PNDSD ROOT SET -SOURCE- 2040 15 JAN 81 22-2362 KP  24998-18194 2001 S C0122 &.TMTH SYS INDEPENDENT LIBRARY             H0101 ASMB,L,R,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED TRIPLE PRECISION ADD, SUBTRACT, MULTIPLY, DIVIDE. NAM .TMTH,7 24998-1X194 REV.2001 780424 * ENT .TADD,.TSUB,.TMPY,.TDIV EXT .FLUN,.XFER,.CFER,FLOAT * A EQU 0 A-REG ADDRESS B EQU 1 B-REG ADDRESS SPC 2 * TRIPLE PRECISION ARITHMETIC ROUTINES. * * * THESE ROUTINES PERFORM TRIPLE PRECISION (4-WORD) ADD, SUBTRACT, * MULTIPLY, AND DIVIDE. THE CALLING SEQUENCES ARE THE SAME AS FOR * DOUBLE PRECISION, NAMELY: * * JSB .TADD, .TSUB, .TMPY, .TDIV * DEF * DEF * DEF * * * ON RETURN, THE OVERFLOW BIT WILL BE SET IF AND ONLY IF UNDERFLOW, * OVERFLOW OR DIVIDE BY ZERO OCCURED. THE OPERANDS ARE EXPECTED TO * BE NORMALIZED (OR ZERO). SKP * ADD AND SUBTRACT. SPC 2 .TSUB NOP JSB ENTER JUST LIKE .TADD, BUT COMPL ARG2 (AC1) LDB AC2P3 JSB TCM ADA EXP2 STA EXP2 JMP TADSB * .TADD NOP JSB ENTER COPY ARGS, RESULT ADDR, RETURN ADDR TADSB LDA AC2 CHECK FOR ARG2=0 SZA,RSS JMP EXIT YES, RESULT = ARG1 LDA AC1 CHECK FOR ARG1=0 SZA,RSS JMP TAD0 YES, RESULT = ARG2 LDA EXP2 FIND EXP DIFF CMA,INA ADA EXP1 EXP1-EXP2 STA EXPDF SSA,RSS JMP TAD1 IF EXP1 .GE. EXP2 * * IN WRONG ORDER, SWITCH * TAD0 CMA,INA ABS(DIFF) STA EXPDF LDA AC1 SWITCH LDB AC2 STA AC2 STB AC1 LDA AC1+1 LDB AC2+1 STA AC2+1 STB AC1+1 LDA AC1+2 LDB AC2+2 STA AC2+2 STB AC1+2 LDA AC1+3 LDB AC2+3 STA AC2+3 STB AC1+3 LDA EXP2 STA EXP1 LDA AC2 IF AC2=0 NOW, DONE SZA,RSS JMP EXIT LDA EXPDF * * TEST FOR DIFF > 56 IF SO, RESULT = AC1 * TAD1 ADA =D-57 SSA,RSS JMP EXIT * * RIGHT SHIFT AC1 BY EXPDF FIRST, BY WHOLE WORDS * LDA AC2 SET B = WORD OF SIGN BITS CLB SSA CCB LDA EXPDF ARS,ARS DIFF/4 ARS,ARS DIFF/16 ADA TAD2 SELECT CODE FOR 0-3 WORDS OF SHIFT JMP A,I TAD2 DEF *+1 JUMP TABLE FOR WORD SHIFTS JMP TAD8 JMP TAD3 JMP TAD4 JMP TAD5 * TAD3 LDA AC2+2 RIGHT SHIFT ONE WORD STA AC2+3 LDA AC2+1 STA AC2+2 LDA AC2 STA AC2+1 JMP TAD7 TAD4 LDA AC2+1 RIGHT SHIFT TWO WORDS STA AC2+3 LDA AC2 STA AC2+2 JMP TAD6 TAD5 LDA AC2 RIGHT SHIFT THREE WORDS STA AC2+3 STB AC2+2 ADD LEADING EXTENDED SIGN BITS TAD6 STB AC2+1 TAD7 STB AC2 * * NOW RIGHT SHIFT BY PARTIAL WORD * TAD8 LDA EXPDF GET SHIFT COUNT AND =B17 SZA,RSS JMP TAD13 IF ZERO COUNT, DONE SHIFTING STB AC2-1 FOR SIGN EXTENSION IOR RRRN FORM "RRR N" STA TAD9 PLUG CODE STA TAD10 STA TAD11 STA TAD12 DLD AC2+2 DO SHIFTS TAD9 RRR 16 STB AC2+3 DLD AC2+1 TAD10 RRR 16 STB AC2+2 DLD AC2 TAD11 RRR 16 fiSTB AC2+1 DLD AC2-1 INCLUDES LEADING SIGN BITS TAD12 RRR 16 STB AC2 * * ADD AC2 TO AC1 * TAD13 CLE JUST 4-WORD INTEGER ADD LDA AC1+3 ADA AC2+3 STA AC1+3 LDA AC1+2 SEZ,CLE INA ADA AC2+2 STA AC1+2 LDA AC1+1 SEZ,CLE INA ADA AC2+1 STA AC1+1 CLO LDA AC1 LAST ADD MUST BE DONE VERY CAREFULLY LDB AC2 SEZ,CME,SSA CCE,INA A IS NEG, SAFE TO ADD IN E SEZ,RSS INB A+... IF B-, SAFE, ELSE BOTH +, O.K. ADA B STA AC1 SOC IF OVERFLOWED, RIGHT SHIFT AND EXIT JMP RSEX * * NORMALIZE FIRST BY WORDS * LDA AC1 FORM WORD OF SIGN BITS CLB SSA CCB STB SIGN CLB B=0 FOR TRAILING ZEROES CPA SIGN CHECK FIRST WORD JMP TAD14 IF 'ZERO' LDA =D-4 4 WORDS TO BIT NORMALIZE JMP TAD19 TAD14 LDA AC1+1 CHECK SECOND WORD CPA SIGN JMP TAD15 IF 'ZERO' STA AC1 LEFT SHIFT ONE WORD LDA AC1+2 STA AC1+1 LDA AC1+3 STA AC1+2 LDA =D-3 3 WORDS TO BIT NORMALIZE JMP TAD18 TAD15 LDA AC1+2 CHECK THIRD WORD CPA SIGN JMP TAD16 IF 'ZERO' STA AC1 LEFT SHIFT TWO WORDS LDA AC1+3 STA AC1+1 LDA =D-2 2 WORDS TO BIT NORMALIZE JMP TAD17 TAD16 LDA AC1+3 CHECK FOURTH WORD CPA SIGN JMP ZERO TRUE ZERO (EXTRA 8 BITS) STA AC1 CCA (-1) ONE WORD TO BIT NORMALIZE STB AC1+1 ADD TRAILING ZEROES TAD17 STB AC1+2 TAD18 STB AC1+3 * * ADJUST EXPONENT IF OVERNORMALIZED, R.S. AND EXIT * TAD19 STA T1 -(NUMBER OF WORDS TO BIT NORMALIZE) ADA =D4 NUMBER OF WORDS SHIFTED ALF *16 = NUMBER OF BITS SHIFTED  CMA,INA ADJUST EXP ADA EXP1 STA EXP1 LDA AC1 CHECK IF OVERNORMALIZED (SIGN CHANGED) XOR SIGN SSA JMP RSEX YES, RIGHT SHIFT AND EXIT * * BIT NORMALIZE * JSB FLOAT USE FLT TO DETERMINE SHIFT COUNT JSB .FLUN A = 15-(NORMALIZATION COUNT) ADA =D-15 SZA,RSS ALREADY NORMALIZED ? JMP EXIT YES. LDB A ADB EXP1 ADJUST EXP STB EXP1 ADA RRRNS FORM "RRR 16-N" = SWITCH, RRL N STA TAD21 LDA AC1PT ADDR AC1 STA T2 TAD20 DLD T2,I SHIFT LOOP TAD21 RRR 16 STB T2,I ISZ T2 ISZ T1 JMP TAD20 JMP EXIT SKP * MULTIPLY. SPC 2 .TMPY NOP JSB ENTER COPY ARGS LDA AC1 CHECK FOR ZERO RESULT SZA,RSS JMP ZERO LDA AC2 SZA,RSS JMP ZERO JSB MDENT TAKE ABS LDA EXP2 FOR EXPONENT CALCULATION CLB,INB MAKE BIT 15 A CARRY JSB MDNT2 UNPACK CLA CLEAR OUT SUM OF PARTIAL PRODUCTS STA AC3 STA AC3+1 STA AC3+2 LDA AC1+3 TAKE (AC2)*(AC1+3) UPPER MPY AC2 RRL 1 STB AC3+3 * * INITIALIZE OUTER LOOP * LDA AC1PT T1 = AC1 PTR STA T1 LDA =D-3 T3 = OUTER LOOP COUNTER STA T3 * * START OUTER LOOP... INITIALIZE INNER LOOP * TMPY1 LDA AC2PT T2 = AC2 PTR STA T2 LDA T3 T4 = PTL PROD PTR & INNER LOOP CNTR ADA AC3P2 STA T5 INA STA T4 T5 = T4-1 (CARRY POINTER) * * INNER LOOP * TMPY2 LDA T1,I AC1(I) MPY T2,I AC1(I)*AC2(J) RRL 1 B=UPPER RAR A=LOWER ADB T4,I ADD UPPER PRODUCT, PROPOGATE CARRY RBL,CLE,SLB,ERB ISZ T5,I STB T4,I LDB T4 UPDATE T4,,DT5 STB T5 ISZ T4 ADA T4,I ADD LOWER PRODUCT, PROPOGATE CARRY RAL,CLE,SLA,ERA ISZ B,I STA T4,I ISZ T2 BUMP J CPB AC3P2 INNER LOOP CONTROL JMP *+2 JMP TMPY2 * * USE ONLY UPPER OF LAST PRODUCT OF INNER LOOP * LDA T1,I AC1(I) MPY T2,I AC1(I)*AC2(5-I) RRL 1 ADB T4,I RBL,CLE,SLB,ERB ISZ T5,I STB T4,I ISZ T1 BUMP I ISZ T3 OUTER LOOP CONTROL JMP TMPY1 * * COMMON MULTIPLY AND DIVIDE EXIT CODE. * CLEAN UP, PACK. * MDEX LDB AC3+2 PK AC1+3 FROM AC3+3<12:0>,0 LDA AC3+3 AC1+2 FROM AC3+2<13:0>,AC3+3<14:13> SSA ADB MDCON STB AC3+2 UPPER BITS MIGHT HAVE CHANGED CLE,ELA ELB,RBR LSL 2 STB AC1+2 STA AC1+3 DLD AC3+1 PACK AC1+1 FROM AC3+1<14:0>,AC3+2<14> SEZ ADA MDCON RBL,ELB ELA STA AC1+1 LDB AC3 SEZ ADB MDCON STB AC1 * * IF UNNORMALIZED, LEFT SHIFT ONE BIT; ATTTACH SIGN. * ELA A = AC1+1 ELB B = AC1 SSB JMP MDEX1 IF NORMALIZED STB AC1 ELSE LEFT SHIFT ONE BIT LDB AC1+3 CLE,ELB STB AC1+3 LDB AC1+2 ELB STB AC1+2 RAR,ELA STA AC1+1 LDA EXP1 DECR EXP ADA =D-1 STA EXP1 MDEX1 LDA SIGN IF SHOULD BE NEG, COMPLEMENT SSA,RSS JMP EXIT LDB AC1P3 JSB TCM ADA EXP1 STA EXP1 JMP EXIT SKP * DIVIDE. * .TDIV NOP JSB ENTER COPY ARGS LDA AC2 CHECK FOR DIVIDE BY ZERO. SZA,RSS JMP DIVZR TAKE DIVIDE-BY-ZERO EXIT LDA AC1 CHECK FOR ZERO RESULT SZA,RSS JMP ZERO JSB MDENT TAKE ABS Y LDA AC2 CHECK FOR NUM .GE. DENOM CMA,INA ADA AC1 SSA,RSS JSB RSHFT YES, RIGHT SHIFT IT LDA EXP2 FOR EXPONENT CALCULATION CMA,INA CCB MAKE BIT 15 A BORROW JSB MDNT2 UNPACK * * SET UP DIVIDE LOOP * LDA AC3M1 T1 = QUOTIENT PTR STA T1 LDA =D-4 T2 = LOOP COUNTER (N-4) STA T2 * * DIVIDE LOOP... FIRST FIND QUOTIENT * TDIV1 ISZ T1 LDB AC1 FORM DIVIDEND LDA AC1+1 SSB,RSS JMP TDV1C REM POS, O.K. STB T3 REM NEG, ADJUST QUOTIENT AND REMAINDER CLB STB T1,I LDB AC1+1 TDV1B LDA AC1+2 ADD DIVISOR TO REMAINDER ADA AC2+1 RAL,CLE,SLA,ERA INB STA AC1+2 IN CASE LOOP LDA T1,I DECR QUOTIENT ADA =D-1 STA T1,I ADB AC2 RBL,CLE,SLB,ERB TALLY CARRY, IF ANY ISZ T3 JMP TDV1B NOT POS YET, DO IT AGAIN ISZ T2 JMP *+2 JMP MDEX ISZ T1 LDA AC1+2 TDV1C CPB AC2 NOW MAY BE ALMOST TOO BIG JMP *+2 JMP TDV1A ADB A YES, FAKE THE DIVIDE LDA =B77777 JMP TDIV2 TDV1A CLE,ERB MAKE INTO 30-BIT INTEGER RAL,ERA DIV AC2 DIVIDE SZA QUOTIENT ZERO ? JMP TDIV2 NO, MUST GO FIGURE REMAINDER. STA T1,I YES, CAN JUST LEFT SHIFT REMAINDER. ISZ T1 ADVANCE LDA AC1+2 ISZ T2 JMP TDV1A JMP MDEX TDIV2 STA T1,I SAVE QUOTIENT STB T3 T3 = REMAINDER OF INTEGER DIVIDE MPY AC2+1 FORM FIRST WORD OF FULL REMAINDER RRL 1 B = UPPER RAR A = LOWER CMB,INB ADB T3 CMA,INA (SAVE LOWER PART) STA T3 SSB,RSS IF POS REMAINDER, O.K. JMP TDV2A CPB =B100000 SPECIAL CASE IN (1-EPS1)/(1-EPS1+EPS2) JMP TDV2A TDV2B ADB AC2 LDA AC1+2 ADA AC2+1 RAL,CLE,SLA,ERA INB STA AC1+2 LDA T1,I ADA =D-1 STA T1,I SSB MAY HAVE TO DO TWICE. JMP TDV2B * * COMPUTE REST OF REMAINDER NEEDED. * TDV2A STB AC1 ISZ T2 JMP *+2 JMP MDEX N WAS 3, DONE. LDA T2 INA,SZA,RSS JMP TDIV1 N WAS 2, REMAINDER O.K., LOOP LDA T1,I AC3+N MPY AC2+2 (AC3+N)*(AC2+2) RRL 1 UPPER RAR LOWER CMB,INB STB T4 CMA,INA STA T5 LDA AC1+2 LDB T2 IF N=1, JUST USE T3 & T4 CPB =D-2 JMP TDIV3 LDA T1,I AC3+N MPY AC2+3 (AC3+N)*(AC2+3) RRL 1 UPPER CMB,INB AC1+3 - (AC3+N*AC2+3)U - (AC3+N*AC2+2)L LDA AC1+2 ADB AC1+3 RBL,CLE,SLB,ERB ADA =D-1 ADB T5 RBL,CLE,SLB,ERB ADA =D-1 STB AC1+2 TDIV3 LDB AC1 AC1+2 - (AC3+N*AC2+2)U - (AC3+N*AC2+1)L RAL,CLE,SLA,ERA ADB =D-1 ADA T4 RAL,CLE,SLA,ERA ADB =D-1 ADA T3 RAL,CLE,SLA,ERA ADB =D-1 STA AC1+1 STB AC1 JMP TDIV1 SKP * COMMON INITIALIZATION CODE * (ADD,SUB,MPY,DIV) * ENTER NOP STA SAVEA SAVE A,B IN CASE WE INDIRECT THRU THEM. STB SAVEB LDA ENTER OUR ENTRY ADA =D-2 LDA A,I CALLER-S ENTRY STA EXITA PARAM LIST ADDR JSB ENTR1 GET RESULT ADDR STA RESLT JSB ENTR1 GET ARG 1 ADDR STA T1 PROCESS IN REVERSE ORDER (F.P. ACC = AC1) JSB ENTR1 GET ARG 2 ADDR LDB AC2PT COPY FIRST 3 WORDS JSB .XFER LDB A,I MANT, EXP JSB .FLUN STB AC2+3 MANT STA EXP2 EXP LDA T1 BACK TO ARG 1 LDB AC1PT COPY FIRST 3W WORDS JSB .XFER LDB A,I SEPARATE MANTISSA, EXP JSB .FLUN STB AC1+3 MANT STA EXP1 EXP JMP ENTER,I EXIT * * ENTR1 NOP ROUTINE TO GET NEXT ADDR IN PARAM LIST LDA EXITA ADDR ADDR PARAM ISZ EXITA LDB SAVEB RESTORE ORIGINAL B ENTR2 STA T2 SAVE ADDR TO INDIRECT THRU LDA SAVEA RESTORE ORIGINAL A LDA T2,I DO THE INDIRECT RAL,CLE,SLA,ERA JMP ENTR2 INDIRECT BIT WAS SET, TRY AGAIN JMP ENTR1,I EXIT SKP * COMMON INITIALIZATION CODE * (MPY,DIV) * MDENT NOP LDA AC1 COMPUTE FINAL SIGN XOR AC2 STA SIGN LDA AC1 TAKE ABS(AC1) SSA,RSS JMP MDNT1 LDB AC1P3 JSB TCM ADA EXP1 STA EXP1 MDNT1 LDA AC2 TAKE ABS(AC2) SSA,RSS JMP MDENT,I LDB AC2P3 JSB TCM ADA EXP2 STA EXP2 JMP MDENT,I * MDNT2 NOP ADA EXP1 FINISH EXPONENET CALC STA EXP1 STB MDCON SAVE SENSE OF BIT 15 DLD AC1+2 UNPACK AC1 RRR 2 CLE,ERB STB AC1+3 DLD AC1+1 CLE,ERA ERB,CLE,ERB DST AC1+1 DLD AC2+2 UNPACK AC2 RRR 2 CLE,ERB STB AC2+3 DLD AC2+1 CLE,ERA ERB,CLE,ERB DST AC2+1 JMP MDNT2,I SKP * COMMON UTILITY ROUTINES SPC 4 * RIGHT SHIFT AC1 ONE BIT, CHANGE SIGN, AND INCR EXP1 * RSHFT NOP LDA AC1 CLE,SSA SET E TO SIGN OF A CCE ERA R. SHIFT ONE BIT, SHIFTING E INTO SIGN STA AC1 LDA AC1+1 ERA STA AC1+1 LDA AC1+2 ERA STA AC1+2 LDA AC1+3 ERA STA AC1+3 ISZ EXP1 INCR EXP1 JMP RSHFT,I EXIT JMP RSHFT,I * * COMPLEMENT CdONTENTS OF MANTISSA. * INPUT: B=(ADDR MANTISSA)+3 * OUTPUT: A=0 EXCEPT: * IF WAS -2**N, R.S. AND A=1. * IF WAS +2**N, L.S. AND A=-1. * TCM NOP LDA B,I CMA,CLE,INA STA B,I CMB,INB CMB LDA B,I CMA,SEZ,CLE INA STA B,I CMB,INB CMB LDA B,I CMA,SEZ,CLE INA STA B,I CMB,INB CMB CLO LDA B,I CMA,SEZ INA STA B,I CPA =B140000 CHECK FOR UNNORMALIZED RESULT JMP TCM1 YES. CLA NORMAL RETURN = 0 SOS IF NO OFL, DONE JMP TCM,I LDA =B40000 ELSE RIGHT SHIFT AC1 AND INCR EXP1 STA B,I CLA,INA OVERFLOW RETURN = +1 JMP TCM,I TCM1 LDA =B100000 SET NORMALIZED RESULT STA B,I CCA NORMALIZE RETURN = -1 JMP TCM,I SKP * COMMON EXIT ROUTINE: CHECK OFL/UFL, PACK, EXIT. * RSEX JSB RSHFT FOR RIGHT SHIFT BEFORE EXIT LDA AC1 FIX SIGN XOR =B100000 STA AC1 EXIT LDA AC1+3 ROUND MANTISSA LDB AC1 CLE,SSB,RSS INA IF POS, USE 200B ADA =B177 IF NEG, USE 177B AND =B177400 STA AC1+3 SEZ PUSH CARRY UP ISZ AC1+2 JMP EXIT3 ISZ AC1+1 JMP EXIT3 ISZ AC1 LDA AC1 CHECK OFL CPA =B100000 JMP EXIT5 YES. CPA =B140000 NO, CHECK -0.5 UNNORMALIZED JMP *+2 YES. JMP EXIT3 NO, O.K. CLE,ELA SET -1.0, DECR EXP CCB JMP EXIT4 EXIT5 RAR +1.0, SET +0.5 AND INCR EXP CLB,INB EXIT4 STA AC1 FIX COEF, EXP ADB EXP1 STB EXP1 EXIT3 LDA EXP1 CHECK OFL/UFL AND =B077600 SHOULD ALL BE SAME SZA CPA =B077600 JMP *+2 JMP OFGGUFL OFL OR UFL XOR EXP1 EXPONENT AND SIGN RAL FORMATTED EXPONENT IOR AC1+3 INSERT INTO LAST WORD STA AC1+3 CLO LEAVE WITH O REG = 0 EXIT6 JSB .CFER COPY RESULT. RESLT DEF *-* DEF AC1 LDA SAVEA RESTORE A,B LDB SAVEB JMP EXITA,I * * OVERFLOW OR UNDERFLOW. RETURN MAX POS OR ZERO. * ZERO CLO SET UP AS UFL BUT O=0 CLB,CLE JMP ZERO1 OFUFL LDA EXP1 SIGN OF A DETERMINES OFL/UFL DIVZR STO O=1 LDB =B77777 SET UP E,B AS PER OFL/UFL CCE,SSA A+, E=1 AND B=77777 CLB,CLE A-, E=0 AND B=0 ZERO1 STB AC1 FIRST WORD ELB SECOND, THIRD WORDS STB AC1+1 STB AC1+2 BLS FOURTH WORD STB AC1+3 JMP EXIT6 EXIT SKP * LOCAL STORAGE * AC1 BSS 4 ACCUMULATOR 1 1 OCT 0 FOR NORMALIZE BSS 1 FOR SIGN EXTENSION IN ADD ALIGNMENT AC2 BSS 4 ACCUMULATOR 2 AC3 BSS 4 ACCUMULATOR 3 (MPY,DIV) EXP1 BSS 1 EXPONENT 1 EXP2 BSS 1 EXPONENT 2 EXPDF BSS 1 EXPONENT DIFFERENCE AC1PT DEF AC1 PTR TO AC1 AC2PT DEF AC2 PTR TO AC2 AC3M1 DEF AC3-1 PTR TO AC3 AC1P3 DEF AC1+3 PTR TO END OF AC1 AC2P3 DEF AC2+3 PTR TO END OF AC2 AC3P2 DEF AC3+2 PTR TO LAST POS OF T5 IN MPY T1 BSS 1 TEMP T2 BSS 1 TEMP T3 BSS 1 TEMP T4 BSS 1 TEMP T5 BSS 1 TEMP MDCON BSS 1 VALUE BIT 15 IN MPY/DIV UNPACKED FORM SIGN BSS 1 RESULT SIGN RRRN RRR 16 TO FORM "RRR N" RRRNS OCT 101120 "RRR N" + 16 EXITA BSS 1 EXIT ADDRESS SAVEA BSS 1 A-REG AT ENTRY SAVEB BSS 1 B-REG AT ENTRY * END `B@< A-REG. = DIRECT SOURCE ADDRESS + 4 * B-REG. = DIRECT DESTINATION + 4 * E-REG = 0 * SPC 1 .CFER NOP JSB .ZPRV DEF LIBX1 LDB .CFER DESTINATION ADDRESS ISZ .CFER LDA .CFER SOURCE ADDRESS ISZ .CFER LDA A,I PICK UP NEXT LEVEL INDIRECT RAL,CLE,SLA,ERA JMP *-2 STA TEMP LDB B,I PICK UP NEXT LEVEL INDIRECT RBL,CLE,SLB,ERB JMP *-2 LDA TEMP,I STA B,I ISZ TEMP INB LDA TEMP,I STA B,I ISZ TEMP INB LDA TEMP,I STA B,I ISZ TEMP INB LDA TEMP,I STA B,I INB BUMP B=B+4(DIRECT) LDA TEMP CLE,INA BUMP A=A+4(DIRECT) LIBX1 JMP .CFER,I DEF .CFER SPC 1 A EQU 0 B EQU 1 TEMP NOP * END * * * #    24998-18197 2001 S C0122 &.FLUN SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED ".FLUN" RETURN EXPONENT IN A-REG, LO-MANTISSA IN B-REG. NAM .FLUN,6 24998-1X197 REV.2001 750701 ENT .FLUN EXT .ZPRV * * * ENTER WITH B=LOW PART OF A FLOATING POINT NUMBER. * RETURN WITH A=EXPONENT,B=LOW MANTISSA. .FLUN NOP JSB .ZPRV DEF LIBX LDA 1 MOVE ARGUMENT TO A AND MASKL GET EXPONENT BITS CMB SUBTRACT ADB 0 FROM CMB B SLA,RAR POSITION & TEST SIGN. IF MINUS IOR XSEXP PUT IN EXTRA BITS. LIBX JMP .FLUN,I DEF .FLUN MASKL OCT 377 XSEXP OCT 77600 END * `  24998-18198 2001 S C0122 &.XFER SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED ".XFER" EXTENDED PRECISION "TRIPLE LOAD/STORE" NAM .XFER,6 24998-1X198 REV.2001 790523 ENT .XFER EXT .ZPRV EXT .DFER SPC 1 * * THIS ROUTINE PASSES TRIPLE PRECISION ARGUMENTS * BETWEEN EXTENDED PRECISION ROUTINES. * CALLING SEQUENCE: * LDA (SOURCE ADDRESS) * LDB (DESTINATION ADDRESS) * JSB .XFER * A-REG. = DIRECT SOURCE ADDRESS + 3 * B-REG. = DIRECT DESTINATION + 3 SPC 1 .XFER NOP JSB .ZPRV DEF LIBX STA SORC SET SOURCE ADDRESS STB DEST SET DESTIONATION ADDRESS JSB .DFER CALL TRIPLE WORD MOVE ROUTINE DEST DEF * SORC DEF * LIBX JMP .XFER,I DEF .XFER END *   24998-18199 2001 S C0122 &.DFER SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED ".DFER" EXTENDED PRECISION "TRIPLE LOAD/STORE" NAM .DFER,6 24998-1X199 REV.2001 790523 ENT .DFER EXT .ZPRV SPC 1 * * THIS ROUTINE PASSES TRIPLE PRECISION ARGUMENTS * BETWEEN EXTENDED PRECISION ROUTINES. * CALLING SEQUENCE: * JSB .DFER * DEF (DESTINATION) * DEF (SOURCE) * A-REG. = DIRECT SOURCE ADDRESS + 3 * B-REG. = DIRECT DESTINATION + 3 * E-REG = 0 * SPC 1 .DFER NOP JSB .ZPRV DEF LIBX1 LDB .DFER DESTINATION ADDRESS ISZ .DFER LDA .DFER SOURCE ADDRESS ISZ .DFER LDA A,I PICK UP NEXT LEVEL INDIRECT RAL,CLE,SLA,ERA JMP *-2 STA TEMP LDB B,I PICK UP NEXT LEVEL INDIRECT RBL,CLE,SLB,ERB JMP *-2 LDA TEMP,I STA B,I ISZ TEMP INB LDA TEMP,I STA B,I ISZ TEMP INB LDA TEMP,I STA B,I INB BUMP B=B+3(DIRECT) LDA TEMP CLE,INA BUMP A=A+3(DIRECT) LIBX1 JMP .DFER,I DEF .DFER SPC 1 A EQU 0 B EQU 1 TEMP NOP END *     24998-18200 2013 S C0122 &$MLB1 HEADER RECORD,MATH LIB             H0101 ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18200 * RELOC: 24998-1X200 * PGMR: BG & JTS * * * * * NAM $MLB1 24998-12001 REV.2013 800205 END   24998-18201 2026 S C0122 &$MLB2              H0101 xLASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18201 * RELOC: 24998-1X201 * PGMR: BG & JTS * * * * * NAM MLIB2 24998-12002 REV.2026 800509 * END   24998-18230 2001 S C0122 &FMTIO SYS INDEPENDENT LIBRARY             H0101 !ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED FMTIO NAM FMTIO,7 24998-1X230 REV.2001 790417 SPC 2 ENT .IOI.,.IOJ.,.IOR. ENT .IIO.,.JIO.,.RIO.,.XIO.,.TIO. ENT .IAR.,.JAR.,.RAR.,.XAR.,.TAR. ENT .IAY.,.JAY.,.RAY.,.XAY.,.TAY. ENT .DIO.,.BIO.,.DTA. ENT NEWIO,OLDIO,CODE,ACODE,ITLOG,ISTAT,LGBUF EXT .FRMN,.LS2F,.INPN,.DTAN,FMT.E EXT PNAME,REIO,EXEC,.SBT * A EQU 0 B EQU 1 SPC 2 * SPECIAL ENTRY POINTS: * ************************************************************************ * ASSEMBLY FORTRAN (IV) * * JSB CODE CALL CODE(ICHRS) * DEF *+2 READ (IBUF,*) A,B,C * DEF ICHRS * LDA IBUFR(,I) * CLB(,INB) * JSB .DIO. * DEF FORMT * DEF ENDLS * * WHERE: * IBUFR = THE IN MEMORY BUFFER TO CONVERT TO BINARY * ICHRS = THE NUMBER OF ASCII CHARACTERS IN " IBUFR " * * NOTES: * THE ENTRY POINT " CODE " IS NOW IN THE FORMATTER WHICH * ALLOWS THE OPTIONAL PARAMETTER " ICHRS " TO BE PASSED * TO LIMIT THE SIZE OF THE BUFFER THAT THE FORMATTER WILL * READ. IF " IBUFR " IS NOT PASSED, THEN THE FORMATTER WILL * SEARCH ALL OF MEMORY, IF NECESSARY, TO SATISFY THE VARIABLE * LIST. (A,B,C) SKP * JSB ITLOG ICHRS = ITLOG(IXXXX) * DEF *+1 * STA ICHRS * WHERE: *  ICHRS = THE NUMBER OF CHARACTORS READ OR WRITTEN BY THE FORMATTER * BY ITS LAST INPUT/OUTPUT REQUEST TO THE SYSTEM. " ICHRS " VALUE * WILL BE 0 TO 134 (120 OF BINARY) REGARDLESS OF THE SPECIFIED * BUFFER SIZE IN THE READ OR WRITE STATEMENT. * IXXXX = THE SAME AS " ICHRS " *********************************************************************** * JSB ISTAT ISTUS = ISTAT(IXXXX) * DEF *+1 * STA ISTUS * WHERE: * ISTUS = THE STATUS WORD RETURNED FROM THE EXEC IN THE LAST * INPUT/OUTPUT CALL THE FORMATTER DID. * IXXXX = SAME AS " ISTUS " ************************************************************************ * JSB LGBUF CALL LGBUF(IBUFF,LENTH) * DEF *+3 * DEF IBUFF * DEF LENTH * WHERE: * IBUFF = ADDRESS OF A USER BUFFER. * LENTH = LENGTH OF BUFFER, IN WORDS. THIS BECOMES THE NEW MAXIMUM * RECORD LENGTH. *********************************************************************** * FORTRAN EXAMPLES. *** * CALL EXEC (1,401B,IBUFR,-80) * CALL ABREG(IA,ICHRS) * CALL CODE(ICHRS) * READ(IBUFR,*) A,B,C,D *** * 5 READ (1,10) (IBUF(I),I=1,36) * 10 FORMAT (36A2) * IF (ITLOG(ICHRS)) 20,5,20 * 20 ISTRC = 1 * CALL NAMR(IPBUF,IBUF,ICHRS,ISTRC) * * NOTE: ICHRS CAN BE AS LARGE AS 134 IF 134 CHARACTERS ARE INPUT. *** * READ (8,10) (IBUF(I),I=1,80) * 10 FORMAT (40A2) * IF (IAND(ISTAT(ISTUS),240B)) 99,20,99 * 20 CONTINUE * --- * 99 CONTINUE (END OF FILE OR END TAPE DETECTED) *** * DIMENSION IBUFF(1000) * --- * CALL LGBUF(IBUFF,1000) * READ(8,10) (ARRAY(I),I=1,2000) * 10 FORMAT(2000A1) HED COMMUNICATION WITH FRMTR. * FOLLOWING LOCATIONS REFERENCED IN FRMTR: * ADX BSS 1 ADDRESS VARIABLE. TYPE BSS 1 TYPE LENTH BSS 1 LENGTH (IN WORDS) SKIP BSS 1 FLAG TO SKIP STOREiN IN .IOI./.IOJ./.IOR. FCR BSS 1 POINTS TO CHARACTER IN FORMAT CCNT BSS 1 COUNTS WORDS/CHARS IN BUFFER CMAX BSS 1 MAX VALUE OF CCNT AT TAB LEFT. BCR BSS 1 IO BSS 1 FLAG...=0 FOR OUTPUT, 1 FOR IN SKIPL BSS 1 FLAG TO AVOID SPURIOUS RTN TO LIST. TSCAL BSS 1 SCALE BSS 1 SCALE FACTOR NEST BSS 1 PAREN LVLS. INIT -6, -5 IN FMT, * -4 TO -1 FOR NESTING. CFLAG BSS 1 BCRS BSS 1 USED FOR REMEMBERING BCR F2LSI BSS 1 SWITH BSS 1 RNEST BSS 1 NEST VALUE OF UNLIMITED GROUPS. ADRFD DEF RFSV USED FOR INDEXING IN RFLD. RF BSS 1 FORMAT REPEAT FIELD COUNTER WSAVE BSS 1 HOLDS INITIAL W FOR REPEATS DSAVE BSS 1 HOLDS INITIAL D FOR REPEATS GFLAG BSS 1 = -1 IF G FIELD, +1 OTHERWISE. .OBUF DEF BUFO EORD BSS 1 ALSO DTAI & ATMP. OFLAG DEC 0 =0,-1 FOR ASA/OLD FORMATS. HED CONSTANTS & LOCALS. * CONSTANTS. * CNTRL BSS 1 MIN6 DEC -6 MIN2 DEC -2 MIN1 DEC -1 ....1 DEC 1 ....2 DEC 2 ....3 DEC 3 ....7 DEC 7 ...13 DEC 13 PAPER OCT 34000 TEST FOR PAPER TAPE. O76K OCT 76000 O2000 OCT 2000 PBIT OCT 200 SET BIT FOR IOC. BASIC OCT 400 .4000 OCT 4000 CHECK FOR TYPE CODE = 1X ASC2B OCT 500 SPCOL ABS 72B-40B ":" - " " "B" OCT 102 "^0" BYT 40,60 " 0" "0" OCT 60 BLANK OCT 40 MXPS OCT 77777 MAX POS # DMXPS DEF MXPS * * LOCALS. * FMTAD BSS 1 ADDR FORMAT TEMP1 BSS 2 TEMPORARY TEMP2 BSS 1 STORAGE RFLD BSS 5 REPEAT FIELD FOR GROUPS. RFSV BSS 5 INITIAL VALUE OF R-FIELD. LPRN BSS 5 ADDRESS OF LEFT PAREN'S IN GROUP UNIT OCT 1 INPUT/OUTPUT UNIT ENDLS BSS 1 POINTS TO ENDOF CALLING SEQUENCE ALNTH BSS 1 AND .IAR. BFLAG BSS 1 =1 FOR BINARY I/O, 0 FOR DECIMAL STXXX NOP BUFBN EQU 60 BUFLN EQU 67 BUFI BSS BUFLN BUFO EQU BUFI BINRY ABS -BUFBN-BUFBN BINARY RECORD LENGTH ASCRY ABS -BUFLN-BUFLN FORMATTED RECORD LENGTH CLEN ABS -BUFLN-BUFLN HED ROUTINES TO PASS LIST ITEMS. ******************************************************************** * THIS SET OF ROUTINES IS USED TO PASS THE ADDRESS, TYPE AND * * LENGTH (IF ARRAY). FOR EACH VARIABLE OR ARRAY OF TYPE: * * INTEGER (I), DOUBLE INTEGER (J), REAL/2-WD FLOATING (R), * * EXTENDED PRECISION/3-WD FLOATING (X) OR DOUBLE PRECISION/4-WD * * FLOATING (T), THERE IS A SINGLE CALL TO ONE OF THE FOLLOWING: * * .IOZ., Z=I,J,R; .ZIO./.ZAR./.ZAY., Z=I,J,R,X,T. * * THERE IS INITIALLY A SINGLE CALL TO EITHER .DIO. OR .BIO. . * ******************************************************************** SPC 3 IOCHK NOP A SWITCH ON THE VALUE OF IO. RE- STB TEMP2 SAVE B LDB IO TURN TO P+1 FOR OUTPUT, P+2 FOR SZB INPUT. ISZ IOCHK LDB TEMP2 RESTORE B JMP IOCHK,I SPC 3 BCHEK NOP RETURNS TO P+1 IF BINARY, ELSE 2 STB TEMP2 LDB BFLAG SZB,RSS ISZ BCHEK LDB TEMP2 JMP BCHEK,I SPC 2 * ROUTINE TO INITIALIZE .ZIO. / .ZAR. / .ZAY. * CTYPE NOP ADB MIN2 ACTUAL ENTRY POINT ADDR. LDA B,I COPY ENTRY POINT. STA .TIO. CMB COMPUTE OFFSET FROM FIRST ONE. ADB CTYPE,I CMB BRS TYPE = OFFSET / 2 STB TYPE SZB TYPE = 0 CPB ....1 OR 1 ? INB YES, LENTH IS ONE LARGER (ELSE EQUAL) STB LENTH ISZ CTYPE EXIT JMP CTYPE,I SKP * .IOI. / .IOJ. / .IOR. * * CALLING SEQUENCE: * * * JSB ROUTINE * SPC 2 .IOI. NOP STORE ARG & CALL .IIO. STA TEMP1 JSB .IIO. DEHTF TEMP1 LDA TEMP1 LDB SKIP IF FREE-FIELD & NULL, SKIP STORE. SZB ISZ .IOI. JMP .IOI.,I * .IOJ. NOP STORE ARG & CALL .JIO. STA TEMP1 STB TEMP1+1 JSB .JIO. DEF TEMP1 LDA .IOJ. SAVE A LITTLE SPACE HERE. STA .IOR. JMP IOR1 * .IOR. NOP STORE ARG & CALL .RIO. STA TEMP1 STB TEMP1+1 JSB .RIO. DEF TEMP1 IOR1 LDA SKIP FREE-FIELD & NULL ? SZA ISZ .IOR. YES. SKIP. SZA ISZ .IOR. LDA TEMP1 LOAD UP RESULT. LDB TEMP1+1 JMP .IOR.,I EXIT. SKP * .IIO. / .JIO. / .RIO. / .XIO. / .TIO. * * CALLING SEQUENCE: * * JSB ROUTINE * DEF SPC 2 .IIO. NOP JSB TIO .JIO. NOP JSB TIO .RIO. NOP JSB TIO .XIO. NOP JSB TIO .TIO. NOP JSB TIO SPC 1 TIO NOP LDB TIO COMPUTE TYPE, LENTH. JSB CTYPE DEF .IIO. LDB A,I B = BASE ADDR. ISZ .TIO. CLA,INA A = # ELEMENTS = 1. JMP TAY1 SKP * .IAR./.JAR./.RAR./.XAR./.TAR. .IAY./.JAY./.RAY./.XAY./.TAY. * * CALLING SEQUENCES: * * LDA <# ELEMENTS> JSB ROUTINE * LDB DEF * JSB ROUTINE DEC <# ELEMENTS> * * INDIRECTION IS ALLOWED ON BOTH VALUES (THE # OF ELEMENTS * IS TREATED AS AN ADDRESS). SPC 3 .IAR. NOP JSB TAR .JAR. NOP JSB TAR .RAR. NOP JSB TAR .XAR. NOP JSB TAR .TAR. NOP JSB TAR * TAR NOP STB ADX SAVE A,B. STA ALNTH LDB TAR SET TYPE, LENTH. JSB CTYPE DEF .IAR. LDB ADX B = BASE ADDR. LDA ALNTH A = # ELEMENTS. JMP TAY1 SPC 2 .IAY. NOP JSB TAY .JAY. NOP  JSB TAY .RAY. NOP JSB TAY .XAY. NOP JSB TAY .TAY. NOP JSB TAY * TAY NOP LDB TAY SET TYPE, LENTH. JSB CTYPE DEF .IAY. LDB A,I B = BASE ADDR. ISZ .TIO. LDA .TIO.,I A = # ELEMENTS. ISZ .TIO. JMP TAY1 SKP * AT THIS POINT: TYPE, LENTH & RETURN ADDR ARE * SET UP, AND: B=BASE ADDR, A=# ELEMENTS. SPC 2 LDB B,I REMOVE INDIRECTS FROM BASE ADDR. TAY1 RBL,CLE,SLB,ERB JMP *-2 STB ADX JMP *+2 REMOVE "INDIRECTS" ON LENGTH LDA A,I RAL,CLE,SLA,ERA JMP *-2 JSB BCHEK BINARY ? JMP TAY3 YES. CMA,INA,SZA,RSS - # ELEMENTS. JMP .TIO.,I IF NONE. STA ALNTH TAY2 JSB LST2J GO CONVERT. LDA ADX BUMP TO NEXT ELEMENT. ADA LENTH STA ADX ISZ ALNTH DONE ? JMP TAY2 NO, DO ANOTHER. JMP .TIO.,I YES, EXIT. * * BINARY ARRAY I/O. * TAY3 MPY LENTH A = TOTAL LENGTH. CMA,INA,SZA,RSS SET UP COUNT. JMP .TIO.,I IF ZERO. STA ALNTH TAY4 ISZ CCNT TEST FOR END OF BUFFER. JMP TAY5 NO. JSB DTA YES, DO I/O. JMP TAY4 AND TRY AGAIN. TAY5 ISZ BCR BUMP BUFFER POINTER. LDA ADX,I FOR OUTPUT. JSB IOCHK WHICH ? STA BCR,I OUTPUT. LDA BCR,I INPUT. JSB IOCHK WHICH ? JMP *+2 OUTPUT - DONE. STA ADX,I INPUT - STORE IN VARIABLE. ISZ ADX TO NEXT ELEMENT. ISZ ALNTH DONE ? JMP TAY4 NO, DO AGAIN. JMP .TIO.,I EXIT. HED CODE - ENCODE/DECODE. * THE FOLLOWING CODE WAS ADDED FOR THE "CALL CODE" PROBLEM * CALLING: * JSB CODE JSB CODE * DEF *+1 DEF *+2 * LDA IBUFR(,I) DEF TLOG +CHARS * CLB(,INB) - OR - LDA IBUFR(,I) * JSB .DIO. CLB(,INB) * DEF FORMT JSB .DIO. * DEF ENDLS DEF FORMT * ETC. DEF ENDLS * ETC. ****************************************** CODE NOP SPECIAL ENTRY FOR INTERNAL CONVERSION ACODE EQU CODE DO THE ALGOL THING ******************************************* LDB CODE,I GET RETURN ADDRESS + LDA BUFFR(,I) ISZ CODE BUMP TO FIND OUT IF TLOG LDA CODE,I GET POSSIBLE PRAM ADDRESS CPB CODE CHECK IF PASSED PARM LDA DMXPS NO, GET DEF MAX POS #. LDA A,I GET TLOG IN CHARS OR MAX POS #. CMA MAKE -TLOG-1 OR MAX NEG #. STA CCNT SAVE AS BUFFER LEN STA CMAX STB BFLAG SAVE RETURN ADDRESS LDA B,I LOAD: "LDA IBUFR(,I)". AND O2000 MASK TO FIND IF CLE,SZA CURRENT OF BASE PAGE? LDA B CURRENT, GET PAGE BITS XOR B,I LOAD IF BASE, MIRGE IF CURRENT AND O76K MASK OFF PAGE IF BASE, XOR B,I MIRGE IN IF CURRENT RSS NOW TRACK DOWN ANY LDA A,I INDIRECT ADDRESSES RAL,CLE,SLA,ERA INDIRECT? JMP *-2 YES, DO IT AGAIN RAL DOUBLE IT AND ADA MIN1 SUBTRACT ONE STA BCR SAVE THE BUFFER ADDRESS ADB ....3 POINT TO THE P+1 OF JSB .DIO. STB CODE SAVE IN CONVENENT PLACE JMP BFLAG,I RETURN TO EXECUTE LDA IBUFF,CLB,JSB .DIO. HED .DIO. & .BIO. - INITIALIZATION. *************************** .DIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR FORMATTED INPUT/ *************************** OUTPUT. STA UNIT STB IO LDA .DIO. CHECK IF CALL CODE BEFORE CPA CODE MUST BE SAME JMP INTCN YES, CALL CODE CONVERSION \ LDA UNIT SET FUNCTION BITS JSB SETLU STA CNTRL LDA UNIT NO, PROCESS AS BEFORE CCE,SZA CHECK FOR UNIT=0. (E=1) JMP DIO1 NO-IO TRANSFER. ERA INTERNAL CONVERSION. (A=MAX NEG #) STA CCNT SET CCNT = MAX NEG #. STA CMAX LDB .DIO.,I B = BUFFER ADDR. LDA B,I VERIFY ABOVE FENCE. STA B,I RBL FORM BYTE ADDR - 1: BCR. ADB MIN1 STB BCR ISZ .DIO. INTCN CLA,RSS CALL CODE INTERNAL CONVERSION DIO1 CLA,RSS STA UNIT STA BFLAG STA SKIP STA SKIPL STA TSCAL INITIAL SCALE FACTOR = 0 STA SCALE CLEAR SCALE FACTOR FOR FREE INPT STA SWITH LDA ASCRY STA CLEN RECORD SIZE LDA MIN6 STA NEST OUTSIDE LEVEL 0 PARENS. CCA STA CFLAG FREE-FIELD COMMAS. SKP * COPY FORMAT AND END-OF-LIST ADDRESSES. * LDA .DIO. GET FORMAT ADDRESS LDA A,I GET DOWN TO NEXT LEVEL RAL,CLE,SLA,ERA TEST FOR INDIRECT (1 LEVEL) JMP *-2 SEARCH FOR EVER IF NEED BE STA FMTAD SAVE FORMAT ADDRESS LDB A,I VERIFY ABOVE FENCE. STB A,I RAL CONVERT TO A CHARACTER CMA,INA,SZA ADDRESS CMA STA FCR ISZ .DIO. GET THE END-OF LIST LDA .DIO.,I ADDRESS STA ENDLS LDB A,I VERIFY ABOVE FENCE. STB A,I * * IF FORMATTED OUTPUT, WAIT FOR PREV. OUTPUT & GO. * IF INPUT, READ RECORD. IF FORMATTED, GO. * ISZ .DIO. SET UP LDA .DIO. THE RETURN STA LST2J ADDRESS JSB IOCHK IF OUTPUT, JSB WAITO WAIT. JSB IOCHK JMP FORMT GO. JSB DTA INPUT. READ A RECORD. LDA FCR FORMATTED ? SZA JMP FORMT YES, GO. * * FR5FEE-FIELD INPUT. * NXTON JSB F2LST LIST DEFINITION IOTST LDB UNIT CHECK IF INTERNAL CONVERSION LDA CCNT IF CCNT = 0, SZA CHECK IF SLASH WAS ENCOUNTERED JMP NSLSH NO SZB,RSS SLASH, BUT INTERNAL CONVERSION? JMP ENDLS,I YES RETURN, UNSATISFYING LIST JSB DTA SO READ NEXT RECORD NSLSH JSB .INPN ENTER FRMTR TO CONVERT DATA DEF ADX LDA SWITH CPA ....7 IF SWITH = 7, GO TO END OF LIST JMP ENDLS,I SZA JMP NXTON STORE ELEMENT JMP IOTST MUST BE SLASH SKP *************************** .BIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR NON-FORMATTED *************************** INPUT/OUTPUT STA UNIT STB IO JSB SETLU CONFIGURE THE LU CONTROL WORD XOR ASC2B MAKE IT BINARY STA CNTRL AND PUT IT AWAY CLA,INA BFLAG = 1. STA BFLAG CLA SKIP = 0. STA SKIP LDA BINRY STA CLEN RECORD SIZE LDB IO TEST FOR I/O DIRECTION SZB JMP BIO1 IF INPUT. JSB WAITO OUTPUT, WAIT. JMP .BIO.,I BIO1 JSB DTA INPUT, READ. JMP .BIO.,I SPC 3 *************************** SET NEW FORMAT DEFS. NEWIO NOP * CALLING SEQUENCE: * JSB NEWIO *************************** DEF *+1 CLA STA OFLAG ISZ NEWIO JMP NEWIO,I SPC 3 *************************** SET OLD FORMAT DEFS. OLDIO NOP * CALLING SEQUENCE: * JSB OLDIO *************************** DEF *+1 CCA STA OFLAG ISZ OLDIO JMP OLDIO,I HED LINKAGE TO "FRMTR". * MAIN LOOP. CALL FRMTR & ACCEPT REQUESTS: * SWITH<6: PRODUCE ERROR MSG & QUIT. * D@ SWITH=6: GET A LIST ITEM. * SWITH=8: DO I/O. * FORMT JSB .FRMN ENTER FRMTR TO PROCESS LIST DEF ADX TSTSW LDA MIN6 ADA SWITH SSA JMP ERROR SWITCH < 6 = ERROR. SZA,RSS JMP NRML SWITCH=6=F2LST JSB DTA SWITCH=8 JSB .DTAN ENTER FRMTR AFTER DATA I/O DEF ADX JMP TSTSW NRML JSB F2LST JSB .LS2F CONTINUE LIST PROCESS DEF ADX JMP TSTSW SPC 3 * COROUTINE MECHANISM FOR LIST ITEMS: * THE CONVERSION ROUTINES IN FRMTR AND THE LIST-ITEM * HANDLERS IN FMTIO ACT AS COROUTINES. THE LINKAGE IS * PERFORMED BY LST2J AND F2LST. WHEN FRMTR IS READY * FOR A LIST ITEM, IT RETURNS TO THE FREE-FIELD OR * FORMATTED LOOP IN FMTIO, WHICH CALLS F2LST. * F2LST RETURNS THRU LST2J TO THE PREVIOUSLY CALLED * ITEM HANDLER, WHICH RETURNS TO THE CALLER. THE * CALLER CALLS ANOTHER ITEM HANDLER, WHICH CALLS LST2J * (SAVING ITS RETURN POINT). LST2J RETURNS THRU F2LST * TO THE CONVERSION LOOP, WHICH "RETURNS" TO FRMTR BY * CALLING THE APPROPRIATE ENTRY POINT. * SINCE FORMATTED I/O CALLS FRMTR FIRST, FORMATTED * I/O IS DRIVEN BY THE FORMAT. SINCE FREE-FIELD * I/O RETURNS FOR A LIST ITEM FIRST, FREE-FIELD * INPUT IS DRIVEN THE THE LIST. SPC 1 LST2J NOP LDA ADX,I VERIFY DATA ABOVE FENCE. STA ADX,I JMP F2LST,I SPC 1 F2LST NOP LDA BCR STA BCRS ISZ SKIPL PROCESSING FINAL RIGHT PAREN ? JMP LST2J,I NO, RETURN TO .IOI. & FRIENDS. JMP F2LST,I YES, RETURN TO FORMAT PROCESSOR. HED I/O ROUTINES. DTA NOP PERFORMS A COMPLETE I/O OPERA- JSB .DTA. TION.  JSB IOCHK JMP *+3 JSB WAITI INPUT WAIT JMP DTA,I JSB WAITO OUTPUT WAIT JMP DTA,I SPC 2 .DTA. NOP LDA UNIT SET UP STATUS CONTROL SZA,RSS IF UNIT=0, JMP .DTA.,I IGNORE CALL. JSB IOCHK NOW TEST FOR INPUT OR OUTPUT. JMP DTAO * INPUT SECTION * JSB IOCIN PERFORM IOC CALL. JMP .DTA.,I RETURN * OUTPUT SECTION * DTAO LDB CCNT GET NUMBER OF CHARACTERS/WORDS. JSB BCHEK BINARY ? JMP DTAO2 YES. CMB,CLE,INB -CCNT ADB CMAX CMAX-CCNT (E=0 IFF B<0) LDB CCNT NORMALLY USE CCNT. SEZ CMAX > CCNT ? LDB CMAX YES, USE IT. CMB # CHARS UNUSED. ADB CLEN CHAR COUNT. STB OUTBL STORE AS # OF CHARS. OUTPUT. CMB,SLB,INB B=# CHARS. EVEN ? JMP DTAO1 YES, IS O.K. ADB BUFOA NO. FORM ADDR CHAR AFTER LAST. ADB BUFOA LDA BLANK STORE A BLANK AFTER LAST CHAR. JSB .SBT DTAO1 JSB IOCOU PERFORM IOC CALL JMP .DTA.,I RETURN DTAO2 SZB BINARY RECORD CONTINUATION ? CMB NO. B = # WORDS NOT USED. BLS B = # CHARS NOT USED. ADB CLEN B = -(# CHARS USED) STB OUTBL CMB,INB B = REC LENGTH BLF,BLF POSITION AS HIGH CHARACTER RBR IN WORDS. LDA CNTRL ALF,ALF ROTATE P-BIT TO SIGN SSA IF NOT ZERO, STORE AS STB .IBUF,I FIRST CHARACTER IN BUFFER. JMP DTAO1 SKP WAITI NOP WAITS FOR INPUT LDB UNIT IGNORE SZB,RSS CALL IF JMP WAITI,I UNIT=0. JSB BCHEK BINARY OR ASCII? ARS BINARY--CONVERT TO WORD COUNT. CMA STORE AS NEGATIVE IN STA CCNT COUNTER. STA CMAX LDB .IBUF GET BUFFER ADDRESS JSB BCHEK BINARY ? JMP WTI3 UG YES RBL FOR ASCII SET BCR TO POINT TO WTI2 ADB MIN1 THE FIRST CHARACTER PRECEDING WTI4 STB BCR THE BUFFER. JMP WAITI,I WTI3 LDA CNTRL ALF,ALF SSA,RSS PAPER TAPE ? JMP WTI2 NO ISZ CCNT YES JMP WTI4 * INPUT ERROR * * WAITO NOP WAITS FOR OUTPUT TO BE COMPLETED LDA UNIT IGNORE CALL IF SZA,RSS UNIT=0. JMP WAITO,I LDA .OBUF SET UP BUFFER ADDRESS AND CCB LENGTH. ADB CLEN JSB BCHEK BINARY. JMP WTO6 RAL ADJUST BUFFER ADDRESS FOR ADA MIN1 CHARACTERS STA BCR STB CCNT STB CMAX JMP WAITO,I WTO6 BRS ADJUST LENGTH FOR WORDS. ADA MIN1 STA BCR STB CCNT (DON'T NEED CMAX FOR BINARY) LDA CNTRL ALF,ALF SSA,RSS TEST FOR PAPER TAPE. JMP WAITO,I NOT PAPER TAPE. ISZ CCNT IF PAPER TAPE, BUMP BUFFER ISZ BCR ADDRESS AND COUNTER. JMP WAITO,I RETURN SKP SETLU BSS 1 SZA,RSS IF LU = 0 THEN JMP SETLU,I RETURN JSB EXEC ELSE DEF *+3+1 TEST FOR PAPER TAPE AND CONFIGURE DEF ...13 THE CONTROL WORD DEF UNIT DEF STXXX LDA STXXX AND PAPER CPA .4000 CLA SZA CLA,RSS LDA PBIT IOR UNIT IOR BASIC JMP SETLU,I SKP IOCIN NOP INPUT CALL TO IOC INAGN JSB REIO DEF *+5 DEF ....1 DEF CNTRL .IBUF DEF BUFI DEF CLEN STA STATS SAVE STATUS FOR LATER STB TLOG SAVE TRANSMISSION LOG FOR LATER RAL TEST DOWN BIT SSA ARE WE OK? JMP INAGN NO GO TRY AGAIN AND O500 IS EOT OR EOF BITS SET? SZA,RSS JMP IOCI1 NO, CONTINUE JSB BCHEK CHECK IF BINARY OR ASCII RSS ^ BINARY JMP ENDLS,I ASCII, EXIT LDB CLEN YES, DUMMY THE TLOG SSB -? CMB,INB YES, MAKE POSITIVE IOCI1 LDA B JMP IOCIN,I SPC 3 IOCOU NOP OUTPUT CALL TO IOC LDA CNTRL CLEAR BIT 7 AND =B177577 FOR OUTPUT REQUESTS STA CNTRO JSB REIO DEF *+5 DEF ....2 DEF CNTRO BUFOA DEF BUFO DEF OUTBL STA STATS STB TLOG SAVE STATUS AND TLOG JMP IOCOU,I OUTBL BSS 1 CNTRO BSS 1 SKP * ITLOG - GET LAST TRANSMISSION LOG. * ITLOG NOP ENTRY TO GET LAST TRANSMISSION LOG LDA TLOG GET LAST TRANSMITTION LOG LDB ITLOG GET RETURN ADDRESS STB ISTAT DUMMY UP ENTRY JMP ISTAT+2 SPC 4 * ISTAT - GET LAST STATUS WORD. * ISTAT NOP ENTRY TO GET LAST STATUS WORD LDA STATS GET LAST STATUS LDB ISTAT,I GET RETURN ADDRESS STB ITLOG SAVE TEMP ISZ ISTAT CHECK IF PARAMETER PASSED CPB ISTAT CLB,RSS SET DUMMY ADDRESS IN B-REG LDB ISTAT,I GET PARAMETER ADDRESS STA B,I RETURN PARAMETER JMP ITLOG,I RETURN SPC 1 STATS NOP LAST I/O STATUS WORD TLOG NOP LAST I/O TRANSMITTION LOG O500 EQU ASC2B SPC 4 * LGBUF - SUBSTITUTE USER BUFFER FOR FMTIO BUFFER. * LGBUF BSS 1 ISZ LGBUF LDA LGBUF FETCH THE BUFFER ADDRESS LGLP1 LDA A,I RAL,CLE,SLA,ERA TEST AND CLEAR INDIRECT BIT JMP LGLP1 TRY AGAIN STA BUFOA FIX THE ADDRESS POINTERS STA .IBUF STA .OBUF ISZ LGBUF LDA LGBUF,I FETCH THE BUFFER LENGTH LDA A,I ALS MAKE IT INTO A BYTE COUNT CMA,INA STA ASCRY STA BINRY ISZ LGBUF JMP LGBUF,I HED ERROR PROCESSING. * PRINT ON LU "FMT.E" THE FORMAT ERROR IN THE FOR TRNM: * " /PROGM: FMT ERR 3 @12345B" * (WITHOUT QUOTES) THIS EXAMPLE HAS ERROR #3 FROM THE FORMAT AT * ADDRESS 12345 OCTAL, AND THE CALLING PROGRAM IS NAMED "PROGM". SPC 1 ERROR LDA UNIT INHIBIT ERRORS WHEN SZA,RSS INTERNAL CONVERSION JMP ENDLS,I LDA SWITH GET ERROR NUMBER ADA "^0" CONVERT TO ASCII " 0" STA MESSS+8 FIRST WORD OF ERROR CODE LDA FMTAD GET FORMAT ADDRESS LDB DFADS GET ADDRESS OF MEM BUFFER RAL,CLE,SLA POSITION MEM ADDRESS & SKIP AGAIN LDA IOCOU GET NEXT OCT DIGIT ALF,RAR ROTATE LEFT 3 STA IOCOU SAVE FOR NEXT PASS AND ....7 MASK DOWN TO DIGIT IOR "0" MIRGE IN TO ASCII SEZ,RSS SKIP IF LO-CHAR IN WORD ALF,SLA,ALF POSITION TO HI-HALF IOR B,I MIRGE IN HI-HALF STA B,I AND PUT IN WORD SEZ,CME BUMP WORD TO NEXT WORD? INB YES, DONE WITH BOTH CHARS CPB DFEND DONE WITH 5 CHARS? SEZ,RSS YES JMP AGAIN NO, FINISH CONVERSION IOR "B" LAST CHAR IS "B" STA B,I AND PUT IN LAST WORD JSB PNAME COPY PROGRAM NAME DEF *+2 DEF MESSS+1 LDA MESSS+3 CHANGE 6TH CHAR TO ":" ADA SPCOL STA MESSS+3 3RD WORD OF NAME JSB REIO DEF *+5 DEF ....2 DEF FMT.E DEF MESSS DEF ...13 JMP ENDLS,I SPC 1 DFADS DEF MESSS+10 DFEND DEF MESSS+12 SUP MESSS ASC 13, /PROGS: FMT ERR 4 @12345B UNS LITERALS, IF ANY: END UT   24998-18231 2001 S C0122 &FRMTR SYS INDEPENDENT LIBRARY             H0101 ASMB,Q,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED "FRMTR" REAL TIME FORTRAN FORMATTER. NAM FRMTR,6 24998-1X231 REV.2001 790503 ENT .FRMN,.LS2F,.INPN,.DTAN EXT .FLUN,.CFER,.XPAK,$SETP EXT .ZRNT EXT IFIX,FLOAT,.LBT,.SBT A EQU 0 B EQU 1 SPC 1 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F O R T R A N * * * * I / O * * * * P R O G R A M * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * THE FORTRAN I/O PROGRAM PROVIDES FOR ALL INPUT AND * OUTPUT SERVICES SPECIFIED BY THE -HP-2116 FORTRAN * COMPILER. THIS INCLUDES THE FOLLOWING TYPES OF * FORTRAN STATEMENTS: * * I WRITE (,) * II READ (,) * III WRITE () * IV READ () * * THE FIRST TWO STATEMENTS PROVIDE FOR FORMATTED * INPUT/OUTPUT, THE LAST TWO FOR BINARY INPUT/ * OUTPUT. A SPECIAL FORM OF THE TYPE II STATEMENT * IS FREE-FIELD INPUT. THIS IS SPECIFIED BY A STAR * IN THE FORMAT FIELD. * * IN ADDITION TO THE USUAL BASIC FORTRAN FORMAT SPE- * CIFICATIONS, THE FOLLOWING SPECIFICATIONS ARE RE- * COGN\IZED: * * 1) Q-FORMAT: THIS CAN BE USED TO OUTPUT A CHARACTER * STRING WITHOUT EXPLICITLY SPECIFYING THE NUMBER * OF CHARACTERS. ITS FORM IS: * " " * * 2) FREE-FIELD INPUT: THIS ALLOWS FOR INPUT DATA * WITHOUT ANY PARTICULAR FORMAT BEING SPECIFIED. * * FOR THE REAL TIME SYSTEM, FRMTR IS USED FOR DATA CONVERSION * AND FMTIO IS USED FOR I/O. IN THIS WAY FRMTR CAN BE MADE * RE-ENTRANT. FRMTR ACCEPTS AS INPUT A FORMAT STRING AND,FOR * INPUT, A CHARACTER STRING OR, FOR OUTPUT, A SINGLE VARIABLE. * THE NECESSARY DATA CONVERSION IS PERFORMED,AND FRMTR RETURNS * TO FMTIO. ITEMS THAT MUST BE SAVED ARE STORED IN FMTIO AND * REFERENCED INDIRECTLY BY FRMTR. SKP * THE PROGRAM ITSELF CONSISTS OF THREE SETS OF * ROUTINES. THESE CAN BE CLASSIFIED AS: * * 1) THE FORMAT ANALYZER. THESE ROUTINES ARE RESPON- * SIBLE FOR SCANNING THE FORMAT STRING AND PASSING * CONTROL TO THE CORRECT CONVERSION ROUTINE. * * 2) THE CONVERSION ROUTINES. THESE ROUTINES ARE THE * ONES THAT PERFORM THE ACTUAL CONVERSION BETWEEN * INTERNAL AND EXTERNAL REPRESENTATIONS. * * 3) THE COMMUNICATION ROUTINES. THESE ARE THE ROU- * TINES THAT ARE ACTUALLY CALLED BY THE FORTRAN * PROGRAM. THEY ESSENTIALLY DRIVE THE ROUTINES * OF CLASSES 1 AND 2. * * THE CALLING SEQUENCES ARE AS FOLLOWS: * *********************************************************************** * INITIALIZATION CALL: * * BINARY INPUT/OUTPUT * * JSB .BIO. (A=UNIT, B=0 FOR OUTPUT, 1 FOR INPUT) * * DECIMAL INPUT/OUTPUT * * JSB .DIO. (A=UNIT, B=0 FOR OUTPUT, 1 FOR INPUT) * DEF BUFFER (ONLY IF UNIT=0) * DEF FORMAT (=0 FOR FREE-FIELD INPUT) * DEF ENDLIST * * WHEN UNIT=0, THE FORMATTER WILL CONVERT DIRECTLY TO OR FROM * THE USER'S BUFFER. NO ACTUAL I/O WILL TAKE PLACE. ************************************x************************************ * CONTINUATION CALLS: * * Single element I/O: * * JSB .zIO. z=I,J,R,X,T * DEF JSB .IOz. z=I,J,R * * Array I/O: * * JSB .zAY. z=I,J,R,X,T LDA length * DEF
LDB address * DEC JSB .zAR. z = I,J,R,X,T * * Where the letters I,J,R,X,T are for 1 & 2-word integer and * 2, 3 & 4-word floating, in that order. *********************************************************************** * TERMINATION CALL: (USED ONLY FOR OUTPUT) * * JSB .DTA. SKP * SUBROUTINE ENTRY POINTS. * TDB NOP ABS TDBND-* THIS MANY WORDS MUST BE STACKED TO NOP SUPPORT REENTRANTCY. TRNAD NOP JMP TRNAX F2LST NOP JMP F2LSX DTA NOP JMP DTX FCHAR NOP JMP FCHAX OUTCR NOP JMP OUTCX INCHR NOP JMP INCHX DIGIT NOP JMP DIGIX FINTG NOP JMP FINTX RFCHK NOP JMP RFCHX WGET NOP JMP WGEX WSET NOP JMP WSEX WDFIX NOP JMP WDFIZ WDGET NOP JMP WDGEX OUTPT NOP JMP OUTPX OUTP1 NOP JMP OUTPZ MTPLO NOP JMP MTPLX GETDG NOP JMP GETDX NORML NOP JMP NORMX INPUT NOP JMP INPUX .XCOM NOP JMP XCOMX PTEN NOP JMP PTENX MULT NOP JMP MULTX DIVD NOP JMP DIVDX RSN NOP JMP RSNX LSONE NOP JMP LSONX INDIG NOP JMP INDIX ABLKS NOP JMP ABLKX BCKUP NOP JMP BCKUX * * INDIRECTS FROM FMTIO. * AADX DEF 0 ADDR VARIABLE. TYPE BSS 1 TYPE. LENTH BSS 1 LENGTH. SKIP BSS 1 FREE FIELD SKIP FCR BSS 1 FORMAT POINTER CCNT BSS 1 BUFFER COUNT CMAX BSS 1 MAX VALUE OF CCNT AFTER TAB LEFT. BCR BSS 1 BUFFER POINTER IO BSS 1 FLAG FOR I/O SKIPL BSS 1 FOR UNLIMITED GROUPS TSCAL BSS 1 SCALE FACTOR SCALE BSS 1 USED FOR F AND I FIELDS NEST BSS 1 NEST LEVEL FOR GROUPS. CFLAG BSS 1 COMMA CHECK FOR FREE F. BCRS BSS 1 SAVE BCR F2LSI BSS 1 ENTRANCE INTO FRMTR SWITH BSS 1 TYPE OF EXIT FOR FMTIO. * 1-5:ERR1-5. * 6:F2LST * 7:ENDLS * 8:DTA (NEW RECORD) RNEST BSS 1 NEST FOR UNLIMITED GROUPS ADRFD BSS 1 INDEX FOR RFLD RF BSS 1 REPEAT FIELD. WSAVE BSS 1 DSAVE BSS 1 GFLAG BSS 1 .OBUF BSS 1 EORD BSS 1 OFLAG BSS 1 OLD-NEW DEFINITIONS FLAG ATMP EQU EORD FLAG FOR A VS. R FORMAT. DTAI EQU EORD ENTRANCE AFTER I/O. SPC 3 * MANTISSA AND "XEQ", A ROUTINE FOR VARIABLE SHIFTING. * MANT BSS 5 MANTISSA OF NUMBER BEING CONVERTED. XEQ NOP NOP TDBND JMP XEQ,I (NEED NOT BE SAVED) SKP * TEMPS LOCAL TO NAMED ROUTINES. * MULTA EQU FCHAR MULTB EQU OUTCR MULTC EQU INCHR MULTD EQU DIGIT DIVDA EQU FCHAR DIVDB EQU OUTCR DIVDC EQU INCHR DIVDD EQU DIGIT DIVDE EQU WGET DIVDF EQU WSET PTENA EQU OUTP1 PTENB EQU MTPLO MTPL1 EQU XEQ MTPL2 EQU XEQ+1 FINTA EQU XEQ QTYPA EQU XEQ QTYPB EQU XEQ+1 ATYPA EQU WGET ATYPB EQU WSET TTYPA EQU XEQ+1 INDIA EQU OUTP1 INPUA EQU XEQ INPUB EQU XEQ+1 INPUC EQU WGET INPUD EQU WSET OUTA EQU OUTP1 GETDB EQU XEQ+1 NORMA EQU GETDG NORMB EQU DIVD * * GLOBAL TEMPS. * GETDA EQU XEQ GETDC EQU WGET ADX EQU F2LST DIRECT ADDR VARIABLE. EXP EQU WDFIX EXPONENT W EQU NORML -W D EQU .XCOM -D-1 EFLAG EQU WDGET THE E FORMAT FLAG DBLNK EQU OUTPT FL ,AG FOR SKIPPING BLANKS IN FMT BCNT EQU MTPLO COUNTS LEADING BLANKS FOR OUTPOT EXPON EQU DTA EXPONENT PART OF NUMBER EXPNS EQU INDIG COPY OF EXPON FOR G-FORMAT. SGDIG EQU OUTPT FOR NEG SCALE FACTORS, E-FORMAT. OCONT EQU PTEN # ZEROES FOR E SCALE FACTOR. POST EQU WDGET INPUT CONTROL INDICATOR SIGN EQU ABLKS SIGN OF NUMBER. MANTP EQU TRNAD FWA WORKING AREA IN MANTISSA MANTL EQU FINTG LWA DITTO OVTOG EQU RFCHK FLAG INDICATING OUTPUT BUFFER OVERRUN. SKP * ADDRESS CONSTANTS & SHIFT INSTRUCTIONS. * MULTZ DEF MULT DIVDZ DEF DIVD AAADX DEF AADX TO SEE IF ADDRESSES NEED BE RESET. AMANT DEF MANT FWA MANTISSA AMNT3 DEF MANT+3 LWA USED BY .XCOM MANTE DEF MANT+5 LWA+1 MANTISSA RRR16 RRR 16 RRL16 RRL 16 * * NUMERIC AND CHARACTER CONSTANTS. * NUMAD ABS OFLAG-AADX+1 NUMBER OF ADDRESSES FROM FMTIO NEG1 OCT 100000 LOGICAL TRUE. MIN72 OCT -72 -"9"-1 MIN5 DEC -5 MIN4 DEC -4 MIN3 DEC -3 MIN2 DEC -2 MIN1 DEC -1 ....2 DEC 2 ....3 DEC 3 ....6 DEC 6 ....8 DEC 8 ....9 DEC 9 .177 OCT 177 BLANK OCT 40 CHARACTER CONSTANTS. QUOTE OCT 42 " "$" OCT 44 "&" OCT 46 PLUS OCT 53 COMMA OCT 54 MINUS OCT 55 "." OCT 56 "/" OCT 57 "0" OCT 60 "1" OCT 61 "7" OCT 67 "@" OCT 100 "D" OCT 104 "E" OCT 105 "F" OCT 106 "L" OCT 114 "P" OCT 120 "R" OCT 122 "T" OCT 124 _"Y" OCT -131 -"Y" "Y_@" ABS 131B-100B "Y"-"@" "@_&" ABS 100B-046B "@"-"&" "0_." EQU ....2 "0"-"." HED ENTRY POINTS. * GENERAL ENTRY ROUTINE. * TRNAX LDA MIN4 FIND ORIGIONAL CALLER ADA TRNAD NOP ADDRESS LDB A,I GET NOP'S CONTENTS INA NOW GET THE POSSIBLE LDA A,I JSB $LIBR?? STA .LS2F+1 FIX UP P+1 OF OTHER CALLS STA .DTAN+1 SSA,RSS IS IT A JSB $LIBR? STB TDB+2 NO, SET THE TDB RETURN LDB AAADX  LDA TDB+2,I CPA B,I CHECK IF ADDRESSES NEED SETTING JMP SAME NO, SKIP IT JSB $SETP SET UP INDIRECTS FROM FMTIO. DEF NUMAD SAME LDA AADX,I COPY ADDR VARIABLE. STA ADX ISZ TDB+2 SKIP PARAM JMP TRNAD,I * * FORMATTED I/O ENTRY POINT. * .FRMN NOP ENTRANCE TO FORMAT SCANNER JSB .ZRNT DEF LIBX JSB TRNAD CCA SET FLAG THAT NO LIST ITEM PROCESSED YET. STA ADX JMP FORMT * * FREE-FIELD INPUT ENTRY. * .INPN NOP ENTRANCE FOR FREE FIELD INPUT JSB .ZRNT 1ST ENTRY IF FREE FIELD INPUT DEF LIBX1 DEF ANOTHER LIBX JSB TRNAD JSB INPUT LIBX1 JMP TDB+2,I RETURN DEF TDB DEC 0 SKP * ROUTINE TO REQUEST LIST ELEMENT FROM FMTIO. * F2LSX LDA F2LST STA F2LSI,I LDA ....6 STA SWITH,I JMP LIBX .LS2F NOP ENTRANCE FROM ELEMENT LIST JMP * STALL IF CALLED BEFORE .FRMN DEF TDB JSB TRNAD TRANSFER ADDRESSES LDA F2LSI,I JMP A,I ENTER FORMATTER * * ROUTINE TO REQUEST I/O FROM FMTIO. * DTX LDA DTA STA DTAI,I LDA ....8 STA SWITH,I LIBX JMP TDB+2,I DEF TDB DEC 0 .DTAN NOP ENTRANCE AFTER AN I/O REQUEST JMP * STALL IF CALLED BEFORE .FRMN DEF TDB JSB TRNAD LDA DTAI,I JMP A,I RETURN TO THE DTA CALL * * ERROR EXITS. * ERR1 LDA ....1 JMP STERR ERR2 LDA ....2 JMP STERR ERR3 LDA ....3 JMP STERR ERR4 LDA ....4 JMP STERR ERR5 LDA ....5 STERR STA SWITH,I JMP LIBX HED SOME UTILITY ROUTINES ********************* * UTILITY ROUTINES * ********************* * * THE ROUTINES THAT HANDLE CHARACTER MANIPULATION USE * STANDARD BYTE ADDRESSES. C SPC 5 * CALL: JSB FCHAR * RETURNS: A = THE NEXT VALID FORMAT STRING CHARACTER * B = MEANINGLESS * * BLANKS ARE IGNORED DEPENDING ON THE FLAG DBLNK. SPC 2 FCHAX ISZ FCR,I A _ NEXT FORMAT CHAR. LDB FCR,I LOAD CHARACTER INTO A AND TEST JSB .LBT FOR BLANK OR COMMA LDB DBLNK SKIP BLANKS IF DBLNK=1 CPA BLANK CHAR=BLANK ? SZB,RSS AND DBLNK.NE.0 ? JMP FCHAR,I NO, DONE. JMP FCHAX YES, SKIP THE BLANK. SPC 4 * CALL: LDA CHAR * JSB OUTCR * RETURN: A = OVTOG * B = NEXT BYTE ADDRESS IN THE OUTPUT BUFFER SPC 2 OUTCX ISZ CCNT,I A<7:0> PLACED IN OUTPUT. END OF BUFFER ? JMP OUTC1 CCA YES-- RESET CCNT AND RETURN STA CCNT,I JMP OUTC2 SET OVTOG TO SAY BUFFER IS BOMBED OUTC1 ISZ BCR,I ADVANCE BUFFER POINTER LDB BCR,I JSB .SBT STORE CHARACTER IN BUFFER. CLA CLEAR OVTOG AND WERE OKAY OUTC2 STA OVTOG JMP OUTCR,I RETURN. SKP * CALL: JSB INCHR * RETURN: A = THE NEXT CHARACTER IN THE INPUT STRING OR A BLANK * B MEANINGLESS SPC 3 INCHX LDA CCNT,I A_NEXT INPUT CHAR. IF CCNT=0 THEN SZA,RSS RETURN A JMP RTBNK BLANK ISZ CCNT,I IF CCNT=-1 THEN SKIP JMP GETC CCA RESET CCNT TO -1. STA CCNT,I LDA POST IF BEGINNING OF NUMBER SCAN IOR FCR,I IN FREE FIELD INPUT SZA JMP RTBNK LDA ....7 STA SWITH,I JMP LIBX GO TO END OF LIST RTBNK LDA BLANK OTHERWISE RETURN A BLANK JMP INCHR,I GETC ISZ BCR,I IF CCNT <-1 THEN LDB BCR,I JUST JSB .LBT GET THE NEXT JMP INCHR,I CHARACTER SKP * CALL: LDA CHAR * JSB DIGIT * RETURN: P+1 CHAR IN A NOT A DIGIT * A = CHAR * P+2 CHAR IN A A DIGIT * A = B = VALUE. SPC 2 DIGIX LDB A  TESTS CHARACTER IN A FOR A DIGIT * * IF IT IS RETURN THE TRUE * * DIGIT IN A AND SKIP. ELSE * * RETURN THE CHARACTER AND ******************************* DON'T SKIP. ADB MIN72 CHARACTERS > '9' REMAIN POSITIVE SSB,RSS SKIP IF B NEGATIVE JMP DIGIT,I RETURN...NOT A DIGIT ADB ...10 CHARACTERS < '0' REMAIN NEGATIVE SSB JMP DIGIT,I RETURN...NOT A DIGIT ISZ DIGIT BUMP RETURN ADDRESS LDA B PLACE THE DIGIT IN A JMP DIGIT,I SPC 3 ******************************* FINTX JSB DIGIT COMPUTES THE INTEGER IN THE FOR- * * MAT STRING. THE FIRST DIGIT ******************************* IS ALREADY IN A. MAX VALUE 511. JMP FINTG,I IF NOT A DIGIT ISZ FINTG ELSE GOOD RETURN (IF ANY) FINT1 STA FINTA SAVE RESULT SO FAR JSB FCHAR GET NEXT CHARACTER JSB DIGIT CHECK FOR DIGIT JMP GOTIT END OF INTEGER CLO MULTIPLY RESULT SO FAR BY 10. LDB FINTA *1 ADB B *2 ADB B *4 ADB FINTA *5 ADB B *10 ADA B ADD THAT TO CURRENT DIGIT. LDB A LIMIT VALUE TO 16383. ADB B BY DOUBLING THE FINAL VALUE IN (B). SOS DID IT FIT ? JMP FINT1 YES. LOOP. JMP ERR1 NO. ERROR. * GOTIT CCB BACK UP FORMAT POINTER ADB FCR,I STB FCR,I LDA FINTA RETURN WITH JMP FINTG,I RESULT IN A HED FORMAT ANALYZER * * * THE FOLLOWING SECTION IS THE FORMAT ANALYZER. CONTROL IN * * HERE IS GOVERNED BY THE CONTROL LOOP, WHICH EXAMINES THE * * FORMAT AND PASSES CONTROL TO THE VARIOUS CONVERSION ROU- * * TINES. SINCE TERMINATION OF THE tI/O STATEMENT IS DETER- * * MINED BY THE CALLING SEQUENCE, EACH CONVERSION ROUTINE * * MUST CHECK THE LIST BEFORE PERFORMING A CONVERSION. THIS * * IS DONE BY CALLING A ROUTINE CALLED F2LST. THE SOLE FUNC-* * TION OF THIS ROUTINE IS TO HOLD THE ADDRESS FROM WHICH * * IT WAS CALLED, AND THEN TO GET BACK TO THE CALLING * * SEQUENCE. THE CALLING SEQUENCE WILL THEN PASS CONTROL * * BACK THROUGH THE COMMUNICATION ROUTINES (SEE ABOVE). * * EACH OF THESE CALLS A ROUTINE CALLED LST2F, WHICH GETS * * BACK TO THE FORMATTER BY USING THE ADDRESS LEFT AT * * F2LST. * * * ******************************************************************** RFCHX ISZ RF,I CHECK REPEAT. IF RF GOES TO ZERO, JMP RFCHK,I CONTROL FALLS THROUGH TO FORMT. FORMT CLA,INA SET DBLNK FOR SKIPPING. STA DBLNK STA GFLAG,I LDA "E" STA EORD,I LDB TSCAL,I SCALE FACTOR CMB,INB STB SCALE,I CCA FORM1 STA RF,I SET REPEAT FIELD AT ONE. * * GET FORMAT CHARACTER AND GO TO APPROPRIATE ROUTINE. * FORM2 JSB FCHAR GET THE CHARACTER AND TEST IT ADA _"Y" -"Y" SSA,RSS >X ? JMP FORM3 YES. ADA "Y_@" +"Y"-"@" SSA <@ ? JMP FORM3 YES. ADA FMTBL IN [@,X], USE JUMP TABLE. LDA A,I A = ADDR ROUTINE TO HANDLE CHAR. JMP A,I SKP FORM3 ADA "@_&" +"@"-"&" CPA MIN4 " JMP QTYPE CPA ....1 ' JMP QTYPE CPA ....2 ( JMP LPTYP CPA ....3 ) JMP RPTYP CPA ....6 , JMP FORM2 CPA ....7 - JMP MTYPE CPA ....9 / JMP INOUT ADA "&" RESTORE ORIGINAL CHAR. JSB FINTG LASTb CHANCE: NUMBER JMP ERR3 CMA,INA,SZA,RSS JMP STRNP JMP FORM1 * * JUMP TABLE FOR FORMAT CHARACTERS "@" THRU "X". * FMTBL DEF *+1 DEF OTYPE @ DEF ATYPE A DEF ERR3 B DEF ERR3 C DEF DTYPE D DEF ETYPE E DEF FTYPE F DEF GTYPE G DEF HTYPE H DEF ITYPE I DEF ERR3 J DEF OTYPE K DEF LTYPE L DEF ERR3 M DEF ERR3 N DEF OTYPE O DEF PTYPE P DEF ERR3 Q DEF RTYPE R DEF ERR3 S DEF TTYPE T DEF ERR3 U DEF ERR3 V DEF ERR3 W DEF XTYPE X HED P, X & H SPECIFICATIONS. ***************************************** * * * FOLLOWING ARE THE CONVERSION ROUTINES * * * ***************************************** SPC 3 MTYPE JSB FCHAR GET NEGATIVE SCALE FACTOR. JSB FINTG TEST FOR NUMBER JMP ERR1 NOT A DIGIT STRNP STA TSCAL,I JSB FCHAR MAKE SURE NEXT CPA "P" CHARACTER IS P. JMP FORMT JMP ERR3 TOO BAD. * PTYPE LDA RF,I STA TSCAL,I JMP FORMT SPC 3 ********************************** * HTYPE HANDLES H-CONVERSION * ********************************** HTYPE CLA SET FOR NO STA DBLNK SKIPPING HLOOP LDB IO,I WHICH WAY? SZB,RSS JMP HOUT OUT JSB INCHR IN ISZ FCR,I ADVANCE FORMAT COUNTER LDB FCR,I JSB .SBT PLACE INTO FORMAT HCHEK JSB RFCHK TEST RF JMP HLOOP HOUT JSB FCHAR GET A CHAR FROM STRING JSB OUTCR OUTPUT IT JMP HCHEK HED T SPECIFICATION. TTYPE JSB FCHAR GET DIGIT, L OR R. CPA "R" R ? JMP TR1 YES. LDB BC0R,I NO. B = (ADDR CURRENT COLUMN)-1 CMB -(ADDR CUR COL) ADB .OBUF,I -(ADDR CUR COL)+(ADDR COL 1)/2 ADB .OBUF,I -(ADDR CUR COL)+(ADDR COL 1) ADB MIN1 -(CURRENT COL #) STB TTYPA CPA "L" L ? JMP TL1 YES. * * T-FORMAT. CONVERT TO RELATIVE TAB. * JSB FINTG NUMBER ? JMP ERR3 NO, ERROR. ADA TTYPA M = REL TAB = N-(CUR COL #) SSA,RSS WHICH WAY ? JMP TR2 RIGHT. M >= 0. CMA,INA LEFT. TL GETS -M > 0. JMP TL2 * * TL-FORMAT. IF NEW COL < 1, SET TO 1. * TL1 JSB FCHAR GET AMOUNT TO GO LEFT. (-M) JSB FINTG JMP ERR3 IF NO NUMBER. TL2 STA B CHECK IF COL < 1 (INCLUDES T0) ADB TTYPA -(NEW COL) CMA,INA M SSB,INB,RSS NEW COL > 0 ? ADA B NO, M = 1 - (CURRENT COL) LDB CCNT,I SEE IF OLD POSITION WAS MAX REACHED. CMB,CLE,INB -CCNT ADB CMAX,I CMAX-CCNT (E=0 IFF B<0) LDB CCNT,I TO SET NEW MAX. SEZ,RSS IS CCNT > CMAX ? STB CMAX,I YES, SET NEW MAX COLUMN. TL3 STA B UPDATE BCR & CCNT. ADB CCNT,I ADA BCR,I STA BCR,I STB CCNT,I JMP FORMT DONE. SKP * TR-FORMAT. IF NEW COL > LAST COL, SET TO LAST+1. * XTYPE LDA RF,I X FORMAT: CHANGE NX TO TRN. CMA,INA JMP TR2 TR1 JSB FCHAR GET AMOUNT TO GO RIGHT. JSB FINTG JMP ERR3 IF NOT A NUMBER. TR2 STA B M ADB CCNT,I CCNT+M. SSB SHOULD BE < 0. JMP TR3 IS, O.K. LDA CCNT,I CMA M = -CCNT-1 TR3 LDB IO,I IN OR OUT ? SZB JMP TL3 IN. STA B OUT. B=M. SEE IF OLD POS > OLD MAX. LDA CCNT,I CMA,INA -OLD POS. ADA CMAX,I CMAX-CCNT SSA CCNT >1 CMAX ? (NOW AT MAX ?) JMP TR4 YES. JUST OUTPUT SPACES. LDA B A=B=M. IS NEW POS > OLD MAX ? ADB CCNT,I NEW CCNT. CMB,INB -CCNT. ADB CMAX,I CMAX-CCNT SSB,RSS CCNT > CMAX ? JMP TL3 NO, JUST POSITION TO NEW POSITION. ADA B YES. A = AMNT TO ADVANCE TO GET TO CMAX. ADA BCR,I ADVANCE TO CMAX. STA BCR,I LDA CMAX,I STA CCNT,I CMB,INB OUTPUT EXCESS SPACES. TR4 LDA BLANK JSB MTPLO JMP FORMT HED SLASH & L SPECIFICATIONS. * INOUT HANDLES THE SLASH IN A FORMAT. * INOUT JSB DTA JSB RFCHK JMP INOUT SPC 4 LTYPE CLA JSB WGET LLOOP JSB F2LST GET LIST ITEM. JSB WSET SET UP W. LDB IO,I WHICH WAY? SZB,RSS JMP LOUT LIN JSB INCHR SKIP BLANKS UNTIL CPA BLANK FIND A T OR F. JMP NEXTC IF RUN OUT OF FIELD, ERROR 4. CLB,INB B<0> = NOT FOUND FLAG. CPA "T" LDB NEG1 IF TRUE, MANT = 100000B CPA "F" CLB SLB FOUND ONE ? JMP ERR5 NO, ERROR. STB ADX,I YES, STORE RESULT. JMP *+2 SKIP REST OF FIELD. JSB INCHR ISZ W JMP *-2 LTYP1 JSB RFCHK CHECK FOR REPEATS JMP LLOOP * NEXTC ISZ W JMP LIN JMP ERR5 SPC 2 LOUT LDA BLANK OUTPUT W-1 LEADING BLANKS. LDB W CMB JSB MTPLO LDB ADX,I OUTPUT "T" OR "F" LDA "T" "T" IF SIGN BIT SET. SSB,RSS LDA "F" "F" IF NOT. JSB OUTCR JMP LTYP1 HED A & R SPECIFICATIONS. ATYPE CCB A: ATMP=-1. LDA OFLAG,I OLD ? SSA SKIP IF NOT. RTYPE CLB R, OLD A: ATMP=0. STB ATMP,I CLA GET W JSB WGET ALOOP JSB F2LST GET LIST ITEM. JSB WSET SET W. LDA ADX e FORM BYTE ADDR OF VARIABLE. RAL STA ATYPA LDB LENTH,I # WDS DATA. BLS # CHARS DATA. ADB W # CHARS - W STB ATYPB LDA IO,I IN OR OUT ? SZA,RSS JMP AOUT OUT. * * A&R INPUT. * AIN SSB W > # CHARS DATA. (EXCESS DATA) ? JMP AIN1 YES. LDA ATMP,I NO. EXACT OR TOO LITTLE DATA. (B=DIFF) SZA,RSS R-FORMAT ? (IF SO, A=0 FOR ABLKS) JSB ABLKS YES, SUPPLY LEADING BINARY ZEROES. JMP AIN3 (ATYPB=0 NOW FOR R-FORMAT) AIN1 STB ATYPB - # CHARS EXCESS. AIN2 JSB INCHR SKIP THEM. ISZ W (CAN'T GO TO ZERO) ISZ ATYPB JMP AIN2 (ATYPB=0 WHEN DONE) AIN3 JSB INCHR COPY W CHARS. LDB ATYPA JSB .SBT STB ATYPA ISZ W JMP AIN3 LOOP. LDA BLANK SUPPLY TRAILING BLANKS, IF ANY. LDB ATYPB JSB ABLKS ATYP1 JSB RFCHK REPEAT ? JMP ALOOP YES. SKP * A&R OUTPUT. * AOUT SSB W VS # CHARS DATA. JMP AOUT1 W > # CHARS. ADB ATYPA W <= # CHARS. SKIP CHARS IN DATA. LDA ATMP,I BUT ONLY IF R FORMAT. SSA,RSS STB ATYPA JMP AOUT2 AOUT1 CMB,INB B = AMOUNT W EXCEEDS DATA. LDA BLANK OUTPUT THAT MANY BLANKS. JSB MTPLO AOUT2 LDB ATYPA COPY W CHARS TO OUTPUT. JSB .LBT STB ATYPA JSB OUTCR ISZ W JMP AOUT2 LOOP. JMP ATYP1 GO CHECK REPEATS. SPC 3 * ROUTINE TO PUT -B- COPIES OF A<7:0> * INTO A/R VARIABLE, B >= 0. * ABLKX CMB,INB,SZB,RSS -COUNT. ZERO ? JMP ABLKS,I YES, DONE. STB ATYPB (WILL BE ZERO NEXT TIME) LDB ATYPA ABLK1 JSB .SBT ISZ ATYPB JMP ABLK1 STB ATYPA JMP ABLKS,I HED @, K & O SPECIFICATIONS. * OTYPE HAND@ELES @ SPECIFICATIONS * * OTYPE CLA GET JSB WGET THE W-FIELD OLOOP JSB F2LST GET A LIST ITEM. JSB WSET SET W. LDB IO,I IN/OUT SWITCH SZB,RSS JMP OCOUT * * INPUT. * CLA INITIALIZE TO STA ADX,I ZERO OCT1 JSB INCHR GET A CHARACTER STA B SAVE IN B IOR ....7 TEST FOR OCTAL DIGIT CPA "7" JMP OCT2 IT IS ONE OCT3 ISZ W END OF THIS INPUT ? JMP OCT1 NOPE OCT6 JSB RFCHK CHECK FOR REPEATS JMP OLOOP * ADD NEW DIGIT IN * OCT2 LDA B GET OCTAL DIGIT BACK IN A AND ....7 REMOVE ASCII BITS LDB ADX,I REPOSITION PREVIOUS RESULT. BLF,RBR ADA B ADD TO NEW DIGIT STA ADX,I PUT IT BACK. JMP OCT3 * * OUTPUT. * OCOUT LDA BLANK LDB W IS W GEQ -6 ? ADB ....6 SSB JMP OCT4 NO---OUTPUT A BLANK LDA ADX,I GET NUMBER CMB RAR,RAR POSITION OVER 2 FOR 16TH BIT CPB MIN1 ALR,RAR ALF,RAR ROTATE 3 INB,SZB DONE ROTATING???? JMP *-2 NOT YET, SON AND ....7 MASK OFF IOR "0" ASCII BITS OCT4 JSB OUTCR THERE IT GOES ISZ W END OF VALUE ? JMP OCOUT JMP OCT6 HED " AND ' SPECIFICATIONS. ********************************** * QTYPE HANDLES "-CONVERSION * ********************************** QTYPE ADA "&" RESTORE " OR ' STA QTYPA REMEMBER WHICH. CLA SET FOR NO STA DBLNK SKIPPING LDA FCR,I SAVE FCR FOR STA QTYPB REPEATS QLOOP JSB FCHAR GET FORMAT CHARACTER CPA QTYPA CHECK FOR SAME KIND OF QUOTE. JMP QUOT1 JMP FOR SPECIAL HANDLIG LDB IO,I WHICH WAY? SZB,RSS JMP *+3 JSB INCHR JMP QLOOP JSB OUTCR JMP QLOOP QUOT1 JSB 8RFCHK CHECK THE REPEAT COUNT LDA QTYPB RESTORE FCR STA FCR,I AND JMP QLOOP LOOP SPC 4 ******************************************************************** * LPTYP AND RPTYP HANDLE THE PARENTHESIS MANIPULATION * * LPRN CONTAINS ADDRESS OF LEFT PARENTHESIS. * * RFSV CONTAINS INITIAL VALUE OF REPEAT FIELD FOR THE GROUP. * * RFLD CONTAINS CURRENT VALUE OF REPEAT FIELD. * * THESE 5-WORD ARRAYS ARE INDEXED BY THE CURRENT VALUE OF NEST.* * THE ORDER OF THE ARRAYS IS : RFLD,RFSV,LPRN. * ******************************************************************** * LPTYP ISZ NEST,I ADVANCE DEPTH COUNTER JMP *+2 JMP ERR2 TOO DEEP, GAS IT. LDA NEST,I LDB A ADA ....3 IF NEST = -5 OR -4, SSA STB RNEST,I STORE FOR UNLIMITED GROUPS ADB ADRFD,I CONTAINS INDEXED ADDRESS ADB ...10 LDA FCR,I OF LPRN. STA B,I STORE FORMAT LOC. OF LEFT PAREN. ADB MIN5 NOW IN RFSV. LDA RF,I STA B,I STORE REPEAT FIELD IN RFSV STRF ADB MIN5 STA B,I AND IN RFLD. JMP FORMT HED PARENTHESIS MANIPULATION. RPTYP LDA NEST,I ADA ....5 OUTER PAREN? (NEST=-5) SZA,RSS JMP LASTP YES. SSA NO. NEST <-5 ? JMP ERR2 YES. GAS IT. LDB NEST,I NO. ADB ADRFD,I B CONTAINS INDEXED ADD. IN RFLD. ISZ B,I CHECK CURRENT VALUE OF REPEAT FD JMP STFCR STILL MORE REPEATS. LDA NEST,I REPEAT FIELD EXHAUSTED ADA MIN1 STA NEST,I DECREMENT NEST BY 1. ADB ....5 NOW B IN RFSV. LDA B,I RESTORE REPEAT JMP STRF FIELD AND EXIT. STFCR ADB ...10 MORE REPEATS. B IN LPRN. LDA B,I RESET FCR TO STA FCR,I LEFT PAREN LOC. JMP FORMT LASTP LDA ADX REMEMBER IF WE USED ANY LIST ITEMS. STA DTA JSB F2LST RETURN TO CALLING SEQ. LDA DTA LIST ITEMS BUT NO CONVERSION SPECS ? SSA JMP ERR3 JSB DTA IF WE GET BACK, UNLIMITED GROUP. CCA I/O THE RECORD AND AVOID STA SKIPL,I A SPURIOUS RETURN TO CALLER STA ADX NOTE NO CONVERSIONS SO FAR. LDB RNEST,I STB NEST,I RESET NEST ADB ADRFD,I JMP STFCR SET FCR, EXIT. HED MANIPULATION OF W & D. ******************************************************************** * * * FOLLOWING ARE SOME UTILITY ROUTINES FOR OBTAINING THE W AND D * * FIELDS, AND DOING A FEW OTHER LITTLE THINGS. * * * ******************************************************************** WGEX STA SIGN SAVE LENGTH OF EXPONENT FIELD. JSB FCHAR GET NUMBER IN FORMAT. JSB FINTG JMP ERR1 NOT A DIGIT!! CMA,INA NEGATE. ADA SIGN =4 FOR E AND G TYPE, 0 OTHERWISE SSA,RSS IF NOT NEGATIVE THEN JMP ERR1 TAKE GAS. STA WSAVE,I JMP WGET,I SPC 3 WSEX LDA WSAVE,I RESTORES W. STA W JMP WSET,I SPC 3 WDFIZ LDA DSAVE,I INIT W AND D. A=POS D. CMA A=-D-1. WDFX1 STA D SET D TO INCLUDE POINT LDB SIGN SIGN. CMB,INB -SIGN. ADB WSAVE,I -W-SIGN. STB W SET UP W. CMB,INB W+SIGN. ADA B W-D-1+SIGN. STA BCNT NUMBER OF LEADING BLANKS. SSA,RSS <0 ? JMP WDFIX,I NO, DONE. LDA W YES, SET D=W. JMP WDFX1 SPC 3 WDGEX JSB WGET GETS W AND W. FIRST W. JSB FCHAR MAKE SURE NEXT CHARACTER CPA "." IS A DECIMAL POINT. JMP *+2 IT IS...OK JMP ERR1 HIT'S NOT...TOO BAD JSB FCHAR COMPUTE NEXT NUMBER IN FORMAT JSB FINTG TEST FOR DIGIT JMP ERR1 NOT A DIGIT!! STA DSAVE,I SET D. JMP WDGET,I HED SCALING AND CONVERSION ROUTINES. * NORML - MANTISSA NORMALIZATION. * THE MANTISSA AND EXPONENT ARE ADJUSTED SO THAT THEY * CONTAIN A NORMALIZED VALUE. IT IS ASSUMED THAT THE * INITIAL STATE IS NOT UNNORMLIZED BY MORE THAN 31 BITS. * NORMX LDB MANT SEE IF NORMALIZED. LDA MANT+1 ASL 1 SOC JMP NORML,I YES, DONE. ASL 15 NO, SEE IF WORD SHIFT. SOC JMP NORM1 NO. SZB,RSS YES, IS SECOND WORD ZERO TOO ? JMP NORM3 YES, IS ZERO. STB MANT NO, DO WORD SHIFT. LDB MANT+2 STB MANT+1 LDB MANT+3 STB MANT+2 LDB MANT+4 STB MANT+3 STA MANT+4 LDA EXP ADJUST EXPONENT ADA =D-16 STA EXP NORM1 LDA MANT DETERMINE BIT SHIFT. JSB FLOAT B = 30 - 2*SHIFT BRS B = 15-SHIFT ADB =D-15 B = -SHIFT LDA B SAVE SHIFT COUNT CMA,INA,SZA,RSS A = SHIFT. IS IT ZERO ? JMP NORML,I YES, DONE. ADB EXP ADJUST EXPONENT. STB EXP IOR RRL16 SET UP SHIFT. STA XEQ+1 LDA AMANT SET UP BIT NORMALIZE LOOP. STA NORMA LDA MIN4 STA NORMB NORM2 DLD NORMA,I WORD PAIR. JSB XEQ LEFT SHIFT. STA NORMA,I NEW FIRST WORD OF PAIR. ISZ NORMA BUMP ADDR. ISZ NORMB BUMP COUNT. JMP NORM2 IF MORE. JMP NORML,I EXIT. NORM3 STB EXP ZERO, SET EXPONENT ZERO TOO. JMP NORML,I SKP * PTEN - SCALE NUMBER BY A POWER OF TEN. * * PTEN MULTIPLIES THE VALUE IN (MANT...MANT2) AND (EXP) * BY 10**(A). NO CHECK IS MADE FOR OVERFLOW/UNDERFLOW. * * CALLING SEQUENCE: * LDA POWER * JSB PTEN SPC 2 PTENX LDB AMANT SET UP MANTISSA POINTERS. STB MANTP LDB TYPE,I SZB CPB ....1 ADB ....2 IF TYPE<2, USE EXTRA WORD. ADB MIN1 # WORDS PRECISION TO USE - 1 ADB MANTP LWA USED MANTISSA STB MANTL SZA,RSS IF N=0, LEAVE ALONE. JMP PTEN,I SSA,RSS N>0 ? JMP PTEN1 YES. CMA,INA NO, TAKE IABS(N) STA PTENA LDA ....2 RIGHT SHIFT MANTISSA TWO BITS. JSB RSN LDB DIVDZ SET "DIVIDE" JMP PTEN2 PTEN1 LDB MULTZ SET "MULTIPLY" STA PTENA PTENA = IABS(N) PTEN2 STB PTENB PTENB = ADDR MULT OR DIVD PTEN3 LDA PTENA A=N ADA MIN6 N-6 CLE,SSA N<6 ? (E=0 FOR MULT) JMP PTEN4 YES, GO DO LAST ONE. STA PTENA NO, MULT/DIV BY 10**6 LDA PWR1A+10 LDB PWR1A+11 JSB PTENB,I JMP PTEN3 TRY AGAIN. PTEN4 ADA ....5 A = N-1 RAL,CLE,SLA N=0 ? JMP PTEN5 YES, GO NORMALIZE. ADA PWR10 GET POWER OF TEN. (E=0 FOR MULT.) DLD A,I JSB PTENB,I GO MPY DIV USING IT. PTEN5 LDB MANT NORMALIZE. ASL 1 SOC THERE ? JMP PTEN,I YES. JSB LSONE NO, LEFT SHIFT. JMP PTEN5 AND TRY AGAIN. SKP * POWER OF TEN TABLE. FIRST PART IS (10**I)/2, I=1,2,3. SECOND * PART IS IDENTICAL TO 2-WORD FLOATING EXCEPT THE SECOND WORD HAS * BEEN RIGHT SHIFTED ONE BIT. VALUES ARE 1O**I FOR I=1,6. SPC 1 .5000 DEC 5000 PWR10 DEF PWR1A BASE ADDRESS. ....5 DEC 5 DEC 50 DEC 500 PWR1A DEC 20480 10**1 ....4 DEC 4 DEC 25600 10**2 ....7 DEC 7 DEC 32000,10 10**3 DEC 20000,14 10**4 DEC 25000,17 10**5 DEC 31250,20 10**6 SPC 3 * INDIG - ADD INPUT DIGIT TO NUMBER. * * INDIG TAKES AN INPUT DIGIT AND COMBINES IT WITH THE * RUNNING MANTISSA. THE RUNNING MANTISSA IS NOT IN A * USABLE FORM UNIL A TERMINAION CALL IS MADE. THE * MANTISSA IS THEN USABLE BUT MAY NOT BE NORMALIZED. * * CALLING SEQUENCE: * * LDA * JSB INDIG * * A TERMINATION CALL IS SIGNALLED BY NEGATIVE. * ANY TRAILING ZEROES OR DIGITS AFTER THE LIMIT (20) * AFFECT ONLY THE TRAILING ZERO COUNT IN "INPUD". SPC 1 * CHECK FOR ZERO, EXTRA DIGIT OR TERMINATION. * INDIX STA INDIA SAVE DIGIT. SSA TERMINATION CALL ? JMP INDI7 YES. INDI1 LDB MANTL NO. AT LIMIT ? SZA OR ZERO DIGIT ? CPB MANTE JMP INDI6 YES, JUST COUNT IT. * * GOOD DIGIT. ADD IT OR A SKIPPED ZERO. * LDA INPUA NO. GOOD DIGIT. MULTIPLY OTHERS BY 10. ALS,ALS ADA INPUA ALS LDB INPUD ANY UNUSED ZEROES ? SZB,RSS IF SO, ADD THEM FIRST. ADA INDIA IF NOT, ADD THIS DIGIT. STA INPUA ISZ INPUB COUNT DIGITS. FULL GROUP OF 4 ? JMP INDI5 NO. LDA .5000 YES, ADD THEM. INDI2 LDB =D-16 MAKE ROOM. CMB,CCE,INB B=16, E=1. JSB MULT LDB MANTL ADD DIGIT(S) ISZ MANTL LDA B,I CLE ADA INPUA STA B,I CCA,SEZ,RSS CARRY ? JMP INDI4 NO. INDI3 ADB A PROPOGATE IT. ISZ B,I JMP INDI4 JMP INDI3 INDI4 LDA MIN4 RESET COUNT. STA INPUB CLA RESET DIGITS. STA INPUA LDB INPUD RELOAD TRAILING ZERO COUNT. * * IF JUST PROCESSED A SKIPPED ZERO, DO ANOTHER DIGIT. * INDI5 LDA INDIA WAS IT A TERMINATION CALL ? SSA,RSS SZB,RSS OR NO TRAILING ZEROES ? JMP INDIG,I YES, DONE WITH THIS DIGIT. ADB MIN1 IT WAS A SKIPPED ZERO. DECREMENT COUNT. STB INPUD JMP INDI1 TRY AGAIN. * * } ZERO, EXTRA DIGIT & TERMINATION PROCESSING. * INDI6 LDA INPUA ZERO OR EXTRA DIGIT. LEADING ZERO ? ADA EXP (IF SO, EXP=-1 AND INPUA=0) SSA,RSS ISZ INPUD NO, TRAILING DIGIT, COUNT IT. JMP INDIG,I DONE WITH THIS ONE. INDI7 LDA INPUB ANY UNUSED DIGITS ? CPA MIN4 JMP INDIG,I NO, DONE. ADA PWR10 YES. ADD THEM. LDA A,I JMP INDI2 SKP * GETDG - EXTRACT DIGITS FOR OUTPUT. * * GETDG EXTRACTS DIGITS FROM THE MANTISSA AND RETURNS THEM * FOR OUTPUT PURPOSES. ONLY (SGCNT) DIGITS WILL BE RETURNED, * ANY AFTER THAT ARE 0 OR 9 AS REQUIRED TO PRODUCE THE CORRECT * ROUNDING. LESS PRECISION IS USED AS DIGITS ARE GENERATED. SPC 2 GETDX LDA GETDA TOO MANY DIGITS ? CLE,SSA,RSS JMP NOSIG YES, SEND ROUNDING DIGIT. ISZ GETDC ANY DIGITS LEFT ? JMP GETD1 YES, GET ONE. LDA .5000 NO, GENERATE 4 MORE. JSB MULT ISZ MANTP THEY'RE IN THE NEXT WORD. LDA MIN4 STA GETDC GETD1 LDA GETDC A = - # DIGITS IN WORD. ADA GETDZ GET POWER OF TEN FOR EXTRACTING DIGIT. STA GETDB LDA MANTP,I DIGITS. CLB DIV GETDB,I A = NEW DIGIT, B = REST. STB MANTP,I ISZ GETDA IS THIS FIRST AFTER LAST VALID DIGIT ? JMP GETDG,I NO. LDB ....9 YES. IF .GE. 5, RETURN NINES NOW. ADA MIN5 SSA CLB ELSE RETURN ZEROES. STB GETDC NOSIG LDA GETDC RETURN ROUNDING DIGIT (0 OR 9) JMP GETDG,I SPC 2 .1000 DEC 1000 DEC 100 ...10 DEC 10 ....1 DEC 1 GETDZ DEF * SKP * RSN - LOGICAL RIGHT SHIFT MANTISSA BY N BITS, N IN [1,15]. * RSNX LDB A ADJUST EXPONENT. ADB EXP STB EXP IOR RRR16 SET UP SHIFT INSTRUCTION. STA XEQ+1 LDA MANT+2 SHIFT. LDB MANT+3 JSB XEQ STB MANT+3 LDA MANT+1 oLDB MANT+2 JSB XEQ STB MANT+2 LDA MANT LDB MANT+1 JSB XEQ STB MANT+1 CLA LDB MANT JSB XEQ STB MANT JMP RSN,I EXIT SPC 4 * LSONE - LOGICAL LEFT SHIFT MANTISSA ONE BIT. * LSONX LDA MANT+3 SHIFT. CLE,ELA STA MANT+3 LDA MANT+2 ELA STA MANT+2 LDA MANT+1 ELA STA MANT+1 LDA MANT ELA STA MANT CCA ADJUST EXP ADA EXP STA EXP JMP LSONE,I SKP * .XCOM - NEGATE MANTISSA / ROUND RESULT. * * IF B=-1 THE MANTISSA IS NEGATED ELSE IT IS ROUNDED USING * B+1 AS THE ROUND CONSTANT. WHEN ROUNDING, THE LOCATION * INPUA IS SET TO THE ADDRESS OF THE LAST WORD. SPC 2 XCOMX INB,SZB NEGATE OR ROUND ? JMP XCOM1 ROUND, DON'T COMPLEMENT. LDA MANT COMPLEMENT MANTISSA. CMA STA MANT LDA MANT+1 CMA STA MANT+1 LDA MANT+2 CMA STA MANT+2 LDA MANT+3 CMA STA MANT+3 LDA AMNT3 ADDR WORD TO START INCR. JMP XCOM2 XCOM1 CCA FORM ADDR LAST WORD. ADA LENTH,I ADA AMANT STA INPUA SPECIAL: SET UP FOR INPUT. XCOM2 CLE,INB ADB A,I ADD ROUND CONSTANT. XCOM3 STB A,I SEZ,RSS CARRY ? JMP .XCOM,I NO, DONE. ADA MIN1 YES, PROPOGATE IT. LDB A,I CLE,INB CPA AMANT AT FIRST WORD ? JMP *+2 JMP XCOM3 NO, KEEP GOING. STB MANT STORE FIRST WORD. CLA,INA A=1. CPB NEG1 OVERFLOW ? JMP XCOM4 YES. ASL 1 NEG UNNORM ? SOC JMP .XCOM,I NO, DONE. CCA,RSS YES. B = NEW FIRST WD. DECR EXP. XCOM4 RBR OFL. R.S. & INCR EXP. (A=1) STB MANT ADA EXP STA EXP JMP .XCOM,I SKP * MULT - MULTIPLY THE MANTISSA BY A SCALAR. * * MULT MULTIPLIES THE MANTISSA BY A 15-BIT SCALAR AND ADJUSTS THE * EXPONENT. THE RESULT IS AS IF AN INTEGER MULTIPLY OF THE MANTISSA * AND SCALAR WERE DONE FOLLOWED BY A RIGHT SHIFT 15. THE RESULT * WILL NOT OVERFLOW BUT IT MAY BECOME UNNORMALIZED. * * CALLING SEQUENCE: * * CLE/CCE LAST WORD FLAG. * LDA SCALAR MULTIPLIER. * LDB N EXPONENT ADJUSTMENT. * JSB MULT * * WHERE E=1 INDICATES THAT THE LAST WORD OF THE CURRENT * MANTISSA IS ZERO. (INPUT CONVERSION). FOR THIS * CASE, THE EXPONENT ADJUSTMENT MUST NOT CARRY OUT. SPC 2 MULTX STA MULTA SAVE MULTIPLIER. RAL AND 2*MULTIPLIER. STA MULTD CME E=0 IFF INPUT ADB EXP ADJUST EXPONENT STB EXP LDB MANTL CURRENT WORD ADDR SEZ,RSS INPUT ? JMP MULT3 YES, SKIP FIRST MPY STB MULTB RAR RESTORE MULTIPLIER. MPY B,I ASL 1 JMP MULT2 MULT1 LDA MULTA MULTIPLIER. MPY B,I * CURRENT WORD. CLE,ELA ALIGN. ELB,CLE ADA MULTC,I ADD LOWER TO CURRENT + 1 STA MULTC,I SEZ PROPOGATE CARRY. INB MULT2 LDA MULTB,I CORRECT FOR BIT 15. SSA ADB MULTD STB MULTB,I LDB MULTB SEE IF DONE. MULT3 CPB MANTP I.E., IS CURRENT WORD THE START ? JMP MULT,I YES, DONE. STB MULTC NO, UPDATE POINTERS. ADB MIN1 STB MULTB JMP MULT1 AND LOOP. SKP * DIVD - DIVIDE MANTISSA BY A SCALAR. * * DIVD DIVIDES THE MANTISSA BY A SCALAR AND ADJUSTS THE * EXPONENT ACCORDINGLY. THE EFFECT IS AS IF THE TWO WERE * INTEGERS AND THE DIVIDE WERE DONE, KEEPING 15 FRACTION * BITS, FOLLOWED BY A LEFT SHIFT 15. * OVERFLOW CAN OCCUR ONLY IF THE MANTISSA IS NORMALIZED * OR THE DIVISOR IS LESS THAN 2**1}=4. * * CALLING SEQUENCE: * * LDA SCALAR 15-BIT DIVISOR. * LDB N EXPONENT ADJUSTMENT. * JSB DIVD SPC 4 DIVDX STA DIVDA SAVE DIVISOR. ARS SAVE DIVISOR/2. STA DIVDD CMB,INB CORRECT EXPONENT. ADB EXP STB EXP LDA MANTP SET UP POINTERS. STA DIVDB STA DIVDC LDB A,I B = FIRST WORD. CMA,INA -MANTP ADA MANTL MANTL-MANTP = # WDS - 1 CMA - # WDS STA DIVDE CLA BITS 15,14 FIRST WORD = 0 JMP DIVD2 DIVD1 ISZ DIVDB CLA SAVE BIT 15 (IN E). ELA,ELA CMB FORM REM - DIVISOR/2 ADB DIVDD CMB,CLE,SSB POS ? ADB DIVDD NO, RESTORE REM & SET E. CME SAVE BIT 14 (IN E). ERA,RAR DIVD2 STA DIVDF SAVE BITS 15,14. ISZ DIVDC LDA DIVDC,I A = NEXT WORD (LOW) DIV DIVDA DIVIDE. CLE,ERA SHIFT RIGHT, SAVE BIT 0 AS BIT 15. IOR DIVDF ADD PREV BITS 15,14. STA DIVDB,I ISZ DIVDE DONE ? JMP DIVD1 NO, LOOP. JMP DIVD,I YES, EXIT. SKP * OUTPT - SCALE NUMBER FOR OUTPUT. * * OUTPT COPIES A VARIABLE TO BE NUMERICALLY OUTPUT, PUTTING * IT IN A STANDARD FORMAT (4 WORD MANTISSA, SEPARATE EXPONENT). * THEN IT MULTIPLIES OR DIVIDES THE NUMBER BY A POWER OF TEN * TO THAT IT IS IN [1000,10000). THE BINARY POINT IS PLACED * AFTER THE FIRST WORD SO THE FIRST 4 DIGITS ARE IN THAT WORD. * THE VALUE OF N S.T. (ORIGINAL #) * (10**(-N)) IS IN [.1,1) * IS STORED IN EXPON, I.E. NUMBER * 10**EXPON = ORIG NUMBER. * THE FOLLOWING APPROXIMATION IS USED: * * LOG10(X*(2**N)) = [((N*19729)/128)+((X*(2**15))*617)/(2**16)-290]/512 * * WHERE X IS IN [0.5,1). THE ERROR IS ALWAYS POSITIVE. SPC 2 * COPY NUMBER AND CONVERT IT. * SI OUTPX LDA AMANT COPY THE DATA. STA OUTA (MUST COPY ONLY EXACT AMOUNT TO AVOID DM) LDA LENTH,I # WORDS. CMA,INA OUTPE LDB ADX,I COPY A WORD. STB OUTA,I ISZ ADX BUMP SOURCE. ISZ OUTA BUMP DEST. INA,SZA COUNT & LOOP. JMP OUTPE * LDA TYPE,I WHAT TYPE IS IT ? ADA MIN2 SSA,INA,RSS JMP OUTPB FLOATING. * * INTEGER. * SZA,RSS INTEGER. 1 OR 2-WORD. JMP OUTPC 2-WORD. LDA MANT 1-WORD. FLOAT IT. JSB FLOAT STA MANT SET UP AS IF 2-WORD FLOATING. STB MANT+1 CLA,INA JMP OUTPB OUTPC STA MANT+2 2-WORD. FLOAT TO 3-WD FLOATING. LDA =D31 JSB .XPAK DEF MANT LDA ....2 SET UP AS IF 3-WORD FLOATING. SKP * FLOATING. * OUTPB ADA AMANT FORM ADDR LAST WORD STA OUTA LDB A,I UNPACK THAT WORD. JSB .FLUN STB OUTA,I STA EXP ISZ OUTA ZERO OUT NEXT WORD. CLA STA OUTA,I * * REMEMBER SIGN, TAKE ABS VALUE, CHECK FOR ZERO. * JSB NORML NORMALIZE. LDB MANT SET SIGN. ASR 16 STB SIGN STB EXPON IN CASE ZERO. SZA,RSS ZERO ? JMP OUTPD YES, DON'T SCALE. SSA NEGATIVE ? JSB .XCOM YES, TAKE ABS VALUE. (B=-1) * * SCALE TO [1000,10000). * FIRST, ESTIMATE LOG BASE 10. * LDA EXP FORM N*19729 MPY =D19729 ASR 7 (N*19729)/128 STA OUTA LDA MANT X*(2**15) MPY =D617 B = ((X*(2**15))*617)/(2**16) ADB OUTA + (N*19729)/128 ADB =D222 -290+512 ASR 9 B = FLOOR(LOG10(NUMBER))+1 STB EXPON = N. * * NOW PERFORM THE SCALING. * CMB,INB DIVIDE NUMBER BY 10**(N-4) ADB ....4 L LDA B JSB PTEN SKP * IF < 1000, MULTIPLY BY 10. * (CAN HAPPEN DUE TO ERROR IN COMPUTING LOG.) * LDA MANT GET INTEGER PART. LDB EXP RBL JSB IFIX ADA =D-1000 IS IT < 1000 ? CLE,SSA,RSS JMP OUTPA NO, O.K. LDA PWR1A YES, MULTIPLY BY TEN. LDB PWR1A+1 JSB MULT (E=0: NON-INPUT MODE) CCA DECREMENT EXPONENT. ADA EXPON STA EXPON * * MOVE BINARY POINT TO AFTER FIRST WORD. * OUTPA LDA EXP ADJUST EXP TO +15 ADA =D-15 CMA,INA JSB RSN * * SET UP MANTP, MANTL, W AND D. EXIT. * OUTPD LDA AMANT RESET TO HIGHER ACCURACY. STA MANTP (FOR ZERO CASE) ADA LENTH,I FOR DIGIT PRODUCTION. STA MANTL JSB WDFIX SET W AND ADJUST AND SET D. JMP OUTPT,I EXIT. HED D, E, F, G & I SPECIFICATIONS. GTYPE LDB IO,I I/O SWITCH SZB OUTPUT JMP FTYPE INPUT SAME AS F-TYPE LDA ....4 JSB WDGET PICK OFF W AND D FIELDS CLA STA SCALE,I NO SCALE FACTOR IF F-TYPE USED GCONV JSB F2LST JSB OUTPT SCALE, SET W & D. CCA SET FLAG SO FTYPE & ETYPE WILL RETURN. STA GFLAG,I LDA EXPON CHECK RANGE. A = SCALE FROM [.1,1) STA EXPNS SAVE FOR RECHECKING LATER. SSA < 0.1 ? JMP GTOE YES, USE -E-. ADA D FLOOR(LOG10(X))+1-D-1 LDB D CHECK D TOO. CMB,SZB,RSS IF D=-1 AND EXPON=0, FORCE -E-. INA SSA,RSS FLOOR(LOG10(X))= -1 ? JMP FOUT2 NO, AT LEAST ONE DIGIT AFTER POINT. STB EFLAG YES, FORCE A LEADING ZERO. FOUT1 CMB,INB NO, REMOVE LEADING BLANKS. LDA GFLAG,I IF G-FORMAT, TREAT BCNT AS ZERO. SSA JMP FOUT3 ADB BCNT ADJUST BCNT. STB BCNT FOUT3 CMB,SSB -BCNT-1. BCNT<0 ? JMP FOUT2 NO, O.K. ADB D YES. D-BCNT-1. SSB,INB,RSS SKIP IF BCNT>=D. D-BCNT. STB W DOESN'T FIT. OUTPUT DOLLARS. STB D FITS. ADJUST D ACCORDINGLY. CLB AND BCNT=0. SSA,RSS IF G-FORMAT, LEAVE BCNT ALONE. STB BCNT FOUT2 JSB OUTP1 PRINT NUMBER. LDA GFLAG,I GFIELD ? SSA JMP BACKF YES. GO BACK TO GTYPE. JSB RFCHK AGAIN ? JMP FOUT YES. SKP DTYPE LDA "D" STA EORD,I PUT ASCII D FOR EXPONENT FIELD. ETYPE LDB IO,I I/O SWITCH SZB JMP FTYPE INPUT IS THE SAME AS F-TYPE. LDA ....4 4 CHARS EXPONENT. JSB WDGET ELOOP JSB F2LST CHECK THE LIST JSB OUTPT SCALE, SET W & D. GTOE CCA SET EFLAG:=TRUE. STA EFLAG LDA EXPON SUBTRACT SCALE FACTOR FROM EXPONENT. ADA TSCAL,I STA EXPON LDA TSCAL,I ADD IT TO D. CMA,INA + SCALE FACTOR. STA SGDIG (IF + SCALE, NO SPECIAL ROUNDING) ADA D STA D A = D. LDB TSCAL,I - SCALE FACTOR. SSB,RSS SCALE FACTOR <= 0 ? JMP ETYP2 YES. * * 8 SCALE FACTOR > 0. DECREMENT D. IF BCNT > 0, DECR * BCNT. THEN IF TOO FEW PLACES, ADJUST D & EXPON. * CCB TRY TO DECREMENT BCNT. ADB BCNT SSB STILL + ? JMP ETYP1 NO, LEAVE BCNT & D. STB BCNT YES. DO IT. ADA MIN1 D TOO. STA D ETYP1 LDB MANT NUMBER ZERO ? SZB,RSS JMP ETYP5 YES, DELETE EXTRA LEADING ZEROES. SSA NO. DIGITS BEFORE POINT LOST ? JMP ETYP4 NO. LDB D YES, ADJUST EXPON TO REFLECT THIS. JMP ETYP3 ETYP5 CMA,SSA,INA -D. WAS D >= 0 ? CLA YES, USE D=0. ADA W W-D CMA D-W-1 = # OF EXTRA ZEROES + BCNT. STA BCNT JUST DELETE THEM. JMP ETYP4 SKP * SCALE FACTOR <= 0, MAKE SURE AT LEAST ONE DIGIT. * ETYP2 ADA B RESTORE ORIGINAL D. ADA B ACCOUNT FOR LEADING ZEROES. STA SGDIG REMEMBER FOR ROUNDING. INA (OLD D)+(# LDNG ZEROES)+1 = - # SIG DIG. CMA,SSA,RSS # SIG DIG - 1. AT LEAST ONE ? JMP ETYP4 YES, IS O.K. STA B NO. FIX D & EXPON. CMA,INA 1 - # SIG DIG ADA D START DIGITS THAT MUCH SOONER. STA D LDA MIN2 LIMIT ROUNDING. STA SGDIG ETYP3 ADB EXPON CORRECT EXPONENT. STB EXPON * * OUTPUT NUMBER AND EXPONENT. * ETYP4 LDA MANT SZA,RSS IF NUMBER ZERO, SET EXPONENT = 0 STA EXPON JSB OUTP1 LDA EORD,I OUTPUT EXPONENT. FIRST, JSB OUTCR DESCRIPTIVE E (OR D) LDA MINUS LDB EXPON SSB SKIP IF POSITIVE CMB,INB,RSS IF NEGATIVE, 2'S COMPLEMENT&SKIP LDA PLUS IF POSITIVE,CHANGE A TO '+' STB EXPON JSB OUTCR OUTPUT THE SIGN LDA EXPON NOW THE MAGNITUDE. CLB DIV ...10 A=FIRST, B=SECOND. ADA "0" ADB "0" STB EXPON JSB OUTCR LDA EXPON JSB OUTCR SECOND DIGIT LDA GFLAG,I SSA JMP BACKE JSB RFCHK CHECK FOR REPEATS JMP ELOOP HED GENERAL DIGIT OUTPUT. ********************************************************************** * OUTP1 IS THE ROUTINE WHICH PERFORMS THE ACTUAL OUTPUT CONVERSION. * * IT ASSUMES THAT WSAVE, DSAVE, AND BCNT HAVE BEEN PROPERLY INI- * * TIALIZED, AND THAT THE NUMBER HAS BEEN PROPERLY SCALED BY OUTPT. * * IT USES GETDG TO PRODUCE SIGNIFICANT DIGITS FROM LEFT TO RIGHT * * AND PRODUCES LEADING BLANKS, LEADING ZEROES AND THE DECIMAL POINT * * ACCORDING TO WSAVE, DSAVE AND BCNT. SPECIAL CARE IS TAKEN TO * * OUTPUT THE SIGN AND THE DECIMAL POINT PROPERLY, AND TO ROUND THE * * RESULT CORRECTLY. * ********************************************************************** * * * THIS ROUTINE HAS BEEN MODIFIED TO OUTPUT 0'S AFTER THE NUMBER OF * SIGNIFICANT DIGITS GIVEN BY THE TABLE "SDTBL". * THIS WAS DONE TO SUPPRESS THE RETURN OF INSIGNIFICANT DIGITS IN * LARGE FORMAT FIELDS. SPC 3 * INITIALIZE, OUTPUT LEADING BLANKS & SIGN. * OUTPZ LDA W MAY ALREADY BE TOO LATE. SSA,RSS JMP BCKS3 YUP. DOLLARS. LDB BCNT OUTPUT LEADING BLANKS LDA BLANK JSB MTPLO LDB SIGN OUTPUT A MINUS ? LDA MINUS SZB IF NOT. JSB OUTCR YES. LDA "0" SPECIAL CASE FROM F-FORMAT. LDB EFLAG IF EFLAG=+1, OUTPUT "0" CPB ....1 JSB MTPLO (UPDATE W TOO) LDA SDTBL ADA TYPE,I LDA A,I STA GETDA SET COUNTER FOR # OF SIGNIFICANT DIGITS LDA MIN5 SET UP CONVERSION FOR GETDG. STA GETDC SKP * OUTPUT DIGITS. * LDA D D CMA,INA -D ADA W W-D STA OCONT  LDB W IF W=0, DONE. SSB,RSS JMP ALDON SSA ANY DIGITS BEFORE POINT (W * * ALL OF THESE ARE OPTIONAL, AND THE APPEARANCE OF THE FIRST * SIGN, DIGIT, OR DECIMAL PT. DEFINES A NUMBER. ANY COMBINATION * OF THE ABOVE IS LEGAL, WITH THE FOLLOWING EXEPTIONS: * * * (1) AN INITIAL E IS IGNORED IN FREE-FIELD, AND IS ILLEGAL IN * FIXED FIELD; * (2) IF NO INTEGER PART OR FRACTION APPEARS (AND A SIGN OR * DEC.PT. DOES), THE RESULT IS ZERO * * IN FIXED-FIELD INPUT, IF NO DECIMAL PT. APPEARS, THE RESULT IS * * MULTIPLIED BY 10**(-D). * * THE FOLLOWING SPECIAL FEATURES ARE INCLUDED FOR FREE-FIELD INPUT: * * (1) WHEN 2 CONSECUTIVE COMMAS APPEAR WITH NO DATA BETWEEN, * THAT LIST ELEMENT IS SKIPPED. * * (2) WHEN A SLASH OCCURS IN AN INPUT RECORD, THE REMAINDER * OF THE RECORD IS TREATED AS COMMENTS. * * (3) IF A LINE TERMINATES WITHOUT A SLASH, THE INPUT OPERATION * TERMINATES AND THE REMAINDER OF THE LIST REMAINS * UNCHANGED. * * (4) WHEN A QUOTE APPEARS, THE FOLLOWING * * CHARACTERS IN THAT LINE ARE TREATED AS COMMENTS * * UNTIL ANOTHER QUOTE APPEARS. * * * (5) ALL UNRECOGNIZED CHARACTERS ARE TREATED AS BLANKS * * (6) WHEN AN INTEGER IS PRECEDED BY THE CHARACTER "@", THE IN- * TEGER IS INTERPRETED AS OCTAL. * * CONTROL WITHIN INPUT IS GOVERNED BY THE VARIABLE POST, * WHOSE VALUE INDICATES HOW FAR THE NUMBER HAS BEEN * SCANNED, AS FOLLOWS: * * POST = 0 : NUMBER NOT STARTED YET * 1 : NUMBER STARTED, BUT NO DECIMAL PT. REACHED YET * 3 : LAST CHARACTER WAS THE 'E' * 4 : EXPONENT BEING PROCESSED * ******************************************************************* * * INITIALIZATION. SKP INPUX LDA AMANT SET UP MANTISSA ADDRESSES. STA MANTP STA MANTL LDA MIN4 FOR INDIG. STA INPUB # DIGITS THIS GROUP - 4. CCA STA EXP CLA STA INPUA ACCUMULATED DIGITS THIS GROUP. (UP TO 4) STA INPUC SIGN OF EXPONENT. STA INPUD # TRAILING ZEROES. STA SIGN SIGN OF MANTISSA. STA MANT STA MANT+1 STA MANT+2 STA MANT+3 STA MANT+4 STA EXPON STA SKIP,I STA POST CPA FCR,I FREE FIELD ? JMP *+2 JMP INLUP STA W STA D STA DSAVE,I * * MAIN LOOP. READ A CHAR AND DECIDE WHAT TO DO. * FLIP ISZ W CHECK FOR END OF FIELD JMP INLUP NO, KEEP GOING. JMP FINAL YES, GO PACK IT UP. INLUP JSB INCHR LDB POST CPA "/" JMP INSLS CPA COMMA JMP INCOM CPA PLUS JMP INPLS CPA MINUS JMP INMIN CPA "." JMP INPNT CPA "E" JMP INE CPA "D" JMP INE CPA QUOTE JMP INQUO CPA "@" JMP INOCT JSB DIGIT JMP INBLN SKP ***** THE CHARACTER IS A DIGIT. WE FIRST SET POST AS FOLLOWS: **** * POST=0 : POST_1 * POST=2 : DF_DF+1 * POST=3 : POST_6 * ******************************************************************* BNKNM LDB POST SZB,RSS ISZ POST IF POST=0, SET IT TO 1 CPB ....3 JMP INEX3 PROCESSING EXPONENT CPB ....4 JMP INEX4 PROCESSING EXPONENT * * ADD THIS DIGIT TO MANTISSA. * LDB POST IF PAST DEC POINT, COUNT DIGITS. CPB ....2 ISZ D NOP COULD SKIP ! JSB INDIG ADD DIGIT. JMP FLIP * * EX(PONENT PROCESSING. * INEX3 ISZ POST INEX4 LDB EXPON MULTIPLY EXPON BY 10 BLS,BLS ADB EXPON BLS ADB A ASL 4 GUARANTEE LARGE EXPONENTS STAY LARGE. SOC IF TOO BIG, LDB =B77777 SET TO MAX POS. (BECOMES 3777) ASR 4 STB EXPON JMP FLIP * * COMMA. * INCOM LDA FCR,I TREAT A COMMA ON INPUT SZA TEST FOR FREE FIELD INPUT JMP ERR4 CCA SZB IS POST=0? JMP FINL1 CPA CFLAG,I JMP *+3 DOUBLE COMMA STA CFLAG,I JMP FLIP STA SKIP,I STA SWITH,I JMP INPUT,I SKP * "+" AND "-": SET THE APPROPRIATE SIGN. * INMIN CCA FOR MINUS SZB WHICH ? JMP INPL2 DEC EXPONENT. STA SIGN MANTISSA. JMP FLIP INPL2 STA INPUC INPLS CPB ....4 IF POST=4 THIS IS ILLEGAL JMP ERR5 LDA ....4 SZB IF POST>0 THEN SET IT TO 4 STORP STA POST JMP FLIP * * "." : DECIMAL POINT. * INPNT BRS HANDLES DECIMAL POINT SZB JMP ERR5 MEANS POST WAS 2 OR MORE LDA DSAVE,I SUBTRACT DSAVE FROM D. CMA,INA ADA D STA D LDA ....2 JMP STORP * * "E" : NOTE END OF MANTISSA. * INE ADB MIN3 SSB,RSS JMP ERR5 POST WAS 3 OR 4 LDA ....3 SET IT TO 3 JMP STORP * * "/" : FORMATTED, ERROR. FREE-FIELD, IS END-OF-LINE. * INSLS LDA FCR,I SZA JMP ERR4 STA CCNT,I SET CCNT=0 TO READ NEXT LINE JMP FINAL BEAT IT * * FREE-FIELD COMMENT PROCESSING. * INQUO LDA FCR,I ERROR IF NOT FREE-FIELD. SZA JMP ERR4 FIXED, ERROR 4. INQU1 JSB INCHR READ CHARACTERS UNTIL ANOTHER CPA QUOTE QUOTE IS READ. JMP INBLN INBLN CCzA *** CHECK IF END OF BUFFER? CPA CCNT,I *** THIS CODE ADDED TO FIX '123"' JMP INSLS *** YES FREE FIELD INPUT BUG JMP INQU1 SKP * BLANK. * INBLN LDB FCR,I SEE IF FREE-FIELD. SZB,RSS JMP INBL1 YES. CPA BLANK NO. MUST BE A TRUE BLANK. RSS JMP ERR4 NO, UNRECOGNIZED CHAR. LDA OFLAG,I YES. IGNORE OR TREAT AS A ZERO ? LDB POST SZB IF POST=0, ALWAYS IGNORE. SZA JMP FLIP OLDIO. IGNORE. JMP BNKNM NEWIO. TREAT AS ZERO. (A=0) INBL1 LDB POST FREE-FIELD. POST=0 ? SZB,RSS JMP FLIP YES. IGNORE IT. (ELSE FALL INTO "FINAL") * * END OF NUMBER. PUT IT ALL TOGETHER. * FINAL CLA FINL1 STA CFLAG,I CCA ADD ANY REMAINING DIGITS. JSB INDIG JSB NORML NORMALIZE. LDA MANT IF ZERO, DONE. SZA,RSS JMP FNL11 LDA EXPON FINAL COMPUTATION OF NUMBER ISZ INPUC COMPUTE EXTERNAL CMA,INA EXPONENT AS NEGATIVE LDB POST IF NO E-FIELD ADB MIN3 ADD SSB SCALE FACTOR ADA SCALE,I ADA D ADJUST FOR DECIMAL POINT OR EXCESS DIGITS. CMA,INA ADA INPUD ACCOUNT FOR TRAILING ZEROES, EXTRA DIGITS. LDB A CHECK FOR LARGE VALUE. ASL 9 OFL IF OUTSIDE [-64,+64) SOC SHOULD NEVER BE OUTSIDE [-60,+39] JMP FNL13 (MANTISSA IN [1,10**20], RRR 9 RESULT IN [10**-39,10**39] ) JSB PTEN MULTIPLY BY POWER OF TEN. LDB SIGN TEST THE SIGN SSB NEGATIVE ? JSB .XCOM YES, COMPLEMENT MANTISSA. (B=-1) SKP * ALL SET EXCEPT COMBINING MANTISSA & EXPONENT. * INPCK LDA TYPE,I WHAT TYPE ? ADA MIN2 CLE,SSA,INA,RSS JMP FINL6 FLOATING. LDA EXP INTEGER. CHECK EXPONENTl. CMA,SSA,INA,RSS IN [-.5,+.5) ? JMP FNL14 YES, RESULT = 0 ADA =D15 NO. A = SHIFT-16 TO INTEGERIZE. SSA SHIFT<16 ? JMP FINL3 YES. MIGHT BE <0 (OFL) STA EXP NO. REMEMBER REST OF SHIFT. LDA MANT+2 DO WORD SHIFT. IOR MANT+1 STA MANT+2 LDB MANT STB MANT+1 ASR16 ASR 16 STB MANT LDA EXP REST OF SHIFT JMP FINL4 GO DO IT. FINL3 ADA =D16 SHIFT. CLE,SSA <0 ? (OVERFLOW) JMP FNL15 YES. FINL4 SZA,RSS NO. SHIFT>0 ? JMP FNL4A NO, DONE SHIFTING. IOR ASR16 FORM ASR SHIFT STA XEQ+1 LDB MANT+1 CATCH BITS SHIFTED PAST POINT. CLA JSB XEQ IOR MANT+2 JUST OR THEM IN STA MANT+2 LDB MANT NOW DO THE SHIFT. LDA MANT+1 JSB XEQ STB MANT STA MANT+1 FNL4A LDB MANT NUMBER<0 ? SSB,RSS JMP FINL5 NO. LDA MANT+2 YES. CHECK FOR BITS PAST POINT. IOR MANT+3 SZA,RSS JMP FINL5 IF NONE. ISZ MANT+1 SOME. INCREMENT RESULT. JMP *+2 NO CARRY. INB PROPOGATE CARRY. FINL5 LDA TYPE,I SINGLE OR DOUBLE INTEGER ? CLE,SZA JMP FNL5A DOUBLE, DONE. LDA MANT+1 SINGLE, SHORTEN IT. ASL 16 SOC OVERFLOW ? JMP FNL15 YES. (E=0) FNL5A STB MANT NO. UPDATE FIRST WORD. JMP FNL11 * * ROUND FLOATING. CHECK FOR OFL UFL, PACK EXPONENT. * FINL6 LDB .177 ADD 200B TO ROUND. JSB .XCOM ROUND. ALSO SET INPUA TO LWA. LDB EXP CHECK EXP CLA FOR USE IN FORMATTING EXP ASL 8 MUST FIT IN 8 BITS WITH SIGN. SOC JMP FNL13 NO, OFL/UFL. CLE,ELB E=EXP SIGN, B<15:9>=EXP MANT. BLF,BLF B<7:1>=EXP MANT. RBR,ELB B<7:0>=FORMATTED EXPONENT. LDA INPUA,I LAST WORD MACNTISSA. AND =B177400 MAKE ROOM FOR EXP. IOR B PUT TOGETHER. STA INPUA,I FNL11 LDA AMANT COPY RESULT. LDB ADX STB INPUB LDB LENTH,I SET UP COUNT. CMB,INB STB INPUA FNL12 LDB A,I CAN'T USE .MVW: IS TYPE 7. STB INPUB,I INA INCR ADDRESSES & LOOP. ISZ INPUB ISZ INPUA DO "LENTH" TIMES. JMP FNL12 STA SWITH,I INDICATE PRESENCE OF NUMBER. JMP INPUT,I EXIT. * * OVERFLOW & UNDERFLOW HANDLING. * FNL13 CCE,SSB OFL OR UFL ? (IF OFL, E=1) FNL14 CLA,CLE,RSS UFL. (E=0) FNL15 LDA =B77777 OFL. E=1 IF FLOATING. STA MANT RAL,ARS UFL:0 OFL:-1 STA MANT+1 STA MANT+2 STA MANT+3 CCB,SEZ,RSS INTEGER OR UFL ? (B=-1) JMP FNL11 YES, DONE. ADB LENTH,I NO, COMPUTE ADDR LAST WORD. ADB AMANT LDA B,I FLOATING & OFL, CLEAR LAST BIT. ALS STA B,I JMP FNL11 GO COPY IT. SKP * FREE-FIELD OCTAL PROCESSING. * INOCT STA POST SZB IF POST WAS NON ZERO, TREAT AS A JMP INBLN BLANK. STB CFLAG,I RESET CFLAG TO SAY NO COMMA LDA FCR,I SZA TEST FOR FREE FIELD INPUT JMP ERR4 INOC2 JSB INCHR GET NEXT CHARACTER. JSB DIGIT CHECK FOR DIGIT. JMP INOC1 NO. LDB MANT GET PREVIOUS OCTAL RESULT BLF,RBR SHIFT LEFT 3. IOR B MERGE WITH NEW DIGIT. STA MANT JMP INOC2 INOC1 LDA MANT FLOAT IT. JSB FLOAT STA MANT BRS STB EXP STA SWITH,I INDICATES NUMBER PROCESSED (A.NE.7) CPA BLANK IF TERMINATING CHARACTER IS JMP INPCK OTHER THAN A BLANK, CCB UNREAD IT. ADB BCR,I STB BCR,I CCB ADB CCNT,I STB CCNT,I JMP INPCK END   +6 24998-18232 2001 S C0122 &FMT.E SYS INDEPENDENT LIBRARY             H0101 wASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED "FMT.E" ROUTINE TO DEFINE LIST LU FOR "FMTIO" MODULE NAM FMT.E,7 24998-1X232 REV.2001 781107 ENT FMT.E SPC 1 * PURPOSE: * THE REASON THIS ROUTINE IS IN THE LIBRARY IS TO ALLOW * THE USER TO EASILY CHANGE THE LOGICAL UNIT THAT ERROR * MESSAGES GET PRINTED TO BY THE "FMTIO" ROUTINE. (OR * INHIBIT THEM ALL TOGETHER BY SETTING = 0) SPC 1 FMT.E DEC 6 LINE PRINTER SHALL BE DEFAULT * FOR ALL ERROR MESSAGES. END    24998-18233 2001 S C0122 &#COS SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO CCOS NAM #COS,7 24998-1X233 REV.2001 750701 ENT #COS EXT ERR0,.ENTR,CCOS Y NOP X NOP #COS NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB CCOS DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP #COS,I RETURN END * * * n   24998-18234 2001 S C0122 &#EXP SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO CEXP NAM #EXP,7 24998-1X234 REV.2001 750701 ENT #EXP EXT ERR0,.ENTR,CEXP Y NOP X NOP #EXP NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB CEXP DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP #EXP,I RETURN END * * lv   24998-18235 2001 S C0122 &#LOG SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO CLOG NAM #LOG,7 24998-1X235 REV.2001 750701 ENT #LOG EXT ERR0,.ENTR,CLOG Y NOP X NOP #LOG NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB CLOG DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP #LOG,I RETURN END * * 4b  24998-18236 2001 S C0122 &#SIN SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO CSIN NAM #SIN,7 24998-1X236 REV.2001 750701 ENT #SIN EXT ERR0,.ENTR,CSIN Y NOP X NOP #SIN NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB CSIN DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP #SIN,I RETURN END * *   24998-18237 2001 S C0122 &%AN SYS INDEPENDENT LIBRARY             H0101 aASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * * * UTILITY ROUTINE CALL TO TAN * NAM %AN,7 24998-1X237 REV.2001 750701 ENT %AN EXT TAN,ERR0 %AN NOP ENTRY/EXIT ISZ %AN LDB %AN,I DLD 1,I LOAD PARAMETER INTO A AND B REG JSB TAN CALL TO TAN ROUTINE JSB ERR0 ERROR RETURN ISZ %AN JMP %AN,I RETURN END * *   24998-18238 2001 S C0122 &%IN SYS INDEPENDENT LIBRARY             H0101 jASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * * * UTILITY ROUTINE CALL TO SIN * NAM %IN,7 24998-1X238 REV.2001 750701 ENT %IN EXT SIN,ERR0 %IN NOP ENTRY/EXIT ISZ %IN LDB %IN,I DLD 1,I LOAD PARAMETER INTO A AND B REG JSB SIN CALL SIN ROUTINE JSB ERR0 ERROR RETURN ISZ %IN JMP %IN,I RETURN END * * )%  24998-18239 2001 S C0122 &%LOG SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * * * UTILITY ROUTINE CALL TO ALOG * NAM %LOG,7 24998-1X239 REV.2001 750701 ENT %LOG EXT ALOG,ERR0 %LOG NOP ENTRY/EXIT ISZ %LOG LDB %LOG,I DLD 1,I LOAD PARAMETER INTO A AND B REG JSB ALOG CALL ALOG ROUTINE JSB ERR0 ISZ %LOG JMP %LOG,I RETURN END * *   24998-18240 2001 S C0122 &%LOGT SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO ALOGT NAM %LOGT,7 24998-1X240 REV.2001 770518 ENT %LOGT ENT %LOG0 EXT ALOGT,ERR0 %LOG0 EQU * %LOGT NOP ISZ %LOGT LDB %LOGT,I DLD 1,I LOAD PARAMETER INTO A AND B JSB ALOGT JSB ERR0 ERROR RETURN ISZ %LOGT JMP %LOGT,I RETURN END * *   24998-18241 2001 S C0122 &%OS SYS INDEPENDENT LIBRARY             H0101 iASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * * * UTILITY ROUTINE CALL TO COS * NAM %OS,7 24998-1X241 REV.2001 750701 ENT %OS EXT COS,ERR0 %OS NOP ENTRY/EXIT ISZ %OS LDB %OS,I DLD 1,I LOAD PARAMETER INTO A AND B REG JSB COS CALL COS ROUTINE JSB ERR0 ERROR ROUTINE ISZ %OS JMP %OS,I RETURN END * * Cd  24998-18242 2001 S C0122 &%TAN SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * * * UTILITY ROUTINE CALL TO ATAN * NAM %TAN,7 24998-1X242 REV.2001 750701 ENT %TAN EXT ATAN,ERR0 %TAN NOP ENTRY/EXIT ISZ %TAN LDB %TAN,I DLD 1,I LOAD PARAMETER INTO A AND B REG JSB ATAN CALL TO ATAN ROUTINE JSB ERR0 ERROR RETURN ISZ %TAN JMP %TAN,I RETURN END * * a  24998-18243 2001 S C0122 &%XP SYS INDEPENDENT LIBRARY             H0101 tASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * * * UTILITY ROUTINE CALL TO EXP * NAM %XP,7 24998-1X243 REV.2001 750701 ENT %XP EXT EXP,ERR0 %XP NOP ENTRY/EXIT ISZ %XP LDB %XP,I DLD 1,I LOAD PARAMETER INTO A AND B REG JSB EXP CALL EXP ROUTINE JSB ERR0 ERROR RETURN ISZ %XP JMP %XP,I RETURN END * * -  24998-18244 2001 S C0122 &$EXP SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO DEXP NAM $EXP,7 24998-1X244 REV.2001 750701 ENT $EXP EXT ERR0,.ENTR,DEXP Y NOP X NOP $EXP NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB DEXP DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP $EXP,I RETURN END * * sw  24998-18245 2001 S C0122 &$LOG SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO DLOG NAM $LOG,7 24998-1X245 REV.2001 750701 ENT $LOG EXT ERR0,.ENTR,DLOG Y NOP X NOP $LOG NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB DLOG DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP $LOG,I RETURN END * * ;c  24998-18246 2001 S C0122 &$LOGT SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO DLOGT NAM $LOGT,7 24998-1X246 REV.2001 770518 ENT $LOGT ENT $LOG0 EXT ERR0,.ENTR,DLOGT Y NOP X NOP $LOG0 EQU * $LOGT NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB DLOGT DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP $LOGT,I RETURN END * * t  24998-18247 2001 S C0122 &$SQRT SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED CALL BY NAME TO DSQRT NAM $SQRT,7 24998-1X247 REV.2001 750701 ENT $SQRT EXT DSQRT,ERR0,.ENTR Y NOP X NOP $SQRT NOP JSB .ENTR TRANSFER PARAMETERS DEF Y JSB DSQRT DEF *+3 DEF Y,I DEF X,I JSB ERR0 ERROR RETURN JMP $SQRT,I RETURN END * *   24998-18248 2001 S C0122 &CLRIO SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED "CLRIO" DUMMY CLRIO FOR RTE AND DOS NAM CLRIO,7 24998-1X248 REV.2001 750701 ENT CLRIO SPC 2 * CALLING SEQUENCE: * JSB CLRIO * DEF *+1 * NOTHING IS MODIFIED A,B,E,O REGS. SPC 2 CLRIO NOP STA TEMP LDA CLRIO,I GET RETURN ADDRESS STA CLRIO LDA TEMP JMP CLRIO,I AND RETURN TEMP NOP END * * - ! 24998-18249 2001 S C0122 &ER0.E SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED "ER0.E" ROUTINE TO DEFINE LIST LU FOR "ERR0" MODULE NAM ER0.E,7 24998-1X249 REV.2001 750701 ENT ER0.E SPC 1 * PURPOSE: * THE REASON THIS ROUTINE IS IN THE LIBRARY IS TO ALLOW * THE USER TO EASILY CHANGE THE LOGICAL UNIT THAT ERROR * MESSAGES GET PRINTED TO BY THE "ERR0" ROUTINE. (OR * INHIBIT THEM ALL TOGETHER BY SETTING = 0) SPC 1 ER0.E DEC 6 LINE PRINTER SHALL BE DEFAULT * FOR ALL ERROR MESSAGES. END * * 4i " 24998-18250 2001 S C0122 &ERR0 SYS INDEPENDENT LIBRARY             H0101 {ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED "ERR0" ERROR PRINT FOR RTE,DOS,, AND DOS-III NAM ERR0,7 24998-1X250 REV.2001 771122 ENT ERR0 EXT REIO,ER0.E EXT PNAME SPC 1 * PURPOSE: * THIS IS A GENERAL PURPOSE ERROR ROUTINE FOR VARIOUS MATH ROUTINES * IN THE LIBRARY. SPC 1 * USES: * THIS ROUTINE WILL PRINT ON LOGICAL UNIT 6 THE CONTENTS OF THE * A & B-REGISTER IN ASCII IN THE FOLLOWING FORM. * * ! /PROGM : AA BB @12345B! * * WHERE THE MESSAGE STARTS AT !, AA=A-REG.,BB=B-REG, 12345 = OCTAL * ADDRESS OF P-1 OF THE CALL TO ERR0 AND "PROGM" = NAME OF CALLING * PROGRAM. SPC 1 * CALLED: * ASSEMBLY ONLY * MESSA & MESSB ARE THE FOUR CHARACTERS OF THE MESSAGE * LDA MESSA * LDB MESSB * JSB ERR0 * A&B-REG=0 SPC 1 * EXAMPLE: * DLD X Y = SQRT (X) * JSB SQRT P+2 RETURN IF OK, ELSE P+1 RETURN * JSB ERR0 SQRT RETURN IF X IS NEGATIVE * DST Y ZERO RETURNED. SPC 1 ERR0 NOP STA MESSS+5 FIRST WORD OF ERROR CODE STB MESSS+7 2ND WORD OF ERROR CODE LDA ERR0 GET P+2 ADDRESS ADA DM2 CALC P+0 ADDRESS LDB DFADS GET ADDRESS OF MEM BUFFER RAL,CLE,SLA POSITION MEM ADDRESS & SKIP AGAIN LDA TEMPW GET NEXT OCT DIGIT ALF,  RAR ROTATE LEFT 3 STA TEMPW SAVE FOR NEXT PASS AND O7 MASK DOWN TO DIGIT IOR O60 MIRGE IN TO ASCII SEZ,RSS SKIP IF LO-CHAR IN WORD ALF,SLA,ALF POSITION TO HI-HALF IOR B,I MIRGE IN HI-HALF STA B,I AND PUT IN WORD SEZ,CME BUMP WORD TO NEXT WORD? INB YES, DONE WITH BOTH CHARS CPB DFEND DONE WITH 5 CHARS? SEZ,RSS YES JMP AGAIN NO, FINISH CONVERSION IOR "B" LAST CHAR IS "B" STA B,I AND PUT IN LAST WORD JSB PNAME ADD PROGRAM NAME TO MESSAGE DEF *+2 DEF MESSS+1 JSB REIO DEF *+5 DEF D2 RCODE=2 FOR WRITE DEF ER0.E LIST DEV = 6 DEF MESSS FWA OF MESSS DEF D12 12 WORDS OF MESSAGE CLA CLB JMP ERR0,I EXIT D12 DEC 12 DM2 DEC -2 TEMPW NOP "B" OCT 102 DFADS DEF IADRS-3 DFEND DEF IADRS-1 MESSS ASC 12, /PROGS : 03 UN @12345B IADRS EQU * O7 OCT 7 O60 OCT 60 D2 OCT 2 B EQU 1 END * * w  $ 24998-18251 2001 S C0122 &IND.E SYS INDEPENDENT LIBRARY             H0101 w ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED "IND.E" ROUTINE TO DEFINE LIST LU FOR "INDEX" MODULE NAM IND.E,7 24998-1X251 REV.2001 750701 ENT IND.E SPC 1 * PURPOSE: * THE REASON THIS ROUTINE IS IN THE LIBRARY IS TO ALLOW * THE USER TO EASILY CHANGE THE LOGICAL UNIT THAT ERROR * MESSAGES GET PRINTED TO BY THE "INDEX" ROUTINE. (OR * INHIBIT THEM ALL TOGETHER BY SETTING = 0) SPC 1 IND.E DEC 6 LINE PRINTER SHALL BE DEFAULT * FOR ALL ERROR MESSAGES. END * *  $ 24998-18252 2001 S C0122 &INDEX SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * NAM INDEX,7 24998-1X252 REV.2001 750701 ENT .INDA,.INDR EXT REIO,IND.E * .INDA AND .INDR ARE USED BY THE ALGOL COMPILER * IN ORDER TO ACCESS ARRAY ELEMENTS. .INDA PRODUCES * THE ABSOLUTE ADDRESS OF AN ARRAY ELEMENT, WHEREAS *.INDR PRODUCES THE VALUE STORED IN THAT LOCATION. * THE CALLING SEQUENCE TO THESE ROUTINES IS: * * JSB .INDA OR .INDR * DEF ARRAY TABLE * ABS -NUMBER OF INDICES * DEF INDEX1 * ..... * DEF INDEX N * * THE ARRAY TABLE FOR A GIVEN ARRAY HAS THE FORM: * * TABLE ABS NUMBER OF INDICES (+=REAL, -=INTEGER) * ABS SIZE OF 1ST DIM * ABS -LOWER BOUND OF 1ST DIM * ..... * ABS SIZE OF LAST DIM * ABS -LOWER BOUND OF LAST DIM * .INDA NOP LDA .INDA JSB GETAD JMP T,I * .INDR NOP LDA .INDR JSB GETAD LDB 0 LDA 1,I INB LDB 1,I JMP T,I * GETAD IS THE ROUTINE THAT DOES ALL THE WORK. THE * COMPUTATION OF THE LOCATION IS DONE AS FOLLOWS: * * M_INDEX[1]-LB[1]; * FOR I_2 STEP 1 UNTIL NUMBEROFINDICES DO * M_SIZE[I]*M+INDEX[I]-LB[I]; * IF REAL ARRAY THEN M_2*M. * ADDRESS_M+BASE GETAD NOP STA T SAVE POINTER TO INDICES. LDA T,I GET ADDRESS OF ARRAY TABLE RAL,CLE,SLA,ERA TEST FOR INDIRECT. LDA 0,I RELOAD IF INDIRECT STA TABLE SAVE TyABLE ADDRESS LDA TABLE,I BET # OF INDICES FROM TABLE STA MODE SAVE IN MODE FOR LATER USE. ISZ T BUMP T TO POINT AT ACTUAL COUNT. SSA,RSS SET COUNT IN CALLING SEQUENCE CMA,INA NEGATIVE STA COUNT AND SAVE IN COUNT CPA T,I MAKE SURE COUNT AGREES JMP CNTOK THEY DO--WE CAN CONTINUE * * ILLEGAL ARRAY REFERENCE* * ERROR ISZ T FIXUP FOR CORRECT RETURN ISZ COUNT REPOSITION FOR JMP ERROR PROPER RETURN LDB T GET ADDRESS TO BE PRINTED LDA .1+3 STA COUNT SET FOR 3 TIMES LDA BNLOC STA MODE LDA B2006 GET BLANK UPPER OF 1ST CHAR RBL,CLE POSITION B REG. JMP *+4 POOL LDA B3006 JSB RRL3 ALF,RAL JSB RRL3 STA MODE,I STORE 2 DIGITS ISZ MODE BUMP BUFFER ADDRESS ISZ COUNT ARE WE DONE? JMP POOL NO, GO NEXT 2 DIGITS JSB REIO PRINT ERROR MESSAGE DEF *+5 DEF .1+1 DEF IND.E PRINT ON THE SYST. TTY DEF FLAG DEF .1+2 3WORDS(6 CHARS.) CLA CLB BACK ISZ T JMP GETAD,I RRL3 NOP ROTATE B AND A 3 BITDS ELB ELA ELB ELA ELB ELA JMP RRL3,I SUP B2006 OCT 2006 B3006 OCT 3006 .1 OCT 1,2,6,-3 FLAG ASC 6,INDEX? BNLOC DEF FLAG+3 LOCN. K OF START OF NUMBER CNTOK ISZ TABLE POINT TABLE TO FIRST SIZE CLA CLEAR M INITIALLY. LOOP STA M LDA TABLE,I GET DIMENSION SIZE CMA,INA AS NEGATIVE STA SIZE ISZ TABLE POINT AT LOWER BOUND LDA TABLE,I GET LOWER BOUND ISZ T ADD IN LDB T,I INDEX ADA 1,I SSA TEST FOR LEGAL JMP ERROR+1 ERROR INDEX TOO LOW STA 1 SAVE IN B ADA M ADD TO INDEX ADB SIZE SSB,RSS JMP ERROR+1 ERRO/, R-INDEX TOO HIGH ISZ COUNT TEST FOR DONE JMP MULT NO--GO DO A MULTIPLY * LDB MODE TEST MODE SSB,RSS IF + (REAL) ALS DOUBLE M ISZ TABLE ADA TABLE,I ADD IN BASE ADDRESS JMP BACK * MULT ISZ TABLE MPY TABLE,I JMP LOOP * T NOP TABLE NOP MODE NOP COUNT NOP M EQU .INDA SIZE EQU .INDR * END * *  ' 24998-18253 2001 S C0122 &PAUSE SYS INDEPENDENT LIBRARY             H0101 $ASMB,R,L,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED PAUSE AND STOP FOR RTE,DOS,AND IOMEC/DOS NAM PAUSE,7 24998-1X253 REV.2001 771122 ENT .PAUS,.STOP EXT EXEC,PAU.E,REIO EXT PNAME * SUP *ENTER WITH A= 4-DIGIT OCTAL NUMBER .PAUS NOP LDB PSASC STB TEXT+5 SET LDB PSASC+1 STB TEXT+6 -PAUSE- LDB PSASC+2 IN JSB PRINT PRNAM :PAUSE NNNN JSB EXEC SUSPEND EXECUTION DEF *+2 DEF *+2 JMP .PAUS,I EXIT AFTER: GO,FTN DEC 7 RCODE FOR SUSPEND EXECUTION PSASC ASC 3,PAUSE * * * TEXT ASC 5, PRNAM : ASC 3,PAUSE TEXTN NOP NOP * * * STASC ASC 2,STOP * .STOP NOP LDB STASC STB TEXT+5 SET LDB STASC+1 STB TEXT+6 -STOP- LDB TEXT IN JSB PRINT PRNAM :STOP NNNN JSB EXEC END RUN DEF *+2 DEF *+1 DEC 6 RCODE FOR COMPLETION REQUEST * *ENTER WITH A= 4-DIGIT OCTAL NUMBER PRINT NOP STB TEXT+7 CLB LSL 7 BLS,BLF SHIFT IN POSITION FOR NEXT LSL 3 LSL 3 2ND DIGIT TO B ADB .ASCN CONVERT TO ASCII STB TEXTN FIRST 2 DIGITS TO TEXT CLB LSL 3 3RD DIGIT TO B BLS,BLF SHIFT IN POSITION FOR NEXT LSL 3 LSL 3 4TH DIGIT TO B ADB .ASCN CONVERT TO ASCII STB TEXTN+1 LAST   2 DIGITS TO TEXT JSB PNAME ADD PROGRAM NAME TO MESSAGE DEF *+2 DEF TEXT+1 JSB REIO PRINT TEXT LINE DEF *+5 DEF .2 RCODE=2 FOR WRITE DEF PAU.E SYSTEM TTY= 1 DEF TEXT FWA OF TEXT DEF .M20 20 CHARACTERS JMP PRINT,I RETURN .ASCN ASC 1,00 .2 DEC 2 .M20 DEC -20 END * * p   ' 24998-18254 2001 S C0122 &PAU.E SYS INDEPENDENT LIBRARY             H0101 m$ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * HED "PAU.E" ROUTINE TO DEFINE LIST LU FOR "PAUSE" MODULE NAM PAU.E,7 24998-1X254 REV.2001 750701 ENT PAU.E SPC 1 * PURPOSE: * THE REASON THIS ROUTINE IS IN THE LIBRARY IS TO ALLOW * THE USER TO EASILY CHANGE THE LOGICAL UNIT THAT ERROR * MESSAGES GET PRINTED TO BY THE "PAUSE" ROUTINE. (OR * INHIBIT THEM ALL TOGETHER BY SETTING = 0) SPC 1 PAU.E DEC 1 SYSTEM CONSOL SHALL BE DEFAULT * FOR ALL ERROR MESSAGES. END * * ( !' 24998-18255 2001 S C0122 &%QRT SYS INDEPENDENT LIBRARY             H0101 ASMB,R,L * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAME: PART OF MATH LIBRARY * SOURCE: 24998-18XXX SEE NAM FOR LAST THREE DIGITS * RELOC: PART OF 24998-12001 * PGMR: BG & JTS * * * UTILITY ROUTINE CALL TO SQRT * NAM %QRT,7 24998-1X255 REV.2001 750701 ENT %QRT EXT SQRT,ERR0 %QRT NOP ENTRY/EXIT ISZ %QRT LDB %QRT,I DLD 1,I LOAD PARAMETER INTO A AND B REG JSB SQRT CALL TO SQRT ROUTINE JSB ERR0 ERROR ROUTINE ISZ %QRT JMP %QRT,I RETURN END * *  "( 24999-16044 1752 R 0100 %RECON RTE BOOT UP RECONFIGURATION             H0101  xRECON  24999-16044 REV.1650 761124 @#RECONSEXEC $LIBR$LIBXRMPAR;`dWddt$$   4Z d ,d4t l,";`]$$+&dT,4duT:,7lV,l@,lc ,MDJt>,d},<,F,N:`m@,FFF l>,@ d?…lJ \Kƅ!,*,(F}\L,@,2@lN:`mOm=QT=,?HI?}MtN?d!PDNt!d"PDNt"d%  PDNt%d(`OPDNt(t2d1P,mDNt14Ot4,`Ksd},<,F,R:`m~gp@wpwtwwgq@wqwwwwuwwgs@wswwg@ww|wwg~@w~g@w/@&`\~gz@wzg{@w{g~@w~g@wwg@wg@w/@:`m5@fvcFFv> fV!k 6 .[f6>vA.vfn6vnfo6vofm6vmf:`mB6m@AkNV.{ .}. . f{cFFfA.s cFCfA:`m.VsnߨN6N.??.@vk~kNV.N>.=`UW.Nv6NfC?  #* 24999-16048 1932 R 0100 %JSAVE              H0101 q RPLS @},.SFB .MBT  4JSAVE &s<24999-16048 REV 1932 790913@2JSAVE "<e$.MPY .DIV .DST ..MAP.TAPEEXEC CLRIOIABS LOGLUGETSTEQCOLNAMR QUOTEREIO PARSE LURQ CNUMDIFBRKFSTAT ASCIIFTIMEJVRFY`AU&`B&<`n4! /JSAVE: MAG TAPE LU: _ /JSAVE: DISC CRN[-LU]: ([,LAST TRACK] LU= 0 => END) _/JSAVE: TH<`n!?AT'S NOT A DISC!/JSAVE: THAT'S NOT A MAG TAPE!/JSAVE: CAN'T DO THAT LU! /JSAVE: MAX = 50, MI`C=!mN = 0!<`nF !q/JSAVE: ENTER ANY ADDITIONAL COMMENTS OR " "CR/JSAVE: DEFAULT HEADER IS: /JSAVE: END? _ /J `G&J!SAVE: DONE! `V((! /JSAVE: MAG TAPE FILE: _/JSAVE: EOF FOUND!.`c!/JSAVE: NOT JSAVE FILE/JSAVE: VERIFYING/JSAVE: WAITING FOR LU# `S /JSAVE: CARTRIDGE NOT MOUNTED. -`bi!24999-16048 1932 SOFTWARE SERVICE KIT SYSTEM 1000 /JSAVE: VERIFY ? _<`nV CR `D 4`hQ `Gr&!`BN& `Cn&(<`boO""" 6&,t&+d&.D&+t&-"&/&0d&1T&0,","d&3&0t&2d&0 6&D&2t&4d&3<``/"&t&5d&5D&7t"d&5D&8"d&5D&3t&5D&4,"'"9&0$"? &0&%,"d&: t&9d&9;`^%"FZD&3,"K,"9d&; 4&t d&< T ,"Wd t&"d&=T ,"_d t&#d&>T <`^J"d,"gd&?t& d&@T Z,"od t&(d&AT ,"wd t&&d&B T ,"d t&$d&CT <`b","d&Dt& d&ET ,"" 6&!,"9"&$&-!&d&1T&0Z,"d&3t&#d&#t&d&0;`g"ZD&1,",""&&-!0& "&3&-&&F  $" d t&&"&&&6&Gd&H&G &T&I<`bl"˶,","d&H&G 4&T&J,",""&$&-!G&," $"&K&&&3td&1T,",# d&D&L;`eѻ"t""&&d&1T&',""&&+&!&d&3t&'$#&&1&&10&M# &N,& ,"d&3D&#<`])j#,#d&&D&Od&0D&1t&Pd&1T&"&P,#",#Ud&1T&,#),#0d&D&Qt&Sd&R&Sd&<`dW#/t& #6&&-&!&  #<&3$&-&T  #C d t&"d D&1,#Ld t&(d&:t&)d&1T&"<`bt?#S,#U,%d&"D&1,#[,#`d&"t&"d&3t&)#c6d&3t&U &W&)&U&T&",#s,# ;`c#u&W&3&U&t&"d&1T&(,# &W&&U&t&(,#d&UD&3t&UD&V,#ed&3T&)<`bT&#,#,#d&Xt d&Xt d&Yt #&&" d&XT ,##&&" #&$&- &,#"d&"PD&Z,#;`cK4#,##&&-&!V&,#"#$&&"&Gd&\&GB &.t&[d&]T&[t&Pd&^T&[4&P,#,#;`ftF#$#&&-!:&,#"d&1T&,#,$_d&0D&1,#,$$#&&-!& #&3&-0&F  $$ ;`_х$d t&#d&#t&d&1ZD&#,$ ,%d&#D&,$,$$&$&-!c&,#d&# D&3,$",$_:`c9$"d&3D&t&6$+$&3&&&6 4PdD&1,$3,$:$9&$&-!&,$_d D&_,$A,$H$G&&-;`d$E&!&,$N$N$&&-d&`D&&t&6$U&:6&6d&YD&#t&#d&3 T&#,$_,$"$g&3&"$&a&b&1 <``=K$id&YDtd&1T&(t&Pd&(D&P,$zd&(t$&3$&"&&1d&c t&d&3t&5d&d<`]m$D&5D&et&Sd&5D&8&Sd&3D&5D&et&Sd&X&Sd&5D&3t&5D&:,$d&Yt $6 d&XT <`_`$,$$& $ d&ft d&0D&1,$,$d>&5d&5D&et&Sd&X&Sd&5D&3t&5D&<`f@$Ű,$$&&-&!&$&$&- &$$&&-!q& $$&3&- &h dt&!d&!ZD&i,$d&it&!d&jD&!;`ca$t&6$&$&- &6$$&&& &dt&d t&d&(T&Z,%d&YD&t&d t&k$%&3&"&;`b%&&1d&3D&t&6%&&&0&6%&l,& d&kT,%%,%)d&YDt,%d&t$%3&3&"<`a%0$&&1d&3D&t&6%<&&&&&6%?&l,& dD&3tZD&,%+d&&D&md&&D&md&nD&&t&6:`c%Q%U&:&6d&YD&$t&$d&1T&0,%_,%cd& ,%x,%%i$&&-!& $%o&3&-&o&3d&pT&o;`_%t,%v,%d&Dt& d&3 T&,%,%d&nD&&t&6$%&:&6d&nD&&t&6%&:&6d&qD&&t&6% &:<`dBB%0&6 d&ctd&1T,%d&`D&&t&6%&:&6,%Bd&&D&O%$&&-!&$%&3&&&_ <`c%0%&&-&%$&+&"&&&*d&1 T,%̶,%d&1T&0,%,%d& ,%,%d&`D&&t&6;`^%ڄ%&:&6d&3t&d&1T&,%d&3D&t&d&3D&t&d&$D&1,%,$_d&0ZD&1,%,%"`TT%Z,#"d& ,&d&rD&&t&6&&:0&6& &&-&!&& &Z `D&2 `I&   `B*&.`Ar&1`Au&3`Bc&7$ `M&:D F I L M R V " `F&H?&(!`A&O1`B&Q ! _`A&T `E&V `O&\>d'@ 04`B&m0@`C&pYE@" ASCII ]cCHECK FOR LEGAL ASCII 790720@ ASCII N.ENTR;`^BdRtQdTtSdU,,0dVDQtXdQDW4X,,-dS<`]}_ZDYtXdZPDS4X,*,-d[dVDQtXdQD\4X,;PtQdYDS,CdYtSdTZDS,KdYtSdQ4S`AaR `DT _ `D;Y ` ~ JVRFY #c24999-16163 REV.1932 790810@6uJVRFY !I ##.DIV .DST .ENTR.GOTOEXEC IFBRKCMPWDMOD CNUMO CNUMD <`nX /JSAVE: DISK READ ERROR - STATUS RECORD # /JSAVE: MT RECORD LENGTH ERROR - LE<`n5NGTH RECORD # /JSAVE: MT STATUS ERROR - STATUS RECORD # /JSAVE: C<`ncOMPARE ERROR RECORD # /JSAVE: TRACK # SECTOR # OFFSET /JSAVE: C`TOMPARE GOOD. RECORDS `G `Ga>`;`cadttdZD,,wdD Dt$ dD;`Z ,,d D Dt d D DtSd D DSd D DtSd D Dt;`]0S,d D DtSd ZD DSdT,,wdTP,<`^  ,zdT,,dt,!d T,,dtdD Dtd D;`[RN+,/DtdDtd DtD DZ,?,dtdDtd;`b3FDtdDtST$S6dT,^,dD Dteh$e;`[hdT,o,dDtZD,A,dt,dtdt,dtdt;`],dtdt,d tdtdDt!d  !t tdtd;`jvDt""$  $ $, 7 $?$#, ;`l &S 0[&B, &n 0z  $^,  `E&d`Hb.`AbF`C `Bc` `B{M`AbY`A `B$ `Db@& QUOTE NcQUOTE STgRING SUBROUTINE FOR JSAVE 790524 @rQUOTEEQCOL$ s.ENTR.SFB .MBT ;`dc"d lP  P|! d!HBd!l ";`]$"#5P tFڬ$"tGHTJ,9dGITK,=,@dGDLtG,5PdGDMdG`MA"<"<F,/$==& LCMPWD cWORD COMPARE FOR 21MX & LATER CPU 6/10/77 @CMPWDN.ENTR'`Wq:dl",lP@,_ $ . 24999-16049 2024 R 0100 %JRSTR RESTORE JSAVE TAPES             H0101 0 ,#Cd(/(+,$E,$d'D()t% $K'%$$R'( 'd(0(-0(+(-,$_ `F6r$^,$q $d(( (1`S([ /JRSTR: SAVE FORMAT CAN NOT RESTOR !!.`_u$d$j'( ([0(2$p'( &((,"d(3(-(+ (-,$~,$ $(( (4`Tݘ(n /JRSTR: LSAVE FORMAT CAN NOT RESTOR !! <`a$$'( (n0(5$'( &((," $$((('d( D((t((d((D(6t%d(7%d( D((t((d((D(6t%d(8;`c1"$%$'( &(($( $( 'd(9T Z,$,$մd(:T ,$,"d(#D(t($'(d( <`c,$Ǡ T',$Ͷ,$d(&D(t($$'(,$!$$'( !'$( ( 0'd(D(;t%d %d(D(;<`_$t%d %d'6t($ &( d t(<d( T ,%d t( d(<D't(>d(=D(<(>;`cY% ,% ,%d( T(<Z,%,"ℒ%'( ! 6',$%(&(<(d(( ( t(? d'T(?t(>;`c%, d(@T(?4(>,%4,%; %:$'( ! ',$ղd(A(+,%Kd( D( t(%K( (6(d(% t( :`Y%Od t(Bd(BDD( t(Cd t(Dd'D(Et%d%d(D(Et%d%d(D(Et%d%d(;`^Z%hD(Ft%d%d'D(Ft%d%d'D(Ft%d%d T(C,%~,%%'$( !i(,"<``~%$%( (<(( &(G( d(*Dt(Hd( t(Id( t(Jd( T( ,%,%d( t ,%d(HT,%;`e %,&$d(D(Kt% $%d(D(;t% %(Hd(D(Lt% %&(D%'$( !|(%$'( !($%':`h%$( !(%$'( !(d( T( ,%۰,&%'( &!(%'$( !(%$( ( '6d't(;``1F%% ( d D( ,%,"d( T ,&,&d(9 T ,& ,&$d(Ht d D(H;`]S7&,&,&dD t(Id(ID(Bt(d(DZD(,&$d(ID(Bt d(IDt( d(MD(Ft&- &.&( -&4;`a&0$'( !(d(ID t ,&^ &;6( t(d( D(,&C,&Fd(*t(,"d( D( t(&O( (0(<`_&Q&V(((d(N(T( ,&^,'dt(Od(BDt(>d(ID(BD(>,&m,&d(BD;`b$&p,&vd(IDt(O&~'(<$( (O( ,&8d( T(J,&,&8d( t(Jd(PD(Qt& &0&';`a`;`cadttdZD,,wdD Dt$ dD;`Z ,,d D Dt d D DtSd D DSd D DtSd D Dt;`]0S,d D DtSd ZD DSdT,,wdTP,<`^  ,zdT,,dt,!d T,,dtdD Dtd D;`[RN+,/DtdDtd DtD DZ,?,dtdDtd;`b3FDtdDtST$S6dT,^,dD Dteh$e;`[hdT,o,dDtZD,A,dt,dtdt,dtdt;`],dtdt,d tdtdDt!d  !t tdtd;`jvDt""$  $ $, 7 $?$#, ;`l &S 0[&B, &n 0z  $^,  `E&d`Hb.`AbF`C `Bc` `B{M`AbY`A `B$ `Db@ JDCMC fc UTILITY TO DO A DCMC 790919 @JDCMC q.ENTREXEC $LIBR$LIBXREIO PARSECNUMD$BMONKCVT `A`B`C$~`Ax@`B LU #`I ALREADY OWNS ID #`I ENTER NEW ID? _`AaE!`QgDCMC ERR :`cEcyL2L3NFL0 5OVNNNGZEBtttgtDkthd, 6tt;`k0$l TO UPDATE YOUR CART. LIST DO A ':DC,--$"00,RR & :MC,00'.cDrt$k;``[}$qjl,QT,Ln|L ,ʶ,Wdtd4tk$qjll1`XTu\,Ln|Z,,*LlT,Ll|ZL ,,Wdt;`gl40  l 6pd#4t#$k#$E |E$&EFdG,[,]t)$lq:`cc'&j,dlLl97$lq6jEcDtB| k9Zdl 9`\JEdy,^dz,^d{,^d|,^d},^d~,^d,^d,^dtxel&so& LCMPWD cWORD COMPARE FOR 21MX & LATER CPU 6/10/77 @CMPWDN.ENTR'`Wq:dl",lP@,i$ % 0 24999-16050 1938 R 0100 %SDLS4              H0101 W vSDLS4 c24999-16050 REV.1938 790919 @SSDLS4 <.MPY .DIV .DST .ENTR.DIO..IIO..IAY..DTA.FLOATEXEC CLRIORMPARLURQ CLOSE REIO GETRC CODE CREATOPEN WRITFLOCF READFPOSNTALPHAPURGEPARSE`Ano.`An{9`Aǵ/YE4`h REEL #: `T$P `Be`Anr2`SY20 PART NUMBER TYPE LABEL`Cny6<`bPD;D<d=T,d>td@Dt?dtAd %`["("24999-16050 1938 SOFTWARE SERVICE KIT SYSTEM 1000"/) `FGd `ND(/"/SDLS4: MAG TAPE LU = _");`d]d BC&BB> d@DBtD &4Dd=T., &Ed=t.d=tF`H޶dGtPd &`J|(/"/SDLS4: TASK: _");`a愒 >?P64dHTP,,dITPZ,, dJTP,, *dKTP,:`^J, dLTP,,zdMTPZ,, dNTP,, dOTP,$,dP;``J% TP,+,dQTPtSdRTP4S,8,dT TP,?B, d 0E`L("/SDLS4: INPUT ERROR!");`bcxE,d=T;,M,Td S,дdUT;,[,dd &c9@,d  `F@g&l;,<`n("/SDLS4: END OF TAPE") ("/SDLS4: BREAK AT FILE"I5) ("/SDLS4: ERROR"I4". PLEASE REFER TO LI `Fإ STINGS...") `Hymd uE`LD]("/SDLS4: FILE ERROR"I5)#`Ugu yE,Є dBV&;9,dWtXd `L)q("/SDLS4: LIST FILE: _");`c&, dYtEd2D=,,md> T9, dBV&r;9 d$B=;9d; D=,`PD,F>T=Z,,d +`R+("/SDLS4: TAPE HAS NO LABEL!! ???");`Y݉,zdZD;D3`[UFֶD:tDDd:D>t:D],d. =d_D;DTY,;`Z,d=t`dGtd*Datdbd4DatdcddDatdGd=T2,0;`_!/,Nd@td=TZ,:detd*DftdDHE$0d48d=DE,m,\<`deNVE0$=48d=DE,\,m $cdB>;4P9d;, ,k>TdZ,q,xd `Er ?w`N?("/SDLS4: END OF DIRECTORY")<`Z"w,d9tgd\D;Dt:Dh,`FڶdmD;DtmDo,`M M(1X,I4,": "11A2,1X,27A2):`cʬ脒E4P-d=DE,,md>D`t`,\E&>d=DE, ,m $Epqr<`au 4sds *tDdqDDDett $Etd;ZD=, $,Fd., _,ж, _dutX `FM ,d Z 2`RZ("/SDLS4: ENTER BATCH-FILE NAME: _") `P 2, deT2, :,?d>t.d l B `Fl("ECHO? _") `G_ Bd r Iv`Br(A2);`c8 IdwTv, QΠdxt7 Y$E0*44P8d=DE, _,m f$EP+yd=ZDE, l,m;`^? ldeTy, s,dzTP, z,zdytd{tX, d>tF, *d{tXd t `O9t("/SDLS4: LOAD INTO FILE: _") ;`^6 , d=t3d>t:d:D|t dG Ͷd:D>t:D+, d=T., , $ EP}%`T 4Pyd=DE, ,mdeTy,?, d  `T|("/SDLS4: ENTER STOCK # OR FILE #: _") <`c  >?P4Z}d6, , fdiPT~, ,?ddD|TG, , X dP  ;`_ 4P3d3D>, ,?d3D9, , d9B dD3td3D9PtdD, ;`b H , " dB$V;9d>t:d9D3tD $ dBe;4P9d;D=, ,Fd:D>t:DD;`` , , Jd>t:d>Dt .d$BY;9d; D=, 5,Fd:D>t:D, ' C$dB<`e? @$e;9d;ZD=, J,F QdB=&;9d;D=,F, f $ _dB>;4P9d;D=, f;`]H" e ,Fd7, k, d>t:d:Dt d*D:t& v d:D>t:D, md `Ac `E d:D|t  `B= d>t:`G* d:D>t:D, `E d:Dt  `BK d>t:`H-L d:D>t:D,  `F(6A2,4X,6A2)<`]R dt6d>t:d*D:t td:D|TZ, , d:D>t:D, , d><`] t:d*D:t& td:D|Pt d , , d*D:t td:PD|D<`^ , , Xd:D>t:D, dxt6, _dD|TG, , d=TF, , ;`^ & tdD|Pt d , , F tdD|TtS 6td}D|t `G d S, F, _`NW(9X,"REV CODE DISCREPANCY:");`^ PdD|TG, &, fdD|t  , td}D|Dt 7"Dtd=<`` ; T, FdA  Fd=TF, M, fdD|t  S Ͷd}D|t  Z4 <`cg [ `Ee fEP4y iitd @Dtd=ttt:`G) d:D>t:D4, `FN d:D;Dt:D, `Fl ɶd:D;Dt:Do, `M&m(1X,3A2,": ",8A2,1X,27A2) ;`Z^ ׶d>tgd4t:dgDt d:D;D< d>Dgtgd:D>t:D, dgDt ͠dG;`ZZh d>Dgtgdnt:dgDt d:ZD;D< d>Dgtgd:D>t:ZDo, dgD;`^% t d= deT2Z, , 3d@td*Dft ͶdD d=T, $det -E0;`b )$<48d=ZDE,m, h ;E0$=48d=DE, A,mdeZT2tSdED=S`Jyg KB, UdA 0 U0`Qt(9X"DUPLICATE FILE NAME - - "3A2) ;`aG UdEt2d=T2tSd84S, b, f f&`d=t $ odB=;4P9d;D=, v, ;`bk vZd;D<t& }>Td, ,  $Ede, h >T4, , d=T<`bo , d>t0, h& >TY, , d=T0X, $ Ed=d=t0 >Te;`_o , , d=T, , d>td*D;D2 4d &PM :d :`h' <\ @d t Fd  LBd 2 Rd &P Xd  ^d  d;`hl dd  jBd M2 pd &P vd * |d G d d Bd r`Ba 0 <`n% (/" TASK FUNCTION"/) ("LABEL PRINT TAPE LABEL")("DIRECTORY LIST ALL FILE IDENTIFICA`Vٴ7TION ON TAPE")("REWIND REWIND THE TAPE") <`n3\("N PRINT CURRENT FILE POSITION NUMBER")("LL CHANGE THE LOG DEVICE, LU # WILL<`n( BE ASKED") ("LOAD LOAD A FILE FROM THE TAPE TO DISC") (" NAME & PART # OR FIL<`nE # WILL BE ASKED") ("BATCH GET LOAD COMMANDS FROM A FILE") (" TAPE FORMAT: NAM4`h`R") (" PART # OR FILE #") (" NAMR") `O\M(" .")<`n(" /E TERMINATES THE COMMANDS") ("UPDATE SAME AS BATCH,BUT MUST U<`nI<SE PART #. IT LOADS") (" FILES WITH LATER REV THAN THAT SPECIFIED IN")(" `W)j COMMAND FILE") ("END/EXIT EXIT FROM SDLS4") ;`^6 ,d>t:d:D|tdGd:D>t:D+,  >?P0+ d>t:Zd:D|iT<`])n Z, , d:D|td:D|4d:D|T, , d:D|td:D|;``4h 4od:PD>t:D, d*t P/d/D>, ,?det2$ 9`a( $E0=48d=DE, , dTE, ,mXdEt2 6EXd & `N("PUNCH LU FOR LABEL IS? _")+`\? d dxt8,Є dBV&;9 &B>d &&`I}("/SDLS4: DONE!"/)`H,& )(+`An1`Bn42`C< c`Ao@`AC`LG DILOBAUPREN LLLAPUENEX `DkT?? `G3Y" % `FMa 1FILE  `Eh  1 `Bnn,`Au 3`BGwYE `Efz/E O `Cy+_`Cn `F7 SSRRAADD /`An`HU:,: "GETRC Fc VERSION 2 REV.1938 790919 @GETRC EXEC .ENTRIFBRK<`]IRdD(tGt:dT!,T",)ZT#,4,D,8d/tt t ;`[g"td":dd0d0dD"td1<,dl !,~;`_=dt t I+|;O$'dڔ4>d$3t<d$3t <d?,t?;`\ޓ#ZdD$Dl ,%d ,:d@tdAGdB:t dT,l ;`\?,E<\,,;2,Jd,itDl\,tDD$tCl  ,l ;`\'[ \C,`,[,dd",idZD#D#lDLdDD#L|,%\,xd;`^Tw,iDtCl  ,dTC,,dD$,d",iD! D#lDD<`\DdDDt,%d(tDDZtCl P, ,T9,dD#l",dD#;`\D#lDdDD#L|,%d l Zd!,iD#l ,iD#lL | <`_ץZL) ,id ZD:t@tl< \ ,GtAZ:tBt ,=@Q;`h.@QجtE$Ed ,i%99SSRRAADD2`f   P1ALPHA Qc REV A 750120 @ALPHAN.ENTR;`]SltKtEdEDtLtIdE TK,D,DtFdFDtMtJdPtG;`]xdLM<M ,@ ,3 <G, p4NM4NM,@dOtHdLtIIJ@IJ`I+<<I<J<H,7<F,<E, `Ca N* & 2 24999-16051 2024 R 0100 %RXREF RELO. X'REF.             H0101 [! RXREF #Z24999-16051 REV.2024 800528 9tXd/t@ `9414@W;`\7Z<W `941<X,/dW)tW|Xd=tYWXA<W<X<Y,FWZtY;`\SXZDYAZdQD?tQl[\,idQT7,ul[|dQt7T4,,q<`\Xrod=d9l|d2td^t8l\[Z,dQ,d=d9d8\],<`]l[|lB ,d8A,,L6|6p ,d8AZ,,p6,ptB;`[ Zl7 ,D8p, |Ed7,ܠZL8,A, dl|dD5t8l|d<`bpd)pd  d`l)tt, EMA= MSEG= PL7 ,PTD,K |6;`\ ,TD,K,dFD=lG lFL<6,dFD=lG dED7lFL<dD;`]5ZD8FL<|FdEG<G,/dDD6 ,d8A,A,dED5dElDL6:`^^,/L5|6p ,+d8A,A,dE6D5d8D5D7t8<,{,a: ENT;`a~<= > EXT= d7T4,d8laR<,/d8lba<,/ ****DUP ENT: :`cT(],SKIP IT ****DUP EXT: ,SKIP IT|UdFD@lGtFtED6lUlEd8;`]L4 dEpl[\,l[|dZ,d7,a,Pdxl ),a;`^ END= 6dFlGLNLNLNH ,ڬdGt<GlN,|Ul.G;`^ <G<U,dA PtDD7D=P, ,ZtYdA |)tDZD6,tEZD7 <)D=;`^,d),lLY dDD5,Z<Y,ttYdGtdAtDD8 ,&|W<`^zZtX<W,<X XD8,PD4,D5GlG \F,dY \F,|G,dD;`]gGZD8|WtX<XXD8 P,$L4Z<W,<YdDD5,dTGP,td |)<`^u2PtD\,@DZl <)dZD4TG,2d),tdT.,tZttYd;`]PDYT,r\,X<Y,OtWdtTYP,kPdD lH ,kd.WdD4;``mmTG,Z<Y,O<,/dA<D7<l\PD=,v NOT ENOUGH SP;`bACE TO COMPUTE LEVEL NUMBER t*t+dAtDlV|dDD7<`_tT.t* $Zl-|t)dDD6 ,,|EZL7,t(<)L4,<`^aP(DD,t+d,(l |\\,l-| d(,Ǵ dED5 ,:`^d),dT-lAL4Z  ,dDD5Z,d*,6<d+;`j݁ < ****BACKWARD REFERENCE ****CIRCULAR REFERENCE *  <`^54t7 ,?t)t74lB 0|EL8l7,} ,lZlW |lV;`]WRdEdED7 ,k|DlZ\\,blY|dD ,YdTYdED6;``o ,Ed7,8<)0lVd0 ,llY|t),Q 0 1 ( 249:`m{99-16051 2024 SOFTWARE SERVICE KIT SYSTEM  MODULE MODULE SIZE :`mH(OCTAL)  NAME MODULE IDENT. BPAG MAIN COMM  -----------------------------:`m-------------------------- MODULE LEVEL MODULES WHERE USED ENTRY DEFN-MOD MODULE:`m-S WHERE USED UNRESOLVED EXT MODULES WHERE USED 0?(`HhC_ '0 24999-16052 1752 R 0100 CMM3: MEMORY/DISC ACCESS AND MODIFICATION             H0101  CMM3 Z@OCMM3 <.MPY .DIV .DST .GOTOEXEC CLRIOIOR IAND RMPARREIO PARSEIGET DOIO CNUMD DTRK IPUT XPUT IXGETIFBRKCNUMODISC3DUMMYMAPXX `Fe ID SEG OF `GbS MEM RES PROG `Di9 EXTENT`IBc WORD , VALUE `Mw LU,TRK,SECTR,WORD,VALUE `J  MODIFY OP SYSTEM ?%`[# DISC MOD ! ENTER A /D AT ANY TIME TO EXIT THIS MODE `F. SAY WHAT ?`JTr EQT # DVR `L~Mn NOT FOUND DRT PART `FA INT TABLE `HT] =CMM3 DONE ! "`YS(24999-16052 1752 SOFTWARE SERVICE KIT SYSTEM 1000 `G+&z YES OR NO ? `KmINT TABLE STARTS AT 6.$`Z[ LU = TRK = SECTR = WORD = `G OUT OF RANGE<`nB[ ID,PROGRAM NAME ID,SEGMENT NAME ID,NUMBR = ALL ID'S IN SYSTEM EQ,NUMBR EQ,NUMBR,NUM<`ndBR GIVES EQTS INCLUSIVE LM,ADDRESS,# OF WORDS LM,ADDRESS DR,NUMBR DR,NUMBR,NUMBR GIVE<`nS?S DRT ENTRIES INCLUSIVE IN,NUMBR IN,NUMBR,NUMBR GIVES INT TABLE ENTRIES INCLUSIVE LL,L<`nmIST LU# PM,ADDRESS,NEW VALUE F/,VALUE TO FIND,START ADDRESS,# OF WORDS LI,ENTRY POINT N*`_MAME DL,LU,TRK,SECTR, # OF SECTORS DS,LU,TRK,VALUE TO FIND `T+ TA TA,LU # TA,LU #,TRK #, # OF TRKS.`c DM DISC MOD EX EXIT EN EXIT /E EXIT,`a?= XL,ADDRESS (SYSTEM MAP) XL,ADDRESS,# OF WORDS (SYSTEM MAP)3`g__ XP,ADDRESS,VALUE (SYSTEM MAP) XF,VALUE TO FIND,START ADDRESS,# OF WORDS `VR DP,VALUE TR,START LOCATION,LIST DELIMITER`Kk DI,ENTRY POINT NAME `M? LP,PROG NAME,REL ADDRESS`Bk LE`MS@ PG, PG#,# OF WORDS,OoFSET<`n` INPUT FUNCTION ID LIST ID SEGMENT EQ LIST EQT AND EXTENTS DR LIST DEV REF TABLE LM `G/ LIST MEMORY `PQ7 XL LIST MEMORY (SYSTEM MAP)-`b"k IN LIST INTERUPT TABLE LL CHANGE LIST DEVICE PM PATCH MEMORY`QnG XP PATCH MEMORY (SYSTEM MAP)`N F/ FIND A VALUE IN MEMORY`UX XF FIND A VALUE IN MEMORY (SYSTEM MAP)`K ; LI LIST ENTRY POINT&`\m DI REPORT DISC DICTIONARY ADDRESS OF AN ENTRY POINT `QMZ LE LIST ALL ENTRY POINTS IN SYS*`_ DL LIST DISC SECTOR DM DISC MOD ANY LU DS DISC SEARCH `Lq /E OR EN OR EX TO EXIT`V:G DP DISPLAY INPUT IN OCTAL DECIMAL & ASCII`Hq TR TRACE LIST`S= PG LIST ANY LOCATION IN PHYS MEMORY`O  XT TRACE LIST (SYSTEM MAP) `N!L LP LIST DISC RES PROGRAM *`_| A PK AFTER THE INPUT GIVES A PACKED LISTING OR USE PK, `Qά TA LIST TRACK ASSIGNMENT TABLE `O*( FOR MORE INFO DO A ??,INPUT `V9 TRACK ASSIGNMENT TABLE SYS DISC AUX DISC`C[ RP `IVJ DISC RES ABS %`[=mIDEQDRXLLMINLLPMXPF/XFLIDILEDLDMDSTATRXTDPLP??/EEXENPG<``6#d#tIdJTIZ,dKtIdMDItL$3I(2dOtNdKtd3DPtQ;`YζdJQdRDPtQdJQd?DPtQdJQd1DPtQdJQd4DPtQdSQdTDItV;`dV焒3VN6UdWDItV$KV(Ad3tV(V6dRDXTYZ,d1DP;`f tQdKQdKtZPdZD[T,66$ZUoe$!$fa$ / [ W$ R U<`h1$ lKKK dZDKtZDH,C3$I\,$J3I8,Q3I&]]U40J X_DS;``'JYt^d1DXTKZ,c,dKtZdKD^t^ k^TJ,q,h &t^DBtV $yV;``6 yZTtad8DXtQ ^D:tb bZQatcd6DXtd 6^D@te 4etg<``  gfti &ihdc,,dZPDKtZD`,edKD^t^dRDPTj,<``, ^TJZ,,Ʉ ^DBtV VTJ,,d8DktQdlQd6DktQ;`^kٶdmQd7DktQdnQ,d8DktQ ^DBtV VQd6DktQ 6^D:tV <`b6VQd7DktQ ^D@tV VQ &^todHDotp ^D@tV Vtb bCtq;`a- ^D@tV !Vtb &bDtrdDTrX,1 &/^D9todD Tr,:d6Dotp;`c^:dKTq,CdEDotpds T,J, dtDLtV$RRVK$X3Leu ^opL<`b]6d1DXTKZ,g,,n3I&n\, r6wtv vyPtxd Dx,~dxt d<`^RMZDx,,=dKD,dKtdtZdRDPTj,,dSDZCDvtod3;`batDztQ Z6ڏQd?D{tQd?DzQd?DotV Vtb b| Wt(d(@ ;`_5063D(t(d3DztQ &(Qd?DztQ QfT},d?DztQd?DzD~Q;`a޶d9D{tQd?DzQdtDLtVRVK3L69d@DotV $oVLd9DotV<`c5<V$p$K;6dDtQdKQtad?Dz T4a, ,]dD;`bE"tdBDotV/V$p7$K;6dDtQdKZQ,@,]dtDLtV;`bD$HRVK$N3L9?dDtQdDDDStV $]QVLdZDKtZD ,, ;``Hf&ht l6td4DtQdQx3$Lt4d D,dt 1dDJ,dK;`_tdDDStVd DDStb $VbLd4DtQdQdtDLtV$RVK 3<`^C$Lt4dDDSDtVd DDSDtb $VbL,ɶd?DPtQdSQdJDtad<``öD DStVdJZDV4a,,Dd DDStV $VL, t td4D:`^$,,$3LA\d ZD,dPt dDJ,dKtdDDtod D:`^8DStpdtd3DPtQdKQ $opL,3I&,dMDtL,d?DPtQ;`cWdSQ '$L-$3IzdWDItVd8DXtQ9KVQ6Kd8DXTZ,B,;`cNhBPd?DPTJ,NN& d?DP TS,ZZ  $`L,d?DPtQdS<`]eZQdJD tadD DStVdJDV4a,u,Dd tZdD DStV ~ZPTta;`a4Pd?DPTJZa,,ZTtad?DPPTSa,,, $ZZL<`]6dRDPTjZ,,ɶdRDPtQdKQdKDtdZDKtZDV,{PdRDPTJ;`dڱZ,,h,  Mt tb &bDStdKtZ  DDKtb<``0jdKDtdTZ,,dJtdKDtK$;dKt ,ɴdT;`] Z, , 6dDtQd4DX QtadKDDtdd8DXdatcd3D<`a~ !Dt fte ehtgPd6DXTgZc, 5, ?, dDtQ$ ?3LQdT;`` B, F, d3DDtQ Q6DKt W$ W wh 6 dRDDtQdRDDtd $ eQ<`_B b$ڏdLdRDPTj, n,dRDPtQdKQdKDt,  }3L&1d4DtQd;`` QdRDDB Mted7DtQ $ eQdRDDtQ QtedADtd $ e<`a~ 6؏dd4DtQ$ 3LQ@, dRDDtQd1Dtd &Qd 3$L8, dRDDtQ<`a ¶d?Dtd &Qd 3$L4dTZ, ,ɶdD?tD;,dZDKtZDb;`b7 㶀,dT, ,,hdJt 3$L6,dKtd;Dte K$e; <`a/ 0  $L6dRDPTjZ, ,ɶdKDtdD, ", 'dJtdKD ;`c &t dDKtD, ,$ 53IH ;3I 6=dTDIte$ D3ez8dWDIte M;`bL I$Ke(K6dT(, V,dT(Z, ], dTDIte f$3e7dWDIte o;`c k$Ke(=6d3te z(ed3T, ,dtd3td1DXt ;`b $pdDp, ,Ddt, dTDIte 3e6:dWDIte$ Ke(=d3:`^g 6te (&ed3T, ,dtdtd tdtdDJ, ,=d<`c ΢DXtdADXtdtd;Dte K$e;dJt $&LdJT;`a@A , dTDIte 3$ezdWDIted8DXtQ$ KeQKPd8DXT, <`_ ,d8DXTZ, dJtdRT, ( '6t +DDtdDtQ;`cs( 1dQ 6Ptod?D, D ?te Ded;Dte O$e;d?D, X;``pP T XodJt, dJtZd;Dte hK$e; ZdKtdD T, s, dA<`a) tDtQ zZ6؏QdDtQ $ QdBDtQ 3L&ڏQCdDKtZD;, jdZDKtZ;`a D, ],$ 3LBdJtdDRZtadJD4a, ,= "te "De;`aJ Mt te DeDStpdRT, ,  $3L1dJ T , ն, d t;`^D@ ׄ D todoDp, ,=dDoDStedpDe, dDoDStp & D te ;``G $ epLPdRDPTj, ,d3 T, ,dJT, ,dtDLte<`` $ ReK$ 3L 1dKDpD todDptpdoDp, ,,=dJT Z, 3, Bd t:`^p| 5dDoDStedpZDe, BdDoDStp H$opLdRDPTj, Q,,d?;`^mb SDPtQdSQdKDtad T4a, c, i&LdRDPtQdKQd?DP<`_I q TJ, z ytd?DPTS,  t, WdtdJtdRDPtQdKQ;`a  KKK$KLZ,doDpTEZ, , doDpT6, dKDptpdSDp;`` te etod3tdJDo, dRt &ot o  6MtdStd3D te<`^ Ѷd3DtQ $eQp6dDt d3DDtdKtd?DPtQdKQdDDJ;`^C , , dKD t dDt,  3I&8,dDtadJD4atcdKD <`` 4c, ,=$ odTD, , +dB TtpdpDtdTZpDtdtp;`\QF -d td3DPtQdKQdKtZdtd4DPtQdQ B4Pd;D, JdSD<`^mj ItpdpDote $ SoeLPdRDPTj, \,dRDPtQdKQdDtdZD;tZ;`fA gZD , 6,ɶdKtZdZD[ T,  Z>Q$^kx$$ *$;`i $=&dZDKtZXDH, n$ 3L6 3L09 3L&: 3$LB 3:`m $L7 $3L7D$ 3L: 3L0A 3L&6 3$LC $3LL@$ 3LG5:`mB ㄒ 3L0G 3L&B 3$L7 $3LGA$3L@3LX0E 3L&93:`mA$Lm>$3LZA$3L9%3L09+3L& 713$LB7$3L(C$=3LF;`k=,D3L&7J3$L7P$3LD,W3L01]3L& G,d$3L/1$j3L;`jh&4F,q$3L)4$w3LB,~3L&K13$LP<,$3Lj8,3L$q9:`hc,3L&|5,$3L9,Ʉ3L6D,3$LA,$3L:,3L;`lx&+33$L-1$3L2:,3L043L&43$L4,$3L=@3L;`emF&KG,$3L_A,Ʉ3Lp65,3$L1,d3DtQdQ$ 3LA,<`gr $3L9,3L&?:,$3L:d4DtQdQ$)3L6,03L&k3, `Wq2  @  `BoJ`ApM`BMO= `DsR`CWPK`C[ l`BtQ_`Anf`Aoh `Enj'd`C5sLP@`As`w `Fy'? `CB00`Asq `DxMs12`Asz`IbYE``A LE`B"DI `F5 LI/D`AF ]`B~ `Fπ_`IM? КDOIO rc@8DOIO y$ .DIV .ENTREXEC IABS CNUMDCNUMOIXGETIASCIIGET IFBRK PACK %`[4 WORD LOCATION VALUE(8) VALUE(10) VALUE(AS) `H[E PHYSICAL PAGE `N4 LOCATIONS THROUGH "`Yy <`_uudRxtQdSDRDxTTZ,,dMD2RDxtVdUZV,,dM;`bDRDxtVdWDXtYVYZwE6Od[DRDx TU,Zw6\ut]dT<`[a DQtQdMDRDxZtVdUVt` d_TQ4`,,dUtQdMDRDxtVdMDRDx;``=4DTVd[DatVQVdZDRDxTTZ,d[DatVQ6؂VdbDatV$];`\6ڂVdMDRDxtVdUV,, dMDRDxtVdbDatY&ڂVYdbDatVdcVdd;`cnz PDRDxTR,,J&]t^deDatV!^V$]t^dfDatV-&^V0]<`_c0Pt^dUD^,>dfDatVdfDaDgV&A]t^dLDatVI^V,}M]t^de;`a%ODatVU^0VX]t^dfDatV$a^Vd6]t^dUD^,rdfDatVdfDa<`b,pDgVu]t^dLDatV$}^V$Zwh $Zi,d]PDTt]v,,d[DR;`]gDxtVdjVyutQdQvPt^dUD^,ydkDltVQVdmDltV;``&vVdQvB  nZDU,doDQt^dmDltV^VdMDRDxtVdUV;`]&϶,,dkDltV؀xVvxt^uD^tpdmDltV$pVdMDRDxtVdWDX<`do찒tYVYdqwt^$[^TdMDRDxtVdUV,  $ZwEO$Zw4Ndq<`bwt^[&^TdTt]dQvDTt^ddZDRDxDTtp *^pQ0P0Zw&PPdbDQ0`X2ZtQdQvt^dUD^,=y @i,d]DTt]Db,, `EbL % `DbR`BfW D`CblZ`Af_`Ha PG  `Fj'3@?`Adq@yy dDISC3 Nc@ DISC3 R ~.ENTREXEC IABS CNUMDIASCICNUMOIFBRKDUMMYPACK `T.6 WORD VALUE(8) VALUE(10) VALUE(AS) `Qq ;`aJ6Jd6D7DQt8]M8d9 O,d,vd2t:d;Md=t;`^kPD7DOT;,ud?t<,zd;t:d?t)6 DO YOU WISH A DIRECTORY ?_7`b?##(()60(#((&!k(d(T!k,#,(d( T!k,#׶,$d(t(#$(((( `F)D WHAT LU _ ;`e#߄#(()D0(#((&!k(d( T!k,#,(d(t(#!k(!JZd(D(t(,$„$ `DK@$$((((`L_)J FILE NAMR,:_<`aA$$(()J6(d(t!d(D(t% d(% d(D(t% d(% $ $((!(6d(T!,$),(<``$)d(T,$0,(0d(t(d(t( $<$!((,$d(t(d( D(,$H,$d(;`[h$ID(t% d(D(% d(D(t% d(D(% d(D(¶t% d(D(% Zd(D(t(d(ƠD(;`bP$dt( $k!$Z((,$d(t( $u&((t( ${$((t(d( D(,$,$d(D(t% ;`\$Zd(D(% d(D(t% d(D(% d(D(t% d(D(% d(T(Z,$d(D(t(<`\$d(T(,$d(D(t(Ŷ,$d(D(t% d(D(% d(D(ʶt% d(D(% d(D(t% ;`Z'k$Zd(D(% d(t(d(t!d(D(̶t% d(% d(t(Ͷd(t(d(t(d(t(d(D(t( $;`a$$(((6d(T(,$,(0d( T(,$,%d(t(d(D(t(d( (;`^$t(d((t(d(T(,%,%d(D(t% d(D(t%%$ڥ (d(D(ضt%Bd(D((<`_q%D(%Bd(D(t(%!(((%'((!6(d(D(t%Bd(D((%Bd(ƶD(t%Bd(D(%B<`]%6dO(D(t%Bd(D(%Bd(D(t%B%EB!(d(D(t%Xd(D(%Xd(D(t%XPd(D(%X;`]%Sd(D(t%X%[$ڥX!(d(D(ܶt%pd(D((ٶD(%pd(D(t%pZd(D(%pd(ԶD(t%p%s;`\ V%p$ڥp!(d(D(ܶt&d(D((ٶD(&d(D(t&Zd(D(&d(D(t&d(D(&D(;`_%t%!6(d(D(t&d(D(&d(D(ܶt&d(D(& d(D(t%!(d(:`c^D%D(t&d(D(&%((&!(d(D(t(%(((%((!6(d(D(t($%(((d(<`_8V%ζt(d((D(涊t(d(D(T(Z,%,'jPd(D(T(,%,'d( T(,%,';`ZI%d(tdD(t&d(&dD(tZD(,%d(D(t&d(D(&d(D(t&d(D(<`^2&D(&d(D(t&d(D(D(&d(D(D(t&d(D(t&&$ڦ(d(D((T(:`^&%,&0d(D(t&JZd(D((D(&Jd(D(D( T(,&:,&d(D(D(B (<`^&Ctd(D(t&J$&LJ(d(D((T(,&^d(D(綊t&gd(D((ٶD(&gd(D(D(;`^<&at&gd(D(t&h$&jgh(d(D(t&d(&d(ZD(D((t&z!(d(D(t&d(D(;`\&&d(D((T(,&d(D(t&d(D((D(&ֶd(D(t&d(D(&d(;`^Z&td(D(D(t&֢d(&,&d(td(D(D(( (Dtd( T,&;`]&,&&!6(d(D(t&d(D((D(&ֶd(D(t&d(D(&,&d(D(ͶD(t&&<`_ &$ڦ!(d(D(綊t&d(D(&d(D(D(t&d(߶D(t&&&Ц(d(D((T(,&;`^.&d(D(t'd(D((D('$'((!w(,'jd(D(T Z,','jd(D(D(t'd(<`]0'D(',','jd(D(ͶD(t'd(D( ','(,'jd(D(t(d(D(D(t'd(;`[m'0Z','9d(ZD(D(t(d(˶D(t'd(D(D('d(D(t'ضd(D(D(('d(;`^Ҡ'KD(t'd(D(D( 6('d(D(D!t!d(T(,'jd(D(̶t'd(D(D(<`]'i'd(D(t(D(,%d(t(ζd(D(t('z&((t(d(D(дPt(d(D(,',%,$d(;`d' T(,',( d(t('$ (!!(&((d(D(,',('0 ' ($!(((d(D(;`a't('((&(d(ѴT(,',( d(D( T,'Ķ,'d(D(6(D(t:`^^q'˶d(t(d(D(t(dD(t'$' ((Ѷd(Dtd(D,','d(D(t('(:`^}V'$((d(T(,',( d(td(D(t(D(,'d(D(t(d(D(,(;`a%q(,( ,'( ,(0d(T(,((($(((,(0d(t(d(D(t(#(%(#(d(D(t(`N((d(((0($(!m((6$((((`Lr)V ANY MORE THIS FILE ? _;`b(6(<(()V0((B((&!(d(T!,(I,(ld( T(,(P,(Td(D( ,(bd(D(t(-`Z(X$([((d(D(t((b((d)D(t((i&((d(t(,$(r((( (`L)b ANY MORE THIS TAPE ? _7`ek(r(x(()b0((~((&!(d(T!,(,"Td(D( ()&(((( #`B( `F( /E`B<( !I `F(?&(1`A(`C(2`I/( !! ? _YENO`A(`B͗($ `A (`B(! `A( !`B(`B(`O(@!=@ !  `I( !v0+ `D($  `G( NO FILE !l- `B )! HEADL 6c24999-16053 REV.2024 800509 @HEADL N.ENTR<`_Bd/t0d0D2DT3,,d0D2DT4,,)d5D0t0,) `N d0D2t0D1,d1d1D0`A`/2 `E1  ASCII C@ ASCIIN.ENTR<`_"tBd8t7dD:tAt@t?T;,d@ ,t@|Bd@ ?L<:`^A ?t@Z`D<״AAdAD9tA<7,dB<Ad=ДA4>A0 `F=-$ &ISOL8 -cISOLATE,RIGHT JUSTIFY BITS. 18 JAN 77.@ISOL8N.ENTR;`cK4P, ,t , ,lL?`J_#?I ) 3 24999-16054 1640 A 0100 ET10324 BINARY TAPE              H0101 H@((V69?cwjw?cxjs?ck(K(?cyj( (czj셂CBSH9(sc{jsc|j?cjHscCBs{cjc %?ckpc %c c %9?csc}j?ccp Ʉ@A)cp cɄ@ c^k_? RF))S)+! )&s)3s)cة9+bg (s Acs셂CBӹA;۹A)HU A;S)9@ )3/s{?ckj %?ckp@9dc %c c %?ckvcC %c  %?cU/@cS)c~jc C{ c gq9{C c {C c {C cC ;?;cj?cjHs?cjHss酂v!9օCBS)[)cj %?sS)ccjaɄ)I< *r!z"!#!#:!:"*j$Ʉ*IZ *?(#r8r8:B=b>r9b8r8;B=:9*.%#*:0 bFbG? rdRf*]Rh*be *X2drd*Ljd 0rd*Lbg ?*IbdHVJ9e// ROM FIXIT PROGRAM (ET-10324)INPUT COMMAND ? OP CODE ERROR MEMORIZING !HALT FLAG SET ! HALT FLAG W9CLEAR ! TS MODE ! PASS= ADDRESS=ENTER ADDRESS:ENTER FIND FIELDHI WORD=LO WORD=FIND AT ADDRESS=DA;9TA NOT FOUND !"MR"..MEMORIZE "SH"..HALT AFTER PRINTING FIRST ERROR "CH"..CLEARS THE HALT FLAG "TS"..RUN TROU9BLESHOOT MODE "RU"..RUN TEST "SA"..SET SINGLE STEP ADDRESS "SS"..SINGLE STEP "FF"..SET FIND FIELD "SC"..SC9IAN FOR FIND FIELD "??"..PRINT COMMANDS FAILED AT ADDRESS= DATA READ=GOOD DATA=ixU`kq#MRSASHCHTSRU/SSFFSC?? ' d 0׻))S6 ? K|M   *1 24999-16055 1902 R 0100 %CLASS              H0101 a CLASS cREV 780913 FOR RTE-III/IV @0CLASS p3.MPY .DIV .DST ..MAP.DIO..IIO..IAY..DTA.EXEC CLRIORMPARIXGETGETCLPARSE CODE WHOGT`Ik `Ac,`a`l `CE `Ac<`aCpsv6,dT,,~dt,dD,tdDtdDtt&T:`aAZ,,dDtdDt,6dT-,,d, %`[(/"/CLASS: CLASS TABLE IS AT "K6" WITH"I3" ENTRIES!") `F0d, <`n(/"/CLASS: FOLLOWING COMMANDS ARE ACCEPTED:"/," DISPLAY,N1,N2,LU - DISPLAY STATUS OF CLAS<`nњ0S TABLE FOR",/," CLASS NUMBERS N1 THROUGH N2",/," LIST,LU -<`n=^ LIST CONTENTS OF CLASS TABLE ON LU",/," CLEAR,N - CLEAR OUT PENDING CLASS BUFF<`nERS",/," ON CLASS NUMBER 'N'",/," ?? - HELP"/" END `K - END") `F1d, `Jv(/"/CLASS: TASK: _")<`dIh10 d 6t 1& dT ,,d T ,ݶ,dT :`^,,dT ,,d T ,,dT ,,)dT Z,, `F2ed, `L("/CLASS: INPUT ERROR!");`]W`,dT,d,tdZTtdD4,dtdD,",&d,`W#tdtdDtdDZ,2,;d, :&`\W("/CLASS: ONLY CLASS NUMBERS 'TWEEN 0 AND"I3" PLEASE!") `I:, =dH C`Q|(/,29X,"GET PROG OR BUFFER PRAMS")`NCIHo_0 KdH Q'`]AP(" CLASS POSSIBLE OWNERS SECU #RQ SIZE OPT1 OPT2"/) :`^QWH6dtdt¶dtdtdtdtdDtiTZ,o,`Jo qdH &%y`MJ%(I5,2X," ** AVAILABLE **")<`aqyH6,PtdD,,t,tdtdD˶td;`_dDtD,d  t¶dtDDt6tdDtȀ;`bR&T,,dDϰtѠ T,ΠB, $tdǶDt<`cVE4 $tͶdDt4 $tͶdDt64d<`]DtdDt¢dDtdD,,d¶tdT,,;&`YA}dDt"&E $dH 240 0E`LS2(2X,I3,2X,9A2,K3,4X,3A2);`c\4:H6,dtödDtD6tdD,K,c MdH >\ ;`cWbH6,dDtȄitd۶DtpȶtdDt&wt z`UMzdH > 0ƀ`P5>(2X,I3,2X,9A2,K3,I5,I5,2(2X,K6));`as(H0tɢdD,,dDtȄtd۶DtȶtdD+`ZttƶdDt6t dH N0ƀ`IN(35X,I3,2(2X,K6)) <``k&ʄH6,dDt D,Yd-,,,dDtޢdDtd:`^ZD4,,dDt6tdD,, &tdD,,d5`` 4t$1&dDtȄT, , d, W(0%`[^"W("/CLASS: CLASS"I3 " NOW HAS NO OUTSTANDING BUFFERS!") $`S(,d,tdTZ,3dt 5dH r;`S)r(/,5X,"CLASS ADDRESS CONTENTS"/) .`]R;AH6dtdDtItɆ LdH &X0`J(6X,I3,5X,K6,5X,K6) 6``:X^H4PdD,e,dtʶdDtm6t pdH x0 `D$(34X,K6):`ax~H6dDtD,j6t,^dDtD,C,d, &`Iy("/CLASS: DONE!"/)`Q$,- `Bc`Ci!+`Ag `G1ENEX/E??DILICL`Ad`Ad`Ad `B.  `A`H @ `De;`CK  `Ad7qp WHOGT fc@:WHOGT  3;.ENTRIXGET<`_BWtVdXdYDZDt[dX[dUDZDt[d\[6Vt]d^T]<`^vH,"d_D]t`(`Z,.,2d_DVtV,daD]t`8`dYDZDt[/`V>=dbD]t`C6`[dUDZDt[dcD]t`&N`d4e[`A`U `DuW**`A\* `B`^ `Ea   "GETCL c@'GETCL "$CLAS.ENTR`N\&dZ, ,W+ +3 24999-16163 1902 R 0100 %JVRFY              H0101 ]# JVRFY < JVRFY FROM SSK 24999-16163 REV 1902@NQJVRFY * ).DIV .DST .DIO..IIO. .DTA..GOTO EXEC CLRIORMPARIFBRKCMPWDMOD PRTN :`e3B>dDT ,,dDBt d +0&`\+(/"24999-16163 1902 SOFTWARE SERVICE KIT SYSTEM 1000"/) :`^d T,,6d T,,z`K9>(/" AUXILIARY DISC"/)+`X-zdtdtdt,gdDt& `Ac`Bf`Af`Af`Af`Ab`B   `DSYSTEM`Af`Acu`A?LG`Af `F5@-ENTS-`Af`OILIBRY-GLOBAL-FMP-- `Ac6 `Ac$# KFDISK *c@FDISK La.DIV .ENTRIAND IGET 9`a~Kd#d$Z,d%D&t'&' ( 6) `DdY#`Bj( sPRGTR Cc@)PRGTR ".MPY .DIV .ENTRIOR IAND IGET FDISK;`c0 t td D,,dDt & tdt!T:`^I#,(d"t#T,1,d%Zt$d,7,[d'Dt =6 t&d!Dt ;`_}AD t(d*Dt K t)d+Dt &R td-Dt Y t,,~d#Dt  a<`_`6 t&d.Dt h t(d/Dt o t)d0Dt &v td1Dt } t,d:`c7 T,,Z,d&D(D3B 45t d)DD3 45D t2 ,6;``=v&78d7,,d2B 6D8t9d8t:D9Z:,d,;`a'¶d;Dt 6 t,dT,,,$,67,3DD"tDt, d?Dt  d5D"Dt@'`TmdADt 6 @dD"Dt@Bt  $@`AaZ`Ae `Aa^`Aan`Ca!`Aa%&`Aaw'`Ba* `Ea-`Cbw3`Aa;`Ca=^ `BA e( -5 24999-16178 1814 R 0100 SAMSZ, FIND SAM SIZE              H0101 6 SAMSZ REV II FOR RTE-III/IV 2-24-78 <EXEC $OPSYIFBRKCNUMD$ALC :`^uo tPdg, tt(t6diZTillTgl|l , ,L|:`^u,!,#Ԁ|tt,+,-ԀpDt<`ZL t,9,;ԀT;`i51<,?t,(C&jG0oKsOw$S{dtZ`gl0fhf f4`he  TIME: : : , WORDS, MAX BLK= `C`Ba|-d .4 24999-16197 2024 R 0100 %CDA4 CRASH DUMP ANALYZER             H0101 Ļ CDA4 ,Z24999-16197 REV. 2024 781107@CDA4 <~.DST .GOTO EXEC CLRIOREIO CDA CDASGDRTN PRNT PARSE IWSUB EXSUB QUSUB LMSUBLLSUBTRSUBDPSUBDUSUBMPSUBWBPSUB;`icLLFI/EEXEN??PHDPSYUS-- COMMAND CAN'T BE USED IN --B MAP dt%ⶀtdT!`PAF+,-,5dtdⰒt5dT,>`Pmw16WARNING: DEAD AREA PROCESSED!!;`Z\;>dtdtd tdt"dDtddDtddDtd<`_6UdDtddDtddDth$dDtq4d;`^tPtdD,{,5 6dD T,dDtd dTt<`bQ dT4,,dT Z,,ք4Xdt&5`[7[&dtdDT,,dDᢊtD,dT ,,`O ~CRASH FILE HAS NOT BEEN OPENED;`^:τ6,5dtdtdt dtPdDT,,dPDtD;`^, ,5 dTtZdDT,,FdTtdD;`^Y PT,,FdTtdD T,",FdTtdD<`^&)T,2,FdDtddDtdDDEݤ ,5d<``9GtKtdT,S,5dtdtdDTZ,`,dddD;`kE4g T,m,qq $$$$$$ `E\$ `GU%INTERNAL ERROR;`_%6,5,5 ,5 ,5 ",5 ,5;`]6Gr ",5Ķ ,5",5,56,5d`MHӶDt&,5#`G;CDA4A ! `FT= `FGPKEPLL`AX `F"  `FbCDA4B  JIWSUB c@IWSUB  9.ENTREXEC `Q SAY WHATB ?4`B`J HITSUB c@ITSUB  9.ENTREXEC `R} OUT OF RANGE0&`B`^ TNFSUB /c@#NFSUB 9.ENTREXEC ;`b NOT FOUND  d*t)d)D+t,d)ZD-D ,d)PD*t)D(,%. `Dr"$Ѐ ' `B`u' `Bdl*`B`p-  vEXSUB ?c@EXSUB j.ENTREXEC CDA LURQ CLOSEERR :`cld0D t2 /261d1T ,  6! , #`H&7 =CDA4 DONE ! `KH#)3 704-56`C/ `D`o3 `LMSUB 4c@!LMSUB  .ENTRDOIO ITSUB<``t0d2D0t1d3 ,d0t1d3,t1d3`O D0,$,+$*01.`B`s2 LLSUB |c@!LLSUB >b.ENTREXEC LURQ IFTTYABREGIFBRKIWSUB:`cA2 ]&^^_&€`,X6ڀdadb, ddtf(`Wl#(cfe,ghd^ Tg,3dbTg,:,A `Gv|nWAITING FOR LU`G:@in4j,G `G||uWAITING FOR RN*`[7AGiu0jNkf^$e^lQ4mTb,W,[4`C`] `Ea `D`^i  TRSUB Uc@)TRSUB x.ENTRDOIO IGET IFBRK;``PtKdMtL,dMDKtNTK4N,جDKtK$#K;`] $KdODLtLTLtNdPDQDPTR4N,6dKtKdPDQDtSdO`L=SAKtKET,H,`A`M `DO' XDPSUB )c@nDPSUB ! .MPY .DIV .ENTREXEC IABS OCT CNUMDIASCIINVRSPRNT <`nj22 VALUE(8) VALUE(10) VALUE(AS) VALUE(SYM) ...... ...... .. ................`K\......................;`aS%d,,d ,d ,Ŷ<`aŴd, dZ,dD t〤Ⲁt";`^od!D t&"d,d!D tZd!D DD#d$D t$d%D #`UStt  $ &' 6jd&D't" $("`Hl* + / -  `DAv#`Aak( NDUSUB c@DUSUB  <.ENTRDOIO !`R5BdDDtd&`C`\`BY QUSUB c@&QUSUB f.MPY .DIV .ENTRQT MEM PRNT IFBRK;``cd , ,)dtdDT,,)dDPDD`I@ ,",TdDtPD, `J .10CMD DESCRIPTION ;`a),/6dt44T,:dD T,CdDDDtK<`^DJ&LKdD]tZD,1dDDtdDDt_&`_dDDDtd 0`Y+htdDtd"DtdPDDT,,Y`B `G302 `A0`Bb YBPSUB *c@BPSUB  Ѳ.ENTRCDA IWSUB<`a)d%Zt'd&P',d% ,d(td&,# `C%!d)t`B%ONOF`B`k( MPSUB gc@"MPSUB 4.ENTRCDA CDA2 IWSUBPRNT <``OdMZtOdNZOtQ dPQtSdRS,dM:`^ ,'dTt dR,/dUt dN,7dVt dPZ,?dW`H/>Pt d D,F`OiX15REQUESTED MAP IS NOT IN DUMP`F&7FIXdt `B0MPHSY`APUS`ARDP `D`T )ERR -c@ERR %.ENTREXEC IABS CDA CNUMD;`eoFILE I/O ERROR ------- d( D ,Z d t*d)D+t*0%, $'`Aq% `C`~' `Bn+   ECDA }cBLOCK DATA FOR CDA4 @CDA  BrCDA2 cBLOCK DATA FOR CDA4 @CDA2  jCDASG cBLOCK DATA FOR CDA4 @ CDASG <`nh LU= TRK = SECTR = WORD = OLD(8) = **EXEN/E??LMLLTRDPDU<`nXMPBPIDEQDRINCTF/LIEPTACMMADBWH**ANFI**VE**********`Na .`cbT DOIO Wc@IDOIO $ .DIV .ENTREXEC IABS CNUMDCNUMOIGET IASCIINVRSIFBRK PACK '`]%( WORD LOCATION VALUE(8) VALUE(10) VALUE(AS) VALUE(SYM)`H[V PHYSICAL PAGE `NE LOCATIONS THROUGH 4`heh <`_d5t4d6D5DT7Z,,{d0D5Dtd8Z,,d0;`bD5Dtd9D:t;V62dd7<`[[uǶD4t4d0D5DZtd8tA d@T44A,,d8t4d0D5Dtd0D5D;``3D7d7DBt4붊d;D5DT7Z,d7DBt46؀d6DBt$>;`]<6ځd0D5Dtd8, ,d0D5Dtd6DBt&ځd6DBt'dC' ;`a36>t?dDDBt'(?'&Z+>t?dEDBt34?037>t?d8D?,EdEDBtO;`aW@ZdEDBDFOH>t?dGDBtOP?0OS>t?dHDBt[^$>?[IJdJDKt?<`_ag;0? jL,td>D7t>,,zdd4D7;``^t?dVD5DD7tR ?$R4a$;a3dUD4t4d4Pt?d8D?,!`MԖ! $Lh,td>D7t>DU,,} `Db0 %`I5 U`Af@`H(B PG  `AbK `EM'D@?`AdTS`BbU IGET c@IGET  .MPY .DIV .ENTREXEC CDA CDA2 SGET READFERR `IdP,`LnNEGATIVE ADDRESS IN IGET;`_ 6dTZtD4ٶtdT4tdTZ4,',-;`a,(&*tdӬ 6tdtdTZ,HB ԶDtd;``GJI T,V 6DtdTZ,hdڶDDtd td;`_FGi T,zdDDtdB ԶtdTtdD"4,:`^R,dtdtӶdt,+d "DtdDDt袊dDt;`_xdD,dtd T, $dTZ,,ɠd `NŶtdt,+ 6dDDtdt,+ `Ee `Aa`Aa `Ae `Byp;`Ba(!`Aa)`Bv ىSGET dc@SGET d.MPY .DIV .ENTREXEC CDA READFERR `I&dNP,`LXNEGATIVE ADDRESS IN SGET;`aF OX4P MDRtQdR T, dSDQtQdTQX,.6.,:`^2*MTQdU T,5,=dNtLdNtdRtdL6?dVDQMDRDW `DHHtLdQt,; `DaM `BaR `CeU OCT $c@OCT  69.ENTRCNUMO8`]TB d tRdD!Dt"dD!D4#"dD tD, `A`b`B`b `A#00 *INVRS c@2INVRSN.ENTR;`^Idtt8 @t>t3d9t4t5t6;,Rd5 ,e:l=l<$`P#P|7D?d6ڠ,EL4<7,&dt8d5,5 `Ee9p;`_?$@Y}4Z9P$6Zt6P,5dQ ,+,d5PbDDhd5cd3$5;`]2^d$5,5|l l|<,t,.d:t4t7<d5P,`E5f{L4<7,v<,k<`\sP,5t6\dZd6,5dQd,5d,5,57`c?C|l8\>,5ҋ|8l  Z ;`` | ϶d4T9,lL9l ` ` ܬϠT`LGDDD%:(@`NZtddQdI<`] td!dZl4|# L" LL,l4L#|<##<,`I#L#|# :`h463d!dD8@H ؄(0z8{l@FHFPU[XU\`hpxH@:`m;\a;@b+HL@I=HM TH@a;b+HLI=HM N a< @O} N:`mp TNa<b,NO}NSSTT SW@TTz:`mST TT SW @T T  z  ATA E5@TT@@:`mląÄ݄̈́@t@| $Id@v I^SSSBSCVVVV\*\+:`mV{j{kZ[ւփ~>@gPg׌ ׌ Ñ‘ƔkŔǕ ʤCDˤkˤl:`m=سس ٴ ȺȺST#$/5ZZ\&e0fP ghGG:`mjZ[⋂ꋃBC̹֓֔3ZZ:`mܸzݸ}́}S>TS==} Yv] *짧*{b *Y*à:`m hH鰿鰿qxŀ[Tb H FW 'K 2 읟`OgT Y H z c "FNDET c@9FNDET E.FSB .ENTRFLOATREADF<`c:dt$Z,,ӶdtdDtdDD<`]rtdDDtdDD tdDD4tdDDT;`]<Z,,߶dDtD,dDtZD,d ,ڶЬdd#`OݶdDDDdZDD`Ba`Aa3`A3`Be=`Aa;`Aa@ `E`  PACK4 c@PACK IASCI|DUMMYtMAPXX$LIBR$LIBX.ENTR.ENTP$IDEXIGET <`_tDf,df,t,tdlZ|m6tLh|c<`]t(|qditpljm<m<p,#d,/-h,0|pB|$6pmc<<c<<,';`_:K<PLq4kdT GЬBtSTTdeDgU Ӷ<S,KG|bll5!;`fl[ߠ$d<lbU 0 *@rdrst6zzt;`btj|zdZ Lz{ |pD,dd@ld_;`]BZdDdtdt| "Z|dT,dtpdtqdq;`]N<q<p,dtdtdɄTDn ځoЬd `F2,x `DaE ARTNS )c ASSEMBLER ROUTINES FOR CDA4+@ z.XLA .XLB .MWF %JFTIMSCDA3 PRNT JMP JMPX JRETN&DRTN CLAEXEC IGET .ENTRCDA ;`_qZttT, ,t|4Zl @l<t$td$;`b;hd$<ttd  @tB6@A<@<A<B,3d@@%:`cAZ<C<CdCC 0AMPM4StS ,X|Rdl4MHd;`]dZlPDL,jlOddJ|tdDItԶlLKdQZ LN LL`@ :`cgt` Zt΢l L䈀PDQDD  LՈ6l|d$`T;R<R<,S  D@4 0 : :`mI]dn12:01 PM MON., 29 DEC., 1975FRI.SAT.SUN.MON.TUE.WED.THU.MA;`iUR.APR.MAY JUNEJULYAUG.SEPTOCT.NOV.DEC.JAN.FEB.<D HtD @-`ZDtlZ|(d( QTAB c@uQT :`m$xx$$dOn$n!PB$$7id$*[$$q;x:`m?-$].0$9CKY11ID LIST ID SEGMENT 13EQ LIST EQT AND EXTENTS12DR LIST DEV REF TAB:`mZLE09LM LIST MEMORY 13IN LIST INTERRUPT TABLE17TA LIST TRACK ASSIGNMENT TABLE 08TR TRAC:`mE LIST29DP DISPLAY INPUT IN OCTAL, DECIMAL & ASCII (& DO ARITH)12LL CHANGE LIST DEVICE14:`mF/ FIND A VALUE IN MEMOpRY11LI LIST ENTRY POINT17FI SPECIFY CRASHED SYSTEM FILE 16CM CO:`m_MPARE CRASH TO SNAPSHOT 20BP SET BASE PAGE SUBSTITUTION ON/OFF 24CT COMPARE PARTICULAR W:`mLORDS OF TABLES TO SNAP08MP SELECT MAP13/E (OR EN OR EX) EXIT 11** ANNOTATE LISTING18PK:`mx; PACKED OPTION (NOT A COMMAND) 18?? HELP FEATURE - TRY ??,COMMAND 12WH RUN WHZAT ON CRA:`mKhSH09ID,PROGRAM NAME 09ID,SEGMENT NAME 16ID,NUMBER = ALL ID'S IN SYSTEM04EQ,NUM18EQ,NUM,N:`m UM GIVES INCLUSIVE EQT'S 10LM,ADDR,# OF WORDS05LM,ADDR 19LM,ADDR,-ADDR GIVES INCLUSIVE:`m ADDRS04DR,NUM18DR,NUM,NUM GIVES INCLUSIVE DRT'S 04IN,NUM19IN,NUM,NUM GIVES INCLUSIV:`m;E INT ENTS07LL,LIST LU #25F/,VALUE TO FIND,START ADDRESS,# WORDS TO SEARCH19F/,VALUE,S:`m&LTARTING ADDR,-ENDING ADDR 16LI,ENTRY POINT NAME,# OF WORDS02TA05TA,LU # 13TA,LU #,TRK :`m:I#,# OF TRKS 04/E OR 04EX OR 11EN -- ALL EXIT CDA4 19DP,VALUE,OP,VALUE OP IS +,-,*, OR:`mYv /33TR,START ADDR,LIST DELIMITER [,OFFSET [,MAX # LINKS TO FOLLOW]] 05FI,NAMR 20CM,A:`miDDR,-ADDR COMPARE BETWEEN LIMITS 09CM,ADDR,# WORDS 14BP,XX XX IS 'ON' OR 'OFF'18CT :`m_ COMPARE ALL TABLES 17CT,XX COMPARE TABLE XX 19CT,?? PRINT LIS:`ml;T OF TABLES 23CT,XX,ENTRY # COMPARE SINGLE ENTRY OF TABLE20MP,XX XX IS 'PH', 'DP', 'SY:`m\*', OR 'US'18**,TEXT TREATED AS COMMENT 21--PK,... GIVES -- IN PACKED FORM:`mWAT20??,-- DESCRIBES -- IN DETAIL 09DU DUMP SYSTEM 12AN ANALYSIS OF SYSTEM:`m012MA DUMP THE FOUR MAPS16EP EJECT PAGE IF LINE PRINTER11DB ENTER DEBUG MODE04WH"`Yt,AL 04WH,SM 04WH,PA 13VEC VERIFY THE ID TABLE  1CDA4A c24999-16197 REV.2024@CDA4A <5.GOTOEXEC CLRIOCDA CDASGINIT PRNT IDSUBEQSUBDRSUB INSUB CTSUB FSSUB LISUB TASUBCMSUBMASUBANSUBJMP `A`A:`h=dT Z, ,  ,3 3333$33333$3337@$IPX]f$3qz3`Ks($333$33333 3`H/08INTERNAL ERROR;`]36,6?   ",H  ", O  ",<`]sP W  ", \  , e   ", p h  "<`]Rm ,6y   ",~  , (, h   `DD ", `E05NOT YET `KZ  OCMSUB #c@ CMSUB J! .MPY .DIV .ENTREXEC CDA PRNT SGET IGET OCT IFBRK <`bzHBHIHtdI,XItH HdHtdD `Dupj,n,r`NC14NEGATIVE ADDRESSES ILLEGAL;`[nqJHtdtdtdDtddDtD,xdtdDt;`aӍt dDt  T ,,dDt&t d 6D Dt$ <`^!dtdDtZD ,d T,,dtdDtt d DD;`dȰt ̶dDtD ,0'&dDt'0 #`P;k6tdD,JdDtD,tJ`AaH`BaI `Dq `H# )$%02 JJ IDSUB c@IDSUB 3.DIV .ENTREXEC IGET DOIO FNDETNFSUBCNUMD `FfC ID SEG OF :`mg EXTENT$IDEX VIRGIN ID SEGS B-<`^6dVtUdXtWdVtY?[DXtZd\DXD- T],K,d]t^d]DZtZSZTV;``TZ,Y,EdODXD-t=&`ZDat_&e_=tcdbDXD-tdpZDetfu<`_LYt4 fdcthdgDXD-tiZDjtkkl4mPih,,d^D]t^;``D`,Md]DZtZdSDXD0 Tn,3ZTVZ,,ۄZDat_<`[X4_TV,,dbDot=dp=dgDot=dq=dPDot=dr=dVtW,dbDo;`aΰt=ZDat__=dgDot=6ZDet_6_=dPDot=ZDjt__;`a1 ﰚ=ZtsdmDstt6ZDjt_6_vtu6ZDjt_ 6_xtwdxTw;`_9,ZDTtsdxTwtcdVTYc,#,dX TW,*,Yd]TW;`_Ϋ/,1,Udst^dS DsT^tc<^TxZc,C,LF^TV,L,Yd^D]<`cINt^Dt,3d]tWd]DUtU,dy1t_$aS_]$gz1{mst160dxTw;`cRqtcd]Tu4c,z,&}ZD|t_&_TV,,$ }/~dVT}<`b]&,,3dST~,& 2dST~,,&ZD|t_&_ts&t_ds<`d B D_tfftsz1& QdzDst_s_16Ѐ0d\DXD- T],ڠ,;`_Vڶ¬3dXtW4 ZTVtc dVTUc,3dVTUZ,,0dy1t_ S;`f&_]U0z1&TdxTwtc ZPTVc,z1&PdVTY,%;`bQ"%z1$0P(ZTVZ,.3dVtUdo]tY,#d}t_dgDXD.t=>_0=Dz`MNA$ڀ2.R,dODXD-tKM&K23 `FbO   `AbV`AbX`CfS[`Cc` `Abe `Abg`Abj `G\l '`Abv `Edx`B I33 EQSUB c@EQSUB G .MPY .DIV .ENTREXEC IGET CNUMDDOIO IWSUB`JS EQT # DVR <`b  &t6t t Pt D,'dt D,-,<`]-d ,4dtdtdPDDT,@dDDtödDD tM;`bJNMdƶDttdDD tdDt\   0 ;`]l dDD ttu tdƴZDD TZ,dƶDD tdDD D;`adDtdDD dt0ŀ&dDt6dD`JtD,6`Aa `Ad`Ad`A``C'`I9? `Cr DRSUB c@DRSUB U{.ENTREXEC IGET DOIO ;`d7 DRT PART 6qtpstrtttudoDvtxdwx$y o<`]$Dr,+drtuDz,3d{ttdz,;dttudtDpD|t}duDp<`a`yAD|t~I}$~ doDvtxdxd t}V}0{\y &odtDpD|Drt}du`KybDpD|Drt~$l}~  `A`o`Ad\q`Ad_s`Bv 1 `D`y`C 2  INSUB mc@INSUB U{.ENTREXEC IGET DOIO `;`hI INT TABLE INT TABLE STARTS AT 6.B_t^& at`tbd],);`^m (,U/c&dD`,6d`tbde ,>tbD^DgtfdbD^Dgth)`VPhFdcDiDtkdjkT$fh[c4l`A`]`AdL_`AdOa`C`c`A`g`B`i`A`l FSSUB ic@FSSUB m*.ENTRIGET DOIO NFSUBITSUB<`aM taDctbdd,,ZddZ, tbda;``M!te%eZ,+,,,E2ee&ڀd`DcDTg,< d`DcDthdf7`](AhdfdePDfteDb,"d`DcD Td,YY ] `A```B`c`Bf'  LISUB c@!LISUB  .DIV .ENTR.GOTOEXEC FNDETDOIO CNUMDCNUMONFSUB `D4 ABS `C RP <`eK DISC RES6dttD,)dt0$dT:`c%2Z,7,??J${dDDtI$$P dDDtdd<`_^Udd tdDDtde6ڀddtdDDtop&odDDtx;`etzx6dDt$جdDt$$d%`UtdDDt$  `Da `A``A``Lt   TASUB c@)TASUB 4-.ENTREXEC IGET DOIO IWSUB<`j AUX DISC SYS DISC TRACK ASSIGNMENT TABLE0%& dt<5`a)* D,1dtDZtd4,<,?"tD"Dt&Jt;`aiKNDDtd,X,^$d ,e,j6t<`_ldD,r,dDDt뢊dD,dDDt&t$d;``zPDDT,d ,dT,dt0<`^K$dDtd越DtdD,,dZ,,ӶdDD(`UcɴPtdD,dDDt섒6݀ `Da7 `Ba+`Bi`Bd`B' ANSUB c@ANSUB  $ .MPY .DIV .ENTREXEC LISUBFNDETNFSUBDOIO IGET TRSUB CNUMD <`nU$OP $LIST $UNPE $PVCN $CIC $POWR $WORK $LSTM $PETB $DMS $CIC0 +13BADDRESS FOR CURR<`nFENT EQT ENTRY CHAN--CURRENT DMA CHANNEL NUMBERRQP1--CURRENT EXEC REQUEST NUMBER XEQT--ID SEG,`a,tMENT ADDR OF CURRENT PROGRAMXLINK--ID SEGMENT ADDR OF LAST PROGRAM<`n*SKEDD--SCHEDULE LISTSUSP2--GENERAL WAIT LISTSUSP3--MEMORY SUSPEND LISTSUSP4--DISC SUSPEND LI`AfST`QJEQT # DEVICE SUSPEND LIST !`X~$CLAS TABLE $RNTB TABLE $MATA TABLE $MNP $ZZZZ `H.$ +1+2+3+4 `Ea `DpN `Eaq `Dpj`N CURRENT OCCUPANT = ;`d]6dtdt6dDt$ dDt', ;``[&$'6Ё dDD T,6Ь dDtD,dtdDtDI$D<`aF$ځdTZ,P,}dT,]dDt[$][ dTZ,d,dD ;`^gDtdtdDtdDDtdDdt$dD;``/t&ځdDDtdDDt6ЁdDD T, d;`_PDtD,sdDtD,?dDt$ځdTZ,,}d;`akRĠ T,жdDt&Ё΁ dT,,dt&dDt愀;`ae$ځdDtdDt$dDDTZ, dt$;`b >0&ځdDDT, ddDDtXdX*;`\Fv(&ځdDDT,4 ddDDtXdXdtdtdDD;`_TDtdt$MdDtXdDDtYZ&ڂXYdDtbdDtcf b;``c$ڂcdDDT,p dDtD,@dtdDt~~$;`_אdT,,}dT,dDt dT,,dt:`cڠ$dDt$ځdDtDt&ځdDDT<`b3Ŷ,Ǭ dDtXD,y$6dT,,}dTX,$ d;`d T,, 6t $d T,,}dT,  ;`b dT,,dt  0#t'DDtdDt;``S-36ЁdDD T,=ج dDt&CT,I,YdDtd<`\~MdDtddDtd¶,dDtdDtb6Dtg6d;`_diDtdDtqDtÄvudDtdDtDtÄ :`^U,$dPDtD,*dtdtZdDDtdt$dD;`aEtdDDt6؃dDt $&ځdDDT,Ƭ d;`b4ǴPDtD,tȄtdtdDt $dt0;`bnH$ $6ЁdDD T,ڬ dDtdPDtD,;`bT- $d T,,}dT,  6 dT,',vdt/;`c-&5$;$&>tdD,E,v&HtdDDtdd:`^PZD,U,vdDtdDta&ځdDDT,k dDD:`^]ntdt6t,OdDDtd dtdDDt 0 `C& `JeO  `Ad `G'`Ad`Ad`B$ `Ft" `C$L`Bi `EV~ `Dl`Ah `Dm   MASUB c@"MASUB M.MPY .ENTR.GOTOEXEC CDA READFERR PACK :`c MAP6 &dtdt$.>NdDtgdg;`Yz#dDtgdgdDtgdg,SdDtgdgdDtgdgdDtgd;`ZV<g,SdDtgdgdDtgdgdDtgdg,SdDtgdgY ;`` Vd6DtdtdDtgi$g&odDtdDt`KpvD,`dDtD,`Cao%`Aa)`OESYSTEMUSER PORT A B`B` `Ce0 ԸINIT c@INIT ( ].ENTR.STOP EXEC CDA ABREGNAMR LOGLUIFTTYOPEN ;`[_((dt dt dt dt dt dt dt dt dt dt |dt G4`a8C$ $KdtS 0Y &\t dD t 6c t `S-CDA4 THE CRASH DUMP ANALYZER 01/01/80&`V?dj 0p &dDT,z,`O3BAD ENTRY POINT SNAPSHOT FILE ;``z 6,dDtdDt 4PdD ,,zdT  `Bn,,`Tп)ENTRY POINT SNAPSHOT FILE IS NOT TYPE 1 )`X6 )6Bd $ dDT,,`L=BAD SYSTEM SNAPSHOT FILE `F% = "`Y.IFORMAT: RU, entry point snapshot, system snapshot <`a& I6Zd dDtdDt6 , &΀dD ,,dT  `Bn۴,,`Q8bSYSTEM SNAPSHOT FILE IS NOT TYPE 1`J݄ b6Zd dt "`YsPLEASE SPECIFY THE CRASH FILE WITH THE FI COMMAND `G s4( `Ea`Og (( CTSUB c@CTSUB !.ENTRMEM CT PRNT CTPRC<``c]Bdq, dqdrZ,,/dptsdsDv Tq,ds;`^z7 DvDpDwt'('dsDutsDt,dptsdsDv Tq,:,^dsDvDx;``>Dw,F,idqZ,M,WQsTqZ,WdsDutsDt,1`G^dq,e`Nq'z14TABLE REQUESTED NOT FOUND `Jehz$msty`Cp?? `Et CTPRC c@dCTPRC 0.MPY .DIV .ENTREXEC CDA MEM CT CTPR JMP PRNT IGET SGET CNUMD OCT IFBRK <`b'11 ENTRY NUMBER ------6dStTdUtQdV,dVtTdVt dWDXt:`^dWTZ,,KdtYdUDt[dSDX6[DtZdVZ,,6`ZTжdUt[dSDX[DtYdYtZDt\dV\,,`N)c~14ENTRY NUMBER OUT OF RANGE <`\~dQdSDXt]dYt^dVt_daZDXt`dVtbdUD]t[dSD`Df<`^FktedSD`t`dVPtgdVDe,,)dbD^DgtcctidbD^Dgtj"jTi;`]/$,)dSt_deDetedgDStgDh, dbDdtbD[,dVT_,A,A;`aDXAdVTT,PDXDSDftOPOdYD^  ]DStcdkDlt` a&c`;`\b&dgmdVtTdaDXt`dVtbdUD]tcdStgdgDotdpdgDStg;`[~DR,udSD`DftedSD`t`drtqdVtgdgDbtid]ZDi,,dbD^;`_otDgtiitjdsgDqDot j4PdVDe,,ds6gDqDUDotߠdt<`_>dbD^DgtiitjdbD^Dgtu4uTj,dbD^Dgtiitjds<`_D6gDqDvDot߄ jdeDetedwTg,dktqdgDStgDh, xTV;``)Z,,MdbD^ti &idbD^DytidzDot  $ i  4a {d|Dot;`c a 0{mdyZDg,%,:dzDot, .4a ,{d}Dot5 7a 5{:/`XU{96mdb DdtbDc,sd^D]t^DZl] ,dVtQPm,`Bc%R `Dc%UP;`Aba`Abd`Af?`Abh `F׼k 02 `Cr *`BcvH `Ecy%$Im 'CTAB c@2jMEM CT CTPR FIGET FNDETJRETNCDA :`mc ![}`V$5$- m>J$12CM COMMUNICATIONS AREA:`m[-08MA $MATA TABLE09KB KEYWORD BLOCK12TR TRACK MAP TABLE #1 12T2 TRACK MAP TABLE #2 10EQ EQU:`m{ZIPMENT TABLE13DR DRIVER MAPPING TABLE 16MP MEMORY PROTECT FENCE TABLE :`c `dtdt,Z$MATA tX$MNP t&t,&tt$P<;`cP,dDt,$TB31 tdt, $TB32 ttBt,6t<`d4Ͳt,$DVMP tt,$MPFT ttdt,B6d#`VeDtd  2iCDA4B ic24999-16197 REV.2024@CDA4B $ Q.GOTOEXEC CLRIOCDA CDASGPRNT DB WHZITFISUB VESUB JMP `A`A7`iPI)))))$)))))$)))))$)))))$))))-$28)?)$D)))) )`HQ07INTERNAL ERROR`O-),Q,H61 ,H67,H`P"YBE OF GOOD CHEER SAM IS COMING! *`Y8>OY6P,H Cܶ,H H K$NN FISUB Zc@FISUB X<P.MPY .DIV .ENTREXEC CDA CDA2 CDA3 CLOSENAMR OPEN READFPRNT FNDET IGET TMVAL JFTIMCNUMDOCT ERR `HgJ 24TIME OF CRASH <`nM $08REV CODE......21...... PAGES OF DRIVER PARTITIONS DUMPED21DEAD SPO*T IS BETWEEN ...... AND;`eR ......Vd T ,dd dt dtn$€VWt$VWdD`GwT,~,`IJINVALID FILE NAME 4`\~ 6XdDtdDt 4PdD ,,`H6CANNOT OPEN FILE`N0 6XdT ,,`LCRASH FILE IS NOT TYPE 1,`Xs# 6Xdt 6  &dT ,,`PVh16FILE TOO SMALL - MAPS MISSING ;`\OݬXdt dt dt dt dt dt dt dt'dt'   `H׳6dT,,`J10CRASH TIME UNKNOWN<``Z-,$dDt   dDt dDt   7dDt 4t;`cd 6Dt7dDt d DD dDt ! &$  +`K'  d T,2,6`Iׯ09REV CODE UNKNOWN9`c25,D &9tdDt@A@D$ G4 Tt NTZ4,U,e`I̪09STANDALONE DUMP 5`^bCUXdt' ]t' &at'dt', l  dTZ,s,`P 16DUMP TYPE CANNOT BE DETERMINED`L sv dt'dt'dt'dt',`Hn~08GENNED IN DUMP4`\rdt'dt'dDt t' &  6dT,,`He!08$MRMP MISSING ;`_q!dt'X t t'dD',dt'dD',dt'd;``SD'tdDt„&,dDt̆'dDt'4Pd'D',9`^BڄAdt'dD'Dt  dt dT ,,dt' `Wv)23DRIVER PTTNS, SYSTEM AND USER MAPS SUPRESSED;`_Dr)XdD'Dt  $dt dtdDtd';`[?D,,$dDtddDt,9dDtdDPdD,9d;`^2DtdDDdT,@,ZdDtK dt dT `FEP,T,Zdt'`P@16SYSTEM AND USER MAPS SUPRESSED;`_VY@XdPDtD,dDt6l &dt d T ,u,{ `Bdudt'`JP10USER MAP SUPRESSED`GwzPXdt'X`Hc@  `Ff  `D$TIME `A `K)m7 $DATC #:`TP0\DUMP  $MRMP  + @ `B   ;`Bc@!XX DB c92067-16??? REV.GAA- 790313 @DB ;EXEC IFBRK$LIBX$LIBRLOGLUIGET FNDET:`m2%HMI=@HLb+@a;H@N O} @ N b,:`m=_ @a< N TTSST TST T@T @T T T:`m TT SWSW  z z  HM:`m)I=HLb+a;H@ NO}Nb,:`mpa<N tT@@T:`mx@@IdI^$  |@v@SSSBSCVVVV:`m@Z[ւփ~> ׌ ב‘Ĕ dzسش :`mmٴ #$5\*\+{j{kT#ÔƤCDʤkˤl˺:`mFȺST/g@gPZZ\&efP0g h:`mGGZ[ꋂ⋃ԷBC:`mG̀3ZZzܸ}Ձ}֓֔3`g!S>S==}T$mo$$[:`mR$s$Cg$gGg$ggg$K$ggI$gggg$g8y START DBUG<`_7R //P|<\,׶4t<t tlx!,;`_.@,?,dPtdtP5ttZttdttttt;`Zdtdtttttttdttt@ttttl|tWt;`ZIG׶tT,alTֶ,*lT,*l⢊LDludTl Td T ,|D, ;`e#D,3O, ~6$<ZDl ",0D,3<<`]%Dl\<L U,<<㢀  HZdD,ն$ |ad 8P,.D,g<`^53 lL T,Ml ,EZhL\,I ,=ج d,htdl<`\{bQ H|l ZL H|OT<l|d,dJ,hd|dadad~T,,4;`^ tmd,d}`l dݢl ,g,4OdaZdl a<,d<`](VZt,idt,D,dt,iDtt,id}, |P<,t<`^,#D,4tܶdl\D|L ,d,Ǵ dh,ǴZ$,ed;`^$ $Dt Z|l d}t}Аgftt<,hDP,gD,g|,|;`Z;d,d,d,dtl td},4,4l,l,d ,|l;`[,l,l, |l|ڢl d}l ,#l|,"l d}t~<`]ZZd~t~al|d~t~tf d~5Dd ~ ,22~t} ,<`\26,Z,,Z/ M dBadaadad`adadԢtQtP<`^kRdP <Q,Qclb+ ,=S |||Tض,T,T,;`\=pZTA,iT,T@,DZdDdOdTd<,sZdl<dd <`] Fd, dZ<d@t#d@ad,^Z dada<dada;`]L01#  |||T,TAZ,T |HT T,΢DD5`ZOdT׶ڬ<,dlH ,l<+- ,2l|~ `EK `C ]B9`] hC,<`d  (t Z| l ,l !d l <`e  END OF DEBUG MODE Z//tQ|P PlQ ڶT@!alQ<P<Q;`]\1,%dBa,etQlF\E6L\TQ,A Z,9L<66&dtWdPXd ,g;`\[Nt`dt,dW,^,dk,d$,d<,Rk,,:`^djڬfl|lP,}<kZd5D,Dt}Z,pD<kD<kkI`Lda,gD# dadBa,gD;`^rda tdD,d ph,L ,df<d;`]ht,t],җ[dDZ,cLd]LddD#D"LӢd|<`\H!,d]"l\~,dtdT$, <x L#L"T, <ⶀ<,;`_ <T,Z,dC,dZDP,DP,,tX  t$  <`a"' PdTZ<dAP|@ f@8t|adtt#l\a%;`^`.D#D"Q<<%Da,rt`T,IdD#Z,I$D#t#tdD;`[L,rtdaT,fdt#袊,r,xP$,rTx,tT,tTϴ,td;`\sgtdtPt \t<,+dta,fT,T#,T),T,<`^a/,D,rdt,fdt$td,d, ,ttdl;`[Zd,d6ad`ad%d<L ,l| |l#|\,<`]Nd,d_l\daldT,x#dd6aZdatPC<`\6ٴP,t`ҢDl+dadd,H|d6tdl$|;`\K6,l+dd5t,6 dadadadada <`\;Ztadadadl+dl+l+dl\a#tU<`]"-|W|V |lU| dt6DV DW<,7\,B,3lW\DDXDTDTY<`b-JdTdDTZd6al \U+,1[] +IڴPtl5L!P߰<;`all\tl\tla"w,dtt\$t¬tt`O$d׶l|:`m#HH؄z{lFFU[U\ ?A\A"`Y12$3$# 2 /+WHZIT c 92067-16??? REV .GAGA 790316 @EWHZIT#>EXEC TMVAL.MWF .XLA .XLB .ENTRFNDET;`j$MATA $MNP $TIME $RNTB $CLAS $d dt.dt2<`bP*dt3$!d.DYt.<2<,,tXtt ttt ;`[LtddlT^*"teT,dT,dT,d Dt d ,d,ft d;``2gl/T*tft dDtBtCdPDftg,D] @ , ,DX :`^,dgl ,E DP,<f,p,lgL ,L  ,d ,;`[H,D@Dlg|tg,l \X,dtg,l^bth;`^dtg,Zl \X`t l  ,|gTX< T,ڈTdBtC,tfT <`]޶,ldXt ,pDC,鈀 Td01ZdgFt !l \X,t ,dgB;`eZ<BdDTB,\g,<ALSMPA** BLOCK ** **1`e "*********** DEAD LOCK **2 *** SEE ABOVE FOR REPORT ON E;`bEZD^^TY,R,l`,,d le\,, ? `Dbg:`mW i**********************************************************************;`]Wy |l]T,d-[,latpc ,lV,dH<`^p4 X,ZdHl d14 ddHڴZdgFt l]t<`^xl7dTlHl5`6l[жllHl3`dh, Ztd;`adhdhTX,8TY,dH,Q . 0 -- 2AA4BB6EEt,d,6^Dt+;`a?Z,JTg,^,J,A<,d,T,O,:dS[,Q T, EXEC Y( [[ ]])dS<`^\`4ZXd,dXl+LtWdZڶdtCdt<C,vd\:`^~X,QdS tT,ŶT,T,8,8,JcD,;`` ^tZC,dtFl^Ȣ,Qtd, BL,EQTd[d,Q:`c'S QUEUE RESOURCEd,CLASS # dV,Q LU/EQ DN dVlXZt,;`` DcDЀcD@t,6^Dt+,^t+dD Z^t,dH,^RN ;``M ,LKPRG= tActBctCBFTA,<B<C, ddAô',QLULK 0d;`^dCC',QddDAڀT,8D@ZDF'd<Z'=;`b=GLOBL ECL Z FtIdDdI,QZl`,W,j d6D,c!<`\Bq_d6t,WtƴddgD¶o!*ddtBdDt+t,+<,;`\A{,d6D,!dBtdSd,<+d,T,x!*dȦd;`]utBdDt+t,+<,ZYT,d6D,!dBtdS6d,d+:`c D^t+d,T,!*^dնlT# DOWN EQT'SDOWN LU'S 4`h PT SZ PRGRM,T ,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC*OPER * NEXT TIME *;``Bl|P6l6<t |ҬdڢЬdDX6t;``}O!dl6hLT!dl/T*DLldH@08 <8@|Ԡ0;``AZ<8dD8t D\lYlvdvZFt[|C]X$diCTdd;`bao!^h l::n00lYlv$xQedjtBdtC,dk6B;`^+JDBtB<C,}dmڬoLgttdt`L| ,Dtd <`\4Z|,Tݶ,4t<۶<,d4|d, l lY;`cnOZ lXZlXZ D @ 'd  0;`_dolT*tft t+,؀D+tg"ڃ+,lYQ,d_,C<`\m<,DVdflYQ, d,lQ,d,l[QpdH dl;`\ZQ6thdH dڢdhdH6XlYQt,dd,DhlZ;`\$7Q6d dlXQ,MF!<fd+Dt+Tg,V,d[,CL+;`^ &SQdVdDfdT,hdDfd]t!Vp:`m qPTN# SIZE PAGES BG/RT PRGRM --  RR SSCC`S/MM-  BG  RT  VESUB c@,VESUB +! P.ENTRGORT SGET PRNT FNDETTLISTIGET IFBRKIFND OCT :`mA22BAD TIME LIST POINTER FOR ID SEG AT ......19ID SEGMENT AT ...... NOT IN ANY LIST<`_ -0)1YtX5XtZdXt[dWDXt\dXD[D]t^d^D_t F[ d^D_T`1`ZL,P,i&S[Datb&XbcT`,_,id[PD]t[D\,;`Q17CAN'T FIND END OF KEYWORD TABLE <`]%~u fiddD[t[d^D_t d` t[ted]t^d^Dft d` d^D]t^PDW,w:`hWgj*&kl$lZe`T`Z,+mZ&e]T`,+$nZeo;`fE_ T`,+p$ZeqT`,+$rZe4sT`,ˬ+$tZe<`aE4uT`,ج+dXtv&vt^4`T`,+dxD^tbbxtwd`Tw<`atzdyTw4zt{4P^DfT`Z4{,,d|D}t   &^ dD^tb<`_Dobt~dcD^tb6btd`T~tzd`T4zt{dZDtdDe:``~24{,8,BdDt> $?^>B6dvD]tvD[,L4lT`,R+`T20$ZZZZ IS NON-ZERO - CRASH WAS IN $LIST `DRU+`AcW`AfIY`Ab] `C_+`Bbc `D[}f $ZZZZ `Ium`Bbx`Bg| `Br`Bg++ TLIST c@2TLIST B z.ENTRIFBRKIGET IFND OCT PRNT <`nq22STATUS DOESN'T AGREE FOR ID SEG AT ......25ID SEG APPEARS IN LISTS MORE THAN ONCE AT ....;`f...14INVALID POINTER AT ......=dt>tL T,SdBd;``;bTtXtdT,`,QctdT,k,dDD=T,u:`^qt,dDt{$|{6,QdDD=tddDtZAtd;`cPA4,,dDt& T,,IdDt$ `CA6/,Q,I`A` `Ea `Dee .BB $ dDtdT,H,Mdtd:`^KDtdDtTXT$dDtdT,b,gdtdDtd;`^9iD,m,~d DtdDtddPDtD,r & dDt;`bdD,,$ "Z dtPdDTtdDDT;`\EtdDDtdPT,dDDtdDtD,;`]9ŶdtdDZTtdPDDTtdDDtdT:`^I,dDDtdDtD,ǶdDtD,6 td`Fi T,, `S2$MRMP UNDEFINED; NO DRIVER PARTITIONS ;`bc$ 0ttdZD,dPtdD,"dtd 6t/;`b,p($& 7$ dtdtdDtdDtDdPD,K;`c"~J,edt S$ d D,Z,e`& c dDtZD,;d-`^YmDtdD 6t |$  $$ `AdT`Cc`Bd `Ac `DeB@A`Ac`C$$S`A4SC`KT $MRMU  P 0`Ad CSUB c@CSUB =c.ENTR.STOPEXEC NAMR CREATLURQ OPENF(`^Gi SPECIFY OUTPUT FILES/LUS (2 REQUIRED) FILE CANNOT BE CREATED<`ee/CANNOT OPEN LU6F$ڀ687tdDtdDdDt<`bgTPdDTtdDZT4,f,nl$< dDTP,w;`bv,dDtdDt9$:;4Pd:,=$<dDt(`Z9:4Pd:,=$</`Ba `De`A` `Eab H== 9CCLOS c@"CCLOS 3.ENTRWRITFRWNDFCLOSELURQ !`W0$ &&`B[ ՀDMP c@DMP .MPY .DIV .ENTR.STOPEXEC WRITF;`cX{tpdp tq"qDptp Dr,¬dtts);``B#$tuvq6pdtDptpZDp,2,7dtDqtqdrtpdwDxDt?$Ctu?v$qp5`[CdtDptpDp,L,QdtDqtqdrtp$WyodrDy,^,f`Mi|ERROR IN FILE WRITE: RETRY`P̠^dz|"Z{dsDtts,!`Aa0o`A`r `Ea|tB@A`B`z Y  07 24999-16199 2024 A 0100 !CDMP CTU DUMP PROGRAM FOR CDA4             H0101 P~&9~AFvFvFvFvvv ~dnN~ .H@8f ы~n~S>n^. @8fvvF.3nS>fV.=V9~9.*@?.;@8.*nnf@fȃɃʃn^ndH^n~dnN~^ĮS.WffƋѮ^~fvhn>h^.hfVջ9~rA.nfv>>.vfV.". d`!` .fՅU.vffՄ.ff"1~f@@0 @  ?0@A n&p1d256Wp5CS~:J 17 24999-16200 1839 R 0100 PATCH RELOCATABLE              H0101 * PATCH !PROGRAM TO WRITE PATCHES INTO MEMORY FROM ABS FILESIPUT EXEC OPEN CLOSEREADFNAMR GETST;`cJ-6dt$#-,pd&T,p$-$Z,od'ZT,p,.;`g)#6$$()dT,nA$-,d,md,,:,{<`^.JD,kd.t+Pd-t-pdt'd+'<' ,W',ldt''t*$f+*<+<';`c)h<-,`,:<<<<<<<dDt{$#$  `R+ 0 PATCH ERROR : /.x 28 24999-16201 1839 R 0100 CMMM RELOCATABLE              H0101 g& %]CMMM Z 24999-16101 REV 1839 RTE M SYS MGR PROG.@CMMM 33.MPY .DIV .DST EXEC CLRIORMPARREIO PARSEIGET DOIO CNUMD IPUT XPUT IXGETDISC3IFBRK `F] ID SEG OF `DiJ EXTENT`IBA WORD , VALUE `Mn LU,TRK,SECTR,WORD,VALUE %`[# DISC MOD ! ENTER A /D AT ANY TIME TO EXIT THIS MODE `F& SAY WHAT ?`JTjy EQT # DVR `L~Ef NOT FOUND DRT PART `F9 INT TABLE `HLU =CMM3 DONE ! `Vo CMMM ! RTE M2 & M3 VERSION 03/01/77 `G+r YES OR NO ? `KmxINT TABLE STARTS AT 6.$`Z\' LU = TRK = SECTR = WORD = `G" OUT OF RANGE<`nB> ID,PROGRAM NAME ID,SEGMENT NAME ID,NUMBR = ALL ID'S IN SYSTEM EQ,NUMBR EQ,NUMBR,NUM<`nGBR GIVES EQTS INCLUSIVE LM,ADDRESS,# OF WORDS LM,ADDRESS DR,NUMBR DR,NUMBR,NUMBR GIVE<`n6"S DRT ENTRIES INCLUSIVE IN,NUMBR IN,NUMBR,NUMBR GIVES INT TABLE ENTRIES INCLUSIVE LL,L<`n'dPIST LU# PM,ADDRESS,NEW VALUE F/,VALUE TO FIND,START ADDRESS,# OF WORDS DL,LU,TRK,SECTR,<`n2~ # OF SECTORS DS,LU,TRK,VALUE TO FIND DM DISC MOD EX EXIT EN `I1 EXIT /E EXIT,`aPN XL,ADDRESS (SYSTEM MAP) XL,ADDRESS,# OF WORDS (SYSTEM MAP)3`g_p XP,ADDRESS,VALUE (SYSTEM MAP) XF,VALUE TO FIND,START ADDRESS,# OF WORDS `V5 DP,VALUE TR,START LOCATION,LIST DELIMITER<`n` INPUT FUNCTION ID LIST ID SEGMENT EQ LIST EQT AND EXTENTS DR LIST DEV REF TABLE LM `G/ LIST MEMORY `PW= XL LIST MEMORY (SYSTEM MAP)-`b"| IN LIST INTERUPT TABLE LL CHANGE LIST DEVICE PM PATCH MEMORY`QtnM XP PATCH MEMORY (SYSTEM MAP)`N F/ FIND A VALUE IN MEMORY`U^ XF FIND A VALUE IN MEMORY (SYSTEM MAP)*`_ DL LIST DISC SECTOR DM DISC MOD ANY LU DS DISC SEARCH `Lw" /E OR EN OR EX TO EXIT`V2? DP DISPLAY INPUT IN OCTAL DECIMAL & ASCII `Wss TR TRACE LIST XT TRACE LIST (SYSTEM MAP) *`_| A PK AFTER THE INPUT GIVES A PACKED LISTING OR USE PK, `O* . FOR MORE INFO DO A ??,INPUT ;``a6#d D t d T ,d t d t  m 6 od t d D tQd :`YQd mD tQd Qd D tQd Qd wD tQd Qd kD tQd Qd D t <`d $$ m d D t -$ ( l6d mt 8( Pd D T ,Ed kD tQ:`^ΥCd Qd T,L,d T,S,d T,Z,d TZ,a,<`_ad T,h,$d T,o,/d T,v,rd T,},zd T;`_C5,,ud T,,d T,,d TZ,,+d T,:`^+',dd T,, d TZ,, Xd T,, Sd T,, d ;`a( T,ö, d T,,d TZ,,d T,, m$ :`cNް, m & r,$ m U $ n 6 D t d kD T ,,Vd rD tQ<`]ddQd pD tQZd rD Qd qD tQd pD Qd t d D t  T P,;``=[," D yt ' Tt d rD tQ1 D tt 6 Q t d pD t:`^.>A D xt F  4 P ,O,d D t ZD ,d D t d D ;`a\ T ,bC:,e T Z,k,n D yt s T ,y,d rD tQd ;`\o}Qd pD tQd Qd qD tQd Q,d rD tQ D yt  Qd pD tQ;`bU& D tt & Qd qD tQ D xt   4 Qd D t   m ;`b&]  t d D t & D xt &  zt & D xt &  {t d {T :`^R ݰ, D st d {T ,d pD t d T t d qT 4 t d lT ;`ald4 t d T Z4 ,d |D t   $ d kD T ,,V,$ m f<`_6 ,! t % t d D ,-d t dD ,3,d D,:d td;`^/;t d D T Z,E,d D  zD t d mD tQ $R Qd wD ötd wD ;``HYd D td wD t b  B  d D td D td D B  p m;`]yd D td mD t &Іd wD  T ,d wD td wD D <`bd sD td wD d D t   m y6 sd xD t  $ d D t ;``D ,<,& t 6 t d nD td  m$ l nd D ,d t d;`]ؠZD ,d tdD D t d D D t  $ d nD td d D t ;``$ $ m l ndD D D t d D D D t   6,d wD td :`^d Dt dD D t d ZD 4 ,$,߶d DD t  $. ,2 t ;``36 t d nZD,=,kC m 94P d D ,Jd t dZD ,Rd td:`^+SD D t d D ζD t d D tdd mD td  j $ ,$q m < ;`a6q,dt ,d wD td  $  m r6 d D t d rD t $ ;`cPd rD T ,,d wD T , 6 d wD T X, $  <`]c$ ,d wD t@d @d D ,ƶd t d D t dD D t d D 4 <``,,d t dD D t & Tt d wD T  ,찚, T;`_|t d wD T  ,,,  $ d D T , ,d D t@d ;`\f@d D t@d D D @d PD t D ,d D T Z,*,,d t ;`c-d Dt 8$ u 6d D t@$E @$ 'd D T ,N,d mD;`^>PPtd D,W,\d td D t d D t ZD,-,j m 6 d D t :`c5n$s m td D t |$ ( 6d mt ( d T,,dt d;`]t d t dt ޢd D ,,d D t d lD t d t d D t  :`cm$ u d D td $ $ 'd T ,ȶج d D t $ m r ;`_Ѷd D t d rD t &Ј d rD T ,涊,d rD T Z, d ;`]oD t 'd 'd ׶D t  $ u ݶ, d t d t ,d t d t d Dt ;`a $  u& d t d ֢D T, , =d t d lD t ' (& 'd D t . / <`a= .6؉.d yD t 6$ 8 m 6 z ; ,d D t D u, d D mt ZD , d T ;`^( O, R,,d wD t d d Dt d T4 , d, j& d D t ;`_X md d wD T , { ztd wD T ,  t, Xd D t d<`_xL d D t d d D t d  $ 6',d T, , d T<``` Z, , d T, , d T, , d T, Ŷ, d T, :`^Nj ˶, d T, , d TZ, , d T, , d T, , d <``# T, ﶀ, d T, , d TZ, , d T, , d T:`^o , , 1d T, , >d T, , Ed T, , Ld TZ, ', S;`j6 'd T, ., S 4 m$  p :$ m  s$ @ m  t F m 0 y L m & q R m$ =:`mk Q0 { X m & t ^ m$ s p d$ m { z$ j m ? o p m 0 y v m & q | m$ M l :`m ~$ m  x$ m ^ | m 0 s m & s m$  q $ m " y$ m . z m ;`kXu 6 }, m$  q $ m  q$ m  {, _ m & k m$  ~, _$ m  k m;`jG& $  }, _$ m  n m 6 y, _ m$ . k $ m 3 v, _ m M6 r,  m$ T;`i 6 s,  m$ _ o,$  m u {, _  m & l, $ m  t, $ m 0 n * m <`j; )0 n 0 m & n, 7$ m N x$ = m \ ~, _ D m &p l, K$ m  o, R m 4 k,<`d2 Sd mD t d ꄒ ^ m 6 l,d nD t d  j m$  p,  `IlW w `Co " `E = $`ZN PKIDEQDRXLLMINLLPMXPF/XFDLDMDSTRXTDP??/EEXEN`Cpt \`Al `Hh '@`Al `Ao  `F 'x? `Ao  `Dt k12`Ao  `E YE `D @< /D`Al3 `A j `EY :&`B $ 'DOIO c@DOIO $ .DIV .ENTREXEC IABS CNUMDCNUMOIXGETIASCIIGET IFBRK PACK `E, `A"(i#`A>#I?`A:I%`[?# WORD LOCATION VALUE(8) VALUE(10) VALUE(AS) `N LOCATIONS THROUGH "`Y :`^dDDtdtdDDT,,wdDDT,:`^j$ۀ#tdDtdDDt6сdDD T,ڶdDDt<`bs!$dDDt6сdDD T,찛,%tdDDt$<`_&ZtdDDt&QtdD,dDDtdDDDE;`a_tdDDt$&,](6tdDDt14tdDD<`_f9t>Atd[D,QdDDtdDDD&TtdDmD;``5Xt]c 0  f ,pdDt,,vdDDtd m<`_[x[tdtdD,۬d DDtd DDt&dE <`c D,dDtd DDtdt&$ۀd<`bYt6dtdDtdDDDt $??6dDt0`XlCܢdtd[D,  ,pdDtD,,y `Eb%`Ab< `Db `FoC  `F5 '@?@`AbT DISC3 c@ DISC3  ~.ENTREXEC IABS CNUMDIASCICNUMOIFBRKDUMMYPA&CK `E,~ `A(i`Ui j WORD VALUE(8) VALUE(10) VALUE(AS) `Q~ ;`\@v~dsD]DT^[,,dXt_dsdat`,dst_dbt`dcD]Dtd<`a6ہddeD]DtdddZD]Dtd&ۀddfD]DtdddcD]DTsE;`b$,g&ۀ`dhD]DTs,g&j\dhD]DTs,,4ti:`^ݶdiD]DtddZD]D tk&dki6 diD]DtddhD]D tk$dkdiD];`][DtjdlD]D td&jddiD]DQtdd^d,dlD]D tddlD]D ;``Dmd g$À Z#"n,-diDstiD_,ݶ۬dcD]Dtddod8'ap4`^v8dsti @r$spF$g[drDptpLn,-diDsti[Dq,: `GbmX%`Caa `Dae `Bnl `Ao'`Caq IXGET c@IXGETXPUT PACK .IASCIDUMMYIGET IPUT  Ӿ$LIBR$LIBX.ENTR:`h@@ԀZt<t< Հ;`_ (**.t*D,;d,2+t+,t,d-l-Z|6t-L|;`\-G|dtl<<,Kl,d+P,U,WҀ|i]&<,<<-<*,O;`_= cPL4.d{ nЬitzT{dD| Ӷ<z,rn|l-5!;`eCߠ$<-l| 0 *6dt1`Z |dע LPpD,d@l_K 0.**0 3 @ 24999-16202 1938 R 0100 %CMM4              H0101 Ea CMM4 Z24999-16202 REV.1938 790911 @CMM4 )<Q".MPY .DIV .DST .GOTOEXEC CLRIORMPARCINITIRTE4IFTTYLURQ REIO PARSE ABREG IFBRK IGET DOIO IDEX CNUMD mDTRK IPUT IXPUTIXGETCNUMODISC3IMFP DUMMYMAPXX `Fj ID SEG OF `Gbc MEM RES PROG `DiI EXTENT`I\$ WORD , VALUE: _`N LU,TRK,SECTR,WORD,VALUE: _`J MODIFY OP SYSTEM ?%`[# DISC MOD ! ENTER A /D AT ANY TIME TO EXIT THIS MODE `F3 SAY WHAT ?`JTw EQT # DVR `L~Rs NOT FOUND DRT PART `FF INT TABLE `HZb =CMM4 DONE ! (`^6( CMM4 ! THE RTE IV SYSTEM MOD/ANALIZE PROGRAM ! 09/11/79 `G+j YES OR NO ?_`KmINT TABLE STARTS AT 6.0`d LU = TRK = SECTR = WORD = OLD(8) = `G,% OUT OF RANGE<`nBo ID,PROGRAM NAME ID,SEGMENT NAME ID,NUMBR = ALL ID'S IN SYSTEM EQ,NUMBR EQ,NUMBR,NUM<`nx%BR GIVES EQTS INCLUSIVE LM,ADDRESS,# OF WORDS LM,ADDRESS DR,NUMBR DR,NUMBR,NUMBR GIVE<`ngSS DRT ENTRIES INCLUSIVE IN,NUMBR IN,NUMBR,NUMBR GIVES INT TABLE ENTRIES INCLUSIVE LL,L<`nIST LU# PM,ADDRESS,NEW VALUE F/,VALUE TO FIND,START ADDRESS,# OF WORDS LI,ENTRY POINT N:`muAME ,# OF WORDS DL,LU,TRK,SECTR, # OF SECTORS DS,LU,TRK, WORD TO FIND , (5 WORDS MAX) `TM TA TA,LU # TA,LU #,TRK #, # OF TRKS.`c8 DM DISC MOD EX EXIT EN EXIT /E EXIT,`aOM XL,ADDRESS (SYSTEM MAP) XL,ADDRESS,# OF WORDS (SYSTEM MAP)3`g_o XP,ADDRESS,VALUE (SYSTEM MAP) XF,VALUE TO FIND,START ADDRESS,# OF WORDS $`Zw DP,VALUE,*,VALUE TR,START LOCATION,LIST DELIMITER(`K{- DI,ENTRY POINT NAME `Ma LP,PROG NAME,REL ADDRESS`B4 LE`NL PG, PG#,OFFSET,# OF WORDS `N PP, PG#, OFFSET, NEW VALUE%`[: NS, # OF SECTS/TRK, # OF SECTS/TRK (FOR MS COMMAND) `WJ MS, LU,TRK,SECTR, LU,TRK,SECTR, # OF SECTRS <`n` INPUT FUNCTION ID LIST ID SEGMENT EQ LIST EQT AND EXTENTS DR LIST DEV REF TABLE LM `G/ LIST MEMORY `PaG XL LIST MEMORY (SYSTEM MAP)-`b"{ IN LIST INTERUPT TABLE LL CHANGE LIST DEVICE PM PATCH MEMORY`Q~W XP PATCH MEMORY (SYSTEM MAP)`N F/ FIND A VALUE IN MEMORY`Uh XF FIND A VALUE IN MEMORY (SYSTEM MAP)`K K LI LIST ENTRY POINT&`\} DI REPORT DISC DICTIONARY ADDRESS OF AN ENTRY POINT `Qo| LE LIST ALL ENTRY POINTS IN SYS*`_ DL LIST DISC SECTOR DM DISC MOD ANY LU DS DISC SEARCH `L, /E OR EN OR EX TO EXIT`V?L DP DISPLAY INPUT IN OCTAL DECIMAL & ASCII`Hq TR TRACE LIST`S>& PG LIST ANY LOCATION IN PHYS MEMORY`V1 PP MODIFY ANY LOCATION IN PHYSICAL MEMORY`O  XT TRACE LIST (SYSTEM MAP) `N!n LP LIST DISC RES PROGRAM *`_} A PK AFTER THE INPUT GIVES A PACKED LISTING OR USE PK, `Q< TA LIST TRACK ASSIGNMENT TABLE `O*8 FOR MORE INFO DO A ??,INPUT `Q TRACK ASSIGNMENT TABLE SYS DISC `G# OF SECTORS =`Sa SOURCE IS: DESTINATION IS: `P)M NS SET # OF SECTRS PER TRACK `WsB3 MS MOVES DISC SECTORS TO ANOTHER DISC AREA `E+ AUX DISC`C RP `IVl0 DISC RES ABS +``lIDEQDRXLLMINLLPMXPF/XFLIDILEEPDLDMDSTATRXTDPLP??/EEXENPGPPMSNSFP"`Bw86`` `D,*,/,+,-<`n->t FOOTPRINT AREA : # OF CHANGES = LATEST 190 SAVED NUMBER OF SECTORS MOVED = +``$ TURN OFF DISK WRITE PROTECT ON LU2 FP DISPLAY PAST DISK MODS<`n ILLEGAL SECTOR BAD DISK REFERENCE EP EJECT PAGE IF LINE PRINTER NOT RUNNING ON A RTE-I<`nV SYSTEM NOT ALLOWED--RUNNING NO DISC MOD VERSIONPPLLPMXPDMMSNS/EEXEN WAITING FOR LU WAIT;`as6$ING FOR RN,/6#d#t8d9T8Z,9d:t8dt=d?T=;`_ E,G,kJPd:D@T:,S,Z$Y8A,dtBdDDBDEtdBD@;`bddBD:tBD!,\q$8(t4BTF,z,ydHtG&8tIdKD;tCJ<`Z;&C:d:tdDLtd9dMDLtd9d(DLtd9dDLtd9dDL;`dmtdD$8GNdOD8tC:$C( d tC $(CdMDPTQ<`]Ķ,dDLtd:dDTI,,)d:tBPdBDRT,,)dBPD:tBD&<`ab,dDtSdKD;tCT&C: 6d9T,,)dDTZ,,dDTS<`fr,  $8d9tS,dDTS,$8!d9tS#+9$9U &"V,;`h(,d:tBdBDWT,VVB$   -$ o } $ 2 2 2 $ ^$ ;`g P$6dBD:tBD3,+c$8X,j8%6!,q$8.,$x8<`dw6&,$8-$8bY$96[DDtZdDPT:,,d:tBd:DZ<`c7tZZT9Z,,ZD+tCCTt]d!DPtZD*t^^:`^]t_dDPt /ZD#t``a 43 /_,,dBD:tBD\,<`bܶd:DZtZdMDLTb,,Z T9,,ZD+tCCT9P,;`[,d!DctdddDctded Dctdf,3d!DctZD+tC;``v[6CdDct!ZD*tC&Cd Dct-ZD#tC2C6Ztgd3Dg;`at9th=ZD#tCBC,tiGZD#tCLC-tjd-Tj,YWZD"tgd-:`c׸Z Tj,bdDgthdkTZ,i,OdlD;tCq$MC:w$;jm$}gh;;`bi} d-Tjt] d:Ti4],,6ZD'tC4CT9,,ZtCC;`dLtg;&I(dDgtCgC;6dDPT:Z,,ܰ,8&sX, o<`^[ðtnqtpd Dp,϶dpt dDp,,]d:D,d:tdtBdMDL;`^ʕ Tb,,dDDB ,DntgdDrtBd(Dst d(Dr d(DgtC;`cm& Ct Ot(d(B  D(t(dDrt  (6d(Dra Tu, *<`_ "d(Drt d(DrDv d"Dst d(Dr dlD;tC 9$MC: ?$;"d#Dg<`d AtC HgC&;d"DgtC SCwx$yh [$:z$w6xdyD@t d: t]d(Dr<`cj ePT{4], l, dyD@t|d+DgtC$ {Cwxy&h :$z$wxdyD@t d:<`b , , dlD;tC M&C: $;I(dyD@t dyD@D|DDtC $C;dB;``~@ PD:tBD ,, }t| t~dDt d  ;y4Pd D~, d~;`]j ʴPt dD9, d:td DPT9, dt dD|DDtCd D|DDt^ <``b $C^;dDt d dlD;tC M&C: $;ydD|DDD~tCd D|DDD~;`^ t^ C^&;,d(DLt dD d ZD9, d:Pt d9D, ",dd DDD;`cG %tC ,C&;, 06t 4PtdD, ;, h A$;FXd D, Hdt ;`\0c HPd DPT9, Rdt dDDtgd DDthdtdDLt d:  gg;`c d$h;,$ n8,dDDtxd(DLt dD d:td:tB;`a J Mt`& QD`D, -t^d:Dxtx _4Tx, e, jd9txd:Dwtw<`a"s k$ r:z$&wxd:t $Z w,d T, , dD@t dDP t]d:D<`]@ D@t /d!DPZ /]t_dDD@a43t`dDPPT`_, , , `d<`c6 D@t  $;UdTZ, , vdDD@D:t $  % 7d9T ;`^ ̶, d:t dMDD@t dMDD@D DDt`$ `;PdMDLTb, ,dM:`^ݢ DLt d: d:Dt, H $;0d!Dt d dMDD@ ltdD@;`]LdD:tD,zd:tZdDPDt`dD>td( 6D&DPP,<`],dD:tD`,dBtgd:thd(DD$,dDDBtgd0Dt$gd1<`_۩Dt6؎d#Dt$;,d:tdD>td:DD>dD:tD(;`\D)ٶ,d:Dtd T,d:td:DtdT,,dD>tdD@;`_],d:DBtBd:td6TB,, $ :$& B,d9ThZ,,,;``Q;6+d9tdZD9,$d:ZtdDMt]d9D4],/,]2t;`c47Dt=tADDDthdMT,K,Q$;&d9 T ,X;`]W,rd t]6D tgdgDh,e,]dDgDDtdhD,rdDgDDthu<`a t6D t}$h;dMDLTb,,dTZ,,d9T,,dl;``mD;tM&:$;+d:DhD tgdDhthdgDh,,]d9T ,:`^,d tdDgDDtdhD,dDgDDthgh&;dMDL Tb,<`^9Ӷ,,d(DLtdDd:Dt]d T4],,$;dMDLtd:<`aPd(DLT9,6td(DL TD, t,ڴd9T ,,;d;``A@ T ,d td T ,$dDtdT Z,1dB td<``(2 T ,;O"dDtdtd9tdMDLtd:N$::::$;,d:Ti;`^R,V,dgDhT,adDhthdDhtg6tgdtd9ZDg,qdM:`^v>ptdDt&wtdgtxdg DyD@tPd9P,G,ydDyD@tPd0DtQRPQZdyD@D:td1D<`bEZt^_^dMDyD@thdDtijh6ؓidlD;t$rM:$x;%,dDyD@;`aP|td0DtdlD;t$M:$;.dMDyD@td#Dưt<`as&$;)d(Dyty VTDZ,,dyD$,,dDytyd:Dxtx<``;Dx,,d9txd:Dwtw$:$w6xdBD:tBDi,",dlD;t;`hބMD,d:tBdBDWT,B$$ '.$5WB$IP^;`iT5$]qq$q 6dBD:tBD3,$;$$;"*;0*0; :`m/0+6;& <$;G-B$;*$H;<)N;0T;&,Z$;n#`:`m\$;L$f;0l;0r;&+x$; ~$;W)$;#;h:`m0.;&"$;}'$;|)$;"w;0";& $;3/;`m8$;-$;-;0#;&,+$;8,$;/,;0 ;;`ku& $; -,$;;60,$;C$;H/,ㄒ ;=0;`i$;1+,ㄒ;_0;&d1,&$;~!,-;6",4$;, ;;`i7$;"$A;),H;&-,O$;),V;6.,]$;, d;`lxc`$;M$j;Op;T6*,w$;}$;$;,;&M#;`d$;[0,ㄒ;o6),$;,$;d:tBdDtXdBD ;`c($; dBPD:tBD(,,dDtd$;),$;-",;;`f&a*,$;#,ㄒ;6#dDtd;&,$;,<`j$;,dDt$;0 $;J/$;&;42,!  `Sx#@$   `Bv|9`Av< `D> "NF`C>D`AH=_`IRJPK`BT`C W `B{M[ `Fqha'i`CĭkLP`AzXo `Fq'? `B.zB00`Azh} `DIx 1 2`Azq `Dh `DvYE`C`BeLEDI `E  4LI`B/D`A `A# = `Ezπx@`Av`Aw3A`LQ5* + / - "PG?PP`J[$`xs$*) CINIT c @ CINITDSKOTa~^EXEC $LIBR$LIBX.ENTR;`ddЃt"t9t?c WtX|YcC V DYDT ځDXtX|Y&P[ \<`d[`$&XY,HtZdX4PdYQdURa;X Y\C$P[\X6YTO,H :`h# HdXSdY4TB@]c]t|kop"`UJrpx[_$ڀ`]^ydl&a IMFP c@IMFP x2.MPY .ENTREXEC DSKOTUPTRS;`cDBdDDtd߶DDt$6ЀdDD T,$<`\!#,dtdDDtJdDD䢀DJ,5,dDᢊtD,&dDD;`^l?tJdDDtKL$JKdDDtdDDDt|d6ڀ|dD;`YV]DDt||dDDDt||dDDDt||dtdDDt|;`_}vdDDt}$|}dDDtdDDt$6ڀdDDDt<`^XdtdDPDDtdDPDDtdD<`[^PDDZ,dDDtdDDtdDDtdDDtٴdD`PζDtdDDt݀ր$؀ـڀۀ `Fa@B`Aa)`Ba1 UPTRS |c@dqdm;`\FS#,&,Ddrdn&/ttsds,6,Ddsdn,Ddu<`]]?Lnv$mdwDxDtyydzDxDtyydqDxDty`ON=\yd{DxDtyyj$m `Favm@ `EdtB`B`z DOIO c@IDOIO ' r.DIV .ENTREXEC IABS CNUMDCNUMOIXGETIASCIINVRSIGET IFBRK PACK '`]%( WORD LOCATION VALUE(8) VALUE(10) VALUE(AS) VALUE(SYM)`H[V PHYSICAL PAGE `NE LOCATIONS THROUGH 4`heh <`_dtdDDTZ,,Ƕd|DDtdZ,,d|;`b^DDtdDtV6~dDD T,Ą(6td<`[_ǶDtd|DDZtdt dT4,,dtd|DDtd|DD;``7DdDt붊dDDTZ,dDt6؀dDt$;`\6ځd|DDtd, ,d|DDtdDt&ځdDt1d1d;`clPDDT,',i&*tdDt1215tdDt=>&=A<`_P1APtdD,OdDtYdDDY&RtdDtYZY]tdD;`dW`teh$؁e, &ltdDtsts wtdDt& t<`_9dD,dDtdDD 6tdDt &tdDt<`b&dDt0 ,dDt,,dDDtd:`^Ŷ٬tdtdD,ӬdDt6؁dDt$ဇd<`_v  "D,dDtdDtd|DDtdZ,,!d:`^UDt6ڂtDtdDtd|DDtdDt !;`c2 A6؂ dt$)d|DDtdX,9$9V~?E6}dt<`bgC$GdZtdDtdDDDt Z$a`$adDtd+`UetdD,m p",dDtD,I, `Dc| %`I U`Af`Iy PG  `Ab `E8'D@?`Ad`Be,@ DISC3 c@ DISC3 j! ).ENTREXEC IABS CNUMDIASCICNUMOINVRSIFBRKDUMMY PACK "`Y\I WORD VALUE(8) VALUE(10) VALUE(AS) VALUE(SYM)0`d ;`aFb6bdtDuDittuetdv g,|,dotwdxedztyd{<`]8PDuDgTx,dsty,dxtwdstydpDuDgTxZ,,d{DuDit;`cbd|DuDit&ڀcd}DuDitdd~DuDgTxX,$hiy;`aFödDuDgTxX,$hIrdDuDgTxZ,ܬjdDuDgTx:`^,,KetdDuDftdDtdDuDftdDt;`]MdDuDftdDt$dDuDft*dv*, dDt*PdDD;`a}*dDuDft*dzDt+.$v*+dDt7$h$Z:,DdDxt;`a*~@Dw,jd~DuDgtdj Ofdxt W$x$]$h$qdDt`Llpa$Zc,DdPDxtD,Qj`Hbpo@%`Aax `Gbz  `Er `Aa`A'`Aajj שDTRK c}@DTRK $.MPY .DIV .ENTRIGET ISSCT;`b_& strdtZ,,!Dutv&vtrtwdttx,;;`\A5"&$ztyd{d|Dytxd}PtwdtDw,4,;dtdytxt~,Ndrq<`b>tvdw vdq0rDwt~d~ qdq"ڀD~dxdr#`OU`,d,kddrd`A`q@`Chs`C{`A` 6PIDMI c@t3d9t4t5t6;,Rd5 ,e:l=l<$`P#P|7D?d6ڠ,EL4<7,&dt8d5,5 `Ee9p;`_?$@Y}4Z9P$6Zt6P,5dQ ,+,d5PbDDhd5cd3$5;`]2^d$5,5|l l|<,t,.d:t4t7<d5P,`E5f{L4<7,v<,k<`\sP,5t6\dZd6,5dQd,5d,5,57`c?C|l8\>,5ҋ|8l  Z ;`` | ϶d4T9,lL9l ` ` ܬϠT`LGDDD%:(@`NZtddQdI<`] td!dZl4|# L" LL,l4L#|<##<,`I#L#|# :`h463d!dD8@H ؄(0z8{l@FHFPU[XU\`hpxH@:`m;\a;@b+HL@I=HM TH@a;b+HLI=HM N a< @O} N:`mp TNa<b,NO}NSSTT SW@TTz:`mST TT SW @T T  z  ATA E5@TT@@:`mląÄ݄̈́@t@| $Id@v I^SSSBSCVVVV\*\+:`mV{j{kZ[ւփ~>@gPg׌ ׌ Ñ‘ƔŔǕ ʤCDˤkˤl:`m=سس ٴ ȺȺST#$/5ZZ\&e0fP ghGG:`mjZ[⋂ꋃBC̹֓֔3ZZ:`mܸzݸ}́}S>TS==} Yv] *짧*{b *Y*à:`m hH鰿鰿qxŀ[Tb HS`^Z FW 'K 2 읟`OgT Y H z c $ISSCT c@0ISSCTK$SSCT `DnFd ` 4I 24999-16205 1913 R 0100 %DV65T DS/1000 DVA65 WITH TRACE             H0101 % 4DVA65 &24999-16205 REV 1913 790127 W/ TRACE #@eIA65 CA65 MIC$X{$LIST$OPSY$TIME$CGRN;`cU cs L<,$|dJDCk l tH @0dB dAt4@;``֔#P? ж,sT;,h;T,a\>,Q\=,G\E,\F,P  ,VC0P<`a +C d,LIJd Cl|l dDTC;`f}-d,L4ø ù 㴠P 4#P$,b ,;`_'C  ddK,,Զ,q\,\,l,T,c 변)d <`]Jl  7d÷,жdK,,,q\,\,l\,T},<`\ƶdldK,,,q,,,֠,.cd7l;`],/ldK,,,(\P,\,뵶d;dK,P,,(۵,;`\\,.,dZd7d<K,,o,(d J۹,7\,ld;`]#g, 7dzK,,.,(,,ld좀4l,/l;`^E8d 4,7dl,TT,XTZ ,T,!T,(,zL:`^(V,L4l d,9lC#d뵬l,/,z;`aیtd,{d,{dltC#ld䶐,0 ?@ @@;`_PlJ Kd Jd,9T,l \,x;`^K lzd,| ,tP<,;l,/dK,,;`\Ң, ,ڻT,P7,4B  dldD;d|d{D:`^gD|L||,Lc Ad,9dl,K,,;`].  dltJdtJP~, 4 ,/,.,.ll4;`_A)klҴPl{C,d,:d7<l\B뵬 cs㴠;`` H0Cl t},Wt@ڇ@,k|̶,jll d  k;`bhlld,r}K<K\K<K\K<KK@@@;`_Ьd<,<,|, lhZkll;`a(PtpP˷|t t k|P| d,9tdttXt!d;``~P,l [<̬l \,|ZLҲdl,;`h" ! P|㳶tJ4"tUt+`T d$}tNt:$t$#t$tWt$%tV$$t <  5< 24999-16213 1902 R 0100 %NDTDU              H0101 J& lNDTDU YDUMP NDT FILE 771104 24999-16213 REV 1902 3~RMPARGETSTOPEN CLOSEREADFPOSNTEXEC CNUMDIFBRK IFTTY $CVT1 $PARS $LIBR $LIBX#FWAM#NODE;`bd,a, l,,dtƄu,* ,ad4t$#;`b="0)&|udlZld΢Dudl͋,8,<׋ע,5L|u@d  <``[TD0GHdd4t4tpX$oضT,\,d,ad,rD,f;``<dd,rdD,ld,r d@Dt|cDttjC th,tf5`]mDhDhtgdDfZtdu@Dtudud,֤d,to;`_6ftit~tqq4dtdi,Dh,t}d|l|ZL~ d~t|`Ot{ydjD}td|tqdkt+`UҶ<dDt<q,d{ditrdjtd6{y o;`]6g,dtnd|tqdjtdkDtD ttl} , n,,;`_<n<n<,n, ,- ,^<nn,  Ѵn4<`_$ts$,st<ndѶDtDtt<ж<q, dztt*d{d&4{dv<<r;`dC,Ip4Zd|D}t}Di,^t~$Wo]p6,addtr`Kg<ddts<d$qǁrsd;`eztdtdmllPydo¬to&od,^ *** FMP ERROR -NNNNNN;`j ***h4d,^ *** TOO MANY NODES. MAX =NNNNRNN ***d4,^ *** BAD DATA IN FIL`CpE *** `D,,,::`mq?@?> /NDTDU: NDT FILE NAMR? _ NETWORK D`MxESCRIPTION TABLE I  N FILE `Tk AT NODE NNNNNNNNNNN NODES IN NETWORK `Ck$ `E[v ! :`m -----+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+---`SV--+-----+-----+-----+-----+-----+-----d  6= 24999-16214 1902 R 0100 %SLCIN              H0101 X) SLCIN cPRINT SLC INFO 780613 DMT 24999-16214 REV 1902 ! {EXEC CNUMOCNUMD$LIBR$LIBX$OPSY#FWAM#LU3KD$EQT D$XS5 ;`fd,, Ԁt̂d,= ,d,+P=! , RUN LSTEN FIRST! HP 3000 N<`]&OT ENABLEDZ= dtkdd]tdDtfdtgdthdntudeU<fgPtl<g,=;`\C}CdgluLًltgf.duTr,==v<k,9ddDt/D.t0dc]D D0l+;``_@tT=e= ="l|hd/l.vwl3deUL0|i|jKln;`\5P|u (!"Z| &|dTd,T,Tٶ,l!l!Z,d,Tߴ,D;``@,X} dD(|klpkZ,d,T߶,lod)dD*|k:`^lqk,dT,߶lTlD,@D+|klokKiL0\j<``&٠P, (| Ѐ(|dD,dD,|klrkdD, dD-|klt;`^?Rk=v!deUKiL0\j, ls|u,=vi\2,,xdrtul;`_0.,dttul.,!|mt(&mudluLh|u !|mt5mud;``L6luLh|u .Z=t;<==t<<=$J́;<=djTTRdStjK4;`iVu,XU,_] + x$}  :`m SLC LONG TERM STATISTICS: SLC EVENT TRACE,`a TABLE: STATUS FUNCTION EVENT STATE :`ml/ READ REQUESTS WRITE REQUESTS MESSAGES TRANSMITTED :`m} LINE ERRORS BCC/PARITY ERRORS LONG TIMEOUTS RESPONSE ERRON9  RS RESPONSE REJ _ `F+$1:`md`$fkpv{  INQUIRY INITIAL CONTINUE  REPEAT  W/REVRS INT DELAY$:`m9 INQUIRY CONTINUECONVERSTNLRESET DISCONNECTDELAY $$CLEAR IN:`mFITIALIZELINE OPEN LINE CLOSEESTABLISH LOC IDESTBL REM ID LSTCHNG ERROR PRAMSZE:`mRO COMM STATS SHIFT TO RECEVDISABLE NAK SEND $(09BK$T]clu$}$:`m$$$LINE OPEN REQ LINE CLOSE REQREAD INQUIRY REQREAD INITIAL R:`mAEQREAD CONTINUE RQREAD REPEAT REQ READ/REV INT REQDELAY READWRITE INQURY REQWR:`m{nITE CNTNUE REQWRITE CONV REQWRT RESET(EOT)RQWRITE DISCON REQDELAY WRITE REQ ACK0:`m0 RECEIVED ACK1 RECEIVED WACK RECEIVED RVI RECV/SENT ENQ RECEIVEDNAK RECEIVEDEO:`mT RECEIVEDDLE EOT RECEIVEDTTD RECEIVEDTEXT RECEIVED BCC PRTY/FMT ERRTEXT OVERRUN:`mvGARBAGE RECEIVEDBAD ID SEQUENCE SHORT TIMEOUT LONG TIMEOUTLOW HIGHMID 8=B:`m"$GOWZ`$ent}$$$UNOPENEDCONTROL READ ENQREAD ENQ ERROR:`mOCHECK READ REQREADREAD TEXT READ RVIRESTRICTED READ WRITE ENQ WRITE ENQ ERRO:`m8|R ENQ-ENQ CONTENTNWRITE WRITE TEXTWRITE RESPNS ENQCHECK RESPONSEBAD ACK RECEIV:`mjEDWRITE RETRY ENQ RCV IN WRITEENQ RCRD IN WRITWRITE CONVERSTNLWRITE EOT READ E`KIOT RSPONSEWRITE TTD `  7> 24999-16215 1902 R 0100 %DSINF              H0101 e' |DSINF A1000-1000-3000 780106 24999-16215 REV 1902 <DEXEC$LIBR$LIBX$PARS$CVT1CNUMOCNUMDEXEC RMPAR $CLAS $RNTB #CNOD #FWAM #TBRN#QRN #MSTO#SVTO#WAIT#BREJ-x#LU3K#QZRN#GRPM#NRV #TST #RFSZ#LDEF#NCNT#NODE#LNODD$LIDD$RIDD$XS5 $OPSY!`Ai `A`6 3`_Ytt$Z<Ŭ,ج  ,ߠ;`d1t<t<$  7d l dtD ;`aK <,RԀ $ c,LZ>CtPDQTR,+S,L,;`bH+dPl">dPD7B>:";cZtOk*Z <O,A `BM;`kO QR?5S /DSINF: VALID FUNCTIONS-- AV AVAILABLE MEMORY SUSPEND LIST CL I:`m4|/O CLASSES VA DS/1000 VALUES DU DUMP OF SAM BLOCK LI DS/1000 LISTS NR NODAL R:`mOUTING VECTOR EQ DS/1000 EQT ENTRIES EQ,N DS/1000 EQT ENTRY # N /E OR EX TERMINA:`c TE DSINFSY Rfx  "  R ;`l"S AVAILABLE MEMORY SUSPEND LIST IS EMPTY PT SZ PRGRM T PRIOR AMT.MEM RN `K.%FATHER@|?--B RN;`_248P "Sc̢t%,Sd- #dd%D76l5d%D ;`]F}S>td%D8t1*t d1) ڂ*td%D,l.Pd%Dt0;`]p|d%l/d0 |dtd0(,t3d0Dt2Pd2D76l4:`^yL6Pd2D(,t3dD+td2D͢Dt2dD, &7`Z(Sddt,dD+t %t%,Hd- #[,S6:`mH I/O CLASS INFORMATION CLASSES IN SYSTEM CLASSES IN USE: CLASS STATE GET9`lK POSSIBLE OWNER CLASSES AVAILABLE[ BLOCK(S) WORDS]  BUALGT@ <``&$Zd֢t!t"S" d"ҤZ S" t d!t#l!L"<`_rF| #D #,#t$,VST< ,dd!D# d$,dtt;`]e td$,t<d$D+Dƶtd$t$,fvwdl&Zbd϶td2<`^d3td4t" d,d$(,dt,dtc˴Zt%d%,d%;`aPD#,%t%,&d%,Pd%D76l'6Z,dݠl'+d$;`^Cdtd>ttdDt%D , d%D7,Zd%D76l4L6d<`^8߶DtD,tdDtD ,td,Ƕdt d#t#,Gd"#`QtZD ,", Sd  S(:`m@ DS/1000 VALUES: RESOURCE NUMBERS: OWNER LOCKERTABLE ACCESS QUIESC:`mp=ENT QUEZ "LISTEN" TIMEOUT VALUES (SEC): MASTER T/O SLAVE T/O :`mj REMOTE BUSY WAIT REMOTE QUIET WAIT RFA FILES MAY BE OP:`m.EN HP3000 IS ON LU LOCAL ID SEQUENCE: REMOTE ID SEQUENCE`QD:  ` `K/ $  ;`\۵tt<ddlދ" .dtZd!Dt$ʹZtT,dܠl ;`_B ",d, dl+,dDD76l6"d$ʹZtT,#dܠl'<`b~ X,6d,,dlZ+,6dDD76l6" SPS;`b~@Zd֢t!t"d23d:dR,TdASH d4 Ц^T;`b(b d4 "k" a d4tznR d2d3td4t"{ Sd<`bBd,Sdt d| ,6lҋ d,Dt.`Z"d| ,6lӋd,DtS::`m DUMP OF TCB BLOCK LOC OCTAL CONTENTS OF LOC THROUGH LOC+4 DUMP OF HP3000 TRANSA0`d&zCTION STATUS TABLE LOC OCTAL CONTENTS OF LOC THROUGH LOC+7 !;`aLddtDl ,J$ ZtL|ZD,CdDD 7t F:`^6dD,D4t? Fdt,) dDt,PSt5S <``TJd tZddDtdtd tEd,wdZtD D td .t `D?tdtEL:`m)| DS/1000 LISTS ENTRIES IN MASTER REQUEST LIST, STARTING AT ACTIVE SLAVE MON:`mFITORS: 1ST TCB STREAM CLASS MONITOR ENTRIES LOCATION ENT:`mXRIES IN NULL LIST, STARTING AT ENTRIES IN HP3000 PROCESS LIST, STARTING AT `Vq  ENTRIES IN SLAVE LISTS ';`^N txd{, (d D{67t{<x, dxҬ S|Sd5, 4dt{tz ;`a 8 >z6l dzL | FS PtytD6, dD D<`` Ytz6t{ddzZD ,  D76l' 6Zdϴ tdzʹt<`_V yXd{, $ { 4 dyDxGty, d tP dt, Rdy ;`_ " Sdt{tz $ zl RdzZL | " d, Ķdt{tz  (`U[  z l dzL | äZS * Sd, , :`m e $ D  0 1 DVA65 EQT INFORMATION EQT # , LU # : WORD VALUE MEANING :`mL  WORD VALUE MEANING *BIT BREAKDOWN 15 12 9 6 3 0 DVG67 EQT INF:`m @ORMATIONI/O LIST ADDRESS INITIATION ADDRESS CONTINUATION ADDR STATUS/UNIT/SUBCHNL*AV:`m1 m/TYPE/STATUS* CONWD DATA BUFFER ADDRESS DATA BUFFER LENGTH REQUEST BUFF:`m? ER ADDR REQUEST BUFFER LEN COROUTINE ADDRESS CURRENT STATUS* EQT EXTENSION ADDR NO:`m#) MINAL TIMEOUT MICROCODE TIMEOUT DATA TRANSFER COUNT LAST WORD RECEIVED VPW/REPLY RE:`m Q LENGTHDPW/REPLY DATA LEN TOTAL BLOCK TRANSFERTOTAL # RETRIES NEW REQ ID SEQ ADDR <`_b_ %t !D t 6Dt "d !  t $Z 7 d l "Z;<d ζD;t ά %Sd ;`\' D2d3t d4t d t "  dd t tdD #, ed %d :`^~ ` % $, YS dd lދ+dtdϢt d tD;, ;`a= ~ , d d  HDt, x  dTd7ZtT $, rS A<`^w d Cl<`_n Z,d ֠| & S 9 d t #d7t $ A = d t d Jt dt d;`\  Ōd D t < t< d l L "< , t d T , " , `E Z S :`mV < P SLC LONG TERM STATISTICS K READ REQUESTS WRITE REQUESTS MESSAGES TRANSMITTED :`m i ERROR-FREE MSGS RECV  LINE ERRORS NAKS RECEIVED BCC/PARITY ERRORS LONG TIMEOUTS<`ij RESPONSE ERRORS RESPONSE REJ WACK/TTD RECEIVED"Pdt DR t Ed d E<`^b   X Sdt Fd ED D6 d F< F6 d F*6 &d F< F B;`cy P4 C ," S< D, ʀXd! dT,  ?" 2S NRV SPECIFI:`m CATIONS: LOCAL NODE#: , NO. OF NODES= : NODE= , LU= , TO= 2`fMg - (SEC.) LAST LOAD-NODE= NONE ?AVCLVADULINREQ/EEX :`c^ Td , h ^$ V e & Sdt Qt R o & P+, d PT G, v6, T H<`\J w, {(, T I, :, T J, L, T K,  *, T L,  , T M,  ;`e , T N, T O, t , ۠ S@PEXECW /DSINF: FUNCTION?_ /DSIN$`Xu F: RUN LSTEN FIRST! *** END OF DSINF **`* lY;`bl( Ԅ t5Zt d, lP , kL, DCPL76d ", d tc;`aN D76t l ͋"d l ϋ"d l ΋ PDP,cD,d tt Ӱ,5:`^ɣ$b 6 d >t d *t ,/T .,,T,, ,.d |  ,5d4 t<`_Š5PD,>cZD,Cld l |ZCttdZD,Qdt,HDt 8`_Td,]d  cDdZD t D ,hd t d ,o  ,d,,;`b&$x TIME--- : : t  sdttdu϶t~dvt|@$"SJx d4   ;`\jSdV6Zd (d:d>Ld  *d d 8`a ,d lX Zt d lڋd , S," ,$$ K$ 8 C 24999-16218 2024 A 0100 !TDMP MT DUMP PROGRAM FOR CDA4             H0101 6~'9~Awwg7wwwKwVwg7wwLwWwg7wwwMgg@W/ !/w uoO /$Yg ы2od?o_w98/4gwwG/Eod?gW/<.MPY .DIV .DIO..IIO. .IAY..DTA..GOTOEXEC CLRIOIODVCMEMSZ ISOL8GETSTLOGLUIGET NAMR CODE DATE DISC  DDIFBRKSERCH!`XeJAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC `AeY`AdT`BS-Z`AdU:`c ,>AF$>I6tMtQ tU"t!&Y$t#d%D!t!dt&d(t'<``6ad#D*t)d,t+dt-d,t.d,t/r>$Z.,d t /$۴d,T ;`^KZ,dt,dT t2d1TZ2,,d,T ,,dt+d<`^t-,d3T ,,dZD+,dPt-d-D,dt-,d3 T ,.`Xn8,d4td,T Z,,̶dtdt,d &f `B f(O6)<`_նd5tdt,d3T ,,d,T Z,,dt,d f ;`^<6d5td/PD,t/D,ld-T+,,i, d4td74t6&9t8*`Z6;t: <&= &>=d@D> 6%D,t? '4BAd h Q `E[1d/DBt5 `E"T,d?t/d,D?t0`K4y6d/D,t/D0,1  = `E\ Cd/DCtG `BAdDt/`IHd/D@t/D%,C1`e !h(25X"RTE-IV SYSTEM CONFIGURATION"/25X,"ON ",2A2,I2,","I4" AT"I3,2(":"I2))`JiQd [ A 89`l{C(/20X"CONFIGURED MEMORY SIZE IS "I4" K WORDS",/,22X"TIME BASE GENERATOR IS IN S.C. "K2) `N([d3T:B,id 0i :`Ui(/22X"PRIVILEGED INTERRUPT IS IN S.C. "K2) `F9/id o<`nH(/27X"---- E Q T ----"/3X"LU EQT S.CHNL S.C. ADDR STATUS T.O. DRIVER"4X"DEVICE NAMz `ERE"6X"LU"/)<`aNou>4ZEd,y,|GtFd+DFD@tFd+t/d3tHI,FtJd3TJ#`TZ,,Zd4,,Ǣd  / /!`Xc@(I5,4X,18("*")" LU UNASSIGNED "18("*")9X,I4) :`^R,JL6ER;`]6dD't0&0tSdUtTd3DS,dVtTdWST3Z,dXT4YtTdU;`]ktZd[ST3, d\tZd]ST3,dXZ4^tZdUt_d`ST3<`_)(,!dat_d3tbdPD't0)60tcd3Tc,1,5d,Dctb;$HKd5;`^UJ= td,CP,_dDHPt2dHD2,P,Q,ǢdDt2dD24`d[,^,_,d  0/ M K O ' 0T Z _ bB /$`Z(I5,I6,1X,I5,4X,K2,4X,K5,2X,3A2,I5,3X,3A2,2X,8A2,I4);`^H_Zd,,Ƕd,D&t&d,D!t!d)T&,,6!tdd'Td,,d&"`R=tO,_d&T8,,d 3 2&,`ImC3(21X,K2,33X"TBG") `Pdd&T:,,d &< &,`Ob<(21X,K2,33X"PRIVILEGED FENCE");`]d3Td,,,yd,DFtFd/D,t/D-,d,,d3Dd,,3`[Hܶdet/d3tKdDd LD,tMddt'd&tO,d K 0&`NeK(" NO EQT DEFINED FOR "K2) `N,d-T+,,d Y<`nY(//36X"EQT STATUS LEGEND:"//37X"D= DMA REQUIRED"/37X"B= AUTOMATIC OUTPUT BUFFERING USED"/37X<`n6"P= DRIVER PROCESSES""z) POWER FAIL"/37X"S= DRIVER PROCESSES TIME-OUT"/37X"T= DEVICE"" HAS TIM `DC ED OUT")`HA  6@  *`Cdh`Ad2`Ah`Ah  `Ah"`Bh$`Ah(`Adq*`Adn,`A1SC`Ccv3`Af7@`Ah69`Bhg; `Ad@`CB$`Ah2G`AdL`AdN?`AdP `EU D @B `D[ P S`B`T `Ahe?> dDATE Tc@DATE  .MPY .DIV .ENTR;`f  KtJdKJtLdMTL,&,+;`[&dNDOtQdPQdStRdR dRDOtQ Q,9,FdRZDO dRDS`F=AtRDI,-`A`I `A`K `Da/M`A`S ٦DISC c@>DISC ! L7.MPY .DIV .DST .ENTR.DIO..IIO. .DTA. EXEC ISOL8IGET ;`g$]^4_tZat`$`ccD[tb`]6etd:`^4$`ghtfdjftiltkdbDnDotpptmdhtqdjtrd\tsdjTi<`a}Ƕ,dtts$jbsd0fdjtuds 6vtpdjDqtqdqDk,涀,FdxDu;`_vDjtwdwDyt Tz,,#d[DwDytehZDh,,#dw;`[y[t{d}Dwt|drDxDt~d{Dy~djDrtrdr,,Od{Djt{D|;`\͎", duDjtuDp,djDftfdhTi,6djDftfdmDf,<,dhtf/`YR>dhtid\tsdjDdtd,dxDrB v &W r `Q,(I6," WDS OVERFLOWS LIBARY ARRAY")`A.W,FK `E8[ `Aea`Aac`Aae`Bag`Aaj`Ael`Ben`Aat@`Aav`Cx I`Aa} SERCH c@-SERCH .MPY .ENTRCNUMOISOL8;`ctdZDDtdZD,dDt &t&:`^0#$tdDDtydydDDtyd4ydDDty?$<`]]A4ydtdDDtdDtdDDT,X,dDD;`_S0^,b,dDDtydDDtlol&4ydDDty|yt<`_c_}dDDDttdT,dtǴdT,dtǠd#`O_DDtd4ǶʬdDtZ,E`A``C0`C,..`HDV `Aa`Aa`Aa`B\RR IODVC  c24999-16222 REV.2011 800312 @?IODVCN.ENTR:`mDUMB TERMINAL TAPE READER TAPE PUNCH 2645/2648 :`m-TRMNL MULTI-PT TRMNL PLOTTER CARD READER 2767 LP TV M:`mhZONITOR MARK READER :`mn 9-TR MAG TAPE 7-TR MAG TAPE :`m FIXED HEAD DISC 7900 DISC 7905/6/20/25 DSCFLEXIBLE DISC :`mY WCS HP-IB BUS DATA SOURCE INT. :`m SPOOL  3480/5 DVM 3480/4 DVM 3480/4:`m;/2911 DVM RJE 40-BIT OUTPUT RG:`m'h2312 SUBSY 2310/11 SS 6940 SUBSY 2313 SUBSY:`m%r DS/1000 LINK 2570A COM DS/3000 LINK 6129:`m/30/31 DVS 6940 SUBSY 2321 SUBSY :`mr  2320 SUBSY 2323 SUBSY MUX 264X TRMNL L.CTU264X TRMNL R.CTU264X TRM:`mQNL DSPLY264X TRMNL PRNTR264X TRMNL EXTDVLINE PRINTER 2607-2618 LP 2608A LP 26:`mZ:I08A (GRAPHICS)IC DISC IC DISC (# 2) MAC DISC (# 2) POWER FAIL DATA ENTRY T<`kvRMNLSERIAL LINK KIT UNIVERSAL INF. @px Ld<`et <<, #'5:@.ABCMPRSZ<\,<`Z\Nƶ\,\,\,\,\,\,\,Tl,Tl,D,<`Z lH,TlTlTlTl,TlTlTl,Tl,Tl!`O,Tl,Tl`ZL Q @L MEMSZ c REV.2007 800211 @4MEMSZ .ENTR$MATA$MNP 2`[<dPtlL,t DL<, `B`f$ &ISOL8 -cISOLATE,RIGHT JUSTIFY BITS. 18 JAN 77.@ISOL8N.ENTR;`cK4P, ,t , ,lL?`J_#?O$"$ : E 24999-16224 1902 R 0100 %PSMON              H0101 e W-PSMON 24999-16224 REV. 1902 11-10-786$LIBR$LIBXEXEC CNUMDCNUMOCREATOPEN CLOSEREADF WRITF RWNDF POSNT KCVT NAMR IFBRKRMPARDEXEC<`_g |"|||||X d4} tdt d~d&t%D&,";`bV d&t%d%DGZt'ddT@,4MtS0i5@&;?$}9|t DB;`_A$} ,ZdEF,OT?,TF,, XtW"V, |&|%|$|'| c<`aV`$Dxd,d,d!D",<! xX$)x'dD;t!d),T:,,&;`^Bd;t!d'tdutdNt$BL!|!,dDNtdZDN,lN<`c Ht |X,dW,$J>@>6<,d9t#D%t |$ONΏZ,ƅN#<#<`_¶d$4#<#Ϣ,΅O#<#d$#<#d D# ,T(,d$t$A ,;``-ONϏ$Z ,d9D#t!<"d! @t!d ,d&D%D$,Td;`h,&!.$A*1A$B2S$ATw%"6nd=tduDF<`^)t.d~t /ZD.t.<dP<<,,DlOj}d9t#Zd!,Tt<`]GZI,dVlQ@#`t:\(,d\),`\*,b\+,h\,,fd,jd d ,j;`^=ddd,idZ</l ,lPL@@$v#6lQ|5|9|;<#l#tOl|2;`]Gt OR LU? FMP ERROR - :`ml8 DUPL. FILE. OVERWRITE(YES OR NO)? /PSMON:REWINDING FILE DATA SOURCE:,LU, OR :`mBLANKS TO TAKE 'LIVE' DATA?_  STOP RC TNW RLW RLM ,`a! `M0L1 .&d@ T:`m8?#LOGGED= RX MNEM DATA ASCII CLOCK RX MNEM DA :`mJTA ASCII CLOCK !----------------------------------------------------------------------`Aew#`L}X R YE?_ B ;C 24999-16225 1902 R 0100 %TRC65              H0101 Ly( 0TRC65 -25999-16225 REV.1902 790122 DVA65 'TRACE' PRGM<2%CREATOPEN CLOSEREADFWRITFRWNDFEXEC KCVT POSNT #TRCL #TRCN NAMR RNRQ IFBRKCNUMOCNUMDRMPARTMVAL$TIME7#NODE;`\ |||||||||:||  d4 ZtddTM,}4Zt;`cd,-dt"d"DZt"T,!&\l3M$H[9$L G| t B;`a ?$  | ,d!NTNX,GTL,$Qt dZ,,_dlPNd |)<`b`t  T  ,d ,o oS d ,d 4 tyNd  4 t ,}d 4 ;`e`tW$ ) d  4 t  t*2cd  t$i\0nXLd<`a,mw&x t9< , |||| d Otd,;`bȢdD,<:$  d ,TH,,d9,d,UK$MKJ,<``lꄚ d,dMt( &(  dt /dDtdDtdDtd;`d?P Z ,dDDt,td,Ӱ*" $&*&;`].$1 dIt d0DNt:dtP;D:t:<d<< ,8Dld D <`a_KPt d,XtU \& d8l9 ,gld7\ d6 \ d6ll"M;`]Tl&d td t"d dt Zx,d6l/M"\,\,\,\,\;`],do,dudx,drd~,d{< l.LMBM&ڀ"l|d"T l | <":`c_l "t-l L | @ t<"c" t&lH6<"ʀ"<`\6d.td1td9,d/td0td l- 4Mt dl"|dDs趀t<,;`^<"< ,v,tdJtdtجd 4 t$Nd , 4 t ;`kBt  0X:d , &T t  0  $$(&.Q;`hͼ.3 7$;?& C4.d:,Љtd tvtZ: <`f`V$L"#,t Z |tl d@l| s$: L, { & l ;`dC|جtdtt$ML 4XG| t $ ,d%dWXt%, <`h $: %L$Z"#,TJ,t & %M$(,$M);L 6Ld T ,;`eȄ: $N"#,,*: $Z  ,TH,dP,d,tM$<G;`g:,$M,-[ 6 <<$ MPt);`a&<V)$*+,d, Zpd* TP <TR<R4PL*d/t ;`c5l T<ZT<T<T<LO< ,6/@$ &`\XzDVA65 TRACE PROGRAM REV 1-22-79 TRACE INPUT= :`mw ----------------------------------------------------------------------# REC# ,P`B\ASS#:`m,TIME:  NXRX MNEM DATA STATE EQT# TICK# NXRX MNEM DATA STATE EQT# T`KICK#!LOGGED AT NODE #:`mv ILLEGAL RESPONSETRC65:END RECS LOGGED, RCS, RLMS, RLWS `T STOPS'"FILE <NAMR>?FMP ERROR - :`mCB( DUPL. FILE. OVERWRITE(YES OR NO)? /TRC65:REWINDING FILE LINK LU, -LU TO TRACE ALL,`NBU OR ?_CLASS NUMBER =`CXf RN #=:`mxl(8) p  sSTOPvRC yTNW |RLW RLM  DRIVER LEGEND: :`m ---------------------------------------------- STATE 0:INITIATING READ, SENDING TNW :`ml STATE 1:WRITING, SENDING RC STATE 2:WRITING, SENT RC, EXPECT :`m}TNW STATE 3:WRITING, SENDING DATA LENGTH STATE 4:WRITING, SENT DATA :`m LNTH, EXPECT ECHO STATE 5:WRITING, SENDING REQUEST LENGTH STATE 6:WRITING, SENT:`mM REQ. LNTH, EXPECT ECHO STATE 7:WRITE RETRY STATE 8:WRITE P:`mPzREAMBLE FAILURE--RETRY STATE 9:YIELD FOR SIMULTANEOUS REQUEST STATE 10:W:`mRITING, SENDING TNW, EXPECT TNW STATE 11:PERFORMING WRITE RETRY STAT:`mfE 12:FIRST INTERRUPT IN LSTEN MODE, EXP.RC STATE 13:GOT 'RC', SEND 'TNW', EXP. DATA LEN :`m STATE 14:RECEIVING, EXPECTING DATA LENGTH STATE 15:ECHOING DATA LENGTH, EXPECT REQ:`m.. LNTH STATE 16:RECEIVING, EXPECTING REQ. LNTH STATE 17:QUEUE BUSY, SENDING 'STOP:`m SHOWS OLDEST ENTRY. ^ INDICA:`mgTES TIME-OUT R INDICATES RECEIVE, X INDICATES TRANSMIT :`m(ALL) 0 : `Ah^`R(  &dB&d@4$2`I-> `Bj `N 5`X R >YE?Ǻ <E 24999-16227 1902 R 0100 %SAM              H0101 'm cSAM S (24999-16227 REV.1902 790911 @SAM 3.DIO..IIO..DTA. EXEC CLRIORMPARSAMMYIFTTYLURQ LOGLUUNBUF DUMP SORTR MAP CLASSREBUF`P.)(X,A2," ERROR. TRY A RE-RUN.") ;`_0 6d t d t dDD, dDtdt dDT,,;`g-.*dt <m d  $ ?4T,E,`J&T,P,``MQ&Std 9^ $`Z9(" SOMEONE ELSE HAS LOCKED LU",I6," SO I'LL USE",I6)<`bY^dt cdD,pd )pZ dt dDD,d &)dD<``$Jt dPDtD X,rd , $dtPdDT tdDT <`\-Z,, dD!D,dD!tddD!tZdD!"dDt:`cXD, ,   d , &d#D$Dtd%T,:`^ 4߄ d'4t&(&&dDtd#Dtd(DtdDtd Dt`Lu$ $$  `CcL  `G)DE`BZ`B2, `F:  CL`Bc'@  |MAP D c781207@MAP .DIV .ENTR.DIO..IIO..IAY..DTA.ISAM PNAME<`n(8X,K5," WDS",10X,"FREE ")(8X,K5," WDS",10X,"CLASS",I4) (8X,K5," WDS",10X,"EQT #",I4,10X,"LU<`n #",I4," DEVICE ",A2) (8X,K5," WDS",10X,"RE-EN I/O",10X,"FOR ",3A2) (X,K7,X,9("**"))(/4X,K5,<`n" =SUM OF ENTRIES SHOULD EQUAL BUFFER"," SIZE= ",K5)(4X,K5," WORD GAP. THIS AREA NOT IN ANY <`nQLIST KNOWN TO ME")(8X,K5," WDS",10X,"IDSEG EXT",10X,"FOR ",3A2) (/" FREE MIN MAX"/3(<`n4\J1X,K6)/"L IN USE ""CLASS EQT RE-EN DS STRING LU SM"/3XK5" = "K5" + "<`nxK5" + "K5" + "K5" + "K5" + ",K5" + "K5) (/" START SYS AV MEM #",I2," AT",K7," LENGTH=",K5)(/<`nA5K5," WORDS MISSING FROM S.A.M.#",I2)(/" START SYS AV MEM AT",K7," IN SYS MAP. LENGTH=",K5)(8<`nfX,K5," WDS",10X,"D.S. TABLES")(8X,K5," WDS",10X,"S.M. SESSION CONTROL BLOCK")(8X,K5," WDS",<`n610X,"TURN-ON STRING",5X,"FOR ",3A2) (8X,K5," WDS",10X,"LU # ",I4,18X," DEVICE ",A2) (8X,K5,"`Ts0 WD EXTRA FOR THE ABOVE TURN-ON STRING")<`]. 6 d`t_dbtadaDetd`ضdaDbtaDd,dgtfd`thdbtid`:`^W(tjdbtk0$k[\d\ZD`,7,d\D[Dmtld] Tk,B,[dbDktc<`]GF$JcnodmDnTl,R,[doD\t\dptid\D[Dmtld\Djtjd_tqdr ;``c,g,s  s0k[\d[tsdbtadaDttd[tudaDtDl<``<4u,,daPDtDs,,dr Z,, ZsdaDttds<`atvdbTvtudmDaDwTxu,,  2v,dr ;`]Ķ,, &,vdyDetdyDeDbdbD_t_daDttdaDzts<``ZdaDzD_t_dr ,, &daDttZdaDwTb,,5<`\BdbDetdbDet{daDz{daDztdfZ,daDztfdaDzDh;``-,#daDzthdr ,*,5 5daDzJt3daDwTp,><`^t=,`dpDetdpDet{daDz{dr ,P,`  `da DztYda;`]t[D|t^ZFdaDw}T]Z,j,d]Detd]Det{daDz{daD|<``Nx}t~daD|B }tdaDwB }tdtdb T,dt<`bdpT,dtdr Z,, daDzt~2daDw;`[gZtdtu daDwDd4u,,dDetdDet{ZdaDz{شdaD|;`a}հtځdr ,,daDwZTtudaDwTy4u, %<`adaDztJdaDwTtudaDwTd4u, daDzt;`_)daDwT^Z,&,CdDetQdDet{daDz{Qdr <``6,8,C &CdaDztAZdaDwTx,L,sdaD|tQSQdyDet<``2VdyDet{daDz{dr Z,e,s sdaDztnJdaDw;`^v T,|,ddDetddDet{daDz{dr ,,  da;`^  Dztda D|tdaDtPdaDwT,,d^Detd^Det{<`__*ZdaDz{dr ,, &daDztǂZdaDbta ,wdb;`bѶDltcdsDcPtvdvD`,, sB 0vdqPD_D\;``JPtdD`,, ZkdkDitkD]li ,+dpDetd]<`\DetcdDeDctdDeDtdyDeDtddDeDtd^DeD`Q/Bt <6OdbDet9fh `E\WBdaDetF `BS@dpta"`SGdaDbtaD^P,B Y_Pj`Bc]`Ac``Acb`Bgd`Ag`Acm`Acp`ArIH`Aôt` `Dͼw`0 `BȤ|``Ad `E?BSDNUP`Cu   `PNAME ;c@PNAME  9.ENTRIGET ;`^^kB0t/d1D2Dt3d4D/t553d6D2Dt3d7D/t553 `N_d.D2Dt3d:D/t5(59483`A`r.`Cr0`A`4 `E_6  3CLASS ^ c@CLASS .C.DIV .ENTR.DIO..IIO..IAY..DTA.IGET <`ns(/" CLASS TABLE @",K5," WITH ",I3," ENTRIES."," DISPLAY ONLY CLASS NUMBERS IN USE."//" CL# C<`nONTENTS CODE # REQUESTS")(X,I3,3X,K6,18X," DEALLOCATED, AVAILABLE.")(X,I3,3X,K6,18X," BUFF<`niER QUEUE STARTS HERE")(X,I3,3X,K6,2X,K3,8X,K4," ALLOCATED. NO ONE WAITS.") (X,I3,3X,K6,2X,K`VH3,8X,K4," ALLOCATED. ",3A2," WAITS.")(10K7)<`bNBZdDt dDt2dtdZDDtd ;``t%tdtdT,2,3,dZD,9,D C,d;`bET,L,[ &%Z0,dDDDtdDtg<`_gdDtdDtqdDtdDt{4 @4``ͣ0JdPDtDZ,, [b0  `A``Cv  `B`C!`C=` `B`  DUMP : c@DUMP JW.ENTR.DIO..IIO..DTA.`C7(5K7) <`aBd1t0 &7&d0D2td0D3td.0D4td0D5td0`M!D6t$d0D1t0, `F1 `# plSAMMY 9cEXAMINE S.A.M.(RTE4) WED 11 SEP 79.@ySAMMYLUNITPREBLISAM UNBUFREBUF0gT$LIBR$LIBX#FWAM#SAVM.ENTR$ALC $RTN $PNTREXEC $DHED $CLAS $STRG $SMEM $SSCT$STRK;`bZ  T(,/< H< v< ;`]\"< < 5hv T( dԀTE,D,BP :`^ d?,3d) / l|FF<FtGF<FZ ,s ,s `DԀ:`^~]P*`DЀd ,s`,qh,Wd+ <G,QH c<`]{tGctFF,,,pPDԀcDGԀ,d d, dFD ;`^JtF<G,~vZ,,,,cڀ,<<|t$Z4:`^ d4l dԀڃԀl|䶀dtDԀdtdD;`__ZԀ,dڃԀ,dZDԀ,Z,,tZllt;`_9LL-Ԁd ԀZԀlZd;`_d.  dԀ,4,2PԀԀ  @Ll;`^n1,d/   kK|FctGdFZl0l1|g2,c\,c,aD<`^S OԀcDGd dgԀ,c,Kd3 <F<G,>5??d,u;`_ˈmZd,udh dԀvd vd v:`^dl<<tG < <G,c˴Pt?s$"FdFZ,F:`^9ZtF,DlFP,l@@A ЬtZ,d4 d ,*<<``ȶ<<<< 9dҬ6D- PDC5Pctct;`ff6,<<,cDH @  <`^/@, ,dtdtdtdtdtd<`^Js,tdtԁtԁD t,<,=,>,;ڬ9tYA<A |ZHA;``~JDZD-t[<A ,WlYL[ ,W<AdYA AZ<\\kԀ|w;`^Ij |rL7ԀLw |sA,v<ccc,|,~,R<xxA6҂,,A$`T]e6҂,,A6ЂѬ<< $ `FcT ;`` L- L ߬6L|t8%`V(l dB4%`TjxA<D-C6t'D- Cpd'`Q](ONFRCLEQRESTDNUPLUOV?! TSORTR Nc SORT ADJACENT ARRAYS IN COMMON @7SORTRN.ENTR;`]U[BtItCdCDtJtGdCTI,B,BtDdDDtKtHdMtE;`\'dJK<K ,> ,,<E, ,>tFdJtGGHڂ@GHdGtGdH`H'K;tH<F,1<D,<C, `Aa L`A`MK$ = H 24999-16244 2024 R 0100 %DLB FILE DIRECTORY LISTER             H0101  DLRP @\.CBT # DL LJ24999-16244 REV.2024 800605 RTE-IVB @%IFGLU2tJ$=>(C6Jd(DBlLF ,%,%9`i-#$GtI+HI. @.;$./012~0y# qDLSUB c REV.2024 800605 RTE-IVB @DLSUB W<?Y.FMP .FDV .FAD .FSB .MPY .DIV .DLD .DST ..MAP.ENTR.DIO..RIO..IIO..IAY..DTA..GOTO FLOATEXEC IFIX &<TLOGLUGETSTREIO NAMR STGFD ISOL8 FSTAT JULIAIFGLULURQ IFBRKASCIICNUMDNAMCK ALPHA!MOD "IGET #PURGE$IFMGR%  iAMOD 'ABREG(`C!::`Cp!`Xe `Ap `FbN`Ap`B`B`Bp`Ap `Eq`A$::`Bq `G`A`C$ `Ap`A$- `Ap`PU^T0T]tĢd d`J1(" /DL - REV 2024") ;`\ddU,j,WU tdtȶdtdtd˶tdtdtжdtd<`_$tdtdDİt6dTtdT,,d T,, `FSd 2<`n[2(/" ENTER: Namr filter[,List dev.,List opt.,Special opt.,Reverse ""filter,ALL]"//" WHERE: Li<`n@`st opt. is ,Special opt. is"6X",Reverse filter is,"/7X"'OF' LIST OFF ,'HE' EXPAND HEAD<`nING ,'RF' Rev. NAME FILTER"/7X"'OP' OPEN FILES ,'FC' FILE CNT & SIZE ,'RS' Rev. SC FILTER"<`ni/7X"'PU' PURGED FILES,'BO' BOTH 'HE' & 'FC','RT' Rev. pTYPE FILTER"/24X",'SC' SCAN SEC CODE <`nO ,'RA' Rev. ALL FILTERS"/24X",'PU' PURGE FILES"/24X",'DI' DIRCT. LOCATION"/24X",'DS' DISC US<`nVpAGE SUMMARY"/7X"'EN' END OF DIR. , # OF FILES TO LIST"//7X" ALL PARAMETERS OPTIONAL (EXCEPT `Hj]FNAMR FILTER)"/) `N,dT,,d N`Pl6N(" ENTER FILE NAMR FILTER : _") ;`db0dtڴdT,ĬW, $,dDt $Uy |;```&dtߴdT,,%dDtdt $dT,,<`^dDtdTZ,dt,dDtd 6DtdD,dt;`^1dtdDthZdDhdPDtD, *6tdT,3dt<`_3dT,;dtdtdtVT,Gdt LPtdD,T;`]Rdt,dtdT,`dtd T,hdtdT,pd;`\otdT,xdt,Ŷdt,dt,dtdDT,dt:`^ ^PdDT,dtPdDT,dtPdDT,,d<`]NtdtdtdDtD,,dTZ,dtdT,dt<`^1ƴ dTtݴ dT4ݶtdT,dtd4tdtݢd,;`\#, dtdtжdtdtdtdTtdTtdT`Hr,, d &`P9(" OPTION NOT AVAILABLE TO YOU");`beh,7 &dT,,d T,,dT,$,d *<`n(" **** CAUTION ****"/" YOU 8ARE ABOUT TO PURGE ALL FILES ""LISTED WITH THIS PROGRAM"/" DO YO`LU WANT TO PROCEED ? _") "`Tw*06dT,7,>d =,V`HZ(" DL ABORTED") `FX>d &D`J &(" VETO OPTION ? _")"`TDJ6dT,Rdtd 0X`Q0(" ENTER MASTER SECURITY CODE: _")0`^kXdt`$C hC6VT,o,vd Au,7`QA(" ILLEGAL MASTER SECURITY CODE") *`VyvdtdT,,dƠ T,B,d R0$`ZR(" YOU MUST SPECIFY A CARTRIDGE FOR THIS OPTION _") ;`d}<dt$C C6dt,dƶtdt  T,;`\,dDtD,dt dDtdTZ,,dD,ʶ,dt<`fB̢dtdt   $P T,,   "t   td 6`]t,d Dt ZD,d t dT,dt d l0 `Ql(1X,A2" = ",I5," IS NOT MOUNTED") ;`],VdT,dt,"dDtdtdtdtd T,),@,%`Tq,dTN,3,7dtdBtNd }0@<`n}(/16X"DISC CARTRIDGE UTILAZATION SUMMARY "6A2//25X"AVAILABLE"10X,"A F T E R P A C K"/3X,"C<`n RN LU LABEL SCT/ BLKS/ DIR."" %USED BLKS/ DIR. %USED NEXT LAST DIR"/19X"TRK"9X"EN`V@T."16X"ENT."10X"TRK TRK TRK"/2X,77("-")) <`_y@dtd,KK 6dtdtdT,V,[dDt,dT;`cv_,b,k  t $ tdDtdtdtdt ;``+$,^dZD,,dT,,dtdDth $hd;`\ DthdhdPDtD,d@t@dötdtdt dD t! !;```$PT,,d D"th $!hd Dt D,dt#,d;`^l޶D t#dt$dǶt%dt&dD%'dBD)dt+dT,,d<`h$))dDt+d$).d+.6B0d2026B,d$'.d;`f :$00.0440,486dt:d$:Dt;dT,F,r$K)`Wk?J6t$Pm?,V,?,?v6dT,6dTt<`bY d@T4ݶtdT4td$,,4Bd 0dD`I},,dT,, `EkC(67X,6A2) )`^EXd ΄B@ Ɔ0:,6<`n6(1X,31("*"),5X,3A2,5X,31("*")/32X,"CR=",3A2," LU=",I3//30X,"SECTORS/TRACK = ",I3/" 1ST TRACK<`n+. ="I4,2X"NEXT TRACK ="I4,10X,"NEXT SECTOR = ",I3/18X,"LAST TRACK ="I4,11X,"DIR TRACKS = ",I3!`X9\//28X,"BLOCKS AVAILABLE = ",I6,2X,F6.2,"% USED")`Mζ,dT,d &t`N]t("**** FILES PURGED ON ***")<``X۴dT,,dD,,dTZ,,dD,B,d 0`Hwi"@ &`\$H(/25X,5("*"),5X,3A2,5X,5("*")/30X,"CR=",3A2," LU=",I3/) <`_dtAdtBdƶtCdtDdtEdT,dtdAtF $PFT;`crM"M ,%, FD,2B,C $FDDtDdT,C,dT;`aEtdT,P,dT,W,dTNZ,^,w &Fth<`cf mhN&GdtdDG,wdtdD,},dBt $HFT;`aZ,dtdT,,dBt $FTZ,dtd<``td,,dT,,dDBt $HF dT,,<`_ʶdtIdDt޶dIDt HF ,,dIDtIZD,dD$`S1UPtdD,,dDȴBtd 0`T (" /DL : MORE THAN "I4" SECURITY CODES")<``,7dJT,,)dtKdHDKtL LFT,,)dKDtKD;``/y,,dDPtdD,),dTt FD,<,<`c <dtM $TMBt  M$ZF dMPDtMDX,>dD6OtNdDF<`c6_64NtN TBt d4N dDBtBdBD,v, FT;`\,,dDEtEdDCtCdFDtFD,dtAdDtd$ 6DtL<``3IdDL,,d%T,,dᶀDtd$ DtdPtLdP:`c  0$$DLt $, dTtݴ dT4,,d;`cDEtdt,ydDBtBdCD;tQdD 0,R4R408TdE<`g D;tVdT, , V0,R, , :d  9" "@$0,Q:`k)} +06RVT&0:, d  VB WB@$,Q06&:<`n/(1X,3A2,I4,1X,3A2,I4,I7,"/",I5,F7.2,I7,"/",I5,F7.2,I6,I6,2X,I3) (1X,3A2,I4,1X,3A2,I4,I7,"/",`PUI5,F7.2,2X,18("-"),I6,I6,2X,I3) `N' V d$, \B, d 0 dQ`U@(23X,"DIRECTORY ENTRIES AVAILABLE = ",I5/)`R d,R, vd  vRT'`]%(23X,"BLOCKS AVAILABLE AFTER PACK = ",I6,2X,F6.2"% USED") `N) vdVTQB, d "0 V%`[V"(17X,"DIRECTORY ENTRIES AVAILABLE AFTER PACK = ",I5/) `Ju d#D, d = `Ez d D"t  `B dt `H6 d Dt D#, `Q=(30X,"BAD TRACK LIST"/6(35X,I3/)) ;`_  W,QdTB, ,7dTtdTZ, ,dD, , <`b dDtdZ, d  "@P dD, , d, , d `EZq   <`nU(3X,"NAME",3X,"TYPE",2X,"BLKS\LU EXT RECLEN",3X,"SECURITY",3X,"TRACK",2X,"SECTOR OPEN TO")3`g&^(3X,"NAME",3X,"TYPE",2X,"BLKS\LU EXT RECLEN",3X,"TRACK",2X,"SECTOR OPEN TO");`aj d, , !$ TBXd, , dZtYdXDBtZdZ 6t[" Z6t\d[<`[ n Pt]d\D, dD]t]dtKdKD^t d dKDtKD, dt_dtK<`[h, d\t`dD_t_dtad_tbdtdDbtcdƴPtddD`, 7dtddTb:`h :, >, Tc4t $TbP t Tc4t* $Tb:`c bZ*t T&cte Tb e, dtd_ Tb, ;`\ , ddD[Dtad, dD_t_dT, , dDataddD[Ta-w<`^-T , , dtadD`t`dtfdYDfD^t Tfb dfDtfZD, d<`]3' PDYD^T, dDYD^t dg dDYthdDYtY dT`tݴd]TK<`_z ܢ, , dZDY, ,  6hdtYdbDtbDB, (dKDtKD]<`a , dTY, dDYtL 6L,'dtidtMdtj TMtkdk<`a. B ODtdmkB ضDtldnktdTM, 7, FdoT, >;``r =, FdpT, E, F, R$ N &dtodtpdktqd, Z, v <`eb ]$l T, hB, $l tqdq, , ʹdT, , ;`g  $PlTt $lZT4t $PlTP4, <`a Z, ad, ,  &lt  $ڋrtjdjZDs, djZtsd, , Ԣdj,:`cO , ,dTZ, , a $PlT, lt d d;`h6 B, $Hlt dB  $Hlt $  lTB,  :`h+ $lt)dgB) $lt) l  ) lBt) <`cG =$ln)dTtdT4, P, q l6t)dDl4) <`aE `$lt)d) $lt)d)dBTMZ, {dDMtMdT, <`a , dtt utt)d)dtDttD, dtdHDtL L$l<`a6 T, , ,# wDtvdHDtL Ll"ytxdxDvtL# LD=tzd:`^g ötKdD{tL uLK6t)dKDzDᰚt|# |)dKDtKD, dt}dH<`b DtL $Llt)d), d~t}dD{tL uL&t)dD{@t| <``>U $u|4})dD{Pt{dD{, dtdtKdD{tL uLK4t)<`^ #d)dKDtKZD, dPDtD, dTj, ;,d Tj, B<`_ A, ZdtKdKDBt) $Kl)dKDtKDH, Ddt,dTs, a3`bu `P,dD, g, d & 0s0`J  u&Kt  `B dtK`G dKDtKD, `B dt<`a dDtDZ, dDsBdt,dtΆ6dT, , "`QX dT, , dtdBtd N0 `P,N(" PURGE ? (YES, NO, ABORT) _") ;`a.P ɶdt $dTZ, جdT, ,V0dsDiDti<`b3 ꄒ$ &% $dtsdtdBTMtdTq, P, dBDM"`P tdTqZ,,dq, , Ԡ, 1`e(E(2X,3A2,2X,I3,4X,I5," +",I3,2X,I5,3X,I6,"=",A2,3X,I4,4X,I3,4X,3A2,1X,3A2) *`_(2X,3A2,2X,I3,4X,I5," +",I3,2X,I5,2A2,I4,4X,I3,4X,3A2,1X,3A2) :`cl $PlTtdTZ,0,IdD,6B,:d  B ;`j?$ltDB $ltNB $ltXB $ltbB $l;`j i6tl l6tv Hl6t B $ltB $l `DT,6t`J u&Kt `BdtK`G"dKDtKD, `Bdt;`cg"ݴdDtD, ldtdtd{D,d `J} u&Kt `BմdtK`G"ᶊdKDtKD,`Fd϶dDtdDtL+`T52越dDtDLZ,dDtD,dt{dt`H%(64X,3A2,1X,3A2)`H%(52X,3A2,1X,3A2)<`c6dT, ,:dTZ,,dtdt,  &lt) ;`iHlt*$,$)* lt9%:$ď9 $l T,H,+``~(2X,3A2,2X,I3,4X,I5,7X,I5,3X,I6,"=",A2,3X,I4,4X,I3,4X3A2,1X,3A2)$`ZD(2X,3A2,2X,I3,4X,I5,7X,I5,2A2,I4,4X,I3,4X3A2,1X,3A2)<`fFHP,dD,O, $l 4t $ltd $ ;`j<nl6tv l6t l6t l6t0`N2i B $Hlt`S9(2X,3A2,2X,I3,4X,O3,I2,15X,I6,"=",A2) `N_"(2X,3A2,2X,I3,4X,O3,I2,2A2) <`_`dBDMtݴ dTs,, a"W,QdMDtMDB, diDBtBd$ ;`fF2&t'&Z&tdtddT,,'$$`TdDtdD,d ^`S\^(" SECURITY CODE ",I6,"=",A2," HAS A")7`_ dTtݴ dT4ݶtdT4,,'d q0B8`kq(/" TOTAL OF ",I4," FILES USING",I4," TRACKS AND ",I3," SECTORS (64 WORD SECTORS)"//) `IB,'d 0'!`XS(" DIRECTORY TOO LARGE MORE THAN",I5," ENTRIES")<`b}'dDtdƠPT,776dDtD,Bd,G7G &d`M*[I,K,Qd &BQV$`N(17(" *"),"END DL",16("* "))`G VBWd 0]$`Zn(" /DL : PARTITION TO SMALL INCREASE SIZE OF DL !") <`bl]W(bdT,i,dT,p,$v  tdtdTP,`KC*B,yd 0 "`Y (" /DL :"I5" ERROR TRYING TO MAP LU"I3" INTO SST")`L B,7d 0`K(2A2,2X," DL ABORTED")`A.W`Ap`Kr!(@ `Aq`A `A  `A `A  `A `A5 `Bq`B??HE`Aq!`C|$M`Aq1`MOSFLFNORFRSRTRAALOFENPU`H@^ DISC `DYEc`Bv `E CRLUFCDS `AS`B `D$? `A" G`BՈ8d`Bq= `A@BO`AqH `AJOP`ByO`A^^ `Ag--`By.m`Aqr`A^u `Augw`Ary`Bp~-`Be$ `A `B Y A `B$:`A`Ar?`B[IO12WW ASCII ]cCHECK FOR LEGAL ASCII 790720@ ASCII N.ENTR;`^BdRtQdTtSdU,,0dVDQtXdQDW4X,,-dS<`]}_ZDYtXdZPDS4X,*,-d[dVDQtXdQD\4X,;PtQdYDS,CdYtSdTZDS,KdYtSdQ4S`AaR `DT _ `D;Y ` ~" HNAMCK cREV. 1924 790614 CHECK FILE NAME @&NAMCKN.ENTR;``tttZttdtl |<,T,IT;`] P,-d,( <D,,<d,5<<,,||d,>PdD,i<`] =Zt[tlZttd,o|d,O|,d,VdDDt[t<`_Z,l"[<Z,i<,\tlZdD,yttd,,|9`_#yd,iZd,|d,dtDZ,,i[,|-+ wALPHA Zc REV.2020 750120 @ALPHAN.ENTR;`]&tSZtWtMdMDtTtQdMTS,J,JtNdNDtUtRdY;`]> tOdTUP<U ,F ,9<O,"p4VUV<WU4VU,FdXtPdTtQ'`Pm=ZQR@QR<Q<R<P,=<N,<M, dW `DaV& JULIA ocTIME ROUTINE A.T. 14JUN79 <<21MX ONLY!>> @JULIA 9EXEC .ENTR;`cgBKl6dl9L:>T<( IFG.LU vc92067-16125 REV.1903 780926 @ FG.LUl$SMVE.ENTP$LIBR$LIBX:`cOtE6tpd7 ,pcD8ƒԀt=$:=;t?;`_#T@,DDA6״Zt TB,F<>>BT,F<?,-d9,p* .Z- ;`^ cB<EtCtl 6T6|T|C,JdslELC ,pdrlC l ,p<E$`V`Pd4|mL|uo$t=u:BH >O 24999-16245 1932 R 0100 %DLA              H0101 3T DLRP @\.CBT ) !#DL 4J24999-16245 REV.1932 790917 RTE-IVA (& RTE-III) EXEC COR.ADLSUB;`dcF+)cϔ t Ct0D/,t0,cD.t3$'( -36&d D,t1#01`Pc$$&*~ 1DLSUB cREV. 1938 790917 RTE-IVA @DLSUB <?I.FMP .FDV .FAD .FSB .MPY .DIV .DLD .DST ..MAP.ENTR.DIO..RIO..IIO..IAY..DTA..GOTO FLOATEXEC IFIX #6LOGLUGETSTREIO NAMR STGFD ISOL8 FSTAT LURQ IFBRKJULIANAMCKALPHAASCIIIGET PURGE!IFMGR"AMOD $`C::`Cm J!`Xd}% `Am M `Fb`Am N`B`B`Bm O`Am} < `Em Q`A ?:: `G| 5`PE_0 Wt Vd V  `J5@ (" /DL - REV 1932") :`^ᢊd X,, +  @t Yd At Zd =t [d Xt \d ]t ^d `D Vt _$ a bd c.`YZTt ed dPT e, ,d IT b,,d V  <`n$ (/" ENTER: Namr filter[,List dev.,List opt.,Special opt.,Reverse ""filter,ALL]"//" WHERE: Li<`n;)st opt. is ,Special opt. is"6X",Reverse filter is,"/7X"'OF' LIST OFF ,'HE' EXPAND HEAD<`nWING ,'RF' Rev. NAME FILTER"/7X"'OP' OPEN FILES ,'FC' FILE CNT & SIZE ,'RS' Rev. SC FILTER"<`ne/7X"'PU' PURGED FILES,'BO' BOTH 'HE' & 'FC','RT' Rev. TYPE FILTER"/24X",'SC' SCAN SEC CODE <`n_M ,'RA' Rev. ALL FILTERS"/24X",'PU' PURGE FILES"/24X",'DI' DIRCT. LOCATION"/7X"'EN' END OF DI3`gq~R. , # OF FILES TO LIST"//7X" ALL PARAMETERS OPTIONAL (EXCEPT NAMR FILTER)"/) `NE, d XT b, ,8d V &`Pg(" ENTER FILE NAMR FILTER : _") ;`d&, A _0 adt bd XT b,7, >$ b Q,d AD St S $K SK <``oJ6d =t gd X T g,U,d iD Qt hd At j b h$ ? A j kd X T j,i,ud i<`] jD ht kd hT b,td ht k,xd iD kt kd kB  ID At ld At jd jD mtd jD n;``dd jD At jXD l, $ I =t gd XT g,d it Pdt odt R $ G p;`[Pt gd gD X,dt N,8d =t gd AT g,dt q,8dt U,8dt T,8:`^ ^¶d At jd jD r T s,ζd tt 6d jD r T u,ضd tt 7d jD r T v,;`]d tt 8d jD r T w,,d tt 6d tt 7d tt 8d jD At jZD =,d xT U:`^h,d At Z(" VETO OPTION ? _")"`TiCI A _ ~6 d T ~,Qd At Od V dW`QLd(" ENTER MASTER SECURITY CODE: _")0`^Wd At Q_ A$ V  g6 QT,n,ud V ut,6`Qu(" ILLEGAL MASTER SECURITY CODE") *`Vud t Md AT O,~,d X T R,B,d V 0$`Z(" YOU MUST SPECIFY A CARTRIDGE FOR THIS OPTION _") <`bvd V  R,~d Xtd At $ A @ T X,,d D At D ,d:`^t d iD d t d AT Z;`b,!,&d >D nt o,sd AT >,-,6  A J" @t  I J @t d AD J<`_jAt Jd t d Xt d Xt d IT ,O,Sd t d At [$ A = 4P d ZD A,a<`_s`,>d T ,h,d At d D t  A Ed D At ZD =,jd <`bmItd@t d At d FD t  A ET X,,d D t  $P A E<`]d D At D G,d Gt ,d iD t dCt dDt dFDD d Xt d XTB;`e,,d i  dBDCt d   d   d I 0   dE<``:3t d  6 @D it d IT Z,d D t d qT V,,'$ q At d XT !`SyrZ,,'d XT \B,d V 0 q`L~(1X"WAITING FOR LU# "I3);`aZd At \ $ X I X $P" , *,,d dT Tt ed T T4 et d |T T4 9``7t 4d t$ 4,>,mAd q JJd ZZD A,P,md T M,W, `Ef(67X,6A2) `UDWd q lB  C0FB <`n0(1X,31("*"),5X,3A2,5X,31("*")/32X,"CR=",I5," LU=",I4//30X,"SECTORS/TRACK = ",I3/18X,"NEXT TR+``ACK = ",I3,10X,"NEXT SECTOR = ",I3/28X,"BLOCKS AVAILABLE = ",I6)`Mjl,d T M,yd q &$y`NX("**** FILES PURGED ON ***")-`ZNyd T M,,>d <D X,,d q   %`[ (/25X,5("*"),5X,3A2,5X,5("*")/30X,"CR=",I5," LU=",I4/)<`_d It d At d Xt d Xt d Xt d XT T,d Xt d t   A$P ET X;`c4,,b  A ED X, B,  $ p ED t d }T U,,d {T U;`aKt ed T  e,඀,d {T U,,d XTZ,,  A& Et<`cѠ G& k d 6t 9d XD ,d 6t 9d XD P, ,d 7Bt :  $ ET o;`ajZ,d 7t :d iT N,&,8d 8Bt ;  $ @ ET NZ,8d 8t ;d : 9<``: ;t 5d 5,@,d |T T,G,d ZD nBt  $ Ed AT Z,Z,w<`_{7Zd At d iD Zt fd D nt  E,p,d D At ZD f,_d AD Z$`S yPt Zd ZD B,,d iD ZBt Zd V 90 Z`Tn9(" /DL : MORE THAN "I4" SECURITY CODES")<``h,6d T U,,d At d D t  ET X,,d D At D p;``,,d iD Pt d XD ,,d }T Ut e  A ED X e,,<`c6u̴d At $ @t  $Z Ed PD At D =X,d D 6 t d iD <`cB6 `4 t  @ @td 4 d AD t d D Y,,  A ET i;`\,,d AD t d AD t d D At D D,d At d AD t d 6 ID it <``.d D ,5,Hd T ,<,bd iD t d  ID t d  t d :`cbgN  0  D t a A $= , d {T Ut e d T 4 e,o,vd T;`_,qD t d t ,Dd iD t d D t d  I0  d D t d t$ 4`J,,d q &M `UޝM(23X,"DIRECTORY ENTRIES AVAILABLE = ",I5/)`P@  ,d q b À`Ub(/23X,"BLOCKS AVAILABLE AFTER PACK = ",I6)`Nd T B,d q w0 %`[Q=w(17X,"DIRECTORY ENTRIES AVAILABLE AFTER PACK = ",I5/) `J`Nd D X,Ѣd q  `EyĶd D t `B´d At `H$ɶd D At D ,`Qd(30X,"BAD TRACK LIST"/6(35X,I3/)) ;`_Kф , $d XT ,, d |T Tt ed {T UZ e,, d <D X,, `FYYd q <`nT(3X,"NAME",3X,"TYPE",2X,"BLKS\LU EXT RECLEN",3X,"SECURITY",3X,"TRACK",2X,"SECTOR OPEN TO")<`cd {T U,,d }T U,,$ d At d it $ @ @t d ;`_Z D t d   `D At d ˶ t d AT ,1,@d ̠ T ,8,@<`aF8d T ,?,@,LH$ A = 6 d t d t Ͷd  t d {T UZ,V,r <`e ,Y$ @ E T X,dB,  $ G E  `t ΢d ,,ϴd XT,~,;`gO~  A$P ETt e $ I EZT4 et   =$P ETP4 ,<`cF, Td {T U,,  G E 6 `t d D ,d t d { T U,:`cȴP,d , ,, d XT,, T  D " ET X, $ D Et<`h`qd  $ Et  A " ET i,  $ A Et d ;`hK" $ p Et   p$ E  I  G 4 Et $ G E d {T U;`c ;t ed T TZ4 e, E, f  D& Et d iD Ɇ E  H Et d <`_ ^ G Et d d T t ed {T U e, ud AD t d T%Z, |, d A<`bo }Bt  $ A Dt d Ӷ d D At D =, ~d At d D t  ET X;``W , , d D Bt  $ E D t d At d AD t $ Dt d D ;`_ D it  ض d D At D =, d Ct ٶd D t  EPt d X , ;``+{ ޶d t d AD t   & = Dt d AD נBt  $ = D ۶4 d AD t נd I;`^ ZD , d It d At d AD נBt  $ Dt d Ӷ d D At D =, d D A<`^ t D p, d {T Ut e d XT  e, ., d iT Z, 5, Md At d D rt <`` :  $Z E d PD At D , 7d t, d X T , TP, d <D X, Z, &`[ Zd q  0 0`J y  & Dt  `B wd At `G d D At D =, y `B ud At <`_ d D At D Z, wd t ^, d ]t ^d AD φB K Kd T M, , d XT O`Oi Z, , Ͷd t d t d V  `P(" PURGE ? (YES, NO, ABORT) _") ;`d  A _ ~6 d T ~, Ŭ d T ~Z, , * !  $ " $ F Vd Xt ;`^&J ܶd Xtd T t ed {T U et d XT  , P,d D t ed XT `J  e, , d Z,,,1`e'D(2X,3A2,2X,I3,4X,I5," +",I2,3X,I5,3X,I6,"=",A2,4X,I3,4X,I3,4X,3A2,1X,3A2) :`c /   @$P ET Xt ed2 T TZ e, , -d <D X, B, d q  B  ;`j<9 '$ A Et ,B  $ I Et 6B  $ = Et @B  $ @ Et JB  $ p ;`jP Q6 Et T  D 6 Et ^  6 Et h B  $ H Et tB  $ G `DJ {6 Et ~`J   & Dt  `B d At `G d D At D =, `B d At .`X d D At D Z, d At d I t d ZD , d q & `J   & Dt  `B d At `GP d D At D =, `FLr d AD t d ID t +`T Ŷd D At D Z, d D At D =, d Xt d Xt ܬ ^`H%(&(64X,3A2,1X,3A2);`b ٴd T M, , d XT O, , d t d t ,  A 4 Et $ E;`i+ t !  $  A Et "  F$ V $ @ E T X, B,  p`H+ $$H E0 K K+``}(2X,3A2,2X,I3,4X,I5,7X,I5,3X,I6,"=",A2,4X,I3,4X,I3,4X3A2,1X,3A2)<`f g ,P, d <D X, 3, $ H E 4 t $ H E t d q $. ;`j R A 6 Et Z  I 6 Et d  = 6 Et n  @ 6 Et x0 `Nv | B  $ Et  `S8.(2X,3A2,2X,I3,4X,O3,I2,15X,I6,"=",A2) ;`apc d D t e d XT  e, , T " , $d D At D , d 2 I<`dJ 0  K #t $ K2 #t d I6 t d X6 Kd T T, ,  & o d ZD At e`P Ϣd <D X eB, d q A0  o Ѐ`SVA(" SECURITY CODE ",I6,"=",A2," HAS A")7`_ ߴ d dT Tt e d XT T4 et d {T U4 , , d q T 0   8`koT(/" TOTAL OF ",I4," FILES USING",I4," TRACKS AND ",I2," SECTORS (64 WORD SECTORS)"//) `I B, d V 0  Y!`X6(" DIRECTORY TOO LARGE MORE THAN",I5," ENTRIES")<`c d ZD At ed XPT < e,   = y6 id >D At >D ,d q  $$ ) = y i, *`Ni(17(" *"),"END DL",16("* "))`GԺ *Bd V 0 1$`ZQ(" /DL : PARTITION TO SMALL INCREASE SIZE OF DL !") `AF 1`Am =`Jnn @  `Am X`Aw ] `Bnf ``B) c??HE`Am i`B m$`Am p `G& r RFRSRTRAOF `DX z@ENSCPU `D_ YEc`Br `CC CRLUFC`A `Bnb `B $=`A `Am `C  `AA BO`An `AM OP`Av `Bu `C --DI `A; %`BmI -`B $ `A `Ae AB`B% $  `B~+ @`Anl ? YASCII 3c@ ASCII N.ENTR<`^Bd,d.Zt-d/t1D041,d/d2D-,d2t-`Lgd.T-,&d2t-4-`Aal,`C. ~`As2 " HNAMCK cREV. 1924 790614 CHECK FILE NAME @&NAMCKN.ENTR;``tttZttdtl |<,T,IT;`] P,-d,( <D,,<d,5<<,,||d,>PdD,i<`] =Zt[tlZttd,o|d,O|,d,VdDDt[t<`_Z,l"[<Z,i<,\tlZdD,yttdՐ,,|9`_#yd,iZd,|d,dtDZ,,i[,|-+ P1ALPHA Qc REV A 750120 @ALPHAN.ENTR;`]SltKtEdEDtLtIdE TK,D,DtFdFDtMtJdPtG;`]xdLM<M ,@ ,3 <G, p4NM4NM,@dOtHdLtIIJ@IJ`I+<<I<J<H,7<F,<E, `Ca N& JULIA ocTIME ROUTINE A.T. 14JUN79 <<21MX ONLY!>> @JULIA 9EXEC .ENTR;`cgBKl6dl9L:>T<(< ?N 24999-16246 2024 R 0100 %DXREF SEARCH RELO. FILES             H0101  DXREF J24999-16246 REV.2024 800529 @%DXREF <.MPY .DIV .DST ..MAP.DIO..IIO. .IAY. .DTA..GOTOEXEC CLRIOLOGLUGETSTNAMR REIO CODE RWNDFREADFCLOSEaFILTROPEN LOCF FSTATASCIIIFBRKNAMCKALPHD`C݊::::`Cݐ::::`A`C`Ar`A`Aq`Cq`Aq`Cq`A `Df'NO FILE `Aq`As3,`Cq:`^x6t&dDtʶdtdtdζtdtdtѶdtdt;`` $ , dtׄ   :& C CdD, , 5dضtdtdDڴt3d<`\Cu $D3dDբtD, dtdtd̶tdtdܶtdT, B<`^q @dt, dZD, J, dtdtd٢DT, YdtPdDT;`_2 ^, ddtdDTZ, odtdD T, zdtdD;`_ } T, dtdDTZ, dtd٢DT, dtd<`]` DT, , dtdtdtdضtdDtD, Nd, dt;`\ Zd, dδ td, ŶdtdtdضtdT, dtd444;`] բ4, dtdT, dtdDբtD, Zd, , Pd, `G[ B, Td 70 `L7(" FILTER OPTIONS ? _") ;`b  0 dTZ, , T dTt dT, , %d 6t ;`_h 4@d 0 %  ̶dtd4춀tdTtdT, 8, LdҠt#`Y :d C S   0     0 <`noC~(/" ENTER ANY SEQUENCE OF THE FOLLOWING 2 LETTER CODES"/6X"STATE"/" LIST = "I3/" LO - ("L1<`nq") ASK FOR LISTING OPTIONS"/" MO - ("L1") ASK FOR FILTERING BY MODULE NAME"/" EN - ("L1") <`nASK FOR FILTERING BY ENTRY POINT NAME"/" EX - ("L1") ASK FOR FILTERING BY EXTERNAL REFERANC<`n aE"/" RE - ("L1") REPEAT FILTER QUESTIONS AS SET ABOVE"/" SE - ("L1") SET ALL FILTERS INITI<`n6qALLY ONLY"/" BA - ("L1") "4A2"WILL BE USED AS BATCH FILE"/" AL - ASK FOR ALL FILTERS"/" N<`n))O - (OR 'CR') LEAVE FILTER OPTIONS AS IS"//" NOTE: ANY CODE ENTERED WILL TOGGLE CURRENT STA`CWTE"/) <`] S, dtd, [, dZD, b, dD, i, d, m, , dt<`[A pdDt3dD3dDtZD, pdtdtdDt3dD3dD<`[ tD, dtdtdtdtdնtdDt3d٢D3dDՠt<`\ɻ D, dtdtdtdضt, dtdضtdtdt dδtd `DE „Z `VZ("/DXREF: SUPPRESS FILE NAME REPORTING ? _")<`c Ƣd p ͆ dT, dt &dD, , d 6tdD*`W/ , , d,  dtdt, d r  `V` r("/DXREF: READF ERROR "I3" IN BATCH FILE") <`^ dt , dtdtd, dtZd, ,  dtZ, d, , `I> d, 'd  '"`Yq("/DXREF: ('CO' => CHANGE OPTIONS: '::' TO STOP)")`H 'dtd & /`U("/DXREF: ENTER INPUT FILE NAME (LU): _") <`a / 50 dTtdT, E, dTtdT*`V P, S, dTtdT4, `B, gd 0 f`Nl(" NO FILE CURRENTLY OPEN") <`^ f, dtdt dTt dT, x, 8dTZ, ,r dTt<`` dT, ,rdTZ, ,r dtdt $dtѴd;`^q t, dT, ,rd,  dT, , , dtd, dt`OI ¢d, , d, , d  $`Z2("/DXREF: LIST OPTION : ENT, EXT, BOTH, OR NONE _") `G~b Ѣd  ؄ `BΊ(A2)`O آd, , d, , d  *`_F("/DXREF: ENTER MODULE NAME FILTER"6X"( - = DON'T CARE): _") #`T 焒 d, , d, , d  ,`aR("/DXREF: ENTER ENTRY POINT NAME FILTER"" ( - = DON'T CARE): _") #`T8  d, , d, , d  +`` ("/DXREF: ENTER EXTERNAL NAME FILTER"4X"( - = DON'T CARE): _") ;``  dtdD, , #dնtdT, 'dtd, +,  3$<`c /$dZD, 9, dtdD, A, k J$& MdtdD ;`]\ R6DtdDT, ^, ddDDt, kdDբtD, OPd, p8`] o, ndTtd T4, }, d, , d t dt d @ `K@("FILE NOT PROCESSED")`L B, d K0   00`dgK("/DXREF: FILE ",4A2," IS TYPE ",I5,". OK TO USE AS"" BATCH FILE ? _")`G| d p  `Bp(A1)`M4 dT, , nd &o `Ro("/DXREF: OK TO PROCESS THEN ? _") +`Zc d p  dT, , , d  Ɔ  `T(" FMGR ERROR ",I4," OPENING ",4A2,".") ;`a m ƶ, dtdtƶdt d t d, , # բd  B     dt<`]4 $ dTZ, , dDt3d3dDt3d3dDt3d3dT.`\N , , dD, dD̰t 0 & $ `WE(" * FILE NAME: ",4A2,":",I5,":",I5,":",I5) <`b dtϬ  &4T, ,, dD, 3, M$ :4PdD, A, bd`Jd< B  L 0 `Rk-("/DXREF: READF ERROR "I3" IN "4A2);`_ L, dDt$ V dtdT, b, dT, i, ldΠt;`^% k, dT, s, #dtdT, }, #dTtdT, :`^S , #dT, , dDtdtdtdtdT, , $  :`^E 6dT, , #d tdtdDt3ZdD3dԴPDtD<`Zw Ŷ, dtdtdtdtdܴPtdD, dDt3d3dtdtd;`_+ ߶tdt dt!dtdt "6t3d3 #6t3d3d٠D<`^& tD, 越dDtD, , #d$TZ,,d,, #d,dt<`_2dtdt%dtd t&dT,.,?d&Dt383 $dT<``.;,?,dZTtdPT4,L,dt " 6tdDD&D;`b%[dT,u $" t "$Z '4dDtD,Nd;`\&`}D t dtdZD ,,Vdt,gdtdDtD%,#, #d(T<`\2,,d, , #d,dtdtdt%dtdD Dt&dT<`ao,,d&DtÎ$ dΠ T,ʶ,dTtdT4,;`cyֶ,dt #!t)dDD&D)dT, #!Bt) #<`]$!'4)dDtZD,dնD!t!dtdZD!,,dt,gd;`[tdDtD%,, #d* T,&,Bd4tdtdD+t)dD<`\1D)dDբtD,,d-t,d.t, #d/T,I,^dD t d<`_kMD!t!S0 WO!dt0d D0,`d t0d!ZD0,gd!Zt0dtdΠT<`^Ul,sdtdt dT,dtdZ,,P, #dD%`R",,dtd,,d1t , d &:`m(/3X,"MODULE",37X,"ENTRY PTS",5X,"EXTERNALS"/,3X,"------",37X,"---------",5X,"---------") `G{d ΄  `ENdDt `Bqdt`G'_dDtD, `EodDt `Bdt`G'dDtD, `Ed2Dt `B Edt2`H8ƶd2Dt2D,,`af(1X,I3,2X,3A2,",",I3,",",I5,",",I1,",",I4,4(",",I2),2(/12X,30A2)) ;`[ζdDtdD3,dD϶tdtd5t4dD!tdD ,dt4*`Y(T,, dΠ T,B,3d  0-  4`J "&t  `Bdt`IXdDtD, 4`Jd #2&t" `B `dt2`J:uw#d2Dt2D, 4,`a (11X"PROGRAM LENGTH (IN WORDS)=",I5,A2,4X,3A2,2X,A2,4X,3A2,2X,A2) *`V -dtdDt϶,5dT,:,td -n  4`JbE "&tN `B 3Cdt`IY OdDtD,E 4`JZ #2&tc `B Xdt2`Judd2Dt2D,Z 4&`\-(21X,"WORDS IN COMMON="I5,A2,4X,3A2,2X,A2,4X,3A2,2X,A2) *`VndtdDt϶,5dT,{,d I  4`J "&t `B tdt`IYdDtD, 4`Jh #2&t `B dt2`Jv{d2Dt2D, 4(`^LI(16X"BASE PAGE ALLOCATION="I5,A2,4X,3A2,2X,A2,4X,3A2,2X,A2) 0`[sdtdDt϶,5dT,,d g  ,  4`Jp "&t `B ʴdt`IZֶdDtD, 4`J #2&t `B!(ߴdt2`Jw붊d2Dt2D, 40`dg(5X"EMA BLOCK "3A2"(MSEG="I2")="I5" PAGES"A2,4X,3A2,2X,A2,4X,3A2,2X,A2) .`VwdtdDtϴZ,5dD!tdD ,,5d $2`J  "&t `B  dt`G*KdDtD, `Jr  #2&t) `B!gdt2`K:*d2Dt2DZ, dDϠt`S7(43X,"*",4X,3A2,3X,"*",4X,3A2,3X,"*") <`]5dDtD0,d0tdܶtdDtdΠZT tdΠPT!,P,Wd `DUWRV`Hk(13X,30("* "),/)`GpVB, #d 0]`B$(/) `IE]B, #d 0f `S!n(" RECORD TYPE ",K6," NOT PROCESSED.")`LHfB, #d 0q  ,  #$`Z(" ENT("L1") OR EXT("L1") ARRAY OVERFLOW (300 MAX)"):`bzarud,{{dDtdT,dDt6$6d `H%("$END DXREF.") `C5 `DrM@ `Ds9 ,`Aq`As `Ar`A `A `Ar`A`C$`KhLOMOENEXRESEBAALNOLLLI `D ? Y `F= `ArG `F: CO::/E `Are `Dz `Aq # `E| @`As `FY`  `C۶"$O@`Bi'`B?J*`C2z- `A1 `Ar30`A5 * >FILTR dc24999-16246 REV.2024 791009 @$FILTR .DIV .DST .ENTRREIO MOD ;``6dZtYdYD\Dt^d]^dYPDZtYDX, d_t[$ Z[`<`_3A"dd WDZta0WTbZ,?daD\Dt^daD\D4c^dZtY*`TAdYD\DT]Z,KdYDZtYDa,Adb`B`W`A`Z`B\--`Ba_`B`b- {ASCII ]c REV.1929 790720 @ ASCII N.ENTR;`^BdRtQdTtSdU,,0dVDQtXdQDW4X,,-dS<`]}_ZDYtXdZPDS4X,*,-d[dVDQtXdQD\4X,;PtQdYDS,CdYtSdTZDS,KdYtSdQ4S`AaR `DT _ `D;Y ` ~ ALPHD Ic REV.1939 790928 @ALPHDN.ENTR<`^Jt>d>HDtDtBx0.*d>TFZ,=,=t?d?HDtEtCdGt@dD<`\q! E<EZ ,9 ,,<@, ,9dGtAdDtBBC@BC<B<C<A,0<?,<> `B<,`C`F COMMA ,c REV A 751031@COMMAN.ENTR;`^B5 t$t%&T(,d%'T),,d%D*t%,d%D+`N Id%<<$, ::" HNAMCK cREV. 1924 790614 CHECK FILE NAME @&NAMCKN.ENTR;``tttZttdtl |<,T,IT;`] P,-d,( <D,,<d,5<<,,||d,>PdD,i<`] =Zt[tlZttd,o|d,O|,d,VdDDt[t<`_Z,l"[<Z,i<,\tlZdD,yttd,,|9`_#yd,iZd,|d,dtDZ,,i[,|-+9=0 @ M 24999-16247 1938 R 0100 %SCB              H0101 ,j fSCB K24999-16247 REV.1938 790213 @SCB <.MPY .DIV .DIO..IIO..IAY..DTA.EXEC CLRIORMPARLOGLUGTSADGTSCBOPEN READF MOD MOVCAIGETBBLANCCODE =JASC ;`b!$6dDtdT,21t5tdDtdTP,A;`c{@,sEdTB,Qd =2QdT,X,d T,id Ri`FcdDtg`SIR(/,X,"SYSTEM LU#",I3," NOT LOGGED ON");`bidT,p,dDt넒y6dT,d &Z=dTP,`A4,`Uvt=(/,X,"** SCB RUNS UNDER SESSION ONLY **") `THe &dD,d &e(`^e(/,X,"FMP ERROR ",I4," IN SCB WHILE OPENING ACCOUNTS FILE") -`[MdD,, $dZD,d 0,`ay(/,X,"FMP ERROR ",I4," IN SCB WHILE READING FROM ACCOUNTS"" FILE");``=dD,,dDtZdDDtd  6DDt $T<`d%k۴,d  Dt $&dD,d &dD,,;`bK t TZ,dtd DDtdDt&dD<`bn!t$&$tdDt,$.,dDt6dDt8$;686dDt@$B@t<`_\$CdDtHJ&ڃHdDtRdDtTW$RTdtdDt}d},cd:`^ybtdDt}dZ},sdDt}dD}dDt} ~$}d;`a+D,d PdD,,d,dDtdDt$;``dDt&ڃtdD tߴdT,d.DtdD tÃ$:`cE&dT,dtdD t $  d dDt2`f#(3X,"USER: ",5A2,X,"GROUP: ",5A2/,3X,"CURRENTLY LOGGED ONTO SYSTEM LU#",I3) `F?d <`n(/,3X,"-SCB-",11X,"-----DECIMAL------",/,3X,"INDEX OCTAL UPPER LOWER WORD ASCII",9X,"1`euLDESCRIPTION",/,3X,"----- ------- ----- ----- ------ -----",2X,25("-")) `Hꆈd &`Va("(5X,I2,3X,@6,4X,I3,3X,I3,X,I6,4X,A2,2X,") <`^adt dD td Dt&ڃtd Dt궊td DtdDtd;`[D4,dDtdDtdZD4,'dDtdtdD%`Q]+tCdCdD䢊tD,)d T,<,G`L35X,"SESSION IDENTIFIER")"`R] T,,'|`Hw9X,"SST SPARE") `KdDt$,`Oa2X,"SYS LU# / SES LU# ") <`cdDt $ dDt $ ( dDt   $) ,d&ZDDT `E;'Z,,,7`K6X,"- DISC CAPACITY") %`TwD,dDt36$3,d DTZ,@,K`HI9X,"DISC SPARE")`K@dDtGJ$G,`O\2X," / / LU# ");`aKdDtRU$R*Zd D+T+Z,_,jd/Dtfi$,f߶,td4D;`bltqt0$څqd D5T5,~,dDt6$څ,dDt<`em`$9䅐ߴZd Dt<<4B d 0d DBtd Dt `QQ}Zd D䢊t D,B,d 0`J"(/,X,"SCB ABORTED") (`WTĶ,dD t $  dD t  & d & `G(X,"$END SCB") `G0ۄ 2`Cj`Af-`Bf< `D+@CCT!6`A `A8 `AfC`Cf` `AO  `F A`C @`Af~`CV 0`dZ   3@@GROUP PRIVATE ADDED EXIST   IGETB c. 92903-16001 REV.1805 760907@IGETBN.ENTR`L4Zl6L - MOVCA c. 92903-16001 REV.1805 760907@$MOVCAN.ENTR%`Ud6Dl6L BLANC c. 92903-16001 REV.1805 770824@BLANCN.ENTR'`V$BZtZldp   JASC c. 92903-16001 REV.1805 770721@JASC X.ENTRBLAN CNUMDIGET1PUTCAMOVCA;`atdZ,tdDZtd4,$$;``$td,.t2dt8 T,>,EdDtD;`^CDP,4d,L,TdDtT4PdD,\DDDtd;`b~bDtl$D,rڬdtDDt|4T,`J/&dDtZD,x`A``A` `F! - `A0 " wGTSAD .c GET SCB ADDRESS UTILITY - 112978@GTSAD $SHED.ENTR$SMVE<``t$Xdt%%dt&,%'&$()-d,T$,!d)t&,d& `B"%`B`j'`A`r- AJ 24999-16248 1938 R 0100 %VERIF              H0101 X &VERIF P24999-16248 REV.1938 790921 @0kVERIF <F.MPY .DIO..IIO..IAY..DTA.EXEC CLRIORMPARFNAMEDCBDMKCVT OPEN IFMGR LOCF FSTAT CNUMD READFIFBRKDMPALWCLOSE;`b' ON CR TYPE IS 0d T,ʶdtdT,dtdt dt `Hֶdt d &4`K4(" /VERIF: REV 1938"/);`bބ  &dD,,&dZD,,dDt6dD;`ZVtddDtddtdDtdDdDtZD, dD<`cXtddTZ,%dt,dT,-,$5&   ;$,<`c[=dT ,D,n M$0 Pdtd D !DtdD" T,a;`['`,gdDD"t ,ndDtZD,RdtdDtdD#dDt<`bq{D,pd!Dt  d$T ,,3$  dZD,,ԢdD;`]4,,$$dD%t22dD%t2d2dD%t2d2dtdD&<`\]t2dD2dDtD,dD&t2d2dT,dt,3dT;`h}Z,,$$   $,dT ,, $$& ;`]{dtd D 6!DtdD"T,,dDD"t ,dDtD;`]L,dtdD&t2dD#2dDtD,d!D&t2 3 2d$PT t(;`b8 d T'(,@,gG%)d*T,N,Qd t),Y W+",d;`b|AZ T),`,3d$T ,g,n%$'d*T,u,xd t', ~+<`` |$Z,d  T',,gd$T ,,dD t dt ",d'T);`\,,"d),,dt,dt-dtdD.t/dD0 /,dD,t,<`_-=dDtD),dT,,,,3dD1t1dT Z,,d ?߀*`\""  Z dTZ,d ?"   .`cq?(" /VERIF: ",9A2," IS DIFFERENT FROM"/10X,9A2," IN ",I5," RECORDS.") `N dTB,d b01`H b(" FILE # ",I5) 9``g!,dT, ,dT-Z,,d bZ1dt-B,3d j0!`Ij(/" COMPARE GOOD")<`c4!,dt-d T)Z,+,ad2tdT,,Zd<`\? T,E,ndT,L,dDDtddDDtdﶀ,`d;`Yp[DDtddDDtddDDtD,dDDtd;`YtdDDtddDDtD,dDDtddDDtd;`ZBdDDtDdDDtDd,dDDt<`\t,dDDtdZ,dDDtdd,d<`\öDDtdd,dDDtddDDt6`Aa`Ca&`Aa5 `Ss? @BABRBN  @DMPAL (c@ DMPAL *]>.ENTR.DIO..IIO..IAY..DTA.CODE ASCII`Cҧ(" ") `Q%%) 6% 3 `Ev5(1X,9A2/) ;`[F6d t d D t d ',B't d tdDtkdkdPD tD,D `FCQ4BRd  f `EQYdDt] `BWd t(`V^dD tD Z,Yd Dtkmk od $ `ERvdDtz `Btd t;`cp{dD tD P,v) %%d D t Z',8) ) <`]yJ& d t d D t d Z(,(t d tdDtddD tD`Hn,d  `ERŶdDt `Bôd t(`VʶdD tD Z,d Dtـ d $ `ERdDt `B9d t7`_z綊dD tD P,) %%d D t Z(,) *`M(8(1X,K6))("*",8A2) (37A2)`Aan%`BaU `AaU  `D! ** IFMGR c@(IFMGR 9EXEC .ENTR;`ea)POtOM l 04UtpLR p@DZ;`^GA%Zl=|Y |XlQ|WY<Y<W,+lX ,9<Xdl|Y,)?V6T ;`mnCIV0SLN,I 00[$$$$$ APOSN CLOSE CREAT FCONT FSTAT LOCF `UWpNAMF OPEN POSNT PURGE READF RWNDF WRITF `JERROR - IN FILE `Id PROGRAM ABORTED! COMMA ,c REV A 751031@COMMAN.ENTR;`^B5 t$t%&T(,d%'T),,d%D*t%,d%D+`N Id%<<$, ::' gASCII (cMAKES BUFFER LEGEL ASCII CHARACTERS 770406 @ ASCIIpN.ENTR<`],Bt!#ZtD&,d"t%t D',d$t d4 <<!`Kk,  i4 B L 24999-16295 2024 R 0100 %CMX2L MX TO RTE-L CODE CONVERTER            H0101 *q REPLA #@G.CBS .CBT .CMW .LBT .MBT .MVW .SFB .TBS  w\CMX2L 7c24999-16295 REV.2024 ;@=OPRLUCMX1 mCMX2 zCMX3 CMX4 CMX5 CMX6 CMX7 @NMX1l@NMX2y@NMX3@NMX4@NMX5@NMX67@ @NMX7FLERRmPMSGTFILE1pIDCB1IERR1vFILE2wODCB2IERR2}BRCE  FILE3~LDCB3IERR3<0!CLOSELOGLUEXEC OPENFLOCF CREATNAMR GETSTPNAME REIO MANLP READF INLNG INBUF@BINB.CBT .CMW .MBT .MVW :`^S$Hl||dt 6dlGuˤ*pe*:`^ݯ&~]*w6X $Z**<**<*t|d,9dt6J]*;`bdlP!jzdlw!jRd,|Lk;`b4 DP4h״D dDtdjd&imdi6dDtlLj:`^ ftdgt<,lH,<4Zt ,|Zl"Tdvhodi,id;`hlah qd&lo<,i****ERROR EXPECTING OPERAND: N OP USED D NOP dD,;`c8XtdD&idDj,d&hodgg6Bg,djdggg,<d>j:`h6qdgkgd7l#"ldot &B 2 ;`d&X,H X dddddXdddjdgggd$;`jhp<`lgJ***WARNING LITERAL IN DEF STATEMENT 9 END ~****ERROR NO;`i[E END STATEMENT; END ADDED d]jr<dglgR***WARNING EMA PSEUDO INSTRUCTIO:`h,nN NOT IMPL EMENTED XEMA d&js<dg&lgz ***WARNING MIC PSEUDO INSTUCTION;`aB MAY NOT BE IMPLEMENTED FMIC Zdtldt<,,"T,|l$|l-`U6,dt|l$<<d@D$ז$|l,*<`cl 0-1-2-3-4-5-6-7-Hdgt" ,|h"Tu, ,dDft,Lf`Z,d ;`jtjndg&kg<,B***WARNING RPL MICROCODE CALL NOT IMPLEMENTED ON L SERIES d<`a &ADDtZ ,|h"Tu,P,DdDft`",DLk4i,D"`,c;`h2bP] : $&27K. DE F END @ JSB . ` EXT RP7`gL  , P , `Dc8= APRMPR @/PRMPR +RESA .LBT ;`]Ztz<t~<Zt}D~t|,hdz6D}Ztxd|t|lx<|,,h<`[kTv,Tr,Lq|y <|,( ,[Tv,[Tr,d6lE5l7 L85 ,3L70`VhZ|9 6L9L?dD>,0,-l9|7,l9|8,L=d:d;`L:A 8F TABLE c@NSTMINSTMAXTABADTABLE;`m z.DCM .MAP ADX ADY ALOG ALOGT ATAN CAX :`ms-CAY CBS CBT CBX CBY CMW COS CXA CXB :`mNZCYA CYB DBLE DDINT DFER DJP DJS DSX DSY :`mENTP ENTR EXP FAD FDV FIX FIXD FLT FLTD :`m FLUN FMP FSB GOTO ISX ISY JLY JPY JRS :`m#LAX LAY LBT LBX LBY LDX LDY LFA LFB :`maMBF MBI MBT MBW MVW MWF MWI MWW PAA :`m;PAB PA_CK PBA PBB PWR2 RSA RSB RVA RVB :`mehSAX SAY SBS SBT SBX SBY SETP SFB SIN :`mFSJP SJS SNGL SQRT SSM STX STY SYA SYB :`m] TADD TAN TANH TBS TDIV TFTD TFTS TFXD TFXS :`mrTMPY TSUB UJP UJS USA USB XAX XAY XBX :`m/XBY XCA XCB XCOM XFER XLA XLB XMA XMB $`Z8IXMM XMS XPAK XSA XSB  \OUTPT @7OUTPT qWRITFODCB2FLERRFILE2IERR2LDCB3FILE3IERR3.MBT ;`_t\<t[D $ <6:<da tb:`c02$cbJ,(d[Y2cb dWPta6Pt`DaDZ;`aBP,IdaDZڬ:t`d\l]LaX `d^ "XlaL`|a:` :`mpc `F! `A` OUTMG @*OUTMGwOUTPT%`V,P,6|6d`AV OUTML @/OUTMLiRESA OUTPTREIO OPRLU-`^P|6|t6&d0& ADEXT 3@ADEXTOUTMGSTMAXTABLERESB .MVW <`_Zdt$l&<$, L#P" ,T ,X|%L`l'""d(l%`TV=v$"0) EXT .  $ C N 24999-16296 2024 R 0100 %LMOD CMM4 FOR RTE-L             H0101  `LMOD !Y 24999-16296 REV.2024 79.11.01@LMOD *<z .MPY .DST .ENTREXEC CLRIOTERM INPUTSNDATSNAP SYSTMRTE NAMR FOPENREIO LOGLUIGET FREADMOVE CMDLNWCLOSE`Jfq( ;`hB "$BdDt)$;``*-06tdt 66+tdt+dT,Adt+d 6tI0 `AJ `T= RTE-L MEMORY/DISC UTILITY VERS 79.11.01 `F$KQ `I TYPE ?? FOR HELP 4`[8QW 4[7ܴt`7ܶtdT,h,}dtܴdD`M SNAP FILE, SYSTEM FILE:<`c!^lts&d t{ 7"tP;4,,h7<`` td,,7涀tdT,,7K;td,,;`bI[dDt$dۆ t dt4 d,ΰ,7 `FBц;  `Aa`Ba6 `Do`C``C >>+* TERM c@TERM `A`B VINPUT )c@-INPUT  3RBUF !c@RBUF  !NSECS c@&NSECS `A`` BASE c@BASE `B`C`A`A`A`D %SNDAT c@+SNDAT  BSNAP c@SNAP  QSYSTM c@3SYSTM  IO c@ɐIO `B`G`BMEME LFOPEN .c@$FOPEN  .ENTRFMPEROPEN <`a0d%D&Dtd'D&Dtd)D&Dtd*D&Dt$( $+ `C-!t$d$`I;K% OPENF  MFREAD 0c@FREAD  .ENTRFMPERREADF;`a5Bd&D'Dtd(D'Dtd)D'Dt$*+d+t%,",# `D!d/t%d% `Ea& `D:,READF  lCMDLN Ic@CMDLN <.ENTREXEC TERM RBUF BASE PARSEUPDATSYMBLSTABLCLISTDLIST DMODF SETIO FWORD SECTS MEMRYMDUMPSETBATRACE/CALC DVT IFT ID ;`c10d)D,T- ,%,&,d)D,T),0,32,#:`^Zm3Pd*D,T.,<,?d/,#d*D, T0,H,Qd2D,tO4P1O,#;``QPd*D,T3,Z,]6\,#d*D, T4,f,ih,#d*D,T5,r<``q,u t,#d*D,T6,~, ,#d*D,T7Z,, ,#d*D,T8<`aݶZ,, ,#d*D,T9,, ,#Pd*D,T:,, 6,#d*;``*gD,T;,,,#d*D,T<Z,,Ɇ,#d*D,T=,,<`a҆,#d*D,T>,,,#Pd*D,T?,,6,#d*D,T@<``j,,,#d*D,TAZ,,,#d*D,TB,,,#d*D,(`U_TC,,,##*D6+dHt_dHt_`H]d)P/ELI `W"|2DI??DLDMIODSFINSLMLRMDBATRCADVIFID WHAT??  ,d>`Aa?`CrAMEDI`A`E`AAH VFWRIT ,c@,FWRIT  .ENTRFMPERWRITF;`aa6d$t#d%D&Dtd'D&Dtd(D&Dt&)"t# `B$!d#`HG$ WRITF  eGETEM Qc@(GETEM  .DIV .ENTRSYSTMIGET MOD FREAD<``6dGtEDH,,,CdI,,dJtE,CdK;`aL ,$,CB FDHtL06FDHtM6LtNdMDOdPDN,C `D,AdJtEdE `FrFMEDI`BEO DIGIS wc@4DIGIS ,.MPY .DIV .ENTRIABS MOD SETDBCPUT :`^ 6dd,,dftedhtgdi,djte,+dkte<`_#Ptgdi,+dltedctmdmDptq4&gqdg tgdmDotmDn;``-B,-ditr$JrM6edntmdmDpDtuDvtsZsdmPDntmDc,O`B`c `Af0 `E_ h1 - `Ca0n`Cbt0  ~SHOW Uc@SHOW +{.ENTREXEC DISPLINVRS<`ec(0(4)*&NtMdODPt<?)N$Ѐ<OQdM,KdQDStT$KR(TdM+`BdO`B`R++ DISPL c@#DISPL \.ENTRGETEMBASE DIGISASCIIMOVE <`e ( : 6dtdDtdtdt<`^ %Zd ,*,9dDDtd ,4dtdDtd>tdd<`\&C,F,{dDtdDtddDT,]dDtdd 4``>_,cd Dt$h$m $r &ut{$dtd`B``C )`C R) `DN}SCMEM  SHOWB [c@$SHOWB g .ENTREXEC KCVT DIGISASCII;`jբ ( ): tP0$Q0't dRDS<`Zb*tUdTUdVDStUdWUDX,8,GdRDStUdYUdZDStUdYUdVDS`JR DtUdYUM$ZO `FO  ( `EV):  ׀BITS Zc@BITS 8{.ENTREXEC SETDBCPUT MOD ROTAE;`ee( BX dMtL0LNdPtO OS TM,((NdUtT. OtVdM0`Zй1DV,6dWtT9TdODRtODQX,dLtY$JX Y`BM `D`P`AU0 `BW1 ! dROTAE cINTEGER FUNCTION TO ROTATE WORD @+ROTAEN.ENTR`NCyP@  , `A`` OCTAL c@/OCTAL .ENTRINPUTSETSBSETDBKHAR CPUT ZPUT NAMR <`asdttsdvtu!s%&udxtwdvt dvTw,1,F&4yty<`_S+5dzTy,>dxDwtwdv Ty,E,n,*IytydzTyt{dvTy4{5`^@Tt}d|Ty4},],a&`y,Ff$~tdttn u6d trdr`A`t`A`v`A`x`Az, `A|D `B~B, [UPDAT @c@-UPDAT *->.ENTREXEC SHOW PATCHRBUF IO TERM BASE OCTALREIO ABREGPARSE DIGIS ASCII `JH PATCH MADE TO "`YDPATCH TO ?`Aab!;`_tl**d D"t(d#D" T$,;d%t dD" T&,Ed%t d ,M;`^$IL't(d D(td'D(Zd ,Zd D(t(d D(,`,d)Dt*h*(;`bgZ,l,d+Dt*u$'* ,$y-. ~& .+d+t/d't0d#D"T1<`]9,d2t0d!T/Z,,Pd#D"T3,,d0D(t(d D(tPd D(D0<``,Zdtd)Dt*  $*(d D"td5D6t $À4d D"t;``ƶd7D6t $ڀd8D6td D"t &׀d)Dt*   *&d+Dt*;`_$'*9'd: T9,,d D"t$(tZd,,dD;t=d<=d>)`V T,dD;t=d?=  0(4* `Da `H "+R D '`Bbc+`H)1^ /E `C:YESC`B>MEM ** vASCII cMAKE WORD INTO TWO ASCII CHARS@ ASCIIN.ENTR/`X;״Zt4ZpL dL d `D`  XFMPER cREPORT FMP ERRORS @(FMPER ^ .ENTREXEC TERM KCVT CNUMD`SI : FMP ERROR - IN FILE `B`:`^LddtdDDtqdZq,,,dtdDtq;`ZƦ1dDDqdDtqdDDqdDtqdDDqdDtqdD;`\^KXDt&RqdDtqdDDqdDtqdZDDqdDtqd;`]gZDDqdDDtqr4qT,x,dDDPtd,,d9`]#DDtdDZDdDtddDt0&d`Ca `H  `EY - XISEQL *c@ISEQL N.ENTR:`^6d%t#d$t&d&D'Dt(d&PD'D(,,!d&PD$t&`E+, d)t#d#`B`g$`A`g'`Aj)# CINVRS cMOD FOR L-SERIES J. BRIDGES 10.18.79@2INVRS v.ENTR.DIV .SBT ;`^Idtt8 @t>t3d9t4t5t6;,Rd5 ,e:l=l<$`P#P|7D?d6ڠ,EL4<7,&dt8d5,5 `Ee9p;`_?$@Y}4Z9P$6Zt6P,5dQ ,+,d5PbDDhd5cd3$5;`]2^d$5,5|l l|<,t,.d:t4t7<d5P,`E5f{L4<7,v<,k<`\sP,5t6\dZd6,5dQd,5d,5,57`c ?C|l8\>,5|8l  Z ;`` | ϶d4T9,lL9l ` ` ܬϠT`LGDDD%:(@`NZtddQdI<`]td!dZl4|# L" LL,l4L#|<##<,`I#L#|# :`h463d!dD8@H ؄(0z8{l@FHFPU[XU\`hpxH@:`m;\a;@b+HL@I=HM TH@a;b+HLI=HM N a< @O} N:`mp TNa<b,NO}NSSTT SW@TTz:`mST TT SW @T T  z  ATA E5@TT@@:`mląÄ݄̈́@t@| $Id@v I^SSSBSCVVVV\*\+:`mV{j{kZ[ւփ~>@gPg׌ ׌ Ñ‘ƔŔǕ ʤCDˤkˤl:`m=سس ٴ ȺȺST#$/5ZZ\&e0fP ghGG:`mjZ[⋂ꋃBC̹֓֔3ZZ:`mܸzݸ}́}S>TS={\=} Yv] *짧*{b *Y*à:`m hH鰿鰿qxŀ[Tb H FW 'K 2 읟`OgT Y H z c" 3uOCVT cConvert to two digit octal ASCII @OCVT N.ENTR`O p@D800 MEMRY <cProcess LM and LR commands@3MEMRY .ENTRPARMSTERM RBUF BASE OCTALGPARMLMEM ;`d Z2, ,0 4t3$42t5&7t6d4D8T9,!,)( 3`M3$$5:;6035&;6`A`t2`A`w4 `E7#LM ҈LMEM dc@LMEM N.ENTREXEC BASE DIGISLSTM :`c REL DISPLAY FROM Btd tZt d[T ,#,2d\t :`^(%dXD]t>d>,/d\t d Dtd ,7,Kd_D`t>?^0>EX#`TvC&YKX$€abP$dct dct dZt `B`X `I!W[   LSTM c@LSTM -.ENTREXEC IO IFBRKGETEMDISPLKCVT INVRS`Cɯ ( ) ;`]*6**t+*Dt*D,=*tdtdDt_dPDD*_<`_1G*tL,dDt_d_X6dDt_a_6dDtdD<`axftrjrdDtru$rdDt~$,dDtdDDd`GePDtD,I-`A``A``Bd`A` `De `A`-- rIFT cDisplay IFT @IFT $ B.ENTREXEC TERM IO GPARMdqSYMBLGETEMCNUMDROTAEOCVT LSTM :`hu ID. # EXT WORDS = t6tdt$"$':`^_($,dDtdD4,8,dDt$@dtdDt<``a`FdT,M,RdDDt,8dDtXYXdDta6e4t8`bfdtdDt o v0 {6dT,, $`Hb= IFT EXTENSION: `OH 6dDt $`A``A``A``A``C $IFTA `C$IFT# `A` `Fc  `CaA?`B  DVT cDisplay DVT @DVT $ B.ENTREXEC IO TERM GPARMSYMBLGETEMROTAECNUMDOCVT LSTM ;`j DD. # DVR PARMS = t6t &%6*$:`^^)*dDtdPD4,6,dDt>BtdtdD;`_8HtdT,P,UdDDt,6dDt[\[dDtd&h /`]g6tdtdDt r6 y$ ~$ $ `F DVR PARMS: `OH~ 6dDt $`A``A``B``C$DVTA `C$DVT# `A``A` `Fa `Ca=?`B  ID [cDisplay ID@ɅID .MPY .ENTRTERM IO GPARMSYMBLGETEMLSTM <`gZ&EEtD 6GtF$HIJ&IM$HNO!&NRdDDRtSdD0`\Ӯ'DH4S,-,B2HT0U7TXdZDDXDMtYBY&XF;s`A`E`B`G`C7J$IDA `CO$ID# `C#TU$IDSZ `A`Z ЋCALC }c@CALC  y.MPY .DIV .ENTRPARMSTERM RBUF SHOWBBITS GPARM;``4dlDmDn, ,doD tqdrDmtq&pdrDmt ,j!<`c9E Zs,%,j)uutt.nwtv3sutxdyTv,=dxDttzd{ Tv,G;``CdxDttzd| Tv,Qdxttzdw Tv,^dt 6xtzdoD tqf`H;c$qpzj6z `Exl!'`B`r`A`u`Aw/ `Ay+ `B{- *  TRACE c@TRACE /! .ENTREXEC PARMSTERM IO OCTALGPARMGETEMDIGIS IFBRK <`n - ( ): ( ): FWA OF MEM BLK CONTENTS LI:`^.NK/$ 5,9,dDtddDtddT,NdDt<`e@VLdQtV°t[°t`tdti$$odD;`iiqtwʰ|˰ 0 0 0 0&dT4`Z="tdT4,,dζtdT,, $Z,,o/ `EaH `DEM DISC`Aa`Aa`Aa`Aa `A) `Aa`A// ASETBA 0c@(SETBA .ENTREXEC TERM BASE RBUF CNUMOOCTAL;`dR BASE ADDR =  d*D+ T,,,#d-D.t4"4/),' `D$&&/t `G$)    VSECTS 3c@)SECTS J.ENTREXEC NSECmSTERM RBUF CNUMD;`c-# SECTORS/TRACK=   d,D-T.,,d/D-t ,)d0D1t"# "`G#)24+ `Hg-+    SETIO c@6SETIO .ENTREXEC IO RBUF TERM `IINPUT= /OUTPUT=;`^  dD TtPdDT , ,UdDtd dDtd ;`[L)dDtddDtddDTZ,AdDtddD<``'D T,NdDtdT6,}dDZTtdDT45`ZXd,idDt PdDTtdDPT4,}dDt  `Ecs  `Bd `G M SCDIME  SYMBL c@,SYMBL ' Z.ENTREXEC ISEQLIFBRKDISPLTERM IO SNAP SNDAT RWNDFFREADCNUMO`HaH ;`d4WMRUNCMABRP0'  +dt0,6PtdD,=;`^<,dDtFdDtGH$ FG,L,dtdDd,Y,d;`_3ZDtpdDXDDp$gdtdDtpr4'pt dT6`[y,}dDt &/,dDtD3,-dtd,, `Ev NOT FOUND`HK /6d `B``G/$`A<RP`C`  STABL c@ STABL %* .ENTREXEC IFBRKDISPL RBUF TERM IO SNAP SNDAT RWNDFFREADCNUMOMOVE `Ij `E MRUNCMABRP`Aa <`aƷ%%,  06dtdDT,>dDtd4tC,d;`^FDtL6tdD,S,dDtbdDDDbdDtbdb;`_JddDtil$ڀidDttdDtv &xt+vtdtdD T$`R,dDt $dDtD3,@%`C` `C7 `F>4 `C] RP%% LCLIST #c@ CLIST V.ENTRRBUF TERM HELP 5`\dDT, d t d DT!,d"t `F   ٍHELP nc@HELP  <>.ENTRPRINT;`e(l ,, ,dat,t4 E??{/EN xLIMD oDI:`m]' DSFINLM*LR:BA hTRCANSIO~DL DMDVIFID INPUT Function$ $ ?? Help$:`m-T /E Exit$ N See/modify system $ LI List Symbol from SNAP $ LM List Memory $ LR List :`m memory relative to BASE $ TR TRace list$ CA CAlculate or display$ BA Set BASE addr for:`ma LR command $ MD Memory Dump $ DI Display snap & contents $ DL List disc $ DM Disc :`m\Modify $ IO See/set input/output$ FI FInd (search) system for values $ DS Search disc f:`mor values$ DV Device Table$ IF Interface Table $ ID ID Segment$ NS See/set # sectors/t:`m5rack (for DS)$ $ Type ??,INPUT for more help$\ FI,1st addr,last addr,<3 words max@ or :`m:bASCII word of 6 chars> $\ MD,1st addr,last addr$\ ??[,command][,list LU]$\ Symbol value :`m$(octal) shown as:$ RP = value replaces JSB symbol $ MR = memory resident addr$ CM:`m = addr in COMMON$\ DS,LU,TRAK,<3 words max @or AySCII word of 6 chars> $\ DL,LU,TR[,SECT]:`m^[,# SECTS]$\ NS[,# sectors (64 word)]$\ DI[,list LU] $\ TR,fwa[,ofset][,terminator][list :`m}LU] $\ CA,P1[,Operator (+,-,*,/)][,P2]$\ LM,1st ADDR[,count][,list lu]$\ LR,1st ADDR[,coun:`mT'Ct][,list lu] $ ADDR added to base (See BA) $ LRX > dec disp rel loc $\ BA[,New BAse ad:`mpdr]$ Use for LR command $\ IO[,MEm or DIsc][,MEm or DIsc]$\ DV,DVT # $\ IF,IFT # $\ ID,:`mID # $\ NO MORE HELP!$\ DM,LU,track[,sector]$ DISC MOD SUBPROCESSOR (PROMPT = --) $ Rea:`mds disc tr/sect into 64 wd buff$ LI = List Buffer$ N = See/modify word N in buffer$ :`m This is just like N command$ for system. View or modify $ buffer and e:`m$xit in same way$ /E = Exit subprocessor. If any$ patch to buffer, you will be $ :`mQ asked if you wish to write the $ buffer to the disc before exit$\ N[,R[,D]] $:`mV~ R : N is added to BASE address $ D : In R mode, read N as decimal $ N = octal addr.:`m Location of addr is $ input (memory or system file) $ shown by IO command. Conten:`mts are $ shown in octal, decimal & ascii.$ Enter:$ $ cr View next addres:`m"Bs$ cr = return key$ N cr Patch current loc to N $ (trail:`m)2ing B for octal) $ ,/E cr Exit from view mode$ $ Patches go to output shown by I`O2_O$ \b NOT A VALID COMMAND $\ FE PRINT vc@-PRINT *1.ENTREXEC SETSBSETDBKHAR CPUT :`ck(B(dktj4(&jldntm$:m=6otodpTo,E,hdq To,L6`^ÃK,:drToP,S,^V6odsTm,],^,:dmtugt$ڀ)u,4*`Bݮk}`A`n `E!gp\ @ $ P** bMDUMP Gc@2MDUMP C-6.ENTREXEC PARMSTERM IO GPARMOCTALMOD IFBRKMIN0 CNUMO GETEM FLINE KCVT `C ( ):`Qm0 LOC THRU FROM ;`c8CCI Z",M,Q$t#U"t%&Y$t&^$Z% D%t%d D&t'd D&<`]ft(k( D'D)t&d+t*d+t,d-D.tdd!D.td/d0TP,:`^#%d!D.td1d%t24,d6D2t' '&t5d5D2,,d2t7;`a$* t*$,8t,d+ T*,,d9D.t $2d6D7t' '&t:d;D.<`c°t :Ƅ "#<0= "#&0!d+t>d>D7t'd=D>D@t '߶d>D=t>;`^D?,d$DAt 6Bd"DAtC&,Cd$DAtCd$DADDECd9DB8`\/t'  "#&'d=D*t*dFD,t,d7D t7D5,d2D3t2D&,C`Ca `Aah$`Aai)`Aal+ `ES[-/SCMEM `Aa3@`Aa6?`Ba8P`C; `Cf?`CD) CC FWORD c@#FWORD Y<.MPY .DIV .ENTREXEC ISEQL PARMSIO RBUF NSECSRTE SNDATSYSTMTERM OCTALGETEMIFBRKSHOW GPARM MOVE ʶCNUMDKCVT DIGISASCII<`g7E SECT: WD: Ydtdtc,g,dDT;`[l,p,dDtdDdDtdâDdDtdDdt;`\!,dDDŶtdtdDtdDɢDdDtD,dD<`_ T1,,t˄td˶tdtdDƶtdDDtǀd<``u/´PDtD,,dtdDZD#,,dDDt $߀B,;`^̷,dDt 4/dӶtdDtD,dD͢tD,, ;`czD7t 6tdtd׶D;t,d °t"ԤGd<`^&#tdT,,,Od϶Dt141GdD;tڢdD,=Z,OdDt<``AdDtKdDذtO$KdtdDtV $YVB,],dtdD:`^kFatefցedDtzdzdDtzq6zdDtzdDt|}$ځzށ|dD<``stdDt$ɁdDtdDt&/EdDtD,Q`K dDtD, d, `F NOT FOUND! `I/6dtY `Eb! `K/P _ A`Cl DS`AbN@`BfQA`BS?`Ab`A٠G `E DT: `AbYY FLINE c@FLINE .MPY .ENTRDIGISSETDBCPUT ZPUT SETSBKHAR `A <``D6dtdDDDt-d6DDt/$0-/dPDtD, d;`b8=dtBdDDtJMJ6dDtD,?W6dt<``"Z$^dtctdDtdD4,pdtsdDtD,` `Dz}`A``I * `A` DMODF qc@_DMODF <n.MPY .DIV .ENTREXEC PARMSRTE RBUF HEADR TERM SNAP SYSTK MCLOSEGPARMMOVE CNUMD REIO ABREGPARSEHELP  FLINESHOWBFOPEN<`f}d&t"',,&)*t(&'*t+&$*t,d, ;`b0''t-d'D(t. )$.-%+-d),t/d/60D)D1td)D2t &0 `PO6(7 +7  ,7 ';7 3`HRTYPE ?? FOR HELP<`f#K  ';R64d5D;t. $'.6)d7D;t.$).8$!9:&&:Kd)TK<``ݚ+,-,td'D; T<,6,d'D;T=Z,?,DC>;, Pd'D;T?;`b47K,M, S';@) Y6';73d)tAdAD2t`$c`DdDt. l';.dA<`\mPDCtADB,[, d'D;ZtEdED0tFd)DE4F,,d5D;t.dED2t;`c.Ed7D;t.$).8$9:&:Kd*TKZ,,dGt"dED2t`FZd'D;d5D;`OdYZPATCH MADE TO SECTOR BUFFER: <``$ft. '.&ZHdED2t;EPd#D;T*,,d)DEtE,xdID;T<(`T#tFdJD; T<4F,, d",,d5D;`HiiWRITE TO DISC? <`c 氒t. '.&iKd7D;t.).68dLT,,d/60D)D1t 40d'(`X; D(t. '$.-%+- ';M6Q  `Eb#`Bbl)`I80@,-- `F";K/E??DMLI `BbB9`KG YE DONE !  DLIST c@"DLIST E-.MPY .DIV .ENTREXEC PARMSHEADR TERM RTE SYSTM GPARMIFBRKMOVE CNUMD FLINE;`eEEK Z,O,ЄSt׶dDt[&t`&te&tj4<`cjtdtfd`dtr,Рd 0t $+&dTZ,d<`d\Dt + װ7 7  7 $؄ 76dtdDt;``Rdt $dPDtD,dDtdPDtD,oE `Ea`Ba `EA+@ `Bam9EE 'HEADR c@HEADR `T LU: TR: SECT: Nf DZ 24999-16301 2024 R 0100 %MFGET MANY FILE GETER FROM JSAVE TAPES             H0101 L( gMFGET .Z24999-16301 REV.2024 11-20-79 @JMFGET "E<.MPY .DIV .DST .TAPEEXEC CLRIOIFEXI RMPARREIO PARSEABREG MSGFR RDIRC ASCIIIFBRKMOD IFENTCREATCLOSE OPEN WDIRCWRITF`C:* `Ao $ `B# C ? _`N! MAG TAPE LU: _FMGR ERR `P!FILE: : : :.`c!0 THAT'S NOT A MAG TAPE!TOO MANY DIRECTORY TRACKS! MAX = 50, MIN = 1!<`n$.!T MAG TAPE FILE: _ FILE CREATION ERROR COMMAND? NAME TYPE #BLKS/LU SCODE TRACK SEC `D!OPEN TO 4`hH ! CR ILAB= NXTR= NXSEC #SEC/TR LAST TR= #DR TR= `A(*;`es"E"H"K4P d*D ,"Rd*t d*D t*"[**&!*"a*$* %*!d*"t*$"l %;`ch"j&*d*D*t*"u**6*d***͠ T*,",""**&!0*,"Ud*D*d*t*"<`dO"$**!T*$"** %*Ն!d*"t*" %*6d*D*t*d*D*t*d*PD**,"<`_ӥ",""**&!I*,"d*D*t*d*T*,","d*D*t*d*D*,","d*t*;`a¡"жd*D*t*d*t*"***0*"**$****d*PD*t*D*P,"d*D*,","d*<`fv"D*t*"+6*d*D*t*$"+*d*D*t*#**& %*# *$* $*#$**!*d+T!;`_*[#,#,#9 #"!,# ,*d+ T!,#',#d+D*t*d*D*t*#1+6*d*D*t* #8:`^#6&+*,"d*t+d*t+d*t+d*t+d*t+d*t+ d*t*#N+ $***+ d*D*t*#W*;`b] #T$*#* #[&!"d+ + Pt*d"D*,#f,#x#m$+ ***+ d+t*d*t+ d*趀D*t+d*;`]#vD"t+d+D"t"d*D",#d"t*d+D+t#d+D+t##$+ *裌+d+D+t#d+;``#D+t##*$$+ *d*,#,#d+D+t#d+D+t##+ *裫&ڣ+d+D+t#d+D+<``:#t#d+D+t#$#*ͣ+&У*d*T+,#,#d*РZD+t+d+ZD*,#,$Yd+D+;`]p&#t+d+  *t+d*̢D+t+d*D+t+d*D+D+,#,#Nd+D+t+d*t+d*;`e#t+#**&!h*#*$*#+ $&!"$#&"d+T,$ ,$`d+ T,$,&d+<``$$ T,$,),d+ T,$",)d+!TZ,$),)d+"T,$0,)d+#T<`_$5,$7,)d+$T,$>,)d+% T,$E,(d+&T,$L,*  $O",$R,*d+'t+(`L$T $X+(*,#턒$_**!<4*,*`T^+z("ILLEGAL COMMAND. USE ?? TO GET HELP") <`a$`d*t+dt+)d*ZD+),$kd*t+)d*t*d*t+ ${"1"6";$"@*$*+&+ +d*T*,$;`]$,%Ad+*t+d+ D+t$d+D++t$$$*d+D++t$d+D+++,D+-$d+)D+.t*$+;`^$&*+$*$+)!*d*D+/t$d*D++0$d*D+/t$d*͢D+$d+D+/t$d+D+$:`^$d*D+t$$$ڤ %*d*D+/t$d*D+1$׶d*D+/t$d+D+1$d*D+t$ׄ$ڤ %*;`\Uf$ڶd+2D+/t$d*D+1+,D+-$d+*D+/t$d+D+1$d+D+t$$$ %*d+3D+/t%d*;`]$D+1+,D+-%d+4D+/t%d+D+1%d+5D+t% d*D+%D+t!%!& %*d+6D+/;`_9%t%d*D+1%d*D+/t%d+D+1%%$+& %*d*D+/t%Xd+D+1%$%1*+)!*ؠd+);``%2D+.t*%9+&**d+)D+.t*넒%A+**d+t+7d+ +D+7t+d+D+ T+,%Q,&d+;`\k%RD+T*,%Z,#d*t!d!D+8t%d+9%d!D*t!D*,%\d*D+8t%d+D+;`[4%n%d+D+8t%d*ZD+D+%d+ D+8t%d*D+D+%d+D+D+t%d*D+8t%$%;`^%&Х*d*D+8+:T+;,%d*D+8t%d*̢D+8+,D+<%d+D+D+T*Z,%,&=<``b%d*D+D+  *t!d+5D+8t%%$!*d+5D+8+:T+;,%d+5D+8t%Դd+5D+8;`],s%+,D+<%d+ D+D+t%d+=D+8t%%ץԥ6*d+=D+8t&Cd+9&Cd*D+D++>t!%;`]-%$! %*d+?D+8t&Cd*D+1&CZd+?D+8+:T+;Z,&d+?D+8t&Cd+?D+8+,D+<&Cd*;`]N&D+8t&Cd+D+1&Cd*t!d*D+D+t&Cd*&C,&d*t!d*̴PD+D++:  *<`^6i&D!t!d*T!,&',&M$&,! %*d*D+8t&Cd*D+1+,D+@&Cd+3D+8t&Cd+D+1&C;`^r&<,&Md+ D+D+t&C&FC %*նd*D+8t&Vd+D+1&Vd+5D+D+t&Vd*D+8t&W$&YVW*d*;`\L&ZD+8+:T+;,&kd*D+8t'&d*D+8+,D+<'&d*D+D+Pt'&d*'&,&yd*D+8;``~&vt'&d+A'&&$*+)!n*$Z&!,#d+7PD+2t+7D*,%Cd*t+d*D+t*&*+t+d*<`\u& T+,&,%Ad*D*t*D+,$m,#d+*t+Bdt*d t*d*t*d*t*d*D+t+C:`^&Zd*D+t+Dd*Pt+Ed+ D*,&,&d*D+t+Cd*D+t+Dd+ D*t+E$&*+D!*<`^&&+C+Ed+Bt+Fd+FD+GT*,&,#d+D+FD+Gt'&d*'&,&,(d*D+FD+G+HT*;`]?&,&,(d+FD+GT+,&,(d*D+FD+Gt'&d*'&,',(d*t+Id*D+FD+G;`[' t+Jd+D+FD+Gt!d*D+Kt'&d+ZD+FD+G'&d*t+Ld*t+Md*D+It+Id+FD+Gt'&$'5$<`dW'&$&";"1++L$++I*+M"@$"6*++ +Pt+Nd+ND*,'<,'d*D+J  *t+Od+I+Ot+Pd+ D+F;`[('JD+Gt+Qd*D+FD+G+>t+Rd*t*d+ D*D+St'xd*D+FD+G'xd*D*t*D*,'U;`_"'ed*t+Td*T,'rd+5D+FD+Gt+Td+5D+St'x'z+Tx6*d*D+St'$'*ᧀ*d+*D+St:`cA't''!6*d*D+St'd+U'd+3D+St'$'+P*$'**!*Ѷd+FD+Gt''$ E+V+P!;`cA'&+T*d*D+V,','d*ֶD+Wt''+V&*'*$*! *,(&' Ed*t+Id+FD+Gt'' E;`_q*'$+V+ +T*d+QT+,',(d+QD+,','d*D*찒t*'+*d+D+t+d*D*t*;`d'鄚'+*d+QZD+,',','d*D+t+d*D*t*(*$*#*( $*****$$*++ +;`d( $(***d**T*,(,(,' (&$*****$$*++ +d+R+ D*t!d*t+7(0+N;`_ >(1,(d!D+t(9$(; E+V9*d*D!t!d*D!,(D,(kd*D+t+d*D*t*넒(P**# *:`cfT(P(\***$**$*+&+ +(a*&**d**T*Z,(i,(d*t!d+7D*t+7XD+O,(-;`e(s$(~****$*$*++ 6+d*D+It+Id*t+Ld*t+Md+FD+Gt(($$";"1++L+$+I*+M"@"6$*+;`bC(&+ +t+Nd+ D+ND+t+Qd*D+ND++>t+R $(****$*$*++ 6+d*T+N,(,':`^H(&( Ed+FD+2t+FZD*,&d*t+Bd*D*t*$(*+t*d* T*,(Զ,&d*D*t*<`cz(آD+,&,#d*t+Id*t+Ld*t+M($";$"1++L++I$*+M"@"6*$++ +t+Nd*ZT+Nt*d*;`\W (PT+I*,),)zd*T+N,) ,#d*t+Fd+FD+ND+D+t*d*D+FD**d+FD*;`ag.)t+FD+,) )("1"6";$"@+L$*+&+ +d*D+It+I,(d*t+Xd t+Id*t+Ld+t+M$)F$:`c%:)8$";"1++L+$+I*+M"@"6$*++ +t+Nd*T+N,)N,)ed+ND+t*d+*d*t+X$)a"1"6";"@;`_)[$+L$*++ 6+d*D+It+I,)0 d*T+It* d*T+X*,)r,)zd*T+IZ,)y,#,).`I1+("FILE NOT FOUND");`c&v)zd+Yt+( )+(6*,#d+t+Ld*t+Md t+I)$$";"1+$+L++I*+M$"@"6*++ 6+t+Nd+Zt+(d*`JA) T+N,) )+(*,#`NA&+("WARNING:\ FILE NOT FOUND!");``p)dt*d*D*,)d+[t*,#d*t+Md*t+Xd t+Id*t+L)$$";"1+$+L++I*+M$"@"6:`^y)$*++ +t+Nd*T+N,),)d*t+Xd*D+It+I,)d*T+It*d*T+X*,)<`cO),)z,#d*t+Xd*Ͷt+Md t+Id*t+L*$";$"1++L++I$*+M"@"6*$++ +t+Nd* T+N,* ;`a*,#d*D+It+I,)d+\t+( *+(6*d+]t+( *&+(*d+^t+( $*+(*d+_t+( *%+(*d+`t+( *+:`c:*)&+(*d+at+( $*1+(*d+bt+( *7+(*d+ct+( *=+(*d+dt+( *C+(6*d+et+( *I&+(*d+ft+( :`cz*L$*O+(*d+gt+( *U+(*d+ht+( *[+(*d+it+( *a+(6*d+jt+( *g&+(*d+kt+( $*m+(*d+lt+(<`df*o *s+(*d+mt+( *y+(*d+nt+( *+(6*d+ot+( *&+(*d+pt+( $*+(*d+qt+( *+(*d+rt+(0`]* *+(*d+st+( *+(*d+tt+( *+(6*d+ut+( *&+(*d+vt+( $*+(*,#<`nf+("COMMANDS ARE:") ("DL[,LU] DIRECTORY LISTING(DEFAULT LU = TERMINAL)")("PU,NAME[,EXT#]<`nY+ DELETE FILE NAME FROM DIRECTORY")("DELETE,NAME[,EXT#] MARK ALL FILES IN DIRECTORY UP TH<`nw,RU BUT")(" NOT INCLUDING 'NAME' SO THAT THEY WILL")(" NOT BE INCLU<`n^,/DED WHEN FILES ARE ADDED TO") (" EXISTING DISC.")("RN,OLDNAM,NEWNAM CHANGE THE<`nL,] NAME OF A FILE,")(" SO THAT WHEN IT IS ADDED TO THE") (" <`n/,EXISTING DISC, IT WILL HAVE A NEW") (" NAME.") ("ADD[,SC[,CR]] ALL FILES NO<`nҘ,T EXPLICITLY EITHER PURGED")(" OR REMOVED VIA THE 'DELETE' OR 'REMOVE'") (" <`n, COMMANDS WILL BE ADDED TO THE EXISTING")(" FILE SYSTEM,WITH SECURITY <`nZ-CODE SC, ON") (" CARTRIDGE 'CR'.") (" 2 DEFAULTING SPECIFIES TH<`nv-CAT FILES MAY")(" BE ADDED WHEREVER THERE IS ENOUGH ROOM.") ("SK,N SET <`n-q# SECTORS SKIPPED IN DIRECTORY TO N") (" (DEFAULT IS 14, USABLE FOR MOST") (" <`n- DIRECTORIES)")("MA,NAME MARK FILE 'NAME' AS 'DON'T TAKE'")("CL,NAME <`n7-CLEAR THE 'DON'T TAKE' FLAG FROM FILE") (" 'NAME'")("EX END") ("EN `S- END") ("/E END") <`dKB*d+Vt*d*D+wt***몹6*d*D+wt+yd+x+y***&!^*d*D***!  `Ep* #`A*`A**`A+*`A-* `C!2*?&1`Bg*2`B*`AN*`AR* `D2+YENO`AO+ `A+ @`B+$":"0`Cm+$"?"5#`A`+`Ll+DLADPUDESKCLMAMKRN??+z`M]+*!=@ ! $`J,+8 !m 0 +DT`B9+G !`A:+K !`A̩+S !`A+U :`A̤+W ! +``9+Y$++++$++,,!,>$,N,f,,,$,,----$-J-g---$----. !]- F"E NIFEXI &c@IFEXI N.ENTR<`_gd!t d",d#t d$ ,d#t d%,d#t d `Aa `EQ!EXEN/E ^RDIRC >c@RDIRC 9.ENTREXEC <`daDc@#WDIRC 9.ENTREXEC <`daDA0 `F=- {wMSGFR 5cREV 4-26-78 @&MSGFR 9.ENTREXEC ;`_O8BT1 Z |t-d2t03T.,<-T/,<- <0,`R/L44td-t-*,"-"" `D1(" 5IFENT Nc11-20-79@"IFENT `.MPY .ENTRRDIRCWDIRCMOD :`cI2t1d3t,d5t4d.t6d3t/d8t0-;``6#$  6$ d/:t9dt=D;,9d.|0.*t4D/t7 7t/d3T/4`^ڊZ,,-d0,""$  6$ d6D.t6,d3t,,`Bas-`Bbt2`Aa5`Aay8`Aa:@`Aa<`Ba>`B`A`AaD `F<H--0 E R 24999-16310 2024 R 0100 %CDGN : MEM RES. DUMP PRG FOR CDA4 (CTU)             H0101  #DUMP c24999-16310 REV.2024 800116 :EXEC $MRMP;`]tӅADtDtDtDtthtDldDlƢ| |`;`[+<l\F\,>8dɶttD,1l`<dT,;T,(;`_}8>?,9>8,(lld>dЃdhѠ dԃɃʃdP d҃d;`\\Wlɋlklɢq8lȬFkl|qlضL|\׬`,dPdσdًѢk|<`Zusdtul<u\,udZTA,{dt<<ʶ,dT,<`_}Є",qZ` !` ,dڅU,tdd;`dYZՄ,dڶdd@@0 @&`[  ?0@A l&p1d256Wp5CS FL 24999-16311 2024 R 0100 %TDGN : MEM RES. DUMP PRG FOR CDA4 (MT)             H0101  #DUMP c24999-16311 REV.2024 800116 :EXEC $MRMP<`\PtʅAttd4tttLtWtd4ttMtXtd4tttNd;`]^` d@XT,%!,htDldDl| |s<l\Z\<`]g9,3dtŴPtD,Fls<dŢT,=dڇ@T,VP,N#,N;``Vd?dȃdhѠ d˃ɃʃdP dɃZdl‹l~llZ~l<``v|lL|϶\άs,wdPdЋѬ~d4Pdd Ƅ,@;``,dZ",tdd<HE@%`[ 0@  Bz GM 24999-16313 2024 R 0100 %\DMP : SYSTEM ENTRY POINT \DUMP             H0101 ub "\DUMP 324999-16313 REV.2024 800116 @A\DUMPF$MRMP;`aSV|k| ,LT, T , "T!,%<,, #DUM!`R!PLL|2d$ 4#dd$܀2t< HN 24999-18052 1752 S 0100 %RECON RTE BOOT UP RECONFIGURATION             H0101 ASMB,R,L,C HED RTE 7900/7905 BOOTSTRAP RECONFIGURATOR * * NAME: RECON--SOFTWARE UTILITY TOOL * RELOC: 24999-16044 * SOURCE: 24999-18052 * PRGR: D.L.S. * NAM RECON,3,10 24999-16044 REV.1650 761124 ENT RECON EXT EXEC,$LIBR,$LIBX,RMPAR SUP * BEGIN EQU * SKP RECON NOP JSB RMPAR RECOVER PARAMETER DEF *+2 ONE WHICH IS THE DEF CONLU CONSOLE LU #. * LDA CONLU IF ZERO, CHANGE SZA,RSS TO ONE. LDA D1 STA CONLU JSB EXEC DISPLAY PART # DEF *+5 DEF D2 DEF CONLU DEF HEAD0 DEF D52 * RECN1 JSB EXEC GO REQUEST A TRACK. DEF *+6 DEF D4 DO SUSPENSION ON FIRST TRY. DEF ONETR DEF STTRK DEF LU# DEF SECT# * LDA STTRK IF NO TRACKS NOW, SSA,RSS ISSUE A 'RECON WAITING JMP RECN5 TRACKS' MESSAGE TO THE LDA D1 CONSOLE AND THEN IOR MSIGN REISSUE THE REQUEST STA ONETR FOR TRACKS. LDB WAITT JSB MESS JMP RECN1 * RECN5 JSB EXEC TRY TO LOCK DEF *+3 RECON INTO THE DEF D22.I PARTITION. DO DEF D1 NOT ABORT. NOP DELAY FOR CLOCK TO TICK. * JSB EXEC TRY TO READ BOOTSTRAP DEF *+7 EXTENSION. DEF D1 DEF D2 DEF BTEXT DEF D128 DEF ZERO DEF ZERO SKP * LDA BTEXT+7 CHECK IF RECONFIGURATION CPA OTA1 ALREADY DONE. JMP RECN8 YES. * LDA BTEXT+165B CHECK IF BOOTSTRAP CPA DUMB1 EXTENSION IS JMP RECN9 VALID. * RECN7 LDB UNDBT 'UNDEFINED BOOTSTRAP EXTENSION' REC71 JSB MESS JMP REC15 * RECN8 LDB RCNDN 'BOOTSTRAP RECONFIGURATION ALREADY DONE' JSB MESS JMP REC10 * RECN9 LDB BTEXT+143B CHECK IF BASE TRACK(7900) OR SZB,RSS CYLINDER(7905) IS ZERO. JMP REC91 ERROR IF NONZERO. LDB NZEBT 'BOOTSTRAP EXTENSION DOES NOT BEGIN JMP REC71 WITH TRACK 0(7900) OR CYLINDER 0(7905). * REC91 LDA BTEXT+23B CPA LSR.7 SET DISC FLAG TO ONE JMP REC95 FOR 7905. CPA STA.B SET DISC FLAG TO ZERO RSS FOR 7900. JMP RECN7 IF NEITHER, THEN ERROR. SKP * * PATCH UP THE 7900 DUMMY, RECONFIGURATION PASS 1, * AND BOOTSTRAP EXTENSION BOOTS. * LDA BTEXT+140B SET UP AND C77 RECONFIGURATION ADA M600B BOOTSTRAP ADDRESS STA CONT IOR MSIGN INCLUDING DIRECTION STA MEMAD BIT. * LDB BTEXT+151B GET 7900 UNIT # LDA SKCM0 ADD TO IOR B SEEK COMMAND STA SKCM0 AND SAVE. * LDA RDCM0 ADD TO IOR B SEEK COMMAND STA RDCM0 AND SAVE. * STB UNIT0 SAVE AS UNIT. * LDA DENTY WRITE OUT THE 7900 STA DUMBT DUMMY BOOT. * LDA STTRK SET UP STA DKADD TRACK WORD. CLA SET HEAD/SECTOR WORD STA HDSCT TO 0(HEAD 0, SECTOR 0). * LDB DMK31 GET 7900 DEVICE TYPE FOR RECON BOOT. * LDA D00P1 GET 7900 RECON PASS 1 BOOT ADDRESS. JMP RE100 SKP * * PATCH UP CONSTANTS IN 7905 DUMMY, RECONFIGURATION * PASS 1 AND BOOT ENTENSION BOOTS. * REC95 LDA BTEXT+145B SET UP STARTING ADDRESS AND C77 OF RECONFIGURATION BOOT ADA M600B AND ALSO DMA DESTINATION STA CONT5 ADDRESS WITH THE DIRECTION IOR MSIGN BIT SET FOR 'INTO MEMORY'. STA MADD5 * LDA DWAK GET THE DESTINATION ADDRESS OF STA DEST THE 10 7905 CONTROL WORDS. LDB DB147 GET THE SOURCE ADDRESS IN THE * LOOP INB |s BOOT EXT FOR THE 10 7905 CONTROL LDA B,I WORDS. STA DEST,I MOVE THE 10 7905 ISZ DEST CONTROL WORDS FROM CPB DB151 THE BOOT EXTENSION TO RSS THE DUMMY BOOT. JMP LOOP * LDA DE795 GET THE ADDRESS OF THE 7905 STA DUMBT DUMMY BOOT AND SAVE. * LDA STTRK GET THE TRACK CLB AND CONVERT TO DIV BTEXT+141B ACYLINDER ADDRESS. STA CYLAI SAVE THE CYLINDER ADDRESS. STA CYLA3 BLF,BLF POSITION HEAD TO STB HDA BITS 8-12 AND STB HDA3 * LDB DMK32 GET DEVICE TYPE OF 7905. LDA D05P1 GET 7905 RECON PASS 1 ENTRY POINT. SKP * * PATCH UP RECONFIGURATION BOOT PASS 2 AND WRITE * ALL BOOTSTRAPS TO THE DISC. * RE100 STA DREBT SAVE ADDRESS OF PASS 1 BOOT. STB DMASK SAVE DISK TYPE. * LDA DPAS2 FORCE BOOTSTRAP EXTENSION STA JMP3I TO RETURN TO RECON PASS 2. * JSB EXEC WRITE RECONFIGURATION DEF *+7 BOOT PASS DEF D2 ONE TO DEF LU# DISC DREBT DEF * DEF D128 DEF STTRK DEF ZERO NOP DELAY FOR CLOCK TO TICK. * JSB EXEC WRITE RECONFIGURATION DEF *+7 BOOT PASS DEF D2 TWO TO DEF LU# DISC. DEF PASS2 DEF D256 DEF STTRK DEF D2 NOP DELAY FOR CLOCK TO TICK. * JSB EXEC WRITE BOOT EXTENSION DEF *+7 TO DISC. DEF D2 DEF LU# DEF BTEXT DEF D128 DEF STTRK DEF D6 NOP DELAY FOR CLOCK TO TICK. * JSB $LIBR GO NOP PRIVILEGED. * LDB XEQT ASSIGN TRACK 0 STB TAT,I TO RECON. SKP Pl JSB $LIBX GO DEF *+1 UNPRIVILEGED. DEF *+1 * JSB OUEXEC WRITE DUMMY BOOTSTRAP DEF *+7 INTO TRACK ZERO SECTOR DEF D2 ZERO. DEF D2 DUMBT DEF * DEF D128 DEF ZERO DEF ZERO NOP DELAY FOR CLOCK TO TICK. * LDA TAT LDB LU# COMPUTE ENTRY IN SLB TRACK ASSIGNMENT ADA TATSD TABLE AND SAVE. ADA STTRK STA TRKAT * CLB COMPUTE ADA D128 POSITION DIV D64 OF THIS STB OFSET TAT CLB ENTRY DIV D96 ON THIS STB TATSE DISC. STA TATTK * JSB $LIBR GO PRIVILEGED. NOP * ADA TAT ASSIGN LDB XEQT TO STB A,I RECON. * JSB $LIBX GO UNPRIVILEGED. DEF *+1 DEF *+1 NOP * JSB EXEC GO READ DEF *+7 THIS DEF D1 PORTION DEF LU# OF TAT. DEF DBUFF DEF D64 DEF TATTK DEF TATSE SKP LDB DDBUF SET DISK ADB OFSET TAT ENTRY LDA MSIGN TO STA B,I SYSTEM. * JSB EXEC WRITE DEF *+7 TAT DEF D2 BACK DEF LU# TO DDBUF DEF DBUFF DISK. DEF D64 DEF TATTK DEF TATSE NOP * JSB $LIBR GO PRIVILEGED. NOP * LDA TATTK ASSIGN TAT ENTRY ADA TAT TRACK, NEW BOOTS LDB MSIGN TRACK AND BOOT STB A,I EXTENSION TRACK STB TRKAT,I TO THE SYSTEM. STB TAT,I * JSB $LIBX GO UNPRIVILEGED. DEF *+1 DEF *+1 * REC10 LDB RCNFN 'RECON FINISHED' RSS * REC15 LDB RCNAB 'RECON ABORTED' JSB MESS * JSB EXEC UNLOCK PROGRAM DEF *+3 FROM CORE. IGNORE DEF D22.I ABORTIONS. DEF ZERO NOP IGNORE ERRORS. * JSB EXEC TERMINATE PROGRAM. DEF *+2 DEF D6 * SKP * ******************************************************* * * SUBROUTINE MESS: * * MESS WILL OUTPUT TO THE CONSOLE A MESSAGE. * * CALLING SEQUENCE: * LDB ADDD' * JSB MESS * * WHERE: * ADD DEF *+1 * DEF N * ASC N,MESSAGE * ***************************************************************** * MESS NOP LDA B GET BUFFER LENGTH STA IBUFL ADDRESS AND STORE. INB LDA B GET BUFFER ADDRESS STA IBUFR AND STORE. JSB EXEC DEF *+5 GO ISSUE MESSAGE. DEF D2 DEF CONLU IBUFR DEF * IBUFL DEF * JMP MESS,I SKP * * CONSTANTS, VARIABLES, MESSAGES AND BUFFERS * A EQU 0 B EQU 1 * ZERO DEC 0 D1 DEC 1 D2 DEC 2 D4 DEC 4 D6 DEC 6 D52 DEC 52 D64 DEC 64 D96 DEC 96 D128 DEC 128 D256 DEC 256 D22.I OCT 100026 C77 OCT 177700 M600B OCT 177200 * TRKAT NOP OFSET NOP TATSE NOP TATTK NOP * MSIGN OCT 100000 ONETR DEC 1 STTRK NOP LU# NOP SECT# NOP DMK31 OCT 14400 DMK32 OCT 15000 DEST NOP * LSR.7 OCT 101047 'LSR 7' STA.B OCT 070001 'STA B' * D00P1 DEF RBT00 D05P1 DEF RBT05 * DENTY DEF ENTRY DE795 DEF E7905 * DWAK DEF WAK DB147 DEF BTEXT+126B DB151 DEF BTEXT+140B * CONLU BSS 5 BUFFER FOR RMPAR. * WAITT DEF *+1 DEC 13 ASC 13,RECON WAITING FOR TRACKS. * RCNFN DEF *+1 DEC 8 ASC 8,RECON FINISHED. * RCNAB DEF *+1 DEC 7 ASC 7,RECON ABORTED. * RCNDN DEF *+1 DEC 20 ASC 20,BOOTSTRAP RECONFIGURATION ALREADY DONE. * UNDBT DEF *+1 DEC 15 ASC 15,UNDEFINED BOOTSTRAP EXTENSION. * NZEBT DEF *+1 DEC 38 ASC 17,BOOTSTRAP EXTENSION DOES NOT BEGIN OCT 6412 ASC 20, AT TRACK 0(7900) OR CYLINDER 0(7905). HEAD0 ASC 26g3, 24999-16044 1752 SOFTWARE SEVICE KIT SYSTEM 1000 SKP * ***************************************************************** * * 7900 DUMMY BOOTSTRAP * ***************************************************************** * BSS BEGIN+700B-* * ENTRY CLA IF SOMEONE JUMPS DIRECTLY HERE, ABS JMP-L+OTA1 * OCT 17506 * SPECIAL OCT 17506 * WORDS OCT 17506 * FOR OCT 124003 * SWTCH OCT 2011 * TO CHECK. * OTA1 OTA 1 THEN CLEAR SW.REG. * RSTRT ABS LDB-L+MEMAD GET STARTING ADDRESS OF CLC 2 RECONFIGURATION BOOT AND SEND. ABS JMP-L+CONSW * OCT 3304 * SPECIAL OCT 40001 * WORDS OCT 5225 * FOR OCT 106702 * SWTCH OCT 106602 * TO CHECK. * CONSW OTB 2 ABS LDA-L+WDCNT GET WORD COUNT, STC 2 SET DMA AND OTA 2 SEND IT. * ABS LDA-L+DKADD GET TRACK ADDRESS DSKDA OTA 0 AND SENT IT. DSKDB STC 0,C * ABS LDA-L+SKCM0 GET SEEK COMMAND DSKCA CLC 1 AND SEND IT. DSKCB OTA 1 DSKCC STC 1,C START SEEK. * ABS LDB-L+HDSCT GET HEAD-SECTOR. DSKDC SFS 0 WAIT FOR TRACK. ABS JMP-L+DSKDC * DSKDD OTB 0 SEND HEAD/SECTOR COMMAND. DSKDE STC 0,C ABS LDA-L+RDCM0 GET READ COMMAND. DSKCD SFS 0 WAIT FOR SEEK. ABS JMP-L+DSKCD * RSS SKIP OVER BBDL ENTRY ADDRESS. ABS 2000B+JMPIN-L * DSKCE OTA 1 SEND READ COMMAND. DSKDF STC 0,C SET UP FOR READ. DSKCF CLC 1 STC 6,C START DMA A DSKCG STC 1,C START READ. DSKCH SFS 1 WAIT FOR END. ABS JMP-L+DSKCH * STF 6 DISABLE DMA DSKDG STC 0,C FOR STATUS. ABS LDA-L+UNIT0 DSKCI CLC 1 GET STATUS DSKCJ OTA 1 ON UNIT. DSKCK STC 1,C DSKDH SFS 0 WAIT FOR STATUS. ABS JMP-L+DSKDH * ABS LDB-L+CH.0 SET TO DISC CHANNEL. DSKDI LIA 0 SLA,RSS ABS JMP-L+CONT+I+I HLT 31B ABS JMP-L+RSTRT * * DATA SECTION * MEMAD OCT 100000 MEMORY ADDRESS FOR RECON & BOOT EXTENSION. DKADD NOP TRACK ADDRESS OF RECON & BOOT EXTENSION. SKCM0 OCT 30000 SEEK COMMAND. HDSCT NOP HEAD/SECTOR WORD FOR RECON & BOOT EXTENSION. RDCM0 OCT 20000 READ COMMAND. UNIT0 NOP UNIT OF DUMMY BOOT. CONT NOP STARTING ADDRESS OF RECON BOOT. CH.0 NOP WDCNT OCT 177000 -WORD COUNT FOR RECON & BOOT EXTENSION. B77.0 OCT 77 C77.0 OCT 177700 * DUMB2 ABS LDA-L+JMPIN+I+I GET DISC S.C. ABS AND-L+B77.0 FROM PROTECTED ABS STA-L+CH.0 BOOT AND SAVE. HLT 77B EXECUTE HLT 77. * ABS LDA-L+DSKDA 'OTA 0' ABS AND-L+C77.0 ABS ADA-L+CH.0 ABS STA-L+DSKDA * INA ABS STA-L+DSKCB 'OTA 1' ABS STA-L+DSKCE ABS STA-L+DSKCJ * ABS LDA-L+DSKDB 'STC 0,C' ABS AND-L+C77.0 ABS ADA-L+CH.0 ABS STA-L+DSKDB ABS STA-L+DSKDE ABS STA-L+DSKDF ABS STA-L+DSKDG * INA ABS STA-L+DSKCC 'STC 1,C' ABS STA-L+DSKCG ABS STA-L+DSKCK * ABS LDA-L+DSKCA 'CLC 1' ABS AND-L+C77.0 ABS ADA-L+CH.0 ABS STA-L+DSKCA ABS STA-L+DSKCF ABS STA-L+DSKCI * ABS LDA-L+DSKDC 'SFS 0' NOP * SPECIAL WORD FOR SWTCH TO CHECK. ABS AND-L+C77.0 ABS ADA-L+CH.0 ABS STA-L+DSKDC ABS STA-L+DSKCD ABS STA-L+DSKDH * INA ABS STA-L+DSKCH 'SFS 1' * ABS LDA-L+DSKDD 'OTB 0' ABS AND-L+C77.0 ABS ADA-L+CH.0 ABS STA-L+DSKDD * ABS LDA-L+DSKDI 'LIA 0' ABS AND-L+C77.0 ABS ADA-L+CH.0 ABS STA-L+DSKDI ABS JMP-L+RSTRT BSS 0 FORCE JM<>PIN AT 164B RELATIVE. * JMPIN NOP JSB HERE FROM ROM BOOT. ABS LDA-L+JMPIN CHECK IF CAME SZA FROM PAPER TAPE ABS JMP-L+DUMB1 OR ROM BOOT. HLT60 HLT 60 IF FROM PAPER BOOT, ABS JMP-L+HLT60 THEN HLT 60. * DUMB1 STF 6 CLEAN UP DMA AND CLC 0,C THE I/O SYSTEM. CLA CLEAR SWITCH OTA 1 REGISTER. ABS JMP-L+DUMB2 GO DO HLT 77. * L EQU ENTRY-11B SKP * ***************************************************************** * * 7905 DUMMY BOOTSTRAP * ***************************************************************** * BSS BEGIN+1100B-* * E7905 CLA ABS JMP-N+E7951 * OCT 17506 * SPECIAL OCT 17506 * CHECK OCT 17506 * WORDS OCT 124003 * FOR OCT 2011 * SWTCH. * E7951 OTA 1 * RTRT5 ABS LDB-N+MADD5 SET MEMORY ADDRESS CLC 2 AND DIRECTION BIT ABS JMP-N+E7952 * OCT 3304 * SPECIAL OCT 40001 * CHECK OCT 5225 * WORDS OCT 106702 * FOR OCT 106602 * SWTCH. * E7952 OTB 2 AND SEND. * ABS LDA-N+WDCT5 GET WORD COUNT STC 2 SET DMA AND OTA 2 SEND IT. * ABS LDB-N+D#PRM GET THE COMMAND SLOOP INB ADDRESS AND LDA B,I THE COMMAND. RAL,CLE,SLA,ERA IF SIGN BIT DSK10 CLC DC SET THEN SEND DSK11 OTA DC,C 'COMMAND IS COMING' ABS CPB-N+A#DMA IF DMA, THEN STC 6,C START IT. DSK12 STC DC ALLOW ATENTION. SEZ,RSS IF NOT A COMMAND, THEN ABS JMP-N+STDMA DON'T WAIT FOR FLAG. * DSK13 SFS DC WAIT FOR FLAG. ABS JMP-N+*-1 STDMA STF 6 STOP DMA IF NEEDED. NOP RSS SKIP OVER BBDL  ABS 2000B+INJMP-N ENTRY ADDRESS. ABS CPB-N+A#END END OF LOOP? RSS YES, SO SKIP. ABS JMP-N+SLOOP NO, SO GO AGAIN. * DSK14 LIA DC,C GET STATUS 1. DSK15 SFS DC WAIT FOR FLAG. ABS JMP-N+*-1 DSK16 LIB DC,C GET STATUS 2. ABS LDB-N+CH.5 SET TO DISC CHANNEL. ABS AND-N+C174B ISOLATE, IF NO SZA,RSS ERRORS, THEN EXECUTE ABS JMP-N+CONT5+I+I RECONFIGURATION BOOT. * ABS CPA-N+C174B ELSE, IF ATTENTION RSS THEN SKIP. HLT 31B OTHERWIZE, HLT 31. CONTT ABS JMP-N+RTRT5 TRY AGAIN. * * DATA SECTION * C174B OCT 177400 MADD5 OCT 100000 MEMORY ADDRESS AND DIRECTION BIT. WDCT5 OCT 177000 -WORD COUNT OF RECONFIGURATION & BOOT EXT. * WAK OCT 113000 SKCMD OCT 101200 CYLAI NOP HDA NOP AD#RC OCT 106000 CYLA3 NOP HDA3 NOP FILM# OCT 107404 R#CMD OCT 102400 S#TAC OCT 101400 D#PRM ABS WAK-N-1+2000B A#DMA ABS R#CMD-N+2000B A#END ABS S#TAC-N+2000B B77.5 OCT 77 CH.5 NOP IORMK OCT 4000 C77.5 OCT 177700 CONT5 NOP * DUM52 ABS LDA-N+INJMP+I+I ABS AND-N+B77.5 ABS STA-N+CH.5 HLT 77B * ABS LDA-N+DSK10 'CLC DC' ABS AND-N+C77.5 ABS ADA-N+CH.5 ABS STA-N+DSK10 * ABS LDA-N+DSK11 'OTA DC,C' ABS AND-N+C77.5 ABS ADA-N+CH.5 ABS STA-N+DSK11 * ABS LDA-N+DSK12 'STC DC' ABS AND-N+C77.5 ABS ADA-N+CH.5 ABS STA-N+DSK12 * ABS LDA-N+DSK13 'SFS DC' ABS AND-N+C77.5 ABS ADA-N+CH.5 ABS STA-N+DSK13 ABS STA-N+DSK15 * ABS LDA-N+DSK14 'LIA DC,C' ABS AND-N+C77.5 ABS JMP-N+E7953 * OCT 2 * SPECIAL WORDS NOP * FOR SWTCH TO NOP * TO CHECK. * E7953 ABS ADA-N+CH.5 ABS STA-N+DSK14 ABS IOR-N+IORMK 'LIA DC,C' ABS STA-N+DSK16 * ABS JMP-N+RTRT5 * G BSS 11 FORCE INJMP AT 164B RELATIVE. * INJMP NOP JSB FROM ROM OR PROTECTED BOOT. ABS LDA-N+INJMP CHECK IF CAME SZA FROM PAPER TAPE ABS JMP-N+DUM51 OR PRPTECTED BOOT. HLL60 HLT 60 IF FROM PAPER TAPE, ABS JMP-N+HLL60 THEN HLT 60. * DUM51 STF 6 CLEAN UP DMA AND CLC 0,C THE I-O SYSTEM. CLA CLEAR THE SWITCH OTA 1 REGISTER. ABS JMP-N+DUM52 GO DO HLT 77. * N EQU E7905-11B DC EQU 0 SKP * ***************************************************************** * * 7900 RECONFIGURATION BOOTSTRAP PASS 1 * ***************************************************************** * BSS BEGIN+1300B-* * RBT00 ABS STB-R+CHP2 SAVE DISC CHANNEL FOR PASS 2. * ABS LDA-T+DCKDA 'OTA 0' ABS AND-M+C77.1 ADA B ABS STA-T+DCKDA * INA ABS STA-T+DCKCB 'OTA 1' ABS STA-T+DCKCE ABS STA-T+DCKCJ * ABS LDA-T+DCKDB 'STC 0,C' ABS AND-M+C77.1 ADA B ABS STA-T+DCKDB ABS STA-T+DCKDE ABS STA-T+DCKDF ABS STA-T+DCKDG * INA ABS STA-T+DCKCC 'STC 1,C' ABS STA-T+DCKCG ABS STA-T+DCKCK * ABS LDA-T+DCKCA 'CLC 1' ABS AND-M+C77.1 ADA B ABS STA-T+DCKCA ABS STA-T+DCKCF ABS STA-T+DCKCI * ABS LDA-T+DCKCD 'SFS 0' ABS AND-M+C77.1 ADA B ABS STA-T+DCKCD ABS STA-T+DCKDC ABS STA-T+DCKDH * INA ABS STA-T+DCKCH 'SFS 1' * ABS LDA-T+DCKDD 'OTB 0' ABS AND-M+C77.1 ADA B ABS STA-T+DCKDD * ABS LDA-T+DCKDI 'LIA 1' ABS AND-M+C77.1 ADA B INA ABS STA-T+DCKDI * ABS JMP-T+BTEXT GO TO BOOT EXTENSION. * M EQU RBT00-700B * C77.1 OCT 177700 SKP * ****t*************************************************** * * 7905 RECONFIGURATION BOOT PASS 1 * ******************************************************* * BSS BEGIN+1400B-* * RBT05 ABS STB-R+CHP2 SAVE DISC CHANNEL FOR PASS 2. * ABS LDA-T+DCK10 'CLC DC' ABS AND-P+C77.6 ADA B ABS STA-T+DCK10 * ABS LDA-T+DCK11 'OTA DC,C' ABS AND-P+C77.6 ADA B ABS STA-T+DCK11 * ABS LDA-T+DCK12 'STC DC' ABS AND-P+C77.6 ADA B ABS STA-T+DCK12 * ABS LDA-T+DCK13 'SFS DC' ABS AND-P+C77.6 ADA B ABS STA-T+DCK13 ABS STA-T+DCK15 * ABS LDA-T+DCK14 'LIA DC,C' ABS AND-P+C77.6 ADA B ABS STA-T+DCK14 * ABS LDA-T+DCK16 'LIB DC,C' ABS AND-P+C77.6 ADA B ABS STA-T+DCK16 * ABS JMP-T+BTEXT GO TO BOOT EXTENSION. * C77.6 OCT 177700 * P EQU RBT05-700B SKP * ***************************************************************** * * RECONFIGURATION BOOTSTRAP PASS 2 * ***************************************************************** * BSS BEGIN+1500B-* * PASS2 ABS LDA-R+DMASK SCAN FOR FIRST ABS JSB-R+SCAN DVR3X DEVICE. ABS STA-R+DKEQT * LDA INTRB STORE EQT ABS ADA-R+M6 TABLE ADDRESS ABS ADA-R+CHP2 INTO INTERRUPT ABS STA-R+TEMP0 ABS STB-R+TEMP0+I+I TABLE. ABS ISZ-R+TEMP0 * CLE SET E=0 IF ABS LDA-R+DMASK 7900, E=1 IF ABS CPA-R+B15K 7905. CCE * SEZ,RSS IF 7900, THEN STORE EQT ADDRESS ABS STB-R+TEMP0+I+I IN SECOND INTRB LOCATION. * LDB DRT STORE NEW INB S.C. INTO LDA B,I DRT ENTRY ABS AND-R+C77P2 TWO. ABS IOR-R+DKEQT STA B,I * SEZ IF 7900, THEN ABS JMP-R+PAS10  PUT A 'CLC SC' ABS LDA-R+CLCSC IN THE FIRST ABS IOR-R+CHP2 TRAP CELL. ABS STA-R+CHP2+I+I ABS ISZ-R+CHP2 * PAS10 ABS LDA-R+.5+I+I GET 'JSB $CIC,I' FROM OLD DISC ABS STA-R+JCICI TRAP CELL AND SAVE. PUT INTO NEW ABS STA-R+CHP2+I+I DISC BASE PAGE TRAP CELL. * LIA 1 GET NEW S.C. FOR ABS AND-R+B77P2 CONSOLE FROM S-REG SZA,RSS BITS 0-5. ABS JMP-R+PAS21 IF ZERO, SKIP. * ABS STA-R+CHP2 SAVE S.C. AND ABS LDA-R+CHSC3 CONFIGURE I-O ABS IOR-R+CHP2 INSTRUCTIONS. ABS STA-R+CHSC3 ABS LDA-R+CHSC4 ABS IOR-R+CHP2 ABS STA-R+CHSC4 ABS LDA-R+CHSC2 ABS IOR-R+CHP2 ABS STA-R+CHSC2 * ABS LDA-R+CHMRS SEND MASTER RESET.FLAG SET=12966A. CHSC2 CLF 0 CHSC3 OTA 0 CHSC4 SFS 0 * CLE,RSS IF NOT 12966A CARD, SET E=0. CCE IF 12966A CARD, SET E=1. * LDB SYSTY GET ABS ADB-R+D4.0 OLD LDA B,I DEVICE ABS AND-R+TMASK TYPE. ABS CPA-R+B2400 ABS JMP-R+PAS29 SEZ ABS JMP-R+PAS28 OLD=00, NEW=05. ABS JMP-R+PAS27 OLD=00, NEW=00. * PAS29 SEZ ABS JMP-R+PAS27 OLD=05, NEW=05. PAS28 CLA,SEZ OLD=05, NEW=00. ABS LDA-R+B2400 SCAN FOR 00 OR ABS JSB-R+SCAN 05 DEVICE. * STB SYSTY SETUP BASE PAGE CONSOLE WORD. * STA DRT,I FIX LU#1. * PAS25 LDA INTRB FIX INTERRUPT ABS ADA-R+M6 TABLE ABS ADA-R+CHP2 ENTRY. STB A,I * ABS LDA-R+JCICI ABS STA-R+CHP2+I+I * PAS21 LIA 1 GET NEW S.C.FOR ALF,ALF TBG FROM S-REG RAL,RAL BITS 6-11. ABS AND-R+B77P2 SZA,RSS IF ZERO, ABS JMP-R+PAS22 SKIP. STA TBG CLB CLEAR LDA INTRB =s TBG ABS ADA-R+M6 INTERRUPT ADA TBG TABLE STB A,I LOCATION. * ABS LDA-R+JCICI SET UP TBG STA TBG,I TRAP CELL. * PAS22 LIA 1 GET NEW S.C. ALF FOR PRIVILEGE ABS AND-R+B17P2 INTERRUPT CARD. SZA,RSS IF ZERO, ABS JMP-R+PAS23 SKIP. * ABS CPA-R+B10 IF NEW S.C=10 CLA THEN CLEAR STA DUMMY DUMMY. * ABS LDB-R+JCICI PUT 'JSB $CIC,I' INTO BASE STB DUMMY,I PAGE TRAP CELL. PAS23 JMP 3,I GOTO SYS.(FINALLY,HOPE SHE FLIES). * PAS27 ABS ADB-R+DM1 CURRENT SYSTEM CONSOLE IS ALRIGHT LDA B,I EXCEPT FOR THE CHANNEL IN EQT ABS AND-R+C77P2 WORD 4. FIX UP WORD ABS IOR-R+CHP2 4 THEN RETURN AND STA B,I FIX UP BASE PAGE ABS ADB-R+DM3 ABS JMP-R+PAS25 TRAP CELL AND INTRB. * CHMRS OCT 150077 MASTER RESET FOR 12966A CARD. CLCSC OCT 106700 'CLC SC' JCICI NOP DMASK NOP SET UP BY RECON. DKEQT NOP OLDCH NOP SET BY SCAN. CHP2 NOP B15K OCT 15000 B17P2 OCT 17 B77P2 OCT 77 C77P2 OCT 177700 B10 OCT 10 B2400 OCT 2400 M6 DEC -6 .5 DEC 5 DPAS2 ABS JMP-R+PASS2 SKP * **************************************************************** * * SCAN SUBROUTINE: * * ENTRY: * :=BITS 8-13 = DEVICE TYPE. * JSB SCAN * * EXIT: * :=EQT# * :=EQT1 ADDRESS. * **************************************************************** * SCAN NOP PW ABS STA-R+TEMP0 SAVE DEVICE TYPE MASK. LDB EQT# SET CMB,INB UP ABS STB-R+COUNT COUNT. LDB EQT POSITION TO FIRST ABS ADB-R+D4.0 EQT WORD 5. * SCAN1 LDA B,I GET DEVICE TYPE ABS AND-R+TMASK FROM EQT WORD 5. ABS CPA-R+TEMP0 IF CORRECT TYPE, ABS JMP-R+SCAN2 THEN EXIT. ABS ADB-R+D15.0 POSITION TO NEXT ABS ISZ-R+COUNT EQT WORD 5. ABS JMP-R+SCAN1 CONTINUE SCAN. HLT 61 IF NO DEVICE, ABS JMP-R+*-1 HLT 61. * SCAN2 ABS ADB-R+DM1 LDA B,I ABS AND-R+B77P2 GET OLD ABS STA-R+OLDCH CHANNEL AND LDA B,I SAVE IT. ABS AND-R+C77P2 FIX CHANNEL ABS IOR-R+CHP2 IN EQT WORD 4. STA B,I ABS ADB-R+DM3 POSITION TO EQT1. ABS LDA-R+COUNT COMPUTE ADA EQT# EQT # INA AND ABS JMP-R+SCAN+I+I RETURN. * TEMP0 NOP TMASK OCT 37400 COUNT NOP D4.0 DEC 4 D15.0 DEC 15 DM1 DEC -1 DM3 DEC -3 * R EQU PASS2-1100B SKP * ***************************************************************** * * BOOTSTRAP EXTENSION * ***************************************************************** * BSS BEGIN+2000B-* * BTEXT EQU * * BSS 200B * JMP3I EQU BTEXT+5B * DCKDA EQU BTEXT+60B DCKDB EQU BTEXT+61B DCKCA EQU BTEXT+63B DCKCB EQU BTEXT+64B DCKCC EQU BTEXT+65B DCKDC EQU BTEXT+74B DCKDD EQU BTEXT+76B DCKDE EQU BTEXT+77B DCKCD EQU BTEXT+101B DCKCE EQU BTEXT+103B DCKDF EQU BTEXT+104B DCKCF EQU BTEXT+105B DCKCG EQU BTEXT+107B DCKCH EQU BTEXT+110B DCKDG EQU BTEXT+113B DCKCI EQU BTEXT+115B DCKCJ EQU BTEXT+116B DCKCK EQU BTEXT+117B DCKDH EQU BTEXT+120B DCKDI EQU BTEXT+122B * DCK10 EQU BTEXT+72B DCK11 EQU BTEXT+73B DCK12 EQU BTEXT+76B DCK13 EQU BTEXT+101B DCK14 EQU BTEXT+107B DCK15 EQU BTEXT+110B DCK16 EQU BTEXT+112B * BENT EQU BTEXT+164B * T EQU BTEXT-1500B SKP * ***************************************************************** * * DISC BUFFER FOR TAT * **************************************************************** * DBUFF BSS 128 * * * ZXTCPB EQU 056000B CPA EQU 052000B LDB EQU 066000B STB EQU 076000B ADB EQU 046000B JSB EQU 016000B ISZ EQU 036000B LDA EQU 062000B STA EQU 072000B ADA EQU 042000B AND EQU 012000B XOR EQU 022000B IOR EQU 032000B JMP EQU 026000B I EQU 040000B INDIRECT BIT(CODE AS I+I) * EQT EQU 1650B EQT# EQU 1651B DRT EQU 1652B INTRB EQU 1654B TAT EQU 1656B TBG EQU 1674B SYSTY EQU 1675B XEQT EQU 1717B DUMMY EQU 1737B TATSD EQU 1756B * END RECON pkZ I] 24999-18065 1932 S 0100 &JSAVE              H0101 pFTN4,L C C VERSION 4 / 21 / 76 JRT C MODIFIED 6 / 08 / 7 MCC C MODIFIED 9 / 13 / 79 DHP C PROGRAM JSAVE(3,60),24999-16048 REV 1932 790913 C LOGICAL RWIND,VERIFY C DIMENSION IREG(2),MBUF(50),IPBUF(33),ISTNG(40) DIMENSION IBUF(8321),JBUF(20000B),ICLST(4,32) INTEGER FIRST,LAST,SFLAG,FILEN C DIMENSION MESS1(12),MESS2(29),MESS3(13),MESS4(15) DIMENSION MESS5(13),MESS6(14),MESS7(23),MES71(13) DIMENSION MESS8(8),MESS9(12),MES10(13),MES11(9) DIMENSION IREV(25),JVMESS(9) DIMENSION MES12(11),MES13(9),MES14(15),MES15(19) C EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) EQUIVALENCE (IBUF,ITRAK),(JBUF,IBUF(2)),(IBUF,ICLST) EQUIVALENCE (IPBUF(4),IWD4),(IPBUF(5),IWD5) EQUIVALENCE (IPBUF(2),IWD2),(IPBUF(6),IWD6) C EQUIVALENCE (JBUF(4),JBUF4),(JBUF(5),JBUF5),(JBUF(7),JBUF7), + (JBUF(8),JBUF8),(JBUF(10),JBUF10) EQUIVALENCE (MBUF(2),MBUF2),(MBUF(11),MBUF11),(MBUF(26),MBUF26), + (MBUF(27),MBUF27),(MBUF(4),MBUF4) C EQUIVALENCE (MES15(10),MS150),(MES15(11),MS151),(MES15(12),MS152) C DATA SFLAG,JLNTH,MLNTH/0,128,29/ C DATA MESS1/6412B,2H/J,2HSA,2HVE,2H: ,2HMA,2HG ,2HTA,2HPE, & 2H L,2HU:,2H _/ DATA MESS2/6412B,2H/J,2HSA,2HVE,2H: ,2HDI,2HSC,2H C,2HRN,2H[-, & 2HLU,2H]:,2H (, & 2H[,,2HLA,2HST,2H T,2HRA,2HCK,2H] ,2H , & 2HLU,2H= ,2H0 ,2H=>,2H E,2HND,2H) ,2H _/ DATA MESS3/2H/J,2HSA,2HVE,2H: ,2HTH,2HAT,2H'S,2H N,2HOT, & 2H A,2H D,2HIS,2HC!/ DATA MESS4/2H/J,2HSA,2HVE,2H: ,2HTH,2HAT,2H'S, & 2H N,2HOT,2H A,2H M,2HAG,2H T, & 2HAP,2HE!/ DATA MESS5/2H/J,2HSA,2HVE,2H: ,2HCA,2HN',2HT , & 2HDO,2H T,2HHA,2HT ,2HLU,2H! / DATA MESS6/2H/J,2HSA,2HVE,2H: ,2HMA,2HX ,2H= , & 2H50,2H, ,2HMI,2HN ,2H= ,2H0!/ DATA MESS7/2H/J,2HSA,2HVE,2H: ,2HEN,2HTE,2HR ,2HAN,2HY ,2HAD, & 2HDI,2HTI,2HON,2HAL,2H C,2HOM,2HME,2HNT,2HS ,2HOR, & 2H ",2H ",2HCR/ DATA MES71/2H/J,2HSA,2HVE,2H: ,2HDE,2HFA,2HUL,2HT ,2HHE,2HAD, & 2HER,2H I,2HS:/ DATA MESS8/6412B,2H/J,2HSA,2HVE,2H: ,2HEN,2HD?,2H _/ DATA MESS9/6412B,2H/J,2HSA,2HVE,2H: ,2HDO,2HNE,2H! ,6412B/ DATA MES10/6412B,2H/J,2HSA,2HVE,2H: ,2HMA,2HG , & 2HTA,2HPE,2H F,2HIL,2HE:,2H _/ DATA MES11/2H/J,2HSA,2HVE,2H: ,2HEO,2HF ,2HFO,2HUN,2HD!/ DATA MES12/2H/J,2HSA,2HVE,2H: ,2HNO,2HT ,2HJS,2HAV,2HE ,2HFI, & 2HLE/ DATA MES13/2H/J,2HSA,2HVE,2H: ,2H V,2HER,2HIF,2HYI,2HNG/ DATA MES14/2H/J,2HSA,2HVE,2H: ,2HWA,2HIT,2HIN,2HG ,2HFO, & 2HR ,2HLU,2H# ,3*2H / DATA MES15/2H/J,2HSA,2HVE,2H: ,2HCA,2HRT,2HRI,2HDG,2HE ,3*2H , & 2H N,2HOT,2H M,2HOU,2HNT,2HED,2H. / DATA IREV /2H24,2H99,2H9-,2H16,2H04,2H8 ,2H19,2H32,2H S,2HOF, & 2HTW,2HAR,2HE ,2HSE,2HRV,2HIC,2HE ,2HKI,2HT ,2HSY, & 2HST,2HEM,2H 1,2H00,2H0 / DATA JVMESS/2H/J,2HSA,2HVE,2H: ,2HVE,2HRI,2HFY,2H ?,2H _/ C C SET DEFAULTS AND CHECK TURN ON STRING C DATA MBUF/2HCR,24*20040B,6412B,24*20040B/ DATA ISTNG/40*0/,LEN,IDISC,NFILE/0,0,0/ DATA IRCNT,ISTRC/1,1/,MTLU/8/,IMESS/0/ DATA RWIND/.TRUE./,VERIFY/.FALSE./,LASTTR/0/ DATA ICL /3/,IDELT/0/ C C GET SESION TERMINAL C LU = LOGLU(ISES) ILU=LU+400B C C GET TURN ON STRING C CALL GETST(JBUF,-70,ILOG) IF(ILOG .EQ. 0)GO TO 3 C C SAVE ORIGINAL STRING IN CASE OF " . . . "'S C IOFF = IAND(ILOG,1) IWDL = ILOG/2 + IOFF DO 700 I=1,IWDL ISTNG(I) = JBUF(I) 700 CONTINUE C C CHANGE "=" 'S TO ":" 'S C CALL EQCOL(JBUF,ILOG) C C SCAN STRING FOR WHAT TO DO. ORDER DOESN'T MATTER C 710 IF(NAMR(IPBUF,JBUF,ILOG,ISTRC))3,720 C 720 NTYPE = IAND(IWD4,3) IF(NTYPE .LE. 1)GO TO 710 IPBUF N= IOR(IAND(IPBUF,77400B),40B) IF(IPBUF .EQ. 1HD)IDISC = IWD5 IF(IPBUF .EQ. 1HF)NFILE = IWD5 IF(IPBUF .EQ. 1HI)RWIND = .FALSE. IF(IPBUF .EQ. 1HL)LASTTR= IWD5 IF(IPBUF .EQ. 1HM)MTLU = IWD5 IF(IPBUF .EQ. 1HR)IRCNT = IWD5 IF(IPBUF .EQ. 1HV)VERIFY= .TRUE. IF(IPBUF .EQ. 1H")CALL QUOTE(ISTNG,MBUF27,LEN) GO TO 710 C 3 CALL EXEC(2,ILU,IREV,25) IF(ILOG .EQ. 0)NFILE = 1 FILEN = NFILE C C GET DISC AND MAG TAPE LU'S C IF(ILOG .GT. 0)GO TO 11 10 CALL EXEC(2,ILU,MESS1,12) X=REIO(1,ILU,JBUF,-10) CALL PARSE(JBUF,IB,IPBUF) MTLU=IWD2 C 11 CALL EXEC(13,MTLU,ISTAT) IF(IAND(ISTAT,37400B)*2.EQ.23000B)GO TO 14 IF(IAND(ISTAT,37400B)*2.EQ.24000B)GO TO 14 C C NOT A MAG TAPE IF NOT DVR23 OR DVR24 C CALL EXEC(2,ILU,MESS4,15) GO TO 10 C 14 IREG=LURQ(100001B,MTLU,1) IF(IREG.EQ.0)GO TO 142 C C LOCK UNSUCCESSFUL, SO REPORT C CALL CNUMD(MTLU,MES14(13)) IF (IMESS .EQ. 0)CALL EXEC(2,LU,MES14,15) C IMESS = 1 CALL EXEC(12,0,2,0,-3) IF(IFBRK(IDMMY))99,14 142 IF(NFILE .GE. 1)REWIND MTLU C IF(ILOG .GT. 0 .AND. IDISC .NE. 0)GO TO 152 C 15 IF(SFLAG.EQ.0)GO TO 151 MESS2(13)=020137B MLNTH=13 C C GET DISK LU (LAST TRK) ETC. C 151 CALL EXEC(2,ILU,MESS2,MLNTH) X=REIO(1,ILU,JBUF,-12) CALL PARSE(JBUF,IB,IPBUF) IDISC=IWD2 IF(IWD5 .GT. 0)LASTTR=IWD6 ICL = 3 C C QUIT IF DISK LU GIVEN AS 0. C IF(IDISC.EQ.0)GO TO 90 152 IF(IDISC .GT. 0)GO TO 153 IDISC = IABS(IDISC) ICL = 1 153 CALL FSTAT(ICLST) DO 154 J=1,31 IF(ICLST(ICL,J) .NE. IDISC)GO TO 154 IDISC = ICLST(1,J) IF(LASTTR .EQ. 0)LASTTR = ICLST(2,J) GO TO 158 154 CONTINUE C C IF THIS IS AN LU# LET HIM SAVE IT C IF(ICL .EQ. 1)GO TO 158 C C TELL HIM THE CRN IS NOT MOUNTED C MS150 = 20040B  MS151 = 20040B MS152 = -1 CALL ASCII(IDISC,MS152) IF(MS152 .EQ. 2H )CALL CNUMD(IDISC,MS150) CALL EXEC(2,ILU,MES15,19) GO TO 15 C C DISK LU < 7 NOT ALLOWED C 158 IF(IDISC .GT. 6)GO TO 16 CALL EXEC(2,ILU,MESS5,13) GO TO 15 C 16 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37000B)/256 C C NOT A DISK IF DVR NOT 30 OR 32 C IF((ITYPE.EQ.30B).OR.(ITYPE.EQ.32B))GO TO 20 CALL EXEC(2,ILU,MESS3,13) GO TO 15 C C GET MAG TAPE FILE NUMBER AND IDENT C 20 IF(SFLAG.NE.0)GO TO 30 IF(ILOG .GT. 0)GO TO 205 C C GET FILE # IF FIRST TIME. C 21 CALL EXEC(2,ILU,MES10,13) X=REIO(1,ILU,JBUF,-10) CALL PARSE(JBUF,IB,IPBUF) NFILE=IWD2 FILEN=NFILE C C QUIT IF FILE # < 0 . C 205 IF(NFILE.LT.0)GO TO 90 C C GO POSITION THE TAPE IF FILE # <= 50. IF(NFILE.LE.50)GO TO 22 CALL EXEC(2,ILU,MESS6,14) GO TO 21 C C POSITION THE TAPE C 22 IF(NFILE.LE.1)GO TO 30 C C READ ONE LONG (6145) RECORD FORM TAPE. C 23 X=EXEC(1,MTLU,IBUF,JLNTH+1) IF(IB.GT.0)GO TO 211 CALL EXEC(2,ILU,MES11,9) GO TO 30 211 IF(IB.LE.100)GO TO 212 C C NOT A HEADER IF LENGTH > 100 WORDS. C CALL EXEC(2,ILU,MES12,11) GO TO 213 C C DISPLAY THE HEADER FOR THIS FILE THEN FF ONE FILE . C (TO THE END OF THIS DISK COPY) C 212 CALL EXEC(2,ILU,IBUF,IB) 213 CALL EXEC(3,MTLU+1300B) NFILE=NFILE-1 IF(NFILE .EQ. 1)30,23 C C GET HEADER AND WRITE TO TAPE C C C GET THE # OF TRKS BY FORCING A SEEK BEYOND THE POSIBLE END. C 30 X=EXEC(1,IDISC,JBUF,128,10000,0) ITRAK=IB-1 IF(LASTTR.NE.0 .AND. LASTTR .LE. ITRAK)ITRAK=LASTTR CALL EXEC(1,IDISC,JBUF,JLNTH,ITRAK,0) C C CALCULATE BUFFER LENGTH FROM NUMBER OF SECTORS/TRACK C JLNTH = JBUF7 * 64 C C PUT CR# LABEL INTO OUTPUT BUFFER & BLANK FILL THE CRN C DO 305 Ik=1,3 MBUF(I+5) = JBUF(I) MBUF(I+1) = 20040B 305 CONTINUE C C CHECK FOR POSSIBLE ASCII CR# C MBUF4 = -1 CALL ASCII(JBUF4,MBUF4) IF(MBUF4 .EQ. 2H )CALL CNUMD(JBUF4,MBUF2) C C CALL FTIME ROUTINE TO GET THE CURRENT DATE & TIME C CALL FTIME(MBUF11) C MBUF26 = 6412B IF(ILOG .GT. 0)GO TO 33 DO 31 I=27,50 MBUF(I)=2H 31 CONTINUE C C DISPLAY DEFAULT HEADER AND C PROMPT FOR HEADER. C CALL EXEC(2,ILU,MES71,13) CALL EXEC(2,ILU,MBUF,25) CALL EXEC(2,ILU,MESS7,23) C C READ THE HEADER. C X = REIO(1,ILU,MBUF27,-48) LEN = IB C C AND WRITE IT TO TAPE. C 33 IF(LEN .GT. 48)LEN = 48 CALL EXEC(2,ILU,MBUF,-(LEN+52)) CALL EXEC(2,MTLU,MBUF,50) C C C HAVE ALL LU'S, NOW GO COPY THE DISC... C COPY ALL DIRECTORY TRACKS FIRST, FOLLOWED BY C ALL TRACKS USED BY FMP (UN-USED TRACKS WON'T BE COPIED) C FIRST=JBUF5 LAST=JBUF10 IF(LAST.EQ.LASTTR)LAST=LAST-1 LOWDIR=JBUF8 C 40 CALL EXEC(1,IDISC,JBUF,JLNTH,ITRAK,0) 41 CALL EXEC(2,MTLU,IBUF,JLNTH+1) IF(IFBRK(IDUM))99,42 C C GO COPY DATA TRKS IF DONE WITH DIRECTORY TRACKS. C 42 IF(ITRAK.EQ.LOWDIR)GO TO 45 C C ELSE - DECREMENT TRK # TO NEXT DIRECTORY TRK. C ITRAK=ITRAK-1 GO TO 40 C 45 DO 49 ITRAK=FIRST,LAST CALL EXEC(1,IDISC,JBUF,JLNTH,ITRAK,0) CALL EXEC(2,MTLU,IBUF,JLNTH+1) IF(IFBRK(IDUM))99,49 49 CONTINUE C C PUT 2 EOF AT THE END. C ENDFILE MTLU ENDFILE MTLU C C NOW SPACE BACK OVER ONE EOF. C CALL EXEC(3,MTLU+1400B) C C INCREMENT THE REPEAT COUNTER C IRCNT = IRCNT - 1 C IF(ILOG .EQ. 0)GO TO 1000 IF(VERIFY)1005,50 1000 CALL EXEC(2,ILU,JVMESS,9) CALL REIO(1,ILU,IANS,1) IF(IANS .NE. 2HYE) GO TO 50 VERIFY = .TRUE. C C 2-MORE BF & 1-FF REQUIRED IF NOT FIRST FILE i C 1005 IF(FILEN .EQ. 1) GO TO 1010 CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+1400B) C C CHECK IF AT SOT. YES ? DON'T DO FF. C X = EXEC(3,MTLU+600B) IA = IAND(IA,100B) IF(IA .EQ. 0)CALL EXEC(3,MTLU+1300B) GO TO 1020 C 1010 REWIND MTLU C C READ THE HEADER AGAIN & DISPLAY IT C 1020 CALL EXEC(2,ILU,MES13,9) X = EXEC(1,MTLU,IBUF,100) CALL EXEC(2,ILU,IBUF,IB) C C VERIFY THE FILE C CALL JVRFY(IBUF,LU,IDISC,MTLU,IDELT) C C NO ERROR ? CONTINUE C IF(IBUF .EQ. 0)GO TO 50 C C IF INTERACTIVE CONTINUE C IF(ILOG .EQ. 0)GO TO 50 C C IF INHIBIT REWIND SPICIFIED ASSUME POSSIBLE BATCH MODE C AND DO A FORWARD FILE FOR NEXT JSAVE. C IF(RWIND)GO TO 50 CALL EXEC(3,MTLU+1300B) C 50 SFLAG=1 IF(FILEN .EQ. 0)FILEN = FILEN + 1 FILEN = FILEN + 1 51 IF(IRCNT .GT. 0)GO TO 30 IF(ILOG .GT. 0)GO TO 90 GO TO 15 C C END: REWIND TAPE OFF LINE C 90 IF(RWIND)CALL EXEC(3,MTLU+500B) CALL EXEC(2,ILU,MESS9,12) C 99 END SUBROUTINE ASCII(BINARY,IA),CHECK FOR LEGAL ASCII 790720 C C THIS ROUTINE PERFORMS TWO(2) FUNCTIONS: C C 1. CHECK THE CONTENTS OF A WORD TO ENSURE BOTH BYTES C ARE UPPER CASE PRINTING ASCII, IF EITHER BYTE FAILS C TWO ASCII BLANKS (20040B) WILL BE SENT BACK TO THE C CALLER. THIS MODE IS INVOKED BY SETTING THE SECOND C PARAMETER TO -1 WHEN CALLED. C C 2. GIVEN A BINARY VALUE. CHECK FOR UPPER AND LOWER CASE C PRINTING ASCII, IF NOT, SET THE OFFENDING BYTE TO AN C ASCII BLANK. C INTEGER BINARY,RBYTE RBYTE = IAND(BINARY,377B) LBYTE = IAND(BINARY,77400B) IF(IA .NE. -1)GO TO 10 IF(RBYTE .LT. 40B .OR. RBYTE .GT. 137B)GO TO 5 IF(LBYTE .LE. 20000B .OR. LBYTE .GE. 60000B)GO TO 5 IA = BINARY RETURN 5 IA = 20040B RETURN 10 IF(RBYTE.LT.40B.OR.RBYTE.GT.176B)RBYTE = 4D'0B IF(LBYTE.LT.20000B)LBYTE = 20000B IF(LBYTE.GE. 77400B)LBYTE = 20000B IA = IOR(LBYTE,RBYTE) RETURN END SUBROUTINE JVRFY(IBUFF,LUCRT,LUDISK,LUMT,IDELT) +,24999-16163 REV.1932 790810 C C THIS SUBROUTINE IS DESIGNED TO COMPARE THE CONTENTS OF C A MAG TAPE FILE AGAINST THE CONTENTS OF A DISK TRACK. C THE MAG TAPE FORMAT SHOULD BE: C 6145 OR 8193 WORDS LONG C WHERE WORD #1 IS THE TRACK #. C TERMINATION WILL OCCUR UPON READING EOF. C THE MAG TAPE MUST BE POSITIONED TO THE FIRST DISC IMAGE RECORD C BEFORE SCHEDULING THIS SUBROUTINE. C C FORM OF CALL: C CALL JVRFY(IBUFF,LUCRT,LUDISK,LUMT,IDELT) C C WHERE: C LUCRT - LU WHERE MESSAGES WILL BE SENT C C LUDISK - LU # OF THE DISK SUBCHANNEL C TO BE VERIFIED. C C LUMT - LU # OF THE MAG TAPE. C C IDELT = OFFSET BETWEEN THE OLD DIRECTORY AND A C THE NEW DIRECTORY IF IT HAS BEEN MOVED C C IPBUF(1) = 0 - COMPARE GOOD. C IPBUF(2) = # OF MAG TAPE RECORDS TESTED. C C IPBUF(1) = -1 MAG TAPE COMPARE ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = TRACK # C IPBUF(4) = SECTR # C IPBUF(5) = WORD OFFSET C C IPBUF(1) = -2 - MAG TAPE STATUS ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = EQT #5 STATUS INFO C C IPBUF(1) = -3 - MAG TAPE RECORD LENGTH ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = LENGTH OF MAG TAPE RECORD. C C IPBUF(1) = -4 - DISK READ ERROR. C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = EQT #5 STATUS INFO. C DIMENSION IBUFF(1),IPBUF(5),LENB(7),ISCTRS(7),IREG(2) DIMENSION LENC(7) C DIMENSION JVM10(28),JVM20(31),JVM30(28),JVM40(46),JVM50(18) C EQUIVALENCE (REG,IREG),(IREG(2),IBREG) C EQUIVALENCE (IPBUF(1),CRIPBUF1),(IPBUF(2),IPBUF2),(IPBUF(3),IPBUF3), + (IPBUF(4),IPBUF4),(IPBUF(5),IPBUF5) C EQUIVALENCE (JVM10(18),JVM118),(JVM10(26),JVM126) EQUIVALENCE (JVM20(21),JVM221),(JVM20(29),JVM229) EQUIVALENCE (JVM30(18),JVM318),(JVM30(26),JVM326) EQUIVALENCE (JVM40(17),JVM417),(JVM40(29),JVM429), + (JVM40(37),JVM437),(JVM40(44),JVM444) EQUIVALENCE (JVM50(12),JVM512) C DATA JVM10/2H /,2HJS,2HAV,2HE:,2H D,2HIS,2HK ,2HRE,2HAD,2H E,2HRR, & 2HOR,2H -,2H S,2HTA,2HTU,2HS ,3*2H ,2H R,2HEC,2HOR, & 2HD ,2H# ,3*2H / C DATA JVM20/2H /,2HJS,2HAV,2HE:,2H M,2HT ,2HRE,2HCO,2HRD,2H L,2HEN, & 2HGT,2HH ,2HER,2HRO,2HR ,2H- ,2HLE,2HNG,2HTH,3*2H , & 2H R,2HEC,2HOR,2HD ,2H# ,3*2H / C DATA JVM30/2H /,2HJS,2HAV,2HE:,2H M,2HT ,2HST,2HAT,2HUS,2H E,2HRR, & 2HOR,2H -,2H S,2HTA,2HTU,2HS ,3*2H ,2H R,2HEC,2HOR, & 2HD ,2H# ,3*2H / C DATA JVM40/2H /,2HJS,2HAV,2HE:,2H C,2HOM,2HPA,2HRE,2H E,2HRR,2HOR, & 2H R,2HEC,2HOR,2HD ,2H# ,3*2H ,6412B, & 2H /,2HJS,2HAV,2HE:,2H T,2HRA,2HCK,2H #,3*2H ,2H S, & 2HEC,2HTO,2HR ,2H# ,3*2H ,2H O,2HFF,2HSE,2HT ,3*2H / C DATA JVM50/2H /,2HJS,2HAV,2HE:,2H C,2HOM,2HPA,2HRE,2H G,2HOO,2HD., & 3*2H ,2H R,2HEC,2HOR,2HDS/ C DATA LENB/128,256,512,1024,2048,2176,2048/ DATA LENC/129,257,513,1025,2049,4097,6273/ DATA ISCTRS/0,2,6,14,30,62,96/ C C ICOUNT = 0 C C GET A MAG TAPE RECORD AND TEST FOR EOF C 10 IF(IFBRK(IDMY) .LT. 0) GO TO 100 REG=EXEC(1,LUMT,IBUFF(128),8193) C C IF FIRST TIME THROGH SET VALUES C (IBUFF(136) == WORD 7 OF DIRECTORY [LOWEST DIRECTORY TRACK]) C (IBUFF(138) == WORD 9 OF DIRECTORY [NEXT AVAILABLE TRACK]) C IF(ICOUNT .GT. 0)GO TO 15 LODIR = IBUFF(136) IBUFF(136) = IBUFF(136) + IDELT IF(IBUFF(138) .GT. IBUFF(136))IBUFF(138) = IBUFF(136) C C FINISHED IF EOF FOUND C 15 IF(IAND(IREG,200B) .NE. 0) GO TO 100 C C ANY OTHER STATUS EXCEPT NO WRITE RING IS AN ABORT CONDITION. C IF(IAND(IREG,373B) .NE. 0) GO TO 200 C C RECORD LENGTH MUST BE 6145 OR 8193 C IF(IBREG .NE. 6145) GO TO 20 ITMS = 6 GO TO 40 20 IF(IBREG .NE. 8193) GO TO 300 ITMS = 7 C C TRACK # IS IN FIRST WORD. C 40 ITRK = IBUFF(128) IF(ITRK .GE. LODIR)ITRK = ITRK + IDELT ICOUNT = ICOUNT + 1 IF(ITRK .LT. LODIR .AND. ITRAK .GE. (LODIR+IDELT))GO TO 10 C C NOW GET AND TEST THE CONTENTS OF ONE TRACK (6 READS) C DO 50 I=1,ITMS LENGTH = LENB(I) INDEX = LENC(I) C REG = EXEC(1,LUDISK,IBUFF,LENGTH,ITRK,ISCTRS(I)) C IF(IAND(IREG,1) .NE. 0) GO TO 400 C CALL CMPWD(IBUFF,IBUFF(INDEX),LENGTH,IERR) IF(IERR .NE. 0) GO TO 500 C 50 CONTINUE GO TO 10 C C GOOD COMPLETION C 100 IPBUF1 = 0 GO TO 1000 C C MAG TAPE STATUS ERROR. C 200 IPBUF1 = -2 IPBUF3 = IREG GO TO 1000 C C MAG TAPE RECORD LENGTH ERROR. C 300 IPBUF1 = -3 IPBUF3 = IBREG GO TO 1000 C C DISK READ ERROR. C 400 IPBUF1 = -4 IPBUF3 = IREG GO TO 1000 C C COMPARE ERROR. C 500 IPBUF1 = -1 IPBUF3 = ITRK IPBUF4 = ISCTRS(I) + IERR/64 IPBUF5 = MOD(IERR,64) C C FINISHED. C C WRITE A MESG IF LUCRT IS GIVEN C 1000 IPBUF2 = ICOUNT C IGO = IPBUF1 + 5 GO TO (1010,1020,1030,1040,1050),IGO C 1010 CALL CNUMO(IPBUF3,JVM118) CALL CNUMD(IPBUF2,JVM126) CALL EXEC(2,LUCRT,JVM10,28) C011 FORMAT(" /JVRFY: DISK READ ERROR - STATUS ",K6," RECORD #",I4) GO TO 2000 C 1020 CALL CNUMD(IPBUF3,JVM221) CALL CNUMD(IPBUF2,JVM229) CALL EXEC(2,LUCRT,JVM20,31) C021 FORMAT(" /JVRFY: MT RECORD LENGTH ERROR - LENGTH ", C + I5," RECORD #",I4) GO TO 20v700 C 1030 CALL CNUMO(IPBUF3,JVM318) CALL CNUMD(IPBUF2,JVM326) CALL EXEC(2,LUCRT,JVM30,28) C031 FORMAT(" /JVRFY: MT STATUS ERROR - STATUS ",K6," RECORD #",I4) GO TO 2000 C C 1040 CALL CNUMD(IPBUF2,JVM417) CALL CNUMD(IPBUF3,JVM429) CALL CNUMD(IPBUF4,JVM437) CALL CNUMD(IPBUF5,JVM444) CALL EXEC(2,LUCRT,JVM40,46) C041 FORMAT(" /JVRFY: COMPARE ERROR RECORD #",I4/, C + " /JVRFY: TRACK #",I4," SECTOR #",I4," OFFSET",I4) GO TO 2000 C 1050 CALL CNUMD(IPBUF2,JVM512) CALL EXEC(2,LUCRT,JVM50,18) C051 FORMAT(" /JVRFY: COMPARE GOOD. ",I4," RECORDS") C 2000 IBUFF = IPBUF1 RETURN END END$ ASMB,R,L,C,Z IFN HED WORD COMPARE FOR 2100 & EARLIER CPU NAM CMPWD,7 WORD COMPARE FOR 2100 & EARLIER CPU 6/10/77 XIF IFZ HED WORD COMPARE FOR 21MX & LATER CPU NAM CMPWD,7 WORD COMPARE FOR 21MX & LATER CPU 6/10/77 XIF ENT CMPWD EXT .ENTR SKP * THIS PROGRAM WILL COMPARE THE CONTENTS OF TWO BUFFERS * AND RETURN: * IERR = 0 - GOOD COMPARE * IERR = +N - ERROR DETECTED. * WHERE N = BUFFER INDEX OF FAILED COMPARISON. * * THIS PROGRAM WILL RETURN AFTER ENCOUNTERING THE FIRST * COMPARE FAILURE. * * THIS PROGRAM IS FORTRAN CALLABLE AS FOLLOWS: * CALL CMPWD(BUF1,BUF2,LENGTH,IERR) * - OR - * REG = CMPWD(BUF1,BUF2,LENGTH,IERR) * WHERE IERR IS RETURNED IN THE 'A' REGISTER. * * CONDITIONAL ASSEMBLY REQUIRED FOR COMPUTER TYPE: * N FOR 2100 OR EARLIER MODELS * Z FOR 21MX OR LATER MODELS * * MCC 6/10/77 * SKP BUFF1 NOP BUFF2 NOP LENTH NOP IERR NOP CMPWD NOP SPC 1 JSB .ENTR DEF BUFF1 SPC 1 IFN LDA LENTH,I GET THE BUFFER LENGTH CMA,INA COMPLEMENT AND SAVE IT STA COUNT SPC 1 LOOP LDA [BUFF1,I GET FIRST WORD XOR BUFF2,I XOR WITH SECOND SZA OK IF ZERO RESULTS. JMP ERROR NO - ERROR. SPC 1 ISZ COUNT YES - FINISHED IF COUNT = 0 JMP INCR SPC 1 JMP OUT FINISHED SPC 1 INCR ISZ BUFF1 INCREMENT BOTH BUFFER ADDRESSES ISZ BUFF2 JMP LOOP GO TEST THE NEXT TWO. SPC 1 ERROR ISZ COUNT SET UP THE LDA LENTH,I ERROR COUNT ADA COUNT FOR RETURN JMP BAD THEN RETURN SKP XIF IFZ LDA BUFF1 GET THE TWO ADDRESSES IN 'A' & 'B' LDB BUFF2 CMW LENTH,I GO TEST THESE ARRAYS JMP OUT GOOD RETURN HERE. SPC 1 NOP ERROR RETURN HERE LDB BUFF1 GET THE START ADDRESS CMB,INB AND SUBTRACT FROM ADA B PRESENT ADDRESS FOUND IN 'B' INA JMP BAD RETURN THE ERROR INDEX XIF SKP OUT CLA GOOD RETURN HERE. SPC 1 BAD STA IERR,I JMP CMPWD,I SKP COUNT NOP A EQU 0 B EQU 1 END * 1430 HRS THU 24 MAY 79 NAM QUOTE,7 QUOTE STRING SUBROUTINE FOR JSAVE 790524 ENT QUOTE,EQCOL EXT .ENTR,.SFB,.MBT * * CALLING SEQUENCE: * * CALL QUOTE(IBUF,QBUF,QLEN) * * WHERE : * IBUF = ASCII BUFFER TO CHECK FOR " . . . " * QBUF = BUFFER TO CONTAIN " . . . " * QLEN = LENGTH OF " . . . " BUFFER * ( 0 IF NOT FOUND) * * NOTE: IBUF SHOULD CONTAIN TWO(2) QUOTE MARKS(") IN THE BUFFER * OR SHOULD BE INITIALIZED WITH NULLS(OCT 0). THIS IS * TO PREVENT POSSIBLE ERRORS DUE TO MEMORY SCAN RUNAWAY. * (THE 'SFB' INSTRUCTION STOPS ONLY ON THE TEST BYTE OR * A TERMINATE BYTE.(WHICH IS NULL(0) IN THIS SUBROUTINE) * * QUOTE USES TWO(2) MX INSTRUCTIONS WHICH ARE: * 1) SFB SCAN FOR BYTE * 2) MBT MOVE BYTE * IBUF NOP STRING BUFFER QBUF NOP QUOTE BUFFER(" . . " RETURNED HERE) QLEN NOP QUOTE BUFFER LENGTH QUOTE NOP ENTRY POINT JSB .ENTR DEF IBUF CLA SET ERROR RETURN FLAG STA QLEN,I LDA ." GET TERMINATOR/TEST BYTE LDB IBUF AND ADDRESS OF SOURCE BUFFER RBL FORM BYTE ADDRESS JSB .SFB START LOOKING FOR ' " ' RSS FOUND IT !!! JMP QUOTE,I WE HAVE AN ERROR, GET OUT INB BUMP BUF. ADD. PAST THE " STB FBAD SAVE BUF. ADD. LOCALLY JSB .SFB START SCAN FOR 2ND. BYTE RSS FOUND JMP QUOTE,I NOT FOUND, GET OUT !!! ELB,CLE,ERB KILL HIGH BIT FOR ADDITION LDA FBAD START TO CALCULATE ELA,CLE,ERA DO SAME FOR LOW ADDRESS CMA,INA THE LENGTH ADB A OF THE QUOTE STB QLEN,I TELL USER TOO LDA FBAD NOW SET UP FOR MOVE BYTE LDB QBUF GET DESTINATION ADDRESS RBL SET TO BYTE ADDRESS JSB .MBT MOVE THE QUOTE TO USER DEF QLEN,I NOP JMP QUOTE,I AND RETURN * A EQU 0 * ." OCT 42 FBAD NOP ADDRESS OF 1ST BYTE IN QUOTE SPC 3 * * THIS SUBROUTINE, GIVEN AN ADDRESS AND LENGTH OF A BUFFER, * WILL CHECK FOR IMBEDDED EQUALS(=) AND REPLACE THEM WITH COLONS(:) * FOR THE NAMR LIBRARY ROUTINE. * * THE BUFFER CAN BE ANY LENGTH AND SHOULD SPECIFY * THE NUMBER OF CHARACTERS IN THE BUFFER. * BUFAD NOP BUFFER ADDRESS BUFLA NOP BUFFER LENGTH EQCOL NOP WHERE IT ALL BEGINS JSB .ENTR GO GET THE ADDRESSES DEF BUFAD OF THE PARAMATERS LDA BUFLA,I HOW ABOUT THE LENGTH? CLE,ERA IS IT AN ODD CHARACTER COUNT? SEZ NO, ITS ALL READY TO GO INA YES, INCREASE THE WORD COUNT BY ONE CMA,INA LET'S MAKE IT NEG. FOR COUNTING STA BUFL AND SAVE IT SZA,RSS IS IT A ZERO LENGTH BUFFER? JMP EQCOL,I WELL GET THE HECK OUT OF HERE THEN. START LDA BUFAD,I ORIGINAL NAME HUH ? STA TEMP LET'S GET A WORD AND GET ON WITH IT AND M177 HOW ABOUT THE LOW BYTE? CPA LO= AN ='S ? JMP LFIX YES, GO MAKE IT A COLON PAR1 LDA TEMP NO, PREPARE TO CONTINUE AND M774 THIS TIME LOOK AT THE HI BYTE CPA HI= AN ='S ? JMP HFIX YES, GO MAKE IT A COLON JMP TERM1 NO, LETS SAVE WHAT WE HAVE AND GO ON LFIX LDA TEMP GET ORIGINAL WORD ADA M3 MAKE THAT = A COLON STA TEMP AND SAVE JMP PAR1+1 GO CHECK HI BYTE HFIX LDA TEMP GET PRESENT VALUE ADA M1400 MAKE THE HI BYTE = A COLON RSS AND SAVE IN ORIGINAL BUFFER TERM1 LDA TEMP LETS GET THE CURRENT VALUE STA BUFAD,I AND SAVE IN ORIGINAL BUFFER ISZ BUFAD INCREMENT THE BUFFER ADDRESS ISZ BUFL ANY MORE WORDS? JMP START YES, HERE WE GO AGIAN JMP EQCOL,I NOPE, LETS GET OUT!! SPC 1 * CONSTANTS AND STORAGE * BUFL NOP TEMP NOP M177 OCT 177 M774 OCT 77400 LO= OCT 75 HI= OCT 36400 M3 OCT -3 M1400 OCT -1400 END ASMB,R,L,Q NAM MXLIB,0 ("MX" INSTRUCTION SET--SIMULATED) 6/78 DGA ENT .MBT,.CBT,.SFB,.SBL,.SBT,.LBT,IDRCT SPC 3 * NAME SIZE(10) ENTRIES EXTERNALS * * !1MBT 25 .MBT IDRCT,.LBT,.SBT * * !1CBT 41 .CBT IDRCT,.LBT * * !1SFB 25 .SFB .LBT * * !1SBL 14 .SBL .LBT * * !1SBT 23 .SBT * * !1LBT 11 .LBT * * !1DRK 17 IDRCT * * * FROM NOP LCNT NOP * AREG EQU 0 BREG EQU 1 * HED SIMULATION OF "MOVE BYTES" 21MX INSTRUCTION SPC 2 * CALL SEQUENCE: * A-REG. TO CONTAIN SOURCE ADDRESS * B-REG. TO CONTAIN SOURCE ADDRESS * JSB .MBT CALL SUB. OR OCT 105765 * DEF CNT(,I) ADDRESS OF # OF BYTES TO MOVE * NOP RESERVED FOR MICROCODE * BOTH A & B INCREMENTED BY CNT * * .MBT NOP STA FROM SOURCE BYTE ADDRESS STB TO DESTINATION BYTE ADDRESS * LDA .MBT,I JSB IDRCT TRACK DOWN INDIRECTS LDA AREG,I PICK UP ACTUAL BYTE COUNT CMA,INA STA BCNT USE AS LOOP COUNTER * SZA,RSS COUNT = 0? JMP EXIT2 YES, DO NOTHING * LOOP2 LDB FROM JSB .LBT TAKE A BYTE STB FROM BYTE ADDRESS INCREMENTED BY LBT * LDB TO JSB .SBT PUT IT HERE STB TO PREPARE FOR NEXT BYTE, IF ANY. * ISZ BCNT MOVE ENOUGH? JMP LOOP2 NOPE * LDA FROM NEXT BYTE IN SOURCE ARRAY EXIT2 ISZ .MBT ISZ .MBT SET UP RETURN ADDRESS JMP .MBT,I B-REG. ALREADY CORRECT. * TO NOP BCNT NOP * SPC 2 * CALLING SEQUENCE: * A-REG. TO CONTAIN STRING 1 ADDRESS * B-REG. TO CONTAIN STRING 2 ADDRESS * JSB .CBT SUB. CALL OR OCT 105766 * DEF CNT(,I) ADDRESS OF BYTE COUNT * NOP RESERVED FOR MICROCODE * JMP EQUAL THE BYTE STRINGS WERE EQUAL * JMP LESS STRING 1 LESS THAN STRING 2 * JMP MORE STRING 1 MORE THAN STRING 2 * * RESULTS: * ON ALL RETURNS B-REG. CONTAINS ORIGINAL VALUE * INCREMENTED BY "CNT". * ON EQUAL RETURN A-REG. HAS ALSO BEEN INCREMENTED * BY "CNT". * ON UNEQUAL RETURNS A-REG. CONTAINS STRING 1 * ADDRESS WHERE INEQUA}YLITY FOUND. * .CBT NOP STA ARAY1 STB ARAY2 * LDA .CBT,I JSB IDRCT LDA AREG,I GET ACTUAL BYTE COUNT * ADB AREG STB BSAVE B-REG.'S RETURN VALUE * CMA,INA STA BCNT SET UP LOOP COUNTER SZA,RSS COUNT = 0? JMP NEQL1+1 YES, TAKE EQUAL EXIT! * ISZ .CBT ISZ .CBT SET UP FOR EQUAL RETURN * LOOP3 LDB ARAY1 JSB .LBT TAKE A BYTE FROM STRING 1 STB ARAY1 SAVE INCREMENTED BYTE ADDRESS STA BYTE1 * LDB ARAY2 JSB .LBT STB ARAY2 CMA,INA ADA BYTE1 STRING 1 MINUS STRING 2 * SZA EQUAL? JMP NEQL1 NO ! ISZ BCNT EXAMINED ALL BYTES? JMP LOOP3 NO * LDA ARAY1 "A" SET TO ORIGINAL + CNT JMP .CBT,I "B" ALREADY CORRECT, EQUAL * RETURN ! * NEQL1 SSA,RSS STRING 1 LARGEST? ISZ .CBT YES, SKIP TWO WORDS ISZ .CBT ELSE SKIP ONE * CCA ADA ARAY1 STRING 1 ADDRESS AT NON-MATCH LDB BSAVE STRING 2 ADDRESS + CNT JMP .CBT,I * ARAY1 NOP ARAY2 NOP BYTE1 NOP ATEMP NOP BTEMP NOP AWORK NOP BSAVE NOP * HED SIMULATION OF "SCAN FOR BYTE" 21MX INSTRUCTION * * CALLING SEQUENCE: * A-REG. TO CONTAIN TERMINATION BYTE AND TEST BYTE * B-REG. TO CONTAIN ADDRESS OF FIRST BYTE * JSB .SFB CALL SUB. OR OCT 105767 * EXIT IF BYTE FOUND TO MATCH TEST BYTE * EXIT IF BYTE FOUND TO MATCH TERMINATION BYTE * .SFB NOP STA ATEMP AND BMASK ISOLATE TEST BYTE STA TEST * LDA ATEMP ALF,ALF AND BMASK ISOLATE TERMINATION BYTE STA TERM * LOOP4 JSB .LBT FETCH A BYTE CPA TEST EQUAL TEST BYTE? JMP T.OU&T YES * CPA TERM EQUALS TERMINATION BYTE? JMP DONE YES JMP LOOP4 NOPE, LOOK SOME MORE * DONE ISZ .SFB RETURN TO P + 2 LDA ATEMP RESTORE A-REG. JMP .SFB,I * T.OUT ADB M.1 DECREMENT B LDA ATEMP JMP .SFB,I RETURN TO P + 1 * TEST NOP TERM NOP BMASK OCT 377 M.1 DEC -1 * HED "SCAN BYTES LEFT" SUBROUTINE * * CALLING SEQUENCE: * * LDA FILL CHARACTER TO REMOVE * LDB BYTAD BYTE ADDRESS TO START * JSB .SBL * B-REG. CONTAINS ADDRESS * OF FIRST OPEN BYTE * * PURPOSE: * USED TO REMOVE TRAILING BLANKS. * * .SBL NOP AND M377 ISOLATE BYTE TO REMOVE STA SAVE ADB M1 DECREMENT BYTE ADDRESS * SLOOP JSB .LBT FETCH IT CPA SAVE REMOVE THIS ONE? RSS YES JMP .SBL,I NO, DONE! * ADB M2 LBT INCREMENTS B, JMP SLOOP THEREFORE, GO BACK 2 * SAVE NOP M1 DEC -1 M2 DEC -2 M377 OCT 377 * HED SIMULATION OF "STORE BYTE" 21MX INSTRUCTION SPC 2 * CALLING SEQUENCE: * A-REG. TO CONTAIN BYTE TO BE STORED * B-REG. TO CONTAIN BYTE ADDRESS * JSB .SBT CALL SUB. OR OCT 105764 * B-REG INCREMENTED BY ONE * .SBT NOP STA ATEMP AND MASK ISOLATE BYTE OF INTEREST ALF,ALF STA AWORK SAVE IT IN LEFT BYTE * STB BTEMP CLE,ERB CONVERT TO WORD ADDRESS, LDA BREG,I "E" = B SEZ 0 = STORE IN LEFT BYTE, THEREFORE SAVE RIGHT BYTE ALF,ALF SWAP BYTES AND MASK ISOLATE BYTE TO SAVE IOR AWORK MERGE BYTES SEZ WORD IN PROPER POSITION? ALF,ALF NO, SWAP IT BACK STA BREG,I REPLACE IN MEMORY * LDA ATEMP RESTORE A-REG. LDB BTEMP RESTORE B-REG. fd`INB POINT TO NEXT BYTE JMP .SBT,I * MASK OCT 377 * HED SIMULATION OF "LOAD BYTE" 21MX INSTRUCTION SPC 2 * CALLING SEQUENCE: * B-REG. TO CONTAIN BYTE ADDRESS C JSB .LBT CALL SUB. OR OCT 105763 * BYTE REQUESTED IN RIGHT HALF OF A-REG. * B-REG. INCREMENTED BY ONE * .LBT NOP CLE,ERB PRODUCE WORD ADDRESS, BYTE FLAG IN "E" LDA BREG,I GET WORD SEZ,RSS 0 INDICATES LEFT BYTE ALF,ALF SWAP BYTES AND MASK ISOLATE BYTE OF INTEREST * ELB RESTORE "B" INB POINT TO NEXT BYTE JMP .LBT,I * * SPC 2 * HED INDIRECT TRACKING SUBROUTINE SPC 2 * CALLING SEQUENCE: * LOC. CONTAINING AN ADDRESS * JSB IDRCT * A-REG. HAS DIRECT ADDRESS * * RESULTS: * "B","E", AND "O" UNAFFECTED. * IDRCT NOP STA ATEMP CLA ELA STA AWORK SAVE "E" * LDA ATEMP PICK UP START OF CHAIN RSS LDA AREG,I GO ONE MORE LEVEL RAL,CLE,SLA,ERA TEST AND TURN OFF BIT 15 JMP *-2 PLAY IT AGAIN SAM! * STA ATEMP NOW HAVE DIRECT ADDRESS LDA AWORK ERA RESTORE "E" LDA ATEMP JMP IDRCT,I * * END END$ Gf J` 24999-18066 2024 S 0100 &JRSTR SOURCE             H0101 !FTN4,L C C VERSION 4 / 24 / 76 JRT C VERSION 6 / 08 / 77 MCC C VERSION 8 / 24 / 78 TEF C VERSION 1 / 18 / 79 LW/TEF SESSION MONITOR C VERSION 9 / 24 / 79 DHP C PROGRAM JRSTR (3,60),24999-16049 REV.2024 800611 C DIMENSION LU(5),IREG(2),MBUF(52),IPBUF(33),IMBUF(33) DIMENSION IBUF(8321),JBUF(20000B),IANS(2),IHEAD(25) DIMENSION KFILE(5) INTEGER FILE,SFLAG C DIMENSION MESS1(8),MESS2(6),MESS3(9),MESS4(11),MESS5(9),MESS6(10) DIMENSION MESS7(3),MESS9(4),MES10(22),MES11(19),MES12(6) DIMENSION MES20(19),MES21(14),MES22(17),MES23(14),MES24(15) DIMENSION MES25(14),MES26(23),MES27(14),MES28(20),MES29(6) DIMENSION IVMESS(9),MES30(51),MES14(15) C EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) EQUIVALENCE (IBUF,ITRAK),(JBUF,IBUF(2)),(LU(2),LIST) C EQUIVALENCE (MBUF,IMBUF(2)),(MBUF(2),MBUF2),(IPBUF(2),IPBUF2), + (JBUF(2),JBUF2),(JBUF(3),JBUF3),(JBUF(7),JBUF7), + (JBUF(8),JBUF8),(JBUF(9),JBUF9),(JBUF(10),JBUF10), + (IPBUF(5),IPBUF5),(IPBUF(6),IPBUF6) C DATA KFILE/6412B,2H F,2HIL,2HE ,2H / DATA IVMESS/2H/J,2HRS,2HTR,2H: ,2HVE,2HRI,2HFY,2H ?,2H _/ DATA JLNTH/20000B/,FILE/1/,SFLAG/0/ DATA IMBUF/6412B/,IMBUF(32)/2H ?/,IMBUF(33)/2H _/ DATA IHEAD/2H24,2H99,2H9-,2H16,2H04,2H9 ,2H20,2H24,2H S,2HOF,2HTW, & 2HAR,2HE ,2HSE,2HRV,2HIC,2HE ,2HKI,2HT ,2HSY,2HST,2HEM, & 2H 1,2H00,2H0 / DATA MESS1/6412B,2HMA,2HG ,2HTA,2HPE,2H L,2HU:,2H _/ DATA MESS2/6412B,2HDI,2HSC,2H L,2HU:,2H _/ DATA MESS3/2HTH,2HAT,2H'S,2H N,2HOT,2H A,2H D,2HIS,2HC!/ DATA MESS4/2HTH,2HAT,2H'S,2H N,2HOT,2H A,2H M,2HAG,2H T,2HAP,2HE!/ DATA MESS5/2HCA,2HN',2HT ,2HDO,2H T,2HHA,2HT ,2HLU,2H! / DATA MESS6/2HMA,2HX ,2H= ,2H50,2H, ,2HMI,2HN ,2H =,2H 1,2H! / DATA MESS7/2HEN,2HD?,2H _/ DATA MESS9/6412B,2HDO,2HNE,2H! / DATA MES10/6412B,2HMA,2HG ,2HT&AA,2HPE,2H F,2HIL,2HE:,2H (,2H-1, & 2H =,2H D,2HIR,2HEC,2HTO,2HRY,2H, ,2H0 ,2H= , & 2HEN,2HD),2H _/ DATA MES11/6412B,2H /,2HJR,2HST,2HR:,2H F,2HIL,2HE ,2H ,2H U, & 2HNK,2HNO,2HWN,2H T,2HAP,2HE ,2HFO,2HRM,2HAT/ DATA MES12/6412B,2HEO,2HF ,2HFO,2HUN,2HD!/ DATA MES14/2H/J,2HSA,2HVE,2H: ,2HWA,2HIT,2HIN,2HG ,2HFO, & 2HR ,2HLU,2H# ,3*2H / DATA MES20/6412B,2HDI,2HRE,2HCT,2HOR,2HY ,2HIN,2HCO,2HNS,2HIS, & 2HTE,2HNC,2HY!,2H #,2H T,2HRA,2HCK,2H =,2H? / DATA MES21/2HLO,2HAD,2HIN,2HG ,2HCA,2HRT,2HRI,2HDG,2HE ,2H' ,2H , & 2H ,2H ,2H' / DATA MES22/2HPR,2HEV,2HIO,2HUS,2H D,2HIR,2HCT,2HOR,2HY ,2HAT,2H T, & 2HRA,2HCK,2H: ,2H ,2H ,2H / DATA MES23/2HDI,2HSC,2H (,2H L,2HU ,2H) ,2HMA,2HX ,2HTR,2HAC,2HK , & 2H ,2H ,2H / DATA MES24/2HLO,2HWE,2HST,2H T,2HRA,2HCK,2H O,2HN ,2HTH, & 2HIS,2H C,2HR:,2H ,2H ,2H / DATA MES25/2HMO,2HVE,2H D,2HIR,2HCT,2HOR,2HY ,2HTO,2H N,2HEW, & 2H T,2HRA,2HCK,2H ?/ DATA MES26/6412B,2H(Y,2HES,2H,N,2HO,,2H O,2HR ,2HNE,2HW ,2HTR, & 2HAC,2HK ,2HNU,2HMB, & 2HER,2H [,2H<=,2H0 ,2H= ,2HAB,2HOR,2HT],2H _/ DATA MES27/2HDI,2HRE,2HCT,2HOT,2HY ,2HNO,2HW ,2HON,2H T,2HRA,2HCK, & 2H ,2H ,2H / DATA MES28/6412B,2HCR,2H ',2H ,2H ,2H ,2H' ,2HDI,2HRE,2HCT, & 2HOR,2HY ,2HON,2H T,2HRA,2HCK,2H ,2H ,2H ,2H / DATA MES29/2HIN,2HPU,2HT ,2HER,2HRO,2HR! / C DATA MES30/6412B,2H /,2HJR,2HST,2HR:,2H W,2HAR,2HNI,2HNG,2H! , + 2HDA,2HTA,2H E,2HXC,2HEE,2HDS,2H D,2HIS,2HC ,2HSP,2HAC,2HE , + 2HFO,2HR ,2HLU,6412B,2H /,2HJR,2HST,2HR:,2H D,2HAT, + 2HA ,2HFR,2HOM,2H T,2HRA,2HCK,3*2H ,2H O,2HN ,2HNO, + 2HT ,2HRE,2HST,2HOR,2HED,2H! ,6412B/ C C CALL RMPAR(LU) IF(LU.EQ.0)LU=1 IF(LIST .EQ. 0)LIST = LU ILU=LU+400B  CALL EXEC(2,ILU,IHEAD,25) ASSIGN 30 TO IRTN C C C GET MAG TAPE LU C 10 CALL EXEC(2,ILU,MESS1,8) X=REIO(1,ILU,MBUF,10) CALL PARSE(MBUF,IB*2,IPBUF) MTLU=IPBUF2 C CALL EXEC(13,MTLU,ISTAT) LU2LK = MTLU C C ONLY DVR 23 OR 24 DEVICES ALLOWED. C IF(IAND(ISTAT,37400B)*2.EQ.23000B)GO TO 20 IF(IAND(ISTAT,37400B)*2.EQ.24000B)GO TO 20 CALL EXEC(2,ILU,MESS4,11) GO TO 10 C 20 IREG=LURQ(100001B,LU2LK,1) IF(IREG.EQ.0)GO TO IRTN C C LOCK UNSUCCESSFUL, SO REPORT C CALL CNUMD(MTLU,MES14(13)) IF (IMESS .EQ. 0)CALL EXEC(2,LU,MES14,15) C IMESS = 1 CALL EXEC(12,0,2,0,-3) IF(IFBRK(IDMMY))410,20 30 REWIND MTLU FILE=1 IBROKE = 0 C C C GET MAG TAPE FILE NUMBER 0 = END <0 = PRINT DIRECTORY C 40 CONTINUE C C ASK FOR FILE #. C 50 CALL EXEC(2,ILU,MES10,22) SFLAG=1 LASTTR = 0 IBUF = 2H X=REIO(1,ILU,MBUF,10) CALL PARSE(MBUF,IB*2,IPBUF) NFILE=IPBUF2 IF(NFILE .EQ. 0)GO TO 400 C C IF < 0 GO DO A DIRECTORY LIST C IF(IBROKE .GE. 0)GO TO 60 CALL EXEC(3,MTLU+1400B) X = EXEC(3,MTLU+600B) IA = IAND(IA,100B) IF(IA .EQ. 0)CALL EXEC(3,MTLU+1300B) 60 IF(NFILE.LT.0)GO TO 310 C C IF = 0 QUIT. C IF(NFILE.LE.50)GO TO 65 CALL EXEC(2,ILU,MESS6,10) GO TO 40 C C DEOF FOUND RESTART C 63 CALL EXEC(2,ILU,MES12,6) GO TO 40 C C POSITION THE TAPE C C********************************** 65 IF(NFILE .GT. 1)GO TO 67 REWIND MTLU FILE = 1 GO TO 120 67 IF(FILE.EQ.NFILE)GO TO 110 CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GO TO 70 CALL EXEC(3,MTLU+1300B) 70 CALL EXEC(1,MTLU,MBUF,50) CALL HEADL(MBUF,LEN,50) KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) CALL EXEC(2,ILU,MBUF,LEN) C C FORWORD-BACK WOR1BD UP PROCESSOR C C IF(NFILE.GT.FILE)GO TO 80 GO TO 90 C C C FORWORD C C 80 CALL EXEC(3,MTLU+1300B) FILE=FILE+1 IF(FILE.EQ.NFILE)GO TO 120 KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) CALL EXEC(1,MTLU,MBUF,50) CALL HEADL(MBUF,LEN,50) CALL EXEC(2,ILU,MBUF,LEN) GO TO 80 C C C BACK WORD C C 90 FILE=FILE-1 CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GO TO 120 CALL EXEC(3,MTLU+1300B) IF(FILE .EQ. NFILE)GO TO 120 CALL EXEC(1,MTLU,MBUF,50) KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) CALL HEADL(MBUF,LEN,50) CALL EXEC(2,ILU,MBUF,LEN) GO TO 90 C C C GET HEADER AND CHECK IF THAT'S WHAT HE WANTS C 110 CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GOTO 120 CALL EXEC(3,MTLU+1300B) 120 X = EXEC(1,MTLU,IBUF,JLNTH+1) HEDLNT = IB IF(HEDLNT .EQ. 0)GO TO 63 C C IF DSAVE TAPE, SKIP HEADR STUFF C IF(HEDLNT .GT. 300)GO TO 180 C C IF SAVE OR LSAVE FORMAT TELL HIM BUT STILL DISPLAY THE HEADR C KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) C C CHECK FOR SAVE FORMAT C IF(HEDLNT .NE. 140)GO TO 122 CALL HEADL(IBUF,LEN,36) CALL EXEC(2,ILU,38H /JRSTR: SAVE FORMAT CAN NOT RESTOR !!,-38) CALL EXEC(2,ILU,IBUF,LEN) GO TO 50 C C CHECK FOR LSAVE FORMAT C 122 IF(HEDLNT .NE. 247)GO TO 124 CALL HEADL(IBUF,LEN,75) CALL EXEC(2,ILU,39H /JRSTR: LSAVE FORMAT CAN NOT RESTOR !!,-39) CALL EXEC(2,ILU,IBUF,LEN) GO TO 50 C C SET UP A ' ? _' IN THE BUFFER. C 124 CALL HEADL(IBUF,LEN,50) LEN=LEN+1 IBUF(LEN)=20077B LEN = LEN + 1 IBUF(LEN)=20137B C*********************************************** CALL EXEC(2,ILU,IBUF,LEN) CALL REIO(1,ILU,IANS,2) IF(IANS.EQ.2HYE)GO TO 180 IF(IANS.EQ.2HNO)GO TO 50 C**************************** CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GO TO 140 CALL EXEC(3,MTLU+1300B) 140 GO TO 120 C C C ASK FOR DISK LU #. C 180 CALL EXEC(2,ILU,MESS2,6) X=REIO(1,ILU,MBUF,10) MES23(12)=MBUF MES23(13)=MBUF2 CALL PARSE(MBUF,IB*2,IPBUF) IDISC=IABS(IPBUF2) IF(IPBUF5 .EQ. 1)LASTTR = IPBUF6 C C DISK LU OK IF > 6 C IF(IDISC.GT.6.AND.IDISC.LT.63)GO TO 190 IF(IDISC.EQ.0)GO TO 40 CALL EXEC(2,ILU,MESS5,9) GO TO 180 C 190 CALL EXEC(13,IDISC,ISTAT) ITYPE=IAND(ISTAT,37400B)/256 C C THIS LU OK IF DVR IS 30 OR 32 C IF((ITYPE.EQ.31B).OR.(ITYPE.EQ.32B))GO TO 200 CALL EXEC(2,ILU,MESS3,9) GO TO 180 C C GET DIRECTORY TRACKS - PERHAPS MODIFY DIRECTORY TO PUT IT IN C A DIFFERENT TRACK THAN WHAT IT CAME FROM, AS FROM 7905 TO 7905 C WITH DIFFERENT # TRACKS PER CARTRIDGE. C C MAG TAPE RECORD GIVES TRACK NUMBER THAT THE DIRECTORY CAME FROM... C EXEC CALL GIVES LAST TRACK OF THE DISC WE'RE WRITING TO C IF THEY'RE THE SAME, JUST PROCEED.... C IF DIFFERENT PRINT OUT CURRENT VALUES AND REQUEST OPERATOR C FOR DESIRED LOCATION OF DIRECTORY. C C NOW... READ THE TAPE TO FIND SPECIFIED TRACK C GET MAX TRACK ON THIS DISC C REQUEST CHANGE (IF ANY) C MODIFY DIRECTORY C COPY ALL DIRECTORY TRACKS C GO TO COPY DOWN REMAINING TRACKS C C C READ THE NEXT RECORD IF THE LAST WAS A HEADER (LENGTH <= 100). C 200 IF(HEDLNT.LE.100)CALL EXEC(1,MTLU,IBUF,JLNTH+1) JLNTH = JBUF7 * 64 LODIR=JBUF8 NDIR=ITRAK-LODIR+1 LOWEST=JBUF10 MES21(11)=JBUF MES21(12)=JBUF2 MES21(13)=JBUF3 MES28(4) =JBUF MES28(5) =JBUF2 MES28(6) =JBUF3 C C #TRACKS SPECIFIED & FOUND ON TAPE DONT' MATCH. C IF(NDIR.EQ.-JBUF9)GO TO 210 CALL EXEC(2,ILU,MES20,19) rGO TO 40 C C FORCE A SEEK BEYOND THE END OF THIS LU TO GET # TRKS. C 210 X=EXEC(1,IDISC,IDMMY,1,32766,0) MAXTRK=IB-1 IDELT=0 IMES = 0 IF(LASTTR .EQ. 0)GO TO 220 IPBUF2 = LASTTR GO TO 230 220 IF(ITRAK.EQ.MAXTRK)GO TO 250 C 230 CALL CNUMD(ITRAK,MES22(15)) CALL CNUMD(MAXTRK,MES23(12)) CALL CNUMD(LOWEST,MES24(13)) CALL EXEC(2,ILU,MES21,14) CALL EXEC(2,ILU,MES22,17) CALL EXEC(2,ILU,MES24,15) CALL EXEC(2,ILU,MES23,14) IF(LASTTR .NE. 0)GO TO 240 CALL EXEC(2,ILU,MES25,14) CALL EXEC(2,ILU,MES26,23) X=REIO(1,ILU,MBUF,10) CALL PARSE(MBUF,IB*2,IPBUF) C IF(IPBUF2.LE.0)GO TO 40 IF(IPBUF.EQ.1)GO TO 240 IF(IPBUF2.NE.2HYE)GO TO 250 IPBUF2 = MAXTRK C 240 IF(IPBUF2.GT.MAXTRK)GO TO 300 IDELT=IPBUF2-ITRAK IF(LOWEST .GT. (LODIR+IDELT))JBUF10 = LODIR + IDELT C C HAVE ALL LU'S, NOW GO COPY THE DISC... C 250 LASTTR = ITRAK + IDELT CALL CNUMD(LASTTR,MES28(18)) CALL EXEC(2,ILU,MES28,20) JBUF8=JBUF8+IDELT GO TO 280 C 260 IF(IFBRK(0).GE.0)GO TO 270 IBROKE = -1 GO TO 40 270 X=EXEC(1,MTLU,IBUF,JLNTH+1) CALL EXEC(13,MTLU,ISTAT) C C END IF EOF ENCOUNTERED. C IF(IAND(ISTAT,200B).NE.0)GO TO 360 280 KTRAK=ITRAK IF(ITRAK .LT. LODIR .AND. ITRAK .GE. (LODIR+IDELT))GO TO 290 IF(ITRAK.GE.LODIR)KTRAK=ITRAK+IDELT CALL EXEC(2,IDISC,JBUF,JLNTH,KTRAK,0) GO TO 260 290 IF(IMES .EQ. 1)GO TO 260 IMES = 1 C C " /JRSTR: WARNING! DATA EXCEEDS DISC SPACE FOR LU" C " /JRSTR: DATA FROM TRACK XXXXXX ON NOT RESTORED!" C CALL CNUMD(ITRAK,MES30(39)) CALL EXEC(2,ILU,MES30,51) GO TO 260 C C ERROR C 300 CALL EXEC(2,ILU,MES29,6) GO TO 40 C C DIRECTORY OF MAG TAPE C C C READ ONE RECORD FROM TAPE - LOOK FOR DEOF TO SIGNIFY C THE END OF TAPE. C 310 REWIND MTLU e FILE = 1 IF (LIST .EQ. ILU)GO TO 315 C C GO LOCK LIST DEVICE C ASSIGN 315 TO IRTN LU2LK = LIST GO TO 20 315 X=EXEC(1,MTLU,JBUF,JLNTH) IF(IB.NE.0)GO TO 320 C C IF DEOF BACK UP TO BETWEEN DEOF C CALL EXEC(3,MTLU+1400B) CALL EXEC(3,LIST+1100B,-1) GO TO 40 C 320 IF(IFBRK(0).GE.0)GO TO 330 CALL EXEC(3,MTLU+0200B) CALL EXEC(3,LIST+1100B,-1) GO TO 40 C C IF TRANSMISSION LOG TELLS US WHAT KIND OF FILE WE HAVE C BASED ON THE FOLLOWING LENGTHS: C C JSAVE,WRITT = <= 50 WORDS C DSAVE = JLNTH WORDS C SAVE = 140 WORDS C LSAVE,USAVE = 247 WORDS C 330 KFILE(5) = KCVT(FILE) CALL EXEC(2,LIST,KFILE,5) IF(IB.LE.50)GO TO 334 C C CHECK FOR SAVE FORMAT C IF(IB.NE.140)GO TO 331 CALL HEADL(IBUF,LEN,36) CALL EXEC(2,LIST,39H /JRSTR: SAVE FORMAT CAN NOT RESTOR !!,-39) CALL EXEC(2,LIST,IBUF,LEN) GO TO 340 331 IF(IB.NE.247)GO TO 332 C C CHECK FOR LSAVE FORMAT C CALL HEADL(IBUF,LEN,75) CALL EXEC(2,LIST,40H /JRSTR: LSAVE FORMAT CAN NOT RESTOR !!,-40) CALL EXEC(2,LIST,IBUF,LEN) GO TO 340 332 IF(IB.NE.JLNTH)GO TO 350 CALL EXEC(2,LIST,22H, /JRSTR: DSAVE FORMAT ,11) GO TO 340 C C ELSE - DISPLAY THE HEADER C 334 CALL HEADL(IBUF,LEN,50) LINE1 = LEN DO 335 J=1,LEN IF (IBUF(J) .NE. 6412B)GO TO 335 LINE1 = J IBUF(J) = 2H 335 CONTINUE CALL EXEC(2,LIST,IBUF,LINE1) IF(LINE1.LT.LEN)CALL EXEC(2,LIST,IBUF(LINE1),LEN-LINE1) C C AND FF TO THE NEXT FILE. C 340 CALL EXEC(3,MTLU+1300B) FILE=FILE+1 GO TO 315 C C UNRECOGNIZED TAPE FORMAT C 350 MES11(9) = KCVT(FILE) CALL EXEC(2,LIST,MES11,19) GO TO 340 C C SET UP A TEST FOR VERIFICATION C 360 FILE = FILE + 1 C CALL EXEC(2,ILU,IVMESS,9) CALL REIO(1,ILU,IANS,1) IF(IyANS .NE. 2HYE) GO TO 390 C C 2-BF & 1-FF REQUIRED IF NOT FILE #2 C IF(FILE .EQ. 2) GO TO 380 CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+1400B) 380 IF(FILE .EQ. 2)REWIND MTLU IF(FILE .NE. 2)CALL EXEC(3,MTLU+300B) C C READ THE HEADER AGAIN C X = EXEC(1,MTLU,IBUF,100) CALL EXEC(2,ILU,IBUF,IB) CALL JVRFY(IBUF,LU,IDISC,MTLU,IDELT) C C UPDATE CRN ON DIRECTORY OF LU 2 C 390 CONTINUE CALL JDCMC(LU,IDISC,LASTTR) GO TO 40 C C C END: REWIND TAPE AND TERMINATE C 400 REWIND MTLU CALL EXEC(2,ILU,MESS9,4) C 410 END SUBROUTINE HEADL(IBUF,LEN,MAX) +, REV.2024 800611 DIMENSION IBUF(MAX) C C DO BACK SCAN ON IBUF TO FIND TRUE LENGTH OF RECORD C 10 DO 20 I=MAX,1,-1 IF(IBUF(I) .EQ. 2H )GO TO 20 IF(IBUF(I) .NE.6412B)GO TO 30 I = I - 2 GO TO 30 20 CONTINUE LEN = 1 30 LEN = I + 1 C RETURN END SUBROUTINE JVRFY(IBUFF,LUCRT,LUDISK,LUMT,IDELT) +,24999-16163 REV.1932 790810 C C THIS SUBROUTINE IS DESIGNED TO COMPARE THE CONTENTS OF C A MAG TAPE FILE AGAINST THE CONTENTS OF A DISK TRACK. C THE MAG TAPE FORMAT SHOULD BE: C 6145 OR 8193 WORDS LONG C WHERE WORD #1 IS THE TRACK #. C TERMINATION WILL OCCUR UPON READING EOF. C THE MAG TAPE MUST BE POSITIONED TO THE FIRST DISC IMAGE RECORD C BEFORE SCHEDULING THIS SUBROUTINE. C C FORM OF CALL: C CALL JVRFY(IBUFF,LUCRT,LUDISK,LUMT,IDELT) C C WHERE: C LUCRT - LU WHERE MESSAGES WILL BE SENT C C LUDISK - LU # OF THE DISK SUBCHANNEL C TO BE VERIFIED. C C LUMT - LU # OF THE MAG TAPE. C C IDELT = OFFSET BETWEEN THE OLD DIRECTORY AND A C THE NEW DIRECTORY IF IT HAS BEEN MOVED C C IPBUF(1) = 0)2 - COMPARE GOOD. C IPBUF(2) = # OF MAG TAPE RECORDS TESTED. C C IPBUF(1) = -1 MAG TAPE COMPARE ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = TRACK # C IPBUF(4) = SECTR # C IPBUF(5) = WORD OFFSET C C IPBUF(1) = -2 - MAG TAPE STATUS ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = EQT #5 STATUS INFO C C IPBUF(1) = -3 - MAG TAPE RECORD LENGTH ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = LENGTH OF MAG TAPE RECORD. C C IPBUF(1) = -4 - DISK READ ERROR. C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = EQT #5 STATUS INFO. C DIMENSION IBUFF(1),IPBUF(5),LENB(7),ISCTRS(7),IREG(2) DIMENSION LENC(7) C DIMENSION JVM10(28),JVM20(31),JVM30(28),JVM40(46),JVM50(18) C EQUIVALENCE (REG,IREG),(IREG(2),IBREG) C EQUIVALENCE (IPBUF(1),IPBUF1),(IPBUF(2),IPBUF2),(IPBUF(3),IPBUF3), + (IPBUF(4),IPBUF4),(IPBUF(5),IPBUF5) C EQUIVALENCE (JVM10(18),JVM118),(JVM10(26),JVM126) EQUIVALENCE (JVM20(21),JVM221),(JVM20(29),JVM229) EQUIVALENCE (JVM30(18),JVM318),(JVM30(26),JVM326) EQUIVALENCE (JVM40(17),JVM417),(JVM40(29),JVM429), + (JVM40(37),JVM437),(JVM40(44),JVM444) EQUIVALENCE (JVM50(12),JVM512) C DATA JVM10/2H /,2HJS,2HAV,2HE:,2H D,2HIS,2HK ,2HRE,2HAD,2H E,2HRR, & 2HOR,2H -,2H S,2HTA,2HTU,2HS ,3*2H ,2H R,2HEC,2HOR, & 2HD ,2H# ,3*2H / C DATA JVM20/2H /,2HJS,2HAV,2HE:,2H M,2HT ,2HRE,2HCO,2HRD,2H L,2HEN, & 2HGT,2HH ,2HER,2HRO,2HR ,2H- ,2HLE,2HNG,2HTH,3*2H , & 2H R,2HEC,2HOR,2HD ,2H# ,3*2H / C DATA JVM30/2H /,2HJS,2HAV,2HE:,2H M,2HT ,2HST,2HAT,2HUS,2H E,2HRR, & 2HOR,2H -,2H S,2HTA,2HTU,2HS ,3*2H ,2H R,2HEC,2HOR, & 2HD ,2H# ,3*2H / C DATA JVM40/2H /,2HJS,2HAV,2HE:,2H C,2HOM,2HPA,2HRE,2H E,2HRR,2HOR, & 2H R,2HEC,2HOR,2HD ,2H# ,3*2H ,6412B, & 3 2H /,2HJS,2HAV,2HE:,2H T,2HRA,2HCK,2H #,3*2H ,2H S, & 2HEC,2HTO,2HR ,2H# ,3*2H ,2H O,2HFF,2HSE,2HT ,3*2H / C DATA JVM50/2H /,2HJS,2HAV,2HE:,2H C,2HOM,2HPA,2HRE,2H G,2HOO,2HD., & 3*2H ,2H R,2HEC,2HOR,2HDS/ C DATA LENB/128,256,512,1024,2048,2176,2048/ DATA LENC/129,257,513,1025,2049,4097,6273/ DATA ISCTRS/0,2,6,14,30,62,96/ C C ICOUNT = 0 C C GET A MAG TAPE RECORD AND TEST FOR EOF C 10 IF(IFBRK(IDMY) .LT. 0) GO TO 100 REG=EXEC(1,LUMT,IBUFF(128),8193) C C IF FIRST TIME THROGH SET VALUES C (IBUFF(136) == WORD 7 OF DIRECTORY [LOWEST DIRECTORY TRACK]) C (IBUFF(138) == WORD 9 OF DIRECTORY [NEXT AVAILABLE TRACK]) C IF(ICOUNT .GT. 0)GO TO 15 LODIR = IBUFF(136) IBUFF(136) = IBUFF(136) + IDELT IF(IBUFF(138) .GT. IBUFF(136))IBUFF(138) = IBUFF(136) C C FINISHED IF EOF FOUND C 15 IF(IAND(IREG,200B) .NE. 0) GO TO 100 C C ANY OTHER STATUS EXCEPT NO WRITE RING IS AN ABORT CONDITION. C IF(IAND(IREG,373B) .NE. 0) GO TO 200 C C RECORD LENGTH MUST BE 6145 OR 8193 C IF(IBREG .NE. 6145) GO TO 20 ITMS = 6 GO TO 40 20 IF(IBREG .NE. 8193) GO TO 300 ITMS = 7 C C TRACK # IS IN FIRST WORD. C 40 ITRK = IBUFF(128) IF(ITRK .GE. LODIR)ITRK = ITRK + IDELT ICOUNT = ICOUNT + 1 IF(ITRK .LT. LODIR .AND. ITRAK .GE. (LODIR+IDELT))GO TO 10 C C NOW GET AND TEST THE CONTENTS OF ONE TRACK (6 READS) C DO 50 I=1,ITMS LENGTH = LENB(I) INDEX = LENC(I) C REG = EXEC(1,LUDISK,IBUFF,LENGTH,ITRK,ISCTRS(I)) C IF(IAND(IREG,1) .NE. 0) GO TO 400 C CALL CMPWD(IBUFF,IBUFF(INDEX),LENGTH,IERR) IF(IERR .NE. 0) GO TO 500 C 50 CONTINUE GO TO 10 C C GOOD COMPLETION C 100 IPBUF1 = 0 GO TO 1000 C C MAG TAPE STATUS ERROR. C 200 IPBUF1 = -2 IPBUF3 = IREG GO TO 1000 C C MAG TAPE RECORD LENGJTH ERROR. C 300 IPBUF1 = -3 IPBUF3 = IBREG GO TO 1000 C C DISK READ ERROR. C 400 IPBUF1 = -4 IPBUF3 = IREG GO TO 1000 C C COMPARE ERROR. C 500 IPBUF1 = -1 IPBUF3 = ITRK IPBUF4 = ISCTRS(I) + IERR/64 IPBUF5 = MOD(IERR,64) C C FINISHED. C C WRITE A MESG IF LUCRT IS GIVEN C 1000 IPBUF2 = ICOUNT C IGO = IPBUF1 + 5 GO TO (1010,1020,1030,1040,1050),IGO C 1010 CALL CNUMO(IPBUF3,JVM118) CALL CNUMD(IPBUF2,JVM126) CALL EXEC(2,LUCRT,JVM10,28) C011 FORMAT(" /JVRFY: DISK READ ERROR - STATUS ",K6," RECORD #",I4) GO TO 2000 C 1020 CALL CNUMD(IPBUF3,JVM221) CALL CNUMD(IPBUF2,JVM229) CALL EXEC(2,LUCRT,JVM20,31) C021 FORMAT(" /JVRFY: MT RECORD LENGTH ERROR - LENGTH ", C + I5," RECORD #",I4) GO TO 2000 C 1030 CALL CNUMO(IPBUF3,JVM318) CALL CNUMD(IPBUF2,JVM326) CALL EXEC(2,LUCRT,JVM30,28) C031 FORMAT(" /JVRFY: MT STATUS ERROR - STATUS ",K6," RECORD #",I4) GO TO 2000 C C 1040 CALL CNUMD(IPBUF2,JVM417) CALL CNUMD(IPBUF3,JVM429) CALL CNUMD(IPBUF4,JVM437) CALL CNUMD(IPBUF5,JVM444) CALL EXEC(2,LUCRT,JVM40,46) C041 FORMAT(" /JVRFY: COMPARE ERROR RECORD #",I4/, C + " /JVRFY: TRACK #",I4," SECTOR #",I4," OFFSET",I4) GO TO 2000 C 1050 CALL CNUMD(IPBUF2,JVM512) CALL EXEC(2,LUCRT,JVM50,18) C051 FORMAT(" /JVRFY: COMPARE GOOD. ",I4," RECORDS") C 2000 IBUFF = IPBUF1 RETURN END END$ ASMB,R,L,C,Z IFN HED WORD COMPARE FOR 2100 & EARLIER CPU NAM CMPWD,7 WORD COMPARE FOR 2100 & EARLIER CPU 6/10/77 XIF IFZ HED WORD COMPARE FOR 21MX & LATER CPU NAM CMPWD,7 WORD COMPARE FOR 21MX & LATER CPU 6/10/77 XIF ENT CMPWD EXT .ENTR SKP * THIS PROGRAM WILL COMPARE THE CONTENTS OF TWO BUFFERS * AND RETURN: * IERR = 0 - GOOr&D COMPARE * IERR = +N - ERROR DETECTED. * WHERE N = BUFFER INDEX OF FAILED COMPARISON. * * THIS PROGRAM WILL RETURN AFTER ENCOUNTERING THE FIRST * COMPARE FAILURE. * * THIS PROGRAM IS FORTRAN CALLABLE AS FOLLOWS: * CALL CMPWD(BUF1,BUF2,LENGTH,IERR) * - OR - * REG = CMPWD(BUF1,BUF2,LENGTH,IERR) * WHERE IERR IS RETURNED IN THE 'A' REGISTER. * * CONDITIONAL ASSEMBLY REQUIRED FOR COMPUTER TYPE: * N FOR 2100 OR EARLIER MODELS * Z FOR 21MX OR LATER MODELS * * MCC 6/10/77 * SKP BUFF1 NOP BUFF2 NOP LENTH NOP IERR NOP CMPWD NOP SPC 1 JSB .ENTR DEF BUFF1 SPC 1 IFN LDA LENTH,I GET THE BUFFER LENGTH CMA,INA COMPLEMENT AND SAVE IT STA COUNT SPC 1 LOOP LDA BUFF1,I GET FIRST WORD XOR BUFF2,I XOR WITH SECOND SZA OK IF ZERO RESULTS. JMP ERROR NO - ERROR. SPC 1 ISZ COUNT YES - FINISHED IF COUNT = 0 JMP INCR SPC 1 JMP OUT FINISHED SPC 1 INCR ISZ BUFF1 INCREMENT BOTH BUFFER ADDRESSES ISZ BUFF2 JMP LOOP GO TEST THE NEXT TWO. SPC 1 ERROR ISZ COUNT SET UP THE LDA LENTH,I ERROR COUNT ADA COUNT FOR RETURN JMP BAD THEN RETURN SKP XIF IFZ LDA BUFF1 GET THE TWO ADDRESSES IN 'A' & 'B' LDB BUFF2 CMW LENTH,I GO TEST THESE ARRAYS JMP OUT GOOD RETURN HERE. SPC 1 NOP ERROR RETURN HERE LDB BUFF1 GET THE START ADDRESS CMB,INB AND SUBTRACT FROM ADA B PRESENT ADDRESS FOUND IN 'B' INA JMP BAD RETURN THE ERROR INDEX XIF SKP OUT CLA GOOD RETURN HERE. SPC 1 BAD STA IERR,I JMP CMPWD,I SKP COUNT NOP A EQU 0 B EQU 1 END ASSMB,R,L * ************************************************************* * * * UTILITY TO PERFORM A * * :DC,-LU * * :MC,LU * * WITHOUT CHANGING THE ORDER OF THE CARTRIDGES * * IN THE DIRECTORY. * * * * THIS UTILITY PATCHES THE CARTRIDGE DIRECTORY * * ON LU 2. * * * * WRITTEN BY: TEF 8/24/78 * * MODIFIED BY: DHP 8/10/79 FOR SESION MONITOR * * * ************************************************************* * NAM JDCMC,7 UTILITY TO DO A DCMC 790919 * EXT .ENTR,EXEC,$LIBR,$LIBX,REIO,PARSE,CNUMD EXT $BMON,KCVT * ENT JDCMC * SUP PRESS EXTRANIOUS LISTINGS * * CARTRIDGE DIRECTORY * STRCK BSS 1 SICNW OCT 000102 SBUF BSS 128 SBAD DEF SBUF SBADR DEF SBUF SOVFL DEF SBUF+124 POINT BSS 1 * * FILE DIRECTORY * FTRCK BSS 1 FICNW OCT 074100 FBUF BSS 128 * * TRACK ASSIGNMENT TABLE SAVE VALUES * LTAT BSS 1 DRTR BSS 1 * * INPUT/OUTPUT * OUTMS ASC 2,LU # OUTLU BSS 3 ASC 9, ALREADY OWNS ID # OUTID BSS 3 ASC 8, ENTER NEW ID? _ INCTL OCT 000400 INID BSS 33 INLN DEC 33 PBUF BSS 33 * * CONSTANTS * DISID NOP -LU OF DISC SIZE NOP NUMBER OF TRACKS SCBCD NOP SST LENGTH WORD D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D6 DEC 6 D25 DEC 25 D128 DEC 128 DN1 DEC -1 * * ERROR OUTPUT * EMES ASC 5,DCMC ERR ENUM BSS 1 E1 ASC 1,LY2 E2 ASC 1,L3 E3 ASC 1,NF E4 ASC 1,L0 E5 ASC 1, 5 E6 ASC 1,OV E7 ASC 1,NN E8 ASC 1,NG E9 ASC 1,ZE * SKP ************************************************************* * * * START JDCMC * * * ************************************************************* * LU NOP CRT IDISC NOP DISC LU LASTR NOP LAST TRACK OF CART. JUST RESTORED * JDCMC NOP JSB .ENTR GET LU FROM INPUT PARAMETER DEF LU LDA LU,I GET CRT STA LU SAVE AS LOCAL VALUE LDA IDISC,I SAME FOR DISC STA IDISC SAVE IT LOCAL TOO CMA,INA SAVE AS -LU ALSO STA DISID LDA LASTR,I AND FINALLY STA LASTR ADA D1 ADD 1 FOR SIZE STA SIZE * LDA $BMON CHECK WHAT OP. SYS. WHERE IN SZA,RSS JMP DC.1 RTE -IV A * JSB KCVT CONVERT LU TO ASCII DEF *+2 DEF IDISC STA MES1+21 SAVE IN MESSAGE STA MES1+27 * JSB EXEC PRINT MESSAGE TO DO DEF RTN A :DC :MC ON LU XX. DEF D2 DEF LU DEF MES1 DEF LEN1 LENGTH RTN JSB JDCMC,I RETURN TO CALLER * LEN1 DEC 29 MES1 OCT 6412 ASC 13, TO UPDATE YOUR CART. LIST OCT 6412 ASC 14, DO A ':DC,-00,RR & :MC,00'. * * THE FOLLOWING CODE CAN BE USED FOR AUTOMATIC MOUNTING OF THE DISC * LU. IT HAS A NUMBER OF LIMITATIONS HOWEVER AND WAS NOT ADDED * IN THE INTEREST OF VERSATILITY AND PROGRAM SIZE. FUTURE REVISIONS * MAY INCLUDE THESE ENHANCEMENTS DEPENDING ON THE NEED. * * JSB $ESTB GET THE SST LENGTH WORD * STB SCBCD * * JSB DCMC CALL SESSION TO DO A DCMC * DEF RTN * DEF ENUM * DEF D3 CODE = 3 MOUNT LU AND CHANGE CRN IUN CL * DEF DISID -LU OF DISC * DEF D0 P/G = 0 = PRIVATE * DEF SIZE SIZE OF THE DISC * DEF D0 IDENT (NOT USED) * DEF D0 DIRTK (NOT USED) * DEF D0 LABEL (NOT USED) * DEF SCBCD SSB LENGTH WORD * DEF D0 SECT (NOT USED) *RTN JMP JDCMC,I RETURN TO CALLER * * READ CARTRIDGE DIRECTORY DC.1 LDA 1756B A=#TRACKS ON LU2 ADA DN1 A=LAST FMP TRACK ON LU2 STA STRCK JSB EXEC READ DEF *+7 DEF D1 DEF SICNW CARTRIDGE DEF SBUF DEF D128 DEF STRCK DEF D0 DIRECTORY * FIND CARTRIDGE POINTED TO BY LU D.1 LDB SBADR B=START OF SBUF LDA 1,I A=LU OF 1ST CARTRIDGE SZA,RSS JMP ER3 CARTRIDGE NOT FOUND CPA LU+1 JMP D.2 CARTRIDGE FOUND ADB D4 B=ADDRESS OF NEXT LU STB SBADR SBADR= " " " " CMB,INB CHECK ADB SOVFL FOR SSB,RSS OVERFLOW JMP D.1 CHECK NEXT LU JMP ER6 OVERFLOW ERROR * LU FOUND IN CARTRIDGE TABLE * FIND CARTRIDGE SPEC ENTRY D.2 LDA LASTR A=LAST FMP TRACK ON LU STA FTRCK LDA IDISC PREPARE IOR FICNW STA FICNW ICNWD JSB EXEC READ DEF *+7 DEF D1 DEF FICNW DEF FBUF FILE DEF D128 DEF FTRCK DEF D0 DIRECTORY * * CHECK FOR DUPLICATE ID'S * LDB SBAD B=START OF BUFFER RSS D.3 LDB POINT POINT POINTS TO CURRENT LU CPB SBADR IS THIS THE LU TO BE CHANGED? RSS YES JMP *+4 NO ADB D4 B POINTS TO NEXT LU STB POINT POINT " " " JMP D.3 DO IT AGAIN LDA 1,I A " " " SZ]A,RSS END OF LIST ? JMP D.5 YES ADB D2 B POINTS TO CARTRIDGE/ LDA 1,I A=CURRENT ID CPA FBUF+3 CHECK ID JMP D.4 DUPLICATE ID FOUND ADB D2 B=ADDRESS OF NEXT LU STB POINT SAVE THIS CMB,INB CHECK ADB SOVFL FOR SSB,RSS OVERFLOW JMP D.3 CHECK NEXT LU JMP ER6 OVERFLOW * DUPLICATE ID - GET NEW ID FROM LOGLU D.4 LDA POINT GET DUP LU ADDRESS STA *+3 SAVE FOR OUTPUT JSB CNUMD CONVERT DEF *+3 LU BSS 1 TO DEF OUTLU ASCII JSB CNUMD CONVERT DEF *+3 ID DEF FBUF+3 TO DEF OUTID ASCII JSB EXEC OUTPUT DEF *+5 DEF D2 WARNING DEF LU DEF OUTMS MESSAGE DEF D25 LDA INCTL IOR LU STA INCTL JSB REIO INPUT DEF *+5 DEF D1 DEF INCTL DEF INID NEW DEF INLN ID RBL STB INLN JSB PARSE PARSE DEF *+4 DEF INID ID DEF INLN DEF PBUF LDA PBUF+1 A=NEW ID SSA IS INPUT NEGATIVE JMP ER8 YES SZA,RSS IS INPUT ZERO JMP ER9 YES STA FBUF+3 SAVE NEW ID JSB EXEC KEEP DEF *+7 DEF D2 NEW DEF FICNW DEF FBUF FILE DEF D128 DEF FTRCK DEF D0 / DIRECTORY JMP D.3-2 DO IT AGAIN * * MOVE LABEL WORD TO SBUF * D.5 LDA FBUF+3 GET LABEL WORD LDB SBADR ADB D2 B POINTS TO LABEL WORD IN CART TABLE STA 1,I LABEL STORED IN CARTRIDGE TABLE * PATCH TRACK ASSIGNMENT TABLE JSB PATCH * PATCH CARTRIDGE TABLE JSB EXEC KEEP DEF *+7 DEF D2 NEW DEF SICNW DEF SBUF CARTRIDGE DEF D128 DEF STRCK DEF D0 TABLE * UNPATCH TRACK ASSIGNMENT TABLE JSB UPTCH * RETURN TO CALLING PROGRAM JMP JDCMC,I * * SUBROUTINES TO PATCH AND UNPATCH TAT * * PATCH TRACK ASSIGNMENT TABLE PATCH NOP JSB $LIBR TURN OFF MEMORY PROTECT NOP LDA 1656B 1656=FIRST WORD OF TRACK ASSIGNMENT TABLE ADA STRCK A=LOCATION OF CARTRIDGE DIRECTORY ENTRY STA LTAT LTAT= " " " " LDB 0,I GET D.RTR'S ID SEGMENT FROM TAT STB DRTR SAVE THIS!!!!!!!!!!!!!!! LDB 1717B GET THIS PROGRAM'S ID SEGMENT STB 0,I PATCH TAT JSB $LIBX TURN ON MEMORY PROTECT DEF PATCH * UNPATCH TRACK ASSIGNMENT TABLE UPTCH NOP JSB $LIBR TURN OFF MEMORY PROTECT NOP LDA LTAT LOCATION IN TRACK ASSIGNMENT TABLE LDB DRTR B=D.RTR'S ID SEGMENT FROM TAT STB 0,I PUT IT BACK! JSB $LIBX TURN ON MEMORY PROTECT DEF UPTCH * * ERROR ROUTINE * ER1 LDA E1 JMP ESTP ER2 LDA E2 JMP ESTP ER3 LDA E3 JMP ESTP ER4 LDA E4 JMP ESTP ER5 LDA E5 JMP ESTP ER6 LDA E6 JMP ESTP ER7 LDA E7 JMP ESTP ER8 LDA E8 JMP ESTP ER9 LDA E9 ESTP STA ENUM JSB EXEC DEF *+5 DEF D2 DEF LU DEF EMES DEF D6 * RETURN TO CALLING PROGRAM JMmljfP JDCMC,I END nEl Kb 24999-18067 1938 S 0100 &SDLS4              H0101 `FTN4,L,C C C VERSION 1 / 10 / 76 JRT C C VERSION 9 / 17 / 79 CEJ C THIS VERSION WILL HANDLE DATA FILES SUCH AS THE C QUERY HELP FILE. ALL CHANGES TO JRT'S SDLS4 ARE C DENOTED BY A LINE OF DASHES AS UNDERLINES. C C CCCC C C SOURCE: 24999-18050 C RELOC: 24999-16050 C CCCC PROGRAM SDLS4(3,99),24999-16050 REV.1938 790919 DIMENSION IPRAM(5),IREG(2),IREQ(20),IBUF(1153) DIMENSION ITITL(40),IDBLOK(43),IPBUF(33),IDCB(144),ISIZE(2) DIMENSION IDCB2(144) C INTEGER BATCH INTEGER YES,TPFORM,EOBFL INTEGER PGLABL(19),FILEFL,FNMBR INTEGER FINDF(27),FNAME(3),SC,CR,FTYPE,FSIZE,RECLN INTEGER NBUFR(50) C LOGICAL NWREQ,ECHO,PUN C EQUIVALENCE (X,IREG),(IA,IREG),(IB,IREG(2)) EQUIVALENCE (LU,IPRAM) EQUIVALENCE (TPFORM,ITITL),(IREEL,ITITL(40)) EQUIVALENCE (FNAME,IPBUF(2)),(SC,IPBUF(6)) EQUIVALENCE (CR,IPBUF(10)),(FTYPE,IPBUF(14)) EQUIVALENCE (FSIZE,IPBUF(18)),(RECLN,IPBUF(22)) C DATA BATCH/0/,NFILE/1/ DATA YES/2HYE/ DATA ITITL/35*2H ,2HRE,2HEL,2H #,2H: ,2H / DATA IREQ/20*2H /,ISIZE/-1,0/,FILEFL/-1/ DATA PGLABL/2H0 ,3*2H ,2H P,2HAR,2HT ,2HNU,2HMB,2HER,2H , 1 2H ,2H ,2HTY,2HPE,2H ,2H L,2HAB,2HEL/ DATA NWREQ/.FALSE./,ECHO/.FALSE./,PUN/.FALSE./ C C C STATEMENT FUNCTIONS: C IWORD(I)=IBUF(INDEX+I) C C C C TAKE CARE OF THE AMENITIES FIRST... C CALL RMPAR(IPRAM) IF(LU.EQ.0)LU=1 ILU=LU+400B LLU=LU WRITE(LU,1000) 1000 FORMAT("24999-16050 1938 SOFTWARE SERVICE KIT SYSTEM 1000"/) C WRITE(LU,100) 100 FORMAT(/"/SDLS4: MAG TAPE LU = _") READ(LU,*)MTLU C C TRY TO LOCK THE MAG TAPE C X=LURQ(100001B,MTLU,1) C C C REWIND THE TAPE C 4 CALL EXEC(3,MTLU+400B) C C******************************************************* C C C MAIN LOOP C C 10 IF(BATCH.NE.0)CALL CLOSE(IDCB2,IERR) BATCH=0 IUPFL=0 IREQ=2H WRITE(LU,110) 110 FORMAT(/"/SDLS4: TASK: _") CALL REIO(1,ILU,IREQ,3) IF(IREQ.EQ.2HDI)GO TO 20 IF(IREQ.EQ.2HLO)GO TO 50 IF(IREQ.EQ.2HBA)GO TO 40 IF(IREQ.EQ.2HUP)GO TO 46 IF(IREQ.EQ.2HRE)GO TO 26 IF(IREQ.EQ.2HN )GO TO 87 IF(IREQ.EQ.2HLL)GO TO 85 IF(IREQ.EQ.2HLA)GO TO 21 IF(IREQ.EQ.2HPU)GO TO 8000 IF((IREQ.EQ.2HEN).OR.(IREQ.EQ.2HEX))GO TO 90 IF(IREQ.EQ.2H??)GO TO 200 C C C******************************************************* C C C ERROR SECTION C 11 WRITE(LU,111) 111 FORMAT("/SDLS4: INPUT ERROR!") GO TO 10 C 12 IF(INDEX.NE.0)GO TO 14 WRITE(LU,112) GO TO 10 C 14 IF(INDEX.NE.-4)GO TO 16 WRITE(LU,116)NFILE GO TO 10 C 16 WRITE(LU,117)INDEX GO TO 10 112 FORMAT("/SDLS4: END OF TAPE") 116 FORMAT("/SDLS4: BREAK AT FILE"I5) 117 FORMAT("/SDLS4: ERROR"I4". PLEASE REFER TO LISTINGS...") C 19 WRITE(LU,119)IERR 119 FORMAT("/SDLS4: FILE ERROR"I5) CALL CLOSE(IDCB,IERR) GO TO 10 C C TASK TO REWIND THE TAPE C 26 CALL GETRC(IBUF,MTLU,-3,INDEX,NFILE) GO TO 10 C******************************************************* C C C C DIRECTORY SECTION: C LIST THE ALL PROGRAM I.D. BLOCKS INTO C A SPECIFIED FILE - - FORMATTED FOR LINE PRINTER * DUMP * C 20 ASSIGN 21 TO IRETN WRITE(LU,121) 121 FORMAT("/SDLS4: LIST FILE: _") GO TO 501 C 21 IERR=-2 IF(FILEFL.GT.0)GO TO 19 IF(NFILE.NE.1)CALL GETRC(IBUF,MTLU,-3,INDEX,NFILE) CALL GETRC(IBUF,MTLU,0,INDEX,NFILE) IF(INDEX.LE.0)GO TO 12 IF(IWORD(1).EQ.0)GO TO 23 WRITE(LU,123) 123 FORMAT("/SDLS4: TAPE HAS NO LABEL!! ???") GO TO 26 C C PUT LABEL INFO INTO HEADER FOR LISTING C 23 IBUF(INDEX+16)=2H IBUF(INDEX+25)=2H IBUF(INDEX+31)=2H C DO 24 I=2,34 ITI\TL(I)=IWORD(I+1) 24 CONTINUE CALL CODE WRITE(IREEL,124)IBUF(INDEX+37) 124 FORMAT(I2) C C IF IT'S A 'LABEL' REQUEST, WE'RE DONE C IF(IREQ.NE.2HLA)GO TO 241 CALL REIO(2,ILU,ITITL,40) GO TO 10 241 CALL GETRC(IBUF,MTLU,0,INDEX,NFILE) IF(INDEX.LE.0)GO TO 12 IF(IWORD(1).NE.-2)GO TO 241 C C SET UP POINTERS... C 25 NLINE=0 TPFORM=2H PGLABL(2)=2HFI PGLABL(3)=2HLE PGLABL(4)=2H C C ID BLOCK LISTING SECTION C 30 IF(FILEFL.EQ.0)GO TO 31 ISIZE=FSIZE IF(ISIZE.EQ.0)ISIZE=-1 ISIZE(2)=RECLN CALL CREAT(IDCB,IERR,FNAME,ISIZE,4,SC,CR) IF(IERR.LT.0)19,33 C 31 CALL OPEN(IDCB,IERR,FNAME,0,SC,CR) IF(IERR.LT.0)GO TO 19 C LOOP C C 33 CALL GETRC(IBUF,MTLU,1,INDEX,NFILE) IF(INDEX)39,38,32 32 IF(IWORD(1).NE.4)GO TO 34 WRITE(LU,130) 130 FORMAT("/SDLS4: END OF DIRECTORY") GO TO 38 C 34 N=NFILE IBUF(INDEX+31)=IOR(IAND(IWORD(13),77400B),40B) IBUF(INDEX+11)=2H IBUF(INDEX+13)=IOR(IAND(IBUF(INDEX+13),77400B),40B) IBUF(INDEX+31)=2H C IF(NLINE/50*50.NE.NLINE)GO TO 36 CALL WRITF(IDCB,IERR,ITITL,40) TPFORM=2H1 CALL WRITF(IDCB,IERR,PGLABL,19) CALL WRITF(IDCB,IERR,PGLABL(11),2) C 36 CALL CODE WRITE(IDBLOK,136)N,(IBUF(INDEX+I),I=3,13),(IBUF(INDEX+J),J=18,44) 136 FORMAT(1X,I4,": "11A2,1X,27A2) CALL WRITF(IDCB,IERR,IDBLOK,43) IF(IERR.LT.0)GO TO 19 NLINE=NLINE+1 GO TO 33 C C END LOOP C 38 CALL WRITF(IDCB,IERR,ITITL,1) IF(IERR.LT.0)GO TO 19 39 CALL LOCF(IDCB,IERR,IREC,IRB,IOFF,ISEC) ITRUN=ISEC/2-IRB-1 CALL CLOSE(IDCB,IERR,ITRUN) IF(INDEX.LE.0)GO TO 12 IF(BATCH)42,10,42 C C******************************************************* C C C INITIATE BATCH MODE OPERATIONS - GET INPUT FILE C C BATCH FILE FORMAT: C C FILE NAME (NAMR) C ;1 STOCK NUMBER OR FILE NUMBER (FORWARD SEARCH ONLY IF GIVEN ST #) C . C . C FILE NAME C STOCK NUMBER OR FILE NUMBER C C ALL FIELDS MUST BE LEFT JUSTIFIED C IF A "/E" IS ENCOUNTERED, THE TAPE WILL BE RE-WOUND C C 40 ASSIGN 41 TO IRETN WRITE(LU,140) 140 FORMAT("/SDLS4: ENTER BATCH-FILE NAME: _") GO TO 501 C 41 IF(FILEFL.EQ.-1)GO TO 11 BATCH=1 WRITE(LU,45) 45 FORMAT("ECHO? _") READ(LU,47)IREPLY 47 FORMAT(A2) IF (IREPLY .EQ. 2HYE) ECHO = .TRUE. CALL OPEN(IDCB2,IERR,FNAME,2,SC,CR) IF(IERR.LT.0)GO TO 19 C 42 CALL READF(IDCB2,IERR,IREQ,20,LEN) IF(IERR.LT.0)GO TO 19 IF(LEN.EQ.-1)GO TO 10 IF(IREQ.EQ.2H/E)GO TO 26 IB=LEN ASSIGN 51 TO IRETN GO TO 502 C C C INITIATE 'UPDATE MODE OPERATION': C SIMILAR TO BATCH EXCEPT THAT ONLY TAPE FILES WHOSE REV CODES C ARE GREATER THAT THOSE SPECIFIED IN THE REQUEST BATCH FILE C WILL BE LOADED C 46 IUPFL=1 GO TO 40 C C C*************************************************** C C LOAD / STORE REQUESTS C 50 ASSIGN 51 TO IRETN WRITE(LU,150) 150 FORMAT("/SDLS4: LOAD INTO FILE: _") GO TO 501 C 51 FNMBR=0 DO 552 I=1,20 IREQ(I)=2H 552 CONTINUE IF(BATCH.EQ.0)GO TO 551 CALL READF(IDCB2,IERR,IREQ,8,LEN) IF(IERR.LT.0)GO TO 19 IF(LEN.EQ.-1)11,58 C 551 WRITE(LU,151) 151 FORMAT("/SDLS4: ENTER STOCK # OR FILE #: _") CALL REIO(1,ILU,IREQ,8) 58 IF (NWREQ) GO TO 6999 IF(IAND(IREQ,77400B).EQ.20000B)GO TO 11 IF(IREQ(4).NE.2H )GO TO 60 CALL CODE READ(IREQ,*)FNMBR IF(FNMBR.LE.1)GO TO 11 C C C TAPE SEARCH GIVEN FILE NUMBER C (ASSUME REWIND SPEED = 4 X READ SPEED AND ALL FILES SAME SIZE) C 57 IF(FNMBR.GT.NFILE)GO TO 52 ITIME1=NFILE/4+FNMBR ITIME2=NFILE-FNMBR IF(ITIME2.LT.ITIvQME1)GO TO 54 C CALL GETRC(IBUF,MTLU,-3,INDEX,NFILE) 52 DO 53 I=1,FNMBR-NFILE CALL GETRC(IBUF,MTLU,-1,INDEX,NFILE) IF(INDEX.LE.0)GO TO 12 53 CONTINUE GO TO 56 C 54 DO 55 I=1,ITIME2+1 CALL GETRC(IBUF,MTLU,-2,INDEX,NFILE) IF(INDEX.LE.0)GO TO 12 55 CONTINUE CALL GETRC(IBUF,MTLU,-1,INDEX,NFILE) IF(INDEX.LE.0)GO TO 12 C C TAPE IS NOW POSITIONED... C 56 CALL GETRC(IBUF,MTLU,0,INDEX,NFILE) IF(INDEX.LE.0)12,711 C C TAPE SEARCH GIVEN STOCK NUMBER (FORWARD SEARCH ONLY) C 60 CALL GETRC(IBUF,MTLU,1,INDEX,NFILE) IF (INDEX .LE. 0) GO TO 12 6999 IF (.NOT.(ECHO)) GO TO 61 DO 7000 I=1,6 7000 NBUFR(I) = IWORD(I+2) WRITE(LU,6000) (IREQ(I),I=1,6),(NBUFR(I),I=1,6) 6000 FORMAT(6A2,4X,6A2) 61 NWREQ = .FALSE. DO 62 I=1,6 IF (IWORD(I+2) .NE. IREQ(I)) GO TO 63 62 CONTINUE GO TO 69 63 DO 64 I=1,6 IF (IWORD(I+2) .GT. IREQ(I)) GO TO 65 IF (IWORD(I+2) .LT. IREQ(I)) GO TO 60 64 CONTINUE 65 NWREQ = .TRUE. GO TO 42 C 69 IF(IREQ(7).EQ.2H )GO TO 70 IF(IUPFL.EQ.0)GO TO 70 C IF(IWORD(9).GT.IREQ(7))GO TO 71 IF((IWORD(9).EQ.IREQ(7)).AND.(IWORD(10).GT.IREQ(8)))71,42 163 FORMAT(9X,"REV CODE DISCREPANCY:") C C CHECK PROG TYPE, FIGURE OUT FILE TYPE, CREATE THE FILE C 70 IF(IREQ(7).EQ.2H )GO TO 711 IDSCRP=IREQ(7)-IWORD(9)+IREQ(8)-IWORD(10) IF(IDSCRP.NE.0)WRITE(LLU,163) C C IF UPDATE MODE, UPDATE THE BATCH-FILE TO HAVE NEW REV CODES C 71 IF(IUPFL.EQ.0)GO TO 711 IREQ(7)=IWORD(9) IREQ(8)=IWORD(10) CALL POSNT(IDCB2,IERR,-1) CALL WRITF(IDCB2,IERR,IREQ,LEN) C 711 ITYPE=IAND(IWORD(12),77400B) ITYPE=ITYPE+ITYPE/256 FTYPE=0 IF(ITYPE.EQ.2HSS)FTYPE=4 IF(ITYPE.EQ.2HRR)FTYPE=5 IF(ITYPE.EQ.2HAA)FTYPE=7 IF(ITYPE.EQ.2HDD)FTYPE=1 C------------------------------------------------------------ IF(FTYPE.NE.0)GO TO 72 WRITE(LU,170)ITYPE 170 FORMAT("/SDLS4: ILLEGAL PROGRAM TYPE: "A2) GO TO 10 C 72 WRITE(LLU,172)(FNAME(I),I=1,3),(IBUF(INDEX+I),I=3,10), & (IBUF(INDEX+I),I=18,44) 172 FORMAT(1X,3A2,": ",8A2,1X,27A2) N = 1 DO 175 I=3,10 NBUFR(N) = IBUF(INDEX+I) 175 N = N+1 NBUFR(N) = 2H N = N + 1 DO 176 I=18,44 NBUFR(N) = IBUF(INDEX+I) 176 N = N+1 NBUFR(N) = 0 IF(FILEFL.NE.-1)GO TO 74 ISIZE=FSIZE ISIZE(2)=RECLN IF(ISIZE.EQ.0)ISIZE=-1 CALL CREAT(IDCB,IERR,FNAME,ISIZE,FTYPE,SC,CR) IF(IERR.LT.0)19,75 C 74 CALL OPEN(IDCB,IERR,FNAME,0,SC,CR) IF(IERR.LT.0)GO TO 19 IF((FILEFL.NE.-1).AND.(IERR.GT.0))WRITE(LLU,174)FNAME 174 FORMAT(9X"DUPLICATE FILE NAME - - "3A2) FILEFL=IERR C C LOOP READ TAPE, LOAD FILE C C CHECK THE DATA TYPE (IWORD(1)): C TYPE C A) EOB BLOCKS => WRITE 0-LENGTH RECORD * 3 C B) EOF BLOCKS => WRITE EOF 4 C C) DATA BLOCKS => THAT'S FINE!!! -1 C D) PHYSICAL EOF => DONE! -2 C E) ELSE => ERROR C C * EXCEPT THE FIRST AND LAST ONES C C C ALSO, CHECK GETRC STATUS (INDEX): C C ANY ERROR (OR BREAK) ENCOUNTERED DURING PROGRAM LOAD WILL C RESULT IN THE LOAD FILE BEING PURGED (EXCEPT IF TYPE 0) AND C THE TAPE BEING POSITIONED BACK TO THE START OF THAT FILE C C IF ((FILEFL .NE. 0) .OR. (.NOT.(PUN))) GO TO 700 CALL ALPHA (NBUFR,LUP) 700 IRECN=0 75 CALL GETRC(IBUF,MTLU,0,INDEX,NFILE) IF(INDEX.LE.0)GO TO 80 NWDS=IBUF(INDEX) IF(IWORD(1).NE.4)GO TO 755 CALL WRITF(IDCB,IERR,IBUF,-1) GO TO 75 755 IF(IWORD(1).NE.3)GO TO 76 756 IF(IRECN.NE.0)EOBFL=1 GO TO 75 76 IF(IWORD(1).EQ.-2)GO TO 77 IF(EOBFL.NE.0)CALL WRITF(IDCB,hIERR,IBUF,0) EOBFL=0 IF(IWORD(1).NE.-1)GO TO 78 C IF(NWDS.EQ.0)GO TO 756 IRECN=1 CALL WRITF(IDCB,IERR,IBUF(INDEX+2),NWDS) IF(IERR.LT.0)19,75 C C EOF FOUND C 77 WRITE(LU,177) 177 FORMAT("/SDLS4: LOAD COMPLETE") GO TO 39 C C RECORD OUT OF SEQUENCE C 78 INDEX=-14 C C BREAK DURING LOAD: PURGE ACTIVE FILE (UNLESS TYPE 0) C SET TAPE TO START OF CURRENT FILE C 80 CALL CLOSE(IDCB,IERR) IF(FILEFL.EQ.0)GO TO 81 CALL PURGE(IDCB,IERR,FNAME,SC,CR) IF(IERR.LT.0)GO TO 19 81 CALL GETRC(IBUF,MTLU,-2,IDUMY,NFILE) C-----------------------------------------IDUMY INSTEAD OF INDEX CALL GETRC(IBUF,MTLU,-1,IDUMY,NFILE) C-----------------------------------------NO MORE 129 ERRORS! GO TO 12 C C******************************************************** C C PRINT CURRENT FILE NUMBER C 87 WRITE(LU,187)NFILE 187 FORMAT("/SDLS4: CURRENT MAG TAPE FILE ="I5) GO TO 10 C C CHANGE LOG LU C 85 WRITE(LU,185) 185 FORMAT("/SDLS4: ENTER LOG LU: _") READ(LU,*)LLU GO TO 10 C C PRINT ALL SDLS4 COMMANDS C 200 WRITE(LU,219) WRITE(LU,201) WRITE(LU,203) WRITE(LU,205) WRITE(LU,206) WRITE(LU,207) WRITE(LU,209) WRITE(LU,211) WRITE(LU,212) WRITE(LU,213) WRITE(LU,214) WRITE(LU,202) WRITE(LU,204) WRITE(LU,206) WRITE(LU,208) WRITE(LU,215) WRITE(LU,216) WRITE(LU,218) WRITE(LU,217) 219 FORMAT(/" TASK FUNCTION"/) 201 FORMAT("LABEL PRINT TAPE LABEL") 203 FORMAT("DIRECTORY LIST ALL FILE IDENTIFICATION ON TAPE") 205 FORMAT("REWIND REWIND THE TAPE") 207 FORMAT("N PRINT CURRENT FILE POSITION NUMBER") 209 FORMAT("LL CHANGE THE LOG DEVICE, LU # WILL BE ASKED") 211 FORMAT("LOAD LOAD A FILE FROM THE TAPE TO DISC") 212 FORMAT(" NAME & PART # OR FILE # WILL BE ASKED") 213 FORMAT("BATCH GET LOAD COMMANDS FROM A FILE") 214 FORMAT(" TAPE FORMAT: NAMR") 202 FORMAT(" PART # OR FILE #") 204 FORMAT(" NAMR") 206 FORMAT(" .") 208 FORMAT(" /E TERMINATES THE COMMANDS") 215 FORMAT("UPDATE SAME AS BATCH,BUT MUST USE PART #. IT LOADS") 216 FORMAT(" FILES WITH LATER REV THAN THAT SPECIFIED IN") 218 FORMAT(" COMMAND FILE") 217 FORMAT("END/EXIT EXIT FROM SDLS4") GO TO 10 C C C********************************************************* C C C 'SUBROUTINE' TO OPEN AND CREATE REQUIRED FILES C C NOTES: INPUTS 'NAMR' C TRIES AN EXCLUSIVE OPEN ON THE FILE C IF IT EXISTS AS TYPE 1, CLOSE IT 'TILL NEEDED C IF NON-EXISTANT, FLAG IT AS 'NEEDED' C ( WHY TIE UP A FILE (OR DISC) IF YOU HAVE TO SEARCH THE TAPE FIRST) C 501 DO 511 I=1,20 IREQ(I)=2H 511 CONTINUE X=REIO(1,ILU,IREQ,20) 502 DO 504 I=1,IB IF(IAND(IREQ(I),77400B).NE.35000B)GO TO 503 IREQ(I)=IOR(IAND(IREQ(I),377B),26000B) 503 IF(IAND(IREQ(I),177B).NE.72B)GO TO 504 IREQ(I)=IOR(IAND(IREQ(I),177400B),54B) 504 CONTINUE C IB=IB*2 CALL PARSE(IREQ,IB,IPBUF) IF(IPBUF.LE.1)GO TO 11 C FILEFL=-1 CALL OPEN(IDCB,IERR,FNAME,0,SC,CR) IF(IERR.GE.0)GO TO 512 IF(IERR.NE.-6)GO TO 19 GO TO IRETN C 512 FILEFL=IERR CALL CLOSE(IDCB,IERR) GO TO IRETN C 8000 WRITE(LU,8010) 8010 FORMAT("PUNCH LU FOR LABEL IS? _") READ(LU,*)LUP PUN = .TRUE. GO TO 10 C********************************************************** C C C END SECTION REWIND TAPE AND UNLOCK THE LU C C 90 CALL GETRC(IBUF,MTLU,-3,INDEX,NFILE) CALL LURQ(100000B,MTLU,1) 990 WRITE(LU,190) 190 FORMAT("/SDLS4: DONE!"/) C END ASMB,R,B,L,C * ( NAM GETRC,7 VERSION 2 REV.1938 790919 * * THIS VERSION WILL HANDLE DATA FILES SUCH AS THE QUERY * HELP FILE. ALL CHANGES MADE TO JRT'S GETRC FOR THIS * FEATURE ARE DENOTED BY A LINE OF DASHES AS UNDERLINES. * * ENT GETRC EXT EXEC,.ENTR,IFBRK * * * * * CALLING INFORMATION: * * IFLAG: -3 REWIND THE TAPE * -2 REVERSE 1 FILE (SET TAPE TO PREVIOUS FILE) * -1 FORWARD FILE (FIND EOF) * 0 FIND NEXT SEQUENTIAL RECORD * 1 FIND PROGRAM ID BLOCK * 2 FIND LIBRARY DIRECTORY RECORD * 3 FIND EOB BLOCK * 4 FIND AN EOF BLOCK * ELSE REWIND & START ALL OVER.... * * * IBUF IS 1153 WORDS LONG AND RESIDENT IN THE CALLING PROGRAM. * GETRC READS INTO IBUF FROM MAG TAPE (MTLU) AND SETS 'INDEX' * TO POINT TO THE DESIRED ITEM (RECORD). RECORD STRUCTURE ON * THE MTLS TAPE IS A HIERARCHY OF DATA RECORDS => LOGICAL RECORDS * => PHYSICAL RECORDS. GETRC KEEPS TRACK OF THIS CRAP. * WHEN DATA RECORDS ARE SPLIT BETWEEN TWO PHYSICAL MAG TAPE RECORDS * GETRC WILL MOVE THE FIRST PORTION OF THE RECORD INTO LOW-INDEXED * PART OF 'IBUF' THEN READ THE NEXT MAG TAPE RECORD TO GET THE REST * OF THE DATA RECORD. THIS IS WHY 'IBUF' MUST BE 1153 WORDS LONG * EVEN THOUGH THE LARGEST MAG TAPE RECORD IS 1024 WORDS. THE * ROUTINE USES "CFLAG" AS A FLAG TO INDICATE A RECORD REQUIRES * CONTINUATION. MAG TAPE RECORDS ARE READ INTO 'IBUF' STARTING * AT IBUF(129) IN ORDER TO LEAVE ROOM FOR A POSSIBLE MOVE AS * DESCRIBED HERE. * * * GETRC RETURNS THE CURRENT PHYSICAL FILE NUMBER IN 'NFILE' * * RETURN FORMAT IN 'IBUF': * * IBUF(INDEX) = LENGTH OF DATA RECORD * IBUF(INDEX+1) = RECORD TYPE 1-4 AS ABOVE * 0 = TAPE LABEL RECORD * -1 = DATA RECORD * -2 = PHYSICAL EOF 9ENCOUNTERED * IBUF(INDEX+2) = FIRST DATA WORD * * * SKP * * * * RETURN FORMAT FOR 'INDEX': * * -14 = RECORD OUT OF SEQUENCE * -13 = ILLEGAL PROGRAM TYPE * -12 = DATA RECORD LENGTH > 255 * -11 = INTERNAL ERROR SEE LISTING * -10 = INTERNAL ERROR SEE LISTING * -9 = INTERNAL ERROR SEE LISTING * -8 = LOGICAL RECORD LENGTH ERROR * -7 = ILLEGAL RECORD LENGTH * -6 = LOGICAL RECORD OUTSIDE OF PHYSICAL BOUNDS * -5 = INTERNAL ERROR SEE LISTING * -4 = BREAK FLAG WAS SET * -3 = ILLEGAL LOGICAL RECORD TYPE * -2 = CHECKSUM ON DATA RECORD * -1 = CHECKSUM ERROR ON PHYSICAL RECORD * 0 = END OF TAPE * >0 = POINTER INTO IBUF FOR DESIRED RECORD * * NOTES: IPOINT IS LOCAL BUFFER POINTER * PMAX POINTS TO END OF LOGICAL RECORD * NMAX POINTS TO END OF PHYSICAL RECORD * LRLNTH IS LENGTH OF LOGICAL RECORD * * * * * SKP * * * IBUF BSS 1 MTLU BSS 1 IFLAG BSS 1 INDEX BSS 1 NFILE BSS 1 * GETRC NOP JSB .ENTR DEF IBUF * * SET UP OFT-USED ADDRESSES INTO DATA BUFFER * LDA IBUF ADA D128 SET ADDRESS OF START OF ACTIVE STA IB129 PART OF DATA BUFFER INA STA IB130 AND NEXT WORD,TOO. * LDA D129 SET RETURN-POINTER TO START OF STA INDEX,I DATA ARRAY AS WELL. LDA IFLAG,I CHECK FOR 'QUICKIE'S 1ST CPA DM3 JMP RWIND -3 = REWIND THE TAPE CPA DM2 JMP RVFIL -2 = REVERSE 1 FILE CPA DM1 JMP FWFIL -1 = FORWARD ONE FILE SSA IFLAG CAN'T BE <-3 OR >4... JMP RWIND ELSE TAPE REWINDS ADA DM5 SSA JMP PHYSR IF O.K., GET A DATA RECORD * *q * * SKP * * RWIND LDA B400 REWIND CODE... JSB TAPE GO DO IT... CLA,INA RESET MAG TAPE FILE # TO 1 STA FILE RTRN0 CLA '0' RETURN POINT (EOF RETURN) STA PMAX RESET ALL LOCAL POINTERS STA NMAX STA BPNTR LDA DM2 SET DATA WORD 2 = -2 STA IB130,I AS INDICATION OF EOF * RTRN1 LDA FILE '1' RETURN, PASS RESULTS TO CALLER STA NFILE,I JSB BCHK CHECK BREAK FLAG JMP GETRC,I * * REVERSE 1 FILE ON THE TAPE * RVFIL LDA B1400 REV FILE CODE JSB TAPE GO DO IT... LDA B1400 GO DO IT AGAIN... JSB TAPE LDA FILE ADA DM2 RESET THE FILE COUNTER SZA,RSS IF FILE # <=0 SET IT CLA,INA EQUAL TO 1 SSA CLA,INA STA FILE ELSE, IT'S O.K. * * FORWARD SPACE ONE FILE * FWFIL LDA B1300 FORWARD FILE CODE JSB TAPE GO DO IT... ISZ FILE INCREMENT FILE COUNTER JMP RTRN0 RETURN THRU 'EOF RETURN' * * SKP * * * START LOOKING FOR A TAPE DATA RECORD HERE * PHYSR LDA BPNTR IF LOCAL POINTER IS WITHIN LDB NMAX DATA BUFFER BOUNDS, THEN WE DON'T JSB .GE. NEED A PHYSICAL TAPE READ YET... SEZ,RSS JMP LR.1 SO GO GET THE NEXT LOGICAL RECORD! * PHSR2 JSB BCHK IF NEED A TAPE READ, CHECK BREAK LDA D129 FLAG FIRST. ALL O.K., PRESET RETURNED STA INDEX,I POINTER. RESET LOCAL RECORD CLA POINTERS ALSO. STA PMAX STA NMAX * JSB EXEC GO GET THAT MOTHA!!! DEF *+5 DEF ONE DEF MTLU,I IB129 NOP DEF D1024 STB TLOG SAVE TRANSMISSION LOG (AAMCO TOOT TOOT) * JSB EXEC IS IT AN EOF? DEF *+4 DEF D13 DEF MTLU,I DEF ISTAT * LDA ISTAT AND B200 SZA,RSS JMP GOT1 IF NOT AN EOF, PROCESS THE RECORD! * * EOF PROCESSING * LDA DM2 SET IBUF(130) = -2 TO SIGNAL CALLER STA IB130,I ISUZ FILE INCREMENT FILE COUNTER ISZ EOTFL COUNT # OF EOF'S IN A ROW... JMP PCNT1 IF NOT 2 IN A ROW, CONTINUE CLA ELSE CLEAR EOF FLAG AND SIGNAL STA INDEX,I CALLER THAT THIS IS IT!!! STA EOTFL RESET EOT FLAG JMP RTRN1 TAPES ALL DONE!!! * PCNT1 CCA GOT 1 EOF, GET SET FOR STA EOTFL POSSIBLE NEXT ONE. LDA IFLAG,I IF OP CODE = 0 (FIND NEXT SZA,RSS SEQUENTIAL RECORD) THEN RETURN. JMP RTRN1 IF HE WANTS SOMETHING SPECIAL JMP PHSR2 GO TRY AGAIN * SKP * * * START PROCESSING MAG TAPE RECORDS HERE... * * CHECK TAPE RECORD'S CHECKSUM * GOT1 STA EOTFL RESET EOT FLAG LDA TLOG CHECK THAT RECORD WAS < 1024 LDB D1024 JSB .LE. SEZ JMP CHK.1 ALL'S O.K. GO TO CHK.1 LDA DM7 ELSE, -7 = ERROR CODE! .BAD STA INDEX,I THIS IS BAD GUY RETURN! JMP RTRN0 NOW TO 'EOF RETURN'! * CHK.1 LDB IB130 = DATA ADDRESS START LDA IB129,I GET SIO COUNT ARS CHANGE TO WORD COUNT ADA IB129 ADD STARTING ADDRESS STA END = END = DATA ADDRESS END LDA B,I SET UP CHECKSUM STA CHKSM LOOP1 INB INCREMENT ADDRESS CPB END = LAST ADDRESS? JMP CHK.2 YES, CHECK CHECKSUMS ADA B,I NO, KEEP ADDING.... JMP LOOP1 DO IT AGAIN, DO IT AGAIN, DO IT... * CHK.2 CPA B,I OURS = THEIRS??? JMP PH.OK YES, PHYS. RECORD O.K. CCA NO, FUCK YOU!!! JMP .BAD * PH.OK STB NMAX SAVE 'END' AND MAX PHYS REC LDA IB130 ADDRESS. RESET WORK POINTER STA BPNTR * * SKP * * * START PROCESSING LOGICAL RECORDS HERE... * * THERE'S A LOT OF CHECKING TO DO: * 1) MAYBE WE ONLY NEED A DATA RECORD (ASCII LINE, ABSOLUTE RECORD * ETC.). IF WE ACTUALLY DO NEED A NEW LOGICAL RECORD GO TO '3)' * ELSE WE'RE STILL PROCESSING THE PREVIOUS ONE AND... * 2) IF WE'RE HERE, WE HAVE PROGRAM DATA SINCE MTLS INFO-RECORDS * MUST BY DEFINITION BE PROCESSED COMPLETELY BEFORE ASKING FOR * A NEW ONE. THUS, IF THE OP-CODE (IFLAG IN CALL) IS NOT A * REQUEST FOR NEXT-SEQUENTIAL-RECORD (0) IT IS FOR AN MTLS * RECORD AND THEREFOR EVEN IF WE ARE NOT DONE WITH THIS ONE WE * NEED A NEW ONE ANYHOW (GO TO '3)') ELSE GO PROCESS DATA... * 3) IF WE'RE DONE WITH THE LOGICAL RECORD SEE IF THERE'S ANOTHER * ALREADY IN MEMORY. IF NOT, GO GET ANOTHER MAG TAPE RECORD * (PHYSICAL READ VS. LOGICAL READ) * 4) THE LOGICAL RECORD LENGTH SHOULD BE CONSISTENT WITH PHYSICAL * RECORD BOUNDS. AS OF 4/75, THERE ARE MTLS TAPES OUT WITH ERRORS * IN PROGRAM ID BLOCK RECORDS (THEY'RE MISSING A WORD) SO THIS * CHECK CAN'T BE DONE YET. * 5) CHECK LOGICAL RECORD TYPE. IF IT'S AN MTLS RECORD, IT'S LENGTH * SHOULD AGREE WITH THE TABLE VALUES (SEE 'LNTAB') * * LR.1 LDA BPNTR LDB PMAX = BPNTR . IF WORK POINTER EXCEEDS JSB .GE. LOG REC POINTER, SO NEED A SEZ NEW LOGICAL RECORD. ELSE WE JMP GETLR GOT DATA. CHECK THAT OP-CODE LDA IFLAG,I IS 0, OR ELSE WE NEED A SZA NEW LOGICAL RECORD. JMP NXTLR LDA PRGTP PROCESS DATA ACCORDING TO CPA SS PROGRAM TYPE (S, R, OR ABS) JMP SRC.2 IF TYPE = 'SS', HAVE SOURCE. JMP REL.1 ELSE CHECK FOR RELOCATABLE... * * SKP * * * GET A NEW LOGICAL RECORD * GETLR LDA BPNTR NEED A PHYSICAL RECORD FIRST? LDB NMAX (I.E. IS WORK POINTER OUT OF BOUNDS) JSB .GE. SEZ JMP PHSR2 YES, GET ONE * LDA BPNTR,I NO, GET LR RECORD LENGTH CMA,INA STA LRLNT SAVE IT. SSA,RSS IF (-) = WORDS JMP *+5 IF(+) = CHARACTERS. CONVERT CMA,INA TO (+) WORDS  INA ARS STA LRLNT SAVE IT INA SET PMAX = POINTER + LENGTH + 1 ADA BPNTR STA PMAX THIS IS MAX LR ADDRESS * * TAKE AWAY *'S TO ENABLE THIS SECTION * * LDB NMAX IF LR BOUND EXCEEDS PHYS REC * JSB .GT. BOUND, THEN NO GOOD! * SEZ SET EOF (THIS SHOULD MUCK THINGS UP! * JMP RTRN0 * SKP * * * PROCESS A NEW LOGICAL RECORD... * * IF LENGTH >= 0 HAVE A DATA RECORD: SOURCE * RELOCATABLE * ABSOLUTE * * LENGTH < 0 & WE HAVE AN MTLS-INFO RECORD * * WORD 2 MEANING LENGTH * 0 TAPE LABEL 37 * 1 PROGRAM I.D. BLOCK 129 * 2 LIBRARY DIRECTORY 129 * 3 EOB BLOCK 1 * 4 EOF BLOCK 3 * * *-------------------------------------------------------------- * * THERE IS A PROBLEM HERE, HOWEVER, SINCE A DATA TYPE FILE MAY * CONTAIN NEGATIVE DATA WHERE THIS PROGRAM THINKS IT HAS A LENGTH * WORD. SO, IF BPNTR DOES NOT POINT TO IB130 AND PROGRAM TYPE * IS DD AND IFLAG IS ZERO, SKIP DIRECTLY TO SRC.1. * *------------------------------------------------------------- * * LDA BPNTR *-------------------------------------------------------------- CPA IB130 *--------------------------------------------------------------- JMP ROKAY *--------------------------------------------------------------- LDA PRGTP *--------------------------------------------------------------- CPA DD *--------------------------------------------------------------- RSS *--------------------------------------------------------------- JMP ROKAY *--------------------------------------------------------------- LDA IFLAG,I *--------------------------------------------------------------- SZA,RSS *-------------------------------------------------"-------------- JMP SRC.1 *--------------------------------------------------------------- * ROKAY LDA BPNTR,I GET LENGTH AGAIN *---------------------------------------NEW LABEL SSA IF < 0, PROCESS MTLS STUFF JMP .MTLS (CHECK IT FIRST...) LDA IFLAG,I CHECK OP-CODE: MUST BE = 0! SZA,RSS OR GET A NEW LOGICAL RECORD JMP SRC.1 IF = 0, WE HAVE DATA, O.K. JMP NXTLR ELSE GET NEXT LOGICAL RECORD. * * SKP * * * PROCESS MTLS-INFO RECORDS * .MTLS CLA RESET 'CONTINUATION' FLAG STA CFLAG SO WE KNOW THAT NEXT DATA LDA BPNTR RECORD IS A NEW ONE... INA LDA A,I GET RECORD TYPE STA RECTP SAVE IT CPA IFLAG,I IS IT WHAT HE WANTS? JMP GOTIT YES, GO TO IT BABY!!! LDB IFLAG,I NO, WILL HE TAKE ANYTHING? SZB,RSS YES, WE GOT THAT, TOO! JMP GOTIT * NXTLR LDA PMAX GET NEXT LOGICAL RECORD STA BPNTR RESET WORK POINTER JMP GETLR GO THRU NORMAL CHANNELS. * * * SKP * * * * PROCESS MTLS INFO RECORDS * * * GOTIT CPA FOUR IF WITHIN 0 TO 4, O.K. JMP *+6 AND THREE CPA RECTP JMP *+3 LDA DM3 ELSE ERROR CODE = -3 JMP .BAD * ADA LNTAB INDEX INTO LENGTH TABLE LDA A,I AND VERIFY RECORD LENGTH CPA LRLNT IF AGREE, ALL'S WELL... JMP M.OK LDB BPNTR EXECEPTION!: THE LAST PROG ADB THREE ID BLOCK IN THE LIBRARY IS LDB B,I A SHORT ONE INDICATING THE END CPB .99 OF THE LIBRARY. IT'S FOR JMP M.OK PART NUMBER 99999-99 ETC LDA DM8 ELSE ERROR CODE = -8 JMP .BAD * M.OK STA BPNTR,I SET POINTERS, ETC: LDA IBUF SET (+) LR LNTH IN BUFFER CMA,INA SET 'INDEX' = INDEX INTO ARRAY ADA BPNTR SET LOCAL POINTER = PMAX INA SO NEXT ROUND GETS NEW RECORD STA INDEX,I IF HAVE ID BLOCK, SAVE PROG TYPE LDA PMAX RETURN TO CALLER LDB BPNTR STA BPNTR LDA RECTP CPA ONE RSS JMP RTRN1 * ADB TWELV GET PROG TYPE CHARACTER LDA B,I ISOLATE IT & DUPLICATE IT AND UPPER SO IT'S 'SS' OR 'AA' OR 'RR' STA B BLF,BLF IOR B STA PRGTP SAVE IT JMP RTRN1 RETURN * * SKP * * * PROCESS PROGRAM DATA * * SRC.1 ISZ BPNTR POINT TO DATA INFO LDA PRGTP CPA SS IS IT SOURCE DATA? RSS JMP REL.1 NO, CHECK FOR RELOCATABLE * * * SOURCE RECORDS (THE WORST) * * PHYSICALLY MOVE 'EM FROM WHERE THEY ARE (IBUF(129) OR ABOVE) TO * LOW IN THE BUFFER (IBUF(1)). GOTTA DO THIS 'CAUSE CR & LF NOT * NECESSARILY IN THE SAME WORD. SDLS (VS. MTLS) DOES SOME CLEANUP Px * OF TAPE RECORDS TO TRY TO HAVE THAT, BUT IT CAN'T BE GUARANTEED... * ALSO, PREFACE THE RECORD WITH FAKE LENGTH AND TYPE TO MAINTAIN * FORMAT COSISTENCY WITH MTLS-INFO RECORDS. * * * NOTES BBYTE: SOURCE/DESTINATION BYTE * DBYTE: POINTERS * DPNTR: DESTINATION BUFFER ADDRESS * LFFLG: LINE-FEED FLAG * * LDA B177 XOR SHIFT RE-SET: SOURCE BYTE POINTER STA BBYTE LINE FEED FLAG CLA CONTINUATION FLAG STA LFFLG LDB CFLAG IF IT'S NOT A CONTINUATION, RESET STA CFLAG THE DESTINATION BYTE POINTER AND SZB ADDRESS POINTER JMP SRC.3 SRC.2 LDA TWO NOTE: CONTINUATION OCCURS WHEN ADA IBUF A DATA RECORD IS SPLIT 'TWIXT STA DPNTR TWO MAG TAPE RECORDS. LDA B177 STA DBYTE * * SKP * * * * LOOP FOR PROCESSING SOURCE CODE * SRC.3 LDA BPNTR IF WE'RE OUT OF THE BUFFER LDB PMAX WE NEED A NEW RECORD JSB .GE.@ SEZ,RSS JMP SRC.4 CLA,INA STA CFLAG SET CONTINUATION FLAG JMP GETLR GO GET A RECORD * SRC.4 LDA BPNTR,I GET BYTE W/O PARITY AND BBYTE STA B AND DBYTE HAVE TO SHIFT IT? SZA IE. DO WE WANT THE CHAR WHERE BLF,BLF 'DBYTE' AIN'T? LDA B IF SO, SHIFT ALREADY! CPA HI.CR IGNORE IT IF IT'S RSS A CARRIAGE RETURN CPA LO.CR JMP IGNOR CPA HI.LF IF IT'S A LINE FEED THEN RSS MAKE IT A SPACE AND SET CPA LO.LF THE LINE FEED FLAG RSS JMP STUFF ELSE STUFF IT IN BUFFER ALS,ALS LINE UP LF BITS WITH SPACE AND DBLSP (DON'T KNOW HI OR LO) STA LFFLG STUFF STA CHAR SAVE THE CHARACTER * LDA DBYTE GET GOOD BYTE FROM DESTINATION AND DPNTR,I IOR CHAR INSERT NEW CHARACTER STA DPNTR,I PUT IN DESTINATION BUFFER * LDA DBYTE RESET BYTE POINTERS XOR SHIFT STA DBYTE SLA ISZ DPNTR * * * SKP * * IGNOR LDA BBYTE SET UP NEXT SOURCE BYTE XOR SHIFT MASK STA BBYTE IF GETTING HIGH BITS NEXT, SLA,RSS INCREMENT WORD POINTER. ISZ BPNTR * LDA LFFLG GET A LINE FEED? SZA,RSS JMP SRC.3 NO, LOOP SOME MORE CLA YES, RESET THE FLAG STA LFFLG SET THE RECORD LENGTH LDA IBUF ADA TWO (2 FOR LENGTH & TYPE) CMA,INA ADA DPNTR STA IBUF,I * LDB IBUF RETURN RECORD TYPE INB CCA STA B,I CLA,INA SET POINTER = 1 STA INDEX,I JMP RTRN1 RETURN... * * SKP * * * RELOCATABLE & ABSOLUTE RECORDS * * REL.1 LDA CFLAG IS IT A CONTINUATION? SZA,RSS JMP REL.2 NO, CONTINUE NORMALLY LDA TEMP1 YES, RESET TEMP VALUES STA BPNTR LDA TEMP2 STA IB129,I OVERWRITE OLD SIO COUNTS WITH LDA TEMP3 NEW DATA STA IB130,I CLA STA CFLAG * *REL.2 LDB PMAX *--------------REMOVED FOR PROCESSING OF DATA TYPE REL.2 LDA PRGTP IS THIS A DATA FILE? *--------------------------------------------------------------- CPA DD *--------------------------------------------------------------- JMP DAT.1 YES, GO PROCESS DATA TYPE. *--------------------------------------------------------------- LDB PMAX * --------REPLACING INSTRUCTION REMOVED ABOVE LDA BPNTR,I GET ADDRESS OF FIRST NON- SZA ZERO WORD (RECORD LENGTH) JMP REL.3 GOT IT! GO PROCESS ISZ BPNTR CPB BPNTR IF RUN OUT OF DATA, GO JMP GETLR GET ANOTHER RECORD JMP REL.2+1 ELSE KEEP LOOKING * REL.3 AND UPPER ISOLATE WORD COUNT CPA BPNTR,I A LEGITIMATE VALUE? JMP *+3 LDA DM12 NO, ERROR CODE = -12 JMP .BAD ALF,ALF GET BITS WHERE THEY BELONG.. STA RECLN YES, SAVE RECORD LENGTH LDB PRGTP PROG TYPE ABSOLUTE? CPB AA RSS JMP REL.4 NO, GO PROCESS RELOCATABLE * * SKP * * * ABSOLUTE RECORDS * * ADA BPNTR IF RECORD IS NOT ENTIRELY ADA TWO IN MEMORY, GO DO CONTINUATION STA END TRICK. ELSE PROCESS INA LDB PMAX JSB .GE. SEZ JMP CNTNU * LDB BPNTR CHECK THE RECORD'S CHECKSUM INB LDA B,I ABS.2 INB CPB END JMP ABS.3 ADA B,I JMP ABS.2 ABS.3 CPA B,I CHECKSUMS AGREE? JMP ABS.4 YES, GO ON... LDA DM2 NO, ERROR CODE = -2 JMP .BAD * ABS.4 LDA BPNTR SET TYPE - -1 ADA DM1 CCB STB A,I I@ ADA DM1 LDB RECLN SET LENGTH = ABS RECORD ADB THREE RECORD-LENGTH STB A,I LDA IBUF SET INDEX INTO ARRAY CMA,INA ADA BPNTR ADA DM1 STA INDEX,I ADB BPNTR RESET POINTER FOR NEXT RECORD STB BPNTR JMP RTRN1 RETURN * * SKP * * * PROCESS RELOCATABLE RECORDS * * REL.4 CPB RR IS PROG TYPE RELOCATABLE? JMP *+3 YES, CONTINUE LDA DM13 ELSE ERROR CODE = -13 JMP .BAD SOCK IT TO 'IM!!! ADA BPNTR IS RECORD ENTIRELY WITHIN STA END MEMORY? LDB PMAX JSB .GE. SEZ JMP CNTNU NO, GO GET CONTINUATION * LDA BPNTR INA LDB A,I GET 1ST VALUE INA LOOPR INA CPA END JMP REL.5 ADB A,I JMP LOOPR * REL.5 LDA BPNTR ADA TWO CPB A,I CHECKSUMS AGREE? JMP *+3 LDA DM2 NO, ERROR CODE = -2 JMP .BAD * ADA DM3 CCB STB A,I ADA DM1 LDB RECLN STB A,I CMA,INA ADA IBUF CMA,INA INA STA INDEX,I LDA BPNTR ADA RECLN STA BPNTR JMP RTRN1 RETURN TO CALLER * * SKP **----------------------------------------------------------- ** ** THIS WHOLE SECTION WAS ADDED FOR PROCESSING OF DATA ** TYPE FILES. THE UNDERSCORING IS DISCONTINUED DURING ** THIS SECTION. THE SECTION ENDS WITH THE SKP INSTRUCTION ** IMMEDIATELY PRECEDING THE CONTINUATION SECTION. ** **----------------------------------------------------------- * * * PROCESS DATA FILE RECORDS * * DAT.1 LDA D128 GET DATA RECORD LENGTH STA RECLN ADA BPNTR IF RECORD IS NOT ENTIRELY STA END IN MEMORY, LDB NMAX CPA B (IF SAME ALL OKAY) JMP DAT.2 JSB .GE. SEZ JMP CNTNU GO GET CONTINUATION. * * END OF FILE IS SIGNIFIED ON DATA FILES BY 2 DC3 CHARACTERS IN THE * FIRST WORD OF THE CURRENT LOGICAL RECORD. CHECK FOR THIS. IF at * IT IS AN END OF FILE, RETURN WITH TYPE = -2 INSTEAD OF -1. * DAT.2 LDA BPNTR,I CPA .2DC3 RSS JMP DAT.3 LDA BPNTR END OF FILE, ADA DM1 SET TYPE TO -2 LDB DM2 STB A,I JMP DAT.4 AND CONTINUE WITH PROCESSING. * DAT.3 LDA BPNTR SET TYPE = -1 ADA DM1 CCB STB A,I DAT.4 ADA DM1 SET RECORD LENGTH = 128 LDB RECLN STB A,I LDA IBUF SET INDEX INTO ARRAY CMA,INA ADA BPNTR ADA DM1 STA INDEX,I ADB BPNTR RESET POINTER FOR NEXT RECORD STB BPNTR JMP RTRN1 RETURN * * SKP SKP * * * * RECORD CONTINUATION SECTION * CNTNU LDA PMAX CHECK IF THIS IS REALLY LDB NMAX NECESSARY JSB .GE. LDA DM9 SET ERROR CODE = -9 SEZ,RSS JMP .BAD * ADA DM1 SHOULD NOT HAVE CONTINUATION HERE. LDB CFLAG SZB JMP .BAD * ADA DM1 PRESET ERROR = -11 LDB BPNTR MUST NOW MOVE EXISTING DATA CMB,INB OUT OF THIS AREA INTO LOW BUFFER. ADB NMAX BUT ONLY FAR ENOUGH SO THAT STB NMOVE IT'LL BE CONTIGUOUS WITH CMB,INB NEW DATA TO BE READ IN. THIS ADB D131 PART CHECKS THAT THE MOVE IS SSB ENTIRELY WITHIN THE BUFFER. JMP .BAD * LDA NMOVE CMA,INA SAVE AS START, NEXT TIME. ADA IB130 CLACULATE END OF MOVE INA STA TEMP1 STA DPNTR LDB BPNTR LOOPM LDA B,I MOVE-LOOP... STA DPNTR,I ISZ DPNTR INB CPB PMAX RSS JMP LOOPM * LDA IB129,I SAVE DATA IN WORD-COUNT STA TEMP2 AND TYPE WORDS. LDA IB130,I STA TEMP3 CCA SET CONTINUATION FLAG STA CFLAG JMP PHSR2 GO READ THE MAG TAPE... * * SKP * * * * * * UTILITY ROUTINESj * * * PERFORMS .OP. E = 1/0 FOR TRUE/FALSE * .LE. NOP CMA,INA A<=B IF B-A IS (+) ADA B CLE,SSA,RSS CCE JMP .LE.,I * .GE. NOP CMB,INB A>=B IF A-B IS (+) ADA B CLE,SSA,RSS CCE JMP .GE.,I * * SKP * * TAPE NOP IOR MTLU,I = CONTROL CODE STA CONWD JSB EXEC DEF *+3 DEF THREE DEF CONWD JMP TAPE,I RETURN * * BCHK NOP JSB IFBRK CHECK BREAK FLAG DEF *+2 DEF * SSA,RSS IF SET, SET CODE = -4 JMP BCHK,I AND RETURN TO CALLER LDA DM4 JMP .BAD * * SKP * * * BUFFERS, CONSTANTS, AND STORAGE..... * * LNTAB DEF *+1 D37 DEC 37 * TABLE OF VALID MTLS D129 DEC 129 * RECORD LENGTHS DEC 129 * ONE DEC 1 * THREE DEC 3 * * FILE DEC 1 GETS MODIFIED... NMAX NOP INPUT TAPE-RECORD MAX ADDRESS PMAX NOP LOGICAL RECORD MAX ADDRESS EOTFL NOP END-OF-TAPE FLAG CFLAG NOP CONTINUATION FLAG NMOVE NOP * PRGTP NOP PROGRAM TYPE SS AA RR .99 ASC 1,99 SS ASC 1,SS RR ASC 1,RR AA ASC 1,AA DD ASC 1,DD RECTP NOP MTLS INFO RECORD TYPE LRLNT NOP LOGICAL RECORD LENGTH * BPNTR NOP DATA BUFFER POINTER DPNTR NOP DEST. BUFFER POINTER BBYTE NOP BUFFER BYTE SELECT MASK DBYTE NOP DEST. BUFR BYTE SELECT * * SKP * * CONSTANTS * * DM13 DEC -13 DM12 DEC -12 DM9 DEC -9 DM8 DEC -8 DM7 DEC -7 DM5 DEC -5 DM4 DEC -4 DM3 DEC -3 DM2 DEC -2 DM1 DEC -1 * TWO DEC 2 FOUR DEC 4 TWELV DEC 12 D13 DEC 13 D128 DEC 128 D131 DEC 131 D256 DEC 256 D1024 DEC 1024 D1025 DEC 1025 * B177 OCT 177 B200 OCT 200 B400 OCT 400 B1400 OCT 1400 B1300 OCT 1300 UPPER OCT 77400 SHIFT OCT 77577 HI.CR OCT 64D00 LO.CR OCT 15 HI.LF OCT 5000 LO.LF OCT 12 DBLSP ASC 1, * .2DC3 OCT 11423 * * STORAGE * *q IB130 BSS 1 TLOG BSS 1 ISTAT BSS 1 CHKSM BSS 1 CHAR BSS 1 LFFLG BSS 1 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 END BSS 1 RECLN BSS 1 CONWD BSS 1 * *q A EQU 0 B EQU 1 * * END ASMB,R,B,L,C NAM ALPHA,7 REV A 750120 * DOES AN ALPHABETIC SORT ON 3-WORD FIELD IN (NAMES) IFILE FIELDS LONG. * IT ALSO SETS BIT 8 OF THE TRACK SECTOR WORD IF IT IS AN EXTENT. * CALLED FROM FTN BY: CALL ALPHA(NAMES,IFILE) ENT ALPHA EXT .ENTR NAMES BSS 1 IFILE BSS 1 ALPHA NOP JSB .ENTR DEF NAMES CLA STA RPEAT LDA IFILE,I CMA,INA STA CNTR1 LOOP1 EQU * LDA CNTR1 ADA IFILE,I ALS,ALS ADA NAMES STA ADDR1 STA PNTR1 LDA CNTR1 CPA RPEAT JMP OUT INA SZA,RSS JMP OUT STA CNTR2 LOOP2 EQU * LDA CNTR2 ADA IFILE,I ALS,ALS ADA NAMES STA ADDR2 STA PNTR2 LDA DM3 STA CNTR3 LDA ADDR1 LOOP3 EQU * LDB ADDR2,I CMB,INB ADB A,I INA ISZ ADDR2 SSB JMP END2 SZB JMP SWTCH ISZ CNTR3 JMP LOOP3 STA B LDA A,I IOR IFLAG SET A FLAG STA B,I IF A FILE LDA ADDR2,I EXTENT IOR IFLAG STA ADDR2,I JMP END2 SWTCH EQU * LDA DM4 STA CNTR4 LDA ADDR1 STA PNTR1 LOOP4 EQU * LDA PNTR1,I LDB PNTR2,I SWP STA PNTR1,I STB PNTR2,I ISZ PNTR1 ISZ PNTR2 ISZ CNTR4 JMP LOOP4 END2 EQU * ISZ CNTR2 JMP LOOP2 ISZ CNTR1 JMP LOOP1 OUT EQU * JMP ALPHA,I CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 CNTR4 BSS 1 PNTR1 BSS 1 PNTR2 BSS 1 RPEAT BSS 1 ADDR1 BSS 1 ADDR2 BSsTS 1 IFLAG OCT 200 DM4 DEC -4 DM3 DEC -3 A EQU 0 B EQU 1 END _ Lh 24999-18068 2024 S 0100 &RXREF SOURCE             H0101 ASMB,Q,C NAM RXREF,4,90 24999-16051 REV.2024 800528 ************************ * MODULE CROSS-REFERENCING PROGRAM - VERSION IV * * WRITTEN BY: KATHY HAHN * * HISTORY--- * * MODIFIED BY: TERRY DONAHUE * DATE MODIFIED: * * MODIFIED BY: LYLE WEIMAN * DATE MODIFIED: 14 SEPT '76 * REASON: TO PRINT FILE NAME,CR #RECORD SIZE(DATE), FULL NAM RECORD * * MODIFIED BY: LYLE WEIMAN * DATE MODIFIED: 23 FEB. '77 * REASON: TO PRINT ACTUAL CARTRIDGE REF. # OF FILE, CHANGE ALL * EXEC I/O CALLS TO REIO CALLS, AND ALLOW "BATCH" USE. * * MODIFIED BY: LYLE WEIMAN * DATE MODIFIED: 20 DEC '77 * REASON: INCORPORATE EMA RECORDS FOR RTE-IV * * MODIFIED BY: LYLE WEIMAN * DATE MODIFIED: MAR 30 '78 * REASON: CHANGE NAME TO 'RXREF' SO AS TO AVOID DUPLICATE MODULE * NAME (MICROCODE ASSEMBLER'S CROSS-REF IS 'MXREF' * * MODIFIED BY: LYLE WEIMAN * DATE MODIFIED: 11 APR '78 * REASON: ALLOW 'BATCH' USAGE * * MODIFIED BY: HARVEY CLAWSON * DATE MODIFIED: 1 AUG '79 * REASON: CONVERT FOR COMPATIBILITY WITH RTE-L (REMOVE 'LG' CAPABILITY * AND ALLOW 'LOD' AND 'GEN' RECORDS BEFORE 'NAM' RECORD) * ALSO: ALLOW USE OF LARGE BACKGROUND PARTITION (MAKE TYPE 4; USE * 'LIMEM' TO DETERMINE FREE MEMORY SIZE) * ALSO: ALLOW COMMAND INPUT FROM A FILE * ALSO: ALLOW LIST OUTPUT TO A FILE * ALSO: DEFAULT THE LIST FILE TO THE USER TERMINAL * ALSO: LOCK LIST DEVICE FOR DURATION OF PROGRAM * ALSO: IMPROVE ERROR REPORTING ON FILE ERRORS * ALSO: ALLOW ASCII FILE SUBPARAMETERS (USE 'NAMR' SUBROUTINE). * ALSO: ALLOW SPECIFICATION OF RELOCATABLE FILE NAMES * IN THE RUN STRING * ALSO: ALLOW SEVERAL NEW TERMINATION COMMANDS (END, /E, EX, /A) * ALSO: PRINT THE NUMERIC TYPE OF EACH MODULE * ALSO: PRINT A WARNING MESSAGE IF THE MODULES ARE NOT IN LOGICAL * LOAD ORDER. '* * MODIFIED BY: HARVEY CLAWSON * DATE MODIFIED: 10 OCT '79 * REASON: FIX THE ALGORITHM FOR DETERMINING WHETHER ALL MODULES ARE * IN LOGICAL LOAD ORDER. PRINT AN ASTERISK BESIDE THE * MODULE NAME OF EACH BACKWARD REFERENCE. * ALSO: DELETE TRAILING SPACES FROM OUTPUT RECORDS TO REDUCE THE * AMOUNT OF DISC SPACE REQUIRED FOR LISTING TO A FILE. * ALSO: ABORT THE CROSS REFERENCE IF THE BREAK FLAG IS SET BY * THE OPERATOR 'BR' COMMAND. * ALSO: PRINT THE MODULE NUMBER WITHIN THE FILE (IMMEDIATELY * BELOW THE MODULE NAME). * ALSO: ALLOW MORE THAN 256 MODULES TO BE CROSS REFERENCED * (LIMITED ONLY BY THE SIZE OF FREE MEMORY). * * MODIFIED BY: HARVEY CLAWSON * DATE MODIFIED: 27 MAY '80 * REASON: PRINT THE TIME AND DATE WITH EACH LISTING * ALSO: CHANGE THE START-UP SEQUENCE TO PROMPT FOR * PARAMETERS NOT SPECIFIED IN THE RUN STRING * ALSO: MAKE 'EX' EQUIVALENT TO '/E', NOT '/A'. * HED RXREF OPERATING CHARACTERISTICS * * CALLING SEQUENCE: * RU,RXREF,COMMAND NAMR,LIST NAMR,RELOC1,...,RELOCN,/E * * WHERE: * 'COMMAND NAMR' IS A FILE CONTAINING A LIST OF RELOCATABLE * FILE NAMES (DEFAULTS TO USER TERMINAL, PROMPTS * WITH '-') * * 'LIST NAMR' IS A LIST DEVICE OR FILE (DEFAULTS TO USER TERMINAL). * IF THE FILE CANNOT BE FOUND, IT IS CREATED. * * 'RELOCX' IS THE FILE NAMR OF A RELOCATABLE BINARY FILE OR * OTHER VALID INPUT AS FOLLOWS: * * * FILE IS OPENED AND SCANNED. NAM,ENT,EXT * & END RECORDS ARE READ AND SORTED FOR * LATER CROSS-REFERENCE PRINTOUT. * * SAME AS ABOVE, EXCEPT THE SPECIFIED LOGICAL * UNIT IS READ INSTEAD OF A DISC FILE. * * -END, END, /E, EX, jOR END OF FILE * SIGNIFIES LAST FILE HAS BEEN INPUT. * CAUSES PROGRAM TO BEGIN ALPHABETICAL SORTING AND * PRINTOUT OF: * MODULES, WHERE-USED * ENTRY POINTS, DEFINING MODULE & REFERENCING * MODULES * UNDEFINED EXTERNALS, WHERE-USED * * /A ABORT. DO NOT COMPLETE CROSS REFERENCE. * * MULTIPLE FILE NAMES MAY BE INPUT IN ONE RECORD. SKP * * ERROR MESSAGES (DISPLAYED ON USER TERMINAL): * * FMP ERROR -NNN ON FILEX (SUBRX) -- * WHERE: * -NNN IS THE FMP ERROR NUMBER * FILEX IS THE NAME OF THE FILE OR DEVICE LU * SUBRX IS THE NAME OF THE FMP ROUTINE (I.E. OPENF, CLOSE) * * WAITING FOR FILEX -- THE NAMED FILE OR DEVICE IS OPEN OR LOCKED * TO ANOTHER PROGRAM. ENTER 'BR,RXREF' TO STOP RETRIES. * * CHECKSUM -- BAD CHECKSUM, OR FILE IS NOT RELOCATABLE BINARY. * * NOT ENOUGH SPACE TO COMPUTE LEVEL NUMBER -- BE SURE YOU * LOAD THIS PROGRAM TO USE AS LARGE A PARTITION AS POSSIBLE. * * SYMBOL TABLE-MODULE TABLE OVERFLOW -- BE SURE YOU * LOAD THIS PROGRAM TO USE AS LARGE A PARTITION AS POSSIBLE. * * NNN WARNINGS -- THE SPECIFIED NUMBER OF WARNING MESSAGES HAVE * BEEN PRINTED ON THE LIST FILE. * * * WARNING MESSAGES (DISPLAYED ON LIST FILE): * * ****DUP MODULE NAME: -- MODULE OF SAME NAME HAS BEEN SEEN BEFORE. * * ****DUP ENT: ,SKIP IT -- ENTRY POINT OF SAME NAME HAS BEEN * SEEN BEFORE. * * ****DUP EXT: ,SKIP IT -- EXTERNAL REFERENCE REPEATED WITHIN * MODULE. * * ****BACKWARD REFERENCE -- TO ALLOW EFFICIENT SEARCHING OF LIBRARIES, * EACH MODULE SHOULD PRECEDE THOSE MODULES IT REFERENCES. THE MODULES * MARKED WITH '*' FOLLOW THE REFERENCED MODULE. * TO GUARANTEE EFFICIENT S~EARCHING OF LIBRARIES, ALL * BACKWARD REFERENCES MAY BE RESOLVED BY ORDERING THE MODULES IN * ASCENDING NUMERICAL LEVEL NUMBER. * * ****CIRCULAR REFERENCE -- SOME MODULE REFERS TO A SECOND MODULE WHICH * IN TURN REFERS BACK TO THE FIRST MODULE. BOTH MODULES ARE LISTED * AS HAVING A LEVEL NUMBER OF 1000. * SKP * * NOTE: "LEVEL" IS AN INDICATION OF SUBROUTINE NESTING. * IF RXREF SEES A MODULE WHICH IS NOT CALLED FROM ANY OTHER * MODULE, THEN IT ASSIGNS THAT MODULE LEVEL 1. THE MODULES * THIS MODULE CALLS ARE ASSIGNED LEVEL 2, AND SO ON. * LEVELS ARE ASSIGNED BY THE MAXIMUM DEPTH FROM WHICH THEY ARE * CALLED. FOR EXAMPLE, IF A UTILITY SUBROUTINE IS CALLED FROM * VARIOUS LEVELS, ITS LEVEL WOULD THEN BE ONE LARGER THAN THE LARGEST * LEVEL NUMBER OF ANY SUBROUTINE WHICH CALLS IT. * OCCASIONALLY, IT IS NECESSARY FOR SOFTWARE TO REFER TO * LEVELS "ABOVE" IT. THAT IS, A MODULE AT LEVEL N REFERS * TO ANOTHER MODULE WITH A LOWER LEVEL NUMBER. IN THIS * CASE, RXREF SIMPLY GIVES UP AND ASSIGNS LEVEL NUMBER 1000. * IF INSUFFICIENT MEMORY IS AVAILABLE TO COMPUTE THE NUMBERS, * ZEROES ARE PRINTED. * * SKP * TABLE FORMATS: * SYMBOL TABLE -- GROWS DOWNWARD FROM LWAM * WORD 7 - ADDRESS OF DEFINING MODULE ENTRY * WORD 6 - ADDRESS OF FIRST ENTRY IN USER-MODULE LIST * WORD 5 - ADDRESS OF NEXT ALPHA. SYMBOL TABLE ENTRY * WORD 4 - ADDRESS OF NEXT ALPHA. ENTRY IN MODULE-ENT LIST * WORD 3 - CHARACTER 5 OF NAME; FLAGS * WORD 2 - CHARACTERS 3 AND 4 OF NAME * WORD 1 - CHARACTERS 1 AND 2 OF NAME * * USER-MODULE LIST -- GROWS DOWNWARD WITH THE SYMBOL TABLE * WORD 2 - ADDRESS OF NEXT ENTRY IN USER-MODULE LIST * WORD 1 - ADDRESS OF MODULE ENTRY REFERENCING THIS SYMBOL * * MODULE-TABLE -- GROWS UPWARD FROM FWAM; LENGTH VARIES AS * THE NUMBER OF EXT'S IN A MODULE VARY * WORT D N - ADDRESS OF S.T. ENTRY FOR EXT #N * : * : * WORD 8 - ADDRESS OF S.T. ENTRY FOR EXT #1 * WORD 7 - NUMBER OF EXT'S FOR THIS MODULE * WORD 6 - LEVEL NUMBER * WORD 5 - ADDRESS OF FIRST S.T. ENTRY IN MODULE-ENT LIST * WORD 4 - ADDRESS OF NEXT ALPHA. MODULE TABLE ENTRY * WORD 3 - CHARACTER 5 OF NAME; FLAGS * WORD 2 - CHARACTERS 3 AND 4 OF NAME * WORD 1 - CHARACTERS 1 AND 2 OF NAME * ******** * HED RELOC. MODULE CROSS-REFERENCE GENERATOR EXT KCVT DECIMAL TO ASCII CONVERSION EXT IFBRK RETURNS -1 IF BREAK FLAG SET EXT CREAT CREATE A FILE EXT READF READ A FILE EXT WRITF WRITE A FILE EXT GETST GETS OPERATOR PARAMETERS EXT LOGLU RETURNS LU OF OPERATOR CONSOLE EXT OPENF LU OR FILE "OPEN" ROUTINE EXT NAMR FMGR NAMR PARSE ROUTINE EXT CLOSE FILE CLOSER EXT CNUMD INTEGER-TO-DECIMAL ASCII CONVERTER EXT FSTAT CARTRIDGE INFO. GETTER EXT FTIME SYSTEM TIME FORMATTER EXT LOCF FILE INFO EXT LIMEM GET FIRST WORD AND SIZE OF FREE MEMORY EXT EXEC OPERATING SYSTEM EXECUTIVE EXT REIO BUFFERED I/O EXT .MVW MOVE WORDS * A EQU 0 B EQU 1 SUP * SKP * RXREF EQU * * INITIALIZATION ROUTINE * * NOTE: THIS CODE IS OVERLAID AFTER EXECUTION BY * THE CARTRIDGE DIRECTORY INFORMATION BLOCK. * * JSB GETST GET THE RUN STRING DEF *+4 DEF CMDBF BUFFER DEF M80 LENGTH DEF CMD1 TLOG * JSB LIMEM GET FREE MEMORY DEF *+4 DEF ZERO GET MEMORY DEF FWAM FIRST WORD OF FREE MEMORY DEF HADDR # OF WORDS LDA FWAM STA LADDR ADA M1 ADA HADDR COMPUTE LAST WORD STA HADDR * JSB LOGLU GET LU OF OPERATOR CONSOLE DEF *+2 Z(FOR ERROR MESSAGES) DEF LUTTY STA LUTTY STORE LU OF OPERATOR CONSOLE IOR B400 SET THE ECHO BIT FOR TERMINAL INPUT STA LUIN * CLA STA MCNT NUMBER OF MODULES STA AMDT ADD OF MODULE TABLE STA ASYMT ADD OF SYMBOL TABLE STA MADDR ADD OF CURRENT MODULE ENTRY STA ADDR ADD OF CURRENT ST ENTRY STA TBPSZ TOTAL BASE PAGE SIZE STA TMNSZ TOTAL MAIN SIZE STA TCMSZ TOTAL COMMON SIZE STA WARN WARNING COUNT * CLA,INA STA X INDEX FOR PARSE ROUTINE * LDB CMD1 SZB,RSS JMP GETIT NO STRING SPECIFIED, ASK FOR FILES * * COM? JSB NAMR PARSE COMMAND FILE NAME DEF *+5 DEF CNAME RESULT DEF CMDBF DEF CMD1 DEF X INDEX * LDA CNAME SZA,RSS JMP TTY INTERACTIVE COMMAND INPUT CPA LUTTY JMP TTY INTERACTIVE COMMAND INPUT * JSB OPENW OPEN THE COMMAND FILE DEF DCBC COMMAND DCB DEF IERR DEF CNAME NAME DEF ZERO OPTION DEF CSECR DEF CCART JSB FMPER PRINT ANY ERRORS DEF CNAME DEF OPEN CLB NON-INTERACTIVE SSA TTY CCB USE TERMINAL STB TTYFL * * JSB NAMR PARSE LIST FILE NAME DEF *+5 DEF LNAME RESULT DEF CMDBF DEF CMD1 DEF X * CCB LDA CMD1 ANY FILE NAMES PAST THE LIST DEVICE? INA CPA X CLB NO, NO RELOCS IN RUN STRING STB QUIT? LDA LNAME SZA,RSS LDA LUTTY DEFAULT TO USER TERMINAL STA LNAME * JSB OPENW OPEN THE LIST FILE DEF DCBL DEF IERR DEF LNAME NAME DEF ZERO OPTION DEF LSECR DEF LCART CPA M6 JMP CRETL CREATE THE LIST FILE JSB FMPER PR'INT ANY ERRORS DEF LNAME DEF OPEN LERR? SSA JMP ABORT GIVE UP * * JSB LIST EJECT PAGE DEF EJECT SSA JMP ABORT GIVE UP * JSB LIST '24998-XXXXX XXXX SOFTWARE KIT' DEF HEAD0 * JSB FTIME FORMAT THE TIME AND DATE MESSAGE DEF *+2 DEF DATE+2 * JSB LIST ' 4:11 PM WED., 10 OCT., 1979' DEF DATLN * JSB LIST 'MODULE MODULE SIZE (OCTAL) DEF HEAD1 JSB LIST 'NAME MODULE IDENT. BPAG MAIN COMM' DEF HEAD2 JSB LIST '----------------------------' DEF HEAD3 JMP NXTCM * * * CRETL LDA LSIZE CREATE THE LIST FILE SZA,RSS LDA D24 DEFAULT TO 24 BLOCK FILE STA LSIZE LDA LTYPE SZA,RSS LDA D4 DEFAULT TO TYPE 4 STA LTYPE JSB CREAT CREATE THE LIST FILE DEF RTN11 DEF DCBL DEF IERR DEF LNAME DEF LSIZE DEF LTYPE DEF LSECR DEF LCART RTN11 JSB FMPER PRINT ANY ERROR DEF LNAME DEF CRET JMP LERR? * * * GETIT JSB REIO '*RELOCATABLE MODULE CROSS REFERENCE*' DEF *+5 DEF D2 DEF LUTTY DEF TITLE DEF TITLN * JSB REIO 'PLEASE ENTER FILE NAMES AS FOLLOWS:' DEF *+5 DEF D2 DEF LUTTY DEF PLEAS DEF PLNG * * JSB REIO 'COMMAND, LIST, RELOC1,...,RELOCN,/E' DEF *+5 DEF D2 DEF LUTTY DEF RUNST DEF RUNLN * JSB REIO READ THE RUN STRING DEF *+5 DEF D1 DEF LUIN DEF CMDBF DEF M80 STB CMD1 JMP COM? PARSE COMMAND FILE NAME * * * THE FOLLOWING FOUR MESSAGES ARE OVERLAID BY THE * RELOCATABLE BINARY INPUT. THE TOTAL LENGTH MUST * BE AT LEAST 60 WORDS. * RBBUF EQU * DATLN DEC 17 DATE ASC 17, * TITLON DEC 18 TITLE ASC 18,*RELOCATABLE MODULE CROSS REFERENCE* * PLNG DEC 18 PLEAS ASC 18,PLEASE ENTER FILE NAMES AS FOLLOWS: * RUNLN DEC 19 RUNST ASC 19,COMMAND, LIST, RELOC1,..., RELOCN, /E * * * * NOTE: SIZE OF CARTRIDGE DIRECTORY INFORMATION * BLOCK MUST BE AT LEAST 175 WORDS OCTAL, GIVEN * BELOW BY SZCM: * SZCM EQU *-RXREF * M80 DEC -80 M6 DEC -6 M11 DEC -11 ZERO DEC 0 D24 DEC 24 X NOP QUIT? NOP WARN NOP FWAM NOP POINTS TO BASE OF MODULE TABLE HED RXREF COMMAND PROCESSOR * NXTCM JSB NAMR PARSE THE INPUT DEF *+5 DFILE DEF FNAME RESULT OF PARSE DEF CMDBF INPUT BUFFER DEF CMD1 INPUT BUFFER LENGTH DEF X INDEX * LDA FNAME SZA,RSS JMP CMDIN INPUT COMMAND * LDA DFILE LDB DEND JSB COMP CHECK FOR 'END' SZA,RSS JMP FINIS FINISH XREF * LDA DFILE LDB D.END JSB COMP CHECK FOR '-END' SZA,RSS JMP FINIS FINISH XREF * LDA DFILE LDB D/E JSB COMP CHECK FOR '/E' SZA,RSS JMP FINIS FINISH XREF * LDA DFILE LDB DEX JSB COMP CHECK FOR 'EX' SZA,RSS JMP FINIS EXIT * * LDA DFILE LDB D/A JSB COMP CHECK FOR '/A' SZA,RSS JMP ABORT EXIT * * * JSB CLOSE DEF *+2 DEF #DCB CPA M11 CLA IF NOT OPEN, IGNORE ERROR JSB FMPER PRINT ANY OTHER ERRORS DEF FNAME DEF CLOS * * JSB OPENW ATTEMPT TO OPEN FILE OR LU DEF #DCB DEF IERR DEF FNAME NAME DEF B311 OPTION DEF FSECR DEF FCART JSB FMPER PRINT ANY ERRORS DEF FNAME DEF OPEN SSA JMP NXTCM TRY NEXT FILE * * GET FILE INFORMATION * JSB LOCF DEF *+10 DEF #DCB DEF IERR DEF IERR DON'T CARE ABOUT THESE PARAMS DEF IERR DEF IERR DEF FSIZE FILE SIZE(IN SECTORS) DEF FLU LU OF FILE DEF FTYPE FILE TYPE DEF FREC RECORD SIZE(SOMETIMES HAS DATE FILE MADE) JSB FMPER PRINT ANY ERROR DEF FNAME DEF LOC * * EXTRACT THE CARTRIDGE REFERENCE NUMBER FROM THE * CARTRIDGE DIRECTORY. * JSB FSTAT DEF *+2 @CRTN DEF RXREF * LDA @CRTN LLL EQU * SEARCH LOOP LDB A,I GET LU OF CARTRIDGE SZB,RSS END OF LIST? JMP LL2 NOT FND,DON'T KNOW HOW THIS COULD HAPPEN.... CPB FLU SAME AS FILE? JMP LLF YES, FOUND ADA D4 MOVE ON TO NEXT ENTRY. JMP LLL * LLF EQU * HERE WHEN CARTRIDGE FOUND ADA D2 MOVE POINTER TO CARTRIDGE REF. NO. LDA A,I GET DIRECTORY TRACK NUMBER STA FCART LL2 EQU * JSB NAME MOVE FILE NAME DEF FNAME DEF FN1 * JSB CNUMD CONVERT CARTRIDGE TO DECIMAL DEF *+3 DEF FCART DEF FN2 * JSB CNUMD CONVERT FILE TYPE TO DECIMAL DEF *+3 DEF FTYPE FILE TYPE DEF FN3 * LDA FSIZE GET FILE SIZE(IN SECTORS) ARS CONVERT TO BLOCKS STA FSIZE STORE FOR CONVERSION JSB CNUMD CONVERT TO DECIMAL DEF *+3 DEF FSIZE DEF FN4 * JSB CNUMD CONVERT FILE SIZE TO DECIMAL DEF *+3 (RECORD SIZE IS SOMETIMES USED TO INDICATE DEF FREC DATE FILE CREATED) DEF FN5 * JSB CNUMD CONVERT FILE'S LU TO DEF *+3 DECIMAL DEF FLU DEF FN6 * * JSB LIST 'FILE NAME: FILEXX::CR:TY:SZ' DEF FNBUF * CLA STA MODS CLEAR MODULE COUNT * READB JSB RBIN READ BINARY RECORD * ADA RTBL INDEX INTO JUMP bTABLE LDA A,I JMP A,I JUMP TO RECORD PROCESSOR * * FNBUF ABS FBUFL-FNBUF-1 ASC 6, FILE NAME: FN1 BSS 3 FILE NAME BUFFER ASC 1,:: FN2 EQU * CARTRIDGE REFERENCE NUMBER FIELD. BSS 3 ASC 1,: FN3 EQU * BSS 3 FILE TYPE FIELD. ASC 1,: FN4 EQU * BSS 3 FILE SIZE FIELD ASC 1,: FN5 EQU * BSS 3 RECORD SIZE (DATE) FIELD. ASC 5, IS ON LU FN6 EQU * FILE LU FIELD. BSS 3 FBUFL EQU * * * * * * IERR NOP PRMT ASC 1,-_ ASK FOR INPUT * * * LNAME BSS 4 10-WORD PARSE BUFFER LSECR NOP * LCART NOP * LTYPE NOP * LSIZE NOP * LREC NOP * NOP * * * CNAME BSS 4 10-WORD PARSE BUFFER CSECR NOP * CCART NOP * CTYPE NOP * CSIZE NOP * CREC NOP * NOP * * * FNAME BSS 4 10-WORD PARSE BUFFER FSECR NOP * FCART NOP * FTYPE NOP * FSIZE NOP * FREC NOP * FLU NOP * * * * FINIS JSB BLINE BLANK THE LINE LDA TTLHD LDB MPTBF PRINT TOTAL HEADING JSB MVNAM LDB TBPSZ LDA OBF13 JSB CONV CONVERT TOTAL BPAGE SIZE TO ASCII LDB TMNSZ JSB CONV CONVERT TOTAL MAIN SIZE LDB TCMSZ JSB CONV CONVERT TOTAL COMMON SIZE JSB BFOUT JSB LVLNM COMPUTE MODULES' LEVEL NUMBERS JSB MREF DO MODULE CROSS REFERENCE JSB XREF DO ST CROSS REFERENCE * LDA WARN SZA,RSS JMP RXEND NO WARNINGS * LDB D8 CPA D1 LDB D7 STB WRN LENGTH OF WARNING MESSAGE * JSB CNUMD CONVERT WARNING COUNT TO DECIMAL DEF *+3 DEF WARN DEF WRN+1 * JSB ERROR 'NNN WARNINGS' DEF WRN * RXEND JSB LIST 'END OF CROSS REF' DEF NDMSG JSB LIST PAGE EJECT DEF EJECT * HALT JSB CLOSE CLOSE THE BINARY INPUT FILE DEF *+2 DEF #DCB CPA M11 CLA JSB FMPER PRINT ANY OTHER ERRORS DEF FNAME DEF CLOS * JSB CLOSE CLOSE THE COMMAND INPUT FILE DEF *+2 DEF DCBC CPA M11 CLA JSB FMPER PRINT ANY OTHER ERRORS DEF FNAME DEF CLOS * JSB CLOSE CLOSE THE LIST FILE DEF *+2 DEF DCBL CPA M11 CLA JSB FMPER PRINT ANY OTHER ERRORS DEF FNAME DEF CLOS * JSB EXEC DONE WITH PROGRAM DEF *+2 DEF D6 * * ABORT JSB ERROR 'RXREF ABORTED' DEF ABMSG JMP HALT * ABMSG DEC 7 ASC 7,RXREF ABORTED * * WRN DEC 8 ASC 8,XXXXXX WARNINGS * * TTLHD DEF *+1 ASC 3,TOTAL D.END DEF *+1 ASC 3,-END DEND DEF *+1 ASC 3,END D/E DEF *+1 ASC 3,/E D/A DEF *+1 ASC 3,/A DEX DEF *+1 ASC 1,EX BLANK ASC 2, * CLOS ASC 3,CLOSE OPEN ASC 3,OPENF CRET ASC 3,CREAT LOC ASC 3,LOCF WRIT ASC 3,WRITF READ ASC 3,READF * B311 OCT 311 D8 DEC 8 * NDMSG DEC 9 ASC 9, END OF CROSS REF * SKP * CMDIN EQU * ISZ QUIT? CLA,INA,RSS JMP FINIS RELOCS WERE SPECIFIED IN RUN STRING, QUIT STA X RESET INDEX FOR 'NAMR' LDA TTYFL GET TTY FLAG. SSA,RSS INTERACTIVE DEVICE? JMP CMDFL NOT A TTY, DON'T SEND PROMPT. JSB REIO ISSUE PROMPT TO TERMINAL. DEF *+5 DEF D2 DEF LUTTY DEF PRMT DEF M2 * JSB REIO READ TERMINAL INPUT DEF *+5 DEF D1 DEF LUIN DEF CMDBF  DEF M80 SZB,RSS JMP FINIS END OF INPUT JMP RDEX SAVE TRANSMISSION LOG * CMDFL JSB READF READ A RECORD FROM FILE DEF *+6 DEF DCBC DEF IERR DEF CMDBF BUFFER DEF D40 DEF CMD1 JSB FMPER PRINT ANY ERRORS DEF CNAME DEF READ SSA JMP FINIS ERROR, FINISH PROCESSING LDB CMD1 SSB JMP FINIS END OF FILE BLS CONVERT LENGTH TO CHARACTERS RDEX STB CMD1 JMP NXTCM PARSE NEXT COMMAND * SKP * FMPER NOP SSA,RSS JMP FMPOK NO ERROR, RETURN STA FMP ERROR ACCUMULATOR CMA,INA COMPLEMENT ERROR NUMBER STA FMP3 JSB CNUMD CONVERT TO DECIMAL DEF *+3 DEF FMP3 DEF FMP1 * LDA MINUS STA FMP1 ADD MINUS SIGN LDA FMPER,I STA FMPNM JSB NAME MOVE THE FILE NAME TO THE MESSAGE FMPNM NOP DEF FMP2 * ISZ FMPER LDA FMPER,I LDB DFMP3 JSB MVNAM MOVE THE SUBROUTINE NAME * JSB ERROR 'FMP ERROR -NNNN ON FILEX (SUBR)' DEF MSGP LDA FMP FETCH ERROR CODE RSS FMPOK ISZ FMPER ISZ FMPER JMP FMPER,I * * * FMP NOP * MSGP DEC 18 ASC 5,FMP ERROR FMP1 ASC 5,XXXXXX ON FMP2 ASC 4,XXXXXX ( FMP3 ASC 4,XXXXXX) * DFMP3 DEF FMP3 MINUS ASC 1, - * SKP * * NAME:OPENW * SUBROUTINE TO OPEN A FILE OR LU WITH WAIT. * IF THE FILE IS OPEN OR THE LU IS LOCKED TO * ANOTHER PROGRAM, RXREF PRINTS * THE MESSAGE 'WAITING FOR XXXXXX', AND THEN * RETRIES THE OPEN REQUEST FOREVER AT 6 SECOND * INTERVALS. RETRIES MAY BE STOPPED BY AN OPERATOR BREAK. * * * CALLING SEQUENCE: * JSB OPENW * DEF DCB * DEF ERROR * DEF NAME * DEF OPTION * DEF SECR * DEF CR * >ERROR CODE IN A * Ws* OPENW NOP OPEN WITH WAIT CLA STA ERCOD LDA OPENW LDB DOPEN JSB .MVW MOVE THE PARAMETERS TO THE CALL DEF D6 NOP LDA OPENW ADA D6 ADJUST THE RETURN ADDRESS STA OPENW * * OPNLP JSB OPENF OPEN THE FILE OR LU DEF *+7 OPEND NOP DCB OPENE NOP ERROR CODE OPENN NOP NAME NOP OPTION NOP SECR NOP CARTRIDGE SSA,RSS JMP OPENW,I SUCCESS! * * CPA M8 RSS FILE OPEN CPA M36 RSS LU LOCKED JMP OPENW,I FAILURE * * * CPA ERCOD JMP WAITO MESSAGE ALREADY PRINTED * STA ERCOD LDA OPENN STA *+2 JSB NAME MOVE FILE NAME TO MESSAGE NOP DEF WBUF+9 * JSB ERROR PRINT 'WAITING FOR XXXXXX' DEF WTBF * * WAITO JSB IFBRK CHECK THE BREAK FLAG DEF *+1 SZA JMP QUIT * JSB EXEC TIME SUSPEND DEF RTN23 DEF TIME CODE 12 DEF ZERO NAME DEF D2 CODE 2=SECONDS DEF ZERO MULTIPLE DEF M6 6 SECONDS * RTN23 JMP QUIT ABORT RETURN FROM EXEC 12 JMP OPNLP TRY AGAIN * QUIT LDA OPENE,I NO MORE RETRIES, BREAK FLAG SET JMP OPENW,I FAILURE * * WTBF DEC 12 WBUF ASC 12,RXREF WAITING FOR XXXXXX M8 DEC -8 M36 DEC -36 TIME DEF 12,I ERCOD NOP DOPEN DEF OPEND * SKP * ERROR NOP PRINT ERROR MESSAGE ON TERMINAL LDA ERROR,I STA ERLNG INA STA ERBUF JSB REIO WRITE THE ERROR MESSAGE DEF *+5 DEF D2 DEF LUTTY TERMINAL LU ERBUF NOP ERLNG NOP ISZ ERROR JMP ERROR,I * SKP * * CALLING SEQUENCE: * JSB LIST * DEF STRNG * . * . * . *STRNG DEC N MUST BE POSITIVE WORD LENGTH * ASC N,XXXXXXXXXXXXXXXX * * * LIST NOP OUTPUT LISTING JSB IFBRK TEST THE BREAK FLAG DEF *+1 SZA JMP ABORT BREAK FLAG SET, QUIT * LDA LIST,I LDB A,I WORD LENGTH INA STA LSBUF BUFFER ADDRESS ADB A LSTLP ADB M1 BACK UP ONE WORD LDA B,I CPA BLANK REMOVE ALL TRAILING BLANKS JMP LSTLP * INB LDA LSBUF CMA,INA ADB A SZB SSB CLB,INB IF START OF BUFFER WAS PASSED, OUTPUT ONE WORD STB LSLNG JSB WRITF WRITE THE LISTING DEF RTN5 DEF DCBL DEF IERR LSBUF NOP DEF LSLNG RTN5 JSB FMPER PRINT ANY ERRORS DEF LNAME DEF WRIT ISZ LIST JMP LIST,I * LSLNG NOP SKP * * NAME:NAME * SUBROUTINE TO MOVE A FILE NAME TO A BUFFER. * IF THE PARAMETER IS NUMERIC, THE MESSAGE * 'LU XX' IS MOVED. * * CALLING SEQUENCE: * JSB NAME * DEF NAMBF (MUST BE IN 'NAMR' PARSED FORMAT) * DEF BUFFER (3-WORD DESTINATION BUFFER) * * NAME NOP MOVE A FILE NAME DLD NAME,I STB NTMP1 ISZ NAME ISZ NAME JSB .MVW MOVE THE FILE NAME DEF D3 NOP LDA A,I RAR,SLA JMP NAME,I ASCII FILE NAME, DONE * LDA NTMP1,I NUMERIC (LU) AND B77 STA NTMP2 JSB KCVT CONVERT LU TO DECIMAL DEF *+2 DEF NTMP2 LDB NTMP1 ADB D2 STA B,I DLD LU MOVE ASCII PREFIX DST NTMP1,I JMP NAME,I DONE * NTMP1 NOP NTMP2 NOP LU ASC 2,LU * SKP * RBIN NOP RDF JSB READF READ BINARY INPUT DEF *+6 DEF #DCB DEF IERR RBBFA DEF RBBUF BUFFER DEF D60 DEF RBCNT COUNT JSB FMPER PRINT ANY ERRORS DEF FNAME DEF READ IOR RBCNT SSA JMP NXTCM ERROR OR END-OF-FILE, ASK FOR NEXT FILE ***** * * COMPUTE AND CHECK CHECKSUM * LDA RBCNT GET NEG. #DATA WORDS. CMA,INA,SZA,RSS JMP RDF ZERO LENGTH, TRY AGAIN ADA D3 SET UP COUNTER SSA,RSS (PROTECTION AGAINST JMP CKSER LT 4 WORD RECORD.) STA RBTM1 SET COUNTER LDA RBBUF+1 START CKSM WITH I. D. WORD LDB DRB3 * RBLP ADA B,I ADD INB REMAINING ISZ RBTM1 WORDS IN JMP RBLP RECORD - SUM IN A CPA RBBUF+2 COMPARE WITH RECORD CHECKSUM JMP RBOK EQUAL, RECORD GOOD * CKSER JSB ERROR 'CHECKSUM' DEF ERR1 JMP NXTCM TRY NEXT FILE * ERR1 DEC 4 ASC 4,CHECKSUM * * RBOK LDA RBBUF+1 ALF,RAR ROTATE RIC FIELD TO AND B7 LOW A AND ISOLATE CODE. STA RIC SAVE RECORD TYPE JMP RBIN,I * RBTM1 NOP DRB3 DEF RBBUF+3 D60 DEC 60 * * RECORD TYPE DRIVER * RTBL DEF *+1 DEF READB DEF NAM DEF ENXTR DEF READB DEF ENXTR DEF ENDR DEF ENXTR EMA RECORD DEF READB SKP MCNT NOP MODS NOP MODULE NUMBER WITHIN FILE RBCNT NOP RIC NOP TBPSZ NOP TCMSZ NOP TMNSZ NOP * * TEMP NOP OBF1 DEF OBUF+1 OBF5 DEF OBUF+5 OBF7 DEF OBUF+7 MPTBF DEF OBUF+9 OBF13 DEF OBUF+13 EMTBF DEF OBUF+22 ENDLN DEF OBUF+36 LSTPS DEF OBUF+37 RBF3 DEF RBBUF+3 RBF17 DEF RBBUF+17 DER4 DEF ERR4+12 DER5 DEF ERR5+8 DER6 DEF ERR6+8 * * * * * LER4 LDA RBF3 LDB DER4 JSB MVNAM MOVE THE NAME TO THE MESSAGE JSB LIST 'DUP MODULE NAME:' DEF ERR4 ISZ WARN INCREMENT WARNING COUNT DUMMY JSB RBIN CPA D5 JMP READB JMP DUMMY * * * * ERR4 DEC 14 ASC 14, ****DUP MODULE NAME: * * SKP * * SET UP MODULE TABLE ENTRY FROM A NAM RECORD , * NAM LDA HADDR CHECK FOR ST-MT OVERFLOW LDB LADDR ADB D7 JSB OVFCH JSB LIST PRINT BLANK LINE DEF SPACE ISZ MODS BUMP MODULE COUNT * JSB BLINE LDB AMDT SZB,RSS EMPTY MODULE LIST? JMP NBEG YES LDA RBF3 NO JSB COMP SZA,RSS JMP LER4 ERROR-DUPL. MODULE NAMES SSA JMP NSRCH NBEG LDA LADDR THIS MODULE GOES AT THE ALPHA. STA B BEGINNING OF THE LIST STA MADDR B, MADDR = ADD OF NEW ENTRY ADA D3 STA LADDR LDA AMDT SUCCESSOR IS PREVIOUS 1ST ENTRY STA LADDR,I STB AMDT JMP MV1 * * SEARCH MODULE TABLE WHERE B IS ADD OF LAST * MODULE ENTRY SEARCHED * NSRCH ADB D3 STB PREVE LDA B,I STA B ADD OF NEXT ENTRY IN B SZB,RSS JMP EOL END OF LIST LDA RBF3 JSB COMP SZA,RSS JMP LER4 DUPL. MODULE NAMES SSA JMP NSRCH * EOL LDA LADDR STA MADDR SET ALPHA. MODULE SUCCESSOR OF STA PREVE,I PREV ENTRY TO PT TO THIS ENTRY ADA D3 STA LADDR STB LADDR,I SET ALPHA. MODULE SUCCESSOR MV1 EQU * LDB MADDR STORE MODULE NAME. LDA RBF3 JSB MVNAM IN TABLE ENTRY ISZ MCNT INCREMENT # MODULES INB CLA INITIALIZE STA B,I POINTERS INB TO 0: STA B,I INB STA B,I LDA D4 ADA LADDR STA LADDR UPDATE LADDR JSB BLINE BLANK OUT BUFFER LDB OBF1 MOVE NAME LDA MADDR OUTPUT JSB MVNAM BUFFER * LDA OBUF+3 IOR B54 INSERT COMMA AFTER NAME STA OBUF+3 * JSB KCVT CONVERT TYPE TO DECIMAL DEF *+2 DEF RBBUF+9 STA OBUF+4 * LDB RBCNT GET RECORD LENGTH CMB,INB MAKE NEGATIVE  ADB D17 TEST FOR EXTENDED-NAM SSB,RSS EXTENDED NAM FIELD PRESENT? JMP MV2 NO,CONTINUE CMB,INB STB TEMP1 LDA RBF17 SOURCE ADDRESS LDB OBF7 LOAD DESTINATION ADDRESS JSB .MVW MOVE WORDS DEF TEMP1 NOP MV2 EQU * JSB BFOUT PRINT OUT THE LINE * JSB CNUMD CONVERT MODULE COUNT TO ASCII DEF *+3 DEF MODS DEF OBUF+1 * LDA EMTBF STA CTR SET FOR ENT OUTPUT CCA FOR THE NAM RECORD (THIS STA EFLG INFO IS USED IN ENXTR) LDA OBF13 LDB RBBUF+7 ADB TBPSZ STB TBPSZ LDB RBBUF+7 CONVERT BP LENGTH TO ASCII JSB CONV CONVERT BP LENGTH TO ASCII LDB RBBUF+6 RBL,CLE,ERB ADB TMNSZ STB TMNSZ LDB RBBUF+6 RBL,CLE,ERB CLEAR AIC CODE IN BIT # 15 JSB CONV CONVERT MAIN PROG LENGTH LDB RBBUF+8 ADB TCMSZ STB TCMSZ LDB RBBUF+8 JSB CONV CONVERT COMMON LENGTH JMP READB * OBUFA DEF OBUF * SPACE DEC 1 ASC 1, * CTR NOP B54 OCT 54 * SPC 2 * CHECK FOR SYMBOL TABLE - MODULE TABLE OVERFLOW * OVFCH NOP CMB,INB ADB A HADDR - LADDR SSB,RSS JMP OVFCH,I +: NO OVERFLOW LDB EMTBF CPB CTR ANYTHING LEFT IN BUFFER? RSS JSB BFOUT YES, DUMP IT JSB ERROR 'SYMBOL TABLE-MODULE TABLE OVERFLOW' DEF OVMSG JMP FINIS * OVMSG DEC 19 ASC 19, SYMBOL TABLE-MODULE TABLE OVERFLOW SPC 2 * MOVE SYMBOL NAME TO TABLE ENTRY, OR OUTPUT BUFFER * * ON ENTRY: (A) = SOURCE ADDRESS * (B) = DESTINATION ADDRESS * * 5 CHARS WILL BE MOVED (6TH IS BLANKED) * MVNAM NOP STA TEMP3 LDA A,I STORE: STA B,I CHARACTERS 1 & 2 INB ISZ TEMP3 LDA TEMP3,I STA B,I + CHARACTERS 3 & 4 INB ISZ TEMP3 LDA TEMP3,I AND BYTE IOR B40 STA B,I CHARACTER 5 INB JMP MVNAM,I SPC 1 * BLANK OUT PRINT BUFFER,OBUF * BLINE NOP LDA BLANK STA OBUF LDA OBUFA LDB A INB JSB .MVW FILL BUFFER DEF D39 NOP JMP BLINE,I * D39 DEC 39 SPC 2 * * CONVERSION ROUTINE * CONVERT 15-BIT BINARY NUMBER TO 6 CHARACTER * (LEADING BLANK) ASCII FORM OF OCTAL * * ON ENTRY: (B) = BINARY NUMBER TO CONVERT * (A) = ADDRESS TO STORE ASCII * CONV NOP STA TEMP1 SAVE STORAGE ADDRESS RBL POSTION FIRST DIGIT TO BITS 15-13 LDA M3 STA TEMP2 CONVERT COUNTER = -3 LDA B40 MAKE FIRST CHARACTER A SPACE CONV1 ALF,ALF ROTATE CHAR TO UPPER POSITION STA TEMP3 AND SAVE BLF,RBR POSITION NEXT DIGIT TO BITS 2-0 LDA B AND D7 ISOLATE DIGIT IOR B60 MAKE AN ASCII CHAR (60-67) IOR TEMP3 PACK IN UPPER CHARACTER STA TEMP1,I AND STORE IN STORAGE AREA ISZ TEMP1 INCREMENT STORAGE AREA ADDRESS BLF,RBR ROTATE NEXT DIGIT TO LOW BYTE LDA B ISOLATE CHAR AND D7 IN LOW A IOR B60 MAKE AN ASCII CHAR ISZ TEMP2 INCREMENT CONVERT COUNTER JMP CONV1 NOT FINISHED LDA TEMP1 FINISHED.SET (A) =NEST STORAGE JMP CONV,I AREA WORD ADDRESS, AND EXIT * TEMP3 NOP * SPC 2 * * * COMP - DETERMINES ALPHABETIC ORDER OF 2 SYMBOLS * A= ADD OF CURRENT RECORD * B = ADD OF A TABLE ENTRY * RESULTS IN A, WHERE: * (A) LT 0 WHEN (A,I) GT (B,I) * (A) EQ 0 WHEN (A,I) EQ (B,I) * (A) GT 0 WHEN (A,I) LT (B,I) * COMP NOP STA TEMP1 STB TEMP2 LDA M2 STA CNT CMP1 LDA TEMP1,I CMA,INA ADA TEMP2,I SZA JMP COMP,I CHExARS 1 & 2 DON'T MATCH ISZ TEMP1 CHARACTERS ISZ TEMP2 MATCH SO FAR ISZ CNT JMP CMP1 LDA TEMP1,I AND BYTE TEST CHAR 5 : CMA,INA STA CNT TEMPORARY SAVE LDA TEMP2,I AND BYTE ADA CNT JMP COMP,I * TEMP1 NOP TEMP2 NOP CNT NOP BYTE OCT 177400 SKP * * FIND OR ADD A SYMBOL TABLE ENTRY FOR AN EXT OR * ENT RECORD * ENXTR EQU * LDA RIC ADA M4 SSA CLA,INA 1 FOR ENT, 2 FOR EMA STA RIC 0 FOR EXT LDB EMTBF CPB CTR EMPTY BUFFER? JMP ENXX YES LDA RIC CPA EFLG NEW RECORD TYPE(FROM LAST RECORD) JMP ENXT1 NO JSB BFOUT YES, DUMP CONTENTS LDB EMTBF RESET BUFFER POINTER STB CTR ENXX EQU * LDA RIC STA EFLG CPA D2 EMA RECORD? JMP EMAX YES, PROCESS SLIGHTLY DIFFERENTLY. SZA JMP ENXT0 LDA EXTH RSS ENXT0 LDA ENTH LDB CTR JSB MVNAM STB CTR ENXT1 LDA RBBUF+1 GET AND ISOLATE RECORD AND B77 ITEM COUNT CMA,INA SET NEGATIVE COUNTER STA RBBUF+1 FOR PROCESSING LDA RBF3 STA EBUFA ENXT2 LDB CTR MOVE NAME TO CPB EMTBF OUTPUT BUFFER RSS JMP ENXT3 LDA RIC SZA JMP ENXT4 LDA EXTH RSS ENXT4 LDA ENTH JSB MVNAM LDA EBUFA ENXT3 JSB MVNAM CPB LSTPS RSS JMP ENXT5 ENTX1 EQU * JSB BFOUT LDB EMTBF ENXT5 STB CTR LDB ASYMT SZB,RSS JMP EBEG EMPTY ST LDA EBUFA COMPARE ENT-NAME AND JSB COMP ST NAME (FIRST ENTRY) SZA,RSS JMP ESTM HAVE FOUND THE MATCHING ST ENTRY SSA,RSS JMP EBEG NEW ENTRY GOES AT BEGINNING OF ST ESRCH ADB D4 SEARCH SYMBOL TABLE STB PREVE SAVE ADD OF PREV ENTRY'S WORD #5 LDA B,I STA B GET NEXT ST ENTRY ADD SZB,RSS JMP ESRC1 END OF ST LDA EBUFA COMPARE SYMBOLS JSB COMP SZA,RSS JMP ESTM HAVE A ST MATCH SSA JMP ESRCH CONTINUE SEARCH ESRC1 JSB GETNT ADD AN ENTRY TO THIS POSITION IN STA PREVE,I THE ST. SET PTR TO IT JMP ESRC2 EBEG JSB GETNT GET SPACE ALLOCATED FOR NEW ENTRY STA ASYMT AT BEGINNING OF ST ESRC2 LDB EFLG ENT OR EXT? SZB,RSS JMP SETMU SET UP MOD-USE LIST ENTRY ADA D6 ENT STA B JMP ELST ENT-JUMP TO MOD-ENT LIST SEARCH * * HAVE A MATCHING SYMBOL TABLE ENTRY * ESTM STB ADDR HAVE A ST MATCH LDA EFLG EXT OR ENT? SZA,RSS JMP EXTPR GOTO EXT RECORD PROCESSOR ADB D6 ENT - DEFINED YET? LDA B,I SZA JMP LER5 YES-DUPL. ENT RECORDS JMP ELST NO-SEARCH THRU MOD-ENT LIST * SKP * * EMA RECORD PROCESSOR * EMAX EQU * LDA EMAH MOVE "EMA=" TO OUTPUT BUFFER LDB CTR JSB MVNAM STB CTR LDA RBBFA GET POINTER TO SYMBOL ADA D3 STA EBUFA LDB CTR JSB MVNAM MOVE EMA SYMBOL NAME TO OUTPUT BUFFER STB CTR LDA RBBUF+1 GET EMA SIZE AND B1777 MASK EMA SIZE STA B LDA CTR JSB CONV CONVERT TO OCTAL STA B MOVE DESTINATION ADDRESS TO (B) LDA BLANK STA B,I STORE TWO BLANKS INB LDA MSGH GET DESTINATION ADDRESS JSB MVNAM MOVE "MSEG=" LDA B LDB RBBUF+6 GET MSEG SIZE JSB CONV CONVERT STA CTR SAVE CCA SET UP SO ENT/EXT PROCESSORS WORK ON STA RBBUF+1 ON ONE SYMBOL ONLY. JMP ENTX1 B1777 OCT 1777 EMAH DEF *+1 ASC 3, EMA= MSGH DEF *+1 ASC 3,MSEG== * * EXT PROCESSING * EXTPR EQU * ADB D5 GET ADDRESS LDB B,I OF MODULE-USE LIST SZB,RSS JMP SETMU EMPTY MODULE-USE LIST LDA B,I M-U NOT EMPTY CPA MADDR SEARCH THRU MOD-USE LIST JMP LER6 MOD ALREADY THERE-DUPL EXT'S IN I SETM0 INB STB PREVE LDB B,I GET ADD. OF NEXT MOD-USE ENTRY SZB,RSS JMP SETM1 NO MORE LDA B,I CPA MADDR MATCH MOD JMP LER6 DUPL, EXT'S JMP SETM0 * SETM1 LDA HADDR ADA M2 LDB LADDR INB JSB OVFCH CHECK FOR ST-MT OVERFLOW LDB HADDR ADD ENTRY AT THIS POSITION IN LIS ADB M1 STB PREVE,I JMP ADDEX SETMU LDA HADDR ADA M2 LDB LADDR INB JSB OVFCH CHECK FOR ST-MT OVERFLOW LDA ADDR EMPTY M-U LIST ADA D5 LDB HADDR ADB M1 STB A,I SET MOD-USE POINTER ADDEX LDA MADDR STA B,I STORE ADD. OF USER MODULE ADA D6 ISZ A,I INCREMENT # OF EXT'S IN MODULE CLA SET NEXT M-U ENTRY PTR. TO 0 STA HADDR,I (SINCE WE ALWAYS ADD THEM AT THE END) ADB M1 END) STB HADDR LDA ADDR GET SPACE FOR EXT ADD STA LADDR,I IN MODULE ENTRY ISZ LADDR UPDATE JMP NXTEN GET NEXT ENTRY IN RECORD * * SEARCH MODULE'S ENT-LIST * ELST LDA MADDR ENT PROCESSING STA B,I SET MODULE-DEFN ADDRESS ADA D4 LDB A,I GET ENT-LIST PTR. SZB,RSS JMP LBEG EMPTY ENT-LIST LDA EBUFA SEARCH THRU JSB COMP ENT-LIST SZA,RSS JMP LER5 DUPLICATE ENT RECORDS -ERROR SSA JMP LSRCH CONTINUE SEARCH LBEG LDA ADDR PLACE ENTRY AT BEG. OF LIST ADA D3 STB A,I PTR. TO SUCCESSOR IN ENT-LIST LDA ADDR LDB MADDR ADB D4 PTR. TO FIRST ENTRY IN  STA B,I MODULE'S ENT-LIST JMP NXTEN GET NEXT RECORD ENTRY LSRCH ADB D3 SAVE ADD. CONTAINING ADD. OF STB PREVE NEXT ENT-LIST ENTRY LDA B,I GET NEXT MOD-ENT ENTRY STA B SZB,RSS JMP NXTEA END OF MOD-ENT LIST LDA EBUFA JSB COMP COMPARE SYMBOL NAMES SZA,RSS JMP LER5 ERROR-DUPL ENT'S SSA JMP LSRCH SEARCH NEXT ENTRY * NXTEA LDA ADDR PREV. MOD-ENT LIST ENTRY STA PREVE,I POINTS TO THIS ENTRY ADA D3 STB A,I SET NEXT MOD-ENT ENTRY PTR. NXTEN LDA EBUFA GET OLD RECORD ENTRY ADDRESS ADA D3 ADD 3 FOR NEXT EXT ENTRY ADA EFLG ADD 1 MORE FOR ENT STA EBUFA SET ADD OF NEXT ENTRY ISZ RBBUF+1 INCREMENT ENTRY COUNT JMP ENXT2 MORE TO PROCESS JMP READB FINISHED-GET NEXT RECORD * * PREVE NOP EFLG NOP EBUFA NOP * ENTH DEF *+1 ASC 3, ENT= EXTH DEF *+1 ASC 3, EXT= * * * * DUPLICATE SYMBOL * LER5 EQU * LDA EFLG IS THIS AN CPA D2 EMA RECORD? JMP EXTPR YES, ALLOW DUPLICATES. LDA EBUFA LDB DER5 JSB MVNAM MOVE NAME TO MESSAGE * JSB LIST 'DUP ENT: SKIP IT' DEF ERR5 ISZ WARN INCREMENT WARNING COUNT JMP NXTEN * LER6 LDA EBUFA LDB DER6 JSB MVNAM MOVE NAME TO MESSAGE * JSB LIST 'DUP EXT: SKIP IT' DEF ERR6 ISZ WARN INCREMENT WARNING COUNT JMP NXTEN * ERR5 DEC 14 ASC 14, ****DUP ENT: ,SKIP IT * ERR6 DEC 14 ASC 14, ****DUP EXT: ,SKIP IT SPC 2 * * GET A SYMBOL TABLE ENTRY * GETNT NOP GET SPACE ALLOCATED FOR A NEW SYM STB TEMP LDA HADDR BOL TABLE ENTRY ADA M7 LDB LADDR JSB OVFCH CHECK FOR ST-MT OVERFLOW STA HADDR POINTS TO NEXT FREE SPACE INA 4 STA ADDR PTS. TO BEGINNING OF NEW ENTRY ADA D4 LDB TEMP STB A,I PT. TO NEXT S.T. ENTRY LDB ADDR MOVE NAME TO LDA EBUFA JSB MVNAM ENTRY CLA INITIALIZE: STA B,I MOD-ENT LIST PTR., ADB D2 STA B,I MOD-USE LIST PTR., INB STA B,I AND MOD-DEFN. PTR. TO 0 LDA ADDR JMP GETNT,I * SPC 2 * * END RECORD PROCESSOR * ENDR EQU * LDB EMTBF CPB CTR ANY ENT'S OR EXT'S LEFT IN BUFFER? JMP ENDR0 NO JSB BFOUT YES, PRINT THEM LDB EMTBF STB CTR ENDR0 LDA RBBUF+1 IS A TRANSFER ADDRESS GIVEN? SLA JMP ENDR1 YES LDA EFLG NO-IS THERE A MODULE NAME SSA,RSS LEFT IN OBUF? JMP READB NO JMP ENDR2 YES, PRINT IT * ENDR1 LDA ENDH YES - JSB MVNAM PRINT IT STB A LDB RBBUF+3 RBL,CLE,ERB JSB CONV ENDR2 JSB BFOUT JMP READB * ENDH DEF *+1 ASC 3, END= SPC 2 * BFOUT NOP JSB LIST LIST THE OUTPUT BUFFER DEF OUT JSB BLINE JMP BFOUT,I SKP * * COMPUTE MODULE LEVEL NUMBER * LVLNM NOP LDA HADDR LDB LADDR REP 3 ADB MCNT CMB,INB CHECK TO SEE WHETHER ADB A THERE IS ENOUGH SSB,RSS SPACE AVAILABLE JMP INT0 YES, GO PROCESS LEVELS NOROM JSB ERROR 'NOT ENOUGH SPACE...LEVEL NUMBER' DEF NOTRM JMP LVLNM,I * INT0 LDA LADDR STA VECTR SAVE ADD OF LEVEL VECTOR ISZ LADDR LDB MCNT CMB,INB,SZB,RSS JMP RXEND SKIP REMAINDER OF CROSS REFERENCE LISTING STB TEMP LDB D1000 DEFAULT VALUE FOR HIGHEST LEVEL # INT1 STB LADDR,I AND INITIALIZE ENTIRE VECTOR TO IT ISZ LADDR ISZ TEMP JMP INT1 * LDA AMDT PLACE MODULE ID # (ALPHA ORDER) CLB,INB INT2 STA MADDR INTO MODULE ENTRY WORD 6 ADA D5 STB A,I ADA M2 GET NEXT MODULE ENTRY LDA A,I SZA,RSS JMP INT3 END OF MODULE TABLE INB JMP INT2 * INT3 CLA,INA STA CNT LDA AMDT INT4 CLB STB UFLG W-U FLAG (=0 UNTIL ONE FOUND) STA MADDR ADA D4 LDA A,I GET FIRST ENT ENTRY SZA,RSS JMP INT6 NO ENT'S INT5 STA ADDR ADA D5 LDB A,I GET FIRST W-U ENTRY SZB NONE ISZ UFLG INCREMENT WHEN ONE FOUND ADA M2 GET MODULE'S NEXT ENT LDA A,I SZA JMP INT5 LDA UFLG NO MORE ENTS ANY W-U'S FOUND? SZA JMP INT7 YES INT6 CLA,INA SET MODULE LEVEL = 1 LDB VECTR SINCE NO W-U'S ADB CNT STA B,I INT7 LDA MADDR ADA D3 LDA A,I GET NEXT MODULE ENTRY SZA,RSS JMP INT8 NO MORE ISZ CNT INCREMENT MODULE # (AND OFFSET JMP INT4 IN VECTOR) * INT8 CLA,INA STA LEVEL INITIALIZE LEVEL # STA CNT LDA LADDR STA PRLST LDA AMDT INT9 STA MADDR ADA D6 LDB A,I SZB,RSS JMP INT14 NO EXT'S - GO TO NEXT MODULE CMB STB TEMP1 SAVE NEG # EXTS STA TEMP2 SAVE ADD OF EXT LIST INT10 ISZ TEMP1 RSS JMP INT11 NO MORE EXT'S ISZ TEMP2 LDA TEMP2,I GET ADD OF EXT-ST ENTRY ADA D6 LDA A,I GET ITS DEFN MODULE ADD SZA,RSS JMP INT10 AN UNDEFF GO TO NEXT EXT ADA D2 HAS AN ENTRY ALREADY BEEN LDB A,I MADE IN THE PARLIST FOR SLB THESE 2 MODULES (BIT #1 ON)? JMP INT10 YES, GO TO NEXT EXT ISZ A,I NO SET FLAG IN WORD #3 OF MODULE'S ADA D3 ENTRY LDA A,I PUT MODULE'S # STA LADDR,I IN PARLIST ENTRY LDB LADDR INB CPB HADDR ^ JMP NOROM OVERFLOW LDA CNT STA B,I SECOND WORD INB CPB HADDR JMP NOROM OVERFLOW STB LADDR JMP INT10 * INT11 LDA MADDR CLEAR FLAGS OF THOSE ADA D6 MODULES REFERENCED LDB A,I BY THIS MODULE CMB,INB STB TEMP1 SAVE NEG # EXT'S STA TEMP2 INT12 ISZ TEMP2 LDA TEMP2,I ADA D6 LDB A,I GET DEFN MODULE ADD SZB,RSS JMP INT13 UNDEFINED ADB D2 LDA B,I AND BYTE CLEAR FLAG IN LOW HALF STA B,I OF MODULE ENTRY WORD #3 INT13 ISZ TEMP1 JMP INT12 * INT14 ISZ CNT LDA MADDR ADA D3 LDA A,I SZA JMP INT9 * LDA PRLST CPA LADDR JMP EXIT HAD ONLY ONE MODULE SLCT1 LDA PRLST CLB STB UFLG SLCT2 STA PARNT SAVE ADD OF PARLIST ENTRY INA LDA A,I GET HIGH MODULE # ADA VECTR AND GET IT ITS ENTRY IN VECTR LDB A,I GET HIGH'S LEVEL # CPB LEVEL RSS JMP SLCT3 LDA PARNT,I GET LOW MODULE # ADA VECTR LDB LEVEL INB STB A,I SEj LEVEL # OF LOW TO LEVEL+1 ISZ UFLG SLCT3 LDA PARNT GET NEXT PARLIST ENTRY ADA D2 CPA LADDR RSS JMP SLCT2 LDA UFLG SZA,RSS JMP EXIT LDA LEVEL CPA D1000 JMP EXIT * INA STA LVL1 SET TO LEVEL+1 CLA,INA STA CNT CHK2 LDA VECTR ADA CNT CPA PRLST JMP CHK6 LDB A,I CPB LVL1 JMP CHK3 ISZ CNT JMP CHK2 * CHK3 STA TEMP1 LDA PRLST CHK4 STA PARNT LDA A,I CPA CNT = CURRENT MODULE INDEX? RSS JMP CHK5 NO, GO TO NEXT PAR LIST ENTR, LDA PARNT INA LDA A,I GET HIGH'S LEVEL # ADA VECTR LDA A,I LDB LVL1 CMB,INB ADB A SSB JMP CHK5 NO GET NEXT PARLIST ENTRY LDA D1000 STA TEMP1,I * CHK5 LDA PARNT ADA D2 CPA LADDR RSS JMP CHK4 ISZ CNT JMP CHK2 * CHK6 ISZ LEVEL JMP SLCT1 * EXIT LDA AMDT ISZ VECTR EX1 ADA D5 LDB VECTR,I STB A,I ISZ VECTR LDB VECTR CPB PRLST JMP LVLNM,I ADA M2 LDA A,I JMP EX1 * VECTR NOP PARNT NOP PRLST NOP LEVEL NOP LVL1 NOP NOTRM DEC 21 ASC 21, NOT ENOUGH SPACE TO COMPUTE LEVEL NUMBER * SKP * * MODULE CROSS REFERENCE * MREF NOP CLA STA CFLAG STA BFLAG JSB LIST EJECT PAGE DEF EJECT JSB LIST 'MODULE LEVEL MODULES WHERE USED' DEF HEAD5 JSB LIST '------------------------------------' DEF HEAD3 JSB BLINE BLANK OUT PRINT BUFFER LDA AMDT SZA,RSS JMP MREF,I NO MODULES IN LIST MXRF1 STA MADDR GET MODULE ENTRY & SAVE ADD LDB OBF1 MOVE MODULE JSB MVNAM OUTPUT BUFER STB @ADR LDA MADDR CONVERT LEVEL # TO ASCII ADA D5 LDA A,I STA CTR CPA D1000 STA CFLAG SET THE CIRCULAR REFERENCE FLAG * JSB CNUMD CONVERT LEVEL NUMBER TO DECIMAL DEF *+3 DEF CTR @ADR NOP ADDRESS OF 3-WORD ASCII STORAGE * LDB OBF8 STB CTR CLA STA UFLG LDA MADDR GET ADD OF FIRST ST ENTRY IN ADA D4 MODULES ENT LIST LDB A,I SZB JMP MXRF2 JSB BFOUT EMPTY ENT-LIST, PRINT MODULE NAME, & JMP NXTMD GET NEXT ONE MXRF2 STB ADDR ADB D5 GET ADD OF FIRST ENTRY IN LDA B,I SYMBOL'S W-U LIST SZA,RSS JMP NXTST EMPTY LIST,GO TO NEXT ST ENTRY SRCHW STA WUENT ISZ UFLG LDB A,I GET MODULE ENTRY ADD ADB D2 LDA B,I  HAS MODULE NAME BEEN PRINTED? SLA YET? JMP NXTWU YES ISZ B,I SET SO WON'T BE PRINTED AGAIN * LDA WUENT,I CMA,INA ADA MADDR CHECK FOR BACKWARD REFERENCE SSA,RSS JMP OK NO STA BFLAG SET THE BACKWARD REFERENCE FLAG LDA MARK STA CTR,I MARK THE OFFENDING MODULE * OK LDA WUENT,I FOR CURRENT MODULE LDB CTR INB JSB MVNAM STB CTR CPB ENDLN FULL BUFFER? RSS JMP NXTWU JSB BFOUT YES, DUMP IT LDB OBF8 STB CTR NXTWU LDA WUENT INA LDA A,I GET NEXT W-U ENTRY SZA JMP SRCHW CONTINUE NXTST LDA ADDR GET NEXT ST MOD-ENT LIST ENTRY ADA D3 LDB A,I SZB JMP MXRF2 CONTINUE LDA UFLG SZA,RSS JMP NXT0 LDA CTR NO MORE MOD-ENT LIST ENTRIES CPA OBF8 EMPTY OUTPUT BUFFER? RSS NXT0 JSB BFOUT NO, DUMP CONTENTS LDB AMDT NXT ADB D2 LDA B,I CLEAR OUT AND BYTE PRINT FLAGS STA B,I IN MODULE INB ENTRIES LDB B,I SZB JMP NXT NXTMD LDA MADDR GET NEXT MODULE TABLE ENTRY ADA D3 LDA A,I SZA JMP MXRF1 * * * CHECK FOR BACKWARD REFERENCES OR CIRCULAR REFERENCES. * PRINT A WARNING IF ANY WERE FOUND. * LDA CFLAG SZA,RSS JMP BREF? NO CIRCULAR REFERENCES * JSB LIST 'CIRCULAR REFERENCE' DEF CREF ISZ WARN * BREF? LDA BFLAG SZA,RSS JMP MREF,I NO BACKWARD REFERENCES * JSB LIST 'BACKWARD REFERENCE' DEF BREF ISZ WARN JMP MREF,I * * BREF DEC 12 ASC 12, ****BACKWARD REFERENCE * CREF DEC 12 ASC 12, ****CIRCULAR REFERENCE * WUENT NOP UFLG NOP CFLAG NOP BFLAG NOP MARK ASC 1, * OBF8  DEF OBUF+8 * SKP * * BINARY TO ASCII (DECIMAL) CONVERSION * * * D1000 DEC 1000 D1 DEC 1 * SKP * * ENTRY CROSS REFERENCE * XREF NOP JSB LIST EJECT PAGE DEF EJECT CLA STA EFLG DO ENTRY XREF FIRST JSB LIST 'ENTRY DEFN-MOD MODULES WHERE USED' DEF HEAD6 JMP XRF1 * UNRSD STA UFLG INA STA EFLG JSB LIST EJECT PAGE DEF EJECT JSB LIST 'UNRESOLVED EXT MODULES WHERE USED' DEF HEAD7 XRF1 JSB LIST '-------------------------------------' DEF HEAD3 JSB BLINE LDB ASYMT SZB,RSS JMP XREF,I NO ENTRIES IN LIST XRF2 STB ADDR GOT ST ENTRY AND SAVE ADD ADB D6 LDA B,I IS SYMBOL DEFINED? LDB EFLG SZA,RSS JMP UNDCH NO SZB JMP NXTE LDB OBF5 YES-MOVE NAME TO OUTPUT BUFFER JSB MVNAM INB STB CTR XRF3 LDB OBF1 AND MOVE SYMBOL NAME TO OBUF LDA ADDR JSB MVNAM LDA ADDR GET FIRST ENTRY ADA D5 IN SYMBOL'S W-U LIST LDB A,I SZB,RSS JMP NXTE1 EMPTY W-U LIST SCHWU STB MADDR SAVE ENTRY ADDRESS LDA B,I GET ADD OF W-U MODULE LDB CTR MOVE NAME TO JSB MVNAM OBUF CPB ENDLN FULL BUFFER? RSS JMP NXTE0 JSB BFOUT LDB MPTBF NXTE0 STB CTR LDA MADDR INA LDB A,I GET NEXT W-U ENTRY SZB JMP SCHWU AND CONTINUE LDA CTR NO MORE CPA MPTBF EMPTY BUFFER? RSS NXTE1 JSB BFOUT NO NXTE LDA ADDR GET NEXT ST ENTRY ADA D4 LDB A,I SZB JMP XRF2 AND CONTINUE LDA EFLG NO MORE? SZA,RSS ALL DONE? JMP UNRSD NO,DO UNDEFS XREF ISZ UFLG WERE THERE ANY UNRES'D EXTS? RSS JMP XREF,I YES JSB BLINE LDB OBF1 LDA NOENT JSB MVNAM JSB BFOUT PRINT A 0 JMP XREF,I RETURN * UNDCH SZB,RSS ARE WE PROCESSING UNDEFS? JMP NXTE NO LDB MPTBF YES,SET CTR TO APPROPRIATE STB CTR POSITION IN OBUF CCA STA UFLG JMP XRF3 * * NOENT DEF *+1 ASC 3, 0 SPC 2 * EJECT DEC 1 ASC 1,1 PAGE EJECT IF LINE PRINTER SPC 2 SKP * * HEADINGS * OUT DEC 40 MUST PRECEDE OBUF -- OBUF MUST BE 50 WORDS OBUF EQU * LAST 10 WORDS MAY CONTAIN NAM RECORD * COMMENTS WHICH ARE NOT PRINTED. HEAD0 DEC 26 ASC 26, 24999-16051 2024 SOFTWARE SERVICE KIT SYSTEM HEAD1 DEC 26 ASC 26, MODULE MODULE SIZE (OCTAL) * HEAD2 DEC 23 ASC 23, NAME MODULE IDENT. BPAG MAIN COMM * HEAD3 DEC 28 ASC 28, -------------------------------------------------------- * HEAD5 DEC 18 ASC 18, MODULE LEVEL MODULES WHERE USED * HEAD6 DEC 18 ASC 18, ENTRY DEFN-MOD MODULES WHERE USED * HEAD7 DEC 18 ASC 18, UNRESOLVED EXT MODULES WHERE USED * * CONSTANTS * B40 OCT 40 B377 OCT 377 B60 OCT 60 B77 OCT 77 B400 OCT 400 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 B7 EQU * D7 DEC 7 D17 DEC 17 D40 DEC 40 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M7 DEC -7 AMDT NOP ADDRESS OF MODULE TABLE ASYMT NOP ADDRESS OF SYMBOL TABLE CMD1 NOP LENGTH OF CURRENT COMMAND MADDR NOP ADD OF CURRENT MOD TABLE ENTRY ADDR NOP ADD OF CURRENT SYM TABLE ENTRY HADDR NOP LWAM LADDR NOP MODULE TABLE STARTS HERE - FWAM TTYFL DEC -1 TTY FLAG:-1 IF INTERACTIVE INPUT, 0 OTHERWISE. LUTTY NOP LU OF OPERATOR CONSOLE LUIN NOP LU OF OPERATOR CONSOLE + E CHO BIT * SKP * DCBC BSS 144 COMMAND DCB DCBL BSS 144 LIST DCB #DCB BSS 144 BINARY INPUT DCB CMDBF BSS 40 COMMAND INPUT BUFFER END RXREF EQ M"p 24999-18069 1752 S 0100 CMM3: MEMORY/DISC ACCESS AND MODIFICATION             H0101 FTN4,L,C PROGRAM CMM3 (3,90) C C C MIKE MANLEY REVISION 2 C C DIMENSION IPBUF(33),LU(5),IBUF(25),IREG(2),IMESS5(6),IDP(22) DIMENSION IMESS0(8),IMESS1(9),IMES11(6),IMESS3(6),IMESS7(7) DIMENSION IMESS2(11),IWHAT(6),IMESS8(11),IPRAM(6),IVALU2(13) DIMENSION IARRAY(64),IDISC(26),MDISK(10),IVALUE(9),ITEL33(28) DIMENSION IEXT(4),ITEL22(14),ITEL23(20),ITEL24(17),ITEL25(22) DIMENSION IX(8),I1(11),I2(13),I3(12),I4(9),I5(13),I6(12) DIMENSION I7(9),I9(14),IG(11),IH(11),IJ(11),IK(9),IOUT(7) DIMENSION IL(12),IO(15),IP(16),IQ(17),IR(21),IDI(28),MEMR(7) DIMENSION IN(8),IM(22),IPACK(23),MORUSE(8),ITEL30(5),ITEL31(17) DIMENSION ITEL1(9),ITEL2(9),ITEL3(16),ITEL4(5),ITEL5(19),ITEL6(12) DIMENSION ITEL7(6),ITEL8(5),ITEL9(23),ITEL10(5),ITEL11(26) DIMENSION ITEL12(7),ITEL13(11),ITEL14(22),ITEL15(11),ITEL16(16) DIMENSION ITEL17(13),ITEL18(17),ITEL19(6),ITEL20(6),ITEL21(6) DIMENSION IGTOUT(27),ITAT(12),ISYS(5),IAUX(5),LDISC(5),IABS(7) DIMENSION IT(17),ITEL26(2),ITEL27(5),ITEL28(13),ITEL34(13) DIMENSION IPR(14),ILE(17),ITEL35(2),IGO(27),IRP(6) DIMENSION IPG(19),ITEL36(13) EQUIVALENCE(IREG,REG,IA),(IREG(2),IB) EQUIVALENCE(IPBUF(2),IPRS1),(IPBUF(6),IPRS2),(IPBUF(10),IPRS3) EQUIVALENCE(IPBUF(14),IPRS4),(IPBUF(18),IPRS5) C DATA IMESS1/2H ,2HID,2H S,2HEG,2H O,2HF / DATA MEMR/2H ,2HME,2HM ,2HRE,2HS ,2HPR,2HOG/ DATA IEXT/2H ,2HEX,2HTE,2HNT/ DATA IVALUE/2H ,2HWO,2HRD,2H ,,2H V,2HAL,2HUE,2H ,2H / DATA IVALU2/2H ,2HLU,2H,T,2HRK,2H,S,2HEC,2HTR,2H,W,2HOR, & 2HD,,2HVA,2HLU,2HE / DATA MDISK/2H ,2HMO,2HDI,2HFY,2H O,2HP ,2HSY,2HST,2HEM,2H ?/ DATA IGTOUT/2H ,2HDI,2HSC,2H M,2HOD,2H !,2H ,2HEN,2HTE,2HR , & 2HA ,2H/D,2H A,2HT ,2HAN,2HY ,2HTI,2HME,2H T,2HO , & 2HEX,2HIT,2H T,2HHI,2HS ,2HMO,2HDE/ DATA IWHAT/2H ,2HSA,2HY ,2HWH,2HAT,2H ?/ DATA IMESS2/2H ,2HEQ,2HT ,2H# ,2H ,2H ,2H ,2H ,2HDV,2HR / DATA IMES11/2H ,2HNO,2HT ,2HFO,2HUN,2HD / DATA IMESS3/2H ,2HDR,2HT ,2HPA,2HRT,2H / DATA IMESS5/2H ,2HIN,2HT ,2HTA,2HBL,2HE / DATA IMESS0/2H ,2H =,2HCM,2HM3,2H D,2HON,2HE ,2H! / DATA IBUF/2H24,2H99,2H9-,2H16,2H05,2H2 ,2H17,2H52,2H S,2HOF, & 2HTW,2HAR,2HE ,2HSE,2HRV,2HIC,2HE ,2HKI,2HT ,2HSY, & 2HST,2HEM,2H 1,2H00,2H0 / DATA IMESS7/2H ,2HYE,2HS ,2HOR,2H N,2HO ,2H? / DATA IMESS8/2HIN,2HT ,2HTA,2HBL ,2HE ,2HST,2HAR,2HTS, & 2H A,2HT ,2H6./ DATA IDISC/2H ,2HLU,2H =,2H ,2H ,2H ,2HTR,2HK ,2H= , & 2H ,2H ,2H ,2HSE,2HCT,2HR ,2H= ,2H ,2H ,2H , & 2H ,2HWO,2HRD,2H =,2H ,2H ,2H / DATA IOUT/2H ,2HOU,2HT ,2HOF,2H R,2HAN,2HGE/ DATA ITEL1/2H ,2HID,2H,P,2HRO,2HGR,2HAM,2H N,2HAM,2HE / DATA ITEL2/2H ,2HID,2H,S,2HEG,2HME,2HNT,2H N,2HAM,2HE / DATA ITEL3/2H ,2HID,2H,N,2HUM,2HBR,2H =,2H A,2HLL,2H I, & 2HD',2HS ,2HIN,2H S,2HYS,2HTE,2HM / DATA ITEL4/2H ,2HEQ,2H,N,2HUM,2HBR/ DATA ITEL5/2H ,2HEQ,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HEQ,2HTS,2H I,2HNC,2HLU,2HSI, & 2HVE/ DATA ITEL6/2H ,2HLM,2H,A,2HDD,2HRE,2HSS,2H,#,2H O,2HF , & 2HWO,2HRD,2HS / DATA ITEL7/2H ,2HLM,2H,A,2HDD,2HRE,2HSS/ DATA ITEL8/2H ,2HDR,2H,N,2HUM,2HBR/ DATA ITEL9/2H ,2HDR,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HDR,2HT ,2HEN,2HTR,2HIE,2HS , & 2HIN,2HCL,2HUS,2HIV,2HE / DATA ITEL10/2H ,2HIN,2H,N,2HUM,2HBR/ DATA ITEL11/2H ,2HIN,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HIN,2HT ,2HTA,2HBL,2HE ,2HEN, & 2HTR,2HIE,2HS ,2HIN,2HCL,2HUS,2HIV,2HE / DATA ITEL12/2H ,2HLL,2H,L,2HIS,2HT ,2HLU,2H# / DATA ITEL13/2H ,2HPM,2H,A,2HDD,2HRE,2HSS,2H,N,2HEW, & 2H V,2HAL,2HUE/ DATA ITEL14/2H ,2HF/,2H,V,2HAL,2HUE,2H T,2HO ,2HFI,2HND, & 2H,S,2HTA,2HRT,2H A, & 2HDD,2HRE,2HSS,2H,#,2H O,2HF ,2HWO,2HRD,2HS / DATA ITEL15/2H ,2HLI,2H,E,2HNT,2HRY,2H P,2HOI,2HNT,2H N, & 2HAM,2HE / DATA ITEL16/2H ,2HDL,2H,L,2HU,,2HTR,2HK,,2HSE,2HCT,2HR,, & 2H #,2H O,2HF ,2HSE,2HCT,2HOR,2HS / DATA ITEL17/2H ,2HDS,2H,L,2HU,,2HTR,2HK,,2HVA,2HLU,2HE , & 2HTO,2H F,2HIN,2HD / DATA ITEL26/2H ,2HTA/ DATA ITEL27/2H ,2HTA,2H,L,2HU ,2H# / DATA ITEL28/2H ,2HTA,2H,L,2HU ,2H#,,2HTR,2HK ,2H#,, & 2H #,2H O,2HF ,2HTR,2HKS/ DATA ITEL18/2H ,2HDM,2H ,2H ,2HDI,2HSC,2H M,2HOD,2H , & 2H ,2H / DATA ITEL19/2H ,2HEX,2H ,2H ,2HEX,2HIT/ DATA ITEL20/2H ,2HEN,2H ,2H ,2HEX,2HIT/ DATA ITEL21/2H ,2H/E,2H ,2H ,2HEX,2HIT/ DATA ITEL22/2H ,2HXL,2H,A,2HDD,2HRE,2HSS,2H ,2H ,2H(S, & 2HYS,2HTE,2HM ,2HMA,2HP)/ DATA ITEL23/2H ,2HXL,2H,A,2HDD,2HRE,2HSS,2H,#,2H O,2HF , & 2HWO,2HRD,2HS ,2H ,2H(S,2HYS,2HTE,2HM ,2HMA, & 2HP)/ DATA ITEL24/2H ,2HXP,2H,A,2HDD,2HRE,2HSS,2H,V,2HAL,2HUE, & 2H ,2H ,2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA ITEL25/2H ,2HXF,2H,V,2HAL,2HUE,2H T,2HO ,2HFI,2HND, & 2H,S,2HTA,2HRT,2H A,2HDD,2HRE,2HSS,2H,#,2H O, & 2HF ,2HWO,2HRD,2HS / DATA ITEL30/2H ,2HDP,2H,V,2HAL,2HUE/ DATA ITEL31/2H ,2HTR,2H,S,2HTA,2HRT,2H L,2HOC,2HAT,2HIO,2HN,, &2HLI,2HST,2H D,2HEL,2HIM,2HIT,2HER/ DATA ITEL33/2H ,2HDI,2H,E,2HNT,2HRY,2H P,2HOI,2HNT,2H N,2HAM, &2HE / DATA ITEL34/2H ,2HLP,2H,P,2HRO,2HG ,2HNA,2HME,2H,R,2HEL, &2H A,2HDD,2HRE,2HSS/ DATA ITEL35/2H ,2HLE/ DATA ITEL36/2H ,2HPG,2H, ,2HPG,2H#,,2H# ,2HOF,2H W,2HOR,2HDS, &2H,O,2HFS,2HET/ DATA IX/2H I,2HNP,2HUT,2H ,2HFU,2HNC,2HTI,2HON/X DATA I1/2H ,2HID,2H ,2HLI,2HST,2H I,2HD ,2HSE,2HGM,2HEN,2HT / DATA I2/2H ,2HEQ,2H ,2HLI,2HST,2H E,2HQT,2H A,2HND,2H E,2HXT, & 2HEN,2HTS/ DATA I3/2H ,2HDR,2H ,2HLI,2HST,2H D,2HEV,2H R,2HEF,2H T,2HAB, & 2HLE/ DATA I4/2H ,2HLM,2H ,2HLI,2HST,2H M,2HEM,2HOR,2HY / DATA IP/2H ,2HXL,2H ,2HLI,2HST,2H M,2HEM,2HOR,2HY ,2H , & 2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA I5/2H ,2HIN,2H ,2HLI,2HST,2H I,2HNT,2HER,2HUP,2HT ,2HTA, & 2HBL,2HE / DATA I6/2H ,2HLL,2H ,2HCH,2HAN,2HGE,2H L,2HIS,2HT ,2HDE,2HVI, & 2HCE/ DATA I7/2H ,2HPM,2H ,2HPA,2HTC,2HH ,2HME,2HMO,2HRY/ DATA IQ/2H ,2HXP,2H ,2HPA,2HTC,2HH ,2HME,2HMO,2HRY,2H ,2H , & 2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA I9/2H ,2HF/,2H ,2HFI,2HND,2H A,2H V,2HAL,2HUE,2H I,2HN , & 2HME,2HMO,2HRY/ DATA IR/2H ,2HXF,2H ,2HFI,2HND,2H A,2H V,2HAL,2HUE,2H I,2HN , & 2HME,2HMO,2HRY,2H ,2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA IG/2H ,2HLI,2H ,2HLI,2HST,2H E,2HNT,2HRY,2H P,2HOI,2HNT/ DATA IDI/2H ,2HDI,2H ,2HRE,2HPO,2HRT,2H D,2HIS,2HC ,2HDI,2HCT, &2HIO,2HNA,2HRY,2H A,2HDD,2HRE,2HSS,2H O,2HF ,2H A,2HN ,2HEN,2HTR, &2HY ,2HPO,2HIN,2HT / DATA ILE/2H ,2HLE,2H ,2HLI,2HST,2H A,2HLL,2H E,2HNT,2HRY, &2H P,2HOI,2HNT,2HS ,2HIN,2H S,2HYS/ DATA IH/2H ,2HDL,2H ,2HLI,2HST,2H D,2HIS,2HC ,2HSE,2HCT,2HOR/ DATA IJ/2H ,2HDM,2H ,2HDI,2HSC,2H M,2HOD,2H ,2HAN,2HY ,2HLU/ DATA IK/2H ,2HDS,2H ,2HDI,2HSC,2H S,2HEA,2HRC,2HH / DATA IL/2H ,2H/E,2H O,2HR ,2HEN,2H O,2HR ,2HEX,2H T,2HO , &2HEX,2HIT/ DATA IDP/2H ,2HDP,2H ,2HDI,2HSP,2HLA,2HY ,2HIN,2HPU,2HT , &2HIN,2H O,2HCT,2HAL,2H D,2HEC,2HIM,2HAL,2H &,2H A,2HSC,2HII/ DATA IN/2H ,2HTR,2H ,2HTR,2HAC,2HE ,2HLI,2HST/ DATA IPG/2H ,2HPG,2H ,2HLI,2HST,2H A,2HNY,2H L,2HOC,2HAT,2HIO, &2HN ,2HIN,2H P,2HHY,2HS ,2HME,2HMO,2HRY/ DATA IM/2H ,2HXT,2H ,2HTR,2HAC,2HE ,2HLI,2HST,2H (,2HSY, &2HST,2HEM,2H M,2HAP,2H) / DATA IPR/2H ,2HLP,2H ,2HLI,2HST,2H D,2HIS,2HC ,2HRE,2HS , &2HPR, 2HOG,2HRA,2HM / DATA IPACK/2H ,2HA ,2HPK,2H A,2HFT,2HER,2H T,2HHE,2H I,2HNP, &2HUT,2H G,2HIV,2HES,2H A,2H P,2HAC,2HKE,2HD ,2HLI,2HST,2HIN, &2HG / DATA MORUSE/2H ,2HOR,2H U,2HSE,2H ,2H ,2HPK,2H, / DATA IT/2H ,2HTA,2H ,2HLI,2HST,2H T,2HRA,2HCK,2H A,2HSS, &2HIG,2HNM,2HEN,2HT ,2HTA,2HBL,2HE / DATA IO/2H ,2HFO,2HR ,2HMO,2HRE,2H I,2HNF,2HO ,2HDO,2H A, & 2H ?,2H?,,2HIN,2HPU,2HT / DATA ITAT/2H ,2HTR,2HAC,2HK ,2HAS,2HSI,2HGN,2HME,2HNT, &2H T,2HAB,2HLE/ DATA ISYS/2H ,2HSY,2HS ,2HDI,2HSC/ DATA IAUX/2H ,2HAU,2HX ,2HDI,2HSC/ DATA IRP/2H ,2HRP,2H / DATA LDISC/2H ,2HDI,2HSC,2H R,2HES/ DATA IABS/2H ,2HAB,2HS ,2H / DATA IGO/2HID,2HEQ,2HDR,2HXL,2HLM,2HIN,2HLL,2HPM,2HXP,2HF/, & 2HXF,2HLI,2HDI,2HLE,2HDL,2HDM,2HDS,2HTA,2HTR,2HXT, & 2HDP,2HLP,2H??,2H/E,2HEX,2HEN,2HPG/ C CALL RMPAR(LU) LU1=LU IF(LU1.EQ.0) LU1=1 LU2 = LU1+200B C CALL EXEC(2,LU1,IBUF,25) C IPRMPT = 2H= C C SET UP THE IPRAM BUFFER. THIS BUFFER IS USED BY THE I/O C SUBROUTINES (DOIO & DISC3) TO DETERMINE HOW THE I/O IS C TO BE DONE. C 1 IPRAM = 1 IPRAM(2) = 0 IPRAM(3) = 0 IPRAM(4) = 0 IPRAM(5) = 0 IPRAM(6) = -1 CALL EXEC(2,LU1+ 2000B,IPRMPT,-2) REG = REIO(1,LU1 + 400B,IBUF,17) CALL PARSE(IBUF,IB*2,IPBUF) C SEE IF THE PACKED FORM OF THE OUTPUT IS DESIRED IF(IPBUF(3).EQ.2HPK) IPRAM(5) = 1 C C C FIND OUT WHICH COMMAND IT WAS C C DO 20 I = 1,27 IF(IPRS1.EQ.IGO(I)) GO TO(100,200,300,400,410,500,600,710,700, &810,800,900,900,900,1000,1100,1400,1500,1610,1600,1700,100,9000, &50,50,50,1900) I 20 CONTINUE C C C ILLEGAL COMMAND C C 25 CALL EXEC(2,LU1,IWHAT,V^-12) GO TO 1 30 CALL EXEC(2,LU1,IOUT,7) GO TO 1 50 CALL EXEC(2,LU1,IMESS0,-16) CALL EXEC(6,0) C C C **********GET ID SEGMENT INFO************** 100 KYWORD = IGET(1657B) -1 IF(IPBUF(5).EQ.1) GO TO 175 C C 150 DO 170 I = 1,257 KYWORD = KYWORD +1 IF(IGET(KYWORD).EQ.0) GO TO 190 IF(((IPRS2.EQ.IGET(IGET(KYWORD)+12)).AND. & (IPBUF(7).EQ.IGET(IGET(KYWORD)+13))).AND. & (IPBUF(8).EQ.IOR(IAND(IGET(IGET(KYWORD)+14),177400B),40B))) & GO TO 176 170 CONTINUE 175 KYWORD = KYWORD +1 IF(IPRAM(3).EQ.9999) GO TO 1 IF(IGET(KYWORD).EQ.0) GO TO 1 IF(IGET(IGET(KYWORD)+12).NE.0) GO TO 176 IMESS1(7) = 2H GO TO 180 176 IMESS1(7) = IGET(IGET(KYWORD)+12) IMESS1(8) = IGET(IGET(KYWORD)+13) IMESS1(9) = IGET(IGET(KYWORD)+14) C 180 ISTART = IGET(KYWORD) ISTOP = ISTART +27 ITEMP = IAND(IGET(IGET(KYWORD) +14),17B) ITEMP1= IAND(IGET(IGET(KYWORD) +14),20B) IF(ITEMP1.EQ.20B) ISTART= IGET(KYWORD) +11 IF(ITEMP1.EQ.20B) ISTOP = ISTART + 8 IF(ITEMP.EQ.1) ISTOP = ISTART + 21 C C SEE IF THIS IS 'ID' OR 'PL' COMMAND C IF(IPRS1 .EQ.2HLP) GO TO 1800 C C 'ID' COMMAND, SO GIVE HIM THE ID SEGMENT !! CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IMESS1,-17) CALL DOIO(ISTART,ISTOP,LU2,IPRAM) IF(IPBUF(5).EQ.1) GO TO 175 GO TO 1 190 CALL EXEC(2,LU1,IMES11,-12) GO TO 1 C C C **********GET EQT INFO************* C C 200 IEQTA = IGET(1650B) IEQTNO = IGET(1651B) IF(IPRS3 .GT. IEQTNO) IPRS3 = IEQTNO IF(IPRS2.GT.IEQTNO) GO TO 25 IF(IPRS2.LT. 1) IPRS2 = 1 C C DO 210 I = IPRS2,IPRS3 IF(IPRAM(3) .EQ. 9999) GO TO 1 ISTART = IEQTA + (I - 1)*15 CALL CNUMD(I,IBUF(2)) IMESS2(4) = IBUF(4) IBUF = (IAND(IGET(ISTART+4),37400B)/256) IBUF = IBU{F + 2*(IBUF/8) CALL CNUMD(IBUF,IBUF(2)) C INSERT A 0 SO DVR00 DOESNT LOOK LIKE DVR 0 IF (IAND(IBUF(4),177400B).EQ.20000B) IBUF(4) = IBUF(4) + 10000B IMESS2(11) = IBUF(4) C CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IMESS2,11) CALL DOIO(ISTART,ISTART +14,LU2,IPRAM) C C C GET THE DISC ADDRESS OF THE EQT CALL DTRK(ISTART+11,ITRK,ISECTR,IWORD,ISTOP,IARRAY) C GET THE SECTOR CALL EXEC(1,102B,IARRAY,64,ITRK,ISECTR) C IF IT IS DVR00 THERE ARE NO EXTENTS C IF # OF EXTENT WORDS IS NEG THERE ARE NO EXTENTS IF((IARRAY(IWORD).LT.1).OR.(IBUF(4).EQ.30060B)) GO TO 210 IDRT = IARRAY(IWORD) C NOW GET THE ADDRESS OF THE EXTENT CALL DTRK(ISTART+12,ITRK,ISECTR,IWORD,ISTOP,IARRAY) CALL EXEC(1,102B,IARRAY,64,ITRK,ISECTR) C IF ADDRESS OF EXTENT IS NEG THERE ARE NO EXTENTS IF(IARRAY(IWORD).LT.1) GO TO 210 C C CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IEXT,4) CALL DOIO(IARRAY(IWORD),IARRAY(IWORD)+IDRT-1,LU2,IPRAM) 210 CONTINUE GO TO 1 C C C C **********GET DEVICE REF TABLE************** C 300 IDRT = IGET(1652B) LUMAX = IGET(1653B) IMESS3(6) = 61B C C CALL EXEC(2,LU2,IMESS3,6) IF(IPRS3.GT.LUMAX) IPRS3 = LUMAX IF(IPRS2.LE.0) IPRS2 = 1 CALL DOIO(IDRT + IPRS2-1,IDRT + IPRS3-1,LU2,IPRAM) IMESS3(6) = 62B CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IMESS3,6) CALL DOIO(IDRT+IPRS2-1+LUMAX,IDRT+IPRS3-1+LUMAX,LU2,IPRAM) GO TO 1 C C C C ***********LIST ANY MEMORY LOCATION REQUESTED**************** C C 400 IPRAM(4) = -1 IF((IPRS2.LT.0).OR.(IPRS3+IPRS2-1.LT.0)) GO TO 30 410 CALL DOIO(IPRS2,IPRS2+IPRS3-1,LU2,IPRAM) GO TO 1 C C C *************GET THE INTERUPT TABLE***************** C C 500 INTBA = IGET(1654B) INTLG = IGET(1655B) C C IF(IPRS2.LT.6) GO TO 550 CALL EXEC(2,LU2,IMESS5,-12) IF(I<PRS3.GT.INTLG) IPRS3 = INTLG IF(IPRS2.LE.0) IPRS2 = 1 ISTART = INTBA + IPRS2 -6 ISTOP = INTBA +IPRS3 -1 IPRAM = IPRS2 IPRAM(2) = 1 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) GO TO 1 550 CALL EXEC(2,LU1,IMESS8,-22) GO TO 1 C C C C ***********CHANGE OUTPUT LU*************** C C 600 LU2 = IPRS2 + 200B GO TO 1 C C C C ***********PATCH MEMORY ANY MEMORY LOCATION**************** C 700 IPRAM(4) = -1 710 CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) CALL EXEC(2,LU1,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) C IF YOU CHANGE YOUR MIND THIS IS THE ESCAPE ROUTE IF(IPBUF(7).NE.2HYE) GO TO 1 IF(IPRAM(4).EQ.0)CALL IPUT(IPRS2,IPRS3) IF(IPRAM(4).EQ.-1)CALL XPUT(IPRS2,IPRS3) CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) GO TO 1 C C C*******FIND A WORD BETWEEN GIVEN LIMITS IN MEMORY******** C 800 IPRAM(4) = -1 810 IF((IPRS3.LT.0).OR.(IPRS3+IPRS4-1.LT.0)) GO TO 30 DO 850 I = IPRS3,IPRS3+IPRS4-1 IF((IGET(I).EQ.IPRS2).AND.(IPRAM(4).EQ.0)) GO TO 820 IF((IXGET(I).EQ.IPRS2).AND.(IPRAM(4).EQ.-1)) GO TO 820 GO TO 850 820 CALL DOIO(I,I,LU2,IPRAM) IF(IPRAM(3).EQ.9999) GO TO 1 IPRAM(3) = 1 IPRAM = IPRAM + 1 850 CONTINUE IF(IPRAM(3).EQ.0) GO TO 190 GO TO 1 C C C*******FIND ADDRESS OF SELECTED SYSTEM ENTRY POINTS******** C C C C C C 900 ITRK = IGET(1761B)/128 ISECTR = IAND(IGET(1761B),177B)-1 DO 993 I = 1,IGET(1762B)/16 + 1 ISECTR = ISECTR + 1 IF(ISECTR.NE.96) GO TO 910 ISECTR = 0 ITRK = ITRK + 1 910 CALL EXEC(1,102B,IARRAY,64,ITRK,ISECTR) DO 992 J = 1,64,4 IF(IFBRK(IDUMY))1,911 911 IF(IPRS1.EQ.2HLE) GO TO 965 IF(((IARRAY(J).EQ.IPBUF(6)).AND.(IARRAY(J+1).EQ.IPBUF(7))).AND. &(IOR(IAND(IARRAY(J+2),177400B),40B).EQ.IPBUF(8))) GO TO 970 GO TO 992 C 965 CALL EXEC(2,LU2,IARRAY(J),-5) C C C 970 IF(I/PRS1.EQ.2HDI) GO TO 995 MYTYPE = IAND(IARRAY(J+2),177B) + 1 GO TO (975,980,190,985,990) MYTYPE C C 975 CALL DOIO(IARRAY(J+3),IARRAY(J+3),LU2,IPRAM) IF(IPRAM(3).EQ.9999) GO TO 1 IPRAM(3) = 1 IPRAM = IPRAM + 1 GO TO 991 C C 980 CALL EXEC(2,LU2,LDISC,5) IDISC(6) = 2H CALL CNUMD((IARRAY(J+3)/128),IDISC(9)) CALL CNUMD(IAND(IARRAY(J+3),177B),IDISC(17)) CALL EXEC(2,LU2,IDISC(6),14) GO TO 991 C C C 985 CALL CNUMO(IARRAY(J+3),IABS(5)) CALL EXEC(2,LU2,IABS,7) GO TO 991 C C 990 CALL CNUMO(IARRAY(J+3),IRP(4)) CALL EXEC(2,LU2,IRP,6) C 991 IF(IPRS1.EQ.2HLI) GO TO 1 992 CONTINUE 993 CONTINUE IF(IPRS1.EQ.2HLE) GO TO 1 GO TO 190 C 995 IPRAM = 0 CALL DISC3(2,ITRK,ISECTR,J,IARRAY,IPRAM,LU2,IDISC) GO TO 1 C C C********LOOK AT ANY DISC LOCATION************ 1000 DO 1050 J = 1,IPRS5 CALL EXEC(1,IPRS2 + 100B,IARRAY,64,IPRS3,IPRS4) CALL DISC3(IPRS2,IPRS3,IPRS4,IPRAM,IARRAY,IPRAM,LU2,IDISC) IF(IPRAM(3).EQ.9999) GO TO 1 IPRS4 = IPRS4 + 1 IF(IPRS4.LT.96) GO TO 1050 IPRS4 = 0 IPRS3 = IPRS3 + 1 1050 CONTINUE GO TO 1 C C C C*************MODIFY OP SYSTEM ON THE DISC**************** C C C 1100 CALL EXEC(2,LU1,IGTOUT,27) CALL EXEC(2,LU1,MDISK,10) CALL EXEC(2,LU1+2000B,IMESS7,7) REG = REIO(1,LU1+400B,IBUF,1) IF(IBUF.EQ.2H/D) GO TO 1 IF(IBUF.NE.2HYE) GO TO 1150 C C C C ASK FOR THE LOCATION AND REPLACEMENT VALUE C 1125 CALL EXEC(2,LU1+2000B,IVALUE,9) REG = REIO(1,LU1 +400B,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IF(IPBUF.EQ.2) GO TO 1 IFIX = IPRS2 ILU = 2 INULL = IPBUF(5) C CALL DTRK(IPRS1,ITRK,ISECTR,IWORD,ISTOP,IARRAY) C SEE IF WORD IS BEYOND ACTUAL OP SYSTEM SIZE C IF(IPRS1.GT.ISTOP) GO TO 30 C ASSIGN 1125 TO ILABEL C GO TO 1210 C C C** THIS SECTION ALLOWS MODIFICATION OF ANY DISC** C C 1150 CALL EXEC(2,LU1+2000B,IVALU2,13) REG=REIO(1,LU1+400B,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IF(IPBUF.EQ.2) GO TO 1 ILU= IPRS1 ITRK= IPRS2 ISECTR = IPRS3 IWORD = IPRS4 IF(IWORD .LE. 0 ) GO TO 25 IFIX = IPBUF(18) INULL = IPBUF(17) C ASSIGN 1150 TO ILABEL C C 1210 CALL EXEC(1,ILU+100B,IARRAY,64,ITRK,ISECTR) IPRAM = 0 CALL DISC3(ILU,ITRK,ISECTR,IWORD,IARRAY,IPRAM,LU2,IDISC) C IF (INULL.EQ.0) GO TO ILABEL CALL EXEC(2,LU1+2000B,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) IF(IPBUF(7).EQ. 2H/D) GO TO 1 IF(IPBUF(7).NE. 2HYE) GO TO ILABEL C C C C LETS GO MODIFY THE TRACK ASSIGNMENT TABLE SO WE CAN WRITE C ON SYSTEM TRACKS. C 1300 LUTYP = 0 IF(ILU.EQ.3) LUTYP = IGET(1756B) ITAT = IGET(1656B) + ITRK +LUTYP IARRAY(IWORD) = IFIX ISTART = IGET(ITAT) IF(ILU.LT.4)CALL IPUT(ITAT,IGET(1717B)) C !!!!!PATCH DISC!!!!!! CALL EXEC(100002B,ILU+100B,IARRAY,64,ITRK,ISECTR) GO TO 1310 C C FIX TRACK ASSIGNMENT TABLE 1310 IF(ILU.LT.4)CALL IPUT(ITAT,ISTART) C C C C INULL = 0 GO TO 1210 C C C C C***THIS SECTION WILL SEARCH A TRACK FOR ALL OCCURRENCES OF A *** C*** GIVEN VALUE. USE THIS SECTION TO UNPURGE A FILE. *** C*** HINT ! IF YOU UNPURGE DON'T FORGET THE EXTENTS OR YOU WILL *** C*** DEVELOP A FMGR -005 ERROR . C C C 1400 DO 1450 I =0,95 CALL EXEC(1,IPRS2 + 100B,IARRAY,64,IPRS3,I) DO 1425 J = 1,64 IF(IARRAY(J).NE.IPRS4) GO TO 1425 CALL CNUMD(I,IDISC(17)) CALL CNUMD(J,IDISC(24)) CALL EXEC(2,LU2,IDISC(12),15) 1425 CONTINUE 1450 CONTINUE GO TO 1 C C*********** PRINT OUT THE TRACK ASSIGNMENT TABLE ****************** C 1500 CALL EXEC(2,LU2,ITAT,12) IPRAM = 0 IF((IPRS2.GT.3).OR.(IPRS2.LT.0)) GO TO 25 C GET *# OF TRACKS ON AUX DISC INEED =-( IGET(1755B))- IGET(1756B) C GET STOP ADDRESS OF TAT FOR SYS DISC ISTOP = IGET(1656B) + IGET(1756B) - 1 IF (IPRS2 .EQ. 3) GO TO 1510 C PRINT OUT SYS DISC TRACK ASSIGNMENTS CALL EXEC(2,LU2,ISYS,5) C IF(IPRS3.EQ.0) GO TO 1505 IPRAM = IPRS3 C ISTART = IGET(1656B) + IPRS3 IF(ISTART .GT. ISTOP ) GO TO 25 IF(ISTART+IPRS4-1.LT.ISTOP)ISTOP=ISTART+IPRS4-1 1505 CALL DOIO(IGET(1656B)+IPRS3,ISTOP,LU2,IPRAM) C C IF(IPRAM(3).EQ.9999) GO TO 1 1510 IF(IPRS2.EQ.2) GO TO 1 IF (INEED .EQ.0 ) GO TO 1 C CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IAUX,5) ISTART = ISTOP + 1 + IPRS3 ISTOP = ISTOP + INEED IF(ISTART .GT.ISTOP) GO TO 25 IF(IPRS3 .EQ. 0 ) GO TO 1520 IPRAM = IPRS3 IF(ISTART+IPRS4-1 .LT. ISTOP)ISTOP = ISTART+IPRS4-1 1520 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) IF(IPRAM(3) .EQ. 9999) GO TO 1 GO TO 1 C C C******************* TRACE A LIST IN ANY MAP ************************** C 1600 IPRAM(4) = -1 1610 IF((IPRS2 .LT.1).OR. (IPRS2 .EQ.IPRS3)) GO TO 1 CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) IPRAM(3) = 1 IF(IPRAM(4).EQ.0) IPRS2 = IGET(IPRS2) IF(IPRAM(4).EQ.-1) IPRS2 = IXGET(IPRS2) GO TO 1610 C C*********DISPLAY WHATEVER THE USER HAS INPUT ************ C C 1700 IARRAY = IPRS2 IPRAM = 0 IPRAM(3) = 1 CALL DISC3(1,1,1,1,IARRAY,IPRAM,LU2,IDISC) GO TO 1 C C C*********DISPLAY ABSOLUTE PROGRAM ON THE DISC*********** C C 1800 IF(ISTOP - ISTART .EQ. 21) GO TO 1880 IF(ISTOP - ISTART .EQ. 8) ISTOP = ISTOP +1 ISTART = IGET(ISTOP-1) IPRS2 = 2 IF(ISTART.LT.0) IPRS2 = 3 ISECTR = IAND(ISTART,177B) ITRK = (IAND(ISTART,77777B)/128) C SET A FLAG FOR THE DTRK SUBROUTINE IARRAY = -1 CALL DTRK(IPRS3+2,IARRAY,IARRAY(2),IPRAM,ISTOP,IARRAY) C ON RETURN IARRAY(1) =TRK#,IARRAY(2) = SECTR# C IWORD = WORD # C IPRS3 = ITRK+IARRAY IPRS4 = ISECTR + IARRAY(2) IPRS5 = 1 IPRAM(4) = 1 IF((IPRS4 -95).LE.0) GO TO 1850 C OPPS TOO MANY SECTORS C IPRS3 = IPRS3 + 1 IPRS4 = IPRS4 - 96 C 1850 GO TO 1000 1880 CALL EXEC(2,LU1,MEMR,7) GO TO 1 C C C************ LIST ANY LOCATION IN PHYSICAL MEMORY ********* C C 1900 IF(((IPRS2.GT.1023).OR.(IPRS2.LT.0)).OR.(IPRS3.LT.1)) GO TO 25 CALL DUMMY(IARRAY,ISTART) IF(IPRS4.LT.1024) GO TO 1910 ISTOP = IPRS4/1024 IPRS2 = IPRS2 + ISTOP IPRS4 = IPRS4 -(ISTOP * 1024) C 1910 ISTOP = 63 J = IPRS3 IPRAM(2) = 1 C DO 1950 I = 1,IPRS3,64 IPRAM = IPRS4 IPRAM(6) = IPRS2 CALL MAPXX(IPRS2,IPRS4,IARRAY) IF(J .LT. 64) ISTOP = J - 1 CALL DOIO(ISTART,ISTART + ISTOP,LU2,IPRAM) C IF(IPRAM(3).EQ.9999) GO TO 1 IPRAM(3) = 1 J = J - 64 1950 CONTINUE GO TO 1 C C C******** MAKE THE PROGRAM FRIENDLY FOR THE PEOPLE ************ C 9000 DO 9025 I = 1,27 IF(IPRS2.EQ.IGO(I)) GO TO(9100,9200,9300,9960,9400,9500,9600, &9700,9970,9800,9980,9900,9988,9992,9905,9910,9920,9930,9984, &9984,9982,9990,25,9940,9940,9940,9994) I 9025 CONTINUE C C CALL EXEC(2,LU2,IX,8) CALL EXEC(2,LU2,I1,11) CALL EXEC(2,LU2,I2,13) CALL EXEC(2,LU2,I3,12) CALL EXEC(2,LU2,I4,9) CALL EXEC(2,LU2,IP,16) CALL EXEC(2,LU2,I5,13) CALL EXEC(2,LU2,IT,17) CALL EXEC(2,LU2,IN,8) CALL EXEC(2,LU2,IM,15) CALL EXEC(2,LU2,IPR,14) CALL EXEC(2,LU2,IDP,22) CALL EXEC(2,LU2,IPG,19) CALL EXEC(2,LU2,I6,12) CALL EXEC(2,LU2,I7,9) CALL EXEC(2,LU2,IQ,17) CALL EXEC(2,LU2,I9,14) CALL EXEC(2,LU2,IR,21) CALL EXEC(2,LU2,IG,11) CALL EXEC(2,LU2,IDI,28) CALL EXEC(2,LU2,ILE,17) CALL EXEC(2,LU2,IH,11) CALL EXEC(2,LU2,IJ,11) CALL E#XEC(2,LU2,IK,9) CALL EXEC(2,LU2,IL,12) CALL EXEC(2,LU2,IO,15) CALL EXEC(2,LU2,IPACK,23) GO TO 1 C C C C 9100 CALL EXEC(2,LU2,ITEL1,9) CALL EXEC(2,LU2,ITEL2,9) CALL EXEC(2,LU2,ITEL3,16) GO TO 9999 9200 CALL EXEC(2,LU2,ITEL4,5) CALL EXEC(2,LU2,ITEL5,19) GO TO 9999 9300 CALL EXEC(2,LU2,ITEL8,5) CALL EXEC(2,LU2,ITEL9,23) GO TO 9999 9400 CALL EXEC(2,LU2,ITEL7,6) CALL EXEC(2,LU2,ITEL6,12) GO TO 9999 9500 CALL EXEC(2,LU2,ITEL10,5) CALL EXEC(2,LU2,ITEL11,26) GO TO 9999 9600 CALL EXEC(2,LU2,ITEL12,7) GO TO 1 9700 CALL EXEC(2,LU2,ITEL13,11) GO TO 1 9800 CALL EXEC(2,LU2,ITEL14,22) GO TO 1 9900 CALL EXEC(2,LU2,ITEL15,11) GO TO 1 9905 CALL EXEC(2,LU2,ITEL16,16) GO TO 9999 9910 CALL EXEC(2,LU2,ITEL18,17) GO TO 1 9920 CALL EXEC(2,LU2,ITEL17,13) GO TO 1 9930 CALL EXEC(2,LU2,ITEL26,2) CALL EXEC(2,LU2,ITEL27,5) CALL EXEC(2,LU2,ITEL28,13) GO TO 9999 9940 CALL EXEC(2,LU2,ITEL21,6) CALL EXEC(2,LU2,ITEL20,6) CALL EXEC(2,LU2,ITEL19,6) GO TO 1 9960 CALL EXEC(2,LU2,ITEL22,14) CALL EXEC(2,LU2,ITEL23,19) GO TO 9999 9970 CALL EXEC(2,LU2,ITEL24,17) GO TO 1 9980 CALL EXEC(2,LU2,ITEL25,22) GO TO 1 9982 CALL EXEC(2,LU2,ITEL30,5) GO TO 1 9984 ITEL31(2) = IPRS2 CALL EXEC(2,LU2,ITEL31,17) GO TO 1 9988 CALL EXEC(2,LU2,ITEL33,11) GO TO 1 9990 CALL EXEC(2,LU2,ITEL34,13) GO TO 9999 9994 CALL EXEC(2,LU2,ITEL36,13) C 9999 MORUSE(6) = IPRS2 CALL EXEC(2,LU2,MORUSE,8) GO TO 1 9992 CALL EXEC(2,LU2,ITEL35,2) GO TO 1 END SUBROUTINE DOIO(ISTART,ISTOP,LU,IPRAM) DIMENSION IBUF(25),IMESS(27),IPRAM(6),LMESS(17) DIMENSION IPAGE(11) INTEGER OBUF(37) C DATA IMESS/2H ,2H ,2H ,2HWO,2HRD, &2H ,2H ,2HLO,2HCA,2HTI,2HON,2H , &2HVA,2HLU,2H7E(,2H8),2H ,2HVA,2HLU,2HE(,2H10,2H) , &2HVA,2HLU,2HE(,2HAS,2H) / DATA IPAGE/2H ,2HPH,2HYS,2HIC,2HAL,2H P,2HAG,2HE / DATA LMESS/2H ,2HLO,2HCA,2HTI,2HON,2HS ,2H ,2H ,2H , &2H T,2HHR,2HOU,2HGH,2H / DATA IBUF/25*2H / C C C THE IPRAM ARRAY TELLS HOW TO DO THE I/O C IPRAM(1) = WORD # TO START COUNTING AT, C IPRAM(2) = 0 MEANS WORD COUNT TO BE IN DECIMAL C IPRAM(2) = 1 MEANS WORD COUNT TO BE IN OCTAL C IPRAM(3) = 0 MEANS PRINT HEADER. = 1 MEANS NO HEADER. C IPRAM(4) =-1 MEANS WE ARE DOING A CROSS MAP LOAD C IPRAM(5) = 1 MEANS A PACKED LISTING IS DESIRED C IPRAM(6) =+N MEANS A MAPPED IN LISTING OF PHYS MEMORY C WHERE N = PHYSICAL PAGE NUMBER C IPRAM(6) =-1 MEANS WE ARE DOING NORMAL I/O C C ISTART IS LOCATION TO START COUNTING AT C ISTOP IS LOCATION TO STOP COUNTING AT. C LU IS THE OUTPUT LU. C C K = IPRAM-1 C IF(IPRAM(5).EQ.1) GO TO 500 C IF(IPRAM(6).LT.0) GO TO 1 CALL CNUMD(IPRAM(6),IPAGE(9)) CALL EXEC(2,LU,IPAGE,11) 1 IF(IPRAM(3).EQ. 0) CALL EXEC(2,LU,IMESS,-54) C C DO 100 I = ISTART,ISTOP K = K + 1 IF((IPRAM(6).LT.0).OR.(K.NE.1024)) GO TO 2 K = 0 IPRAM(6) = IPRAM(6) + 1 2 CALL CNUMD(K,IBUF(3)) IF(IPRAM(2) .EQ.1) CALL CNUMO(K,IBUF(3)) CALL CNUMO(I,IBUF(8)) IF(IPRAM(6).LT.0) GO TO 5 CALL CNUMD(IPRAM(6),IBUF(8)) IBUF(8) = 2HPG 5 IF(IPRAM(4) .NE.-1) GO TO 50 CALL CNUMO(IXGET(I),IBUF(13)) CALL CNUMD(IABS(IXGET(I)),IBUF(18)) IF(IXGET(I).LT.0)IBUF(18) = IBUF(18) + 6400B C CALL IASCI(IXGET(I),IBUF(25)) C GO TO 75 50 CALL CNUMO(IGET(I),IBUF(13)) CALL CNUMD(IABS(IGET(I)),IBUF(18)) IF (IGET(I).LT.0) IBUF(18) = IBUF(18) + 6400B C CALL IASCI(IGET(I),IBUF(25)) C 75 CALL EXEC(2,LU,IBUF,-50) IF(IFBRK(IDMY))200,100 100 CONTINUE GO TO 300 200 IPRAM(3) = 9999 3030 RETURN C C 500 K = ISTART 550 IF((ISTOP-K).LT.0) RETURN CALL CNUMO(K,LMESS(7)) CALL CNUMO(ISTOP,LMESS(15)) IF(((ISTOP-K)/64).GT.0) CALL CNUMO(K + 63,LMESS(15)) C IF(IPRAM(6).LT.0) GO TO 551 CALL CNUMO(IPRAM,LMESS(7)) CALL CNUMO(IPRAM+ISTOP - ISTART,LMESS(15)) CALL CNUMD(IPRAM(6),IPAGE(9)) C 551 CALL EXEC(3,LU + 1100B,1) IF(IPRAM(6).GE.0) CALL EXEC(2,LU,IPAGE,11) CALL EXEC(2,LU,LMESS,17) CALL EXEC(3,LU + 1100B,1) C DO 800 I = 1,8 C CALL PACK (ISTOP - K + 1,IPRAM(4)+1,K,OBUF) CALL EXEC(2,LU,OBUF,37) C K = K + 8 IF((ISTOP-K).LT.0) RETURN IF(IFBRK(IDMY)) 200,800 800 CONTINUE C GO TO 550 END SUBROUTINE DISC3(LU,ITRK,ISECTR,INDEX,IARRAY,IPRAM,LU2,IDISC) DIMENSION IARRAY(64),IPRAM(6),IBUF(17) INTEGER OBUF(37) DIMENSION IDISK(20),IDISC(20) DATA IDISK/2H ,2HWO,2HRD,2H ,2H V,2HAL,2HUE,2H(8,2H) , & 2H V,2HAL,2HUE,2H(1,2H0),2H ,2HVA,2HLU,2HE(, & 2HAS,2H) / DATA IBUF/17*2H / C C C THIS SUBROUTINE DOES THE I/O FOR ALL DISC READS. THE MAIN C PROGRAM DOES THE READ PASSING THE 64 WORDS READ IN IARRAY. C THIS ROUTINE FORMATS THE OUTPUT. C C IN ADDITION IT DOES THE OUTPUT FOR THE ' DP ' INSTRUCTION C THIS IS A SLIGHT PERTERBATION FROM THE SUBROUTINES REAL C PURPOSE. C C C IF IPRAM(1) #0 THEN 64 WORDS ARE OUTPUT C IF IPRAM(1) =0 THEN ONLY ONE WORD IS OUTPUT C IF IPRAM(3) # 0 THEN NO DISC TRK & SECTOR INFO IS PRINTED C IF IPRAM(4) = 1 THEN 64 WORDS ARE OUTPUT PLUS THE WORD # C IF IPRAM(5) = 0 THEN A PACKED LISTING IS DESIRED C CALL CNUMD(INDEX,IDISC(24)) IF(IPRAM .EQ.0) GO TO 55 NUMBR = 64 INDEX = 1 ID = 19 IF(IPRAM(4).EQ.1) ID = 26 GO TO 100 C 55 NUMBR = 1 ID = 26 C 100 CALL CNUMD(LU,IDISC(3)) CALL CNUMD(ITRK,IDISC(9)) CALL CZNUMD(ISECTR,IDISC(17)) IF(IPRAM(3).NE.1) CALL EXEC(2,LU2,IDISC,ID) IF(IPRAM(5).NE.1) CALL EXEC(2,LU2,IDISK,20) C IF(IPRAM(5).EQ.1) GO TO 2000 C C DO 1020 I = INDEX,NUMBR C CALL IASCI(IARRAY(I),IBUF(17)) C C C C CALL CNUMD(I,IBUF) CALL CNUMO(IARRAY(I),IBUF(5)) CALL CNUMD(IABS(IARRAY(I)),IBUF(10)) IF (IARRAY(I).LT.0) IBUF(10) = IBUF(10) + 6400B CALL EXEC(2,LU2,IBUF,17) IF(IFBRK(IDUMY)) 999,1020 1020 CONTINUE RETURN 999 IPRAM(3) = 9999 RETURN C C C FIX UP A POINTER TO THE ARRAY IARRAY SO THAT THE C PACK ROUTINE WILL WORK. C 2000 CALL DUMMY(IARRAY,IPOINT) C DO 3000 I = 1,8 CALL PACK(8,1,IPOINT,OBUF) CALL EXEC(2,LU2,OBUF,37) IPOINT = IPOINT + 8 IF(IFBRK(IDUMY)) 999,3000 3000 CONTINUE END SUBROUTINE DTRK(IPRS1,ITRK,ISECTR,IWORD,ISTOP,IARRAY) DIMENSION IARRAY(64) C C SEE WHETHER WE ARE LOOKING AT A PROGRAM OR OP SYS. C IF(ITRK.GE.0) GO TO 1200 C C A PROGRAM ! C IPAST = IPRS1 ISTART = 0 GO TO 1240 C 1200 CALL EXEC(1,102B,IARRAY,64,0,1) DO 1207 I = 1,64 IF(((IARRAY(I).EQ.2).AND.(IARRAY(I+1).EQ.2000B)).AND. &(IARRAY(I+3).EQ.2000B))GO TO 1208 1207 CONTINUE C C C GRANDFATHER DISC C C C BASE PAGE STARTS HERE IBASE = 2 C ASSUME OP SYSTEM ENDS HERE ISTOP = 77770B C OP SYSTEM STARTS HERE ISTART = 18 C GO TO 1233 C C C STARTING SECTOR OF OP SYSTEM ON DISC 1208 ISTART = IARRAY(I+5) C LAST WORD OF OP SYSTEM ISTOP = IARRAY(I+4) C STARTING SECTOR OF BASE PAGE VALUES ON THE DISC IBASE = IARRAY(I+2) C C C SEE IF WORD IS ON BASE PAGE C 1233 IPAST = IPRS1 - 1024 IF(IPAST.GE. 0) GO TO 1240 C C WORD ON BASE PAGE C ITRK = 0 ISTART = IBASE ITEMP = IPRS1 - 2 GO TO 1250 C C 1240 ITRK = IPAST/6144 + ITEMP = IPAST - (ITRK * 6144) 1250 ISECTR = ITEMP/64 IWORD = ITEMP - (ISECTR * 64) ISECTR = ISECTR +ISTART IF((ISECTR - 95).LE.0) GO TO 1210 C C OOPS TOO MANY SECTORS C ITRK = ITRK + 1 ISECTR = ISECTR - 96 C C C C CHANGE RANGE OF WORD FROM 0-63 TO 1-64 SO FORTRAN CAN HANDLE IT. 1210 IWORD = IWORD + 1 END ASMB,L NAM IXGET,7 ENT IXGET,XPUT,PACK,IASCI,DUMMY,MAPXX * ENT IGET,IPUT EXT $LIBR,$LIBX,.ENTR,.ENTP * * * *GET NOP * DLD IGET,I * SWP * LDA A,I * LDA A,I * JMP B,I * * * IXGET NOP DLD IXGET,I SWP LDA A,I XLA A,I JMP B,I * * * *PUT NOP * JSB $LIBR * NOP * LDA IPUT,I * STA IGET * ISZ IPUT * DLD IPUT,I * LDA A,I * LDB B,I * STB A,I * JSB $LIBX * DEF IGET * * * XPUT NOP JSB $LIBR NOP LDA XPUT,I STA IXGET ISZ XPUT DLD XPUT,I LDA A,I LDB B,I XSB A,I JSB $LIBX DEF IXGET * * * * * * * * * THIS ROUTINE ACCEPTS UP TO 8 WORDS OF INPUT AND CONVERTS THOSE * WORDS TO OCTAL ASCII IN A PACKED FORMAT . EIGHT WORDS OF OCTAL * DELIMITED BY A * AND THEN THEIR ASIII REPRESENTATION. * THE WORDS MAY EITHOR BE IN THE SYSTEM MAP OR THE USER MAP * THE ROUTINE IS FORTRAN CALLABLE AS: * * CALL PACK(#WORDS,MAP,INPUT BUFFER,OUTPUT BUFFER) * * MAP = 0 SYSTEM MAP * MAP >= 1 USER MAP * * THE OUTPUT BUFFER MUST BE 36 WORDS LONG * * * KOUNT NOP MAP NOP INBUF NOP ASSLC NOP PACK NOP JSB .ENTR GET THE PARAMETER ADDRESSES DEF KOUNT * LDA KOUNT,I GET THE # OF WORDS TO CONVERT BACK CMA,INA MAKE NEG AND SSA,RSS IF 0 OR NEG WORDS INPUT THEN FORGET IT JMP PACK,I STA KOUNT NOW SAVE FOR LOOP * ADA D8 ADD 8 TO SEE IF INPUT # L SSA,RSS GREATER THAN 8 JMP CONTU ALL IS WELL ! LDA D8 JMP BACK * * CONTU LDA MAP,I GET THE MAP AND SAVE STA MAP FOR LATER * LDA INBUF,I STA INBUF * LDA ASSLC GET THE ADDRESS LDB ASSLC TWICE STB TEMP SAVE TEMPORARIALLY INA BUMP IT CLE,ELA CONVERT TO A BYTE ADDRESS STA ASSLC AND SAVE FOR LATER ADB D29 NOW DEFINE THE ASCII ADDRESS STB OABUF AND SAVE FOR THE IASCI SUBROUTINE STB YTEMP * LDA DM37 NOW CLEAR OUT THE OLD BUFFER STA XTEMP LDB BLANK GET A BLANK READY * LOOPX STB TEMP,I SET A BLANK INTO THE OUTPUT BUFFER ISZ TEMP STEP BUFFER POINTER ISZ XTEMP DONE YET ? JMP LOOPX NO * * * LOOP LDB INBUF GET THE 1ST WORD LDA MAP GET THE MAP TO USE SZA,RSS SYS MAP ? JMP SYSTM YES LDB B,I NO JMP OUT SYSTM XLB B,I GET THE INFO FROM THE SYSTEM MAP OUT STB XTEMP SAVE FOR THE IASCI SUBROUTINE JSB ASCI AND CONVERT TO OCTAL ASCII * JSB IASCI AND PLACE THROUGH THE ASCII FILTER DEF *+3 DEF XTEMP DEF TEMP * STB OABUF,I PUT RESULT INTO THE OUTPUT BUFFER * ISZ INBUF BUMP OUR ISZ OABUF POINTERS ISZ ASSLC AND THE CHAR ADDRESS * ISZ KOUNT ARE WE DONE ? JMP LOOP NOT YET * CCB YES,GET THE END OF THE OCTAL #'S ADB YTEMP LDA B,I NOW GET THE LAST WORD IOR ASTRK PUT IN AN ASTRISK STA B,I NOW PUT IT BACK * JMP PACK,I RETURN TO THE CALLER * * * * ** DATA TO OCTAL ASCII CONVERSION ** SPC 1 * CALLING SEQUENCE: LDB (DATA WORD) * LDA (ADDRESS AT START OF STORAGE) * JSB ASCI SPC 1 ASCI NOP b OUTPUT 6 DIGITS * STA ASSLC SET THE ADDRESS (NOT USED AT THE MOMENT ) LDA KM6 GET NO. OF DIGITS TO CONVERT RBL MOVE FIRST DIGIT TO LOW B JSB NUM.F CONVERT THE NUMBER JMP ASCI,I RETURN SPC 2 *SCI2 NOP 5 DIGITS & BLANK * LDA KM5 GET NO OF DIGITS TO CONVERT * BLF POSITION FIRST DIGIT * JSB NUM.F CONVERT THE NUMBER * JMP ASCI2,I RETURN * * *********************************** * * CONVERT DIGITS TO ASCII BASE 8 * * *********************************** * * NUM.F NOP STA T1NUM SAVE THE DIGIT COUNT CPA KM6 IF 6 THEN CLA,INA,RSS USE 1 AS A MASK FOR FIRST DIGIT NUM00 LDA K7 ELSE USE 7 AND B ISOLATE THE DIGIT ADA "0" ADD 60 TO MAKE ASCII JSB PUT.F PUT IN THE BUFFER BLF,RBR POSITION THE NEXT DIGIT ISZ T1NUM DONE? JMP NUM00 NO DO NEXT DIGIT * JMP NUM.F,I YES RETURN * T1NUM NOP KM6 DEC -6 * SPC 2 * * ******************************** * * PUT CHARACTER IN LIST BUFFER * * ******************************** * PUT.F NOP STB T1PUT SAVE B LDB ASSLC GET CURRENT BUFFER ADDRESS AND B177 ISOLATE THE CHARACTER CLE,ERB WORD ADDRESS TO B E=UPPER,LOWER FLAG SEZ,RSS IF UPPER CHAR ALF,SLA,ALF POSITION AND SKIP XOR B,I INCLUSION OF HIGHER CHAR. XOR B40 ADD,TAKE AWAY LOWER BLANK STA B,I SET THE WORD DOWN ISZ ASSLC STEP THE CHAR ADDRESS LDB T1PUT RESTORE B JMP PUT.F,I RETURN * T1PUT NOP OABUF NOP B40 OCT 40 K7 DEC 7 D8 DEC 8 "0" OCT 60 D29 DEC 29 DM37 DEC -37 BLANK ASC 1, ASTRK OCT 52 LOWER BYTE = * B177 OCT 177 TEMP NOP D64 DEC 64 D1024 DEC 10E 24 XTEMP NOP YTEMP NOP ADDRS NOP PONTR NOP DUMMY NOP THIS IS A DUMMY SUBROUTINE TO FIX UP A POINTER JSB .ENTR SO THAT THE PACK ROUTINE CAN WORK WITH ARRAYS DEF ADDRS IN A PROGRAM AS WELL AS MEMORY ADDRESSES. * LDA ADDRS STA PONTR,I JMP DUMMY,I SPC 1 * * * * * * * THE IASCI SUBROUTINE TAKES ONE WORD OF INPUT AND CONVERTS THAT * WORD TO ASCII. IF ANY BYTE CAN NOT BE CONVERTED TO ASCII THEN * AN ASCII BLANK IS RETURNED FOR THAT BYTE. * * * CALLING SEQUENCE : JSB IASCI * DEF RETURN * DEF VALUE VALUE TO BE CONVERTED * DEF ASCII RETURNED ASCII VALUE * ---- * * ON RETURN, THE B REGISTER HAS THE ASCII VALUE * VALUE NOP LOCTN NOP IASCI NOP JSB .ENTR DEF VALUE * LDA VALUE,I GET THE VALUE TO CONVERT STA TEMP1 SAVE IT AND M377 KEEP ONLY LOWER BYTE JSB CNVRT AND CONVERT STB VALUE SAVE THE RETURNED VALUE * LDA TEMP1 GET THE WORD BACK AGAIN AND M1774 KEEP ONLY THE UPPER BYTE ALF,ALF SHIFT TO LOW ORDER JSB CNVRT AND GO CONVERT BLF,BLF PUT INTO UPPER BYTE ADB VALUE NOW MERGE ADD IN LOWER BYTE STB LOCTN,I AND RETURN IT TO THE USER JMP IASCI,I * * * THIS SUBROUTINE CONVERTS LOWER BYTE OF A TO ASCII AND PLACES * THE RETURNED ASCII INTO B * CNVRT NOP STA B AND SAVE CMA,INA ADA B135 SSA IS IT OK JMP BLNK2 NO LDA B40 CMA,INA ADA B SSA OK ? BLNK2 LDB B40 NO JMP CNVRT,I * * * * A EQU 0 B EQU 1 M1774 OCT 177400 B135 OCT 137 M377 OCT 377 TEMP1 NOP DM64 DEC -64 SIGN OCT 100000 * * * ************************************** * * MAP IN ANY PAGE OF PHYSICAL MEMORY * * ************************************** * * * THE PURPOSE OF THIS SUBROUTINE IS TO MAP IN THE PAGE REQUESTED * AND READ 64 WORDS OF THAT MAPPED PAGE. THE ROUTINE IS FORTRAN * CALLABLE. TO BE USED ONE OF TWO CONDITIONS MUST BE MET. * THE PROGRAM USING THE ROUTINE MUST NOT BE GREATER THAN 30K * IN LENGTH (IE IF PROGRAM IS 10K AND LARGEST ADDRESSABLE * PARTITION IS 12K YOUR OK. IF LARGEST ADDRESSABLE PARTITION IS * 11K YOU HAVE PROBLEMS). ALTERNATELY IF THE PROGRAM EXTENDS * INTO THE LAST TWO PAGES OF MEMORY MAKE SURE THIS ROUTINE * AND THE INPUT PARAMETERS TO THIS ROUTINE DO NOT RESIDE THERE * AND YOU WILL BE ALLRIGHT. * * THE PROGRAM MODIFIES THE USER MAP REGISTERS BUT ALSO RESTORES THEM. * * * CALLING SEQUENCE JSB MAPXX * DEF RETURN * DEF PAGE# * DEF OFFSET (NOT GREATER THAN 1023 DECIMAL) * DEF ARRAY (ARRAY OF 64 WORDS) * * * PAGE# NOP OFSET NOP ARRAY NOP * MAPXX NOP JSB $LIBR NOP JSB .ENTP DEF PAGE# * LDA MPBUF GET THE ADDRESS OF THE MAP BUFFER ADA SIGN SET THE SIGN BIT SO IT IS A READ USA GET THE USER MAP * LDA MAP31 GET THE OLD VALUE STA OLD31 AND SAVE IT LDA MAP32 OLD VALUE. STA OLD32 SAVE THIS TOO LDB PAGE#,I GET THE DESIRED PAGE STB MAP31 PUT IT INTO THE OLD PAGE INB BUMP PAGE # TO ACCOUNT FOR OVERFLOW STB MAP32 SET NEXT PAGE INTO THE LAST LOCATION * LDA MPBUF GET THE USER MAP BUFFER ADDRESS USA !!!!!! LOAD THE USER MAP !!!!!! * * * LDA DM64 GET LOOP INDEX STA XTEMP LDA START GET THE START ADDRESS ADA OFSET,I ADD IN THE OFFSET STA YTEMP SAVE POINTER LDA ARRAY GET ARRAY ADDRESS MLOOP LDB YTEMP,I GET THE WORD STB A,I AND PUT INTO BUFFER p~ ISZ YTEMP BUMP OUR INA POINTERS ISZ XTEMP DONE ? JMP MLOOP NO * * LDA OLD31 YES RESTORE THE USER MAP STA MAP31 LDA OLD32 STA MAP32 * LDA OFSET,I GET THE OFFSET ADA D64 ADD 64 WORDS FOR WHAT WE JUST DID CLB DIV D1024 DIVIDE NEW OFFSET BY # OF WORDS IN PAGE ADA PAGE#,I ADD OLD PAGE # TO GIVE NEW PAGE # STA PAGE#,I AND SEND THE RESULT BACK STB OFSET,I SEND THE NEW OFFSET BACK TOO * LDA MPBUF USA !!!!!! RESTORE THE USER MAP !!!!!!! * JSB $LIBX RESTORE INTERUPT SYSTEM DEF MAPXX AND RETURN TO CALLER * * * START OCT 74000 START ADDRESS OF NEWLY MAPPED AREA MPBUF DEF MAPIT MAPIT BSS 30 BUFFER FOR 1ST 30 WORDS OF USER MAP MAP31 NOP THIS LOCATION IS USED TO CHANGE MAP MAP32 NOP THIS LOCATION IS FOR I/O OVERFLOW OLD31 NOP OLD32 NOP * * END FTN4,L END$ o Ni 24999-18070 2024 S 0100 &FGETR SOURCE             H0101 FTN4,L PROGRAM FGETR(3,90),24999-16053 REV.2024 800514 C C C THIS PROGRAM ALLOWS THE USER TO ACCESS FILES ON C JSAVE MAG TAPES. IT ALSO WILL GIVE A "DL" ON THE C FILE FOR HIM. THE DIRECTORY LIST IS SLIGHTLY C FASTER THAN THE FILE MANAGER BECAUSE IT DOES C TRACK BUFFERS AT A TIME. C C THE ONLY ROUTINE OTHER THAN THIS REQUIRED IS C ASCII WHICH DOES A BINAR TO ASCII CONVERSION C WITH LEADING ZEROS LEFT. THE ROUTINE IS IN C ASSEMBLER THE CALLING SEQUNCE IS C CALL ASCII(I,J,K) C C I IS THE BINARY NUMBER C J IS THE ADDRESS OF THE RESULT (3 WORDS) C K IS THE BASE WE WANT THE RESULT IN C C C REVISIONS FOR 2024 C C 1) ABLE TO HANDLE 7925 DISC C 2) HANDLE TYPE 2 FILES CORRECTLY C 3) GIVE CORRECT HEADINGS WHEN DOING MORE THAN ONE DL. C 4) POSITION TO MT FILE CORRECTLY FROM ANYWHERE. C 5) IMPROVE PROGRAM FLOW (HOPEFULLY FRIENDLINESS) C DIMENSION ID(144),NA(3),LT(40),LS(40),NS(40),NA2(3) DIMENSION LU(5),IREG(2),MBUF(52),IPBUF(33) DIMENSION IBUF(8193),JBUF(8192),IANS(2),MES11(10) C ****** ****** DIMENSION LIN(24),LIN1(5),KFILE(5) DIMENSION LIN2(35),LIN3(24),NSS(2) C **************** INTEGER FIRST,LAST,FILE EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) EQUIVALENCE (IBUF,ITRAK),(JBUF,IBUF(2)) EQUIVALENCE (IBUF(4),IBUF4) C C********************* DATA JLNTH/8192/ C********************* DATA KFILE/6412B,2H F,2HIL,2HE ,2H / C************************************************************* C C REMOVED MESS1 TO,MES10 AND MES12 TO MES15 FROM DATA AREA C C************************************************************* DATA MES11/2H F,2HIL,2HE ,2HCR,2HEA,2HTI,2HON,2H E,2HRR,2HOR/ DATA LIN/24*2H / DATA LIN1/2H ,2HCR,2H,3*2H / DATA LIN2/2H ,2H I,2HLA,2HB=,3*2H ,2H N,2HXT,2HR=, *2*2H ,2H N,2HXS,2HEC,2*2H ,2H #,2HSE,2HC/,2HTR,2*2H , *2H L,2HAS,2HT ,2HTR,2H= ,2*2H ,2H #,2HDR,2H T,2HR=,2H / DATA LIN3/2H ,2HNA,2HME,2H ,2H T,2HYP,2HE ,2H#B,2HLK, *2HS/,2HLU,2H S,2HCO,2HDE,2H T,2HRA,2HCK,2H S,2HEC,2H , *2HOP,2HEN,2H T,2HO / CALL RMPAR(LU) IF(LU.EQ.0)LU=1 ILU=LU+400B C*********************************************************** CALL EXEC(2,LU,2H ,-2) CALL EXEC(2,LU,30H 24999-16053 2024 SSK SYS 1000,-30) C*********************************************************** C C GET MAG TAPE LU C C********************************************** 10 CALL EXEC(2,ILU,2H ,-2) CALL EXEC(2,ILU,16H MAG TAPE LU: _,-16) C********************************************** X=REIO(1,ILU,MBUF,10) IF (MBUF.EQ.2H/E)GO TO 380 CALL PARSE(MBUF,IB*2,IPBUF) MTLU=IPBUF(2) C CALL EXEC(13,MTLU,ISTAT) IF(IAND(ISTAT,37400B)*2.EQ.23000B)GO TO 20 IF(IAND(ISTAT,37400B)*2.EQ.24000B)GO TO 20 C***************************************************** CALL EXEC(2,ILU,24H THAT'S NOT A MAG TAPE!,-24) C***************************************************** GO TO 10 C********************************************* 20 IREG=LURQ(100001B,MTLU,1) IF(IREG.EQ.0)GO TO 30 CALL EXEC(2,ILU,16HLU LOCK REJECTED,-16) C********************************************* GO TO 380 C 30 REWIND MTLU 40 FILE=1 C C C GET MAG TAPE FILE NUMBER AND IDENT C C*********************************************** 50 IFLG = 0 CALL EXEC(2,ILU,2H ,-2) CALL EXEC(2,ILU,18H MAG TAPE FILE: _,-18) C*********************************************** X=REIO(1,ILU,MBUF,10) IF(MBUF .EQ. 2H/E)GO TO 380 CALL PARSE(MBUF,IB*2,IPBUF) NFILE=IPBUF(2) IF(NFILE.LT.0)GO TO 380 IF(N!FILE.EQ.0)NFILE = FILE C C C C POSITION THE TAPE C C********************************** IF(NFILE .GT. 1)GO TO 60 REWIND MTLU FILE = 1 GO TO 120 60 IF(FILE.EQ.NFILE)GO TO 110 CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GO TO 70 CALL EXEC(3,MTLU+1300B) 70 CALL EXEC(1,MTLU,MBUF,50) CALL HEADL(MBUF,LEN) KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) CALL EXEC(2,ILU,MBUF,LEN) C C FORWORD-BACK WORD UP PROCESSOR C C IF(NFILE.GT.FILE)GO TO 80 GO TO 90 C C C FORWORD C C 80 CALL EXEC(3,MTLU+1300B) FILE=FILE+1 IF(FILE.EQ.NFILE)GO TO 120 KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) CALL EXEC(1,MTLU,MBUF,50) CALL HEADL(MBUF,LEN) CALL EXEC(2,ILU,MBUF,LEN) GO TO 80 C C C BACK WORD C C 90 FILE=FILE-1 CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GO TO 120 CALL EXEC(3,MTLU+1300B) 100 IF(FILE .EQ. NFILE)GO TO 120 CALL EXEC(1,MTLU,MBUF,50) KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) CALL HEADL(MBUF,LEN) CALL EXEC(2,ILU,MBUF,LEN) GO TO 90 C C C GET HEADER AND CHECK IF THAT'S WHAT HE WANTS C 110 CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GOTO 120 CALL EXEC(3,MTLU+1300B) 120 CALL EXEC(1,MTLU,MBUF,50) KFILE(5)=KCVT(FILE) CALL EXEC(2,ILU,KFILE,5) CALL HEADL(MBUF,LEN) C C SET UP A ' ? _' IN THE BUFFER. C LEN=LEN+1 MBUF(LEN)=20077B LEN = LEN + 1 MBUF(LEN)=20137B C*********************************************** 130 CALL EXEC(2,ILU,MBUF,LEN) CALL REIO(1,ILU,IANS,2) IF(IANS.EQ.2HYE)GO TO 150 IF(IANS.EQ.2HNO)GO TO 50 C**************************** CALL EXEC(3,MTLU+1400B) IF(FILE.EQ.1)GO TO 140 CALL EXEC(3,MTLU+1300B) 140 GO TO 120 C C  ASK IF THEY WANT A DIRECTORY LISTING OF THAT FILE C C********************************************************* 150 CALL EXEC(2,ILU,2H ,-2) CALL EXEC(2,ILU,28H DO YOU WISH A DIRECTORY ?_,-28) C********************************************************* CALL REIO(1,ILU,IANS,2) IF (IANS.EQ.2H/E)GO TO 380 IF(IANS.NE.2HYE)GO TO 160 IFLG=1 C C ASK WHERE HE WOULD LIKE IT C C**************************************** CALL EXEC(2,ILU,2H ,-2) CALL EXEC(2,ILU,11H WHAT LU _,-11) C**************************************** X=REIO(1,ILU,IANS,2) IF (IANS.EQ.2H/E)GO TO 380 CALL PARSE(IANS,IB*2,IPBUF) LIST=IPBUF(2) GO TO 200 C C DOESNT WANT A DIRECTORY ASK FOR A FILE NAME C C***************************************************** 160 CALL EXEC(2,ILU,2H ,-2) CALL EXEC(2,ILU,24H FILE NAMR,:_,-24) C***************************************************** MBUF=2H MBUF(2)=2H MBUF(3)=2H X=REIO(1,ILU,MBUF,30) IF (MBUF.EQ.2H/E)GO TO 380 IF (IB .EQ. 0)GO TO 350 ICHRS = IB * 2 IP = 1 IF (NAMR(IBUF,MBUF,ICHRS,IP)) 160 ,170 170 IT = IAND (IBUF4,3) IF(IT .LE. 1)GO TO 160 NA (1) = IBUF (1) NA (2) = IBUF (2) NA (3) = IBUF (3) ISC2 = IBUF(5) ICR2 = IBUF(6) IF (NAMR(IBUF,MBUF,ICHRS,IP)) 190 ,180 180 IT = IAND (IBUF4,3) ISCHK = ISOL8(IBUF4,2,3) ICCHK = ISOL8(IBUF4,4,5) IF(IT .LE. 1)GO TO 190 NA2 (1) = IBUF (1) NA2 (2) = IBUF (2) NA2 (3) = IBUF (3) IF(ISCHK .NE. 0) ISC2 = IBUF (5) IF(ICCHK .NE. 0) ICR2 = IBUF (6) GO TO 200 190 NA2 (1) = NA (1) NA2 (2) = NA (2) NA2 (3) = NA (3) C**************************** C C WERE THERE AT THE FILE READ IN THE DIRECTORY C TRACKS AND EITHER FIND OUR FILE OR FORMAT THE C INFO AND OUTPURT IT TO THE LIST DEVICE C 200 ISUM=0 NSS=0 NSS(2) = 0 MR=0 210 M=1 ISEC=0 JSEC=0 C C ******************************************************** C * READ A RECORD FROM MAG TAPE * C ******************************************************** C C READ A TRACK C X = EXEC(1,MTLU,IBUF,JLNTH+1) IF(IAND(IREG,200B).NE.0)GO TO 350 C C IF FIRST DIRECTORY TRACK FIRST 16 WORDS C ARE PACK LBL INFO C IF(MR.NE.0)GO TO 220 M=17 ISPT=JBUF(7) IBPT=ISPT/2 JLNTH=64*ISPT IF(IFLG.EQ.0)GO TO 220 C C FORMAT AND OUTPUT THE DL HEADER INFO C CALL ASCII(JBUF(4),LIN1(3),10) LIN1(3)=IAND(LIN1(3),177B)+36400B CALL EXEC(3,1100B+LIST,-1) CALL EXEC(2,LIST,LIN1,5) LIN2(5)=IAND(JBUF(1),77777B) LIN2(6)=JBUF(2) LIN2(7)=JBUF(3) CALL ASCII(JBUF(10),MBUF,10) LIN2(11)=MBUF(2) LIN2(12)=MBUF(3) CALL ASCII(JBUF(6),MBUF,10) LIN2(16)=IAND(MBUF(2),177B)+36400B LIN2(17)=MBUF(3) CALL ASCII(JBUF(7),MBUF,10) LIN2(22)=IAND(MBUF(2),177B)+36400B LIN2(23)=MBUF(3) IA=JBUF(8)-JBUF(9)-1 CALL ASCII(IA,MBUF,10) LIN2(29)=MBUF(2) LIN2(30)=MBUF(3) IA=-JBUF(9) CALL ASCII(IA,MBUF,10) LIN2(35)=MBUF(3) CALL EXEC(2,LIST,LIN2,35) CALL EXEC(3,1100B+LIST,1) CALL EXEC(2,LIST,LIN3,24) CALL EXEC(3,1100B+LIST,1) C C SCAN THE ENTIRE TRACK LOOP C 220 DO 270 N=M,128,16 C C COMPUTE THE FILE INFO OFFSET C MR=N+ISEC*64 C C IF ELEMENT = -1 FILE WAS PURGED IGNORE C IF(JBUF(MR).EQ.-1)GO TO 270 C C IF = 0 END OF DIRECTORY GET OUT C IF(JBUF(MR).EQ.0)GO TO 280 IF(IFLG.EQ.0)GO TO 260 C C DO DL FORMATTING STUFF C DO 230  IA=1,24 230 LIN(IA)=2H LIN(2)=JBUF(MR) LIN(3)=JBUF(MR+1) LIN(4)=JBUF(MR+2) CALL ASCII(JBUF(MR+3),LIN(5),10) IF(IAND(LIN(5),77400B).EQ.30000B)LIN(5)=IAND(LIN(5),177B) 1+20000B IF(JBUF(MR+3).EQ.0)GO TO 240 IA=JBUF(MR+6)/2 CALL ASCII(IA,LIN(8),10) IF(IAND(LIN(8),77400B).EQ.30000B)LIN(8)=IAND(LIN(8),177B) 1+20000B CALL ASCII(JBUF(MR+4),LIN(15),10) LIN(15)=20040B IA=IAND(JBUF(MR+5),377B) CALL ASCII(IA,MBUF,10) LIN(18)=MBUF(2) IF(IAND(LIN(18),77400B).EQ.30000B)LIN(18)=IAND(LIN(18) 1,177B)+20000B LIN(19)=MBUF(3) IA=0 IF(JBUF(MR+5).LT.0)IA=200B IA=IA+IAND(77400B,JBUF(MR+5))/256 IF(IA.EQ.0)GO TO 250 CALL ASCII(IA,MBUF,10) LIN(21)=IAND(MBUF(2),177B)+25400B LIN(22)=MBUF(3) GO TO 250 240 CALL ASCII(JBUF(MR+4),MBUF,10) LIN(10)=MBUF(3) 250 CALL ASCII(JBUF(MR+8),LIN(12),10) IF(IAND(LIN(12),77400B).EQ.30000B)LIN(12)=IAND(LIN(12) 1,177B)+20000B CALL EXEC(2,LIST,LIN,24) GO TO 270 C C NOT DOING DL SO SEE IF ENTRY IS FOR OUR FILE C 260 IF(JBUF(MR).NE.NA)GO TO 270 IF(JBUF(MR+1).NE.NA(2))GO TO 270 IF(JBUF(MR+2).NE.NA(3))GO TO 270 C C YES SAVE AND INCRIMENT PERTINANT INFORMATION C ISUM=ISUM+1 IF(JBUF(MR+5).LT.256)NTP=JBUF(MR+3) LT(ISUM)=JBUF(MR+4) LS(ISUM)=IAND(377B,JBUF(MR+5)) NS(ISUM)=JBUF(MR+6)/2 NSS=NSS+NS(ISUM) C*************************************** IF(NTP .EQ. 2) NSS(2) = JBUF(MR+7) C*************************************** 270 CONTINUE C C DONE TRACK MUST BE MORE SO SET UP FOR THEM C M=1 ISEC=MOD(ISEC+14,ISPT) C **** JSEC=JSEC+1 IF(JSEC.LT.IBPT)GO TO 220 C **** GO TO 210 C C DONE SCAN SET UP TO GET FILE OFF TAPE C 280 IF(ISUM.EQ.0)GO TO 330 IS=1 C C CREATE THE FILE BECAUSE WE FOUND SOMETHING C CALL CREAT(ID,IRE,NA2,NSS,NTP,ISC2,ICR2) IF(IRE.LT.0)GO TO 340 C C CLOSE THE FILE SO WE CAN OPEN IT BETTER C CALL CLOSE(ID) C C OPEN THE FILE TYPE ONE SO WE MAY JUST C TRANSFER WHOLE RECORDS C CALL OPEN(ID,IRE,NA2,4,ISC2,ICR2) C C READ IN A MAG TAPE RECORD 290 X = EXEC(1,MTLU,IBUF,JLNTH+1) IF(IAND(IREG,200B).NE.0)GO TO 320 C C SEE IF WE WANT THIS TRACK C 300 IF(IBUF.NE.LT(IS))GO TO 290 C C YES FIGURE OUT OUR OFFSET INTO THE FILE C IA=64*LS(IS)+1 C C TRANSFER THE CORRECT NUMBER OF SECTORS DO 310 N=1,NS(IS) CALL WRITF(ID,IRE,JBUF(IA),128) IA=IA+128 C C MAKE SURE WE DONT CROSS TRACK BOUNDS C IF(IA.LT.JLNTH)GO TO 310 X = EXEC(1,MTLU,IBUF,JLNTH+1) IF(IAND(IREG,200B).NE.0)GO TO 320 IA=1 310 CONTINUE IS=IS+1 IF(IS.GT.ISUM)GO TO 320 GO TO 300 320 CALL CLOSE(ID) GO TO 350 C C IF NOT DOING DIRECTORY AND NO FILE SAY SO C 330 IF(IFLG.EQ.0)CALL EXEC(2,ILU,8H NO FILE,-8) GO TO 350 C C FILE ERROR SAY SO C 340 CALL ASCII(-IRE,MES11(11),10) MES11(12)=26440B CALL EXEC(2,ILU,MES11,13) C C ASK IF ANY MORE TO DO C C**************************** 350 CALL EXEC(2,ILU,2H ,-2) CALL EXEC(2,ILU,24H ANY MORE THIS FILE ? _,-24) C******************************************* CALL REIO(1,ILU,MBUF,10) IF(MBUF.NE.2HYE)GO TO 370 IF(FILE .NE. 1)GO TO 355 REWIND MTLU GO TO 360 355 CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+1300B) 360 CALL EXEC(3,MTLU+300B) IFLG = 0 GO TO 160 370 CALL EXEC(2,ILU,2H ,-2) CALL EXEC(2,ILU,24H ANY MORE THIS TAPSE ? _,-24) CALL REIO(1,ILU,MBUF,10) IF(MBUF.EQ.2HYE)GO TO 50 C C REWIND MAG TAPE C C****************************** 380 REWIND MTLU C C UNLOCK LU'S C CALL LURQ(100000B,MTLU,1) C****************************** C NO BYE BYE C END SUBROUTINE HEADL(IBUF,LEN),24999-16053 REV.2024 800509 DIMENSION IBUF(50) C C DO BACK SCAN ON IBUF TO FIND TRUE LENGTH OF RECORD C 10 DO 20 I=50,1,-1 IF(IBUF(I) .EQ. 2H )GO TO 20 IF(IBUF(I) .NE.6412B)GO TO 30 I = I - 2 GO TO 30 20 CONTINUE LEN = 1 30 LEN = I + 1 C RETURN END END$ ASMB,L,C NAM ASCII ENT ASCII EXT .ENTR A EQU 0 B EQU 1 NUM NOP PUT NOP E NOP ASCII NOP JSB .ENTR GET CALLING PARMS DEF NUM CLA STA FLAG LDA DM3 STA CNT LDA PUT SAVE DESTINATION ADDRESS ADA .2 STA PUTT LDA NUM,I STA NUMM LDA E,I STA BASE CPA .8 JMP LOP LDA NUMM SSA,RSS JMP LOP CCB CMA,INA STA NUMM STB FLAG LOP LDA NUMM CLB DIV BASE ADB B60 STB PUTT,I CLB DIV BASE STA NUMM LDA B ADA B60 ALF,ALF IOR PUTT,I STA PUTT,I LDA PUTT ADA DM1 STA PUTT ISZ CNT JMP LOP LDA FLAG SZA,RSS JMP ASCII,I ISZ PUTT LDA B377 AND PUTT,I IOR MIN STA PUTT,I JMP ASCII,I CNT NOP DM3 DEC -3 DM1 DEC -1 .2 DEC 2 .8 DEC 8 B60 OCT 60 B377 OCT 377 MIN OCT 26400 BASE NOP NUMM NOP PUTT NOP FLAG NOP END ASMB,R,B,L NAM ISOL8,7 ISOLATE,RIGHT JUSTIFY BITS. 18 JAN 77. ENT ISOL8 EXT .ENTR * * I=ISOL8(J,11,8) ISOLATES BITS 11,10,9,8 FROM J AND RETURNS640 THEM * IN THE LEAST SIGNIFICANT BITS OF I. HIGH BITS OF * I ARE ZEROED OUT. * I=ISOL8(J,8,11) DOES THE SAME THING. * * I=ISOL8(J,15,0) RETURNS I=J * I=ISOL8(J,16,1) RETURNS I = J ROTATED 1 BIT RIGHT * J NOP I1 NOP I2 NOP ISOL8 NOP JSB .ENTR DEF J LDA I1,I CMA,INA (A)= -I1 ADA I2,I (A)= I2-I1 SSA (A)>0 ? I2>I1 ? JMP RVERS NO. I1>I2. LDB I1,I YES. I2>I1. GET I1. JMP CONT RVERS LDB I2,I I2 IS THE LEAST OF I1,I2. CMA,INA (A)>=0. CONT CMB,INB LEAST OF I1,I2 COUNTS ROTATIONS. STA MASK# MASK NUMBER >= 0. LDA J,I GET THE WORD TO BE OPERATED ON. * RLOOP SZB,RSS DONE? ROTATION COUNTER ROSE TO ZERO ? JMP ISOL YES. RAR NO. MOVE BITS-OF-INTEREST ONE PLACE RIGHT. INB BUMP ROTATION COUNTER. JMP RLOOP * ISOL LDB .MASK ADB MASK# (B) POINTS TO DESIRED MASK. AND B,I ZERO OUT UNWANTED BITS. JMP ISOL8,I RETURN WITH (A)=RIGHT JUSTIFIED ISOLATED BITS. * MASK# NOP .MASK DEF *+1 OCT 000001 OCT 000003 OCT 000007 OCT 000017 OCT 000037 OCT 000077 OCT 000177 OCT 000377 OCT 000777 OCT 001777 OCT 003777 OCT 007777 OCT 017777 OCT 037777 OCT 077777 OCT 177777 * A EQU 0 B EQU 1 S EQU 1 END 26 O ] 24999-18071 1938 S 0100 "UTIL SSK DOCUMENTATION             H0101  SOFTWARE SERVICE KIT DOCUMENTATION HP 1000 24999-90001 REVISION CODE 1938 SEPTEMBER 17,1979 MATERIAL LIST NAME REL BINARY SOURCE REVISION PART # PART # CODE JSAVE 24999-16048 24999-18065 1932 * JRSTR 24999-16049 24999-18066 1932 * SDLS4 24999-16050 24999-18067 1938 * RXREF 24999-16051 24999-18068 1902 * CMM3 24999-16052 24999-18069 1752 FGETR 24999-16053 24999-18070 1902 * CLASS 24999-16055 24999-18083 1902 * JVRFY 24999-16163 24999-18163 1902 * SAMSZ 24999-16178 24999-18178 1814 CDA4 24999-16197 24999-18197 1938 * SNPSH 24999-16198 24999-18198 1839 CDMP 24999-16199 24999-18199 1839 PATCH 24999-16200 24999-18200 1839 CMMM 24999-16201 24999-18201 1839 CMM4 24999-16202 24999-18202 1938 * DSINF 24999-16215 24999-18215 1902 * SLCIN 24999-16214 24999-18214 1902 * NDTDU 24999-16213 24999-18213 1902 * TDMP 24999-16218 24999-18218 1902 * TRC65 24999-16225 24999-18225 1902 * PSMON 24999-16224 24999-18224 1902 * DVT65 24999-18226 1902 * SAM 24999-16227 24999-18227 1902 * MAPIO 24999-16222 24999-18222 1902 * SCB 24999-16247 K 24999-18247 1938 * DLB 24999-16244 24999-18244 1935 * DLA 24999-16245 24999-18245 1932 * VERIF 24999-16248 24999-18248 1938 * DXREF 24999-16246 24999-18246 1938 * "UTIL 24999-18071 1938 * NOTE: asterisks (*) denote new or updated tools - FOR HP INTERNAL USE ONLY - HP 1000 SOFTWARE SERVICE KIT SUMMARY OF PARTS +------------------------------------------------------+------------------+ | | | | SUMMARY OF PARTS | CHAPTER 1 | | | | +------------------------------------------------------+------------------+ NAME PAGE DESCRIPTION SYSTEM DEBUGGING AIDS: CMM3 Permits modification of memory or disc, gives listing of system tables, etc for RTE-II and RTE-III CMM4 Permits modification of memory or disc, gives listing of system tables, etc for RTE-IV CMMM Permits modification of memory or floppy, gives listing of system tables, etc for RTE-M PATCH Patches system from a file containing binary absolute code DATA COMMUNICATIONS DEBUGGING AIDS: DSINF Gives listings of DS/1000 tables, etc. NDTDU Dumps DS/1000 Network Description Table TRC65 Trace program for DS/1000 communication line DVT65 Modified DVA65 needed for TRC65 PSMON Passive monitor program for DS/1000 communication line SLCIN Long term statistic and event trace for DS/1000-3000 CRASH DUMP ANALYSIIS: CDA4 Gives listings of system tables, etc from the memory under the system map of a crashed system. Output and use is similar to CMM4 CDMP Dumps the memory under the system map to cassette for use by CDA4 TDMP Dumps the memory under the system map to mag tape for use by CDA4 SNPSH Saves system snapshot on cassette for use be CDA4 - FOR HP INTERNAL USE ONLY - 1 HP 1000 SOFTWARE SERVICE KIT SUMMARY OF PARTS FILE RELATED UTILITIES: VERIF Provides a means to verify a FMGR disc file RXREF Generates cross refrence map of a program DXREF Allows selective searching of modules, entry points, and external refrences. (See RXREF) DL Gives directory information about purged and open files and gives enhanced filtering options to the 'DL' command. SDLS4 Read CUPERTINO distribution tape into FMP files JSAVE Save disc cartridge on mag tape JRSTR Restores disc cartridge from JSAVE mag tape JVRFY Verify disc cartridge and JSAVE tape FGETR Access a file and directory on JSAVE mag tape PERFORMANCE AND TABLE ANALYSIS UTILITIES: CLASS Displays status of class table, list contents or clear pending buffers SCB Dumps and breaks out a Session Control Block (SCB) SAM Identifies each buffer in System Available Memory, who asked for it and what its contents are SAMSZ Determines the amount of SAM dynamically MAPIO Displays LU/EQT/SC relationships (LUPRN) N APPENDIX A CUPERTINO DISTRIBUTION TAPE FORMAT APPENDIX B JSAVE/JRSTR TAPE FORMAT - FOR HP INTERNAL USE ONLY - 2 DEBUGGING AIDS CMM3, CMM4 and CMMM +------------------------------------------------------+------------------+ | | | | DEBUGGING AIDS | CHAPTER 2 | | | | +------------------------------------------------------+------------------+ 2.1 CMM3, CMM4 AND CMMM PROCEDURE NAMES:CMM3, CMM4 AND CMMM PART NUMBER:24999-16052, 24999-16202 AND 24999-16201 DESCRIPTION: CMM3, CMM4 and CMMM can be used as a debugging aid for program development or as tools for trouble shooting. They allow the user to examine or modify memory cells, to list, system tables and peripheral information, to trace program linkage lists, and to modify the disc. CMM3 should be used for RTE II and RTE III, CMM4 for RTE-IV and CMMM for RTE M USAGE: CMM3 can be called by a command RU,CMM3 CMM4 can be called by a command RU,CMM4 CMMM can be called by a command RU,CMMM CMM4 cannot be run from multipoint terminals. When the CMM program is ready, a prompting character "-" is displayed and it waits for the following commands to be entered. DESCRIPTION OF CMM COMMANDS: Numbers used for parameters may be entered in decimal(nn) or octal(nnb) form. The standard output is produced in one word per line in decimal, octal, and ASCII along with the location. In addition, CMM4 prints symbolic output (inverse asemble). Any commands which produces more than one word of output may be appended with PK (e.g. INPK,6,10). It causes the output to be produced in 8 words of octal and ASCII per line instead of one word per line. - FOR HP INTERNAL USE ONLY - 3 DEBUGGING AIDS CMM3, CMM4 and CMMM COMMAND DESCRIPTION ?? Displays all available CMM commands with description. ??,xx Displays syntax format for the command xx. ??,LI /E, EN, or EX Exits from CMM ID,xxxx Displays ID segments of the program xxxx. If the program is a segment, 9 words are displayed; otherwise, 28 words are displayed. ID,n Displays all ID segments. n=any number. ID,FMGR ID,1 EQ,n1 Displays the contents of equipment table EQ,n1,n2 entries n1 through n2. EQ,4 EQ,1,9 DR,n1 Displays the contents of device reference DR,n1,n2 table entries n1 through n2. Each entry is displayed in two parts. DR,1 DR,1,5 IN,n1 Displays the contents of interrupt table IN,n1,n2 entries n1 through n2. ͞ IN,6 IN,6,13 LM,n1 List n2 memory locations starting at n1 LM,n1,n2 address. LM,2000B LM,2000B,300 TA Displays complete track assignment table TA,lu# if the logical unit is not specified; TA,lu ,trk , of trks otherwise, the track assignment for the system disc(lu=2) or auxillary disc(lu=3) as many tracks specified from the specified track. TA,2 PM,n1,n2 Patch memory address n1 with the value n2. The contents of n1 followed by the message - FOR HP INTERNAL USE ONLY - 4 DEBUGGING AIDS CMM3, CMM4 and CMMM "YES" or "NO" are displayed. Type "YES" to patch it; otherwise, type "NO" to quit. PN,2000B,100B F/,xx,n1,n2 Find all occurrence of value xx in next n2 locations starting at address n1. F/,77B,2000B,200 LI,xxxx,# of words List the address of the entry point name xxxx. LI,CMM3,5 DI,xxxx List the disc address of the 4 word dictionary that describes the entry point xxxx. DI,CMM3 LE List all entry points in the system LL,lu # Change the list device tfo lu . It is initially set to the terminal where the RU,CMM3 command was entered. LL,6 TR,n1 Traces a threaded list starting at the TR,n1,n2 address n1 until the address contains the value n2. If n2 is omitted, the value of 0 or negative number terminates the trace. TR,1711B XT,n1 It is the same as TR except that it traces XT,n1,n2 the system map. DP,n Displays the value n in octal, decimal, and ASCII format. DP,3479 DL,lu,trk,sctr,# of sctrs Disc listing of any number of sectors starting at the specified sector. DM Disc modification in interactive mode as follows: MODIFY OP SYSTEM ? YES OR NO ? LU,TRK,SECTR,WORD,VALUE type lu #, track #, sector #, word # to specify the address and the value to be entered. The contents of the specified address is displayed. If it is the cell to be changed - FOR HP INTERNAL USE ONLY - 5 DEBUGGING AIDS CMM3, CMM4 and CMMM type "YES"; otherwise, type "NO". /D terminates DM mode. DS,lu #,trk #,value Scans the disc and displays all occurrences of the value found on the track. Use this information with DM to unpurge files. XL,n1 List the contents of n2 locations in the XL,n1,n2 system map starting with the address n1. XL,46000B XL,46000B,100 XF,n1,n2,n3 Scans for the value n1 in next n3 locations in the system map strating at n2 address. XF,111B,46000B,1000 XP,n1,n2 Patch the system map at the address n1 with the value n2. LP,xxxx,n List the absolute program xxxx on disc. The sector number corresponding to the relocatable address n is listed. PG,pg #,# of words,offset List any number of words starting at the first word of the page plus offset PP,pg #,offset,value Patch a word in physical memory at offset in page. physical memory starts at page 0. NS,# of sectors Set number of sectors per track. If two NS,# of sectors,# of sectors values are entered, the second value will be used as the number of sectors per track in the new track of the MS command. MS,lu1,track1,sector1,lu2,track2,sector2,# of sectors Move disc sectors from one track and sector to another. Use the NS command if the source and destinAation LU's have a different number of tracks per sectors. FP Footprint command. Displays the last 190 past disc modifications. The following commands are not available in CMM3: PP NS MS FP - FOR HP INTERNAL USE ONLY - 6 DEBUGGING AIDS CMM3, CMM4 and CMMM The following commands are not available in CMMM: TA LI DI LE LP PG PP NS MS FP A more complete description of CMM commands, and a "How To" primer are included as appendix C. - FOR HP INTERNAL USE ONLY - 7 DEBUGGING AIDS PATCH 2.2 PATCH PROCEDURE NAME:PATCH PART NUMBER:24999-16100 DESCRIPTION: Patch is a program which can be used to put patches into the operating system after it has been booted up. Patch is normally run from the WELCOM file. USAGE: Patch can be scheduled with: RU,PATCH,terminal lu,file name where terminal lu is used to log error messages and file name is a binary absolute file (type 7) containing the patches to be made. EXAMPLE: Change program LOADR name to XXADR upon bootup. 1. Using CMM3, find word 13 of the ID segment of LOADR (23435B). 2. Assemble the following program into file PATCH1::-2 ASMB,A,L g ORG 23435B ASC 1,XX END 3. Put the following statement into the WELCOM file: :RU,PATCH,1,PATCH1::-2 ERRORS: 2 - First parameter not integer 3 - Second parameter not a namr 4 - File is not Binary Absolute (type 7) 6 - Checksum does not compute 7 - Record too large - FOR HP INTERNAL USE ONLY - 8 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF +------------------------------------------------------+------------------+ | | | | DATA COMMUNICATIONS DEBUGGING UTILITIES | CHAPTER 3 | | | | +------------------------------------------------------+------------------+ 3.1 DSINF PROCEDURE NAME:DSINF PART NUMBER:24999-16215 DESCRIPTION: DSINF is a program to printout DS/1000 internal information. It allows the user to examine EQT's, information stored in SAM and information The source code is written with the following assembly options: "N" 1000-1000 and 1000-3000 version "Z" 1000-3000 only (no DEXEC or NRV) The relocatable code for the "N" option is %DSINF, and for the "Z" option is %DSIN2. Only %DSINF is included on the software service kit. %DSIN2 should be used when no other 1000's are connected to a node or when program size is a critical factor (%DSIN2 is about a page shorter than %DSINF). Both cannot be generated into the same system because they have the same program name. DSINF is a type 19 program: background disc residentQ with access to Subsystem Global Area. The default priority is 65. It does not use the end of its partition, so there is no advantage to assinging extra pages. The 1000-1000-3000 version requires six pages while the 1000-3000 version requires five. DSINF will not work in a non-DMS system (RTE-M II) USAGE: Run DSINF from RTE with: RU,DSINF,,,,, The run-time parameters have these meanings: - FOR HP INTERNAL USE ONLY - 9 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF The logical unit number of the input device. The default is the number of the scheduling terminal passed by MTM or 1. If the input device is interactive (uses DVR00, DVR07 or DVR05 and subchannel 0), a prompt is printed on the device before each read. The logical unit number of the device where information is printed. The default is the input LU (if interactive) or 6. A control word which specifies DSINF will be run noninteractively. The functions which take place are determined by the bits set: DECIMAL VALUE PRINT THIS INFORMATION ------- ------------------------------ 1 available memory suspend list 2 I/O classes 4 DS/1000 values 8 dump of SAM block 16 DS/1000 lists 32 Nodal Routing Vector 64 DS/1000 EQT entries For example, to print the I/O class and DS/1000 values on your terminal, type RU,DSINF,,,6. To get all the functions, type RU,DSINF,,,177B. When DSINF runs non-interactively, it prints the time and node number as a heading. The node number where I/O is to occur. Default is local node (-1). Set to a non-zero value when the node number is 0 (to distinguish it from the default). If DSINF is scheduled with wait from REMAT (RW,DSINF), the and parameters are not needed. DSINF will run in the remote node but will perform its I/O operations at the local node. The 1000-3000 version (%DSIN2) will not run remotely. DSINF reuses its scheduling parameters if new ones are not provided This allows DSINF to run non-interactively in the time list. For example, suppose you want the I/O class and DS/1000 lists information printed on LU 6 every hour. You would enter the RTE commands *IT,DSINF,4,1 - FOR HP INTERNAL USE ONLY - 10 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF *ON,DSINF,NOW,,6,18 Because of this feature, you should provide your terminal's LU if you run DSINF from a non-MTM terminal. Otherwise it will use its previous parameters. DSINF will not execute unless the node has been initialized by LSTEN. If the node hasn't been initialized, DSINF prints "RUN LSTEN FIRST!" COMMANDS In interactive mode, DSINF recognizes the following commands: AV available memory suspend list CL I/O classes VA DS/1000 values DU  dump of SAM block LI DS/1000 lists NR Nodal Routing Vector EQ DS/1000 EQT entries EQ,N print information on EQT N /E OR EX terminate DSINF All other characters cause the functions to be listed on the output device. NOTE: If the relocatable %DSIN2 is used, the NR command is not recognized and the EQ command prints DVG67 information only. SAMPLE OUTPUT FOR EACH COMMAND 1. The available memory suspend list AVAILABLE MEMORY SUSPEND LIST PT SZ PRGRM T PRIOR AMT.MEM RN FATHER ---------------------------------------------------------------------- 5 5 SON 3 99 3608 F GF 5 5 DAVEM 3 99B 3708 RN DAVEE GYLRD LENDR WILAM JASON FMGR ---------------------------------------------------------------------- In this example, two programs are in the available memory suspend list. "SON" is in partition 5, requires 5 PAGES, is a type 3 program, has priority 99, has requested 3608 words of system available memory, and was scheduled by "F". "F" was scheduled by "GF". "DAVEM" has the same information with the following exceptions: the "B" following the priority indicates it is being run in batch mode, the amount of memory is 3708 words, the "RN" indicates a resource number has been locked, and his "ancester" programs are as follows: FMGR scheduled JASON, who scheduled WILAM, who scheduled LENDR, who scheduled GYLRD, who - FOR HP INTERNAL USE ONLY - 11 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF scheduled DAVEE, who scheduled DAVEM., if no programs are waiting for memory, DSINF prints AVAILABLE MEMORY SUSPEND LIST IS EMPTY 2.I/O CLASSES DSINF prints the following: I/O CLASS INFORMATION 40 CLASSES IN SYSTEM CLASSES IN USE: CLASS STATE GET POSSIBLE OWNER 27 GT PROGL ASMB LSTEN 28 GT OPERM ASMB LSTEN 29 GT RFAM ASMB LSTEN 30 GT EXECM ASMB LSTEN 31 GT PTOPM ASMB LSTEN 32 GT EXECW ASMB LSTEN 33 GT CNSLM ASMB LSTEN 34 GT DLIST ASMB LSTEN 35 GT QCLM ASMB LSTEN 36 GT RTRY ASMB LSTEN 37 GT GRPM ASMB LSTEN 38 GT RPCNV ASMB LSTEN 39 GT RQCNV ASMB LSTEN 40 AL ASMB LSTEN 26 CLASSES AVAILABLE Each of the classes in use can be in one of the following three states: AL -- the class has been allocated but no program is waiting to receive data from it. GT -- the class has been allocated and the program named in the "GET" column iswaiting on it for data via a class I/O "GET" call. BU -- the calss has been allocated and data is currently waiting. The number of buffers and their total size is printed on one line and the allocation information is printed on a second line. The possible owner field lists the programs which may have allocated the class. For slave monitors, this would be LSTEN (unless LSTEN was - FOR HP INTERNAL USE ONLY - 12 DATA COMMUNICATIONS DEBUGGING UTILITIES  DSINF removed from the system after initialization). Because of the way RTE maintains its I/O class table, it is impossible to determine exactly which program originally allocated a class. If the program which allocated the class has been removed from the system, or removed and later restored to a different ID segment address, it will not appear as a possible owner. If a program is aborted while waiting with a get, the get program name will be . 3.DS/1000 VALUES DSINF prints the following information in response to the VA command: DS/1000 VALUES: RESOURCE NUMBERS: OWNER LOCKER TABLE ACCESS 40 LSTEN QUIESCENT 39 QUEZ "LISTEN" 38 TIMEOUT VALUES (SEC): MASTER T/O 45 SLAVE T/O 30 REMOTE BUSY WAIT 3 REMOTE QUIET WAIT 0 21 RFA FILES MAY BE OPEN HP3000 IS ON LU 12 If an HP 3000 is not connected to the node, the QUEZ "LSTEN" resource number and HP 3000 LU are not printed. For the resource numbers, the name of the owner program should be because all DS/1000 RN'S are allocated globally. Under normal conditions, the table access and quiescent RN'S are not locked ( is the locker) and the QUEZ RN is locked globally. in the above example, LSTEN has not completed initialization and has the table access RN locked locally. The quiescent RN is locked globally when the system is quiesced. 4.DUMP OF SYSTEM AVAILABLE MEMORY BLOCK DSINF dumps the locations used for transaction control blocks and the HP 3000 transaction status table. CM [See material in the DS/1000 lists section for information on TCB'S.] DUMP OF TCB BLOCK LOC OCTAL CONTENTS OF LOC THROUGH LOC+4 - FOR HP INTERNAL USE ONLY - 13 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF 55610 55615 42123 27461 30060 30040 55615 55622 32057 33467 20122 52105 55622 55627 44511 20055 30462 31464 55627 55634 33470 34460 24450 23446 55634 55641 21442 20500 25452 54417 55641 55646 57062 20044 42516 42040 55646 55653 46501 52040 0 36516 55653 55660 0 55725 372 1221 55660 55665 1 55655 367 1216 55665 55672 36122 55701 100035 613 55672 0 2 55732 367 1222 DUMP OF HP3000 TRANSACTION STATUS TABLE LOC OCTAL CONTENTS OF LOC THROUGH LOC+7 55677 0 0 0 0 0 0 0 55706 0 0 0 0 0 0 0 55715 0 0 0 0 0 0 0 55724 0 0 0 0 0 0 0 55733 0 0 0 0 0 0 0 55742 0 0 0 0 0 0 0 Every time an HP 3000 user makes a master request to the HP 1000, an entry is made in the transaction status table (TST). If there is no HP 3000 connected to the node, the TST table is not printed. Each entry in the TST consists of 14 words (two lines of the dump): WORD 1 - DS/1000 stream (0 if the table entry:` is not in use) WORD 2 - local sequence number WORD 3 - holding class number WORD 4 - monitor class number WORD 5 - call type code WORD 6 - mask word (POPEN) (the rest of the words are from the DS/3000 fixed format header) WORD 7 - BITS 8-15: length of DS/3000 request (words) BITS 0- 7: DS/3000 message class WORD 8 - reserved for future use WORD 9 - DS/3000 stream WORD 10 - reserved for future use WORD 11 - BITS 8-15: from process number BITS 0- 7: to process number WORD 12 - local sequence number WORD 13 - MPE sequence number WORD 14 - number of bytes in parameters and data 5.DS/1000 LISTS DSINF prints the number of entries in each of the DS/1000 lists. If a list has entries, DSINF prints the address of the first TCB in the list. After the LI or DU command has been completed, the same list information will be printed for the lists until a new dump of SAM is taken. The lists always reflect the state of the TCB's in the previous dump. - FOR HP INTERNAL USE ONLY - 14 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF There are three types of active transaction control blocks: PROCESS NUMBER LIST ENTRIES. An entry is made in this list each time an HP 1000 user issues a successful HELLO to an HP 3000. The entry is deleted after a BYE. The words in the TCB have these meanings: WORD 1 - address of next entry in list (0 indicates end) WORD 2 - reserved for future use WORD 3 - MPE session main process number WORD 4 - logging device LU number WORD 5 - BIT 15: when seM2t, indicates a bad entry BITS 0-14: logon program's ID segment address MASTER LIST ENTRIES. The master list contains an entry for each master request currently outstanding. The words in the TCB have these meanings: WORD 1 - address of next entry in list (0 indicates end) WORD 2 - BIT 15: UPLIN may set this bit BIT 14: set for requests to HP 3000 BITS 8-13: reserved for future use BITS 0- 7: timeout counter. Timeout occurs when the counter reaches octal 377. WORD 3 - local sequence number WORD 4 - BIT 15: when set, indicates long master timeout (about twenty minutes) BITS 0-14: master class number WORD 5 - BIT 15: when set, indicates a bad entry BITS 0-14: master program's ID segment address SLAVE LISTS ENTRIES. The slave lists contain an entry for each outstanding slave request. There can be a slave list for each enabled slave monitor. The words in the TCB have these meanings: WORD 1 - address of next entry in list (0 indicates end) WORD 2 - same as master list entry WORD 3 - local sequence number WORD 4 - origin sequence number WORD 5 - origin nodal address Any TCBs which are not in these three active lists are not currently being used and are in the null list. - FOR HP INTERNAL USE ONLY - 15 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF DS/1000 LISTS 0 ENTRIES IN MASTER REQUEST LIST ACTIVE SLAVE MONITORS: 1ST TCB STREAM CLASS MONITOR ENTRIES LOCATION 1 34 DLIST 0 2 33 CNSLM 0 3 32 EXECW 0 4 31 PTOPM 0 5 30 EXECM 0 6 29 RFAM 0 7 28 OPERM 0 9 27 PROGL 0 0 ENTRIES IN SLAVE LISTS 11 ENTRIES IN NULL LIST, STARTING AT 55610 0 ENTRIES IN HP3000 PROCESS LIST The HP3000 process list is not printed if no HP 3000 is connected. Slave monitor stream lists are not printed if the associated slave monitor has not been enabled by LSTEN. 6.NODAL ROUTING VECTOR DSINF prints the same NRV information as LSTEN: NRV SPECIFICATIONS: LOCAL NODE: 3, NO. OF NODES= 8 1: NODE= 1, LU= 7, TO= 90(SEC.) 2: NODE= 2, LU= 7, TO= 45(SEC.) 3: NODE= 3, LU= 0, TO= 0(SEC.) 4: NODE= 4, LU= 7, TO= 90(SEC.) 5: NODE= 5, LU= 7, TO= 90(SEC.) 6: NODE= 0, LU= 7, TO= 90(SEC.) 7: NODE= 33, LU= 7, TO= 90(SEC.) 8: NODE= 11, LU= 7, TO= 90(SEC.) LAST LOAD-NODE= 2 The last APLDR load-node (the last node from which a program was downloaded) is printed for RTE-M systems only. - FOR HP INTERNAL USE ONLY - 16 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF 7.DS/1000 EQUIPMENT TABLE INFORMATION DSINF prints the following for each EQT with driver type 65: DVA65 EQT INFORMATION EQT 7, LU 7: WORD VALUE MEANING WORD VALUE MEANING 1 0 I/O LIST ADDRESS 2 30702 INITIALIZATION ADDRESS 3 31443 CONTINUATION ADDR 4 10125 STATUS/UNIT/SUBCHNL* 5 32401 AV/TYPE/STATUS* 6 107 CONWD 7 0 DATA BUFFER ADDR 8 14 DATA BUFFER LEN 9 0 REQUEST BUFFER ADDR 10 0 REQUEST BUFFER LEN 11 31467 COROUTINE ADDRESS 12 2000 CURRENT STATUS* 13 34145 EQT EXTENSION ADDR 14 177775 NOMINAL TIMEOUT 15 0 MICROCODE TIMEOUT 16 1 DATA TRANSFER COUNT 17 0 LAST WORD RECEIVED 18 0 VPW/REPLY REQ LENGTH 19 0 DPW/REPLY DATA LEN 20 0 TOTAL BLOCK TRANSFER 21 0 TOTAL RETRIES 22 34530 NEW REQ ID SEQ ADDR *BIT BREAKDOWN 15 12 9 6 3 0 WORD 4 0 0 0 1 0 0 0 0 0 1 0 1 0 1 0 1 WORD 5 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 WORD 12 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 Note that EQT words 16 through 22 are in the EQT extension. If an HP 3000 is connected, the following is printed: DVG67 EQT INFORMATION EQT 12, LU 12: WORD VALUE MEANING WORD VALUE MEANING 1 0 I/O LIST ADDRESS 2 32033 INITIATION ADDRESS 3 32001 CONTINUATION ADDR 4 100014 STATUS/UNIT/SUBCHNL* 5 33400 AV/TYPE/STATUS* 6 0 CONWD *BIT BREAKDOWN 15 12 9 6 3 0 WORD 4 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 WORD 5 0 0 1 1 0 1 1 1 0 0 0 0 0 0 0 0 SLC LONG TERM STATISTICS  0 READ REQUESTS 0 WRITE REQUESTS 0 MESSAGES TRANSMITTED 0 ERROR-FREE MSGS RECV 0 LINE ERRORS 0 NAKS RECEIVED 0 BCC/PARITY ERRORS 0 LONG TIMEOUTS 0 RESPONSE ERRORS 0 RESPONSE REJ 0 WACK/TTD RECEIVED - FOR HP INTERNAL USE ONLY - 17 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF For both drivers, words 4 and 5 have the standard RTE meanings: WORD 4-- BIT 15: 1 if DMA required BIT 14: 1 if automatic buffering is used BIT 13: 1 if driver is to process power fail BIT 12: 1 if driver is to process time-out BIT 11: 1 if device timed out BITS 6-10: last subchannel addressed BITS 0-5: select code for I/O controller WORD 5-- BITS 14-15: 0 if I/O controller is available, 1 if disabled (down), 2 if busy, 3 if waiting for DMA BITS 9-13: driver type (65 for DVA65, 67 for DVG67) BITS 0- 8: status DVA65 maintains status bits in words 5 and 12 WORD 5-- BIT 7: write flag for GRPM BIT 6: parity or protocol error BIT 5: remote busy BIT 4: stop received BIT 3: time-out BIT 2: simultaneous request reject BIT 1: request pending on a write, or not pending on a read BIT 0: request completed with no errors WORD 12-- BIT 14: microcode read/write flag BIT 13: flag for write retry in progress BIT 12: last successful operation (1 = write) BIT 10: listen mode enabled BIT 9: request pending BIT T 6: broken line BITS 0-5: retry counter or broken line counter - FOR HP INTERNAL USE ONLY - 18 DATA COMMUNICATIONS DEBUGGING UTILITIES DSINF DVG67 maintains status in bits 0-7 of word 5: OCTAL CODE ABORT? MEANING 0 NO the request completed normally 1 YES invalid request 2 YES request incompatible with line state 4 YES local hardware failure 5 NO end-of-transmission (EOT) received 6 NO disconnect (DLE EOT) received 7 YES long timeout occurred 10 YES ENQ received in response to EOT 11 YES data overrun 12 YES maximum number of NAKS received 13 YES maximum number of ENQS sent 14 YES reverse interrupt (RVI) received 15 NO ENQ received in response to ENQ sent 16 YES NAK received in response to write inquiry 17 YES maximum number of ENQX received in write conversational situation 20 YES incorrect response (not NAK) to TTD 21 YES impossible situation 22 YES text error Bits 5-7 are the block specification bits: BIT 5 = 0 for no heading 1 for heading BIT 6 = 0 for nontransparent mode = 1 for transparent mode BIT 7 = 0 for ETX ending block 1 for ETB ending block - FOR HP INTERNAL USE ONLY -  19 DATA COMMUNICATIONS DEBUGGING UTILITIES NDTDU 3.2 NDTDU PROCEDURE NAME:NDTDU PART NUMBER:24999-16213 DESCRIPTION: This program formats and prints the information stored in a DS/1000 NTD (network description table) file created by NTDGN. Because it does not use RFA or DEXEC calls, it can be run either before or after a node has been initialized by LSTEN. NDTDU uses the area at the end of its partition to read the NTD file records. Tests that have been run in RTE-III indicate a network file defining 180 nodes should fit without adding extra pages. For each additional page given to NDTDU, it will be able to add 341 nodes. NDTDU is designed to run as a background partition-resident program. It is not designed to run in RTE-M II systems. When loaded on-line, NDTDU must be given access to subsystem global area. It's default priority is 89. USAGE: Run from RTE with: *RU,NDTDU,,, The scheduling parameters have the following meanings: the first parameter is either the namr for the NTD file (in the format name:security:cartridge) or the lu of an interactive device where the namr can be read. default is 1 or the mtm lu number. the lu of an output device where information can be printed. Default is same as . the number of columns on the print page. default is 80. minimum is 50. maximum is 128. If the command *BR,NDTDU is entered, NDTDU stops printing, closes the NTD file, and terminates. - FOR HP INTERNAL USE ONLY - 20 DATA COMMUNICATIONS DEBUGGING UTILITIES NDTDU ERRORS NDTDU detects several errors and reports them to the user. " *** FMP ERROR - NNNNN ***" The indicated FILE MANAGER error occured when NTDGN tried to access the NTD file. See batch-spool monitor manual for further information. " *** BAD DATA IN FILE ***" The specified file does not conform to the NTD format in one of the following areas: type is not 9, first word of record >= 0, or the timeout/lu word is negative. " *** TOO MANY NODES. MAX = NNNNN ***" The NTD file contains more nodes than NDTDU can handle. (NDTDU prints the maximum number of nodes that it can process.) Reload NDTDU and assign it another page. OUTPUT NDTDU prints a header of three lines: 1. The namr given it for the NTD file 2. The local node number (or a blank line if the node isn't initialized) 3. The number of nodes in the network The "to" node numbers are printed across the page and the "from" node numbers are printed down the left side. At the intersection in the resulting matrix two numbers are printed. the top number is the LU number used to communicate between the "from" and "to" nodes. The lower number is the timeout value for the link. When the "from" and "to" numbers are the same, both values are zero. If it is impossible to communicate between the nodes, the numbers are left blank. NDTDU prints as many "to" node numbers as will fit in the given width. If they do not all fit, NDTDU will make as many passes as are needed through the file (after all the "from" numbers are printed) to handle the remaining "to" node numbers. - FOR HP INTERNAL USE ONLY - 21 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 3.3 TRC65,DRT65 PROCEDURE NAME:TRC65,DRT65 PART NUMBER:24999-16225,24999-18226 DESCRIPTION: 1)Displays line protocol sent and received (data words sent are not displayed). Effectively turns any terminal into a logic analyzer for the link. 2)Displays driver state with each word. A legend is printed which provides state-code description. 3)Allows tracing all lines, or allows you to focus attention on only one. 4)Displays TBG 'tick' count, providing time between event information. 5)Displays pass number and time-of-sample, flagged in inverse video if the printout program has gotten behind the driver. 6)Displays the class number allocated and resource number allocated. You may need this information if you have to bring it out of its resource number lock suspension, e.g., if you asked for a trace of the wrong line. 7)Can save 'trace' buffer information in a disc file for high-speed and/or continuous usage purposes. When the last record of the file has been written, the program will either terminate, or rewind the file, causing new data to be written over old. The message "/TRC65: REWINDING FILYE" is printed the first time to tell you that the data in the circular file is all valid (if you examined the data in the file prior to printout of this message, an indeterminate number of records at the end of the file would contain garbage). Since the file is opened non-exclusively, you may examine the circular file while it is being logged by using another copy of this program. You should be aware that you may occasionally see very strange-looking printouts, as there is no synchronization between the two copies of this program. However, you may find this a useful feature. for example, since the driver provides synchronization with the program via a resource number, the program will "hang up" if the line is - FOR HP INTERNAL USE ONLY - 22 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 inactive. You can look at what's in the file with another copy of the same program, while still leaving the first copy "armed",i.e., ready to log new data records into the file as soon as they become available. 8)You can get a printout of the data stored in the circular data file (see 7 above). when taking data from a data file, the program waits two seconds before printing each "screen". This is to give you a chance to examine the previous screen. If you need more time, two seconds is more than enough time to obtain system attention (the device should be unbuffered, though). Hold its attention as long as you need to examine the screen, then type a carriage return or space carriage return. 9)Usable with terminals from ASR-33 to the latest HP 264x termianl. The display will be enhanced, however, if output is to a DV.05 or DV.07 type of terminal, enhancements include: Inverse video for pass number when not sequential(i.e., display does not show consecutive trace records) Inverse video for all protocol words received black video for transmissions All abnormal protocol words ('RLM', 'RLW', 'STOP') are flashed 10)Keeps counts of the number of "RC", "RLM", "RLW" and "STOP" protocol words seen, thus providing an indication of line quality somewhat more exact than the statistics maintained by the driver. 11)Can optionally print or log either all 'trace' buffers or only those containing 'RLW', 'RLM' or 'STOP' (i.e., only those in which an error occurred). Data source may be either "live" or from disc file. 12)Prints the number of abnormal protocol words seen in each record, and summary of the total number of protocol words seen when the program terminates. 13)A rough estimate of the line quality may be obtained by counting the number of 'RLM' words observed and comparing to the number of messages sent during the observation interval. The accuracy of this method improves as the observation period increases. 14)Works with hardwired and modem links. This program operates with the cooperation of the driver (a version of DVA65 supporting 'trace' must be used), but without special microcode. d - FOR HP INTERNAL USE ONLY - 23 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 It displays only the protocol words which the software driver itself sent at the end of the transfer, nor the 'TNW' which separates them. A 'trace' may be set up on either or both sides of the line. USAGE: *ON,TRC65,[lutty[,luprin[,mode]]] lutty = LU of operator console. Used for dialog and error messages. Default is your terminal (MTM environment), else 1. luprin= LU for printing trace table (specify only when trace table printout is desired to a unit other than . Default is lutty. Note: if luprin = 2, then all trace buffers will be recorded in their "raw" form on a disc file, whose name & size are then asked for by the program. The file will normally be circular, but you can specify that the program quit as soon as the last record is written (actually, on the attempt to write the next one after that). If the default (circular) option is taken, trace information is maintained in a circular fashion: old information is overwritten by new, the number of "fresh" trace buffers being determined by the size of the file. When the file is rewound for the first time, a message is printed to inform you that the data in the file is now valid (prior to this, data records towards the end of the file would contain garbage). Syntax is: filnam : sc : cr : : records for file Note that the parameter specifying of records for file is in the same position as file size when specifying a with "FMGR" syntax, and hence should be easy to remember. To obtain a formatted printout of this information, simply set the 'break' flag so the program will close the file. Wait for the program to print its termination message:: this will include the number of complete buffers logged. Then re-run it, specifying the file name in response to the question, "LINE LU?" Note: you will have to use the pass number to determine the oldest and newest entries. The program simply formats records starting from the first one in the file. : bit mask bit 0 = 0 causes program to wait until whole buffer is filled before printing. # 0 then program will print contents of trace buffer, continuously, without waiting for synchronization from - FOR HP INTERNAL USE ONLY - 24 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 the driver. bit 1 = 0 causes program to print driver state legend. # 0 inhibits printout of driver state legend. bit 2 used only when 'trace' data is being logged to a disc file. =0 causes program to automatically rewind file when last record has been written & begin writing new data over oldest data records. The message "/TRC65:rewinding file" is printed after the file is rewound the first time, thus notifying the user that the data in the file is completely valid. #0 causes program to terminate as soon as the last record has been wrsitten into the file (actually, when on the attempt to write the next record after that). The file is closed and the termination message is printed. bit 3 used to include or ignore 'trace' records containing no abnormal protocol words. =0: include all 'trace' records =1: include only those 'trace' records containing abnormal protocol errors. Note: this feature may be used either to log only those records containing errors, or to print only those records which contain errors. It will probably be found most useful to log all records into very large logging files, then print only those records in which errors occurred. It will still be possible to use the record number selection option on printout if it is necessary to determine the context of the "bad" records. However, by logging only exception conditions, over a long period of time, one might then go back later and print these records, using the summary printed at the end as a "figure of merit" for the particular communication line. "LINK LU, -LU TO TRACE ALL, OR ?" You are asked to specify the communication link LU to be traced. To "trace" activity on all links, enter the negative of any link LU. Enter zero to terminate completely, release all resources, and disable trace mode. The program checks the response. The only allowable responses are: - A file [,first record [,last record ]] first record number and last record number may optionally be specified, separated by commas. The defaults allow the whole file to be printed. You may use this to quickly scan through a large trace file in order to locate a particular area of concern, and then print that. If the last record number specified is less than the first, then only one record will be printed. - FOR HP INTERNAL USE ONLY - 25 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 Illegal if output to a file has already been specified. if an error occurs on the attempt to open the file, the error number will be printed: FMP ERR - nnn (where nnn = open error code) and the program terminates. - Zero - A valid link LU, or the negative of one (must be connected to a device of type 65) If none of the above, the message "illegal response" will be printed and the question will be repeated. To change the print LUs or trace mode, set the 'break' flag for this program, and re-schedule it. NOTE! NOTE! NOTE! 1)This program semi-permanently allocates a block of system available memory to be used as the trace buffer. This is a potential hazard if you leave it allocated for long periods of time (i.e., hours or days) because it may be located in 'SAM' such that it prevents large buffers from being allocated, thus producing a 'deadly embrace'. 2)This program allocates a class number and a resource number when it runs. They are stored in 'RES', so they can't be lost. If you must abort the program, ALWAYS re-run it again, specifying a trace LU of 0. This will release the class buffer, class number, and resource number. 3)The program locks itself in its partition wheGn it is logging data (except when the data source is a file). 4)"Escape sequences" are used when the print device is a terminal. When used on multipoint terminals, you MUST have the update which supports transparency mode. 5)Some protocol words will not show up in the 'trace' because they are handled completely within the microcode. This includes the two parity words and the intervening 'TNW'. Also, there is an asymney between what one observes on the receiving side, and what one sees on the transmitting side. 6)When comparing 'trace' printouts between two nodes ( should be logging into disc files), note that the TNWs sent by microcode will show up on the receiving side by not on the transmitting side. This means you should make allowances for the "lack" of two TNWs when comparing word-for-word between sides. - FOR HP INTERNAL USE ONLY - 26 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 The program must be loaded with access to SSGA. Program type may be either 2 or 3. The protocol words are printed two to a line, in the order:

(repeated twice) = 'x' if word was transmitted = 'r' if word was received. The line will be displayed in inverse video if the terminal is driven by DV.05 or DV.07. An up-arrow will be printed if there was a time-out indication. A right-arrow (->) will be printed to the left of for the oldest entry. Protocol word mnemonic: If data word does not match any of these possibilities. For example, the data lengths will not *z match. = protocol word in octal. = driver state number. A legend is printed when this program first begins execution, giving a brief description of each driver state. For detailed information, it is helpful to have a driver listing. = eqt number (useful in separating activity among various lines), printed in decimal. = low 16 bits of $TIME word when entry was made, converted to decimal. This provides an elapsed time indication between this entry and the previous one. Each tick represents ten milliseconds. To change the size of the trace buffer, change '.SIZE'. the size must be a multiple of 4, plus 2 extra words. It must not be less than 128 words if disc files are to be used. This program requires the version of DVA65 which supports 'trace', and the revision 1901 version of 'RES' or subsequent. the 'trace' version of the driver produces almost no increased overhead when trace mode is disabled, and very little while it is enabled, since it is of most use with high error-rate lines, which implies modems, and the existing driver adds a very insignificant overhead to transmissions because modems are so slow. The trace buffer format is described in the source for DVA65. The format of the disc records is almost identical, except that the time at which the record was obtained and the local node number are contained in the three words immediately preceding the rest of the record as described. The format of the time of day is exactly the form of the two "$TIME" words in RTE. the record size is 128 words, - FOR HP INTERNAL USE ONLY -  27 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 the trace buffer size is 122 words (enough for 30 entries, or 15 lines on the screen). DVA65 PROTOCOL (as recorded in 'trace' buffers) The parity word exchange and all data words are not recorded in the 'trace' buffer. See the Network Manager's Manual for a complete protocol description. The description below shows both sides. If you were observing from, say, the "transmitting side", then arrows to the right would appear as "x", arrows from the right would appear as "r" (received). The reverse would, of course, be true for observers at the "receiving side". TRANSMITTING SIDE RECEIVING SIDE ----------------- ------------------ RC ---------------------------------> <-------------------------------- TNW -----------------------> <---------------------------------- (echo of length) -------------------> <-------------------------------- (echo of length) note: bit 15 set if in closed loop. TNW ----------------------------> <------------------------------(note:TNW sent by microcode, and therefore not seen by "TRACE" on this side) Data transmission is handled by microcode. No trace entries are made for any data words, nor for the parity words nor intervening TNW. When transmissionӢ is complete, the sending side will send a 'TNW' if it was good, or 'RLM' if a retry is to be attempted, or 'STOP' otherwise. TNW ----------------------------> or RLM ----------------------------> <-------------------------------- TNW or STOP --------------------------> - FOR HP INTERNAL USE ONLY - 28 DATA COMMUNICATIONS DEBUGGING UTILITIES TRC65,DRT65 DRIVER LEGEND: STATE 0: Initiating read, sending TNW STATE 1: Writing, sending RC STATE 2: Writing, sent RC, expect TNW STATE 3: Writing, sending data length STATE 4: Writing, sent data lnth, expect echo STATE 5: Writing, sending request length STATE 6: Writing, sent req. lnth, expect echo STATE 7: Write retry STATE 8: Request preamble write failure--retry STATE 9: Writing, simult.rqst, am backing down. STATE 10: Writing, sending TNW, expect TNW STATE 11: Performing write retry STATE 12: First interrupt in LSTEN mode, exp.RC STATE 13: Power failed! STATE 14: Receiving, expecting data length STATE 15: Echoing data length, expect req. lnth STATE 16: Receiving, expecting req. lnth STATE 17: QUEUE busy, sending 'STOP' STATE 18: Request to send 'STOP' STATE 19: Read rqst, echoing rqst lnth STATE 20: Read rqst, checking response STATE 21: Block has been read, waiting for TNW STATE 22: Block read but last ctrl unrec STATE 23: Checking response to RLW  STATE 24: 'STOP' received during xmit--abort STATE 25: Parity error(read or write) STATE 26: Protocol failure STATE 27: Time-out occurred-end of rqst STATE 28: Simultaneous request retry STATE 29: LSTEN mode aborted with stop - FOR HP INTERNAL USE ONLY - 29 DATA COMMUNICATIONS DEBUGGING UTILITIES PSMON PROCEDURE NAME:PSMON PART NUMBER:24999-16224 DESCRIPTION: Provides "passive monitor" capability for DS/1000 12665 hardwire links. Useful in those cases where 'TRC65' does not show enough (this program displays all data on the communication link, not just certain protocol words). REQUIREMENTS: 1) Separate computer 2) Two HP 12665 interface cards (in addition to those used to connect the computer to a DS/1000 network, if any) 3) Connecting cables modified for passive monitoring. 4) An RTE operating system (may be RTE-M) with DS/1000 software generated in. USAGE: 1) Install two interface cards in the computer and hook them up to the line to be traced with a cable modified to provide passive monitoring. 2) Edit the source for 'PSMON', specifying the select codes for the two interface cards as the definitions for "XMTIF" and "RCVIF". All data taken from the interface in the "XMTIF" select code will be considered as "transmit" data. All data from the "RCVIF" select code will be considered as "receive" data. Be sure to writ_e down which is which so you can determine data direction from the printout. 3) Re-assemble the source and load the program in the computer to be used for monitoring. 4) Schedule the program: *ON,PSMON,[lutty[,luprin[,node[,mode[,points]]]]] lutty = Lu of operator console(must be capable of input & output) at local node. Used for dialog and error messages. Default is your terminal (MTM environment), else 1 NOTE : Special features are invoked if the terminal is driven using DVR05 or DVR07: 1) Each line which is 'recieved (as opposed to 'transmitted') is displayed in inverse video. - FOR HP INTERNAL USE ONLY - 30 DATA COMMUNICATIONS DEBUGGING UTILITIES PSMON 2) Abnormal protocol indications ('RLM', 'RLW', 'STOP') are highlighted: 'RLM' & 'RLW' are underlined, 'STOP' is shown blinking. Requires optional modules supporting these functions be installed in the 264X terminal used. luprin= LU for printing trace table if not the same as at remote or local node. Useful when hardcopy log is desired. Default is lutty. NOTE: If luprin = 2, then all trace records will be recorded in their "raw" form, either on a disc file or a remote device, such as a tape. The program will ask for the file parameters; enter the name of the file, security code, etc., or the LU of the remote device. When outputting raw data to a disc file, the file is  normally assumed to be circular: old information is overwritten by new, the number of "fresh" trace records being determined by the size of the file. When outputting to a remote device, such as a mag tape, all data is recorded. syntax is: filnam : sc : cr : : records for file or To obtain a formatted printout of this information, simply set the 'break' flag so the program will close the file, then re-run it, specifying the file name or device LU in response to the question, "FILE OR DEVICE TO GET 'TRACE' DATA?" NOTE: If disc files are not going to be used, you do not need to load the program with the FMP routines (CREAT, OPEN, CLOSE, READF, etc.), and may ignore these undefined symbols at load time. = remote node number for printout (allows you to use a computer without an output device of its own). Default is local node. If luprin = 2 then data logging is done locally, and this parameter has no effect. bit mask bits 0 not used bit 1 =0:(default) causes printout or logging of all data gathered. =1: causes program to ignore all data buffers which contain no abnormal protocol words. ('STOP', 'RLM', 'RLW') bit 2 used only when 'trace' data is being logged to a disc file. =0 causes program to rewind file automatically when last record has been written. New data overlays old. The message "/PSMON:REWINDING FILE" is printed after the first time to inform you that the data in the file is now valid.׺ - FOR HP INTERNAL USE ONLY - 31 DATA COMMUNICATIONS DEBUGGING UTILITIES PSMON = 1 causes program to terminate as soon as the last record has been written (actually, when the attempt is made to write the next one after that). The file is closed and the termination message is printed. = number of data points to log. Maximum allowable value, and also the default, is 2048 points. 5) The program will wait for activity on the communication link with the interrupt system off. Use 'REMAT' to create such activity. It is advisable to use a transfer file containing a large number of "TI" commands for the simple reason that the data will be far too voluminous otherwise. At any time, you may bring it out of its "waiting for data" loop by setting the sign bit in the switch register. For your own information, the program displays its internal "pseudo-clock" in bits 14 thru 0 of the switch register while it is waiting. NOTE! NOTE! NOTE! When gathering "live" data (i.e., not taking data from a disc file), this program turns normal RTE interrupt processing off!! This means that the system time-keeping and other real-time activities cease during this period. You must be sure that no other critical activities exist before using this program, and you may wish to re-set the system time-of-day afterwards. (Be sure to re-schedule all programs in the time list whose "time of next schedule" has been passed over. You can find out which ones these are from a 'WHZAT' printout). During the printout phase, normal RTE interrupt processing is restored and the system becomes an RTE again. You will be asked to specify the data source. Acceptable responses are: 1)File ---the name of a data file in which data was logged during some previous run. The cartridge reference number and security code may be specified in the usual way. 2)The logical unit of some device, typically a mag tape or mini-cartridge, on which data was logged during some previous run. The program will continue to read until an EOF or EOT condition or some other mag tape-related error condition is set. 3)Blanks--the program will take data "live", i.e., directly from the passive-monitor interface cards. - FOR HP INTERNAL USE ONLY - 32 DATA COMMUNICATIONS DEBUGGING UTILITIES PSMON To terminate this program while it is printing, set the "break" flag. To terminate it while it is gathering data (non-privileged interrupts are off), set the sign bit in the switch register. The print format shown below is actually repeated twice per line:

= 'x' if word was transmitted = 'r' if word was received.

= mnemonic if data word matches one of the protocol words. Note: since data is transmitted transparently over these links, occasional "matches" to protocol words may appear. You will have to study the activity surrounding the "match" to determine if it is, indeed, valid.  Mnemonics: RC TNW RLM RLW STOP If not a match to above, then blanks are used. = protocol word in octal. = a pseudo-"clock" number which is incremented after checking the two interface cards for data. This provides some indication of elapsed time. Each tick represents about twenty microseconds or so, depending on whether data was available in this "pass" for the "receive" or "transmit" path or both. NOTE: to analyze any particular sequence, one must be familiar with the line protocol (see Network Manager's Manual for details). To change the size of the trace buffer, change ".SIZE". It must be a power of two. The "trace" buffer format is: buffer: 1st data word observed buffer+1: buffer+2:2nd data word observed " 3: . . etc. = "transmit" line or "receive" line flag, coded 0/1, and stored in bit 15. = 15-bit unsigned integer pseudo-"clock" value representing the time at which the data was available. - FOR HP INTERNAL USE ONLY - 33 DATA COMMUNICATIONS DEBUGGING UTILITIES PSMON Default select codes for the passive monitor cards are (note: the actual declaration in the source is shown to aid you in finding what to change): RCVIF EQU 16B "receive" line interface select code  XMTIF EQU 17B "transmit" line interface select code WIRING DIAGRAM FOR MODIFIED CABLE - FOR HP INTERNAL USE ONLY - 34 DATA COMMUNICATIONS DEBUGGING UTILITIES SLCIN 3.4 SLCIN PROCEDURE NAME:SLCIN PART NUMBER:24999-16214 DESCRIPTION: This program prints long term statistics and the event trace table maintained by the synchronous line control (SLC) package for links from DS/1000 to HP 3000 systems. In DS/1000, the implementation of SLC is handled by the module HSLC and the driver DVG67. The long term statistics and event trace table are maintained in the SSGA module D$EQT. (when DSINF is loaded on line it must be given access to SSGA.) In the currently released version, there are 100 words set aside for the trace table. This number can be changed by modifying the source code, re-assembling D$EQT, and re-generating the system. Each entry in the trace table contains two words plus one word for each event and state that occurs during the given request. Here is the format: +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ bits !15!14!13!12!11!10! 9! 8! 7! 6! 5! 4! 3! 2! 1! 0! +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ word 1 ! address of next entry ! +-----------------------+-----+-----------------+ word 2 ! v ! w ! x ! +-----------------------+-----+-----------------+Ab word 3 ! y ! z ! +-----------------------+-----------------------+ ! y ! z ! +-----------------------+-----------------------+ (y and z word repeated as many times as needed) v = completion status of request (see below) w = i/o request code (1=read, 2=write, 3=control) x = function code used in request (see below) y = SLC event number (see below) z = SLC state number that is the result of the event (see below) The trace buffer is circular; when the last word if filled, the next entry goes to the first word of the table. - FOR HP INTERNAL USE ONLY - 35 DATA COMMUNICATIONS DEBUGGING UTILITIES SLCIN The "station states" are the states SLC is in after each request when it is waiting for another request. The SLC initialize control request resets the trace table (all previous entries are destroyed). As requests are received by SLC, it uses the event and current state to address its state transition table. This tells it what action to perform and what state it will be in next. Thus, the trace table can show how the HP 1000 got out of step with the HP 3000 if something goes wrong. USAGE: Run from RTE with: RU,SLCIN, Where is the LU where the information is to be printed. Default is 1 or the multi-terminal-monitor LU. If the node has not been initialized by LSTEN, SLCIN will not print the SLC information. Instead it will tell the user to "RUN LSTEN FIRST!" If the node has been initialized, but the HP 3000 was not enabled, SLCIN prints "HP 3000 not enabled" and terminates. If the node has been initialized, SLC starts printing information. The SLC long term statistics are printed first, followed by the event trace table. The trace table includes the octal status, the function, and the event(s) and state(s) associated with the function. MEANING OF STATUS OCTAL CODE ABORT? MEANING 0 NO The request completed normally 1 YES Invalid request 2 YES Request incompatible with line state 4 YES Local hardware failure 5 NO End-of-transmission (EOT) received 6 NO Disconnect (DLE EOT) received 7 YES Long timeout occurred 10 YES ENQ received in response to EOT 11 YES Data overrun 12 YES Maximum number of NAKs received 13 YES Maximum number of ENQs sent 14 YES Reverse interrupt (RVI) received 15 NO ENQ received in response to ENQ sent 16 YES NAK received in response to write inquiry 17 YES Maximum number of ENQX received in write - FOR HP INTERNAL USE ONLY - 36 DATA COMMUNICATIONS DEBUGGING UTILITIES SLCIN conversational situation 20 YES Incorrect response (not NAK) to TTD 21 YES Impossible situation 22 YES Text error SLC FUNCTIONS READ FUNCTIONS-- READ INQUIRY Used to wait for the 3000 to bid for the line with an ENQ. 8 READ INITIAL Used to receive text from the 3000 after an ENQ is received. WRITE FUNCTIONS-- WRITE INQUIRY Used to bid for the line. send an ENQ, receive an ACK0. WRITE CONVERSATIONAL The normal way of sending and receiving text with the 3000: send a block, receive a block of text. Continues until EOT is received from 3000 or 1000 performs write reset. WRITE RESET Send an EOT to relinquish use of the line. WRITE DISCONNECT Send DLE EOT to inform 3000 that there is to be no more transmission of data. CONTROL FUNCTIONS-- CLEAR Disables the interface borad and severs the link between HSLC and DVG67. (inverse of initialize.) INITIALIZE Establishes the link between HSLC and DVG67. LINE OPEN Readies the line for read/write operations by initializing HSLC values. LINE CLOSE Disconnects the line and disables it for further read/write operations. (inverse of line open.) CHANGE THE ERROR RECOVERY PARAMETERS Resets the number of retries to 7 and the long timeout to 60 seconds. ZERO THE LONG TERM COMMUNICATIONS STATISTICS Resets all the long term statistics to zero. - FOR HP INTERNAL USE ONLY - 37 DATA COMMUNICATIONS DEBUGGING UTILITIES SLCIN SLC EVENTS These are the events reported by SLCIN. Some of these events are not possible under the current implementation. SLCIN ABBREVIATION FULL MEANING (IF NECESSARY) e ------------------ --------------------------- line open req line open request line close req line close request read inquiry req read inquiry request read initial req read initial request read continue RQ read continue request read repeat req read repeat request read/rev int req read with reverse interrupt request delay read write inqury req write inquiry request write cntnue req write continue request write conv req write conversational request WRT reset(EOT)RQ write reset request (write EOT) write discon req write disconnect request (write DLE EOT) delay write req delay write request ACK0 received ACK1 received WACK received RVI recv/sent RVI received or being sent ENQ received NAK received EOT received DLE EOT received TTD received text received bcc prty/fmt err bcc parity or format error detected text overrun garbage received bad id sequence short timeout long timeout low high mid SLC STATES SLCIN ABBREVIATION FULL MEANING (IF NECESSARY) ------------------ --------------------------- unopened control read ENQ read ENQ error check read req check read request type read - FOR HP INTERNAL USE ONLY - 38 DATA COMMUNICATIONS DEBUGGING UTILITIES SLCIN read text read RVI restricted read write ENQ write ENQ error ENQ-ENQ contentn ENQ-ENQ contention |; write write text write respns ENQ write previous response ENQ check response bad ACK received write retry ENQ rcv in write ENQ received in write or write conversational mode ENQ rcrd in writ second state: ENQ record in write or write conversational mode write converstnl write conversational write EOT read EOT rsponse read EOT response disconnect hang up (a disconnect) write TTD LOW, HIGH, AND MID EVENTS When low, high, or mid appears in a dump, the meaning is associated with the state on the line above (the state SLC was in when the event started) not the one on the same line (the state after the event completed). The low, high, and mid events have different meanings for different states. They are defined as follows: Read ENQ error low -- not defined high-- no error counter overflow mid -- error counter overflow: bad id Check read request type low -- read delay made in read state or read inquiry high-- read initial mid -- read delay made in restricted read state Read RVI low -- 2nd RVI request high-- 1st RVI request mid -- not defined Write ENQ error low -- error counter overflow, no bad id high-- no error counter overflow mid -- error counter overflow, bad id - FOR HP INTERNAL USE ONLY - 39 DATA COMMUNICATIONS DEBUGGING UTILITIES SLCIN ENQ-ENQ contention low -- Tretry counter overflow high-- no retry counter overflow mid -- not defined Previous response ENQ low -- retry counter overflow high-- no overflow--write mode mid -- no overflow--write conversational mode Check response low -- bad ACK received high-- RVI received mid -- good ACK received Bad ACK received low -- timeout flag not set or bad-response flag set high-- timeout flag set and bad-response flag not set (write conversational mode) mid -- timeout flag set and bad-response flag not set (write conversational mode) Write retry low -- retry counter overflow high-- no overflow--write mode mid -- no overflow--write conversational mode ENQ received (write or write conversational mode) low -- text not just received high-- text just received and ENQ not just sent mid -- ENQ just sent Second state--ENQ received in write low -- retry counter overflow high-- no overflow--write mode mid -- no overflow--write conversational mode Write EOT low -- line error high-- no line error mid -- not defined All other states low -- line error high-- not defined mid -- not defined - FOR HP INTERNAL USE ONLY - 40 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP +-----------------------------------------------------+------------------+ | | | | CRASH DUMP ANALYSIS | CHAPTER 4 | | s{ | | +-----------------------------------------------------+------------------+ 4.1 CDA4,SNPSH,CDMP,TDMP PROCEDURE NAME:CDA4, SNPSH, CDMP, TDMP PART NUMBER:24999-16197, 24999-16198, 24999-16199, 24999- DESCRIPTION AND USAGE: The crash dump analyze package provides a means by which a copy of a crashed system can be saved on a mini-cartridge and be examined and analyzedat a later time. The package consists of three parts: 1.!CDMP - the dump program dumps the first 32k of physical memory, the system map, the user map, and both port maps (ie the crashed system)to a mini-cartridge. 2.SNPSH - the snapshot program dumps a system's snapshot (ie entrypoint information) to a mini-cartridge. 3.CDA4 - the analyze program performs the actual examination and analysis of the crashed system. SNAPSHOT PROGRAM SNPSH is designed to run on-line on an up and running system. It will dump a snapshot of the system onto a mini-cartridge. RTE keeps a snapshot of the operating system on the disc. This snapshot contains all the entry point names, types and locations of all the modules (except type 8) that were included at generation time. SNPSH will read this snapshot from the disc and dump it to a mini-cartridge in 128 word records. To run SNPSH from a terminal: RU,SNPSH,ctu lu - FOR HP INTERNAL USE ONLY - 41 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP where ctu lu is the logical unit number of the cartridge tape unit to which SNPSH directsB its output. After successful completion the message: SNAPSHOT WRITTEN TO CASSETTE appears on the terminal. In order to operate correctly, CDA4 requires a type 1 file which contains the snapshot generated by SNPSH. This file should be obtained from the mini-cartridge created above using the FMGR command: :ST,ctu lu,name::crn:1:-1,BN where ctu lu is the logical unit number of the cartridge tape unit where the SNPSH output is located, name is the name of the file to contain the snapshot and crn is an optional cartridge reference number on which name is to becreated. The snapshot program need only be run once for a given generation, whereasthe dump program must be run once for every system crash. DUMP PROGRAM !CDMP is an absolute program which dumps a crashed system to a mini-cartridge. !TDMP operates similarly, but dumps the system to a magnetic tape. The first 32K of physical memory, the system map, the user map, the port A map and the port B map will be dumped. !CDMP or !TDMP must first be put on a paper tape or a mini-cartridge so that it can be loaded into memory by either the paper tape or mini-cartridge ROM boot in the event of a system crash. This is done by using the FMGR command: :DU,!CDMP,lu ,BA or :DU,!TDMP,lu ,BA where lu # is the logical unit number of either the paper tape punch or a cartridge tape unit. When this is done, and the system crashes, the program can be brought into memory by using the appropriate ROM boot. The program begins at address 77463B and ends at address 77677B, ie it is located right before the ROM boot in high memory. Consequently, the original 140 words of memory which the program replaces are lost. To run the program once it is in memory, select no parity for the terminal and place the mini-cartridge in the left CTU or ready the - FOR HP INTERNAL USE ONLY - 42 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP tape drive, as appropriate. The terminal must be one which is normally driven by DVR05. The tape drive must be one which is normally driven by DVR23. Set the P-register to 2 (the beginning of the dump program) and then set the S-register to the select code of the terminal. Press RUN and the program should execute. A HLT 77 indicates a normal completion. A HLT 42 indicates that an error occurred trying to write to the CTU. By pressing RUN after a HLT 42 the dump program will be retried. !TDMP also uses HLT 41 and HLT 43 which are not recoverable. In order to operate correctly, CDA4 requires a type 1 file which contains the crashed system. Such a file can be obtained from the mini-cartridge created above by using the FMGR command: :ST,lu,name::crn:1:257,BN where lu is the logical unit number of the tape unit where the dump program output is located, name is the name of the file to be created to contain the crashed system and crn is an optional cartridge reference number on which name is to be created. The dump program must be run once for every system crash whereas the snapshot program need only be run once for a given generation. ANALYZE PROGRAM INTRODUCTION CDA4 is a program designed to work with one type 1 file containing the crashed system's snapshot and any number of type 1 files containing 5crashed systems. The CDA4 commands are entered interactively at a terminal. The commands perform the following functions: * Control CDA4 operation * Examine specified memory locations of the crashed system * List various system tables of the crashed system * List specified system information CDA4 COMMANDS All the CDA4 commands are summarized in the following table. This table presents the commands in the same functinal groups in which they are described. - FOR HP INTERNAL USE ONLY - 43 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP FUNCTIONAL GROUP COMMAND FUNCTION CDA4 FI Specify crashed system file OPERATION LL Change list device PK Packed listing ?? Request command information DP Display input in octal, decimal, ASCII and symbolic EP Eject page if line printer /E, EN, EX Terminate CDA4 MEMORY LM List memory EXAMINATION TR Trace list F/ Find a value in memory TABLE ID List ID segment EXAMINATION EQ List EQT DR List device reference table IN List interrupt table TA List track assignment table LI List entry point SYSTEM DU Dump system D INFORMATION AN Analysis of system MA Dump all four maps SPECIAL DB Invoke DBUGR OPTIONS WH Run WHZAT on the crashed system Please note that the command structure, syntax rules and many of the commands are identical to those of CMM3 and CMM4. CDA4 OPERATION To use CDA4 you simply run the program from a terminal. It responds with a request for a snapshot file and a prompt. Upon entering the snapshot file name, it reminds you that the first thing you should do is to specify the file containing a crashed system by using the FI command. It then issues an equal (=) prompt, at which time you may enter any command. When you run CDA4 it assumes the terminal which initiated CDA4 as the default device used for command input, to log errors and to list output. You may change the list device during operation of CDA4 with the LL command. CDA4 operation is terminated with a /E, EN or EX command. - FOR HP INTERNAL USE ONLY - 44 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP RUNNING PROGRAM CDA4 To request CDA4 from your terminal, simply run CDA4 as follows: RU,CDA4,device where device is the logical unit number for input of CDA4 commands, logging of errors and default for listing. The default is the logical unit number of the device where CDA4 was scheduled. CDA4 will respond with the message: CDA4! THE RTE IV CRASH DUMP ANALYZE PROGRAM! INPUT SNAPSHOT FILE NAME = A type 1 file containing the system snapshot should be specified using the format: =name[:[security][:crn]] where name is the name of the type 1 file cre=ated by SNPSH as described above, security is its optional security code and crn is its optional cartridge reference number. In the event of an error, an error message will be printed followed by the message: ENTER /E TO EXIT and another prompt to enter the snapshot file. To exit CDA4, input /E, otherwise try to input the snapshot file name again. Note that the snapshot file name cannot be /E. When a correct snapshot file name has been entered, CDA4 prints the message: SPECIFY FILE CONTAINING CRASHED SYSTEM WITH FI COMMAND = The equal prompt indicates that you may enter any command. The message indicates that the first command entered should be an FI command to specify the file containing the crashed system. After entering an FI command, CDA4 responds with another equal prompt. - FOR HP INTERNAL USE ONLY - 45 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP EXPLANATION OF COMMANDS EP Eject Page if line printer The EP command will do a top of form if the output LU is a line printer and will space one line if the output LU is a terminal. Format: EP FI Specify the file containing the crashed system You may specify the file name you wish to use as the file containing the crashed system with the FI commnad. Format: FI,namr DU DUmp the system to the list device The DU command will list 32K words of the crashed system's memory to the list device. The format of the output is 64 word sections in packed format. Format: DU AN ANalysis of system The AN command will list several system entry points, base page locations gCand tables. In addition, it will trace several system lists. The following entry points are given: $OP - The last operator command entered. $LIST - IF $LIST is non-zero, a list change was made, but the crash occurred before another program could be dispatched. $UNPE - If $UNPE is zero, no parity error occurred. $PVCN - If $PVCN is non-zero, the crash was due to a JSB $LIBR call. $CIC - Contents of $CIC (central interrupt controller) when crash occurred. $POWR - Contents of $POWR (power up/down entry) when crash occurred. $WORK - Address of last ID segment that $LIST processed. $LSTM - Addres of last $LIST caller $LSTM+1 - Old status of last program moved $LSTM+2 - Last $LIST function code. $PETB - Physical page number of parity error $PETB+1 - Logical parity error address $PETB+2 - Map containing parity error $PETB+3 - ID segment address if program $PETB+4 - Partition number(s) if program $DMS - DMS status at interrupt - FOR HP INTERNAL USE ONLY - 46 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP $DMS+1 - Interrupt system on (0) or off (1) $CIC0+13B The last CLF xx instruction configured The following base page locations are listed: 1660B-1672B Addresses for 1771B-1774B current EQT entry 1673B CHAN - current DMA channel number 1700B RQPI - current EXEC request number 1717B XEQT - ID segment address of currently executing program. 1720B XLINK - ID segment address of last executing program The following tables are printed. All ID segments and extensions All equipment table entries Interrupt table Device refereQ]nce table $CLASS table $RNTB table Memory allocation table ($MATA table) The following lists are traced: SKEDD The schedule list SUSP2 The general wait list SUSP3 The memory suspend list SUSP4 The disc suspend list The device suspend list for each EQT entry $ZZZZ The abort list Format: AN or ANPK (for a packed listing) MA Dump the four maps to the list device The system map, user map, port A map and port B map can be listed with the MA command. The 32 words of each map will be printed in packed format. Format: MA - FOR HP INTERNAL USE ONLY - 47 CRASH DUMP ANALYSIS CDA4,SNPSH,CDMP,TDMP The following commands perform identically as in CMM3 and CMM4: LL PK ?? DP /E EN EX LM TR F/ ID EQ DR IN TA LI DB Invokes the DBUGR which allows you to set labels to relative addresses and use some of the nicer listing options of DBUGR. To exit DBUGR just use ESC P. WH This will cause a WHZAT print out of the crashed system. The usefulness of this should be quite obvious. NOTE! NOTE! NOTE! DEPENDING ON THE SEVERITY OF THE CRASHED SYSTEM THE 'WH' OPTION MAY GIVE UNPREDICTABLE RESULTS!!! - FOR HP INTERNAL USE ONLY - 48 FILE RELATED UTILITIES SDLS4 +-----------------------------------------------------+------------------+ | | | | FILE RELATED UTILITIES | CHAPTER 5 | | | | +-----------------------------------------------------+------------------+ 5.1 SDLS4 PROCEDURE NAME:SDLS4 PART NUMBER:24999-16050 DESCRIPTION: SDLS4 is a routine which will read information from CUPERTINO distribution tapes (SDLS or MTLS format, see Appendix A) directly into RTE FMP files. It accepts absolute, relocatable, or source files, but it does not read "DATA" files from the MTLS tapes. SDLS4 consists of two parts, a main program written in FORTRAN-IV to interact with the operator, and a subroutine "GETRC"(ASMB) which control and reads the mag tape, passing infomation records back to the main program for processing. SDLS4 requies an 8K background area in order to operate. SDLS4 checks the break flag (BR,SDLS4) at each mag tape record. If a LOAD is in progress, the load file is purged and the tape set back to the beginning of that file. USAGE: SDLS4 can be called by RU,SDLS4. It requests the LU of the mag tape locks it, and rewinds the tape. When it is ready, a meassage "TASK:" is displayed and waits for the following commands to be entered: COMMANDDESCRIPTION LABELReads the tape label and prints it on the terminal ??Displays available SDLS4 commands DIRECTORYSearches the tape for all program ID blocks and creates a file suitable for dumpping to line printer. The result is a directory of the tape, giving part number, revision number, type, and the tape file position number&. The list file NAMR will be requested by "LIST FILE:". The list file may be non-disc file (type 0) or a disc file. REWINDRewinds the tape - FOR HP INTERNAL USE ONLY - 49 FILE RELATED UTILITIES SDLS4 NPrints current file position number on tape LLChanges log device. The log device is initially set up to be the terminal from which the RU,SDLS4 command was entered. LOADLoads a specific file on tape to disc. The destination FMP NAMR is requested by "LOAD INTO FILE:". The tape file ID (part number) or file position number(available from the directory output) is requested by "ENTER STOCK OR FILE ". If the file number is given, a random search of the file is applied. If the part number is given, the tape will be searched forward only. A revision code may be specified along with the part number. If it does not match what is on tape, a message "REV DESCRIPANCY" will be displayed. In any case, the file is still loaded. When the tape file is found, the ID and the destination file are logged on the log device in order that a record of transaction can be kept. The old files are overwritten if existing names are given as destination files. This is reported on the log device. The destination files may be non-disc files(type 0). BATCHGets LOAD commands from an FMP file. The format of the command file is as follows: file NAMR part number rev or file number file NAMR . . file NAMR part number or file number E The part number and revision must be 16 characters long with no trailing blanks and in the format: XXXXX-XXXXX RRRR The /E causes a tape to rewind and return to interactive mode. UPDATEJust like BATCH mode, except that it requires part number rev and not file number. In this mode, SDLS4 will only load those files whose rev codes are more recent than that specified in the command file. It will update the command file rev parameter to reflect the current rev, so that next - FOR HP INTERNAL USE ONLY - 50 FILE RELATED UTILITIES SDLS4 month the same command file can be used to update. To pick up a file of unknown revision, use a rev code of A000. END OR EXIT Exit from SDLS4 The list of error codes output by SDLS4 and their meaning. CODE MEANING 0 End of tape reached 1 Checksum error on mag tape physical record 2 Checksum error on data record 3 illegal logical record type on mag tape(wrong format) 4 break flag was set 5 internal error 6 tape logical record size greater than physical record 7 illegal record size (wrong format) 8 illegal logical record size 9 internal error (GETRC) 10 internal error(GETRC) 11 internal error(GETRC) 12 data record size> 255 13 illegal program type(DATA or cartridge image) 14 record out of sequence 129 internal error (wrong position in buffer from GETRC) - FOR HP INTERNAL USE ONLY - 51 FILE RELATED UTILITIES JSAVE 5.2 JSAVE PROCEDURE NAME:JSAVE PART NUMBER:24999-16048 DESCRIPTION: JSAVE will save a disc cartridge on to a mag tape with a cartridge header and directory of files in the cartridge. the tape format that JSAVE generates is shown in APPENDIX B. JSAVE uses some of the extended instructions of the MX computer If you need to run JSAVE on a 2100 or earlier machine a library of MX instructions(simulated for the 2100) is provided in the source file. JSAVE will work on the following discs: 7900 / 7905 / 7906 / 7920 / 7925 USAGE: &dD &d@ &dD &d@ ! D&dDisk&d@ = x, ! ! F&dDile&d@ = x, ! Parameters may be in any ! I&dDnhibit&d@, ! order seperated by RU,JSAVE, ! L&dDast trk&d@ = x,! commas (,) ! M&dDag Tape&d@ = x,! ! R&dDepeat&d@ = x, ! ! V&dDerify&d@, ! &dD! &d@" . . . " &dD !&d@ NOTE:Only the first letter of each option is necessary except for quote strings then both quotes are needed to delimit the F string. Equals signs(=) can be replaced with colons(:) if desired. 'RU,JSAVE' with no parameters will cause JSAVE to prompt for all answers. (As it did) 'RU,JSAVE, . . .' with any parameters will cause JSAVE to use defaults for unspecified parameters. A list of JSAVE parameters and their defaults(if any) are described below. - FOR HP INTERNAL USE ONLY - 52 FILE RELATED UTILITIES JSAVE D&dDisk&d@ = xDEFAULT: Ask operator for +CRN or -LU. i.e. NO default either specify in run string or let JSAVE ask you for it. F&dDile #&d@ = xDEFAULT: x = 0 which tells JSAVE to start at current position. Do not rewind tape on entry to program. (NOTE: This is only true for the 'batch' mode.) I&dDnhibit RW&d@DEFAULT: Rewind Mag Tape OFF-LINE when done. Specifing 'I' in the run string will inhibit this function when JSAVE terminates. L&dDast track&d@ = x DEFAULT: last track of the subchannel for the given disc LU. (NOTE: This need only be specified if the cartridge mounted was mounted with other than the last track for that subchannel. i.e. 'MC,lu,xx' was used. In addition if the cartridge is currently mounted and the last track was not specified JSAVE will use the last track as given in the cartridge list not the physical last track defined by the subchannel.) M&dDag Tape&d@ = xDEFAULT: x = 8 R&dDepeat&d@ = xDEFAULT: x = 1. 'x' specifies the number of times this disc LU will be saved on consecutive files on the tape. V&dDerify&d@DEFAULT: Verify NOT performed. header. e.g. CR42LUO4210:39 AMMON.,9APR.,1979 NOTE: The default is ALWAYS put on the tape. Comments will be appended to the default. This is true for the interactive mode also. - FOR HP INTERNAL USE ONLY - 53 FILE RELATED UTILITIES JSAVE Some examples are given below. RU,JSAVE,D=47,F=1,V,"SSK DEVELOPMENT" This would save Disc CRN 47, start at file 1, verify, add 'SSK DEVELOPMENT' to the default header and rewind off-line when done. or RU,JSAVE,D:47,I This would save Disc CRN 47, start at the current position of the tape, not do a verify, use the default header, and leave the mag tape positioned between the double EOF after the file just created. ADDITIONAL: (1)JSAVE now locks the MT LU #. (2)JVRFY is now a subroutine to JSAVE, hence the program "JVRFY" will be obsoleted. - FOR HP INTERNAL USE ONLY - 54 FILE RELATED UTILITIES JRSTR 5.3 JRSTR PROCEDURE NAME:JRSTR PART NUMBER:24999-16049 DESCRIPTION: JRSTR restores a disc cartridge from a mag tape saved by JSAVE. USAGE: JRSTR can be called by RU,JRSTR. When JRSTR is ready, the following qestions will be requested interactively: MAG TAPE LU:Enter lu of the mag tape drive MAG TAPE FILE:Enter the file position that contains the cartridge data to be restored. Entering the file number 0 terminates JRSTR procedure. Entering a negative value causes to display all of the file headers on mag tape. JRSTR positions the tape to the requested file and displays the header. If it is the desired file, type "YES"; otherwise, type "NO". DISC LU:Enter disc cartrdige lu to restore. Note: JRSTR now updates the cartridge number for RTE-II,III and IVA operating systems. If the cartridge number on the JSAVE tape is already mounted, you will be prompted for a new cartridge number. The following error messages can be returned from the subroutine which does the update: DCMC ERR NF LU not found in cartridge table OV Internal error NG Negative response to CRN prompt ZE Zero response to CRN prompt - FOR HP INTERNAL USE ONLY - 55 FILE RELATED UTILITIES JVRFY 5.4 JVRFY PROCEDURE NAME:JVRFY PART NUMBER:V24999-16163 DESCRIPTION: NOTE! NOTE! NOTE! NOTE! JVRFY WILL BE OBSOLETED DURING THE NEXT UPDATE CYCLE. JSAVE AND JRSTR NOW CALL A SUBROUTINE 'JVRFY' FOR THE VERIFY OPERATION THUS ALLOWING A CONTINUAL LOCK ON THE MAG TAPE. THIS PROGRAM IS SUPPLIED ONLY FOR BACKWARD COMPATABLITY AND IS NOT USED BY ANY OF THE SOFTWARE IN THIS KIT. JVRFY compares the contents of a mag tape file against the contents of a disc cartridge. The mag tape must be in the following format: n consecutive records with 6145 words per record(the first word of a record must be the associated disc track number). It terminates on EOF mark on tape. Since a JSAVE tape file contains a header record of 100 characters as the first record, this record must be by-passed by a command CN,mag tape lu,FR if JVRFY is to be called from a command. USAGE: JVRFY can be called by a command: CN,mag tape lu,FR RU,JVRFY,list lu ,disc lu , mag tape lu JVRFY can be called from a program( e.g.JSAVE, JRSTR): CALL EXEC (icode,JVRFY, list lu ,disc lu , mag tape lu ) where :list lu = device for the message to be displayed disc lu = lu number of the disc cartridge mag tape lu = lu number of the mag tape drive icode = 9,10,23, or 24. 9 or 23 allows to retrieve additional information upon return from JVRFY using CALL RAMPAR(IPBUF). - FOR HP INTERNAL USE ONLY - 56 FILE RELATED UTILITIES VERIF 5.5 VERIF PROCEDURE NAME:VERIF PAR T NUMBER:24999-16248 DESCRIPTION: 'VERIF' provides a means to verify a FMGR disc file to LU or file to file or LU to LU. It also allows checking of one large file to many smaller files in case the file has been split for some reason. Also an octal and ASCII dump can be obtained on records that do not compare. If 'VERIF' senses an EOF on one file (or device) and not the other file (or device) it will ask the user if he wants to continue the comparision. If the user responds with 'YE', VERIF will ask him for the new disc file (or LU) to continue the comparision on. The new file is then compared to the other file from the its current position. Zero length records are ignored by VERIF. NOTE! NOTE! NOTE! NOTE! VERIF can only compare a MAXIMUM of 128 words per record! USAGE: RU,VERIF,P1,P2,P3,P4 WHERE P1 = INTERACTIVE DEVICE LU (DEFAULT=1) P2 = LIST DEVICE LU (DEFAULT=P1) P3 = RECORD DUMP FLAG (DEFAULT: REPORT ERROR ONLY) IF 'P3' IS NON ZERO AND IF AN ERROR OCCURS AN OCTAL AND ASCII DUMP OF BOTH RECORDS IS GIVEN. P4 = CONTINUE TO DEOF FLAG(DEFAULT: 1 FILE) WHEN COMPARING TWO MAG TAPES YOU MAY SET THIS PARAMETER TO NON ZERO AND VERIF WILL CONTINUE UNTIL A DEOF IS ENCOUNTERED ON THE FIRST DEVICE. - FOR HP INTERNAL USE ONLY - 57 FILE RELATED UTILITIES : FGETR 5.6 FGETR PROCEDURE NAME:FGETR PART NUMBER:24999-16053 DESCRIPTION: FGETR reads JSAVE tape and provides disc directory listing or allowes to transfer files from the tape to disc one at a time. USAGE: It can be called by RU,FGETR. When it is ready, it will request information interactively. DIRECTORY LIST REQUEST: MAG TAPE LU:Enter lu of the mag tape drive DO YOU WISH A DIRECTORY ?Enter Yes WHAT LU ?Enter lu of the listing device MAG TAPE FILE:Enter JSAVE tape file position which contains the desired cartridge directory. FGETR positions the tape and displays the file header created by JSAVE followed by a question mark(?). Enter "YES" if this is the file which contains the desired directory. ANY MORE ?Enter "NO" to terminate FGETR or "YES" to continue to another file or directory listing. MAG TAPE LU:Enter lu of the mage tape drive DO YOU WISH A DIRECTORY ?Type "NO" FILE NAMR, :Enter NANR of the desired file on tape. If the new NAMR is supplied, the file will be stored on disc with the new NAMR. MAG TAPE FILE:Enter JSAVE mag tape file position which contains the desired file NAMR. FGETR positions the tape and displays the file header created by JSAVE followed by a question mark(?). Enter "YES" if it is the tape file. - FOR HP INTERNAL USE ONLY - 58 FILE RELATED UTILITIES @ FGETR ANY MORE ?Enter "NO" to terminate FGETR or "YES" to continue to another file. /E entered for any inquiry terminates FGETR. - FOR HP INTERNAL USE ONLY - 59 FILE RELATED UTILITIES RXREF 5.7 RXREF PROCEDURE NAME:RXREF PART NUMBER:24999-16051 DESCRIPTION: RXREF provides cross references of modules used by a specific program. The cross reference listing contains four parts. The first part provides the listing of used modules with each module description such as the name, the size, the entry points, and external references. The second part provides the listing of modules with each module's level and references where it is used. The third part provides the list of entry point names with references to where they are defined and used. The last part provides the unresolved external names and references where they are used. USAGE: RXREF can be called by RU,RXREF,input lu,log lu, where input lu is the LU where input will come from (terminal) and log lu is where the RXREF output will be printed. When RXREF is ready, a prompting character COMMANDDESCRIPTION NAMRRequest to produce cross reference list for the relocatable binary NAMR lu #Request to produce cross reference list of the relocatable binary which is on the device specified by the logical unit. m 2 spacesRequest to produce cross reference list of the relocatable binary in load-and go area. control-DSignifies that the last file request has been specified and request to start processing NOTE: "LEVEL" refers to the structured programming concept. If RXREF sees a module which is not called from any other module, then it assigns that module LEVEL 0. The modules to which this module calls are assigned LEVEL 1, and so on. Levels are assigned by the maximum depth from which they are called. For example, if a utility subroutine is called from various levels, its level would then be one larger than the largest level number of any subroutine which calls it. Occaionally, it is necessary for software to refer to levels above it. That is , a module at level n refers to another module with a lower level number. In this case, RXREF simply gives up and assigns level - FOR HP INTERNAL USE ONLY - 60 FILE RELATED UTILITIES RXREF number 100. ERROR MESSAGES: OPEN ERRORFile named could not be opened. Cause of error is not printed. BAD COMMANDCommand is not recognized. Type it again correctly. READ ERRORFile-read or parity error. File may be corrupt. CHECKSUMBad checksum, or file is not relocatable binary. ILL RECORDRecord type read not defined in relocatable binary. ILL RECORD SEQUENCE Legal record sequence is always NAM first. DUP MODULE NAMEModule of the same name has been seen before. SYMBOL TALBLE OVERFLOW MODULE TABLE OVERFLOW  NOT ENOUGH SPACE TO COMPUTE LEVEL NUMBER WARNING:CR OF FILE DOES NOT MATCH CR USED-- possible that RXREF is using the wrong file. Check for correctness. This situation is caused by use of on- off-line disc restore utilty in order to change the file system on a peripheral disc, without first dismounting old cartridge, or removing a cartridge and inserting a new cartridge. - FOR HP INTERNAL USE ONLY - 61 FILE RELATED UTILITIES RXREF SAMPLE RXREF OUTPUT MODULE MODULE SIZE (OCTAL) NAME MODULE IDENT. BPAG MAIN COMM ------------------------------------------------------- FILE NAME: %MXLIB:: 215: 5: 20: 000 IS ON LU 17 AVMEM 7 FEB 74 -TLD- 00000 00104 00000 ENT= GLWAM GFWAM EXT= EXEC IFCHR 14 JAN 74 -TLD- 00000 00033 00000 ENT= IFCHR EXT= .ENTR ISCHR 14 JAN 74 -TLD- 00000 00043 00000 ENT= ISCHR EXT= .ENTR CVTNP 25 JAN 74 -TLD- 00000 00153 00000 ENT= CVTNP EXT= .ENTR IFCHR NAMFM 25 JAN 74 -TLD- FMGR NAMR PARSE 00000 00512 00000 ENT= NAMFM EXT= .ENTR IFCH'@R ISCHR CVTNP RDDSK 1 FEB 74 -TLD- 00000 00126 00000 ENT= RDDSK EXT= EXEC .ENTR RREAD 1 FEB 74 -TLD- 00000 00117 00000 ENT= RREAD EXT= DCB4 .ENTR READG RBINY 15 FEB 74 -TLD- 00000 00402 00000 ENT= RBIN RBILU DCB RBLU EXT= .ENTR RREAD READF EXEC .L.G. 1 FEB 74 -TLD- 00000 00467 00000 ENT= DCB DCB4 READG OPNLG EXT= .ENTR RDDSK EXEC FILE NAME: XRXREF:: 2: 5: 27: 000 IS ON LU 2 RXREF 23 FEB '77 -LAW- -TLD- -KH- 00000 03622 00000 EXT= RBIN RBILU DCB RMPAR EXT= .ENTR OPNLG OPEN NAMFM EXT= CLOSE FSTAT LOCF GLWAM EXT= EXEC GFWAM RBLU REIO END= 00001 TOTAL 00000 06247 00000 - FOR HP INTERNAL USE ONLY - 62 FILE RELATED UTILITIES RXREF MODULE LEVEL MODULES WHERE USED ------------------------------------------------------- .L.G. 4 RREAD RXREF AVMEM 2 RXREF CVTNP 3 NAMFM IFCHR 4 CVTNP NAMFM ISCHR 3 NAMFM RXREF 1 NAMFM 2 RXREF RBINY 2 RXREF RDDSK 5 .L.G. RREAD 3 RBINY ENTRY DEFN-MOD MODULES WHERE USED ------------------------------------------------------- DCB RBINY RXREF  CVTNP CVTNP NAMFM DCB .L.G. DCB4 .L.G. RREAD GFWAM AVMEM RXREF GLWAM AVMEM RXREF IFCHR IFCHR CVTNP NAMFM ISCHR ISCHR NAMFM NAMFM NAMFM RXREF OPNLG .L.G. RXREF RBILU RBINY RXREF RBIN RBINY RXREF RBLU RBINY RXREF RDDSK RDDSK .L.G. READG .L.G. RREAD RREAD RREAD RBINY UNRESOLVED EXT MODULES WHERE USED ------------------------------------------------------- .ENTR IFCHR ISCHR CVTNP NAMFM RDDSK RREAD RBINY .L.G. RXREF CLOSE RXREF EXEC AVMEM RDDSK RBINY .L.G. RXREF FSTAT RXREF LOCF RXREF OPEN RXREF READF RBINY REIO RXREF RMPAR RXREF END OF CROSS REF - FOR HP INTERNAL USE ONLY - 63 FILE RELATED UTILITIES RXREF INTERNAL TABLE FORMATS: SYMBOL TABLE -- GROWS DOWNWARD FROM LWAM WORD 7 - ADDRESS OF DEFINING MODULE ENTRY WORD 6 - ADDRESS OF FIRST ENTRY IN USER-MODULE LIST WORD 5 - ADDRESS OF NEXT ALPHA. SYMBOL TABLE ENTRY WORD 4 - ADDRESS OF NEXT ALPHA. ENTRY IN MODULE-ENT LIST WORD 3 - CHARACTER 5 OF NAME; FLAGS WORD 2 - CHARACTERS 3 AND 4 OF NAME WORD 1 - CHARACTERS 1 AND 2 OF NAME USER-MODULE LIST -- GROWS DOWNWARD WITH THE SYMBOL TABLE WORD 2 - ADDRESS OF NEXT ENTRY IN USER-MODULE LIST WORD 1 - ADDRESS OF MODULE ENTRY REFERENCING THIS SYMBOL MODULE-TABLE -- GROWS UPWARD FROM FWAM; LENGTH VARIES AS THE NUMBER OF EXqT'S IN A MODULE VARY WORD N - ADDRESS OF S.T. ENTRY FOR EXT N : : WORD 8 - ADDRESS OF S.T. ENTRY FOR EXT 1 WORD 7 - NUMBER OF EXT'S FOR THIS MODULE WORD 6 - NOT USED WORD 5 - ADDRESS OF FIRST S.T. ENTRY IN MODULE-ENT LIST WORD 4 - ADDRESS OF NEXT ALPHA. MODULE TABLE ENTRY WORD 3 - CHARACTER 5 OF NAME; FLAGS WORD 2 - CHARACTERS 3 AND 4 OF NAME WORD 1 - CHARACTERS 1 AND 2 OF NAME - FOR HP INTERNAL USE ONLY - 64 FILE RELATED UTILITIES DXREF 5.8 DXREF PROCEDURE NAME:DXREF PART NUMBER:24999-16246 DESCRIPTION: 'DXREF' has a similar function to 'RXREF' but allows for selective searching of modules, entry points, and external referances. It also gives the module number, NAM record info, program size, base page and common allocations if used. USAGE: RU,RXREF,P1,P2,P3,P4,P5 WHERE P1 = INTERACTIVE DEVICE LU# (DEFAULT=1) P2 = LIST DEVICE LU# (DEFAULT=P1) P3 = PROGRAM INPUT LU# (DEFAULT=ASK OPERATOR) OR P3-P5 = FMGR FILE NAME IF 'P3' = "1!" SPECIAL LIST & SEARCH OPTIONS ARE INVOKED.(*) AND IF 'P4' = "RE" THESE OPTIONS WILL BE CONTINUALLY ASKED AS SPECIFIED IN 'P5'. P5 = "AL" ASK FOR ALL OPTIONS AGAIN. ( DEFAULT ) "LO" ASK ONLY FOR CHANGE TO LIST OPTION "MO" ASK ONLY FOR SEARCH BY MODULE NAME "EN" ASK ONLY FOR SEARCH BY ENTRY POINTS z, "EX" ASK ONLY FOR SEARCH BY EXTERNALS (*) P3 = 1! AND P4 NOT EQUAL TO "RE". THIS IS USEFUL WHEN SEARCHING FOR ONE PARTICULAR MODULE, ENTRY POINT, OR EXTERNAL REFRENCE. ALL FILTERS AND LIST OPTION ARE SET INITIALLY AND ARE NOT ASKED AGAIN. THEREBY ALLOWING EASY SEARCHES OF MANY FILES FOR A SPECIFIC PIECE OF INFORMATION. IF P4 = RE ANOTHER FEATURE IS ENABLED. THE SAME FILE CAN BE LOOKED AT AGAIN BY ENTERING A SINGLE COLON (:) INSTEAD OF A FILE NAME. THIS ALLOWS SEARCHES THROUGH ONE PARTICULAR FILE FOR MANY DIFFERINT PIECES OF INFORMATION. A NOTE OF CAUTION HOWEVER: A DOUBLE COLON (::) WILL TERMINATE RXREF. TO TERMINATE DXREF ENTER '::' OR '0' OR ZERO LENGTH RECORD. - FOR HP INTERNAL USE ONLY - 65 FILE RELATED UTILITIES DL 5.9 DL PROCEDURE NAME:DL PART NUMBER:24999-16244, AND 24999-16245 DESCRIPTION: 'DL' is a program which allows enhanced capabilities over the 'DL' command in FMGR. It also can give you more information and thus be an aid in certian trouble shooting tasks. 'DL' has all of the filtering capabilities of the 'DL' command except for filtering on block size and record lengths. In addition 'DL' has string searching capabilities within the file name, and special listing options to make finding the files of interest very easy and fast. 'DL' is supplied in two versions one which runs on RTE-IVB (24999-16244) and one which runs on RTE-IVA and RTE-III (24999-16245). 'DL' uses the memory behind the prog!%ram space for data arrays. The larger the listing the more space it will need. Increasing the size by about 4 or 5 pages is usually adequate. USAGE: TO RUN TYPE RU,DL,(P1)[,(P2),(P3),(P4),(P5),(P6)] * (P1)= FILE NAMR FILTER MAY INCLUDE SECURITY,CART.,TYPE (SEE BELOW FOR EXTENSIONS TO THIS FILTER) (P2)= LIST UNIT (DEFAULT YOUR CONSOLE) P3 IS USED TO INVOKE SPECIAL LISTING OPTIONS TO DL. (P3)= 'OF' LIST OFF. DO NOT LIST FILES. (P3)= 'EN' LIST END OF DIRECTORY FILES GIVEN BY 'P4' (P3)= 'OP' LIST ONLY FILES THAT ARE OPEN (P3)= 'PU' LIST FILES THAT HAVE BEEN PURGED - FOR HP INTERNAL USE ONLY - 66 FILE RELATED UTILITIES DL P4 IS PRIMARILY USED TO DETERMINE THE OUTPUT FORMAT OF DL. IT ALSO INVOKES SOME SPECIAL OPTIONS. (P4)= NUMBER OF FILES TO BE LISTED IF P3 IS 'EN'(DEFAULT ALL) (P4)= 'HE' TO HAVE AN EXPANDED HEADING PRINTED. (P4)= 'FC' TO HAVE NUMBER OF FILES PRINTED (P4)= 'BO' TO HAVE HEADING AND FILE INFO PRINTED (P4)= 'SC' TO SCAN ALL SECURITY CODES ON A GIVEN PLATTER (P4)= 'PU' TO PURGE ALL FILES LISTED (P4)= 'DI' GIVES DIRECTORY TRACK, SECTOR, AND WORD OF THE FILE P5 REVERSE FILTER FLAGS. THIS PARAMETER IS USED TO LIST 'EVERYTHING BUT' WHAT THE FILTER WOULD NORMALLY ALLOW TO BE LISTED. 'P5' CAN BE ANY COMBINATION OF UP TO 3 REVERSE FLAGS. e.g. 'RTRS' WOULD REVERSE THE EFFECT OF THE FILE TYPE FILTER AND THE SECURITY CODE FILTER. 'RTRSRF' WOULD BE THE SAME AS 'RA'. (P5)= 'RF' REVERSE FILE NAME FILbTER (P5)= 'RS' REVERSE SECURITY CODE FILTER (P5)= 'RT' REVERSE FILE TYPE FILTER (P5)= 'RA' REVERSE ALL FILTERS (P6)= 'AL' CHECK ALL CARTRIDGES MOUNTED IN THE SYSTEM (RTE-IVB ONLY) * THE FILE NAME FILTER GIVES MANY OPTIONS TO THE USER OF DL. THE MOST COMMONLY USED FORM IS SPECIFYING CERTAIN CHARACTERS TO BE 'DON'T CARE' CHARACTERS. E.G. '--AB' WOULD GIVE YOU ALL FILES WITH THE 3RD AND 4TH CHARACTERS 'AB' (5TH & 6TH CHARACTERS ARE IMPLICITLY DON'T CARES). IN ADDITION, DL ALLOWS SEARCHING FOR A STRING OF CHARACTERS ANYWHERE IN THE FILE NAME. THIS FEATURE ALLOWS THE USER TO USE JUST A FEW 'KEY' SYMBOLS WHICH HE BELIEVES MIGHT BE IN THE NAME HE'S LOOKING FOR. FOR EXAMPLE, A USER WANTS TO FIND A BINARY CODED DECIMAL TO FLOATING POINT CONVERSION ROUTINE HE WOULD JUST ENTER, FOR A FILE NAME FILTER, '+BCD' AND ALL THE FILES WITH THE CHARACTER STRING 'BCD' WOULD BE DISPLAYED FOR HIM. ONE OTHER NOTE, MULTIPLE STRINGS ARE ALLOWED AND DASHES(-) ARE STILL USED FOR 'DON'T CARE' PLACE HOLDERS. SOME EXAMPLES FOLLOW. FILTER RESULT +A+B WILL FIND ALL FILES THAT HAVE AN 'A' FOLLOWED BY A 'B' ANYWHERE IN THE FILE NAME. +--AB OR WILL FIND ALL FILES THAT HAVE THE STRING 'AB' ANY- --+AB WHERE IN THE 3RD THROUGH 6TH CHARACTER POSITION. +A-B WILL FIND THE CHARACTER STRING "A(DON'T CARE)B" ANY- WHERE IN THE FILE. - FOR HP INTERNAL USE ONLY - 67 FILE RELATED UTILITIES DL NOTE: When entering the filter if '??' or 'HE' is entered a brief summary to lthe scheduling parameters are given to the user. If you need a file beginning with these characters just supply any additional characters. e.g. '??-' or 'HE:' will cause 'DL' to find these files. PURGE OPTION: WHEN USING THE PURGE OPTION IN DL A 'VETO' OPTION IS ALSO AVAILABLE. WHEN INVOKED DL WILL REQUIRE A RESPONSE TO EACH FILE AS IT IS LISTED. YOU THEN HAVE THE OPTION OF PURGING OR NOT PURGING THE FILE OR ABORTING THE PROGRAM. NOTE: TYPE ZERO(0) FILES ARE NOT PURGED WITH THIS OPTION. ---------------------------------------------------------------------- ADDITONAL PROBLEMS NOT TO BE RESOLVED WHEN ASKING FOR OPEN FILES ONLY (P3 ='OP') THE NUMBER OF EXTENTS WILL NOT BE SHOWN. ANY OTHER TYPE OF LISTING WILL SHOW THE EXTENTS, HOWEVER. THIS IS BECAUSE FMGR DOES NOT KEEP OPEN FLAGS ON EXTENTS, ONLY ON THE MAIN FILE. ---------------------------------------------------------------------- - FOR HP INTERNAL USE ONLY - 68 PERFORMANCE UTILITIES CLASS +-----------------------------------------------------+------------------+ | | | | PERFORMANCE UTILITIES | CHAPTER 6 | | | | +-----------------------------------------------------+------------------+ 6.1 CLASS PROCEDURE NAME:CLASS PART NUMBER:24999-16055 DESCRIPTION: CLASS disaplays the status of the class table for] the specified class number, list the contents of the class table, or clear the pending class buffers for the specified class number. USAGE: It can be called by RU,CLASS. CLASS displays the available commands and their description and waits for the user to enter a command after the TASK:. CLASS AVAILABE COMMANDS: DISPLAY,n1,n2,luDisplays status of the class table for class numbers n1 through n2 on logical unit lu. CLASS outputs the class number, possible owners, class number sequrity code, the number of requests, the total block length of the entry in the class table, the track option word, and the sector option word. LIST,luLists the contents of the class table on lu. CLEARClears pending class buffers. The class number is then requested to be entered. ENDTerminates CLASS procedure. - FOR HP INTERNAL USE ONLY - 69 PERFORMANCE UTILITIES SAMSZ 6.2 SAMSZ PROCEDURE NAME:SAMSZ PART NUMBER:24999-16178 DESCRIPTION: SAMSZ provides a means to determine dynamically the amount of system available memory (SAM) size at any time which allows you to: Determine whether lack of SAM is a bottleneck to your system Determine whether SAM is being left allocated, due to software bugs. Determining how much SAM may be required for planned expansion of a system. --etc. This program totals the size of all blocks of memory in the fSree list to get repeated samples. It prints the time of day for each sample, the total amount of SAM available, and the largest block found. This last feature allows you to spot severe SAM fragmentation problems, if any. You can use the printed time-of-day to correlate the printout with other events the system may be doing. It must be run at the highest priority in the system, or there is the potential problem of the list being re-linked during SAMSZ's sample, with the consequence that SAMSZ may "go off the deep end." USAGE: SAMSZ can be scheduled by a command, ON,SAMSZ,LU where LU = LU you want the printout to come out on. It may be a TTY, CRT, cassette, mag tape, lineprinter, etc. Default is 1 - FOR HP INTERNAL USE ONLY - 70 PERFORMANCE UTILITIES SAMSZ Print format is one line per sample, as shown below: TIME: 76: 12: 58, 3207 WORDS, MAX BLK = 3207 ^ ^ ^ ^ ^ ! ! ! ! +--- largest block ! ! ! ! (size in decimal) ! ! ! +-------- available SAM, in words (decimal) ! ! +--------------- time-of-day (minutes) ! +----------------------- time-of-day (seconds) +------------------------------- time-of-day (centoseconds) SAMSZ can be scheduled for repeated samplings by: *IT,SAMSZ,2,2 (program is to run every two seconds) *ON,SAMSZ,NOW,1 TIME: 76: 14: 58, 3207 WORDS, MAX BLK = 3207 TIME: 76: 16: 58, 3207 WORDS, MAX BLK = 3207Z Note: This program uses $OPSY to determine which operating system it's in. It uses cross-map instructions for examining tables when in a mapped-memory RTE. The SAM free-list head is not an entry point, so SAMSZ must access it via an offset value. This technique is regrettable, because it implies that various versions and revisions of RTE may, from time to time, change the offset value required. One means for determining the proper value is to dump about 400 (octal) words from the entry point of $ALC and following. Look for 77777 and count back about 3 locations. Subtract $ALC's address from this address, and that's your offset. As a check, the word immediately preceding the correct location should be negative. You should run SAMSZ when the system is first booted up, and before any SAM has been allocated. It should print the same number your system generation listing shows as the size of SAM. If the number is far too large, or SAMSZ loops endlessly, you should abort it and check the offset carefully. Note that SAMSZ, in conjunction with LGTAT, can be used to determine whether either of the two most likely bottlenecks are affecting you. To determine whether the availablability of disc swapping tracks is a bottleneck, simply put LGTAT in the time list, running every few seconds, and pass it parameters to print out only the number of available tracks and largest free block of tracks. Determine the swap-track requirements for the largest programs you have scheduled at the time, and be sure there are no samples printed with less than this number available. - FOR HP INTERNAL USE ONLY - 71 PERFORMAN;CE UTILITIES SAMSZ Note: it is possible that these sampler programs may only be runnable at times when the resources they monitor are available. For example, if the printout device is buffered, RTE will delay them until sufficient SAM is available for printing. It may be that SAM will periodically be almost entirely allocated, then quickly be released (say, due to a single, very large class-I/O request). SAMSZ would never "see" this condition if the printout terminal was buffered. Similarly, if the availability of swap tracks is a bottleneck, the utility should be locked into a partition during the duration of its sampling. Check the time of day printed by SAMSZ to see how closely the sample period is maintained. If necessary, modify the code so it locks itself in memory. - FOR HP INTERNAL USE ONLY - 72 PERFORMANCE UTILITIES MAPIO 6.3 MAPIO PROCEDURE NAME:MAPIO PART NUMBER:24999,16222 DESCRIPTION: 'MAPIO' displays the system configuration which includes the following; logical unit number,equipment number,equipmnt status,driver,driver name, select code, and subchannel number. USAGE: The following command would be used; RU,MAPIO[,LIST] Where List = list output device LU, default = LU 1 SAMPLE OUTPUT: RTE-IV SYSTEM CONFIGURATION ON SEP 17,1979 AT 14:50: 1   CONFIGURED MEMORY SIZE IS 256 K WORDS TIME BASE GENERATOR IS IN S.C. 12 LU EQT S.CHNL S.C. EQT STATUS DRIVER DEVICE NAME LU 1 2 1 14 B S DV.00 RS232 TERMINAL 1 2 1 0 13 D DV.32 7906/20 DISC 2 3 1 1 13 D DV.32 7906/20 DISC 3 4 4 0 22 B S DV.02 TAPE PUNCH 4 5 5 0 15 DV.01 TAPE READER 5 104 ********** LU UNASSIGNED ********** 104 105 ********** LU UNASSIGNED ********** 105 106 33 0 76 DV.12 LINE PRINTER 106 107 34 0 77 DV.12 LINE PRINTER 107 EQT STATUS LEGEND: D= DMA REQUIRED B= AUTOMATIC OUTPUT BUFFERING USED P= DRIVER PROCESSES POWER FAIL S= DRIVER PROCESSES TIME-OUT T= DEVICE HAS TIMED OUT - FOR HP INTERNAL USE ONLY - 73 PERFORMANCE UTILITIES SCB 6.4 SCB PROCEDURE NAME:SCB PART NUMBER:24999-16247 DESCRIPTION: THIS PROGRAM DUMPS THE SESSION CONTROL BLOCK (SCB) CONTENTS FOR A SPECIFIED SESSION TO THE SESSION CONSOLE OR OTHER DESIGNATED LIST DEVICE. INSTRUCTIONS SCB IS SCHEDULED AS FOLLOWS: RU,SCB[,LIST[,SESID]] t! WHERE: LIST = DESTINATION LOGICAL UNIT FOR SCB LISTING (DEFAULT IS SESSION CONSOLE) SESID = SESSION IDENTIFIER FOR DESIRED SCB (DEFAULT IS CURRENT SESSION) ENVIRONMENT AND RESOURE REQUIREMENTS: SCB OPERATES ONLY IN THE RTE-IV SESSION MONITOR ENVIRONMENT AND REQUIRES THE FOLLOWING EXTERNAL SUBROUTINES/FUNCTIONS: NAME DESCRIPTION ---- ----------- IGETB BYTE GET UTILITY MOVCA BYTE MOVE UTILITY BLANC FILLS WORDS W BLANKS JASC BINARY TO ASCII GTSAD GETS SCB ADDRESS - FOR HP INTERNAL USE ONLY - 74 PERFORMANCE UTILITIES SCB SAMPLE OUTPUT: USER: POTT GROUP: SESUP CURRENTLY LOGGED ONTO SYSTEM LU 52 -SCB- -----DECIMAL------ INDEX OCTAL UPPER LOWER WORD ASCII DESCRIPTION ----- ------- ----- ----- ------ ----- ------------------------- 3 000064 0 52 52 4 SESSION IDENTIFIER 4 000134 0 92 92 \ ACCT. DIRECTORY ENTRY 5 000074 0 60 60 < CAPABILITY LEVEL 6 000000 0 0 0 ERROR MNEMONIC 7 000000 0 0 0 ERROR MNEMONIC 8 000000 0 0 0 ERROR MNEMONIC 9 000000 0 0 0 ERROR MNEMONIC 10 000000 0 0 0 CPU USAGE 11 015566 27 118 7030 v CPU USAGE 12 007670 15 184 4024 USER ID 13 000013 0 11 11 GROUP ID 14 000017 0 15 15 DISC LIMIT 15 177734 255 220 -36 - SST LENGTH 16 177777 255 255 -1 SST SPARE . . . . . . . . . . . . 27 177777 255 255 -1 SST SPARE 28 177777 255 255 -1 SST SPARE 29 064405 105 5 26885 i SYS LU106 / SES LU 6 30 021042 34 34 8738 "" SYS LU 35 / SES LU 35 31 022044 36 36 9252 $$ SYS LU 37 / SES LU 37 32 006415 13 13 3341 SYS LU 14 / SES LU 14 33 031400 51 0 13056 3 SYS LU 52 / SES LU 1 34 000401 1 1 257 SYS LU 2 / SES LU 2 35 001002 2 2 514 SYS LU 3 / SES LU 3 36 013026 22 22 5654 SYS LU 23 / SES LU 23 37 002405 5 5 1285 SYS LU 6 / SES LU 6 . . . . . . . . . . . . 51 010421 17 17 4369 SYS LU 18 / SES LU 18 52 177770 255 248 -8 - DISC CAPACITY 53 000027 0 23 23 EXIST/PRIV./ACTIVE/LU 23 54 100016 128 14 -32754 ADDED/PRIV./ACTIVE/LU 14 55 100045 128 37 -32731 % ADDED/PRIV./ACTIVE/LU 37 56 040013 64 11 16395 @ EXIST/GROUP/ACTIVE/LU 11 57 040034 64 228 16412 @ EXIST/GROUP/ACTIVE/LU 28 58 040041 64 33 16417 @! EXIST/GROUP/ACTIVE/LU 33 59 140043 192 35 -16349 ADDED/GROUP/ACTIVE/LU 35 60 000000 0 0 0 DISC SPARE 61 000000 0 0 0 DISC SPARE 62 000000 0 0 0 DISC SPARE 63 000000 0 0 0 DISC SPARE - FOR HP INTERNAL USE ONLY - 75 PERFORMANCE UTILITIES SAM 6.5 SAM PROCEDURE NAME:SAM PART NUMBER:24999-16227 DESCRIPTION: THIS ROUTINE EXAMINES CONTENTS OF THE SYSTEM AVAILABLE MEMORY (SAM) BUFFER FOR RTE 4. IT DOES THIS BY TRACING OUT THE FOLLOWING LISTS: 1) FREE MEMORYORIGINAL LIST POINTER FOUND IN THE ENTRY POINT $PNTR IN THE $ALC PROGRAM. 2) CLASS I/O.LISTS MAY ORIGINATE FROM A POINTER IN ANY ONE OF THE LOCATIONS IN THE CLASS I/O TABLE ($CLAS). 3) EQT LISTS.AN EQT LIST BEGINS WITH A POINTER IN THE EQT LINK WORD (WORD 1) OF ANY ENTRY IN THE EQT TABLE. 4) REENTRANT I/O STARTING WITH A SINGLE POINTER (NEAR $REIO IN EXEC4) A LIST OF RE-ENTRANT (AND SOME NONREENTRANT) I/O MAY BE TRACED. 5) TURN-ON CHARACTER STRINGS STARTING FROM LCOATION $STRG IS A LIST OF THE CHARACTER STRINGS BEING PASSED AS TURN-ON PARAMETERS. 6) LU LISTSAN LU LIST BEGINS WITH A BUFFER POINTER IN THE 2ND HALF OF THE DEVICE REFERENCE TABLE. 7) DS TABLESLOCATION #FWAM IN THE RES PROGRAM POINTS TO THE DISTRIBUTED SYSTEMS TABLES AND VECTORS WHICH CONSIST OF: TRANSACTION CONTROL BLOCK(TCB) TRANSACTION STATUS TABLE(TST) NETWORK ROUTING VECTOR(NRV). NOTE: IF YOU DO NOT HAVE DISTRIBUTED SYSTEMS THE LOADR MAY GIVE YOU UNDEFINED EXTERNAL ERROR DUE TO #FWAM,#SAVM DECLARED AS EXTERNALS BY THIS PROGRAM. IF THIS OCCURS YOU WILL NEED TO 'FORCE LOAD' SAM ALLOWING THE UNDEFINED EXTERNALS NOT TO BE RESOLVED. 8) SCBIF THE SESSION MONITOR IS IN YOUR SYSTEM IT ALSO ALLOCATES SOME SAM. - FOR HP INTERNAL USE ONLY - 76 PERFORMANCE UTILITIES SAM NOTE: THIS TOO CAN CAUSE UNDEFINED EXTERNAL $SMEM UNLESS RTE4B IS INSTALLED. RESOLVE THIS PROBLEM AS GIVEN ABOVE FOR DS TABLES. 9) CLASS TABLETHOUGH ITS NOT PART OF THE BUFFER, THIS ROUTINE RETURNS THE ENTIRE CLASS TABLE TO THE CALLER IN CASE HE WANTS TO LIST IT. NOTE: TO LOAD SAM YOU MUST SPECIFY ACCESS TO SSGA AREA. USAGE: NORMAL TURN-ON IS: :RUN,SAM,LU,OPTION WHERE: LU =THE DESIRED LIST DEVICE. (LIST DEVICE IS UNBUFFERED DURING SAM PRINTOUT.) OPTION= "CL" TO GET A CLASS TABLE LISTING AFTER THE BUFFER LISTING. OPTION= "IH" TO GET A SUMMARY OF SAM USAGE WITHOUT MAP PRINTOUT. ON,SAM,6,CL DOES IT ALL ON THE LINE PRINTER. HINT:IF#B YOU SUSPECT SYSTEM AVAILABLE MEMORY IS CLOGGED. DON'T FORGET TO RUN SAM WITH THE 'IH' OPTION. EG. :RUIH,SAM. THIS WILL INSURE THAT SAM WILL NOT USE A STRING BUFFER IN SYSTEM AVAILABLE MEMORY WHICH MAY PREVENT 'SAM' FROM RUNNING. - FOR HP INTERNAL USE ONLY - 77 APPENDIX CUPERTINO DISTRIBUTION TAPE FORMAT +-----------------------------------------------------+------------------+ | | | | APPENDIX | CHAPTER 7 | | | | +-----------------------------------------------------+------------------+ 7.1 CUPERTINO DISTRIBUTION TAPE FORMAT REEL 1 I------------------I I TAPE LABEL I --> contains the reel information: rev, date, I I reel , title, etc. I------------------I I TAPE MARK I I------------------I I DIRECTORY I --> only on the first reel: contains I------------------I information for all files on library. I TAPE MARK I (not currently supplied). I------------------I I PROGRAM 1 I --> the 1st record is the ID block I------------------I I TAPE MARK I I------------------I I . I I . I I------------------I I PROGRAM n I I------------------I I TAPE MARK I I------------------I I TAPE MARK  I --> End of logical tape I------------------I I - - - - I I - - - - I REEL 2 12 words<=all physical record<=1024 words I------------------I I TAPE LABEL I 1st word of a record=character count of I------------------I the record I TAPE MARK I I------------------I last word of a record = record checksum I PROGRAM n+1 I I------------------I - FOR HP INTERNAL USE ONLY - 78 APPENDIX CUPERTINO DISTRIBUTION TAPE FORMAT I TAPE MARK I I------------------I I . I I . I I------------------I I PROGRAM n+m I I------------------I I TAPE MARK I I------------------I I PN,REV=999...99 I --> Only on the last reel I------------------I I TAPE MARK I I------------------I I TAPE MARK I I------------------I I - - - I I - - - - - I - FOR HP INTERNAL USE ONLY - 79 APPENDIX JSAVE/JRSTR TAPE FORMAT 7.2 JSAVE/JRSTR TAPE FORMAT I-------------I I I A TAPE FILE I I I FILE 1 I I---------------------I I I I HEADER I I I I 100 CHARACTERS I I-------------I v I---------------------I I I I track I I I FILE 2 I I---------I I -->6145 OR I I I DIRECTORY TRACK I 8193 WORDS I I I---------------------I (1 TRACK) I-------------I I track I I I . I I---------I I --> 6145 OR I . I I FILE TRACK 1 I 8193 WORDS I . I I---------------------I - FOR HP INTERNAL USE ONLY - 80 Table of Contents 1 SUMMARY OF PARTS . . . . . . . . . . . . . . . . . . . . . . . . . 1 2 DEBUGGING AIDS . . . . . . . . . . . . . . . . . . . . . . . . . . 3 2.1 CMM3, CMM4 AND CMMM . . . . . . . . . . . . . . . . . . . . . 3 2.2 PATCH . . . . . . . . . . . . . . . . . . . . . . . . . . . . 8 3 DATA COMMUNICATIONS DEBUGGING UTILITIES . . . . . . . . . . . . . . 9 3.1 DSINF . . . . . . . . . . . . . . . . . . . . . . . . . . . . 9 3.2 NDTDU . . . . . . . . . . . . . . . . . . . . . . . . . . . . 20 3.3 TRC65,DRT65 . . . . . . . . . . . . . . . . . . . . . . . . . 22 3.4 SLCIN . . . . . . . . . . . . . . . . . . . . . . . . . . . . 35 4 CRASH DUMP ANALYSIS . . . . . . . . . . . . . . . . . . . . . . . . 41 4.1 CDA4,SNPSH,CDMP,TDMP . . . . . . . . . . . . . . . . . . . . 41 5 FILE RELATED UTILITIES . . . . . . . . . . . . . . . . . . . . . . 49 5.1 SDLS4 . . . . . . . . . . . . . . . . . . . . . . . . . . . . 49 5.2 JSAVE . . . . . . . . . . . . . . . . . . . . . . . . . .l# . . 52 5.3 JRSTR . . . . . . . . . . . . . . . . . . . . . . . . . . . . 55 5.4 JVRFY . . . . . . . . . . . . . . . . . . . . . . . . . . . . 56 5.5 VERIF . . . . . . . . . . . . . . . . . . . . . . . . . . . . 57 5.6 FGETR . . . . . . . . . . . . . . . . . . . . . . . . . . . . 58 5.7 RXREF . . . . . . . . . . . . . . . . . . . . . . . . . . . . 60 5.8 DXREF . . . . . . . . . . . . . . . . . . . . . . . . . . . . 65 5.9 DL . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 66 6 PERFORMANCE UTILITIES . . . . . . . . . . . . . . . . . . . . . . . 69 6.1 CLASS . . . . . . . . . . . . . . . . . . . . . . . . . . . . 69 6.2 SAMSZ . . . . . . . . . . . . . . . . . . . . . . . . . . . . 70 6.3 MAPIO . . . . . . . . . . . . . . . . . . . . . . . . . . . . 73 6.4 SCB . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 74 6.5 SAM . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 76 7 APPENDIX . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 78 7.1 CUPERTINO DISTRIBUTION TAPE FORMAT . . . . . . . . . . . . . 78 7.2 JSAVE/JRSTR TAPE FORMAT . . . . . . . . . . . . . . . . . . . 80 - FOR HP INTERNAL USE ONLY - iii  P] 24999-18083 1902 S 0100 &CLASS              H0101 aFTN4,L C C VERSION 12 - 20 - 77 LAW (FOR NEW FTN4) C PROGRAM CLASS(3,99),REV 780913 FOR RTE-III/IV C DIMENSION LU(5),IREG(2),IBUF(20),IPBUF(33) DIMENSION IPROG(3,3),JPROG(9),IGTPRG(3) INTEGER CLASAD,OUTBF(40) C EQUIVALENCE (IB,IREG(2)),(X,IREG),(IPROG,JPROG) EQUIVALENCE (N1,IPBUF(6)),(N2,IPBUF(10)),(LLU,IPBUF(14)) EQUIVALENCE (ICMND,IPBUF(2)),(IFLAG,LU(2)) C DATA JPROG/9*2H /,NIDS/0/,IPBUF/33*0/ DATA IGTPRG/3*2H / DATA CLASAD/0/ C C C PRELIMINARIES... C GET COMMUNICATION LU C GET CLASS TABLE PARAMETERS & CHECK C GO TO 'TASK' LOOP C CALL RMPAR(LU) IF(LU.EQ.0)LU=1 ILU=LU+400B N1=LU(3) N2=LU(4) C C KEYBLK=IXGET(1657B) 6 IF(IXGET(KEYBLK).EQ.0)GO TO 7 NIDS=NIDS+1 KEYBLK=KEYBLK+1 GO TO 6 C 7 CALL GETCL(ITADRS,INUMB) IF(IFLAG.NE.0)GO TO 20 C 98 CONTINUE WRITE(LU,101)ITADRS,INUMB 101 FORMAT(/"/CLASS: CLASS TABLE IS AT "K6" WITH"I3" ENTRIES!") C WRITE(LU,102) 102 FORMAT(/"/CLASS: FOLLOWING COMMANDS ARE ACCEPTED:"/, & " DISPLAY,N1,N2,LU - DISPLAY STATUS OF CLASS TABLE FOR",/, & " CLASS NUMBERS N1 THROUGH N2",/, & " LIST,LU - LIST CONTENTS OF CLASS TABLE ON LU",/, & " CLEAR,N - CLEAR OUT PENDING CLASS BUFFERS",/, & " ON CLASS NUMBER 'N'",/, & " ?? - HELP"/ & " END - END") C 10 WRITE(LU,110) 110 FORMAT(/"/CLASS: TASK: _") X=EXEC(1,ILU,IBUF,20) CALL PARSE(IBUF,IB*2,IPBUF) IF(ICMND.EQ.2HEN)GO TO 90 IF(ICMND.EQ.2HEX)GO TO 90 IF(ICMND.EQ.2H/E)GO TO 90 IF(ICMND.EQ.2H??)GO TO 98 IF(ICMND.EQ.2HDI)GO TO 20 IF(ICMND.EQ.2HLI)GO TO 40 IF(ICMND.EQ.2HCL)GO TO 30 12 WRITE(LU,111) 111 FORMAT("/CLASS: INPUT ERROR!") GO TO 10 C C C PROCESS DISPLAY REQUEST REQUEST FORMAT: DISPLAY,N1,N2,LU C WHERE N1, N2 ARE START, END CLASS NUMBERS C LU IS LIST LU C 20 IF(LLU.EQ.0)LLU=LU IF((N2.EQ.0).OR.(N2.LT.N1))N2=N1 IF(N1.GT.0)GO TO 201 N2=INUMB N1=1 201 IF((N1.GT.0).AND.(N2.LE.INUMB))GO TO 21 WRITE(LU,120)INUMB 120 FORMAT("/CLASS: ONLY CLASS NUMBERS 'TWEEN 0 AND"I3" PLEASE!") GO TO 10 C 21 CALL CODE WRITE(OUTBF,121) 121 FORMAT(/,29X,"GET PROG OR BUFFER PRAMS") CALL EXEC(2,LLU,OUTBF,27) CALL CODE WRITE(OUTBF,1211) 1211 FORMAT(" CLASS POSSIBLE OWNERS SECU #RQ SIZE OPT1 OPT2"/) CALL EXEC(2,LLU,OUTBF,27) C DO 29 I=N2,N1,-1 ISECU=0 NPRQ=0 IBLOK=0 IOPT1=0 IOPT2=0 C C IF CLASS AVAILABLE SAY SO & GO TO NEXT ONE. IF IN AUTO MODE C DON'T PRINT 'AVAILABLE' C CLASAD=ITADRS+I IF(IXGET(CLASAD).NE.0)GO TO 24 CALL CODE WRITE(OUTBF,122)I 122 FORMAT(I5,2X," ** AVAILABLE **") CALL EXEC(2,LLU,OUTBF,12) GO TO 29 C C GET NON-ZERO CLASS WORD FOR ANALYSIS (ICLAS) C 24 IF(IXGET(CLASAD).LT.0)GO TO 25 CLASAD=IXGET(CLASAD) GO TO 24 25 ICLAS=IXGET(CLASAD) C C GET POSSIBLE OWNERS: SECURITY CODE = OWNER'S ID # MODULO 31 C DO 22 J=1,9 JPROG(J)=2H 22 CONTINUE ISECU=IAND(ICLAS,17400B)/256 J=1 26 IDADRS=IXGET(IXGET(1657B)+ISECU-1) IF(IXGET(IDADRS+12).EQ.0)GO TO 261 IF(IAND(IXGET(IDADRS+14),20B).NE.0)GO TO 261 IPROG(1,J)=IXGET(IDADRS+12) IPROG(2,J)=IXGET(IDADRS+13) IPROG(3,J)=IOR(IAND(IXGET(IDADRS+14),177400B),40B) 261 J=J+1 ISECU=ISECU+32 IF((ISECU.LE.NIDS).AND.(J.LE.3))GO TO 26 ISECU=IAND(ISECU,37B) C C FIND OUT IF SOMEONE'S IN GET SUSPEND, IF SO, SAY SO & GO TO NEXT ONE C IF(IAND(ICLAS,40000B).EQ.0)GO TO 262 IWORD=ITADRS+I CALL WH*OGT(IWORD,IGTPRG) CALL CODE WRITE(OUTBF,123)I,IPROG,ISECU,IGTPRG 123 FORMAT(2X,I3,2X,9A2,K3,4X,3A2) CALL EXEC(2,LLU,OUTBF,18) GO TO 29 C C ANALYZE QUEUED-UP CLASS BUFFERS, IF ANY C 262 NPRQ=IAND(ICLAS,377B) ICLAS=IXGET(ITADRS+I) IF(ICLAS.GT.0)GO TO 27 CALL CODE WRITE(OUTBF,127)I,IPROG,ISECU,NPRQ CALL EXEC(2,LLU,OUTBF,27) GO TO 29 C 27 IBLOK=IXGET(ICLAS+3) IOPT1=IXGET(ICLAS+6) IOPT2=IXGET(ICLAS+7) C CALL CODE WRITE(OUTBF,127)I,IPROG,ISECU,NPRQ,IBLOK,IOPT1,IOPT2 127 FORMAT(2X,I3,2X,9A2,K3,I5,I5,2(2X,K6)) CALL EXEC(2,LLU,OUTBF,27) C C CHECK FOR ADDITIONAL QUEUED-UP BLOCKS C 28 ICLAS=IXGET(ICLAS) IF(ICLAS.LE.0)GO TO 29 IBLOK=IXGET(ICLAS+3) IOPT1=IXGET(ICLAS+6) IOPT2=IXGET(ICLAS+7) ICNWD=IXGET(ICLAS+1) CALL CODE WRITE(OUTBF,129)IBLOK,IOPT1,IOPT2 129 FORMAT(35X,I3,2(2X,K6)) CALL EXEC(2,LLU,OUTBF,27) GO TO 28 C 29 CONTINUE IF(IFLAG)99,10,99 C C C PROCESS CLEAR REQUEST C 30 ICL=IPBUF(6) IF((ICL.LE.0).OR.(ICL.GT.INUMB))GO TO 10 C ICLAS=IXGET(ITADRS+ICL) IF(ICLAS.LE.0)GO TO 38 C 31 ICLAS=IXGET(ICLAS) IF(ICLAS.GT.0)GO TO 31 C ICLAS=IOR(IAND(ICLAS,17400B),ICL) 34 CALL EXEC(21,ICLAS,IBUF,10,IP1,IP2,IP3) IF(IXGET(ITADRS+ICL).NE.0)GO TO 34 C C 38 WRITE(LU,138)ICL 138 FORMAT("/CLASS: CLASS"I3" NOW HAS NO OUTSTANDING BUFFERS!") GO TO 10 C C SECTION TO LIST CONTENTS OF CLASS TABLE C 40 LLU=LU IF(N1.NE.0)LLU=N1 C CALL CODE WRITE(OUTBF,140) 140 FORMAT(/,5X,"CLASS ADDRESS CONTENTS"/) CALL EXEC(2,LLU,OUTBF,17) DO 45 I=INUMB,1,-1 CLASAD=ITADRS+I ICLAS=IXGET(CLASAD) CALL CODE WRITE(OUTBF,142)I,CLASAD,ICLAS 142 FORMAT(6X,I3,5X,K6,5X,K6) CALL EXEC(2,LLU,OUTBF,16) 42 IF(ICLAS.LE.0)GO TO 45 DO 44 J=ICLAS,ICLAS+7 IWORD=IXGET(J) CALL CODE WRITE(OUTBF,143)IWORD 143 FORMAT(34X,K6) CALL EXEC(2,LLU,OUTBF,20) 44 CONTINUE ICLAS=IXGET(ICLAS) GO TO 42 45 CONTINUE GO TO 10 C C C END PROCESSING C 90 WRITE(LU,190) 190 FORMAT("/CLASS: DONE!"/) CALL EXEC(6) C 99 CALL EXEC(6,0,0,LU,IFLAG) C END C C SUBROUTINE TO IDENTIFY PROGRAM IN 'GET' FOR A GIVEN CLASS C SUBROUTINE WHOGT(IWORD,IGTPRG) C DIMENSION IGTPRG(3) C C KEYWD=IXGET(1657B) IGTPRG=2H** IGTPRG(2)=2H** IGTPRG(3)=2H* C 10 IDADR=IXGET(KEYWD) IF(IDADR.EQ.0)RETURN IF(IXGET(IDADR+1).EQ.IWORD)GO TO 20 KEYWD=KEYWD+1 GO TO 10 C 20 IGTPRG=IXGET(IDADR+12) IGTPRG(2)=IXGET(IDADR+13) IGTPRG(3)=IOR(IAND(IXGET(IDADR+14),77400B),40B) RETURN C 90 END END$ ASMB,R,L NAM GETCL,7 ENT GETCL EXT $CLAS,.ENTR * A EQU 0 * * ADRS BSS 1 NMBR BSS 1 GETCL NOP JSB .ENTR DEF ADRS * LDA DCLAS GET CLASS TABLE ADDRESS SSA,RSS JMP *+4 ELA,CLE,ERA LDA A,I JMP *-4 * STA ADRS,I LDA A,I STA NMBR,I * JMP GETCL,I * DCLAS DEF $CLAS * END ASMB,L NAM IXGP,7 ENT IXGET,IXPUT EXT $LIBR,$LIBX * * * *GET NOP * DLD IGET,I * SWP * LDA A,I * LDA A,I * JMP B,I * * * IXGET NOP DLD IXGET,I SWP LDA A,I XLA A,I JMP B,I * * * *PUT NOP * JSB $LIBR * NOP * LDA IPUT,I * STA IGET * ISZ IPUT * DLD IPUT,I * LDA A,I * LDB B,I * STB A,I * JSB $LIBX * DEF IGET * * * IXPUT NOP JSB $LIBR NOP LDA IXPUT,I STA IXGET ISZ IXPUT DLD IXPUT,I LDA A,I o LDB B,I XSB A,I JSB $LIBX DEF IXGET * * A EQU 0 B EQU 1 END t Q [ 24999-18163 1902 S 0100 &JVRFY              H0101 _FTN4,L PROGRAM JVRFY(3,60), JVRFY FROM SSK 24999-16163 REV 1902 C C THIS PROGRAM IS DESIGNED TO COMPARE THE CONTENTS OF C A MAG TAPE FILE AGAINST THE CONTENTS OF A DISK TRACK. C THE MAG TAPE FORMAT SHOULD BE: C N CONSECUTIVE RECORDS EACH 6145 WORDS LONG C WHERE WORD #1 IS THE TRACK #. C TERMINATION WILL OCCUR UPON READING EOF. C THE MAG TAPE MUST BE POSITIONED TO THE FIRST RECORD BEFORE C SCHEDULING THIS PROGRAM. C C FORM OF CALL: C RUN,JVRFY,LUCRT,LUDISK,LUMT C - OR - C CALL EXEC(ICODE,JVRFY,LUCRT,LUDISK,LUMT) C [CALL RMPAR(IPBUF)] C C WHERE: C LUCRT - OPTIONAL IN THE SCHEDULING CALLS (9/23) C IF GIVEN, MESSAGES WILL BE DIRECTED TO THE C SPECIFIED LU # - ELSE - C NO MESSAGES WILL BE OUTPUT. C LUDISK - LU # OF THE DISK SUBCHANNEL C TO BE VERIFIED. C LUMT - LU # OF THE MAG TAPE. C ICODE - 9,10,23 OR 24 C WHEN EITHER 9 OR 23 ARE USED, C THE FOLLOWING INFO CAN BE RETRIEVED C BY THE FATHER UPON RETURN (USING RMPAR). C IPBUF(1) = 0 - COMPARE GOOD. C IPBUF(2) = # OF MAG TAPE RECORDS TESTED. C C IPBUF(1) = -2 - NO DISK LU GIVEN. C C IPBUF(1) = -3 - NO MAG TAPE LU GIVEN C C IPBUF(1) = -4 - MAG TAPE STATUS ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = EQT #5 STATUS INFO C C IPBUF(1) = -5 - MAG TAPE RECORD LENGTH ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = LENGTH OF MAG TAPE RECORD. C C IPBUF(1) = -6 - DISK READ ERROR. C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = EQT #5 STATUS INFO. C C IPBUF(1) = -1 MAG TAPE COMPARE ERROR C IPBUF(2) = MAG TAPE RECORD NUMBER C IPBUF(3) = TRACK # C IPBUF(t4) = SECTR # C IPBUF(5) = WORD OFFSET C C MCC 6/10/77 DIMENSION IBUFF(6273),IPBUF(5),LENB(6),ISCTRS(6),IREG(2) EQUIVALENCE (REG,IREG),(LUDISK,IPBUF(2)),(LUMT,IPBUF(3)) DATA LENB/128,256,512,1024,2048,2176/ DATA ISCTRS/0,2,6,14,30,62/ C C GET THE PARAMETERS C CALL RMPAR(IPBUF) IF (IPBUF(1).EQ.0) GOTO 2001 LUCRT=IPBUF(1) WRITE(LUCRT,1090) 1090 FORMAT(/"24999-16163 1902 SOFTWARE SERVICE KIT SYSTEM 1000"/) IF(LUDISK .EQ. 0)GO TO 200 IF(LUMT .EQ. 0) GO TO 300 C ICOUNT = 0 C C GET A MAG TAPE RECORD AND TEST FOR EOF C 10 IF(IFBRK(IDMY) .LT. 0) GO TO 100 REG=EXEC(1,LUMT,IBUFF(128),6146) C C FINISHED IF EOF FOUND C IF(IAND(IREG,200B) .NE. 0) GO TO 100 C C ANY OTHER STATUS EXCEPT NO WRITE RING IS AN ABORT CONDITION. C IF(IAND(IREG,373B) .NE. 0) GO TO 400 C C RECORD LENGTH MUST BE 6145 C IF(IREG(2) .NE. 6145) GO TO 500 C C TRACK # IS IN FIRST WORD. C ITRK = IBUFF(128) ICOUNT = ICOUNT + 1 C C NOW GET AND TEST THE CONTENTS OF ONE TRACK (6 READS) C DO 50 I=1,6 LENGTH = LENB(I) INDEX = LENGTH + 1 C C INDEX IS 4097 ON LAST TIME THROUGH. C IF(I .EQ. 6) INDEX = 4097 C REG = EXEC(1,LUDISK,IBUFF,LENGTH,ITRK,ISCTRS(I)) C IF(IAND(IREG,55B) .NE. 0) GO TO 600 C CALL CMPWD(IBUFF,IBUFF(INDEX),LENGTH,IERR) IF(IERR .NE. 0) GO TO 700 C 50 CONTINUE GO TO 10 C C GOOD COMPLETION C 100 IPBUF(1) = 0 GO TO 1000 C C NO DISK LU GIVEN C 200 IPBUF(1) = -2 GO TO 1000 C C NO MAG TAPE LU GIVEN C 300 IPBUF(1) = -3 GO TO 1000 C C MAG TAPE STATUS ERROR. C 400 IPBUF(1) = -4 GO TO 1000 C C MAG TAPE RECORD LENGTH ERROR. C 500 IPBUF(1) = -5 IPBUF(3) = IREG(2) GO TO 1000 C C DISK READ ERROR. C 600 IPBUF(1) = -6 IPBUF(3) = IREG(2) # GO TO 1000 C C COMPARE ERROR. C 700 IPBUF(1) = -1 IPBUF(3) = ITRK IPBUF(4) = ISCTRS(I) + IERR/64 IPBUF(5) = MOD(IERR,64) C C FINISHED. C C WRITE A MESG IF LUCRT IS GIVEN C 1000 IPBUF(2) = ICOUNT IF(LUCRT .EQ. 0) GO TO 2000 C IGO = IPBUF(1) + 7 GO TO (1010,1020,1030,1040,1050,1060,1070),IGO C 1010 WRITE(LUCRT,1011)IPBUF(3),IPBUF(2) 1011 FORMAT(" /JVRFY: DISK READ ERROR - STATUS ",K6," RECORD #",I4) GO TO 2000 C 1020 WRITE(LUCRT,1021)IPBUF(3),IPBUF(2) 1021 FORMAT(" /JVRFY: MT RECORD LENGTH ERROR - LENGTH ", + I5," RECORD #",I4) GO TO 2000 C 1030 WRITE(LUCRT,1031)IPBUF(3),IPBUF(2) 1031 FORMAT(" /JVRFY: MT STATUS ERROR - STATUS ",K6," RECORD #",I4) GO TO 2000 C 1040 WRITE(LUCRT,1041) 1041 FORMAT(" /JVRFY: NO MAG TAPE LU# GIVEN") GO TO 2000 C 1050 WRITE(LUCRT,1051) 1051 FORMAT(" /JVRFY: NO DISK LU# GIVEN") GO TO 2000 C 1060 WRITE(LUCRT,1061)(IPBUF(J),J=2,5) 1061 FORMAT(" /JVRFY: COMPARE ERROR RECORD #",I4/, + " /JVRFY: TRACK #",I4," SECTOR #",I4," OFFSET",I4) GO TO 2000 C 1070 WRITE(LUCRT,1071)IPBUF(2) 1071 FORMAT(" /JVRFY: COMPARE GOOD. ",I4," RECORDS") C 2000 CALL PRTN(IPBUF) 2001 CONTINUE END END$ ASMB,R,L,C,Z IFN HED WORD COMPARE FOR 2100 & EARLIER CPU NAM CMPWD,7 WORD COMPARE FOR 2100 & EARLIER CPU 6/10/77 XIF IFZ HED WORD COMPARE FOR 21MX & LATER CPU NAM CMPWD,7 WORD COMPARE FOR 21MX & LATER CPU 6/10/77 XIF ENT CMPWD EXT .ENTR SKP * THIS PROGRAM WILL COMPARE THE CONTENTS OF TWO BUFFERS * AND RETURN: * IERR = 0 - GOOD COMPARE * IERR = +N - ERROR DETECTED. * WHERE N = BUFFER INDEX OF FAILED COMPARISON. * * THIS PROGRAM WILL RETURN AFTER ENCOUNTERING THE FIRST * COMPARE FAILURE. * * THIS PROGRAM IS FORTRAN CALLABLE AS FOLLOWS: * CALL CMPWD(BUF1,BUF2,LENGTH,IERR) * - OR - * REG = CMPWD(BUF1,BUF2,LENGTH,IERR) * WHERE IERR IS RETURNED IN THE 'A' REGISTER. * * CONDITIONAL ASSEMBLY REQUIRED FOR COMPUTER TYPE: * N FOR 2100 OR EARLIER MODELS * Z FOR 21MX OR LATER MODELS * * MCC 6/10/77 * SKP BUFF1 NOP BUFF2 NOP LENTH NOP IERR NOP CMPWD NOP SPC 1 JSB .ENTR DEF BUFF1 SPC 1 IFN LDA LENTH,I GET THE BUFFER LENGTH CMA,INA COMPLEMENT AND SAVE IT STA COUNT SPC 1 LOOP LDA BUFF1,I GET FIRST WORD XOR BUFF2,I XOR WITH SECOND SZA OK IF ZERO RESULTS. JMP ERROR NO - ERROR. SPC 1 ISZ COUNT YES - FINISHED IF COUNT = 0 JMP INCR SPC 1 JMP OUT FINISHED SPC 1 INCR ISZ BUFF1 INCREMENT BOTH BUFFER ADDRESSES ISZ BUFF2 JMP LOOP GO TEST THE NEXT TWO. SPC 1 ERROR ISZ COUNT SET UP THE LDA LENTH,I ERROR COUNT ADA COUNT FOR RETURN JMP BAD THEN RETURN SKP XIF IFZ LDA BUFF1 GET THE TWO ADDRESSES IN 'A' & 'B' LDB BUFF2 CMW LENTH,I GO TEST THESE ARRAYS JMP OUT GOOD RETURN HERE. SPC 1 NOP ERROR RETURN HERE LDB BUFF1 GET THE START ADDRESS CMB,INB AND SUBTRACT FROM ADA B PRESENT ADDRESS FOUND IN 'B' INA JMP BAD RETURN THE ERROR INDEX XIF SKP OUT CLA GOOD RETURN HERE. SPC 1 BAD STA IERR,I JMP CMPWD,I SKP COUNT NOP A EQU 0 B EQU 1 END END$ END$  R[ 24999-18171 1752 S 0100 %LTAT - LIST TRACK ASSIGNMENT TABLE             H0101 |qFTN4,L C LYLE WEIMAN C 7/27/77 C C TRACK ASSIGNMENT TABLE PRINTOUT PROGRAM C C IDENTIFIES EACH TRACK AS BEING USED FOR: C -SYSTEM (MEMORY-RESIDENT PORTION) C -SYSTEM ENTRY POINTS C -SYSTEM RELOCATABLE LIBRARY C -DISC-RESIDENT PROGRAM STORAGE C " " " SWAP STORAGE C -OWNED BY A PROGRAM C -OWNED BY FMP (FMGR TRACKS) C -ALLOCATED GLOBALLY C - AVAILABLE C C C PROGRAM LTAT DIMENSION LU(5),IOWN(3,10) C C CALL RMPAR(LU) IF(LU.EQ.0)LU=1 WRITE (LU,300) 300 FORMAT (/"24999-16171 1752 SOFTWARE SERVICE KIT SYSTEM 1000"/) LUTTY=LU+400B LIST=LU(2) IF(LIST.EQ.0)LIST=LUTTY C C 15 WRITE(LIST,102) 102 FORMAT(/" TRACK ASSIGNMENT TABLE & = PROG ^ = SWAP"/ & " TRACK 0 1 2 3 4 5 6" & " 7 8 9") 120 FORMAT(I4,2X,10(1X,3A2)) C ITAT=IGET(1656B) NCNT=- IGET(1755B) NCNTP1 = NCNT + 1 C GET # TRACKS ON LU 2 NTDSK = IGET(1756B) NTDSK1 = NTDSK + 1 N= 0 INDEX = 0 ITRACK= -1 LUDISK = 2 C C TRACE THROUGH TAT C 20 DO 21 I=1,10 IOWN(1,I)=2H IOWN(2,I)=2H IOWN(3,I)=2H 21 CONTINUE C DO 100 JCNTR = 1,10 N = N + 1 ITRACK = ITRACK + 1 C IF LAST TRACK ON SYSTEM OR C AUXILIARY DISC, DUMP PRINT BUFFER. IF( N .GT. NCNTP1 ) GOTO 222 IF(N .EQ. NTDSK1) GOTO 222 C C GET T.A.T. ENTRY IAD=IGET(ITAT) C ADVANCE T.A.T. POINTER ITAT=ITAT + 1 C CHECK IF IT'S A SYSTEM TRACK IF(IAD.NE.100000B)GO TO 24 IOWN(1,JCNTR)=2HSY  IOWN(2,JCNTR)=2HST IOWN(3,JCNTR)=2HEM C C NARROW DOWN 'SYSTEM' TO LG, ENTRY POINTS, RELOC. LIBRY, C PROGRAM SOURCE OR SWAP TRACKS. C C LGG = IGET(1765B) C CALCULATE DISK TRACK & LU FROM PACKED DISC PNTR CALL FDISK(LGG,NSPTRK,LUDS,LGSTRT) C CALCULATE LAST LG TRACK LGEND=LGSTRT+IAND(LGG,177B)-1 C NOT LG TRACK IF NOT RIGHT LU... IF(LUDISK .NE. LUDS) GOTO 232 IF((ITRACK .LT. LGSTRT) .OR. (ITRACK .GT. LGEND))GO TO 232 IOWN(1,JCNTR)=2H IOWN(2,JCNTR)=2HLG IOWN(3,JCNTR)=2H GO TO 100 C C SEE IF IT'S IN THE SYSTEM ENTRY POINT LIST... 232 CONTINUE C GET DISC PNTR LST = IGET(1761B) C CALCULATE LU & TRACK FROM PACKED DISC PNTR CALL FDISK(LST,NSPTRK,LUDS,IENTST) C CAN'T BE HERE IF NOT LU 2 IF(LUDISK .NE. 2) GOTO 234 IENTND=IENTST+(IGET(1762B)*4/64+IAND(LST,177B)-1)/NSPTRK IF((ITRACK .LT. IENTST) .OR. (ITRACK .GT. IENTND))GO TO 234 IOWN(1,JCNTR)=2H-E IOWN(2,JCNTR)=2HNT IOWN(3,JCNTR)=2HS- GO TO 100 C C SEE IF IT'S THE RELOCATABLE LIBRARY.... 234 CONTINUE C CAN'T BE IF NOT ON SYSTEM DISC... IF(LUDISK .NE. 2) GOTO 236 LBS=IGET(1763B) CALL FDISK(LBS,NSPTRK,LUDS,LBSTRT) IF((ITRACK .LT. LBSTRT) .OR. (ITRACK .GT. IENTST))GO TO 236 IOWN(1,JCNTR)=2HLI IOWN(2,JCNTR)=2HBR IOWN(3,JCNTR)=2HY- GO TO 100 C C SEE IF IT'S A PROGRAM 'SOURCE' OR SWAP TRACK... 236 CONTINUE CALL PRGTR(ITRACK,LUDISK,IOWN(1,JCNTR)) GO TO 100 C C NON-SYSTEM TRACKS C C GLOBAL? 24 IF(IAD.NE.77777B)GO TO 25 IOWN(1,JCNTR)=2HGL IOWN(2,JCNTR)=2HOB IOWN(3,JCNTR)=2HAL GO TO 100 C C FMP? 25 IF(IAD.NE.77776B)GO TO 26 IOWN(1,JCNTR)=2H-F `IOWN(2,JCNTR)=2HMP IOWN(3,JCNTR)=2H-- GO TO 100 C C ANYBODY OWN IT? 26 IF(IAD.NE.0)GO TO 27 C NOBODY OWNS IT. IOWN(1,JCNTR)=2H IOWN(2,JCNTR)=2H-- IOWN(3,JCNTR)=2H GOTO 100 C SOME PROGRAM OWNS IT. 27 IOWN(1,JCNTR)=IGET(IAD+12) IOWN(2,JCNTR)=IGET(IAD+13) IOWN(3,JCNTR)=IOR(IAND(IGET(IAD+14),77400B),40B) C 100 CONTINUE 222 CONTINUE WRITE(LIST,120)INDEX,IOWN INDEX = INDEX + 10 IF(N .GT. NCNT) GOTO 90 IF(N .NE. NTDSK1) GOTO 20 C SWITCHING OVER TO AUXILIARY DISC. WRITE(LIST,103) 103 FORMAT(/" AUXILIARY DISC"/) ITRACK = -1 LUDISK = 3 INDEX= 0 GOTO 20 C END C 90 CALL EXEC(6,0,0,LU,LU(2)) END C C SUBROUTINE FDISK(IPNTR,NSPTRK,LUDISK,JTRAK) C C FINDS THE SYSTEM OR AUXILIARY DISC WHERE THE DISC C POINTER (IN PACKED FORMAT) POINTS TO, C AS WELL AS THE TRACK. C C USES RTE CONVENTION (IF IPNTR < 0 THEN LU IS 3, ELSE 2. C C ON RETURN: C NSPTRK = # SECTORS PER TRACK ON THE DISC C LUDISK = 2 OR 3 (DISK LU) C JTRAK = TRACK ADDRESS C LUDISK = 2 IF(IPNTR .LT. 0) LUDISK = 3 NSPTRK = IGET(1755B + LUDISK) JTRAK = IAND(IPNTR,77600B) / 128 RETURN END SUBROUTINE PRGTR(ITRACK,LUDISK,NAME) C C VERSION 7-27 - 77 LAW C DETERMINES IF ITRACK & LUDISK POINT TO A TRACK C USED FOR STORING THE VIRGIN VERSION OR C SWAPPED VERSION OF A PROGRAM. C C DIMENSION NAME(3) INTEGER SHRTID,HIGHBP INTEGER FSWTRK C C INITIALIZE SEARCH THRU KEYWORD BLOCK KEYWD=IGET(1657B) C 10 IDADR=IGET(KEYWD) IF(IDADR.LE.0)GO TO 90 NAME3=IGET(IDADR + 14) < SHRTID = 0 IF(IAND(NAME3,20B) .NE. 0) SHRTID = -1 C MAKE SURE IT'S A DISC-RESIDENT PROGRAM C OR SHORT ID FOR SEGMENTS. IF(IAND(NAME3,22) .EQ. 0) GOTO 22 C SET FLAG FOR "SOURCE" TRACK ITYPE=46B C C GET HI & LOW MAIN & BP ADDRESSES C IF(SHRTID) 12,15 12 CONTINUE C C SHORT ID SEGMENT. C LOWMAN=IGET(IDADR + 15) MAINHI=IGET(IDADR + 16) LOWBP = IGET(IDADR + 17) HIGHBP=IGET(IDADR + 18) KTRAK=IGET(IDADR + 19) GOTO 16 15 CONTINUE C C LONG ID SEGMENT C LOWMAN = IGET(IDADR + 22) MAINHI = IGET(IDADR + 23) LOWBP = IGET(IDADR + 24) HIGHBP = IGET(IDADR + 25) KTRAK = IGET(IDADR + 26) 16 CONTINUE C IF BLANK ID SEGMENT THEN GO ON.... IF(KTRAK .EQ. 0) GOTO 22 C C CALCULATE # SECTORS REQUIRED FOR PROGRAM C STORAGE. NSECTS= ((MAINHI - LOWMAN + 127) /128) * 2 + 1((HIGHBP - LOWBP + 127) /128) * 2 C C FIND DISK TRACK & LU CALL FDISK(KTRAK,NSPTRK,LUDS,JTRAK) C CAN'T BE IF LUS NOT RIGHT.... IF(LUDISK .NE. LUDS) GOTO 20 C CALCULATE LAST TRACK LSTRK=JTRAK + NSECTS / NSPTRK IF((JTRAK .LE. ITRACK) .AND. (ITRACK .LE. LSTRK)) 25,20 C C NOT SOURCE TRACK. TRY SWAP TRACK. C C CHECK FOR SHORT ID SEGMENT 20 CONTINUE IF(SHRTID) 22,21 21 CONTINUE C GET CODED SWAP TRACK (LU, TRACK, # TRACKS) KTRAK = IGET(IDADR + 27) C IF NO SWAP TRACKS, GO ON... IF(KTRAK .EQ. 0) GOTO 22 C SEPARATE LU, FIRST & LAST SWAP TRACKS CALL FDISK(KTRAK,NSPTRK,LUDS,FSWTRK) LSWTRK = IAND(KTRAK,177B) + FSWTRK - 1 C IF LUS NOT SAME, THIS PROG NOT ON THIS TRACK IF(LUDISK .NE. LUDS) GOTO 22 C  SET UP SPECIAL CHARACTER IN NAME C TO IDENTIFY TRACK AS SWAP TRACK (^) ITYPE=136B IF((FSWTRK .LE. ITRACK) .AND. (ITRACK .LE. LSWTRK)) 25,22 22 CONTINUE C IF TRACK IS NEITHER SOURCE NOR SWAP TRACK FOR C THIS PROGRAM, GO ON TO NEXT PROGRAM. KEYWD=KEYWD+1 GO TO 10 C C 25 CONTINUE C FOUND PROGRAM WHICH IS STORED ON THIS TRACK. NAME = IGET(IDADR + 12) NAME(2)=IGET(IDADR+13) C MERGE IN CHARACTER FOR SOURCE OR SWAP TRACK. NAME(3)=IOR(IAND(NAME3,77400B),ITYPE) 90 RETURN END END$ V S ] 24999-18178 1750 S 0100 HP 93551A COMMUNICATION BOOTSTRAP LOADER             H0101 ASMB,A,B,L,C HED CBL * (SPECIAL) * 24999-18178 REV 1750 771112 * * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * THIS IS THE CODE USED IN THE CBL ROM FOR INITIATING * DOWNLOADS FROM A REMOTE COMPUTER. ON ENTRY THE SWITCH * REGISTER CONTAINS FIVE OCTAL DIGITS WHICH * ARE LATER CONCATENATED WITH AN ASCII "P" TO PRODUCE * THE FILE NAME OF THE CORE IMAGE TO BE DOWNLOADED. * IF BIT 15 IS "1", CBL PRESUMES IT IS A FORCED COLD * LOAD REQUEST AND CLEARS MEMORY (EXCEPT FOR THE UPPERMOST * 64 WORDS) BEFORE REQUESTING A DOWNLOAD. * ORG 77700B CBL CCB LDA MCALL XE MACRO FOR CBL MICROCODE OCT 100060 CHECK MACHINE TYPE RSS CAN GET HERE ONLY IF XE LDA MX$ GET 21MX CBL MACRO STA MCALL SET INTO IN-LINE CODE LIA 1 GET PGM # RAL,CLE,SLA,ERA SIGN SET? JMP FCL YES, IT'S AN FCL * SETPG STA SWREG SAVE PROGRAM # IO CLC 10B,C INITIALIZE CARD (THIS GETS RECON'D) LDA IO GET I/O INSTRUCTION AND B77 ISOLATE SELECT CODE LDB 0 PASS IT IN B REG TO MICROCODE LDA SWREG OTA 1 ENSURE SW REG HAS PGM # * EXECUTE CBL MICROCODE MCALL OCT 105342 MODIFIED TO 105522 IF A 21MX * OTA 1 FAILED IF WE GOT HERE, SET LDA NCNTR ERROR CODE IN SW REG AND CLB DELAY FOR 10 SECONDS (IF XE) INB,SZB BEFORE HALTING JMP *-1 INA,SZA 10 SECONDS UP? JMP *-3 NO, LOOP HLT 55B YES, HALT * IF OPERATOR PUSHES "RUN", DO A RETRY JMP IO * FCL LDB HIADO   GET -(ADDR OF SCE.1) INB CMB B=ADDR(CBL)-2 CBX CLB FIRST ZERO ALL SBX 1 OF CORE DSX JMP *-3 STA SWREG SAVE PROGRAM NO. LDA FCNTR LOAD 5 SEC DELAY CLB INB,SZB DELAY FOR 5 SEC. JMP *-1 INA,SZA JMP *-3 JMP IO AND START THE DOWNLOAD. * SWREG NOP NCNTR DEC -82 10 SECOND XE DELAY FCNTR DEC -41 5 SECOND XE DELAY B77 OCT 77 MX$ OCT 105522 HIAD EQU CBL+77B * END P^  T[ 24999-18197 2024 S 0100 &CDA4 SOURCE             H0101 FTN4,L PROGRAM CDA4 (4,90),24999-16197 REV. 2024 781107 C C THE CRASH DUMP ANALYSER -- MAINLINE C C MIKE MANLEY RTE IV VERSION C 11/07/78 EFH C 01/16/80 JEF C C-------------------------------------------------------------------- IMPLICIT INTEGER (A-Z) REAL REG,REIO COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) C COMMON /CDASG/ RTNA, IPBUF(33), IPRAM(6), IARRAY(64), IDISC(36), & IGO(35), IGO2(35), IFILE(10), JBUF(30), IOP, LEN, IMAP(35) C DIMENSION IREG(2), ISKP(6), IMCOD(4), MES1(17) C EQUIVALENCE(IREG,REG,IA),(IREG(2),IB) EQUIVALENCE(IPBUF(2),IPRS1),(IPBUF(6),IPRS2),(IPBUF(10),IPRS3) EQUIVALENCE(IPBUF(14),IPRS4),(IPBUF(18),IPRS5) EQUIVALENCE(IPBUF(22),IPRS6),(IPBUF(26),IPRS7) EQUIVALENCE(IPBUF(30),IPRS8) C DATA ISKP /2HLL,2HFI,2H/E,2HEX,2HEN,2H??/ DATA IMCOD /2HPH,2HDP,2HSY,2HUS/ DATA MES1 /2H--,2H C,2HOM,2HMA,2HND,2H C,2HAN,2H'T,2H B,2HE , & 2HUS,2HED,2H I,2HN ,2H--,2H M,2HAP/ C C INITIALIZE VARIABLES, OPEN FILES WITH INIT SUBROUTINE C C---------------------------------------------------------------------- C C DRTN IS AN ASSEMBLER ROUTINE THAT RETURNS THE ADDRESS THAT C IT WAS CALLED FROM. IN THIS PROGRAM, IT IS USED TO MAKE SEGMENTS C LOOK AS IF THEY WERE SUBROUTINES. IMMEDIATELY BELOW, IOP2 IS SET TO C 1 BEFORE CALLING DRTN AND EXECUTING THE SEGMENT. WHEN THE SEGMENT C CALLS THE JMP FUNCTION, IT RETURNS TO THE FIRST STATEMENT AFTER C THE CALL TO DRTN. SINCE IOP2 IS NOW ZERO, THE MAINLINE CONTINUES C RATHER THAN CALLING THE SEGMENT AGAIN. C C---------------------------------------------------------------------- IOP2 = 1 RTXNA = DRTN(0) IF(IOP2.EQ.0)GO TO 1 IOP2 = 0 IOP = 0 CALL EXEC(8,6HCDA4A ) C C SET UP THE IPRAM BUFFER. THIS BUFFER IS USED BY THE I/O C SUBROUTINES (DOIO & DISC3) TO DETERMINE HOW THE I/O IS C TO BE DONE. C 1 IF(IWRN.NE.0) CALL PRNT(32H16WARNING: DEAD AREA PROCESSED!!) IWRN = 0 BPFLAG = HIDEBP MPFLAG = HIDEMP IPRAM = 1 IPRAM(2) = 0 IPRAM(3) = 0 IPRAM(4) = 0 IPRAM(5) = 0 IPRAM(6) = -1 CALL EXEC(2,LU1+ 2000B,2H= ,-2) REG = REIO(1,LU1 + 400B,JBUF,-30) LEN = IB IF(IB.LT.2)GO TO 1 CALL PARSE(JBUF,IB,IPBUF) C C SEE IF THE PACKED FORM OF THE OUTPUT IS DESIRED C IF(IPBUF(3).EQ.2HPK) IPRAM(5) = 1 C C IF LU2 NOT = LU1, PRINT COMMAND TO LU2 C IF(IPRS1.EQ.2HEP .OR. IPRS1.EQ.2HLL)GO TO 19 IF(INTER.EQ.-1)GO TO 19 CALL EXEC(2,LU2,2H ,1) CALL EXEC(2,LU2,JBUF,-LEN) CALL EXEC(2,LU2,2H ,1) C C CHECK FOR A FEW SPECIAL COMMANDS THAT DON'T USE THE CRASH FILE C DO 14 I = 1,6 IF (IPRS1.EQ.ISKP(I)) GO TO 19 14 CONTINUE IF(FIOPEN.EQ.1)GO TO 19 CALL EXEC(2,LU1,30HCRASH FILE HAS NOT BEEN OPENED,15) GO TO 1 C C***** FIND OUT WHICH COMMAND IT WAS C 19 IERR = 0 HIDEBP = BPFLAG HIDEMP = MPFLAG DO 20 I = 1,35 IF (IGO(I).EQ.IPRS1) GO TO 25 20 CONTINUE CALL IWSUB(LU1) GOTO 1 C C CHECK THE MAP IS OK FOR THIS COMMAND C 25 IF(MPFLAG.EQ.0 .AND. IAND(IMAP(I),1).NE.0) GO TO 30 IF(MPFLAG.EQ.1 .AND. IAND(IMAP(I),2).NE.0) GO TO 30 IF(MPFLAG.EQ.2 .AND. IAND(IMAP(I),4).NE.0) GO TO 30 IF(MPFLAG.EQ.3 .AND. IAND(IMAP(I),8).NE.0) GO TO 30 C C IT'S NOT - PRINT AN ERROR MESSAGE C MES1( 1) = IPRS1 MES1(15) = IMCOD(MPFLAG+1) CALL EXEC(2,LU1,MES1,17) GO TO 1 C C SET UP A RETURN ADDRESS @C 30 IOP2 = 1 RNTA = DRTN(0) IF(IOP2.EQ.0)GO TO 1 C C CALL SEGMENT AS REQUIRED C 40 IOP2 = 0 IOP = I IF (IGO2(I).NE.1) GO TO 50 CALL EXEC(8, 6HCDA4A ) 50 IF (IGO2(I).NE.2) GO TO 60 CALL EXEC(8, 6HCDA4B ) 60 GO TO (101, 102, 103, 104, 105, 106, 107, 108, 109, 110, & 111, 112, 100, 100, 100, 100, 100, 100, 100, 120, & 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, & 100, 100, 100, 100, 100) I C C INTERNAL ERROR IF WE GET TO 100 C 100 CALL EXEC(2,LU1,14HINTERNAL ERROR,7) GO TO 1 C C SUBROUTINE CALLS C 101 GO TO 1 C 102 CONTINUE 103 CONTINUE 104 CALL EXSUB GO TO 1 105 CALL QUSUB(IPRS2) GO TO 1 106 CALL LMSUB(IPRS2, IPRS3, IPRAM, LU2, LU1) GO TO 1 107 CALL LLSUB(IPRS2, INTER, LU2, LU1) GO TO 1 108 CALL TRSUB(IPRS2, IPRS3, IPRS4, IPRS5, IPRAM, LU2) GO TO 1 109 CALL DPSUB(IPRS2, IPRS3, IPRS4, LU2) GO TO 1 110 CALL DUSUB(IPRAM, LU2) GO TO 1 111 CALL MPSUB(IPRS2) GO TO 1 112 CALL BPSUB(IPRS2) GO TO 1 120 CALL EXEC(3,LU2+700B,-1) GO TO 1 END C C C ILLEGAL COMMAND C C SUBROUTINE IWSUB(LU1) DIMENSION IWHAT(6) DATA IWHAT/2H ,2HSA,2HY ,2HWH,2HAT,2H ?/ CALL EXEC(2,LU1,IWHAT,-12) RETURN END C C *****OUT OF RANGE MESSAGE***** C SUBROUTINE ITSUB(LU1) DIMENSION IOUT(7) DATA IOUT/2H ,2HOU,2HT ,2HOF,2H R,2HAN,2HGE/ CALL EXEC(2,LU1,IOUT,7) RETURN END C C *****NOT FOUND MESSAGE***** C SUBROUTINE NFSUB(ITEM,LU1) DIMENSION IMES11(9),ITEM(3) DATA IMES11/2H ,2H ,2H ,2H ,2HNO,2HT ,2HFO,2HUN,2HD / DO 60 I = 1,3 IMES11(I) = ITEM(I) 60 CONTINUE CALL EXEC(2,LU1,IMES11,9) RETURN END C C *****EXIT STUFF***** C SUBROUTINE EXSUB IMPLICIT INTEGER (A-Z)3f COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SUBF1(128), SBUF2(128), TRTAB(64) C C UNLOCK ALL DEVICES AND CLOSE FILES C CALL LURQ(100000B, LU2-200B, 1) IF (FIOPEN.EQ.1) CALL CLOSE (IDCB,IERR) CALL ERR CALL CLOSE (SDCB1,IERR) CALL ERR CALL CLOSE (SDCB2,IERR) CALL ERR CALL EXEC(2,LU1,16H =CDA4 DONE ! ,-16) CALL EXEC(6,0) RETURN END C C C*****LIST ANY MEMORY LOCATION REQUESTED***** C C SUBROUTINE LMSUB(IPRS2,IPRS3,IPRAM,LU2,LU1) DIMENSION IPRAM(6) C C L1 = IPRS2 L2 = L1 - 1 + IPRS3 IF(IPRS3.EQ.0) L2 = L1 IF(IPRS3.LT.0) L2 = - IPRS3 IF (L1.LT.0) GO TO 450 CALL DOIO(L1,L2,LU2,IPRAM) RETURN 450 CALL ITSUB(LU1) RETURN END C C*****CHANGE OUTPUT LU***** C SUBROUTINE LLSUB(IPRS2,INTER,LU2,LU1) C C CHECK IF LEGAL LU C CALL LURQ(100000B,0,0) CALL EXEC(100015B,IPRS2,ISTA1) GO TO 650 C C VALID LU # -- CHECK FOR INTERACTIVE (LOCK IF NOT) C 640 INTER = IFTTY(IPRS2) LU2 = IPRS2+200B 641 IF(INTER.EQ.-1) RETURN CALL LURQ(100001B,LU2-200B,1) CALL ABREG(IA,IB) IF(IA.EQ.0) RETURN IF(IA.EQ.-1) GO TO 18 CALL EXEC(2,LU1,14HWAITING FOR LU,7) GO TO 16 18 CALL EXEC(2,LU1,14HWAITING FOR RN,7) 16 CALL EXEC(12,0,1,0,-100) IF(IFBRK(IDMY).NE.-1) GO TO 641 RETURN C C INVALID LU # C 650 CALL IWSUB(LU1) RETURN END C C C******************* TRACE A LIST IN ANY MAP ************************** C SUBROUTINE TRSUB(IPRS2,IPRS3,IPRS4,IPRS5,IPRAM,LU2) DIMENSION IPRAM(6) C C THIS ROUTINE TRACES A LIST STARTING AT IPRS2 UNTIL C THE VALUE IPRS3 IS FOUND. IPRS4 IS ADDED IN AS AN OFFSET, C AND IPRS5 IS AN UPPER LIMIT ON THE NUMBER OF LINKS T)O C FOLLOW C---------------------------------------------------------------------- C IPRL2 = IPRS2 I = 0 GO TO 1615 C 1610 IF(IPRL2.LT.0 .OR. IPRL2.EQ.IPRS3) RETURN IPRL2 = IPRL2 + IPRS4 1615 CALL DOIO(IPRL2,IPRL2,LU2,IPRAM) I = I + 1 IF(I.EQ.IPRS5 .OR. IPRAM(3).EQ.9999) RETURN IPRL2 = IPRL2 IPRAM(3) = 1 IPRL2 = IGET(IPRL2) IF(IFBRK(IDMY))1620,1610 1620 RETURN END C C*********DISPLAY WHATEVER THE USER HAS INPUT ************ C C SUBROUTINE DPSUB(IPRS2,IPRS3,IPRS4,LU2) IMPLICIT INTEGER (A-Z) DIMENSION IARRAY(64),IDISC(36),IPRAM(6) DIMENSION MES1(22),MES2(36) C DATA MES1/2H22,2H ,2HVA,2HLU,2HE(,2H8),2H ,2HVA,2HLU,2HE(, & 2H10,2H) ,2HVA,2HLU,2HE(,2HAS,2H) ,2HVA,2HLU,2HE(, & 2HSY,2HM)/ DATA MES2/ 2H ,2H ,2H..,2H..,2H..,2H ,2H ,2H..,2H.., & 2H..,2H ,2H ,2H ,2H..,2H ,2H ,2H..,2H..,2H.., & 2H..,2H..,2H..,2H..,2H..,2H..,2H..,2H..,2H..,2H.., & 2H..,2H..,2H..,2H..,2H..,2H../ C IF(IPRS3.EQ.0) GO TO 1750 IF(IPRS3.EQ.2H* )IPRS2 = IPRS2*IPRS4 IF(IPRS3.EQ.2H+ )IPRS2 = IPRS2+IPRS4 IF(IPRS3.EQ.2H/ )IPRS2 = IPRS2/IPRS4 IF(IPRS3.EQ.2H- )IPRS2 = IPRS2-IPRS4 1750 CALL OCT(IPRS2,MES2(3)) CALL CNUMD(IABS(IPRS2),MES2(8)) IF(IPRS2.LT.0) MES2(8) = MES2(8) + 2H- - 2H CALL IASCI(IPRS2,MES2(14)) CALL INVRS(0,IPRS2,MES2(17),16,RES) CALL PRNT(MES1) CALL EXEC(2,LU2,MES2,RES+16) RETURN END C C C *****DUMP THE SYSTEM TO LIST DEVICE***** C C SUBROUTINE DUSUB(IPRAM,LU2) DIMENSION IPRAM(6) IPRAM(5) = 1 CALL DOIO(0,32767,LU2,IPRAM) RETURN END SUBROUTINE QUSUB(IPRM1) IMPLICIT INTEGER (A-Z) COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER,E IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) COMMON /QT/ QTTAB(1) COMMON /MEM/ M(1) C C QUSUB IMPLEMENTS THE HELP FUNCTION. IF IPRM1 IS FOUND IN C THE HELP TABLE, THEN A DESCRIPTION OF THAT COMMAND (ONLY) IS C PRINTED. OTHERWISE, A SUMMARY OF ALL COMMANDS IS PRINTED. C C THE DATA TABLE IS QTTAB, AND IS INITIALIZED IN ASSEMBLY CODE. C THE FORMAT OF EACH ENTRY: C C WORD 1 POINTER TO DESCRIPTION C 2 POINTER TO DETAILS C C THE LAST ENTRY IS INDICATED BY A ZERO VALUE IN WORD 1 C C THE DESCRIPTION HAS THIS FORMAT: C C WORD 1 LENGTH (IN ASCII) OF DESCRIPTION (=N) C 2 THE COMMAND CODE C 3-N DESCRIPTION C C THE DETAILED DESCRIPTION CONSISTS OF A SERIES OF TEXT LINES. C EACH LINE HAS THIS FORMAT: C C WORD 1 LENGTH (IN ASCII) C 2 TEXT C C THE END OF THE DESCRIPTION IS INDICATED BY A ZERO (BINARY) WORD C C----------------------------------------------------------------------- C C SEARCH FOR COMMAND C IF(IPRM1.EQ.2H )GO TO 20 DO 10 J = 1,32767,2 IF(QTTAB(J).EQ.0) GO TO 20 IF(M(QTTAB(J)+2).EQ.IPRM1) GO TO 40 10 CONTINUE C C NOT FOUND, PRINT SUMMARY TABLE C 20 CALL PRNT(20H10CMD DESCRIPTION ) CALL PRNT(4H02 ) DO 30 J = 1,32767,2 IF(IFBRK(0).NE.0) RETURN IF(QTTAB(J).EQ.0) RETURN CALL PRNT(M(QTTAB(J)+1)) 30 CONTINUE RETURN C C FOUND, PRINT DETAILS C 40 ADDR = QTTAB(J+1) 50 CALL PRNT(M(ADDR+1)) TEMP = M(ADDR+1) - 2H00 TEMP2 = (TEMP/256) ADDR = ADDR + TEMP - TEMP2*246 IF(M(ADDR+1).NE.0) GO TO 50 RETURN END SUBROUTINE BPSUB(IP) IMPLICIT INTEGER(A-Z) COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1 (128), SBUF2(128), TRTAB(64), & PRFLAG C C SUBROUTINE TO SET THE BASE PAGE FLAG (BP COMMAND) C C------------------------------------------------------------------------- IF(IP.NE.2HON.AND.IP.NE.2HOF)CALL IWSUB(LU1) IF(IP.EQ.2HON) HIDEBP = 1 IF(IP.EQ.2HOF) HIDEBP = 0 RETURN END SUBROUTINE MPSUB(IP) IMPLICIT INTEGER (A-Z) COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64), & PRFLAG COMMON /CDA2/ DS1, DS2, MLIM, MSTAT, DPLIM C C SUBROUTINE TO SET THE MAP FLAG (MP COMMAND) C C------------------------------------------------------------------------- IF(IP.NE.2HPH.AND.IP.NE.2HSY.AND.IP.NE.2HUS.AND.IP.NE.2HDP) & CALL IWSUB(LU1) IF(IP.EQ.2HPH) HIDEMP = 0 IF(IP.EQ.2HDP) HIDEMP = 1 IF(IP.EQ.2HSY) HIDEMP = 2 IF(IP.EQ.2HUS) HIDEMP = 3 IF(HIDEMP.LE.MLIM) RETURN CALL PRNT(30H15REQUESTED MAP IS NOT IN DUMP) HIDEMP = MPFLAG RETURN END SUBROUTINE ERR IMPLICIT INTEGER (A-Z) COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64), & PRFLAG DIMENSION MES1(11) DATA MES1/2HFI,2HLE,2H I,2H/O,2H E,2HRR,2HOR,2H -,2H--,2H--,2H--/ * * ERR PRINTS THE ERROR NUMBER FOR FILE I/O (IE, IF IERR IS < 0) * IF(IERR.GE.0)RETURN CALL CNUMD(IABS(IERR), MES1(9)) CALL EXEC(2,LU1,MES1,11) RETURN END BLOCK DATA CDA,BLOCK DATA FOR CDA4 IMPLICIT INTEGER (A-Z) COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64), & PRFLAG C COMMON /CDA2/ DS1, DS2, MLIM, MSTAT, DPLIM C COMMON /CDASG/ RTNA, IPBUF(33), IPRAM(6), IARRAY(64), IDISC(36), & IGO(35), IGO2(35), IFILE(10), JBUF(30), IOP, LEN, IMAP(35) C DATA IDISC/2H ,2HLU,2H= ,2H ,2H ,2H ,2H ,2HTR,2HK ,2H= , & 2H ,2H ,2H ,2H ,2HSE,2HCT,2HR ,2H= ,2H ,2H ,2H , & 2H ,2HWO,2HRD,2H =,2H ,2H ,2H ,2H ,2HOL,2HD(,2H8), & 2H =,2H ,2H ,2H / DATA IGO /2H**,2HEX,2HEN,2H/E,2H??,2HLM,2HLL,2HTR,2HDP,2HDU, & 2HMP,2HBP,2HID,2HEQ,2HDR,2HIN,2HCT,2HF/,2HLI,2HEP, & 2HTA,2HCM,2HMA,2HDB,2HWH,2H**,2HAN,2HFI,2H**,2HVE, & 2H**,2H**,2H**,2H**,2H**/ DATA IGO2 / 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, & 1, 1, 1, 2, 2, 2, 1, 2, 1, 2, & 0, 0, 0, 0, 0/ DATA IMAP / 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, & 15, 15, 5, 5, 5, 5, 5, 15, 5, 15, & 5, 7, 15, 15, 5, 0, 5, 15, 0, 5, & 0, 0, 0, 0, 0/ C C IGO AND IGO2 DEFINE THE COMMANDS: IGO HAS THE ABBREVIATIONS, C AND IGO2 INDICATES WHICH SEGMENT HAS THE COMMAND. IGO2 = 0 C INDICATES THE MAIN, 1 INDICATES CDA4A, AND 2 INDICATES CDA4B C C IMAP INDICATES WHICH MAPS ARE ALLOWED FOR EACH COMMAND. BIT 0 C IS FOR PH, 1 FOR DP, 2 FOR SY, AND 3 FOR US C C NOTE THAT COMMON AREAS MEM, CT, AND CTPR ARE DEFINED IN ASSEMBLER C END END$ FTN4,Q,L,T SUBROUTINE DOIO(ISTART,ISTOP,LU,IPRAM) DIMENSION IBUF(40),IMESS(29),IPRAM(6),LMESS(17) DIMENSION IPAGE(11) INTEGER OBUF(37) C DATA IMESS/2H ,2HWO,2HRD, &2H ,2HLO,2HCA,2HTI,2HON,2H , &2HVA,2HLU,2HE(,2H8),2H ,2HVA,2HLU,2HE(,2H10,2H) , &2HVA,2HLU,2HE(,2HAS,2H) ,2HVA,2HLU,2HE(,2HSY[,2HM)/ DATA IPAGE/2H ,2HPH,2HYS,2HIC,2HAL,2H P,2HAG,2HE / DATA LMESS/2H ,2HLO,2HCA,2HTI,2HON,2HS ,2H ,2H ,2H , &2H T,2HHR,2HOU,2HGH,2H / DATA IBUF/40*2H / C C C THE IPRAM ARRAY TELLS HOW TO DO THE I/O C IPRAM(1) = WORD # TO START COUNTING AT, C IPRAM(2) = 0 MEANS WORD COUNT TO BE IN DECIMAL C IPRAM(2) = 1 MEANS WORD COUNT TO BE IN OCTAL C IPRAM(3) = 0 MEANS PRINT HEADER. = 1 MEANS NO HEADER. C IPRAM(5) = 1 MEANS A PACKED LISTING IS DESIRED C IPRAM(6) =+N MEANS A MAPPED IN LISTING OF PHYS MEMORY C WHERE N = PHYSICAL PAGE NUMBER C IPRAM(6) =-1 MEANS WE ARE DOING NORMAL I/O C C ISTART IS LOCATION TO START COUNTING AT C ISTOP IS LOCATION TO STOP COUNTING AT. C LU IS THE OUTPUT LU. C C K = IPRAM-1 C IF(IPRAM(5).EQ.1) GO TO 500 C IF(IPRAM(6).LT.0) GO TO 1 CALL CNUMD(IPRAM(6),IPAGE(9)) CALL EXEC(2,LU,IPAGE,11) 1 IF(IPRAM(3).EQ. 0) CALL EXEC(2,LU,IMESS,-58) C C DO 100 I = ISTART,ISTOP K = K + 1 IF((IPRAM(6).LT.0).OR.(K.NE.1024)) GO TO 2 K = 0 IPRAM(6) = IPRAM(6) + 1 2 CALL CNUMD(K,IBUF(1)) IF(IPRAM(2) .EQ.1) CALL CNUMO(K,IBUF(1)) CALL CNUMO(I,IBUF(5)) IF(IPRAM(6).LT.0) GO TO 50 CALL CNUMD(IPRAM(6),IBUF(5)) IBUF(5) = 2HPG 50 CALL CNUMO(IGET(I),IBUF(10)) CALL CNUMD(IABS(IGET(I)),IBUF(15)) IF (IGET(I).LT.0) IBUF(15) = IBUF(15) + 6400B C CALL IASCI(IGET(I),IBUF(22)) CALL INVRS(I,IGET(I),IBUF(25),16,IWRD) C 75 CALL EXEC(2,LU,IBUF,24+IWRD) IF(IFBRK(IDMY))200,100 100 CONTINUE GO TO 300 200 IPRAM(3) = 9999 300 RETURN C C 500 K = ISTART 550 IF((ISTOP-K).LT.0) RETURN CALL CNUMO(K,LMESS(7)) CALL CNUMO(ISTOP,LMESS(15)) IF(((ISTOP-K)/64).GT.0) CALL CNUMO(K + 63,LMESS(15)) C IF(IPRAM(6).LT.0) GO TO 551 CALL CNUMO(IPRAM,LMESS(7)) CALL CNUMO(IPRAM+ISTOP - Il"START,LMESS(15)) CALL CNUMD(IPRAM(6),IPAGE(9)) C 551 CALL EXEC(3,LU + 700B,1) IF(IPRAM(6).GE.0) CALL EXEC(2,LU,IPAGE,11) CALL EXEC(2,LU,LMESS,17) CALL EXEC(3,LU + 700B,1) C DO 800 I = 1,8 C CALL PACK (ISTOP - K + 1,IPRAM(4)+1,K,OBUF) CALL EXEC(2,LU,OBUF,37) C K = K + 8 IF((ISTOP-K).LT.0) RETURN IF(IFBRK(IDMY)) 200,800 800 CONTINUE C GO TO 550 END INTEGER FUNCTION IGET(IADDR) IMPLICIT INTEGER (A-Z) COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) COMMON /CDA2/ DS1, DS2, MLIM, MSTAT, DPLIM C C IGET - FETCHES A WORD FROM THE APPROPRIATE MAP (PH, SY, US) C BY READING FROM THE CRASH FILE. IF THE BASE PAGE FLAG C IS ON, AND THE MAP IS PH OR SY, THEN THE BASE PAGE FROM C THE SNAPSHOT IS SUBSTITUTED. C C RECORDS IN THE CRASH FILE ARE 128 WORDS LONG. RECORDS 1-256 C CONTAIN THE IMAGE OF THE FIRST 32K OF PHYSICAL MEMORY; C RECORD 257 CONTAINS THE FOUR MAPS (S,U,A,B); C C RECORDS 258-K CONTAIN THE DRIVER PARTITIONS (THE EXACT C NUMBER OF BLOCKS IS DETERMINED BY $MRMP IF THE DUMP C WAS FROM THE GENNED IN DUMPER; OTHERWISE 48K IS USED AS C A DEFAULT. IF THE CONTENT OF $MRMP IS <=32, 32K IS DUMPED; C IF THE VALUE IS BETWEEN 32 AND 63, THAT VALUE IS USED; C OTHERWISE 48K IS DUMPED. SINCE THE FIRST 32K ARE AT THE C BEGINNING OF THE TAPE, THIS PART OF THE FILE ONLY HAS THE C REMAINDER (E.G., FOR A 48K DUMP, THERE IS 16K HERE.) C C RECORDS K+1-N C CONTAIN THE PHYSICAL PAGES IN THE SYSTEM MAP AND IN THE USER C MAP THAT ARE NOT PART OF THE BLOCK OF PHYSICAL MEMORY DUMPED C AS DESCRIBED ABOVE  (BETWEEN 32 AND 64K). C C TRTAB IS USED TO MAP FROM SYSTEM/USER MAPS TO RECORD ADDRESSES. C C MPFLAG CODES: C 0 - PHYS MEM (1ST 32K) 1 - DVR PTTNS (REST OF PHYS MEM) C 2 - SYSTEM MAP 3 - USER MAP C C----------------------------------------------------------------------- C IF (IADDR.LT.0)CALL EXEC(2,LU1,24HNEGATIVE ADDRESS IN IGET,12) C C IF BASE PAGE SWITCH IS ON, WORD IS IN BASE PAGE, AND NOT IN C USER MAP, CALL SGET TO FETCH FROM SNAPSHOT C IF (BPFLAG.EQ.0.OR.IADDR.GT.1023.OR.MPFLAG.EQ.1.OR.MPFLAG.EQ.3) & GO TO 10 IGET=SGET(IADDR) RETURN C C COMPUTE THE RECORD NUMBER C 10 IPAGE = IADDR/1024 IWORD = IADDR - IPAGE*1024 IF(MPFLAG.EQ.0) IREC = 1 + IADDR/128 IF(MPFLAG.EQ.1) IREC = 258 + IADDR/128 IF(MPFLAG.EQ.2) IREC = TRTAB(IPAGE + 1) + IWORD/128 IF(MPFLAG.EQ.3) IREC = TRTAB(IPAGE + 33) + IWORD/128 IF(MPFLAG.NE.1 .OR. IADDR.LT.(DPLIM-32)*1024) GO TO 15 IOREC = 0 IGET = 0 IWRN = 1 RETURN C 15 IWD2 = IWORD - (IWORD/128)*128 C C SET THE IWRN FLAG IF DATA FROM THE DEAD AREA IS SELECTED C IADD2 = (IREC-1)*128 + IWD2 IF(IADD2.GE.DS1.AND.IADD2.LE.DS2) IWRN = 1 C C READ IN THE APPROPRIATE RECORD (ONLY IF IT IS NOT IN THE BUFFER) C IF (IOREC.NE.IREC) CALL READF(IDCB,IERR,IBUF,128,IDMY,IREC) IF (IERR.NE.-12) GO TO 20 IOREC = 0 IGET = 0 RETURN 20 CALL ERR IGET = IBUF(IWD2 + 1) IOREC = IREC RETURN END INTEGER FUNCTION SGET(IADDR) IMPLICIT INTEGER (A-Z) COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) C C SGET FETCHES A WORD FROM THE SNAPSHOT OF THE SYSTEM. THE b)C FILE HAS NO STRUCTURE; IT CONTAINS 32K WORDS OF THE SYSTEM C PLUS THE DRIVER PARTITIONS C (256 + N RECORDS OF 128 WORDS EACH). C IF (IADDR.LT.0) CALL EXEC(2,LU1,24HNEGATIVE ADDRESS IN SGET,12) IREC = IADDR/128 + 1 IF(MPFLAG.EQ.1) IREC = IREC + 256 IF (IREC.NE.SOREC) CALL READF(SDCB2,IERR,SBUF2,128,IDMY,IREC) IF (IERR.NE.-12) GO TO 10 SGET = 0 SOREC = 0 IWRN = 1 RETURN 10 CALL ERR SGET = SBUF2(IADDR - (IREC - 1)*128 + 1) SOREC = IREC RETURN END SUBROUTINE OCT(NUM,BUF) IMPLICIT INTEGER (A-Z) DIMENSION BUF(3) C C OCT CONVERTS A NUMBER TO OCTAL WITH LEADING ZEROS C CALL CNUMO(NUM,BUF) DO 10 J = 1,3 BUF(J) = IOR(BUF(J),2H00) 10 CONTINUE RETURN END END$ ASMB,Q,C NAM INVRS,7 * * THIS ROUTINE INVERSE ASSEMBLES HP 21MX * INSTRUCTIONS * * THE CALLING SEQUENCE IS AS FOLLOWS * * JSB INVRS * DEF RTRN * DEF ADDRSS LOGICAL ADDRESS OF INSTRUCTION * DEF VALUE INSTRUCTION AT ADDRSS * DEF IBUF OUTPUT BUFFER * DEF ISIZE SIZE OF OUTPUT BUFFER * DEF IWRDS RETURNED NO OF WORDS FILLED * RTRN ... * * FORTRAN CALL: * * CALL INVRS(IADRS,VALUE,IBUF,ISIZE,IWRDS) * * ENT INVRS EXT .ENTR * * A EQU 0 B EQU 1 * * ADDRS BSS 1 VALUE BSS 1 BUFAD BSS 1 BSIZE BSS 1 WCNT BSS 1 INVRS NOP JSB .ENTR DEF ADDRS LDA BUFAD RAL MAKE BYTE ADDRESS STA BUFAD STA BPNTR LDB BSIZE,I GET BUFFER SIZE RBL MAKE INTO BYTES ADA B COMPUTE END OF BUFFER STA BFEND LDA ADDRS,I STA IADR SAVE ADDRESS OF INSTRUCTION LDA B2 SET NO OF WORDS/ENTRY STA INCR IN INCREMENT JSB LOAD FETCH INSTRUCTION  STA INSTR STA TEMP AND B70K IS IT A MEMORY REFERENCE SZA JMP MRGI YES GO GET IT LDA INSTR NO ELA,ALF PUT SIGN IN E REG RAL AND BITS 10&11 IN BITS 0&1 SEZ IF E SET(I.E. SIGN) MUST BE I/O OR EIG JMP IOGI * AND B3 SET UP OP CODE TABLE COUNTER LDB M18 SHIFT ROTATE SLA LDB M12 ALTER SKIP STB CNTR ADA GRTBL GET ADDRESS OF GROUP TABLE LDB A,I * LOOP1 LDA TEMP FETCH REMAINING BITS OF INSTRUCTION AND B,I ARE ALL REQUIRED BITS SET XOR B,I SZA,RSS JMP FOND1 YES GO GET MNEMONIC LOP1A ADB INCR BUMP ADDRESS ISZ CNTR JMP LOOP1 * NFND LDA BUFAD IF WE FALL THROUGH NOT COMPLETELY STA BPNTR DEFINED SO JUST PRINT OCTAL LDA INSTR JSB PN JMP EXIT * IADR BSS 1 INCR BSS 1 INSTR BSS 1 TEMP BSS 1 CNTR BSS 1 BPNTR BSS 1 * B2 OCT 2 B3 OCT 3 B70K OCT 70000 M12 DEC -12 M18 DEC -18 BFEND BSS 1 * GRTBL DEF *+1 DEF SRGA DEF ASGA DEF SRGB DEF ASGB * MRGA1 DEF MRG-4 * FOND1 JSB POPCD PRINT MNEMONIC LDA B,I REMOVE OPCODE FROM AND B1777 INSTRUCTION XOR TEMP STA TEMP AND B1777 ARE ANY BITS LEFT SZA,RSS JMP EXIT NO,THEN RETURN LDA COMMA JSB TYO PRINT COMMA JMP LOP1A GO LOOK FOR REST * B1777 OCT 001777 COMMA OCT 54 * MRGI LDA INSTR ALF,RAL AND B17 RAL TIMES 2 ADA MRGA1 COMPUTE TABLE POSITION LDB A JSB POPCD PRINT MNEMONIC LDA INSTR COMPUTE ADDRESS AND B2000 MERGE WITH PROPER PAGE SZA LDA IADR XOR INSTR AND B76K XOR INSTR JSB PADR PRINT ADDRESS JMP EXIT * B17 OCT 17 B2000 OCT 2000 B76K OCT 76000 * IOGI LDB IOGTB FETCH TABLE OF LOOP FOR I/O SLA,RSS IF EIG INSTEAD LDB DSGTB THEN GET TABLE FOR EIG'S STB PNTR PARMETERS LDB PNTR,I SET B TO START ISZ PNTR LOOP2 LDA PNTR,I GET COUNT FOR THIS TYPE SSA JMP LOP2A IF NEGATIVE CONTINUE * SZA,RSS IF ZERO THEN DONE JMP NFND LDA B3 STA INCR ELSE SET INCREMENT TO 3 LDA PNTR,I AND MAKE COUNT NEGATIVE CMA,INA * LOP2A STA CNTR ISZ PNTR LOOP3 LDA INSTR FETCH INSTRUCTION XOR B,I SEARCH FOR MATCH AND PNTR,I MASK UNWANTED BITS SZA,RSS JMP FOND2 ADB INCR BUMP ADDRESS IN OPCTBL ISZ CNTR DONE WITH THIS TYPE JMP LOOP3 NO CONTINUE ISZ PNTR JMP LOOP2 YES GO TO NEXT TYPE * * PNTR BSS 1 * FOND2 JSB POPCD GO PRINT MNEMONIC LDA PNTR,I FETCH MASK CMA IF EXACT NO OPERAND IN SAME WORD AND B77 SZA,RSS JMP OPRND * AND INSTR STRIP OFF OPERAND STA TEMP SAVE FOR COMMA C TEST LDB PNTR,I IS MASK FOR CPB DSMSK A DOUBLE SHIFT GROUP SZA AND OPERAND EQUAL 0 RSS LDA B20 YES MAKE OPERAND IT 16 AND B77 AND MASK C BIT JSB PNUMB GO PRINT NUMBER LDA TEMP AND B1000 IS A COMMA C REQUIRED SZA,RSS NO RETURN JMP EXIT LDA COMMA JSB TYO PRINT COMMA LDA "C JSB TYO PRINT "C" JMP EXIT * * * PRINTS MULTI WORD OPERANDS * OPRND LDA TFLAG TRACING SZA,RSS JMP EXIT NO THEN RETURN * * MUTIWORD PRINT HERE * JMP EXIT * * TFLAG OCT 0 * B20 OCT 20 B77 OCT 77 B1000 OCT 1000 "C OCT 103 * * * PRINT ONE CHARACTER * TYO NOP STB TEMP2 SAVE B REG LDB BPNTR CPB BFEND JMP EXIT IF FULL THEN COMPLETE = 1 CRASHED SYSTEM * * THE OUTPUT BUFFER MUST BE 36 WORDS LONG * * * KOUNT NOP MAP NOP INBUF NOP ASSLC NOP PACK NOP JSB .ENTR GET THE PARAMETER ADDRESSES DEF KOUNT * LDA KOUNT,I GET THE # OF WORDS TO CONVERT BACK CMA,INA MAKE NEG AND SSA,RSS IF 0 OR NEG WORDS INPUT THEN FORGET IT JMP PACK,I STA KOUNT NOW SAVE FOR LOOP * ADA D8 ADD 8 TO SEE IF INPUT # SSA,RSS GREATER THAN 8 JMP CONTU ALL IS WELL ! LDA D8 JMP BACK * * CONTU LDA MAP,I GET THE MAP AND SAVE STA MAP FOR LATER * SZA,RSS SYS OR MAPS? JMP NOID MAPS OK AS IS LDA INBUF,I SYS NEED TO TAKE CARE OF STA INBUF INDIRECTION * NOID LDA ASSLC GET THE ADDRESS LDB ASSLC TWICE STB TEMP SAVE TEMPORARIALLY INA BUMP IT CLE,ELA CONVERT TO A BYTE ADDRESS STA ASSLC AND SAVE FOR LATER ADB D29 NOW DEFINE THE ASCII ADDRESS STB OABUF AND SAVE FOR THE IASCI SUBROUTINE STB YTEMP * LDA DM37 NOW CLEAR OUT THE OLD BUFFER STA XTEMP LDB BLANK GET A BLANK READY * LOOPX STB TEMP,I SET A BLANK INTO THE OUTPUT BUFFER ISZ TEMP STEP BUFFER POINTER ISZ XTEMP DONE YET ? JMP LOOPX NO * * * LOOP LDA MAP CRASHED SYS OR MAPS? SZA,RSS MAPS? JMP MAPPP YES * JSB IGET NO DEF *+2 GET THE INFO FROM THE DEF INBUF CRASHED FILE LDB A JMP OUT * MAPPP LDB INBUF,I GET THE INFO FROM THE MAP OUT STB XTEMP SAVE FOR THE IASCI SUBROUTINE JSB ASCI AND CONVERT TO OCTAL ASCII * JSB IASCI AND PLACE THROUGH THE ASCII FILTER DEF *+3 DEF XTEMP DEF TEMP * STB OABUF,I PUT RESULT INTO THE OUTPUT BUFFER * ISZ INBUF BUMP OUR ISZ OABUF POINTERS ISZ ASSLC AND THE CHAR ADDRESS * ISZ KOUNT ARE WE DONE ? JMP LOOP NOT YET * CC\B YES,GET THE END OF THE OCTAL #'S ADB YTEMP LDA B,I NOW GET THE LAST WORD IOR ASTRK PUT IN AN ASTRISK STA B,I NOW PUT IT BACK * JMP PACK,I RETURN TO THE CALLER * * * * ** DATA TO OCTAL ASCII CONVERSION ** SPC 1 * CALLING SEQUENCE: LDB (DATA WORD) * LDA (ADDRESS AT START OF STORAGE) * JSB ASCI SPC 1 ASCI NOP OUTPUT 6 DIGITS * STA ASSLC SET THE ADDRESS (NOT USED AT THE MOMENT ) LDA KM6 GET NO. OF DIGITS TO CONVERT RBL MOVE FIRST DIGIT TO LOW B JSB NUM.F CONVERT THE NUMBER JMP ASCI,I RETURN SPC 2 *SCI2 NOP 5 DIGITS & BLANK * LDA KM5 GET NO OF DIGITS TO CONVERT * BLF POSITION FIRST DIGIT * JSB NUM.F CONVERT THE NUMBER * JMP ASCI2,I RETURN * * *********************************** * * CONVERT DIGITS TO ASCII BASE 8 * * *********************************** * * NUM.F NOP STA T1NUM SAVE THE DIGIT COUNT CPA KM6 IF 6 THEN CLA,INA,RSS USE 1 AS A MASK FOR FIRST DIGIT NUM00 LDA K7 ELSE USE 7 AND B ISOLATE THE DIGIT ADA "0" ADD 60 TO MAKE ASCII JSB PUT.F PUT IN THE BUFFER BLF,RBR POSITION THE NEXT DIGIT ISZ T1NUM DONE? JMP NUM00 NO DO NEXT DIGIT * JMP NUM.F,I YES RETURN * T1NUM NOP KM6 DEC -6 * SPC 2 * * ******************************** * * PUT CHARACTER IN LIST BUFFER * * ******************************** * PUT.F NOP STB T1PUT SAVE B LDB ASSLC GET CURRENT BUFFER ADDRESS AND B177 ISOLATE THE CHARACTER CLE,ERB WORD ADDRESS TO B E=UPPER,LOWER FLAG SEZ,RSS IF UPPER CHAR ALF,SLA,ALF POSITITON AND SKIP XOR B,I INCLUSION OF HIGHER CHAR. XOR B40 ADD,TAKE AWAY LOWER BLANK STA B,I SET THE WORD DOWN ISZ ASSLC STEP THE CHAR ADDRESS LDB T1PUT RESTORE B JMP PUT.F,I RETURN * T1PUT NOP OABUF NOP B40 OCT 40 K7 DEC 7 D8 DEC 8 "0" OCT 60 D29 DEC 29 DM37 DEC -37 BLANK ASC 1, ASTRK OCT 52 LOWER BYTE = * B177 OCT 177 TEMP NOP D64 DEC 64 D1024 DEC 1024 XTEMP NOP YTEMP NOP ADDRS NOP PONTR NOP DUMMY NOP THIS IS A DUMMY SUBROUTINE TO FIX UP A POINTER JSB .ENTR SO THAT THE PACK ROUTINE CAN WORK WITH ARRAYS DEF ADDRS IN A PROGRAM AS WELL AS MEMORY ADDRESSES. * LDA ADDRS STA PONTR,I JMP DUMMY,I SPC 1 * * * * * * * THE IASCI SUBROUTINE TAKES ONE WORD OF INPUT AND CONVERTS THAT * WORD TO ASCII. IF ANY BYTE CAN NOT BE CONVERTED TO ASCII THEN * AN ASCII BLANK IS RETURNED FOR THAT BYTE. * * * CALLING SEQUENCE : JSB IASCI * DEF RETURN * DEF VALUE VALUE TO BE CONVERTED * DEF ASCII RETURNED ASCII VALUE * ---- * * ON RETURN, THE B REGISTER HAS THE ASCII VALUE * VALUE NOP LOCTN NOP IASCI NOP JSB .ENTR DEF VALUE * LDA VALUE,I GET THE VALUE TO CONVERT STA TEMP1 SAVE IT AND M377 KEEP ONLY LOWER BYTE JSB CNVRT AND CONVERT STB VALUE SAVE THE RETURNED VALUE * LDA TEMP1 GET THE WORD BACK AGAIN AND M1774 KEEP ONLY THE UPPER BYTE ALF,ALF SHIFT TO LOW ORDER JSB CNVRT AND GO CONVERT BLF,BLF PUT INTO UPPER BYTE ADB VALUE NOW MERGE ADD IN LOWER BYTE STB LOCTN,I AND RETURN IT TO THE USER JMP IASCI,I * * * THIS SUBROUTINE CONVERTS LOWER BYTE OF A TO ASCII AND PLACES * THE RETURNED ASCII INTO B * CNVRT NOP ѕSTA B AND SAVE CMA,INA ADA B135 SSA IS IT OK JMP BLNK2 NO LDA B40 CMA,INA ADA B SSA OK ? BLNK2 LDB B40 NO JMP CNVRT,I * * * * A EQU 0 B EQU 1 M1774 OCT 177400 B135 OCT 137 M377 OCT 377 TEMP1 NOP DM64 DEC -64 SIGN OCT 100000 * * * ************************************** * * MAP IN ANY PAGE OF PHYSICAL MEMORY * * ************************************** * * * THE PURPOSE OF THIS SUBROUTINE IS TO MAP IN THE PAGE REQUESTED * AND READ 64 WORDS OF THAT MAPPED PAGE. THE ROUTINE IS FORTRAN * CALLABLE. TO BE USED ONE OF TWO CONDITIONS MUST BE MET. * THE PROGRAM USING THE ROUTINE MUST NOT BE GREATER THAN 30K * IN LENGTH (IE IF PROGRAM IS 10K AND LARGEST ADDRESSABLE * PARTITION IS 12K YOUR OK. IF LARGEST ADDRESSABLE PARTITION IS * 11K YOU HAVE PROBLEMS). ALTERNATELY IF THE PROGRAM EXTENDS * INTO THE LAST TWO PAGES OF MEMORY MAKE SURE THIS ROUTINE * AND THE INPUT PARAMETERS TO THIS ROUTINE DO NOT RESIDE THERE * AND YOU WILL BE ALLRIGHT. * * THE PROGRAM MODIFIES THE USER MAP REGISTERS BUT ALSO RESTORES THEM. * * * CALLING SEQUENCE JSB MAPXX * DEF RETURN * DEF PAGE# PHYSICAL PG # (0-1023) * DEF OFFSET (NOT GREATER THAN 1023 DECIMAL) * DEF ARRAY (ARRAY OF 64 WORDS) * DEF FLAG 1/2/3 READ/WRITE/READ BUT DON'T * UPDATE PAGE# OR OFFSET * DEF NVAL NEW VALUE (FLAG = 2) * * * PAGE# NOP OFSET NOP ARRAY NOP FLAG NOP NVAL NOP * MAPXX NOP JSB $LIBR NOP JSB .ENTP DEF PAGE# * LDA MPBUF GET THE ADDRESS OF THE MAP BUFFER ADA SIGN SET THE SIGN BIT SO IT IS A READ USA GET THE USER MAP * LDA MAP31 GET THE OLD VA+LUE STA OLD31 AND SAVE IT LDA MAP32 OLD VALUE. STA OLD32 SAVE THIS TOO LDB PAGE#,I GET THE DESIRED PAGE STB MAP31 PUT IT INTO THE OLD PAGE INB BUMP PAGE # TO ACCOUNT FOR OVERFLOW STB MAP32 SET NEXT PAGE INTO THE LAST LOCATION * LDA MPBUF GET THE USER MAP BUFFER ADDRESS USA !!!!!! LOAD THE USER MAP !!!!!! * LDA FLAG,I GET THE READ WRITE FLAG CPA D2 ARE WE READING OR WRITING ? JMP WRTPG WRITING ! * * * * LDA DM64 GET LOOP INDEX STA XTEMP LDA START GET THE START ADDRESS ADA OFSET,I ADD IN THE OFFSET STA YTEMP SAVE POINTER LDA ARRAY GET ARRAY ADDRESS MLOOP LDB YTEMP,I GET THE WORD STB A,I AND PUT INTO BUFFER ISZ YTEMP BUMP OUR INA POINTERS ISZ XTEMP DONE ? JMP MLOOP NO * * RTMAP LDA OLD31 YES RESTORE THE USER MAP STA MAP31 LDA OLD32 STA MAP32 * LDA MPBUF GET THE ADDRESS USA !!!!!!!!!!RESTORE THE USER MAP!!!!!!!!!!!!!!!! JSB $LIBX RESTORE INTERUPTS DEF *+1 DEF *+1 * LDA FLAG,I GET THE FLAG CPA D1 DO WE UPDATE THE PAGE # & OFFSET RSS YES JMP MAPXX,I NO, SO RETURN TO THE CALLER * LDA OFSET,I GET THE OFFSET ADA D64 ADD 64 WORDS FOR WHAT WE JUST DID CLB DIV D1024 DIVIDE NEW OFFSET BY # OF WORDS IN PAGE ADA PAGE#,I ADD OLD PAGE # TO GIVE NEW PAGE # STA PAGE#,I AND SEND THE RESULT BACK STB OFSET,I SEND THE NEW OFFSET BACK TOO * JMP MAPXX,I RETURN TO CALLER * * WRTPG LDA START GET THE START ADDRESS ADA OFSET,I ADD THE OFFSET INTO THE PAGE LDB NVAL,I GET THE NEW VALUE STB A,I AND SET IT UP. JMP RTMAP RESET THE MAP & RETURN * * * D1 DEC 1 \D2 DEC 2 START OCT 74000 START ADDRESS OF NEWLY MAPPED AREA MPBUF DEF MAPIT MAPIT BSS 30 BUFFER FOR 1ST 30 WORDS OF USER MAP MAP31 NOP THIS LOCATION IS USED TO CHANGE MAP MAP32 NOP THIS LOCATION IS FOR I/O OVERFLOW OLD31 NOP OLD32 NOP * * END ASMB,Q,C NAM ARTNS,7 ASSEMBLER ROUTINES FOR CDA4 ENT .XLA,.XLB,.MWF ENT JFTIM TIME CONVERSION ROUTINE ENT CDA3 COMMON AREA ENT PRNT PRINT ROUTINE ENT JMP FOR EXECUTING CODE FRAGMENTS ENT JMPX FUNCTION VERSION OF JMP ENT JRETN RETURN POINT FOR JMP/JMPX EXT EXEC,IGET,.ENTR,CDA * * THIS ROUTINE DOES XLA,XLB AND MWF FROM THE DUMP * FILE (VIA IGET). IT IS A DIRECT REPLACEMENT * FOR THE NAMED INSTRUCTIONS. * .XLA NOP STA ASAV SAVE THE A REG ELA AND THE STA ESAV REG LDA .XLA,I GET THE ADDRESS CPA AIND IS IT A INDIRECT? JMP CALL YES WE ARE OK ALREADY * IND RAL,CLE,SLA,ERA NO TRACK DOWN ANY INDIRECTS LDA A,I SSA MORE? JMP IND YES (NOTE B MUST BE LOADED FOR THIS * STA ASAV SAVE THE ADDRESS OF INTEREST CALL STB BSAV SAVE THE B REG JSB IGET GET THE WORD DEF *+2 DEF ASAV LDB ESAV RESTORE THE E ERB REG. AND LDB BSAV THE B REG. ISZ .XLA STEP TO THE RETURN JMP .XLA,I AND DO SO * ASAV NOP BSAV NOP ESAV NOP AIND DEF A,I * * .XLB NOP HERE WE DO THE XLB INSTRUCTION STA ASAV2 SAVE A LDA .XLB,I GET THE TARGET ADDRESS STA XLAAD AND SET FOR CALL LDA ASAV2 RESTORE A IN CASE IT IS ADDRESS JSB .XLA DO THE LOAD TO A XLAAD NOP LDB A GET THE RESULT TO B AS REQUIRED LDA ASAV2 RESTORE A ISZ .XLB STEP TO THE RETURN %JMP .XLB,I AND DO SO * * ASAV2 NOP * .MWF NOP MOVE WORDS FROM X=COUNT,B=TO,A=FROM STA ASAV SAVE A TEMP ELA NOW GET E STA ESAV AND SAVE IT LDA ASAV RESTORE A RAL,CLE,SLA,ERA WE ONLY DO ONE LEVEL OF INDIRECT LDA A,I RBL,CLE,SLB,ERB LDB B,I DST FROM CXA GET THE COUNT TO A CMA,INA SET NEGATIVE STA COUNT AND SET IT UP NEXT JSB IGET NOW DO IT DEF *+2 DEF FROM STA TO,I SET THE WORD ISZ FROM ISZ TO ISZ COUNT DONE? JMP NEXT NO DO THE NEXT ONE * LDA ESAV GET THE E REG BACK ERA DLD FROM RESTORE A,B AS REQUIRED JMP .MWF,I AND RETURN * FROM NOP TO NOP COUNT NOP * * * DRTN IS USED TO MAKE SEGMENT CALLS LOOK LIKE * SUBROUTINE CALLS FROM FORTRAN * ENT DRTN DRTN DEF *-* ENTRY POINT ISZ DRTN BUMP RETURN ADDRESS ISZ DRTN AGAIN LDA DRTN LOAD RETURN ADDRESS AS RETURN VALUE JMP DRTN,I RETURN * * * HED TIME FORMAT SUBROUTINE (FOR CDA4) * NAME: JFTIM * SOURCE: 92067-18082 * RELPC: 92067-16035 * PGMR: G.A.A.,C.M.M.,(J.E.F.) * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * CALLING SEQUENCE: * *C GET THE TIME IN A 15 WORD STRING * DIMENSION IBUF(15) *C PARAMETERS ARE SET UP IN CDA3 NAMED COMMON AREA * CALL JFTIM(IBUF) * * * THE TIME AND DATE TO BE CONVERTED ARE STORED IN /CDA3/ * SUP * * GET TIME] AND BUILD HEADER MESSAGE * A EQU 0 B EQU 1 O13 OCT 13 N1900 DEC -1900 D12 DEC 12 MD60 DEC -60 DM12 DEC -12 O30K OCT 30000 ASCII 0 IN HIGH WORD M1 OCT -1 "AM" ASC 1,AM "PM" ASC 1,PM O3 OCT 3 * * P1 NOP JFTIM NOP DLD JFTIM,I STA JFTIM RSS INDCT LDB B,I TRACK DOWN INDIRECTS RBL,CLE,SLB,ERB JMP INDCT STB P1 * * JSB EXEC * DEF *+4 * PARMS * DEF O13 * HAVE BEEN * DEF ITIME * PASSED * DEF IYEAR * THROUGH COMMON LDA IMIN JSB PD00 LDB ":" IOR O30K DON'T SUPPRESS LEADING ZEROS HERE RRR 8 B=1'S BLANK,A= ":" , 10'S DST TMSG+1 SET IN MESSAGE LDA IHOUR LDB "PM" ASSUME PM FOR NOW ADA DM12 IS IT SSA,RSS TEST AND ADJUST JMP PM YES * LDB "AM" NO USE AM LDA IHOUR RESTORE THE CORRECT HOUR PM SZA,RSS IF ZERO USE LDA D12 TWELVE STB TMSG+3 SET THE AM PM JSB PD00 STA TMSG HOURS * LDA IYEAR ADA N1900 SUBTRACT THE HUNDREDS JSB PD00 CONVERT THE YEAR STA TMSG+14 YEARS LDB IDAY ADB MD60 -60 LDA IYEAR AND O3 SZA SKIP IF LEAP YEAR SSB ADB M1 ADJUST FOR LEAP YEAR SSB ADB D366 ADB D31 LDA B RAL,RAL ADA B *5 CLB DIV D153 STA ITIME QUOTIENT=MONTH. LDA B CLB DIV O5 INA GET DAY OF MONTH. JSB PD00 STA TMSG+8 LDB ITIME RECOVER MONTH BLS ADB MOTBA DLD B,I DST TMSG+10 CCA CALCULATE DAY OF WEEK. ADA IYEAR ARS,ARS ADA IYEAR ADA IDAY CLB DIV O7 BLS ADB DAYWK DLD B,I DST TMSG+5 LDB DM15 SET WO[RD COUNT STB CNT LDA TMSGA AND THE TIME ARRAY OLOOP LDB A,I MOVE IT STB P1,I INA ISZ P1 ISZ CNT JMP OLOOP * JMP JFTIM,I RETURN * * * PD00 NOP CONVERT TO 2 ASCII DIGITS CLB DIV D10 DIVIDE BY 10 A=HIGH ,B=LOW SZA SUPPRESS ADA "0" LEADING ZEROS ALF,ALF PUT HIGH TO HIGH ADA B ADD IN THE LOW IOR "0" ADD ASCII BLANK 0 JMP PD00,I RETURN * "0" ASC 1, 0 ":" ASC 1, : D10 DEC 10 DM15 DEC -15 CNT BSS 1 O5 OCT 5 O7 OCT 7 D31 DEC 31 D100 DEC 100 D153 DEC 153 D366 DEC 366 * SPC 1 * CDA3 EQU * COMMON AREA FOR PASSING IN TIME ITIME NOP TENS OF MSEC NOP SEC IMIN NOP MIN IHOUR NOP IDAY NOP IYEAR NOP * SPC 1 * MESSAGE FORMAT: ASC 15,10:03 AM MON., 29 DEC., 1975 * 001122334455667788990011223344 * TMSGA DEF *+1 TMSG ASC 15,12:01 PM MON., 29 DEC., 1975 * DAYWK DEF *+1 ASC 14,FRI.SAT.SUN.MON.TUE.WED.THU. * MOTBA DEF *-1 ASC 2,MAR. ASC 6,APR.MAY JUNE ASC 6,JULYAUG.SEPT ASC 6,OCT.NOV.DEC. ASC 4,JAN.FEB. * * * * PRNT ROUTINE - PRINTS THE STRING PASSED ON UNIT * LU2 (AS DEFINED IN COMMON AREA CDA). THE LENGTH * IS IN THE FIRST WORD IN ASCII; THE MESSAGE FOLLOWS. * FORTRAN CALL: CALL PRNT(10H05MESSAGE ) * PARG DEF *-* ARGUMENT - ADDR OF DATA PRNT NOP JSB .ENTR RESOLVE EXTERNALS DEF PARG LDA PARG,I GET FIRST WORD OF ARG (IE LENGTH IN ASCII) ISZ PARG BUMP TO DATA ADDR ADA NA00 ADD (- 2H00) TO GET TWO BINARY DIGITS CLB SPLIT RRR 8 THE DIGITS STA TEMP MULTIPLY ALS,ALS A ADA TEMP BY ALS 10 SRBR,RBR SHIFT RBR,RBR B RBR,RBR RIGHT RBR,RBR EIGHT AND ADA B ADD IN LOW DIGIT ADA N1 DECREMENT AND STA PCNT SAVE LENGTH JSB EXEC NOW PRINT DEF *+5 DEF D2 DEF CDA+1 DEF PARG,I DEF PCNT JMP PRNT,I RETURN N1 DEC -1 PCNT DEF *-* NUMBER OF WORDS TO PRINT TEMP DEF *-* TEMP NA00 OCT 147720 (- 2H00) -- FOR STRIPPING ASCII D2 DEC 2 * * * JMPX SUBROUTINE - DOES A JMP TO THE ADDRESS GIVEN; * RETURNS A VALUE IN THE A REGISTER * CALL: RESULT = JMPX (ADDR, ARG) * * JADR DEF *-* ADDR TO JUMP TO JARG DEF *-* ARGUMENT JMPX NOP ENTRY POINT JSB .ENTR FETCH ARGS DEF JADR LDB JARG LOAD ARG STB MADDR SAVE LDA JADR,I JMP A,I BRANCH TO ROUTINE JRETN LDA MADDR LOAD RETURN VALUE JMP JMPX,I RETURN POINT * * * JMP SUBROUTINE - DOES A JMP TO THE ADDRESS * SPECIFIED. FORTRAN CALL: CALL JMP(ADDR) * JMP EQU JMPX MADDR DEF *-* RETURN ADDRESS FOR JMP/JMPX END ASMB,R,L HED QTAB - DATA FOR HELP FUNCTION NAM QTAB,7 ENT QT * ******************************************************************** * * QT IS A DATA TABLE FOR USE BY THE HELP FUNCTION OF CDA4. * THE FORMAT IS DESCRIBED IN QUSUB, BUT CAN EASILY BE INDUCED * FROM THE CODE BELOW. * * NOTE THAT THE FIRST TWO LETTERS OF THE LABELS USED FOR EACH * TWO WORD ENTRY ARE THE SAME AS THE COMMAND CODE. --DSC IS * THE LABEL FOR THE ONE LINE DESCRIPTION; --DTL IS THE LABEL * FOR THE DETAILED DESCRIPTION. * ******************************************************************** * SUP SUPRESS WORDS 2-N FOR EACH LINE * * QT EQU * DEF ANDSC ANALYZE SYSTEM DEF ANDTL DEF BPDSC SET BASE P"AGE DEF BPDTL DEF CMDSC COMPARE MEMORY DEF CMDTL DEF CTDSC COMPARE TABLES DEF CTDTL DEF DBDSC DEBUG DEF DBDTL DEF DPDSC DISPLAY & ARITH DEF DPDTL DEF DRDSC DEV REF TABLE DEF DRDTL DEF DUDSC DUMP SYS DEF DUDTL DEF /EDSC EXIT DEF /EDTL DEF EQDSC EQT TABLE DEF EQDTL DEF EPDSC EJECT PAGE DEF EPDTL DEF F/DSC FIND VAL IN MEM DEF F/DTL DEF FIDSC SPECIFY CRASH FILE DEF FIDTL DEF IDDSC ID TABLE DEF IDDTL DEF INDSC INT TABLE DEF INDTL DEF LIDSC LIST ENTRY POINT DEF LIDTL DEF LLDSC CHANGE LIST DEF LLDTL DEF LMDSC LIST MEM DEF LMDTL DEF MADSC DUMP MAPS DEF MADTL DEF MPDSC SET MAP DEF MPDTL DEF TADSC TRACK ASSSIGNMENT DEF TADTL DEF TRDSC TRACE LIST DEF TRDTL DEF VEDSC VERIFY ID TABLE DEF VEDTL DEF WHDSC WHZAT DEF WHDTL DEF XXDSC '**' - ANNOTATE LISTING DEF XXDTL DEF PKDSC PACK OPTION DEF PKDTL DEF ??DSC HELP DEF ??DTL DEF 0 END OF TABLE * * ONE-LINE DESCRIPTIONS * IDDSC ASC 11,11ID LIST ID SEGMENT EQDSC ASC 13,13EQ LIST EQT AND EXTENTS DRDSC ASC 12,12DR LIST DEV REF TABLE LMDSC ASC 09,09LM LIST MEMORY INDSC ASC 13,13IN LIST INTERRUPT TABLE TADSC ASC 17,17TA LIST TRACK ASSIGNMENT TABLE TRDSC ASC 08,08TR TRACE LIST DPDSC ASC 20,29DP DISPLAY INPUT IN OCTAL, DECIMAL & ASC 09,ASCII (& DO ARITH) LLDSC ASC 12,12LL CHANGE LIST DEVICE F/DSC ASC 14,14F/ FIND A VALUE IN MEMORY LIDSC ASC 11,11LI LIST ENTRY POINT FIDSC ASC 17,17FI SPECIFY CRASHED SYSTEM FILE CMDSC ASC 16,16CM COMPARE CRASH TO SNAPSHOT BPDSC ASC 20,20BP SET BASE PAGE SUBSTITUTION ON/OFF CTDSC ASC 20,24CT COMPARE PARTICULAR WORDS OF TABLES ASC 04, TOr SNAP MPDSC ASC 08,08MP SELECT MAP /EDSC ASC 13,13/E (OR EN OR EX) EXIT XXDSC ASC 11,11** ANNOTATE LISTING PKDSC ASC 18,18PK PACKED OPTION (NOT A COMMAND) ??DSC ASC 18,18?? HELP FEATURE - TRY ??,COMMAND WHDSC ASC 12,12WH RUN WHZAT ON CRASH * * THOSE DESCRIPTIONS THAT ARE THE SAME AS THE DETAILS * ARE EQUATED AFTER ALL OF THE DETAILED DESCRIPTIONS * * DETAILED DESCRIPTIONS * IDDTL ASC 09,09ID,PROGRAM NAME ASC 09,09ID,SEGMENT NAME ASC 16,16ID,NUMBER = ALL ID'S IN SYSTEM DEF 0 END OF DESC * EQDTL ASC 04,04EQ,NUM ASC 18,18EQ,NUM,NUM GIVES INCLUSIVE EQT'S DEF 0 END OF DESC * LMDTL ASC 10,10LM,ADDR,# OF WORDS ASC 05,05LM,ADDR ASC 19,19LM,ADDR,-ADDR GIVES INCLUSIVE ADDRS DEF 0 END OF DESC * DRDTL ASC 04,04DR,NUM ASC 18,18DR,NUM,NUM GIVES INCLUSIVE DRT'S DEF 0 END OF DESC * INDTL ASC 04,04IN,NUM ASC 19,19IN,NUM,NUM GIVES INCLUSIVE INT ENTS DEF 0 END OF DESC * LLDTL ASC 07,07LL,LIST LU # DEF 0 END OF DESC * F/DTL ASC 20,25F/,VALUE TO FIND,START ADDRESS,# WORDS ASC 05, TO SEARCH ASC 19,19F/,VALUE,STARTING ADDR,-ENDING ADDR DEF 0 END OF DESC * LIDTL ASC 16,16LI,ENTRY POINT NAME,# OF WORDS DEF 0 END OF DESC * TADTL ASC 02,02TA ASC 05,05TA,LU # ASC 13,13TA,LU #,TRK #,# OF TRKS DEF 0 END OF DESC * /EDTL ASC 04,04/E OR ASC 04,04EX OR ASC 11,11EN -- ALL EXIT CDA4 DEF 0 END OF DESC * DPDTL ASC 19,19DP,VALUE,OP,VALUE OP IS +,-,*, OR / DEF 0 END OF DESC * TRDTL ASC 20,33TR,START ADDR,LIST DELIMITER [,OFFSET ASC 13,[,MAX # LINKS TO FOLLOW]] DEF 0 END OF DESC * FIDTL ASC 05,05FI,NAMR DEF 0 END OF DESC * CMDTL ASC 20,20CM,ADDR,-ADDR COMPARE BETWEEN LIMITS ASC 09,09CM,ADDR,# WORDS DEF 0 END OF DESC * BPDTL ASC 14,14BP,XX XX IS 'ON' OR 'OFF' DEF 0 END OF DESC * CTDTL ASC 18,18CT COMPARE ALL TABLES ASC 17,17CT,XX COMPARE TABLE XX ASC 19,19CT,?? PRINT LIST OF TABLES ASC 20,23CT,XX,ENTRY # COMPARE SINGLE ENTRY OF ASC 03, TABLE DEF 0 END OF DESC * MPDTL ASC 20,20MP,XX XX IS 'PH', 'DP', 'SY', OR 'US' DEF 0 END OF DESC * XXDTL ASC 18,18**,TEXT TREATED AS COMMENT DEF 0 END OF DESC * PKDTL ASC 20,21--PK,... GIVES -- IN PACKED FORM ASC 01,AT DEF 0 END OF DESC * ??DTL ASC 20,20??,-- DESCRIBES -- IN DETAIL DEF 0 END OF DESC * DUDTL ASC 09,09DU DUMP SYSTEM DEF 0 END OF DESC * ANDTL ASC 12,12AN ANALYSIS OF SYSTEM DEF 0 END OF DESC * MADTL ASC 12,12MA DUMP THE FOUR MAPS DEF 0 END OF DESC * EPDTL ASC 16,16EP EJECT PAGE IF LINE PRINTER DEF 0 END OF DESC * DBDTL ASC 11,11DB ENTER DEBUG MODE DEF 0 END OF DESC * WHDTL ASC 04,04WH,AL ASC 04,04WH,SM ASC 04,04WH,PA DEF 0 END OF DESC * VEDTL ASC 13,13VE VERIFY THE ID TABLE DEF 0 END OF DESC * * EQUATES FOR DESCRIPTIONS THAT ARE THE SAME AS THE DETAILS * DUDSC EQU DUDTL ANDSC EQU ANDTL MADSC EQU MADTL EPDSC EQU EPDTL VEDSC EQU VEDTL DBDSC EQU DBDTL * * END FTN4,L PROGRAM CDA4A(5),24999-16197 REV.2024 IMPLICIT INTEGER (A-Z) COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) C COMMON /CDASG/ RTNA, IPBUF(33), IPRAM(6), IARRAY(64), IDISC(36), & IGO(35), IGO2(35), IFILE(10), JBUF(30), IOP, LEN C EQUIVALENCE (IPBUF(2),IPRS1),(IPBUF(6),IPRS2),(IPBUF(10),IPRS3), & (IPBUF(14), IPRS4), (IPBUF(18), IPRS5), (IPBUF(22), IPRS6), & (IPBUF(26), IPRS7), (IPBUF(30), IPRS8) C C THIS SEGMENT HANDLES SOME OF THE COMMANDS FOR CDA4 C C SELECT THE APPROPRIATE SUBROUTINE: C IF(IOP.NE.0) GO TO 10 CALL INIT GO TO 1 C 10 GO TO (100, 100, 100, 100, 100, 100, 100, 100, 100, 100, & 100, 100, 113, 114, 115, 116, 117, 118, 119, 100, & 121, 122, 123, 100, 100, 100, 127, 100, 129, 100, & 100, 100, 100, 100, 100) IOP C 100 CALL PRNT(16H08INTERNAL ERROR) GO TO 1 C 113 CALL IDSUB(IPBUF, IFILE, SDCB1, IPRAM, LU2, LU1) GO TO 1 114 CALL EQSUB(IBUF, IPRS2, IPRS3, IPRAM, LU2, LU1) GO TO 1 115 CALL DRSUB(IPRS2, IPRS3, IPRAM, LU2) GO TO 1 116 CALL INSUB(IPRS2, IPRS3, IPRAM, LU2, LU1) GO TO 1 117 CALL CTSUB(IPRS2, IPRS3) GO TO 1 118 CALL FSSUB(IPRS2, IPRS3, IPRS4, IPRAM, LU2, LU1) GO TO 1 119 CALL LISUB(IDISC, IFILE, IPRS2, SDCB1, IPRAM, LU2, LU1, IPRS3) GO TO 1 121 CALL TASUB(IPRS2, IPRS3, IPRS4, IPRAM, LU2, LU1) GO TO 1 122 CALL CMSUB(IPRS2, IPRS3) GO TO 1 123 CALL MASUB(IARRAY) GO TO 1 127 CALL ANSUB(IDISC, IFILE, IBUF, IPBUF, SDCB1, IPRAM, LU2, LU1) GO TO 1 129 CALL PRNT(10H05NOT YET ) GO TO 1 C C NOW RETURN TO MAIN C 1 CALL JMP(RTNA) END END$ FTN4,Q,L SUBROUTINE CMSUB(L1,LEN) IMPLICIT INTEGER (A-Z) COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64), & PRFLAG DIMENSION OBUF(72) C C SUBROUTINE TO IMPLEMENT THE CM (COMPARE MEMORY) COMMAND C C------------------------------------------------------------------------ C C COMPUTE COMPARISON LIMITS 10 L2 = L1 + LEN IF (LEN.LT.0) L2 = -LEN L1 = (L1/8)*8 IF(L1.GE.0.AND.L2.GE.0) GO TO 15 CALL PRNT(28H14NEGATIVE ADDRESSES ILLEGAL) RETURN 15 DO 60 IADDR = L1,L2,8 COMP = 0 DO 20 J = 1,72 OBUF(J) = 2H 20 CONTINUE C C LOOK FOR DIFFERENCES; IF ANY ARE FOUND, CONVERT THEM TO OCTAL C DO 30 J = 0,7 IF (SGET(IADDR+J).EQ.IGET(IADDR+J))GO TO 30 CALL OCT(SGET(IADDR+J),OBUF(J*4+41)) COMP = 1 30 CONTINUE C C IF A DIFFERENCE WAS FOUND IN THIS LINE, FORMAT THE FIRST LINE C AND PRINT BOTH LINES C IF(COMP.EQ.0)GO TO 60 DO 40 J = 0,7 CALL OCT(IGET(IADDR+J),OBUF(J*4+5)) 40 CONTINUE 50 CALL OCT(IADDR,OBUF) CALL EXEC(2,LU2,OBUF,36) CALL EXEC(2,LU2,OBUF(37),36) CALL PRNT(4H02 ) IF(IFBRK(IDMY).LT.0) RETURN 60 CONTINUE RETURN END C C C **********GET ID SEGMENT INFO************** C C SUBROUTINE IDSUB(IPBUF,IFILE,IDCB,IPRAM,LU2,LU1) DIMENSION IPBUF(33),IPRAM(6),IMESS1(9),IEXT(4) DIMENSION IFILE(10),IDCB(144),IDEX(3),IBMES(11) DIMENSION ISBID(9),ILBID(9) DATA IMESS1/2H ,2HID,2H S,2HEG,2H O,2HF / DATA IEXT/2H ,2HEX,2HTE,2HNT/ DATA IDEX/2H$I,2HDE,2HX / DATA IBMES/2H ,2H ,2H ,2H ,2HVI,2HRG,2HIN,2H I,2HD , & 2HSE,2HGS/ DATA ISBID/2H ,2H/ DATA ILBID/2H ,2H / C C IBLNK = 0 C IBFLG -1/NOT BLANK 0/BLANK 1/VIRGIN IBFLG = -1 C IFRST 1 AFTER 1ST SHORT ID SEG REACHED IFRST = 0 KYWORD = IGET(1657B) -1 IF(IPBUF(5).EQ.1) GO TO 175 C C 150 DO 170 I = 1,257 KYWORD = KYWORD +1 IF(IGET(KYWORD).EQ.0) GO TO 190 IF(((IPBUF(6).EQ.IGET(IGET(KYWORD)+12)).AND. & (IPBUF(7).EQ.IGET(IGET(KYWORD)+13))).AND. & (IPBUF(8).EQ.IOR(IAND(IGET(IGET(KYWORD)+14),177400B),40B))) & GO TO 176 170 [+CONTINUE 175 KYWORD = KYWORD +1 IF(IPRAM(3).EQ.9999) RETURN C EOF SO PRINT VIRGIN SHORT ID MESSAGE IF(IGET(KYWORD).EQ.0) GO TO 186 IF(IGET(IGET(KYWORD)+12).NE.0) GO TO 176 IMESS1(7) = 2H IBFLG = 0 GO TO 180 176 IMESS1(7) = IGET(IGET(KYWORD)+12) IMESS1(8) = IGET(IGET(KYWORD)+13) IMESS1(9) = IGET(IGET(KYWORD)+14) C 180 ISTART = IGET(KYWORD) ISTOP = ISTART +32 ITEMP = IAND(IGET(IGET(KYWORD) +14),17B) ITEMP1= IAND(IGET(IGET(KYWORD) +14),20B) IF(ITEMP1.EQ.20B) ISTART= IGET(KYWORD) +11 C 1ST SHORT ID, GO PRINT VIRGIN LONG ID MESSAGE IF ((ITEMP1.EQ.20B).AND.(IFRST.EQ.0)) GO TO 186 C C 'ID' COMMAND, SO GIVE HIM THE ID SEGMENT !! C NOT A FREE ID 160 IF (IBFLG.EQ.-1) GO TO 183 C 1ST VIRGIN BLANK ID FOUND, JUST UP COUNT IF (IBFLG.EQ.1) GO TO 182 C ELSE CHECK IF 1ST VIRGIN BLANK ID DO 181 I = ISTART,ISTOP IF ((I.EQ.(ISTART+3)).AND.(IGET(I).EQ.20B)) GO TO 181 IF (IGET(I).NE.0) GO TO 183 181 CONTINUE IBFLG = 1 182 IBLNK = IBLNK + 1 GO TO 175 183 CALL EXEC (3,LU2+700B,1) CALL EXEC(2,LU2,IMESS1,-17) CALL DOIO(ISTART,ISTOP,LU2,IPRAM) C C IF NOT EMA OR IF IT'S A SEGMENT OR MEM RES C THEN DON'T PRINT THE ID EXTENSION C IF((ITEMP1 .EQ. 20B).OR. (ITEMP .EQ. 1)) GO TO 185 IF(IGET(IGET(KYWORD)+28).EQ.0) GO TO 185 C GET THE ID EXTENSION CALL FNDET(IDEX,IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 187 IF (MYTYP.EQ.3) CALL NFSUB(IDEX,LU1) IF (MYTYP.EQ.3) GO TO 185 ISTART = IAND(IGET(IGET(KYWORD)+28),111111B) ISTART=IGET(IGET(IWRD4)+ISTART/1024) CALL EXEC(2,LU2,IEXT,4) CALL DOIO(ISTART,ISTART+2,LU2,IPRAM) 185 IF(IPBUF(5).EQ.1) GO TO 175 RETURN C C 186 IBFLG = -1 C EOF, NO ID'S OR NO VIRGIN SHORT ID'S IF ((IGET(KYWORD).EQ.0).AND.(IBLNK.EQ.0)) RETUTbRN C NO VIRGIN LONG ID'S IF (IBLNK.EQ.0) GO TO 166 CALL EXEC (3,LU2+700B,1) CALL CNUMD(IBLNK,IBMES) CALL EXEC (2,LU2,IBMES,11) C SHORT AND EOF IF ((ITEMP1.EQ.20B).AND.(IGET(KYWORD).EQ.0)) &CALL EXEC(2,LU2,ISBID,9) C OR LONG IF (IFRST.EQ.0) CALL EXEC(2,LU2,ILBID,9) C EOF IF (IGET(KYWORD).EQ.0) RETURN IBLNK = 0 C 1ST PART (LONG ID'S DONE, IE REACHED 1ST SHORT ID) 166 IFRST = 1 GO TO 160 C C 187 CALL CNUMD(-(IERR),IFILE(8)) CALL EXEC (2,LU1,IFILE,10) GO TO 185 C C 190 CALL NFSUB(IPBUF(6),LU1) RETURN END C C C **********GET EQT INFO************* C C SUBROUTINE EQSUB(IBUF,IPRS2,IPRS3,IPRAM,LU2,LU1) DIMENSION IPRAM(6),IBUF(30),IMESS2(11) DATA IMESS2/2H ,2HEQ,2HT ,2H# ,2H ,2H ,2H ,2H ,2HDV,2HR / C C IEQTA = IGET(1650B) IEQTNO = IGET(1651B) IPRL2 = IPRS2 IPRL3 = IPRS3 IF(IPRS3 .GT. IEQTNO) IPRL3 = IEQTNO IF(IPRS2.GT.IEQTNO) GO TO 220 IF(IPRS2.LT. 1) IPRL2 = 1 C C DO 210 I = IPRL2,IPRL3 IF(IPRAM(3) .EQ. 9999) RETURN ISTART = IEQTA + (I - 1)*15 CALL CNUMD(I,IBUF(2)) IMESS2(4) = IBUF(4) IBUF = (IAND(IGET(ISTART+4),37400B)/256) IBUF = IBUF + 2*(IBUF/8) CALL CNUMD(IBUF,IBUF(2)) C INSERT A 0 SO DVR00 DOESNT LOOK LIKE DVR 0 IF (IAND(IBUF(4),177400B).EQ.20000B) IBUF(4) = IBUF(4) + 10000B IMESS2(11) = IBUF(4) C CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IMESS2,11) CALL DOIO(ISTART,ISTART +14,LU2,IPRAM) 210 CONTINUE RETURN 220 CALL IWSUB(LU1) RETURN END C C C C **********GET DEVICE REF TABLE************** C SUBROUTINE DRSUB(IPRS2,IPRS3,IPRAM,LU2) DIMENSION IPRAM(6),IMESS3(6) DATA IMESS3/2H ,2HDR,2HT ,2HPA,2HRT,2H / C C IDRT = IGET(1652B) LUMAX = IGET(1653B) IPRL2 = IPRS2 IPRL3 = |IPRS3 IMESS3(6) = 20061B C C CALL EXEC(2,LU2,IMESS3,6) IF(IPRS3.GT.LUMAX) IPRL3 = LUMAX IF(IPRS2.LE.0) IPRL2 = 1 IF (IPRS3.EQ.0) IPRL3 = IPRL2 CALL DOIO(IDRT + IPRL2-1,IDRT + IPRL3-1,LU2,IPRAM) IMESS3(6) = 20062B CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IMESS3,6) CALL DOIO(IDRT+IPRL2-1+LUMAX,IDRT+IPRL3-1+LUMAX,LU2,IPRAM) RETURN END C C C *************GET THE INTERUPT TABLE***************** C C SUBROUTINE INSUB(IPRS2,IPRS3,IPRAM,LU2,LU1) DIMENSION IPRAM(6),IMESS5(6),IMESS8(11) DATA IMESS5/2H ,2HIN,2HT ,2HTA,2HBL,2HE / DATA IMESS8/2HIN,2HT ,2HTA,2HBL,2HE ,2HST,2HAR,2HTS, & 2H A,2HT ,2H6./ C C INTBA = IGET(1654B) INTLG = IGET(1655B) IPRL3 = IPRS3 C C IF(IPRS2.LT.6) GO TO 550 CALL EXEC(2,LU2,IMESS5,-12) IF(IPRS3.GT.INTLG) IPRL3 = INTLG IF (IPRS3.EQ.0) IPRL3 = IPRS2 ISTART = INTBA + IPRS2 -6 ISTOP = INTBA +IPRL3 -6 IPRAM = IPRS2 IPRAM(2) = 1 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) RETURN 550 CALL EXEC(2,LU1,IMESS8,-22) RETURN END C C C*******FIND A WORD BETWEEN GIVEN LIMITS IN MEMORY******** C SUBROUTINE FSSUB(IPRS2,IPRS3,IPRS4,IPRAM,LU2,LU1) DIMENSION IPRAM(6),IDUM(3) DATA IDUM/2H ,2H ,2H / C C L1 = IPRS3 L2 = IPRS3 + IPRS4 - 1 IF (IPRS3.LT.0) GO TO 860 IF (IPRS4.LT.0) L2 = - IPRS4 DO 850 I = L1, L2 IF(IGET(I).EQ.IPRS2) GO TO 820 GO TO 850 820 CALL DOIO(I,I,LU2,IPRAM) IF(IPRAM(3).EQ.9999) RETURN IPRAM(3) = 1 IPRAM = IPRAM + 1 850 CONTINUE IF(IPRAM(3).EQ.0) CALL NFSUB(IDUM,LU1) RETURN 860 CALL ITSUB(LU1) RETURN END C C C*******FIND ADDRESS OF SELECTED SYSTEM ENTRY POINTS******** C C C C C C SUBROUTINE LISUB(IDISC,IFILE,IPRS2,IDCB,IPRAM,LU2,LU1, & IPRS3) DIMENSION IABS(7),IRP(6),LDISC(5),IDISC(36),IFILE(10) DIMENSION IDCB(144),IPRAM(6) DATA IABS/2H ,2HAB,2HS ,2H / DATA IRP/2H ,2HRP,2H / DATA LDISC/2H ,2HDI,2HSC,2H R,2HES/ C C IERR = 0 IPRL3 = IPRS3 IF (IPRS3.LE.0) IPRL3 = 1 C C FIND TYPE AND 4TH WORD INFO FOR SELECTED ENTRY POINT C BRANCH ACCORDINGLY C CALL FNDET(IPRS2,IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 992 GO TO (975,980,995,985,990) MYTYP C C C MEMORY RESIDENT C C 975 CALL DOIO (IWRD4,IWRD4+IPRL3-1,LU2,IPRAM) RETURN C C C DISK RESIDENT C C 980 CALL EXEC (2,LU2,LDISC,5) IDISC(7) = 2H CALL CNUMD(IWRD4/128,IDISC(11)) CALL CNUMD(IAND(IWRD4,177B),IDISC(19)) CALL EXEC (2,LU2,IDISC(7),15) RETURN C C C ABSOLUTE C C 985 CALL CNUMO(IWRD4,IABS(5)) CALL EXEC (2,LU2,IABS,7) RETURN C C C RP MICRO CODED MACRO C C 990 CALL CNUMO(IWRD4,IRP(4)) CALL EXEC (2,LU2,IRP,6) RETURN C C C ERROR CONDITION C C 992 CALL CNUMD(-(IERR),IFILE(8)) CALL EXEC (2,LU1,IFILE,10) RETURN C C 995 CALL NFSUB(IPRS2,LU1) RETURN END C C C C*********** PRINT OUT THE TRACK ASSIGNMENT TABLE ****************** C SUBROUTINE TASUB(IPRS2,IPRS3,IPRS4,IPRAM,LU2,LU1) DIMENSION IAUX(5),ISYS(5),ITAT(12),IPRAM(6) DATA IAUX/2H ,2HAU,2HX ,2HDI,2HSC/ DATA ISYS/2H ,2HSY,2HS ,2HDI,2HSC/ DATA ITAT/2H ,2HTR,2HAC,2HK ,2HAS,2HSI,2HGN,2HME,2HNT, &2H T,2HAB,2HLE/ C C CALL EXEC(2,LU2,ITAT,12) IPRAM = 0 IPRL4 = IPRS4 IF (IPRS4.LE.0) IPRL4 = 1 IF((IPRS2.GT.3).OR.(IPRS2.LT.0)) GO TO 1530 C GET # OF TRACKS ON AUX DISC INEED =-( IGET(1755B))- IGET(1756B) C GET STOP ADDRESS OF TAT FOR SYS DISC ISTOP = IGET(1656B) + IGET(1756B) - 1 IF (IPRS2 .EQ. 3) GO TO 1510 C PRINT OUT SYS DISC TRACK ASSIGNMENTS CALL EXEC(2,LU2,ISYS,5) C IF(IPRS3.EQ.0) GO TO 1505 IPRAM = IPRS3 C ISTART = IGET(1656B) + IPRS3 IF(ISTART .GT. ISTOP ) GO TO 1530 IF(ISTART+IPRL4-1.LT.ISTOP)ISTOP=ISTART+IPRL4-1 1505 CALL DOIO(IGET(1656B)+IPRS3,ISTOP,LU2,IPRAM) C C IF(IPRAM(3).EQ.9999) RETURN 1510 IF(IPRS2.EQ.2) RETURN IF (INEED .EQ.0 ) RETURN C CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IAUX,5) ISTART = ISTOP + 1 + IPRS3 ISTOP = ISTOP + INEED IF(ISTART .GT.ISTOP) GO TO 1530 IF(IPRS3 .EQ. 0 ) GO TO 1520 IPRAM = IPRS3 IF(ISTART+IPRL4-1 .LT. ISTOP)ISTOP = ISTART+IPRL4-1 1520 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) RETURN 1530 CALL IWSUB(LU1) RETURN END C C C *****ANALYSIS OF THE SYSTEM***** C C SUBROUTINE ANSUB(IDISC,IFILE,IBUF,IPBUF,IDCB,IPRAM,LU2,LU1) DIMENSION IDISC(36),IFILE(10),IBUF(30),IPBUF(33),IDCB(144) DIMENSION IPRAM(6),ITABS(12),MATAB(6),MNP(3),IZZZ(3),IEPLST(38) DIMENSION IMLOC1(15),IMLOC(72),ICOMES(14) DIMENSION ILST(52),IEQLS(17) DIMENSION ICONT(3),IOFSET(5),IADR(4),LEN(5),ITAD(4),LLEN(5) C C DATA IEPLST/2H$O,2HP ,2H ,2H$L,2HIS,2HT ,2H$U,2HNP,2HE , & 2H$P,2HVC,2HN ,2H$C,2HIC,2H ,2H$P,2HOW,2HR ,2H$W,2HOR, & 2HK ,2H$L,2HST,2HM ,2H ,2H$P,2HET,2HB ,2H ,2H$D,2HMS, & 2H ,2H ,2H$C,2HIC,2H0 ,2H+1,2H3B/ DATA IMLOC1/2HAD,2HDR,2HES,2HS ,2HFO,2HR ,2HCU,2HRR, & 2HEN,2HT ,2HEQ,2HT ,2HEN,2HTR,2HY / DATA IMLOC/2HCH,2HAN,2H--,2HCU,2HRR,2HEN,2HT ,2HDM, & 2HA ,2HCH,2HAN,2HNE,2HL ,2HNU,2HMB,2HER, & 2HRQ,2HP1,2H--,2HCU,2HRR,2HEN,2HT ,2HEX, & 2HEC,2H R,2HEQ,2HUE,2HST,2H N,2HUM,2HBE,2HR , & 2HXE,2HQT,2H--,2HID,2H S,2HEG,2HME,2HNT, & 2H A,2HDD,2HR ,2HOF,2H C,2HUR,2HRE,2HNT,2H P, & 2HRO,2HGR,2HAM, & 2HXL,2HIN,2HK-,2H-I,2HD ,2HSE,2HGM,2HEN,2HT , & 2HAD,2HDR,2H O,2HF ,2HLA,2HST,2H P,2HRO,2HGR,2HAM/ DATA ILST/2HSK,2HED,2HD-,2H-S,2HCH,2HED,2HUL,2HE , & 2HLI,2HST, & 2HSU,2HSP,2H2-,2H-G,2HEN,2HER,2HAL,2H W, & 2HAI,2HT ,2HLI,2HST, & 2HSU,2HSP,2H3-,2H-M,2HEM,2HOR,2HY ,2HSU, & 2HSP,2HEN,2HD ,2HLI,2HST, & 2HSU,2HSP,2H4-,2H-D,2HIS,2HC ,2HSU, & 2HSP,2HEN,2HD ,2HLI,2HST/ DATA IEQLS/2HEQ,2HT ,2H #,2H ,2H ,2H ,2H ,2HDE, & 2HVI,2HCE,2H S,2HUS,2HPE,2HND,2H L,2HIS,2HT / DATA ITABS/2H$C,2HLA,2HS ,2HTA,2HBL,2HE , & 2H$R,2HNT,2HB ,2HTA,2HBL,2HE / DATA MATAB/2H$M,2HAT,2HA ,2HTA,2HBL,2HE / DATA MNP/2H$M,2HNP,2H / DATA IZZZ/2H$Z,2HZZ,2HZ / DATA ICONT/3,5,2/ DATA IOFSET/2H ,2H+1,2H+2,2H+3,2H+4/ DATA LEN/0,16,17,20,19/ DATA IADR/1673B,1700B,1717B,1720B/ DATA LLEN/0,10,12,13,12/ DATA ITAD/1711B,1713B,1714B,1715B/ DATA ICOMES/2H ,2HCU,2HRR,2HEN,2HT ,2HOC,2HCU,2HPA,2HNT,2H =, & 2H ,2H ,2H ,2H / C C ENTRY POINTS C DO 2010 I = 1,19,3 CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IEPLST(I),3) CALL LISUB(IDISC,IFILE,IEPLST(I),IDCB,IPRAM,LU2,LU1) IF (IPRAM(3).EQ.9999) RETURN 2010 CONTINUE C C DO 2020 I = 22,30,4 CALL FNDET(IEPLST(I),IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 2090 IF (MYTYP.EQ.3) CALL NFSUB(IEPLST(I),LU1) IF (MYTYP.EQ.3) GO TO 2020 INDX = 1 + (I-19)/4 DO 2025 J = 1,ICONT(INDX) IEPLST(I+3) = IOFSET(J) CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IEPLST(I),4) CALL DOIO(IWRD4+J-1,IWRD4+J-1,LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN 2025 CONTINUE C 2020 CONTINUE C C CALL FNDET(IEPLST(34),IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 2090 IF (MYTYP.EQ.3) CALL NFSUB(IEPLST(34),LU1) IF (MYTYP.EQ.3) GO TO 2026 CALL EXEC (3,LU2+700B,1) CALL EXEC(2,LU2,IEPLST(34),5) CALL DOIO(IWRD4+13B,IWRD4+13B,LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN C C MEMORY LOCATIONS C 2026 CALL EXEC (3,LU2+700B,1) CALL EXEC(2,LU2,IMLOC1,15) CALL DOIO(1660B,1672B,LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN IPRAM = 12 IPRAM(3) = 1 CALL DOIO(1771B,1774B,LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN IPRAM = 1 IPRAM(3) = 0 C IX = 1 DO 2027 I = 1,4 IX = IX + LEN(I) CALL EXEC (3,LU2+700B,1) CALL EXEC (2,LU2,IMLOC(IX),LEN(I+1)) CALL DOIO (IADR(I),IADR(I),LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN 2027 CONTINUE C C DO 2030 K = 1,7,6 CALL FNDET(ITABS(K),IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 2090 IF (MYTYP.EQ.3) CALL NFSUB(ITABS(K),LU1) IF (MYTYP.EQ.3) GO TO 2030 CALL EXEC (3,LU2+700B,1) CALL EXEC (2,LU2,ITABS(K),6) CALL DOIO(IWRD4+1,IWRD4+IGET(IWRD4),LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN 2030 CONTINUE C C CALL FNDET(MNP,IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 2090 IF (MYTYP.EQ.3) CALL NFSUB(MNP,LU1) IF (MYTYP.EQ.3) GO TO 2036 IMALG = 7 * (IGET(IWRD4)) CALL FNDET(MATAB,IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 2090 IF (MYTYP.EQ.3) CALL NFSUB(MATAB,LU1) IF (MYTYP.EQ.3) GO TO 2036 CALL EXEC (3,LU2+700B,1) CALL EXEC (2,LU2,MATAB,6) C C DO 2035 I = IGET(IWRD4),IGET(IWRD4)+IMALG-1,7 CALL DOIO (I,I+6,LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN IF (IGET(I+2).NE.0) GO TO 2032 ICOMES(12) = 2H GO TO 2034 2032 ICOMES(12) = IGET(IGET(I+2) +14B) ICOMES(13) = IGET(IGET(I+2) +15B) ICOMES(14) = IGET(IGET(I+2) +16B) 2034 CALL EXEC(2,LU2,ICOMES,-27) 2035 CONTINUE C C LISTS C 2036 IX = 1 DO 2037 I = 1,4 IX = IX + LLEN(I) CALL EXEC (3,LU2+700B,1) CALL EXEC (2,LU2,ILST(IX),LLEN(I+1)) CALL TRS:UB(ITAD(I),(0),0,0,IPRAM,LU2) IF (IPRAM(3).EQ.9999) RETURN 2037 CONTINUE C C IEQTA = IGET(1650B) IEQTNO = IGET(1651B) C DO 2040 I = 1,IEQTNO CALL CNUMD(I,IEQLS(4)) CALL EXEC (3,LU2+700B,1) CALL EXEC(2,LU2,IEQLS,17) CALL TRSUB(IEQTA,(0),0,0,IPRAM,LU2) IF (IPRAM(3).EQ.9999) RETURN IEQTA = IEQTA+15 2040 CONTINUE C C CALL FNDET(IZZZ,IERR,IDCB,MYTYP,IWRD4) IF (IERR.NE.0) GO TO 2090 IF (MYTYP.EQ.3) CALL NFSUB(IZZZ,LU1) IF (MYTYP.EQ.3) GO TO 2060 CALL EXEC (3,LU2+700B,1) CALL EXEC (2,LU2,IZZZ,3) CALL DOIO(IWRD4,IWRD4,LU2,IPRAM) IF (IGET(IWRD4).LT.1) GO TO 2060 IWRD4 = IGET(IWRD4) IPRAM(3) = 1 C 2050 IF (IWRD4.LT.1) GO TO 2060 CALL DOIO(IWRD4-8,IWRD4-8,LU2,IPRAM) IF (IPRAM(3).EQ.9999) RETURN IPRAM(3) = 1 IWRD4 = IGET(IWRD4) GO TO 2050 C 2060 IPRAM(3) = 0 RETURN C C C 2090 CALL CNUMD(-(IERR),IFILE(8)) CALL EXEC (2,LU1,IFILE,10) C C RETURN END C C C *****DUMP THE FOUR MAPS TO THE LIST DEVICE***** C C SUBROUTINE MASUB(IARRAY) IMPLICIT INTEGER (A-Z) COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) DIMENSION IARRAY(37),IMPMS(5) DATA IMPMS/2H ,2H ,2H ,2H M,2HAP/ CALL READF(IDCB,IERR,IBUF,128,IDMY,257) CALL ERR IOREC = 257 DO 2260 I = 1,4 GO TO (2210,2220,2230,2240) I C C SYSTEM MAP C 2210 IMPMS(1) = 2HSY IMPMS(2) = 2HST IMPMS(3) = 2HEM GO TO 2250 C C USER MAP C 2220 IMPMS(1) = 2HUS IMPMS(2) = 2HER IMPMS(3) = 2H GO TO 2250 C C PORT A MAP C 2230 IMPMS(1) = 2HPO IMPMS(2) = 2HRT IMPMS(3) = 2H A GO TO 2250 C C PORT B MAP C 2240 IMPMS(b3) = 2H B C C 2250 CALL EXEC(2,LU2,IMPMS,5) IND = I*32-31 DO 2255 J = 1,4 CALL PACK(8,0,IBUF(IND),IARRAY) CALL EXEC(2,LU2,IARRAY,37) IND = IND + 8 2255 CONTINUE 2260 CONTINUE RETURN END C C INITIALIZATION SUBROUTINE C SUBROUTINE INIT IMPLICIT INTEGER (A-Z) COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64), & PRFLAG DIMENSION PBUF(10), JBUF(30) C C INITIALIZATION ROUTINE... C C PARSE RUN STRING AND OPEN FILES; C ANNOUNCE NAME AND VERSION OF PROGRAM C C------------------------------------------------------------------------- BPFLAG = 0 MPFLAG = 0 HIDEMP = 0 HIDEBP = 0 FIOPEN = 0 IOREC = 0 SOREC = 0 IWRN = 0 IERR = 0 PRFLAG = 1 C C GET PARAMETERS C LU1 = 1 CALL EXEC(14,1,JBUF,-60) CALL ABREG(A,B) C C WIPE OUT "RU,CDA4," C ICHAR = 1 CALL NAMR(PBUF,JBUF,B,ICHAR) CALL NAMR(PBUF,JBUF,B,ICHAR) C C SET COMMAND INPUT LU # C LU1 = LOGLU(IDMY) LU2 = LU1 + 200B INTER = IFTTY(LU1) C C ANNOUNCE PROGRAM AND VERSION C CALL EXEC(2,LU1,38HCDA4 THE CRASH DUMP ANALYZER 01/01/80,19) C C GET ENTRY POINT SNAPSHOT FILE C CALL NAMR(PBUF,JBUF,B,ICHAR) IF (IAND(PBUF(4),3B).EQ.3)GO TO 20 11 CALL EXEC (2,LU1,30HBAD ENTRY POINT SNAPSHOT FILE ,15) GO TO 32 20 CALL OPEN(SDCB1,IERR,PBUF,1,PBUF(5),PBUF(6)) IF(IERR.LT.0)GO TO 11 IF(IERR.EQ.1)GO TO 30 CALL EXEC (2,LU1, & 40HENTRY POINT SNAPSHOT FILE IS NOT TYPE 1 ,20) STOP 1003 C C GET SYSTEM SNAPSHOT FILE C 30 CALL NAMR(PBUF,JBUF,B,ICHAR) IF (IAND(PBUF(4),3B).EQ.3)GO TO 40 31 v CALL EXEC(2,LU1,24HBAD SYSTEM SNAPSHOT FILE,12) 32 CALL EXEC(2,LU1, & 50HFORMAT: RU, entry point snapshot, system snapshot ,25) STOP 1004 40 CALL OPEN(SDCB2,IERR,PBUF,1,PBUF(5),PBUF(6)) IF(IERR.LT.0)GO TO 31 IF(IERR.EQ.1)GO TO 50 CALL EXEC(2,LU1,34HSYSTEM SNAPSHOT FILE IS NOT TYPE 1,17) STOP 1005 C C REQUEST FILE NAME C 50 IERR=0 CALL EXEC(2,LU1, & 50HPLEASE SPECIFY THE CRASH FILE WITH THE FI COMMAND ,25) RETURN END END$ FTN4,Q,T SUBROUTINE CTSUB(TAB,ENT) IMPLICIT INTEGER (A-Z) COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) COMMON /MEM/ M(1) COMMON /CT/ CTTAB(1) C C CTSUB IMPLEMENTS THE CT (COMPARE TABLE) COMMAND FOR CDA4 C C CTTAB IS A DATA TABLE GIVING THE NAMES OF THE TABLES THAT C CAN BE PROCESSED. IT APPEARS AS AN ASSEMBLY LANGUAGE SOURCE C FILE. THE FORMAT FOR AN ENTRY: C C WORD 1 POINTER TO TABLE CODE AND DESCRIPTION C 2 LENGTH OF TABLE ENTRY (I.E., THE TABLE DESCRIBED) C 3 POINTER TO THE BIT MASK FOR COMPARISON C 4 ADDRESS OF A ROUTINE TO SET UP THE TABLE LENGTH C AND ADDRESS. C C THE END OF THE TABLE IS INDICATED BY A ZERO IN WORD 1. C C THE TABLE CODE AND DESCRIPTION HAS THE FOLLOWING FORMAT: C C WORD 1 LENGTH IN WORDS (=N) - 2 ASCII DIGITS C 2 TWO LETTER TABLE CODE C 3-N TEXT OF DESCRIPTION C C WORDS 2-N ARE PRINTED AS TITLES AND FOR THE HELP FUNCTION C C THE BIT MASK PACKS 16 BITS OF COMPARISON INFORMATION INTO A C WORD; IF A BIT IS ON, THE WORD WILL BE COMPARED. BIT 15 IS C USED FIRST; IF MORE THAN 16 BITS AREY NEEDED, ADDITIONAL WORDS C ARE USED. C C C THE ARRAY M (AN EXTERNAL DEFINED WITH CTTAB) IS USED TO REFER C TO MAIN MEMORY. SINCE M IS EQUATED TO 0B, M(J+1) WILL GIVE C THE CONTENTS OF LOCATION J. (NOTE THAT FORTRAN USES 1-ORIGIN C INDEXING). ALSO, NOTE THAT C C CALL EXEC(2, LU2, M(J), LEN) C C WILL PRINT THE DATA STORED STARTING AT LOCATION J, WHILE C C CALL EXEC(2, LU2, IGET(J), LEN) C C WILL NOT. (THIS PROGRAM REDEFINES IGET ANYWAY) C C-------------------------------------------------------------------------- C C CHECK FOR HELP REQUEST (CT,??) C AND PROCESS IF FOUND C 10 IF(TAB.EQ.0) ENT=0 IF(TAB.NE.2H??) GO TO 30 DO 20 J = 1,32767,4 IF(CTTAB(J).EQ.0) RETURN CALL PRNT(M(CTTAB(J)+1)) 20 CONTINUE C C SEARCH FOR THE RIGHT TABLE CODE C 30 DO 40 J = 1,32767,4 IF(CTTAB(J).EQ.0) GO TO 50 IF(M(CTTAB(J)+2).EQ.TAB) GO TO 60 IF(TAB.NE.0) GO TO 40 IF(CTPRC(J,ENT).NE.0) RETURN 40 CONTINUE C C ENTRY WAS NOT FOUND C 50 IF(TAB.EQ.0)RETURN CALL PRNT(28H14TABLE REQUESTED NOT FOUND ) RETURN C C TABLE FOUND - PROCESS ENTRY C 60 IDMY = CTPRC(J,ENT) RETURN END INTEGER FUNCTION CTPRC(J,ENT) IMPLICIT INTEGER (A-Z) COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) COMMON /MEM/ M(1) COMMON /CT/ CTTAB(1) COMMON /CTPR/TLEN, TADR, TYP DIMENSION OBUF(144), MES1(11) DATA MES1/2H11,2H E,2HNT,2HRY,2H N,2HUM,2HBE,2HR ,2H--,2H--,2H--/ C C CTPRC COMPARES A TABLE OR A SINGLE ENTRY (IF ENT IS 0 OR >0, C RESPECTIVELY). J IS A SUBSCRIPT FOR CTTAB, INDICATING WHICH TABLE C TO PROCESS (SEE iCTSUB FOR MORE INFO) C THE RETURN VALUE IS NON-ZERO IS A BREAK WAS DETECTED. C C----------------------------------------------------------------------------- C C SET TITLE FLAG C TITLE = 1 CTPRC = -1 IF(ENT.NE.0) TITLE=0 C C SET TABLE SIZE AND ADDRESS C IERR = 0 CALL JMP(CTTAB(J+3)) IF(TYP.EQ.3) GOTO 130 C C SET LIMITS FOR COMPARE C L1 = TADR L2 = TADR + (TLEN - 1)*CTTAB(J + 1) IF(ENT.EQ.0) GO TO 10 C C SET ENTRY LIMITS; CHECK ENTRY # IS IN RANGE C L1 = TADR + (ENT - 1)*CTTAB(J + 1) L2 = L1 IF (ENT.LE.TLEN .AND. ENT.GE.0) GO TO 10 CALL PRNT(28H14ENTRY NUMBER OUT OF RANGE ) RETURN C C DO COMPARISON C 10 ELEN = CTTAB(J + 1) DO 120 TADDR = L1, L2, ELEN FLAG = 0 PADDR = CTTAB(J + 2) DO 40 K = 0, ELEN - 1, 16 WORD = M(PADDR+1) PADDR = PADDR + 1 DO 30 L = 0,15 IF (WORD.GE.0) GO TO 20 IF ( IGET(TADDR+K+L) .NE. SGET(TADDR+K+L) ) & FLAG = 1 20 WORD = WORD + WORD 30 CONTINUE 40 CONTINUE C C**** IF COMPARE FAILED, PRINT ENTRY C PRINT TITLE IF NEEDED; PRINT ENTRY NUMBER (ALWAYS) C IF(FLAG.EQ.0) GO TO 120 IF(TITLE.NE.0) CALL PRNT(M(CTTAB(J)+1)) CALL CNUMD((TADDR-L1)/ELEN + 1, MES1(9)) CALL PRNT(MES1) CALL PRNT(4H02 ) TITLE = 0 C C NOW FORMAT ENTRY C PADDR = CTTAB(J+2) DO 110 K = 0, ELEN - 1, 16 DO 60 L = 1,144 OBUF(L) = 2H 60 CONTINUE WORD = M(PADDR+1) PADDR = PADDR + 1 DELTA = 5 DO 90 L = 0,15 IF (K+L.GE.ELEN) GO TO 100 CALL OCT(IGET(TADDR+K+L),OBUF(L*4+DELTA))  IF (WORD.GE.0) GO TO 80 OBUF(L*4+DELTA-1) = 2H * IF (IGET(TADDR+K+L) .NE. SGET(TADDR+K+L)) & CALL OCT(SGET(TADDR+K+L), OBUF(L*4+DELTA+72)) 80 WORD = WORD + WORD IF (L.EQ.7) DELTA = 9 90 CONTINUE C C CONVERT ADDRESSES TO OCTAL; THEN PRINT TWO LINES (8 WORDS) C IF MORE THAN 8 WORDS WERE FORMATTED ABOVE, THEN PRINT ANOTHER C TWO LINES. C 100 IF(IFBRK(IDMY).NE.0)GO TO 131 CALL OCT(TADDR+K,OBUF) CALL OCT(TADDR+K+8,OBUF(37)) CALL EXEC(2,LU2,OBUF,36) CALL EXEC(2,LU2,OBUF(73),36) CALL PRNT(4H02 ) IF(L.LT.8) GO TO 110 CALL EXEC(2,LU2,OBUF(37),36) CALL EXEC(2,LU2,OBUF(109),36) CALL PRNT(4H02 ) 110 CONTINUE 120 CONTINUE C C PRINT A BLANK LINE TO SEPARATE TABLES C 130 CTPRC = 0 131 CALL PRNT(4H02 ) RETURN END ASMB,R,L HED CTAB - DATA FOR TABLE COMPARE ROUTINE NAM CTAB,7 ENT MEM COMMON AREA - EQUATED TO 0 - FOR FTN USE ENT CT COMMON AREA - DATA TABLES FOR CTSUB ENT CTPR COMMON AREA - FOR PASSING DATA BACK TO CTSUB * EXT IGET,FNDET,JRETN * A EQU 0 B EQU 1 * * DEFINE CDA COMMON AREA * EXT CDA EXT EQUIVALENT TO FORTRAN NAMED COMMON * MEM EQU 0 EQUATING MEM TO 0 ALLOWS FORTRAN TO REFER TO * LOCATION J IN MEMORY AS M(J+1). MEM IS THE * NAME OF A COMMON AREA CONTAINING (ONLY) M. * ************************************************************************** * * CT - DATA TABLE FOR CTSUB. THE FORMAT OF THE DATA AREA IS DESCRIBED * IN CTSUB. NOTE HOW THE POINTERS ARE SET UP WITH LABELS. NOTE THE * REGULARITY OF THE LABELS: --DSC IS USED FOR THE DESCRIPTION, * --MS?K IS USED FOR THE BIT MASK, AND --SET IS USED FOR THE SETUP * ROUTINE. -- IS THE SAME AS THE TABLE CODE. * ************************************************************************** * SUP SUPRESS 2-N WORDS FOR EACH LINE * CT DEF CMDSC COMMUNICATION AREA - POINTER TO DESCRIPTION DEF 133B LENGTH OF TABLE ENTRY DEF CMMSK POINTER TO MASK DEF CMSET ADDR OF ROUTINE TO SET TABLE LEN & ADDR * DEF DRDSC DRIVER MAPPING TABLE DEF 1 DEF DRMSK DEF DRSET * DEF EQDSC EQT TABLE DEF 15 DEF EQMSK DEF EQSET * DEF KBDSC KEYWORD BLOCK DEF 1 DEF KBMSK DEF KBSET * DEF MADSC MATA TABLE DEF 7 DEF MAMSK DEF MASET * DEF MPDSC MEMORY PROTECT FENCE TABLE DEF 6 DEF MPMSK DEF MPSET * DEF TRDSC TRACK MAP TABLE #1 DEF 17 DEF TRMSK DEF TRSET * DEF T2DSC TRACK MAP TABLE #2 DEF 3 DEF T2MSK DEF T2SET * DEF 0 **END OF TABLE** * * TABLE TITLES/DESCRIPTIONS * CMDSC ASC 12,12CM COMMUNICATIONS AREA MADSC ASC 08,08MA $MATA TABLE KBDSC ASC 09,09KB KEYWORD BLOCK TRDSC ASC 12,12TR TRACK MAP TABLE #1 T2DSC ASC 12,12T2 TRACK MAP TABLE #2 EQDSC ASC 10,10EQ EQUIPMENT TABLE DRDSC ASC 13,13DR DRIVER MAPPING TABLE MPDSC ASC 16,16MP MEMORY PROTECT FENCE TABLE * * COMPARISON BIT MASKS * CMMSK OCT 017740 0 001 111 111 100 000 OCT 000400 0 000 000 100 000 000 OCT 000000 0 000 000 000 000 000 OCT 000777 0 000 000 111 111 111 OCT 160377 1 110 000 011 111 111 OCT 160000 1 110 000 000 000 000 MAMSK OCT 001000 0 000 001 000 000 000 KBMSK OCT 100000 1 000 000 000 000 000 TRMSK OCT 177777 1 111 111 111 111 111 OCT 100000 1 000 000 000 000 000 T2MSK OCT 160000 h 1 110 000 000 000 000 EQMSK OCT 060000 0 110 000 000 000 000 DRMSK OCT 100000 1 000 000 000 000 000 MPMSK OCT 176000 1 111 110 000 000 000 * * CHUNKS OF CODE * NOTE THAT THE CHUNKS ARE ASSUMED TO BE * CALLED BY THE 'JMP' SUBROUTINE; THEY * SHOULD RETURN TO 'JRETN' WITH A JUMP. * CMSET LDA D1 STA TLEN LDA B1645 STA TADR JMP JRETN * MASET JSB FND GET ADDR ASC 3,$MATA OF $MATA STA TADR JSB FND GET NO OF ASC 3,$MNP ENTRIES STA TADR2 GET VALUE JSB IGET OF CELL DEF *+2 DEF TADR2 STA TLEN JMP JRETN * KBSET JSB IGET GET POINTER DEF *+2 DEF B1657 FROM COMMUNICATIONS AREA STA TADR STA TADR2 * * NOW FIND THE END OF THE TABLE * KB1 JSB IGET LOAD TABLE WORD DEF *+2 DEF TADR2 SZA END? ISZ TADR2 NO - INCR SZA YES - END? JMP KB1 NO - CONTINUE LDA TADR2 CMA,INA SUBTRACT ADA TADR TADR CMA,INA TO GIVE COUNT STA TLEN SAVE AND JMP JRETN RETURN * TRSET JSB FND POINT TO TABLE ASC 3,$TB31 STA TADR LDA D1 SET LENGTH STA TLEN AND JMP JRETN RETURN * T2SET JSB FND GET TABLE ASC 3,$TB32 ADDRESS STA TADR2 INA STA TADR GET VALUE JSB IGET OF CELL DEF *+2 DEF TADR2 CMA,INA BEGINNING OF TABLE HAS -LENGTH STA TLEN JMP JRETN * EQSET JSB IGET GET ADDRESS DEF *+2 DEF B1650 FROM COMMUNICATIONS AREA STA TADR JSB IGET GET LENGTH DEF *+2 DEF B1651 FROM COMMUNICATIONS AREA STA TLEN JMP JRETN * DRFCSET JSB FND GET ADDRESS ASC 3,$DVMP FROM THE ENTRY POINT STA TADR JSB IGET GET LENGTH DEF *+2 DEF B1651 FROM COMMUNICATIONS AREA STA TLEN (SAME LENGTH AS EQT TABLE) JMP JRETN * MPSET JSB FND GET ADDRESS ASC 3,$MPFT FROM THE ENTRY POINT STA TADR2 GET VALUE JSB IGET DEF *+2 DEF TADR2 STA TADR LDA D1 ONLY ONE ENTRY STA TLEN JMP JRETN * ***** END OF CODE CHUNKS (AND CT TABLE AREA) * * * CTPR IS USED TO PASS INFORMATION FOR CTSUB AND PRSUB * * CTPR EQU * TLEN DEF *-* THE TABLE LENGTH (WORDS, POSITIVE) TADR DEF *-* THE TABLE ADDRESS TYP DEF *-* RETURN VALUE FROM FIND OPERATION * * FND SUBROUTINE - FINDS AN ENTRY POINT IN THE SNAPSHOT FILE * * CALL: JSB FND * ASC 3,-NAME- * ON RETURN, THE A REGISTER HAS THE ADDRESS OF THE ENTRY POINT * FND NOP ENTRY JSB FNDET CALL FORTRAN ROUTINE DEF *+6 DEF FND,I ENTRY POINT IN ASCII DEF CDA+6 ERROR FLAG (IERR) DEF CDA+156 DCB (SDCB1) DEF TYP KLUDGE DEF FHLD GETS ENTRY POINT ADDRESS LDA FND INCR ADA D3 RETURN STA FND ADDRESS LDA FHLD LOAD ENTRY POINT ADDRESS JMP FND,I RETURN * FHLD DEF *-* GETS ENTRY POINT ADDRESS IDMY DEF *-* DUMMY PARAMETER TADR2 DEF *-* TEMP * * CONSTANTS * B377 OCT 000377 B1774 OCT 177400 B1645 OCT 001645 B1657 OCT 001657 B1650 OCT 001650 B1651 OCT 001651 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D12 DEC 12 M67 DEC -67 END FTN4,L PROGRAM CDA4B(5),24999-16197 REV.2024 IMPLICIT INTEGER (A-Z) COMMON /CDA/LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) C COMMON /CDASG/ RTNA, IPBUF(33), IPRAM(6), IARRAY(64), IDISC(36), & IGO(35), IGO2(35), IFILE(10), JBUF(30), IOP, LEN C EQUIVALENCE (IPBUF(2),IPRS1),(IPBUF(6),IPRS2),(IPBUF(10),IPRS3), & (IPBUF(14), IPRS4), (IPBUF(18), IPRS5), (IPBUF(22), IPRS6), & (IPBUF(26), IPRS7), (IPBUF(30), IPRS8) C C THIS SEGMENT HANDLES SOME OF THE COMMANDS FOR CDA4 C C SELECT THE APPROPRIATE SUBROUTINE: C GO TO (100, 100, 100, 100, 100, 100, 100, 100, 100, 100, & 100, 100, 100, 100, 100, 100, 100, 100, 100, 100, & 100, 100, 100, 124, 125, 126, 100, 128, 100, 130, & 100, 100, 100, 100, 100) IOP C 100 CALL PRNT(16H07INTERNAL ERROR) GO TO 1 124 CALL DB(LU1, IDCB) GO TO 1 125 CALL WHZIT(LU2, SDCB1, IPRS2) GO TO 1 126 CALL EXEC(2,LU1,31HBE OF GOOD CHEER SAM IS COMING!,-31) GO TO 1 128 CALL FISUB(JBUF,LEN) GO TO 1 130 CALL VESUB(IPRS2,SDCB1) GO TO 1 C C NOW RETURN TO MAIN C 1 CALL JMP(RTNA) END END$ FTN4,Q,T SUBROUTINE FISUB(JBUF,LEN) IMPLICIT INTEGER (A-Z) C COMMON /CDA/ LU1, LU2, BPFLAG, MPFLAG, IOREC, SOREC, IERR, IWRN, & HIDEBP, HIDEMP, FIOPEN, INTER, IDCB(144), SDCB1(144), & SDCB2(144), IBUF(128), SBUF1(128), SBUF2(128), TRTAB(64) C COMMON /CDA2/ DS1, DS2, MLIM, MSTAT, DPLIM C COMMON /CDA3/ TIM(5), YR C C DIMENSION JBUF(1),IPBUF(10),T(2) DIMENSION MES1(24), MES2(8), MES3(21), MES4(21) DATA MES1/2H24,2HTI,2HME,2H O,2HF ,2HCR,2HAS,2HH / DATA MES2/2H08,2HRE,2HV ,2HCO,2HDE,2H..,2H..,2H../ DATA MES3/2H21,2H..,2H..,2H..,2H P,2HAG,2HES,2H O,2HF ,2HDR, & 2HIV,2HER,2H P,2HAR,2HTI,2HTI,2HON,2HS ,2HDU,2HMP, & 2HED/ DATA MES4/2H21,2HDE,2HAD,2H S,2HPO,2HT ,2HIS,2H B,2HET,2HWE, & 2HEN,2H ,2H..,2H..,2H..,2H A,2HND,2H ,2H..,2H.., & 2H../ C C FISUB IMPLEMENTS THE FI COMMAND C IT SETS UP THE LIMITS FOR THE 'DEAD AREA', INITIALIZES C MSTAT, MLIM, AND DPLIM, AND SETS UP THE TRANSLATION TABLE C (TRTAB) C C------------------------------------------------------------------------- C C CLOSE THE OLD FILE IF NECESSARY, PARSE THE FILE NAME AND OPEN C THE NEW FILE C IF(FIOPEN.EQ.1)CALL CLOSE(IDCB) FIOPEN = 0 ICHAR = 1 CALL NAMR(IPBUF,JBUF,LEN,ICHAR) CALL NAMR(IPBUF,JBUF,LEN,ICHAR) IF(IAND(IPBUF(4),3B).EQ.3)GO TO 10 CALL EXEC(2,LU1,18HINVALID FILE NAME ,9) RETURN 10 CALL OPEN(IDCB,IERR,IPBUF,1,IPBUF(5),IPBUF(6)) IF (IERR.GE.0)GO TO 20 CALL EXEC(2,LU1,16HCANNOT OPEN FILE,8) RETURN 20 IF(IERR.EQ.1) GO TO 25 CALL EXEC(2,LU1,24HCRASH FILE IS NOT TYPE 1,12) RETURN 25 IERR = 0 C C**** DETERMINE DUMP TYPE C C CHECK FILE LENGTH >= 257 C CALL READF(IDCB,IERR,IBUF,128,IDMY,257) IF(IERR.EQ.0) GO TO 30 CALL PRNT(32H16FILE TOO SMALL - MAPS MISSING ) RETURN C C INITIALIZE STATE C 30 FIOPEN = 1 MPFLAG = 0 HIDEMP = 0 BPFLAG = 0 HIDEBP = 0 SOREC = 0 IOREC = 0 DS1 = 0 DS2 = 0 C PRINT CRASH TIME AND DATE C CALL FNDET(5H$TIME,IERR,SDCB1,TYP,WD4) IF(TYP.NE.3 ) GO TO 31 CALL PRNT(20H10CRASH TIME UNKNOWN) GO TO 32 31 T(1) = IGET(WD4) T(2) = IGET(WD4 + 1) CALL TMVAL(T,TIM) DCNT = IGET(WD4 + 2) YR = DCNT/365 + 1970 TIM(5) = DCNT - (DCNT/365)*365 + 1 CALL JFTIM(MES1(10)) CALL PRNT(MES1) C C PRINT CRASH REV CODE C 32 CALL FNDET(5H$DATC,IERR,SDCB1,TYP,WD4) IF(TYP.NE.3 )GO TO 33 CALL PRNT(18H09REV CODE UNKNOWN) GOK TO 34 33 CALL CNUMD(IGET(WD4),MES2(6)) CALL PRNT(MES2) C C CHECK FOR STANDALONE DUMP C (4666 AND 77777B ARE MAGIC NUMBERS) C 34 IF(IGET(77677B).NE.4666.OR.IGET(77676B).NE.77777B) GO TO 35 CALL PRNT(18H09STANDALONE DUMP ) DPLIM = 48 MSTAT = IGET(77674B) DS1 = IGET(77675B) DS2 = 77777B GO TO 47 C C CHECK FOR GENNED IN DUMP C 35 CALL FNDET(5H\DUMP,IERR,SDCB1,TYP,WD4) IF(TYP.NE.3 ) GO TO 40 C C NOT GENNED IN - SOURCE UNKNOWN C CALL PRNT(32H16DUMP TYPE CANNOT BE DETERMINED) DS1 = 77400B DS2 = 77777B MSTAT = 0 DPLIM = 32 GO TO 47 C C GENNED IN C 40 CALL PRNT(16H08GENNED IN DUMP) DS1 = 1 DS2 = 0 MSTAT = IGET(WD4 - 1) C C FIGURE OUT HOW MANY DRIVER PTTN PAGES WERE DUMPED C CALL FNDET(5H$MRMP,IERR,SDCB1,TYP,WD4) IF(TYP.NE.3 ) GO TO 45 CALL PRNT(16H08$MRMP MISSING ) MLIM = 0 RETURN 45 DPLIM = IAND(IGET(IGET(WD4)),1777B) 47 IF(DPLIM.LT.32) DPLIM = 32 IF(DPLIM.GE.64) DPLIM = 48 CALL CNUMD(DPLIM-32,MES3(2)) CALL PRNT(MES3) C C PRINT DEAD SPOT (IF THERE IS ONE) C CALL OCT(DS1,MES4(13)) CALL OCT(DS2,MES4(19)) IF(DS1.LE.DS2) CALL PRNT(MES4) C C**** SET UP THE TRANSLATION TABLE; C VERIFY THAT THE FILE CONTAINS ENOUGH DATA FOR EACH MAP C MLIM = 0 CALL READF(IDCB,IERR,IBUF,128,IDMY,258+(DPLIM-32)*8) IOREC = 0 IF(IERR.EQ.0) GO TO 50 MLIM = 0 CALL PRNT(46H23DRIVER PTTNS, SYSTEM AND USER MAPS SUPRESSED) RETURN C C SET UP THE TABLE C 50 I = 258 + (DPLIM - 32)*8 CALL READF(IDCB,IERR,IBUF,128,IDMY,257) IOREC = 0 CALL ERR DO 80 J = 1,64 K = IAND(IBUF(J),1777B) IF (K.LT.DPLIM)GO TO 60 TRTAB(J) = I I = I+8  GO TO 70 C ELSE 60 TRTAB(J) = K*8 + 1 IF (K.GT.31) TRTAB(J) = TRTAB(J) + 1 C C CHECK THE SYSTEM WAS COMPLETELY DUMPED C 70 IF (J.NE.33) GO TO 80 CALL READF(IDCB,IERR,IDMY,1,IDMY,I-1) IOREC = 0 IF(IERR.EQ.0) GO TO 80 MLIM = 1 CALL PRNT(32H16SYSTEM AND USER MAPS SUPRESSED) RETURN 80 CONTINUE C C CHECK THE USER MAP IS THERE C CALL READF(IDCB,IERR,IDMY,1,IDMY,I-1) IOREC = 0 IF(IERR.EQ.0) GO TO 90 MLIM = 2 CALL PRNT(20H10USER MAP SUPRESSED) RETURN 90 MLIM = 3 RETURN END END$ ASMB,R,Q,C,N * * NAME: DBUGR * SOURCE: 92067-1???? * RELOC: 92067-16??? * PGMR: B.S.,G.A.,D.D.,D.S.,J.N. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * HED DBUG(USER VERSION) NAM DB,7 92067-16??? REV.GAA- 790313 ENT DB EXT EXEC,IFBRK,$LIBX,$LIBR,LOGLU,IGET,FNDET SUP * * A EQU 0 B EQU 1 R EQU 1 HED SYMBOL TABLES * E N D * * USER DEFINED SYMBOL TABLE AREA * * SYMBOLS WILL RESIDE IN IDENTICAL FORMAT TO TABLE "ISL" * FOLLOWING THIS TABLE IN MEMORY. THAT FORMAT IS: * * 4 TO 6 CHARACTERS IN SYMBOL- * * ENTRY 1 - 1ST WORD(1ST 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 2 - 2ND WORD(2ND 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 3 - OPCODE * * 3 OR LESS CHARACTERS IN SYMBOL- * * ENTRY 1 - SYMBOL WORD IN SQOZE CODE * * ENTRY 2 - MAY BE USED FOR A VALUE * END B BSS 50 SYMBOL TABLE FREE AREA SKP * I S L * * INSTRUCTIONS SYMBOL TABLE * * CONTAINS SYMBOLS FOR THE 2100 ALTER SKIP,SHIFT ROTATE AND * I O INSTRUCTIONS SET IN SQOZE CODE. TABLE ENTRIES ARE IN * THE FOLLOWING FORMAT: * * 4 TO 6 CHARACTERS IN SYMBOL- * * ENTRY 1 - 1ST WORD(1ST 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 2 - 2ND WORD(2ND 3 CHARACTERS OF SYMBOL) IN SQOZE CODE * ENTRY 3 - OPCODE * * 3 OR LESS CHARACTERS IN SYMBOL- * * ENTRY 1 - SYMBOL WORD IN SQOZE CODE * * ENTRY 2 - MAY BE USED FOR A VALUE * ISL EQU * OCT 45 . LOC NOP USED AS THE LOCATION COUNTER OCT 2755 .. DDOT NOP * * I S L 2 * * REMAINDER OF TABLE "ISL" SOMETIMES REFERRED TO DIRECTLY AND * SOMETIMES REFERRED TO AS A PART OF TABLE "ISL" * ISL2 EQU * OCT 44115,0,1000 ALS OCT 44475,0,1100 ARS OCT 130316,0,1200 RAL OCT 130324,0,1300 RAR OCT 44114,0,1400 ALR OCT 61053,0,1500 ERA OCT 60473,0,1600 ELA OCT 44100,0,1700 ALF OCT 47215,0,5000 BLS OCT 47575,0,5100 BRS OCT 130366,0,5200 RBL OCT 130374,0,5300 RBR OCT 47214,0,5400 BLR OCT 61054,0,5500 ERB OCT 60474,0,5600 ELB OCT 47200,0,5700 BLF ISL3 EQU * OCT 52273,0,2400 CLA OCT 52343,0,3000 CMA OCT 51523,0,3400 CCA OCT 52274,0,6400 CLB OCT 52344,0,7000 CMB OCT 51524,0,7400 CCB SEZ OCT 133674,0,2040 SEZ OCT 133674,0,6040 SEZ CLE OCT 52277,0,2100 CLE OCT 52277,0,6100 CLE OCT 52277,0,40 CLE OCT 52277,0, /4040 CLE OCT 52277,35,40 CLES OCT 52347,0,2200 CME OCT 52347,0,6200 CME OCT 51527,0,2300 CCE OCT 51527,0,6300 CCE OCT 131645,0,2001 RSS OCT 131645,0,6001 RSS OCT 134723,0,2020 SSA OCT 75213,0,2004 INA OCT 135353,0,2002 SZA OCT 134724,0,6020 SSB OCT 75214,0,6004 INB OCT 135354,0,6002 SZB SLA OCT 134273,0,10 SLA OCT 134273,0,2010 SLA OCT 44115,0,20 ALS LOWER OCT 44475,0,21 ARS LOWER OCT 130316,0,22 RAL LOWER OCT 130324,0,23 RAR LOWER OCT 44114,0,24 ALR LOWER OCT 61053,0,25 ERA LOWER OCT 60473,0,26 ELA LOWER OCT 44100,0,27 ALF LOWER SLB OCT 134274,0,4010 SLB OCT 134274,0,6010 SLB OCT 47215,0,4020 BLS LOWER OCT 47575,0,4021 BRS LOWER OCT 130366,0,4022 RBL LOWER OCT 130374,0,4023 RBR LOWER OCT 47214,0,4024 BLR LOWER OCT 61054,0,4025 ERB LOWER OCT 60474,0,4026 ELB LOWER OCT 47200,0,4027 BLF LOWER OCT 23,100000 I O15 OCT 15,1000 C OCT 72016,0,102000 HLT HLT EQU *-1 OCT 52300,0,103100 CLF OCT 135000,0,102100 STF STF EQU *-1 OCT 133715,0,102200 SFC OCT 133735,0,102300 SFS OCT 111303,0,102400 MIA OCT 111304,0,106400 MIB OCT 120373,0,102600 OTA OCT 120374,0,106600 OTB OCT 134775,0,102700 STC OCT 52275,0,106700 CLC OCT 106203,0,102500 LIA OCT 106204,0,106500 LIB OCT 44544,0,101020 ASR OCT 44536,0,100020 ASL ASL EQU *-1 OCT 107044,0,101040 LSR OCT 107036,0,100040 LSL LSL EQU *-1 OCT 131574,0,101100 RRR OCT 131566,0,100100 RRL RRL EQU *-1 OCT 51432,0,101741 CAX OCT 51433,0,101751 CAY OCT 51502,0,105741 CBX OCT 51503,0,105751 CBY OCT 53233,0,101744 CXA OCT 53234,0,105744 CXB OCT 53303,0,101754 CYA OCT 53304,0,105754 CYB OCT 153132,0,101747 XAX OCT 153133,0,101757 XAY OCT 153202,0,105747 XBX OCT 153203,0,105757 XBY OCT 105576,0,105763 LBT OCT 133476,0,105764 SBT OCT 106013,0,101727 LFA OCT 106014,0,105727 LFB OCT 110663,0,105702 MBI OCT 110701,0,105704 MBW OCT 112373,0,105705 MWI OCT 112411,0,105707 MWW OCT 131623,0,101730 RSA OCT 131624,0,105730 RSB OCT 132013,0,101731 RVA OCT 132014,0,105731 RVB OCT 154043,0,101722 XMA OCT 154044,0,105722 XMB OCT 154065,0,105721 XMS OCT 56052,0,105761 DSX OCT 56053,0,105771 DSY OCT 75552,0,105760 ISX OCT 75553,0,105770 ISY OCT 110660,0,105703 MBF OCT 112370,0,105706 MWF OCT 122103,0,101712 PAA OCT 122104,0,105712 PAB OCT 122153,0,101713 PBA OCT 122154,0,105713 PBB OCT 135303,0,101710 SYA OCT 135304,0,105710 SYB OCT 143123,0,101711 USA OCT 143124,0,105711 USB OCT 154057,0,105720 XMM OCT 63432,0,105100 FIX OCT 63616,0,105120 FLT OCT 133714,0,105767 SFB "CR" EQU O15 SKP DOUBL EQU * OCT 111763,0,100200 MPY OCT 55230,0,100400 DIV OCT 55376,0,104200 DLD OCT 56046,0,104400 DST OCT 62706,0,105000 FAD OCT 63120,0,105060 FDV OCT 63662,0,105040 FMP OCT 64224,0,105020 FSB OCT 43422,0,105746 ADX OCT 43423,0,105756 ADY OCT 105532,0,101742 LAX OCT 105533,0,101752 LAY OCT 105602,0,105742 LBX OCT 105603,0,105752 LBY OCT 105722,0,105745 LDX OCT 105723,0,105755 LDY OCT 153773,0,101724 XLA OCT 153774,0,105724 XLB OCT 133432,0,101740 SAX OCT 133433,0,101750 SAY OCT 133502,0,105740 SBX OCT 133503,0,105750 SBY OCT 135022,0,105743 STX OCT 135023,0,105753 STY OCT 134737,0,105714 SSM OCT 100223,0 JLY JLY OCT 105762 OCT 100463,0 JPY JPY OCT 105772 * REMAINING INSTRUCTIONS ARE IN THE 21MX BASE SET * BUT ARE NOT SIMULATED BY DDT AND CANNOT BE TRACED. OCT 55272,0,105732 DJP IVINS EQU *-1 OCT 55275,0,105733 DJS OCT 134172,0,105734 SJP OCT 134175,0,105735 SJS OCT 142372,0,105736 UJP OCT 142375,0,105737 UJS OCT 154423,0,101725 XSA OCT 154424,0,105725 XSB STTP2 EQU * OCT 100575,0,105715 JRS OCT 153223,0,101726 XCA OCT 153224,0,105726 XCB OCT 51476,0,105766 CBT OCT 110676,0,105765 MBT OCT 51475,0,105774 CBS OCT 133475,0,105773 SBS OCT 136575,0,105775 TBS OCT 112341,0,105777 L= MVW OCT 52371,0,105776 CMW STTP EQU * SKP * DSPTB DEF PLUS SPACE DEF EXCL ! DEF ASCIN " DEF NUMSN # DEF EXI $ DEF PCT % DEF DAQ & DEF ASO ' DEF PFIX ( DEF EXASC ) DEF STAR * DEF PLUS + CMADD DEF COMMA , DEF MINUS - DEF DOT . DEF BAR / NMFLG BSS 1 NOT USED FOR DISPATCHING (ASCII # 0) BSS 1 NOT USED FOR DISPATCHING (ASCII # 1) BSS 1 NOT USED FOR DISPATCHING (ASCII # 2) BSS 1 NOT USED FOR DISPATCHING (ASCII # 3) BSS 1 NOT USED FOR DISPATCHING (ASCII # 4) BSS 1 NOT USED FOR DISPATCHING (ASCII # 5) TEMP4 BSS 1 NOT USED FOR DISPATCHING (ASCII # 6) TEMP3 BSS 1 NOT USED FOR DISPATCHING (ASCII # 7) TEMP2 BSS 1 NOT USED FOR DISPATCHING (ASCII # 8) TEMP1 BSS 1 NOT USED FOR DISPATCHING (ASCII # 9) DEF COLON : DEF SEMI ; DEF LSSN < DEF EQLS = DEF GRTR > DEF MSTAT ? DEF EXA @ DEF AT A DEF BRK B DEF CT C DEF PNCH D DEF EAS E DEF FT F DEF GO G DEF HT H DEF ERR I DEF USMAP J DEF KILL K DEF TABL L DEF MT M DEF NWS N DEF BPM O DEF PROC P DEF QT Q DEF RSET R DEF ST S DEF TRACE T DEF ECSL U DEF VFY V DEF WDS W DEF XEC X DEF LOAD Y DEF ZRO Z DEF SBRK [ DEF ALT \ ERRX DEF ERR ] DEF UPARW ^ DEF LARR _ * UNL IFN LST UNL XIF LST HED DBUG INITIALIZATION * * PNT10 DEF MSG01 MSG01 OCT 6412 CR/LF UNL LST ASC 6,START DBUGR UNL LST OCT 6412 CR LF ASC 1,// * .DBUG NOP WHERE LOADER WILL PLACE TRUE RETURN. $DDT NOP EVERYONE'S ENTRY POINT DBUGR EQU $DDT DB EQU $DDT UNL IFZ LST JSB SVST NOMINAL ENTRY POINT LDB .DBUG DETERMINE IF CALLED FROM LDA $DDT LOADER($DDT = 0)OR SZA DIRECTLY. LDB $DDT,I SET EXIT ADDRESS STB DDOT FOR PROCEED UNL XIF IFN LST LDB $DDT,I GET THE RETURN ADDRESS STB .DBUG AND SAVE IT CCA UNL XIF LST ISZ $DDT STEP TO POSSIBLE LU ADDRESS. SZA IF APPENDED BY LOADER OR CPB $DDT IF THERE IS NO LU GIVEN, JMP TST THEN GO GET LOG LU OR LU 1. * LDA $DDT,I YES GET IT LDA A,I TO A TST1 AND O77 ISOLATE IT IOR O2500 MAKE HONEST MODE STA LU SAVE AS THE LU ISZ $DDT STEP TO THE DCB ADDRESS LDA $DDT,I GET THE DCB ADDRESS STA DCB AND SAVE IT HERE JSB EXEC GET TYPE CODE DEF TSTRT DEF O15 (DEC 13) DEF LU PCH DEF CH TEMP TSTRT LDA PCH,I GET EQT WORD 5 AND C374 KEEP TYPE STA TMODE SET MODE (0= '\' #0= '\\' LDB PNT10 PRINT 'START JSB OUTMS DBUGR' MESSAGE. JMP LSE O2500 OCT 2500 * TST JSB LOGLU GO RECOVER LOG DEF *+2 LU OR IF NONE, DEF LU THEN USE LU 1. JMP TST1 A-REG = LU#. C374 OCT 37400 HED DBUG - CHARACTER DISPATCH * * LSE RSS CLEARED ON FIRST ENTRY JMP LSE1 * UNL IFZ LST LDA BIX GET THE ADDRESS TO USE AGE AND G74 FOR BREAK INSTRUCTIONS XOR BIX SAhVE THE ADDRESS ONLY STA DSYMX SAVE IT FOR BREAK UNL XIF LST LDA LNEV SET FENCES CMA,INA FOR STA LNEV EVAL CHECKS LDA LXEV MUST BE NEG CMA,INA STA LXEV * UNL IFZ LST LDA 1777B SET DM BOUNDS UNL XIF IFN CCA SET UP THE MOST CLE,ERA WE CAN HAVE UNL XIF LST STA CEND SET END OF MEMORY INA STA UPBD CMA,INA STA MUPBD * LSE1 JSB CRLF CLA PROTECT STA PFLAG STORES LSF LDA PM STA EXPM LSF2 CLA FROM TABP. STA TRAC CLEAR TRACE COUNT STA LSE CLEAR FIRST TIME RSS STA $DDT CLEAR JSB ENTRY POINT. STA LFLG LDA O3 STA LL LDA CEND STA UL * LSS CLA FROM LIM SET. STA CHI STA WRD STA CLEFG CLEAR CLE FLAG STA CMFLG CLEAR COMMA FLAG STA INSTR STA ALTMI * LDA CAD SSN STA SGN CLA LSQ STA ONM STA DNM CLA,CLE CLE IS DECORATION. STA SYM STA SYM+R STA LETF STA CHC LDB SYMXI STB SYMX STA WSD MAKE A NO-OP. LSR0 EQU * STA ASCI SKP * LSR EQU * JSB TTYOP STA CH CPA O177 JMP DEL LDB LFP CPA O12 JMP LFCRT LDB CRP CPA O15 JMP LFCRT LDB CH ADB DSPP LDB B,I ADA M40 SSA LDB ERRX 0-37, ERROR UNLESS... LDA CH CPA O11 LDB TBP CPA O176 LDA O33 CPA O33 JMP ALTMD STB PR ADA M72 SSA,RSS JMP LT 72-177, CHECK FOR LETTER. ADA O12 SSA JMP LSCG 0-57, NOT NUMBER OR LETTER. JSB BUMP PROCESS DIGIT JMP L1 ASCI NOP M40 OCT -40 M41 OCT -41 M72 OCT -72 O11 OCT 11 O176 OCT 176 O1000 OCT 1000 O3 OCT 3 O32 OCT 32 CRP DEF CR CAD DEF PLUS DSYMX DEF SYMX,I CONFIGURED ON 1ST ENTRY DSPP DEF DSPTB-40B EXPM NOP INSTR NOP LETF NOP LFP DEF LF SGN NOP PR NOP TBP DEF TAB UNL IFN LST O33 OCT 33 C3007 OCT 3007 JSBII JSB 0,I UNL XIF LST SKP * LT ADA M41 CHECK FOR LETTER LDB ALTMI CCE,SSA CH42 SEZ,SZB SZB: ALT MODE PRESENT? JMP LSET OPERATOR. ADA O32 SSA JMP LSCG 72-100 * L0 ISZ LETF PROCESS LETTER L ADA O12 MAKE SQOZE CODE L1 INA LDB CHC CPB O3 ISZ SYMX ADB M6 CH125 CLE,SSB,INB,RSS SSB,RSS: MORE THAN SIX CHARS? JMP LSR ISZ CHC ISZ CHI LDB SYMX,I TIMES 50 RBL,RBL ADB SYMX,I BLF,RBR ADB A STB SYMX,I USED AS CONSTANT LDA ASCI ALF,ALF ADA CH JMP LSR0 * LFCRT XOR C3007 SWAP CR AND LF STB PR JSB TYO LDA JSBII ISZ A DELAY TO LET... JMP *-1 C. R. COMPLETE. * LSET ADA M6 72-177 SSA,RSS CHECK FOR 141-177 JMP ERR YES, LOSE. LSCG LDB PR GET DISPATCH ADDRESS ADB LNEV CLA FOR MT,FT CH54 OCT 5254 SSB=RBL,SLB JMP PR,I NO-EVAL, DISPATCH NOW. CPA LETF IF NO LETTERS, JMP LSCI ANY OPERAND IS NUMERIC. LDB SYM+R SZB JMP NOTOP SKP OPLK LDB A SEARCH OP TABLE ADB OPPTR LDB B,I GET SYMBOL CPB SYM JMP OPFND INA SZB JMP OPLK * NOTOP JSB EVS EVALUATE SYMBOLIC TERM. JMP SGN,I DEFINED; GO COMBINE TERMS. LDA CH125 U - UNDEFINED JMP ERRP * OPFND ALF,RAR MOVE INDEX TO OP POSN kALF,CLE,SLA,ALF ALWAYS SKIPS: USED AS CONSTANT CPA IADR,I STA INSTR LSCI LDA ONM COMBINE OPERANDS JMP SGN,I PERFORM SIGN OPERATION. SKP * B U M P * * UPDATES CURRENT NUMERIC ENTRY * * LDA * JSB BUMP * P+1 * * BUMP NOP LDB ONM PROCESS DIGIT BLF,RBR SAVE CURRENT ADB A NUMBER AS STB ONM OCTAL LDB DNM SAVE RBL,RBL CURRENT ADB DNM NUMBER RBL AS ADB A DECIMAL STB DNM JMP BUMP,I HED NON-EVALUATION OPERATORS * DOT CPA CHC IF FIRST CHAR, ISZ LETF TREAT AS LETTER. LDB DNM STB ONM LDA O32 BECOMES SQOZE CODE. JMP L * DEL LDA CH130 X JMP ERRP * SYMO LDA O117 SYMBOL TABLE OVERFLOW RSS * BADP LDA CH120 P JSB TYO * ERR LDA O77 ? UNL IFN XIF BRK EQU ERR PNCH EQU ERR GO EQU ERR TABL EQU ERR TRACE EQU ERR VFY EQU ERR XEC EQU ERR LOAD EQU ERR ZRO EQU ERR SBRK EQU ERR USMAP EQU ERR UNL XIF LST ERRP JSB TYO OTST LDA TAS REGISTER OPEN? CPA LIMBO JMP LSE NO. JMP TABP YES. * ASCIN LDA ASCI ASCII INPUT JMP N1 * DAQ LDA LWT DEFINE SYMBOL AS ADDRESS JSB ADRC CLEARS E LDA B ELA,SLA,RAR CLEAR SIGN & SKIP * COLON LDA LOCP,I DEFINE SYMBOL AS LOCATION LDB LFLG SZB LDA LL LDB LETF CHECK SYMBOL SZB,RSS JMP ERR JSB DEFS JMP TABP O117 OCT 117 LWT NOP TAS DEF SYM ADDRESS OF OPEN REGISTER SKP * ALTMD LDA O134 BACKSLASH JSB TYO ECHO LDA O134 IF SET FOR A ESC GOBBLER LDB TMODE THEN SZB JSB TYO SEND TWO '\' 'S * ALT ISZ ALTMI JMP LSR * ECSL LDA TMODE 'U' CHANGE ESC DOUBLE '\' OPTION SZA CLA,RSS CCA STA TMODE JMP OTST * TMODE NOP INITIAL SET FOR NON '\' GRABBER * END OF ESSENTIAL NO-EVALS. * HED MISCELLANEOUS OPERATORS * KILL LDA ISEND KILL SYMBOLS STA STEND JMP LSE * MT INA FT ADA STED JMP N1 * BPM LDA PM STA BM JMP OTST * HT INA CT INA ST INA AT ADA STPPP LDA A,I USED AS CONSTANT STA PM SET MODE STA EXPM JMP OTST * QT LDA LWT JMP N1 * STAR LDA LOCP,I N1 CLB STB ALTMI ISZ CHI JMP LSQ RESET SYMBOL STUFF. * PFIX CCA UNPROTECT STA PFLAG STORES JMP LSF * LNEV DEF * END OF NO-EVALS. BM DEF NUMP STPPP DEF ADRPP LINK TO MASTER MODE TABLE PFLAG NOP PROTECT FLAG SKP * MINUS CMA,INA PLUS ADA WRD JMP WSET * COMMA IOR WRD WSET STA WRD RETURN HERE FROM SIGN OP. LDA PR LDB PR CPB CMADD IF COMMA SET COMMA FLAG STB CMFLG ADB LXEV CH57 OCT 5257 SSB=RBL,SLB. SKIP UNLESS SIGN OP JMP SSN SET SIGN FOR NEXT TIME. * LDA INSTR CHECK FOR PAGE ERROR CSNZA SZA,RSS JMP NAOP NOT ADDRESSABLE. LDA WRD AND G76 PAGE BITS? LDB A SAVE 'EM SZA,RSS JMP NAOP BASE PAGE. XOR IADR AND G76 CSZA SZA JMP BADP YOU CAN'T GET THERE FROM HERE. LDA O2000 PUT IN PAGE BIT. XOR B NAOP XOR WRD RESTORE LOCAL ADDRESS. ADA INSTR STA WRD CLB STB INSTR LDB CHI SZB,RSS LDA LWT STA LWT JMP PR,I DISPATCH TO PROCESSOR (EVALS) SKP * LXEVQ DEF * END OF COMBINING OPERATORS. * * BEGIN ESSENTIAL EVALS. * GRTR JSB DMCHK CHECK IF IN PARTITION STA UL LIMIT SET CSKP RSS * LSSN STA LL ISZ LFLG JMP LSS * RSET LDB A SET RADIX ADA M2 CH120 CLE,SSA JMP ERR ADA M40 SSA,RSS JMP ERR STB RADIX JMP LSE M2 OCT -2 O2000 OCT 2000 G76 OCT 76000 HED REGISTER EXAMINATION ASO LDA ASCPP PRINT AS ASCII JMP SETM * EXCL LDA INSPP PRINT AS INSTRUCTION JMP SETM * LARR LDA ADRPP PRINT AS ADDRESS JMP SETM * EQLS LDA NUMPP PRINT AS NUMBER SETM STA PR ONE TIME MODE SET LDB ALTMI SZB STA EXPM TEMP MODE SET LDA LWT JSB PR,I JMP TABP * SEMI JSB EXPM,I PRINT IN CURRENT MODE JMP TABP * EXASC LDB ASCPP EXAMINE AS ASCII JMP EXAM * EXI LDB ALTMI $ WITH NO ESC IS SYMBOL CHAR. CMB,INB,SZB ESC ENTERED?? JMP EXI1 YES GO ADJUST * LDA O33 NO PICK UP SQOZE '$' JMP L0 GO PROCESS SYMBOL * EXI1 CMB ESC $ IS PRINT AS INSTR., ESC ESC $ STB ALTMI IS SAME AS ESC / EXCEPT SET TMP. MODE LDB INSPP EXAMINE AS INSTRUCTION JMP EXAM * EXA LDB ADRPP EXAMINE AS ADDRESS JMP EXAM * NUMSN LDB NUMPP EXAMINE AS NUMBER JMP EXAM * PCT JSB STORE CLB STB CHI FOOL BAR LOGIC * BAR LDB EXPM USE TEMP MODE EXAM STB STORE SET IMMEDIATE MODE LDB ALTMI SZB JSB ADRC LDA LWT ELA,CLE,ERA PURGE INDIRECT BIT LDB CHI SZB,RSS ADDRESS SPECIFIED? JMP TA6 NO, USE LWT LDB STORE YES, SET TEMP MODE, TOO. STB EXPM JMP TA5 * TAB JSB STORE LDB ALTMI SZB JSB ADRC LDA LWT TA3 STA TAS JSB CRLF LDA TAS TA4 ELA,CLE,ERA 6PURGE INDIRECT BIT STA TAS JSB ADRP PRINT ADDRESS JSB TYO PRINT / LDB EXPM STB STORE SET TO USE TEMP MODE LDA TAS TA5 STA LOCP,I SET LOCATION COUNTER TA6 STA TAS STA IADR JSB DMCHK TEST IF IN PARTITION JSB PTAB UNL IFZ LST LDA ACCA B LOADED BY PTAB-TYO-TTYOP LDA TAS,I UNL XIF IFN LST LDA TAS CHECK IF IN A REG. CLE,ERA IF NOW ZERO THEN WAS 0 OR 1 CMA,CLE,INA SET E IF IN REG. LDA ACCA GET REG. TO A. B LOADED ABOVE SEZ SKIP LOAD IF POSSIBLE DM LDA TAS,I ELSE GET A OR B TO A SEZ IF ALREADY HAVE IT JMP TA7 SKIP CALL ON IGET * JSB IGET USE DISC READ ROUTINE TO LOAD DEF *+2 DEF TAS UNL XIF LST TA7 STA LWT JSB STORE,I PRINT CONTENTS TABP JSB PTAB JMP LSF2 * CR JSB STORE JMP LSF * UPARW JSB STORE CCA ADA LOCP,I DECREMENT LOCATION COUNTER JMP TA3 * LF JSB STORE CLA,INA NEXT LOCATION ADA LOCP,I JMP TA4 "/" OCT 57 SLASH SPACE OCT 40 "M" OCT 115 SKP * A "?" DISPATCHES HERE MSTAT JSB PTAB 3 SPACES LDA "M" M JSB TYO LDA "S" S JSB TYO LDA CH40 SPACE JSB TYO LDA "=" = JSB TYO LDA CH40 SPACE JSB TYO LDA M6 INITIALIZE STA TEMP1 COUNTER TO 6 RSA GET MEM STATUS MST01 STA TEMP2 SAVE ROTATED STATUS SSA IS BIT15=1? JSB ONE YES JSB ZERO NO LDA TEMP2 RESTORE ROTATED STATUS RAL ROTATE NEXT BIT ISZ TEMP1 DONE? JMP MST01 NO,CONTINUE ALF,ALF YES,GET RAL,RAL ORIGINAL A AND O1777 MASK BP FENCE LDB O10 WRITE BP FENCE JSB PN ON CONSOLE JSB PTAB 3 SPACES JMP LSF2 "=" OCT 75 "S" OCT 123 O10 OCT 10 O1777 OCT 01777 UNL IFZ LST SKP USMAP JSB CRLF CR LF JSB PTAB 3 SPACES USM01 JSB TTYOP GET 1ST OPERATOR INPUT CPA "A" ABORT? JMP USM02 YES CPA "CR" CR? JMP USMAP YES,NO ACTION CPA SPACE SPACE? JMP USM01 YES,IGNORE AND O177 SAVE 1ST ALF,ALF CHARACTER STA TEMP1 IN UPPER BYTE JSB TTYOP GET 2ND OPERATOR INPUT AND O177 FORM IOR TEMP1 WORD CPA "SM" SYSTEM MAPS? JMP SYSTM YES CPA "UM" USER MAPS? JMP USER YES CPA "XL" CROSS LOAD? JMP XLOAD YES CPA "PA" PORT A? JMP PORTA YES CPA "PB" PORT B? JMP PORTB YES JMP ERR NO,NOT DEFINED,ERROR USM02 JSB PTAB 6 JSB PTAB SPACES JMP LSF2 "PA" ASC 1,PA "PB" ASC 1,PB "SM" ASC 1,SM "UM" ASC 1,UM "XL" ASC 1,XL O20 OCT 20 O72 OCT 72 SKP USER LDA O72 : JSB TYO LDA USA JMP RMAP GET USER MAPS USE00 CLA SET UP INDEX STARTING AT 0 USE01 JSB SHMAP 2 MAPS CPA O20 DONE? RSS YES JMP USE01 NO,CONTINUE JSB CRLF CR LF JMP USMAP SYSTM LDA O72 : JSB TYO LDA SYA JMP RMAP GET SYSTEM MAPS SKP XLOAD CLA CLEAR STORE FLAG STA XADR CLEAR LAST ADDRESS LDA IMAPS GET SYSTEM MAPS JSB $LIBR ****PROTECT FOR OLD MX'S NOP SYA JSB $LIBX DEF *+1 DEF *+1 X01 JSB CRLF CR LF JSB PTAB 6 JSB PTAB SPACES LDA "XL" X ALF,ALF JSB TYO LDA "XL" L l JSB TYO JSB PTAB 3 SPACES JSB GETAD GET ADDRESS FROM OPERATOR JMP ERR INPUT ERROR CPB M1 ABORT? JMP USMAP SEE IF DONE SZB,RSS ANY CROSS OPERATION? JMP X01 NO,NO ACTION STA TEMP1 SAVE STA XADR ADDRESS JSB PTAB 3 SPACES ALF,RAL COMPUTE PAGE ADDRESS RAL AND O37 ADA IMAP LDA A,I GET MAP SSA READ PROTECTED JMP DMCK6 YES, GO TO DM ERROR LDA XADR RESTORE A XLA TEMP1,I CROSS LOAD JSB NUMP NO,DISPLAY CONTENTS JMP X01 SEE IF MORE CROSS OPERATIONS * PORTA LDA O72 : JSB TYO LDA PAA JMP RMAP READ PORT A MAPS PORTB LDA O72 : JSB TYO LDA PBA JMP RMAP GET PORT B MAPS * RMAP STA RMAP1 LDA IMAPS BUFFER ADDRESS,I JSB $LIBR UNPROTECT FOR OLD MX'S NOP RMAP1 NOP JSB $LIBX DEF *+1 DEF USE00 USA USA SYA SYA PAA PAA PBA PBA O37 OCT 37 UNL XIF LST SKP * G E T A D * * TAKE AN ADDRESS FROM OPERATOR * * JSB GETAD * P+1 * P+2 * GETAD NOP CLB ASSUME SIGN IS + INITIALLY STB ONM AND CLEAR CHARACTER COUNT STB DNM AND CLEAR OCTAL NUMBER STB CHC AND CLEAR DECIMAL NUMBER GETA5 JSB TTYOP TAKE 1ST CHARACTER CPA "A" ABORT? JMP GETA1 YES CPA "LF" LF? JMP GETA4 YES CPA "^" ^? JMP GETA7 YES CPA SPACE SPACE? JMP GETA5 YES,IGNORE IT RSS NO,TREAT 1ST CHARACTER AS NUMBER GETA2 JSB TTYOP TAKE NEXT NUMBER CPA "CR" DEFAULT? JMP GETA1 YES CPA "/" DONE? JMP GETA3 YES ADA M72 NO,CHARACTER SSA,RSS >71B? JMP GETAD,I YES,ERROR ADA O12 NO,CHARACTER SSA <60B? JMP GETAD,I YES,ERROR JSB BUMP UPDATE NUMBER'S VALUE LDA CHC CHARACTER CPA O5 COUNT ALREADY =5? JMP GETAD,I YES,THIS ONE MAKES IT AN ERROR ISZ CHC NO,BUMP CHARACTER COUNT JMP GETA2 CONTINUE GETA3 LDA ONM A=NUMBER RSS GETA1 CCB,RSS SET ABORT FLAG GETA6 LDB CHC SET UP DEFAULT FLAG ISZ GETAD ADJUST RETURN JMP GETAD,I GETA7 CCB,RSS GETA4 CLB,INB LDA XADR PREVIOUS SZA ADDRESS? JMP GETA8 CLB JMP GETAD,I NO,ERROR GETA8 ISZ CHC CLEAR ABORT FLAG LDA XADR DISPLAY ADA B ADJUST ADDRESS STA XADR JSB NUMP ADDRESS LDA "/" / JSB TYO LDA XADR A=ADDRESS=NUMBER JMP GETA6 "^" OCT 136 "LF" OCT 012 O5 OCT 05 * ONE NOP LDA O61 PRINT A 1 JSB TYO AND A SPACE LDA CH40 AND RETURN P+2 JSB TYO ISZ ONE JMP ONE,I * ZERO NOP LDA O60 PRINT A 0 JSB TYO AND A SPACE LDA CH40 JSB TYO JMP ZERO,I O60 OCT 60 O61 OCT 61 XADR NOP UNL IFZ LST HED NUMBER AND SYMBOL PRINT SKP * S H M A P * * DISPLAYS 2 MAP VALUES ON CONSOLE * * LDA * LDB * JSB SHMAP * P+1 * SHMAP NOP STA TEMP1 SAVE INDEX JSB CRLF CR LF JSB PTAB 6 JSB PTAB SPACES LDA TEMP1 PRINT MAP LDB O10 REGISTER # JSB PN ON CONSOLE LDA TEMP4 SINGLE ADA M2 CHARACTER SSA,RSS MAP REG. #? JMP SHM01 NO LDA SPACE YES,NEED AN JSB 5TYO ADDITIONAL SPACE SHM01 LDA "=" = JSB TYO LDA TEMP1 GET MAP ADA IMAP REGISTER LDA A,I VALUE LDB O10 WRITE IT ON JSB PN THE CONSOLE LDA TEMP4 NEGATE # OF CHARACTERS ADA M6 <6 THAT WERE IN THE STA TEMP4 NUMBER JUST DISPLAYED SSA,RSS 6 CHARACTERS? JMP SHM02 YES SHM03 LDA SPACE NO,NEED JSB TYO ADDITIONAL ISZ TEMP4 SPACES JMP SHM03 SHM02 JSB PTAB 3 SPACES LDA TEMP1 PRINT MAP ADA O20 REGISTER #+16 LDB O10 ON CONSOLE JSB PN LDA "=" = JSB TYO LDA TEMP1 GET MAP ADA O20 REGISTER ADA IMAP +16 LDA A,I VALUE LDB O10 WRITE IT ON JSB PN THE CONSOLE LDA TEMP1 LEAVE INA INDEX+1 JMP SHMAP,I IMAPS DEF MAPS,I IMAP DEF MAPS MAPS BSS 32 UNL XIF LST SKP * G E T N M * * TAKES OPERATOR NUMERICAL INPUT * * LDA * JSB GETNM * P+1 * P+2 * GETNM NOP JSB NUMP DISPLAY OLD VALUE JSB PTAB 3 SPACES GET05 JSB TTYOP TAKE 1ST CHARACTER CLB ASSUME SIGN IS + INITIALLY STB CHC AND CLEAR CHARACTER COUNT STB ONM AND CLEAR OCTAL NUMBER STB DNM AND CLEAR DECIMAL NUMBER CPA "A" ABORT? JMP GET01 YES CPA SPACE SPACE? JMP GET05 YES,IGNORE IT CPA NEG IS IT -? INB YES,SET - FLAG STB NMFLG SAVE + OR - FLAG CPA POS IS IT +? RSS YES SZB NO,1ST CHARACTER TREATED AS 1ST NUMBER? GET02 JSB TTYOP GET CHARACTER CPA "CR" DONE? JMP GET06 YES ADA M72 NO,CupHARACTER SSA,RSS >71B? JMP GETNM,I YES,ERROR ADA O12 CHARACTER SSA <60B? JMP GETNM,I YES,ERROR JSB BUMP UPDATE NUMBER'S VALUE LDA CHC CHARACTER COUNT CPA O6 ALREADY = 6? JMP GETNM,I YES,THIS ONE MAKES IT AN ERROR ISZ CHC NO,BUMP CHARACTER COUNT JMP GET02 CONTINUE GET06 LDA ONM A=NUMBER LDB NMFLG NEGATIVE SZB,RSS NUMBER? JMP GET04 NO,POSITIVE,LEAVE IT ALONE CMA,INA,RSS YES GET01 CCB,RSS SET ABORT FLAG ON EXIT GET04 LDB CHC SET UP DEFAULT FLAG ON EXIT ISZ GETNM ADJUST RETURN JMP GETNM,I O6 OCT 6 POS OCT 53 NEG OCT 55 SKP * STORE NOP UNL IFN LST SZB ANYTHING TYPED?? JMP MPMSG REMIND HIM WE CANN'T DO IT * UNL XIF IFZ LST SZB,RSS ANYTHING TYPED? JMP STORX NO, RETURN. * LDB CLEFG WAS CLE FLAG SET SZB,RSS JMP STORW NO JUST GO STORE IT LDB A AND O2000 YES,WHICH GROUP SZA ADA O40 SRG CLE=2100B ADA O40 ASG CLE=40B IOR B AND MERGE WITH INSTRUCTION * STORW STA TEMP3 SAVE VALUE LDB PFLAG UNPROTECT SZB THE STORE? JMP STORZ LDA TAS NO CHECK FOR MP SZA A OR B REGISTER CPA O1 JMP STORY YES, STORE IT JSB MPCHK CHECK FOR MP & DM ERROR JMP MPMSG GO PRINT "MP?" STA IADR JSB ADCHK CHECK FOR DBUGR OVERWRITE JMP STORY OK TO STORE STORZ JSB $LIBR YES,GO NOP PRIVELEGED STORY LDB TAS SZB,RSS STORE TO A REG LDB DACCA YES GET PHONY A REG ADDRESS STB TAS LDA TEMP3 RESTORE VALUE LDB ACCB RESTORE B STA TAS,I STB ACCB LDB PFLASG JUST STORE SZB,RSS UNPROTECTED? JMP STORX NO,GO ON JSB $LIBX YES,GO DEF *+1 UNPRIVELEGED DEF STORX UNL XIF LST STORX LDB LIMBO STB TAS CLOSE REGISTER JMP STORE,I UNL IFZ LST HED BREAKPOINT * BRK SZB USER ENTER ADDRESS? JMP BRK1 YES,SEE IF VALID FOR BREAKPOINT LDA LIMBO NO,USE CURRENT ADDRESS BRK2 STA BPADR SET BREAKPOINT ADDRESS JMP LSE BRK1 STA TEMP4 SAVE ADDRESS JSB MPCHK CHECK FOR MEMORY PROTECT JMP MPMSG GO PRINT ERROR STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP LDA A,I GET INSTRUCTION JSB AHEAD NO,VALID FOR BREAKPOINT? JMP PR9 NO,DON'T ALLOW IT LDA TEMP4 YES,RESTORE ADDRESS JMP BRK2 * TRAP NOP STA ACCA SAVE A LDA BADD,I GET VALUE TO BE TESTED XOR BVAL TEST VALUE AND BMSK MASK VALUE SZSKP RSS JMP BIXI LDA ACCA ISZ CHC PROCEED COUNT JMP BIX JSB SVST CCA ADA TRAP JSB BRKMS GO DO BREAK MESSAGE JSB PTAB JMP LSF2 G24 OCT 24000 RSS RSS BIXI LDA ACCA JMP BIX SKP * ************************************************************************ * * ROUTINE .SDBG: * * .SDBG PROVIDES A SPECIAL ENTRY POINT TO DBUGR FOR SEGMENTED * PROGRAMS LOADED ON-LINE USING THE RTE-IV RELOCATING LOADER. * THE LOADER INSERTS THE FOLLOWING SUBROTINE(*.STDB*)FROM THE * SYSTEM LIBRARY WITH EACH SEGMENT: * * EXT .SDBG * ENT .DBSG,.STDB * .STDB JSB .SDBG * .DBSG NOP * END .STDB * * THE LOADER PLACES THE ACTUAL ENTRY POINT ADDRESS FOR THE SEGMENT * INTO *.DBSG*. THE SEGMENT'S ID SEGMENT'S ENTRY POINT IS SETUP * TO POINT TO *.STDB*. THIS EFFECTIVELY INSERTS DBUGR JUST BEFORE * ENTRY INTO THE SEGMENT. * * THE MESSAGE 'SEGMENT BREAK' IS PRINTED AND A PSUEDO BREAKPOINT * OCCURS AT THE SEGMENT'S ENTRY POINT ADDRESS. IF * THE CURRENT TRUE BREAKPOINT IS WITHIN THE OLD SEGMENT(E.G., ABOVE * THE MAIN'S LAST WORD), THEN THE MESSAGE 'BREAKPOINT REMOVED' IS * ALSO ISSUED. FINALLY, DBUGR CONTINUES AND GETS THE NEXT * DEBUG COMMAND. * * WHEN A PROCEED COMMAND OCCURS, DBUGR WILL CONTINUE AT THE ENTRY * POINT OF THE SEGMENT. * ************************************************************************ * .SDBG NOP * JSB SVST SAVE STATUS OF SYSTEM. * LDX O5 GET SEGMENT NAME LDA ACCA ADA O14 RAL MAKE BYTE ADDRESS LDB SNAME DESTINATION ADDRESS RBL MAKE BYTE ADDRESS MBF GET NAME FROM SYSTEM MAPS * LDA .SDBG,I STA DDOT SAVE RETURN ADDRESS STA TRAP LDB XB COMPUTE ADDRESS ADB O15 OF 'HIGH MAIN+1'. XLB B,I DETERMINE IF OLD BREAKPOINT IS CMB,INB ABOVE END OF MAIN PROGRAM-- ADB BPADR E.G., WITHIN THE OLD SEGMENT. SSB IF OLD BREAKPOINT IS WITHIN JMP SDBG1 LDB BPADR IF BP IN SEGMENT LDA LIMBO THEN MUST REMOVE STA BPADR LDA OLDBK AND FIX WIPED OUT INSTRUCTION STA B,I * SDBG1 STB SDTMP SAVE OLD BPADR LDA SBNAM IS IT THIS SEGMENT LDB SNAME CMW O3 JMP SDBG4 NOP * LDA SBNM1 LDB SDTMP FETCH OLD BPADR SSB IF BP NOT IN SEGMENT OR CPA M1 DONT STOP FOR ALL SEGMENTS RSS JMP SDBG6 THEN CONTINUE CCA SET SEGMENT BREAK FLAG STA SBFLG * SDBG3 LDA DDOT JSB BRKMS PRINT BREAK MESSAGE JSB CRLF * LDA SDTMP WAS BREAKPOINT REMOVED SSA JMP LSE NO,GO GET NEXT COMMAND JSB ADRP YES,PRINT 'S+XXXXX g LDB PNOBK BREAKPOINT REMOVED!' JSB OUTMS JMP LSE AND GET NEXT COMMAND * SDBG4 CCA SET SEGMENT BREAK FLAG STA SBFLG LDA SGA IS THIS A SEGMENT BREAK SZA,RSS JMP SDBG5 YES GO BREAK * LDA SGA,I NO,IS BREAKPOINT LEGAL JSB AHEAD JMP SDBG5 NO ,GO BREAK LDA SGA YES,SET AND LDB BPADR STB SDTMP SET FOR BP REMOVED MESSAGE STA BPADR CPB LIMBO IF SAME AS PREVIOUSLY RSS SET THEN CONTINUE JMP SDBG3 ELSE BREAK SDBG6 JSB RSST RESTORE STATUS JMP TRAP,I * SDBG5 CCA CLEAR BREAKPOINT REMOVED FLAG STA SDTMP JMP SDBG3 GO PRINT SEGMENT BREAK UNL XIF LST SGA BSS 1 SGB BSS 1 SBFLG OCT 0 SBNAM DEF SBNM1 SBNM1 OCT 0 ASC 2, BYADD BSS 1 BLKBL ASC 1, "]" OCT 135 "B" OCT 102 SDTMP BSS 1 OLDBK BSS 1 O14 OCT 14 * UNL IFZ LST XB EQU 1732B SNAME DEF SNAM1 PSGMS DEF SGMSG SGMSG OCT 6412 CR/LF. ASC 4,SEGMENT SNAM1 ASC 3, ASC 3,BREAK OCT 6412 CR/LF. ASC 1,// * PNOBK DEF NOBKM NOBKM ASC 12, BREAKPOINT REMOVED! OCT 6412 CR/LF. ASC 1,// SKP * * * THIS ROUTINE SETS UP BREAKPOINT WITHIN * A SEGMENT * SBRK STA SGA SAVE A & B STB SGB SZB,RSS IF ADDRESS SUPPLIED JMP SBRK0 JSB MPCHK CHECK FOR MP VIOLATION JMP MPMSG STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP SBRK0 LDB SBNAM COMPUTE BYTE ADDRESS RBL STB BYADD LDB BLKBL FILL WITH BLANKS STB SBNM1 STB SBNM1+1 STB SBNM1+2 * LDA M5 SET CHAR COUNT STA SDTMP SBRK1 JSB SBRK6 READ CHAR CPA "]" CHECK FOR END JMP SBRK3 LDB BYADD STORE CHAR SBT ISZ BYADD ISZ SDTMP NAME COMPLETE JMP SBRK1 NO CONTINUE * SBRK2 JSB SBRK6 IGNOR ALL EXCEPT "]" CPA "]" RSS JMP SBRK2 SBRK3 JSB SBRK6 NOW LOOK FOR ESCAPE,\ OR ^ CPA O176 LDA O33 CPA O33 JSB SBRK5 GO SEND BACKSLASH CPA O134 RSS JMP ERR IF NONE OF ABOVE THEN ERROR JSB SBRK6 NOW LOOK FOR "B" CPA "B" RSS JMP ERR * * NOW WE HAVE GOOD COMMAND * LDA SBNM1 IF NO NAME ASSUME "0" CPA BLKBL RSS CPA ""N" FIX FIRST WORD FOR ALL CLA CPA ""A" OR NONE CCA STA SBNM1 * LDA SBNAM LDB SNAME CMW O3 JMP SBRK4 GO TO NORMAL BREAK NOP LDB SGB WAS ADDRESS SUPPLIED SZB,RSS STB SGA NO,SET ADDRESS TO ZERO FOR JMP LSE SEGMENT BREAK THEN GO GET * NEXT COMMAND * SBRK4 LDA SGA RESTORE A & B LDB SGB JMP BRK AND GO TO NORMAL BREAK * SBRK5 NOP LDA O134 BACKSLASH JSB TYO ECHO LDA O134 LDB TMODE IF SET FOR ESC GOBBLER SZB JSB TYO SEND SECOND BACKSLASH ISZ SBRK5 ADJUST RETURN JMP SBRK5,I M5 OCT -5 ""N" ASC 1,"N * SBRK6 NOP READS CHAR AND CHECKS FOR RUBOUT JSB TTYOP CPA RUB JMP DEL JMP SBRK6,I RUB OCT 177 * ""A" ASC 1,"A SKP * PROC SZB,RSS CLA,INA $P=$1P CMA,INA STA CHC SET PROCEED COUNT LDB DDOT POINT BACK TO STB TRAP LAST ADDRESS LDB BPADR GET THE TRAP ADDRESS CPB TRAP IF RETURNING TO TRAP JMP PR01 SKIP TEST FOR INA,SZA PROCEED COUNT JMP ERR MUST BE 1 FIRST TIME LDA RSS STA SZSKP LDA ALTMI IF SINGLE ESCAPE CPA O1 JMP PRNA OK TO CONTINUE JMP ERR PR01 LDB SKP 2GET SKIP (SZA OR SZA,RSS) LDA ALTMI IF SINGLE ESCAPE CPA O1 LDB RSS PUT IN UNCONDITIONAL SKIP STB SZSKP PR3 ISZ TRAP STEP OVER THE INTERPITED INSTR. LDB BKIA STB IADR FOR ADRC LDA BIX02 RESTORE JMP IN CASE STA BIX01 2 WORD INSTRUCTION LDA BKIA,I FETCH BROKEN INSTRUCTION JSB AHEAD VALID INSTRUCTION FOR EXECUTION JMP PR5 NO,BACK UP PR1 JSB ADRC CALCULATE REAL ADDRESS JMP MAC NOT ADDRESSABLE: GO TEST FOR MAC GROUP PR0 STA SYMX ACTUAL ADDRESS LDA B RETRIEVE INSTRUCTION AND G74 GET OPCODE CPA G24 IF JMP INSTRUCTION GO JMP TRJMP TEST FOR TRACING CPA JSBI JSB INSTRUCTION? CCB,RSS YES. FAKE IT. JMPI JMP PR2 NOT JSB. LDA SYMX GO GET THE DIRECT ADDRESS JSB DIRA STA OPADD SAVE ADDRESS FOR RETURN CLB,INB CACULATE THE RETURN ADDRESS ADB BKIA STB RTADD SAVE RETURN ADDRESS STB A,I FAKE RETURN ADDRESS INA YES STEP BY ONE TO GET JMP TARGET STA OPADD+1 SAVE TARGET ADDRESS FOR JMP LDB TRAC TRACING? SZB,RSS LDA JSBXQ NO CANGE EFFECTIVE ADDRESS LDB JMPI GET JMP INSTRUCTION JMP PR0 GO SET IT UP PR5 LDA RDWD GET TRACE ADDRESS CPA XE1C EXECUTE MODE? LDA PAC YES STA BKIA RESTORE THE STA IADR ADDRESS JSB CRLF CR LF LDA IADR JSB BRKMS BREAK MESSAGE SKP PR9 JSB PTAB 3 SPACES LDA CH111 I JSB TYO LDA "N" N JSB TYO JMP ERR PR2 IOR DSYMX USING SAVED ADDRESS STA BIX STORE INSTRUCTION PR4 JSB CRLF JSB RSST RESTORE STATUS BIX STA SYMX,I USED TO GET ADDRESS OF SYMX,I BIX01 JMP TRAP,I RETURN TO INTERRUPTED CODE ISZ TRAP INSTRUCTION PERFORMED SKIP BIX02 JMP TRAP,I "N" OCT 116 BKI NOP HOLDS BROKEN INSTRUCTION BKIA DEF SYM ADDRESS OF BROKEN INSTRUCTION JSBI JSB 0 JSBII JSB 0,I * PRNA CPB LIMBO GIVING UP CONTROL? JSB BYE YES, PRINT END MESSAGE JSB CRLF CONTINE JSB RSST JMP DDOT,I * * JSB EXECUTE * JSBXQ DEF *+1 STA ACCA SAVE A REG LDA RTADD STA OPADD,I SET RETURN ADDRESS LDA ACCA RESTORE A REG JMP OPADD+1,I AND EXECUTE JMP * OPADD BSS 2 RTADD BSS 1 SKP * * RESTORE STATUS ROUTINE * RSST NOP LDA BPADR,I SAVE BREAK INSTRUCTION STA BKI LDA LTRAP GET THE TRAP JSB IOR JSBII STA BPADR,I PLANT TRAP * LDB DIDTP RESTORE PROGRAM'S TEMP WORDS STB CRLF TO ITS ID SEGMENT. LDB IDWD1 JSB $LIBR NEED TO GO PRIVILEGED NOP TO DO THIS RESTORE. PR10 LDA CRLF,I RESTORE ID XSA B,I SEGMENT ISZ CRLF WORDS 1 INB TO 5. CPB IDWD6 RSS DONE. JMP PR10 JSB $LIBX LET'S GO DEF *+1 UNPRIVILEGED. DEF *+1 * LDB ACCB RESTORE LDX ACCX MACHINE LDY ACCY STATE LDA FLGBX CLF 1 CLEAR OFLOW O33 SLA,RAR STF 1 TURN IT ON ERA RESTORE E-BIT LDA ACCA JMP RSST,I CH111 OCT 1511 SKP * MAC STA BIX SET INSTRUCTION AND M1100 =B176700 CPA HLT IF A HLT JMP MPMS THEN GO PRINT MP MESSAGE AND M6000 =B172000 CPA HLT IF AN IO INSTRUCTION JMP IO THEN GO CHECK S.C. MAC00 LDA BIX ELSE RESTORE A WITH BIX JSB GET2 2 WORD INSTRUCTION? JMP PR4 NO,GO SET UP INSTRUCTION LDA BKIA YES,SET ADDRESS INA STEP TO MAC ADDRESS RAL,ERA g OF SECOND WORD STA BIX01 FOR BIX LDA BIX GET INSTRUCTION CPA JPY JPY? JMP PR6 YES,GO FIX JPY CPA JLY JLY? JMP PR11 YES,GO FIX JLY JMP PR4 NO,GO FINISH THE SET UP PR6 LDY ACCY BE SAFE LDA BIX01 GET 2ND WORD ELA,CLE,ERA ELIMINATE LDA A,I ADDED INDIRECT ADA ACCY FORM DESTINATION ADDRESS JMP PR12 PR11 LDA BKIA SET UP ADA O2 ACTUAL STA ACCY Y LDA BIX01 ELA,CLE,ERA ADA MUPBD TEST FOR DM ERROR SSA,RSS JMP DMCK5 BAD GO PRINT MESSAGE ADA UPBD GOOD SZA,RSS LDA DACCA GET PHONY A REG LDA A,I GET INDIRECT ADDRESS JSB DIRA GET TARGET ADDRESS PR12 LDB TRAC SZB,RSS TRACING? JMP PR2 NO,GO SET UP STA TEMP3 SAVE A JSB CRLF CR LF LDA TEMP3 RESTORE A JMP TRMS SET AND PRINT O2 OCT 2 * IO LDA BIX GET INSTUCTION AND O77 CPA O1 IF S.C. = 1 JMP MAC00 THEN OK JMP MPMS ELSE GO PRINT MP MESSAGE * M1100 OCT 176700 M6000 OCT 172000 SKP * XEC SZB,RSS "EXECUTE" COMMAND JMP ERR LDB TRAP SAVE TRAP INFORMATION STB PAC INCASE WE ARE IN LDB BKIA A BREAK STB ADCK LDB XE1C STB BKIA IF JSB, RETURN TO XE1. STB TRAP OTHERS RETURN TO XE1 JSB AHEAD VALID INSTRUCTION FOR EXECUTION? JMP PR9 NO,NOT ALLOWED STA TEMP2 YES,SAVE INSTRUCTION JSB GET2 2 WORD INSTRUCTION? RSS NO JMP PR9 YES,NOT ALLOWED LDA TEMP2 RESTORE INSTRUCTION JMP XE2 EXECUTE AT BIX * GO SZB,RSS JMP ERR STA TRAP SET ADDRESS LDA BIX02 RESTORE JMP IN CASE STA BIX01 2 WORD INSTRUCTION CLA S MAKE A NO-OP XE2 CCB STB CHC PROCEED COUNT=1 JMP PR1 * XE1C DEF XE1 XE1 JMP XE3 NOT SKIP JSB SVST SKIP JSB CRLF RSS * XE3 JSB SVST LDA PAC RESTORE BREAK STA TRAP LDA ADCK CONDITIONS STA BKIA JMP LSE UNL XIF IFN LST PROC JSB BYE SEND BYE MESSAGE JMP .DBUG,I AND EXIT UNL XIF LST HED BREAKPOINT AND TRACE ROUTINES * ADRC NOP GET ADDRESS OF INSTRUCTION LDB A AND G70 CLE,SZA,RSS JMP ADRCX NON-ADDRESSABLE. ISZ ADRC SET SKIP RETURN LDA B AND O2000 PAGE BIT SZA LDA IADR GET PROPER PAGE XOR B AND G76 ADRCX XOR B JMP ADRC,I UNL IFZ LST * * A H E A D * * CHECKS INSTRUCTION ABOUT TO BE EXECUTED TO SEE IF * THE INSTRUCTION IS ALLOWED FOR EXECUTION * * LDA * JSB AHEAD * P+1 * P+2 * AHEAD NOP STA TEMP1 AND DSMSK IF DOUBLE SHIFT CPA ASL JMP AHE02 CPA LSL JMP AHE02 CPA RRL JMP AHE02 * AND M6000 OR IOG CPA HLT JMP AHE02 * AND G70 OR MRG SZA JMP AHE02 * LDA TEMP1 OR SRG OR ASG SSA,RSS JMP AHE02 * ELSE CHECK REST LEGAL OPCODES LDB PNT08 POINT TO START OF TABLE AHE01 CPA B,I GOT A MATCH? JMP AHE02 YES, VALID FOR DDT ADB O3 NO,BUMP POINTER CPB PNT09 DONE? JMP AHEAD,I YES,NOT VALID JMP AHE01 NO,CONTINUE * AHE02 LDA TEMP1 RESTORE INTRUCTION ISZ AHEAD ADJUST RETURN JMP AHEAD,I PNT08 DEF RRL+3 LINK TO START OF REST OF VALID'S PNT09 DEF IVINS LINK TO START OF INVALID INSTR؈'S SKP * BRKMS NOP PRINT BREAK MESSAGE STA DDOT SAVE THE TRAP ADDRESS LDA SBFLG PRINT SEGMENT BREAK? SZA,RSS JMP BRKM1 CLA STA SBFLG CLEAR FLAG LDB PSGMS PRINT 'SEGMENT NAME0 BREAK' JSB OUTMS MESSAGE BRKM1 LDA DDOT RESTORE A JSB ADRP LDA SRDX JSB TYO ( JSB PTAB A FEW SPACES LDA DDOT,I NOW THE INSTRUCTION JSB INSTP IN SYMBOLIC JSB PTAB PUT IN SOME SPACES LDA SRDX INA JSB TYO ) JSB PTAB MORE SPACES LDA ACCA A REG. JSB BM,I JSB PTAB MORE SPACES LDA ACCB B REG. JSB BM,I JSB PTAB YET MORE SPACES LDA ACCX X REG. JSB BM,I JSB PTAB MORE SPACES LDA ACCY Y REG. JSB BM,I JSB PTAB MORE SPACES LDA FLGBX E,O,INT STA LWT SET LAST WORD TYPED JSB NUMP JMP BRKMS,I UNL XIF LST SKP * SRDX OCT 50 * B Y E * * PRINTS END MESSAGE * BYE NOP STA TEMP5 SAVE A STB TEMP6 SAVE B LDB SBNM1 IS SEGMENT BREAK SET SZB JMP BYE1 YES,DONT PRINT MESSAGE LDB PNT11 ISSUE 'END DBUG' JSB OUTMS MESSAGE. BYE1 LDA TEMP5 RESTORE A LDB TEMP6 RESTORE B JMP BYE,I TEMP5 BSS 1 TEMP6 BSS 1 PNT11 DEF MSG04 MSG04 OCT 6412 ASC 17,END OF DEBUG MODE OCT 6412 CR LF ASC 1,// SKP * ******************************************************************* * * SUBROUTINE OUTMS: * * OUTMS WILL OUTPUT A MESSAGE WHICH TERMINATES WITH A '//' AND * CONTAINS NO INTERNAL /'S. * * CALLING SEQUENCE: * LDB POINTER TO FIRST WORD OF MESSAGE * JSB OUTMS * * RETURN: * ALL REGISTERS ARE DESTROYED. * ******************************2X************************************* * OUTMS NOP CLA INITIALIZE TO LEFT BYTE STA TEMP1 OF MESSAGE STRING. STB TEMP2 SAVE STRING'S ADDRESS. OTMS1 LDA TEMP2,I GET WORD FROM STRING. LDB TEMP1 GET SLB,RSS APPROPRIATE ALF,ALF BYTE. AND O177 MASK OFF CHARACTER. CPA "/" IF FOUND A "/", THEN END JMP OUTMS,I OF MESSAGE, SO RETURN. JSB TYO OTHERWIZE, PRINT LATEST LDB TEMP1 CHARACTER. SLB IF BYTE COUNT IS ODD, THEN ISZ TEMP2 BUMP WORD POINTER. ISZ TEMP1 INCREMENT BYTE COUNTER JMP OTMS1 AND RETURN FOR MEXT BYTE. SKP UNL IFZ LST * MPCHK NOP MEMORY PROTECT & DM CHECK JSB DMCHK GO RESOLVE INDIRECTS LDB 1775B CHECK FOR MEMORY PROTECT ERROR CMB,INB SUBTRACT FENCE FROM ADB A ADDRESS SSB,RSS IF OK RETURN +1 ISZ MPCHK JMP MPCHK,I ELSE RETURN * DIRA NOP DIRECT ADDRESS TRACK DOWN JSB MPCHK RSS MP ERROR JMP DIRA,I OK RETURN MPMS CCA BACK OUT THE INTERPIT STEP ADA TRAP RESTORE CONDITIONS CPA TRTN TRACING LDA RDWD YES GET TRACE ADDRESS CPA XE1C EXECUTE INSRT? LDA PAC YES RESTORE STA BKIA RESTORE THE ADDRESS STA IADR JSB CRLF RETURN THE CARRAGE LDA IADR JSB BRKMS SEND A BREAK MESSAGE JSB PTAB SEPERATE THE MP? UNL XIF LST MPMSG LDA "M" FETCH AN M JSB TYO PUT IT OUT JMP BADP FOLLOW IT WITH A P? DACCA DEF ACCA POINTER TO A-REG CONTENTS SKP * G E T 2 * * SEARCHES DOUBLE WORD INSTRUCTIONS TABLE TO SEE IF * CURRENT INSTRUCTION IS DEFINED THERE. * * LDA * JSB GET2 * P+1 *  P+2 <2 WORD INSTRUCTION,A=SQOZE CODE> * GET2 NOP STA TEMP1 SAVE INSTRUCTION LDB PNT07 POINT TO DOUBLE WORD INSTRUCTIONS MAC02 CPB DSTOP DONE? JMP GET2,I YES,GO FINISH THE SET UP ADB O2 POINT TO OPCODE IN SYMBOL TABLE LDA B,I GET OPCODE CPA TEMP1 DOUBLE WORD INSTRUCTION? JMP MAC01 YES,SET UP FOR 2 WORD INSTRUCTION INB NO,POINT TO NEXT ENTRY JMP MAC02 CONTINUE LOOKING MAC01 ADB M2 POINT BACK TO ENTRY LDA B,I GET SQOZE CODE ISZ GET2 ADJUST RETURN JMP GET2,I DSTOP DEF STTP2 LINK TO END OF 2 WORD INSTR SECTION PNT07 DEF DOUBL LINK TO 2 WORD INSTR SECTION UNL IFZ LST SKP * SVST NOP STX ACCX SAVE STY ACCY REGISTERS STB ACCB STA ACCA CLA ELA,RAL SAVE E-BIT. SOC OVERFLOW ON? INA YES. STA FLGBX LDA BPADR,I SAVE IN CASE OF SEGMENT LOAD STA OLDBK AND MAY WIPE GOOD INSTRUCTION LDA BKI STA BPADR,I RESTORE BROKEN INSTRUCTION LDA BPADR STA BKIA WHERE BROKEN INSTRUCTION WAS STA IADR FOR PRINT LDA BIXS RESTORE THE DOUBLE WORD INSTRUCTION SZA IF NOT SET UP SKIP STA BIX01 LDA BIX01 SET UP STA BIXS * LDB DIDTP SAVE PROGRAM'S TEMP WORDS STB CRLF FROM ITS ID SEGMENT. LDB IDWD1 SVST5 XLA B,I SAVE ID STA CRLF,I SEGMENT'S ISZ CRLF WORDS 1 INB TO 5. CPB IDWD6 JMP SVST,I DONE! JMP SVST5 BIXS NOP HOLDS COPY OF 2ND WORD BEFORE RETURN IDWD1 EQU 1721B ID SEGMENT WORD 1 IDWD6 EQU 1726B ID SEGMENT WORD 6 DIDTP DEF IDTMP POINTER TO BUFFER FOR SAVING IDTMP BSS 5 ID SEGMENT'S TEMP WORDS. UNL XIF LST UNL IFZ  LST HED TRACE ROUTINE TRACE SZB,RSS MAKE A ZERO CLA,INA INTO A 1 CMA,INA SET NEG FOR STA TRAC COUNT AND SET TRNX LDA DDOT STA IADR JSB ADCHK CHECK FOR DBUGR OVERLAP STA RDWD SAVE TRAP LOCATION STA BKIA SET FOR PROCEED LDA TRTN SET RETURN ADDRESS STA TRAP CCA SET PROCEED COUNT FOR STA CHC POSSIBLE JSB TEST JMP PR3 GO EXECUTE THE INSTRUCTION TRTN DEF * RETURN DEFINATION RSS NO SKIP ISZ RDWD SKIP STEP THE ADDRESS ISZ RDWD TWO TIMES IF SKIP JSB SVST SAVE THE STATE LDA RDWD GET THE NEW ADDRESS TRMS STA BKIA RESTORE CONDITIONS STA IADR SET ADDRESS FOR PRINT JSB BRKMS WRITE THE BREAK MESSAGE ISZ TRAC END OF TRACE? JMP TRNX NO CONTINUE JSB PTAB 3 SPACES JMP LSF YES GO GET NEXT COMMAND. * TRJMP LDB TRAC TRACING? SZB,RSS JMP PR2 NO GO SET UP JSB CRLF SEND CARRAGE RETURN LINEFEED LDA SYMX YES JUST UP DATE JSB DIRA THE ADDRESS (MAKE DIRECT) JMP TRMS GO SET AND PRINT UNL XIF LST HED SEARCH ROUTINES * EAS LDA CSKP STA WSD WDS LDA CSZA CH130 CLE,SSA,SLA ALWAYS SKIPS * NWS LDA CSNZA SZB,RSS JMP ERR STA WSTST JSB CRLF LDA LL STA IADR WSL JSB ADCK SEE IF DONE JMP WSIDX IN DEBUG, IGNORE UNL IFZ LST LDA IADR,I UNL XIF IFN LST JSB IGET GET WORD FROM DUMP DEF *+2 DEF IADR UNL XIF LST WSD NOP SKIP IF EFFECTIVE ADDR. JMP WSC * JSB ADRC JMP WSIDX NOT ADDRESSABLE. JSB DMCK GO RESOLVE INDIRECTS JMP WSIDX TOO MANY INDIRECTS NOP  DM ERROR * WSC XOR WRD AND MSK WSTST NOP SZA OR SZA,RSS JMP WSIDX JSB PAC PRINT ADDRESS AND CONTENTS JSB CRLF WSIDX ISZ IADR JMP WSL * * * DM AND MULTIPLE INDIRECT CHECK * * INPUT: A REG=INDIRECT ADDRESS * * OUTPUT: A REG=DIRECT ADDRESS * B REG=ACCB * DMCHK NOP JSB DMCK JMP DMCK3 GO PRINT INDIRECT ERROR JMP DMCK4 GO PRINT DM ERROR JMP DMCHK,I RETURN * * LDA ADDR * JSB DMCK * * * * * OUTPUT: A REG=DIRECT ADDRESS * B REG=ACCB * DMCK NOP LDB M20 SET UP INDIRECT COUNT STB DMCNT LDB ACCB SET UP B REG JMP DMCK1 GO TEST ADDRESS * DMCK0 ISZ DMCNT RSS JMP DMCK,I YES,ERROR 1 RETURN * SZA,RSS TRYING TO USE A REG LDA DACCA YES,GET PHONY A REG ADA MUPBD TEST FOR UPPER BOUND SSA,RSS (DM ERROR) JMP DMCK2 ERROR RETURN ADA UPBD GOOD THEN CORRECT A STA DMCKT JSB IGET DEF *+2 DEF DMCKT DMCK1 RAL,CLE,SLA,ERA IS IT IN DIRECT? JMP DMCK0 YES,GO GET NEXT LEVEL ADA MUPBD NO,CHECK FOR DM ERROR SSA ISZ DMCK BUMP ONE MORE FOR GOOD DMCK2 ADA UPBD RESTORE A REG ISZ DMCK JMP DMCK,I * "I" OCT 111 DMCKT NOP M20 OCT -20 DMCNT BSS 1 * DMCK3 LDA "I" JSB TYO PRINT "I?" JMP ERR * * DMCK5 ADA UPBD RESTORE A DMCK4 JSB NUMP PRINT DM? ERROR DMCK6 JSB PTAB SEPARATE "DM?" LDA "D" JSB TYO TYPE "DM?" LDA "M" JSB TYO JMP ERR * "D" OCT 104 MUPBD BSS 1 NEGATIVE OF UPPER BOUND UPBD BSS 1 POSITIVE BOUND * PAC NOP LDA IADR PRINT ADDRESS AND CONTENTS JSB ADRP JSB TYO PRINT / JSB PTAB JSB IGET GET THE WORD FROM THE DUMP DEF *+2 DEF IADR JSB PM,I JMP PAC,I UNL IFZ LST SKP * * CLEAR CORE * ZRO LDB ALTMI ADB M2 SSB JMP ERR LDB LL STB IADR LDA WRD ZROL JSB ADCHK STA IADR,I ISZ IADR JMP ZROL * UNL XIF LST ADCK NOP CHECK FOR DEBUG OVERLAP STA PR SAVE AC LDA IADR CMA,INA ADA UL CH56 OCT 1256 SSA=RAL,SLA. CLEARS E JMP SOXA DONE, GO RESET LDA IADR CH40 CMA,SEZ E CLEAR: WILL SKIP G70 OCT 70000 LDB A UNL IFZ LST ADA STEND SSA,RSS UNL XIF LST JMP ADCKR BELOW DEBUG ADB DEBOP SSB,RSS JMP ADCKO IN DEBUG, LOSE LDA IADR TEST IF IN PARTITION JSB DMCHK ADCKR ISZ ADCK BUMP FOR NORMAL RETURN ADCKO LDA PR RESTORE AC JMP ADCK,I RETURN * UNL IFZ LST ADCHK NOP JSB ADCK CH53 OCT 1053 RSS=ALS,SLA JMP ADCHK,I JSB PTAB 3 SPACES LDA "T" JSB TYO T JMP BADP "T" OCT 124 HED TAPE OPERATIONS * TABL JSB SOI TABL1 JSB RWDB STA SYM JSB RWDB STA SYM+R AND G70 STA ADCK SAVE FLAGS XOR SYM+R DELETE FLAGS STA SYM+R JSB RWDB LDB ADCK BLF ADB RELTB ADA B,I RELOCATE SYMBOL JSB DEFS JMP TABL1 * LOAD JSB SOI LOA JSB RWDB JSB ADCHK IS ADDRESS OK STA IADR,I STORE JMP LOA * VFY JSB CRLF JSB SOI LDV JSB RWDB JSB ADCK NOP CPA IADR,I COMPARE JMP LDV STORE DONE OR CORE MATCH. SZA,RSS JMP LDV IGNORE ZERO ON TAPE. STA RWDB SAVE TAPE WORD. JSB PAC PRINT DISCREdAPANCY. JSB PTAB LDA RWDB JSB PM,I JSB CRLF JMP LDV RELTB DEF WRD-1 SKP * SOI NOP LDB SOI INB STB RWDB SOF JSB RDCH INB,SZB,RSS COUNT BLANK TAPE JMP SOX LOTS: END OF FILE. C3007 CMA,INA,SZA,RSS HAVE WE A WORD COUNT? JMP SOF NOT YET. STA CHC JSB RDCH DISCARD ONE FRAME JSB RDWD BLOCK ADDRESS STA CHI INIT CHECKSUM ELA,CLE,ERA MAKE SURE NOT INDIRECT STA IADR * RWDG JSB RDWD LDB A ADB CHI STB CHI JMP RWDB,I RETURN * RWDB NOP ISZ IADR ISZ CHC INDEX WORDCOUNT JMP RWDG JSB RDWD READ CHECKSUM LDB M6 MAX. RECORD GAP CPA CHI JMP SOF CKSM OK, GO TO NEXT RECORD LDA RDCHK BAD CHECKSUM LDB SRDX JSB PN COMPLAIN SOX EQU * UNL XIF LST SOXA LDA LOCP,I STA IADR JMP LSE SKP * UNL IFZ LST RDWD NOP READ A WORD JSB RDCH ALF,ALF STA CH JSB RDCH ADA CH JMP RDWD,I * RDCH NOP READ A CHARACTER STB BS SAVE B JSB EXEC GO TO EXEC FOR ONE CHAR. ON 5 DEF RDRTN DEF O1 DEF O2105 DEF BF DEF M1 RDRTN LDA BF GET THE CHAR ALF,ALF AND O377 LDB BS RESTORE B JMP RDCH,I O2105 OCT 2105 O377 OCT 377 RDCHK OCT 50245 SKP PNCH JSB STORE LDA LFLG SZA JMP PCH1 LIMITS SPECIFIED LDA IADR USE CURRENT REGISTER STA LL STA UL PCH1 LDA LL CMA,INA ADA UL SSA JMP LSE DONE AND O77 CMA STA CHC WORDS THIS BLOCK CMA,CCE,INA ALF,ALF JSB PWD WORD COUNT LDA LL STA CHI CHECKSUM JSB PWD ORIGIN PCHL LDA LL,I JSB PWD ADA CHI STA CHI ISZ LL ISZ CHC JMP PCHL JSB PWD CHECKSUM CLA JSB PWD BLANK FRAMES JSB PWD FOR INTER-RECORD GAP JMP PCH1 * PWD NOP PUNCH A WORD STA BF SET WORD JSB EXEC GO TO PUNCH WITH ONE WORD DEF PWRTN DEF O2 DEF O2104 HONEST BINARY DEF BF DEF O1 PWRTN LDA BF RESTORE A JMP PWD,I O2104 OCT 2104 UNL XIF LST HED SYMBOL TABLE OPERATIONS * DEFS NOP STA RDCH JSB EVS JMP DRDF DEFS1 LDA START CHECK FOR OVER FLOW CMA,INA ADA STEND SSA JMP SYMO OVERFLOW GO BITCH CCB NAKE NEW ENTRY ADB STEND LDA RDCH STA B,I ADB M1 LDA SYM+R STA B,I LDA SYM SSA ADA C1031 ADA M3100 SSA,RSS ADB M1 LDA SYM STA B,I STB STEND JMP DEFS,I * DRDF SEZ,RSS IF IN OTHER TABLE JMP DEFS1 PRETEND IT WASN'T * LDA RDCH FIX OLD ENTRY STA CH,I JMP DEFS,I START DEF END+4 SKP * EVS NOP LDB SYM IS IT A CLE CPB CLE JMP CLEFD YES GO SET CLE FLAG LDA STEND STA CH EVSL LDA CH CPA STTOP JMP EVSU UNDEFINED. LDB CH,I GET LEFT HALF ISZ CH G74 STB A USED AS CONSTANT SSB ADB C1031 OVERFLOW. ADB M3100 CPA SYM JMP EVSM1 LEFT HALF MATCH. SSB,RSS ISZ CH EVSI ISZ CH JMP EVSL TRY AGAIN. * EVSM1 LDA CH,I SSB CLA,RSS ISZ CH CPA SYM+R JMP EVSF RIGHT HALF MATCHES. JMP EVSI * EVSF LDA CMFLG HAS A COMMA BEEN TYPED CLE,SZA,RSS JMP EVSF2 THEN VALUE IS OK LDA ISEXP YES MAKE SURE NOT CMA,INA FIRST ROTATE ADA CH CLE,SSA BELOW ROTATES JMP EVSF2 YES THEN OK ADA M60 CLE,SSA ABOVE FIRST ROTATES JMP EVSI NO THEN CONTINUE JMP EVSF2 YES RETURN * * EVSU JSB FLUSH NOT IN OUR TABLE SO BLOW JSB SYMP THE SYMBOL JSB PTAB JSB PTAB CLA STA CCO AND GO TO THE MAIN FOR SNAP VALUE JSB FNDET CALL THE MAIN ROUTINE DEF *+6 DEF BF PASS THE NAME DEF ERRF AN ERROR FLAG DCB NOP THE DCB ADDRESS DEF SYTP EXPECT THE SYMBOL TYPE HERE (MUST BE ZERO) DEF VALUE VALUE COMES HERE LDA ERRF IF FILE ERROR SSA,RSS THEN NO SYMBOL CLA,INA CPA SYTP TYPE MUST BE ONE RSS OK?? ISZ EVS NO SET ERROR RETURN LDA VALUE PICK UP VALUE RETURNED CLE,RSS SKIP OVER THE LOCAL PICK UP EVSF2 LDA CH,I PICK UP VALUE JMP EVS,I * M60 OCT -60 CLEFD STB CLEFG SET CLE FLAG CLA,CLE SET VALUE TO ZERO JMP EVS,I * CMFLG OCT 0 VALUE NOP SYTP NOP ERRF NOP CLEFG OCT 0 O40 OCT 40 ISL3I DEF ISL3 M3100 OCT -3100 C1031 CLF 0 STTOP DEF STTP LINK TO END OF SYMBOL TABLE SKP * * SYMBOL TABLE SEARCH * SRCST NOP STA CH SAVE TABLE LIMITS STB TYO LDA C1000 STA DNM STA NUMP SRCL LDB CH CPB TYO JMP SRCST,I DONE, RETURN LDA CH,I SSA ADA C1031 ADA M3100 CLE,SSA,RSS ISZ CH ISZ CH LDA CH,I FETCH SYMBOL VALUE CH45 CMA,SEZ,INA,RSS WON'T SKIP ADA ONM COMPARE SEZ,CLE,RSS JMP SRCI ENTRY TOO BIG, LOSE STA PR LDA B IF >2 CARACTERS INA CPA CH RSS JMP SRCI1 THEN LOOSE LDA PR YES TEST VALUE ADA NUMP CCE,SSA,RSS JMP SRCI1 AS GOOD OR BETTER ALREADY CH44 CMA,SEZ,INA GOOD MATCH (WON'T SKIP) ADA NUMP STA NUMP UPDATE CLOSENESS LDA B,I SAVE SYMBOL STA SYMP SKP SRCI1 LDA PR CHECK IF BETTER ADA DNM THAN LAST ONE CMA,SSA,INA JMP SRCI NO FORGET IT CLA CLEAR TEMP ",C" FLAG STA CMACT LDA TYO IF SEARCH OF USER TABLE CPA ISEND THEN JMP SRCI2 SKIP LDA C1000 CLEAR SINGLE DEF IF OP-CODE STA NUMP LDA CH,I GET THE VALUE AND ONM MASK CPA CH,I MUST HAVE ALL THE DEFINED RSS BITS ELSE JMP SRCI FORGET SYMBOL SSA IF MAC GROUP GO CHANGE OFFSET JMP SRCI4 XOR ONM OR NOT SAME GROUP AND O6000 SZA JMP SRCI FORGET SYMBOL LDA B,I IF A CPA SEZ SEZ, JMP SRCI3 CPA SLA SLA, JMP SRCI3 CPA SLB OR SLB JMP SRCI3 THEN STOP SEARCH SRCI2 LDA PR OK UPDATE CMA,INA STA DNM LDA CMACT ",C" FLAG STA CMAC LDA B,I AND SAVE THE STA SYM THE SYMBOL INB LDA B,I CPB CH CLA STA SYM+R SRCI ISZ CH JMP SRCL * SRCI3 LDA CH SET END TO NEXT POINTER INA STA TYO JMP SRCI2 AND CONTINUE * SRCI4 AND DSMSK IF DOUBLE SHIFT CPA ASL GO ALLOW O17 OFFSET JMP SRCI8 CPA LSL JMP SRCI8 CPA RRL JMP SRCI8 CPA STF IF STF DONT STRIP C BIT JMP SRCI7 AND O2000 SZA JMP SRCI6 IF NOT IO GROUP * SRCI5 CMA MUST BE EXACT ADA PR SSA,RSS IS IT WITHIN LIMITS JMP SRCI NO FORGET IT LDA CH40 SET TERMINATOR TO SPACE STA TERM JMP SRCI2 * SRCI6 LDA ONM AND O1000 SEfT ",C" FLAG STA CMACT IN TEMP VALUE XOR PR REMOVE THE CLEAR FLAG BIT STA PR * SRCI7 LDA O77 JMP SRCI5 * SRCI8 LDA O17 JMP SRCI5 DSMSK OCT 176760 CMAC OCT 0 CMACT OCT 0 TERM OCT 54 O17 OCT 17 C1000 OCT 100000 HED PRINT ROUTINES * ADRP NOP PRINT ADDRESS IN SYMBOLIC STA ASCP ELA,CLE,ERA GET DIRECT ADDRESS STA ONM LDA STEND USER'S SYMBOL AREA LDB ISEND JSB ADRSP OCT 10 LIMIT OFFSET TO 10 LDA ASCP SSA,RSS INDIRECT? JMP ADRPX NO, DONE. LDA CH54 , JSB TYO LDA CH111 I JSB TYO ADRPX LDA CH57 JMP ADRP,I * ADRSP NOP PRINT SYMBOLIC EXPRESSION JSB SRCST SEARCH PART OF SYMBOL TABLE LDA ONM LDB ADRSP,I ISZ ADRSP STEP RETURN ADB DNM CLOSE ENOUGH? SSB,RSS JMP PSYM YES PRINT ABSOLUTE. LDB SYMP GET SINGLE SYMBOL STB SYM AND SET CLB IT UP STB SYM+R LDB NUMP SET VALUE STB DNM CPB C1000 IF NOT DEFINED JMP AABS FORGET IT. PSYM JSB SYMP PRINT BEST SYMBOL LDA DNM SZA,RSS EXACT? JMP PCMAC YES, GO CHECK ",C" LDA CH53 + LDB ADRSP IF INSTRUCTION CPB DINRT THEN LDA TERM PRINT "," OR " " INSTEAD JSB TYO LDB DNM PRINT DIFFERENCE CMB,INB LDA ADRSP GET RETURN ADDRESS CPA DINRT PRINTING NON ADDRESSABLE INSTR? JMP INONB YES GO RECURE AABSS STB A NO SET OFFSET IN A AABS JSB NUMP PCMAC LDA CMAC IS ",C" REQUIRED SZA,RSS JMP ADRSP,I NO, THEN RETURN LDA CH54 JSB TYO PRINT ",C" LDA CH103 JSB TYO CLA CLEAR ",C" FLAG STA CMAC JMP ADRSP,I AND RETURN CH103 OCT 103 DINRT DEF INONC SKP * I N S T P * * PRINT SYMBOLIC INSTRUCTION * * LDA * JSB INSTP * INSTP NOP JSB ADRC MRG INSTRUCTION? JMP INOND NO,SEE IF 2 WORD INSTRUCTION STA DNM SAVE REFERENCED ADDRESS LDA B AND G74 GET OPCODE ALF,RAL TO LOW BITS ADA OPPTR INDEX INTO MRG SYMBOL TABLE LDA A,I FETCH OPTAB ENTRY LDB SRDX JSB PN PRINT IT INONE LDA CH40 SPACE JSB TYO LDA DNM FETCH ADDRESS JSB ADRP PRINT ADDRESS JMP INSTP,I INONB LDA ONM SSA IF MAC GROUP JMP AABSS JUST PRINT IT AND O6000 ISOLATE THE GROUP BIT ADB A ADD IT BACK STB ONM NON-ADDRESSABLE. INONA LDA CH54 SET TERMINATOR TO "," STA TERM LDA ISEXP POINT TO LDB STTOP TABLE "ISL2" JSB ADRSP SEARCH INSTRUCTION OCT 1777 INONC JMP INSTP,I INOND STB ONM SAVE INSTRUCTION JSB GET2 2 WORD INSTRUCTION? JMP INONA NO,NON-ADDRESSABLE LDB SRDX YES JSB PN PRINT IT LDA TRAC SZA,RSS TRACING? JMP INSTP,I NO,DON'T PRINT ADDRESS LDA DDOT POINT TO INSRUCTION'S INA ADDRESS PARAMETER LDA A,I GET ADDRESS STA DNM SAVE IT JMP INONE ISEXP DEF ISL2 O6000 OCT 6000 SKP * ENDT EQU * CRLF NOP LDA O15 JSB TYO LDA O12 JSB TYO JMP CRLF,I * END1 BSS 0 PTAB NOP LDA CH40 SPACE JSB TYO LDA CH40 JSB TYO LDA CH40 JSB TYO JMP PTAB,I * ASCP NOP ASCII PRINT STA SYMP ALF,ALF JSB TYO LDA SYMP JSB TYO LDA CH42 ADD A " JSB TYO JMP ASCP,I * SYMP NOP SYMBOL PRINT LDA SYM LDB SRDX JSB PN YLDA SYM+R LDB SRDX SZA JSB PN JMP SYMP,I * NUMP NOP NUMBER PRINT LDB RADIX JSB PN LDA CH56 PRINT . LDB RADIX CPB O12 IF DECIMAL. JSB TYO JMP NUMP,I HED NUMBER AND SYMBOL PRINT * PN NOP A=NUMBER, B=RADIX. STA PNTM STB PNT3 CMB,INB STB PNT2 CLB ENTER: B = NUMBER. PDNC STB ENDT LDB PNTM PDVD STB END1 LDA M20 STA CH CLA PDVL CLE,ELB LONG LEFT SHIFT. ELA ADA PNT2 TRIAL DIVIDE SSA,RSS GOES? INB,RSS YES, BUMP QUOTENT ADA PNT3 NO, RESTORE ISZ CH ROUND AND ROUND... JMP PDVL WE GO. CPB ENDT QUOTIENT IN B, REM IN A. JMP PDPNT JMP PDVD DIVIDE AGAIN. PDPNT LDB PNT3 CPB SRDX ADA M1 ADA M12 SSA SKIP IF LETTER ADA M7 NUMBER FIXUP ADA O101 CONVERT TO ASCII CPA O133 PERIOD? LDA CH56 YES. CPA O134 $ ? LDA CH44 YES. CPA O135 % ? LDA CH45 YES. JSB TYO LDB END1 CPB PNTM JMP PN,I JMP PDNC M7 OCT -7 PNTM NOP PNT2 NOP PNT3 NOP M12 OCT -12 O133 OCT 133 O135 OCT 135 UNL IFN LST M6000 OCT 172000 O2 OCT 2 RDCH NOP RDWD NOP CH53 OCT 1053 CH111 OCT 1511 SKP UNL XIF LST TYO NOP AND O177 ISOLATE THE CHARACTER STA TTYOP SAVE CHAR. TO BE OUTPUT LDB CCO GET CURRENT CHARACTER COUNT CLE,ERB ADJUST TO WORD OFFSET ADB DBF ADD THE BUFFER ADDRESS SEZ,RSS IF HIGH CHAR. ALF,SLA,ALF ROTATE AND SKIP IOR B,I ELSE ADD IN THE HIGH FORM LAST TIME STA B,I SAVE THE CHAR ISZ CCO STEP THE COUNT LDB TTYOP IF LINE FEED CPB O12 JSB FLUSH FLUSH THE BUFFER LDB CCO IF BUFFER FULL CPB MAXBF THEN JSB FLUSH FLUSH IT LDB ACCB SET B REG FOR RETURN JMP TYO,I RETURN * FLUSH NOP JSB IFBRK CHECK FOR BREAK DEF *+1 SZA IF ONE JMP LSE TERMINATE CURRENT OP LDA CCO GET COUNT CMA,INA,SZA,RSS IF ZERO JMP FLUSH,I EXIT STA CCO SET CHARACTER COUNT JSB EXEC WRITE THE LINE ON THE TTY DEF RTN01 DEF O2 DEF LU HONEST MODE BINARY DBF DEF BF DEF CCO RTN01 CLA CLEAR THE CHAR. STA CCO COUNT JMP FLUSH,I RETURN SKP * TTYOP NOP JSB FLUSH FLUSH ANY PENDING OUTPUT JSB $LIBR DO INPUT AS DEF TDB REENTRENT JSB EXEC GET ONE CHAR DEF RTN02 DEF O1 FROM SYS TY DEF LU HONEST BINARY ECHO DEF BF DEF M1 ONE CHARACTER RTN02 LDA BF PUT CHAR ALF,ALF IN LOW AND O177 A AND MASK IT LDB TTYOP GET THE RETURN ADDRESS STB TDBRT SET FOR EXIT JSB $LIBX EXIT BACK DEF TDB TO THE CALLER NOP * TDB NOP TDB FOR REENTRENT DEC 4 FOUR WORDS TDBRT NOP RETURN ADDRESS BF NOP BSS 35 MAX BUFFER IS 72 CHAR MAXBF ABS *-BF+*-BF CCO NOP BS NOP HED CONSTANTS,POINTERS,TABLES & VARIABLES OPTAB OCT 115002 NOP - 0 OCT 3 OCT 44216 AND - 10 OCT 100624 JSB - 14 OCT 154204 XOR - 20 OCT 100262 JMP - 24 OCT 75304 IOR - 30 OCT 75554 ISZ - 34 OCT 43373 ADA - 40 OCT 43374 ADB - 44 OCT 52533 CPA - 50 OCT 52534 CPB - 54 OCT 105673 LDA - 60 OCT 105674 LDB - 64 OCT 134773 STA - 70 OCT 134774 STB - 74 OCT 0 = DUMMY ADDRESS FOR LOADR SKP M1 OCT -1 M6 OCT -6 O1 OCT 1 O12 OCT 12 O77 OCT 77 O101 OCT 101 "A" EQU O101 O134 OCT 134 O177 OCT 177 TRAC NOP TRACING FLAG WRD NOP LL NOP UL NOP LU OCT 2501 ACCA NOP ACCB NOP CH NOP CHI NOP SYMXI DEF SYM SYMX NOP SYM OCT 0,0 ONM NOP DNM NOP CHC NOP ALTMI NOP LFLG NOP LIMBO EQU SYMXI IADR NOP RADIX OCT 10 PM DEF INSTP ISEND DEF ISL LOCP DEF LOC STED DEF STEND OPPTR DEF OPTAB ADRPP DEF ADRP MASTER MODE TABLE - MODE INSPP DEF INSTP IS SET BY INDEXING INTO NUMPP DEF NUMP THIS TABLE AND PICKING ASCPP DEF ASCP UP POINTER FOR DISPATCHING * DEBOP DEF *+1 FIRST WORD WICH CAN BE MODIFIED * CEND OCT 77777 DO NOT MOVE DEF END THESE VALUES!!!!!!!!!!!!!!!!!! STEND DEF ISL "F" MSK OCT 177777 "M" FLGBX NOP "M+1" O,E AND INTERRUPT STATUS BPADR DEF SYM "M+2" BP ADDRESS 2 ACCX NOP "M+3" CONTENTS OF X REGISTER ACCY NOP "M+4" CONTENTS OF Y REGISTER BVAL NOP "M+5" BREAKPOINT COMPARE VALUE BMSK OCT 177777 "M+6" BREAKPOINT MASK BADD NOP "M+7" REG OR MEMORY TO BE TESTED SKP SZA "M+8" SENSE OF TEST SZA =,SZA,RSS /= UNL IFZ LST LTRAP DEF $TRAP ORB PLANT A DEF ON THE BASE PAGE $TRAP DEF TRAP ORR ONLY NEED ONE WORD * * UNL XIF LST END ASMB,R,Q,C,Z * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * THE Z OPTION OF WHZAT IS THE CRASH DUMoP VERSION * IN THAT VERSION ALL MEMORY REFERENCES ARE TO BE * THROUGH EXTERNAL ROUTINES WHICH ACCESS THE DUMP * * THE N OPTION IS THE RTE-IV VERSION * IFN HED WHZAT FOR RTE-IV NAM WHZAT,1,1 92067-16007 REV.GAGA 790316 XIF IFZ HED WHZAT FOR CRASH DUMP OF RTE-IV NAM WHZIT,7 92067-16??? REV .GAGA 790316 XIF * * NAME: WHZAT * SOURCE: 92067-18007 * RELOC: 92067-16007 * PRGMR: E.J.W. * SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,TMVAL EXT .MWF,.XLA,.XLB IFN EXT $MATA,$MNP,$TIME,$RNTB,$CLAS * * EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B KEYWD EQU 1657B XEQT EQU 1717B * XIF * A EQU 0 B EQU 1 * *THE FOLLOWING IS A SAMPLE OUTPUT OF THIS PROGRAM: * ON,WHZAT,LU * * 09:51:50:710 * ********************************************************************** * PT SZ PRGRM,T ,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC*OPER * NEXT TIME * * ********************************************************************** * 0 ** MEM *1 *09000 ***** 1 * 2 2 R$PN$*1 *00010 *************** 3,CL 032 * 3 5 PROGA*3 *00097 ******************************* 6 * 4 5 PROGB*3 *00097B*************** 3,LULK 40,LKPRG=PROGA * 5 17 PROGC*3E*00097 *************** 3,RN 031,LKPRG=PROGD * 3A27 PROGD*4 *00097 *************** 3,RESOURCE * 5 7 PROGE*3 *00097 *************** 3,CLASS # * 2 4 QUIKR*3 *00099 0 **********************************00:00:00:000 * 6 7 FMGR *3 *00090 *************** 3,EDITR'S QUEUE * 3 7 EDITR*3 *00050 ************************* 5 * 6 15 ASMB *3 *00099 *************** 3,LU,EQ DN , 5(0[00000000]) * 4A 6 TIMEL*4 *00090 *************** 3,LU,EQ DN 6, 5(0[00000000]) * 4A 6 TIMEL*4 *00090 *************** 3,LU,EQ DN *********00:00:00:000 * 7 7 FMG07*3 *00050 *************** 3,BL,EQT 7 * 2 3 WHZAT*4 *00001 ***** 1 * 0 ** RENSB*1 *00060 ******************** 4 * 3 6 PROGF*4 *00096 *************** 3,RN 031,LKPRG=GLOBL * 6 7 ED26 *3 *00050 ********** 2, 16(2[00000010]) * ********************************************************************** * DOWN LU'S, 6, 14 ************************************************************************ * DOWN EQT'S, 5, 6 * ********************************************************************** * 09:51:50:710 * * * BRIEF EXPLANATION OF SOME OF THE ABOVE. * * PT SZ COLUMN HEADING (PARTITION NUMBER AND PARTITION SIZE) * 0 ** IN RTE-IV MEANS MEMORY RESIDENT PROGRAM * 5 8 IN RTE-IV MEANS PARTITION #5 IS USED AND 8 PAGES IN USE * 11 IN RTE-IV MEANS SCHEDULED PROGRAM IS NOT YET IN PARTITION * * 'A' AFTER THE PARTITION # MEANS THE PROGRAM WAS ASSIGNED * 'E' AFTER THE PROGRAM'S TYPE MEANS IT IS AN EMA PROGRAM * 'B' AFTER THE PROGRAM'S PRIORITY MEANS RUNNING UNDER BATCH * WHEN A PROGRAM IS IN STATE 3[WAIT],THE REASON FOR BEING IN THAT * STATE WILL BE SPECIFIED ACCORDING TO THE FOLLOWING RULES : * IDSEG(2) ::= $RNTB => 'RN ALLOCATION' * ::= DRT(#[6:10])=RN# => 'LU # LOCKED' * ::= >$RNTB,<$RNTB+[$RNTB] => 'RN LOCKED' * ::= $CLAS => 'CLASS ALLOCATION' * ::= >$CLAS,<$CLAS+[$CLAS] => 'CLASS GET' * ::= 4 => 'DEVICE(LU OR EQT) DOWN' * ::= SON'S IDSEG ADDRESS => 'SON'S NAME' * ::= EQT ADDRESS => 'BL,EQT#NN' * * * * FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-IV * ON,WHZAT,LU,1 * * 09:00:21:250 * ********************************************************************** * PTN# SIZE PAGES BG/RT PRGRM * ********************************************************************** * 1 7 42- 48 BG FMG11 * 2 15 49- 63 BG EDITR * 3 16 64- 79 RT WHZAT * 4M 48 80- 127 BG EMAPR * 5C 16 80- 95 BG * 6C 16 96- 111 BG * 7C 1M6 112- 127 BG * 8M 64 128- 191 RT * 9SR 16 128- 143 RT * 10S 16 144- 159 RT PROGQ * 11S 16 160- 175 RT SAMPL * 12SR 16 176- 191 RT * 13 R 64 192- 255 BG EMAID * 14 * 15 * ********************************************************************** * 09:00:21:310 * * SKP IFN WHAT JSB .XLA B,I DEF B,I CLE,SZA,RSS SCHED W PRAM ? CLA,CCE,INA NO-DEFAULT TO LU 1 STA CRTLU SAVE LU FOR OUTPUT INB JSB .XLA B,I DEF B,I STA PARM2 SAVE SECOND PARAMETER INB JSB .XLA B,I GET SPECIAL LU PARAM DEF B,I SZA,RSS IN CASE OF PREV RUN LDA CRTLU SEZ DEFAULT NEEDED? STA CRTLU YES INB PICK UP THE JSB .XLB B,I SESID FROM LAST TIME DEF B,I STB SESID AND SAVE FOR NOW IF NEEDED SPC 2 LDA .EOF SEND BLANK LINE LDB DM6 JSB PRINT USE STD PRINT SUB JSB TOD PRINT TIME-OF-DAY AS NEXT LINE JSB STARS ERASE EOL + A LINE OF ASTERISKS * LDA PARM2 XIF IFZ * * THE DUMP ANAL. VERSION MUST USE THE DUMP ANAL. EXTS TO * GET THE KEY SYSTEM ADDRESSES * EXT .ENTR,FNDET ENT WHZIT * TBLCO DEC -5 * * DEFINE SOME SYMBOLS TO KEEP ASMB HAPPY * WHAT EQU 0 $MATA EQU 0 $MNP EQU 0 $TIME EQU 0 $RNTB EQU 0 $CLAS EQU 0 DDTBL DEF *+1 SYMBOL TABLE ADDRESS ASC 3,$MATA ASC 3,$MNP ASC 3,$TIME ASC 3,$RNTB ASC 3,$CLAS * DNMAD DEF *+1,I ADDRESS OF NAME DEFS LIST DEF @MATA DEF @MNP DEF @TIME DEF .RNTB DEF .CLAS * * EQTA NOP EQT# NOP DRT NOP LUMAX NOP KEYWD NOP XEQT NOP * COU NOP ERR NOP TYP NOP * LU NOP DCB NOP DCB FOR THE FIND ENT CALLS FLPRM NOP WHZIT NOP JSB .ENTR GET THE PRAMS DEF LU LDA DDTBL STA DSYM1 LDA DNMAD GET THE DEF TO THE DEFS STA DSYM AND SET IT IN THE CALL LDA TBLCO GET THE COUNTER STA COU AND SET THE COUNT * * * FIRST LOOK UP ALL THE REQUIRED ADDRESSES * MOR JSB FNDET CALL THE DUMP ROUTINE TO GET THEM DEF *+6 DSYM1 NOP DEF ERR DEF DCB,I DEF TYP DSYM NOP LDA DSYM1 ADA D3 STEP THE ADDRESSES STA DSYM1 ISZ DSYM STEP THE POINTER ISZ COU DONE? JMP MOR NO GO DO MORE * * NOW THE BASE PAGE STUFF * JSB .XLA EQTA EQT ADDRESSES DEF 1650B STA EQTA SET THE WORD JSB .XLA EQT# DEF 1651B STA EQT# JSB .XLA DRT DEF 1652B STA DRT JSB .XLA LUMAX DEF 1653B STA LUMAX JSB .XLA KEYWD DEF 1657B STA KEYWD JSB .XLA XEQT DEF 1717B STA XEQT * LDA LU,I GET THE LU TO LOCAL MEMORY STA CRTLU LDA .EOF START THE PRINT LDB DM6 JSB PRINT JSB TOD JSB STARS HEADER IS NOW DONE WE IS READY LDA FLPRM,I GET THE FLAG PRAM STA PARM2 AND SET THE PRAM XIF CPA "AL" IF ALL CODED THEN JMP FULL GO REPORT ALL * CPA "SM" ALMOST ALL?? JMP FULL YES GO DO IT * CPA "PA" IF PARTITION REPORT REQUESTED JMP WHATP YES, SHOW PARTITIONS * LDA XEQT GET CURRENT SESSION ADDRESS ADA D32 FROM THE ID JSB .XLA A,I AND DEF A,I SZA IF NOT ZERO STA SESID SAVE IT LDA SESID WELL WHAT DO WE HAVE?? SZA,RSS IF ZERO JMP FULL REPORT ALL ACTIVE PGMS. * JMP SES DO SESSION REPORT * FULL CLA SET UP TO DO FULL REPORT STA SESID SESSION ID TO ZERO * * REPORT IS TO BE SESSION RELATED ONLY * SES LDA .HEAD GET THE HEAD LDB DM74 AND JSB PRINT PRINT IT JSB STARS CLA SET UP TO START THE ID SCANN STA IDCNT STA ALL CLEAR THE ALL FLAG LDA NAMSB CLEAR THE ID STACK STA NAMST (STACK OF PROCESSED ID'S) STA DLKFL SET THE DEAD LOCK FLAG * * NXSES LDA KEYWD START THE SCAN ADA IDCNT GET KEY WORD ADDRESS JSB .XLA A,I GET THE ID ADDRESS DEF A,I STA IDPNT SET IT DOWN IN CASE THIS IS IT SZA,RSS END OF LIST?? JMP FINX YES GO CHECK ALL FLAG * ADA D14 IS A SHORT ID JSB .XLB A,I GET FLAG WORD DEF A,I BLF,BLF ROTATE IT AROUND BLF,SLB,BLF WELL?? JMP FINX YES END OF USEFUL ID'S * INA CHECK IF ID IS IN USE JSB .XLB A,I GET STATUS DEF A,I SZB ZERO DORMANT JMP NOTDM NOT DORMANT CONSIDER IT * ADA D2 GET THE TIME LIST WORD JSB .XLB A,I GOT IT DEF A,I BLF,SLB IN THE TIME LIST?? RSS YES JMP NOYET NO DON'T WORRY ABOUT THIS ONE * * * NOTDM LDA IDPNT RESTORE A TO THE ID ADDRESS LDB SESID GET THE SESSION ID SZB,RSS IF ZERO JMP MAIN GO DO THE ALL TESTS * ADA D32 INDEX TO THE SESSION WORD JSB .XLA A,I GET THE WORD DEF A,I CPA B IN THE SESSION?? JMP THISS YES GO DO IT * NOYET ISZ IDCNT NO INDEX THE COUNT JMP NXSES AND TRY AGAIN * * THISS JSB THIS CHECK IF ALREADY REPORTED JMP NOYET ALREADY DONE DON'T DO IT TWICE * THIS1 LDB IDPNT CHECK IF THE PROGRAM IN IN A FATHER SON ADB D20 CHAIN JSB .XLA B,I GET FATHER POINTER DEF B,I RAL POSITION THE BIT SSA IS THEIR A FATHER?nB JMP POP YES GO TRY HIM * ADB DM5 NO TRY FOR A SON JSB .XLA B,I GET STATUS WORD DEF B,I AND B10K ISOLATE THE WAITING BIT SZA SET?? JMP PROGN YES THIS IS A PROGININATOR * LDA ALL AN INDEPENDENT PROG. CHECK IF OK TO REPORT SZA WELL? JMP PROGN YES GO DO IT * JMP NOYET NO SKIP IT * POP RAR THERE IS A FATHER GO UP TO GET HIM AND B377 ISOLATE HIS NUMBER ADA M1 AND COMPUTE HIS ADA KEYWD ADDRESS JSB .XLA A,I GET HIS ID ADDRESS DEF A,I LDB IDPNT SAVE THE CURRENT ONE STB PROCS IN TEMP STA IDPNT AND SET IT UP JSB THIS HAVE WE BEEN HERE BEFORE?? RSS YES SKIP FOR FURTHER TESTS JMP THIS1 NO GO CHECK IF THE PROGIN. YET * LDB ALL CHECK IS SECOND SCAN CPB D2 IF SO THEN IT IS NOT AN ERROR RSS ELSE LET JMP THIS1 NATURE TAKE ITS COURSE * LDA PROCS NOT ERROR STA IDPNT RESTORE THE SON AND * * PROGN JSB THIS MAKE SURE WE ARE NOT IN A LOOP JMP DEAD REPORT A DEAD LOCK * JSB STKNA WE ARE GOING TO PRINT THIS ONE LDB D15 GET STATUS JSB IDWRD AND AND B07 SET IT UP STA STATS FOR THE PROCS SUB. JSB PROCS PROCESS IT LDA SON CHECK IF A SON FOUND SZA IF SO STA IDPNT SET UP TO PRINT HIM SZA WELL?? JMP PROGN YES GO DO IT * LDB ALL IF ALL IS 2 THEN CPB D2 DON'T RESET IT LDA B STA ALL CLEAR ALL IF NOT 2 LDB LNAID IF LAST NAME PRINTED WAS NOT SZB,RSS THE ONE WE WERE REPORTING JMP ENDBL (IT WAS SKIP IT) * STB IDPNT AND SET UP TO RUN DOWN THE BLOCK CPA D2 IF ALREADY IN INDEPENDENTS RSS DO-N'T STEP ALL ISZ ALL ELSE SET THE ALL FLAG DLD BLOCK TELL HIM WHAT WE ARE DOINT JSB PRINT JMP THIS1 * ENDBL DLD INDEP SEND TWO STARS JSB PRINT LDA NAMST UP DATE THE STA DLKFL THE DEAD LOCK FLAG JMP NOYET AND CONTINUE SCAN * * FINX CLA STA IDCNT START THE SCAN ALL OVER CPA ALL IF ALL READY DONE RSS THEN JMP FINIS QUIT * LDA D2 AND STA ALL SET UP TO PICK UP THE INDEPENDENTS JMP NXSES GO DO IT * * DEAD CMA CHECK IF A TRUE DEAD LOCK ADA DLKFL TRUE IF IN SAME DEPEND LOOP SSA,RSS WELL JMP DEAD2 NO JUST A COLISION * DLD DEMES SEND THE DEAD LOCK MESSAGE JSB PRINT DEAD2 JSB SETPT SEND A WARNING MESSAGE AND LDA .SEAB SET UP THE SEE ABOVE MESSAGE JSB MVBYT MOVE IT IN DEF .SEAB+1 LDA IDPNT GET THE NAME TO REFERENCE JSB MVNAM AND MOVE IT INTO THE MESSAGE CLA STA LNAID CLEAR THE FLAG WORD JSB OUTPT SEND THE LINE TO THE DEVICE LDB ALL IF DOING ALL CPB D2 THEN JMP ENDBL JUST CONTINUE * CLA ELSE CLEAR STA ALL THE FLAG JMP ENDBL AND CONTINUE * * STKNA NOP STACK AN ID SEGMENT ADDRESS LDA IDPNT STA NAMST,I ISZ NAMST PUSH POINTER JMP STKNA,I AND RETURN * * THIS NOP CHECK IF ID IS IN STACK (P+1 IF SO, ELSE P+2) LDA NAMSB GET STACK BASE THISO CPA NAMST END OF STACK? JMP THISX YES ALL OK * LDB A,I NO GET THE ENTRY CPB IDPNT HERE ALREADY? JMP THIS,I YES EXIT * INA NO TRY NEXT ONE JMP THISO * THISX ISZ THIS NOT FOUND EXIT JMP THIS,I * SON NOP LNAID NOP ID ADDRESS OF LAST NAME PRINTED SESID NOP B10K OCT 10000 DM5 DEC -5 ALL NOP "AL" ASC 1,AL "SM" ASC 1,SM "PA" ASC 1,PA * BLOCK DEF *+2 DEC -15 OCT 0,0 ASC 6,** BLOCK ** INDEP DEF *+2 DEC -6 OCT 0,0 ASC 1,** DEMES DEF *+2 DEC -28 OCT 0,0 ASC 12,*********** DEAD LOCK ** .SEAB DEF *+2 DEC 32 OCT 0,0 ASC 14,*** SEE ABOVE FOR REPORT ON NAMST NOP DLKFL NOP NAMSB DEF *+1 BSS 256 SPC 2 * MAIN ADA D15 VERIFY JSB .XLA A,I THAT THIS DEF A,I AND B17 IDSEG(16[4-0])=PROG STATUS CPA D3 IF IN GEN WAIT JMP MAYBE GO TEST FOR "SOME OPTION" * SZA NOT DORMANT ? JMP THISS ACTIVE SO PROCESS IT ! * LDB D17 VERIFY JSB IDWRD THAT THIS ALF,SLA IDSEG(18[12])=TIME LIST INDICATOR JMP THISS PROG IS IN TIME LIST ! * JMP NOYET ELSE GO TRY THE NEXT ONE * MAYBE LDA ALL IF DOING FATHER SON TYPES LDB PARM2 OR IF NOT "SOME OPTION CPB "SM" THEN SZA,RSS GO JMP THISS GO DO IT * JMP NOYET ELSE TRY NEXT ONE * * * D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D12 DEC 12 D14 DEC 14 D15 DEC 15 D16 DEC 16 D17 DEC 17 D21 DEC 21 B07 OCT 7 B77 OCT 77 B17 EQU D15 CRTLU NOP PARM2 NOP IDCNT NOP IDPNT NOP STATS NOP STACK OCT 0,0 BSS 45 .STAK DEF STACK STKPT NOP .TM. DEF STACK+31 .DNTM DEF STACK+26 .LAST DEF STACK+36 ASTER OCT 0,0 UNL REP 35 ASC 1,** LST .ASTE DEF ASTER .STAR DEF ASTER+2 DM4 DEC -4 D7 DEC 7 SPC 4 PROCS NOP JSB SETPT CLEAR THE STACK CLB AND STB SON THE SON FLAG LDB D14 JSB IDWRD GET PROG TYPE AND D7 CPA D1 RESIDENT PROGRAM? RSS JMP PRLNG NO, PROCESS DISC RESIDENT * LDA .RSDT  YES, RESIDENT PROGRAM JSB MVBYT PRINT IT IS IN PARTITION 0 DEF D6 * JMP NAME GO GET PROGRAM NAME * PRLNG LDB D21 GET CONTENTS JSB IDWRD OF WORD 22 STA NUM (PARTITION #) STA B AND B77 SSB,RSS WAS PROG ASSIGNED TO PTTN SZA NO, WAS IT IN ANY PTTN? JMP PRPTN YES, ASSIGNED OR IN PTTN (NOT 1) * LDB D8 JSB IDWRD SZA HAS PROGRAM BEEN SUSPENDED BEFORE? JMP PRPT YES, THEN PARTITION #1 IS OK. * LDA .SPAC NO, PROGRAM MAY NOT HAVE BEEN LOADED JSB MVBYT DEF D2 JMP PRASG DO ASSIGNMENT INDICATOR * PRPT CLA PRPTN INA CONVERT TO ASCII JSB .ASC2 AND ADD TO STACK * PRASG LDA .SPAC LDB NUM SSB WAS PROG ASSIGNED TO PTTN? LDA .A YES, PUT 'A' IN LINE JSB MVBYT ELSE PUT A SPACE IN DEF D1 OUTPUT LINE * LDA NUM ALF,RAL GET NUMBER OF PAGES RAL IN PARTITION AND B37 INA ADD 1 FOR BASE PAGE JSB .ASC2 CONVERT TO ASCII LDA .SPAC JSB MVBYT PUT A SPACE DEF D1 * * NAME LDA IDPNT CALC 'FROM' JSB MVNAM MOVE NAME TO OUTPUT STACK CLA CLEAR THE NAME MOVED FLAG STA LNAID FOR SESSION REPORTS * JSB PSTAR PUSH AN ASTERISK SPC 2 TYPE LDB D14 GET PROGRAM TYPE JSB IDWRD AND D7 MASK OFF IDSEG(15[2-0]) STA NUM SAVE PROG TYPE FOR A WHILE JSB .ASC1 & STORE BYTE LDB D28 GET EMA WORD FROM ID SEG LDA NUM CPA D1 IS IT MEM. RES. PROG? CLA,RSS YES, SKIP EMA STUFF JSB IDWRD LDB .SPAC SZA IS IT EMA? LDB .E YES, PUT 'E' IN LINE LDA B ELSE USE SPACE JSB MVBYT DEF D1 JSB PSTAR PUSH AN ASTERISK * PRIOR LDB D6 GET PROG PRIORITY JSB IDWRD IN 'A'REG JSB ZASC5 CONVERT TO ASCII & ADD TO STACK * LDB D20 JSB IDWRD LDB .SPAC SSA IF RUNNING UNDER BATCH, LDB .B PRINT 'B' LDA B ELSE PRINT SPACE JSB MVBYT DEF D1 SPC 2 LDA STATS CALC STATUS COLUMN SZA,RSS DORMANT ? JMP M NO ASTERISKS NECESSARY MPY D5 5 CHARS PER COLUMN STA NUM SET UP MOVE LDA .STAR 'A'REG=SOURCE JSB MVBYT MOVE BYTES,R/L DEF NUM BER OF BYTES * M LDA STATS CONVERT STATUS TO ASCII JSB .ASC2 & PUSH ONTO STACK * LDA STATS GET STATUS CPA D2 I O SUSPEND ? JMP EQT YES-PROCESS EQT# CPA D3 WAIT LIST ? JMP WAIT YES-PROCESS WAIT LDA .SPAC ADD ONE MORE SPACE JSB MVBYT DEF D1 JMP TLIST CHECK TLIST SPC 2 EQTPT NOP #EQTS NOP .RSDT DEF *+1 ASC 3, 0 -- .A DEF *+1 ASC 1,AA .B DEF *+1 ASC 1,BB .E DEF *+1 ASC 1,EE D28 DEC 28 SKP EQT CLA PROG'S IN I/O SUSPEND STA #EQTS SET UP EQT INDEX * EQTLP LDA #EQTS GET EQT INDEX MPY D15 (15 WORDS EQT) ADA EQTA ADD ON EQT AREA BASE STA EQTPT SAVE THIS EQT'S ADDRESS JSB .XLA A,I GET CONTENTS OF EQT'S FIRST WORD DEF A,I * IDSLP SZA,RSS SCAN SUSPEND LIST. NULL LIST? JMP NXTEQ YES-GO TO NEXT EQT CPA IDPNT NO-POINTS TO OUR ID SEG ? JMP FNDEQ YES-GO PROCESS. SSA IF INDIRECT MUST BE GARBAGE JMP NXTEQ JSB .XLA A,I NO-NEXT LIST ELEMENT DEF A,I JMP IDSLP & CONTINUE THE SEARCH * NXTEQ ISZ #EQTS STEP EQT CNTR FOR NEXT EQT ENTRY LDA #EQTS ARE WE THRU ? CPA EQT# COMPARE WITH B oASE PAGE COUNT JMP OSCAR YES-MUST BE OSCAR JMP EQTLP NO- GOTO EQT LOOP * OSCAR LDA .EXEC MOVE " ,EXEC" ONTO STACK JSB MVBYT DEF D6 JMP TLIST & CHECK TIME LIST SPC 2 .EXEC DEF *+1 ASC 3,, EXEC .CMBL EQU .EXEC COMMA, BLANK B140K ABS 140000B .LPAR DEF *+1 ASC 1,( .LBRK DEF *+1 ASC 1,[ .IOBE DEF *+1 ASC 1,]) * SPC 2 FNDEQ EQU * PUSH ", EQ(L[DEV.STAT]) *" LDA .CMBL MOVE COMMA AND BLANK JSB MVBYT DEF D2 LDA #EQTS CALC EQT # INA JSB .ASC2 CONVERT TO ASCII LDA .LPAR PUSH "(" ONTO STACK JSB MVBYT DEF D1 * LDB EQTPT GET DEV.LOG.STATUS ADB D4 JSB .XLA B,I DEF B,I ALF,ALF STA EQST SET UP FOR BINARY STATUS ALF,ALF AND B140K MASK OFF LOGICAL STATUS RAL,RAL RIGHT JUSTIFY IN WORD JSB .ASC1 CONV TO ASCII & STORE LDA .LBRK PUSH "[" ONTO STACK JSB MVBYT DEF D1 * LDA DM8 SET UP LOGICAL STATUS STA CNT COUNTER BINLP LDA EQST CONVERT STATUS WORD TO BINARY RAL ROTATE CCW STA EQST SAVE IT AND D1 MASK OFF LSB(IT) JSB .ASC1 CONV TO ASCII & STORE ISZ CNT DONE 8 ? JMP BINLP NO-LOOP * LDA .IOBE MOVE LAST PART OF MESSAGE JSB MVBYT PUSH DEF D2 JMP TLIST CHECK TLIST SPC 2 DM8 DEC -8 D20 DEC 20 REASN NOP TEST EQU REASN EQST NOP SKP WAIT LDA .EXEC PUSH "," ONTO STACK JSB MVBYT FOR EXPLANATION DEF D1 * CLB,INB GET IDSEG(2) JSB IDWRD STA REASN CPA .RNTB RESOURCES LOCK ? JMP RESLK YES-PUSH "RESOURCE" ONTO STACK * CPA .CLAS NO-CLASS LOCK ? JMP CLSLK YES-PUSH "CLASS #" ONTO STACK * CPA D4 NO-DEVICE DOWN ? JMP DEVDN YES-PUSH "DEVICE DOWN" ONTO STACK * JSB TSTWD RNTBL<=IDSEG(2)<=[RNTBL] ? .RNTB DEF $RNTB+0 JMP RNLCK YES-PUSH "RN LOCK" ONTO STACK * JSB TSTWD CLASS<=IDSEG(2)<=[CLASS] ? .CLAS DEF $CLAS+0 JMP CLGET YES-PUSH "CLASS GET" ONTO STACK * LDA 1650B EQT <= IDSEG(2) <= #EQTS CMA,INA - S.A. OF EQT ADA REASN + POINTER SSA IF -, THEN POINTER < EQT S.A. JMP SONID FORGET IT CLB RESULT IS ADD REL S.A.EQT DIV D15 MOD 15 INA + 1 STA TEMP = EQT # CMA,INA -EQT# ADA 1651B + # EQT'S SSA,RSS IF POS,THEN VALID EQT # JMP BL SO PROCESS IT * SONID LDA REASN GET SON'S IDSEG ADDRESS STA SON POSSIBLE SON FOUND JSB MVNAM MOVE SON'S NAME ONTO STACK LDB D15 JSB IDWRD ALF,SLA JMP TLIST BIT 12 SET, HAVE SON * CLA NOT A SON STA SON CLEAR THE FLAG LDA .QUE BIT 12 CLEAR, SON YET TO BE JMP PUSH8 SPC 2 .BLIM DEF *+1 ASC 3,BL,EQT00 * BL LDA .BLIM SET UP BUFFER LIMIT MESSAGE JSB MVBYT DEF D6 LDA TEMP JSB .ASC2 CONVERT EQT# & PUSH JMP TLIST TEMP NOP SPC 2 .QUE DEF *+1 ASC 4,'S QUEUE .RN?? DEF *+1 ASC 4,RESOURCE RESLK LDA .RN?? PUSH "RN ??" ONTO STACK JMP PUSH8 SPC 2 .CL?? DEF *+1 ASC 4,CLASS # CLSLK LDA .CL?? PUSH "CL ??" ONTO STACK PUSH8 JSB MVBYT PUSH 8 CHARS ONTO STACK DEF D8 JMP TLIST SPC 2 .EQDN DEF *+1 ASC 5,LU/EQ DN DEVDN LDA .EQDN PUSH "LU,EQ DN" ONTO STACK JSB MVBYT DEF D8 LDB D2 JSB IDWRD GET LU# FROM SUSPENDED ID STA REASN SAVE IT TEMPORARILY SSA IF NEGATIVE, IT IS EQT ADDR JMP DVDNE v OF DOWN DEVICE * JSB .ASC4 PUT LU LEADING BLANKS * CCA FIND EQT NO. FOR LU ADA REASN AND B77 ADA DRT JSB .XLA A,I DEF A,I AND B77 ADA M1 STA #EQTS * MPY D15 ADA EQTA STA EQTPT JMP FNDEQ GO PRINT EQT STUFF. * DVDNE CMA,INA SAVE EQT ADDR OF DOWN DEVICE STA EQTPT LDA REASN CONVERT EQT ADDR TO EQT # ADA EQTA BY SUBTRACTING EQT BASE ADDR CMA,INA CLB DIV D15 AND DIVIDE BY 15 INA BUMP BY 1 FOR FIRST EQT STA #EQTS LDA .SPAC PUT 4 BLANKS FOR LU# JSB MVBYT DEF D4 JMP FNDEQ PUT OUT EQT INFO SPC 2 B37 OCT 37 @DRT EQU 1652B @LUMX EQU 1653B .RNLK DEF *+1 ASC 2,RN 00,LKPRG=PROGA . .LKPR DEF *+1 ASC 4,,LKPRG= * RNLCK STA RN SAVE RN# TEMP LDA @DRT GET DRT ADDRESS STA PTR SET UP POINTER LDA @LUMX GET MAX # OF LU'S CMA,INA SET UP COUNTER STA CNT LLOOP EQU * SEARCH FOR LU LOCK JSB .XLA PTR,I DEF PTR,I GET DRT ENTRY RRR 6 POSITION LU LOCK RN AND B37 & MASK IT CPA RN LU LOCK ? JMP LULCK YES-PROCESS IT ISZ PTR NO LOOP ISZ CNT JMP LLOOP LDA .RNLK PUSH "RN LK" ONTO STACK JSB MVBYT DEF D4 LDA RN PROCESS RNLCK JSB ZASC3 JSB PLOCK PUT PROG NAME INTO MESSAGE JMP TLIST SPC 2 .LULK DEF *+1 ASC 3,LULK 00,LKPRG=PROGA . * LULCK LDA .LULK PUT "LULK" ONTO STACK JSB MVBYT DEF D4 LDA CNT PROCESS LU LOCK - FIND ADA @LUMX OWNER'S NAME INA JSB .ASC3 PUT LU# IN MESSAGE JSB PLOCK PUT PROG NAME IN MESSAGE JMP TLIST SPC 2 PLOCK NOP LDA .LKPR PUSH ",LKPRG=" ONTO STACK ,5 JSB MVBYT DEF D7 LDA .RNTB ADA RN JSB .XLA A,I DEF A,I AND B377 GET RESOURCE LOCKER'S ID SEG # CPA B377 IS IT GLOBAL? JMP PLCK9 YES. ADA M1 ADA KEYWD JSB .XLA A,I DEF A,I JSB MVNAM MOVE NAME JMP PLOCK,I * PLCK9 LDA .GLBL JSB MVBYT MOVE NAME 'GLOBL' DEF D5 JMP PLOCK,I * .GLBL DEF *+1 ASC 3,GLOBL M1 DEC -1 RN NOP PTR NOP CNT NOP .CLGT DEF *+1 ASC 3,CL .SPAC DEF .CLGT+2 CL# NOP * CLGET STA CL# LDA .CLGT PUSH "CL " ONTO STACK JSB MVBYT DEF D4 LDA CL# JSB ZASC3 JMP TLIST * * TLIST LDB D17 IDSEG(18[12])=TIME LIST INDICATOR JSB IDWRD ALF,SLA SET ? JMP NXTTM YES-CONV NEXT TIME JMP DUMP NO-PRINT WHAT WE'VE GOT. SPC 2 D8 DEC 8 SPC 2 NXTTM LDA .TM. CALC # OF STARS TO FILL LINE CLE,ELA CMA,INA ADA STKPT CMA,INA SSA,RSS MORE THAN WE CAN FIT? JMP NXTM2 NO, OK * JSB OUTPT YES, LU/DN MSG TOO LONG LDA .DNTM COPY LINE AFTER PRINTING IT CLE,ELA AND ADD TIME STUFF TO IT STA STKPT JMP NXTTM * NXTM2 STA NUM & SAVE IT LDA .STAR SET UP FOR MOVE JSB MVBYT DEF NUM * LDA IDPNT ADA D18 JSB CNVTM * DUMP JSB OUTPT DISPLAY STACK JMP PROCS,I RETURN SPC 2 FINIS JSB STARS EOL + 70 ASTERISKS * DNDEV JSB SETPT RESET STACK FOR DOWN LU'S. LDA .DNLU PRINT LINE HEAD. JSB MVBYT DEF D9 LDA STKPT SAVE CURRENT POSITION STA PTR IN CASE NEED MORE LINES * LDA DRT GET LU TABLE AREA ADDRESS, ADA LUMAX POSITION TO WORD TWO STA EQTPT TABLE AND SAVE. CLA INITIALIZE STA #EQTS COUNTERw. * DNLU1 JSB .XLA EQTPT,I DEF EQTPT,I GET LU'S STATUS. ISZ #EQTS SSA,RSS IS IT DOWN? JMP NXTLU NO--GET NEXT LU. * LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION TO START ADA STKPT SEE IF TOO FULL YET. SSA LINE FULL YET? JMP DNLU2 NO, DO IT * JSB OUTPT YES, DUMP LINE LDA PTR SET UP NEW LINE STA STKPT JUST LIKE THE PREVIOUS DNLU2 LDA .CMBL YES--PROCESS IT. JSB MVBYT PUSH A ','. DEF D1 LDA #EQTS CONVERT LU# JSB .ASC3 TO ASCII. NXTLU ISZ EQTPT INCREMENT DRT WORD 2 POINTER. LDA #EQTS IF LAST, CPA LUMAX THEN GO RSS DUMP LINE. JMP DNLU1 ELSE CONTINUE. * JSB OUTPT PRINT STACK. JSB STARS E0L + LINE OF ASERISKS. * JSB SETPT RESET STACK FOR DOWN EQTS LDA .DNEQ PRINT LINE HEAD JSB MVBYT DEF D10 LDA STKPT SAVE CURRENT POSITION STA PTR IN CASE WE NEED ANOTHER LINE * LDA EQTA GET EQT TABLE AREA ADDRESS ADA D4 INDEX TO STATUS STA EQTPT PUSH POINTER CLA INIT STA #EQTS EQT COUNTER DEVLP JSB .XLA EQTPT,I DEF EQTPT,I FIND EQT'S. GET STATUS ISZ #EQTS RAL,RAL POSITION AND D3 & MASK CPA D1 IS IT DOWN RSS YES-PROCESS JMP NXTDV NO-NEXT EQT * LDA .LAST CLE,ELA CMA,INA NEGATE LAST POSITION ADA STKPT TO SEE IF FULL YET? SSA FULL YET? JMP DNEQ2 NO, DO IT * JSB OUTPT DUMP LINE LDA PTR SET UP FOR ANOTHER LINE STA STKPT JUST LIKE THE PREVIOUS DNEQ2 LDA .CMBL PUSH "," JSB MVBYT DEF D1 LDA #EQTS CONV EQT# TO ASCII JSB .ASC3 NXTDV LDA EQTPT BUMP ADA D15 TO  NEXT STA EQTPT EQT STATUS WORD LDA #EQTS WAS THIS THE LAST CPA EQT# RSS YES-DUMP IT JMP DEVLP NO-CONTINUE SPC 2 DONE JSB OUTPT PRINT STACK DONE1 JSB STARS EOL + LINE OF ASTERISKS EXIT JSB TOD FINALLY TIME OF DAY LDA .EOF ANOTHER BLANK LINE LDB DM6 JSB PRINT SPC 2 IFZ JMP WHZIT,I RETURN FOR DUMP ALAL. VERSION XIF IFN LDA XEQT CHECK IF I AM IN TIME LIST ADA D17 XLA A,I GET THE WORD (*****NOTE*****) ALF,SLA WELL?? LDA PARM2 YES USE CURRENT PRAM2 STA PARM2 NO RESET PARM2 JSB EXEC I AM SERIALLY REUSABLE DEF RSTRT DEF D6 DEF ZERO DEF M1 DEF ZERO DEF PARM2 DEF CRTLU DEF SESID RSTRT JMP WHAT RESTART XIF SPC 2 ZERO OCT 0 D18 DEC 18 DM6 DEC -6 RNTBL NOP CLASS NOP NUM NOP D4 DEC 4 .DNEQ DEF *+1 ASC 5,DOWN EQT'S .DNLU DEF *+1 ASC 5,DOWN LU'S D9 DEC 9 * .EOF DEF *+1 OCT 0,0,20040 .HEAD DEF *+1 OCT 0,0 ASC 10,PT SZ PRGRM,T ,PRIOR ASC 10,*DRMT*SCHD*I/O *WAIT ASC 10,*MEMY*DISC*OPER * NE ASC 5,XT TIME *** SKP SPC 2 FROM BSS 2 TO EQU FROM+1 B377 OCT 377 SPC 2 STBYT NOP LDB TO OCT 105764 JSB SBT STB TO JMP STBYT,I SPC 2 * ('A'REG = WORD ADDRESS OF FROM) * JSB MVBYT * DEF COUNT * MVBYT NOP CLE,ELA LDB STKPT DST FROM LDA MVBYT,I ISZ MVBYT STA .MVBY DLD FROM OCT 105765 JSB MBT .MVBY NOP NOP STB STKPT JMP MVBYT,I SPC 2 PSTAR NOP LDA .STAR JSB MVBYT DEF D1 JMP PSTAR,I SPC 2 SETPT NOP LDA .STAK ADA D2 CLE,ELA STA STKPT JMP SETPT,I SPC 2 OUTPT NOP LDA .STAK LDB .STAK CLE,ELB CONV TO BYTES CMB,INB ADB STKPT ADD ON CURRENT BYTE POSITION CMB,INB JSB PRINT JMP OUTPT,I SPC 2 STARS NOP LDA .ASTE LDB DM74 JSB PRINT JMP STARS,I * DM74 DEC -74 SPC 2 * 'A'REG = UPPER LIMIT * 'B'REG = LOWER LIMIT * TEST = ??????????? * JSB TESTR * RETURN -'A'REG : POS => FALSE NEG => TRUE . TESTR NOP CMB,CLE,INB ADB TEST LDB TEST CMB,SEZ,CLE,INB ADB A ERA SIGN = E. E=0 FALSE E=1 TRUE JMP TESTR,I SPC 2 TSTWD NOP LDB TSTWD,I GET ADDR OF TABLE ISZ TSTWD JSB .XLA B,I GET UPPER LIMIT BY ADDING DEF B,I ADA B SIZE OF TABLE TO ADDR STB SAVEB SAVE ADDR OF TABLE AS LOWER LIMIT JSB TESTR SSA,RSS ISZ TSTWD LDA SAVEB CMA,INA ADA TEST JMP TSTWD,I SPC 2 * (A) = ID SEG ADDR * JSB MVNAM * MVNAM NOP MOVE NAME FROM ID SEG TO OUTPUT LINE STA LNAID SAVE LAST ID NAME USED ADA D12 LDB D3 CBX MOVE 3 WORDS FROM SYSTEM MAP LDB DWRD1 BECAUSE MBF REQUIRES JSB .MWF DEST. TO BE AT EVEN WORD LDA DWRD1 JSB MVBYT DEF D5 JMP MVNAM,I * WORD1 NOP WORD2 NOP WORD3 NOP SPC 2 PRINT NOP STA .BUFF STB CNT JSB EXEC DEF *+1+4 DEF D2 DEF CRTLU .BUFF DEF STACK DEF CNT JMP PRINT,I * TOD NOP JSB SETPT LDA @TIME JSB CNVTM JSB OUTPT JMP TOD,I SPC 2 @TIME DEF $TIME+0 MS NOP SEC NOP MIN NOP HOURS NOP DAY NOP .HOUR DEF HOURS .COLN DEF *+1 ASC 1,:: .ZERO DEF *+1 ASC 1,00 SPC 2 CNVTM NOP LDB D3 MOVE 3 WORDS OF TIME CBX 0 TO USER MAP FROM SYS MAP LDB DWRD1 JSB .MWF JSB TMVAL CONVERT INTO COMPONENTS DEF *+1+2 DWRD1 DEF WORD1 DEF MS LDA .HOUR STA PTR LDA DM4 STA CNT JMP TLOOR * TLOOP LDA .COLN PUSH A ":" OUT JSB MVBYT DEF D1 TLOOR LDA PTR,I JSB .ASC2 CONVERT TIME TO ASCII CCA ADA PTR STA PTR ISZ CNT JMP TLOOP * LDA .ZERO ADD "0" FOR LAST NUMBER JSB MVBYT TO MULTIPLY BY 10 FOR MS DEF D1 JMP CNVTM,I RETURN WITH ASCII VALUES IN ARRAY TIME SPC 2 IDWRD NOP ADB IDPNT JSB .XLA B,I DEF B,I JMP IDWRD,I SPC 2 * 'A'REG = BINARY VALUE * 'B'REG = 5 MINUS NUMBER OF DIGITS TO BE CONVERTED * 'E'REG = 0 FOR NO ZEROES, 1 FOR LEADING ZEROES * JSB ASCII * 'A'REG = LAST BYTE * 'B'REG = BYTE ADDRESS UPDATED * ASCII NOP STA VAL CLA ELA STA FILL LDA STKPT STA TO LDA B (A)=(B)=DIGIT COUNT CODE ADB DM4 STB CCNTR SZB,RSS IF ONLY ONE DIGIT JMP LSTDG GO TO LAST DIGIT CODE ADA .N10K ADJUST POWERS OF TEN TO STA QPNTR NUMBER OF DIGITS DESIRED LOOP LDA VAL CLB DIV QPNTR,I DIVIDE BY POWER OF TEN STB VAL SAVE REMAINDER (LOWER DIGITS) SZA JMP ASCNV CPA FILL LEADING ZEROES WANTED? JMP LZERO NO, BLANK OUT IF E#0 ORIGINALLY ASCNV IOR B60 NOT 0 OR LEADING 0 WANTED STA FILL SO INSURE NO 0 GETS LOST ASCST JSB STBYT ISZ QPNTR INCRE TO NEXT POWER OF TEN ISZ CCNTR BUMP DIGIT COUNTER JMP LOOP MORE THAN 1 DIGIT LEFT LSTDG LDA VAL IOR B60 DO LAST DIGIT EVEN IF ZERO JSB STBYT STB STKPT (B) IS STILL NEXT BYTE ADDR JMP ASCII,I * LZERO LDA B40 REPLACE LEADING ZEROES JMP ASCST WITH =BLANKS SPC 2 .ASC1 NOP CONVERT 1 DIGIT TO ASCII CLE LDB D4 JSB ASCII JMP .ASC1,I SPC 2 .ASC2 NOP CONVERT BINARY TO ASCII CLE LDB D3 JSB ASCII JMP .ASC2,I SPC 2 .ASC3 NOP CONVERT 3 DIGITS, LEADING BLANKS CLE LDB D2 JSB ASCII JMP .ASC3,I SPC 2 ZASC3 NOP CONVERT 3 DIGITS, LEADING ZEROES CCE LDB D2 JSB ASCII JMP ZASC3,I SPC 2 .ASC4 NOP CONVERT 4 DIGITS, LEADING BLANKS CLB,CLE,INB JSB ASCII JMP .ASC4,I SPC 2 .ASC5 NOP CONVERT 5 DIGITS, LEADING BLANKS CLB,CLE JSB ASCII JMP .ASC5,I SPC 2 ZASC5 NOP CONVERT 5 DIGITS, LEADING ZEROES CLB,CCE JSB ASCII JMP ZASC5,I SPC 2 VAL NOP .N10K DEF N10K N10K DEC 10000,1000,100,10 D1 DEC 1 D10 EQU N10K+3 QPNTR NOP CCNTR NOP FILL NOP SAVEB EQU VAL B40 OCT 40 D32 EQU B40 B60 OCT 60 SKP WHATP LDA .PHED LDB DM38 JSB PRINT PRINT HEADING FOR PARTITION STUFF JSB STARS '**********' * CLA,INA STA PTN# INIT PARTITION NUMBER CLA SET STA UFLAG NO. UNDEFINED TO ZERO JSB .XLA $MATA @MATA DEF $MATA STA PTNAD INIT PARTITION ADDR JSB .XLA $MNP GET # OF PARTITIONS @MNP DEF $MNP SZA,RSS JMP DONE IN CASE BOO-BOO MPY D7 ADA PTNAD CALCULATE ADDR OF STA LPTAD LAST PARTITION * NXPTN JSB .XLA PTNAD,I GET LINK WORD DEF PTNAD,I SSA,RSS PARTITION DEFINED? JMP CKPTN YES, CHECK STUFF * IFZ * LDB D3 UNDEFINED BUT WAS JSB PTNWD THIS DUE TO A SZA,RSS PARITY ERROR ? JMP UNDEF NO * LDA .PERR GET THE PARITY ERROR JSB MVBYT MESSAGE & DEbF D16 JMP DMPTN DUMP IT * XIF UNDEF ISZ UFLAG STEP UNDEFINED FLAG JMP DMP0 GO STEP THE PT. NO. * * CKPTN JSB FLUSU FLUSE UNDEFINED IF ANY JSB SETPT SET UP THE NEW LINE LDA PTN# JSB .ASC2 PUT PART. NO. ON LINE LDB D3 JSB PTNWD GET WORD 4 SSA,RSS IS IT MOTHER PTTN? JMP NTMOM NO * LDA .M FILL IN 'M' JMP DOMCS * NTMOM LDB D4 JSB PTNWD GET WORD 5 RAL SSA,RSS IS SUBPTTN IN CHAIN MODE? JMP NTCHN NO * LDA .C FILL IN 'C' JMP DOMCS * NTCHN LDB D6 JSB PTNWD GET WORD 7 STA B LDA .SPAC USE SPACE IF NOT SUBPTTN SZB LDA .S ELSE FILL IN 'S' DOMCS JSB MVBYT DO 'M' 'C' OR 'S' DEF D1 * CKRES LDB D4 JSB PTNWD CALC ADDR OF RES-SIZE CLE,ELA RAR KEEP ONLY 10 BITS AND B1777 (STATUS JUNK IN HIGH BITS) STA PTSIZ SAVE SIZE OF PART. LDA .SPAC OUTPUT SPACE IF NOT RESERVED SEZ ELSE LDA .R USE 'R ' IF RESERVED JSB MVBYT DEF D1 * LDA PTSIZ GET PART. SIZE (MAX=1024) INA ADD 1 FOR BASE PAGE JSB .ASC5 CONVERT TO ASCII + OUTPUT * LDA .SPAC JSB MVBYT 2 MORE SPACES DEF D2 * LDB D3 JSB PTNWD ADDR OF START PAGE # AND B1777 PAGE # IN LOW 10 BITS ONLY STA PAGE# JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDA .DASH JSB MVBYT PUT "-" ON OUTPUT STACK DEF D1 * LDA PAGE# ADA PTSIZ CALCULATE LAST PAGE # JSB .ASC4 CONVERT + OUTPUT 4 DIGITS * LDB D5 JSB PTNWD CLE,ELA PUT RT-BG BIT INTO (E) LDA .BG 'BG " IF BACKGROUND SEZ ELSE LDA .RT ' RT' IF REAL-TIME JSB MVBYT CLASS P,ARTITION DEF D7 * LDB D2 JSB PTNWD SZA,RSS EMPTY? JMP NOPRG YES, PRINT '' JSB MVNAM MOVE NAME TO OUTPUT * DMPTN JSB OUTPT DUMP OUTPUT STACK DMP0 ISZ PTN# INCRE PARTITION # LDA PTNAD ADA D7 INCRE TO NEXT PARTITION ADDR STA PTNAD CPA LPTAD DONE YET? RSS YES. PRINT TIME, EXIT JMP NXPTN NO. DO NEXT PARTITION * JSB FLUSU FLUSH FINAL UNDEFS IF ANY JMP DONE1 AND GO EXIT * NOPRG LDA .NONE JSB MVBYT DEF D6 JMP DMPTN SPC 2 PTNWD NOP ADB PTNAD JSB .XLA B,I DEF B,I JMP PTNWD,I * * FLUSU NOP ROUTINE TO PUT OUT LINE FOR UNDEFINED PART. LDA UFLAG ARE THERE ANY? SZA,RSS WELL? JMP FLUSU,I NO JUST RETURN * JSB SETPT YES START A LINE LDA UFLAG CACULATE THE FIRST PT. NO. CMA,INA FROM COUNT AND CURRENT #. ADA PTN# THERE JSB .ASC2 SEND IT OUT LDA UFLAG CHECK IF MORE THAN 1 CPA D1 WELL JMP ONLY1 NO JUST ONE * LDA .MINU ELSE SEND RANGE '-' JSB MVBYT TO THE LINE DEF D1 CCA NOW GET THE LAST NUMBER ADA PTN# AND SEND IT JSB .ASC2 TO THE LINE ONLY1 LDA .UNDF SEND THE UNDEF LINE JSB MVBYT DEF D14 CLA STA UFLAG JSB OUTPT SEND THE LINE JMP FLUSU,I ALL DONE EXIT SPC 2 .PHED DEF *+1 OCT 0,0 ASC 17,PTN# SIZE PAGES BG/RT PRGRM * .MINU DEF *+1 ASC 1,-- UFLAG NOP .UNDF DEF *+1 ASC 7, .PERR DEF *+1 ASC 8, * .R DEF *+1 ASC 1,RR * .S DEF *+1 ASC 1,SS * .C DEF *+1 ASC 1,CC * .M DEF *+1 ASC 1,MM * .DASH DEF *+1 ASC 1,- * .BG DEF *+1 ASC 4, BG * .N!JONE DEF *+1 ASC 3, .RT DEF *+1 ASC 4, RT * B1777 OCT 1777 DM38 DEC -38 PTSIZ EQU STATS PTNAD EQU EQTPT PTN# EQU IDCNT LPTAD EQU IDPNT PAGE# EQU #EQTS UNS END FTN4,L,Q SUBROUTINE VESUB(IPRS2,SDCB1) IMPLICIT INTEGER (A-Z) C COMMON /GORT/ FND2(257) C DIMENSION FND(256) DIMENSION MES2(22), MES3(19) C DATA MES2/2H22,2HBA,2HD ,2HTI,2HME,2H L,2HIS,2HT ,2HPO,2HIN, & 2HTE,2HR ,2HFO,2HR ,2HID,2H S,2HEG,2H A,2HT ,2H.., & 2H..,2H../ DATA MES3/2H19,2HID,2H S,2HEG,2HME,2HNT,2H A,2HT ,2H..,2H.., & 2H..,2H N,2HOT,2H I,2HN ,2HAN,2HY ,2HLI,2HST/ C C VESUB VERIFIES THE LINK LISTS OF THE ID SEGMENTS. IT C CHECKS THAT ALL OCCUPIED SEGMENTS ARE IN THE APPROPRIATE C SCHEDULER LIST BY CROSS-CHECKING THEIR STATUS. THE C POINTERS OF THE TIME LIST ARE ALSO VALIDTED. C C IF $ZZZZ IS NON-ZERO, THIS FACT IS NOTED. C C------------------------------------------------------------------ C C SCAN THE KEYWORD TABLE TO FIND THE LAST LONG ID SEGMENT C KEYTB = SGET(1657B) KBEG = SGET(KEYTB) DO 20 K = KEYTB,KEYTB+256 J = K - KEYTB + 1 FND2(J) = SGET(K) IF(FND2(J).EQ.0) GO TO 30 IF(IAND(SGET(SGET(K)+14),20B).NE.0) GO TO 30 20 CONTINUE CALL PRNT(34H17CAN'T FIND END OF KEYWORD TABLE ) 30 K = K - 1 FND2(J) = 0 KEND = SGET(K) C C ZERO OUT FLAG ARRAY; LOCATE $ZZZZ C DO 40 J = 1,256 FND(J) = 0 40 CONTINUE CALL FNDET(6H$ZZZZ ,IERR,SDCB1,MYTYP,ZZZZ) C C TRACE THE FIVE SCHEDULER LISTS AND $ZZZZ C IF (TLIST(FND,ZZZZ, KBEG,KEND,0).NE.0) RETURN IF (TLIST(FND,1711B,KBEG,KEND,1).NE.0) RETURN IF (TLIST(FND,1713B,KBEG,KEND,3).NE.0) RETURN IF (TLIST(FND,1714B,KBEG,KEND,4).NE.0) RETURN IF (TLIST(FND,1715B,KBEG,KEND,5).NE.0) RETURN IF (TLIST(FND,1716B,KBEG,KEND,6)0.NE.0) RETURN C C NOW CHECK FOR DORMANT, I/O WAIT, AND TIME LIST C DO 70 L = KEYTB,K J = IGET(L) IF(IFBRK(0).NE.0) RETURN IST = IAND(IGET(J+15),17B) C C TEST FOR STATUS NOT 0 OR 2 AND NOT IN LIST C 50 IF(IST.EQ.0 .OR. IST.EQ.2 .OR. FND(IFND(J)).NE.0) & GO TO 60 CALL OCT(J,MES3(9)) CALL PRNT(MES3) C C TEST FOR INVALID TIME LIST POINTERS C 60 TON = IAND(IGET(J+17),10000B) TLNK = IGET(J+16) IF(TON.EQ.0 .OR. TLNK.EQ.0 .OR. & (TLNK.GE.KBEG .AND. TLNK.LE.KEND)) GO TO 70 CALL OCT(J,MES2(20)) CALL PRNT(MES2) 70 CONTINUE IF(IGET(ZZZZ).EQ.0) RETURN CALL PRNT(40H20$ZZZZ IS NON-ZERO - CRASH WAS IN $LIST) RETURN END INTEGER FUNCTION TLIST(FND,ADR,KBEG,KEND,ST) IMPLICIT INTEGER (A-Z) DIMENSION FND(256) DIMENSION MES1(22),MES2(25),MES3(14) C DATA MES1/2H22,2HST,2HAT,2HUS,2H D,2HOE,2HSN,2H'T,2H A,2HGR, & 2HEE,2H F,2HOR,2H I,2HD ,2HSE,2HG ,2HAT,2H ,2H.., & 2H..,2H../ DATA MES2/2H25,2HID,2H S,2HEG,2H A,2HPP,2HEA,2HRS,2H I,2HN , & 2HLI,2HST,2HS ,2HMO,2HRE,2H T,2HHA,2HN ,2HON,2HCE, & 2H A,2HT ,2H..,2H..,2H../ DATA MES3/2H14,2HIN,2HVA,2HLI,2HD ,2HPO,2HIN,2HTE,2HR , & 2HAT,2H ,2H..,2H..,2H../ C C TLIST TRACES THE SCHEDULER LIST SPECIFIED BY ADR AND SETS WORDS C IN FND TO ONE TO INDICATE THAT ID SEGMENTS ARE IN SOME SCHEDULER C LIST. THE RETURN VALUE IS 0 OR -1, DEPENDING ON WHETHER OR NOT C A BREAK WAS DETECTED DURING EXECUTION C C--------------------------------------------------------------------- TLIST = 0 ADDR = ADR C C CHECK FOR ITEMS IN MORE THAN ONE LIST C 5 IF(IFBRK(0).NE.0)RETURN ADDR2 = ADDR ADDR = IGET(ADDR) IF(ADDR.EQ.0) RETURN T = IFND(AXDDR) IF(T.EQ.0) GO TO 8 IF(FND(T).EQ.0) GO TO 7 CALL OCT(ADDR,MES2(23)) CALL PRNT(MES2) RETURN 7 FND(T) = 1 C C CHECK FOR CORRECT STATUS C IF(IAND(IGET(ADDR+15),17B).EQ.ST.OR.ST.EQ.0)GOTO 8 CALL OCT(ADDR,MES1(20)) CALL PRNT(MES1) C C CHECK FOR POINTER IN RANGE C 8 IF(IFND(ADDR).NE.0)GO TO 5 CALL OCT(ADDR2,MES3(12)) CALL PRNT(MES3) RETURN 20 GO TO 5 END INTEGER FUNCTION IFND(IADDR) IMPLICIT INTEGER (A-Z) COMMON /GORT/ FND2(257) C DO 10 IFND = 1,257 IF(FND2(IFND).EQ.0) GO TO 20 IF(FND2(IFND).EQ.IADDR) RETURN 10 CONTINUE 20 IFND = 0 RETURN END BLOCK DATA GORT,BLOCK DATA FOR VESUB IMPLICIT INTEGER (A-Z) COMMON /GORT/ FND2(257) C END END$ [ U} 24999-18198 2024 S 0100 &SNPSH SOURCE             H0101 FTN4,L,Q,T PROGRAM SNPSH ,,89 IMPLICIT INTEGER (A-Z) DIMENSION IDCB1(144), IDCB2(144), IBUF(128), JBUF(30), PBUF(10) DIMENSION MES1(8), MES4(13) DATA MES1/2HSN,2HAP,2HSH,2HOT,2H W,2HRI,2HTT,2HEN/ DATA MES4/2HER,2HRO,2HR ,2HIN,2H F,2HIL,2HE ,2HWR,2HIT,2HE:, &2H R,2HET,2HRY/ C DEFINE SYSTEM LOCATIONS DATA DSCLB/1761B/, DSCLN/1762B/, SYSLN/1764B/, SECT2/1757B/ C C-------------------------------------------------------------------- C C RU,SNPSH,DEST1,DEST2 C C SNPSH PUTS A SNAPSHOT OF ALL ENTRY POINTS INTO DEST1, C AND AN IMAGE OF THE 32K OF THE SYSTEM MAP INTO DEST2. C C THE ENTRY POINTS ARE FOUND AT DSCLB IN THE SYSTEM C COMMUNICATIONS AREA. THERE ARE DSCLN+SYSLN 4 WORD ENTRIES. C C THE IMAGE OF THE SYSTEM IS TAKEN FROM TWO PLACES: C THE FIRST PAGE IS TAKEN FROM THE DISK, STARTING AT SECTOR C $SSCT. THE NEXT 31K OF THE SYSTEM IS COPIED FROM THE SYSTEM C MAP WITH IXGET. THE FINAL PORTION (THE DRIVER PARTITIONS) C ARE TAKEN FROM THE DISK. THE NUMBER OF PAGES IS DETERMINED BY C THE CONTENTS OF $MRMP ($MRMP CONTAINS THE PAGE NUMBER OF THE C FIRST PAGE AFTER THE END OF THE DRIVER PARTITIONS. C C SECT2 CONTAINS THE NUMBER OF SECTORS/TRACK ON LU 2. C C DEST1 AND DEST2 MAY BE LU'S OR FILES. C C LAST MODIFIED 12/05/79 BY JEF C C-------------------------------------------------------------------- C ILU = LOGLU(IDUM) C C CALCULATE LOCATION OF ENTRY POINTS C ISCNT = IXGET(SECT2) ITRK = IXGET(DSCLB)/128 ISECT = IAND(IXGET(DSCLB),177B) ICNT = IXGET(DSCLN)+IXGET(SYSLN) C C GET PARAMETERS C CALL EXEC(14,1,JBUF,-60) CALL ABREG(A,B) C C WIPE OUT "RU,SNPSH," C ICHAR = 1 CALL NAMR(PBUF,JBUF,B,ICHAR) CALL NAMR(PBUF,JBUF,B,ICHAR) C C PARSE PARMS, CREATE AND OPEN4 FILES C CALL CSUB(JBUF,ICHAR,B,IDCB1,IERR,(ICNT+31)/32,ILU) C C**** DUMP ENTRY POINTS C SSCT = 0 MRMP = 0 DO 100 I = 1,(ICNT+31)/32 C C READ A 64 WORD SECTOR OF ENTRY POINTS C CALL EXEC(1,102B,IBUF,64,ITRK,ISECT) ISECT = ISECT + 1 IF (ISECT.NE.ISCNT) GO TO 80 ISECT = 0 ITRK = ITRK + 1 C C READ ANOTHER 64 WORD SECTOR OF ENTRY POINTS C 80 CALL EXEC(1,102B,IBUF(65),64,ITRK,ISECT) ISECT = ISECT + 1 IF (ISECT.NE.ISCNT) GO TO 90 ISECT = 0 ITRK = ITRK + 1 C C IF THIS IS THE END OF THE AREA, ZERO OUT THE C REST OF THE BUFFER C 90 IF (ICNT.GT.31) GO TO 97 DO 95 J = (ICNT*4+1),128 IBUF(J) = 0 95 CONTINUE C C WRITE A 128 WORD OUTPUT RECORD C 97 CALL WRITF(IDCB1,IERR,IBUF,128) ICNT = ICNT - 32 IF(IERR.GE.0) GO TO 98 CALL EXEC(2,ILU,MES4,13) CALL CCLOS(IDCB1) STOP C C CHECK THE BUFFER FOR $SSCT (SECTOR ADDR OF BOOT IMAGE) C 98 DO 99 J = 1,128,4 IF(IBUF(J).EQ.2H$S.AND. & IBUF(J+1).EQ.2HSC.AND. & IAND(IBUF(J+2),177400B).EQ.IAND(2HT ,177400B)) & SSCT = IBUF(J+3) 99 CONTINUE C C CHECK THE BUFFER FOR $MRMP (ADDR OF MR MAP) C DO 96 J = 1,128,4 IF(IBUF(J).EQ.2H$M.AND. & IBUF(J+1).EQ.2HRM.AND. & IAND(IBUF(J+2),177400B).EQ.IAND(2HP ,177400B)) & MRMP = IBUF(J+3) 96 CONTINUE 100 CONTINUE C C CLOSE 1ST FILE C CALL CCLOS(IDCB1) C C**** DUMP THE SYSTEM IMAGE C C CHECK THE VALUE OF $MRMP AND C(C($MRMP)); THEN C OPEN THE SECOND FILE C SSCT = IXGET(SSCT) IF(MRMP.NE.0) GO TO 110 CALL EXEC(2,ILU,38H$MRMP UNDEFINRED; NO DRIVER PARTITIONS ,-38) 110 MRMP = IXGET(IXGET(MRMP)) IF(MRMP.LT.32) MRMP = 32 IF(MRMP.GT.64) MRMP = 48 C CALL CSUB(JBUF,ICHAR,B,IDCB2,IERR,8*MRMP,ILU) C C DUMP THE FIRST PAGE FROM THE BOOT IMAGE ON THE DISK C CALL DMP(SSCT, ISCNT, 8, IBUF, IDCB2, ILU) C C NOW DUMP PAGES 2-32 OF THE SYSTEM MAP C ICNT = 0 DO 200 J = 1024,32767 C C GET A WORD FROM THE SYSTEM MAP C ICNT = ICNT + 1 IBUF(ICNT) = IXGET(J) C C IF WE HAVE ACCUMULATED 128 WORDS, OUTPUT IT C IF(ICNT.LT.128) GO TO 200 ICNT = 0 CALL WRITF(IDCB2,IERR,IBUF,128) IF(IERR.GE.0) GO TO 200 CALL EXEC(2,ILU,MES4,13) CALL CCLOS(IDCB2) STOP 200 CONTINUE C C NOW DUMP THE DRIVER PARTITIONS C CALL DMP(SSCT+512, ISCNT, (MRMP-32)*8, IBUF, IDCB2, ILU) C C CLOSE FILE AND WRITE TERMINATION MESSAGE C 300 CALL CCLOS(IDCB2) CALL EXEC(2,ILU,MES1,8) C END SUBROUTINE CSUB(IBUF,ICHAR,LEN,IDCB,IERR,ISIZE,ILU) IMPLICIT INTEGER (A-Z) DIMENSION IDCB(144), IBUF(128), PBUF(10) DIMENSION MES2(19),MES3(18),MES5(7) DATA MES2/2HSP,2HEC,2HIF,2HY ,2HOU,2HTP,2HUT,2H F,2HIL,2HES, &2H/L,2HUS,2H (,2H2 ,2HRE,2HQU,2HIR,2HED,2H) / DATA MES3/2HFI,2HLE,2H C,2HAN,2HNO,2HT ,2HBE,2H C,2HRE,2HAT, &2HED/ DATA MES5/2HCA,2HNN,2HOT,2H O,2HPE,2HN ,2HLU/ C C SUBROUTINE TO PARSE A NAMR/LU AND C A) NAMR - CREATE AND OPEN THE FILE C B) LU - LOCK AND OPEN THE LU C----------------------------------------------------------------- C C PARSE THE NAMR C HOLD = NAMR(PBUF,IBUF,LEN,ICHAR) PBUF(4) = IAND(PBUF(4),3B) IF(HOLD.GE.0.AND.(PBUF(4).EQ.1.OR.PBUF(4).EQ.3)) GO TO 10 CALL EXEC(2,ILU,MES2,19) STOP C C CREATE AND OPEN IF A FILE; IF IT ALRO;EADY EXISTS, AN ERROR C MESSAGE IS PRINTED AND THE PROGRAM EXITS. C 10 IF(PBUF(4).EQ.1) GO TO 20 CALL CREAT(IDCB,IERR,PBUF,ISIZE,1,PBUF(5),PBUF(6)) IF(IERR.GE.0) RETURN CALL EXEC(2,ILU,MES3,11) STOP C C AN LU WAS SPECIFIED; LOCK AND OPEN IT C C ELSE 20 CALL LURQ(1,PBUF(1),1) CALL OPENF(IDCB,IERR,PBUF,110B) IF(IERR.GE.0) RETURN CALL EXEC(2,ILU,MES5,7) STOP END SUBROUTINE CCLOS(IDCB) IMPLICIT INTEGER (A-Z) DIMENSION IDCB(144) C C SUBROUTINE TOWWRITE AN END-OF-FILE, REWIND THE FILE, C CLOSE IT, AND RELEASE ALL LU'S C CALL WRITF(IDCB,IERR,IBUF,-1) CALL RWNDF(IDCB,IERR) CALL CLOSE(IDCB) CALL LURQ(100000B,IDMY,IDMY) RETURN END SUBROUTINE DMP(SCT,ISCNT,LEN,IBUF,IDCB2,ILU) IMPLICIT INTEGER (A-Z) DIMENSION IBUF(128),IDCB2(144) C C DMP DUMPS BLOCKS FROM THE BOOT IMAGE TO THE SNAP FILE C C SECT SECTOR ADDRESS ON THE DISK C ISCNT NUMBER OF SECTORS/TRACK C LEN NUMBER OF BLOCKS TO COPY C IBUF BUFFER (128 WORDS) C IDCB2 DCB FOR THE OUTPUT FILE C ILU LU OF THE TERMINAL C C--------------------------------------------------------------------------- C SECT = SCT TRK = SECT/ISCNT SECT = SECT - TRK*ISCNT IF(LEN.LE.0) RETURN DO 150 J = 1,LEN C C GET A 64 WORD SECTOR C CALL EXEC(1,102B,IBUF,64,TRK,SECT) SECT = SECT+1 IF(SECT.LT.ISCNT) GO TO 130 TRK = TRK+1 SECT = 0 C C GET ANOTHER 64 WORD SECTOR C 130 CALL EXEC(1,102B,IBUF(65),64,TRK,SECT) SECT = SECT+1 IF(SECT.LT.ISCNT) GO TO 140 TRK = TRK+1 SECT = 0 C C WRITE 128 WORDS TO THE OUTPUT C 140 CALL WRITF(IDCB2,IERR,IBUF,128) IF/7(IERR.GE.0) GO TO 150 CALL EXEC(2,ILU,26HERROR IN FILE WRITE: RETRY,13) STOP 150 CONTINUE RETURN END END$  V ` 24999-18199 2024 S 0100 &CDMP SOURCE             H0101 ASMB,A,L,C HED CDMP - STANDALONE DUMP TO CART ORG 2 RUN PROGRAM JMP 3,I BY SETTING P REG DEF CDMP TO 2 * * ORG 77000B * * !CDMP IS A STANDALONE PROGRAM THAT DUMPS A CRASHED * SYSTEM TO THE LEFT CARTRIDGE TAPE * * THE PROGRAM DUMPS 48K OF MEMORY AND THE 4 SYSTEM MAPS, FOLLOWED * BY THE CONTENTS OF THE SYSTEM AND USER ADDRESS SPACES. NOTE * THAT THE DUMP ORDER IS: THE FIRST 32K, THE MAPS, THE NEXT 16K, * AND THE PAGES OF THE SYSTEM AND USER ADDRESS SPACES THAT ARE NOT * IN THE FIRST 48K. * * A HALT 42 INDICATES A NONRECOVERABLE WRITE ERROR. BY HITTING * RUN YOU CAN TRY AGAIN. * A HALT 70 INDICATES A PAUSE TO CHANGE TAPES. * (AFTER THE MAPS, AFTER THE DRIVERS, AND AFTER THE SYSTEM A.S.) * A HALT 77 INDICATES A NORMAL COMPLETION. * (AFTER THE USER ADDRESS SPACE) * * TO RUN -- SET THE P REGISTER TO 2 AND THE S REGISTER TO * THE SELECT CODE OF THE TERMINAL. * * THIS PROGRAM IS PART OF THE CRASH DUMP ANALYSIS PACKAGE * * * EJH ??/??/?? * JEF 01/16/80 CHANGED TO DUMP ANOTHER 16K, SYSTEM AND USER * ADDRESS SPACES, AND "DEAD SPOT" - SEE END OF FILE * * A EQU 0 B EQU 1 SC EQU 25B ***** * * CONFIGURE * ***** CDMP LIA 1 LOAD DISPLAY REG INTO A REG ADA SFS1 BUILD INST SFS SC STA FIX1 ADA LIA2 BUILD INST LIA SC STA FIX3 ADA OTA3 BUILD INST OTA SC STA FIX4 ADA STC4 BUILD INST STC SC,C STA FIX5 STA FIX2 ***** * * MAIN ROUTINE * ***** INIT RSA SAVE MEMORY STA MSTAT STATUS REGISTER * * DUMP THE FIRST 32K OF PHYSICAL MEMORY (MAPPING OFF) * CLB STARTING ADDR STB DPAD OF DUMP PH1 JSB WRIT WRITE 128 WORDS LDB DPAD INCR ADB B200 DUMP ADDRESS STB DPAD SSB,RSS  ARE WE DONE? JMP PH1 NO - DO ANOTHER RECORD * * WRITE MAPS TO THE CART AND PAUSE * JSB MAPS JSB EOF WRITE AN EOF ON THE TAPE HLT 70B PAUSE * * TURN THE MAPS ON * LDA D32 CAX LOAD 32 MAP REGISTERS CLA STARTING WITH MR 0 CLB AND VALUES FROM 0 XMS SET MAPS SJP CONT TURN ON MAPS * * SINCE WE CAN'T DETERMINE WHERE THE DRIVER PARTITIONS * END, WE ALWAYS DUMP 48K * HERE, WE DUMP THE LATTER 16K (MAPS ON) * CONT LDB D32 SET STB CPAGE CURRENT PAGE NUMBER * * WRITE PAGES TO CART. PAUSE WHEN DONE * PH2 JSB POUT PUT OUT PAGE ISZ CPAGE BUMP PAGE # LDB CPAGE CPB DLIM LAST PAGE? RSS JMP PH2 NO - DO MORE JSB EOF WRITE AN EOF ON THE TAPE HLT 70B LET THE USER CHANGE CARTS * * DUMP THE CONTENTS OF THE SYSTEM AND USER MAPS * DO NOT DUMP PAGES THAT ALREADY HAVE BEEN DUMPED * I.E., PAGES IN THE FIRST 48K OF PHYSICAL MEMORY * PAUSE AFTER THE SYSTEM MAP IS DUMPED. * LDA B2000 INIT STA MADDR LOOP WL LDA MADDR,I GET PAGE # AND B1777 MASK OUT READ/WRITE PROTECT STA TMP HOLD CMA,INA CHECK ADA DLIM IF PAGE HAS TO CMA,SSA,INA,SZA BE DUMPED JMP NEXT NO - PAGE WAS ALREADY DUMPED LDB TMP YES - WRITE JSB POUT PAGE NEXT ISZ MADDR BUMP PAGE LDA MADDR NUMBER CPA B2040 ARE WE THROUGH THE SYSTEM MAP? JMP HPAUS YES - PAUSE CPA B2100 ARE WE ALL DONE? RSS JMP WL NO - CONTINUE JSB EOF YES - WRITE AN EOF ON THE TAPE STOP HLT 77B THE END!! JMP STOP * HPAUS JSB EOF WRITE AN EOF ON THE TAPE HLT 70B PAUSE TO LET THE USER CHANGE CARTS JMP WL DO NEXT ITERATION * * SUBROUTINE TO WRITE AN EOF ON THE TAPE * EOF DEF *-* LDB ESC JSB OTWD LDB P5 JSB OTWD LDA C JSB OTBYT JMP EOF,I RETURN * * MAPS WRITES THE FOUR MAPS TO THE TAPE/CART * MAPS NOP LDA BADDR SAVE SYA USA MAPS PAA PBA LDB D1 WRITE JSB MSETM -SET MAP- LDB B2000 MAPS JSB WRIT JMP MAPS,I RETURN * * POUT WRITES A PAGE OF MEMORY TO THE CART * THE A REGISTER HAS THE PAGE NUMBER * POUT NOP JSB MSETM SET MAP LDB B4000 INIT STB DPAD ADDR PCONT JSB WRIT WRITE 128 WORDS LDB DPAD INCR DUMP ADDR ADB B200 BY 128 STB DPAD CPB B6000 DONE? JMP POUT,I YES - RETURN JMP PCONT NO - DO MORE * * MSET SETS THE MAP REGISTER SPECIFIED BY WPAG * TO THE PAGE SPECIFIED BY THE B REGISTER * MSETM NOP LDA D1 MAP CAX THE PAGE SPECIFIED LDA WPAG TO WPAG XMS JMP MSETM,I RETURN * * WRIT WRITES 128 BYTES FROM THE ADDRESS SPECIFIED * BY THE B REGISTER (MAPPING MUST ALREADY BE DONE) * WRIT NOP STB ADR SAVE PARM * * PUT OUT ESCAPE SEQUENCE * LDA EPTR RESET POINTER STA *+1 ESLP LDB ESC GET A WORD OF THE ESC SEQ ISZ *-1 MOVE TO NEXT WORD JSB OTWD OUTPUT CURRENT WORD CPB EOT IS IT END OF ESC SEQ? RSS YES-GO WAIT FOR ACK JMP ESLP NO-DO NEXT ESC SEQ WORD * * ACKNOWLEDGE * WACK LDA ENQ SEND ENQ JSB OTBYT JSB INBYT GET ACK CPA ACK IS IT ACK? CLE,RSS YES-SKIP JMP WACK NO-LOOP * * * OUTPUT RECORDS * * x LDA M128 GET COUNTER #WDS/REC STA TMP OTLP LDB ADR,I O.W. GET IT OUT OF SYS MAP JSB OTWD WRITE THE WORD ISZ ADR GET THE NEXT ADDRESS ISZ TMP DONE WITH REC? JMP OTLP NO-DO NEXT WORD LDA DC1 YES-SEND DC1 JSB OTBYT JSB INBYT GET TAPE STATUS CPA S S-SUCCESS? (F-FAIL) JMP *+3 YES-SKIP HLT 42B NO-HALT JMP INIT 2ND CHANCE TO RUN JSB INBYT WAIT FOR CR JMP WRIT,I RETURN * * OUTPUT ONE WORD * OTWD NOP OUTPUT ONE WORD TO CTU CCE START WITH UPPER HALF LDA B PUT DATA IN A REG ALF,ALF PUT IN LOWER POSITION AND B377 MASK OUT UPPER HALF JSB OTBYT OUTPUT BYTE SEZ,RSS SECOND HALF WRITTEN? JMP OTWD,I YES-RETURN LDA B N0-PUT DATA IN A REG CLE SET LOWER HALF FLAG JMP OTWD+4 WRITE IT * * INPUT ONE BYTE * INBYT NOP INPUT ONE BYTE JSB SETUP FIX UP I O INTERFACE CARD LDA RCV PUT IN RECEIVE MODE JSB OUT FIX2 STC SC,C DO IT FIX3 LIA SC PUT THE BYTE INTO A-REG SSA,RSS VALID? JMP *-2 NO. GET ANOTHER. AND B377 MASK OUT UPPER HALF JMP INBYT,I RETURN * * OUTPUT ONE BYTE * OTBYT NOP OUTPUT ONE BYTE STA OVAL SAVE VALUE TO SEND JSB SETUP FIX UP I O INTERFACE CARD LDA XMIT PUT IN TRANSMIT MODE JSB OUT LDA OVAL GET VALUE TO SEND JSB OUT SEND THE BYTE FIX5 STC SC,C PUT CARD IN DATA MODE FIX1 SFS SC IS I/O DONE? JMP *-1 NO-WAIT JMP OTBYT,I RETURN * * DO ONE OTA * OUT NOP FIX4 OTA SC JMP OUT,I * * SET UP THE INTERFACE CARD * SETUP NOP LDA MSET MASTER RESET JSB OUT LDA CHMD PUT IN CHAR MODEJ JSB OUT LDA FRAM CHAR FRAME CONTROL JSB OUT JMP SETUP,I RETURN * * * SFS1 OCT 102300 TO BUILD SFS COMMAND LIA2 OCT 000200 TO BUILD LIA COMMAND OTA3 OCT 000100 TO BUILD OTA COMMAND STC4 OCT 001100 TO BUILD STC,C COMMAND * * M128 DEC -128 B377 OCT 377 * * OVAL NOP ADR NOP DLIM DEF 48 NUMBER OF PHYSICAL PAGES TO DUMP CPAGE DEF *-* PAGE BEING DUMPED B2000 OCT 2000 TMP DEF *-* B1777 OCT 1777 MADDR DEF *-* ADDRESS WITHIN MAP TABLE B2040 OCT 2040 ADDRESS OF 33RD PAGE IN MAP TABLE B2100 OCT 2100 ADDRESS OF 65TH PAGE IN MAP TABLE D1 DEC 1 D32 DEC 32 BADDR OCT 102000 FOR DUMPING MAPS TO 2000 B4000 OCT 4000 B200 OCT 200 B6000 OCT 6000 DPAD DEF *-* ADDRESS OF NEXT RECORD TO WRITE WPAG DEF 2 MAP REGISTER # TO USE FOR I/O * MSET OCT 150077 MASTER RESET FRAM OCT 30003 CHAR FRAME CONTROL RCV OCT 40340 PUT IN RECEIVE MODE XMIT OCT 40740 PUT IN TRANSMIT MODE CHMD OCT 10040 PUT IN CHAR MODE * * EPTR LDB ESC * * ESC OCT 015446 ASCII "ESC" "&" OCT 070061 ASCII LOWER CASE "P" "1" OCT 062062 ASCII LOWER CASE "D" "2" OCT 032466 ASCII "5" "6" EOT OCT 053421 ASCII UPPER CASE "W" "DC1" P5 OCT 070065 ASCII LOWER CASE "P" "5" C OCT 000103 ASCII UPPER CASE "C" ENQ OCT 000005 ASCII "ENQ" ACK OCT 000006 ASCII "ACK" DC1 OCT 000021 ASCII DEVICE CONTROL 1 S OCT 000123 ASCII UPPER CASE "S" * * THE NEXT FOUR WORDS CONTAIN THE MEMORY STATUS REGISTER * AND THE ADDRESSES OF THE "DEAD SPOT" * THEY ARE ASSUMED TO BE AT 077674-077677 ABSOLUTE * MSTAT DEF *-* MEMORY STATUS REG IMAGE DEF CDMP FIRST LOCATION IN PROGRAM =>DEAD DEF 77777B LAST LOCATION IN MEMORY =>SPOT DEF 4666 MAGIC NUMBER * * END CDMP xT$"$ W b 24999-18200 1839 S 0100 PATCH SOURCE              H0101 ASMB,R,L HED READ ABS BIN FILE AND WRITE TO MEMORY 6/17/77 JCB * * *ON,PATCH,, * * FILE NAMR MUST BE ABS BINARY (TYPE 7) * INTERNAL CHECKSUM IS COMPUTED AND MUST MATCH CHECKSUM WORD * NAM PATCH,3,1 PROGRAM TO WRITE PATCHES INTO MEMORY FROM ABS FILE EXT IPUT,EXEC,OPEN,CLOSE,READF,NAMR,GETST A EQU 0 B EQU 1 START NOP JSB GETST GET STRING PASSED BY OPERATOR DEF R1 DEF BUFIN INPUT BUFFER DEF M80 = 80 CHARACTERS (M80=-80) DEF LOG R1 LDA D1 STA STR SET POINTER TO START OF BUFIN FOR NAMR JSB NAMR DEF R2 DEF TERM PARAMETER BUFFER DEF BUFIN INPUT BUFFER DEF LOG DEF STR R2 SSA JMP ERR2 PARAMETER INPUT ERROR * LDA TERM+3 GET PARAMETER TYPE AND D3 CPA D1 INTEGER LU? RSS YES JMP ERR2 NO PARAMETER ERROR * JSB NAMR DEF R3 DEF NAME PARMETER BUFFER DEF BUFIN DEF LOG DEF STR R3 SSA JMP ERR3 PARMETER INPUT ERROR * LDA NAME+3 GET PARAMETER TYPE AND D3 CPA D3 ASCII FILE NAME? RSS YES JMP ERR2 NO. PARAMETER ERROR * JMP BEGIN BEGIN PROGRAM * TERM NOP TERMINAL LU NAME NOP FILE NAME NOP NOP PTR NOP POINTER TO WORD IN ABS BINARY RECORD SEC NOP SECURITY CODE CR NOP CARTRIDGE REFERENCE VALU NOP VALUE OF WORD TO STORE IN MEMORY ADDR NOP ADDRESS TO STORE IT AT! LEN NOP LEN OF ABS BINARY REC RETURNED HERE WCTR NOP WORD COUNT IN BINARY REC (NEG 2'S COMP) BEGIN JSB OPEN COME HERE AFTER WE HAVE ALL PARAMETERS DEF R4 AND OPEN THE FILE DEF DCB DEF ERROR DEF NAME DEF ZERO DEF SEC DEF CR R4 LDA ERROR CPA D7 MUST BE TYPE 7 FILE (ABSOLUTE BINARY) RSS JMP ERR4 CLOSE FILE AND REPORT ERROR * RD JSB READF GET A RECORD FROM THE FILE DEF R5 DEF DCB DEF ERROR DEF BUFIN DEF D500 DEF LEN R5 LDA ERROR SZA JMP ERR5 * LDA LEN SZA,RSS JMP RD IGNORE ZERO LENGTH RECORDS * SSA EOF? JMP FINI YES * CMA,INA ADA D500 SZA,RSS DID WE TRUNCATE THE INPUT TO THE BUF SIZE? JMP ERR7 YES! * LDA BUFIN+1 STA ADDR SET STARTING ADDRESS FOR TARGET IN MEMORY LDA BUFIN ALF,ALF GET RECORD LENGTH CMA,INA STA WCTR SET WORD COUNTER NEGATIVE STA B SAVE FOR CHECKSUM COMPUTATION LDA BPTR STA PTR SET POINTER IN INPUT BUFFER LDA ADDR START CHECKSUM COMPUTATION ADA PTR,I ISZ PTR INB,SZB JMP *-3 * CPA PTR,I DOES CHECKSUM MATCH? RSS YES JMP ERR6 NO * LDA BPTR RESET STA PTR THE BUFFER POINTER NEXT LDA PTR,I GET WORD FROM INPUT BUFFER STA VALU JSB IPUT DEF *+3 DEF ADDR DEF VALU ISZ ADDR ISZ PTR ISZ WCTR JMP NEXT * JMP RD * ERR7 ISZ N RECORD TOO LARGE ERR6 ISZ N CHECKSUM DOESN'T COMPUTE! ERR5 ISZ N NOT USED ERR4 ISZ N FILE TYPE NOT 7 (ABS BINARY) ERR3 ISZ N 2ND PARM NOT ASCII FILE NAME ERR2 ISZ N 1ST PARM NOT INTEGER LU ERR1 ISZ N NOT USED LDA N ADA A60 OCTAL 60 = BASE FOR ASCII NUMBER STA ERN ERROR NUMBER TO REPORT JSB EXEC DEF FINI DEF D2 WRITE REQUEST DEF TERM TO THIS TERMINAL DEF MESS ERROR MESSAGE DEF D9 FINI JSB CLOSE DEF DONE DEF DCB DEF ERROR DONE JSB EXEC DEF *+2 y DEF D6 ZERO NOP D1 DEC 1 D2 DEC 2 D3 DEC 3 D6 DEC 6 D8 DEC 8 D9 DEC 9 D7 DEC 7 D14 DEC 14 D15 DEC 15 D500 DEC 500 LOG NOP N NOP ERROR # STORED HERE M80 DEC -80 A60 ASC 1, 0 * ERROR NOP STR NOP MESS ASC 8, PATCH ERROR : * ERN NOP ERROR NUMBER STORED HERE IN ASCII BPTR DEF BUFIN+2 START OF DATA IN ABSOLUTE BINARY RECORD DCB BSS 144 BUFIN BSS 500 END START END$ m X` 24999-18201 1839 S 0100 CMMM SOURCE              H0101 FTN4 PROGRAM CMMM (3,90), 24999-16101 REV 1839 RTE M SYS MGR PROG. C C C MIKE MANLEY REVISION 2 C RTE M VERSION C C DIMENSION IPBUF(33),LU(5),IBUF(17),IREG(2),IMESS5(6),IDP(22) DIMENSION IMESS0(8),IMESS1(9),IMES11(6),IMESS3(6),IMESS7(7) DIMENSION IMESS2(11),IWHAT(6),IMESS8(11),IPRAM(5),IVALU2(13) DIMENSION IARRAY(128),IDISC(26),IVALUE(9) DIMENSION IEXT(4),ITEL22(14),ITEL23(20),ITEL24(17),ITEL25(22) DIMENSION IX(8),I1(11),I2(13),I3(12),I4(9),I5(13),I6(12) DIMENSION I7(9),I9(14),IH(11),IJ(11),IK(9),IOUT(7) DIMENSION IL(12),IO(15),IP(16),IQ(17),IR(21) DIMENSION IN(8),IM(22),IPACK(23),MORUSE(8),ITEL30(5),ITEL31(17) DIMENSION ITEL1(9),ITEL2(9),ITEL3(16),ITEL4(5),ITEL5(19),ITEL6(12) DIMENSION ITEL7(6),ITEL8(5),ITEL9(23),ITEL10(5),ITEL11(26) DIMENSION ITEL12(7),ITEL13(11),ITEL14(22),ITEL16(16) DIMENSION ITEL17(13),ITEL18(17),ITEL19(6),ITEL20(6),ITEL21(6) DIMENSION IBEGIN(22),IGTOUT(27) EQUIVALENCE(IREG,REG,IA),(IREG(2),IB) EQUIVALENCE(IPBUF(2),IPRS1),(IPBUF(6),IPRS2),(IPBUF(10),IPRS3) EQUIVALENCE(IPBUF(14),IPRS4),(IPBUF(18),IPRS5) C DATA IMESS1/2H ,2HID,2H S,2HEG,2H O,2HF / DATA IEXT/2H ,2HEX,2HTE,2HNT/ DATA IVALUE/2H ,2HWO,2HRD,2H ,,2H V,2HAL,2HUE,2H ,2H / DATA IVALU2/2H ,2HLU,2H,T,2HRK,2H,S,2HEC,2HTR,2H,W,2HOR, & 2HD,,2HVA,2HLU,2HE / DATA IGTOUT/2H ,2HDI,2HSC,2H M,2HOD,2H !,2H ,2HEN,2HTE,2HR , & 2HA ,2H/D,2H A,2HT ,2HAN,2HY ,2HTI,2HME,2H T,2HO , & 2HEX,2HIT,2H T,2HHI,2HS ,2HMO,2HDE/ DATA IWHAT/2H ,2HSA,2HY ,2HWH,2HAT,2H ?/ DATA IMESS2/2H ,2HEQ,2HT ,2H# ,2H ,2H ,2H ,2H ,2HDV,2HR / DATA IMES11/2H ,2HNO,2HT ,2HFO,2HUN,2HD / DATA IMESS3/2H ,2HDR,2HT ,2HPA,2HRT,2H / DATA IMESS5/2H ,2HIN,2HT ,2HTA,2HBL,2HE / DATA IMESS0/2H ,2H =,2HCM,2HM3,2H D,2HON,2HE ,2H! /  DATA IBEGIN/2H ,2HCM,2HMM,2H !,2H ,2H ,2HRT,2HE , & 2HM2,2H &,2H M,2H3 ,2H ,2HVE,2HRS,2HIO, & 2HN ,2H ,2H03,2H/0,2H1/,2H77/ DATA IMESS7/2H ,2HYE,2HS ,2HOR,2H N,2HO ,2H? / DATA IMESS8/2HIN,2HT ,2HTA,2HBL ,2HE ,2HST,2HAR,2HTS, & 2H A,2HT ,2H6./ DATA IDISC/2H ,2HLU,2H =,2H ,2H ,2H ,2HTR,2HK ,2H= , & 2H ,2H ,2H ,2HSE,2HCT,2HR ,2H= ,2H ,2H ,2H , & 2H ,2HWO,2HRD,2H =,2H ,2H ,2H / DATA IOUT/2H ,2HOU,2HT ,2HOF,2H R,2HAN,2HGE/ DATA ITEL1/2H ,2HID,2H,P,2HRO,2HGR,2HAM,2H N,2HAM,2HE / DATA ITEL2/2H ,2HID,2H,S,2HEG,2HME,2HNT,2H N,2HAM,2HE / DATA ITEL3/2H ,2HID,2H,N,2HUM,2HBR,2H =,2H A,2HLL,2H I, & 2HD',2HS ,2HIN,2H S,2HYS,2HTE,2HM / DATA ITEL4/2H ,2HEQ,2H,N,2HUM,2HBR/ DATA ITEL5/2H ,2HEQ,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HEQ,2HTS,2H I,2HNC,2HLU,2HSI, & 2HVE/ DATA ITEL6/2H ,2HLM,2H,A,2HDD,2HRE,2HSS,2H,#,2H O,2HF , & 2HWO,2HRD,2HS / DATA ITEL7/2H ,2HLM,2H,A,2HDD,2HRE,2HSS/ DATA ITEL8/2H ,2HDR,2H,N,2HUM,2HBR/ DATA ITEL9/2H ,2HDR,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HDR,2HT ,2HEN,2HTR,2HIE,2HS , & 2HIN,2HCL,2HUS,2HIV,2HE / DATA ITEL10/2H ,2HIN,2H,N,2HUM,2HBR/ DATA ITEL11/2H ,2HIN,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HIN,2HT ,2HTA,2HBL,2HE ,2HEN, & 2HTR,2HIE,2HS ,2HIN,2HCL,2HUS,2HIV,2HE / DATA ITEL12/2H ,2HLL,2H,L,2HIS,2HT ,2HLU,2H# / DATA ITEL13/2H ,2HPM,2H,A,2HDD,2HRE,2HSS,2H,N,2HEW, & 2H V,2HAL,2HUE/ DATA ITEL14/2H ,2HF/,2H,V,2HAL,2HUE,2H T,2HO ,2HFI,2HND, & 2H,S,2HTA,2HRT,2H A, & 2HDD,2HRE,2HSS,2H,#,2H O,2HF ,2HWO,2HRD,2HS / DATA ITEL16/2H ,2HDL,2H,L,2HU,,2HTR,2HK,,2HSE,2HCT,2HR,, & 2H #,2H O,2HF ,2HSE,2HCT,2a5HOR,2HS / DATA ITEL17/2H ,2HDS,2H,L,2HU,,2HTR,2HK,,2HVA,2HLU,2HE , & 2HTO,2H F,2HIN,2HD / DATA ITEL18/2H ,2HDM,2H ,2H ,2HDI,2HSC,2H M,2HOD,2H , & 2H ,2H / DATA ITEL19/2H ,2HEX,2H ,2H ,2HEX,2HIT/ DATA ITEL20/2H ,2HEN,2H ,2H ,2HEX,2HIT/ DATA ITEL21/2H ,2H/E,2H ,2H ,2HEX,2HIT/ DATA ITEL22/2H ,2HXL,2H,A,2HDD,2HRE,2HSS,2H ,2H ,2H(S, & 2HYS,2HTE,2HM ,2HMA,2HP)/ DATA ITEL23/2H ,2HXL,2H,A,2HDD,2HRE,2HSS,2H,#,2H O,2HF , & 2HWO,2HRD,2HS ,2H ,2H(S,2HYS,2HTE,2HM ,2HMA, & 2HP)/ DATA ITEL24/2H ,2HXP,2H,A,2HDD,2HRE,2HSS,2H,V,2HAL,2HUE, & 2H ,2H ,2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA ITEL25/2H ,2HXF,2H,V,2HAL,2HUE,2H T,2HO ,2HFI,2HND, & 2H,S,2HTA,2HRT,2H A,2HDD,2HRE,2HSS,2H,#,2H O, & 2HF ,2HWO,2HRD,2HS / DATA ITEL30/2H ,2HDP,2H,V,2HAL,2HUE/ DATA ITEL31/2H ,2HTR,2H,S,2HTA,2HRT,2H L,2HOC,2HAT,2HIO,2HN,, &2HLI,2HST,2H D,2HEL,2HIM,2HIT,2HER/ DATA IX/2H I,2HNP,2HUT,2H ,2HFU,2HNC,2HTI,2HON/ DATA I1/2H ,2HID,2H ,2HLI,2HST,2H I,2HD ,2HSE,2HGM,2HEN,2HT / DATA I2/2H ,2HEQ,2H ,2HLI,2HST,2H E,2HQT,2H A,2HND,2H E,2HXT, & 2HEN,2HTS/ DATA I3/2H ,2HDR,2H ,2HLI,2HST,2H D,2HEV,2H R,2HEF,2H T,2HAB, & 2HLE/ DATA I4/2H ,2HLM,2H ,2HLI,2HST,2H M,2HEM,2HOR,2HY / DATA IP/2H ,2HXL,2H ,2HLI,2HST,2H M,2HEM,2HOR,2HY ,2H , & 2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA I5/2H ,2HIN,2H ,2HLI,2HST,2H I,2HNT,2HER,2HUP,2HT ,2HTA, & 2HBL,2HE / DATA I6/2H ,2HLL,2H ,2HCH,2HAN,2HGE,2H L,2HIS,2HT ,2HDE,2HVI, & 2HCE/ DATA I7/2H ,2HPM,2H ,2HPA,2HTC,2HH ,2HME,2HMO,2HRY/ DATA IQ/2H ,2HXP,2H ,2HPA,2HTC,2HH ,2HME,2HMO,2HRY,2H ,2H , & 2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA I9/2H ,2HF/,2H ,2HFI,2HND,2H A,2H V,2HAL,M(2HUE,2H I,2HN , & 2HME,2HMO,2HRY/ DATA IR/2H ,2HXF,2H ,2HFI,2HND,2H A,2H V,2HAL,2HUE,2H I,2HN , & 2HME,2HMO,2HRY,2H ,2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA IH/2H ,2HDL,2H ,2HLI,2HST,2H D,2HIS,2HC ,2HSE,2HCT,2HOR/ DATA IJ/2H ,2HDM,2H ,2HDI,2HSC,2H M,2HOD,2H ,2HAN,2HY ,2HLU/ DATA IK/2H ,2HDS,2H ,2HDI,2HSC,2H S,2HEA,2HRC,2HH / DATA IL/2H ,2H/E,2H O,2HR ,2HEN,2H O,2HR ,2HEX,2H T,2HO , &2HEX,2HIT/ DATA IDP/2H ,2HDP,2H ,2HDI,2HSP,2HLA,2HY ,2HIN,2HPU,2HT , &2HIN,2H O,2HCT,2HAL,2H D,2HEC,2HIM,2HAL,2H &,2H A,2HSC,2HII/ DATA IN/2H ,2HTR,2H ,2HTR,2HAC,2HE ,2HLI,2HST/ DATA IM/2H ,2HXT,2H ,2HTR,2HAC,2HE ,2HLI,2HST,2H (,2HSY, &2HST,2HEM,2H M,2HAP,2H) / DATA IPACK/2H ,2HA ,2HPK,2H A,2HFT,2HER,2H T,2HHE,2H I,2HNP, &2HUT,2H G,2HIV,2HES,2H A,2H P,2HAC,2HKE,2HD ,2HLI,2HST,2HIN, &2HG / DATA MORUSE/2H ,2HOR,2H U,2HSE,2H ,2H ,2HPK,2H, / DATA IO/2H ,2HFO,2HR ,2HMO,2HRE,2H I,2HNF,2HO ,2HDO,2H A, & 2H ?,2H?,,2HIN,2HPU,2HT / C CALL RMPAR(LU) LU1=LU(1) IF(LU1.EQ.0) LU1=1 LU2 = LU1 C CALL EXEC(2,LU1,IBEGIN,22) C IPRMPT = 2H= 1 IPRAM(1) = 1 IPRAM(2) = 0 IPRAM(3) = 0 IPRAM(4) = 0 IPRAM(5) = 0 CALL EXEC(2,LU1+ 2000B,IPRMPT,-2) REG = REIO(1,LU1 + 400B,IBUF,17) CALL PARSE(IBUF,IB*2,IPBUF) C SEE IF THE PACKED FORM OF THE OUTPUT IS DESIRED IF(IPBUF(3).EQ.2HPK) IPRAM(5) = 1 C C C C C C IF(IPRS1.EQ.2HID) GO TO 100 IF(IPRS1.EQ.2HEQ) GO TO 200 IF(IPRS1.EQ.2HDR) GO TO 300 IF(IPRS1.EQ.2HXL) GO TO 400 IF(IPRS1.EQ.2HLM) GO TO 410 IF(IPRS1.EQ.2HIN) GO TO 500 IF(IPRS1.EQ.2HLL) GO TO 600 IF(IPRS1.EQ.2HPM) GO TO 710 IF(IPRS1.EQ.2HXP) GO TO 700 IF(IPRS1.EQ.2HF/) GO TO 810 IF(IPRS1.EQ.2HXF) GO TO 800 IF(IPRS1.EQ.2HDL) GO TO 1000 IF(IPRS1.EQ.2HDM) GO TO 1100 IF(IPRS1.EQ.2HDS) GO TO 1400 IF(IPRS1.EQ.2HTR) GO TO 1610 IF(IPRS1.EQ.2HXT) GO TO 1600 IF(IPRS1.EQ.2HDP) GO TO 1700 IF(IPRS1.EQ.2H??) GO TO 9000 IF(IPRS1.EQ.2H/E) GO TO 50 IF(IPRS1.EQ.2HEX) GO TO 50 IF(IPRS1.EQ.2HEN) GO TO 50 25 CALL EXEC(2,LU1,IWHAT,-12) GO TO 1 30 CALL EXEC(2,LU1,IOUT,7) GO TO 1 50 CALL EXEC(2,LU1,IMESS0,-16) CALL EXEC(6,0) C C C **********GET ID SEGMENT INFO************** 100 KYWORD = IGET(1657B) -1 IF(IPBUF(5).EQ.1) GO TO 175 C IMESS1(7) = IPRS2 IMESS1(8) = IPBUF(7) IMESS1(9) = IPBUF(8) C 150 DO 170 I = 1,156 KYWORD = KYWORD +1 IF(IGET(KYWORD).EQ.0) GO TO 190 IF(((IPRS2.EQ.IGET(IGET(KYWORD)+12)).AND. & (IPBUF(7).EQ.IGET(IGET(KYWORD)+13))).AND. & (IPBUF(8).EQ.IOR(IAND(IGET(IGET(KYWORD)+14),177400B),40B))) & GO TO 180 170 CONTINUE 175 KYWORD = KYWORD +1 IF(IPRAM(3).EQ.9999) GO TO 1 IF(IGET(KYWORD).EQ.0) GO TO 1 IF(IGET(IGET(KYWORD)+12).NE.0) GO TO 176 IMESS1(7) = 2H GO TO 180 176 IMESS1(7) = IGET(IGET(KYWORD)+12) IMESS1(8) = IGET(IGET(KYWORD)+13) IMESS1(9) = IOR(IAND(IGET(IGET(KYWORD)+14),177400B),40B) C 180 CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IMESS1,-18) ISTART = IGET(KYWORD) ISTOP = ISTART +27 ITEMP = IAND(IGET(IGET(KYWORD) +14),17B) ITEMP1= IAND(IGET(IGET(KYWORD) +14),20B) IF(ITEMP1.EQ.20B) ISTART= IGET(KYWORD) +11 IF(ITEMP1.EQ.20B) ISTOP = ISTART + 8 IF((((ITEMP.EQ.1).OR.(ITEMP.EQ.9)).OR.(ITEMP.EQ.17)).OR. &(ITEMP.EQ.25)) ISTOP = ISTART + 21 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) IF(IPBUF(5).EQ.1) GO TO 175 GO TO 1 190 CALL EXEC(2,LU1,IMES11,-12) GO TO 1 C C C **********GET EQT INFO************* C C 200 IEQTA = IGET(1650B) IEQTNO = IGET(1651B) IF(I3PRS3 .GT. IEQTNO) IPRS3 = IEQTNO IF(IPRS2.GT.IEQTNO) GO TO 25 IF(IPRS2.LT. 1) IPRS2 = 1 C C DO 210 I = IPRS2,IPRS3 IF(IPRAM(3) .EQ. 9999) GO TO 1 ISTART = IEQTA + (I - 1)*15 CALL CNUMD(I,IBUF(2)) IMESS2(4) = IBUF(4) IBUF(1) = (IAND(IGET(ISTART+4),37400B)/256) IBUF(1) = IBUF(1) + 2*(IBUF(1)/8) CALL CNUMD(IBUF(1),IBUF(2)) C INSERT A 0 SO DVR00 DOESNT LOOK LIKE DVR 0 IF (IAND(IBUF(4),177400B).EQ.20000B) IBUF(4) = IBUF(4) + 10000B IMESS2(11) = IBUF(4) C CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IMESS2,11) CALL DOIO(ISTART,ISTART +14,LU2,IPRAM) C C 210 CONTINUE C GO TO 1 C C C **********GET DEVICE REF TABLE************** C 300 IDRT = IGET(1652B) LUMAX = IGET(1653B) IMESS3(6) = 61B C C CALL EXEC(2,LU2,IMESS3,6) IF(IPRS3.GT.LUMAX) IPRS3 = LUMAX IF(IPRS2.LE.0) IPRS2 = 1 CALL DOIO(IDRT + IPRS2-1,IDRT + IPRS3-1,LU2,IPRAM) IMESS3(6) = 62B CALL EXEC(3,LU2+1100B,1) CALL EXEC(2,LU2,IMESS3,6) CALL DOIO(IDRT+IPRS2-1+LUMAX,IDRT+IPRS3-1+LUMAX,LU2,IPRAM) GO TO 1 C C C C ***********LIST ANY MEMORY LOCATION REQUESTED**************** C C 400 IPRAM(4) = -1 IF((IPRS2.LT.0).OR.(IPRS3+IPRS2-1.LT.0)) GO TO 30 410 CALL DOIO(IPRS2,IPRS2+IPRS3-1,LU2,IPRAM) GO TO 1 C C C *************GET THE INTERUPT TABLE***************** C C 500 INTBA = IGET(1654B) INTLG = IGET(1655B) C C IF(IPRS2.LT.6) GO TO 550 CALL EXEC(2,LU2,IMESS5,-12) IF(IPRS3.GT.INTLG) IPRS3 = INTLG IF(IPRS2.LE.0) IPRS2 = 1 ISTART = INTBA + IPRS2 -6 ISTOP = INTBA +IPRS3 -1 IPRAM(1) = IPRS2 IPRAM(2) = 1 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) GO TO 1 550 CALL EXEC(2,LU1,IMESS8,-22) GO TO 1 C C C C ***********CHANGE OUTPUT LU*************** C C 600 LU2 = IPRS2 GO TO 1 C  C C C ***********PATCH MEMORY ANY MEMORY LOCATION**************** C 700 IPRAM(4) = -1 710 CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) CALL EXEC(2,LU1,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) C IF YOU CHANGE YOUR MIND THIS IS THE ESCAPE ROUTE IF(IPBUF(7).NE.2HYE) GO TO 1 IF(IPRAM(4).EQ.0)CALL IPUT(IPRS2,IPRS3) IF(IPRAM(4).EQ.-1)CALL XPUT(IPRS2,IPRS3) CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) GO TO 1 C C C*******FIND A WORD BETWEEN GIVEN LIMITS IN MEMORY******** C 800 IPRAM(4) = -1 810 IF (IPRS3.LT.0) IPRS3 = 1 IF((IPRS3.LT.0).OR.(IPRS3+IPRS4-1.LT.0)) GO TO 30 DO 850 I = IPRS3,IPRS3+IPRS4-1 IF((IGET(I).EQ.IPRS2).AND.(IPRAM(4).EQ.0)) GO TO 820 IF((IXGET(I).EQ.IPRS2).AND.(IPRAM(4).EQ.-1)) GO TO 820 GO TO 850 820 CALL DOIO(I,I,LU2,IPRAM) IF(IPRAM(3).EQ.9999) GO TO 1 IPRAM(3) = 1 IPRAM(1) = IPRAM(1) + 1 850 CONTINUE IF(IPRAM(3).EQ.0) GO TO 190 GO TO 1 C C C********LOOK AT ANY DISC LOCATION************ 1000 DO 1050 J = 1,IPRS5 CALL EXEC(1,IPRS2 + 100B,IARRAY,128,IPRS3,IPRS4) CALL DISC3(IPRS2,IPRS3,IPRS4,IPRAM(1),IARRAY,IPRAM,LU2,IDISC) IF(IPRAM(3).EQ.9999) GO TO 1 IPRS4 = IPRS4 + 2 IF(IPRS4.LT.60) GO TO 1050 IPRS4 = 0 IPRS3 = IPRS3 + 1 1050 CONTINUE GO TO 1 C C C C*************MODIFY OP SYSTEM ON THE DISC**************** C C C 1100 CALL EXEC(2,LU1,IGTOUT,27) C C** THIS SECTION ALLOWS MODIFICATION OF ANY DISC** C C 1150 CALL EXEC(2,LU1+2000B,IVALU2,13) REG=REIO(1,LU1+400B,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IF(IPRS1.EQ.2H/D) GO TO 1 ILU= IPRS1 ITRK= IPRS2 ISECTR = IPRS3 IWORD = IPRS4 IF(IWORD .LE. 0 ) GO TO 25 IFIX = IPBUF(18) INULL = IPBUF(17) C ASSIGN 1150 TO ILABEL C C 1210 CALL EXEC(1,ILU+100B,IARRAY,128,ITRK,ISECTR) IPRAM(1) = 0 CALL DISC3(ILU,ITRK,ISECTR,IWOfRD,IARRAY,IPRAM,LU2,IDISC) C IF (INULL.EQ.0) GO TO ILABEL CALL EXEC(2,LU1+2000B,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) IF(IPBUF(7).EQ. 2H/D) GO TO 1 IF(IPBUF(7).NE. 2HYE) GO TO ILABEL C C C C LETS GO MODIFY THE TRACK ASSIGNMENT TABLE SO WE CAN WRITE C ON SYSTEM TRACKS. C 1300 IARRAY(IWORD) = IFIX C !!!!!PATCH DISC!!!!!! CALL EXEC(100002B,ILU+100B,IARRAY,128,ITRK,ISECTR) GO TO 1310 C C FIX TRACK ASSIGNMENT TABLE C 1333 INULL = 0 1310 INULL = 0 GO TO 1210 C C C C C C***THIS SECTION WILL SEARCH A TRACK FOR ALL OCCURRENCES OF A *** C*** GIVEN VALUE. USE THIS SECTION TO UNPURGE A FILE. *** C*** HINT ! IF YOU UNPURGE DON'T FORGET THE EXTENTS OR YOU WILL *** C*** DEVELOP A FMGR -005 ERROR . C C C 1400 ISTART = 0 DO 1450 I =0,58,2 CALL EXEC(1,IPRS2 + 100B,IARRAY,128,IPRS3,I) DO 1425 J = 1,128 IF(IARRAY(J).NE.IPRS4) GO TO 1425 ISTART = 1 CALL CNUMD(I,IDISC(17)) CALL CNUMD(J,IDISC(24)) CALL EXEC(2,LU2,IDISC(12),15) IF(IFBRK(IDUMY)) 1,1425 1425 CONTINUE 1450 CONTINUE IF (ISTART .EQ. 0) GO TO 190 GO TO 1 C C******************* TRACE A LIST IN ANY MAP ************************** C 1600 IPRAM(4) = -1 1610 IF((IPRS2 .LT.1).OR. (IPRS2 .EQ.IPRS3)) GO TO 1 CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) IPRAM(3) = 1 IF(IPRAM(4).EQ.0) IPRS2 = IGET(IPRS2) IF(IPRAM(4).EQ.-1) IPRS2 = IXGET(IPRS2) GO TO 1610 C C 1700 IARRAY(1) = IPRS2 IPRAM(1) = 0 IPRAM(3) = 1 CALL DISC3(1,1,1,1,IARRAY,IPRAM,LU2,IDISC) GO TO 1 9000 IF(IPRS2.EQ.2HID) GO TO 9100 IF(IPRS2.EQ.2HEQ) GO TO 9200 IF(IPRS2.EQ.2HDR) GO TO 9300 IF(IPRS2.EQ.2HLM) GO TO 9400 IF(IPRS2.EQ.2HIN) GO TO 9500 IF(IPRS2.EQ.2HLL) GO TO 9600 IF(IPRS2.EQ.2HPM) GO TO 9700 IF(IPRS2.EQ.2HF/) GO TO 9800 IF(IPRS2.EQ.2HDL) GO TO 9905 c IF(IPRS2.EQ.2HDM) GO TO 9910 IF(IPRS2.EQ.2HDS) GO TO 9920 IF(IPRS2.EQ.2H/E) GO TO 9940 IF(IPRS2.EQ.2HEX) GO TO 9940 IF(IPRS2.EQ.2HEN) GO TO 9940 IF(IPRS2.EQ.2HXL) GO TO 9960 IF(IPRS2.EQ.2HXP) GO TO 9970 IF(IPRS2.EQ.2HXF) GO TO 9980 IF(IPRS2.EQ.2HDP) GO TO 9982 IF(IPRS2.EQ.2HTR) GO TO 9984 IF(IPRS2.EQ.2HXT) GO TO 9984 C C C CALL EXEC(2,LU2,IX,8) CALL EXEC(2,LU2,I1,11) CALL EXEC(2,LU2,I2,13) CALL EXEC(2,LU2,I3,12) CALL EXEC(2,LU2,I4,9) CALL EXEC(2,LU2,IP,16) CALL EXEC(2,LU2,I5,13) CALL EXEC(2,LU2,IN,8) CALL EXEC(2,LU2,IM,15) CALL EXEC(2,LU2,IDP,22) CALL EXEC(2,LU2,I6,12) CALL EXEC(2,LU2,I7,9) CALL EXEC(2,LU2,IQ,17) CALL EXEC(2,LU2,I9,14) CALL EXEC(2,LU2,IR,21) CALL EXEC(2,LU2,IH,11) CALL EXEC(2,LU2,IJ,11) CALL EXEC(2,LU2,IK,9) CALL EXEC(2,LU2,IL,12) CALL EXEC(2,LU2,IO,15) CALL EXEC(2,LU2,IPACK,23) GO TO 1 C C C C 9100 CALL EXEC(2,LU2,ITEL1,9) CALL EXEC(2,LU2,ITEL2,9) CALL EXEC(2,LU2,ITEL3,16) GO TO 9999 9200 CALL EXEC(2,LU2,ITEL4,5) CALL EXEC(2,LU2,ITEL5,19) GO TO 9999 9300 CALL EXEC(2,LU2,ITEL8,5) CALL EXEC(2,LU2,ITEL9,23) GO TO 9999 9400 CALL EXEC(2,LU2,ITEL7,6) CALL EXEC(2,LU2,ITEL6,12) GO TO 9999 9500 CALL EXEC(2,LU2,ITEL10,5) CALL EXEC(2,LU2,ITEL11,26) GO TO 9999 9600 CALL EXEC(2,LU2,ITEL12,7) GO TO 1 9700 CALL EXEC(2,LU2,ITEL13,11) GO TO 1 9800 CALL EXEC(2,LU2,ITEL14,22) GO TO 1 9905 CALL EXEC(2,LU2,ITEL16,16) GO TO 9999 9910 CALL EXEC(2,LU2,ITEL18,17) GO TO 1 9920 CALL EXEC(2,LU2,ITEL17,13) GO TO 1 9940 CALL EXEC(2,LU2,ITEL21,6) CALL EXEC(2,LU2,ITEL20,6) CALL EXEC(2,LU2,ITEL19,6) GO TO 1 9960 CALL EXEC(2,LU2,ITEL22,14) CALL EXEC(2,LU2,ITEL23,19) GO TO 9999 9970 CALL EXEC(2,LU2,ITEL24,17) GO TO 1 9980 CALL EXEC(2,LU2,ITEL25,22) GO TO 1 9982 CALL EXEC(2,LU2,ITEL30,5) GO TO 1 9984 ITEL31(2) = IPRS2 CALL EXEC(2,LU2,ITEL31,17) GO TO 1 C 9999 MORUSE(6) = IPRS2 CALL EXEC(2,LU2,MORUSE,8) GO TO 1 END END$ FTN4,L SUBROUTINE DOIO(ISTART,ISTOP,LU,IPRAM) DIMENSION IBUF(25),IMESS(27),IPRAM(5),OBUF(37),LMESS(17) C DATA IMESS/2H ,2H ,2H ,2HWO,2HRD, &2H ,2H ,2HLO,2HCA,2HTI,2HON,2H , &2HVA,2HLU,2HE(,2H8),2H ,2HVA,2HLU,2HE(,2H10,2H) , &2HVA,2HLU,2HE(,2HAS,2H) / DATA LMESS/2H ,2HLO,2HCA,2HTI,2HON,2HS ,2H ,2H ,2H , &2H T,2HHR,2HOU,2HGH,2H / DATA IBUF/25*2H / C C C THE IPRAM ARRAY TELLS HOW TO DO THE I/O C IPRAM(1) = WORD # TO START COUNTING AT, C IPRAM(2) = 0 MEANS WORD COUNT TO BE IN DECIMAL C IPRAM(2) = 1 MEANS WORD COUNT TO BE IN OCTAL C IPRAM(3) = 0 MEANS PRINT HEADER. = 1 MEANS NO HEADER. C IPRAM(4) =-1 MEANS WE ARE DOING A CROSS MAP LOAD C IPRAM(5) = 1 MEANS A PACKED LISTING IS DESIRED C C ISTART IS LOCATION TO START COUNTING AT C ISTOP IS LOCATION TO STOP COUNTING AT. C LU IS THE OUTPUT LU. C C K = IPRAM(1)-1 C IF(IPRAM(5).EQ.1) GO TO 500 C 1 IF(IPRAM(3).EQ. 0) CALL EXEC(2,LU,IMESS,-54) C C DO 100 I = ISTART,ISTOP K = K + 1 CALL CNUMD(K,IBUF(3)) IF(IPRAM(2) .EQ.1) CALL CNUMO(K,IBUF(3)) CALL CNUMO(I,IBUF(8)) IF(IPRAM(4) .NE.-1) GO TO 50 CALL CNUMO(IXGET(I),IBUF(13)) CALL CNUMD(IABS(IXGET(I)),IBUF(18)) IF(IXGET(I).LT.0)IBUF(18) = IBUF(18) + 6400B C CALL IASCI(IXGET(I),IBUF(25)) C GO TO 75 50 CALL CNUMO(IGET(I),IBUF(13)) CALL CNUMD(IABS(IGET(I)),IBUF(18)) IF (IGET(I).LT.0) IBUF(18) = IBUF(18) + 6400B C CALL IASCI(IGET(I),IBUF(25)) C 75 CALL EXEC(2,LU,IBUF,-50) IF(IFBRK(IDMY))200,100 100 CONTINUE GO T1O 300 200 IPRAM(3) = 9999 300 RETURN C C 500 K = ISTART 550 IF((ISTOP-K).LT.0) RETURN CALL CNUMO(K,LMESS(7)) CALL CNUMO(ISTOP,LMESS(15)) IF(((ISTOP-K)/64).GT.0) CALL CNUMO(K + 63,LMESS(15)) C CALL EXEC(3,LU + 1100B,1) CALL EXEC(2,LU,LMESS,17) CALL EXEC(3,LU + 1100B,1) C DO 800 I = 1,8 C CALL PACK (ISTOP - K + 1,IPRAM(4)+1,K,OBUF) CALL EXEC(2,LU,OBUF,37) C K = K + 8 IF((ISTOP-K).LT.0) RETURN IF(IFBRK(IDMY)) 200,800 800 CONTINUE C GO TO 550 END SUBROUTINE DISC3(LU,ITRK,ISECTR,INDEX,IARRAY,IPRAM,LU2,IDISC) DIMENSION IARRAY(128),IPRAM(4),IBUF(17),OBUF(37) DIMENSION IDISK(20),IDISC(20) DATA IDISK/2H ,2HWO,2HRD,2H ,2H V,2HAL,2HUE,2H(8,2H) , & 2H V,2HAL,2HUE,2H(1,2H0),2H ,2HVA,2HLU,2HE(, & 2HAS,2H) / DATA IBUF/17*2H / C C C THIS SUBROUTINE DOES THE I/O FOR ALL DISC READS. THE MAIN C PROGRAM DOES THE READ PASSING THE 128 WORDS READ IN IARRAY. C THIS ROUTINE FORMATS THE OUTPUT. C C IN ADDITION IT DOES THE OUTPUT FOR THE ' DP ' INSTRUCTION C THIS IS A SLIGHT PERTERBATION FROM THE SUBROUTINES REAL C PURPOSE. C C C IF IPRAM(1) #0 THEN 128 WORDS ARE OUTPUT C IF IPRAM(1) =0 THEN ONLY ONE WORD IS OUTPUT C IF IPRAM(3) # 0 THEN NO DISC TRK & SECTOR INFO IS PRINTED C IF IPRAM(5) = 0 THEN A PACKED LISTING IS DESIRED C IF(IPRAM(1).EQ.0) GO TO 55 NUMBR = 128 INDEX = 1 ID = 19 GO TO 100 C 55 NUMBR = 1 ID = 26 C 100 CALL CNUMD(LU,IDISC(3)) CALL CNUMD(ITRK,IDISC(9)) CALL CNUMD(ISECTR,IDISC(17)) CALL CNUMD(INDEX,IDISC(24)) IF(IPRAM(3).NE.1) CALL EXEC(2,LU2,IDISC,ID) IF(IPRAM(5).NE.1) CALL EXEC(2,LU2,IDISK,20) C IF(IPRAM(5).EQ.1) GO TO 2000 C C DO 1020 I = INDEX,NUMBR C CALL IASCI(IARRAY(I),IBUF(17)) C C C C CALL CNUMD(I,IBUF) CALL CNUMO(IARRAY(I),IBUF(5)) CALL CNUMD(IABS(IARRAY(I)),IBUF(10)) IF (IARRAY(I).LT.0) IBUF(10) = IBUF(10) + 6400B CALL EXEC(2,LU2,IBUF,17) IF(IFBRK(IDUMY)) 999,1020 1020 CONTINUE RETURN 999 IPRAM(3) = 9999 RETURN C C C FIX UP A POINTER TO THE ARRAY IARRAY SO THAT THE C PACK ROUTINE WILL WORK. C 2000 CALL DUMMY(IARRAY,IPOINT) C DO 3000 I = 1,16 CALL PACK(8,1,IPOINT,OBUF) CALL EXEC(2,LU2,OBUF,37) IPOINT = IPOINT + 8 IF(IFBRK(IDUMY)) 999,3000 3000 CONTINUE END END$ ASMB,L NAM IXGET,7 ENT IXGET,XPUT,PACK,IASCI,DUMMY ENT IGET ENT IPUT EXT $LIBR,$LIBX,.ENTR * * * IGET NOP DLD IGET,I SWP LDA A,I LDA A,I JMP B,I * * * IXGET NOP DLD IXGET,I SWP LDA A,I XLA A,I JMP B,I * * * IPUT NOP JSB $LIBR NOP LDA IPUT,I STA IGET ISZ IPUT DLD IPUT,I LDA A,I LDB B,I STB A,I JSB $LIBX DEF IGET * * * XPUT NOP JSB $LIBR NOP LDA XPUT,I STA IXGET ISZ XPUT DLD XPUT,I LDA A,I LDB B,I XSB A,I JSB $LIBX DEF IXGET * * * * * * * * * THIS ROUTINE ACCEPTS UP TO 8 WORDS OF INPUT AND CONVERTS THOSE * WORDS TO OCTAL ASCII IN A PACKED FORMAT . EIGHT WORDS OF OCTAL * DELIMITED BY A * AND THEN THEIR ASIII REPRESENTATION. * THE WORDS MAY EITHOR BE IN THE SYSTEM MAP OR THE USER MAP * THE ROUTINE IS FORTRAN CALLABLE AS: * * CALL PACK(#WORDS,MAP,INPUT BUFFER,OUTPUT BUFFER) * * MAP = 0 SYSTEM MAP * MAP >= 1 USER MAP * * THE OUTPUT BUFFER MUST BE 36 WORDS LONG * * * KOUNT NOP MAP NOP INBUF NOP ASSLC NOP PACK NOP JSB .ENTR GET THE PARAMETER ADDRESSES DEF KOUNT * LDA KOUNT,I GET THE # OF WORDS TO CONVERT BACK CMA,INA MAKE NEG AND SSA,RSS IF 0 OR NEG WORDS INPUT THEN FORGET IT JMP PACK,I STA KOUNT NOW SAVE FOR LOOP * ADA D8 ADD 8 TO SEE IF INPUT # SSA,RSS GREATER THAN 8 JMP CONTU ALL IS WELL ! LDA D8 JMP BACK * * CONTU LDA MAP,I GET THE MAP AND SAVE STA MAP FOR LATER * LDA INBUF,I STA INBUF * LDA ASSLC GET THE ADDRESS LDB ASSLC TWICE STB TEMP SAVE TEMPORARIALLY INA BUMP IT CLE,ELA CONVERT TO A BYTE ADDRESS STA ASSLC AND SAVE FOR LATER ADB D29 NOW DEFINE THE ASCII ADDRESS STB OABUF AND SAVE FOR THE IASCI SUBROUTINE STB YTEMP * LDA DM37 NOW CLEAR OUT THE OLD BUFFER STA XTEMP LDB BLANK GET A BLANK READY * LOOPX STB TEMP,I SET A BLANK INTO THE OUTPUT BUFFER ISZ TEMP STEP BUFFER POINTER ISZ XTEMP DONE YET ? JMP LOOPX NO * * * LOOP LDB INBUF GET THE 1ST WORD LDA MAP GET THE MAP TO USE SZA,RSS SYS MAP ? JMP SYSTM YES LDB B,I NO JMP OUT SYSTM XLB B,I GET THE INFO FROM THE SYSTEM MAP OUT STB XTEMP SAVE FOR THE IASCI SUBROUTINE JSB ASCI AND CONVERT TO OCTAL ASCII * JSB IASCI AND PLACE THROUGH THE ASCII FILTER DEF *+3 DEF XTEMP DEF TEMP * STB OABUF,I PUT RESULT INTO THE OUTPUT BUFFER * ISZ INBUF BUMP OUR ISZ OABUF POINTERS ISZ ASSLC AND THE CHAR ADDRESS * ISZ KOUNT ARE WE DONE ? JMP LOOP NOT YET * CCB YES,GET THE END OF THE OCTAL #'S ADB YTEMP LDA B,I NOW GET THE LAST WORD IOR ASTRK PUT IN AN ASTRISK STA B,I NOW PUT IT BACK * JMP PACK,I RETURN TO THE CALLER * * * * ** DATA TO OCTAL ASCII CONVERSION ** SPC 1 * CALLING SEQUENCE: LDB (DATA WORD) * LDA (ADDRESS AT START OF STORAGE) * JSB ASCI SPC 1 ASCI NOP OUTPUT 6 DIGITS * STA ASSLC SET THE ADDRESS (NOT USED AT THE MOMENT ) LDA KM6 GET NO. OF DIGITS TO CONVERT RBL MOVE FIRST DIGIT TO LOW B JSB NUM.F CONVERT THE NUMBER JMP ASCI,I RETURN SPC 2 *SCI2 NOP 5 DIGITS & BLANK * LDA KM5 GET NO OF DIGITS TO CONVERT * BLF POSITION FIRST DIGIT * JSB NUM.F CONVERT THE NUMBER * JMP ASCI2,I RETURN * * *********************************** * * CONVERT DIGITS TO ASCII BASE 8 * * *********************************** * * NUM.F NOP STA T1NUM SAVE THE DIGIT COUNT CPA KM6 IF 6 THEN CLA,INA,RSS USE 1 AS A MASK FOR FIRST DIGIT NUM00 LDA K7 ELSE USE 7 AND B ISOLATE THE DIGIT ADA "0" ADD 60 TO MAKE ASCII JSB PUT.F PUT IN THE BUFFER BLF,RBR POSITION THE NEXT DIGIT ISZ T1NUM DONE? JMP NUM00 NO DO NEXT DIGIT * JMP NUM.F,I YES RETURN * T1NUM NOP KM6 DEC -6 * SPC 2 * * ******************************** * * PUT CHARACTER IN LIST BUFFER * * ******************************** * PUT.F NOP STB T1PUT SAVE B LDB ASSLC GET CURRENT BUFFER ADDRESS AND B177 ISOLATE THE CHARACTER CLE,ERB WORD ADDRESS TO B E=UPPER,LOWER FLAG SEZ,RSS IF UPPER CHAR ALF,SLA,ALF POSITION AND SKIP XOR B,I INCLUSION OF HIGHER CHAR. XOR B40 ADD,TAKE AWAY LOWER BLANK STA B,I SET THE WORD DOWN ISZ ASSLC STEP THE CHAR ADDRESS LDB T1PUT RESTORE B JMP PUT.F,I RETURN * T1PUT NOP OABUF NOP B40 OCT 40 K7 DEC 7 D8 DEC 8 "0" OCT 60 D29 DEC 29 DM37 DEC -37 BLANK ASC 1, ASTRK OCT 52 LOWER BYTE = * B177 OCT 177 TEMP NOP XTEMP NOP YTEMP NOP ADDRS NOP PONTR NOP DUMMY NOP THIS IS A DUMMY SUBROUTINE TO FIX UP A POINTER JSB .ENTR SO THAT THE PACK ROUTINE CAN WORK WITH ARRAYS DEF ADDRS IN A PROGRAM AS WELL AS MEMORY ADDRESSES. * LDA ADDRS STA PONTR,I JMP DUMMY,I SPC 1 * * * * * * * THE IASCI SUBROUTINE TAKES ONE WORD OF INPUT AND CONVERTS THAT * WORD TO ASCII. IF ANY BYTE CAN NOT BE CONVERTED TO ASCII THEN * AN ASCII BLANK IS RETURNED FOR THAT BYTE. * * * CALLING SEQUENCE : JSB IASCI * DEF RETURN * DEF VALUE VALUE TO BE CONVERTED * DEF ASCII RETURNED ASCII VALUE * ---- * * ON RETURN, THE B REGISTER HAS THE ASCII VALUE * VALUE NOP LOCTN NOP IASCI NOP JSB .ENTR DEF VALUE * LDA VALUE,I GET THE VALUE TO CONVERT STA TEMP1 SAVE IT AND M377 KEEP ONLY LOWER BYTE JSB CNVRT AND CONVERT STB VALUE SAVE THE RETURNED VALUE * LDA TEMP1 GET THE WORD BACK AGAIN AND M1774 KEEP ONLY THE UPPER BYTE ALF,ALF SHIFT TO LOW ORDER JSB CNVRT AND GO CONVERT BLF,BLF PUT INTO UPPER BYTE ADB VALUE NOW MERGE ADD IN LOWER BYTE STB LOCTN,I AND RETURN IT TO THE USER JMP IASCI,I * * * THIS SUBROUTINE CONVERTS LOWER BYTE OF A TO ASCII AND PLACES * THE RETURNED ASCII INTO B * CNVRT NOP STA B AND SAVE CMA,INA ADA B135 SSA IS IT OK JMP BLNK2 NO LDA B40 CMA,INA ADA B SSA OK ? BLNK2 LDB B40 NO JMP CNVRT,I * * * * A EQU 0 B EQU 1 M1774 OC/-`^ZT 177400 B135 OCT 137 M377 OCT 377 TEMP1 NOP END ܹ` Yn 24999-18202 1938 S 0100 &CMM4              H0101 GcFTN4 PROGRAM CMM4 (3,90),24999-16202 REV.1938 790911 C C C MIKE MANLEY RTE IV VERSION C 9/11/79 EFH C C DIMENSION IPBUF(33),LU(5),IBUF(30),IREG(2),IMESS5(6),IDP(22) DIMENSION IMESS0(8),IMESS1(9),IMES11(6),IMESS3(6),IMESS7(7) DIMENSION IMESS2(11),IWHAT(6),IMESS8(11),IPRAM(6),IVALU2(14) DIMENSION IARRAY(64),IDISC(36),MDISK(10),IVALUE(9),ITEL33(28) DIMENSION IEXT(4),ITEL22(14),ITEL23(20),ITEL24(17),ITEL25(22) DIMENSION IX(8),I1(11),I2(13),I3(12),I4(9),I5(13),I6(12) DIMENSION I7(9),I9(14),IG(11),IH(11),IJ(11),IK(9),IOUT(7) DIMENSION IL(12),IO(15),IP(16),IQ(17),IR(21),IDI(28),MEMR(7) DIMENSION IN(8),IM(22),IPACK(23),MORUSE(8),ITEL30(9),ITEL31(17) DIMENSION ITEL1(9),ITEL2(9),ITEL3(16),ITEL4(5),ITEL5(19),ITEL6(12) DIMENSION ITEL7(6),ITEL8(5),ITEL9(23),ITEL10(5),ITEL11(26) DIMENSION ITEL12(7),ITEL13(11),ITEL14(22),ITEL15(17),ITEL16(16) DIMENSION ITEL17(21),ITEL18(17),ITEL19(6),ITEL20(6),ITEL21(6) DIMENSION IGTOUT(27),ITAT(12),ISYS(5),IAUX(5),LDISC(5),IABS(7) DIMENSION IT(17),ITEL26(2),ITEL27(5),ITEL28(13),ITEL34(13) DIMENSION IPR(14),ILE(17),ITEL35(2),IGO(32),IRP(6),INBS(10) DIMENSION IPG(19),ITEL36(14),IPP(22),ITEL37(14),IFUN(4) DIMENSION INS(16),ITEL38(27),IMS(23),ITEL39(23),ISOR(19) C ^ DIMENSION IFPHD(29),IFPMS(17),IKIL(18),IFP(14),IFPAR(6),ILSEC(8) DIMENSION IBDSK(10),IEP(16),INOT4(16),INMOD(21) DIMENSION ISKP(10),IWLU(8),IWRN(8) EQUIVALENCE(IREG,REG,IA),(IREG(2),IB) EQUIVALENCE(IPBUF(2),IPRS1),(IPBUF(6),IPRS2),(IPBUF(10),IPRS3) EQUIVALENCE(IPBUF(14),IPRS4),(IPBUF(18),IPRS5) EQUIVALENCE(IPBUF(22),IPRS6),(IPBUF(26),IPRS7) EQUIVALENCE(IPBUF(30),IPRS8) C DATA IMESS1/2H ,2HID,2H S,2HEG,2H O,2HF / DATA MEMR/2H ,2HME,2HM ,2HRE,2HS ,2HPR,2HOG/ DATA IEXT/2H ,2HEX,2HTE,2HNT/ DATA IVALUE/2H ,2HWO,2HRD,2H ,,2H V,2HAL,2HUE,2H: ,2H _/ DATA IVALU2/2H ,2HLU,2H,T,2HRK,2H,S,2HEC,2HTR,2H,W,2HOR, & 2HD,,2HVA,2HLU,2HE:,2H _/ DATA MDISK/2H ,2HMO,2HDI,2HFY,2H O,2HP ,2HSY,2HST,2HEM,2H ?/ DATA IGTOUT/2H ,2HDI,2HSC,2H M,2HOD,2H !,2H ,2HEN,2HTE,2HR , & 2HA ,2H/D,2H A,2HT ,2HAN,2HY ,2HTI,2HME,2H T,2HO , & 2HEX,2HIT,2H T,2HHI,2HS ,2HMO,2HDE/ DATA IWHAT/2H ,2HSA,2HY ,2HWH,2HAT,2H ?/ DATA IMESS2/2H ,2HEQ,2HT ,2H# ,2H ,2H ,2H ,2H ,2HDV,2HR / DATA IMES11/2H ,2HNO,2HT ,2HFO,2HUN,2HD / DATA IMESS3/2H ,2HDR,2HT ,2HPA,2HRT,2H / DATA IMESS5/2H ,2HIN,2HT ,2HTA,2HBL,2HE / DATA IMESS0/2H ,2H =,2HCM,2HM4,2H D,2HON,2HE ,2H! / DATA IBUF/2H ,2HCM,2HM4,2H !,2H T,2HHE,2H R,2HTE, & 2H I,2HV ,2H S,2HYS,2HTE,2HM ,2H M,2HOD, & 2H/A,2HNA,2HLI,2HZE,2H P,2HRO,2HGR,2HAM,2H !, & 2H ,2H09,2H/1,2H1/,2H79/ DATA IMESS7/2H ,2HYE,2HS ,2HOR,2H N,2HO ,2H?_/ DATA IMESS8/2HIN,2HT ,2HTA,2HBL ,2HE ,2HST,2HAR,2HTS, & 2H A,2HT ,2H6./ C ^ DATA IDISC/2H ,2HLU,2H =,2H ,2H ,2H ,2H ,2HTR,2HK ,2H= , & 2H ,2H ,2H ,2H ,2HSE,2HCT,2HR ,2H= ,2H ,2H ,2H , & 2H ,2HWO,2HRD,2H =,2H ,2H ,2H ,2H ,2HOL,2HD(,2H8), & 2H =,2H ,2H ,2H / DATA IOUT/2H ,2HOU,2HT ,2HOF,2H R,2HAN,2HGE/ DATA ITEL1/2H ,2HID,2H,P,2HRO,2HGR,2HAM,2H N,2HAM,2HE / DATA ITEL2/2H ,2HID,2H,S,2HEG,2HME,2HNT,2H N,2HAM,2HE / DATA ITEL3/2H ,2HID,2H,N,2HUM,2HBR,2H =,2H A,2HLL,2H I, & 2HD',2HS ,2HIN,2H S,2HYS,2HTE,2HM / DATA ITEL4/2H ,2HEQ,2H,N,2HUM,2HBR/ DATA ITEL5/2H ,2HEQ,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HEQ,2HTS,2H I,2HNC,2HLU,2HSI, & 2HVE/ DATA ITEL6/2H ,2HLM,2H,A,2HDD,2HRE,2HSS,2H,#,2H O,2HF , & 2HWO,2HRD,2HS / DATA ITEL7/2H ,2HLM,2H,A,2HDD,2HRE,2HSS/ DATA ITEL8/2H ,2HDR,2H,N,2HYrUM,2HBR/ DATA ITEL9/2H ,2HDR,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HDR,2HT ,2HEN,2HTR,2HIE,2HS , & 2HIN,2HCL,2HUS,2HIV,2HE / DATA ITEL10/2H ,2HIN,2H,N,2HUM,2HBR/ DATA ITEL11/2H ,2HIN,2H,N,2HUM,2HBR,2H,N,2HUM,2HBR,2H , & 2HGI,2HVE,2HS ,2HIN,2HT ,2HTA,2HBL,2HE ,2HEN, & 2HTR,2HIE,2HS ,2HIN,2HCL,2HUS,2HIV,2HE / DATA ITEL12/2H ,2HLL,2H,L,2HIS,2HT ,2HLU,2H# / DATA ITEL13/2H ,2HPM,2H,A,2HDD,2HRE,2HSS,2H,N,2HEW, & 2H V,2HAL,2HUE/ DATA ITEL14/2H ,2HF/,2H,V,2HAL,2HUE,2H T,2HO ,2HFI,2HND, & 2H,S,2HTA,2HRT,2H A, & 2HDD,2HRE,2HSS,2H,#,2H O,2HF ,2HWO,2HRD,2HS / DATA ITEL15/2H ,2HLI,2H,E,2HNT,2HRY,2H P,2HOI,2HNT,2H N, & 2HAM,2HE ,2H,#,2H O,2HF ,2HWO,2HRD,2HS / DATA ITEL16/2H ,2HDL,2H,L,2HU,,2HTR,2HK,,2HSE,2HCT,2HR,, & 2H #,2H O,2HF ,2HSE,2HCT,2HOR,2HS / DATA ITEL17/2H ,2HDS,2H,L,2HU,,2HTR,2HK,,2H W,2HOR,2HD , & 2HTO,2H F,2HIN,2HD ,2H, ,2H(5,2H W,2HOR,2HDS, & 2H M,2HAX,2H) / DATA ITEL26/2H ,2HTA/ DATA ITEL27/2H ,2HTA,2H,L,2HU ,2H# / DATA ITEL28/2H ,2HTA,2H,L,2HU ,2H#,,2HTR,2HK ,2H#,, & 2H #,2H O,2HF ,2HTR,2HKS/ DATA ITEL18/2H ,2HDM,2H ,2H ,2HDI,2HSC,2H M,2HOD,2H , & 2H ,2H / DATA ITEL19/2H ,2HEX,2H ,2H ,2HEX,2HIT/ DATA ITEL20/2H ,2HEN,2H ,2H ,2HEX,2HIT/ DATA ITEL21/2H ,2H/E,2H ,2H ,2HEX,2HIT/ DATA ITEL22/2H ,2HXL,2H,A,2HDD,2HRE,2HSS,2H ,2H ,2H(S, & 2HYS,2HTE,2HM ,2HMA,2HP)/ DATA ITEL23/2H ,2HXL,2H,A,2HDD,2HRE,2HSS,2H,#,2H O,2HF , & 2HWO,2HRD,2HS ,2H ,2H(S,2HYS,2HTE,2HM ,2HMA, & 2HP)/ DATA ITEL24/2H ,2HXP,2H,A,2HDD,2HRE,2HSS,2H,V,2HAL,2HUE, & 2H ,2H ,2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA ITEL25/2H ,2HXF,2H,V,2HAL,2HUE,2H T,2HO ,2HFI,2HND, & 2H,S,2HTA,2HRT,2H A,2HDD,2HRE,2HSS,2H,#,2H O, & 2HF ,2HWO,2HRD,2HS / DATA ITEL30/2H ,2HDP,2H,V,2HAL,2HUE,2H,*,2H,V,2HAL,2HUE/ DATA ITEL31/2H ,2HTR,2H,S,2HTA,2HRT,2H L,2HOC,2HAT,2HIO,2HN,, &2HLI,2HST,2H D,2HEL,2HIM,2HIT,2HER/ DATA ITEL33/2H ,2HDI,2H,E,2HNT,2HRY,2H P,2HOI,2HNT,2H N,2HAM, &2HE / DATA ITEL34/2H ,2HLP,2H,P,2HRO,2HG ,2HNA,2HME,2H,R,2HEL, &2H A,2HDD,2HRE,2HSS/ DATA ITEL35/2H ,2HLE/ DATA ITEL36/2H ,2HPG,2H, ,2HPG,2H#,,2HOF,2HFS,2HET,2H,#,2H O, &2HF ,2HWO,2HRD,2HS / DATA ITEL37/2H ,2HPP,2H, ,2HPG,2H#,,2H O,2HFF,2HSE,2HT,, &2H N,2HEW,2H V,2HAL,2HUE/ DATA ITEL38/2H ,2HNS,2H, ,2H# ,2HOF,2H S,2HEC,2HTS,2H/T,2HRK, & 2H, ,2H# ,2HOF,2H S,2HEC,2HTS,2H/T,2HRK, &2H ,2H(F,2HOR,2H M,2HS ,2HCO,2HMM,2HAN,2HD)/ DATA ITEL39/2H ,2HMS,2H, , & 2HLU,2H,T,2HRK,2H,S,2HEC,2HTR,2H, , & 2HLU,2H,T,2HRK,2H,S,2HEC,2HTR,2H, , & 2H# ,2HOF,2H S,2HEC,2HTR,2HS / DATA IX/2H I,2HNP,2HUT,2H ,2HFU,2HNC,2HTI,2HON/ DATA I1/2H ,2HID,2H ,2HLI,2HST,2H I,2HD ,2HSE,2HGM,2HEN,2HT / DATA I2/2H ,2HEQ,2H ,2HLI,2HST,2H E,2HQT,2H A,2HND,2H E,2HXT, & 2HEN,2HTS/ DATA I3/2H ,2HDR,2H ,2HLI,2HST,2H D,2HEV,2H R,2HEF,2H T,2HAB, & 2HLE/ DATA I4/2H ,2HLM,2H ,2HLI,2HST,2H M,2HEM,2HOR,2HY / DATA IP/2H ,2HXL,2H ,2HLI,2HST,2H M,2HEM,2HOR,2HY ,2H , & 2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA I5/2H ,2HIN,2H ,2HLI,2HST,2H I,2HNT,2HER,2HUP,2HT ,2HTA, & 2HBL,2HE / DATA I6/2H ,2HLL,2H ,2HCH,2HAN,2HGE,2H L,2HIS,2HT ,2HDE,2HVI, & 2HCE/ DATA I7/2H ,2HPM,2H ,2HPA,2HTC,2HH ,2HME,2HMO,2HRY/ DATA IQ/2H ,2HXP,2H ,2HPA,2HTC,2HH ,2HME,2HMO,2HRY,2H ,2H , & 2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA I9/2H ,2HF/,2H ,2HFI,2HND,2H A,2H V,2HAL,O2HUE,2H I,2HN , & 2HME,2HMO,2HRY/ DATA IR/2H ,2HXF,2H ,2HFI,2HND,2H A,2H V,2HAL,2HUE,2H I,2HN , & 2HME,2HMO,2HRY,2H ,2H(S,2HYS,2HTE,2HM ,2HMA,2HP)/ DATA IG/2H ,2HLI,2H ,2HLI,2HST,2H E,2HNT,2HRY,2H P,2HOI,2HNT/ DATA IDI/2H ,2HDI,2H ,2HRE,2HPO,2HRT,2H D,2HIS,2HC ,2HDI,2HCT, &2HIO,2HNA,2HRY,2H A,2HDD,2HRE,2HSS,2H O,2HF ,2H A,2HN ,2HEN,2HTR, &2HY ,2HPO,2HIN,2HT / DATA ILE/2H ,2HLE,2H ,2HLI,2HST,2H A,2HLL,2H E,2HNT,2HRY, &2H P,2HOI,2HNT,2HS ,2HIN,2H S,2HYS/ DATA IH/2H ,2HDL,2H ,2HLI,2HST,2H D,2HIS,2HC ,2HSE,2HCT,2HOR/ DATA IJ/2H ,2HDM,2H ,2HDI,2HSC,2H M,2HOD,2H ,2HAN,2HY ,2HLU/ DATA IK/2H ,2HDS,2H ,2HDI,2HSC,2H S,2HEA,2HRC,2HH / DATA IL/2H ,2H/E,2H O,2HR ,2HEN,2H O,2HR ,2HEX,2H T,2HO , &2HEX,2HIT/ DATA IDP/2H ,2HDP,2H ,2HDI,2HSP,2HLA,2HY ,2HIN,2HPU,2HT , &2HIN,2H O,2HCT,2HAL,2H D,2HEC,2HIM,2HAL,2H &,2H A,2HSC,2HII/ DATA IN/2H ,2HTR,2H ,2HTR,2HAC,2HE ,2HLI,2HST/ DATA IPG/2H ,2HPG,2H ,2HLI,2HST,2H A,2HNY,2H L,2HOC,2HAT,2HIO, &2HN ,2HIN,2H P,2HHY,2HS ,2HME,2HMO,2HRY/ DATA IPP/2H ,2HPP,2H ,2HMO,2HDI,2HFY,2H A,2HNY,2H L,2HOC, &2HAT,2HIO,2HN ,2HIN,2H P,2HHY,2HSI,2HCA,2HL ,2HME,2HMO,2HRY/ DATA IM/2H ,2HXT,2H ,2HTR,2HAC,2HE ,2HLI,2HST,2H (,2HSY, &2HST,2HEM,2H M,2HAP,2H) / DATA IPR/2H ,2HLP,2H ,2HLI,2HST,2H D,2HIS,2HC ,2HRE,2HS , &2HPR, 2HOG,2HRA,2HM / DATA IPACK/2H ,2HA ,2HPK,2H A,2HFT,2HER,2H T,2HHE,2H I,2HNP, &2HUT,2H G,2HIV,2HES,2H A,2H P,2HAC,2HKE,2HD ,2HLI,2HST,2HIN, &2HG / DATA MORUSE/2H ,2HOR,2H U,2HSE,2H ,2H ,2HPK,2H, / DATA IT/2H ,2HTA,2H ,2HLI,2HST,2H T,2HRA,2HCK,2H A,2HSS, &2HIG,2HNM,2HEN,2HT ,2HTA,2HBL,2HE / DATA IO/2H ,2HFO,2HR ,2HMO,2HRE,2H I,2HNF,2HO ,2HDO,2H A, & 2H ?,2H?,,2HIN,2HPU,2HT / DATA ITAT/2H ,2HTR,2HAC,2HK ,2HAS,2HSI,2HGN,2HME,2HNT, &2H T,2HAB,2HLE/ DATA ISYS/2H ,2HSY,2HS ,2HDI,2HSC/  DATA INBS/2H# ,2HOF,2H S,2HEC,2HTO,2HRS,2H =/ DATA ISOR/2H ,2H ,2H ,2H , & 2HSO,2HUR,2HCE,2H I,2HS:,2H ,2H , & 2HDE,2HST,2HIN,2HAT,2HIO,2HN ,2HIS,2H: / DATA INS/2H ,2HNS,2H ,2HSE,2HT ,2H# ,2H O,2HF ,2HSE,2HCT,2HRS, &2H P,2HER,2H T,2HRA,2HCK/ DATA IMS/2H ,2HMS,2H ,2HMO,2HVE,2HS ,2HDI,2HSC,2H S,2HEC,2HTO, &2HRS,2H T,2HO ,2HAN,2HOT,2HHE,2HR ,2HDI,2HSC,2H A,2HRE,2HA / DATA IAUX/2H ,2HAU,2HX ,2HDI,2HSC/ DATA IRP/2H ,2HRP,2H / DATA LDISC/2H ,2HDI,2HSC,2H R,2HES/ DATA IABS/2H ,2HAB,2HS ,2H / DATA IGO/2HID,2HEQ,2HDR,2HXL,2HLM,2HIN,2HLL,2HPM,2HXP,2HF/, & 2HXF,2HLI,2HDI,2HLE,2HEP,2HDL,2HDM,2HDS,2HTA,2HTR,2HXT, & 2HDP,2HLP,2H??,2H/E,2HEX,2HEN,2HPG,2HPP,2HMS,2HNS,2HFP/ C DATA NSECTS/96/ DATA NSECT2/96/ DATA IFUN/2H,*,2H,/,2H,+,2H,-/ C ^ DATA IFPHD/2H ,2HFO,2HOT,2HPR,2HIN,2HT ,2HAR,2HEA,2H :,2H #, & 2H O,2HF ,2HCH,2HAN,2HGE,2HS ,2H= ,2H ,2H , & 2H ,2H ,2HLA,2HTE,2HST,2H 1,2H90,2H S,2HAV,2HED/ DATA IFPMS/2H ,2HNU,2HMB,2HER,2H O,2HF ,2HSE,2HCT,2HOR,2HS ,2HMO, & 2HVE,2HD ,2H= ,2H ,2H ,2H / DATA IKIL/2H ,2HTU,2HRN,2H O,2HFF,2H D,2HIS,2HK ,2HWR,2HIT,2HE , & 2HPR,2HOT,2HEC,2HT ,2HON,2H L,2HU2/ DATA IFP/2H ,2HFP,2H ,2HDI,2HSP,2HLA,2HY ,2HPA,2HST,2H D,2HIS, & 2HK ,2HMO,2HDS/ DATA ILSEC/2H ,2HIL,2HLE,2HGA,2HL ,2HSE,2HCT,2HOR/ DATA IBDSK/2H ,2HBA,2HD ,2HDI,2HSK,2H R,2HEF,2HER,2HEN,2HCE/ DATA IEP/2H ,2HEP,2H ,2HEJ,2HEC,2HT ,2HPA,2HGE,2H I,2HF , & 2HLI,2HNE,2H P,2HRI,2HNT,2HER/ DATA INOT4/2H ,2HNO,2HT ,2HRU,2HNN,2HIN,2HG ,2HON,2H A, & 2H R,2HTE,2H-I,2HV ,2HSY,2HST,2HEM/ DATA INMOD/2H ,2HNO,2HT ,2HAL,2HLO,2HWE,2HD-,2H-R,2HUN, & 2HNI,2HNG,2H N,2HO ,2HDI,2HSC,2H M,2HOD,2H V, & 2HER,2HSI,2HON/ DATA ISKP/2HPP,2HLL,2HPM,2HXP,2HDM,2HMS,2HNS,2H/E, & 2HEX,2HEN/ DATA IWLU/2H ,2HWA,2HIT,2HIN,2HG ,2HFO,2HR ,2HLU/ DATA IWRN/2H ,2HWA,2HIT,2HIN,2HG ,2HFO,2HR ,2HRN/ CALL RMPAR(LU) LU1=LU IF(LU1.EQ.0) LU1=1 LU2 = LU1+200B C C NO FOOTPRINT CHECK DONE IF : RU,CMM4,,,,,NF C INFP = LU(5) IF (INFP.EQ.2HNF) GO TO 15 C ^ C NO GO IF WE CANNOT INITIALIZE ON LU 2 C CALL CINIT (IARRAY) IF (IARRAY(1).NE.1) GO TO 5 CALL EXEC (2,LU1,IKIL,-36) GO TO 50 5 DO 10 I = 2,7 IFPAR(I-1) = IARRAY(I) 10 CONTINUE C 15 CALL EXEC(2,LU1,IBUF,30) IF (IRTE4(I).NE.-9) GO TO 45 C IPRMPT = 2H=_ * INTER = IFTTY(LU1) C C SET UP THE IPRAM BUFFER. THIS BUFFER IS USED BY THE I/O C SUBROUTINES (DOIO & DISC3) TO DETERMINE HOW THE I/O IS C TO BE DONE. C C UNLOCK LIST DEVICE 1 CALL LURQ (100000B,LU2-200B,1) IPRAM = 1 IPRAM(2) = 0 IPRAM(3) = 0 IPRAM(4) = 0 IPRAM(5) = 0 IPRAM(6) = -1 CALL EXEC(2,LU1,IPRMPT,-2) REG = REIO(1,LU1 + 400B,IBUF,30) CALL PARSE(IBUF,IB*2,IPBUF) C SEE IF THE PACKED FORM OF THE OUTPUT IS DESIRED IF(IPBUF(3).EQ.2HPK) IPRAM(5) = 1 C C LOCK LIST DEVICE EXCEPT IF INTERACTIVE DEVICE C OR INTERACTIVE OR NONLISTING COMMAND C IF (INTER.EQ.-1) GO TO 19 DO 16 I = 1,10 IF (IPRS1.EQ.ISKP(I)) GO TO 19 16 CONTINUE IRQFG = -1 17 CALL LURQ(100001B,LU2-200B,1) CALL ABREG(IA,IB) IF (IA.EQ.0) GO TO 19 IF (IA.EQ.-1) GO TO 18 IF (IRQFG.EQ.-1) CALL EXEC (2,LU1,IWLU,8) IRQFG = 0 GO TO 21 18 IF (IRQFG.EQ.-1) CALL EXEC (2,LU1,IWRN,8) IRQFG = 0 21 CALL EXEC (12,0,2,0,-5) IF (IFBRK(IDMY)) 1,17 C C C FIND OUT WHICH COMMAND IT WAS C C 19 DO 20 I = 1,32 IF(IPRS1.EQ.IGO(I)) GO TO(100,200,300,400,410,500,600,710,700, &l810,800,900,900,900,2400,1000,1100,1400,1500,1610,1600,1700, &100,9000,50,50,50,1900,1900,2100,2200,2300) I 20 CONTINUE C C C ILLEGAL COMMAND C C 25 CALL EXEC(2,LU1,IWHAT,-12) GO TO 1 30 CALL EXEC(2,LU1,IOUT,7) GO TO 1 35 CALL EXEC(2,LU1,INMOD,21) GO TO 1 40 CALL EXEC (2,LU1,IBDSK,10) GO TO 1 45 CALL EXEC(2,LU1,INOT4,16) 50 CALL EXEC(2,LU1,IMESS0,-16) CALL EXEC(6,0) C C C **********GET ID SEGMENT INFO************** 100 KYWORD = IGET(1657B) -1 IF(IPBUF(5).EQ.1) GO TO 175 C C 150 DO 170 I = 1,257 KYWORD = KYWORD +1 IF(IGET(KYWORD).EQ.0) GO TO 190 IF(((IPRS2.EQ.IGET(IGET(KYWORD)+12)).AND. & (IPBUF(7).EQ.IGET(IGET(KYWORD)+13))).AND. & (IPBUF(8).EQ.IOR(IAND(IGET(IGET(KYWORD)+14),177400B),40B))) & GO TO 176 170 CONTINUE 175 KYWORD = KYWORD +1 IF(IPRAM(3).EQ.9999) GO TO 1 IF(IGET(KYWORD).EQ.0) GO TO 1 IF(IGET(IGET(KYWORD)+12).NE.0) GO TO 176 IMESS1(7) = 2H GO TO 180 176 IMESS1(7) = IGET(IGET(KYWORD)+12) IMESS1(8) = IGET(IGET(KYWORD)+13) IMESS1(9) = IGET(IGET(KYWORD)+14) C 180 ISTART = IGET(KYWORD) ISTOP = ISTART +32 C ITEMP IS THE PROGRAM TYPE ITEMP = IAND(IGET(IGET(KYWORD) +14),17B) C ITEMP1 IS THE ID SEGMENT TYPE ITEMP1= IAND(IGET(IGET(KYWORD) +14),20B) IF(ITEMP1.EQ.20B) ISTART= IGET(KYWORD) +11 IF(ITEMP1.EQ.20B) ISTOP = ISTART + 8 C C SEE IF THIS IS 'ID' OR 'LP' COMMAND C IF(IPRS1 .EQ.2HLP) GO TO 1800 C C 'ID' COMMAND, SO GIVE HIM THE ID SEGMENT !! CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IMESS1,-17) CALL DOIO(ISTART,ISTOP,LU2,IPRAM) C C IF NOT EMA OR IF IT'S A SEGMENT OR MEM RES C THEN DON'T PRINT THE ID EXTENSION C IF((ITEMP1 .EQ. 20B).OR. (ITEMP .EQ. 1)) GO TO 185 IF(IGET(IGET(KYWORD)+28).EQ.0) GO TO 185 C \GET THE ID EXTENSION ISTART = IDEX(IGET(KYWORD)) CALL EXEC(2,LU2,IEXT,4) CALL DOIO(ISTART,ISTART+2,LU2,IPRAM) 185 IF(IPBUF(5).EQ.1) GO TO 175 GO TO 1 190 CALL EXEC(2,LU1,IMES11,-12) GO TO 1 C C C **********GET EQT INFO************* C C 200 IEQTA = IGET(1650B) IEQTNO = IGET(1651B) IF(IPRS3 .GT. IEQTNO) IPRS3 = IEQTNO IF(IPRS2.GT.IEQTNO) GO TO 25 IF(IPRS2.LT. 1) IPRS2 = 1 C C DO 210 I = IPRS2,IPRS3 IF(IPRAM(3) .EQ. 9999) GO TO 1 ISTART = IEQTA + (I - 1)*15 CALL CNUMD(I,IBUF(2)) IMESS2(4) = IBUF(4) IBUF = (IAND(IGET(ISTART+4),37400B)/256) IBUF = IBUF + 2*(IBUF/8) CALL CNUMD(IBUF,IBUF(2)) C INSERT A 0 SO DVR00 DOESNT LOOK LIKE DVR 0 IF (IAND(IBUF(4),177400B).EQ.20000B) IBUF(4) = IBUF(4) + 10000B IMESS2(11) = IBUF(4) C CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IMESS2,11) CALL DOIO(ISTART,ISTART +14,LU2,IPRAM) C C C GET THE DISC ADDRESS OF THE EQT CALL DTRK(ISTART+11,ITRK,ISECTR,IWORD,ISTOP,IARRAY) C GET THE SECTOR CALL EXEC(1,102B,IARRAY,64,ITRK,ISECTR) C IF IT IS DVR00 THERE ARE NO EXTENTS C IF # OF EXTENT WORDS IS NEG THERE ARE NO EXTENTS IF((IARRAY(IWORD).LT.1).OR.(IBUF(4).EQ.30060B)) GO TO 210 IDRT = IARRAY(IWORD) C NOW GET THE ADDRESS OF THE EXTENT CALL DTRK(ISTART+12,ITRK,ISECTR,IWORD,ISTOP,IARRAY) CALL EXEC(1,102B,IARRAY,64,ITRK,ISECTR) C IF ADDRESS OF EXTENT IS NEG THERE ARE NO EXTENTS IF(IARRAY(IWORD).LT.1) GO TO 210 C C CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IEXT,4) CALL DOIO(IARRAY(IWORD),IARRAY(IWORD)+IDRT-1,LU2,IPRAM) 210 CONTINUE GO TO 1 C C C C **********GET DEVICE REF TABLE************** C 300 IDRT = IGET(1652B) LUMAX = IGET(1653B) IMESS3(6) = 20061B C C CALL EXEC(2,LU2,IMESS3,6) IF(IPRS3.GT.LUMAX) IPRS3 = LUMAX IF(IXPRS2.LE.0) IPRS2 = 1 IF (IPBUF(9).EQ.0) IPRS3 = IPRS2 CALL DOIO(IDRT + IPRS2-1,IDRT + IPRS3-1,LU2,IPRAM) IMESS3(6) = 20062B CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IMESS3,6) CALL DOIO(IDRT+IPRS2-1+LUMAX,IDRT+IPRS3-1+LUMAX,LU2,IPRAM) GO TO 1 C C C C ***********LIST ANY MEMORY LOCATION REQUESTED**************** C C 400 IPRAM(4) = -1 410 IF (IPRS3.LE.0) IPRS3 = 1 IF (IPRS2.LT.0) GO TO 30 CALL DOIO(IPRS2,IPRS2+IPRS3-1,LU2,IPRAM) GO TO 1 C C C *************GET THE INTERUPT TABLE***************** C C 500 INTBA = IGET(1654B) INTLG = IGET(1655B) C C IF(IPRS2.LT.6) GO TO 550 CALL EXEC(2,LU2,IMESS5,-12) IF(IPRS3.GT.INTLG) IPRS3 = INTLG IF (IPBUF(9).EQ.0) IPRS3 = IPRS2 ISTART = INTBA + IPRS2 -6 ISTOP = INTBA +IPRS3 -6 IPRAM = IPRS2 IPRAM(2) = 1 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) GO TO 1 550 CALL EXEC(2,LU1,IMESS8,-22) GO TO 1 C C C C ***********CHANGE OUTPUT LU*************** C C 600 LU2 = IPRS2 + 200B INTER = IFTTY(IPRS2) C CHECK IF LEGAL LU CALL EXEC(100015B,IPRS2,ISTA1) GO TO 25 610 GO TO 1 C C C C ***********PATCH MEMORY ANY MEMORY LOCATION**************** C 700 IPRAM(4) = -1 710 CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) IF (LU1.NE.LU2-200B) CALL DOIO(IPRS2,IPRS2,LU1,IPRAM) CALL EXEC(2,LU1,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) C IF YOU CHANGE YOUR MIND THIS IS THE ESCAPE ROUTE IF(IPBUF(7).NE.2HYE) GO TO 1 IF(IPRAM(4).EQ.0)CALL IPUT(IPRS2,IPRS3) IF(IPRAM(4).EQ.-1)CALL IXPUT(IPRS2,IPRS3) CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) IF (LU1.NE.LU2-200B) CALL DOIO(IPRS2,IPRS2,LU1,IPRAM) GO TO 1 C C C*******FIND A WORD BETWEEN GIVEN LIMITS IN MEMORY******** C 800 IPRAM(4) = -1 810 IF (IPRS3.LT.0) GO TO 30 DO 850 I = IPRS3,IPRS3+IPRS4-1 IF(IPRAM(4).EQ.-1)j GO TO 815 IF(IGET(I).EQ.IPRS2) GO TO 820 GO TO 850 815 IF(IXGET(I).EQ.IPRS2) GO TO 820 GO TO 850 820 CALL DOIO(I,I,LU2,IPRAM) IF(IPRAM(3).EQ.9999) GO TO 1 IPRAM(3) = 1 IPRAM = IPRAM + 1 850 CONTINUE IF(IPRAM(3).EQ.0) GO TO 190 GO TO 1 C C C*******FIND ADDRESS OF SELECTED SYSTEM ENTRY POINTS******** C C C C C C 900 ITRK = IGET(1761B)/128 ISECTR = IAND(IGET(1761B),177B)-1 IPRAM(4) = -1 ICT = 1 C ^ DO 993 I = 1,(IGET(1762B)+IGET(1764B)+15)/16 ISECTR = ISECTR + 1 IF(ISECTR.NE.IGET(1757B)) GO TO 910 ISECTR = 0 ITRK = ITRK + 1 910 CALL EXEC(1,102B,IARRAY,64,ITRK,ISECTR) DO 992 J = 1,64,4 IF(IFBRK(IDUMY))1,911 911 IF(IPRS1.EQ.2HLE) GO TO 965 IF(((IARRAY(J).EQ.IPBUF(6)).AND.(IARRAY(J+1).EQ.IPBUF(7))).AND. &(IOR(IAND(IARRAY(J+2),177400B),40B).EQ.IPBUF(8))) GO TO 970 GO TO 992 C 965 CALL EXEC(2,LU2,IARRAY(J),-5) C C C 970 IF(IPRS1.EQ.2HDI) GO TO 995 MYTYPE = IAND(IARRAY(J+2),177B) + 1 GO TO (975,980,190,985,990) MYTYPE C C 975 IF (IPRS3.EQ.0) IPRS3 = 1 CALL DOIO(IARRAY(J+3),IARRAY(J+3)+IPRS3-1,LU2,IPRAM) IF(IPRAM(3).EQ.9999) GO TO 1 IPRAM(3) = 1 IPRAM = IPRAM + 1 GO TO 991 C C 980 CALL EXEC(2,LU2,LDISC,5) IDISC(7) = 2H CALL CNUMD((IARRAY(J+3)/128),IDISC(11)) CALL CNUMD(IAND(IARRAY(J+3),177B),IDISC(19)) CALL EXEC(2,LU2,IDISC(7),15) GO TO 991 C C C 985 CALL CNUMO(IARRAY(J+3),IABS(5)) CALL EXEC(2,LU2,IABS,7) GO TO 991 C C 990 CALL CNUMO(IARRAY(J+3),IRP(4)) CALL EXEC(2,LU2,IRP,6) C 991 IF(IPRS1.EQ.2HLI) GO TO 1 C ^ IF (ICT.EQ.(IGET(1762B)+IGET(1764B))) GO TO 1 ICT = ICT + 1 992 CONTINUE 993 CONTINUE IF(IPRS1.EQ.2HLE) GO TO 1 GO TO 190 C 995 IPRAM = 0 CALL DISC3(2,ITRK,ISECTR,J,IARRAY,IPRAM,LU2,IDISC)  GO TO 1 C C C********LOOK AT ANY DISC LOCATION************ 1000 INSEC = NSECTS IF(IPRS2 .LE. 3) INSEC = IGET(1755B + IPRS2) DO 1050 J = 1,IPRS5 CALL EXEC(100001B,IPRS2 + 100B,IARRAY,64,IPRS3,IPRS4) GO TO 40 1010 CALL DISC3(IPRS2,IPRS3,IPRS4,IPRAM,IARRAY,IPRAM,LU2,IDISC) IF(IPRAM(3).EQ.9999) GO TO 1 IPRS4 = IPRS4 + 1 IF(IPRS4.LT.INSEC) GO TO 1050 IPRS4 = 0 IPRS3 = IPRS3 + 1 1050 CONTINUE GO TO 1 C C C C*************MODIFY OP SYSTEM ON THE DISC**************** C C C 1100 IF (INFP.EQ.2HNF) GO TO 35 CALL EXEC(2,LU1,IGTOUT,27) CALL EXEC(2,LU1,MDISK,10) CALL EXEC(2,LU1,IMESS7,7) REG = REIO(1,LU1+400B,IBUF,1) IF(IBUF.EQ.2H/D) GO TO 1 IF(IBUF.NE.2HYE) GO TO 1150 C C C C ASK FOR THE LOCATION AND REPLACEMENT VALUE C 1125 CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU1,IVALUE,9) REG = REIO(1,LU1 +400B,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IF(IPBUF.EQ.2) GO TO 1 IFIX = IPRS2 ILU = 2 INULL = IPBUF(5) C CALL DTRK(IPRS1,ITRK,ISECTR,IWORD,ISTOP,IARRAY) C SEE IF WORD IS BEYOND ACTUAL OP SYSTEM SIZE C IF(IPRS1.GT.ISTOP) GO TO 30 C ASSIGN 1125 TO ILABEL C GO TO 1205 C C C** THIS SECTION ALLOWS MODIFICATION OF ANY DISC** C C 1150 CALL EXEC(2,LU2,IMESS1,1) CALL EXEC(2,LU1,IVALU2,14) REG=REIO(1,LU1+400B,IBUF,10) CALL PARSE(IBUF,IB*2,IPBUF) IF(IPBUF.EQ.2) GO TO 1 ILU= IPRS1 ITRK= IPRS2 ISECTR = IPRS3 IWORD = IPRS4 IF(IWORD .LE. 0 ) GO TO 25 IFIX = IPBUF(18) INULL = IPBUF(17) C ASSIGN 1150 TO ILABEL C C 1205 IPRAM(6) = 0 1210 CALL EXEC(100001B,ILU+100B,IARRAY,64,ITRK,ISECTR) GO TO 40 1220 IPRAM = 0 CALL DISC3(ILU,ITRK,ISECTR,IWORD,IARRAY,IPRAM,LU2,IDISC) IF (LU1.NE.LU2-200B) &CALL DISC3(ILU,ITRK,ISECTR,IWORD,IARRAY,IPRAM,LU1,IDISC) C IF+  (INULL.EQ.0) GO TO ILABEL CALL EXEC(2,LU1,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) IF(IPBUF(7).NE. 2HYE) GO TO ILABEL C ^ C CHECK THAT IS NOT FP AREA 1ST TRK AND SECTR IF ((ILU.EQ.2).AND.(ITRK.EQ.IFPAR(5)).AND.(ISECTR.EQ.IFPAR(6))) & GO TO 1320 C C C C LETS GO MODIFY THE TRACK ASSIGNMENT TABLE SO WE CAN WRITE C ON SYSTEM TRACKS. C 1300 LUTYP = 0 IF(ILU.EQ.3) LUTYP = IGET(1756B) ITAT = IGET(1656B) + ITRK +LUTYP C ^ ITEMP = IARRAY(IWORD) IARRAY(IWORD) = IFIX ISTART = IGET(ITAT) IF(ILU.LT.4)CALL IPUT(ITAT,IGET(1717B)) C !!!!!PATCH DISC!!!!!! CALL EXEC(100002B,ILU+74100B,IARRAY,64,ITRK,ISECTR) GO TO 1310 C ^ 1305 IF(ILU.LT.4) CALL IPUT(ITAT,ISTART) CALL EXEC (1,ILU+100B,IARRAY,64,ITRK,ISECTR) IF (IARRAY(IWORD).NE.IFIX) GO TO 1315 CALL IMFP(IFPAR,ILU,ITRK,ISECTR,IWORD-1,ITEMP,IARRAY) GO TO 1315 C C FIX TRACK ASSIGNMENT TABLE 1310 IF(ILU.LT.4)CALL IPUT(ITAT,ISTART) C C C C 1315 IPRAM(6) = 1 INULL = 0 GO TO 1210 1320 CALL EXEC(2,LU1,ILSEC,8) GO TO 1 C C C C C**********************DISC SEARCH ROUTINE************************ C C C C*** USE THIS SECTION TO UNPURGE A FILE. *** C*** HINT ! IF YOU UNPURGE DON'T FORGET THE EXTENTS OR YOU WILL *** C*** DEVELOP A FMGR -005 ERROR . C C 1400 ISTOP = 0 JK = 1 KK = 5 I = 0 IF(IPBUF(33).LT.4) GO TO 25 CALL EXEC(100001B,IPRS2,IARRAY,64,IPRS3,I) GO TO 40 C C 1405 DO 1410 K = 1,5 LU(K) = IARRAY(K) 1410 CONTINUE C C 1415 DO 1420 K = 1,IPBUF(33)-3 IF(LU(K).NE.IPBUF(10 + K*4)) GO TO 1430 1420 CONTINUE C C ISTART = I ISTOP = 1 IF(JK + 4 .GT. 64) ISTART = I - 1 CALL CNUMD(ISTART,IDISC(19)) CALL CNUMD(JK,IDISC(26)) CALL EXEC(2,LU2,IDISC(14),15) C C 1430 DO 1440 K = 1,4 LU(K) = LU(K + 1) 14R_40 CONTINUE C C JK = JK + 1 IF(JK .EQ. 65) JK = 1 KK = KK + 1 IF(KK.EQ.65) GO TO 1475 1450 LU(5) = IARRAY(KK) GO TO 1415 C C 1475 I = I + 1 KK = 1 IF(I .EQ. NSECTS) GO TO 1495 CALL EXEC(1,IPRS2,IARRAY,64,IPRS3,I) GO TO 1450 C C 1495 IF(ISTOP .EQ. 0) GO TO 190 GO TO 1 C C C C*********** PRINT OUT THE TRACK ASSIGNMENT TABLE ****************** C 1500 CALL EXEC(2,LU2,ITAT,12) IPRAM = 0 IF (IPRS4.LE.0) IPRS4 =1 IF((IPRS2.GT.3).OR.(IPRS2.LT.0)) GO TO 25 C GET # OF TRACKS ON AUX DISC INEED =-( IGET(1755B))- IGET(1756B) C GET STOP ADDRESS OF TAT FOR SYS DISC ISTOP = IGET(1656B) + IGET(1756B) - 1 IF (IPRS2 .EQ. 3) GO TO 1510 C PRINT OUT SYS DISC TRACK ASSIGNMENTS CALL EXEC(2,LU2,ISYS,5) C IF(IPRS3.EQ.0) GO TO 1505 IPRAM = IPRS3 C ISTART = IGET(1656B) + IPRS3 IF(ISTART .GT. ISTOP ) GO TO 25 IF(ISTART+IPRS4-1.LT.ISTOP)ISTOP=ISTART+IPRS4-1 1505 CALL DOIO(IGET(1656B)+IPRS3,ISTOP,LU2,IPRAM) C C IF(IPRAM(3).EQ.9999) GO TO 1 1510 IF(IPRS2.EQ.2) GO TO 1 IF (INEED .EQ.0 ) GO TO 1 C CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IAUX,5) ISTART = ISTOP + 1 + IPRS3 ISTOP = ISTOP + INEED IF(ISTART .GT.ISTOP) GO TO 25 IF(IPRS3 .EQ. 0 ) GO TO 1520 IPRAM = IPRS3 IF(ISTART+IPRS4-1 .LT. ISTOP)ISTOP = ISTART+IPRS4-1 1520 CALL DOIO(ISTART,ISTOP,LU2,IPRAM) IF(IPRAM(3) .EQ. 9999) GO TO 1 GO TO 1 C C C******************* TRACE A LIST IN ANY MAP ************************** C 1600 IPRAM(4) = -1 1610 IF((IPRS2 .LT.1).OR. (IPRS2 .EQ.IPRS3)) GO TO 1 CALL DOIO(IPRS2,IPRS2,LU2,IPRAM) IPRAM(3) = 1 IF(IPRAM(4).EQ.0) IPRS2 = IGET(IPRS2) IF(IPRAM(4).EQ.-1) IPRS2 = IXGET(IPRS2) GO TO 1610 C C*********DISPLAY WHATEVER THE USER HAS INPUT ************ C C 1700 IF(IPRS3.EQ.0) GO TO 1750 IF(IPRS3.EQ.2H* )IPRS2 = IPRS2*IPRS4 IF(IPRS3.EQ.2H+ )IPRS2 = IPRS2+IPRS4 IF(IPRS3.EQ.2H/ )IPRS2 = IPRS2/IPRS4 IF(IPRS3.EQ.2H- )IPRS2 = IPRS2-IPRS4 1750 IARRAY = IPRS2 IPRAM = 0 IPRAM(3) = 1 CALL DISC3(1,1,1,1,IARRAY,IPRAM,LU2,IDISC) GO TO 1 C C C*********DISPLAY ABSOLUTE PROGRAM ON THE DISC*********** C C 1800 IF(ITEMP.EQ.1) GO TO 1880 IF(ISTOP - ISTART .EQ. 8) ISTOP = ISTOP +6 ISTART = IGET(ISTOP - 6) IPRS2 = 2 IF(ISTART.LT.0) IPRS2 = 3 INSEC = IGET(IPRS2 + 1755B) ISECTR = IAND(ISTART,177B) ITRK = (IAND(ISTART,77777B)/128) C DO NOT OFFSET A SEGMENT IF (ITEMP.NE.5) IPRS3 = IPRS3 + 34 C SET A FLAG FOR THE DTRK SUBROUTINE IARRAY = -IPRS2 CALL DTRK(IPRS3,IARRAY,IARRAY(2),IPRAM,ISTOP,IARRAY) C ON RETURN IARRAY(1) =TRK#,IARRAY(2) = SECTR# C IWORD = WORD # C IPRS3 = ITRK+IARRAY IPRS4 = ISECTR + IARRAY(2) IPRS5 = 1 IPRAM(4) = 1 IF((IPRS4 -INSEC - 1).LE.0) GO TO 1850 C OPPS TOO MANY SECTORS C IPRS3 = IPRS3 + 1 IPRS4 = IPRS4 - INSEC C 1850 GO TO 1000 1880 CALL EXEC(2,LU1,MEMR,7) GO TO 1 C C C************ LIST ANY LOCATION IN PHYSICAL MEMORY ********* C C 1900 IF((IPRS2.GT.1023).OR.(IPRS2.LT.0))GO TO 25 IF((IPRS1.EQ.2HPG).AND.(IPRS4.LT.1)) GO TO 25 CALL DUMMY(IARRAY,ISTART) IF(IPRS3.LT.1024) GO TO 1910 ISTOP = IPRS3/1024 IPRS2 = IPRS2 + ISTOP IPRS3 = IPRS3 -(ISTOP * 1024) C 1910 ISTOP = 63 J = IPRS4 IPRAM(2) = 1 C DO 1950 I = 1,IPRS4,64 IPRAM = IPRS3 IPRAM(6) = IPRS2 IF(IPRS1 .EQ. 2HPP) GO TO 2000 CALL MAPXX(IPRS2,IPRS3,IARRAY,1,0) IF(J .LT. 64) ISTOP = J - 1 CALL DOIO(ISTART,ISTART + ISTOP,LU2,IPRAM) C IF(IPRAM(3).EQ.9999) GO TO 1 IPRAM(3) = 1 J = J - 64 1950 CONTINUE GO TO 1 C C C************MODIFY ANY LO CATION IN PHYSICAL MEMORY********************* C C 2000 CALL MAPXX(IPRS2,IPRS3,IARRAY,3,0) CALL DOIO(ISTART,ISTART,LU2,IPRAM) IF (LU1.NE.LU2-200B) CALL DOIO(ISTART,ISTART,LU1,IPRAM) CALL EXEC(2,LU1,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) IF(IPBUF(7).NE.2HYE) GO TO 1 CALL MAPXX(IPRS2,IPRS3,IARRAY,2,IPRS4) CALL MAPXX(IPRS2,IPRS3,IARRAY,3,0) CALL DOIO(ISTART,ISTART,LU2,IPRAM) IF (LU1.NE.LU2-200B) CALL DOIO(ISTART,ISTART,LU1,IPRAM) GO TO 1 C C C********************* MOVE DATA ON THE DISC *************************** C C C THIS SECTION OF CMM4 CAN DESTROY A SYSTEM FASTER AND BETTER C THAN ANYTHING I KNOW. C YOU ARE LITERALLY TAKING YOUR LIFE IN YOUR HANDS !!!!!! C 2100 IF (INFP.EQ.2HNF) GO TO 35 INSECS = NSECTS INSEC2 = NSECT2 IF(IPRS2 .LT. 4) INSECS = IGET(1755B + IPRS2) IF(IPRS5 .LT. 4) INSEC2 = IGET(1755B + IPRS5) IPRAM(5) = 1 IPRAM(2) = 1 C ^ ITEMP = IOR(IPRS7,100000B) CALL EXEC(2,LU1,ISOR(5),5) CALL DISC3(IPRS2,IPRS3,IPRS4,ISTART,IARRAY,IPRAM,LU2,IDISC) IF (LU1.NE.LU2-200B) &CALL DISC3(IPRS2,IPRS3,IPRS4,ISTART,IARRAY,IPRAM,LU1,IDISC) CALL EXEC(2,LU1,ISOR(12),8) CALL DISC3(IPRS5,IPRS6,IPRS7,ISTART,IARRAY,IPRAM,LU2,IDISC) IF (LU1.NE.LU2-200B) &CALL DISC3(IPRS5,IPRS6,IPRS7,ISTART,IARRAY,IPRAM,LU1,IDISC) CALL CNUMD(IPRS8,INBS(8)) CALL EXEC(2,LU1,INBS,10) CALL EXEC(2,LU1,IMESS7,-14) CALL REIO(1,LU1+400B,IPBUF(7),1) IF(IPBUF(7).NE.2HYE) GO TO 1 IF (IPRS8 .EQ. 0) GO TO 1 DO 2150 I = 1,IPRS8 C ^ IF ((IPRS5.EQ.2).AND.(IPRS6.EQ.IFPAR(5)).AND.(IPRS7.EQ.IFPAR(6))) & GO TO 2107 CALL EXEC(100001B,IPRS2,IARRAY,64,IPRS3,IPRS4) GO TO 40 2101 LUTYP = 0 IF(IPRS5.EQ.3) LUTYP = IGET(1756B) ITAT = IGET(1656B) + IPRS6 + LUTYP ISTART = IGET(ITAT) IF(IPRS5 .LT. 4) CALL IPUT(ITAT,IGET(1717B)) C ^ h CALL EXEC(100002B,IPRS5+74000B,IARRAY,64,IPRS6,IPRS7) GO TO 2105 2103 CALL ABREG(IA,IB) IF (IPRS5.LT.4) CALL IPUT (ITAT,ISTART) IF(IB.NE.64) GO TO 2107 IF (I.EQ.1) CALL IMFP(IFPAR,IPRS5,IPRS6,ITEMP,0,IPRS8,IARRAY) GO TO 2107 2105 IF(IPRS5 .LT. 4) CALL IPUT(ITAT,ISTART) 2107 IPRS4 = IPRS4 + 1 IF (IPRS4.LT.INSECS) GO TO 2110 IPRS4 = 0 IPRS3 = IPRS3 + 1 2110 IPRS7 = IPRS7 + 1 IF(IPRS7.LT.INSEC2) GO TO 2150 IPRS7 = 0 IPRS6 = IPRS6 + 1 2150 CONTINUE GO TO 1 C C **************SET UP THE # OF 64 WORD SECTORS/TRACK *********** C 2200 IF(IPRS3.NE.0) NSECT2 = IPRS3 NSECTS = IPRS2 GO TO 1 C ^ C C **********DISPLAY PAST DISK MODS******************** C C C 2300 IF (INFP.EQ.2HNF) GO TO 35 ITEMP = IFPAR(4) C *** HEADER *** CALL CNUMD(ITEMP,IFPHD(18)) CALL EXEC(2,LU2,IFPHD,29) IF (ITEMP.EQ.0) GO TO 1 C PRINT 190 MAX IF (ITEMP.GT.190) ITEMP = 190 ITRK = IFPAR(5) ISECTR = IFPAR(6) IWORD = 9 CALL EXEC (1,2,IARRAY,64,ITRK,ISECTR) C C LOOP TO SET UP AND PRINT EACH ENTRY C DO 2320 I = 1,ITEMP CALL CNUMD(IARRAY(IWORD)/64,IDISC(4)) CALL CNUMD(IARRAY(IWORD+1),IDISC(11)) IF (IARRAY(IWORD+2).LT.0) GO TO 2305 C C DISK MOD C CALL CNUMD(IARRAY(IWORD+2),IDISC(19)) IFIX = IAND(IARRAY(IWORD),77B) + 1 CALL CNUMD(IFIX,IDISC(26)) CALL CNUMO(IARRAY(IWORD+3),IDISC(34)) CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IDISC,36) GO TO 2380 C C MOVE SECTORS C 2305 CALL CNUMD(IAND(IARRAY(IWORD+2),77777B),IDISC(19)) CALL EXEC(3,LU2+700B,1) CALL EXEC(2,LU2,IDISC,21) CALL CNUMD(IARRAY(IWORD+3),IFPMS(14)) CALL EXEC(2,LU2,IFPMS,17) C ******* UPDATE POINTERS ******* 2380 IWORD = IWORD + 4 IF (IFBRK(IDMY).EQ.-1) GO TO 1 IF (IWORD.LE.64) GO TO 2320 IWORD = IWORD -64  ISECTR = ISECTR + 1 IF (ISECTR.LT.IGET(1757B)) GO TO 2310 ISECTR = 0 ITRK = ITRK + 1 C READ ANOTHER SECTOR WHEN NECESSARY 2310 CALL EXEC(1,2,IARRAY,64,ITRK,ISECTR) 2320 CONTINUE GO TO 1 C C **********EJECT PAGE (TOP OF FORM FOR LINE PRINTER) ********** C 2400 CALL EXEC(3,LU2+700B,-1) GO TO 1 C C******** MAKE THE PROGRAM FRIENDLY FOR THE PEOPLE ************ C 9000 DO 9025 I = 1,32 IF(IPRS2.EQ.IGO(I)) GO TO(9100,9200,9300,9960,9400,9500,9600, &9700,9970,9800,9980,9900,9988,9992,9925,9905,9910,9920, &9930,9984,9984,9982,9990,25,9940,9940,9940,9994,9996, &9997,9998,9950) I 9025 CONTINUE C C CALL EXEC(2,LU2,IX,8) CALL EXEC(2,LU2,I1,11) CALL EXEC(2,LU2,I2,13) CALL EXEC(2,LU2,I3,12) CALL EXEC(2,LU2,I4,9) CALL EXEC(2,LU2,IP,16) CALL EXEC(2,LU2,I5,13) CALL EXEC(2,LU2,IT,17) CALL EXEC(2,LU2,IN,8) CALL EXEC(2,LU2,IM,15) CALL EXEC(2,LU2,IPR,14) CALL EXEC(2,LU2,IDP,22) CALL EXEC(2,LU2,IPG,19) CALL EXEC(2,LU2,IPP,22) CALL EXEC(2,LU2,I6,12) CALL EXEC(2,LU2,I7,9) CALL EXEC(2,LU2,IQ,17) CALL EXEC(2,LU2,I9,14) CALL EXEC(2,LU2,IR,21) CALL EXEC(2,LU2,IG,11) CALL EXEC(2,LU2,IDI,28) CALL EXEC(2,LU2,ILE,17) CALL EXEC(2,LU2,IH,11) CALL EXEC(2,LU2,IJ,11) CALL EXEC(2,LU2,IK,9) CALL EXEC(2,LU2,IMS,23) CALL EXEC(2,LU2,INS,16) C ^ CALL EXEC (2,LU2,IEP,16) CALL EXEC(2,LU2,IFP,14) CALL EXEC(2,LU2,IL,12) CALL EXEC(2,LU2,IO,15) CALL EXEC(2,LU2,IPACK,23) GO TO 1 C C C C 9100 CALL EXEC(2,LU2,ITEL1,9) CALL EXEC(2,LU2,ITEL2,9) CALL EXEC(2,LU2,ITEL3,16) GO TO 9999 9200 CALL EXEC(2,LU2,ITEL4,5) CALL EXEC(2,LU2,ITEL5,19) GO TO 9999 9300 CALL EXEC(2,LU2,ITEL8,5) CALL EXEC(2,LU2,ITEL9,23) GO TO 9999 9400 CALL EXEC(2,LU2,ITEL7,6) CA@nLL EXEC(2,LU2,ITEL6,12) GO TO 9999 9500 CALL EXEC(2,LU2,ITEL10,5) CALL EXEC(2,LU2,ITEL11,26) GO TO 9999 9600 CALL EXEC(2,LU2,ITEL12,7) GO TO 1 9700 CALL EXEC(2,LU2,ITEL13,11) GO TO 1 9800 CALL EXEC(2,LU2,ITEL14,22) GO TO 1 9900 CALL EXEC(2,LU2,ITEL15,11) CALL EXEC(2,LU2,ITEL15,17) GO TO 1 9905 CALL EXEC(2,LU2,ITEL16,16) GO TO 9999 9910 CALL EXEC(2,LU2,ITEL18,17) GO TO 1 9920 CALL EXEC(2,LU2,ITEL17,21) GO TO 1 9925 CALL EXEC(2,LU2,IEP,2) GO TO 1 9930 CALL EXEC(2,LU2,ITEL26,2) CALL EXEC(2,LU2,ITEL27,5) CALL EXEC(2,LU2,ITEL28,13) GO TO 9999 9940 CALL EXEC(2,LU2,ITEL21,6) CALL EXEC(2,LU2,ITEL20,6) CALL EXEC(2,LU2,ITEL19,6) GO TO 1 9960 CALL EXEC(2,LU2,ITEL22,14) CALL EXEC(2,LU2,ITEL23,19) GO TO 9999 9970 CALL EXEC(2,LU2,ITEL24,17) GO TO 1 9980 CALL EXEC(2,LU2,ITEL25,22) GO TO 1 9982 CALL EXEC(2,LU2,ITEL30,5) DO 9983 I = 1,4 ITEL30(6) = IFUN(I) CALL EXEC(2,LU2,ITEL30,9) 9983 CONTINUE GO TO 1 9984 ITEL31(2) = IPRS2 CALL EXEC(2,LU2,ITEL31,17) GO TO 1 9988 CALL EXEC(2,LU2,ITEL33,11) GO TO 1 9990 CALL EXEC(2,LU2,ITEL34,13) GO TO 9999 9994 CALL EXEC(2,LU2,ITEL36,14) GO TO 9999 9996 CALL EXEC(2,LU2,ITEL37,14) C 9999 MORUSE(6) = IPRS2 CALL EXEC(2,LU2,MORUSE,8) GO TO 1 9992 CALL EXEC(2,LU2,ITEL35,2) GO TO 1 C ^ 9950 CALL EXEC(2,LU2,IFP,2) GO TO 1 C ??,MS 9997 CALL EXEC(2,LU2,ISOR(2),19) CALL EXEC(2,LU2,ITEL39,23) C ??,NS (AND ??,MS) 9998 CALL EXEC(2,LU2,ITEL38,10) CALL EXEC(2,LU2,ITEL38,27) GO TO 1 END END$ ASMB,Q * * * CINIT * FIND THE END OF THE ENTRY POINTS. IF MARKED, * WE'VE INITIALIZED ALREADY, OTHERWISE WE'D BETTER * DO IT. WE TAKE 12 SECTORS FOR THE FOOTPRINT AREA * * 1ST 5 WORDS OF FP AREA IARRAY * 1 = FLAG (-1v DONE) 1 = INIT FLAG (1 BAD) * 2 = NEXT TRACK (IFPAR(1)) * 3 = NEXT SECTOR (IFPAR(2)) * 4 = NEXT WORD (IFPAR(3)) * 5 = COUNT (IFPAR(4)) * 6 = START TRACK FP AREA * (IFPAR(5)) * 7 = START SECTOR FP AREA * (IFPAR(6)) * * NAM CINIT,7 ENT CINIT,DSKOT EXT EXEC, $LIBR, $LIBX, .ENTR * RRAY NOP CINIT NOP JSB .ENTR DEF RRAY * LDA RRAY CAX STA ELOC STA DLOC STA FLOC * LDA DSCLB DISC ADDR OF RES LIB ENTRY PTS CLB DIV D128 QUOTIENT = TRACK REM = SECT STA STRAK TRACK STB SSECT SECTOR * LDA DSCLN # RES LIB ENTRY PTS ADA DSCUN # RTE LIB ROUTINES CLB DIV D16 DIV BY # ENTS/SECT = # SECTS NEEDED SZB NEED PARTIAL SECTOR? INA ADD 1 TO # SECTS NEEDED ADA SSECT ADD IN START SECT ADA D6 OP SYS TAKES 384 MORE FOR GOOD MEASURE CLB DIV SECT2 DIV BY # SECT/TRACK = # TRACKS NEEDED ADA STRAK ADD IN START TRACK STA STRAK START TRACK OF FP AREA STB SSECT START SECTOR OF FP AREA * JSB EXEC GO READ THE SECTOR DEF *+7 DEF D1 READ DEF ICNWD LU2 BINARY ELOC NOP REALLY RRAY DEF IBUFL 64 WORDS DEF STRAK FP AREA 1ST TRACK DEF SSECT FP AREA 1ST SECTOR * LDA RRAY,I GET 1ST WORD SZA ZERO? JMP NEXT NO. HAVE INITIALIZED ALREADY * CCA YES. MUST INITIALIZE STA EFLAG STA RRAY,I SET FLAG LDA STRAK SAX D1,I SET TRACK  LDA SSECT SAX D2,I SET SECT LDA D8 SAX D3,I SET OFFSET * JSB DSKOT WRITE TO DISK DEF *+5 DEF STRAK THIS TRACK DEF SSECT THIS SECTOR DLOC NOP BUFFER TO WRITE DEF IBUFL # OF WORDS * * JSB EXEC READ BACK DEF *+7 TO CHECK THE WRITE DEF D1 DEF ICNWD FLOC NOP DEF IBUFL DEF STRAK DEF SSECT * LDA RRAY,I GET THE FIRST WORD CPA M1 IS IT -1 JMP NEXT CLB,INB STB RRAY,I FLAG IF NO WRITE DONE * NEXT LDA STRAK RETURN START TRACK SAX D5,I LDA SSECT RETURN START SECTOR SAX D6,I JMP CINIT,I * A EQU 0 B EQU 1 TAT EQU 01656B FWA OF TRACK ASSIGN TABLE XEQT EQU 01717B ID SEG ADDR OF CURRENT PROG SECT2 EQU 01757B # SECT/TRACK ON LU2 DSCLB EQU 01761B DISC ADDR IF RES LIB ENTRY PTS DSCLN EQU 01762B # RES LIB ENTRY PTS DSCUN EQU 01764B # RTE LIB ROUTINES * M1 OCT 177777 -1 FLAG D1 DEC 1 D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D8 DEC 8 D16 DEC 16 D128 DEC 128 * STRAK NOP SSECT NOP EFLAG NOP * ICNWD OCT 102 LU2, BINARY IBUFL DEC 64 BUFFER LENGTH * * * * DSKOT * SUBROUTINE TO WRITE TO DISK * MUST FUDGE TAT SO CAN WRITE ON * SYSTEM TRACKS * * TRK NOP SCT NOP BUF NOP BUFL NOP DSKOT NOP JSB .ENTR DEF TRK * LDA TAT TAT ADA TRK,I OFFSET FOR TRACK STA TTAT SAVE POINTER LDB A,I STB SAVE SAVE VALUE LDB XEQT GET OWN ID SEG ADDR * JSB $LIBR TURN OFF INTERRUPT SYS NOP STB A,I PUT OWN SELF IN AS OWNER OF TRK JSB $LIBX l TURN ON INTERRUPT SYS DEF *+1 DEF *+1 * JSB EXEC WATCH OUT! WRITING ON DISK DEF *+7 DEF CODE WRITE,ERR RETURN SET DEF ICNWD DEF BUF,I DEF BUFL,I DEF TRK,I DEF SCT,I JSB SERR ERROR RETURN * SERR LDA TTAT GET POINTER LDB SAVE GET SAVED VALUE JSB $LIBR TURN OFF INTERRUPT SYS NOP STB A,I PUT TAT BACK HOW WE FOUND IT JSB $LIBX TURN INTERRUPT SYS BACK ON DEF *+1 DEF *+1 JMP DSKOT,I BYE BYE * * TTAT NOP TEMP POINTER SAVE NOP TEMP VALUE CODE OCT 100002 END FTN4 SUBROUTINE IMFP (INFO,IL,IT,IS,IW,IV,IB) DIMENSION INFO(6),IB(64) C C C IMFP C I MAKE FOOTPRINTS C C FOUR WORDS/ENTRY C 1. LU (15-6) WORD (5-0) C 2. TRACK C 3. FLAG (15) SECTOR C 4. OLD VALUE (FLAG = 0) C # SECTORS MOVED (FLAG = 1) C C INFO = FOOTPRINT AREA INFORMATION C IL,IT,IS,IW = LU,TRACK,SECTOR,WORD MODIFIED C IV = OLD VALUE (DM) # SECTRS MOVED (MS) C C CALL EXEC (1,102B,IB,64,INFO(5),INFO(6)) C C MAKE SURE THEY DIDN'T CHANGE DISKS ON US C IF (IB(1).NE.-1) GO TO 200 DO 100 I = 2,5 IF (IB(I).NE.INFO(I-1)) GO TO 200 100 CONTINUE C C SET UP NEW ENTRY C CALL EXEC (1,102B,IB,64,INFO(1),INFO(2)) ITMP = INFO(3) IB(ITMP+1) = IOR((IL*64),IW) IB(ITMP+2) = IT IB(ITMP+3) = IS IB(ITMP+4) = IV C C MAKE A FOOTPRINT, MAKE SURE WE MADE IT, C IF EVERYTHING IS PEACHY, UPDATE THE POINTERS C FOR THE NEXT FOOTPRINT C IFLAG = -1 CALL DSKOT(INFO(1),INFO(2),IB,64) C CALL EXEC(1,102B,IB,64,INFO(1),INFO(2)) IF (IB(ITMP+1).EQ.IOR((IL*64),IW).AND.(IB(ITMP+2).EQ.IT) &.AND.(IB(ITMP+3).EQ.IS).AND.(IB(ITMP+4).EQ.IV)) &CALL UPTRS(INFO(1),INFO(2),INFO(I?3),INFO(4),INFO(5),INFO(6),IB) C 200 CONTINUE END C C C C C SUBROUTINE UPTRS (INT,INS,INW,ICT,IST,ISS,IDSK) DIMENSION IDSK(64) C C C UPDATE POINTERS C C INCREMENT COUNT, IF WE'VE FILLED THE FOOTPRINT C AREA, FILL IT UP ALL OVER AGAIN. C FIX THINGS IN CASE WE CROSS SECTOR OR TRACK C BOUNDARY SO WE KNOW WHERE TO STEP NEXT. C UPDATE ON DISK, TOO. C C ICT = ICT +1 IF (ICT-((ICT/190)*190).EQ.0) GO TO 101 INW = INW +4 IF (INW.LT.64) GO TO 201 INW = INW - 64 INS = INS + 1 ISECN = IGET(1757B) IF (INS.LT.ISECN) GO TO 201 INS = INS - ISECN INT = INT + 1 GO TO 201 101 INW = 8 INS = ISS INT = IST 201 CALL EXEC (1,102B,IDSK,64,IST,ISS) IDSK(2) = INT IDSK(3) = INS IDSK(4) = INW IDSK(5) = ICT CALL DSKOT(IST,ISS,IDSK,64) END END$ FTN4 SUBROUTINE DOIO(ISTART,ISTOP,LU,IPRAM) DIMENSION IBUF(40),IMESS(29),IPRAM(6),LMESS(17) DIMENSION IPAGE(11) INTEGER OBUF(37) C DATA IMESS/2H ,2HWO,2HRD, &2H ,2HLO,2HCA,2HTI,2HON,2H , &2HVA,2HLU,2HE(,2H8),2H ,2HVA,2HLU,2HE(,2H10,2H) , &2HVA,2HLU,2HE(,2HAS,2H) ,2HVA,2HLU,2HE(,2HSY,2HM)/ DATA IPAGE/2H ,2HPH,2HYS,2HIC,2HAL,2H P,2HAG,2HE / DATA LMESS/2H ,2HLO,2HCA,2HTI,2HON,2HS ,2H ,2H ,2H , &2H T,2HHR,2HOU,2HGH,2H / DATA IBUF/40*2H / C C C THE IPRAM ARRAY TELLS HOW TO DO THE I/O C IPRAM(1) = WORD # TO START COUNTING AT, C IPRAM(2) = 0 MEANS WORD COUNT TO BE IN DECIMAL C IPRAM(2) = 1 MEANS WORD COUNT TO BE IN OCTAL C IPRAM(3) = 0 MEANS PRINT HEADER. = 1 MEANS NO HEADER. C IPRAM(4) =-1 MEANS WE ARE DOING A CROSS MAP LOAD C IPRAM(5) = 1 MEANS A PACKED LISTING IS DESIRED C IPRAM(6) =+N MEANS A MAPPED IN LISTING OF PHYS MEMORY C WHERE N = PHYSICAL PAGE NUMBER C IPRAM(6) =-1 MEANS WE ARE DOING NORMAL I/O C C QRISTART IS LOCATION TO START COUNTING AT C ISTOP IS LOCATION TO STOP COUNTING AT. C LU IS THE OUTPUT LU. C C K = IPRAM-1 C IF(IPRAM(5).EQ.1) GO TO 500 C IF(IPRAM(6).LT.0) GO TO 1 CALL CNUMD(IPRAM(6),IPAGE(9)) CALL EXEC(2,LU,IPAGE,11) 1 IF(IPRAM(3).EQ. 0) CALL EXEC(2,LU,IMESS,-58) C C DO 100 I = ISTART,ISTOP K = K + 1 IF((IPRAM(6).LT.0).OR.(K.NE.1024)) GO TO 2 K = 0 IPRAM(6) = IPRAM(6) + 1 2 CALL CNUMD(K,IBUF(1)) IF(IPRAM(2) .EQ.1) CALL CNUMO(K,IBUF(1)) CALL CNUMO(I,IBUF(5)) IF(IPRAM(6).LT.0) GO TO 5 CALL CNUMD(IPRAM(6),IBUF(5)) IBUF(5) = 2HPG 5 IF(IPRAM(4) .NE.-1) GO TO 50 CALL CNUMO(IXGET(I),IBUF(10)) CALL CNUMD(IABS(IXGET(I)),IBUF(15)) IF(IXGET(I).LT.0)IBUF(15) = IBUF(15) + 6400B C CALL IASCI(IXGET(I),IBUF(22)) CALL INVRS(I,IXGET(I),IBUF(25),16,IWRD) C GO TO 75 50 CALL CNUMO(IGET(I),IBUF(10)) CALL CNUMD(IABS(IGET(I)),IBUF(15)) IF (IGET(I).LT.0) IBUF(15) = IBUF(15) + 6400B C CALL IASCI(IGET(I),IBUF(22)) CALL INVRS(I,IGET(I),IBUF(25),16,IWRD) C 75 CALL EXEC(2,LU,IBUF,24+IWRD) IF(IFBRK(IDMY))200,100 100 CONTINUE GO TO 300 200 IPRAM(3) = 9999 300 RETURN C C 500 K = ISTART 550 IF((ISTOP-K).LT.0) RETURN CALL CNUMO(K,LMESS(7)) CALL CNUMO(ISTOP,LMESS(15)) IF(((ISTOP-K)/64).GT.0) CALL CNUMO(K + 63,LMESS(15)) C IF(IPRAM(6).LT.0) GO TO 551 CALL CNUMO(IPRAM,LMESS(7)) CALL CNUMO(IPRAM+ISTOP - ISTART,LMESS(15)) CALL CNUMD(IPRAM(6),IPAGE(9)) C 551 CALL EXEC(3,LU + 700B,1) IF(IPRAM(6).GE.0) CALL EXEC(2,LU,IPAGE,11) CALL EXEC(2,LU,LMESS,17) CALL EXEC(3,LU + 1100B,1) C DO 800 I = 1,8 C CALL PACK (ISTOP - K + 1,IPRAM(4)+1,K,OBUF) CALL EXEC(2,LU,OBUF,37) C K = K + 8 IF((ISTOP-K).LT.0) RETURN IF(IFBRK(IDMY)) 200,800 800 CONTINUE C GO TO 550 END SUBROUTINE DISC3(LU,ITRK,ISECTR,INDEX,IARRAY,IPRAM,LU2,IDISC) DIMENSION IARRAY(64),IPRAM(6),IBUF(36) INTEGER OBUF(37) DIMENSION IDISK(25),IDISC(28) DATA IDISK/2H ,2HWO,2HRD,2H ,2H V,2HAL,2HUE,2H(8,2H) , & 2H V,2HAL,2HUE,2H(1,2H0),2H ,2HVA,2HLU,2HE(, & 2HAS,2H) ,2HVA,2HLU,2HE(,2HSY,2HM)/ DATA IBUF/36*2H / C C C THIS SUBROUTINE DOES THE I/O FOR ALL DISC READS. THE MAIN C PROGRAM DOES THE READ PASSING THE 64 WORDS READ IN IARRAY. C THIS ROUTINE FORMATS THE OUTPUT. C C IN ADDITION IT DOES THE OUTPUT FOR THE ' DP ' INSTRUCTION C THIS IS A SLIGHT PERTERBATION FROM THE SUBROUTINES REAL C PURPOSE. C C C IF IPRAM(1) #0 THEN 64 WORDS ARE OUTPUT C IF IPRAM(1) =0 THEN ONLY ONE WORD IS OUTPUT C IF IPRAM(3) # 0 THEN NO DISC TRK & SECTOR INFO IS PRINTED C IF IPRAM(4) = 1 THEN 64 WORDS ARE OUTPUT PLUS THE WORD # C IF IPRAM(5) = 0 THEN A PACKED LISTING IS DESIRED C IF IPRAM(6) = 1 THEN DONT PRINT ANY HEADER INFOD C CALL CNUMD(INDEX,IDISC(26)) IF(IPRAM .EQ.0) GO TO 55 NUMBR = 64 INDEX = 1 ID = 21 IF(IPRAM(4).EQ.1) ID = 28 GO TO 100 C 55 NUMBR = 1 ID = 28 C 100 IF(IPRAM(6) .EQ. 1) GO TO 150 CALL CNUMD(LU,IDISC(4)) CALL CNUMD(ITRK,IDISC(11)) CALL CNUMD(ISECTR,IDISC(19)) IF(IPRAM(3).NE.1) CALL EXEC(2,LU2,IDISC,ID) IF(IPRAM(5).NE.1) CALL EXEC(2,LU2,IDISK,25) C SEE IF JUST LIST OF DISC LOCATION DESIRED IF(IPRAM(2).EQ.1) RETURN C IF(IPRAM(5).EQ.1) GO TO 2000 C C 150 DO 1020 I = INDEX,NUMBR C CALL IASCI(IARRAY(I),IBUF(17)) C C C C CALL CNUMD(I,IBUF) CALL CNUMO(IARRAY(I),IBUF(5)) CALL CNUMD(IABS(IARRAY(I)),IBUF(10)) IF (IARRAY(I).LT.0) IBUF(10) = IBUF(10) + 6400B CALL INVRS (0,IARRAY(I),IBUF(21),16,IWRD) CALL EXEC(2,LU2,IBUF,20+IWRD)  IF(IFBRK(IDUMY)) 999,1020 1020 CONTINUE RETURN 999 IPRAM(3) = 9999 RETURN C C C FIX UP A POINTER TO THE ARRAY IARRAY SO THAT THE C PACK ROUTINE WILL WORK. C 2000 CALL DUMMY(IARRAY,IPOINT) C DO 3000 I = 1,8 CALL PACK(8,1,IPOINT,OBUF) CALL EXEC(2,LU2,OBUF,37) IPOINT = IPOINT + 8 IF(IFBRK(IDUMY)) 999,3000 3000 CONTINUE END END$ FTN4,L SUBROUTINE DTRK(IPRS1,ITRK,ISECTR,IWORD,ISTOP,IARRAY) DIMENSION IARRAY(64) C C SEE WHETHER WE ARE LOOKING AT A PROGRAM OR OP SYS. C NSECTS = IGET(1757B) IF(ITRK.GE.0) GO TO 1200 C C A PROGRAM ! C C GET THE # OF SECTORS PER TRACK NSECTS = IGET(1755B - ITRK) IPAST = IPRS1 ISTART = 0 GO TO 1240 C C C C GRANDFATHER DISC C C C BASE PAGE STARTS HERE 1200 IBASE = ISSCT(II) C ASSUME OP SYSTEM ENDS HERE ISTOP = 77770B C OP SYSTEM STARTS HERE ISTART = IBASE + 16 C C C SEE IF WORD IS ON BASE PAGE C IPAST = IPRS1 - 1024 IF(IPAST.GE. 0) GO TO 1240 C C WORD ON BASE PAGE C ITRK = 0 ISTART = IBASE ITEMP = IPRS1 GO TO 1250 C C 1240 ITRK = IPAST/(64*NSECTS) ITEMP = IPAST - (ITRK * 64 * NSECTS) 1250 ISECTR = ITEMP/64 IWORD = ITEMP - (ISECTR * 64) ISECTR = ISECTR +ISTART IF(ISECTR.LT.NSECTS) GO TO 1210 C C OOPS TOO MANY SECTORS C ITRK = ITRK + 1 ISECTR = ISECTR - NSECTS C C C C CHANGE RANGE OF WORD FROM 0-63 TO 1-64 SO FORTRAN CAN HANDLE IT. 1210 IWORD = IWORD + 1 END END$ ASMB,L NAM PIDMI,7 ENT PACK,IASCI,DUMMY,MAPXX,IDEX,IRTE4 * ENT IGET,IPUT EXT $LIBR,$LIBX,.ENTR,.ENTP,$IDEX,$OPSY * * * *GET NOP * DLD IGET,I * SWP * LDA A,I * LDA A,I * JMP B,I * * * *IXGET NOP * DLD IXGET,I * SWP * LDA A,I * XLA A,I * JMP B,I ?* * * *PUT NOP * JSB $LIBR * NOP * LDA IPUT,I * STA IGET * ISZ IPUT * DLD IPUT,I * LDA A,I * LDB B,I * STB A,I * JSB $LIBX * DEF IGET * * * *IXPUT NOP * JSB $LIBR * NOP * LDA IXPUT,I * STA IXGET * ISZ IXPUT * DLD IXPUT,I * LDA A,I * LDB B,I * XSB A,I * JSB $LIBX * DEF IXGET * IDEXX NOP IDEX NOP ROUTINE TO GET ADDRESS OF ID EXT JSB .ENTR GET THE PARAMETER DEF IDEXX LDB IDEXX,I GET THE ID ADDRESS ADB D28 INDEX TO ID EXT WORD LDA B,I PULL IT IN ALF ROTATE ARROUND RAL,RAL AND M77 KEEP ONLY ID EXT # ADA $IDEX ADD ADDRESS OF ID EXT TABLE LDA A,I PULL IN ADDRESS STA IDEXX,I AND GIVE TO CALLER JMP IDEX,I * D28 DEC 28 M77 OCT 77 * * * * * * * THIS ROUTINE ACCEPTS UP TO 8 WORDS OF INPUT AND CONVERTS THOSE * WORDS TO OCTAL ASCII IN A PACKED FORMAT . EIGHT WORDS OF OCTAL * DELIMITED BY A * AND THEN THEIR ASIII REPRESENTATION. * THE WORDS MAY EITHOR BE IN THE SYSTEM MAP OR THE USER MAP * THE ROUTINE IS FORTRAN CALLABLE AS: * * CALL PACK(#WORDS,MAP,INPUT BUFFER,OUTPUT BUFFER) * * MAP = 0 SYSTEM MAP * MAP >= 1 USER MAP * * THE OUTPUT BUFFER MUST BE 36 WORDS LONG * * * KOUNT NOP MAP NOP INBUF NOP ASSLC NOP PACK NOP JSB .ENTR GET THE PARAMETER ADDRESSES DEF KOUNT * LDA KOUNT,I GET THE # OF WORDS TO CONVERT BACK CMA,INA MAKE NEG AND SSA,RSS IF 0 OR NEG WORDS INPUT THEN FORGET IT JMP PACK,I STA KOUNT NOW SAVE FOR LOOP * ADA D8 ADD 8 TO SEE IF INPUT # SSA,RSS GREATER THAN 8 JMP CONTU ALL IS WELL ! LDA D8 JMP BACK * * CONTU LDA MAP,I GET THE MAP AND SAVE STA MAP FOR LATER * LDA INBUF,I } STA INBUF * LDA ASSLC GET THE ADDRESS LDB ASSLC TWICE STB TEMP SAVE TEMPORARIALLY INA BUMP IT CLE,ELA CONVERT TO A BYTE ADDRESS STA ASSLC AND SAVE FOR LATER ADB D29 NOW DEFINE THE ASCII ADDRESS STB OABUF AND SAVE FOR THE IASCI SUBROUTINE STB YTEMP * LDA DM37 NOW CLEAR OUT THE OLD BUFFER STA XTEMP LDB BLANK GET A BLANK READY * LOOPX STB TEMP,I SET A BLANK INTO THE OUTPUT BUFFER ISZ TEMP STEP BUFFER POINTER ISZ XTEMP DONE YET ? JMP LOOPX NO * * * LOOP LDB INBUF GET THE 1ST WORD LDA MAP GET THE MAP TO USE SZA,RSS SYS MAP ? JMP SYSTM YES LDB B,I NO JMP OUT SYSTM XLB B,I GET THE INFO FROM THE SYSTEM MAP OUT STB XTEMP SAVE FOR THE IASCI SUBROUTINE JSB ASCI AND CONVERT TO OCTAL ASCII * JSB IASCI AND PLACE THROUGH THE ASCII FILTER DEF *+3 DEF XTEMP DEF TEMP * STB OABUF,I PUT RESULT INTO THE OUTPUT BUFFER * ISZ INBUF BUMP OUR ISZ OABUF POINTERS ISZ ASSLC AND THE CHAR ADDRESS * ISZ KOUNT ARE WE DONE ? JMP LOOP NOT YET * CCB YES,GET THE END OF THE OCTAL #'S ADB YTEMP LDA B,I NOW GET THE LAST WORD IOR ASTRK PUT IN AN ASTRISK STA B,I NOW PUT IT BACK * JMP PACK,I RETURN TO THE CALLER * * * * ** DATA TO OCTAL ASCII CONVERSION ** SPC 1 * CALLING SEQUENCE: LDB (DATA WORD) * LDA (ADDRESS AT START OF STORAGE) * JSB ASCI SPC 1 ASCI NOP OUTPUT 6 DIGITS * STA ASSLC SET THE ADDRESS (NOT USED AT THE MOMENT ) LDA KM6 GET NO. OF DIGITS TO CONVERT RBL MOVE FIRST DIGIT TO LOW B JSB NUM.F c CONVERT THE NUMBER JMP ASCI,I RETURN SPC 2 *SCI2 NOP 5 DIGITS & BLANK * LDA KM5 GET NO OF DIGITS TO CONVERT * BLF POSITION FIRST DIGIT * JSB NUM.F CONVERT THE NUMBER * JMP ASCI2,I RETURN * * *********************************** * * CONVERT DIGITS TO ASCII BASE 8 * * *********************************** * * NUM.F NOP STA T1NUM SAVE THE DIGIT COUNT CPA KM6 IF 6 THEN CLA,INA,RSS USE 1 AS A MASK FOR FIRST DIGIT NUM00 LDA K7 ELSE USE 7 AND B ISOLATE THE DIGIT ADA "0" ADD 60 TO MAKE ASCII JSB PUT.F PUT IN THE BUFFER BLF,RBR POSITION THE NEXT DIGIT ISZ T1NUM DONE? JMP NUM00 NO DO NEXT DIGIT * JMP NUM.F,I YES RETURN * T1NUM NOP KM6 DEC -6 * SPC 2 * * ******************************** * * PUT CHARACTER IN LIST BUFFER * * ******************************** * PUT.F NOP STB T1PUT SAVE B LDB ASSLC GET CURRENT BUFFER ADDRESS AND B177 ISOLATE THE CHARACTER CLE,ERB WORD ADDRESS TO B E=UPPER,LOWER FLAG SEZ,RSS IF UPPER CHAR ALF,SLA,ALF POSITION AND SKIP XOR B,I INCLUSION OF HIGHER CHAR. XOR B40 ADD,TAKE AWAY LOWER BLANK STA B,I SET THE WORD DOWN ISZ ASSLC STEP THE CHAR ADDRESS LDB T1PUT RESTORE B JMP PUT.F,I RETURN * T1PUT NOP OABUF NOP B40 OCT 40 K7 DEC 7 D8 DEC 8 "0" OCT 60 D29 DEC 29 DM37 DEC -37 BLANK ASC 1, ASTRK OCT 52 LOWER BYTE = * B177 OCT 177 TEMP NOP D64 DEC 64 D1024 DEC 1024 XTEMP NOP YTEMP NOP ADDRS NOP PONTR NOP DUMMY NOP THIS IS A DUMMY SUBROUTINE TO FIX UP A POINTER JSB .ENTR SO THAT THE PACK ROUTINE CAN WORK WITH ARRAYS DEF ADDRS pH IN A PROGRAM AS WELL AS MEMORY ADDRESSES. * LDA ADDRS STA PONTR,I JMP DUMMY,I SPC 1 * * * * * * * THE IASCI SUBROUTINE TAKES ONE WORD OF INPUT AND CONVERTS THAT * WORD TO ASCII. IF ANY BYTE CAN NOT BE CONVERTED TO ASCII THEN * AN ASCII BLANK IS RETURNED FOR THAT BYTE. * * * CALLING SEQUENCE : JSB IASCI * DEF RETURN * DEF VALUE VALUE TO BE CONVERTED * DEF ASCII RETURNED ASCII VALUE * ---- * * ON RETURN, THE B REGISTER HAS THE ASCII VALUE * VALUE NOP LOCTN NOP IASCI NOP JSB .ENTR DEF VALUE * LDA VALUE,I GET THE VALUE TO CONVERT STA TEMP1 SAVE IT AND M377 KEEP ONLY LOWER BYTE JSB CNVRT AND CONVERT STB VALUE SAVE THE RETURNED VALUE * LDA TEMP1 GET THE WORD BACK AGAIN AND M1774 KEEP ONLY THE UPPER BYTE ALF,ALF SHIFT TO LOW ORDER JSB CNVRT AND GO CONVERT BLF,BLF PUT INTO UPPER BYTE ADB VALUE NOW MERGE ADD IN LOWER BYTE STB LOCTN,I AND RETURN IT TO THE USER JMP IASCI,I * * * THIS SUBROUTINE CONVERTS LOWER BYTE OF A TO ASCII AND PLACES * THE RETURNED ASCII INTO B * CNVRT NOP STA B AND SAVE CMA,INA ADA B176 SSA IS IT OK JMP BLNK2 NO LDA B40 CMA,INA ADA B SSA OK ? BLNK2 LDB B40 NO JMP CNVRT,I * * * * A EQU 0 B EQU 1 M1774 OCT 177400 B176 OCT 176 M377 OCT 377 TEMP1 NOP DM64 DEC -64 SIGN OCT 100000 * * * ************************************** * * MAP IN ANY PAGE OF PHYSICAL MEMORY * * ************************************** * * * THE PURPOSE OF THIS SUBROUTINE IS TO MAP IN THE PAGE REQUESTED * AND READ 64 WORDS OF THAT MAPPED PAGE. THE ROUTINE IS FORTRAN * CALLABLE. TO BE USED ONE OF TWO CONDITIONS MUST BE MET. * THE PROGRAM USING THE ROUTINE MUST NOT BE GREATER THAN 30K * IN LENGTH (IE IF PROGRAM IS 10K AND LARGEST ADDRESSABLE * PARTITION IS 12K YOUR OK. IF LARGEST ADDRESSABLE PARTITION IS * 11K YOU HAVE PROBLEMS). ALTERNATELY IF THE PROGRAM EXTENDS * INTO THE LAST TWO PAGES OF MEMORY MAKE SURE THIS ROUTINE * AND THE INPUT PARAMETERS TO THIS ROUTINE DO NOT RESIDE THERE * AND YOU WILL BE ALLRIGHT. * * THE PROGRAM MODIFIES THE USER MAP REGISTERS BUT ALSO RESTORES THEM. * * * CALLING SEQUENCE JSB MAPXX * DEF RETURN * DEF PAGE# PHYSICAL PG # (0-1023) * DEF OFFSET (NOT GREATER THAN 1023 DECIMAL) * DEF ARRAY (ARRAY OF 64 WORDS) * DEF FLAG 1/2/3 READ/WRITE/READ BUT DON'T * UPDATE PAGE# OR OFFSET * DEF NVAL NEW VALUE (FLAG = 2) * * * PAGE# NOP OFSET NOP ARRAY NOP FLAG NOP NVAL NOP * MAPXX NOP JSB $LIBR NOP JSB .ENTP DEF PAGE# * LDA MPBUF GET THE ADDRESS OF THE MAP BUFFER ADA SIGN SET THE SIGN BIT SO IT IS A READ USA GET THE USER MAP * LDA MAP31 GET THE OLD VALUE STA OLD31 AND SAVE IT LDA MAP32 OLD VALUE. STA OLD32 SAVE THIS TOO LDB PAGE#,I GET THE DESIRED PAGE STB MAP31 PUT IT INTO THE OLD PAGE INB BUMP PAGE # TO ACCOUNT FOR OVERFLOW STB MAP32 SET NEXT PAGE INTO THE LAST LOCATION * LDA MPBUF GET THE USER MAP BUFFER ADDRESS USA !!!!!! LOAD THE USER MAP !!!!!! * LDA FLAG,I GET THE READ WRITE FLAG CPA D2 ARE WE READING OR WRITING ? JMP WRTPG WRITING ! * * * * LDA DM64 GET LOOP INDEX STA XTEMP LDA START GET THE START ADDRESS AD!A OFSET,I ADD IN THE OFFSET STA YTEMP SAVE POINTER LDA ARRAY GET ARRAY ADDRESS MLOOP LDB YTEMP,I GET THE WORD STB A,I AND PUT INTO BUFFER ISZ YTEMP BUMP OUR INA POINTERS ISZ XTEMP DONE ? JMP MLOOP NO * * RTMAP LDA OLD31 YES RESTORE THE USER MAP STA MAP31 LDA OLD32 STA MAP32 * LDA MPBUF GET THE ADDRESS USA !!!!!!!!!!RESTORE THE USER MAP!!!!!!!!!!!!!!!! JSB $LIBX RESTORE INTERUPTS DEF *+1 DEF *+1 * LDA FLAG,I GET THE FLAG CPA D1 DO WE UPDATE THE PAGE # & OFFSET RSS YES JMP MAPXX,I NO, SO RETURN TO THE CALLER * LDA OFSET,I GET THE OFFSET ADA D64 ADD 64 WORDS FOR WHAT WE JUST DID CLB DIV D1024 DIVIDE NEW OFFSET BY # OF WORDS IN PAGE ADA PAGE#,I ADD OLD PAGE # TO GIVE NEW PAGE # STA PAGE#,I AND SEND THE RESULT BACK STB OFSET,I SEND THE NEW OFFSET BACK TOO * JMP MAPXX,I RETURN TO CALLER * * WRTPG LDA START GET THE START ADDRESS ADA OFSET,I ADD THE OFFSET INTO THE PAGE LDB NVAL,I GET THE NEW VALUE STB A,I AND SET IT UP. JMP RTMAP RESET THE MAP & RETURN * * * D1 DEC 1 D2 DEC 2 START OCT 74000 START ADDRESS OF NEWLY MAPPED AREA MPBUF DEF MAPIT MAPIT BSS 30 BUFFER FOR 1ST 30 WORDS OF USER MAP MAP31 NOP THIS LOCATION IS USED TO CHANGE MAP MAP32 NOP THIS LOCATION IS FOR I/O OVERFLOW OLD31 NOP OLD32 NOP * * * THIS ROUTINE RETURNS THE VALUE OF $OPSY * IF $OPSY = -9, THEN WE HAVE AN RTE-IV SYSTEM * * IRTE4 NOP LDB IRTE4,I GET RETURN ADDRESS LDA $OPSY GET VALUE OF $OPSY JMP B,I THAT'S ALL * * END ASMB,Q,C NAM INVRS,7 * * THIS ROUTINE INVERSE ASSEMBLES HP 21MX * INSTRUCTIONS * * THE CALLING SEQUENCE IS AS FOLLOWS * * JSB INVRS * DEF RTRN * DEF ADDRSS LOGICAL ADDRESS OF INSTRUCTION * DEF VALUE INSTRUCTION AT ADDRSS * DEF IBUF OUTPUT BUFFER * DEF ISIZE SIZE OF OUTPUT BUFFER * DEF IWRDS RETURNED NO OF WORDS FILLED * RTRN ... * * FORTRAN CALL: * * CALL INVRS(IADRS,VALUE,IBUF,ISIZE,IWRDS) * * ENT INVRS EXT .ENTR * * A EQU 0 B EQU 1 * * ADDRS BSS 1 VALUE BSS 1 BUFAD BSS 1 BSIZE BSS 1 WCNT BSS 1 INVRS NOP JSB .ENTR DEF ADDRS LDA BUFAD RAL MAKE BYTE ADDRESS STA BUFAD STA BPNTR LDB BSIZE,I GET BUFFER SIZE RBL MAKE INTO BYTES ADA B COMPUTE END OF BUFFER STA BFEND LDA ADDRS,I STA IADR SAVE ADDRESS OF INSTRUCTION LDA B2 SET NO OF WORDS/ENTRY STA INCR IN INCREMENT JSB LOAD FETCH INSTRUCTION STA INSTR STA TEMP AND B70K IS IT A MEMORY REFERENCE SZA JMP MRGI YES GO GET IT LDA INSTR NO ELA,ALF PUT SIGN IN E REG RAL AND BITS 10&11 IN BITS 0&1 SEZ IF E SET(I.E. SIGN) MUST BE I/O OR EIG JMP IOGI * AND B3 SET UP OP CODE TABLE COUNTER LDB M18 SHIFT ROTATE SLA LDB M12 ALTER SKIP STB CNTR ADA GRTBL GET ADDRESS OF GROUP TABLE LDB A,I * LOOP1 LDA TEMP FETCH REMAINING BITS OF INSTRUCTION AND B,I ARE ALL REQUIRED BITS SET XOR B,I SZA,RSS JMP FOND1 YES GO GET MNEMONIC LOP1A ADB INCR BUMP ADDRESS ISZ CNTR JMP LOOP1 * NFND LDA BUFAD IF WE FALL THROUGH NOT COMPLETELY STA BPNTR DEFINED SO JUST PRINT OCTAL LDA INSTR JSB PN JMP EXIT * IADR BSS 1 INCR BSS 1 INSTR BSS 1 TEMP BSS 1 CNTR BSS 1 BPNTR BSS 1 * B2  OCT 2 B3 OCT 3 B70K OCT 70000 M12 DEC -12 M18 DEC -18 BFEND BSS 1 * GRTBL DEF *+1 DEF SRGA DEF ASGA DEF SRGB DEF ASGB * MRGA1 DEF MRG-4 * FOND1 JSB POPCD PRINT MNEMONIC LDA B,I REMOVE OPCODE FROM AND B1777 INSTRUCTION XOR TEMP STA TEMP AND B1777 ARE ANY BITS LEFT SZA,RSS JMP EXIT NO,THEN RETURN LDA COMMA JSB TYO PRINT COMMA JMP LOP1A GO LOOK FOR REST * B1777 OCT 001777 COMMA OCT 54 * MRGI LDA INSTR ALF,RAL AND B17 RAL TIMES 2 ADA MRGA1 COMPUTE TABLE POSITION LDB A JSB POPCD PRINT MNEMONIC LDA INSTR COMPUTE ADDRESS AND B2000 MERGE WITH PROPER PAGE SZA LDA IADR XOR INSTR AND B76K XOR INSTR JSB PADR PRINT ADDRESS JMP EXIT * B17 OCT 17 B2000 OCT 2000 B76K OCT 76000 * IOGI LDB IOGTB FETCH TABLE OF LOOP FOR I/O SLA,RSS IF EIG INSTEAD LDB DSGTB THEN GET TABLE FOR EIG'S STB PNTR PARMETERS LDB PNTR,I SET B TO START ISZ PNTR LOOP2 LDA PNTR,I GET COUNT FOR THIS TYPE SSA JMP LOP2A IF NEGATIVE CONTINUE * SZA,RSS IF ZERO THEN DONE JMP NFND LDA B3 STA INCR ELSE SET INCREMENT TO 3 LDA PNTR,I AND MAKE COUNT NEGATIVE CMA,INA * LOP2A STA CNTR ISZ PNTR LOOP3 LDA INSTR FETCH INSTRUCTION XOR B,I SEARCH FOR MATCH AND PNTR,I MASK UNWANTED BITS SZA,RSS JMP FOND2 ADB INCR BUMP ADDRESS IN OPCTBL ISZ CNTR DONE WITH THIS TYPE JMP LOOP3 NO CONTINUE ISZ PNTR JMP LOOP2 YES GO TO NEXT TYPE * * PNTR BSS 1 * FOND2 JSB POPCD GO PRINT MNEMONIC LDA PNTR,I FETCH MASK CMA IF EXACT NO OPERAND IN SAME WORD AND B77 21SZA,RSS JMP OPRND * AND INSTR STRIP OFF OPERAND STA TEMP SAVE FOR COMMA C TEST LDB PNTR,I IS MASK FOR CPB DSMSK A DOUBLE SHIFT GROUP SZA AND OPERAND EQUAL 0 RSS LDA B20 YES MAKE OPERAND IT 16 AND B77 AND MASK C BIT JSB PNUMB GO PRINT NUMBER LDA TEMP AND B1000 IS A COMMA C REQUIRED SZA,RSS NO RETURN JMP EXIT LDA COMMA JSB TYO PRINT COMMA LDA "C JSB TYO PRINT "C" JMP EXIT * * * PRINTS MULTI WORD OPERANDS * OPRND LDA TFLAG TRACING SZA,RSS JMP EXIT NO THEN RETURN * * MUTIWORD PRINT HERE * JMP EXIT * * TFLAG OCT 0 * B20 OCT 20 B77 OCT 77 B1000 OCT 1000 "C OCT 103 * * * PRINT ONE CHARACTER * TYO NOP STB TEMP2 SAVE B REG LDB BPNTR CPB BFEND JMP EXIT IF FULL THEN COMPLETE SBT ELSE STORE BYTE STB BPNTR UPDATE POINTER LDB TEMP2 RESTORE B REG JMP TYO,I * IOGTB DEF *+1 DEF OVFG DEC -4 OVERFLOW GROUP OCT 177777 DEC -1 CLF OCT 177700 DEC -12 I/O GROUP OCT 176700 OCT 0 INDICATES END OF IO TABLE DSGTB DEF *+1 DEF DSG DEC -6 DOUBLE SHIFT GROUP DSMSK OCT 5760 DEC -90 REST OF BASE SET OCT 5777 * MICROCODED INSTRUCTIONS DEC 27 POSITIVE COUNT MEANS CHANGE INCREMENT OCT 5777 OCT 0 THIS INDICATES END * LOAD NOP LDA VALUE,I JMP LOAD,I * TEMP2 BSS 1 * * PRINT MNEMONIC POPCD NOP STB TEMP3 INB LDA B,I FETCH FIRST 3 CHARS JSB DSQZ GO PRINT THEM LDA INCR CPA B2 DOES MNEMONIC HAVE MORE THAN 3 CHARS JMP POP1 NO,GO TO RETURN LDB TEMP3 ADB B2 YES FETCH NEXT 3 CHARS LDA B,I JSB DSQZ GO TO PRINT THEM POP1 LDB TEMP3 RESTORE B REG JMP POPCD,I RETURN * * DSQZ NOP CLB A=SQOZE CODE DIV D1600 JSB CONV A=FIRST CHAR,B=2ND,3RD LDA B CLB DIV D40 SPLIT SECOND 2 CHARS JSB CONV LDA B JSB CONV JMP DSQZ,I * * A REG = ONE SQOZE CHARACTER * CONV NOP SZA,RSS IF ZERO THEN TERMINATE DSQZ JMP DSQZ,I * CPA B45 IS IT A "." CCA YES SET TO CONVERT TO 56B ADA M13B IS IT A LETTER SSA,RSS ADA B7 YES ADD 101B ADA B72 NO ADD 57B JSB TYO GO PRINT IT JMP CONV,I RETURN * B7 OCT 7 B45 OCT 45 B72 OCT 72 M13B OCT -13 D40 DEC 40 D1600 DEC 1600 * TEMP3 BSS 1 * * * A =ADDRESS TO BE PRINTED * * PADR NOP PRINT ADDRESS STA SIGN SAVE INDIRECT BIT ELA,CLE,ERA REMOVE SIGN BIT * ************INSERT SYMBOL SEARCH HERE * JSB PNUMB GO PRINT NUMBER LDA SIGN SSA,RSS IS ",I" REQUIRED JMP PADR,I NO THEN RETURN * LDA COMMA YES THEN PRINT ",I" JSB TYO LDA "I JSB TYO JMP PADR,I AND RETURN * "I OCT 111 RADIX DEC 8 * SIGN BSS 1 * * A =NUMBER TO BE PRINTED * PNUMB NOP STA TEMP3 LDA BLANK JSB TYO PRINT BLANK LDA TEMP3 JSB PN PRINT NUMBER JMP PNUMB,I * PN NOP LDB TBADD SET TEMP BUFFER STB TBPTR PN1 CLB CLEAR B FOR DIV DIV RADIX ADB M12B CONVERT TO ASCII SSB,RSS ADB B7 ADB B72 JSB SRBT PUT IN TEMP BUFFER SZA IF QUOTIENT NON ZERO CONTINUE JMP PN1 * LDB TBADD ELSE MOVE TO OUTPUT BUFFER CMB,INB SET UP CHAR COUNT ADB TBPTR STB TEMPۚ3 * PN2 ISZ TBPTR BUMP POINTER LDA TBPTR,I FETCH CHARACTER JSB TYO PRINT CHARACTER ISZ TEMP3 JMP PN2 CONTINUE UNTIL ALL ARE MOVED JMP PN,I AND THEN RETURN * * SRBT NOP SAVE CHARACTERS IN REVERSE ORDER STB TBPTR,I CCB ADB TBPTR DECREMENT POINTER STB TBPTR JMP SRBT,I AND RETURN * BLANK OCT 40 M12B OCT -12 * TBPTR BSS 1 BSS 16 TBADD DEF *-1 * EXIT LDA BLANK FILL WITH BLANK CHAR JSB TYO LDA BUFAD COMPUTE WORD COUNT CMA,INA ADA BPNTR ARS STA WCNT,I JMP INVRS,I AND RETURN * * MRG EQU * MEMORY REFERENCE GROUP AND 0 OCT 044216 JSB 0 OCT 100624 XOR 0 OCT 154204 JMP 0 OCT 100262 IOR 0 OCT 075304 ISZ 0 OCT 075554 ADA 0 OCT 043373 ADB 0 OCT 043374 CPA 0 OCT 052533 CPB 0 OCT 052534 LDA 0 OCT 105673 LDB 0 OCT 105674 STA 0 OCT 134773 STB 0 OCT 134774 SRGA EQU * SHIFT ROTATE GROUP ALF OCT 044100 ELA OCT 060473 ERA OCT 061053 ALR OCT 044114 RAR OCT 130324 RAL OCT 130316 ARS OCT 044475 ALS OCT 044115 OCT 40 CLE OCT 052277 SLA OCT 134273 OCT 27 ALF OCT 044100 OCT 26 ELA OCT 060473 OCT 25 ERA OCT 061053 OCT 24 ALR OCT 044114 OCT 23 RAR OCT 130324 OCT 22 RAL OCT 130316 OCT 21 ARS OCT 044475 OCT 20 ALS OCT 044115 SRGB EQU * BLF OCT 047200 ELB OCT 060474 RBR OCT 130374 RBL OCT 130366 BRS 6^ OCT 047575 BLS OCT 047215 OCT 4040 CLE OCT 052277 SLB OCT 134274 OCT 4027 BLF OCT 047200 OCT 4026 ELB OCT 060474 OCT 4025 ERB OCT 061054 OCT 4024 BLR OCT 047214 OCT 4023 RBR OCT 130374 OCT 4022 RBL OCT 130366 OCT 4021 BRS OCT 047575 OCT 4020 BLS OCT 047215 ASGA EQU * ALTER SKIP GROUP CCA OCT 051523 CLA OCT 052273 CMA OCT 052343 SEZ OCT 133674 CCE OCT 051527 OCT 2100 CLE OCT 052277 CME OCT 052347 SSA OCT 134723 SLA OCT 134273 INA OCT 075213 SZA OCT 135353 RSS OCT 131645 ASGB EQU * CCB OCT 051524 CLB OCT 052274 CMB OCT 052344 OCT 6040 SEZ OCT 133674 OCT 6300 CCE OCT 051527 OCT 6100 CLE OCT 052277 OCT 6200 CME OCT 052347 SSB OCT 134724 SLB OCT 134274 INB OCT 075214 SZB OCT 135354 OCT 6001 RSS OCT 131645 OVFG EQU * OVERFLOW GROUP CLO OCT 052311 STO OCT 135011 SOS OCT 134505 SOC OCT 134465 CLF EQU * CLEAR FLAG CLF 0 OCT 052300 IOG EQU * I/O GROUP CLC 0 OCT 052275 STC 0 OCT 134775 OTB 0 OCT 120374 OTA 0 OCT 120373 LIB 0 OCT 106204 LIA 0 OCT 106203 MIB 0 OCT 111304 MIA 0 OCT 111303 SFS 0 OCT 133735 SFC 0 OCT 133715 STF 0 OCT 135000 HLT 0 OCT 072016 DSG EQU * DOUBLE SHIFT GROUP OCT 003100 RRR 1 WORD  OCT 131574 OCT 003040 LSR 1 WORD OCT 107044 OCT 003020 ASR 1 WORD OCT 044544 OCT 002100 RRL 1 WORD OCT 131566 OCT 002040 LSL 1 WORD OCT 107036 OCT 002020 ASL 1 WORD OCT 044536 EIG1 EQU * 1 WORD EXTENDED AND DMS GROUP OCT 003741 CAX 1 WORD OCT 051432 OCT 003751 CAY 1 WORD OCT 051433 OCT 007741 CBX 1 WORD OCT 051502 OCT 007751 CBY 1 WORD OCT 051503 OCT 003744 CXA 1 WORD OCT 053233 OCT 007744 CXB 1 WORD OCT 053234 OCT 003754 CYA 1 WORD OCT 053303 OCT 007754 CYB 1 WORD OCT 053304 OCT 007761 DSX 1 WORD OCT 056052 OCT 007771 DSY 1 WORD OCT 056053 OCT 007760 ISX 1 WORD OCT 075552 OCT 007770 ISY 1 WORD OCT 075553 OCT 003747 XAX 1 WORD OCT 153132 OCT 003757 XAY 1 WORD OCT 153133 OCT 007747 XBX 1 WORD OCT 153202 OCT 007757 XBY 1 WORD OCT 153203 OCT 007763 LBT 1 WORD OCT 105576 OCT 007764 SBT 1 WORD OCT 133476 OCT 007767 SFB 1 WORD OCT 133714 OCT 007100 FIX 1 WORD OCT 063432 OCT 007120 FLT 1 WORD OCT 063616 OCT 003727 LFA 1 WORD OCT 106013 OCT 007727 LFB 1 WORD OCT 106014 OCT 007703 MBF 1 WORD OCT 110660 OCT 007702 MBI 1 WORD OCT 110663 OCT 007704 MBW 1 WORD OCT 110701 OCT 007706 MWF 1 WORD OCT 112370 OCT 007705 MWI 1 WORD OCT 112373 OCT 007707 MWW 1 WORD OCT 112411 OCT 003712 PAA 1 WORD OCT 122103 OCT 007712 PAB 1 WORD OCT 122104 OCT 003713 PBA 1 WORD OCT 122153 OCT 007713 PBB 1 WORD OCT 122154 OCT 003730 RSA 1 WORD OCT 131623 OCT 007730 RSB 1 WORD OCT 131624 OCT 003731 RVA 1 WORD OCT 132013 OCT 007731 RVB 1 WORD OCT 132014 OCT 003710 SYA 1 WORD OCT 135303 OCT 007710 SYB 1 WORD OCT 135304 OCT 003711 USA 1 WORD OCT 143123 OCT 007711 USB 1 WORD OCT 143124 OCT 003722 XMA 1 WORD OCT 154043 OCT 007722 XMB 1 WORD OCT 154044 OCT 007720 XMM 1 WORD OCT 154057 OCT 007721 XMS 1 WORD OCT 154065 EIG2 EQU * 2 WORD EXTENDED AND DMS GROUP OCT 010400 DIV 2 WORDS OCT 055230 OCT 014200 DLD 2 WORDS OCT 055376 OCT 014400 DST 2 WORDS OCT 056046 OCT 010200 MPY 2 WORDS OCT 111763 OCT 015000 FAD 2 WORDS OCT 062706 OCT 015060 FDV 2 WORDS OCT 063120 OCT 015040 FMP 2 WORDS OCT 063662 OCT 015020 FSB 2 WORDS OCT 064224 OCT 015746 ADX 2 WORDS OCT 043422 OCT 015756 ADY 2 WORDS OCT 043423 OCT 011742 LAX 2 WORDS OCT 105532 OCT 011752 LAY 2 WORDS OCT 105533 OCT 015742 LBX 2 WORDS OCT 105602 OCT 015752 LBY 2 WORDS OCT 105603 OCT 015745 LDX 2 WORDS OCT 105722 OCT 015755 LDY 2 WORDS OCT 105723 OCT 011740 SAX 2 WORDS OCT 133432 OCT 011750 SAY 2 WORDS OCT 133433 OCT 015740 SBX 2 WORDS OCT 133502 OCT 015750 SBY 2 WORDS OCT 133503 OCT 015743 STX 2 WORDS OCT 135022 OCT 015753 STY 2 WORDS OCT 135023 OCT 015714 SSM 2 WORDS OCT 134737 OCT 011726 XC"A 2 WORDS OCT 153223 OCT 015726 XCB 2 WORDS OCT 153224 OCT 011724 XLA 2 WORDS OCT 153773 OCT 015724 XLB 2 WORDS OCT 153774 OCT 011725 XSA 2 WORDS OCT 154423 OCT 015725 XSB 2 WORDS OCT 154424 EIG2J EQU * 2 WORD JUMPS OCT 015762 JLY 2 WORDS OCT 100223 OCT 015772 JPY 2 WORDS OCT 100463 OCT 015732 DJP 2 WORDS OCT 055272 OCT 015733 DJS 2 WORDS OCT 055275 OCT 015734 SJP 2 WORDS OCT 134172 OCT 015735 SJS 2 WORDS OCT 134175 OCT 015736 UJP 2 WORDS OCT 142372 OCT 015737 UJS 2 WORDS OCT 142375 EIG3 EQU * 3 WORD JRS OCT 017715 JRS 3 WORDS OCT 100575 OCT 017766 CBT 3 WORDS OCT 051476 OCT 017765 MBT 3 WORDS OCT 110676 OCT 017776 CMW 3 WORDS OCT 052371 OCT 017777 MVW 3 WORDS OCT 112341 OCT 017774 CBS 3 WORDS OCT 051475 OCT 017773 SBS 3 WORDS OCT 133475 OCT 017775 TBS 3 WORDS OCT 136575 MIC EQU * MICRO CODED MACROS OCT 005201 DBLE 0 FORTRAN CALLABLE OCT 054566 OCT 056700 OCT 005202 SNGL 0 FORTRAN CALLABLE OCT 134421 OCT 104600 OCT 025203 .XMPY 4 WORD(S) OCT 166247 OCT 123770 OCT 025204 .XDIV 4 WORD(S) OCT 166236 OCT 075700 OCT 017205 .DFER 3 WORD(S) OCT 164600 OCT 061040 OCT 025213 .XADD 4 WORD(S) OCT 166233 OCT 054660 OCT 025214 .XSUB 4 WORD(S) OCT 166255 OCT 141640 OCT 177221 .GOTO 31 SPECIAL PROCESSING OCT 165001 OCT 137550 OCT 175222 ..MAP 30 SPECIAL PROCESSING OCT 166437 OCT 044320 OCT 167223 .ENTR 29 SPECIAL PROCESSING OCT 164660 OCT 137740 OCT 167224 .ENTP 29 SPECIAL PROCESSING OCT 164660 OCT 137620 OCT 015225 .PWR2 2 WORD(S) OCT 165561 OCT 127570 OCT 007226 .FLUN 1 WORD(S) OCT 164726 OCT 142600 OCT 015227 .SETP 2 WORD(S) OCT 165727 OCT 137620 OCT 015230 .PACK 2 WORD(S) OCT 165533 OCT 052210 OCT 007220 .XFER 1 WORD(S) OCT 166240 OCT 061040 OCT 015206 .XPAK 2 WORD(S) OCT 166252 OCT 044010 OCT 005207 XADD 0 FORTRAN CALLABLE OCT 153106 OCT 053600 OCT 005210 XSUB 0 FORTRAN CALLABLE OCT 154447 OCT 045400 OCT 005211 XMPY 0 FORTRAN CALLABLE OCT 154062 OCT 155300 OCT 005212 XDIV 0 FORTRAN CALLABLE OCT 153303 OCT 144000 OCT 015215 .XCOM 2 WORD(S) OCT 166235 OCT 117730 OCT 015216 ..DCM 2 WORD(S) OCT 166426 OCT 052330 OCT 005217 DDINT 0 FORTRAN CALLABLE OCT 054703 OCT 115260 OCT 005257 .EMAP 0 FORTRAN CALLABLE OCT 164657 OCT 044320 OCT 005240 .EMIO 0 FORTRAN CALLABLE OCT 164657 OCT 075250 OCT 005241 MMAP 0 FORTRAN CALLABLE OCT 111543 OCT 121200 END END MCEND EQU * END END ASMB,R,L NAM ISSCT,7 ENT ISSCT EXT $SSCT * * * THIS ROUTINE IS SO THAT THE FORTRAN SUBROUTINE * DTRK CAN ACCESS THE SYSTEM ENTRY POINT $SSCT * * ISSCT NOP LDB ISSCT,I LDA $SSCT FUNCTION CALL RETURNS VALUE IN A REG JMP B,I A EQU 0 B EQU 1 END E Z. 24999-18213 1902 S 0100 &NDTDU              H0101 LASMB,L,R,C NAM NDTDU,19,89 DUMP NDT FILE 771104 24999-16213 REV 1902 SPC 1 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** SPC 1 ******************************* * * * NAME: NDTDU * * * * SOURCE: 24999-18213 * * * * RELOCATABLE:24999-16213 * * * * PROGRAMMER: DT * * * * DATE: OCTOBER 1977 * * * ******************************* SPC 3 * THIS PROGRAM FORMATS AND PRINTS THE INFORMATION STORED IN A DS/1000 * NDT (NETWORK DESCRIPTION TABLE) FILE CREATED BY NDTGN. SCHEDULE FROM * RTE WITH: * *RU,NDTDU,,, * * THE SCHEDULING PARAMETERS HAVE THE FOLLOWING MEANINGS: * * * THE FIRST PARAMETER IS EITHER THE NAMR FOR THE NDT FILE (IN THE * FORMAT NAME:SECURITY:CARTRIDGE) OR THE LU OF AN INTERACTIVE DEVICE * WHERE THE NAMR CAN BE READ. DEFAULT IS 1 OR THE MTM LU NUMBER. * * * THE LU OF AN OUTPUT DEVICE WHERE INFORMATION CAN BE PRINTED. DEFAULT * IS SAME AS . * * * THE NUMBER OF COLUMNS ON THE PRINT PAGE. DEFAULT IS 80. MINIMUM IS * 50. MAXIMUM IS 128. * * IF THE COMMAND *BR,NDTDU IS ENTERED, NDTDU STOPS PRINTING, CLOSES * THE NDT FILE, AND TERMINATES. SPC 3 EXT RMPAR,GETST,OPEN,CLOSE,READF,POSNT,EXEC EXT CNUMD,IFBRK,IFTTY,$CVT1,$PARS,$LIBR,$LIBX EXT #FWAM,#NODE SPC 1 A EQU 0  B EQU 1 SKP *** START OF PROGRAM *** SPC 1 NDTDU JSB RMPAR GET SCHEDULING PARAMETERS. DEF *+2 DEF INLU SPC 1 ** PROCESS FIRST PARAMETER: NAMR OR INPUT LU LDA INLU SSA JMP TRMN8 INPUT LU IS NEGATIVE--TERMINATE. SZA JMP LU? LDB B401 INPUT LU NOT SPECIFIED--USE 1. JMP STIN LU? AND B777C SAVE BITS 15-6. SZA,RSS IF 1ST PARAM ISN'T LU, JMP TTY? LDA B401 SET INPUT LU STA INLU TO SYS CONSOLE. JSB GETST GET NAMR DEF *+4 FROM @STRG DEF STRNG COMMAND DEF D12 STRING. DEF LOG JMP FILE GO PARSE NAMR. TTY? JSB IFTTY CHECK FOR DEF *+2 INTERACTIVE DEF INLU INPUT LU. SSA,RSS JMP TRMN8 NON-INTERACTIVE--TERMINATE. LDA INLU SET INTERACTIVE IOR B400 BIT IN STIN STA INLU INPUT LU. JSB EXEC PRINT DEF *+5 "WHAT IS NDT FILE NAMR?" DEF D2 DEF INLU DEF NAMR? DEF D12 JSB EXEC READ REPLY. DEF *+5 DEF D1 DEF INLU DEF STRNG DEF D12 STB LOG * NOW READY TO PARSE FILE NAMR. FILE LDA @STRG MOVE STRING SO LDB @STG2 IT CAN BE MODIFIED MVW D12 BEFORE PARSE. LDB COMMA INSURE LDA @STG2 COMMA AT ADA LOG END OF STB A,I NAMR. * SET COLONS TO COMMAS FOR PARSE. LDA SWRD A := ",:". LDB SBYTA B := BYTE ADDRESS OF STRING. LOOP1 SFB SCAN FOR COLON. JMP *+2 COLON FOUND. JMP DONE COMMA FOUND (MUST BE END). ALF,ALF REPLACE SBT COLON WITH ALF,ALF COMMA. JMP LOOP1 SCAN AGAIN. DONE CMB,INB STOP SCANNING AT COMMA. ADB SBYTA CMB,INB B := NO. OF CHARACTERS. STB LOG k* CALL THE RTE PARSER. LDA @STG2 A := WORD ADDRESS OF STRING. JSB $LIBR NOP JSB $PARS DEF PBUF JSB $LIBX DEF *+1 DEF *+1 SPC 1 ** PROCESS SECOND PARAMETER: OUTPUT LU LDA OUTLU SZA,RSS LDA INLU ZERO--USE DEFAULT. IOR B200 SET BIT TO PRINT COL 1. STA OUTLU STORE OUTPUT LU. AND B77 SET UP IOR B1100 CONTROL WORD STA CONWD FOR PAGE EJECT. SPC 1 ** OPEN THE FILE JSB OPEN DEF *+7 DEF DCB DEF ERROR DEF NAME DEF D0 DEF SECU DEF ICR JSB ERCHK CHECK FOR FMP ERROR. CPA D9 TYPE = 9? JMP *+2 JMP BADRC NO--SOMETHING'S WRONG! SPC 1 ** PROCESS THIRD PARAMETER: WIDTH. LDA WIDTH IF WIDTH SZA IS NOT JMP NOT0 PROVIDED, LDA D12 NDFIT := 12 JMP STFIT NOT0 ADA N50 IF WIDTH SSA,RSS IS < 50, JMP NOTSM LDA D7 NDFIT := 7 JMP STFIT NOTSM LDA WIDTH IF WIDTH ADA N129 IS > 129, SSA JMP NOTBG LDA D20 NDFIT := 20 JMP STFIT * CALCULATE NUMBER OF NODES THAT WILL FIT IN THE GIVEN WIDTH NOTBG CLB LDA WIDTH NDFIT := ARS WIDTH/2 ADA N4 -4 DIV D3 /3. STFIT CMA,INA (NEGATE NDFIT FOR STA NDFIT USE AS COUNTER.) SPC 1 ** GRAB END OF PARTITION FOR BUFFER AREA. 1/3 GOES FOR FIRST RECORD, * 2/3 GOES FOR REST OF RECORDS. LDA XEQT LOOK IN ID ADA D23 SEGMENT FOR LDA A,I HI MAIN ADDRESS + 1. STA @RCR1 STORE AS FIRST RECORD ADDR. INA STA @NODE 2ND WORD IS ADDRESS OF NODES. CMA,INA SUBTRACT FROM ADA BGLWA LAST WORD AVAILABLE FOR CLB TOTAL SIZE OF BLOCK. DIV D3 STA MAXND SAVE MAX # OF NODES. SZA,RSS IF ZERO, JMP TOMNY NO ROOM IN PARTITION. INA STA LNRC1 MAX SIZE FOR RECORD 1. ADA MAXND ADA MAXND STA MAXRC MAX SIZE FOR REST OF RECORDS. LDA @RCR1 CALCULATE ADDRESS ADA LNRC1 OF READ BUFFER AS STA @RCRD 1ST ADDR PLUS 1ST LENGTH. SPC 1 ** PRINT HEADING INFORMATION LDA LOG A := ARS NO. OF WORDS IN NAMR. ADA D18 ADD SIZE OF HEADER. STA LOG JSB PRINT PRINT DEF HED1 FIRST DEF LOG HEADING. LDA #FWAM IF NODE SZA,RSS IS INITIALIZED, JMP NOTIN JSB CNUMD CONVERT LOCAL DEF *+3 NODE NUMBER DEF #NODE TO ASCII DEF ATNOD+4 (DECIMAL) JSB PRINT AND DEF ATNOD PRINT DEF D7 IT. JMP READ1 ELSE NOTIN JSB BLINE PRINT BLANK LINE. READ1 JSB READF READ NUMBER DEF *+5 OF NODES AND DEF DCB FILL NODE ARRAY DEF ERROR FROM FIRST RECORD. @RCR1 BSS 1 DEF LNRC1 JSB ERCHK CHECK FOR FMP ERROR. LDA @RCR1,I STA NNODE SAVE NUMBER OF NODES. STA NDLFT NDLFT := NNODE. CMA,INA STA COUNT JSB CNUMD CONVERT DEF *+3 NUMBER OF DEF COUNT NODES TO DEF HED2 ASCII (DECIMAL). JSB PRINT PRINT DEF HED2 SECOND DEF D13 HEADING. JSB BLINE PRINT BLANK LINE. SPC 1 * CHECK FOR TOO MANY NODES LDA NNODE IF NUMBER OF NODES SSA,RSS ISN'T NEGATIVE OR IS JMP TOMNY GREATER THAN THE ADA MAXND MAXIMUM NUMBER OF CMA,SSA,RSS NODES THAT WILL FIT, JMP TOMNY GO PRINT ERROR MESSAGE. g SPC 1 ** INITIALIZE NO. OF NODES TO SKIP := 0 FOR FIRST TIME. CLA SKNOD := 0. STA SKNOD SKP *** BEGINNING OF BIG LOOP *** SPC 1 ** HOW MANY NODES DO WE PRINT PER LINE? BLOOP LDA NDFIT NDFIT := LDB NDFIT WHICHEVER IS CMB,INB LESS IN ADB NDLFT MAGNITUDE OF SSB,RSS NDFIT AND LDA NDLFT NDLFT. STA NDFIT SPC 1 ** FIND # OF WORDS FOR OUTPUT CMA,INA CALCULATE INA 3 WORDS PER MPY D3 NODE PLUS INA FRONT OF STA OUTLN LINE. SPC 1 ** CONVERT "TO" NODE NUMBERS INTO LINE JSB CLEAR CLEAR OUTPUT BUFFER. LDA @NODE SET "TO" NODE POINTER ADA SKNOD TO FIRST NODE. STA TNODE (SKIP OVER ALREADY PRINTED NODES.) LDA NDFIT COUNT := -(NUMBER OF NODES TO PRINT). STA COUNT LDA @LIN4 INITIALIZE STA PNTR2 COLUMN POINTER. CNVRT JSB CNUMD CONVERT NODE DEF *+3 NUMBER INTO TNODE BSS 1 PROPER LINE PNTR2 BSS 1 COLUMNS. ISZ TNODE BUMP LDA PNTR2 THE ADA D3 TWO STA PNTR2 POINTERS. * ISZ COUNT BUMP NODE COUNT. JMP CNVRT NOT DONE--CONVERT NEXT NO. * JSB PRINT PRINT DEF LINE LINE. DEF OUTLN SKP ** PRINT NRV FOR EACH NODE LDA NNODE CONT2:=-(NUMBER OF NODES) STA CONT2 [USED FOR "FROM" NODE]. LDA @NODE STA FNODE JSB PRINT PRINT DEF RULE HORIZONTAL DEF OUTLN LINE. INIT1 JSB CLEAR CLEAR LINES. JSB READF READ DEF *+5 NDT DEF DCB RECORD. DEF ERROR @RCRD BSS 1 DEF MAXRC JSB ERCHK CHECK FOR RFA ERROR. LDA @RCRD,I IF FIRST SSA,RSS WORD >= 0, JMP BADRC SOMETHING'S WRONG. JSB CNUMD CONVERT DEF *+3 "FROM" FNODE NOP NODE DEF LINE+1 NUMBER. LDA @RCRD INITIALIZE INA RECORD POINTER TO STA RCDPT FIRST NODE INFORMATION. LDA NDFIT COUNT:=-(NUMBER OF NODES TO PRINT) STA COUNT [USED FOR "TO" NODE]. LDA @NODE INITIALIZE ADDRESS STA TNODE OF "TO" NODE. LDA @LIN4 INITIALIZE ADA D2 LINE STA PNTR2 POINTERS. ADA D62 STA L1PNT * * SKIP OVER PREVIOUSLY-PRINTED NODES IN THE RECORD. LDB SKNOD B := CMB -(NO. OF NODES TO SKIP) - 1 CHECK INB,SZB,RSS IF DONE, JMP CNVTO GO START CONVERTING. LDA RCDPT,I CPA TNODE,I IF RECORD NODE = "TO" NODE, JMP *+2 JMP *+3 ISZ RCDPT POINT TO ISZ RCDPT NEXT NODE NUMBER. ISZ TNODE BUMP TNODE ADDRESS. JMP CHECK CHECK FOR END. * * CONVERT "TO" NODE NUMBERS. CNVTO LDA RCDPT,I GET NEXT NODE'S NUMBER. CPA TNODE,I IF <> "TO" NODE, JMP *+2 JMP BUMP1 JUST BUMP OUTPUT POINTERS. JSB IFBRK IF BREAK FLAG IS SET, DEF *+1 SSA JMP FINIS TERMINATE. * INSERT LU INTO LINE ISZ RCDPT GET NODE'S LDA RCDPT,I TIMEOUT/LU INFO. SSA IF NEGATIVE, JMP BADRC SOMETHING'S WRONG. AND B77 ISOLATE LU. JSB $LIBR NOP CCE JSB $CVT1 CONVERT. JSB $LIBX DEF *+1 DEF *+1 STA PNTR2,I STORE IN LINE. * INSERT TIMEOUT IN LINE 1 LDA RCDPT,I AND B377C ISOLATE BITS 13-7. ALF,ALF POSITION TIMEOUT RAL,RAL TO LOWER BYTE. SZA IF NOT ZERO, IOR N256 FILL IN UPPER BYTE. CMA,INA MAKE POSITIVE. MPY D5 MULTIPLY BY 5. STA TEMP1 JSB CNUMD CONVERT DEMeF *+3 TO ASCII DEF TEMP1 (DECIMAL). DEF L1PNT,I ISZ RCDPT POINT TO NEXT NODE IN RECORD. * INCREMENT OUTPUT POINTERS BUMP1 LDA PNTR2 PNTR2 := ADA D3 PNTR2 + 3. STA PNTR2 ADA D62 L1PNT := STA L1PNT PNTR2 + 62. * ISZ TNODE BUMP "TO" NODE ADDRESS. ISZ COUNT IF NOT LAST "TO" NODE, JMP CNVTO CONVERT NEXT ONE. LDA VLINE+4 PUT "!" STA LINE+4 IN LINE STA LINE1+4 AND LINE1. JSB PRINT PRINT DEF LINE LINE. DEF OUTLN JSB PRINT PRINT DEF LINE1 LINE1. DEF OUTLN JSB PRINT PRINT DEF VLINE VERTICAL DEF D5 LINE. ISZ FNODE BUMP "FROM" NODE POINTER ISZ CONT2 AND COUNT. JMP INIT1 IF NOT DONE, DO NEXT "FROM" NODE. SPC 1 * DONE WITH THIS PAGE JSB EXEC SKIP DEF *+4 TO DEF D3 NEXT DEF CONWD PAGE. DEF N4 LDA NDFIT FOR NEXT PASS, THE CMA,INA NUMBER OF NODES TO ADA SKNOD SKIP IS THE PREVIOUS STA SKNOD NUMBER PLUS THE ADA NNODE NUMBER JUST PRINTED. SZA,RSS PRINTED THEM ALL? JMP FINIS YES! ALL DONE. * NEED TO PASS THROUGH FILE AGAIN. STA NDLFT SAVE NUMBER OF NODES LEFT. JSB POSNT SPACE DEF *+5 THE DEF DCB NDT DEF ERROR FILE DEF D2 TO DEF D1 REC # 2. JSB ERCHK CHECK FOR FILE ERROR. JSB EXEC SKIP DEF *+4 FOUR DEF D3 LINES. DEF CONWD DEF D4 JMP BLOOP GO BACK IN THE BIG LOOP SPC 2 ** DONE ** FINIS JSB CLOSE CLOSE DEF *+2 THE DEF DCB NDT FILE. TRMN8 JSB EXEC TERMINATE. DEF *+2 DEF D6 SKP *** SUBROUTINE TO PRINT A MESSAGE ON OUTLU *** * CALLING SEQUENCE: JSB PRINT * DEF * DEF * PRINT NOP LDA PRINT,I PICK STA MSG UP ISZ PRINT PARAMETERS. LDA PRINT,I STA LEN ISZ PRINT SET RETURN ADDRESS. JSB EXEC CALL DEF *+5 EXEC DEF D2 FOR DEF OUTLU WRITE. DEF MSG,I DEF LEN,I JMP PRINT,I RETURN. MSG BSS 1 LEN BSS 1 SPC 3 *** SUBROUTINE TO PRINT A BLANK LINE *** * CALLING SEQUENCE: JSB BLINE * BLINE NOP JSB PRINT DEF BLANK DEF D1 JMP BLINE,I SPC 3 *** SUBROUTINE TO SET LINE & LINE1 TO BLANKS *** * CALLING SEQUENCE: JSB CLEAR * CLEAR NOP LDA @BLNK SOURCE := BLANK. LDB @LINE DESTINATION := LINE. MVW D129 MOVE BLANK THROUGH 128 WORDS. JMP CLEAR,I RETURN SPC 3 *** SUBROUTINE TO CHECK FOR FMP ERROR *** * CALLING SEQUENCE: JSB ERCHK ERCHK NOP LDA ERROR IF NO SSA,RSS ERROR, JMP ERCHK,I RETURN. CMA,INA MAKE ERROR STA ERROR POSITIVE. JSB CNUMD CONVERT DEF *+3 ERROR DEF ERROR TO ASCII DEF ERMSG+8 (DECIMAL). JSB PRINT PRINT DEF ERMSG ERROR DEF D13 MESSAGE. JMP FINIS DONE. SUP ERMSG ASC 13, *** FMP ERROR -NNNNNN *** SPC 3 *** ROUTINE CALLED WHEN TOO MANY NODES ARE IN FILE *** * CALLING SEQUENCE: JMP TOMNY * TOMNY JSB CNUMD CONVERT NUMBER DEF *+3 OF NODES ALLOWED DEF MAXND TO ASCII (DECIMAL). DEF ASCMX JSB PRINT PRINT DEF EMSG1 ERROR DEF D18 MESSAGE. JMP FINIS TERMINATE. * EMSG1 ASC 13, *** TOO MANY NODES. MAX = ASCMX ASC 5,NNNNNN *** SPC 3 *** ROUTINE CALLED WHEN BAD DATA IS READ * CALLING SEQUENCE: JMP BADRC* * BADRC JSB PRINT PRINT DEF EMSG2 ERROR DEF D13 MESSAGE. JMP FINIS TERMINATE. * EMSG2 ASC 13, *** BAD DATA IN FILE *** SKP *** BASE PAGE VALUES *** XEQT EQU 1717B ID SEG ADDR BGLWA EQU 1777B LAST WORD IN PARTITION SPC 1 *** DATA STORAGE AREA *** SPC 1 * RUN-TIME PARAMETERS INLU BSS 1 INPUT LU OUTLU BSS 1 OUTPUT LU WIDTH BSS 1 LINE WIDTH BSS 2 LAST 2 NOT USED SPC 1 COMMA ASC 1,,, SWRD ASC 1,,: SCAN WORD SBYTA DBL STRG2 FIRST BYTE OF COMMAND STRING @STG2 DEF STRG2 FIRST WORD OF COMMAND STRING SPC 1 * PARSE BUFFER FOR FILE NAMR PBUF BSS 1 NAME BSS 3 BSS 1 SECU BSS 3 BSS 1 ICR BSS 3 BSS 21 SPC 1 * NDT FILE'S DATA CONTROL BLOCK DCB BSS 144 SPC 1 * NUMERIC CONSTANTS: B777C OCT 77700 B377C OCT 37700 B1100 OCT 1100 B401 OCT 401 B400 OCT 400 B200 OCT 200 B77 OCT 77 D129 DEC 129 D62 DEC 62 D23 DEC 23 D20 DEC 20 D18 DEC 18 D13 DEC 13 D12 DEC 12 D9 DEC 9 D7 DEC 7 D6 DEC 6 D5 DEC 5 D4 DEC 4 D3 DEC 3 D2 DEC 2 D1 DEC 1 D0 DEC 0 N4 DEC -4 N50 DEC -50 N256 DEC -256 N129 DEC -129 SPC 1 * ALPHABETIC STRINGS FOR I/O NAMR? ASC 13,/NDTDU: NDT FILE NAMR? _ HED1 ASC 18, NETWORK DESCRIPTION TABLE IN FILE STRNG BSS 12 [COMMAND STRING] STRG2 BSS 12 ATNOD ASC 7, AT NODE NNNNN HED2 ASC 12,NNNNNN NODES IN NETWORK BLANK ASC 1, LINE BSS 64 LINE1 BSS 64 SPC 1 LNRC1 BSS 1 MAX LENGTH FOR RECORD 1. MAXRC BSS 1 MAX LENGTH FOR OTHER RECORDS. MAXND BSS 1 MAX NO OF NODES. NNODE BSS 1 NUMBER OF NODES IN NDT. @NODE BSS 1 @LIN4 DEF LINE+4 @LINE DEF LINE @BLNK DEF BLANK RCDPT BSS 1 ADDRESS IN RECORD. ERROR BSS 1 FMP ERROR CONWD BSS 1 I/O CONTROL WORD FOR PAGE EJECT. COUNT BSS 1 COUNTERS CONT2 BSS 1 TEMP1 <:6BSS 1 L1PNT BSS 1 POINTER INTO LINE1. LOG BSS 1 VLINE ASC 5, ! OUTLN BSS 1 OUTPUT LENGTH. NDFIT BSS 1 NUMBER OF NODES WHICH WILL FIT ON LINE. SKNOD BSS 1 NUMBER OF NODES TO SKIP. NDLFT BSS 1 NUMBER OF NODES LEFT TO PROCESS. RULE ASC 4, ----- REP 20 ASC 3,+----- BSS 0 SIZE OF NDTDU END NDTDU N5< [j 24999-18214 1902 S 0100 &SLCIN              H0101 ZASMB,L,C NAM SLCIN,19 PRINT SLC INFO 780613 DMT 24999-16214 REV 1902 SUP A EQU 0 B EQU 1 EXT EXEC,CNUMO,CNUMD,$LIBR,$LIBX,$OPSY EXT #FWAM,#LU3K,D$EQT,D$XS5 SPC 1 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** SPC 1 UNL *# EXT IFBRK LST ******************************* * * * PROGRAM NAME: SLCIN * * * * SOURCE PART#: 24999-18XXX * * * * RELOC. PART#: 24999-16XXX * * * * PROGRAMMER : DT * * * * DATE : JUNE 1977 * * * ******************************* SPC 1 * PRINT LONG TERM STATISTICS AND TRACE TABLES FROM THE SYNCHRONOUS * LINE CONTROL (SLC) PACKAGE. * * RUN FROM RTE WITH * RU,SLCIN, * WHERE IS THE LU WHERE THE INFORMATION IS TO BE PRINTED. * * THE SLC LONG TERM STATISTICS ARE PRINTED FIRST, FOLLOWED BY THE * EVENT TRACE TABLE. * * NOTE: MODIFIED 9-22-77 TO REMOVE CHARACTER TRACE PRINT * MODIFIED 6-13-78 TO REMOVE PRINTING OF UNMAINTAINED STATISTICS * (ERROR-FREE MSGS, NACKS, AND WACK/TTD RECEIVED). SPC 1 SKP * PICK UP SCHEDULING PARAMETER SLCIN LDA $OPSY IF OP SYSTEM RAR,SLA IS NOT MAPPED, JMP XLOAD LDA B,I NO DMS LOAD NEEDED. JMP SETLU * XLOAD XLA B,I * SETLU SZA,RSS IF OUTLU=0, CLA,INA OUTLU:=1. STA OUTLU * LDA #FWAM HAS LSTEN SZA BEEN FRUN? JMP CHEK2 YES--IS 3000 ENABLED? * JSB PRINT PRINT DEF RUNL ERROR DEC 9 MESSAGE. JMP FINIS TERMINATE. * CHEK2 LDA #LU3K IF 3000 HAS SZA NOT BEEN JMP LTSTS ENABLED, * JSB PRINT PRINT DEF NOTEN ERROR DEC 10 MESSAGE. JMP FINIS TERMINATE. SPC 2 RUNL ASC 9, RUN LSTEN FIRST! NOTEN ASC 10, HP 3000 NOT ENABLED SKP * PRINT LONG TERM STATISTICS * LTSTS JSB PRINT PRINT DEF SHEAD HEADING. DEC 13 LDA DN4 SET UP COUNTER STA CNT1 FOR 4 LINES. LDA FSTVL INITIALIZE JSB INDR STA FSTVL ADA DN1 STA VPNT VALUE POINTER. LDA MSGTB INITIALIZE STA MPNT MESSAGE POINTER. LDA D14 SET OUTPUT STA BUMP BUMP TO 14. * LOOPA LDA AW3 SET OUTPUT STA OPNTR POINTER. LDA BLANK CLEAR JSB FILL BUFFER. * LOOPB ISZ VPNT BUMP STAT POINTER. LDA MPNT,I GET # OF STA CNT2 CHARACTERS. ISZ MPNT SZA,RSS SKIP MOVE IF JMP LOOPB NO MESSAGE. LDA MPNT MESSAGE SOURCE ADDR. LDB OPNTR MESSAGE DESTINATION FIELD. ADB D3 MVW CNT2 MOVE MESSAGE. STA MPNT POINT TO NEXT MESSAGE. LDB VPNT,I CONVERT THE JSB TO10 VALUE. LDA OPNTR IF PRINTLINE CPA AW17 NOT FULL, JMP LOOPB MOVE 2ND MESSAGE. * JSB PRINT PRINT DEF BUFR MESSAGES. DEC 30 ISZ CNT1 LAST MESSAGE? JMP LOOPA NO--STAY IN LOOP. SKP * DUMP EVENT TRACE TABLE * * CALCULATE START/END OF EVENT/CHARACTER TABLES LDA FSTVL CALCULATE ADA D11 OFFSET STA @TABL FOR CMA,INA TRACE ADA @PNTR TABLES. STA OFSET cr LDA @D$EQ JSB INDR ADA D$EQT ADA OFSET UNL *# STA EOTB2 LAST ADDR IN CHAR TABLE. LST LDB D$XS5+1 B:=# WRDS IN CHAR TABLE. CMB,INB ADA B SUBTRACT FROM A. STA EOTBL LAST ADDR IN EVENT/1ST IN CHAR. * JSB PRINT PRINT DEF BLANK BLANK D1 DEC 1 LINE. JSB PRINT PRINT HEADINGS. DEF EHEAD DEC 12 JSB PRINT DEF EHED2 DEC 28 LDB D4 SET PRINT STB BUMP BUMP TO 4. * * MOVE TRACE TABLES AND POINTERS JSB $LIBR TURN OFF NOP INTERRUPTS. LDA @TABL SOURCE LOCATION. LDB @PNTR DESTINATION LOCATION. MVW D303 MOVE 303 WORDS. JSB $LIBX TURN DEF *+1 INTERRUPTS DEF *+1 BACK ON. * LDB PNTRS+2 B:=FIRST ENTRY ADDRESS. * LOOP LDA BLANK CLEAR JSB FILL PRINTLINE. ADB OFSET ADD OFFSET FOR LOCAL TABLES. STB LINK STORE LINK ADDRESS. STB ENTRY SAVE ENTRY ADDRESS. JSB NXTEV PICK UP WORD 2. LDB AW3 SET UP STB OPNTR OUTPUT POINTER. CLB CLEAR B-REG. LSL 8 B:=COMPLETION STATUS. JSB TO8 CONVERT AND STORE. LSL 2 B:=REQUEST CODE. STB REQCD STORE. CLB LSL 6 B:=FUNCTION CODE. STB FUNCD STORE. * DECODE FUNCTION LDA REQCD LOAD REQUEST CODE. CPA D1 IF = 1, JMP READ DECODE FOR READ. CPA D2 IF = 2, JMP WRITE DECODE FOR WRITE. CPA D3 IF = 3, JMP CNTRL DECODE FOR CONTROL. * BAD FUNCTION BAD LDB REQCD CONVERT REQUEST JSB TO8 CODE AND LDB REQCD FUNCTION TO JSB TO8 OCTAL. JMP WRD3 GO GET WORD 3. * READ LDA FUNCD ** PROCESS READ FUNCTION ** hW SZA,RSS CHECK JMP BAD FOR CPA D7 BAD JMP BAD FUNCTION. ADA DN7 SSA,RSS JMP BAD DLD STA05+1 MOVE DST BUFR+7 "READ". LDA FUNCD ADA @RTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW10 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. JMP WRD3 GO GET WORD 3. * WRITE LDA FUNCD ** PROCESS WRITE FUNCTION ** SZA,RSS CHECK JMP BAD FOR CPA D7 BAD JMP BAD FUNCTION. LDB AW8 MOVE LDA @WRIT "WRITE". MVW D3 LDA FUNCD DON'T USE AND D7 FUNCTION BITS 9-11. ADA @WTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW11 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. JMP WRD3 GO GET WORD 3. * CNTRL LDA FUNCD ** PROCESS CONTROL FUNCTION ** CPA D5 CHECK FOR JMP BAD BAD FUNCTION AND D7 AND LDB D11 MAP CPA FUNCD 40-45 LDB D6 TO ADA DN6 5-12. SSA,RSS JMP BAD ADA B ADA @CTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW8 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * WRD3 JSB NXTEV PICK UP WORD 3. LDB LINK,I ALREADY ADB OFSET UP TO CPB ENTRY NEXT ENTRY? JMP SPCAS YES--SPECIAL CASE! * LOOP2 CLB LSL 8 B:=EVENT #. STB EVENT STORE. CLB LSL 8 B:=STATE #. STB STATE STORE. * LDA EVCENT DECODE EVENT. ADA DN33 CHECK SSA,RSS FOR JMP BADE BAD LDA EVENT EVENT. ADA @ETBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW17 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * DESTA LDA STATE DECODE STATE. ADA DN25 CHECK SSA,RSS FOR JMP BADS BAD LDA STATE STATE. ADA @STBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW26 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * PRNT1 JSB PRINT PRINT EVENT ENTRY. DEF BUFR D33 DEC 33 UNL *# JSB IFBRK IF BREAK *# DEF *+1 FLAG *# SSA SET, *# JMP CTRAC GO TO CHARACTER TRACE. LST LDA BLANK JSB FILL FILL OUTPUT BUFFER WITH BLANKS. JSB NXTEV GET NEXT WORD. LDB LINK,I PROCESSED ADB OFSET THE LAST CPB ENTRY EVENT/STATE WORD? JMP CHK2 YES--CHECK FOR END OF TABLE. LDB AW18 NO-- STB OPNTR SET OUTPUT POINTER JMP LOOP2 AND PRINT THEM. * * SPECIAL CASE--NO EVENT/STATE WORDS SPCAS JSB PRINT PRINT DEF BUFR FIRST WORD DEC 15 INFO ONLY. * CHK2 LDB LINK,I CPB PNTRS+1 LAST ENTRY? JMP CTRAC YES! JMP LOOP NO--LOOP AGAIN. SPC 3 * VARIABLES USED IN EVENT TRACE * EVENT NOP STATE NOP REQCD NOP FUNCD NOP SPC 2 BADE LDA AW17 BAD EVENT-- STA OPNTR CONVERT LDB EVENT TO JSB TO10 DECIMAL. JMP DESTA SPC 2 BADS LDA AW26 BAD STATE-- STA OPNTR CONVERT LDB STATE TO R JSB TO10 DECIMAL. JMP PRNT1 SKP * PRINT CHARACTER TRACE TABLE * (CHARACTER TRACE TABLE IS NOT MAINTAINED FOR HSLC) * CTRAC EQU * UNL *# LDA D$XS5 IF NOT *# AND D2 MODEM *# SZA,RSS LINK, *# JMP FINIS ALL DONE. *# JSB PRINT PRINT *# DEF BLANK BLANK *# DEC 1 LINE. *# JSB PRINT PRINT FIRST *# DEF CHEAD HEAD. *# DEC 14 *# LDA BLANK *# JSB FILL *# LDA @CHD2 SET UP *# LDB AW2 2ND HEAD *# MVW D6 BY MOVING *# LDA AW2 OVERLAPING *# LDB AW10 FIELDS. *# MVW D22 *# JSB PRINT PRINT IT. *# DEF BUFR *# DEC 31 *# LDB D5 SET PRINT *# STB BUMP BUMP TO 5. *# LDB PNTRS B:=1ST CHAR ADDRESS. *# ADB OFSET ADD OFFSET FOR LOCAL TABLE. *# STB PNTRS *# STB ENTRY SAVE. *#* *#LOOP3 LDA BLANK CLEAR *# JSB FILL PRINTLINE. *# LDA AW2 SET UP *# STA OPNTR OUTPUT POINTER. *# LDB DN4 CONVERT 4 CHARACTERS *# STB CNT2 PER LINE. *#* *#LOOP4 LDA ENTRY,I GET NEXT CHARACTER. *# LDB DN3 SET UP *# STB CNT1 BIT COUNTER. *# LDB "1" B:=ASCII 1. *#* *#LOOP5 CLE,ELA ANALYZE *# SEZ BIT *# STB OPNTR,I *# ISZ OPNTR FIELDS. *# ISZ CNT1 DONE? *# JMP LOOP5 *#* *# LSR 3 GET *# AND B377 DATA. *# LDB A *# JSB TO8 CONVERT TO OCTAL. *#* *#* INTERPRET ASCII VALUE OF CHARACTER *# LDB OPNTR POINT *# ADB DN2 TO *# STB CNT1 BUFFER. *# LDB A COPY CHARACTER. *# AND B340 IS IT >= SPACE? *# SZA *# JMP CHAR YES--GO DO U.C. LETTER TEST. *# CLE,ELB POINT INTO *# ADB @CCTB CONTROL CHAR TABLE. *# DLD B,I PICK UP DESCRIPTION. *# JMP STORE STORE IN PRINT BUFFER. *#* *#CHAR EQU * ** PROCESS NON-CONTROL CHARS ** *# STA TEMP SAVE TEST BITS. *# AND B200 IS BIT *# SZA 7 SET? *# JMP UPDT YES--SKIP STORE. *# LDA TEMP *# XOR B140 IF CHARACTER IS *# SZA,RSS LOWER CASE, *# JMP UPDT SKIP STORE. *# LDA B COPY CHAR TO A-REG *# IOR B21K WITH QUOTE IN RIGHT HALF. *# ALF,ALF *# LDB "="" B:="="". *# SWP SWAP 'EM. *#* *#STORE DST CNT1,I STORE CONVERTED CHARACTER. *#* *#UPDT JSB NXTCH UPDATE CHAR POINTER. *# CPA PNTRS LAST CHARACTER IN TRACE? *# JMP PRNTC YES--GO PRINT. *# ISZ CNT2 DONE WITH THIS LINE? *# JMP LOOP4 *#* *#PRNTC JSB PRINT PRINT LINE OF INFO. *# DEF BUFR *# DEC 33 *#* *# LDA ENTRY *# CPA PNTRS END OF LIST? *# RSS *# JMP LOOP3 LST SPC 3 FINIS JSB EXEC TERMINATE DEF *+2 DEF D6 SPC 6 * SUBROUTINES SPC 3 * CONVERT B-REG CONTENTS TO ASCII (OCTAL) TO8 NOP STB TEMP STORE NUMBER. STA AREG SAVE A-REG. JSB CNUMO GO CONVERT. DEF *+3 DEF TEMP DEF OPNTR,I LDA AREG RESTORE A-REG. LDB OPNTR BUMP ADB BUMP OUTPUT STB OPNTR POINTER. CLB CLEAR B-REG. JMP TO8,I RETURN. SPC 5 * CONVERT B-REG CONTENTS TO ASCII (DECIMAL) * TO10 NOP STB TEMP STORE NUMBER. STA AREG SAVE A-REG. JSB CNUMD GO CONVERT. DEF *+3 DEF TEMP DEF OPNTR,I LDA AREG RESTORE A-REG. LDB OPNTR BUMP ADB BUMP OUTPUT STB OPNTR POINTER. CLB CLEAR B-REG. JMP TO10,I RETURN. SPC 3 * PRINT A MESSAGE * MSG NOP  MESSAGE ADDRESS LEN NOP LENGTH * PRINT NOP LDA PRINT,I PICK STA MSG UP ISZ PRINT PARAMETERS. LDA PRINT,I STA LEN ISZ PRINT * JSB EXEC CALL EXEC FOR WRITE. DEF *+5 DEF D2 DEF OUTLU DEF MSG,I DEF LEN * JMP PRINT,I RETURN. SPC 3 * GET NEXT ENTRY IN EVENT TABLE * NXTEV NOP LDA ENTRY GET CURRENT ENTRY ADDRESS. INA ADD ONE. CPA EOTBL IF OUT OF TABLE, LDA SOTBL RESET TO BEGINNING. STA ENTRY STORE. LDA A,I A:=CONTENTS OF ENTRY. JMP NXTEV,I RETURN. * SOTBL DEF TABLE START OF EVENT TRACE TBL EOTBL NOP END OF EVENT TRACE TBL SPC 3 UNL *#* POINT TO NEXT ENTRY IN CHARACTER TABLE *#* *#NXTCH NOP *# LDA ENTRY GET CURRENT ADDRESS. *# INA ADD ONE. *# CPA EOTB2 IF OUT OF TABLE, *# LDA SOTB2 RESET TO BEGINNING. *# STA ENTRY STORE. *# JMP NXTCH,I RETURN. *#* *#SOTB2 EQU EOTBL START OF CHAR TABLE. *#EOTB2 NOP END OF CHAR TABLE. *# SPC 3 LST * FILL OUTPUT BUFFER WITH CHAR IN A-REG * FILL NOP LDX D33 INITIALIZE COUNTER. FLOOP SAX BUFR-1 STORE A-REG. DSX DECREMENT X-REG AND JMP FLOOP STAY IN LOOP UNTIL 0. * JMP FILL,I RETURN. SPC 3 * CHASE DOWN INDIRECTS * INDR NOP RSS N LDA A,I RAL,CLE,SLA,ERA JMP N JMP INDR,I SPC 6 * CONSTANTS AND STORAGE SPC 1 UNL *#"1" ASC 1, 1 *#"="" ASC 1,=" LST @D$EQ DEF D$EQT FSTVL DEF D$XS5+2 BLANK ASC 1, VPNT NOP MPNT NOP BUMP NOP LINK NOP ENTRY NOP CNT1 NOP CNT2 NOP TEMP NOP UNL *#AW2 DEF BUFR+1 LST AW3 DEF BUFR+2 AW8 DEF BUFR+7 AW10 DEF BUFR+9 AW11 DEF BUFR+10 AW17 DEF BUFR+16 AW18 DEF BUFR+17 AW26 DEF BUFR+25 OPNTR NOP BUFR ASC 20, ASC 13, * HEADINGS: SHEAD ASC 13, SLC LONG TERM STATISTICS: EHEAD ASC 12, SLC EVENT TRACE TABLE: EHED2 ASC 25, STATUS FUNCTION EVENT ASC 3,STATE UNL *#CHEAD ASC 14, SLC CHARACTER TRACE TABLE: *#CHED2 ASC 6, T L D DATA *#* *#@CHD2 DEF CHED2 LST OUTLU NOP RUN-TIME BSS 4 PARAMETERS AREG NOP DN33 DEC -33 DN25 DEC -25 DN7 DEC -7 DN6 DEC -6 DN4 DEC -4 UNL *#DN3 DEC -3 *#DN2 DEC -2 LST DN1 DEC -1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D14 DEC 14 UNL *#D22 DEC 22 LST D303 DEC 303 UNL *#B140 OCT 140 *#B200 OCT 200 *#B340 OCT 340 *#B377 OCT 377 *#B21K OCT 21000 LST SPC 3 * LONG TERM STATS HEADINGS * MSGTB DEF *+1 MESSAGE TABLE D7 DEC 7 ASC 7, READ REQUESTS DEC 8 ASC 8, WRITE REQUESTS D11 DEC 11 ASC 11, MESSAGES TRANSMITTED DEC 0 ERROR-FREE STAT NOT KEPT D6 DEC 6 ASC 6, LINE ERRORS DEC 0 NAKS STAT NOT KEPT DEC 9 ASC 9, BCC/PARITY ERRORS DEC 7 ASC 7, LONG TIMEOUTS DEC 8 ASC 8, RESPONSE ERRORS DEC 7 ASC 7, RESPONSE REJ SPC 3 * POINTERS INTO TABLES * UNL *#@CCTB DEF CCTB LST @RTBL DEF RTBL-1 @WRIT DEF STA12+1 @WTBL DEF WTBL-1 @CTBL DEF CTBL @ETBL DEF ETBL @STBL DEF STBL SPC 3 UNL *#* CONTROL CHARACTER TABLE *#* *#CCTB ASC 2, *# ASC 2,=SOH *# ASC 2,=STX *# ASC 2,=ETX *# ASC 2,=EOT *# ASC 2,=ENQ *# ASC 2,=ACK *# ASC 2,=BEL *# ASC 2,=BS *# ASC 2,=HT *# ASC 2,=LF *# ASC 2,=VT *# ASC 2,=FF *# ASC 2,=CR *# ASC 2,=SO *# ASC 2,=SI *# ASC 2,=DLE *# ASC 2,=DC1 *# ASC 2,=DC2 *# ASC 2,=DC3 *# ASC 2,=DC4 *# ASC 2,=NAK *# ASC 72,=SYN *# ASC 2,=ETB *# ASC 2,=CAN *# ASC 2,=EM *# ASC 2,=SUB *# ASC 2,=ESC *# ASC 2,=FS *# ASC 2,=GS *# ASC 2,=RS *# ASC 2,=US *# SPC 3 LST * LOCAL STORAGE FOR TRACE TABLES AND POINTERS * @PNTR DEF PNTRS @TABL NOP OFSET NOP PNTRS BSS 3 TABLE BSS 300 SPC 3 * READ FUNCTION TABLE * RTBL DEF RMSG1 DEF RMSG2 DEF RMSG3 DEF RMSG4 DEF RMSG5 DEF RMSG6 RMSG1 DEC 4 ASC 4, INQUIRY RMSG2 DEC 4 ASC 4, INITIAL RMSG3 DEC 5 ASC 5, CONTINUE RMSG4 DEC 4 ASC 4, REPEAT RMSG5 DEC 6 ASC 6, W/REVRS INT RMSG6 DEC 3 ASC 3, DELAY SPC 2 * WRITE FUNCTION TABLE * WTBL DEF WMSG1 DEF WMSG2 DEF WMSG3 DEF WMSG4 DEF WMSG5 DEF WMSG6 WMSG1 DEC 4 ASC 4,INQUIRY WMSG2 DEC 4 ASC 4,CONTINUE WMSG3 DEC 5 ASC 5,CONVERSTNL WMSG4 DEC 3 ASC 3,RESET WMSG5 DEC 5 ASC 5,DISCONNECT WMSG6 DEC 3 ASC 3,DELAY SPC 2 * CONTROL FUNCTION TABLE * CTBL DEF CMSG0 DEF CMSG1 DEF CMSG2 DEF CMSG3 DEF CMS40 DEF CMS41 DEF CMS42 DEF CMS43 DEF CMS44 DEF CMS45 CMSG0 DEC 3 ASC 3,CLEAR CMSG1 DEC 5 ASC 5,INITIALIZE CMSG2 DEC 5 ASC 5,LINE OPEN CMSG3 DEC 5 ASC 5,LINE CLOSE CMS40 DEC 8 ASC 8,ESTABLISH LOC ID CMS41 DEC 8 ASC 8,ESTBL REM ID LST CMS42 DEC 8 ASC 8,CHNG ERROR PRAMS CMS43 DEC 8 ASC 8,ZERO COMM STATS CMS44 DEC 7 ASC 7,SHIFT TO RECEV CMS45 DEC 8 ASC 8,DISABLE NAK SEND SPC 2 * EVENT TABLE * ETBL DEF EVT00 DEF EVT01 DEF EVT02 DEF EVT03 DEF EVT04 DEF EVT05 DEF EVT06 DEF EVT07 DEF EVT08 DEF EVT09 DEF EVT10 DEF EVT11 DEF EVT12 DEF EVT13 DEF EVT14 DEF EVT15 DEF tEVT16 DEF EVT17 DEF EVT18 DEF EVT19 DEF EVT20 DEF EVT21 DEF EVT22 DEF EVT23 DEF EVT24 DEF EVT25 DEF EVT26 DEF EVT27 DEF EVT28 DEF EVT29 DEF EVT30 DEF EVT31 DEF EVT32 EVT00 DEC 7 ASC 7,LINE OPEN REQ EVT01 DEC 7 ASC 7,LINE CLOSE REQ EVT02 DEC 8 ASC 8,READ INQUIRY REQ EVT03 DEC 8 ASC 8,READ INITIAL REQ EVT04 DEC 8 ASC 8,READ CONTINUE RQ EVT05 DEC 8 ASC 8,READ REPEAT REQ EVT06 DEC 8 ASC 8,READ/REV INT REQ EVT07 DEC 5 ASC 5,DELAY READ EVT08 DEC 8 ASC 8,WRITE INQURY REQ EVT09 DEC 8 ASC 8,WRITE CNTNUE REQ EVT10 DEC 7 ASC 7,WRITE CONV REQ EVT11 DEC 8 ASC 8,WRT RESET(EOT)RQ EVT12 DEC 8 ASC 8,WRITE DISCON REQ EVT13 DEC 8 ASC 8,DELAY WRITE REQ EVT14 DEC 7 ASC 7,ACK0 RECEIVED EVT15 DEC 7 ASC 7,ACK1 RECEIVED EVT16 DEC 7 ASC 7,WACK RECEIVED EVT17 DEC 7 ASC 7,RVI RECV/SENT EVT18 DEC 6 ASC 6,ENQ RECEIVED EVT19 DEC 6 ASC 6,NAK RECEIVED EVT20 DEC 6 ASC 6,EOT RECEIVED EVT21 DEC 8 ASC 8,DLE EOT RECEIVED EVT22 DEC 6 ASC 6,TTD RECEIVED EVT23 DEC 7 ASC 7,TEXT RECEIVED EVT24 DEC 8 ASC 8,BCC PRTY/FMT ERR EVT25 DEC 6 ASC 6,TEXT OVERRUN EVT26 DEC 8 ASC 8,GARBAGE RECEIVED EVT27 DEC 8 ASC 8,BAD ID SEQUENCE EVT28 DEC 7 ASC 7,SHORT TIMEOUT EVT29 DEC 6 ASC 6,LONG TIMEOUT EVT30 DEC 2 ASC 2,LOW EVT31 DEC 2 ASC 2,HIGH EVT32 DEC 2 ASC 2,MID SPC 2 * STATE TABLE * STBL DEF STA00 DEF STA01 DEF STA02 DEF STA03 DEF STA04 DEF STA05 DEF STA06 DEF STA07 DEF STA08 DEF STA09 DEF STA10 DEF STA11 DEF STA12 DEF STA13 DEF STA14 DEF STA15 DEF STA16 DEF STA17 DEF STA18 -HFB DEF STA19 DEF STA20 DEF STA21 DEF STA22 DEF STA23 DEF STA24 STA00 DEC 4 ASC 4,UNOPENED STA01 DEC 4 ASC 4,CONTROL STA02 DEC 4 ASC 4,READ ENQ STA03 DEC 7 ASC 7,READ ENQ ERROR STA04 DEC 7 ASC 7,CHECK READ REQ STA05 DEC 2 ASC 2,READ STA06 DEC 5 ASC 5,READ TEXT STA07 DEC 4 ASC 4,READ RVI STA08 DEC 8 ASC 8,RESTRICTED READ STA09 DEC 5 ASC 5,WRITE ENQ STA10 DEC 8 ASC 8,WRITE ENQ ERROR STA11 DEC 8 ASC 8,ENQ-ENQ CONTENTN STA12 DEC 3 ASC 3,WRITE STA13 DEC 5 ASC 5,WRITE TEXT STA14 DEC 8 ASC 8,WRITE RESPNS ENQ STA15 DEC 7 ASC 7,CHECK RESPONSE STA16 DEC 8 ASC 8,BAD ACK RECEIVED STA17 DEC 6 ASC 6,WRITE RETRY STA18 DEC 8 ASC 8,ENQ RCV IN WRITE STA19 DEC 8 ASC 8,ENQ RCRD IN WRIT STA20 DEC 8 ASC 8,WRITE CONVERSTNL STA21 DEC 5 ASC 5,WRITE EOT STA22 DEC 8 ASC 8,READ EOT RSPONSE STA23 EQU WMSG5 STA24 DEC 5 ASC 5,WRITE TTD SPC 1 BSS 0 SIZE OF SLCIN. SPC 1 END SLCIN |H \m 24999-18215 1902 S 0100 &DSINF              H0101 gASMB,N,C,L IFN NAM DSINF,19,65 1000-1000-3000 780106 24999-16215 REV 1902 EXT DEXEC XIF IFZ NAM DSINF,19,65 1000-3000 VRSN 780106 XIF SPC 1 SUP A EQU 0 B EQU 1 EXT $LIBR,$LIBX,$PARS,$CVT1,CNUMO,CNUMD EXT EXEC,RMPAR,$CLAS,$RNTB SPC 1 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** SPC 1 ******************************************** * * * NAME: DSINF (DS INFORMATION) * * * * SOURCE: 24999-18215 (N-OPTION) * * * * RELOCATABLE: 24999-16215 (N-OPTION) * * * * PROGRAMMER: DT * * * * DATE: APRIL 1977 * * * ******************************************** SPC 3 * THE ORIGINAL CODE FOR THIS PROGRAM WAS WRITTEN IN HP ALGOL. * MODIFICATIONS HAVE BEEN INTRODUCED SINCE TRANSLATION TO * ASSEMBLY LANGUAGE! SPC 3 * ASSEMBLY OPTIONS: * N 1000-1000 AND 1000-3000 VERSION * Z 1000-3000 ONLY (NO DEXEC OR NRV) SKP *COMMENT DS/1000 UTILTIY PROGRAM. [DT] * *RUN FROM RTE WITH * RU,DSINF,,,,, * *THE RUN-TIME PARAMETERS HAVE THESE MEANINGS: * * THE LOGICAL UNIT NUMBER OF THE INPUT DEVICE. THE DEFAULT * IS THE NUMBER OF THE SCHEDULING TERMINAL PASSED BY M-T-M * OR 1. IF THEG INPUT DEVICE IS INTERACTIVE (USES DVR00 OR * SUBCHANNEL 0 AND DVR05), A PROMPT IS PRINTED ON THE DEVICE * BEFORE EACH READ. * * THE LOGICAL UNIT NUMBER OF THE DEVICE WHERE INFORMATION IS * PRINTED. THE DEFAULT IS THE INPUT LU (IF INTERACTIVE) OR 6. * * A CONTROL WORD WHICH SPECIFIES DSINF WILL BE RUN NON- * INTERACTIVELY. THE FUNCTIONS WHICH TAKE PLACE ARE * DETERMINED BY THE BITS SET: * * DECIMAL * VALUE PRINT THIS INFORMATION * ------- ------------------------------ * 1 AVAILABLE MEMORY SUSPEND LIST * 2 I/O CLASSES * 4 DS/1000 VALUES * 8 DUMP OF SAM BLOCK * 16 DS/1000 LISTS * 32 NODAL ROUTING VECTOR * 64 DS/1000 EQT ENTRIES * * FOR EXAMPLE, TO PRINT THE I/O CLASS AND DS/1000 VALUES * ON YOUR TERMINAL, TYPE RU,DSINF,,,6. * * THE NODE NUMBER WHERE I/O IS TO OCCUR. DEFAULT IS LOCAL * NODE (-1). * * SET TO A NON-ZERO VALUE WHEN THE NODE NUMBER IS 0 (TO * DISTINGUISH IT FROM THE DEFAULT). * * *DSINF RECOGNIZES THE FOLLOWING COMMANDS: * AV AVAILABLE MEMORY SUSPEND LIST * CL I/O CLASSES * VA DS/1000 VALUES * DU DUMP OF SAM BLOCK * LI DS/1000 LISTS * NR NODAL ROUTING VECTOR * EQ DS/1000 EQT ENTRIES * EQ,N PRINT INFORMATION ON EQT N * /E OR EX TERMINATE DSINF * *ALL OTHER CHARACTERS CAUSE THE FUNCTIONS TO BE LISTED ON THE *OUTPUT DEVICE.; SKP * RUN-TIME PARAMETERS *INTEGER INLU,OUTLU,CONWD,P4,P5; INLU BSS 01 OUTLU BSS 01 CONWD BSS 01 NODE BSS 01 FLAG BSS 01 SPC 2 *INTEGER I,J, & COUNTERS I BSS 01 J BSS 01 * KYWRD, & BASE OF KEYWORD TABLE KYWRD BSS 01 * BLANK:=" ", & ASCII BLANK BLANK OCT 020040 * MAXID, & # OF ENTRIES IN KEYWORD TABLE MAXID BSS 01 * SSIZE; & SIZE OF SAM BLOCK SSIZE BSS 01 SPC 2 * DS/1000 VALUES EXT #CNOD,#FWAM,#TBRN,#QRN,#MSTO,#SVTO,#WAIT EXT #BREJ,#LU3K,#QZRN,#GRPM,#NRV,#TST EXT #RFSZ,#LDEF,#NCNT,#NODE,#LNOD,D$LID,D$RID SPC 2 *INTEGER ARRAY BUFR[1:1]; & OUTPUT BUFFER BUFR EQU * * OUTPUT FIELDS (WORDS 1 THROUGH 39) W1 BSS 01 W2 BSS 01 W3 BSS 2 W5 BSS 01 W6 BSS 01 W7 BSS 01 W8 BSS 01 W9 BSS 01 W10 BSS 01 W11 BSS 2 W13 BSS 01 W14 BSS 01 W15 BSS 01 W16 BSS 01 W17 BSS 1 W18 BSS 1 W19 BSS 01 W20 BSS 01 W21 BSS 19 * * HOLDING AREA FOR NUMBER CONVERSION *INTEGER HOLD1,HOLD2,HOLD3; HOLD1 BSS 01 HOLD2 BSS 01 HOLD3 BSS 01 * * BASE PAGE LOCATIONS SAMIN BSS 1 SAM ARRAY INITIALIZED? *INTEGER EQTA := @1650, & FIRST WORD OF EQUIPMENT TABLE EQTA EQU 1650B * DRT := @1652, & FIRST WORD OF DEVICE REFERENCE TABLE DRT EQU 1652B * LUMAX := @1653, & NUMBER OF LOGICAL UNITS IN DRT LUMAX EQU 1653B * KEYWD := @1657, & FWA OF KEYWORD BLOCK KEYWD EQU 1657B * SUSP2 := @1713, & "WAIT SUSPEND" LIST SUSP2 EQU 1713B * SUSP3 := @1714; & "AVAILABLE MEMORY" WAIT LIST SUSP3 EQU 1714B XEQT EQU 1717B MY ID SEGMENT ADDRESS * *EQUATE LSTRM := 10; & LAST STREAM NUMBER LSTRM EQU 10 NOSTR ABS LSTRM * *INTEGER ARRAY SAM[0:640], & DS/1000 SYSTEM-AVAILABLE-MEMORY SAM EQU * BSS 640 * PNTR[-3:LSTRM]; & POINTERS INTO SAM PNTR EQU *+3 BSS LSTRM+4 SKP * +--------------+ * ! PROCEDURES ! * +--------------+ SPC 3 * * CONVERT DECIMAL NUMBER TO ASCII * CNVTD NOP STA T1 SATVE THE RAW DATA, TEMPORARILY. LDA CNVTD,I GET THE DESTINATION ADDRESS. STA STUFM CONFIGURE THE CALL TO 'CNUMD'. JSB CNUMD GO TO DEF *+3 CONVERT DEF T1 THE VALUE STUFM NOP TO ASCII. ISZ CNVTD ADJUST THE RETURN POINTER, JMP CNVTD,I AND RETURN TO THE CALLER. SPC 3 * * CONVERT DECIMAL NUMBER TO ASCII, TWO DIGITS * (VALUE GOES IN A-REGISTER) * KCVT NOP CCE SET DECIMAL OPTION. JSB $LIBR GO TO NOP THE SYSTEM JSB $CVT1 FOR CONVERSION. JSB $LIBX RETURN TO DEF KCVT THE CALLER. SPC 3 * * CHASE DOWN INDIRECTS * INDR NOP RSS N LDA A,I RAL,CLE,SLA,ERA JMP N JMP INDR,I SKP * * FILL BUFR ARRAY WITH A-REGISTER CONTENTS * FILL NOP ENTRY POINT LDX D39 INITIALIZE COUNTER LOOP SAX BUFR-1 STORE A-REG DSX DECREMENT X-REG AND CONTINUE JMP LOOP IN LOOP UNTIL X=0. * JMP FILL,I RETURN SPC 3 * * PRINT A STRING * MSG BSS 1 STRING ADDRESS LEN BSS 1 LENGTH * PRINT NOP ENTRY POINT LDA PRINT,I GET PARAMETERS STA MSG ISZ PRINT LDA PRINT,I STA LEN ISZ PRINT * UNL IFN LST JSB DEXEC CALL DEXEC FOR WRITE DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC CALL EXEC FOR WRITE DEF *+5 UNL XIF LST DEF D2 DEF OUTLU DEF MSG,I DEF LEN * JMP PRINT,I RETURN SKP * * MOVE THE DS/1000 BLOCK OF SAM * DEST DEF SAM DESTINATION ADDRESS PONTR NOP ADDRESS WHERE POINTER IS STORE&D DEF PNTR-3 POINTERS' ARRAY * GTSAM NOP ENTRY POINT JSB $LIBR INSURE NOBODY CHANGES SAM NOP BY GOING PRIVILEGED * LDA #FWAM A-REG := SOURCE ADDR IN SAM LDB DEST B-REG := DESTINATION LDX SSIZE X-REG := # OF WORDS TO MOVE MWF MOVE WORDS FROM ALTERNATE MAP * LDA PONTR+1 STA PONTR CCA \ GET ADDRESS ADA #LDEF / OF FIRST POINTER LDX D14 INITIALIZE COUNTER LOOP2 LDB A,I PICK UP POINTER LDB B,I STB PONTR,I STORE POINTER INA INCREMENT SOURCE ADDR ISZ PONTR INCREMENT DEST ADDR DSX DONE? JMP LOOP2 NO--MOVE NEXT POINTER * JSB $LIBX RESTORE SYSTEM DEF GTSAM AND RETURN SPC 3 * * PLACE THE CONTENTS OF A LOCATION IN ALTERNATE MAP * INTO THE A-REGISTER * IXGET NOP ENTRY POINT XLA A,I JMP IXGET,I RETURN SKP * (LYLE WEIMAN'S 11-2-76 VERSION MODIFIED BY DT) * * RETRIEVE DS/1000 EQT CONTENTS * * CALL FROM ALGOL WITH * GTEQT(IBUF[1],EQTN,LU) * * IBUF - BUFFER TO ACCOMODATE 15 WORDS OF EQT + 8 WORD EXTENT * EQTN - I'LL FIND THE FIRST EQT *AFTER* EQTN WHICH IS * DIRECTED TO DVA65 (TYPE 65) AND RETURN THAT * EQT NUMBER IN EQTN - IF NO EQT IS FOUND, I'LL RETURN * ZERO IN 'EQTN' * LU - AN LU POINTING TO THE EQT * EQTBF DEF EBUFR+1 UNL IFN LST EQTN DEF EQNUM EQLU DEF LUNUM * GTEQT NOP LDA 1651B IF REQUEST IS FOR N> NUMBER CMA,INA OF EQT'S IN SYSTEM, ERROR! ADA EQTN,I SSA,RSS JMP DONE1 * LOOP1 LDA EQTN,I GET ADDRESS OF EQT ISZ EQTN,I (POINT TO NEXT ONE...) MPY D15 ADA EQTA h STA EQADR SAVE ADA D4 CHECK TYPE CODE LDA A,I AND EQTYP CPA D65TP FOR DVA65? JMP MOVE YES, GO MOVE IT TO USER AREA LDA EQTN,I NO, WAS IT THE LAST ONE IN CPA 1651B THE SYSTEM? JMP DONE1 YES, ALL DONE! JMP LOOP1 NO, LOOK AGAIN! * * MOVE EQT TO USER BUFFER MOVE LDA EQADR A := SOURCE ADDRESS LDB EQTBF B := DESTINATION JSB $LIBR MAKE SURE EQT ISN'T CHANGED NOP BY HOLDING OFF INTERRUPTS MVW D15 MOVE 15 WORDS FROM EQT * MOVE EQT EXTENSION LDA EQADR GET ADDRESS OF EQT EXTENSION ADA D12 (IT'S IN EQT WORD 13) LDA A,I MVW D8 MOVE 8 WORD EXTENSION JSB $LIBX RESTORE INTERRUPTS DEF *+1 DEF *+1 * * CLA,INA PRESET TO LU=1 STA EQLU,I LDA LUMAX GET DRT TABLE SIZE CMA,INA NEGATE AS COUNTER STA C0UNT LDB DRT GET DRT ADDRESS LOOP4 LDA B,I GET DRT ENTRY AND B77 GET EQT NUMBER CPA EQTN,I = OURS? JMP GTEQT,I YES, WE'RE ALL DONE!, RETURN ISZ EQLU,I NO,INDEX TO NEXT INB ISZ C0UNT JMP LOOP4 KEEP GOING 'TILL RUN OUT... * CLA CAN'T FIND AN LU, SET IT = 0 STA EQLU,I JMP GTEQT,I RETURN TO CALLER * * GET HERE IF RUN OUT OF EQT'S... DONE1 CLA RETURN WITH EQTN=0 STA EQTN,I JMP GTEQT,I RETURN... * C0UNT BSS 1 EQADR BSS 1 EQTYP OCT 37400 D65TP OCT 32400 UNL XIF LST SPC 3 *PROCEDURE BLINE; BLINE NOP * PRINT A BLANK LINE JSB PRINT DEF BLANK D1 DEC 1 JMP BLINE,I SKP *PROCEDURE LFUNS; * BEGIN * * COMMENT * +------------------------------------+ * ! LIST FUNCTIONS PROVIDED BY DSINF ! * +------------------------------------+; * @FUN1 DBL FUN1+1 FUN1 ASC 13, /DSINF: VALID FUNCTIONS-- FUN2 ASC 18, AV AVAILABLE MEMORY SUSPEND LIST FUN3 ASC 9, CL I/O CLASSES FUN5 ASC 11, VA DS/1000 VALUES FUN6 ASC 12, DU DUMP OF SAM BLOCK FUN7 ASC 10, LI DS/1000 LISTS UNL IFN LST FUN9 ASC 14, NR NODAL ROUTING VECTOR UNL XIF LST FUN8 ASC 13, EQ DS/1000 EQT ENTRIES UNL IFN LST FUN8A ASC 15, EQ,N DS/1000 EQT ENTRY # N UNL XIF LST FUN10 ASC 14, /E OR EX TERMINATE DSINF @FN10 DBR FUN10+11 * LFUNS NOP * JSB BLINE * JSB PRINT DEF FUN1 DEC 13 * JSB PRINT DEF FUN2 DEC 18 * JSB PRINT DEF FUN3 DEC 9 * JSB PRINT DEF FUN5 DEC 11 * JSB PRINT DEF FUN6 DEC 12 * JSB PRINT DEF FUN7 DEC 10 * UNL IFN LST JSB PRINT DEF FUN9 DEC 14 * UNL XIF LST JSB PRINT DEF FUN8 DEC 13 * UNL IFN LST JSB PRINT DEF FUN8A DEC 15 * UNL XIF LST JSB PRINT DEF FUN10 DEC 14 * JSB BLINE * END OF LFUNS; JMP LFUNS,I SKP *PROCEDURE AVMEM; * BEGIN * COMMENT * +---------------------------------------+ * ! PRINT AVAILABLE MEMORY SUSPEND LIST ! * +---------------------------------------+; * * HEADINGS: MHED1 ASC 20, AVAILABLE MEMORY SUSPEND LIST IS EMPTY MHED2 ASC 23, PT SZ PRGRM T PRIOR AMT.MEM RN FATHER * B40K OCT 40000 B76K OCT 76000 B77 OCT 77 D3 DEC 3 D6 DEC 6 HYPHN ASC 1,-- "B" ASC 1,B "RN" ASC 1,RN WRD21 BSS 1 ID SEGMENT WORD 21 WRD22 BSS 1 ID SEGMENT WORD 22 FATHR BSS 1 FATHER'S ID SEGMENT WORD 1 MORE BSS 1 MORE FATHERS WAITING? AW1 DEF W1 BAW7 DBL W7 * AVMEM NOP JSB BLINE * IF (LINK := IGET(SUSP3))#0 THEN LDA SUSP3 STA LINK SZA,RSS JMP L383 * BEGIN * & PRINT HEADING JSB PRINT DEF MHED1 D15 DEC 15 * JSB BLINE * JSB PRINT DEF MHED2 DEC 23 * & PRINT A LINE OF HYPHENS * FILL(BUFR,"--"); LDA HYPHN JSB FILL * JSB PRINT DEF BUFR DEC 35 * & PRINT ID INFORMATION FOR EACH PROGRAM IN LIST * DO * BEGIN * & POINT TO NEXT LINK IN "AVAILABLE MEMORY" LIST * FILL(BUFR,BLANK); & CLEAR OUTPUT BUFR L338 LDA BLANK JSB FILL * & MOVE PROGRAM NAME LDA LINK ADA D12 CLE,ELA LDB BAW7 MBT D5 * W10 := KCVT(IGET(LINK+14) AND @17); & TYPE LDA LINK ADA D14 LDA A,I AND B17 JSB KCVT STA W10 * W3 := KCVT(((WRD22:=IGET(LINK+21)) AND @77)+1); & PARTN LDA LINK ADA D21 LDA A,I STA WRD22 AND B77 INA JSB KCVT STA W3 * W5 := KCVT((WRD22 AND @76000)\@2000 + 1); & SIZE LDA WRD22 AND B76K CLB LSR 10 INA JSB KCVT STA W5 * CNUMD(IGET(LINK+6),W11); & PRIORITY LDA LINK ADA D6 LDA A,I JSB CNVTD DEF W11 * IF (WRD21 := IGET(LINK+20))<0 THEN W14:="B "; & BATCH? LDB "B" LDA LINK ޅ ADA D20 LDA A,I STA WRD21 SSA STB W14 * CNUMD(IGET(LINK+1),W15); & AMOUNT OF MEMORY REQUESTED LDA LINK INA LDA A,I JSB CNVTD DEF W15 * IF (WRD21 AND @400)#0 THEN W19:="RN"; & RN? LDB "RN" LDA WRD21 AND B400 SZA STB W19 * & PUT LINE LENGTH IN "I" * I := 20; LDA D20 STA I * & CHECK "FATHER WAITING" BIT * IF (MORE := ((WRD21 AND @40000)#0)) THEN LDA WRD21 AND B40K SZA,RSS JMP L373 CCA STA MORE * BEGIN * & MOVE FATHER NAME(S) * FATHR := IGET(KYWRD + (WRD21 AND @377)); LDA WRD21 AND B377 ADA KYWRD LDA A,I STA FATHR * WHILE MORE DO * BEGIN * & MOVE THE NAME L354 LDA FATHR ADA D12 CLE,ELA LDB AW1 ADB I CLE,ELB MBT D5 * & CHECK FOR GRANDFATHER WAITING * IF (MORE := (IGET(FATHR+20) AND @40000)#0) THEN LDA FATHR ADA D20 LDA A,I AND B40K SZA,RSS JMP L373 CCA STA MORE * BEGIN * I := I + 3; LDA I ADA D3 STA I * FATHR:=IGET(KYWRD+(IGET(FATHR+20) AND @377)); LDA FATHR ADA D20 LDA A,I AND B377 ADA KYWRD LDA A,I STA FATHR * & CHECK FOR FULL OUTPUT BUFFER * IF I > 35 THEN LDA I ADA DM34 SSA JMP L354 * BEGIN & WRITE LINE, THEN CLEAR BUFFER * JSB PRINT š DEF BUFR DEC 38 * FILL(BUFR,BLANK); LDA BLANK JSB FILL * I := 20; LDA D20 STA I * END; * END; * END; JMP L354 * END; * & PRINT OUTPUT BUFFER * PRINT1(I+3); L373 LDA I ADA D3 STA T1 JSB PRINT DEF BUFR T1 DEC 0 * LINK := IGET(LINK); & NEXT ID SEGMENT IN LIST OR 0 LDA LINK,I STA LINK * END * UNTIL LINK=0; SZA JMP L338 * & PRINT LINE OF HYPHENS * FILL(BUFR,"--"); LDA HYPHN JSB FILL * JSB PRINT DEF BUFR DEC 35 * END * ELSE JMP L384 * & NO PROGRAMS IN "AVAILABLE MEMORY" LIST * L383 JSB PRINT DEF MHED1 D20 DEC 20 * BLINE; L384 JSB BLINE * END OF AVMEM; JMP AVMEM,I SKP *PROCEDURE CLASS; * BEGIN * * COMMENT * +-------------------------------+ * ! PRINT I/O CLASS INFORMATION ! * +-------------------------------+; * *INTEGER NBLCK, & NUMBER OF BLOCKS WAITING IN SAM NBLCK BSS 01 * TBLCK; & TOTAL SIZE OF SAM BLOCKS FOR A CLASS TBLCK BSS 01 * * HEADINGS: CHED1 ASC 11, I/O CLASS INFORMATION CHED2 ASC 12, CLASSES IN SYSTEM CHED3 ASC 10, CLASSES IN USE: CHED4 ASC 22, CLASS STATE GET POSSIBLE OWNER CHED5 ASC 12, CLASSES AVAILABLE CHED6 ASC 13,[ BLOCK(S) WORDS] * ACHD6 DEF CHED6 "BU" ASC 1,BU "AL" ASC 1,AL "GT" ASC 1,GT B174C OCT 17400 D4 DEC 4 B17 EQU D15 D32 DEC 32 DM34 DEC -34 DCLAS DEF $CLAS AVLBL BSS 1 NUMBER OF CLASSES AVAILABLE TADDR BSS 1 I/O CLASS OR RN TABLE A\DDRESS TSIZE BSS 1 TABLE SIZE ENTRY BSS 1 TABLE ENTRY NUMBER TWORD BSS 1 CONTENTS OF TABLE ENTRY LINK BSS 1 ID SEGMENT WORD 1 AW9 DEF W9 AW11 DEF W11 * * & GET CLASS I/O TABLE START ADDRESS & NUMBER OF ENTRIES * GETCL(TADDR,TSIZE); CLASS NOP LDA DCLAS GET CLASS TABLE ADDRESS JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF CHED1 DEC 11 * & PRINT NUMBER OF CLASSES * CNUMD(TSIZE,CHED2); LDA TSIZE JSB CNVTD DEF CHED2 * JSB PRINT DEF CHED2 D12 DEC 12 * BLINE; JSB BLINE * & PRINT HEAD FOR CLASSES IN USE * JSB PRINT DEF CHED3 D10 DEC 10 * JSB PRINT DEF CHED4 DEC 22 * & LOOK AT EACH CLASS TO DETERMINE STATE AND POSSIBLE OWNER * AVLBL := 0; CLA STA AVLBL * FOR ENTRY := TADDR+1 TO TADDR+TSIZE DO LDA TADDR INA STA ENTRY LDB TADDR ADB TSIZE STB LASTI L424 CMA,INA ADA LASTI SSA JMP L498 * BEGIN * INTOF; JSB $LIBR NOP * IF (TWORD := IGET(ENTRY))=0 THEN LDA ENTRY,I STA TWORD SZA JMP L434 * BEGIN * INTON; JSB $LIBX DEF *+1 DEF *+1 * AVLBL := AVLBL + 1; & CLASS IS AVAILABLE ISZ AVLBL * END * ELSE JMP L497 * BEGIN * FILL(BUFR,BLANK); L434 LDA BLANK JSB FILL * CNUMD(ENTRY-TADDR,W3); LDA TADDR CMA,INA ADA ENTRY JSB CNVTD Tp DEF W3 * IF TWORD>0 THEN LDA TWORD SZA SSA JMP L456 * BEGIN & STATE 2--BUFFERED REQUESTS * W8 := "BU"; LDA "BU" STA W8 * & FOLLOW LINKS TO BLOCKS OF SAM * NBLCK := TBLCK := 0; CLA STA TBLCK STA NBLCK * WHILE TWORD>0 DO L441 LDA TWORD SZA SSA * BEGIN JMP L447 * NBLCK := NBLCK + 1; ISZ NBLCK * TBLCK := TBLCK + IXGET(TWORD+3); LDA TWORD ADA D3 JSB IXGET ADA TBLCK STA TBLCK * TWORD := IXGET(TWORD); LDA TWORD JSB IXGET STA TWORD * END; JMP L441 * INTON; L447 JSB $LIBX DEF *+1 DEF *+1 * & PRINT INFORMATION * & MOVE # OF BLOCKS AND WORDS HEAD TO OUTPUT BUFFER LDA ACHD6 LDB AW9 MVW D13 * W10 := KCVT(NBLCK); LDA NBLCK JSB KCVT STA W10 * CNUMD(TBLCK,HOLD1); LDA TBLCK JSB CNVTD DEF HOLD1 * MOVE(HOLD2,W16,4); LDA HOLD2 STA W16 LDA HOLD3 STA W17 * JSB PRINT DEF BUFR DEC 22 * FILL(BUFR,BLANK); LDA BLANK JSB FILL * END * ELSE INTON; JMP L457 L456 JSB $LIBX DEF *+1 DEF *+1 * IF (TWORD AND @40000)=0 THEN L457 LDA TWORD AND B40K SZA JMP L461 * W8 := "AL" & ALLOCATED * ELSE LDA "AL" STA W8 JMP L476 * BEGIN * W8 := "GT"; & GET L461 LDA "GT" STA W8 * & SOMEONE MUST BE WAITING ON THIS CLASS'S GET * INTOF; JSB $LIBR NOP * LINK := IGET(SUSP2); & HEAD OF GENERAL WAIT QUEUE LDA SUSP2 STA LINK * WHILE LINK#0 AND IGET(LINK+1)#ENTRY DO L465 LDA LINK SZA,RSS JMP L467 LDA LINK INA LDA A,I CMA,INA ADA ENTRY SZA,RSS * LINK := IGET(LINK); JMP L467 LDA LINK,I STA LINK JMP L465 * INTON; L467 JSB $LIBX DEF *+1 DEF *+1 * IF LINK#0 THEN LDA LINK SZA,RSS JMP L473 * BEGIN & FOUND "GET" PROGRAM * & MOVE NAME TO OUTPUT BUFFER LDA LINK ADA D12 CLE,ELA LDB AW11 CLE,ELB MBT D5 * END * ELSE JMP L476 * & MOVE "" TO BUFFER L473 LDA ANONE LDB AW11 MVW D3 * END; * & PICK UP INDEX INTO KEYWORD TABLE, MODULO 32 * IDNUM := ROTATE(TWORD AND @17400); L476 LDA TWORD AND B174C ALF,ALF * IF IDNUM=0 THEN IDNUM:=32; SZA,RSS LDA D32 STA IDNUM * & FIND POSSIBLE OWNERS * I := 15; & OUTPUT BUFFER POINTER LDA D15 STA I * DONE := FALSE; CLA STA DONE * DO * BEGIN * LINK := IGET(KYWRD+IDNUM); L483 LDA KYWRD ADA IDNUM LDA A,I STA LINK * IF (IGET(LINK+14) AND @20)=0 AND IGET(LINK+12)#0 THEN ADA D14 LDA A,I AND B20 SZA JMP L490 LDA LINK ADA D12 LDA A,I SZA,RSS JMP L490 * BEGIN & GOOD ID SEGMENT * MOVII(LINK+12,AW1+I,5); LDA LINK ADA D12 CLE,ELA LDB AW1 ADB I CLE,ELB MBT D5 * IF (I := I + 4)>34 THEN LDA I ADA D4 STA I ADA DM34 SZA SSA JMP L490 * DONE := TRUE; & OUTPUT BUFFER IS FULL CCA STA DONE * END; * IF (IDNUM:=IDNUM+32)>MAXID THEN L490 LDA IDNUM ADA D32 STA IDNUM CMA,INA ADA MAXID SSA,RSS JMP L493 * DONE := TRUE; & ALL ID SEGMENTS CHECKED CCA STA DONE * END * UNTIL DONE; L493 LDA DONE SSA,RSS JMP L483 * & PRINT LINE OF INFORMATION FOR THIS CLASS LDA I STA T4 JSB PRINT DEF BUFR T4 DEC 0 * END; * END; L497 LDA ENTRY INA STA ENTRY JMP L424 * IF AVLBL=TSIZE THEN L498 LDA TSIZE CMA,INA ADA AVLBL SZA JMP L502 * JSB PRINT DEF NONE DEC 7 * ELSE JMP L507 * BEGIN & PRINT NUMBER OF AVAILABLE CLASSES * BLINE; L502 JSB BLINE * CNUMD(AVLBL,CHED5); LDA AVLBL JSB CNVTD DEF CHED5 * JSB PRINT DEF CHED5 DEC 12 * END; * BLINE; L507 JSB BLINE * END OF CLASS; JMP CLASS,I SPC 3 DONE BSS 1 ALL POSSIBLE CLASS OWNERS FOUND? IDNUM BSS 1 INDEX INTO KEYWORD TABLE NONE ASC 7, SKP *PROCEDURE VALUS; * BEGIN * * COMMENT * +------------------------+ * ! PRINT DS/1000 VALUES ! * +------------------------+; * * HEADINGS: VHED1 ASC 8, DS/1000 VALUES: VHED2 ASC 20, RESOURCE NUMBERS: OWNER LOCKER VHED3 ASC 7,TABLE ACCESS VHED4 ASC 7,QUIESCENT VHED5 ASC 7,QUEZ "LISTEN" VHD12 ASC 12, TIMEOUT VALUES (SEC): VHD13 ASC 13, MASTER T/O VHD14 ASC 13, SLAVE T/O VHD15 ASC 13, REMOTE BUSY WAIT VHD16 ASC 13, REMOTE QUIET WAIT VHED7 ASC 16, RFA FILES MAY BE OPEN VHED9 ASC 11, HP3000 IS ON LU VHD10 ASC 21, LOCAL ID SEQUENCE: VHD11 ASC 21, REMOTE ID SEQUENCE: * B377 OCT 377 UPMSK OCT 177400 MASK2 OCT 177760 D5 DEC 5 D26 DEC 26 AVH10 DBL VHD10+13 AVH11 DBL VHD11+13 DRNTB DEF $RNTB RN BSS 1 FMTAD BSS 1 GLBAL ASC 5, AGLBL DEF GLBAL ANONE DEF NONE+4 AW3 DEF W3 AW13 DEF W13 AW16 DEF W16 AW18 DEF W18 * * PROCEDURE RNOUT(RN,FMTAD); RNOUT BSS 01 * VALUE RN,FMTAD; INTEGER RN,FMTAD; * BEGIN & PRINT RN INFORMATION AND B377 ISOLATE RESOURCE STA RN NUMBER. LDA RNOUT,I STA FMTAD ISZ RNOUT * FILL(BUFR,BLANK); LDA BLANK JSB FILL * & MOVE TITLE LDA FMTAD LDB AW3 MVW D7 * & CONVERT RN NUMBER * W10 := KCVT(RN); LDA RN JSB KCVT STA W10 * & FIND LOCKER * TWORD := IGET(TADDR+RN); LDA TADDR ADA RN LDA A,I STA TWORD * IF (IDNUM := TWORD AND @377)=@377 THEN AND B377 STA IDNUM CPA B377 RSS JMP L548 * & MOVE "" LDA AGLBL LDB AW16 INB MVW D5 * ELSE IF IDNUM=0 THEN JMP L553 L548 LDA IDNUM  SZA JMP L551 * & MOVE "" LDA ANONE LDB AW18 MVW D3 * ELSE JMP L553 * & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 L551 LDA KYWRD ADA IDNUM LDA A,I ADA D12 CLE,ELA LDB AW18 CLE,ELB MBT D5 * & FIND OWNER * IF (IDNUM := ROTATE(TWORD) AND @377)=@377 THEN L553 LDA TWORD ALF,ALF AND B377 STA IDNUM CPA B377 RSS JMP L555 * & MOVE "" LDA AGLBL LDB AW11 INB MVW D5 * ELSE IF IDNUM=0 THEN JMP L560 L555 LDA IDNUM SZA JMP L558 * & MOVE "" LDA ANONE LDB AW13 MVW D3 * ELSE JMP L560 * & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 L558 LDA KYWRD ADA IDNUM LDA A,I ADA D12 CLE,ELA LDB AW13 CLE,ELB MBT D5 * & PRINT INFORMATION L560 JSB PRINT DEF BUFR D21 DEC 21 * END OF RNOUT; JMP RNOUT,I * * & PRINT HEADINGS VALUS NOP * BLINE; JSB BLINE * JSB PRINT DEF VHED1 D8 DEC 8 * BLINE; JSB BLINE * & RESOURCE NUMBERS JSB PRINT DEF VHED2 DEC 20 * GETRN(TADDR,TSIZE); LDA DRNTB GET RN TABLE ADDRESS JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * RNOUT(TBRN,FADDRESS(VHED3)); LDA #TBRN JSB RNOUT DEF VHED3 * RNOUT(QRN,FADDRESS(VHED4)); LDA #QRN JSB RNOUT DEF VHED4 * IF LU3K#0 THEN LDA #LU 3K SZA,RSS JMP L574 * RNOUT(QZRN,FADDRESS(VHED5)); LDA #QZRN JSB RNOUT DEF VHED5 * BLINE; L574 JSB BLINE * & TIMEOUT VALUES JSB PRINT DEF VHD12 DEC 12 * CNUMD(-(MSTO OR @177400)*5,VHD13[10]); LDA #MSTO IOR UPMSK CMA,INA CLB MPY D5 JSB CNVTD DEF VHD13+10 * JSB PRINT DEF VHD13 D13 DEC 13 * CNUMD(-(SVTO OR @177400)*5,VHD14[10]); LDA #SVTO IOR UPMSK CLB MPY D5 CMA,INA JSB CNVTD DEF VHD14+10 * JSB PRINT DEF VHD14 DEC 13 * HOLD1 := KCVT(NOT(ROTATE(BREJ) OR @177760)); LDA #BREJ ALF,ALF IOR MASK2 CMA JSB KCVT STA VHD15+12 * MOVII(AHLD1,FADDRESS(VHD15)+13,2); * JSB PRINT DEF VHD15 DEC 13 * CNUMD(-WAIT,HOLD1); LDA #WAIT CMA,INA JSB CNVTD DEF HOLD1 * MOVIIAHLD2,FADDRESS(VHD16)+12,4); LDA HOLD2 STA VHD16+11 LDA HOLD3 STA VHD16+12 * JSB PRINT DEF VHD16 DEC 13 * BLINE; JSB BLINE * & NUMBER OF FILES WHICH MAY BE OPEN AT ONCE * CNUMD(RFSZ,VHED7[2]); LDA #RFSZ JSB CNVTD DEF VHED7+2 * JSB PRINT DEF VHED7 B20 DEC 16 * & CHECK FOR HP3000 AGAIN * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L611 * BEGIN * BLINE; JSB BLINE * & HP3000 LU * VHED9[10] := KCVT(LU3K); LDA #LU3K JSB KCVT STA VHED9+10 * JSB PRINT DEF VHED9 DEC 11 * & LOCAL ID SEQUENCE LDA Dك$LID LOCAL ID POINTER IN "RES" LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0 JMP L603 INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH10 B := DEST ADDRESS MBT I MOVE CHARACTERS L603 LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L607 * PRINT(VHD10,26+I); ADA D26 CMA,INA STA T3 JSB PRINT DEF VHD10 T3 DEC 0 * & REMOTE ID SEQUENCE L607 LDA D$RID GET REMOTE POINTER IN "RES" INA LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0, JMP L603A INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH11 B := DESTINATION ADDR MBT I MOVE CHARACTERS L603A LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L611 * PRINT(VHD11,26+I); ADA D26 CMA,INA STA T7 JSB PRINT DEF VHD11 T7 DEC 0 * END; * BLINE; L611 JSB BLINE *END OF VALUS; JMP VALUS,I SKP *PROCEDURE DUMP; * BEGIN * * COMMENT * +--------------------------------------+ * ! DUMP CONTENTS OF DS/1000 SAM BLOCK ! * +--------------------------------------+; * * INTEGER BADDR, & DUMP BEGINNING ADDRESS BADDR BSS 01 * EADDR, & DUMP ENDING ADDRESS EADDR BSS 01 * INCR; & ADDRESS INCREMENT INCR BSS 01 * * HEADINGS: DHED1 ASC 9, DUMP OF TCB BLOCK DHED2 ASC 25, LOC OCTAL CONTENTS OF LOC THROUGH LOC+4 DHED3 ASC 20, DUMP OF HP3000 TRANSACTION STATUS TABLE ` DHED4 ASC 25, LOC OCTAL CONTENTS OF LOC THROUGH LOC+7 * D33 DEC 33 DM1 DEC -1 * PROCEDURE DODMP; DODMP BSS 01 * BEGIN * FILL(BUFR,BLANK); LDA BLANK JSB FILL * FOR I := BADDR STEP INCR UNTIL EADDR DO LDA BADDR STA I L637 CMA,INA ADA EADDR LDB INCR SSB CMA,INA SSA JMP L647 * BEGIN * & CONVERT ADDRESS * CNUMO(I,W2); JSB CNUMO DEF *+3 DEF I DEF W2 * FOR J := 0 TO INCR-1 DO CLA STA J CCB ADB INCR STB T1 L641 CMA,INA ADA T1 SSA JMP L645 * & CONVERT CONTENTS * CNUMO(SAM[I+J-FWAM],BUFR[7+4*J]); LDA I ADA J CMA ADA #FWAM CMA CAX LAX SAM STA T2 LDA J RAL,RAL ADA D6 ADA AW1 STA T4 JSB CNUMO DEF *+3 DEF T2 DEF T4,I LDA J INA STA J JMP L641 * & PRINT L645 JSB PRINT DEF BUFR LEN1 NOP * END; LDA I ADA INCR STA I JMP L637 * BLINE; L647 JSB BLINE * END OF DODMP; JMP DODMP,I * * & GET DS/1000 SAM BLOCK DUMP NOP * GTSAM(SAM[0],SSIZE,PNTR[-3]); JSB GTSAM * SAMIN := TRUE; CCA STA SAMIN * BLINE; JSB BLINE * & DUMP TCB AREA IN SAM JSB PRINT DEF DHED1 D9 DEC 9 * JSB PRINT DEF DHED2 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := FWAM; LDA #FWAM STA BADDR [* EADDR := (IF TST#0 THEN TST ELSE NRV) - 1; LDA #TST SZA,RSS LDA #NRV ADA DM1 STA EADDR * INCR := 5; LDA D5 STA INCR LDA D25 SET LEN1 STA LEN1 TO 25. * DODMP; JSB DODMP * & HP3000 CONNECTED? * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L674 * BEGIN * & DUMP TST AREA IN SAM * JSB PRINT DEF DHED3 DEC 20 * JSB PRINT DEF DHED4 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := TST; LDA #TST STA BADDR * EADDR := FWAM + SSIZE - 1; CCA ADA #FWAM ADA SSIZE STA EADDR * INCR := 7; LDA D7 STA INCR LDA D33 SET LEN1 STA LEN1 TO 33. * DODMP; JSB DODMP * END; * END OF DUMP; L674 JMP DUMP,I SKP *PROCEDURE LISTS; * BEGIN * * COMMENT * +----------------------------------+ * ! PRINT DS/1000 LIST INFORMATION ! * +----------------------------------+; * * INTEGER COUNT, & # OF ENTRIES IN A LIST COUNT BSS 01 * STCB, & # OF SLAVE TCB ENTRIES STCB BSS 01 * HEAD, & LIST HEAD HEAD BSS 01 * NEXT; & NEXT LIST ELEMENT NEXT BSS 01 * * HEADINGS: LHED1 ASC 7, DS/1000 LISTS LHED2 ASC 20, ENTRIES IN MASTER REQUEST LIST, ASC 9, STARTING AT LHED3 ASC 24, ACTIVE SLAVE MONITORS: 1ST TCB LHED4 ASC 24, STREAM CLASS MONITOR ENTRIES LOCATION LHED5 ASC 24, ENTRIES IN NULL LIST, STARTING AT LHED7 ASC 20, ENTRIES IN HP3000 PROCESS LIST, ASC 9, STARTING AT LHED8 ASC 16, ENTRIES IN SLAVE LISTS NOT15 OCT 777F77 D2 DEC 2 D19 DEC 19 D39 DEC 39 * * PROCEDURE CHASE; CHASE BSS 01 * BEGIN * COMMENT CHASE A LIST TO ITS END; * COUNT := 0; CLA STA COUNT * WHILE NEXT#0 DO L705 LDA NEXT SZA,RSS * BEGIN JMP L710 * NEXT := SAM[NEXT-FWAM]; LDA #FWAM CMA,INA ADA NEXT CAX LAX SAM STA NEXT * COUNT := COUNT + 1; ISZ COUNT * END; JMP L705 * END; L710 LDA COUNT PUT COUNT IN A-REG. JMP CHASE,I RETURN. * * LISTS NOP * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF LHED1 D7 DEC 7 * BLINE; JSB BLINE * & DO WE NEED TO GET SAM AND POINTERS? * IF NOT SAMIN THEN LDA SAMIN SSA JMP L721 * GTSAM(SAM[0],SSIZE,PNTR[-3]); JSB GTSAM * & CHECK OUT MASTER REQUEST LIST * HEAD := NEXT := PNTR[-1]; L721 LDA PNTR-1 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED2[1]); JSB CNVTD DEF LHED2+1 * CNUMO(HEAD,LHED2[26]); JSB CNUMO DEF *+3 DEF HEAD DEF LHED2+26 * PRINT(LHED2,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T2 JSB PRINT DEF LHED2 T2 DEC 0 * BLINE; JSB BLINE * & CHECK SLAVE STREAMS JSB PRINT DEF LHED3 DEC 24 JSB PRINT DEF LHED4 DEC 24 * STCB := 0; CLA STA STCB * FOR I := 0 TO LSTRM DO CLA STA I L733 CMA,INA ADA NOSTR SSA JMP L753 * BEGIN * HEAD := IGET(xLDEF+2+I); LDA #LDEF ADA D2 ADA I LDA A,I STA HEAD * NEXT := PNTR[I]; LDX I LAX PNTR STA NEXT * FILL(BUFR,BLANK); LDA BLANK JSB FILL * & GET MONITOR NAME FROM ID SEGMENT LDA HEAD ADA D2 LDA A,I * (CHECK FOR INACTIVE MONITOR:) SZA,RSS JMP L751A AND NOT15 ADA D12 CLE,ELA LDB AW11 INB CLE,ELB MBT D5 * W5 := KCVT(I); & STREAM NUMBER LDA I JSB KCVT STA W5 * W9 := KCVT(IGET(HEAD+1) AND @377); & CLASS NUMBER LDA HEAD INA LDA A,I AND B377 JSB KCVT STA W9 * IF NEXT>0 THEN LDA NEXT SZA SSA JMP L751 * BEGIN * & WE HAVE AN ACTIVE STREAM * CNUMO(NEXT,W21); & STARTING LOCATION JSB CNUMO DEF *+3 DEF NEXT DEF W21 * CHASE; JSB CHASE * CNUMD(COUNT,W16); & NUMBER OF ENTRIES JSB CNVTD DEF W16 * JSB PRINT DEF BUFR DEC 23 * STCB := STCB + COUNT; LDA STCB ADA COUNT STA STCB JMP L751A * END; * EMPTY SLAVE LIST-- W18:="0" L751 LDA "0" STA W18 JSB PRINT DEF BUFR DEC 18 *** * END; L751A LDA I INA STA I JMP L733 * & TOTAL NUMBER OF SLAVE TCB'S * CNUMD(STCB,LHED8[1]); L753 LDA STCB JSB CNVTD DEF LHED8+1 * JSB PRINT DEF LHED8 DEC 16 * BLINE; JSB BLINE * & NULL LIST * HEAD := NEXT := PNTR[-2]X; LDA PNTR-2 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED5[1]); JSB CNVTD DEF LHED5+1 * CNUMO(HEAD,LHED5[21]); JSB CNUMO DEF *+3 DEF HEAD DEF LHED5+21 * PRINT(LHED5,29+19*SIGN(HEAD)); LDB D29 LDA HEAD SZA ADB D19 CMB,INB STB T5 JSB PRINT DEF LHED5 T5 DEC 0 * & CHECK FOR HP3000 * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L787 * BEGIN * & PROCESS NUMBER LIST * HEAD := NEXT := PNTR[-3]; LDA PNTR-3 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED7[1]); JSB CNVTD DEF LHED7+1 * CNUMO(HEAD,LHED7[26]); JSB CNUMO DEF *+3 DEF HEAD DEF LHED7+26 * PRINT(LHED7,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T6 JSB PRINT DEF LHED7 T6 DEC 0 * END; * BLINE; L787 JSB BLINE * END OF LISTS; JMP LISTS,I SKP *PROCEDURE EQTS; EQTS NOP * * COMMENT * +--------------------------------------+ * ! PRINT CONTENTS OF ALL DS/1000 EQTS ! * +--------------------------------------+; * JSB BLINE UNL IFN LST *IF GRPM#0 THEN LDA #GRPM SZA JMP L857 UNL XIF LST * BEGIN JMP L903 * BEGIN * * INTEGER EQNUM, & EQT NUMBER EQNUM BSS 01 * LUNUM, & LU CONECTED TO EQT LUNUM BSS 01 * FPNTR, & FORMAT ADDRESS POINTER FPNTR BSS 01 * * INTEGER ARRAY EBUFR[1:22]; & HOLDS EQT WORDS EBUFR EQU *-1 BSS 23 * AEQ1 *DEF EQ1 AEHD4 DEF EHED4+1 DM22 DEC -22 DM6 DEC -6 "0" ASC 1, 0 "1" ASC 1, 1 EHED2 ASC 11, DVA65 EQT INFORMATION EHED3 ASC 12, EQT # , LU # : EHED4 ASC 18, WORD VALUE MEANING ASC 11, WORD VALUE MEANING EHED5 ASC 25, *BIT BREAKDOWN 15 12 9 6 3 0 EHED6 ASC 11, DVG67 EQT INFORMATION * * & EQT WORDS DESCRIPTIONS--20 CHARACTERS EACH EQ1 ASC 10,I/O LIST ADDRESS ASC 10,INITIATION ADDRESS ASC 10,CONTINUATION ADDR ASC 10,STATUS/UNIT/SUBCHNL* ASC 10,AV/TYPE/STATUS* ASC 10,CONWD UNL IFN LST ASC 10,DATA BUFFER ADDRESS ASC 10,DATA BUFFER LENGTH ASC 10,REQUEST BUFFER ADDR ASC 10,REQUEST BUFFER LEN ASC 10,COROUTINE ADDRESS ASC 10,CURRENT STATUS* ASC 10,EQT EXTENSION ADDR ASC 10,NOMINAL TIMEOUT ASC 10,MICROCODE TIMEOUT ASC 10,DATA TRANSFER COUNT ASC 10,LAST WORD RECEIVED ASC 10,VPW/REPLY REQ LENGTH ASC 10,DPW/REPLY DATA LEN ASC 10,TOTAL BLOCK TRANSFERS ASC 10,TOTAL # RETRIES ASC 10,NEW REQ ID SEQ ADDR UNL XIF LST * AW20 DEF W20 COL1 BSS 1 COL3 BSS 1 LASTI BSS 1 LASTJ BSS 1 * * PROCEDURE EQMOV(COL1,COL2,COL3); * INTEGER COL1,COL2,COL3; * BEGIN & MOVE EQT INFO TO OUTPUT BUFFER EQMOV NOP STA COL1 ADA D2 STA COL2 ADA D4 STA COL3 * COL1 := KCVT(I); & EQT WORD NUMBER LDA I JSB KCVT STA COL1,I * CNUMO(EBUFR[I],COL2); & CONTENTS LDX I LAX EBUFR STA T5 JSB CNUMO DEF *+3 DEF T5 COL2 DEF *-* * & MOVE MEANING LDA FPNTR LDB COL3 MVW DgK10 * I := I + 1; ISZ I * POINT TO NEXT MEANING LDA FPNTR ADA D10 STA FPNTR * END OF EQMOV; JMP EQMOV,I SPC 1 * THIS ALGOL BLOCK WAS MODIFIED INTO A SUBROUTINE TO PRINT * EQT INFORMATION. EQOUT NOP * BEGIN * & PRINT HEADER FOR EQT INFORMATION * BLINE; JSB BLINE * CNUMD(EQNUM,HOLD1); LDA EQNUM JSB CNVTD DEF HOLD1 * MOVII(AHLD2,FADDRESS(EHED3)+5,4); LDA HOLD2 STA EHED3+4 LDA HOLD3 STA EHED3+5 * EHED3[10] := KCVT(LUNUM); LDA LUNUM JSB KCVT STA EHED3+10 * JSB PRINT DEF EHED3 DEC 12 * JSB PRINT DEF EHED4 D29 DEC 29 * & PRINT CONTENTS OF EQT AND EXTENT * FILL(BUFR,BLANK); LDA BLANK JSB FILL * FPNTR := FADDRESS(EQ1)+1; LDA AEQ1 STA FPNTR * I := 1; CLA,INA STA I * WHILE I NODE NUMBER (OR "NONE"), DEF APMSG WITHOUT A HEADER. DEC 16 JSB BLINE JMP DSNRV,I PROCESS COMPLETE--CHECK FOR NEW REQUEST. SPC 2 NODM1 ASC 10, NRV SPECIFICATIONS: NODM2 ASC 7, LOCAL NODE#: LOCLN ASC 3, ASC 8,, NO. OF NODES= NNODS ASC 3, * NRVMS EQU * SEQN ASC 3, ASC 4,: NODE= NODEN ASC 3, ASC 3,, LU= VECTR ASC 3, ASC 3,, TO= NRVTO ASC 3, ASC 3,(SEC.) * APMSG ASC 13, LAST LOAD-NODE= APNOD ASC 3,NONE * BT137 OCT 37700 DM256 DEC -256 * NCNT NOP NUMBER OF NODES NONDT NOP NODE COUNTER NPNT NOP SKP UNL XIF LST *PROCEDURE XEQFN; * "AV" ASC 1,AV "CL" ASC 1,CL "VA" ASC 1,VA "DU" ASC 1,DU "LI" ASC 1,LI "NR" ASC 1,NR "EQ" ASC 1,EQ "/E" ASC 1,/E "EX" ASC 1,EX FNCTN ASC 3, FUNCTION TO BE PERFORMED * XEQFN BSS 01 * BEGIN * * COMMENT * +----------------------+ * ! EXECUTE A FUNCTION ! * +----------------------+; * * IF PRMPT THEN LDA PRMPT SSA,RSS JMP L928 * BEGIN & PROMPT FOR COMMAND UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF -vLST DEF D2 DEF INLU DEF BLANK DEF D1 * & PRINT THE PROMPT UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF LST DEF D2 DEF INLU DEF PROMP DEF D9 * END; * * CLEAR WORDS 2 & 3 OF FNCTN LDA BLANK STA FNCTN+1 STA FNCTN+2 * READ COMMAND FROM INPUT LU UNL IFN LST L928 JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST L928 JSB EXEC DEF *+5 UNL XIF LST DEF SD1 SET NO-ABORT BIT. DEF INLU DEF FNCTN DEF D3 JMP EX ERROR: TREAT AS "/E". * * EXECUTE COMMAND * IF FNCTN="AV" THEN AVMEM LDA FNCTN CPA "AV" RSS JMP *+3 JSB AVMEM JMP L939 * ELSE IF FNCTN="CL" THEN CLASS CPA "CL" RSS JMP *+3 JSB CLASS JMP L939 * ELSE IF FNCTN="VA" THEN VALUS CPA "VA" RSS JMP *+3 JSB VALUS JMP L939 * ELSE IF FNCTN="DU" THEN DUMP CPA "DU" RSS JMP *+3 JSB DUMP JMP L939 * ELSE IF FNCTN="LI" THEN LISTS CPA "LI" RSS JMP *+3 JSB LISTS JMP L939 UNL IFN LST * CHECK FOR "NR": CPA "NR" RSS JMP *+3 JSB DSNRV JMP L939 UNL XIF LST * ELSE IF FNCTN="EQ" THEN EQTS CPA "EQ" RSS JMP *+3 JSB EQTS <* JMP L939 * ELSE IF FNCTN="/E" OR FNCTN="EX" THEN MOREC:=FALSE CPA "/E" JMP EX CPA "EX" RSS JMP BADF EX CLA STA MOREC JMP L939 * ELSE LFUNS; BADF JSB LFUNS * END OF XEQFN; L939 JMP XEQFN,I SPC 6 B206 OCT 206 B400 OCT 400 B401 OCT 401 DM640 DEC -640 DM11 DEC -11 D16 DEC 16 D64 DEC 64 D640 DEC 640 SD1 DEF 1,I @EXCW DBL EXECW EXECW ASC 3,EXECW @NAME NOP PROMP ASC 9,/DSINF: FUNCTION?_ RUNL ASC 13, /DSINF: RUN LSTEN FIRST! FINIS ASC 11, *** END OF DSINF *** @RUNL DBL RUNL+1 @PRMP DBR PROMP @FINS DBL FINIS+6 SUB BSS 1 INPUT LU'S SUBCHANNEL DVR BSS 1 INPUT LU'S DRIVER TYPE MOREC BSS 1 MORE COMMANDS TO READ? PRMPT BSS 1 PROMPT FOR COMMANDS? SKP *+-----------------------------+ *! BEGINNING OF MAIN PROGRAM ! *+-----------------------------+; SPC 1 * PICK UP RUN-TIME PARAMETERS *RMPAR(INLU); DSINF JSB RMPAR DEF *+2 DEF INLU *& SET FLAGS *PRMPT := SAMIN := FALSE; CLA STA SAMIN STA PRMPT * UNL IFN LST * DETERMINE THE NODE NUMBER: LDA NODE IF NODE SZA NOT 0, JMP OK USE IT. LDB FLAG CHECK SZB NODE 0 JMP OK FLAG. * WE HAVE BEEN SCHEDULED WITH BOTH FLAG AND NODE SET TO 0. * IF OUR FATHER IS "EXECW", USE #CNOD AS THE NODE NUMBER. LDB XEQT GET ADB D20 FATHER'S LDA B,I ID SEGMENT AND B377 NUMBER. SZA,RSS IF ZERO, JMP LOCAL WE ARE LOCAL. ADA DM1 ADA KEYWD GET ADDR OF FATHER'S LDB A,I ID SEGMENT. #| ADB D12 WHAT'S CLE,ELB HIS NAME? LDA @EXCW EXECW? CBT D5 JMP NTLOC YES--NOT LOCAL NOP LOCAL CCA NODE:=-1 RSS NTLOC LDA #CNOD NODE:=#CNOD STA NODE OK EQU * UNL XIF LST SPC 1 * GET TRUE PROGRAM NAME (USUALLY WILL BE DSINF). LDA XEQT GET ID SEG ADDR. ADA D12 CLE,ELA STA @NAME MOVE FOR LDB @RUNL "RUN LSTEN" MESSAGE. MBT D5 LDA @NAME MOVE FOR LDB @FINS FINAL MESSAGE. MBT D5 LDA @NAME MOVE FOR LDB @PRMP PROMPT. MBT D5 * *IF INLU<1 OR INLU>IGET(LUMAX) THEN CCA ADA INLU SSA JMP L963 LDA LUMAX CMA ADA INLU SSA JMP L968 * BEGIN * INLU := @401; & DEFAULT INPUT LU IS SYS CONSOLE L963 LDA B401 STA INLU * PRMPT := TRUE; & INTERACTIVE DEVICE CCA STA PRMPT * END * ELSE JMP L977 * BEGIN & GET LU INFORMATION UNL IFN LST * DEXEC(NODE,13,INLU,DVR,T7,SUB); L968 JSB DEXEC DEF *+7 DEF NODE UNL XIF LST UNL IFZ LST * EXEC(13,INLU,DVR,T7,SUB); L968 JSB EXEC DEF *+6 UNL XIF LST DEF D13 DEF INLU DEF DVR DEF T7 DEF SUB * SUB := SUB AND @17; LDA SUB AND B17 STA SUB * DVR := ROTATE DVR AND @77; LDA DVR ALF,ALF AND B77 STA DVR * PRMPT := (DVR=00) OR (DVR=07 OR DVR=05 AND SUB=0); CCB SZA,RSS JMP TRU CPA D7 JMu$P SUBCK CPA D5 JMP SUBCK JMP FLS SUBCK LDA SUB SZA FLS CMB TRU STB PRMPT * IF PRMPT THEN SSB,RSS JMP L977 * INLU:=INLU OR @400; & SET "K" BIT FOR INTERACTIVE INPUT LDA INLU IOR B400 STA INLU * END; * CHECK OUTPUT LU DEVICE *IF OUTLU<1 OR OUTLU>IGET(LUMAX) THEN L977 CCA ADA OUTLU SSA JMP L978 LDA LUMAX CMA ADA OUTLU SSA JMP L984 * OUTLU := IF PRMPT THEN INLU ELSE @206; L978 LDB INLU LDA PRMPT SSA,RSS LDB B206 STB OUTLU * * FIND # OF PROGRAM ID SEGMENTS IN SYSTEM *KYWRD := IGET(KEYWD) - 1; L984 CCA ADA KEYWD STA KYWRD *I := 1; CLA,INA STA I *WHILE IGET(KYWRD+I)#0 DO L986 LDA KYWRD ADA I LDA A,I SZA,RSS * I := I + 1; JMP L988 LDA I INA STA I JMP L986 *MAXID := I - 1; L988 CCA ADA I STA MAXID * *SSIZE := (IF TST#0 THEN (TST+14*TSTSZ) ELSE NRV) - FWAM; LDA #TST SZA,RSS JMP L995 LDA D14 CLB MPY #TST+1 ADA #TST RSS L995 LDA #NRV CMA ADA #FWAM CMA STA SSIZE *IF SSIZE>640 THEN ADA DM640 SZA SSA JMP L1001 * & DON'T OVERRUN SAM ARRAY * SSIZE := 640; LDA D640 STA SSIZE * * CHECK TO SEE IF LSTEN HAS BEEN RUN *IF FWAM=0 THEN L1001 LDA #FWAM SZA JMP L1007 * JSB PRINT DEF RUNL DEC 13 * ELSE JMP L1037 * * * CHECK FOR NON-INTERACTIVE RUN *IF CONWD # 0 THEN L1007 LDA CONWD &# SZA,RSS JMP L1033 * BEGIN * INTEGER TMSC,SEC,MIN,HOUR; JMP L1014 TMSC BSS 01 SEC BSS 01 MIN BSS 01 HOUR BSS 01 BSS 1 TIME ASC 9, TIME--- : : * PRMPT := FALSE; L1014 CLA STA PRMPT * EXEC(11,TMSC); JSB EXEC DEF *+3 DEF D11 DEF TMSC * TIME[8] := KCVT(SEC); LDA SEC JSB KCVT STA TIME+8 * TIME[6] := KCVT(MIN); LDA MIN JSB KCVT STA TIME+6 * TIME[4] := KCVT(HOUR); LDA HOUR JSB KCVT STA TIME+4 JSB BLINE * JSB PRINT DEF TIME DEC 9 UNL IFN LST * PRINT LOCAL NODE NUMBER LDA #NODE JSB CNVTD DEF LOCLN JSB PRINT DEF NODM2 DEC 10 UNL XIF LST * BLINE; JSB BLINE * IF (CONWD AND 1)#0 THEN AVMEM; LDA CONWD AND D1 SZA JSB AVMEM * IF (CONWD AND 2)#0 THEN CLASS; LDA CONWD AND D2 SZA JSB CLASS * IF (CONWD AND 4)#0 THEN VALUS; LDA CONWD AND D4 SZA JSB VALUS * IF (CONWD AND 8)#0 THEN DUMP; LDA CONWD AND D8 SZA JSB DUMP * IF (CONWD AND 16)#0 THEN LISTS; LDA CONWD AND D16 SZA JSB LISTS UNL IFN LST * IF (CONWD AND 32)#0 THEN DSNRV; LDA CONWD AND D32 SZA JSB DSNRV UNL XIF LST * IF (CONWD AND 64)#0 THEN EQTS; LDA CONWD AND D64 SZA JSB EQTS * END * *ELSE JMP L1037 * SET PROGRAM NAME IN FUN1 AND FUN10 L1033 LDA @NAME ;2 LDB @FUN1 MBT D5 * MOREC := TRUE; CCA STA MOREC LDA @NAME LDB @FN10 MBT D5 * WHILE MOREC DO L1034 LDA MOREC SSA,RSS * XEQFN; JMP L1037 JSB XEQFN JMP L1034 * L1037 JSB PRINT DEF FINIS DEC 11 * * DSINF REUSES PARAMETERS IF IN TIME LIST * EXEC(6,0,0,INLU,OUTLU,CONWD); JSB EXEC DEF *+9 DEF D6 DEF D0 DEF D0 DEF INLU DEF OUTLU DEF CONWD DEF NODE DEF FLAG D0 DEC 0 *END$ END DSINF  ]( 24999-18218 2024 S 0100 &TDMP SOURCE             H0101 ASMB,A,L,C HED TDMP - STANDALONE DUMP TO TAPE ORG 2 RUN PROGRAM JMP 3,I BY SETTING P REG DEF TDMP TO 2 * * ORG 77377B * * !TDMP IS A STANDALONE PROGRAM THAT DUMPS A CRASHED * SYSTEM TO MAG TAPE. * * THE PROGRAM DUMPS 48K OF MEMORY AND THE 4 SYSTEM MAPS, FOLLOWED * BY THE CONTENTS OF THE SYSTEM AND USER ADDRESS SPACES. NOTE * THAT THE DUMP ORDER IS: THE FIRST 32K, THE MAPS, THE NEXT 16K, * AND THE PAGES OF THE SYSTEM AND USER ADDRESS SPACES THAT ARE NOT * IN THE FIRST 48K. * * A HALT 41 INDICATES TAPE NOT READY. (NOT AT LOAD POINT) * A HALT 42 INDICATES A NONRECOVERABLE WRITE ERROR. * A HALT 43 INDICATES UNABLE TO WRITE END OF FILE. * BY HITTING RUN YOU CAN TRY AGAIN. * A HALT 77 INDICATES A NORMAL COMPLETION. * * TO RUN -- SET THE P REGISTER TO 2 AND THE S REGISTER TO * THE SELECT CODE OF THE MAG TAPE. * * THIS PROGRAM IS PART OF THE CRASH DUMP ANALYSIS PACKAGE * * 24999- REV 1902 * * TEF 12/23/78 * JEF 01/16/80 CHANGED TO DUMP ANOTHER 16K, SYSTEM AND USER * ADDRESS SPACES, AND "DEAD SPOT" - SEE END OF FILE * * A EQU 0 B EQU 1 S EQU 1 * * * * * SELECT CODE OF M.T. INITIALIZATION * TDMP LIA S GET THE LOWER M.T. SELECT CODE STA DC SET THE DATA CHANNEL INA STA CC SET THE COMMAND CHANNEL * * SET-UP I/O INSTRUCTIONS FOR M.T. * LDA OTA.1 IOR CC STA OTA.1 STA OTA.2 STA OTA.4 STA OTA.5 STA OTA.6 LDA STC.2 IOR DC STA STC.2 INA STA STC.4 STA STC.5 STA STC.6 LDA LIA.1 IOR CC STA LIA.1 STA LIA.2 STA LIA.4 * * INITIALIZE THE M.T. INTERFACE * MEM1 LDA CLR CLEAR THE INTERFACE OTA.1 OTA 00 LDA SLECT UNIT SELECT OTA.2 OTA j00 * * CHECK THE M.T. INITIAL STAT * LIA.2 LIA 00 AND ALL7 MASK OFF THE DENSITY BIT CPA BIT6 ONLY THE LOAD POINT BIT SHOULD BE SET JMP READY HLT 41B JMP LIA.2 ***** * * MAIN ROUTINE * ***** READY RSA SAVE STA MSTAT MEMORY STATUS REGISTER * * DUMP THE FIRST 32K OF PHYSICAL MEMORY (MAPPING OFF) * CLB STARTING ADDR STB DPAD OF DUMP PH1 JSB WRIT WRITE 128 WORDS LDB DPAD INCR ADB B200 DUMP ADDRESS STB DPAD SSB,RSS ARE WE DONE? JMP PH1 NO - DO ANOTHER RECORD * * WRITE THE MAPS TO THE TAPE * JSB MAPS * * TURN THE MAPS ON * LDA D32 CAX LOAD 32 MAP REGISTERS CLA STARTING WITH MR 0 CLB AND VALUES FROM 0 XMS DO IT SJP CONT TURN ON MAPS * * SINCE WE CAN'T DETERMINE WHERE THE DRIVER PARTITIONS * END, WE ALWAYS DUMP 48K * HERE, WE DUMP THE LATTER 16K (MAPS ON) * CONT LDB D32 SET STB CPAGE CURRENT PAGE NUMBER * * WRITE PAGES TO TAPE * PH2 JSB POUT PUT OUT PAGE ISZ CPAGE BUMP PAGE # LDB CPAGE CPB DLIM LAST PAGE? RSS JMP PH2 NO - DO MORE * * DUMP THE CONTENTS OF THE SYSTEM AND USER MAPS * DO NOT DUMP PAGES THAT ALREADY HAVE BEEN DUMPED * I.E., PAGES IN THE FIRST 48K OF PHYS MEMORY * LDA B2000 INIT STA MADDR LOOP WL LDA MADDR,I GET PAGE # AND B1777 MASK OUT READ/WRITE PROTECT STA TMP HOLD CMA,INA CHECK ADA DLIM IF PAGE HAS TO CMA,SSA,INA,SZA BE DUMPED JMP NEXT NO - PAGE WAS ALREADY DUMPED LDB TMP YES - WRITE JSB POUT PAGE NEXT ISZ MADDR BUMP PAGE LDA MADDR NUMBER CPA B2100 ARE WE ALL DONE? RSS JMP WL NO - CONTINUE * * NOW WRITE AN END OF FILE * LDA WEOF WRITE AN EOF ON M.T. OTA.4 OTA 00 STC.4 STC 00,C LIA.4 LIA 00 AND ALL7 CPA O4200 EOF + ODD # OF BYTES XFERRED JMP MEM5 JSB CKSTA JMP LIA.4 HLT 43B JMP LIA.4 MEM5 LDA REWOF REWIND TO OFF-LINE OTA.5 OTA 00 STC.5 STC 00,C HLT 77B SUCCESSFUL COMPLETION * * MAPS WRITES THE FOUR MAPS TO THE TAPE * MAPS NOP LDA BADDR SAVE SYA USA MAPS PAA PBA LDB D1 WRITE JSB MSET -SET MAP- LDB B2000 MAPS JSB WRIT JMP MAPS,I RETURN * * POUT WRITES A PAGE OF MEMORY TO THE TAPE * THE B REGISTER HAS THE PAGE NUMBER * POUT NOP JSB MSET SET MAP LDB B4000 INIT STB DPAD ADDR PCONT JSB WRIT WRITE 128 WORDS LDB DPAD INCR DUMP ADDR ADB B200 BY 128 STB DPAD CPB B6000 DONE? JMP POUT,I YES - RETURN JMP PCONT NO - DO MORE * * MSET SETS THE MAP REGISTER SPECIFIED BY WPAG * TO THE PAGE SPECIFIED BY THE B REGISTER * MSET NOP LDA D1 MAP CAX THE PAGE SPECIFIED LDA WPAG TO WPAG XMS JMP MSET,I RETURN * * SET UP DMA WITH THE 3 CONTROL WORDS : * * CW1 --- M.T. SELECT CODE * CW2 --- STARTING ADDRESS * CW3 --- NO. OF WORDS TO BE TRANSFERRED * * WRIT WRITES 128 BYTES FROM THE ADDRESS SPECIFIED * BY THE B REGISTER (MAPPING MUST ALREADY BE DONE) * WRIT NOP LDA DC IOR BIT13 CLEAR CONTROL AT END OF XFER OTA 6 OUTPUT CW1 TO DCPC CHANNEL 1 CLC 2 OTB 2 OUTPUT CW2 STC 2 LDA M128 ALWAYS DO 128 WORDS  OTA 2 OUTPUT CW3 * * INITIATE M.T. & DMA * LDA WREC WRITE 1 RECORD COMMAND OTA.6 OTA 00 STC.6 STC 00,C STC.2 STC 00,C STC 6,C INITIATE DMA * * WAIT FOR COMPLETION OF DMA TO M.T. * SFS 6 JMP *-1 * * DMA TO M.T. COMPLETED , CHECK FOR STAT FROM M.T. * LIA.1 LIA 00 GET STAT FROM COMMAND CHANNEL AND ALL7 MASK OFF DENSITY BIT SZA,RSS JMP WRIT,I NO ERROR , EXIT JSB CKSTA CHECK STAT OF M.T. JMP LIA.1 LDA STAT HLT 42B UNRECOVERABLE WRITE ERROR JMP MEM1 START FROM BEGINNING * * SUBROUTINE TO CHECK THE STAT OF M.T. * CKSTA NOP STA STAT SAVE STAT AND BIT8 CHECK FOR CONTROLLER BUSY FLAG SZA JMP CKSTA,I LDA STAT AND BIT3 CHECK FOR REJECT FLAG SZA JMP CKSTA,I LDA STAT AND BIT9 CHECK FOR TRANSPORT BUSY FLAG SZA JMP CKSTA,I ISZ CKSTA JMP CKSTA,I * * MAG TAPE COMMANDS FOR OUTPUT * CLR OCT 110 SLECT OCT 1400 WREC OCT 31 WEOF OCT 211 REWOF OCT 105 * BIT3 OCT 10 BIT6 OCT 100 BIT8 OCT 400 BIT9 OCT 1000 O4200 OCT 4200 BIT13 OCT 20000 ALL7 OCT 77777 * CC OCT 0 DC OCT 0 STAT OCT 0 M128 DEC -128 DLIM DEF 48 NUMBER OF PHYSICAL PAGES TO DUMP CPAGE DEF *-* PAGE BEING DUMPED B2000 OCT 2000 TMP DEF *-* B1777 OCT 1777 MADDR DEF *-* ADDRESS WITHIN MAP TABLE B2100 OCT 2100 ADDRESS OF 65TH PAGE IN MAP TABLE D1 DEC 1 D32 DEC 32 BADDR OCT 102000 FOR DUMPING MAPS TO 2000 B4000 OCT 4000 B200 OCT 200 B6000 OCT 6000 DPAD DEF *-* ADDRESS OF NEXT RECORD TO WRITE WPAG DEF 66 MAP REGISTER # TO USE FOR I/O * * THE NEXT FOUR WORDS CONTAIN THE MEMORY STATUS REGISTER * AND THE ADDRESSES OF THE "DEAD SPOT" * THEY ARE ASSUMED TO BE AT 077674-077677 ABSOLUTE * MSTAT DEF *-* MEMORY STATUS REG IMAGE DEF TDMP FIRST LOCATION IN PROGRAM =>DEAD DEF 77777B LAST LOCATION IN MEMORY =>SPOT DEF 4666 MAGIC NUMBER * END END$ g ^ h 24999-18222 2024 S 0100 &MAPIO SOURCE             H0101 FTN4,L C PROGRAM MAPIO(3,85),24999-16222 REV.2024 800517 C C ******************************************** C * * C * RTE-IV SYSTEM I/O CONFIGURATION LISTOR * C * * C * RELOC.: 24999-16222 * C * SOURCE: 24999-18222 * C ******************************************** C C C RUNNING INSTRUCTIONS REQUIREMENTS C --------------------------------- C C RU,MAPIO[,LIST],[START LU#],[END LU#],[FILTER1],[FILTER2] C C LIST = LIST OUTPUT DEVICE LU, DEFAULT=LU 1 C C START LU# = START REPORTING THIS LU #, DEFAULT=1 C (NOTE: IF THIS LU IS SPECIFIED AND 'END LU#' C IS NOT SPECIFIED. ONLY 'START LU#' C WILL BE GIVEN.) C ALSO: IF START LU# = 'SC' A LIST BY SELECT C CODE WILL BE GIVEN. C C END LU# = STOP REPORTING AFTER THIS LU #, DEFAULT=ALL LU'S C C FILTER1 = DRIVER TYPE FILTER. THIS PARAMTER ALLOWS YOU TO C FILTER ON A DRIVER TYPE. EITHER AN OCTAL VALUE C CAN BE GIVEN (E.G. 23B) OR AN ALPHANUMERIC STRING C IN THE FOLLOWING FORM: 'A05'. THIS WOULD ONLY C DISPLAY 'DVA05' TYPE LU'S. C (DEFAULT: FILTER1 = SHOW ALL LU'S) C C FILTER2 = DRIVER TYPE FILTER. THIS PARAMETER HAS THE SAME C FORMAT AS 'FILTER1' AND IS USED IN CONJUNTION C WITH 'FILTER1' TO SPECIFY A RANGE OF DRIVER C TYPES TO BE LISTED. C (DEFAULT: FILTER2 = FILTER1) C C EXTERNAL SUBROUTINES REQUIRED C ----------------------------- C C IODVC ASCII TABLE OF DRIVER DEVICE NAMES. C MEMSZ CALCULATES RTE-IV MEMORY SIZE C ISOL8 ISOLATES AND RIGHT JUSTIFIES BITS C EXTERNAL IODVC,MEMSZ,ISOL8 C INTEGER TYPE,TYPMIN,TYPMAX,TYPASC,ASCLL,ASCUL,WORD4 C LOGICAL DVFLT,SCLST C DIMENSION IDVC(8),IPARM(5),MTH(36),NAME(3),LIBARY(256) DIMENSION IPBUF(10) EQUIVALENCE(NAME(2),NAME2),(IPARM(5),IPARM5) EQUIVALENCE(IPBUF(4),WORD4) C DATA MTH/2HJA,2HN ,2HFE,2HB ,2HMA,2HR ,2HAP,2HR ,2HMA,2HY ,2HJU, -2HN ,2HJU,2HL ,2HAU,2HG ,2HSE,2HP ,2HOC,2HT ,2HNO,2HV ,2HDE,2HC / DATA LIBSIZ/256/,DVFLT/.FALSE./,ASCLL/26400B/,ASCUL/55000B/ DATA SCLST/.FALSE./ C C GET PARAMETERS AND SET DEFAULTS. C CALL GETST(LIBARY,-40,ILOG) LUOUT = LOGLU(LUTRUE) IEQTB=IGET(1650B) LUMAX = IGET(1653B) INTBA = IGET(1654B) INTLG = IGET(1655B) C C START INTERRUPT TABLE AT 10B C INTBA = INTBA + 2 ICODE = 10B C C MAKE SURE THE SC LIST DOES'NT START OFF WITH A BANG C IEQTA = 77777B C C SET A STOP FLAG (FOR SC LIST) C ISTOP = 6 + INTLG IBEG = 1 IEND = LUMAX ISTRC = 1 DO 100 I=1,5 IF(NAMR(IPBUF,LIBARY,ILOG,ISTRC))100,10 10 TYPE = IAND(WORD4,3) GO TO(20,30,40,50,80)I 20 IF(TYPE .EQ. 1)LUOUT = IPBUF GO TO 100 30 IF(TYPE .EQ. 3 .AND. IPBUF .EQ. 2HSC)GO TO 110 IF(TYPE .NE. 1)GO TO 100 IBEG = IPBUF IEND = IPBUF GO TO 100 40 IF(TYPE .EQ. 0)GO TO 100 IF(IPBUF .GT. IBEG)IEND = IPBUF IF(IEND .GT. LUMAX)IEND = LUMAX GO TO 100 50 IF(TYPE .EQ. 0)GO TO 100 DVFLT = .TRUE. IF(TYPE .NE. 1)GO TO 60 TYPMIN = IPBUF TYPMAX = IPBUF GO TO 100 60 CALL CODE READ(IPBUF,70)TYPMIN 70 FORMAT(O6) ASCLL = IAND(77400B,IPBUF) TYPMAX = TYPMIN GO TO 100 80 IF(TYPE .EQ. 0)GO TO 100 IF(TYPE .NE. 1)GO TO 90 TYPMAX = IPBUF GO TO 100 90 CALL CODE READ(IPBUF,70)TYPMAX ASCUL = IAND(77400B,IPBUF) 100 CONTINUE C C IF ONLY ONE LU SPECIFIED SKIP THE HEADING AND FOOTI@NG C IF(IBEG .EQ. IEND)GO TO 170 GO TO 120 C C IF S.C. LIST SET OUR FLAG C 110 SCLST = .TRUE. C C SET LINE SPACING CONTROL TO OUTPUT DEVICE C 120 LUPC = IOR(LUOUT,1100B) C C GET TBG AND PRIV. CARD INFO C ITBG=IGET(1674B) IPRIV=IGET(1737B) C C GET TIME AND DATE C CALL EXEC(11,IPARM,IYEAR) CALL DATE(IPARM5,MONTH,IYEAR) IPM=(MONTH-1)*2+1 CALL MEMSZ(ISIZE) WRITE(LUOUT,130)(MTH(I), I=IPM,IPM+1),IPARM5,IYEAR, -(IPARM(I),I=4,2,-1) 130 FORMAT(25X"RTE-IV SYSTEM CONFIGURATION"/25X,"ON ",2A2,I2, -","I4" AT"I3,2(":"I2)) WRITE(LUOUT,140)ISIZE,ITBG 140 FORMAT(/20X"CONFIGURED MEMORY SIZE IS "I4" K WORDS",/, -22X"TIME BASE GENERATOR IS IN S.C. "K2) IF(IPRIV.EQ.0)170,150 150 WRITE(LUOUT,160)IPRIV 160 FORMAT(/22X"PRIVILEGED INTERRUPT IS IN S.C. "K2) 170 WRITE(LUOUT,180) 180 FORMAT(/27X"---- E Q T ----"/ -3X"LU EQT S.CHNL S.C. ADDR STATUS T.O. DRIVER" -4X"DEVICE NAME"6X"LU"/) C C READ THE DISC LIBRARY OF ENTRY POINTS NEEDED FOR DRIVER NAMES. C CALL DISC(LIBARY,LIBSIZ,LUOUT,NENTI) C C IF SC LIST GO GET FIRST NON-ZERO SELECT CODE C IF(SCLST)GO TO 290 C C START IT ALL OVER AGAIN C 190 IDRT=IGET(1652B) IDRT = IDRT + IBEG - 1 C C START LOOP FOR ALL LUMAX LOGICAL UNITS. C DO 360 I=IBEG,IEND IDVR = 0 IF(IFBRK(IDUM))420,200 200 IVAL=IGET(IDRT) IF(IVAL.NE.0) GO TO 220 IF(DVFLT .OR. SCLST) GO TO 350 WRITE(LUOUT,210)I,I 210 FORMAT(I5,4X,18("*")" LU UNASSIGNED "18("*")9X,I4) GO TO 350 C C GET SUBCHANNEL C 220 ISC=ISOL8(IVAL,15,11) C C GET EQT NUMBER C IEQT=IAND(IVAL,77B) C C COMPUTE EQT ADDRESS C IEQTA=(IEQT-1)*15+IEQTB C C EXTRACT SELECT CODE C ISCDE=IAND(IGET(IEQTA+3),77B) C C CHECK FOR LIST BY SkELECT CODE ONLY C IF(.NOT.SCLST) GO TO 230 IF(ISCDE .NE. ICODE)GO TO 350 C C AND DRIVER TYPE C 230 IDVR=ISOL8(IGET(IEQTA+4),13,8) C C SET DRIVER INITIATION ADDRESS C IENTRY=IGET(IEQTA+1) C C AND SET TYPE IN NAME FOR SEARCH ROUTINE C NAME = IDVR C C SEARCH FOR TRUE DRIVER NAME C CALL SERCH(LIBARY,LIBSIZ ,NENTI,IENTRY,NAME) C C DECODE EQT STATUS BITS C ISTAT=IGET(IEQTA+3) IDB=20040B IF(ISTAT.LT.0) IDB=42040B IF(IAND(ISTAT,40000B).NE.0) IDB=IOR(IAND(IDB,177400B),102B) IPS=20040B IF(IAND(ISTAT,20000B).NE.0) IPS=50040B IF(IAND(ISTAT,10000B).NE.0) IPS=IOR(IAND(IPS,177400B),123B) IT=20040B IF(IAND(ISTAT,4000B).NE.0) IT=52040B C C DETERMINE DEVICE TIME OUT C ITO = 0 MTO = IGET(IEQTA+13) IF(MTO .EQ. 0)GO TO 240 ITO = - (MTO+1) C C GET DEVICE NAME C 240 CALL IODVC(IDVR,IDVC,NAME,ISC) TYPASC = IAND(NAME2,77400B) C C CHECK IF FILTERING OUTPUT C IF(.NOT.DVFLT)GO TO 260 IF(TYPMIN .LE. IDVR .AND. IDVR .LE. TYPMAX)GO TO 250 GO TO 350 C 250 IF(ASCLL .LE. TYPASC .AND. TYPASC .LE. ASCUL)GO TO 260 GO TO 350 C C OUTPUT 1 LU NUMBER C 260 WRITE(LUOUT,270)I,IEQT,ISC,ISCDE,IEQTA,IDB,IPS,IT,ITO,NAME,IDVC,I 270 FORMAT(I5,I6,1X,I5,4X,K2,4X,K5,2X,3A2,I5,3X,3A2,2X,8A2,I4) IF(.NOT.SCLST)GO TO 350 280 ICODE = ICODE + 1 INTBA = INTBA + 1 IF(ICODE .EQ. ISTOP) GO TO 400 290 ICHK = IGET(INTBA) C C IF NEXT S.C. POINTS TO CURRENT EQT GO PRINT IT C IF(ICHK .NE. IEQTA)GO TO 300 ISCDE = ICODE GO TO 260 300 IF(ITBG .NE. ICODE)GO TO 320 WRITE(LUOUT,310 )ICODE GO TO 280 310 FORMAT(21X,K2,33X"TBG") 320 IF(IPRIV .NE. ICODE)GO TO 340 WRITE(LUOUT,330 )ICODE GO TO 280 330 FORMAT(21X,K2,33X"PRIVILEGED FENCE") 340 IF(ICHK .EQ. 0)GO TO 280 GO TO 190 350 IDRT=IDRT+1 360 CONTINUE C IF(.NOT.SCLST)GO TO 390 C C NO LU FOUND BUT HAVE SOMETHING IN INTBL. IF EQT ADDRESS WE C CAN PROCESS IT, IF PROGRAM TO SCHEDULE WE'RE OUT OF LUCK. C IF(ICHK .LT. 0)GO TO 370 C C SET UP A PASS THROUGH OUR LOOP C I = 999 ISC = 0 IEQT = (ICHK-IEQTB)/15 + 1 IEQTA = ICHK ISCDE = ICODE GO TO 230 370 WRITE(LUOUT,380)ICODE 380 FORMAT(" NO EQT DEFINED FOR "K2) GO TO 280 C C SKIP THE FOOTING IF ONLY 1 LU. C 390 IF(IBEG .EQ. IEND)GO TO 420 C 400 WRITE(LUOUT,410) 410 FORMAT(//36X"EQT STATUS LEGEND:"//37X"D= DMA REQUIRED"/37X -"B= AUTOMATIC OUTPUT BUFFERING USED"/37X"P= DRIVER PROCESSES" -" POWER FAIL"/37X"S= DRIVER PROCESSES TIME-OUT"/37X"T= DEVICE" -" HAS TIMED OUT") 420 CALL EXEC(3,LUPC,-1) 430 END SUBROUTINE DATE(IDAY,MONTH,IYEAR) C C THIS SUBROUTINE RECEIVES THE GREGORIAN (SOMETIMES MISTAKINGLY CALLED C THE JULIAN) DATE IN 'IDAY' AND THE YEAR IN 'IYEAR' AND RETURNS THE C FOLLOWING: C C MONTH ---> NUMERICAL MONTH OF THE YEAR C DIMENSION IM(12) DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ C C C... CHECK FOR LEAP YEAR ... C IZ=IYEAR/4 IR=IYEAR-IZ*4 IF(IR.NE.0) GO TO 70 C C... LEAP YEAR TIME ... C IM(2)=29 C C... COMPUTE CORRECT MONTH ... C 70 DO 20 I=1,12 MONTH=I IF(IDAY.LE.IM(I)) GO TO 30 20 IDAY=IDAY-IM(I) C 30 END C SUBROUTINE DISC(LIBARY,NLIB,LUOUT,NENTI) C C I MUST READ IN THE C DISC LIST OF USER AVAILABLE ENTRY POINTS STARTING AT DISC ADDRESS C GIVEN IN LOCATION DSCLB=1761B OF BASE PAGE COMMUNICATION AREA. C I WILL SORT OUT AND RETAIN IN LIBARY ARRAY ANY ENTRY POINTS THAT C MIGHT BE USEFUL(I AM LOOKING FOR I.00,IP43,ETC.). C DIMENSION LIBARY(NLIB) INTEGER IREGS(2),AREG,BREG INTEGER SECTOR(128) EQUIVALENCE(IREGS(1),REGS),(IREG.S(1),AREG),(IREGS(2),BREG) C C STATEMENT FUNCTION EXTRACTS 1ST CHAR OF ENTRY PT NAME. C INAME(IWD1)=IOR( ISOL8(IWD1,14,8), 20000B ) C C IDISC=IGET(1761B) LU=ISOL8(IDISC,15,15) + 2 ITK=ISOL8(IDISC,14,7) ISEC=ISOL8(IDISC,6,0) IODD = IAND(ISEC,1) NENTRY=IGET(1762B) NSEC=IGET(1757B + LU - 2) JENTRY=0 ILIB=1 IBUFL = 128 IF(IODD .EQ. 1)IBUFL = 64 C C START LOOP TO READ DISC SECTOR BY SECTOR. C 10 CONTINUE REGS=EXEC(1,LU,SECTOR,IBUFL,ITK,ISEC) C C SECTOR HAS 32(OR 16) FIELDS OF 4 WDS EACH (3 FOR ENT PT NAME, 1 FOR ADDR) C SEARCH THIS SECTOR FOR ENTRY POINTS WITH PROMISING NAMES,BUT C BREAK OUT IF WE EXCEED NENTRY ENTRY POINTS. C DO 200 J=1,IBUFL/4 JENTRY=JENTRY+1 IF(JENTRY.GT.NENTRY)GO TO 400 K=(J-1)*4 + 1 IF( INAME(SECTOR(K) ) .NE. 2H I ) GO TO 200 C WE KNOW NAME BEGINS WITH I. NOW CHECK 6TH BYTE OF NAME. THIS BYTE C =0 FOR MEM RESIDENT, 1 FOR DISC RES, 4 FOR MICROCODE. WE WANT ONLY C MEM RESIDENT ENT PTS BEGINNING WITH I. IF( ISOL8( SECTOR(K+2),7,0 ) .GT. 0 ) GO TO 200 C C I FOUND A PROMISING NAME. I WILL STORE THE 3 WORD NAME AND ITS C 1 WORD ADDRESS IN THE LIBARY ARRAY. C DO 150 I=K,K+3 LIBARY(ILIB)=SECTOR(I) ILIB=ILIB+1 IF(ILIB.GT.NLIB)GO TO 500 150 CONTINUE 200 CONTINUE C C ADDRESS THE NEXT SECTOR ON DISC. C ISEC=ISEC+1 IF(IODD .EQ. 0)ISEC = ISEC + 1 IF(ISEC.LT.NSEC)GO TO 10 ISEC=0 IODD = 0 IBUFL = 128 ITK=ITK+1 GO TO 10 C C DISC READ IS DONE. LIBARY ARRAY HAS ALL RELEVANT ENT PT NAMES. C RETURN TO CALLER NENTI=NUMBER OF ENTRY PT NAMES. C 400 NENTI=(ILIB-1)/4 RETURN C C ERROR PRINTOUT IF TOO MANY ENT PT NAMES FOR THE LIBARY ARRAY. C 500 WRITE(LUOUT,510)ILIB 510 FORMAT(I6," WDS OVERFLOWS LIBARY ARRAY") GO TO 400 END C SUBROUTINE SERCH(LIBARY,NLIB,NENTI,IENTRY,NAMDV) C C GIVEN THAT 2ND WORD OF EQT TABLE=ADDRESS OF INTERRUPT ENTRY POINT, C FIND THE FIVE CHARACTER NAME OF THAT ENTRY POINT BY SEARCHING THE C LIBARY ARRAY OF USER AVAILABLE ENTRY POINTS. C C LIBARY HAS NENTI FIELDS OF 4 WDS EACH (3 FOR ENT PT NAME, 1 FOR ADDR) C SEARCH THIS ARRAY FOR ENTRY POINT ADDR TO MATCH IENTRY. C DIMENSION LIBARY(NLIB),NAMDV(3) CALL CNUMO(NAMDV,NAMDV) IDVR = NAMDV(3) IF(IDVR .LT. 30000B)IDVR = IDVR + 10000B IDOT = ISOL8(2H..,7,0) IRIGHT = ISOL8(IDVR,14,8) NAMDV(1) = 2HDV NAMDV(2) = IOR((IDOT*256),IRIGHT) NAMDV(3) = IOR(ISOL8(IDVR,6,0)*256,40B) DO 200 J=1,NENTI K=(J-1)*4 + 4 IDV = K-2 IF(IDVR .NE. LIBARY(IDV))GO TO 200 IF(LIBARY(K).NE.IENTRY)GO TO 200 C C I FOUND AN ADDRESS THAT MATCHES IENTRY. GET ENTRY PT NAME AND C CHANGE I.05 TO DVR05 OR IX05 TO DVX05 FOR ANY X. C NAMDV(3)=IOR( ISOL8( LIBARY(IDV), 6, 0)*256, 40B ) IRIGHT=ISOL8( LIBARY(IDV),14,8 ) ITEST=ISOL8( LIBARY(K-3), 6, 0 ) IF(ITEST.EQ.IDOT)ILEFT=IAND( 2HRR, 177400B ) IF(ITEST.NE.IDOT)ILEFT=ITEST*256 NAMDV(2)=IOR(ILEFT,IRIGHT) RETURN 200 CONTINUE C C MISSED COMPLETELY. NO MATCH BETWEEN DRIVER TYPE AND ENTRY C POINT INDICATES THE DRIVER TYPE HAS BEEN CHANGED IN THE EQT C (THIS IS DONE BY THE SPOOL DRIVER FOR EXAMPLE). C IF THIS CONDITION OCCURS A DV.XX NAME WILL BE RETURNED IN THE C NAME ARRAY. C RETURN END END$ ASMB,L * HED MAPIO SUBROUTINE TO GET ASCII NAME OF DRIVER TYPE NAM IODVC,7 24999-16222 REV.2011 800312 * ENT IODVC EXT .ENTR * *************************** * * * SOURCE: 24999-18222 * * RELOC.: 24999-16222 * * * *************************** * A EQU 0 B EQU 1 * SUP * TABLE EQU * ** ASCII ** ## * ASC 8,DUMB TERMINAL R00 ASC 8,TAPE READER R01 ASC 8,TAPE PqUNCH R02 ASC 8, R03 ASC 8, R04 ASC 8,2645/2648 TRMNL R05 ASC 8, R06 ASC 8,MULTI-PT TRMNL R07 ASC 8,PLOTTER R10 ASC 8,CARD READER R11 ASC 8,2767 LP R12 ASC 8,TV MONITOR A13 ASC 8, R14 ASC 8,MARK READER R15 ASC 8, R16 ASC 8, R17 ASC 8, R20 ASC 8, R21 ASC 8, R22 ASC 8,9-TR MAG TAPE R23 ASC 8,7-TR MAG TAPE R24 ASC 8, R25 ASC 8, R26 ASC 8, R27 ASC 8,FIXED HEAD DISC R30 ASC 8,7900 DISC R31 ASC 8,7905/6/20/25 DSC R32 ASC 8,FLEXIBLE DISC R33 ASC 8, R34 ASC 8, R35 ASC 8,WCS R36 ASC 8,HP-IB BUS R37 ASC 8,DATA SOURCE INT. R40 ASC 8, R41 ASC 8, R42 ASC 8,SPOOL R43 ASC 8, R44 ASC 8,3480/5 DVM R45 ASC 8,3480/4 DVM R46 ASC 8,3480/4/2911 DVM R47 ASC 8,RJE R50 ASC 8, R51 ASC 8, R52 ASC 8, R53 ASC 8,40-BIT OUTPUT RG R54 ASC 8,2312 SUBSY R55 ASC 8,2310/11 SS R56 ASC 8, R57 ASC 8, R60 ASC 8,6940 SUBSY R61 ASC 8,2313 SUBSY R62 ASC 8, R63 ASC 8, R64 ASC 8,DS/1000 LINK A65 ASC 8,2570A COM R66 ASC 8,DS/3000 LINK G67 ASC 8,6129/30/31 DVS R70 ASC 8, R71 ASC 8,6940 SUBSY A72 ASC 8, R73 ASC 8,2321 SUBSY R74 ASC 8, R75 ASC 8,2320 SUB_SY R76 ASC 8,2323 SUBSY R77 * TABEN EQU * * * WARNING !!! DO NOT REARRANGE ORDER OF THE FOLLING TABLE * DVS00 ASC 8,MUX ** DVS00 SB.05 ASC 8,264X TRMNL L.CTU** DV.05 ASC 8,264X TRMNL R.CTU** DV.05 ASC 8,264X TRMNL DSPLY** DV.05 ASC 8,264X TRMNL PRNTR** DV.05 ASC 8,264X TRMNL EXTDV** DV.05 DV.12 ASC 8,LINE PRINTER ** DV.12 DVA12 ASC 8,2607-2618 LP ** DVA12 DVB12 ASC 8,2608A LP ** DVB12 DVZ12 ASC 8,2608A (GRAPHICS)** DVZ12 DVA32 ASC 8,IC DISC ** DVA32 DVC32 ASC 8,IC DISC (# 2) ** DVC32 DVP32 ASC 8,MAC DISC (# 2) ** DVP32 DVP43 ASC 8,POWER FAIL ** DVP43 DVA47 ASC 8,DATA ENTRY TRMNL** DVA47 DVR65 ASC 8,SERIAL LINK KIT ** DVR65 DVM72 ASC 8,UNIVERSAL INF. ** DVM72 * TABAD DEF TABLE * S00. ABS DVS00-TABEN+100B .12. ABS DV.12-TABEN+100B A12. ABS DVA12-TABEN+100B B12. ABS DVB12-TABEN+100B Z12. ABS DVZ12-TABEN+100B A32. ABS DVA32-TABEN+100B C32. ABS DVC32-TABEN+100B P32. ABS DVP32-TABEN+100B P43. ABS DVP43-TABEN+100B A47. ABS DVA47-TABEN+100B R65. ABS DVR65-TABEN+100B M72. ABS DVM72-TABEN+100B * SPC 2 DVTYP NOP DRIVER TYPE NUMBER DSCRP NOP RETURNED DESCRIPTION NAME NOP TRUE DRIVER NAME SUB NOP SUBCHANNEL IODVC NOP ENTRY POINT JSB .ENTR DEF DVTYP LDB DVTYP,I GET THE DVR TYPE JSB SPECL GO CHECK FOR SPECIAL TYPE BLF,BRS MPY BY 8 TO GET OFFSET ADB TABAD ADD TABLE ADDRESS LDA M8 SET COUNTER TO MOVE 8 WDS STA CNTR LOOP LDA B,I START XFERING THE INFO STA DSCRP,I AND SAVE IN USER BUFFER INB BUMP ADDRESS ISZ DSCRP ISZ CNTR AND COUNTER JMP LOOP DONE YET ? JMP IODVC,I YUP, RETURN * B0 OCT 0 B5 OCT 5 B12 OCT 12 B32 OCT 32 B43 OCT 43 B47 OCT 47 B65 OCT 65 B72 OCT 72 B100 OCT 100 M6 DEC -6 M8 DEC -8 M100B OCT -100` CNTR NOP ". OCT 27000 "A OCT 40400 "B OCT 41000 "C OCT 41400 "M OCT 46400 "P OCT 50000 "R OCT 51000 "S OCT 51400 "Z OCT 55000 HIBYT OCT 77400 * SPECL NOP ISZ NAME SET UP FOR GETTING LDA NAME,I SPECIAL LETTER AND HIBYT CPB B0 CHECK FOR THE MUX JMP .D0 CPB B5 CHECK FOR THE MUX JMP .D5 CPB B12 CHECK FOR LP JMP .D12 GO DOIT CPB B32 JMP .D32 CHECK FOR IC DISC CPB B43 CHECK FOR SPOOL/POWER JMP .D43 CPB B47 DATA CAP ? JMP .D47 MAYBE CPB B65 OLD DS ? JMP .D65 CPB B72 CHECK FOR UI/8940 JMP .D72 JMP SPECL,I NO SPECIALS RETURN * .D0 CPA "S CHECK FOR THE MUX LDB S00. JMP SCHK * .D5 CPA "S CHECK FOR THE MUX LDB S00. LDA SUB,I CHECK FOR SUBCHANNEL SZA,RSS JMP SCHK NO SUB FOR THIS ONE ADA M6 CHECK FOR CRAZY SSA,RSS SUBCHANNEL JMP SCHK NO, GO DO IT. LDA SUB,I LDB S00. ALF,ARS MULTIPLY BY 8 ADB A JMP SCHK * .D12 CPA "A CHECK FOR DVA12 LDB A12. RETURN WITH ADDRESS IN B CPA "B CHECK FOR DVB12 LDB B12. CPA "Z CHECK FOR LOGICAL GRAPHICS LDB Z12. CPA ". CHECK FOR SPOOL MOD. LDB .12. JMP SCHK * .D32 CPA "A CHECK FOR IC DISC LDB A32. CPA "C CHECK FOR 2ND. ID DISC LDB C32. CPA "P 2ND. MAC DISC TOO. LDB P32. JMP SCHK * .D43 CPA "P LDB P43. NO, GET PWR/FAIL JMP SCHK GO PROCESS * .D47 CPA "A CHECK FOR DATA CAPP LDB A47. JMP SCHK * .D65 CPA "R CHECK FOR OLD DS1B' LDB R65. JMP SCHK * .D72 CPA "M DV'R'72 ? LDB M72. MUST BE UI CARD  * SCHK LDA B AND M100B SZA,RSS JMP SPECL,I NOT A SPECIAL ADB M100B BRS,BRS DIVIDE BYE 8 BRS ADB B100 ADD BACK OFFSET JMP SPECL,I AND RETURN END ASMB,L HED MAPIO SUBROUTINE TO RETRIEVE CONFIGURED RTE-IV MEMORY SIZE * NAM MEMSZ,7 REV.2007 800211 * ENT MEMSZ EXT .ENTR,$MATA,$MNP * *************************** * * * SOURCE: 02170-180XX * * RELOC.: 02170-160XX * * * *************************** * * DESCRIPTION * ----------- * * THIS SUBROUTINE CALCULATES THE AMOUNT OF MEMORY CONFIGURED INTO * AN RTE-IV SYSTEM AND RETURNS THE VALUE TO THE CALLING PROGRAM AS * THE DECIMAL NUMBER OF 1024-WORD PAGES. * * CALLING SEQUENCE * ---------------- * * CALL MEMSZ(ISIZE) * * ISIZE = THE ADDRESS OF THE RETURNED NUMBER 0F CONFIGURED PAGES * * ISIZE NOP THE ADDRESS PASSED BY THE CALLING PROGRAM * MEMSZ NOP < ENTRY & EXIT POINT > JSB .ENTR RETRIEVE ADDRESS WHERE MEMORY SIZE IS TO BE STORED DEF ISIZE * LDA $MNP GET MAXIMUM # OF PARTITIONS ALLOWED CMA,INA SET PARTITION ENTRY COUNTER STA ENTRY AND STORE * LDB $MATA GET ADDRESS OF MEMORY ALLOCATION TABLE. ADB =D3 SET TO ADDRESS OF WORD THREE IN CURRENT ENTRY NEXT LDA 1,I LOAD PHYSICAL STARTING PAGE OF PARTITION SZA,RSS A=0? JMP END YES AND PGMSK INSURE PAGE NUMBER ONLY STA ISTRT NO,SAVE INB SET TO ADDRESS OF WORD 4 IN CURRENT ENTRY LDA 1,I LOAD NUMBER OF PAGES IN PARTITION AND PGMSK MAKE SURE PAGE ONLY ADA ISTRT AND ADD TO STARTING PAGE STA ISIZE,I STORE MEMORY SIZE ADB =D6 INCREMENT TO WORD 4 IN NEXT ENTRY ISZ ENTRY INCREMENT PARTITION COUNTER, SKIP IF 0 JMP NEXT TRY NEXT P͹ARTITION ENTRY * END ISZ ISIZE,I ADD ONE TO GET ACTUAL MEMORY SIZE JMP MEMSZ,I RETURN TO CALLER * ENTRY NOP PARTITION COUNTER ISTRT NOP STARTING PHYSICAL PAGE NUMBER PGMSK OCT 1777 PAGE MASK FOR MAT ENTRY * END ASMB,R,B,L NAM ISOL8,7 ISOLATE,RIGHT JUSTIFY BITS. 18 JAN 77. ENT ISOL8 EXT .ENTR * * I=ISOL8(J,11,8) ISOLATES BITS 11,10,9,8 FROM J AND RETURNS THEM * IN THE LEAST SIGNIFICANT BITS OF I. HIGH BITS OF * I ARE ZEROED OUT. * I=ISOL8(J,8,11) DOES THE SAME THING. * * I=ISOL8(J,15,0) RETURNS I=J * I=ISOL8(J,16,1) RETURNS I = J ROTATED 1 BIT RIGHT * J NOP I1 NOP I2 NOP ISOL8 NOP JSB .ENTR DEF J LDA I1,I CMA,INA (A)= -I1 ADA I2,I (A)= I2-I1 SSA (A)>0 ? I2>I1 ? JMP RVERS NO. I1>I2. LDB I1,I YES. I2>I1. GET I1. JMP CONT RVERS LDB I2,I I2 IS THE LEAST OF I1,I2. CMA,INA (A)>=0. CONT CMB,INB LEAST OF I1,I2 COUNTS ROTATIONS. STA MASK# MASK NUMBER >= 0. LDA J,I GET THE WORD TO BE OPERATED ON. * RLOOP SZB,RSS DONE? ROTATION COUNTER ROSE TO ZERO ? JMP ISOL YES. RAR NO. MOVE BITS-OF-INTEREST ONE PLACE RIGHT. INB BUMP ROTATION COUNTER. JMP RLOOP * ISOL LDB .MASK ADB MASK# (B) POINTS TO DESIRED MASK. AND B,I ZERO OUT UNWANTED BITS. JMP ISOL8,I RETURN WITH (A)=RIGHT JUSTIFIED ISOLATED BITS. * MASK# NOP .MASK DEF *+1 OCT 000001 OCT 000003 OCT 000007 OCT 000017 OCT 000037 OCT 000077 OCT 000177 OCT 000377 OCT 000777 OCT 001777 OCT 003777 OCT 007777 OCT 017777 OCT 037777 OCT 077777 OCT 177777 * A EQU 0 B EQU 1 S EQU 1 END gNLHHN _q 24999-18224 1902 S 0100 &PSMON              H0101 gASMB,R,L,C NAM PSMON,3,2 24999-16224 REV. 1902 11-10-78 * * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * SPC 1 * * NAME: PSMON * SOURCE: 24999-18224 * RELOC: 24999-16224 * PGMR: LYLE WEIMAN NOV 1978 * * PURPOSE: PROVIDES "PASSIVE MONITOR" CAPABILITY FOR DS/1000 * HARDWIRE LINKS. * * REQUIREMENTS: * * 1) SEPARATE COMPUTER * * 2) TWO HP 12665 INTERFACE CARDS (IN ADDITION TO * THOSE USED TO CONNECT THE COMPUTER TO A DS/1000 * NETWORK, IF ANY) * * 3) CONNECTING CABLES MODIFIED FOR PASSIVE MONITORING. * * 4) AN RTE OPERATING SYSTEM (MAY BE RTE-M) * WITH DS/1000 SOFTWARE GENERATED IN. * * * * TO USE: * * 1) INSTALL TWO INTERFACE CARDS IN THE COMPUTER AND HOOK THEM UP TO * THE LINE TO BE TRACED WITH A CABLE MODIFIED TO PROVIDE PASSIVE * MONITORING. * * 2) EDIT THE SOURCE, SPECIFYING THE SELECT CODES FOR THE TWO * INTERFACE CARDS AS THE DEFINITIONS FOR "XMTIF" AND "RCVIF". * ALL DATA TAKEN FROM THE INTERFACE IN THE "XMTIF" SELECT CODE * WILL BE CONSIDERED AS "TRANSMIT" DATA. ALL DATA FROM THE * "RCVIF" SELECT CODE WILL BE CONSIDERED AS "RECEIVE" DATA. * BE SURE TO WRITE DOWN WHICH IS WHICH SO YOU CAN DETERMINE * DATA DIRECTION FROM THE PRINTOUT. * * 3) RE-ASSEMBLE THE SOURCE AND LOAD THE PROGRAM IN THE COMPUTER * TO BE USED FOR MONITORING. * * 4) SCHEDULE THE PROGRAM: * * *ON,PSMON,[LUTTY[,LUPRIN[,NODE#[,MODE[,#POINTS]]]]] * * LUTTY = LU OF OPERATOR CONSOLE(MUST BE CAPABLE OF INPUT & OUTPUT) *  AT LOCAL NODE. * USED FOR DIALOG AND ERROR MESSAGES. * DEFAULT IS YOUR TERMINAL (MTM ENVIRONMENT), ELSE 1 * * NOTE: SPECIAL FEATURES ARE INVOKED IF THE TERMINAL IS DRIVEN * USING DVR05 OR DVR07: * * 1) EACH LINE WHICH IS 'RECEIVED' (AS OPPOSED TO 'TRANSMITTED') IS * DISPLAYED IN INVERSE VIDEO. * * 2) ABNORMAL PROTOCOL INDICATIONS ('RLM', 'RLW', 'STOP') ARE * HIGHLIGHTED: 'RLM' & 'RLW' ARE UNDERLINED, 'STOP' IS SHOWN * BLINKING. REQUIRES OPTIONAL MODULES SUPPORTING THESE * FUNCTIONS BE INSTALLED IN THE 264X TERMINAL USED. * * * LUPRIN= LU FOR PRINTING TRACE TABLE IF NOT THE SAME AS * AT REMOTE OR LOCAL NODE. * USEFUL WHEN HARDCOPY LOG IS DESIRED. * DEFAULT IS LUTTY. * * NOTE: IF LUPRIN = 2, THEN ALL TRACE RECORDS WILL BE * RECORDED IN THEIR "RAW" FORM, EITHER ON A DISC FILE * OR A REMOTE DEVICE, SUCH AS A TAPE. THE PROGRAM WILL * ASK FOR THE FILE PARAMETERS; ENTER THE NAME * OF THE FILE, SECURITY CODE, ETC., OR THE LU OF THE * REMOTE DEVICE. WHEN OUTPUTTING RAW DATA TO A DISC FILE, * THE FILE IS NORMALLY ASSUMED TO BE CIRCULAR: * OLD INFORMATION IS OVERWRITTEN BY NEW, THE * NUMBER OF "FRESH" TRACE RECORDS BEING DETERMINED BY * THE SIZE OF THE FILE. * WHEN OUTPUTTING TO A REMOTE DEVICE, SUCH AS A MAG * TAPE, ALL DATA IS RECORDED. * * * SYNTAX IS: FILNAM : SC : CR : :# RECORDS FOR FILE * OR * * * TO OBTAIN A FORMATTED PRINTOUT OF THIS INFORMATION, * SIMPLY SET THE 'BREAK' FLAG SO THE PROGRAM WILL * CLOSE THE FILE, THEN RE-RUN IT, SPECIFYING THE FILE * NAME OR DEVICE LU IN RESPONSE TO THE QUESTION, * "FILE OR DEVICE TO GET 'TRACE' DATA?" * * NOTE: IF DISC FILES ARE NOT GOING TO BE USED, YOU * DO NOT NEED TO LOAD THE PROGRAM WITH THE FMP ROUTINES * (CREAT, OPEN, CLOSE, READF, ETC.), AND MAY * IGNORE THESE UNDEFINED SYMBOLS AT LOAD TIME. * * * * = REMOTE NODE NUMBER FOR PRINTOUT (ALLOWS YOU TO USE * A COMPUTER WITHOUT AN OUTPUT DEVICE OF ITS OWN). * DEFAULT IS LOCAL NODE. * IF LUPRIN = 2 THEN DATA LOGGING IS DONE LOCALLY, AND * THIS PARAMETER HAS NO EFFECT. * * : BIT MASK * BITS 0 : NOT USED * 1=0:(DEFAULT) CAUSES PRINTOUT OR LOGGING OF ALL DATA * GATHERED. * * =1: CAUSES PROGRAM TO IGNORE ALL DATA BUFFERS WHICH * CONTAIN NO ABNORMAL PROTOCOL WORDS. * ('STOP', 'RLM', 'RLW') * * * BIT 2: USED ONLY WHEN 'TRACE' DATA IS BEING LOGGED TO A DISC FILE. * = 0 CAUSES PROGRAM TO REWIND FILE AUTOMATICALLY WHEN LAST RECORD * HAS BEEN WRITTEN. NEW DATA OVERLAYS OLD. THE MESSAGE * "/PSMON:REWINDING FILE" IS PRINTED AFTER THE FIRST TIME * TO INFORM YOU THAT THE DATA IN THE FILE IS NOW VALID. * * = 1 CAUSES PROGRAM TO TERMINATE AS SOON AS THE LAST RECORD HAS * BEEN WRITTEN (ACTUALLY, WHEN THE ATTEMPT IS MADE TO WRITE * THE NEXT ONE AFTER THAT). THE FILE IS CLOSED AND THE * TERMINATION MESSAGE IS PRINTED. * * <#POINTS> = NUMBER OF DATA POINTS TO LOG. MAXIMUM ALLOWABLE VALUE, * AND ALSO THE DEFAULT, IS 2048 POINTS. * * * 5) THE PROGRAM WILL WAIT FOR ACTIVITY ON THE COMMUNICATION LINK * WITH THE INTERRUPT SYSTEM OFF. USE 'REMAT' TO CREATE SUCH * ACTIVITY. IT IS ADVISABLE TO USE A TRANSFER FILE CONTAINING * A LARGE NUMBER OF "TI" COMMANDS FOR THE SIMPL܈E REASON THAT * THE DATA WILL BE FAR TOO VOLUMINOUS OTHERWISE. * * AT ANY TIME, YOU MAY BRING IT OUT OF ITS "WAITING FOR DATA" LOOP * BY SETTING THE SIGN BIT IN THE SWITCH REGISTER. FOR YOUR OWN * INFORMATION, THE PROGRAM DISPLAYS ITS INTERNAL "PSEUDO-CLOCK" * IN BITS 14 THRU 0 OF THE SWITCH REGISTER WHILE IT IS WAITING. * SKP ************************************************************************** * CAVEATS CAVEATS CAVEATS CAVEATS CAVEATS CAVEATS CAVEATS * * CAVEATS CAVEATS CAVEATS CAVEATS CAVEATS CAVEATS CAVEATS * * * * WHEN GATHERING "LIVE" DATA (I.E., NOT TAKING DATA FROM A DISC * * FILE), THIS PROGRAM TURNS NORMAL RTE INTERRUPT PROCESSING OFF!! * * * * THIS MEANS THAT THE SYSTEM TIME-KEEPING AND OTHER REAL-TIME * * ACTIVITIES CEASE DURING THIS PERIOD. YOU **MUST** BE SURE THAT * * NO OTHER CRITICAL ACTIVITIES EXIST BEFORE USING THIS PROGRAM, * * AND YOU MAY WISH TO RE-SET THE SYSTEM TIME-OF-DAY AFTERWARDS * * (BE SURE TO RE-SCHEDULE ALL PROGRAMS IN THE TIME LIST WHOSE * * "TIME OF NEXT SCHEDULE" HAS BEEN PASSED OVER. YOU CAN * * FIND OUT WHICH ONES THESE ARE FROM A 'WHZAT' PRINTOUT). * * * * DURING THE PRINTOUT PHASE, NORMAL RTE INTERRUPT PROCESSING IS * * RESTORED AND THE SYSTEM BECOMES AN RTE AGAIN. * * * ************************************************************************** SKP * YOU WILL BE ASKED TO SPECIFY THE DATA SOURCE. ACCEPTABLE * RESPONSES ARE: * * 1) FILE ---THE NAME OF A DATA FILE IN WHICH DATA WAS LOGGED * DURING SOME PREVIOUS RUN. THE CARTRIDGE REFERENCE NUMBER * AND SECURITY CODE MAY BE SPECIFIED IN THE USUAL WAY. * * 2) THE LOGICAL UNIT OF SOME DEVICE, TYPICALLY A * MAG TAPE OR MINI-CARTRIDGE, ON WHICH DATA WAS LOGGED * DURING SOME PREVIOUS RUN. THE PROGRAM WILL CONTINUE * TO READ UNTIL AN EOF OR EOT CONDITION OR SOME * OTHER MAG TAPE-RELATED ERROR CONDITION IS SET. * * 3) BLANKS--THE PROGRAM WILL TAKE DATA "LIVE", I.E., DIRECTLY * FROM THE PASSIVE-MONITOR INTERFACE CARDS. * * * TO TERMINATE THIS PROGRAM WHILE IT IS PRINTING, SET THE "BREAK" * FLAG. TO TERMINATE IT WHILE IT IS GATHERING DATA (NON-PRIVILEGED * INTERRUPTS ARE OFF), SET THE SIGN BIT IN THE SWITCH REGISTER. * * * * THE PRINT FORMAT SHOWN BELOW IS ACTUALLY REPEATED TWICE PER LINE: * *

* * WHERE= 'X' IF WORD WAS TRANSMITTED * = 'R' IF WORD WAS RECEIVED. * *

= MNEMONIC IF DATA WORD MATCHES ONE OF THE * PROTOCOL WORDS. NOTE: SINCE DATA IS * TRANSMITTED TRANSPARENTLY OVER THESE LINKS, * OCCASIONAL "MATCHES" TO PROTOCOL WORDS MAY * APPEAR. YOU WILL HAVE TO STUDY THE * ACTIVITY SURROUNDING THE "MATCH" TO DETERMINE * IF IT IS, INDEED, VALID. * MNEMONICS: * RC TNW RLM RLW STOP * IF NOT A MATCH TO ABOVE, THEN BLANKS ARE USED. * * = PROTOCOL WORD IN OCTAL. * * = A PSEUDO-"CLOCK" NUMBER WHICH IS * INCREMENTED AFTER CHECKING THE TWO INTERFACE * CARDS FOR DATA. * THIS PROVIDES SOME INDICATION OF ELAPSED * TIME. * WuEACH TICK REPRESENTS ABOUT TWENTY * MICROSECONDS OR SO, DEPENDING ON WHETHER * DATA WAS AVAILABLE IN THIS "PASS" FOR * THE "RECEIVE" OR "TRANSMIT" PATH OR BOTH. * * * NOTE: TO ANALYZE ANY PARTICULAR SEQUENCE, ONE MUST BE FAMILIAR WITH * THE LINE PROTOCOL (SEE NETWORK MANAGER'S MANUAL FOR DETAILS). * * TO CHANGE THE SIZE OF THE TRACE BUFFER, CHANGE '.SIZE'. * IT MUST BE A POWER OF TWO. SKP * * * THE "TRACE" BUFFER FORMAT IS: * * BUFFER: 1ST DATA WORD OBSERVED * BUFFER+1: * BUFFER+2:2ND DATA WORD OBSERVED * " 3: * . . * ETC. * * = "TRANSMIT" LINE OR "RECEIVE" LINE FLAG, * CODED 0/1, AND STORED IN BIT 15. * = 15-BIT UNSIGNED INTEGER PSEUDO-"CLOCK" VALUE * REPRESENTING THE TIME AT WHICH THE DATA WAS AVAILABLE. * RCVIF EQU 16B "RECEIVE" LINE INTERFACE SELECT CODE XMTIF EQU 17B "TRANSMIT" LINE INTERFACE SELECT CODE * EXT $LIBR,$LIBX,EXEC,CNUMD,CNUMO EXT CREAT,OPEN,CLOSE,READF,WRITF,RWNDF EXT EXEC,POSNT,KCVT EXT NAMR EXT IFBRK EXT RMPAR,DEXEC SUP SKP PSMON EQU * PRIMARY ENTRY POINT JSB RMPAR DEF *+2 DEF PRAMS CLB CLEAR FLAGS AND COUNTERS STB NPASS PASS COUNTER STB INFIL DATA TO BE OBTAINED "LIVE" STB RWFLG HAVEN'T PRINTED "REWIND" MESSAGE STB WRFIL NOT LOGGING DATA INTO A FILE STB INLUF WE'RE NOT INPUTTING FROM AN LU STB DCB WE HAVE NO FILES OPEN. * JSB RESET SET UP ALL BUFFER POINTERS LDA LUTTY IS A CONSOLE SZA,RSS LU SPECIFIED? CLA,INA NO, DEFAULT TO 1 IOR =B400 SET "ECHO" BIT FOR INPUT STA LUTTY LDA NODE# LOAD NODE NUMBCER SZA,RSS ZERO? CCA YES, DEFAULT TO LOCAL STA NODE# LDA NPTS LOAD # POINTS AND =B77776 MUST BE EVEN NUMBER! CMA,INA SSA,RSS POSITIVE NUMBER GIVEN? LDA MDFLT NO, LOAD MAXIMUM CMA,INA MAKE POSITIVE AGAIN STA TRACZ SAVE 'TRACE' BUFFER SIZE ADA MDFLT MAKE SURE IT'S CMA,INA SSA,RSS <= MAXIMUM JMP PSM1 LDA MDFLT SET MAXIMUM. CMA,INA STA TRACZ PSM1 EQU * LDA TRACZ WHEN DATA IS LOGGED, A 5-WORD TIME-OF ADA D5 DAY IS INCLUDED. STA FWSIZ LDA LUPRN IS A PRINTOUT LU SZA,RSS SPECIFIED? LDA LUTTY NO, DEFAULT TO LUTTY CPA D2 FILE? JMP GFILE GET FILE NAME IOR B200 SET "HONESTY MODE" BIT STA LUPRN SPC 2 * JSB PRINT PRINT HEADER DEF HED1 DEF HED1L * TRCC2 EQU * JSB EXEC "DATA SOURCE: , LU OR BLANKS DEF *+5 TO TAKE 'LIVE' DATA?" DEF D2 DEF LUTTY DEF MSG1 DEF MSG1L JSB EXEC ASK FOR RESPONSE DEF *+5 DEF D1 DEF LUTTY @BUFR DEF BUFFR DEF M20 STB NCHAR CLA,INA STA NCNTR JSB NAMR PARSE RESPONSE DEF *+5 DEF PBUFR DEF BUFFR DEF NCHAR DEF NCNTR SSA ANY INPUT? JMP EXIT NONE. TERMINATE. LDA PBUFR+3 GET TYPE CODE FOR RESPONSE. AND D3 SZA,RSS DEFAULT? JMP TRC.3 YES CPA D1 NUMERIC? JMP MTAPE YES, GO SET UP TO INPUT FROM A DEVICE. CPA D3 ASCII? JMP MFILE YES. JMP BAD1 INVALID INPUT * TRC.3 EQU * SKP TRC.4 EQU * * SET A FLAG DEPENDING UPON PRINTOUT LU TYPE * JSB DVTYP DETERMINE TYPE OF PRINT DEVICE DEF LUPRN CLA,RSS O~ RETURN HERE: IT'S NOT DV.05 OR DV.07 CCA RETURN HERE: IT'S DV.05 OR DV.07 STA DVFLG SAVE THE FLAG SPC 2 REDTA EQU * JSB IFBRK CHECK OUR "BREAK" FLAG DEF *+1 SSA SET? JMP EXIT YES, EXIT CLB CLEAR ABNORMAL PROTOCOL STB NRLM WORD COUNTERS FOR THIS STB NRLW PASS. STB NSTOP STB NRC STB NPRNT CLEAR # HALF-PRINT LINES CNTR * JSB DEXEC OBTAIN REMOTE-SYSTEM TIME-OF-DAY DEF *+4 DEF NODE# DEF TMCOD DEF TOD NOP * * READ NEXT "TRACE" RECORD * LDA INLUF ARE WE TO GET DATA FROM A TAPE? SZA JMP REDLU YES * LDA INFIL ARE WE GETTING DATA SSA,RSS FROM A FILE? JMP TRC.6 NO, GET IT "LIVE" * * READ DATA FROM THE DISC FILE * LDA FREC GET RECORD NUMBER CMA,INA ADA LREC SSA ALREADY GOTTEN ALL DESIRED RECORDS? JMP EXIT YES ISZ FREC BUMP RECORD COUNTER NOP JSB READF READ "TRACE" BUFFER DEF *+6 DEF DCB DEF ERR @TOD DEF TOD TIME-OF-DAY IMMEDIATELY PRECEDES DATA DEF FWSIZ BUFFER DEF LEN * LDA LEN SET # OBSERVATIONS COUNTER ADA M5 SUBTRACT 5 FOR TIME-OF-DAY STA NOBSV LDA ERR CHECK FOR ERRORS SSA,RSS ERROR? JMP RED.1 NO, GO ON CPA M12 EOF? JMP EXIT YES, WE'RE DONE. JMP FIERR NO, PRINT THE ERROR & TERMINATE. * * HERE TO READ DATA FROM TAPE * REDLU EQU * LDA M5 INITIALIZE # OBSERVATIONS COUNTER STA NOBSV (LESS 5 WORDS FOR TIME-OF-DAY) LDA FWSIZ INITIALIZE # WORDS TO MOVE STA TEMP LDA @TOD INITIALIZE DATA POINTER STA ..RD LDA D512 STA LENGH * RDLUP EQU * JSB DEXEC Ct DEF *+6 DEF NODE# DEF RDCOD DEF INLUF REMOTE LU ..RD NOP BUFFER POINTER DEF LENGH NOP --IGNORE ERRORS -- ADB NOBSV UPDATE # DATA WORDS CNTR STB NOBSV AND =B273 MASK EOF/EOT/ERROR BITS SZA EOF OR EOT OR ERROR? JMP EXIT YES, MUST QUIT NOW. LDA ..RD UPDATE BUFFER POINTER ADA D512 STA ..RD LDA TEMP CMA,INA ADA D512 SSA,RSS ALL DATA READ? JMP RED.1 YES, RESUME MAIN FLOW LDB D512 COMPUTE MINIMUM OF NEW REMAINDER & ADB A 512 CMA,INA MAKE NEW REMAINDER POSITIVE STA TEMP SSB,RSS IS THERE LESS THAN 512 WORDS LEFT TO GO? STB LENGH YES. JMP RDLUP STAY IN LOOP TILL ALL DATA READ * RED.1 EQU * LDA DVFLG IS THIS PRINT DEVICE SSA,RSS A TERMINAL? JMP TRC.7 NO, DON'T DELAY * * GIVE USER A CHANCE TO READ THE PREVIOUS SCREEN FULL * OF OUTPUT BY DELAYING FOR TWO SECONDS. * JSB EXEC DEF *+6 DEF D12 DEF D0 DEF D2 SUSPEND FOR DEF D0 DEF M2 TWO SECONDS JMP TRC.7 NOW GO FORMAT DATA * * READ DATA DIRECTLY FROM THE "TRACE" BUFFER * (I.E., GET IT "LIVE") * TRC.6 EQU * LDA @BUFR INITIALIZE POINTERS STA PNTR ADA TRACZ COMPUTE ADDRESS OF END OF BUFFER STA LAST CLB CLEAR STB CLOCK THE PSEUDO-CLOCK OTB 1 CLEAR SWITCH REGISTER * JSB $LIBR SHUT OFF NORMAL INTERRUPTS PROCESSING NOP AND MEMORY-PROTECT LIA XMTIF CLEAR CARD BY READING IT LIA RCVIF " CLC RCVIF,C CLEAR INTERFACE CARDS BEFORE CLC XMTIF,C BEGINNING * LOOPX EQU * MAIN DATA LOOP SFS RCVIF DOES "RECEIVE" INTERFACE HAVE DATA? JMP XM1 NO, SEE IF "TRANSM;fIT" INTERFACE DOES. LIA RCVIF YES, LOAD DATA STA PNTR,I STORE IN BUFFER ISZ PNTR BUMP POINTER LDA CLOCK LOAD THE "CLOCK" WORD IOR =B100000 SET "RECEIVE" INDICATOR STA PNTR,I STORE IN BUFFER ISZ PNTR BUMP POINTER * XM1 EQU * SFS XMTIF DOES "TRANSMIT" INTERFACE HAVE DATA? JMP CNTR1 NO LIA XMTIF LOAD DATA STA PNTR,I STORE POINTER ISZ PNTR BUMP POINTER LDA CLOCK LOAD PSEUDO-CLOCK STA PNTR,I STORE ISZ PNTR BUMP POINTER * CNTR1 EQU * LDA LAST BUFFER CMA,INA ADA PNTR SSA,RSS FILLED? JMP FORM1 YES-- * BUFFERS NOT FILLED. * UPDATE PSEUDO "CLOCK" * CLA THIS LOOP USED TO SLOW DOWN THE "CLOCK". INA ADJUST THE REPETITION COUNTER FOR PARTICULAR CPA SCALE LINK SPEED USED (LARGER NUMBERS FOR SLOWER LINKS) RSS JMP *-3 LDA CLOCK INA SSA SIGN BIT SET? CLA YES, RESET CLOCK STA CLOCK LIB 1 LOAD SWITCH REGISTER OTA 1 UPDATE SWITCH REGISTER SSB,RSS SIGN BIT SET? JMP LOOPX SKP * HERE TO PRINT INFORMATION "TRACED" SO FAR * FORM1 EQU * LIA XMTIF CLEAR CARDS LIA RCVIF CLC XMTIF,C CLEAR BOTH INTERFACE CARDS CLC RCVIF,C JSB $LIBX RESTORE NORMAL RTE PROCESSING DEF *+1 DEF *+1 SSB WAS SIGN BIT SET IN SWITCH REGISTER? JMP EXIT YES--MUST STOP NOW SPC 2 LDA @BUFR CALCULATE CMA,INA NUMBER ADA PNTR OF STA NOBSV POINTS LOGGED * * HERE WHEN "TRACE" DATA BUFFER IS AVAILABLE. * TRC.7 EQU * ISZ NPASS BUMP PASS NUMBER NOP LDA NOBSV NOW CONVERT THIS TO ACTUAL CLB NUMBER OF DATA WORDS OBSERVED DITV NTENT STA NOBSV JSB CKDTA CHECK DATA FOR ABNORMAL PROTOCOL WORDS JSB SUBTL PRINT THE # RCS, STOPS, ETC. LDA MODE ARE WE TO IGNORE RAR BUFFERS CONTAINING NO ABNORMAL SLA,RSS DATA WORDS? JMP TRC.8 NO, DO IT ANYWAY. LDA NRLM WERE THERE ANY RLM'S? ADA NRLW OR RLW'S ADA NSTOP OR STOP'S SZA,RSS ??? JMP REDTA NO, SKIP THIS ONE. * TRC.8 EQU * LDA WRFIL ARE WE LOGGING DATA? SZA JMP TRC.9 YES, SKIP TITLES & STUFF JSB PBLNK PRINT A BLANK LINE * JSB CNUMD CONVERT # LOGGED DATA WORDS DEF *+3 DEF NOBSV DEF .NRC. JSB DEXEC DEF *+6 DEF NODE# DEF WRCOD "WRITE" CODE, NO ABORT DEF LUPRN DEF TITL1 DEF TTL1L NOP JSB DEXEC DEF *+6 DEF NODE# DEF WRCOD DEF LUPRN DEF TITL2 DEF TTL2L NOP JSB DEXEC DEF *+6 DEF NODE# DEF WRCOD DEF LUPRN DEF TITL3 DEF TTL3L NOP * * * JSB PBLNK PRINT BLANK LINE JSB CNUMD CONVERT PASS NUMBER DEF *+3 DEF NPASS DEF HED4. SPC 2 * WE WILL CONVERT SAMPLING TIME TO ASCII & SO IT CAN BE PRINTED * WITH THE PASS NUMBER. SINCE THE 'TRACE' INFORMATION MAY HAVE COME * FROM A DISC FILE, CONVERT ONLY THE TIME INFORMATION WHICH IS * SIGNIFICANT: HOUR,MINUTES, SECONDS. NOTE ALSO THAT THE * TIME-OF-DAY RETURNED COMES BACK * IN INCREASING ORDER OF SIGNIFICANCE, BUT TIME-OF-DAY IS * USUALLY PRINTED IN DESCENDING ORDER OF SIGNIFICANCE. THEREFORE, * THE POINTER TO THE TIME-OF-DAY INTEGERS IS DECREMENTED EACH * PASS THROUGH THE LOOP. * * SET UP CONVERSION LOOP LDA M4 CONVERT 4 ITEMS STA CNTR LDA @TOD SET UP TIME-OF-DAY POINTER TO ADA D3> "HOURS" WORD STA TRLP. LDA @HD4. SET UP ASCII STA TEMP BUFFER POINTER * TRLUP EQU * JSB KCVT CONVERT INTEGER TO ASCII DEF *+2 TRLP. NOP DEF TO TIME-OF-DAY STORED HERE STA TEMP,I STORE TWO-CHAR ASCII HERE CCA ADVANCE TIME-OF-DAY POINTER TO ADA TRLP. NEXT MOST SIGNIFICANT STA TRLP. ITEM. ISZ TEMP BUMP POINTER TO ASCII STORAGE AREA LDA COLON STORE A COLON TO SEPARATE DATA ITEMS STA TEMP,I ISZ TEMP ISZ CNTR FINISHED LOOP? JMP TRLUP NOT YET. * AT END OF LOOP, SUFFIX THE CENTOSECONDS WITH A "0" * SO IT APPEARS TO BE MILLISECONDS. CCA ADA TEMP LDB ASC0 STB A,I * JSB PRINT DEF HED4 DEF HED4L * LDA @BUFR LOAD ADDRESS OF TRACE BUFFER STA PNTR LDA NOBSV INITIALIZE LOOP CMA,INA COUNTER SZA,RSS JMP REDTA STA CNTR LOOP EQU * JSB IFBRK CHECK "BREAK" FLAG AGAIN DEF *+1 SSA SHALL WE QUIT? JMP EXIT YES. * * NOTE: WE WILL WANT TO SET UP THE VIDEO ENHANCEMENTS ACCORDING * TO THE TYPE OF PROTOCOL WORD. IT WILL BE INVERSE VIDEO IF RECEIVED, * OTHERWISE BLACK VIDEO. IT WILL BE FLASHING IF AN ABNORMAL PROTOCOL * WORD (RLM,RLW,STOP). * THESE MUST BE SET UP IN COMBINATION. * LDA @BVDO LOAD ADDRESS OF "BLACK VIDEO" LDB @PBF0 LOAD DESTINATION ADDRESS MVW D2 MOVE SET-UP WORDS * LDB PNTR,I GET DATA WORD FROM TRACE ENTRY LDA B JSB CASCI CHECK FOR VALID ASCII STA PBUF+9 CPB STOP IS IT 'STOP'? JMP .STOP YES, LOAD ADDRESS FOR "STOP" CPB RC IS IT 'REQUEST COMING'? JMP .RC YES, LOAD ADDRESS OF "RC" CPB TNW IS IT 'TRANSMIT NEXT WORD'? JMP .TNW YES, LOAD ADDRESS OF "TNW" S CPB RLW IS IT 'RE-TRANSMIT LAST WORD'? JMP .RLW YES, LOAD ADDRESS OF "RLW" CPB RLM IS IT 'RE-TRANSMIT LAST MESSAGE'? JMP .RLM YES, LOAD ADDRESS OF "RLM" LDA @UNKN OTHERWISE, IT'S UNKNOWN... JMP SET.. LOAD BLANKS--IT'S NOT RECOGNIZED SPC 2 .RC LDA @RC RSS .TNW LDA @TNW JMP SET.. .STOP LDA @STOP RSS LOAD ADDRESS OF "FLASHING" .RLM LDA @RLM LOAD ADDRESS OF 'RLM' JMP .FLSH GO LOAD ADDRESS OF "FLASHING" .RLW LDA @RLW .FLSH ISZ PBUF0+1 MODIFY VIDEO SET-UP TO INCLUDE "BLINKING" SET.. EQU * LDB WRFIL LOGGING DATA TO SZB A FILE? JMP PR..4 YES, SKIP THE FORMATTING JUNK... LDB @PBUF LOAD DESTINATION ADDRESS ADB D2 SKIP OVER FIRST 4 CHARACTERS (FILLED LATER) MVW D2 MOVE TO PRINT BUFFER JSB CNUMO CONVERT DATA TO OCTAL DEF *+3 DEF PNTR,I DEF PBUF+5 * LDB BLANK LOAD BLANKS STB PBUF+4 STB PBUF+8 STB PBUF+10 ISZ PNTR BUMP TO 2ND WORD OF ENTRY LDB =AX LOAD 'TRANSMIT' IDENTIFYING CODE LDA PNTR,I GET 2ND DATA ITEM (CLOCK) STA WORD SAVE IT FOR LATER. SSA RECEIVE? LDB =AR YES, LOAD 'RECEIVE' IDENTIFIER STB PBUF+1 STORE IDENTIFIER IN BUFFER RAL,CLE,ERA REMOVE SIGN BIT STA TEMP JSB CNUMD CONVERT CLOCK VALUE DEF *+3 DEF TEMP DEF PBUF+11 * * SET UP PRINT BUFFER POINTER AND LENGTH. * IF DEVICE IS A TERMINAL, THEN MOVE POINTER BACK * TO INCLUDE VIDEO ENHANCEMENT SET-UP AND * ADJUST LENGTH. IF WORD WAS RECEIVED, THEN * ENHANCEMENT WILL BE "INVERSE VIDEO", ELSE * BLACK VIDEO IS USED. * IF PROTOCOL WORD IS ABNORMAL, THEN INCLUDE THE * "BLINKING" OPTION. * LDA @PBUF STA BUFPT LDA PBUFL STA BUFPL LDA DVFLG IS PRINT DEV4ICE SSA,RSS A TERMINAL? JMP PR..1 NO. DON'T ENHANCE DISPLAY LDA @PBF0 MOVE POINTER TO INVERSE-VIDEO PART OF STA BUFPT BUFFER LDA TRMLN STA BUFPL LDA PBUF0+1 LOAD VIDEO SET-UP WORD LDB WORD LOAD EVENT/STATE SSB WAS PROTOCOL WORD RECEIVED? IOR D2 YES, INCLUDE "INVERSE VIDEO" BIT IN SET-UP STA PBUF0+1 RESTORE SET-UP WORD * * WE WILL MOVE THIS PRINT BUFFER INTO THE PRINT LINE, WHICH * WILL CONTAIN TWO PRINT BUFFERS WHEN IT IS PRINTED. * THAT IS, THE VIEWER WILL SEE SIDE-BY-SIDE WHAT WAS TRANSMITTED * AND WHAT WAS RECEIVED. * * WHEN THE SECOND ONE HAS BEEN MOVED IN, WE WILL PRINT THE WHOLE * PRINT LINE AND RESET ALL THE POINTERS & COUNTERS. * PR..1 EQU * LDA BUFPT MOVE THIS LDB BFPTR BUFFER TO MVW BUFPL PRINT LINE STB BFPTR SAVE POINTER FOR NEXT MOVE. LDA BUFFL UPDATE THE COUNT ADA BUFPL STA BUFFL ISZ NBUFR HAVE WE GOT TWO BUFFERS NOW? JMP PR..4 NO, GO ON. * * WE HAVE TWO BUFFERS. PRINT BOTH & RESET. * JSB PRINT @BUFF DEF BUFF POINTER TO PRINT-LINE BUFFER DEF BUFFL JSB RESET RESET ALL CNTRS & POINTERS * PR..4 EQU * ISZ PNTR BUMP POINTER TO NEXT ENTRY ISZ CNTR BUMP COUNTER--DONE? JMP LOOP NO. TRC.9 EQU * LDA WRFIL ARE WE SZA LOGGING DATA TO A FILE? JSB WRDTA YES, GO DO IT JMP REDTA NO, GO LOOK FOR MORE DATA. * * SUBROUTINE TO RESET ALL PRINT BUFFERS & POINTERS * RESET NOP CLA STA BUFFL CLEAR COUNT OF # WORDS IN PRINT LINE LDA M2 RESET 2-BUFFER COUNTER STA NBUFR LDA @BUFF RESET PRINT-LINE BUFFER STA BFPTR POINTER JMP RESET,I SKP * HERE TO SET UP FLAGS, ETC. TO READ DATA "RAW" FROM * TAPE D9EVICE * MTAPE EQU * LDA PBUFR LOAD TAPE LU STA INLUF SET "INPUT FROM TAPE" FLAG JMP TRC.4 CONTINUE MAIN FLOW SPC 4 * HERE WHEN USER SPECIFIES FILE NAME FOR INPUT OF * TRACE INFORMATION SPC 2 MFILE EQU * LDA DCB DO WE ALREADY HAVE SZA HAVE A FILE OPEN? JMP BAD1 YES--ILLEGAL RESPONSE! CCA STA INFIL SET "GET DATA FROM FILE" FLAG JSB OPEN TRY TO OPEN FILE DEF *+7 DEF DCB DEF ERR DEF FNAME DEF D1 OPEN IN "SHARED" MODE DEF SCODE DEF CRTG SSA ERROR? JMP FIERR YES, PRINT ERROR MSG & TERMINATE * JSB NAMX CALL NAMR FOR ME SSA SHALL WE DEFAULT? CLB,INB YES, AT LEAST ONE CMB,INB MAKE NEGATIVE TO CHECK SSB,RSS AT LEAST 1? CCB NO, SUBSTITUTE -1 CMB,INB POSITIVE AGAIN STB FREC STORE FIRST RECORD JSB NAMX CALL NAMR AGAIN SSA USE DEFAULT AGAIN? LDB =D32767 YES LDA FREC MAKE SURE IT'S AT LEAST CMA,INA AS LARGE AS ADA B THE SSA FIRST RECORD # LDB FREC NO, USE FIRST ONE. STB LREC * NOW POSITION TO FIRST RECORD JSB POSNT DEF *+5 DEF DCB DEF ERR DEF FREC DEF D1 ABSOLUTE POSITIONING CCA SET NPASS = RECORD # - 1 ADA FREC (IT WILL BE INCREMENTED AT STA NPASS TRC.7) JMP TRC.3 NOW BEGIN PRINTING DATA IN FILE SPC 2 * SUBROUTINE TO CALL NAMR FOR US * NAMX NOP JSB NAMR DEF *+5 DEF PBUF DEF BUFFR I WANT THE PARSE BUFFER IN A 'SCRATCH' AREA DEF NCHAR DEF NCNTR LDB PBUF LOAD THE RESULT JMP NAMX,I RETURN SKP SPC 2 * SUBROUTINE& TO GET NAME OF FILE INTO WHICH RAW 'TRACE' * BUFFERS ARE TO BE LOGGED. * GFILE EQU * CCA SET "LOGGING TO DISC FILE" FLAG STA WRFIL LDA LUTTY SET PRINT LU = TTY STA LUPRN JSB EXEC ASK FOR FILE OR LU DEF *+5 DEF D2 DEF LUTTY DEF MESG2 DEF MS2LL JSB EXEC INPUT FILE SPECIFIER DEF *+5 DEF D1 DEF LUTTY DEF BUFFR DEF M20 STB NCHAR SAVE TRANSMISSION LNTH CLA,INA STA NPNTR JSB NAMR PARSE IT DEF *+5 DEF PBUFR DEF BUFFR DEF NCHAR DEF NPNTR SSA GOOD INPUT? JMP BAD1 NO. LDA PBUFR+3 CHECK TYPE OF RESPONSE AND D3 CPA D1 NUMERIC? JMP GTAPE YES. LDA FSIZE GET # RECORDS DESIRED SZA,RSS ZERO? CLA,INA YES, DEFAULT TO 1 STA FSIZE CLB,CLE COMPUTE DISC FILE SIZE LDA FWSIZ STA FSIZE+1 SAVE RECORD SIZE MPY FSIZE FILE SIZE IN BLOCKS = (TRACE BUFFER SIZE+5) ADA D127 + 127 TO ROUND UP SEZ WAS THERE A CARRY? INB YES DIV D128 COMPUTE # BLOCKS REQUIRED STA FSIZE STORE FILE SIZE IN BLOCKS * * NOW CREATE THE FILE * JSB CREAT DEF *+8 DEF DCB DEF ERR DEF FNAME DEF FSIZE DEF D2 FILE TYPE IS 2 DEF SCODE DEF CRTG SSA,RSS ERROR? JMP OVWR1 NO. WE'RE IN BUSINESS! OPEN FILE SHARED&UPDATE CPA M2 DUPLICATE FILE NAME? JMP OVWRT YES, ASK IF WE CAN OVERWRITE * FIERR EQU * COME HERE FOR ALL FILE ERRORS. CMA,INA MAKE CODE NEGATIVE STA ERR JSB CNUMD CONVERT ERROR CODE DEF *+3 DEF ERR DEF MSG3. JSB EXEC PRINT ERROR MESSAGE DEF *+5 DEF D2c DEF LUTTY DEF MESG3 DEF MSG3L JMP EXIT TERMINATE * * COME HERE IF FILE ALREADY EXISTS. ASK IF WE CAN OVERWRITE. * OVWRT EQU * ASK IF WE CAN OVER-WRITE THE FILE? JSB EXEC DEF *+5 DEF D2 DEF LUTTY DEF MESG4 DEF MSG4L JSB EXEC READ RESPONSE DEF *+5 DEF D1 DEF LUTTY DEF BUFFR DEF D1 LDA BUFFR CPA =AYE YES? RSS NO, SO TERMINATE. JMP EXIT OVWR1 EQU * HERE TO OPEN THE FILE IN "SHARED" MODE JSB OPEN NOW OPEN FILE DEF *+7 DEF DCB DEF ERR DEF FNAME DEF D3 OPEN FOR UPDATE, IN "SHARED" MODE DEF SCODE DEF CRTG SSA ERROR? JMP FIERR YES, PRINT ERROR & QUIT. JMP REDTA NO, WE'RE IN BUSINESS! SPC 2 * HERE TO SET UP FLAGS, ETC., FOR OUTPUT OF RAW DATA * TO TAPE DEVICE. * GTAPE EQU * LDA PBUFR SET "OUTPUT RAW DATA TO FILE" FLAG STA WRFIL (FLAG CONTAINS + LU NUMBER) JMP REDTA RESUME MAIN FLOW SPC 2 * SUBROUTINE TO LOG DATA IN "RAW" FORMAT * WRDTA NOP LDA WRFIL GET OUTPUT FLAG SSA,RSS OUTPUT TO TAPE DEVICE? JMP WRTAP YES * WRDT2 EQU * JSB WRITF DEF *+5 DEF DCB DEF ERR DEF TOD DEF FWSIZ SSA,RSS ERROR? JMP WRDTA,I NO, RETURN CPA M12 WRITING PAST EOF? RSS YES JMP FIERR NO, PRINT CATASTROPHIC ERROR & TERMINATE LDA MODE SHALL WE RAR,RAR STOP SLA NOW? JMP EXIT YES. LDA RWFLG HAVE WE PRINTED "REWINDING" MESSAGE SSA ALREADY? JMP GFIL3 YES, DON'T BOTHER AGAIN CCA SET "PRINTED REWIND MSG" FLAG STA RWFLG JSB EXEC PRINT "/PSMON:REWINDING FILE" DEF a*+5 DEF D2 DEF LUTTY DEF MESG5 DEF MSG5L GFIL3 EQU * JSB RWNDF REWIND THE FILE AND DEF *+2 DEF DCB JMP WRDT2 WRITE THE DATA SPC 2 * HERE TO OUTPUT DATA TO TAPE * WRTAP EQU * LDA FWSIZ INITIALIZE # WORDS TO MOVE COUNTER STA TEMP LDA @TOD INITIALIZE BUFFER POINTER STA ..WR LDA D512 STA LENGH * WRLUP EQU * JSB DEXEC SEND DATA REMOTELY DEF *+6 DEF NODE# DEF WRCOD DEF WRFIL REMOTE LU # ..WR NOP BUFFER POINTER DEF LENGH LENGTH NOP IGNORE ERRORS LDA ..WR UPDATE POINTER ADA D512 STA ..WR LDA TEMP CMA,INA ADA D512 SSA,RSS DATA ALL WRITTEN? JMP WRDTA,I YES, RETURN * COMPUTE MINIMUM OF (512, # WORDS REMAINING TO SEND) LDB D512 ADB A CMA,INA NO, UPDATE NEW REMAINDER STA TEMP SSB,RSS REMAINDER < 512? STA LENGH YES. JMP WRLUP CONTINUE OUTPUTTING SPC 2 * HERE IF LINE LU GIVEN IS NON-NUMERIC OR NOT CONNECTED * TO DVA65 OR FORMAT OF RESPONSE IS OTHERWISE ILLEGAL. * BAD1 EQU * JSB EXEC DEF *+5 DEF D2 DEF LUTTY DEF BADMS DEF BADML JMP TRCC2 GO REPEAT QUESTION. SKP * PRINT ROUTINE * * CALLING SEQUENCE: * JSB PRINT * DEF BUFR * DEF BUFFER LENGTH * PRINT NOP DLD PRINT,I GET ADDRESS OF BUFFER & LENGTH DST @@ ISZ PRINT ISZ PRINT JSB DEXEC PRINT LINE DEF *+6 DEF NODE# DEF WRCOD DEF LUPRN @@ NOP ADDRESS OF BUFFER STORED HERE NOP ADDRESS OF LENGTH STORED HERE NOP JMP PRINT,I EXIT . SPC 2 * * SUBROUTINE TO CHECK DEVICE TYPE * * CALLING SEQUENCE: * JSB DVTYP * vDEF LU TO BE CHECKED * * * DVTYP NOP LDA DVTYP,I GET LU TO CHECK LDA A,I STA DLU ISZ DVTYP BUMP RETURN ADDRESS TO P+2 JSB DEXEC GET DEVICE STATUS DEF *+7 DEF NODE# DEF STCOD I O STATUS CODE, NO ABORT DEF DLU DEF EQT5 DEF EQT4 DUMMY PARAMETER DEF LUTYP LU & SUBCHANNEL STORED HERE NOP LDA LUTYP ISOLATE UNIT NUMBER AND =B377 STA B LDA EQT5 LOAD DEVICE TYPE CODE ALF,ALF ROTATE DEVICE TYPE TO LOW 8 BITS AND =B77 ISOLATE EQUIPMENT TYPE CODE CPA D5 IF DEVICE TYPE IS 5, SZB AND SUBCHANNEL IS 0, RSS THEN WE WILL ISZ DVTYP RETURN TO P+3 CPA D7 ELSE IF DEVICE TYPE IS 7, WE WILL ISZ DVTYP RETURN TO P+3 JMP DVTYP,I ELSE RETURN TO P+2 DLU NOP SPC 2 * SUBROUTINE TO PRINT A BLANK LINE * PBLNK NOP JSB PRINT PRINT THE BLANK LINE DEF BLANK DEF D1 JMP PBLNK,I RETURN TO CALLER * * ROUTINE TO CHECK IF (A) REGISTER CONTAINS TWO PRINTING * ASCII CHARACTERS. IF EITHER CHARACTER IS NON-PRINTING, * IT IS REPLACED BY A BLANK. * * CALLING SEQUENCE: * LDA * JSB CASCI * * CASCI NOP STA TEMP JSB CCK1 CHECK 1ST CHAR STA CHAR STORE CHARACTER LDA TEMP ALF,ALF NOW DO 2ND CHAR JSB CCK1 CHECK 2ND CHAR ALF,ALF ROTATE TO HIGH HALF IOR CHAR MERGE OTHER CHAR JMP CASCI,I RETURN TO CALLER * DEFINE TEMPORARY STORAGE FOR 'CASCI' CHAR NOP TEMP NOP SPC 2 CCK1 NOP AND =B377 MASK CHARACTER STA CCK2 LDA =B137 LOAD LEFT ARROW CMA,INA ADA CCK2 SUBTxRACT LEFT ARROW FROM CHARACTER SSA,RSS JMP LBLNK NO, LOAD A BLANK LDA =B40 SUBTRACT CMA,INA ADA CCK2 A BLANK SSA LESS THAN A BLANK? JMP LBLNK YES, LOAD A BLANK LDA CCK2 RECOVER CHARACTER RSS LBLNK LDA =B40 JMP CCK1,I RETURN CCK2 NOP TEMPORARY STORAGE FOR CCK1 SPC 2 * SUBROUTINE TO CHECK DATA FOR ABNORMAL PROTOCOL WORDS * CKDTA NOP LDA NOBSV INITIALIZE LOOP CMA,INA SZA,RSS ZERO? JMP CKDTA,I RETURN STA CNTR LDB @BUFR CKLUP EQU * LDA B,I LOAD DATA WORD CPA STOP STOP? ISZ NSTOP NOP CPA RLW RLW? ISZ NRLW NOP CPA RLM RLM? ISZ NRLM NOP CPA RC RC? ISZ NRC NOP ADB NTENT ADVANCE POINTER ISZ CNTR BUMP LOOP COUNTER JMP CKLUP CONTINUE LOOP JMP CKDTA,I EXIT LOOP, EXIT ROUTINE SKP * HERE TO EXIT * * * * EXIT EQU * JSB SUBTL PRINT SUB-TOTALS LDA WRFIL ARE WE SZA,RSS LOGGING DATA? JMP EXIT1 NO SSA YES, GOING TO A DEVICE? JMP EXIT2 NO, TO A BONA FIDE DISC FILE. * WRITE AN EOF ON REMOTE DEVICE LDA WRFIL IOR EOFCD STA TEMP JSB DEXEC WRITE AN EOF ON DEVICE DEF *+4 DEF NODE# DEF CNTCD CONTROL CODE, WITH NO ABORT DEF TEMP NOP JMP EXIT3 * EXIT1 EQU * HERE TO SEE IF WE SHOULD CLOSE DISC FILE LDA INFIL ARE WE READING DATA FROM A FILE? SSA,RSS JMP EXIT3 NO. EXIT2 EQU * JSB CLOSE DEF *+2 DEF DCB * EXIT3 EQU * JSB EXEC PRINT TERMINATION MESSAGE DEF *+5 DEF D2 DEF LUTTY DEF ENMSG DEF ENMSL JSB EXEC TERMINATE DEF *+2 DEF D6  SPC 2 * SUBROUTINE TO PRINT SUB-TOTAL INFORMATION * SUBTL NOP JSB CNUMD CONVERT # OF PASSES DEF *+3 DEF NPASS PASS NUMBER. DEF ENCNT JSB CNUMD CONVERT # 'RC'S SEEN DEF *+3 DEF NRC DEF .RC. JSB CNUMD CONVERT # RLMS DEF *+3 DEF NRLM DEF .RLM. JSB CNUMD CONVERT # RLW DEF *+3 DEF NRLW DEF .RLW. JSB CNUMD CONVERT # STOPS DEF *+3 DEF NSTOP DEF .STP. JSB EXEC PRINT SUB-TOTALS DEF *+5 DEF D2 DEF LUTTY DEF SUBMS DEF SUBML JMP SUBTL,I RETURN SKP * DATA BUFFERS AND CONSTANTS * M20 DEC -20 M12 DEC -12 M5 DEC -5 M2 DEC -2 M4 DEC -4 D0 DEC 0 D1 DEC 1 D2 DEC 2 WRCOD OCT 100002 "WRITE" CODE W/NO-ABORT BIT SET RDCOD OCT 100001 "READ" CODE W/ NO-ABORT BIT SET CNTCD OCT 100003 "CONTROL" CODE W/ NO-ABORT BIT SET TMCOD OCT 100013 TIME-OF-DAY CODE W/ NO-ABORT BIT SET EOFCD OCT 100 "EOF" CONTROL SUBFUNCTION CODE. D3 DEC 3 D5 DEC 5 D6 DEC 6 D7 DEC 7 D12 DEC 12 STCOD OCT 100015 I/O STATUS,NO ABORT D127 DEC 127 D128 DEC 128 B200 EQU D128 D512 DEC 512 SPC 4 ASC0 ASC 1,0 COLON ASC 1,: BLANK ASC 2, HED1 ASC 22,PASSIVE MONITOR 'TRACE'PROGRAM,REV 11-10-78 HED1L ABS *-HED1 HED4 ASC 4,RECORD # HED4. BSS 3 ASC 3,,TIME: HED4$ ASC 9, HED4L ABS *-HED4-1 @HD4. DEF HED4$ * BADMS ASC 8,ILLEGAL RESPONSE BADML ABS *-BADMS ENMSG ASC 5,PSMON:END ENMSL ABS *-ENMSG SUBMS ASC 3,PSMON: SUB-TOTALS MESSAGE ENCNT ASC 3, STORAGE # OF PASSES LOGGED HERE ASC 7, RECS LOGGED, .RC. ASC 3, STORE # RCS ASC 3, RCS, .RLM. ASC 3, STORE # RLM ASC 3, RLMS, .RLW. ASC 3, STORE # RLWS ASC 3, RLWS .STP. ASC 3, # STOPS ASC 3, STOPS SUBML ABS *-SUBMS * MESG2 ASC 9,FILE 87OR LU? MS2LL ABS *-MESG2 MESG3 ASC 6,FMP ERROR - MSG3. BSS 3 STORAGE FOR FMP ERROR CODE (IN ASCII) MSG3L ABS *-MESG3 MESG4 ASC 18,DUPL. FILE. OVERWRITE(YES OR NO)? MSG4L ABS *-MESG4 MESG5 ASC 11,/PSMON:REWINDING FILE MSG5L ABS *-MESG5 MSG1 ASC 28,DATA SOURCE:,LU, OR BLANKS TO TAKE 'LIVE' DATA?_ MSG1L ABS *-MSG1 @UNKN DEF *+1 ASC 2, @STOP DEF *+1 ASC 2,STOP @RC DEF *+1 ASC 2,RC @TNW DEF *+1 ASC 2,TNW @RLW DEF *+1 ASC 2,RLW @RLM DEF *+1 ASC 2,RLM * * LENGH NOP RWFLG NOP FLAG: 0 UNTIL "REWINDING FILE" MSG HAS BEEN PRINTED NBUFR NOP BFPTR NOP BUFFL NOP BUFPL NOP INFIL NOP FLAG FOR "GET DATA FROM FILE" INLUF NOP FLAG FOR "GET DATA FROM TAPE" WRFIL NOP FLAG FOR "STORE DATA IN FILE" LEN NOP FILE LENGTH NCNTR NOP FREC NOP FIRST RECORD NUMBER LREC NOP LAST RECORD NUMBER NPNTR NOP NSTOP NOP COUNTER OF NUMBER OF 'STOPS' SEEN NRLW NOP " " " " 'RLW'S " NRLM NOP " " " " 'RLM'S " NRC NOP " " " " 'RC'S " NTENT EQU D2 # WORDS PER TRACE TABLE ENTRY STOP OCT 7760 'STOP' WORD RC OCT 170017 'REQUEST COMING' WORD TNW OCT 170360 'TRANSMIT NEXT WORD' RLW OCT 7417 'RE-TRANSMIT LAST WORD' RLM OCT 170377 'RE-TRANSMIT LAST MESSAGE' BUFPT NOP WILL CONTAIN ADDRESS OF PRINT BUFFER * * NOTE: DO NOT DISTURB ORDER OF LOCATIONS PBUF0 THROUGH PBUFL. * WHEN OUTPUT IS TO A TERMINAL (DV.05 OR DV.07) AND THE PROTOCOL WORD FROM * THE TRACE BUFFER WAS RECEIVED,THE PRINT BUFFER CONSISTS OF LOCATIONS * PBUF THROUGH PBUFL-3. OTHERWISE, IT CONSISTS OF LOCATIONS PBUF THROUGH * PBUFL-3. THE TWO LOCATIONS ON EITHER SIDE OF THESE TWO POINTS * ARE USED, RESPECTIVELY, TO SET UP AND CLEAR INVERSE VIDEO. * PBUF0 ASC 3, STORAGE HERE FOR VIDEO SET-UP PBUF ASC 17, PBUFX EQU * PBUFR BSS 10 FNAME EQU PBUFR SCODE EQU PBUFR+4 CRTG EQU PBUFR+5 FSIZE EQU PBUFR+7 EQT5 NOP EQT4 NOP LUTYP NOP WORD NOP @PBUF DEF PBUF @PBF0 DEF PBUF0 TRMLN ABS PBUFX-PBUF0 PBUFL ABS PBUFX-PBUF BVDEO ASC 2,&d@ BLACK-VIDEO SETUP. @BVDO DEF BVDEO DVFLG NOP FLAG:-1 IF PRINTER IS TERMINAL, ELSE 0 DCB NOP BSS 143 BUFF BSS 48 PRAMS BSS 5 LUTTY EQU PRAMS LUPRN EQU PRAMS+1 NODE# EQU PRAMS+2 MODE EQU PRAMS+3 NPTS EQU PRAMS+4 NPRNT NOP NCHAR NOP CNTR NOP # POINTS/LOOP COUNTER LAST NOP "END+1" POINTER TO TRACE BUFFER NOBSV NOP # POINTS OBSERVED NPASS NOP PASS NUMBER PNTR NOP BUFFER POINTER CLOCK NOP PSEUDO "CLOCK" .SIZE EQU 4096 SIZE OF TRACE BUFFER TRACZ ABS .SIZE STORAGE FOR SIZE OF TRACE BUFFER MDFLT ABS -.SIZE FWSIZ NOP TRACZ SIZE OF LOGGED-DATA RECORDS A EQU 0 B EQU 1 SCALE DEC 6 ERR NOP TITL1 ASC 4,#LOGGED= .NRC. ASC 3, STORE # LOGGED DATA WORDS TTL1L ABS *-TITL1 TITL2 ASC 15,RX MNEM DATA ASCII CLOCK ASC 3, ASC 15,RX MNEM DATA ASCII CLOCK TTL2L ABS *-TITL2 TITL3 ASC 20,---------------------------------------- ASC 15,------------------------------ TTL3L ABS *-TITL3 * * TOD BSS 5 TIME-OF-DAY BUFFER BUFFR BSS .SIZE DATA BUFFER END PSMON ڊ `| 24999-18225 1902 S 0100 &TRC65              H0101 N{ASMB,R,L,C HED DS/1K 'TRACE' PRGM FOR DVA65 * (C) HEWLETT-PACKARD CO. 1979 NAM TRC65,22,45 25999-16225 REV.1902 790122 DVA65 'TRACE' PRGM * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * SPC 1 * * NAME: TRC65 * SOURCE: 24999-18225 * RELOC: 24999-16225 * PGMR: LYLE WEIMAN SEP 1978 * * 'TRACE' INFORMATION PRINTOUT PROGRAM FOR DVA65 * --REQUIRES VERSION OF DVA65 SUPPORTING 'TRACE' * * * *ON,TRC65,[LUTTY[,LUPRIN[,MODE]]] * * LUTTY = LU OF OPERATOR CONSOLE(MUST BE CAPABLE OF INPUT & OUTPUT) * USED FOR DIALOG AND ERROR MESSAGES. * DEFAULT IS YOUR TERMINAL (MTM ENVIRONMENT), ELSE 1 * * NOTE: SPECIAL FEATURES ARE INVOKED IF THE TERMINAL IS DRIVEN * USING DVR05 OR DVR07: * * 1) EACH LINE WHICH IS 'RECEIVED' (AS OPPOSED TO 'TRANSMITTED') IS * DISPLAYED IN INVERSE VIDEO. * * 2) ABNORMAL PROTOCOL INDICATIONS ('RLM', 'RLW', 'STOP') ARE * HIGHLIGHTED: 'RLM' & 'RLW' ARE UNDERLINED, 'STOP' IS SHOWN * BLINKING. REQUIRES OPTIONAL MODULES SUPPORTING THESE * FUNCTIONS BE INSTALLED IN THE 264X TERMINAL USED. * * 3) THE "TRACE RECORD NUMBER" PRINTED IS SHOWN * IN INVERSE VIDEO IF NOT CONSECUTIVE. * * LUPRIN= LU FOR PRINTING TRACE TABLE IF NOT THE SAME AS * USEFUL WHEN HARDCOPY LOG IS DESIRED. * DEFAULT IS LUTTY. * * NOTE: IF LUPRIN = 2, THEN ALL TRACE RECORDS WILL BE * RECORDED IN THEIR "RAW" FORM ON A DISC FILE, WHOSE * NAME & SIZE ARE THEN ASKED FOR BY THE PROG'RAM. * TRACE INFORMATION IS NORMALLY MAINTAINED IN A CIRCULAR * FASHION: OLD INFORMATION IS OVERWRITTEN BY NEW, THE * NUMBER OF "FRESH" TRACE RECORDS BEING DETERMINED BY * THE SIZE OF THE FILE. * * SYNTAX IS: FILNAM : SC : CR : :# RECORDS FOR FILE * * TO OBTAIN A FORMATTED PRINTOUT OF THIS INFORMATION, * SIMPLY SET THE 'BREAK' FLAG SO THE PROGRAM WILL * CLOSE THE FILE, THEN RE-RUN IT, SPECIFYING THE FILE * NAME IN RESPONSE TO THE QUESTION, "LINE LU?" * * NOTE: TO ENABLE FMGR & REMAT TO HANDLE "TRACE" FILES, * THE NUMBER OF "TRACE" ENTRIES PER RECORD WILL BE * REDUCED TO 30 (RECORD SIZE OF 128 WORDS) WHEN LOGGING * TO A FILE OR READING FROM ONE. * * : BIT MASK * BIT 0 = 0 CAUSES PROGRAM TO WAIT UNTIL WHOLE RECORD IS * FILLED BEFORE PRINTING. * = 1 THEN PROGRAM WILL PRINT CONTENTS OF TRACE RECORD, * CONTINUOUSLY, WITHOUT WAITING FOR SYNCHRONIZATION * FROM THE DRIVER. * * BIT 1 = 0 CAUSES PROGRAM TO PRINT DRIVER STATE LEGEND. * = 1 INHIBITS PRINTOUT OF DRIVER STATE LEGEND. * * BIT 2: USED ONLY WHEN 'TRACE' DATA IS BEING LOGGED TO A DISC FILE. * = 0 CAUSES PROGRAM TO REWIND FILE AUTOMATICALLY WHEN LAST RECORD * HAS BEEN WRITTEN. NEW DATA OVERLAYS OLD. THE MESSAGE * "/TRC65:REWINDING FILE" IS PRINTED AFTER THE FIRST TIME * TO INFORM YOU THAT THE DATA IN THE FILE IS NOW VALID. * * * = 1 CAUSES PROGRAM TO TERMINATE AS SOON AS THE LAST RECORD HAS * BEEN WRITTEN (ACTUALLY, WHEN THE ATTEMPT IS MADE TO WRITE * THE NEXT ONE AFTER THAT). THE FILE IS CLOSED AND THE * TERMINATION MESSAGE IS PRINTED. * * BIT 3: USED TO IGNORE 'TRACE' RECORDS WHICH DO NOT CONTAIN ABNORMAL * PROTOCOL WORDS. * = 0: PRINT/LOG ALL RECORDS * = 1: IGNORE ALL RECORDS CONTAINING NO ABNORMAL PROTOCOL WORDS. SKP * YOU WILL BE ASKED TO SPECIFY THE COMMUNICATION LINK LU TO * BE TRACED. IF YOU WANT ALL LINKS TRACED, ENTER THE NEGATIVE OF * ANY LINK LU. TO TERMINATE COMPLETELY, RELEASE ALL RESOURCES * AND DISABLE TRACE MODE, ENTER A ZERO. * * TO CHANGE THE PRINT LUS OR TRACE MODE, SET THE 'BREAK' FLAG * FOR THIS PROGRAM, AND RE-SCHEDULE IT. * * * THIS PROGRAM SEMI-PERMANENTLY ALLOCATES A BLOCK OF SYSTEM AVAILABLE * MEMORY TO BE USED AS THE TRACE BUFFER. THIS IS A POTENTIAL HAZARD * IF YOU LEAVE IT ALLOCATED FOR LONG PERIODS OF TIME (I.E., HOURS OR * DAYS) BECAUSE IT MAY BE LOCATED IN 'SAM' SUCH THAT IT PREVENTS LARGE * BUFFERS FROM EVER BEING ALLOCATED, THUS ALLOWING FOR THE POSSIBILITY * OF A "DEADLY EMBRACE". SINCE RTE DOES NOT * REALIZE THAT THIS BUFFER IS SEMI-PERMANENTLY ALLOCATED, IT * CANNOT DETECT THE "DEADLY EMBRACE" CONDITION WHICH EXISTS WHENEVER * A PROGRAM ATTEMPTS TO ALLOCATE A BUFFER WHICH IS SMALLER THAN THE * TOTAL AMOUNT OF FREE "SAM", BUT LARGER THAN THE FRAGMENTS LEFT- * OVER AFTER THIS PROGRAM IS RUN. IF YOU INTEND TO ALLOW THE * PROGRAM TO RUN FOR LONG PERIODS OF TIME, YOU SHOULD ATTEMPT TO * MINIMIZE THIS PROBLEM BY RUNNING IT IMMEDIATELY * AFTER 'LSTEN' IS RUN. THIS CAUSES THE "SAM" BLOCK ALLOCATED TO BE * LOCATED RIGHT AFTER THE "SAM" WHICH 'LSTEN' ALLOCATES. * NOTE THAT THIS REDUCES BUT DOES NOT ELIMINATE THE PROBLEM. * * * THE CLASS NUMBER AND RESOURCE NUMBER ALLOCATED ARE STORED IN 'RES', * THUS ELIMINATING THE DANGER THAT RESOURCES MAY BE LOST IF THIS * PROGRAM IS ABORTED. HOWEVER, IF IT IS ABORTED, YOU SHOULD * RUN IT AGAIN, SPECIFYING ZERO FOR THE LINE LU, TO ALLOW * IT TO CLEAN UP AFTER ITSELF. SKP * THE PRINT FORMAT SHOWN BELOW IS ACTUALLY REPEATED TWICE PER LINE: * * <^>

* * WHERE= 'X' IF WORD WAS TRANSMITTED * = 'R' IF WORD WAS RECEIVED. * <^>= AN UP-ARROW WILL BE PRINTED IMMEDIATELY FOLLOWING * IF A TIME-OUT INDICATION OCCURRED. * = A RIGHT-ARROW (->) IS PRINTED TO THE LEFT OF * THE OLDEST ENTRY * *

= MNEMONIC FOR PROTOCOL WORD * RC, TNW, RLM, RLW, STOP, OR BLANKS IF PROTOCOL * WORD IS NONE OF ABOVE. * NOTE: THE "LENGTH" WORDS WILL NOT NORMALLY MATCH * ANY OF THE ABOVE. * * = PROTOCOL WORD IN OCTAL. * * = DRIVER STATE NUMBER. A LEGEND IS PRINTED WHEN * THIS PROGRAM FIRST BEGINS. * * = EQT NUMBER (USEFUL IN SEPARATING ACTIVITY * AMONG VARIOUS LINES), PRINTED IN DECIMAL * = LOW 16 BITS OF $TIME WORD WHEN ENTRY WAS * MADE, CONVERTED TO DECIMAL. THIS PROVIDES * AN INDICATION OF THE AMOUNT OF TIME ELAPSED * BETWEEN THIS ENTRY AND THE PREVIOUS ONE. * EACH TICK REPRESENTS TEN MILLISECONDS. * * * NOTE: TO ANALYZE ANY PARTICULAR SEQUENCE, ONE MUST BE FAMILIAR WITH * THE LINE PROTOCOL (SEE NETWORK MANAGER'S MANUAL FOR DETAILS). * * TO CHANGE THE SIZE OF THE TRACE BUFFER, CHANGE '.SIZE'. * IT MUST BE A MULTIPLE OF 4, PLUS THREE EXTRA WORDS. * * * THE "TRACE" BUFFER FORMAT IS DESCRIBED IN THE COMMENTS * IN THE SOURCE OF DVA65. THE DISC FILE FORMAT IS THE SAME * EXCEPT THAT THREE WORDS HAVE BEEN ADDED IN FRONT: 2 TIME * WORDS AND THE LOCAL NODE NUMBER. THE RECCORD SIZE IS * REDUCED TO 128 WORDS AND THE TRACE BUFFER SIZE IS REDUCED * TO 30 ENTRIES IN THIS CASE. EXT CREAT,OPEN,CLOSE,READF,WRITF,RWNDF EXT EXEC,KCVT,POSNT EXT #TRCL,#TRCN,NAMR EXT RNRQ,IFBRK EXT CNUMO,CNUMD EXT RMPAR,TMVAL,$TIME EXT #NODE SUP TRC65 EQU * JSB RMPAR DEF *+2 DEF PRAMS CLB CLEAR FLAGS STB INFIL STB RWFLG STB WRFIL STB NDFLG STB NRC CLEAR # RCS COUNTER STB TSTOP CLEAR TOTAL # STOPS STB TRLW CLEAR TOTAL # RLWS STB TRLM CLEAR TOTAL # RLMS STB DCB SHOW WE DON'T HAVE ANY FILES OPEN. STB SKPFL AVOID THE 2-SEC DELAY BEFORE PRNTG 1ST BLOCK STB RECN CLEAR RECORD NUMBER COUNTER * JSB RESET SET UP ALL BUFFER POINTERS LDA LUTTY IS A CONSOLE SZA,RSS LU SPECIFIED? CLA,INA NO, DEFAULT TO 1 IOR =B400 SET "ECHO" BIT FOR INPUT STA LUTTY LDA LUPRN IS A PRINTOUT LU SZA,RSS SPECIFIED? LDA LUTTY NO, DEFAULT TO LUTTY CPA D2 FILE? JMP GFILE GET FILE NAME IOR B200 SET "HONESTY MODE" BIT STA LUPRN SPC 2 * LDA MODE PRINT 'STATE' RAR,SLA LEGEND? JMP TRCC2 NO. * * PRINT LEGEND * LDA @STAT STA PNTR P.LUP EQU * JSB PRINT PNTR NOP DEF @@HED LDA PNTR ADA @@HED STA PNTR CPA @@END FINISHED? RSS YES, GO ON. JMP P.LUP NO, CONTINUE * TRCC1 EQU * JSB PRINT PRINT HEADER DEF HED1 DEF HED1L * TRCC2 EQU * JSB EXEC "LINK LU, -LU TO TRACE ALL, OR ?" DEF *+5 DEF D2 DEF LUTTY DEF MSG1 DEF MSG1L JSB EXEC ASK FOR LU OR FILE NAME TO TRACE DEF *+5 DEF D1 (DEF LUTTY DEF BUFFR DEF M20 STB NCHAR CLA,INA STA NCNTR JSB NAMR PARSE RESPONSE DEF *+5 DEF PBUFR DEF BUFFR DEF NCHAR DEF NCNTR CLB CLEAR STB BUFFR PASS NUMBER COUNTER. SSA ANY INPUT? JMP EXIT NONE. TERMINATE. LDA PBUFR+3 GET TYPE CODE FOR RESPONSE. AND D3 CPA D3 ASCII? JMP MFILE YES CPA D1 NUMERIC? RSS JMP BAD1 NO, BAD INPUT. * JSB CNUMD CONVERT LINE LU TO ASCII DEF *+3 DEF PBUFR @.LU. DEF .LU. CLB,INB ASSUME TRACE IS JUST FOR THIS LINK. LDA PBUFR GET LU SZA,RSS ZERO? JMP EXIT YES, USER WANTS TO TERMINATE & RELEASE * RESOURCES SSA,RSS ALL LINKS TO BE TRACED? JMP TRC.0 NO, JUST THIS ONE. LDA @ALL MOVE "(ALL)" INTO "TRACE LU" BUFFER LDB @.LU. MVW D3 LDA PBUFR GET LU AGAIN CMA,INA MAKE POSITIVE CLB TRC.0 EQU * STB TROPT STORE TRACE OPTION STA LINK STORE LINK LU * * FIND LINK TYPE JSB DVTYP DEF LINK NOP CPA =B65 DEVICE TYPE = 65? RSS YES, GOOD THING! JMP BAD1 NO, SO IT'S NOT A VALID LINK LU. * * ALLOCATE A SYNCHRONIZATION RESOURCE NUMBER * * IT IS ALLOCATED AND LOCKED GLOBALLY FOR TWO REASONS: * 1) SO ANOTHER PROGRAM CAN BE WRITTEN BY THE USER * TO BRING THIS PROGRAM OUT OF 'RN SUSPEND', WHICH * IT CAN GET INTO IF ASKED TO TRACE AN INACTIVE * LINE. * 2) SO IF THIS PROGRAM IS ABORTED FOR ANY REASON, THEN * RE-RUN IN ANOTHER ID SEGMENT, THE RESOURCE NUMBER IT * ALLOCATES WILL STILL BE USABLE BY IT. * LDA #TRCN HAS ONE ALREADY SZA BEEN ALLOCATED? JMP TR..1 YES, SKIP ALcLOCATION JSB RNRQ ALLOCATE ONE DEF *+4 DEF B22 ALLOCATE & LOCK IT GLOBALLY DEF #TRCN STORE RESOURCE NUMBER IN "RES" MODULE DEF STAT STORE STATUS HERE. * TR..1 EQU * LDA #TRCL HAS A CLASS NUMBER SZA,RSS ALREADY BEEN ALLOCATED? JMP TRC.2 YES, SKIP CLEAN-UP LDA LINK TEMPORARILY IOR =B700 DISABLE STA ICNWD TRACE JSB EXEC MODE. DEF *+3 DEF D3 DEF ICNWD LDA #TRCL CLEAR ALL MODE BITS AND =B17777 IOR =B120000 SET "DO NOT DE-ALLOCATE CLASS" STA #TRCL AND "NO-WAIT" BITS * * CLEAR OUT CLASS BUFFERS * T...1 JSB GET RELEASE THIS BUFFER SSA,RSS ANY DATA? JMP T...1 YES, CONTINUE * TRC.2 EQU * SKP * * * * * ISSUE CLASS WRITE-READ TO ALLOCATE SOME SYSTEM AVAILABLE MEMORY. * * LDA LINK IOR =B700 SET SUBFUNCTION BITS FOR STA ICNWD 'ENABLE TRACE MODE' JSB EXEC HANG DUMMY CLASS 'WRITE' ON LINK EQT DEF *+8 DEF D20 DEF ICNWD DEF BUFFR DEF TRACZ TRACE BUFFER SIZE DEF TROPT TRACE OPTION DEF #TRCN RESOURCE NUMBER DEF #TRCL 'TRACE' BUFFER CLASS-I/O NUMBER SPC 2 LDA #TRCL CLEAR SPECIAL BITS AND =B17777 IOR =B60000 SET "SAVE BUFFER & CLASS #" BITS STA #TRCL AND =B377 CLEAR ALL SYSTEM BITS FROM CLASS # STA ICNWD FOR CONVERSION TO ASCII JSB PBLNK PRINT BLANK LINE JSB CNUMO CONVERT CLASS NUMBER DEF *+3 DEF ICNWD DEF .CLA. TO ASCII LDA #TRCN LOAD RESOURCE NUMBER AND =B377 MASK RN PART STA ICNWD SAVE FOR CONVERSION TO ASCII JSB CNUMD CONVERT RESOURCE NUMBER DEF *+3 DEF ICNWD DEF .RN. JSB PRINT DEF MSG2 DE2F MSG2L * * LOCK MYSELF IN MY PARTITION SO I CAN BE DISPATCHED QUICKLY. * JSB EXEC DEF *+3 DEF D22 DEF D1 * SPC 2 TRC.3 EQU * LDA WRFIL ARE WE LOGGING DATA SZA IN A FILE? JMP TRC.4 YES, DON'T PRINT THE HEADER JSB PRINT PRINT REST OF HEADER DEF HED2 DEF HED2L JSB PRINT DEF HED5 DEF HED5L JSB PRINT PRINT DASHES DEF HED3 DEF HED3L * SPC 2 SKP TRC.4 EQU * * SET A FLAG DEPENDING UPON PRINTOUT LU TYPE * JSB DVTYP DETERMINE TYPE OF PRINT DEVICE DEF LUPRN CLA,RSS RETURN HERE: IT'S NOT DV.05 OR DV.07 CCA RETURN HERE: IT'S DV.05 OR DV.07 STA DVFLG SAVE THE FLAG * * READ NEXT "TRACE" RECORD * REDTA EQU * ISZ RECN INCREMENT RECORD NUMBER COUNTER NOP (IT MIGHT ROLL OVER) JSB IFBRK CHECK 'BREAK' FLAG DEF *+1 SSA SET? JMP EXIT YES, WE MUST QUIT. * CLB STB NRLM STB NRLW STB NSTOP STB NPRNT CLEAR # HALF-PRINT LINES CNTR LDA TRACZ COMPUTE # ENTRIES TO PRINT DIV NTENT BY DIVIDING BUFFER SIZE BY # WORDS PER ENTRY STA NOBSV SAVE # OBSERVATIONS LDA INFIL ARE WE GETTING DATA SSA,RSS FROM A FILE? JMP TRC.6 NO, GET IT "LIVE" * * READ DATA FROM THE DISC FILE * LDA FREC GET RECORD NUMBER CMA,INA ADA LREC SSA ALREADY GOTTEN ALL DESIRED RECORDS? JMP EXIT YES ISZ FREC BUMP RECORD COUNTER NOP JSB READF READ "TRACE" BUFFER DEF *+6 DEF DCB DEF ERR DEF BTIME DEF FWSIZ DEF LEN * LDA ERR CHECK FOR ERRORS SSA,RSS ERROR? JMP RED.1 NO, GO ON CPA M12 EOF? JMP EXIT L YES, WE'RE DONE. JMP FIERR NO, PRINT THE ERROR & TERMINATE. * RED.1 EQU * LDA DVFLG IS THIS DEVICE SSA,RSS A TERMINAL? JMP TRC.7 NO, GO FORMAT DATA LDA SKPFL DID WE SKIP PRINTOUT OF LAST SZA,RSS RECORD (HAD NO ABNORMAL PROTOCOL WORDS)? JMP TRC.7 YES, DON'T DELAY * * GIVE USER A CHANCE TO READ THE PREVIOUS SCREEN FULL * OF OUTPUT BY DELAYING FOR TWO SECONDS. * JSB EXEC DEF *+6 DEF D12 DEF D0 DEF D2 SUSPEND FOR DEF D0 DEF M2 TWO SECONDS JMP TRC.7 NOW GO FORMAT DATA * * READ DATA DIRECTLY FROM THE "TRACE" BUFFER * (I.E., GET IT "LIVE") * TRC.6 EQU * JSB CNUMD CONVERT RECORD NUMBER DEF *+3 TO ASCII DEF RECN DEF .REC. LDA MODE SHOULD WE WAIT SLA FOR DRIVER TO FILL TRACE BUFFER? JMP TRAC3 NO, JUST PRINT IT. * LOCK RN SO WE WILL BE RE-SCHEDULED IMMEDIATELY * DRIVER RELEASES IT (I.E., AS SOON AS * THE BUFFER IS AVAILABLE). LDA D2 STA ICODE JSB RNRQ DEF *+4 DEF ICODE DEF #TRCN DEF STAT SPC 2 * OBTAIN A COPY OF THE TRACE BUFFER BY ISSUING A "GET" * CALL (SAM BUFFER IS RETAINED). * TRAC3 EQU * JSB GET DO "GET" DLD $TIME STORE TIME AT WHICH SAVE WAS MADE DST BTIME LOCALLY. LDA #NODE SAVE LOCAL NODE # STA NODE# SKP TRC.7 EQU * JSB CKDTA COUNT # ABNORMAL PROTOCOL WORDS & RCS LDA TRLM UPDATE TOTAL # RLMS OBSERVED ADA NRLM STA TRLM LDA TRLW UPDATE TOTAL # RLWS OBSERVED ADA NRLW STA TRLW LDA TSTOP UPDATE TOTAL # STOPS ADA NSTOP STA TSTOP LDA MODE ARE WE TO IGNORE RAR,RAR BUFFERS CONTAINING RAR NO RLMS, RLWS, >[ SLA,RSS OR STOPS? JMP TAKDT NO, TAKE IT ANYWAY. LDA NRLM WERE THERE ANY RLMS ADA NRLW OR RLWS ADA NSTOP OR STOPS STA SKPFL SZA,RSS ?? JMP REDTA NO, SKIP THIS ONE. * TAKDT EQU * HERE TO TAKE THE DATA BUFFER. CCA SET "DIDN'T SKIP LAST RECORD" FLAG STA SKPFL LDA WRFIL ARE WE LOGGING SZA TO A DISC FILE? JMP WRDTA YES. JSB PBLNK PRINT BLANK LINE JSB CNUMD CONVERT SUB-TOTAL OF # RCS DEF *+3 DEF NRC DEF .RC. JSB CNUMD CONVERT SUB-TOTAL OF # RLWS DEF *+3 DEF NRLW DEF .RLW. JSB CNUMD CONVERT SUB-TOTAL OF # RLMS DEF *+3 DEF NRLM DEF .RLM. JSB CNUMD CONVERT SUB-TOTAL OF # STOPS DEF *+3 DEF NSTOP DEF .STP. JSB PRINT PRINT SUB-TOTALS DEF SUBM1 DEF SUB1L * * * WE WILL CONVERT SAMPLING TIME TO ASCII SO IT CAN BE PRINTED * WITH THE PASS NUMBER. SINCE THE 'TRACE' INFORMATION MAY HAVE COME * FROM A DISC FILE, CONVERT ONLY THE TIME INFORMATION WHICH IS * SIGNIFICANT: HOUR,MINUTES, SECONDS. NOTE ALSO THAT THE * TIME-OF-DAY RETURNED BY SUBROUTINE 'TMVAL' COMES BACK * IN INCREASING ORDER OF SIGNIFICANCE, BUT TIME-OF-DAY IS * USUALLY PRINTED IN DESCENDING ORDER OF SIGNIFICANCE. THEREFORE, * THE POINTER TO THE TIME-OF-DAY INTEGERS IS DECREMENTED EACH * PASS THROUGH THE LOOP. * JSB TMVAL CONVERT SAMPLING TIME TO 5 INTEGERS DEF *+3 DEF BTIME @PTRT DEF PBUFR STORE 5 INTEGERS IN PARSE BUFFER * SET UP CONVERSION LOOP LDA M4 CONVERT 4 ITEMS STA CNTR LDA @PTRT SET UP TIME-OF-DAY POINTER TO ADA D3 "HOURS" WORD STA TRLP. LDA @HD4. SET UP ASCII STA STAT BUFFER POINTER * TRLUP EQU * JSB KCVT CONVERT INTEGER TO ASCII DEF *+2 TRLP. NOP DEF TO TIME-OF-DAY STORED HERE STA STAT,I STORE TWO-CHAR ASCII HERE CCA ADVANCE TIME-OF-DAY POINTER TO ADA TRLP. NEXT MOST SIGNIFICANT STA TRLP. ITEM. ISZ STAT BUMP POINTER TO ASCII STORAGE AREA LDA COLON STORE A COLON TO SEPARATE DATA ITEMS STA STAT,I ISZ STAT ISZ CNTR FINISHED LOOP? JMP TRLUP NOT YET. * AT END OF LOOP, SUFFIX THE CENTOSECONDS WITH A "0" * SO IT APPEARS TO BE MILLISECONDS. CCA ADA STAT LDB ASC0 STB A,I * LDA TRACN COMPUTE ADDRESS OF OLDEST ADA @TRAC TRACE ENTRY STA TRACN LDA NDFLG HAS THE "LOGGED AT NODE#" BEEN SSA PRINTED YET? JMP TRC6 YES, SKIP PRINTING CCA NO, CLEAR THE FLAG STA NDFLG JSB CNUMD CONVERT NUMBER DEF *+3 OF THE NODE DEF NODE# DOING THE LOGGING DEF .NOD. TO ASCII JSB PRINT DEF HED6 DEF HED6L * TRC6 EQU * JSB CNUMD CONVERT PASS NUMBER DEF *+3 DEF NPASS DEF .PAS. LDA @BLNK LOAD ADDRESS OF BLANKS LDB DVFLG IS PRINT SSB,RSS DEVICE A TERMINAL? JMP TRC.8 NO. LDB LSTPS LOAD LAST PASS NUMBER LDA @IVDO LOAD ADDRESS OF "INVERSE VIDEO" SET-UP CPB NPASS ARE WE ON THE SAME PASS AS BEFORE? LDA @BVDO YES, LOAD BLACK VIDEO SET-UP ADDRESS INB ARE WE ON THE VERY NEXT PASS? CPB NPASS ?? LDA @BVDO YES, LOAD BLACK VIDEO SET-UP TRC.8 EQU * LDB @DPEN LOAD DESTINATION ADDRESS MVW D2 MOVE SET-UP TO BUFFER JSB PRINT @DPEN DEF HED4 DEF HED4L LDA NPASS LOAD PASS NUMBER STA LSTPS STORE FOR CHECK NEXT TIME. * TRC.9 EQU * LDA @TRAC LOAD ADDGRESS OF TRACE BUFFER STA PNTR LDA TRACZ LOAD TRACE SIZE LDA NOBSV LOAD # 'TRACE' ENTRIES CMA,INA FORM COUNTER STA CNTR LOOP EQU * JSB IFBRK CHECK "BREAK" FLAG AGAIN DEF *+1 SSA SHALL WE QUIT? JMP EXIT YES. * * NOTE: WE WILL WANT TO SET UP THE VIDEO ENHANCEMENTS ACCORDING * TO THE TYPE OF PROTOCOL WORD. IT WILL BE INVERSE VIDEO IF RECEIVED, * OTHERWISE BLACK VIDEO. IT WILL BE FLASHING IF AN ABNORMAL PROTOCOL * WORD (RLM,RLW,STOP). * THESE MUST BE SET UP IN COMBINATION. * LDA @BVDO LOAD ADDRESS OF "BLACK VIDEO" LDB @PBF0 LOAD DESTINATION ADDRESS MVW D2 MOVE SET-UP WORDS * LDB PNTR,I GET DATA WORD FROM TRACE ENTRY CPB STOP IS IT 'STOP'? JMP .STOP YES, LOAD ADDRESS FOR "STOP" CPB RC IS IT 'REQUEST COMING'? JMP .RC YES, LOAD ADDRESS OF "RC" CPB TNW IS IT 'TRANSMIT NEXT WORD'? JMP .TNW YES, LOAD ADDRESS OF "TNW" CPB RLW IS IT 'RE-TRANSMIT LAST WORD'? JMP .RLW YES, LOAD ADDRESS OF "RLW" CPB RLM IS IT 'RE-TRANSMIT LAST MESSAGE'? JMP .RLM YES, LOAD ADDRESS OF "RLM" LDA @UNKN OTHERWISE, IT'S UNKNOWN... JMP SET.. LOAD BLANKS--IT'S NOT RECOGNIZED SPC 2 .RC LDA @RC RSS .TNW LDA @TNW JMP SET.. .STOP LDA @STOP RSS LOAD ADDRESS OF "FLASHING" .RLM LDA @RLM LOAD ADDRESS OF 'RLM' JMP .FLSH GO LOAD ADDRESS OF "FLASHING" .RLW LDA @RLW .FLSH ISZ PBUF0+1 MODIFY VIDEO SET-UP TO INCLUDE "BLINKING" SET.. EQU * LDB @PBUF LOAD DESTINATION ADDRESS ADB D2 SKIP OVER FIRST 4 CHARACTERS (FILLED LATER) MVW D2 MOVE TO PRINT BUFFER JSB CNUMO CONVERT DATA TO OCTAL DEF *+3 DEF PNTR,I DEF PBUF+5 * * STORE EITHER BLANKS IN FIRST CHARS, OR * A RIGHT ARROW (-d>) IF THIS IS THE OLDEST ENTRY. * LDB BLANK LOAD BLANKS STB PBUF+4 LDA PNTR CPA TRACN OLDEST? LDB RAROW YES, LOAD RIGHT ARROW (->) STB PBUF STORE IN PRINT BUFFER ISZ PNTR BUMP TO 2ND WORD OF ENTRY LDB =AX LOAD 'TRANSMIT' IDENTIFYING CODE LDA PNTR,I GET 2ND DATA ITEM (EVENT) STA WORD SAVE IT FOR LATER. SSA RECEIVE? LDB =AR YES, LOAD 'RECEIVE' IDENTIFIER SLA TIME-OUT OCCUR? ADB =B76 YES, MAKE 2ND CHAR UP-ARROW (^) STB PBUF+1 STORE IDENTIFIER IN BUFFER RAL,CLE,ERA REMOVE SIGN BIT ARS AND ISOLATE EVENT/STATE FIELD STA STAT SAVE FOR A FEW LINES... ISZ PNTR MOVE POINTER TO THIRD WORD OF ENTRY LDA EQTA CONVERT CMA,INA EQT ADA PNTR,I ADDRESS CLB TO DIV NWEQT AN INA EQT STA TEMP NUMBER JSB CNUMD CONVERT EQT NUMBER TO DECIMAL DEF *+3 DEF TEMP DEF PBUF+9 CONVERSION STORAGE * * NOW OVERLAY PART OF THE EQT NUMBER (IT'S MOSTLY LEADING * BLANKS ANYWAY) WITH THE -STATE- NUMBER * JSB KCVT DEF *+2 DEF STAT STATE LDB BLANK STORE IN BUFFER RRR 8 WITH BLANKS ON DST PBUF+8 EACH SIDE. ISZ PNTR BUMP POINTER TO 4RTH WORD OF ENTRY JSB CNUMD CONVERT TIME-OF-DAY AT WHICH ENTRY DEF *+3 WAS MADE DEF PNTR,I DEF PBUF+13 * * SET UP PRINT BUFFER POINTER AND LENGTH. * IF DEVICE IS A TERMINAL, THEN MOVE POINTER BACK * TO INCLUDE VIDEO ENHANCEMENT SET-UP AND * ADJUST LENGTH. IF WORD WAS RECEIVED, THEN * ENHANCEMENT WILL BE "INVERSE VIDEO", ELSE * BLACK VIDEO IS USED. * IF PROTOCOL WORD IS ABNORMAL, THEN INCLUDE THE * "BLINKING" OPTION. * LDA @PBUF 6 STA BUFPT LDA PBUFL STA BUFPL LDA DVFLG IS PRINT DEVICE SSA,RSS A TERMINAL? JMP PR..1 NO. DON'T ENHANCE DISPLAY LDA @PBF0 MOVE POINTER TO INVERSE-VIDEO PART OF STA BUFPT BUFFER LDA TRMLN STA BUFPL LDA PBUF0+1 LOAD VIDEO SET-UP WORD LDB WORD LOAD EVENT/STATE SSB WAS PROTOCOL WORD RECEIVED? IOR D2 YES, INCLUDE "INVERSE VIDEO" BIT IN SET-UP STA PBUF0+1 RESTORE SET-UP WORD * * WE WILL MOVE THIS PRINT BUFFER INTO THE PRINT LINE, WHICH * WILL CONTAIN TWO PRINT BUFFERS WHEN IT IS PRINTED. * THAT IS, THE VIEWER WILL SEE SIDE-BY-SIDE WHAT WAS TRANSMITTED * AND WHAT WAS RECEIVED. * * WHEN THE SECOND ONE HAS BEEN MOVED IN, WE WILL PRINT THE WHOLE * PRINT LINE AND RESET ALL THE POINTERS & COUNTERS. * PR..1 EQU * LDA BUFPT MOVE THIS LDB BFPTR BUFFER TO MVW BUFPL PRINT LINE STB BFPTR SAVE POINTER FOR NEXT MOVE. LDA BUFFL UPDATE THE COUNT ADA BUFPL STA BUFFL ISZ NBUFR HAVE WE GOT TWO BUFFERS NOW? JMP PR..4 NO, GO ON. * * WE HAVE TWO BUFFERS. PRINT BOTH & RESET. * JSB PRINT @BUFF DEF BUFF POINTER TO PRINT-LINE BUFFER DEF BUFFL JSB RESET RESET ALL CNTRS & POINTERS * PR..4 EQU * ISZ PNTR BUMP POINTER TO NEXT ENTRY ISZ CNTR BUMP COUNTER--DONE? JMP LOOP NO. JMP REDTA NO, GO LOOK FOR MORE DATA. * * SUBROUTINE TO RESET ALL PRINT BUFFERS & POINTERS * RESET NOP CLA STA BUFFL CLEAR COUNT OF # WORDS IN PRINT LINE LDA M2 RESET 2-BUFFER COUNTER STA NBUFR LDA @BUFF REST PRINT-LINE BUFFER STA BFPTR POINTER JMP RESET,I SKP * HERE WHEN 'BREAK' FLAG IS SET * * * WE CLEAR TRACE MODE & RELEASE RESOURCES. * EXIT EQU *  LDA LINK IOR =B700 STA ICNWD JSB EXEC ISSUE "DISABLE TRACE MODE" CALL TO DRIVER DEF *+3 DEF D3 DEF ICNWD * LDA #TRCL DO WE HAVE A CLASS SZA,RSS NUMBER ALLOCATED? JMP EXIT3 NO, SKIP DE-ALLOCATION. AND =B17777 CLEAR "DO NOT DE-ALLOCATE BUFFER" IOR =B100000 & SET "NO WAIT" BIT STA #TRCL JSB GET RELEASE CLASS BUFFER. JSB GET RELEASE CLASS NUMBER. CLA CLEAR STORAGE IN 'RES' STA #TRCL EXIT3 EQU * JSB CLOSE DEF *+2 DEF DCB LDA #TRCN DO WE HAVE A RESOURCE SZA,RSS NUMBER ALLOCATED? JMP EXIT4 NO, SKIP DE-ALLOCATION JSB RNRQ DEF *+4 DEF UNLKI DEF #TRCN DEF STAT NOP CLA STA #TRCN EXIT4 EQU * JSB CNUMD CONVERT # PASSES DEF *+3 DEF NPASS DEF ENCNT JSB CNUMD CONVERT TOTAL # RCS DEF *+3 DEF NRC DEF .RC. JSB CNUMD CONVERT TOTAL NUMBER OF RLWS DEF *+3 DEF TRLW DEF .RLW. JSB CNUMD CONVERT TOTAL NUMBER OF RLMS DEF *+3 DEF TRLM DEF .RLM. JSB CNUMD CONVERT TOTAL NUMBER OF STOPS DEF *+3 DEF TSTOP DEF .STP. JSB PRINT PRINT TERMINATION MESSAGE DEF ENMSG DEF ENMSL JSB EXEC TERMINATE DEF *+2 DEF D6 SPC 2 * SUBROUTINE TO PRINT SUB-TOTALS FOR * NUMBER OF ABNORMAL PROTOCOL ERRORS OBSERVED * SUBTL NOP JSB CNUMD CONVERT # OF PASSES DEF *+3 DEF BUFFR PASS NUMBER. DEF ENCNT JSB CNUMD CONVERT # 'RC'S SEEN DEF *+3 DEF NRC DEF .RC. JSB CNUMD CONVERT # RLMS DEF *+3 DEF NRLM DEF .RLM. JSB CNUMD CONVERT # RLW DEF *+3 DEF NRLW DEF .RLW. JSB CNUMN!D CONVERT # STOPS DEF *+3 DEF NSTOP DEF .STP. JSB PRINT PRINT SUBTOTALS DEF SUBMS DEF SUBML JMP SUBTL,I RETURN SKP * HERE WHEN USER SPECIFIES FILE NAME FOR INPUT OF * TRACE INFORMATION SPC 2 MFILE EQU * LDA DCB DO WE ALREADY HAVE SZA HAVE A FILE OPEN? JMP BAD1 YES--ILLEGAL RESPONSE! DLD FNAME MOVE FILE NAME TO "TRACE INPUT=...." DST .LU. LDA FNAME+2 STA .LU.+2 CCA STA INFIL SET "GET DATA FROM FILE" FLAG JSB OPEN TRY TO OPEN FILE DEF *+7 DEF DCB DEF ERR DEF FNAME DEF D1 OPEN IN "SHARED" MODE DEF SCODE DEF CRTG SSA ERROR? JMP FIERR YES, PRINT ERROR MSG & TERMINATE * JSB NAMX CALL NAMR FOR ME SSA SHALL WE DEFAULT? CLB,INB YES, AT LEAST ONE CMB,INB MAKE NEGATIVE TO CHECK SSB,RSS AT LEAST 1? CCB NO, SUBSTITUTE -1 CMB,INB POSITIVE AGAIN STB FREC STORE FIRST RECORD JSB NAMX CALL NAMR AGAIN SSA USE DEFAULT AGAIN? LDB =D32767 YES LDA FREC MAKE SURE IT'S AT LEAST CMA,INA AS LARGE AS ADA B THE SSA FIRST RECORD # LDB FREC NO, USE FIRST ONE. STB LREC * NOW POSITION TO FIRST RECORD JSB POSNT DEF *+5 DEF DCB DEF ERR DEF FREC DEF D1 ABSOLUTE POSITIONING JMP TRC.3 NOW BEGIN PRINTING DATA IN FILE SPC 2 * SUBROUTINE TO CALL NAMR FOR US * NAMX NOP JSB NAMR DEF *+5 DEF PBUF DEF BUFFR I WANT THE PARSE BUFFER IN A 'SCRATCH' AREA DEF NCHAR DEF NCNTR LDB PBUF LOAD THE RESULT JMP NAMX,I RETURN SKP SPC 2 * % SUBROUTINE TO GET NAME OF FILE TO USE FOR * OUTPUTTING RAW TRACE BUFFERS. * GFILE EQU * LDA LUTTY SET PRINT LU = TTY STA LUPRN STA WRFIL SET "WRITE TRACE DATA TO FILE" FLAG JSB EXEC ASK FOR FILE DEF *+5 DEF D2 DEF LUTTY DEF MESG2 DEF MS2LL JSB EXEC INPUT FILE SPECIFIER DEF *+5 DEF D1 DEF LUTTY DEF BUFFR DEF M20 STB NCHAR SAVE TRANSMISSION LNTH CLA,INA STA NPNTR JSB NAMR PARSE IT DEF *+5 DEF PBUFR DEF BUFFR DEF NCHAR DEF NPNTR SSA GOOD INPUT? JMP BAD1 NO. LDA FSIZE LOAD # RECORDS SPECIFIED. SZA,RSS DID HE FORGET TO SPECIFY? LDA D20 DEFAULT TO 20 RECORDS STA FSIZE CMA,INA SPECIFIED # RECORDS SSA,RSS > 0? JMP BAD1 NO. * * NOW CREATE THE FILE * JSB CREAT DEF *+8 DEF DCB DEF ERR DEF FNAME DEF FSIZE DEF D1 FILE TYPE IS 1 DEF SCODE DEF CRTG SSA,RSS ERROR? JMP OVWR1 NO. WE'RE IN BUSINESS! OPEN FILE SHARED&UPDATE CPA M2 DUPLICATE FILE NAME? JMP OVWRT YES, ASK IF WE CAN OVERWRITE * FIERR EQU * COME HERE FOR ALL FILE ERRORS. CMA,INA MAKE CODE NEGATIVE STA ERR JSB CNUMD CONVERT ERROR CODE DEF *+3 DEF ERR DEF MSG3. JSB EXEC PRINT ERROR MESSAGE DEF *+5 DEF D2 DEF LUTTY DEF MESG3 DEF MSG3L JMP EXIT TERMINATE * * COME HERE IF FILE ALREADY EXISTS. ASK IF WE CAN OVERWRITE. * OVWRT EQU * JSB EXEC DEF *+5 DEF D2 DEF LUTTY DEF MESG4 DEF MSG4L JSB EXEC READ RESPONSE DEF *+5 DEF D1 DEF LUTTY DEF BUFF"R DEF D1 LDA BUFFR CPA =AYE YES? RSS NO, SO TERMINATE. JMP EXIT OVWR1 EQU * HERE TO OPEN THE FILE IN "SHARED" MODE JSB OPEN NOW OPEN FILE DEF *+7 DEF DCB DEF ERR DEF FNAME DEF D3 OPEN FOR UPDATE & SHARED DEF SCODE DEF CRTG SSA ERROR? JMP FIERR YES, PRINT ERROR & QUIT. JMP TRCC1 NO, WE'RE IN BUSINESS! SPC 2 * HERE TO LOG DATA TO A DISC FILE * WRDTA EQU * WRDT1 JSB WRITF DEF *+5 DEF DCB DEF ERR DEF BTIME DEF FWSIZ SSA,RSS ERROR? JMP REDTA NO, GO GET NEXT RECORD CPA M12 WRITING PAST EOF? RSS YES JMP FIERR NO, PRINT CATASTROPHIC ERROR & TERMINATE LDA MODE SHALL WE RAR,RAR STOP SLA NOW? JMP EXIT YES. LDA RWFLG HAVE WE PRINTED "REWINDING" MESSAGE SSA ALREADY? JMP GFIL3 YES, DON'T BOTHER AGAIN CCA SET "PRINTED REWIND MSG" FLAG STA RWFLG JSB EXEC PRINT "/TRC65:REWINDING FILE" DEF *+5 DEF D2 DEF LUTTY DEF MESG5 DEF MSG5L GFIL3 EQU * JSB RWNDF REWIND THE FILE AND DEF *+2 DEF DCB JMP WRDT1 WRITE THE DATA SPC 2 * HERE IF LINE LU GIVEN IS NON-NUMERIC OR NOT CONNECTED * TO DVA65 OR FORMAT OF RESPONSE IS OTHERWISE ILLEGAL. * BAD1 EQU * JSB EXEC DEF *+5 DEF D2 DEF LUTTY DEF BADMS DEF BADML JMP TRCC2 GO REPEAT QUESTION. SPC 2 * * SUBROUTINE TO ISSUE A "GET" UPON ASSIGNED I/O CLASS NUMBER. * GET NOP JSB EXEC DEF *+6 DEF D21N DEF #TRCL DEF BUFFR DEF TRACZ DEF TEMP NOP IGNORE ERRORS JMP GET,I SKP * PRINT ROUTIN3E * * CALLING SEQUENCE: * JSB PRINT * DEF BUFR * DEF BUFFER LENGTH * PRINT NOP DLD PRINT,I GET ADDRESS OF BUFFER & LENGTH DST @@ ISZ PRINT ISZ PRINT JSB EXEC PRINT LINE DEF *+5 DEF D2 DEF LUPRN @@ NOP ADDRESS OF BUFFER STORED HERE NOP ADDRESS OF LENGTH STORED HERE JMP PRINT,I EXIT . SPC 2 * * SUBROUTINE TO CHECK DEVICE TYPE * * CALLING SEQUENCE: * JSB DVTYP * DEF LU TO BE CHECKED * * * DVTYP NOP LDA DVTYP,I GET LU TO CHECK LDA A,I STA DLU ISZ DVTYP BUMP RETURN ADDRESS TO P+2 JSB EXEC GET DEVICE STATUS DEF *+6 DEF D13 DEF DLU DEF EQT5 DEF EQT4 DUMMY PARAMETER DEF LUTYP LU & SUBCHANNEL STORED HERE LDA LUTYP ISOLATE UNIT NUMBER AND =B377 STA B LDA EQT5 LOAD DEVICE TYPE CODE ALF,ALF ROTATE DEVICE TYPE TO LOW 8 BITS AND =B77 ISOLATE EQUIPMENT TYPE CODE CPA D5 IF DEVICE TYPE IS 5, SZB AND SUBCHANNEL IS 0, RSS THEN WE WILL ISZ DVTYP RETURN TO P+3 CPA D7 ELSE IF DEVICE TYPE IS 7, WE WILL ISZ DVTYP RETURN TO P+3 JMP DVTYP,I ELSE RETURN TO P+2 DLU NOP SPC 2 * SUBROUTINE TO PRINT A BLANK LINE * PBLNK NOP JSB PRINT PRINT THE BLANK LINE DEF BLANK DEF D1 JMP PBLNK,I RETURN TO CALLER SPC 2 * SUBROUTINE TO CHECK DATA FOR ABNORMAL PROTOCOL WORDS * CKDTA NOP LDA NOBSV INITIALIZE LOOP CMA,INA SZA,RSS ZERO? JMP CKDTA,I RETURN STA CNTR LDB @TRAC CKLUP EQU * LDA B,I LOAD DATA WORD CPA STOP STOP? ISZ NSTOP NOP CPA RLW RLtW? ISZ NRLW NOP CPA RLM RLM? ISZ NRLM NOP CPA RC RC? ISZ NRC NOP ADB NTENT ADVANCE POINTER ISZ CNTR BUMP LOOP COUNTER JMP CKLUP CONTINUE LOOP JMP CKDTA,I EXIT LOOP, EXIT ROUTINE SPC 2 * DATA BUFFERS AND CONSTANTS * M20 DEC -20 M12 DEC -12 M4 DEC -4 M2 DEC -2 D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 B22 OCT 22 UNLKI OCT 40044 UNLOCK RN & RELEASE IT, NO-ABORT D12 DEC 12 D13 DEC 13 D20 DEC 20 D22 DEC 22 D122 DEC 122 D128 DEC 128 B200 EQU D128 D21N OCT 100025 CLASS 'GET', NO ABORT SKP HED1 ASC 16,DVA65 TRACE PROGRAM REV 1-22-79 HED1L ABS *-HED1 HED2 ASC 7,TRACE INPUT= .LU. BSS 3 TRACE LU OR FILE NAME STORED HERE HED2L ABS *-HED2 HED3 ASC 20,---------------------------------------- ASC 15,------------------------------ HED3L ABS *-HED3 HED4 EQU * ASC 2, STORE DISPLAY ENHANCEMENT HERE ASC 2,REC# .REC. ASC 3, STORE CONVERTED ASCII RECORD # HERE ASC 3,,PASS# .PAS. BSS 3 ASC 3,,TIME: HED4$ ASC 9, HED4L ABS *-HED4 @HD4. DEF HED4$ HED5 ASC 16,NXRX MNEM DATA STATE EQT# TICK# ASC 1, ASC 16,NXRX MNEM DATA STATE EQT# TICK# HED5L ABS *-HED5 HED6 ASC 8,LOGGED AT NODE # .NOD. BSS 3 ASCII STORAGE FOR NODE # WHERE LOGGED HED6L ABS *-HED6 * BADMS ASC 8,ILLEGAL RESPONSE BADML ABS *-BADMS * ENMSG ASC 5,TRC65:END SUBMS EQU * ENCNT ASC 3, STORAGE # OF PASSES LOGGED HERE ASC 7, RECS LOGGED, SUBM1 EQU * .RC. ASC 3, STORE # RCS ASC 3, RCS, .RLM. ASC 3, STORE # RLM ASC 3, RLMS, .RLW. ASC 3, STORE # RLWS ASC 3, RLWS .STP. ASC 3, # STOPS ASC 3, STOPS ENMSL ABS *-ENMSG SUBML ABS *-SUBMS-1 SUB1L ABS *-SUBM1-2 * MESG2 ASC 6,FILE ? MS2LL ABS *-MESG2 MESG3 V7ASC 6,FMP ERROR - MSG3. BSS 3 STORAGE FOR FMP ERROR CODE (IN ASCII) MSG3L ABS *-MESG3 MESG4 ASC 18,DUPL. FILE. OVERWRITE(YES OR NO)? MSG4L ABS *-MESG4 MESG5 ASC 11,/TRC65:REWINDING FILE MSG5L ABS *-MESG5 MSG1 ASC 19,LINK LU, -LU TO TRACE ALL, OR ?_ MSG1L ABS *-MSG1 MSG2 ASC 7,CLASS NUMBER = .CLA. BSS 3 ASC 3, RN #= .RN. BSS 3 ASC 2,(8) MSG2L ABS *-MSG2 @UNKN DEF *+1 ASC 2, @STOP DEF *+1 ASC 2,STOP @RC DEF *+1 ASC 2,RC @TNW DEF *+1 ASC 2,TNW @RLW DEF *+1 ASC 2,RLW @RLM DEF *+1 ASC 2,RLM * * STATE DESCRIPTIONS * @STAT DEF *+1 ASC 24, DRIVER LEGEND: ASC 24,---------------------------------------------- ASC 24,STATE 0:INITIATING READ, SENDING TNW ASC 24,STATE 1:WRITING, SENDING RC ASC 24,STATE 2:WRITING, SENT RC, EXPECT TNW ASC 24,STATE 3:WRITING, SENDING DATA LENGTH ASC 24,STATE 4:WRITING, SENT DATA LNTH, EXPECT ECHO ASC 24,STATE 5:WRITING, SENDING REQUEST LENGTH ASC 24,STATE 6:WRITING, SENT REQ. LNTH, EXPECT ECHO ASC 24,STATE 7:WRITE RETRY ASC 24,STATE 8:WRITE PREAMBLE FAILURE--RETRY ASC 24,STATE 9:YIELD FOR SIMULTANEOUS REQUEST ASC 24,STATE 10:WRITING, SENDING TNW, EXPECT TNW ASC 24,STATE 11:PERFORMING WRITE RETRY ASC 24,STATE 12:FIRST INTERRUPT IN LSTEN MODE, EXP.RC ASC 24,STATE 13:GOT 'RC', SEND 'TNW', EXP. DATA LEN ASC 24,STATE 14:RECEIVING, EXPECTING DATA LENGTH ASC 24,STATE 15:ECHOING DATA LENGTH, EXPECT REQ. LNTH ASC 24,STATE 16:RECEIVING, EXPECTING REQ. LNTH ASC 24,STATE 17:QUEUE BUSY, SENDING 'STOP' ASC 24,STATE 18:REQUEST TO SEND 'STOP' ASC 24,STATE 19:READ RQST, ECHOING RQST LNTH ASC 24,STATE 20:READ RQST, CHECKING RESPONSE ASC 24,STATE 21:BLOCK HAS BEEN READ, WAITING FOR TNW ASC 24,STATE 22:BLOCK READ BUT LAST CTRL UNREC ASC 24,STATE 23:CHECKING RESPONSE TO RLW ;]ASC 24,STATE 24:'STOP' RECEIVED DURING XMIT--ABORT ASC 24,STATE 25:PARITY ERROR(READ OR WRITE) ASC 24,STATE 26:PROTOCOL FAILURE ASC 24,STATE 27:TIME-OUT OCCURRED-END OF RQST ASC 24,STATE 28:SIMULTANEOUS REQUEST RETRY ASC 24,STATE 29:SEND 'STOP' AS 'LISTEN MODE' REJECT ASC 24,STATE 30:POWER FAILED! BLANK ASC 24, ASC 24, -> SHOWS OLDEST ENTRY. ^ INDICATES TIME-OUT ASC 24, R INDICATES RECEIVE, X INDICATES TRANSMIT @@END DEF * SIGNIFIES END OF LEGEND. @@HED DEC 24 # WORDS IN EACH EXPLANATION RWFLG NOP FLAG: 0 UNTIL "REWINDING FILE" MSG HAS BEEN PRINTED NBUFR NOP BFPTR NOP BUFFL NOP BUFPL NOP INFIL NOP FLAG FOR "GET DATA FROM FILE" NDFLG NOP FLAG: 0 UNTIL SOURCE NODE # FOR TRACE IS PRINTED SKPFL NOP FLAG:0 IF WE SKIPPED THE LAST RECORD WRFIL NOP FLAG FOR "STORE DATA IN FILE" LEN NOP FILE LENGTH NOBSV NOP NCNTR NOP FREC NOP FIRST RECORD NUMBER LREC NOP LAST RECORD NUMBER LSTPS NOP STORAGE FOR LAST PASS NUMBER ICNWD NOP NPNTR NOP NSTOP NOP COUNTER OF NUMBER OF 'STOPS' SEEN THIS PASS NRLW NOP " " " " 'RLW'S " " " NRLM NOP " " " " 'RLM'S " " " NRC NOP " " " " 'RC'S " " " TRLW NOP COUNTER OF TOTAL NUMBER OF RLWS SEEN TRLM NOP " " " " " RLMS " TSTOP NOP " " " " " STOPS " NTENT EQU D4 # WORDS PER TRACE TABLE ENTRY NWEQT DEC 15 NUMBER OF WORDS PER EQT ENTRY. STOP OCT 7760 'STOP' WORD RC OCT 170017 'REQUEST COMING' WORD TNW OCT 170360 'TRANSMIT NEXT WORD' RLW OCT 7417 'RE-TRANSMIT LAST WORD' RLM OCT 170377 'RE-TRANSMIT LAST MESSAGE' ALL ASC 3,(ALL) @ALL DEF ALL ASC0 ASC 1,0 COLON ASC 1,: ASCII COLON (:) BUFPT NOP WILL CONTAIN ADDRESS OF PRINT BUFFER * * NOTE: DO NOT DISTURB ORDER OF LOCATIONS PBUF0 THROUGH PBUFL. * WHEN OUTPUT IS TO A TERMINAL (DV.05 OR DV.07) AND THE PROTOCOL WORD FROM * THE TRACE BUFFER WAS RECEIVED,THE PRINT BUFFER CONSISTS OF LOCATIONS * PBUF THROUGH PBUFL-3. OTHERWISE, IT CONSISTS OF LOCATIONS PBUF THROUGH * PBUFL-3. THE TWO LOCATIONS ON EITHER SIDE OF THESE TWO POINTS * ARE USED, RESPECTIVELY, TO SET UP AND CLEAR INVERSE VIDEO. * PBUF0 ASC 3, STORAGE HERE FOR VIDEO SET-UP PBUF ASC 17, PBUFX EQU * TEMP NOP PBUFR BSS 10 FNAME EQU PBUFR SCODE EQU PBUFR+4 CRTG EQU PBUFR+5 FSIZE EQU PBUFR+7 ICODE NOP TROPT NOP EQT5 NOP EQT4 NOP LUTYP NOP WORD NOP @PBUF DEF PBUF @PBF0 DEF PBUF0 TRMLN ABS PBUFX-PBUF0 PBUFL ABS PBUFX-PBUF IVDEO ASC 2,&dB INVERSE VIDEO SETUP. BVDEO ASC 2,&d@ BLACK-VIDEO SETUP. @BVDO DEF BVDEO @IVDO DEF IVDEO @BLNK DEF BLANK DVFLG NOP FLAG:-1 IF PRINTER IS TERMINAL, ELSE 0 DCB BSS 144 BUFF BSS 48 PRAMS BSS 5 LUTTY EQU PRAMS LUPRN EQU PRAMS+1 MODE EQU PRAMS+2 STAT NOP NPRNT NOP RAROW ASC 1,-> RIGHT ARROW CNTR NOP RECN NOP RECORD NUMBER COUNTER NCHAR NOP LINK NOP @TRAC DEF BUFFR+2 ADDRESS OF TRACE TABLE .SIZE EQU 170 SIZE OF TRACE BUFFER TRACZ ABS .SIZE STORAGE FOR SIZE OF TRACE BUFFER BTIME BSS 2 DOUBLE-WORD TIME-OF-DAY STORAGE NODE# BSS 1 STORE NODE NUMBER HERE WHEN WRITING/READING BUFFR BSS .SIZE TRACE BUFFER FWSIZ ABS *-BTIME NPASS EQU BUFFR PASS COUNTER TRACN EQU BUFFR+1 * * A EQU 0 B EQU 1 EQTA EQU 1650B SPC 2 ERR NOP ..... EQU * SEE HOW BIG IT IS END TRC65 E a} 24999-18226 1902 S 0100 &DVT65              H0101 S|ASMB,R,Z,L,C IFZ HED DVA65 24999-16205 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 # NAM DVA65 24999-16205 REV 1913 790110 W/ TRACE # XIF IFN HED DVA65 91740-16071 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 NAM DVA65 91740-16071 REV 1913 790110 XIF SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 *************************************************************** * *DVA65 COMMUNICATIONS DRIVER FOR DS/1000 * ALL LINE INTERRUPTS HANDLED BY MICROCODE * EXCEPT PROTOCOL FOR LINES ABOVE PRIVILEGED SLOT * *SOURCE PART # 91740-18071 * *REL PART # 91740-16020 * *WRITTEN BY: CHUCK WHELAN * *DATE WRITTEN: DEC 1976 *MODIFIED BY: LYLE WEIMAN, AUG. '78, TO ADD TRACE CAPABILITY * (# IN RIGHT-HAND COLUMN MARKS CHANGES) *MODIFIED BY: CRAIG HAMILTON 09/07/78 TO IMPROVE ERROR RECOVERY. * * USE "Z" OPTION TO INCLUDE "TRACE" OPERATION # * USE "N" OPTION TO EXCLUDE "TRACE" OPERATION # * *************************************************************** SPC 3 * * DEFINE ENTRY POINTS * ENT IA65,CA65 ENT MIC$X SPC 1 * * DEFINE EXTERNALS * EXT $LIST,$OPSY IFZ EXT $TIME,$CGRN # XIF SKP * * CALLING SEQUENCES * SPC 2 * TRANSMIT OR RECEIVE REQUEST AND DATA SPC 1 * JSB EXEC * DEF *+7 * DEF RCODE OCT 1 * DEF CONWD LU (BIT 6= 1 IF WRITE, BIT 7= 1 IF PROGL) * DEF DBUF S DATA BUFFER ADDRESS * DEF DBUFL DATA BUFFER LENGTH * DEF RBUF REQUEST BUFFER ADDRESS * DEF RBUFL REQUEST BUFFER LENGTH * SPC 2 * ENABLE LISTEN MODE SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 100B+LU * SPC 2 * SEND STOP SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 0 + LU * SPC 2 * CLEAR REQUEST SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 200B + LU * SPC 2 * SKP * *##################################################################### * * SET UP TRACE BUFFER AND ENABLE TRACE MODE REQUEST # * # * JSB EXEC # * DEF *+5 # * DEF RCODE OCT 20 (CLASS WRITE-READ) # * DEF CONWD OCT 700B + LU # * DEF BUFR TRACE BUFFER # * DEF TRBFL TRACE BUFFER LENGTH-- MUST BE 4N + 3 # * WHERE N = # ENTRIES DESIRED IN TABLE. # * DEF RN# RN# = SYNCHRONIZING RESOURCE NUMBER # * (MUST BE ALLOCATED GLOBALLY AND LOCKED PRIOR TO # * CALL). THIS RN IS CLEARED EACH TIME DRIVER FILLS# * BUFFER, THUS PROVIDING SYNCHRONIZATION WITH TRACE# * PRINTOUT PROGRAM. # * DEF OPTN TRACE SELECTION OPTION # * DEF CLASS CLASS NUMBER (SET TO ZERO BEFORE CALL). # * # * THEREAFTER, WHENEVER A COPY OF THE CURRENT CONTENTS OF THE # * TRACE TABLE ARE DESIRED, THEY MAY BE OBTAIANED WITH A CLASS I/O # * "GET" CALL, USING THE CLASS NUMBER RETURNED FROM THE PREVIOUS # * SET-UP CALL. BE SURE TO SET THE "DO NOT DE-ALLOCATE BUFFER" # * BIT, OR DISASTROUS THINGS WILL HAPPEN!!!!!!!!!!! # * # * TRACE SELECTION SPECIFIER: # * 0 = TRACE ALL DVA65 ACTIVITY # * #0 = TRACE ONLY ACTIVITY FOR LU USED IN SET-UP CALL. # * # * "TRACE" BUFFER FORMAT: # * # * WORD 1 -- CONTAINS PASS NUMBER (INCREMENTED EACH TIME THE # * TRACE BUFFER IS RESET). USEFUL IN DETERMINING IF # * TRACE DATA HAS BEEN MISSED. # * WORD 2 -- CONTAINS ADDRESS OF NEXT ENTRY TO BE MADE IN TABLE # * ("OLDEST" ENTRY IN TABLE). # * WORD 3 -- BEGINS TRACE ENTRIES, FOUR WORDS PER ENTRY. # * ENTRY WORD 1 -- DATA WORD AS READ OR WRITTEN # * 2 -- R/X(BIT 15), STATE/EVENT, TIME-OUT INDICATION # * (BIT 0). BIT 15 IS SET IF WORD WAS RECEIVED, # * ELSE 0. BIT 0 IS SET IF A TIME-OUT OCCURRED,# * ELSE 0. # * DATA WORD NOT VALID IF TIME-OUT OCCURRED. # * 3 -- EQT ADDRESS # * 4 -- TIME-OF-DAY (LOW 16 BITS OF SYSTEM TIME WORD) # * # * # SPC 1 * ENABLE TRACE MODE REQUEST # * NOTE: YOU MUST HAVE MADE A SET-UP CALL PRsEVIOUSLY)# * # * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 1700B+ANY COMMUNICATION LU LINKED TO DVA65 # * # * DISABLE TRACE MODE REQUEST # * # * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 700B+ANY COMMUNICATION LU LINKED TO DVA65 # * # *##################################################################### SKP * * ERROR CODES (IN EQT 5 STATUS) * * BIT MEANING * 0 REQUEST COMPLETED...NO ERRORS * 1 REQUEST PENDING ON A WRITE, OR NOT PENDING ON A READ * 2 SIMULTANEOUS REQUEST REJECT * 3 TIME OUT * 4 STOP RECEIVED * 5 REMOTE BUSY * 6 PARITY ERROR OR PROTOCOL FAILURE * 7 WRITE FLAG (FOR "GRPM" AT CCE) * * * EQT WORD USAGE BREAKDOWN * * EQT # USE * 1 DEFINED * 2 DEFINED * 3 DEFINED * 4 DEFINED * 5 DEFINED * 6 DEFINED * 7 ADDRESS OF DATA BUFFER * 8 LENGTH OF DATA BUFFER * 9 ADDRESS OF REQUEST BUFFER * 10 LENGTH OF REQUEST BUFFER * 11 COROUTINE ADDRESS * 12 CURRENT STATUS TABLE (SEE BREAKDOWN) * 13 ADDRESS OF EQT EXTENSION * 14 DEFINED...USED FOR SINGLE WORD TURN-AROUND TIMEOUT * 15 j DEFINED...MICROCODE ALSO SETS TIME-OUTS * EXT(0) COUNTER FOR DATA TRANSFER * EXT(1) LAST WORD RECEIVED OVER COMM LINE * EXT(2) VERTICAL PARITY WORD / RP REQ LENGTH * EXT(3) DIAGONAL PARITY WORD / RP DATA LENGTH * EXT(4) COUNT OF TOTAL # BLOCKS TRANSMITTED * EXT(5) COUNT OF TOTAL NUMBER OF TRANSMIT-RETRIES * EXT(6) ID SEQ ADDRESS FOR SCHEDULE ON NEW REQUEST * * BREAKDOWN OF EQT WORD 12 * * BIT USAGE * 0-2 RETRY COUNTER OR * 0-5 BROKEN LINE COUNTER * 6 BROKEN LINE FLAG * 7-8 NOT USED * 9 REQUEST PENDING * 10 LISTEN MODE ENABLED * 11 RESERVED (USED BY SPECIAL FORCED-COLD-LOAD # * DRIVER, NOT PART OF DS/1000) # * 12 LAST SUCCESSFUL OPERATION (1=WRITE) * 13 FLAG FOR WRITE RETRY IN PROGRESS * 14 MICROCODE READ/WRITE FLAG * 15 POWER-FAIL RECOVERY IN PROGRESS # SKP * * DRIVER INITIALIZATION SECTION * IA65 NOP LDA EQT14 INA STA EQT15 REESTABLISH EQT15 ADDR JSB SETIO CONFIGURE I/O INSTRUCTIONS SERET LDB EQT13,I EXTENSION ADDRESS ADB B6 LDA 1,I GET 7TH EXT. WORD SZA IS THIS THE FIRST ENTRY FOR EQT? JMP NFIR NO * * THIS CODE IS EXECUTED ONLY ON FIRST TIME THROUGH FOR EQT * STA EQT12,I YES, INITIALIZE EQT12 STATUS STB TEMP 7TH WORD OF EXT. AREA * MODIFY INTERRUPT TABLE LDA CELL GET SELECT CODE ADA N6 SUBTRACT 6 TO FIND ADA INTBA ENTRY IN INTERRUPT TABLE LDB 0,I FETCH USER INTERRUPT LINK CMB,INB GET INTERRUPT LINK STB TEMP,I AND SAVE LDB EQT1 SET DRIVER STB 0,I INTERRUPT LINK JSB RDD.C CLEAR CARD T* MODIFY CODE IF A DMS SYSTEM LDB $OPSY SYSTEM TYPE CLA,CCE RBR,SLB DMS SYSTEM? STA MOD1 YES, MODIFY INSTRUCTIONS ERA CCB SET REGISTERS FOR CPU TYPE CHECK OCT 100060 THIS SETS B TO 0 IFF XE NOP LDA XEMIC MICROCODE CALL FOR XE SZB SKIP IF XE LDA MXMIC ELSE USE 21MX MICROCODE CALL STA MIC$X SAVE LOCALLY * LDA EQT4,I TELL RTE TO RETURN CONTROL ON TIME OUT, IOR .300 AND FOR POWER-FAIL RECOVERY. # STA EQT4,I SKP * NFIR LDB EQT5,I LDA EQT6,I GET REQUEST CODE AND B3703 ISOLATE IT CCE,SSB IS THIS A POWER-RECOVERY ENTRY? # JMP PFAIL YES, GO TO ABORT CURRENT OPERATION. # CPA B3 IS IT A STOP REQUEST? JMP STPRQ YES, SEND A "STOP". * DETERMINE OPERATION TYPE LDB 0 AND B3 MASK OFF CODE CPA B1 IS IT A READ? JMP REQ YES...READ OR WRITE/READ CPB B203 IS IT A CLEAR REQ? JMP CLREQ YES...CLEAR REQ. CPB B103 IS IT AN ENABLE LISTEN MODE JMP LCREQ YES IFZ CPB B703 DISABLE TRACE MODE? # JMP DTRAC YES. # CPB B1703 RE-ENABLE TRACE MODE? # JMP ETRAC # XIF * ERROR IN REQUEST HAS OCCURRED CLB,INB CODE FOR REQUEST ERROR SZA WAS IT A CONTROL CODE? REJCT INB YES, RETURN A 2 (CONTROL REQ. ERROR) JMP IDON * * B3 OCT 3 B6 OCT 6 B103 OCT 103 B203 OCT 203 B3703 OCT 3703 .300 OCT 30000 # MXMIC OCT 105520 XEMIC OCT 105300 IFZ B700 OCT 700 # B1700 OCT 1700 B703 OCT 703 # B1703 OCT 1703 f # XIF SKP * * SET UP ENABLE LISTEN MODE LCREQ LDA MIC$X INITIALIZE TO USE OPEN LOOP MICROCODE MOD1 JMP LCR2 NOP IF DMS SYSTEM CELL EQU *+1 XSA * DO CROSS-MAP STORE RSS LCR2 STA CELL,I NON-DMS, MODIFY TRAP CELL JSB RDD.C READ CARD TO CLEAR IT LISTI STC 0,C SET RECEIVE INTERRUPT MODE LDA .020 SET LISTEN ENABLED STATUS RSS CLREQ JSB RDD.C READ DATA AND STATUS FROM CARD TO CLEAR STA EQT12,I UPDATE EQT STATUS CLB,INB GOOD STATUS BIT JSB STAT PUT NEW STATUS IN EQT 5 LDB B4 SET FOR IMMEDIATE COMPLETION * * HERE FOR COMPLETION RETURN * EQT 12 WILL BE SET DEPENDING UPON LISTEN MODE * STATUS IDON STB TEMP SAVE COMPLETION STATUS LDA EQT12,I GET CURRENT DRIVER STATUS AND .020 MASK OFF ALL BUT LISTEN ENABLE LDB LSTNI GET ADDRESS OF LISTEN ENABLED ROUTINE SZA LISTEN MODE ENABLED? CLA,INA,RSS YES, ENABLE MICROCODE READ CLB NO STA EQTX,I SET TRANSFER COUNT LDA TEMP GET STATUS AGAIN STB EQT11,I SAVE COROUTINE ADDRESS JMP IA65,I RETURN TO RTE SYSTEM SKP * * COME HERE ON A READ OR WRITE * REQ EQU * IFZ LDA EQT6,I GET REQUEST # AND B1700 MASK SUBFUNCTION # CPA B700 ENABLE TRACE MODE CALL? # JMP TRAC. YES # XIF LDB EQT7,I GET ADDRESS OF DATA ADB N7 POINT TO 2ND WORD OF CLASS HDR LDA EQT14,I GET THIS EQT'S TIMEOUT IOR TBITS ENSURE BITS 15, 14, AND RAL 0 ARE SET FOR SYSTEM USE STA 1,I PASS TIMEOUT TO GRPM LDA EQT8,I DATA LENGTH CMA,INA ADA EQT9,I COMPUTE (REQ ADDR - DATA LEN) STA EQT7,I USE IT AS ACTUAL BUFFER ADDR * LDA MEQT12,I AND NMSK CLEAR UNNECESSARY FLAGS STA EQT12,I * LDB EQT6,I GET REQUEST CODE BLF,BLF RBL ALF,RAR ALF,ERA E = REQUEST PENDING FLAG LDA EQT8,I STA EQT6,I SET XMISSION LOG INTO EQT6 ADA EQT10,I COMBINE BOTH LENGTHS SLB,RSS IS THIS A WRITE TO SCE-1? STA EQT8,I NO, SAVE COMBINED LENGTHS LDA EQT5,I EQT STATUS WORD AND B1774 CLEAR BITS 7-0 SSB,RSS IS THIS A WRITE? CME,RSS NO, REVERSE RP FLAG IOR B200 YES, SET BIT 7 STA EQT5,I CLA,SEZ,INA SKIP IF (WRITE&NOT RP) OR (READ&RP) JMP BUSY OTHERWISE BUSY OR INVALID REQUEST SSB SKIP IF A READ JMP WREQ DO A WRITE SKP * * READ REQUEST * LDA EQT12,I AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I * REQ1 LDB EQT10,I GET RECEIVED RQST LENGTH LDA EQT4,I ALF,ALF GET LSB OF SUBCHANNEL RAL,ELA AND STORE IT IN E REG RBL,ERB ECHO WD WITH BIT15=1 IF CLOSED LOOP REQ2 EQU * IFZ LDA B23 STATE 19: READ RQST, ECHOING RQST LNTH# XIF JSB TALK READ RESPONSE IFZ LDA B24 STATE 20: READ RQST, CHECKING RESPONSE# XIF JSB CHECK CHECK RCVD WORD JMP REQ3 MUST RETRY ON TIMEOUT JMP ERR.7 STOP RECEIVED # JMP ERR.8 RC RCVD, PROTOCOL FAILURE CPB TNW JMP RDREQ "TNW" RCVD, OK TO READ-IN REQUEST CPB RLW RLW RECEIVED? JMP REQ1 YES, RE-ECHO REQUEST LENGTH * REQ3 JSB RETRY UNRECOGNIZED WORD RECEIVED LDB RLW SEND RLW AND JMP REQ2 TRY AGAIN SPC 2 * * SET-UP TO READ DATA BLOCK * RDREQ LDA EQT8,I DATA LENGTH CPA B2 IS THIS AN SCE-1 REQUEST? CLA,INA,RSS YES JMP RDBLK NO, INITIATE READ STA ;EQT8,I SET READ LENGTH TO 1 LDB EQT7,I BUFFER ADDRESS LDA EQT1 ADDR OF THIS EQT STA 1,I PASS IT TO PROGL IN 1ST WORD ISZ EQT7,I BUMP ADDR FOR BUFFER * * THIS SECTION INITIATES ALL MICROCODE BLOCK READS * RDBLK LDB EQT4,I LSL 9 SIGN = SUBCHANNEL LSB LDA MIC$X GET MICROCODE MACRO INSTRUCTION SSB SKIP IF SUBCHANNEL EVEN (XMIT MODE) INA ODD SUBCHANNEL, RUN CARD IN RCV MODE STA CELL,I STORE COMM.LINES TRAP CELL LDB TNW SEND TNW IFZ CLA STATE 0: INITIATING READ, SENDING TNW# XIF JSB OUTPB LDB EQT14,I & SET COMM LINE TIMEOUT STB EQT15,I LDA EQT8,I GET SUM OF DATA & REQ LENGTHS CMA -# OF WORDS -1 STA EQTX,I SET MICROCODE'S COUNTER JSB CEXIT NOW DO IT! * * BLOCK HAS BEEN READ, CHECK TRANSMISSION LDA COUNT MICROCODE COUNT ADA EQT8,I SSA SKIP IF XFER GOT STARTED JMP RDB4 ELSE RETRY, TNW MAY HAVE BEEN LOST # IFZ LDA B25 STATE 21: BLOCK HAS BEEN READ, # * WAITING FOR TNW# XIF JSB CHECK CHECK XMISSION JMP RDTO TIMEOUT, EXAMINE THE REASON. # JMP ERR.7 STOP RECEIVED # JMP ERR.8 REQUEST COMING: PROTOCOL FAILURE! # RDB2 CPB TNW WAS LAST A "TNW"? # JMP ENDIT YES, SUCCESSFUL READ. # RDTO CPB RLM REQUEST TO TRY AGAIN? # JMP RDB4 YES, SEE IF ALLOWED. # LDB COUNT IF THE MICROCODE COUNT HAS # CPB B100 BEEN SET =100B, THEN # JMP ER6WT A PROTOCOL FAILURE HAS BEEN DETECTED!# SZA ACTUAL TIMEOUT? # JMP ERR.3 YES, PROCESS THE ERROR. # * 3* LAST CONTROL UNRECOGNIZED IFZ LDA B26 STATE 22:BLOCK READ BUT LAST CTRL UNREC# XIF RDB3 LDB RLW SEND "RETRANSMIT LAST WORD # JSB TALK & READ RESPONSE IFZ LDA B27 STATE 23:CHECKING RESPONSE TO RLW # XIF JSB CHECK SEE WHAT WE GOT JMP RDB5 NO RESPONSE, TRY AGAIN, IF ALLOWED. # JMP ERR.7 STOP RECEIVED # JMP ERR.8 REQUEST COMING: PROTOCOL FAILURE! # JSB RETRY RETRY OUR RETRY JMP RDB2 * RDB4 JSB RETRY GIVE IT 8 TRIES JMP RDBLK * RDB5 JSB RETRY IF RETRIES ARE ALLOWABLE, # JMP RDB3 SEND RLW, AND AWAIT ACKNOWLEDGMENT. # SPC 2 * HERE WHEN 'STOP' RECEIVED ON "READ" * ERR.7 EQU * # JSB RTEQT RETURN EQT NUMBER # JMP ERR.4 AND TAKE 'STOP' EXIT # * RTEQT NOP SUBROUTINE TO RETURN EQT NUMBER # LDB EQT9,I # LDA EQT1 # STA B,I # JMP RTEQT,I RETURN TO CALLER # * * HERE ON RECEIVE PROTOCOL ERRORS--DELAY TO FORCE XMIT TIMEOUT # * ER6WT EQU * # JSB RTEQT RETURN EQT ADDRESS SO QCLM CAN PRINT EQT # LDA DM100 ALLOW A 1 SECOND DELAY # STA EQT15,I TO FORCE A TRANSMITTER TIMEOUT. # CLA DISABLE # STA EQTX,I MICROCODE. # JSB CEXIT AWAIT THE TIMEOUT RETURN. # LDB B100 INDICATE PROTOCOL FAILURE IN EQT5. # JMP CEND GO TO TERMINATE THE CURRENT OPERATION. # * DM100 DEC -100 # * SKP * * WRITE REQUEST H * WREQ LDA EQT9,I LDA 0,I GET 1ST WORD OF REQUEST SLB IS THIS A PROGL DOWNLOAD? STA EQT10,I YES, USE IT INSTEAD OF BUFFER LEN * WRTRY LDB RC IFZ CLA,INA STATE 1:WRITING, SENDING RC # XIF JSB TALK SEND RC & READ RESPONSE IFZ LDA B2 STATE 2:WRITING, SENT RC, EXPECT TNW# XIF JSB CHECK CHECK WHAT WE GOT JMP WRTR1 TRY AGAIN IF TIMEOUT JMP WRTRY STOP, RETRY IMMEDIATELY JMP SIMRQ RC, SIMULTANEOUS REQUEST CPB RLW RLW RECEIVED? JMP WRTRY YES, OTHER SIDE SAYS RETRY CPB TNW RSS SKIP IF "TNW" RECEIVED JMP WRTR1 UNRECOGNIZED, RETRY * SEND DATA LENGTH LDB EQT6,I IFZ LDA B3 STATE 3:WRITING, SENDING DATA LENGTH# XIF JSB TALK SEND DATA LENGTH, GET ECHO IFZ LDA B4 STATE 4:WRITING, SENT DATA LNTH, # * EXPECT ECHO # XIF JSB CHECK CHECK RESPONSE JMP ERR.3 TIMEOUT JMP TSDLN 'STOP' CODE MAY BE A VALID DATA LENGTH # JMP SIMRQ SIMULTANEOUS REQUEST TSDLN CPB EQT6,I ECHO OK? # JMP SRQLN YES # CPB STOP LEGITIMATE 'STOP'? # JMP ERR.4 YES, PROCESS IT. # JMP WRTR1 NO, RETRY * SEND REQUEST LENGTH SRQLN LDB EQT10,I REQUEST LENGTH # IFZ LDA B5 STATE 5:WRITING, SENDING REQUEST LENGTH# XIF JSB OUTPB SEND IT LDA B1776 STA EQT15,I APPROXIMATELY 1 SEC TIMEOUT JSB TRAPR SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT READ NEXT WORD WREQ2 EQU * IFZ LDA B6 STATE 6:WRITING, SENT REQ. LNTH, EXPECT ECHO# XIF JSB CHECK CHECK RESPONSE JMP WRG2TR1 TIMEOUT, RETRY JMP ERR.5 REMOTE IS BUSY JMP SIMRQ RC * CONFIGURE FOR EITHER CLOSED OR OPEN LOOP MICROCODE PROCESSING LDA EQT10,I ELA SAVE EQT10 SIGN LDA MIC$X MICROCODE CALL RBL,SLB,ERB IF BIT 15=1, RCVR WANTS CLOSED LOOP INA SET TO CALL CLOSED LOOP PROCESSOR STA CELL,I SET TRAP CELL CPB EQT10,I CHECK ECHOED RQST LENGTH JMP WRBLK LENGTH ECHO IS OK SKP * JSB RETRY NOT VALID ECHO, BUMP RETRY COUNT CPB RLW WAS IT AN RLW? (SCE-1 RETRY) JMP WRTRY YES, DO IMMEDIATE RC RETRY LDB RLW IFZ LDA B7 STATE 7:WRITE RETRY # XIF JSB TALK SEND RLW JMP WREQ2 * * REQUEST PREAMBLE WRITE FAILURE - WAIT 1 I/O T.O. AND RETRY THE RC# * WRTR1 JSB RETRY CHECK RETRY COUNT LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT DO READ IFZ LDA B10 STATE 8: REQUEST PREAMBLE WRITE FAILURE--RETRY# XIF JSB CHECK SEE WHAT WE GOT JMP WRTRY TIMED-OUT, RESEND RC JMP ERR.4 STOP RCVD, EXIT RSS RC, SIMULTANEOUS REQUEST JMP WRTRY UNRECOGNIZED, DO RC ANYWAY * * SIMULTANEOUS REQUEST OCCURRED, RESOLVE BASED ON LAST OPERATION * SIMRQ JSB RETRY DON'T TRY FOREVER LDA EQT12,I ALF,SLA TEST LAST SUCCESSFUL OPERATION RSS LAST WAS WRITE, WE MUST WAIT JMP WRTR1+1 LAST WAS READ, WE GET PRIORITY * LDB RLW IFZ LDA B11 STATE 9: WRITING, SIMULT.RQST, # * AM BACKING DOWN # XIF JSB XMITX SEND RLW IN XMIT MODE LDB B4 JMP CEND GIVE SIMULTANEOUS REQUEST STATUS SKP * ENTER HERE TO DO ALL BLOCK WRITES WRBLK LDB TNW THIS TNW WILL INITIATE MICROCODE IFZ LDA B12 STATE 10:WRITING, SENDING TNW, EXPECT TNW# XIF WXFER EQU * JSB OUTPB SEND IT LDB EQT14,I STB EQT15,I SET LINE TIMEOUT LDA EQT12,I IOR .400 SET MICROCODE WRITE BIT STA EQT12,I UPDATE EQT STATUS LDA EQT8,I LENGTH FOR XFER SZA,RSS JMP ENDIT ZERO LENGTH DATA, GET OUT NOW CMA -LENGTH-1 STA EQTX,I SET MICROCODE COUNTER JSB CEXIT LET MICROCODE DO ITS THING * * BLOCK HAS BEEN WRITTEN, CHECK TRANSMISSION LDA COUNT GET MICROCODE XFER COUNT, # LDB EQTX AND EQT EXTENSION ADDRESS. # SZA,RSS IF THE TRANSFER WAS SUCCESSFUL, THEN # JMP WRTOK COMPLETE THE HOUSEKEEPING. # * # CPA B77 IF PARITY FAILED # JMP WRTR2 GO TO RETRY THE TRANSFER. # CPA B100 IF PROTOCOL FAILED, # INB,RSS THEN SKIP TO DETERMINE THE REASON; # JMP ERR.3 ELSE, GIVE A TIMEOUT ERROR. # LDA B,I GET THE RECEIVED WORD. # CPA STOP IF A "STOP" WAS RECEIVED, # JMP ERRW4 THEN ABORT, AND INFORM THE CALLER. # CPA RC IF AN "RC" WAS RECEIVED, THEN THE RCVR # JMP SIMRQ IS OUT OF SYNC--RESOLVE THE CONFLICT. # JMP ERR.9 UN-RECOGNIZEABLE: PROTOCOL FAILURE! # * # WRTOK ADB B4 POINT TO DATA BLOCK XFER COUNTER. # ISZ B,I BUMP THE TOTAL SUCCESSFUL BLOCK COUNT. # NOP # JMP ENDIT COMPLETE THIS OPERATION. # * * PARITY FAILURE: PERFORM A WRITE RETRY # WRTR2 JSB RETRY CHECK RETRY COUNT W # ADB B5 POINT TO THE BLOCK RETRY COUNTER # ISZ B,I BUMP WRITE RETRY COUNTER NOP LDA EQT12,I IOR .200 SET "WRITE RETRY" FLAG STA EQT12,I LDB RLM "RETRANSMIT LAST MESSAGE" IFZ LDA B13 STATE 11: PERFORMING WRITE RETRY # XIF JMP WXFER PERFORM RE-WRITE SKP * LOCAL BUSY OR READ REJECT FOR NO R.P. BUSY CCB LDA EQT15,I IS THERE A TIMEOUT PENDING IOR EQTX,I OR IS MICROCODE ENABLED? SZA,RSS SKIP IF YES TO EITHER STB EQT15,I ELSE SYSTEM WIPED OUR TIMEOUT LDB B2 JSB STAT SET LOCAL BUSY FLAG LDA B4 IMMEDIATE COMPLETION LDB EQT6,I RETURN DATA LENGTH IN B JMP IA65,I RETURN * * HERE FOR REMOTE BUSY ERR.5 LDB B40 JMP CEND * # * HERE FOR PROTOCOL FAILURES ON 'READ' * STORE EQT ADDRESS IN 2ND BUFFER ERR.8 EQU * JSB RTEQT STORE EQT # JMP ERR.9 AND EXIT W/ PROTOCOL FAILURE STATUS # * * POWER FAIL: SEND 'STOP' & REPORT PROTOCOL ERROR; HIGHER LEVELS MAY RETRY # * # PFAIL LDA EQT12,I SET POWER-FAIL RECOVERY IN PROGRESS # RAL,ERA (EQT12: BIT#15) # STA EQT12,I INTO THE EXTENDED STATUS WORD. # IFZ LDA B13 STATE 13:POWER FAILURE RSS XIF * * HERE FOR PARITY ERROR ERR.6 EQU * # IFZ LDA B31 STATE 25: PARITY ERROR # RSS # XIF * * HERE ON ALL PROTOCOL FAILURES (WRITING & READING) * ERR.9 EQU * IFZ LDA B32 STATE 26:PROTOCOL FAILURE # XIF * * HERE TO SET ERROR, SEND STOP, & TERMINATE ERSET EQU * LDB B100 LOAD PARITY ERROR STATUS IFZ STA STATE SAVE DRIVER STATE # XIF JSB STAT PUT STATUS INTO EQT 5 LDB STOP IFZ LDA STATE LOAD STATE #(DEPENDS ON ERROR) # XIF JSB XMITX SEND STOP & AWAIT INTERRUPT JSB RDD.C CLEAR CARD BY READING IT LDA EQT5,I WAS THIS # ALF,ALF REQUEST # SSA A 'READ'? # JMP CEND+1 NO. # JSB RTEQT RETURN ADDRESS OF EQT IN 2ND BUFFER# JMP CEND+1 AND RETURN ERROR CODE. # * LSTNI DEF ILSTN B1 OCT 1 .020 OCT 2000 .010 OCT 1000 * B40 OCT 40 B77 OCT 77 B100 OCT 100 .100 OCT 10000 .200 OCT 20000 .400 OCT 40000 NMSK OCT 13100 TBITS OCT 160000 CLR9 OCT 176777 CLR11 OCT 173777 SKP * * THIS SUBROUTINE INITIALIZES THE EQT TIMEOUT FLAG, SETS THE * COMM LINE TRAP CELL TO A "JSB CIC" IF IT IS ABOVE THE * PRIVILEGED CARD AND SETS THE MICROCODE COUNTER TO 1. * TRAPR NOP LDA EQT4,I AND CLR11 CLEAR THE EQT4 TIMEOUT FLAG STA EQT4,I LDB CELL THIS LINE'S SELECT CODE CMB,INB ADB DUMMY TEST AGAINST PRIVILEGED CARD'S SC LDA MIC$X MICROCODE CALL MACRO SSB ARE WE ABOVE THE PRIVILEGED CARD? LDA TBG,I YES, GET A "JSB CIC" STA CELL,I SETUP TRAP CELL CLA,INA STA EQTX,I SET MICROCODE COUNT = 1 JMP TRAPR,I RETURN SPC 1 * * SEND WORD, SET TIMEOUT, & AWAIT RESPONSE * TALK NOP JSB OUTPB SEND WORD IN B REG LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAPCELL FOR 1 WORD READ LDA TALK COROUTINE RETURN ADDRESS JMP CEXT1 SPC 1 * * IF ALREADY 7 RETRIES, GIVE PARITY ERROR ELSE BUMP COUNT & RETURN * RETRY NOP LDA EQT12,I AND B7 ISOLATE RETRY COUNTER CPA B7 IS THIS THE 8TH RETRY? JMP FAIL YES, RETURN ERROR ISZ EQT12,I BUMP COUNT JMP RETRY,I & TRY AGAIN * FAIL LDB COUNT SZB WAS WORD COUNT ZERO? CPB B77 NO, WAS IT BLOCK PARITY? JMP ERR.6 RETURN A PARITY ERROR * * HERE FOR TIMEOUT ERR.3 LDB B10 TIMEOUT BIT FOR EQT5 IFZ LDA B33 XIF JMP ERSET EXIT WITH LINE T.O. ERROR SKP * * CONTINUATION SECTION * CA65 NOP JSB SETIO CONFIGURE I/O INSTRUCTIONS LDB EQT11,I GET COROUTINE ADDR SZB,RSS IT IT SET-UP? JMP IUNKN GO TO UNKNOWN INTERRUPT PROCESSOR LDA EQTX,I STA COUNT SAVE MICROCODE COUNT CLA STA EQTX,I DISABLE MICROCODE LDA EQT12,I AND .020 ISOLATE "LISTEN ENABLED" BIT IOR EQT1,I ALSO TEST FOR DRIVER BUSY SZA ARE EITHER CONDITION TRUE? JMP 1,I YES, GO TO COROUTINE ADDR ISZ CA65 * CLCRD JSB RDD.C CLEAR THE CARD JMP CEXT3 & GET OUT * * * * UNKNOWN INTERRUPTS COME HERE * WE'RE IN TROUBLE IF WE EVER GET HERE!!!!! * IUNKN STB EQT12,I CLEAR ALL CARD STATI LDB B77 SET ALL STATUS ERROR BITS JMP CEND GET OUT...NOW!!! * SKP * * HERE FOR FIRST INTERRUPT WHEN CARD IN LISTEN MODE * ILSTN LDA EQT12,I AND B1776 INITIALIZE BROKEN LINE COUNT STA EQT12,I * ILSN0 EQU * IFZ LDA B14 STATE 12: FIRST INTERRUPT IN LSTEN MODE, EXP.RC # XIF JSB CHECK FIND OUT WHAT THEY SENT US JMP ILSN4 TIME OUT...IGNORE JMP ILSN4 STOP...IGNORE JMP ILSN1 REQUEST COMING * * ENTER HERE WHEN UNRECOGNIZED WORD RECEIVED WHILE "LISTENING" SZB ZERO RECEIVED? JMP ILSN4 NO, JUST Io<GNORE IT JSB RDD.C CLEAR COMMUNICATIONS CARD LDA EQT12,I ISZ EQT12,I BUMP BROKEN LINE COUNT AND B77 CPA B77 64 ZEROES IN A ROW = BROKEN LINE! JMP DEXIT IT IS, LEAVE CARD DISABLED & EXIT JSB TRAPR SETUP FOR 1 WORD READ JSB CEXIT EXIT IN RCV MODE JMP ILSN0 GOT ANOTHER WORD, GO CHECK IT * ILSN1 LDA EQT12,I EQT STATUS IOR .010 SET REQUEST PENDING FLAG STA EQT12,I SAVE IT * ILSN2 LDB TNW SEND A TNW IFZ LDA B15 STATE 13: GOT RC, SENDING TNW, EXP.DATA LNTH # XIF JSB TALK & WAIT FOR DATA LENGTH IFZ LDA B16 STATE 14: RECEIVING, EXPECTING DATA LENGTH # XIF JSB PRECK DO PREAMBLE CHECKING ADA B3 POINT TO EXT(3) STB 0,I SAVE DATA LENGTH FOR PROGRAM IFZ LDA B17 STATE 15: ECHOING DATA LENGTH, EXPECT REQ. LNTH # XIF JSB TALK ECHO IT & GET REQUEST LENGTH IFZ LDA B20 STATE 16: RECEIVING, EXPECTING REQ. LNTH # XIF JSB PRECK DO PREAMBLE CHECKING ADA B2 POINT TO EXT(2) STB 0,I SAVE RQST LENGTH FOR PROGRAM ADA B4 POINT TO EXT(6) LDB 0,I GET I/O ADDRESS OF PROGRAM STB PROG SAVE ADDRESS ADB B17 GET TO STATUS LDA 1,I GET STATUS AND B17 MASK OFF ALL BUT STATUS SZA BUSY? JMP ILSN3 YES...TELL OTHER SIDE TO RETRY ADB N5 ID SEG B REG SAVE AREA LDA EQT4 GET ADDRESS OF LU STA 1,I PASS IT IN B REG JSB $LIST SCHEDULE PROGRAM OCT 101 PROG NOP ILSN4 JSB RDD.C CLEAR CARD BY READING IT JSB TRAPR SETUP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI SET FOR LISTEN MODE INTERRUPT JMP CEXT1 AND EXIT * * HERE IF WE GOT A "BUSY" CONDITION * ILSN3 LDB STOP SEND STOuP TO INDICATE "REMOTE BUSY" IFZ LDA B21 STATE 17: QUEUE BUSY, SENDING 'STOP' # XIF JSB OUTPB SEND IT * * HERE ON STOP...CLEAR REQUEST PENDING STATUS * ILSN5 LDA EQT12,I AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I JMP ILSN4 TERMINATE * * SUBROUTINE TO CHECK RCVD PREAMBLE WORD & RETRY IF RC * PRECK NOP JSB CHECK CHECK RCVD WORD JMP ILSN5 TIME-OUT, CLEAR RP CONDITION RSS 7760B IS POSSIBLE DATA LEN JMP ILSN2 RC, RESTART PREAMBLE LDA EQTX PASS EXT AREA ADDR BACK JMP PRECK,I * SKP * * HERE FOR SEND STOP REQUEST * STPRQ LDB STOP SEND STOP CLA DON'T ALTER STA CELL TRAP CELL. IFZ LDA B22 STATE 18: REQUEST TO SEND 'STOP' # # XIF JSB XMITX IN XMIT MODE JSB RDD.C READ CARD TO CLEAR IT STA CELL LDA EQT12,I AND BSTMK SAVE LISTEN, BROKEN LINE, & LAST OP.BITS JMP ENDOK * * NOW SET FLAG TO SHOW WHETHER THE LAST SUCCESSFUL OPERATION WAS A * READ OR WRITE. THIS IS USED TO RESOLVE SIMULTANEOUS LINE CONTENTION. ENDIT LDA EQT12,I AND .020 SAVE "LISTEN ENABLED" FLAG LDB EQT5,I BLF,BLF SSB SKIP IF READ IOR .100 SET LAST OPERATION AS WRITE * ENDOK STA EQT12,I SET STATUS CLB,INB SET GOOD STATUS # JMP CEND # * * 'STOP' RECEIVED SOMETIME DURING TRANSMISSION ERRW4 EQU * IFZ CH.01 NOP 'RSS' HERE WHEN TRACE MODE ENABLED # JMP ERR.4 SKIP 'TRACE' STUFF WHEN DISABLED # JSB CKTRC CHECK IF WE'RE TO TRACE THIS ONE # JMP ERR.4 NO, CONTINUE LDB B30 STATE 24:'STOP' RC'D DURING XMIT-ABORT# JSB TRACE # LDB STOP )i # IOR SBIT SET 'RECEIVE' INDICATOR JSB TRACE # LDB EQT1 # JSB TRACE # LDB $TIME # JSB TRACE # XIF # * * 'STOP' RECEIVED EXIT * ERR.4 EQU * LDB B20 SKP * * HERE TO TERMINATE * CEND JSB STAT UPDATE EQT 5 STATUS LDA EQT12,I GET CARD STATUS WORD AND .020 IS IT LISTEN MODE? SZA,RSS JMP CLCRD NO, CLEAR CARD & EXIT JSB TRAPR SET UP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI GET LISTEN INTERRUPT JMP CEXT2 AND LEAVE * * HERE TO DO CONTINUATION RETURN * CEXIT NOP LDA CEXIT GET NEXT INTERRUPT ADDRESS CEXT1 ISZ CA65 BUMP CONTINUATOR RETURN CEXT2 STC 0,C SET FOR RECEIVE MODE CEXT3 STA EQT11,I SAVE NEW INTERRUPT LOCATION CEXT4 CLA LDB SETIO CPB I65AD WAS THIS ENTRY VIA INITIATOR? JMP IA65,I YES, THEN RETURN THE SAME WAY LDB EQT6,I GET EQT6 IN CASE IT'S COMPLETION JMP CA65,I RETURN * I65AD DEF SERET SPC 3 * * SUBROUTINE TO PUT NEW STATUS INTO EQT WORD 5 * STAT NOP LDA EQT10 STA EQT15 FOOL RTE SO IT LEAVES TIMEOUT ALONE LDA EQT5,I GET WORD 5 AND B1776 MASK OFF OLD STATUS IOR 1 STUFF IN NEW STATUS STA EQT5,I AND PUT IT AWAY JMP STAT,I RETURN * SKP * * ROUTINE TO DO CHECKING OF INPUT DATA * * CALLING SEQUENCE: * IF 'TRACE' MODE, LOAD (A) WITH DRIVER STATE NUMBER * JSB CHECK * WILL RETURN P+1 TIME OUT * P+2 STOP RECEIVED * P+3 REQUEST COMING RECEIVED * P+4 NORMAL RETURN...B REG= LAST DATA WORD * CHECK NOP 5b LDB EQTX EQT EXTENSION ADDRESS INB LDB 1,I LOAD LAST WORD RECEIVED IFZ STA STATE SAVE (TRACE VERSION ONLY) # XIF LDA EQT4,I WAS THIS ENTRY # AND .040 VIA # SZA TIME-OUT? # JMP CHCK1 YES, DATA IN (B) # * * THERE WAS NO TIMEOUT. CLEAR 'COUNT' WORD * SO WE DON'T THINK THERE WAS A TIME-OUT, * DISABLE CARD, AND PICK UP DATA DIRECTLY FROM * INTERFACE CARD. STA COUNT CLCC1 CLC 0,C LIB1 LIB 0 CHCK1 EQU * # IFZ # CH.00 NOP CHANGED TO 'RSS' WHEN TRACING IS ENABLED # JMP CHEC0 SKIP OVER 'TRACE' CODE WHEN NOT ENABLED # STB RDD.C SAVE FOR JUST A SECOND # JSB CKTRC SHOULD WE TRACE THIS ONE? # JMP CHEC. NO, DON'T TRACE THIS ONE. # LDB RDD.C RECOVER RECEIVED WORD # JSB TRACE STORE IN TRACE TABLE # LDB STATE RECOVER DRIVER STATE # RBL MOVE TO 'STATE' FIELD # LDA COUNT WAS THERE A # CCE,SZA A TIME-OUT? # INB # RBL,ERB AND SET 'RECEIVE' INDICATOR BIT # JSB TRACE STORE TRACE/EVENT # LDB EQT1 STORE EQT ADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # * # CHEC. LDB RDD.C RECOVER RECEIVED DATA WORD # CHEC0 EQU * # XIF LDA COUNT MICROCODE oCOUNT # SZA,RSS DID MICROCODE FINISH? # JMP CHEC1 YES. # LDA EQT4,I NO. CHECK FOR POSSIBLE RTE TIME-OUT # AND .040 ISOLATE T.O. BIT # SZA TIME-OUT? # JMP CHECK,I YES, TAKE TIME-OUT RETURN # SPC 2 * * CHEC1 ISZ CHECK SET FOR 'STOP' RETURN # CPB STOP 'STOP'? # JMP CHECK,I YES...TAKE 'STOP' RETURN # ISZ CHECK # CPB RC REQUEST COMING? # JMP CHECK,I YES # ISZ CHECK SET "NONE OF THE ABOVE" RETURN # JMP CHECK,I RETURN # * * * B10 OCT 10 B20 OCT 20 B17 OCT 17 .040 OCT 4000 BSTMK OCT 12100 B1774 OCT 177400 B1776 OCT 177600 TEMP NOP MIC$X NOP OPEN LOOP MICROPROGRAM CALL COUNT NOP EQTX NOP SKP * ROUTINE TO CLEAR CARD * RDD.C NOP CLCC2 CLC 0,C LIAC2 LIA 0,C CLEAR STATUS LIA2 LIA 0 READ DATA WORD CLA JMP RDD.C,I * * HERE TO SEND WORD AND EXIT IN TRANSMIT MODE XMITX NOP JSB OUTPB SEND WORD JSB TRAPR SETUP TRAP CELL STC0 STC 0 SET TRANSMIT MODE LDA XMITX COROUTINE UPON RETURN STA EQT11,I DEXIT ISZ CA65 BUMP CONTINUATION RETURN JMP CEXT4 * OUTPB NOP IFZ OTB2 NOP 'RSS' WHEN TRACE MODE IS ENABLED # JMP OTB1 RETURN IMMEDIATELY IF TRACE DISABLED. # STB RDD.C SAVE (B) FOR A FEW LINES.... # JSB CKTRC SHOULD WE BE TRACING THIS ONE? # JMP OTB3 NO, DON'T TRACE THIS ONE. # LDB RDD.C RECOVER (B) REGISTER # JSB TRACE STORE OUTPUT WORD # RAL MOVE TO 'STATE' FIELD # LDB A LOAD EVENT # JSB TRACE STORE EVENT IN TRACE TABLE # LDB EQT1 STORE EQT ADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # OTB3 EQU * # LDB RDD.C RECOVER DATA TO BE TRANSMITTED # XIF OTB1 OTB 0 JMP OUTPB,I RETURN * RC OCT 170017 REQUEST COMING WORD TNW OCT 170360 TRANSMIT NEXT WORD STOP OCT 7760 SEND STOP RLW OCT 7417 RETRANSMIT LAST WORD RLM OCT 170377 RETRANSMIT LAST MESSAGE B2 OCT 2 B4 OCT 4 B7 OCT 7 N5 DEC -5 N6 DEC -6 N7 DEC -7 SKP *############################################################################ * * TRACE SECTION * * TRAC.-- SECTION TO SET UP TRACE BUFFER. * IFZ TRAC. EQU * LDA EQT7,I GET TRACE BUFFER ADDRESS STA NPASS SAVE ADDRESS OF PASS COUNT STA B COMPUTE ADDRESS ADB EQT8,I OF END OF BUFFER + 1 STB TRACL SAVE ADDRESS OF END OF BUFFER INA GET ADDRESS OF 2ND WORD OF TRACE BUFFER STA TRPTR STORE POINTER TO NEXT AVAILABLE LOCN INA BUMP TO START OF TRACE BUFFER STA TRACB SAVE TRACE BUFFER LDB EQT9,I GET TRACE SELECTION SZB TRACE ALL? LDB EQT1 NO, TRACE ONLY THIS LU STB TREQT SAVE TRACE EQT, OR ZERO FOR ALL LDB EQT10,I LOAD RESOURCE NUMBER STB RN# SAVE IT. SPC 2 * ENABLE TRACE MODE. * ETRAC EQU * CHECK THAT BUFFER HAS BEEN DEFINED CLB,INB LDA TRACB LOAD BUFFER ADDRESS SZA,RSS WAS ONE DEFINED? JMP REJCT NO, THIS IS AN ERROR STA TRACN YES, INITIALIZE "NEXT" TRACE ENTRY PNTR LDA RSS J; STORE 'RSS' INSTRUCTION IN ALL TRA.3 EQU * "BYPASS TRACE CODE" PLACES. STA OTB2 STA CH.00 STA CH.01 * * "IMMEDIATE COMPLETION" RETURN TO RTIOC * LDA B4 JMP IA65,I RETURN TO RTE SPC 2 * DISABLE TRACE MODE * DTRAC EQU * CLA STORE 'NOP' INSTRUCTION IN ALL "BYPASS TRACE JMP TRA.3 CODE" PLACES. * * SUBROUTINE TO CHECK WHETHER WE SHOULD BE * TRACING THIS ENTRY OR NOT. * CKTRC NOP LDB TREQT LOAD THE 'TRACE' EQT SZB TRACE ALL? CPB EQT1 NO, COMPARE TO THIS EQT ISZ CKTRC WE'RE TRACING THIS ONE! JMP CKTRC,I RETURN TO CALLER SKP * * TRACE -- SUBROUTINE TO MAKE AN ENTRY IN THE TRACE TABLE * * CALLING SEQUENCE: * LDB * JSB TRACE * * TRACE NOP ENTRY/EXIT STB TRACN,I STORE DATA IN TRACE BUFFER LDB TRACN ADVANCE TO NEXT ENTRY, OR INB CPB TRACL END? JMP TRAND YES, RESET TO START & UNLOCK RN TRA.1 EQU * STB TRACN STORE "NEXT" ENTRY POINTER CMB,INB COMPUTE RELATIVE OFFSET ADB TRACB SO BACKGROUND PROGRAM CMB,INB STB TRPTR,I KNOWS WHERE WE ARE. JMP TRACE,I RETURN TO CALLER SPC 2 TRAND EQU * LDA RN# LOAD RESOURCE NUMBER JSB $CGRN UNLOCK RESOURCE NUMBER ISZ NPASS,I BUMP PASS NUMBER NOP PROTECT AGAINST ROLLOVER. LDB TRACB JMP TRA.1 RETURN TO MAIN FLOW * * STORAGE FOR 'TRACE' * STATE NOP STORAGE FOR DRIVER STATE TREQT NOP EQT ADDRESS TO BE TRACED, OR 0 FOR ALL OF THEM TRPTR NOP STORAGE FOR ADDRESS OF "NEXT" ENTRY IN BUFFER NPASS NOP ADDRESS OF NUMBER OF PASSES COUNTER RN# NOP RESOURCE NUMBER TRACB NOP POINTER TO START OF TRACE BUFFER TRACN NOP POINTER TO NEXT TRACE TABLE DENTRY TRACL NOP POINTER TO END OF TABLE + 1 B11 OCT 11 B12 OCT 12 B13 OCT 13 B14 OCT 14 B15 OCT 15 B16 OCT 16 B21 OCT 21 B22 OCT 22 B23 OCT 23 B24 OCT 24 B25 OCT 25 B26 OCT 26 B27 OCT 27 B30 OCT 30 B31 OCT 31 B32 OCT 32 B33 OCT 33 RSS RSS 'RSS' INSTRUCTION SBIT OCT 100000 SIGN BIT XIF B5 OCT 5 *######################################################################## SKP SETIO NOP LDA EQT12,I EQT STATUS AND MICFG CLEAR MICROCODE R/W & RETRY FLAGS STA EQT12,I UPDATED EQT LDB EQT2,I CLA SSB SYSTEM TRYING TO INITIATE NEW REQUEST? CCA YES, SET A TICK STA EQT15,I SET TIMEOUT LDB EQT13,I STB EQTX SAVE ADDRESS OF EQT EXTENSION LDA EQT4,I AND B77 ISOLATE SELECT CODE STA CELL SAVE FOR TRAP CELL ADDR IOR CLCC CLC0,C COMMAND STA CLCC1 STA CLCC2 XOR .040 CONVERT TO STC 0,C COMMAND STA LISTI STA CEXT2 XOR .010 CONVERT TO STC 0 COMMAND STA STC0 XOR B200 CONVERT TO LIA COMMAND STA LIA2 XOR .010 CONVERT TO LIA 0,C COMMAND STA LIAC2 XOR .050 CONVERT TO LIB COMMAND STA LIB1 XOR B300 CONVERT TO OTB 0 COMMAND STA OTB1 JMP SETIO,I RETURN * * MICFG OCT 117777 CLCC CLC 0,C B200 OCT 200 B300 OCT 300 .050 OCT 5000 * BSS 0 SEE HOW BIG IT IS SKP * * DEFINE BASE PAGE LOCATIONS NEEDED * * * . EQU 1650B EQT1 EQU .+8 EQT2 EQU .+9 EQT4 EQU .+11 EQT5 EQU .+12 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 DUMMY EQU 1737B INTBA EQU 1654B TBG EQU 1674B * A EQU 0 B EQU 1 END * b 24999-18227 1902 S 0100 &SAM              H0101 )oFTN,L PROGRAM SAM(3,40),24999-16227 REV.1902 790911 C DRAW S.A.M. BUFFER MAP FOR RTE IV. C C NORMAL TURN-ON IS: C :RUN,SAM,LU WHERE LU IS THE DESIRED LIST DEVICE. C LIST DEVICE IS UNBUFFERED DURING SAM PRINTOUT. C C PAR 2= " CL" TO GET A CLASS TABLE LISTING AFTER THE BUFFER LISTING. C PAR 2= " IH" TO GET A SUMMARY OF SAM USAGE WITHOUT MAP PRINTOUT. C C ON,SAM,6,CL DOES IT ALL ON THE LINE PRINTER. C C C THE OTHER 3 TURN-ON PARAMETERS ARE INTENDED FOR CHECKOUT & C ARE NORMALLY DEFAULTED TO ZERO. C PAR 3=INTON. IF INTON="ON" THEN INTERRUPTS WILL BE LEFT ON THROUGHOUT C PROGRAM EXECUTION. OTHERWISE INTERRUPTS WILL BE TURNED OFF C DURING BUFFER EXAMINATION (NOT DURING MAP PRINTOUT) IN C ORDER TO PREVENT ALTERATION OF BUFFER CONTENTS DURING C THE EXAMINATION. IF MISSING A TIME BASE GENERATOR INTERRUPT C WOULD BE A SERIOUS PROBLEM, THEN TURN ON SAM AS FOLLOWS: C ON,SAM,6,,ON C PAR 4=DEBUG. IF PAR 4="DE" THEN DEBUG PARAM SET TRUE. THIS CAUSES C DUMPS OF THE 5 MAIN ARRAYS BEFORE & AFTER SORTING. C NOTE: SUBROUTINE SAMMY MAY SET DEBUG TRUE ONLY IF C ARRAY OVERFLOW OCCURS (IOVF="OV"), OF IF "EQ" ERROR OCCURS. C PAR 5=IWAIT. IF IWAIT>0 THE RUN TIME IS GREATLY EXTENDED. IF C THE INTERRUPTS HAVE BEEN LEFT ON (PARAM 3) AND IF C THE PROGRAM PRIORITY IS LOW THIS MAKES IT LIKELY THAT C THE BUFFER CONTENTS WILL BE ALTERED DURING THE RUN. C THIS RESULTS IN SEVERAL KINDS OF ERROR PRINTOUTS. C C C THE RELOCATABLE %SAM MUST BE LOADED WITH %SAMMY AND %SORTR C TO WHICH IT ISSUES CALLS. RELOCATABLE %SAMS CONTAINS ALL 3 MODULES. C C IF INTERRUPTS KEPT ON DURING THE RUNNING OF ROUTINE C SAMMY, THEN THE BUFFER CONTENTS CAN BE ALTERED DURING C THE RUN. SAMMY SHOULD DETECT ALL SUCH ERRORS AND THEY WILL BE C REPORTED ON SAM'S BUFFER MAP LISTING. A RE-RUN (PERHAPS AT C HIGHER PRIORITY) WILL USUALLY CURE THE PROBLEM. C THE NORMAL RUN, WITH INTERRUPTS OFF, SHOULD PMREVENT SUCH ERRORS. C C LOGICAL DEBUG DIMENSION IPAR(5),IERR(6) COMMON IADD(500),ILEN(500),IVAL2(500),IVAL3(500),ITAG(500) * ,ICLAS(500),ISUSP(500) EQUIVALENCE(KCLAS,IPAR(2)),(INTON, IPAR(2) ), (IWAIT, IPAR(4) ) 4 FORMAT(X,A2," ERROR. TRY A RE-RUN.") CALL RMPAR(IPAR) C MAX=LENGTH OF EACH ARRAY IN COMMON. MAX=500 LIST=6 IF(IPAR(1).GT.0)LIST=IPAR(1) DEBUG=.FALSE. IF(IPAR(4).EQ.2HDE)DEBUG=.TRUE. C C PARAMETERS HAVE BEEN DETERMINED. NOW CHECK THE BUFFER. C CALL SAMMY(IADD,ILEN,IVAL2,IVAL3,ITAG,ICLAS,ISUSP,MAX,ITOTL * ,INTON,IERR,IOVF,IWAIT,DEBUG) C BUFFER HAS BEEN EXAMINED. PREPARE TO PRINT RESULTS. C IF LIST DEVICE IS NOT TTY, ASSUME IT IS PRINTER & LOCK IT. IF(IFTTY(LIST).EQ.-1)GO TO 60 C DEVICE IS NOT INTERACTIVE, SO REQUEST AN LU LOCK. SET THE C BIT 15 FOR "NO WAIT" (FORGET BIT 14=NO ABORT). THEN LURQ C RETURNS WITH (A)=0 IF LOCK SUCCESSFUL. IF(LURQ(100001B,LIST,1).EQ.0)GO TO 60 C EITHER LIST IS ALREADY LOCKED OR NO MORE RESOURCE NUMBERS C AVAILABLE. I WILL ASK FOR LU # OF CRT THAT TURNED ME ON AND C DO MY LISTING THERE. LOG=LOGLU(IDUMMY) WRITE(LOG,55)LIST,LOG 55 FORMAT(" SOMEONE ELSE HAS LOCKED LU",I6," SO I'LL USE",I6) LIST=LOG 60 CONTINUE C WHATEVER THE LIST DEVICE IS AFTER THE ABOVE LOCKING SEQUENCE, C I MUST NOW UNBUFFER IT OR THIS BUFFER CHECK PROGRAM MIGHT C CLUTTER THE BUFFER WITH ITS OWN PRINTOUT. CALL UNBUF(LIST) IF(IOVF.GT.0)WRITE(LIST,4)IOVF DO 80 I=1,6 80 IF(IERR(I).GT.0)WRITE(LIST,4)IERR(I) IF(DEBUG)CALL DUMP(ITOTL,LIST) C CLEAR ALL INDIRECT BITS. DO 100 I=1,ITOTL IF(ITAG(I).NE.5 .AND. ITAG(I).NE.7)GO TO 100 C REIO LONG BLOCK ADDR SHOULD HAVE BIT 15 SET. IF NOT, THROW IT AWAY. IF(IADD(I).GT.0)IADD(I)=0 100 IADD(I)=IAND( IADD(I), 77777B ) C SORT DATA IN ADDRESS ORDER & PRINT THE BUFFER MAP. CALL SORTR(IADD,ITOTL,5,MAX) CALL MAPM(ITOTL,LIST,KCLAS) IF(DEBUG)CALL DUMP(ITOTL,LIST) IF(ICLAS(2).GT.0 .AND. KCLAS.EQ.2HCL)CALL CLASS(LIST,DEBUG) C C ISSUE FORM FEED TO THE LINE PRINTER. ICNWD=IOR(LIST,1100B) CALL EXEC(3,ICNWD,-1) C RESTORE LIST DEVICE TO ITS ORIGINAL STATE BEFORE UNBUF CALL CALL REBUF C TERMINATE NORMALLY(NO RESOURCES SAVED SO WE START WITH A FRESH C COPY OF PROGRAM NEXT TIME), BUT PASS CURRENT PARAMETERS BACK C TO MYSELF. THIS ENABLES SCHEDULING OF REPEATED RUNS AT THE C SAME TERMINAL. CALL EXEC(6,0,0,IPAR(1),IPAR(2),IPAR(3),IPAR(4),IPAR(5) ) END C SUBROUTINE MAP(ITOTL,LIST,IPAR2),781207 C PRINT FINAL BUFFER MAP OF THE SORTED DATA. INTEGER FWA,SIZE DIMENSION NAME(3),JSUM(8) COMMON IADD(500),ILEN(500),IVAL2(500),IVAL3(500),ITAG(500) * ,ICLAS(500),ISUSP(500) 1 FORMAT(8X,K5," WDS",10X,"FREE ") 2 FORMAT(8X,K5," WDS",10X,"CLASS",I4) 3 FORMAT(8X,K5," WDS",10X,"EQT #",I4,10X,"LU #",I4," DEVICE ",A2) 4 FORMAT(8X,K5," WDS",10X,"RE-EN I/O",10X,"FOR ",3A2) 5 FORMAT(X,K7,X,9("**") ) 6 FORMAT(/4X,K5," =SUM OF ENTRIES SHOULD EQUAL BUFFER", *" SIZE= ",K5) 8 FORMAT(4X,K5," WORD GAP. THIS AREA NOT IN ANY LIST KNOWN TO ME") 9 FORMAT(8X,K5," WDS",10X,"IDSEG EXT",10X,"FOR ",3A2) 10 FORMAT(/" FREE MIN MAX"/ * 3(1X,K6)/" IN USE " *"CLASS EQT RE-EN DS STRING LU SM"/ *3XK5" = "K5" + "K5" + "K5" + "K5" + "K5" + ",K5" + "K5) 11 FORMAT(/" START SYS AV MEM #",I2," AT",K7," LENGTH=",K5) 12 FORMAT(/K5," WORDS MISSING FROM S.A.M.#",I2) 13 FORMAT(/" START SYS AV MEM AT",K7," IN SYS MAP. LENGTH=",K5) 14 FORMAT(8X,K5," WDS",10X,"D.S. TABLES") 15 FORMAT(8X,K5," WDS",10X,"S.M. SESSION CONTROL BLOCK") 16 FORMAT(8X,K5," WDS",10X,"TURN-ON STRING",5X,"FOR ",3A2) 17 FORMAT(8X,K5," WDS",10X,"LU # ",I4,18X," DEVICE ",A2) 18 FORMAT(8X,K5," WD EXTRA FOR THE ABOVE TURN-ON STRING") ISUM=0 DO 20 I=1,7 R 20 JSUM(I)=0 MINFR=32767 MAXFR=0 ISTEP = 1 ISIZE = 0 C C START LOOP TO COVER THE 3 SYS AV MEM BUFFER AREAS. C DO 1000 IS=1,3,ISTEP CALL ISAM(IS,FWA,SIZE) IF(SIZE.LE.0)GO TO 1000 LWA = FWA + SIZE - 1 IF(IS .EQ. 3)GO TO 90 CALL ISAM(IS+1,NFWA,NSIZE) IF((NFWA-1) .NE. LWA)GO TO 90 SIZE = SIZE + NSIZE ISTEP = 2 LWA=FWA+SIZE-1 90 ISIZE=ISIZE+SIZE ISUMO=ISUM IF(IPAR2 .EQ. 2HIH)GO TO 95 WRITE(LIST,11)IS,FWA,SIZE 95 JADD=FWA C C START LOOP TO LIST EACH ITEM IN THIS PARTICULAR S.A.M.BUFFER. C DO 900 I=1,ITOTL IF(IADD(I).LT.FWA .OR. IADD(I).GT.LWA)GO TO 900 C IS THERE A GAP BETWEEN UPDATED JADD & CURRENT IADD ? IF(JADD.GE.IADD(I) )GO TO 400 IF(IPAR2 .EQ. 2HIH)GO TO 300 WRITE(LIST,5)JADD 300 JDIFF=IADD(I) - JADD C OCCASIONALLY THE STRING SEARCH MISSES 1 WORD OF BUFFER SINCE C IT RELIES ON THE CHAR COUNT IN THE BUFFER & MAY MISS AN EXTRA C WORD WHICH HAS BEEN ALLOCATED. IF( JDIFF.EQ.1 .AND. ITAG(I-1).EQ.9 )GO TO 350 WRITE(LIST,8)JDIFF GO TO 400 350 IF(IPAR2 .EQ. 2HIH)GO TO 360 WRITE(LIST,18)JDIFF C FRI 14 APR 78. CORRECT THE PRINTED SUMS TO ACCOUNT FOR EXTRA WORD. 360 JSUM(6)=JSUM(6)+1 ISUM=ISUM+1 400 CONTINUE JADD=IADD(I) + ILEN(I) ISUM=ISUM+ILEN(I) C PRINT FWA OF THIS BUFFER AREA. IF(IPAR2 .EQ. 2HIH)GO TO 450 WRITE(LIST,5)IADD(I) C IF TAG=1, PRINT INFO FROM FREE LIST POINTER IN $ALC PROGRAM. 450 IF(ITAG(I).NE.1)GO TO 500 JSUM(1)=JSUM(1)+ILEN(I) IF(ILEN(I).LT.MINFR)MINFR=ILEN(I) IF(ILEN(I).GT.MAXFR)MAXFR=ILEN(I) IF(IPAR2 .EQ. 2HIH)GO TO 500 WRITE(LIST,1)ILEN(I) 500 CONTINUE C IF TAG=2, PRINT INFO OBTAINED FROM BUFFER POINTERS IN CLASS I/O TABLE IF(ITAG(I).NE.2)GO TO 550 JSUM(2)=JSUM(2)+ILEN(I) IF(IPAR2 .EQ. 2HIH)GO TO 550 WRITE(LIST,2)ILEN(I),IVAL2(I) 550 CONTINUE 1C IF TAG=3, PRINT INFO GAINED FROM EQT LINK POINTERS. IF(IAND(ITAG(I),377B).NE.3)GO TO 600 JSUM(3)=JSUM(3)+ILEN(I) IEQ=IAND(IVAL2(I),377B) L =IAND(IVAL2(I)/400B, 377B) IVAIL= IAND(ITAG(I)/400B, 377B) IUP=2HBS IF(IVAIL.EQ.1)IUP=2HDN IF(IVAIL.EQ.2)IUP=2HUP IF(IPAR2 .EQ. 2HIH)GO TO 600 WRITE(LIST,3)ILEN(I),IEQ,L,IUP 600 CONTINUE C IF 4<=TAG<=7, PRINT INFO FOUND IN REENTRANT I/O SEARCH. IF(ITAG(I).LT.4 .OR. ITAG(I).GT.7) GO TO 700 JSUM(4)=JSUM(4)+ILEN(I) CALL PNAME(IVAL2(I),NAME) IF(IPAR2 .EQ. 2HIH)GO TO 700 IF(ITAG(I).EQ.4 .OR. ITAG(I).EQ.6)WRITE(LIST,9)ILEN(I),NAME IF(ITAG(I).EQ.5 .OR. ITAG(I).EQ.7)WRITE(LIST,4)ILEN(I),NAME 700 CONTINUE C IF TAG=8, PRINT DISTRIB SYSTEM TRANSACTION CONTROL BLOCK. IF(ITAG(I).NE.8)GO TO 750 JSUM(5)=JSUM(5)+ILEN(I) IF(IPAR2 .EQ. 2HIH)GO TO 750 WRITE(LIST,14)ILEN(I) C IF TAG=9, ANNOUNCE A CHARACTER STRING BEING PASSED TO PROGRAM 750 IF( ITAG(I).NE.9 ) GO TO 800 CALL PNAME(IVAL2(I), NAME) JSUM(6)=JSUM(6)+ILEN(I) IF(IPAR2 .EQ. 2HIH)GO TO 800 WRITE(LIST,16)ILEN(I),NAME C IF TAG=10, PRESENT AN ENTRY FROM AN LU LIST. 800 IF( ITAG(I).NE.10 )GO TO 850 JSUM(7)=JSUM(7)+ILEN(I) IF(IPAR2 .EQ. 2HIH)GO TO 850 WRITE(LIST,17)ILEN(I),IVAL2(I),IVAL3(I) C IF TAG=11 SESSION CONTROL BLOCK 850 IF(ITAG(I) .NE. 11)GO TO 900 JSUM(8) = JSUM(8) + ILEN(I) IF(IPAR2 .EQ. 2HIH)GO TO 900 WRITE(LIST,15)ILEN(I) 900 CONTINUE C C FINISHED A SAM AREA. CHECK FOR LAST POSSIBLE GAP & CHECK TOTAL SIZE. JDIFF=LWA+1 - JADD IF(JDIFF.LE.0)GO TO 950 WRITE(LIST,5)JADD WRITE(LIST,8)JDIFF 950 CONTINUE II=SIZE - ( ISUM-ISUMO ) IF(II.LE.0)GO TO 1000 WRITE(LIST,12)II,IS 1000 CONTINUE C KSUM=JSUM(2)+JSUM(3)+JSUM(4)+JSUM(5)+JSUM(6)+JSUM(7)+JSUM(8) WRITE(LIST,10)JSUM(1),MINFR,MAXFR,KSUM,(JSUM(I),I=2,8) , WRITE(LIST,6)ISUM,ISIZE RETURN END C SUBROUTINE PNAME(IDADD,NAME) C GIVEN IDADD=FWA PROG ID SEG, RETURN 6 CHARACTER PROG NAME. DIMENSION NAME(3) JDADD=IAND(77777B,IDADD) NAME(1)=IGET(JDADD+12) NAME(2)=IGET(JDADD+13) NAME(3)=IOR( 40B, IAND( 177400B, IGET(JDADD+14) ) ) RETURN END C SUBROUTINE CLASS(LIST,DEBUG) LOGICAL DEBUG COMMON IADD(500),ILEN(500),IVAL2(500),IVAL3(500),ITAG(500) * ,ICLAS(500),ISUSP(500) DIMENSION NAME(3) 1 FORMAT(/" CLASS TABLE @",K5," WITH ",I3," ENTRIES." * , " DISPLAY ONLY CLASS NUMBERS IN USE."// * " CL# CONTENTS CODE # REQUESTS") 2 FORMAT(X,I3,3X,K6,18X, " DEALLOCATED, AVAILABLE.") 3 FORMAT(X,I3,3X,K6,18X, " BUFFER QUEUE STARTS HERE") 4 FORMAT(X,I3,3X,K6,2X,K3,8X,K4," ALLOCATED. NO ONE WAITS.") 5 FORMAT(X,I3,3X,K6,2X,K3,8X,K4," ALLOCATED. ",3A2," WAITS.") 6 FORMAT( 10K7 ) IMAX=ICLAS(2) WRITE(LIST,1)ICLAS(1),IMAX DO 500 I=1,IMAX JCLAS=ICLAS(I+2) ISEC =IAND( JCLAS, 017400B ) / 400B NREQ =IAND( JCLAS, 000377B ) C IF(JCLAS.NE.0)GO TO 200 GO TO 500 C 200 IF(JCLAS.LT.0)GO TO 300 WRITE(LIST,3)I,JCLAS GO TO 500 C 300 IF( IAND( JCLAS, 140000B ) .EQ. 140000B)GO TO 400 WRITE(LIST,4)I,JCLAS,ISEC,NREQ GO TO 500 C 400 NAM=ISUSP(I+2) + 12 NAME(1)=IGET(NAM) NAME(2)=IGET(NAM+1) NAME(3)=IOR(40B, IAND(177400B, IGET(NAM+2) ) ) WRITE(LIST,5)I,JCLAS,ISEC,NREQ,NAME 500 CONTINUE IF(DEBUG)WRITE(LIST,6)ICLAS,ISUSP RETURN END C SUBROUTINE DUMP(ITOTL,LIST) C DUMP ALL ARRAYS. COMMON IADD(500),ILEN(500),IVAL2(500),IVAL3(500),ITAG(500) * ,ICLAS(500),ISUSP(500) 1 FORMAT(5K7) DO 100 I=1,ITOTL 100 WRITE(LIST,1)IADD(I),ILEN(I),IVAL2(I),IVAL3(I),ITAG(I) RETURN END END$ ASMB,R,L dNAM SAMMY,7 EXAMINE S.A.M.(RTE4) WED 11 SEP 79. HED RTE 4 S.A.M. BUFFER EXAMINATION ROUTINE FOR USE WITH &SAM. * THIS VERSION CAUSES DUMP IF EQT ERROR HAPPENS. DIAGNOSE EQT ERR PROBLEM. ENT SAMMY EXAMINE BUFFER FOR ALL TYPES OF LISTS. ENT LUNIT CONVERT EQT # TO LU & REPORT AVAILABILITY. * EXT $LIBR,$LIBX FOR RUNNING WITH INTERRUPTS OFF. * * THIS ROUTINE EXAMINES CONTENTS OF THE SYSTEM AVAILABLE * MEMORY (SAM) BUFFER FOR RTE 4. IT DOES THIS BY * TRACING OUT THE FOLLOWING LISTS: * * 1) FREE MEMORY. ORIGINAL LIST POINTER FOUND IN THE ENTRY POINT * $PNTR IN THE $ALC PROGRAM. * * 2) CLASS I/O. LISTS MAY ORIGINATE FROM A POINTER IN ANY ONE * OF THE LOCATIONS IN THE CLASS I/O TABLE ($CLAS). * * 3) EQT LISTS. AN EQT LIST BEGINS WITH A POINTER IN THE EQT * LINK WORD (WORD 1) OF ANY ENTRY IN THE EQT * TABLE. * * 4) REENTRANT I/O * STARTING WITH A SINGLE POINTER (NEAR $REIO IN EXEC4) * A LIST OF RE-ENTRANT (AND SOME NONREENTRANT) * I/O MAY BE TRACED. * * 5) TURN-ON CHARACTER STRINGS * STARTING FROM LCOATION $STRG IS A LIST OF * THE CHARACTER STRINGS BEING PASSED AS TURN-ON * PARAMETERS. * * 6) LU LISTS * AN LU LIST BEGINS WITH A BUFFER POINTER IN * THE 2ND HALF OF THE DEVICE REFERENCE TABLE. * * 7) DS TABLES LOCATION #FWAM IN THE RES PROGRAM POINTS TO * THE DISTRIBUTED SYSTEMS TABLES AND VECTORS * WHICH CONSIST OF: TRANSACTION CONTROL BLOCK(TCB) * TRANSACTION STATUS TABLE(TST) * NETWORK ROUTING VECTOR(NRV). * * NOTE: IF YOU DO NOT HAVE DISTRIBUTED SYSTEMS THE * LOADR MAY GIVE YOU UNDEFINED EXTERNAL ERROR * DUE TO #FWAM,#SAVM DECLARED AS EXTERNALS BY * % THIS PROGRAM. * * 8) SCB IF THE SESSION MONITOR IS IN YOUR SYSTEM IT * ALSO ALLOCATES SOME SAM. * * NOTE: THIS TOO CAN CAUSE UNDEFINED EXTERNAL $SMEM * UNLESS RTE4B IS INSTALLED. * * 9) CLASS TABLE THOUGH ITS NOT PART OF THE BUFFER, THIS ROUTINE * RETURNS THE ENTIRE CLASS TABLE TO THE CALLER IN * CASE HE WANTS TO LIST IT. * * * * OPERATION OF THIS ROUTINE DEPENDS ON THE FOLLOWING SHAKY * ASSUMPTIONS: * * 2) $STRK(TRACK), $SSCT(SECTOR) POINTS TO THE BASE PAGE COMMUNICATION * AREA OF THE RTE SYSTEM. THE CURRENT EQT PORTION OF THIS AREA * BEGINS AT WORD 49(DECIMAL) OF THAT SECTOR. IT CONTAINS THE * FWA & LENGTH OF THE SAM BUFFER. IF THIS INFORMATION IS MOVED * TO A DIFFERENT ADDRESS IN THE SECTOR THIS ROUTINE WILL GET FALSE * BUFFER LIMITS INFORMATION & BOMB OUT. * * A METHOD OF LOADING SAM INTO RTE IV FOLLOWS: * * :RU,LOADR,#SAM::24,,6,SS WHERE COMMAND FILE #SAM HAS: * RE,%SAM::26 * RE,%SAMMY::26 * RE,%SORTR::26 * END * * THE "SS" IN 4TH PARAMETER ALLOWS THIS PROGRAM ACCESS TO THE * SUBSYSTEM GLOBAL AREA OF MEMORY. THIS IS NECESSARY FOR SUCH * EXTERNALS AS #FWAM IN THE DISTRIBUTED SYSTEMS PROGRAMS. * * FOR AN EXAMPLE OF RTE 4 MEMORY LAYOUT AND LOCATION OF THE S.A.M. * AREAS, SEE THE END OF THIS PROGRAM LISTING. * * HERE IS A LIST OF THE IDENTIFIER TAGS PUT INTO ITAG ARRAY * BY EACH OF THE LIST TRACING ROUTINES: * TAG=1 FOR A FREE LIST ENTRY * TAG=2 FOR A CLASS I/O ENTRY * TAG=3 FOR AN EQT LIST ENTRY * TAG=4 FOR A RE-ENTRANT I/O MAIN CHAIN SHORT BLOCK * TAG=5 FOR A RE-ENTRANT I/O MAIN CHAIN LONG BLOCK * TAG=6 FOR A RE-ENTRANT I/O SIDE CHAIN SHORT BLOCK * TAG=7 FOR A RE-ENTRANT I/O SIDE CHAIN LONG BLOCK * TAG=8 FOR THE DISTRIBUTED SYSTEMS TABLES. ~* TAG=9 FOR A TURN-ON CHARACTER STRING PASSED TO AN RTE PROGRAM. * TAG=10 FOR AN LU LIST STARTING FROM 2ND HALF OF DRT. * TAG=11 FOR THE SESSION MONITORS 'SESSION CONTROL BLOCK'. * * IADD NOP ARRAY OF ADDRESSES OF BUFFER AREAS. ILEN NOP ARRAY OF LENGTHS OF BUFFER AREAS. IVAL2 NOP CLASS #, OR EQT #, OR ID SEG ADDRESS. IVAL3 NOP ITAG NOP DATA IS TAGGED TO IDENTIFY IT FOR PRINTOUT. ICLAS NOP ARRAY FOR STORAGE OF CLASS TABLE. ISUSP NOP ARRAY FOR 'WAIT SUSPEND' LIST ID SEG POINTERS. MAX NOP =LENGTH OF EACH OF THE ABOVE ARRAYS. ITOTL NOP BUMP ITOTL ONCE FOR EACH ITEM FOUND IN BUFFER. INTON NOP ="ON" TO KEEP INTERRUPTS ON. IERR NOP ERROR FLAG ARRAY(1 FOR EACH SEARCH ROUTINE). IOVF NOP SET TO "OV" IF WE OVERUN MAX ARRAY LENGTH. IWAIT NOP OPER CAN CAUSE LONG RUN TIME WITH IWAIT>0. DEBUG NOP SAMMY CAN CAUSE ARRAY DUMP BY SETTING DEBUG=.TRUE. SAMMY NOP JSB .ENTR DEF IADD CLA STA ITOTL,I COUNTER=0 STA IOVF,I CLEAR OVERFLOW FLAG. JSB SYSAD GET SYSTEM ADDRESSES. * JSB PREBL SET UP BUFFER LIMITS * LDA INTON,I DOES HE WANT THE CPA =AON INTERRUPTS LEFT ON ? JMP *+3 YES. JSB $LIBR HAVE RTE TURN OFF INTERRUPTS. NOP NOP FOR PRIVILEGED ROUTINE. * JSB FREE GET FREE MEMORY DATA. ISZ IERR NOW POINT TO IERR(2). JSB CLASS CHECK CLASS I/O TABLE. ISZ IERR AIM AT IERR(3). JSB EQT CHECK THE EQT TABLE. ISZ IERR NOW IERR(4). JSB REEN FOLLOW THE CHAIN FROM $REIO. ISZ IERR POINT TO IERR(5) JSB STRNG CHECK FOR TURN-0N CHAR STRINGS. ISZ IERR POINT TO IERR(6) JSB LULST CHECK DRT FOR LU LISTS. JSB DSTAB LOOK FOR DISTRIBUTED SYSTEM TC BLOCK. JSB SESON CHECK FOR SESSION'S SCB. JSB CLTAB STORE CLASS TABLE INTO ICLAS ARRAY. JSB SUSP GET PROGRAMS WHICH WAIT FORLY CLASS I/O. EXIT EQU * LDA INTON,I DID WE RUN CPA =AON WITH INTERRUPTS ON ? JMP SAMMY,I YES. JSB $LIBX NO. TURN THEM ON & RETURN. DEF SAMMY * * AT ADDRESS .FREE IS START OF LIST OF THE FREE AREAS OF BUFFER. * FREE NOP CLA STA IERR,I CLEAR THE ERROR FLAG. LDA .FREE (A)=$ALC+174B NEXFR XLA A,I GET A PTR TO FREE AREA. CPA STOP IS THIS PTR REALLY A STOP FLAG? JMP EXITF YES. JSB BULIM NO. IS PTR AIMED AT BUFFER? JMP FREER NO. STA IADD,I YES. RETURN PTR TO CALLER. XLB A,I GET WORD 1=LENGTH OF THIS FREE AREA. STB ILEN,I RETURN LENGTH TO CALLER CLB,INB STB ITAG,I TAG FREE DATA WITH A 1. JSB BUMP INCREMENT ARRAY ADDRESSES. INA PT TO WORD 2 (LOCATION OF NEXT FREE AREA). JMP NEXFR CONTINUE FREE MEMORY SEARCH. * FREER EQU * ERR EXIT FOR BAD PTR DURING FREE SEARCH. LDA =AFR IDENTIFY THE FREE ROUTINE. STA IERR,I SET THE ERROR FLAG. EXITF EQU * NORMAL EXIT FROM FREE SEARCH. JMP FREE,I STOP OCT 77777 MARKS END OF LIST OF FREE ADDRESSES. * * AT ADRESS .CLAS IS FWA OF THE CLASS I/O TABLE. * POINT NOP COUNT NOP CLASS NOP CLA STA IERR,I CLEAR THE ERROR FLAG. LDB .CLAS INITIALIZE POINTER STB POINT TO FWA OF CLASS TABLE. LDA POINT,I 0TH ENTRY = NUMBER OF ENTRIES. ISZ POINT POINT TO 1ST CLASS ENTRY. CMA,INA STA COUNT INITIALIZE LOOP COUNTER. * RETURN TO NEXTB FOR EACH SUCCESSIVE CLASS TABLE ENTRY. NEXTB LDB POINT,I GET AN ENTRY FROM CLASS TABLE. ISZ POINT AIM POINTER AT NEXT ENTRY. SZB,RSS CLASS ALLOCATED? ENTRY >0? JMP ENDTB NO. TRY NEXT TABLE ENTRY. SSB BIT 15 RESET? ENTRY AIMED AT CLASS Q? JMP ENDTB NO. TRY NEXT TABLE ENTRY. * B REG AIMED AT 1ST WORD OF A MEMBER OF A CLASS QUEUE IN BUFFER. * THIS 1ST PTR CAME FROM CLASS TABLE & DOES NOT NEED TO BE CHECKED. * RETURN TO NEXQ WITH CHECKED PTR FOR EACH MEMBER OF THE QUEUE * WHICH LEADS OUT FROM THIS CLASS TABLE ENTRY. NEXQ STB IADD,I SAVE ADDR OF THIS CLASS Q ENTRY. LDA B ADA D4 A PTS TO CLASS ID WORD OF CLASS Q ENTRY. XLA A,I GET CLASS ID WORD STA IVAL3,I SAVE WITH SECURITY CODE. AND =B377 ISOLATE CLASS NUMBER FROM IT. STA IVAL2,I SAVE CLASS #. LDA B ADA D3 A PTS TO BLOCK LENGTH WORD. XLA A,I GET LENGTH STA ILEN,I & SAVE IT IN ILEN ARRAY. LDA D2 STA ITAG,I DATA TAG=2 FOR CLASS I/O. XLB B,I GET QUEUE ENTRY LINKAGE WORD STB IVAL3,I & SAVE IT FOR A POSSIBLE DUMP. JSB BUMP INCREMENT ARRAY ADDRESSES. SSB DOES LINK WORD LEAD TO NEXT QUEUE ENTRY? JMP ENDTB NO. BIT 15 SET TO TERMINATE QUEUE. LDA B YES. BUT CHECK FOR BAD PTR. JSB BULIM IS IT AIMED AT BUFFER? JMP BADPT NO. BUFFER HAS BEEN ALTERED. LDB A YES. JMP NEXQ CONTINUE TRACING CLASS QUEUE. BADPT LDA =ACL TELL BEEP WHICH ROUTINE HAS ERROR STA IERR,I & THEN QUIT TRACING THIS QUEUE. ENDTB EQU * END OF QUEUE MEANS THIS TABLE ENTRY IS DONE ISZ COUNT LAST TABLE ENTRY? JMP NEXTB NO. JMP CLASS,I * * SEARCH THE EQT TABLE. * EQT NOP CLA STA IERR,I CLEAR ERROR FLAG. LDA EQT# USE THE EQT # AS A CMA,INA COUNTER TO SCAN WHOLE EQT TABLE. STA COUNT LDA EQTA USE EQTA TO STA POINT INITIALIZE THE POINTER. NEXEQ EQU * RETURN HERE TO CHECK NEXT EQT ENTRY. LDA POINT,I NXLST EQU * RETURN HERE TO TRACE EQT LIST THRU BUFFER. JSB IDSAM AIMED AT SAM OR THRU ID SEG TO SAM ? JMP EQERR NO. THIS WAS NO A VALID POINTER. JMP EXITQ NO, BUT IT WAS A VALID ZERO LIST TERMINATOR. %JMP PROCS YES. PROCESS AN EQT LIST IN S.A.M. PROCS EQU * PROCESS BUFFER AREA CLAIMED BY THIS EQT. STA IADD,I SAVE THE EQT LINK PTR. STA B SAVE PTR. WE NEED IT FOR NEXT LOOP. ADA D3 A REG POINTS TO LENGTH WORD. XLA A,I GET LENGTH STA ILEN,I & SAVE FOR BUFFER MAP. LDA EQT# INA (A)=MAX EQT + 1. ADA COUNT (A)=CURRENT EQT ENTRY NUMBER. JSB EQLU STORE EQT,LU,AVAILIBILITY & TAG. XLA B,I GET NEXT PTR FOR CURRENT EQT LIST. STA IVAL3,I SAVE PTR FOR POSSIBLE DUMP. JSB BUMP INCREMENT ARRAY ADDRESSES(A&B REGS PRESERVED). JMP NXLST PTR MAY LEAD TO NEXT IN LIST. EQERR EQU * * LDA .TRUE CAUSE DEBUG DUMP TO HELP STA DEBUG,I DIAGNOSE EQT ERROR PROBLEM. * LDA =AEQ RETURN EQT ERROR FLAG STA IERR,I & TRY NEXT EQT ENTRY. EXITQ EQU * LDA POINT ADA D15 MOVE POINTER TO NEXT EQT ENTRY. STA POINT ISZ COUNT LAST ENTRY IN THE EQT TABLE? JMP NEXEQ NO. CHECK THE NEXT ENTRY. JMP EQT,I YES. * * LDA PTR GET A POINTER TO BE VALIDATED. * JSB IDSAM SEE IF AIMED AT SAM OR THRU ID SEG TO SAM. * RETURN TO P+1 IF INVALID(NEITHER SAM NOR 0). A REG HAS BAD PTR. * RETURN TO P+2 IF LEADS TO ZERO LIST TERMINATOR. A REG = 0. * RETURN TO P+3 IF SAM PTR OR IF LEADS TO SAM PTR. IN EITHER * CASE A REG HAS THE FINAL VALID SAM POINTER. * IDSAM NOP ENTER WITH (A)= POINTER TO BE CHECKED. SSA I HOPE THE INDIRECT BIT IS RESET. JMP NGXIT INDIRECT IS SET. I DON'T LIKE IT. SZA,RSS NON-ZERO ? JMP ZEXIT NOT A POINTER. THIS IS A ZERO (LIST TERMINATOR). JSB BULIM YES. IS IT AIMED AT S.A.M. ? JMP *+2 NO. BUT MAYBE IT LEADS TO SAM (THRU ID SEG). JMP OKXIT YES. SEARCH ENDS WITH A VALID SAM POINTER. JSB IDLIM IS IT AIMED AT PROG ID SE7sGMENT ? NOP NO. MIGHT BE A SYSTEM REQUEST TRY AGAIN. XLA A,I YES, SO USE THIS ID SEG PTR JMP IDSAM+1 TO FETCH THE NEXT PTR OF THE CHAIN. * EXITS FOR THE CASES OF OK, ZERO AND NO GOOD. OKXIT ISZ IDSAM RETURN TO P+3 WITH (A)=VALID SAM POINTER. ZEXIT ISZ IDSAM RETURN TO P+2 WITH (A)=ZERO (LIST TERMINATOR). NGXIT JMP IDSAM,I RETURN TO P+1 WITH (A)=JUNK * * GET LU # AND AVAILABILITY OF THIS EQT. * JSB EQLU WITH (A)=EQT NUMBER. * LU WILL BE MERGED WITH EQT & STORED IN IVAL2 * AVAIL WILL BE MERGED WITH TAG & STORED IN ITAG * (B) WILL BE PRESERVED & (A) WILL BE DESTROYED. * EQLU NOP STB SAVEB STA EQ JSB LUNIT GET LU IN A REG DEF *+3 & AVAILIBILITY IN LOCATION AVAIL. DEF EQ DEF AVAIL ALF,ALF LU # TO HIGH BYTE. IOR EQ MERGE EQT STA IVAL2,I & STORE BOTH. LDA AVAIL ALF,ALF AVAILABILITY TO HI BYTE IOR D3 MERGE TAG FOR THE EQT LIST DATA. STA ITAG,I LDB SAVEB JMP EQLU,I SAVEB NOP EQ NOP AVAIL NOP * * AT $DHED BEGINS THE CHAIN OF REENTRANT I/O DATA. * THERE IS A MAIN CHAIN OF SHORT BLOCKS, EACH POINTING TO NEXT * SHORT BLOCK & ALSO TO A LONG BLOCK. * EACH MAIN CHAIN SHORT BLOCK MAY ALSO HAVE PTR TO SIDE CHAIN. * SIDE CHAIN IS CHAIN OF SHORT BLOCKS, EACH POINTING TO NEXT * SHORT BLOCK & ALSO TO A LONG BLOCK. * REEN NOP CLA STA IERR,I CLEAR ERROR FLAG. LDA .REIO GET STARTING PTR FROM $REIO-7 XLA A,I IT LEADS TO PTR IN $REIO-6 XLA A,I WE NOW HAVE 1ST PTR TO BUFFER. * MAIN CHAIN LEADS FROM WD 1 OF SHORT BLOCK TO NEXT SHORT BLOCK. MAINE EQU * LDB D4 MAIN CHAIN DATA TAGGED WITH A STB RETAG 4(SHORT BLOCK) OR 5(LONG BLOCK). JSB SHORT GET SHORT BLOCK DATA. LDA REPTR SAVE THE MAIN CHAIN STA MAIN PTR FROM THIS SHORT BLOCK. ADA D2 POINT TO WD 3 (IT LEADS TO LïONG BLOCK). XLA A,I GET PTR TO LONG BLOCK. JSB LONG GET LONG BLOCK DATA. * CHECK FOR A SIDE CHAIN LEADING TO ADDITIONAL SHORT BLOCKS. * THE PTR TO SIDE CHAIN IS IN 4TH WD OF A SHORT BLOCK. SIDE EQU * LDA D6 SIDE CHAIN TAGGED WITH A STA RETAG 6(SHORT BLOCK) OR 7(LONG BLOCK). LDA REPTR GET CURRENT SHORT BLOCK POINTER. ADA D3 4TH WORD MAY BE POINTER TO XLA A,I SIDE CHAIN OF MORE SHORT BLOCKS. SZA DOES IT LEAD FURTHER? JMP FURTH YES. LDA MAIN XLA A,I NO. GO BACK TO THE JMP MAINE TRACING OF THE MAIN CHAIN. * PROCESS A SIDE CHAIN SHORT BLOCK & ITS ASSOCIATED LONG BLOCK. FURTH JSB SHORT GET SHORT BLOCK DATA. LDA REPTR ADA D2 GET PTR TO LONG BLOCK. XLA A,I JSB LONG GET LONG BLOCK DATA. JMP SIDE SEE IF THE SIDE CHAIN CONTINUES. .TRUE OCT 100000 FTN4 LOGICAL .TRUE. * * LDA PTR GET PTR TO 1ST WD OF SHORT BLOCK. * JSB SHORT GET ID SEG EXTENSION DATA FROM SHORT BLOCK. * SHORT NOP SZA,RSS END OF CHAIN? JMP EXITR YES. 0 ENDS THE CHAIN. JSB BULIM IS PTR AIMED WITHIN BUFFER LIMITS? JMP REERR NO. STA REPTR YES. SAVE IT STA IADD,I & RETURN IT TO CALLER. INA POINT TO 2ND WORD= PROGRAM ID SEG ADDRESS. XLA A,I GET ID SEG ADDR TO FIND BLOCK SIZE. LDB D4 ASSUME 4 WD BLOCK. SSA CHECK ASSUMPTION. LDB D5 FALSE. BIT 15 SAYS 5 WORDS. STB ILEN,I RETURN BLOCK LENGTH TO CALLER. STA IDSEG SAVE ID SEG ADDR. STA IVAL2,I RETURN ID SEG ADDR TO CALLER. ADB REPTR (B)=(REPTR) + BLOCK LENGTH ADB =D-1 B POINTS TO LAST WORD (WORD 4 OR 5). XLB B,I GET LAST WORD STB IVAL3,I RETURN TO CALLER FOR DEBUG PRINTOUT. LDA RETAG TAG THE DATA WITH A STA ITAG,I 4(MAIN SHORT) OR 6(SIDE SHORT). JSB DLBUMP INCREMENT ARRAY ADDRESSES. JMP SHORT,I REPTR NOP VALIDATED PTR TO WORD 1 OF SHORT BLOCK(ID SEG EXT). MAIN NOP VALIDATED PTR TO SHORT BLOCK IN MAIN CHAIN. IDSEG NOP PROGRAM ID SEGMENT ADDRESS. RETAG NOP DATA TAG=4(MAIN CHAIN) OR 6(SIDE CHAIN). * * LDA PTR GET PTR TO LONG DATA BLOCK. * JSB LONG TO GET DATA FROM IT. * LONG NOP STA IADD,I RETURN BLOCK ADDR TO CALLER. ELA,CLE,ERA CLEAR BIT 15 (THE MOVED/NOT MOVED FLAG). XLB A,I GET WORD 1 (THE 'MOVE BACK' WORD). STB IVAL3,I RETURN IT TO CALLER FOR DEBUG PRINTOUT. INA POINT TO WORD 2 (BLOCK LENGTH). XLB A,I GET LENGTH WORD. STB ILEN,I RETURN BLOCK LENGTH TO CALLER. LDB IDSEG THE ID SEG ADDR FOUND BY 'SHORT' STB IVAL2,I ROUTINE APPLIES TO LONG BLOCK ALSO. LDA RETAG TAG THE DATA WITH A INA 5(MAIN LONG BLOCK) OR STA ITAG,I A 7(SIDE LONG BLOCK). JSB BUMP INCREMENT ARRAY ADDRESSES. JMP LONG,I * REERR EQU * ERROR EXIT IF BAD POINTER FOUND. LDA =ARE CHARACTER PAIR IDENTIFIES REEN ROUTINE. STA IERR,I LET 'EM KNOW WE GOT A BAD POINTER. EXITR EQU * NORMAL EXIT FROM REEN ROUTINE. JMP REEN,I * * .STRG GIVES US A POINTER TO 1ST CHARACTER STRING IN THE BUFFER. * STRNG NOP CLA STA IERR,I CLEAR ERROR FLAG. LDA .STRG GET THE STARTING POINTER. NEXST XLA A,I GET NEXT BUFFER POINTER STA IVAL3,I SAVE NEW POINTER FOR DEBUG AID. SZA,RSS NON-ZERO? A POSSIBLE BUFFER POINTER ? JMP EXITS NO. ZERO ENDS THE LIST. JSB BULIM IS IT REALLY AIMED AT BUFFER ? JMP STERR NO. STA IADD,I YES. RETURN POINTER TO CALLER. INA AIM AT WD 2(PROG ID SEG PTR) XLB A,I GET ID SEG POINTER(PRESERVING BUFFER PTR). STB IVAL2,I RETURN ID SEG PTR TO CALLER. INA AIM AT WD 3(CHARACTER COUNT) ( XLB A,I GET THE CHAR COUNT. SLB EVEN CHAR COUNT ? INB NOW IT IS EVEN. BRS DIVIDE BY 2 TO GET WORD COUNT. ADB D3 ADD THE 3 WORDS OVERHEAD IN EACH LIST ENTRY. STB ILEN,I RETURN BUFFER LENGTH TO CALLER. LDB D9 APPLY THE CHAR STRING STB ITAG,I IDENTIFICATION TAG TO THIS DATA. LDA IADD,I RECOVER THE POINTER SO WE CAN CONTINUE SEARCHING. JSB BUMP BUMP ARRAY ADDRESSES(PRESERVING A & B REGS). JMP NEXST CHECK FOR ANOTHER CHAR STRING. * STERR LDA =AST ERR EXIT FOR BAD PTR IN STRING SEARCH. STA IERR,I SET THE ERROR FLAG. EXITS JMP STRNG,I NORMAL EXIT FROM STRING SEARCH. * * NEW 2ND HALF OF DEVICE REF TABLE IS ORIGIN FOR LU LISTS. * LULST NOP CLA STA IERR,I CLEAR THE ERROR FLAG. LDB DRT B POINTS TO FWA DRT ADB LUMAX B POINTS TO 2ND HALF OF DRT. STB POINT LDA LUMAX CMA,INA COUNT= - NR OF DRT ENTRIES. STA COUNT NXTLU EQU * RETURN HERE TO CHECK NEXT DRT ENTRY. LDA POINT XLA A,I GET THE NEXT DRT ENTRY. LDB =ADN ASSUME DEVICE IS DOWN. SSA,RSS IS IT DOWN? IS BIT 15 SET? LDB =AUP NO. DEVICE IS UP. STB DSTAT SAVE DEVICE STATUS FOR THIS WHOLE LU LIST. AND =B77777 RESET BIT 15. SZA,RSS HAVE I GOT A LIST POINTER ? JMP EXITL NO. ZERO MEANS NO LIST. JSB LULIM IS THIS AN LU NUMBER ? RSS NO. SO IT SHOULD BE A BUFFER PTR. JMP EXITL YES. SKIP IT. SEE P A-4 OF RTE3 MANUAL. CONTU JSB BULIM IS POINTER AIMED WITHIN BUFFER ? JMP LUERR NO. STA IADD,I ADA D3 AIM AT 4TH WORD (WORD COUNT). XLA A,I GET THE WORD COUNT. STA ILEN,I LDA LUMAX ADA COUNT (A)=LUMAX-COUNT INA (A)=CURRENT LU # STA IVAL2,I LDA D10 IDENTIFY THE LU LIST SEARCH. STA ITAG,I LDA DSTAT o RETURN DEVICE STA IVAL3,I STATUS TO CALLER. LDA IADD,I PREPARE TO CONTINUE TRACING JSB BUMP BUMP ARRAY POINTERS(A & B PRESERVED). XLA A,I TRACE 1 STEP FURTHER IN THE LIST. SZA,RSS DO WE HAVE A LIST POINTER ? JMP EXITL NO. A NULL PTR ENDS THE LIST. JMP CONTU YES. CONTINUE TRACING. * LUERR LDA =ALU SET THE LU SEARCH ERROR FLAG. STA IERR,I EXITL ISZ POINT LOOK AT NEXT WORD IN 2ND HALF OF DRT. ISZ COUNT FINISHED DRT ? JMP NXTLU NO. JMP LULST,I NORMAL EXIT FROM LU LIST SEARCH. DSTAT ASC 1,?? DEVICE STATUS FROM 2ND DRT WORD. * * PROGRAM RES, THE CORE RESIDENT(LIBRARY) PART OF RTE DISTRIBUTED * SYSTEMS HAS ENTRY POINTS #FWAM , #SAVM WHICH GIVE THE FWA * AND LENGTH OF THE TRANSACTION CONTROL BLOCK. THIS IS A LINKED * LIST OF 4 WORD ENTRIES, ONE FOR EACH TRANSACTION ALLOWED FOR * DISTRIBUTED SYSTEMS. * EXT #FWAM,#SAVM DSTAB NOP LDA #FWAM GET FWA OF THE TC BLOCK. JSB BULIM VALID S.A.M. POINTER ? JMP EXITD NO. PROBABLY UNDEFINED EXTERNAL(A STILL 0). STA IADD,I YES. RETURN THE ADDRESS. LDA #SAVM GET THE LENGTH OF TCB. SSA,RSS SZA,RSS JMP EXITD IF(LENGTH .LE. O) GO CHECK FOR HP3000 STA ILEN,I ELSE RETURN LENGTH TO THE CALLER; LDA D8 STA ITAG,I TAG THE TCB DATA WITH AN 8. JSB BUMP INCREMENT ARRAY POINTERS. EXITD EQU * NORMAL EXIT FROM DSTAB JMP DSTAB,I * * IN RTE-IVB WITH THE SESSION MONITOR A NEW ENTRY POINT HAS * BEEN DEFINED($SMEM). WITH THIS ENTRY POINT WE CAN TRACE * WHAT THE SESSION MONITOR IS USING IN SAM. * SESON NOP LDA .SMEM GET ADDRESS OF ADDRESS XLA A,I GET -ADDRESS OF SCB CMA,INA MAKE TO ACTUAL ADDRESS JSB BULIM CHECK IF IN SAM AREA. JMP SESON,I NO, SESON NOT ON. STA IADD,I YES, SAVE THE ADDRESS. LDA .SMEM GET ADDRESS OF ADDRESS AGAIN INA BUMP TO THE LENGTH WORD XLA A,I GET THE LENGTH IN 1'S COMPL. CMA MAKE TO PROPER LENGTH SSA,RSS SZA,RSS JMP SESON,I IF(LENGTH .LE. 0)GET OUT STA ILEN,I EVERYTHING LOOKS GOOD LDA D11 SET TAG FOR SCB DATA STA ITAG,I JSB BUMP INCREMENT ARRAY POINTERS. JMP SESON,I RETURN. * * STORE CLASS TABLE POINTER, # OF ENTRIES & THE WHOLE DAMN CLASS TABLE * INTO THE ICLAS ARRAY. * CLTAB NOP LDB .CLAS GET TABLE POINTER. STB ICLAS,I RETURN TO CALLER. ISZ ICLAS POINT TO ICLAS(2) LDA B,I GET THE # OF ENTRIES IN CLASS TABLE. STA ICLAS,I RETURN # TO CALLER. ISZ ICLAS POINT TO ICLAS(3) CMA,INA USE # OF ENTRIES FOR A LOOP COUNTER. STA COUNT SSA,RSS IF COUNT>=0 THEN RETURN. JMP CLTAB,I INB PASS OVER 1ST ENTRY. IT'S ALREADY STORED. * NXCLA LDA B,I GET A CLASS TABLE ENTRY. STA ICLAS,I RETURN IT TO CALLER. ISZ ICLAS INB ISZ COUNT END OF TABLE ? JMP NXCLA NO. JMP CLTAB,I YES. * * " WAIT SUSPEND " LIST STARTS ON BASEPAGE WITH PTR TO AN ID SEG. * THE LIST IS LINKED FROM ONE ID SEG TO THE NEXT BY WORD 1 OF * EACH ID SEG. AT EACH ID SEG WE PAUSE TO EXAMINE WORD 2. IT IS * EITHER AIMED AT CLASS TABLE(PROG WAITING FOR CLASS I/O) OR AT * ANOTHER ID SEG(PROG IS FATHER WAITING FOR SON TO TERMINATE). * THE CLASS I/O CASE INTERESTS US. WE WILL STORE THE ID SEG ADDRESS * OF SUCH A PROGRAM IN THE PROPER CLASS NUMBER POSITON OF THE * ISUSP ARRAY(CORRESPONDING TO CLASS NUMBER POSITION OF ICLAS ARRAY). * E.G. ICLAS(3) & ISUSP(3) ARE FOR CLASS 1. * SUSP NOP LDA SUSP2 GET 'WAIT SUSPEND' LIST POINTER STA POINT * CNTNU LDA POINT SZA,RSS IS CURRENT PTR=0? END OF LIST? JMP SUSP,I YES. JOB DONE. INA AIM AT WORD 2 OF PROG ID SEG. LDA A,I GET TqHE PTR FROM WORD 2. JSB CLAS? IS IT A PTR TO CLASS TABLE? SSA,RSS IF (A)<0 THEN IT WAS NOT CLASS PTR. JMP CLASY IF (A)>0 THEN (A)=CLASS NUMBER NEXID LDA POINT,I USE THIS PTR TO GET NEXT ID SEG PTR. STA POINT JMP CNTNU CONTINUE TRACING THE WAIT LIST. * CLASY INA (A)=CL# + 1. LET US SAY CL#=2, SO (A)=3. ADA ISUSP (A)=ISUSP+3 TO AIM AT ISUSP(4)=CLASS 2 POSITION. LDB POINT GET CURRENT ID SEG PTR. STB A,I SEND PTR BACK TO CLASS 2 POSITION OF ISUSP ARRAY. JMP NEXID CONTINUE TRACING THE WAIT LIST. * * LDA WORD2 OF PROG ID SEG. IT PTS TO CLASS TABLE OR ID SEG. * JSB CLAS? TO SEE IF IT IS A CLASS TABLE POINTER. * UPON RETURN (A)=CLASS NR IF IT WAS A CLASS TABLE POINTER * (A)=-1 OTHERWISE. * CLAS? NOP ENTER WITH (A)=UNKNOWN POINTER. LDB .CLAS GET FWA OF CLASS TABLE. CMB,INB (B)= -FWA ADA B (A)=PTR - FWA JSB LIM IS (A) A VALID CLASS NUMBER ? DEC 1 1=LEAST CLASS NUMBER. DEF $CLAS,I $CLAS HAS RANGE OF CLASS NUMBERS. CCA ERROR RETURN. NOT A CLASS NUMBER. JMP CLAS?,I NORMAL RETURN. (A)=VALID CLASS NUMBER. * * IF IT IS SAFE TO DO SO, THEN INCREMENT ARRAY ADDRESSES. * A & B REGISTERS ARE BOTH PRESERVED. * BUMP NOP STA SAVE LDA MAX,I GET ARRAY LENGTH. CMA,INA ADA ITOTL,I (A)=ITOTL-MAX INA PLAY SAFE. BE SURE WE DON'T OVERFLOW. SSA (A)>=0? ITOTL>=MAX? JMP NOOVF NO. ARRAYS NOT YET FULL. LDA =AOV YES. STA IOVF,I ANNOUNCE OVERFLOW ERROR. LDA .TRUE STA DEBUG,I CAUSE A DUMP. JMP EXIT HALT THE BUFFER EXAMINATION. NOOVF EQU * ISZ IADD BUMP EACH ISZ ILEN ARRAY ADDRESS. ISZ IVAL2 ISZ IVAL3 ISZ ITAG ISZ ITOTL,I ONE MORE LINE TO BE PRINTED. LDA IWAIT,I SZA DID OPERATOR REQUESTED A [SLOW RUN ? JSB WAIT YES. LDA SAVE JMP BUMP,I SAVE NOP * * L=LUNIT(IEQT,IVAIL) TO CONVERT EQT # TO LU # & GET CURRENT AVAILABILITY. * IEQT NOP IVAIL NOP LUNIT NOP JSB .ENTR DEF IEQT * LDA IEQT,I MUST LOOK UP EQT # IN THE TABLE. ADA =D-1 (A)=EQT-1 MPY D15 (A)=15*(EQT-1) ADA D4 (A)=15*(EQT-1) + 4 ADA EQTA (A)=ADDR OF WD 5 OF DESIRED EQT ENTRY. LDA A,I GET WORD 5. AND =B140000 ISOLATE AVAILABILITY (2 BITS). RAL,RAL MOVE TO LOW POSITION. STA IVAIL,I RETURN SHIFTED AVAILABILITY TO CALLER. * LDA LUMAX SET UP LOOP TO SEARCH DEV REF TABLE. CMA,INA STA COUN LOOP COUNTER= - NUMBER DRT ENTRIES. LDA DRT STA POIN POINT TO 1ST DRT ENTRY. * NEXLU LDA POIN,I GET A DRT ENTRY. AND =B77 ISOLATE EQT NUMBER FROM IT. CPA IEQT,I HAVE WE FOUND THE EQT NUMBER? JMP FOUND YES. ISZ POIN POINT TO NEXT LU. ISZ COUN LAST LU? JMP NEXLU NO. CLA YES. JMP LUNIT,I RETURN WITH LU = 0. * FOUND LDA LUMAX INA (A)=LUMAX+1 ADA COUN (A)=LUMAX+1 - COUNT = LU NUMBER. JMP LUNIT,I RETURN WITH LU NUMBER. POIN NOP COUN NOP * * * HED A COLLECTION OF UTILITY ROUTINES USEFUL FOR SYSTEM PROGRAMS. * EXT .ENTR EXT $ALC,$RTN,$PNTR ALL THESE IN $ALC PROGRAM. EXT EXEC,$DHED,$CLAS,$STRG,$SMEM,$SSCT,$STRK * A EQU 0 B EQU 1 S EQU 1 EQTA EQU 1650B FWA EQT TABLE. EQT# EQU 1651B POSITIVE # OF EQT ENTRIES(15 WDS EACH) DRT EQU 1652B FWA DEVICE REFERENCE TABLE. LUMAX EQU 1653B POSITIVE NUMBER OF ENTRIES IN DRT. KEYWD EQU 1657B FWA OF KEYWORD BLOCK (PROG ID SEG POINTERS). SUSP2 EQU 1713B 'WAIT SUSPEND' LIST ( CLASS I/O, FATHER-SON) * .RTN DEF $RTN ENTRY PT FOR BUFFER DE-ALLOCATION. .ALC DEF $ALC ENTRY PT FOR BUFFER ALLOCATION.+ .PNTR DEF $PNTR FRRE LIST START PNTR IN $ALC PROGRAM. .FREE NOP PTR TO $ALC + 174B (START OF FREE LIST). .REIO DEF $DHED PTR TO $DHED .CLAS DEF $CLAS PTR TO FWA CLASS TABLE .STRG DEF $STRG PTR TO LIST OF TURN-ON CHAR STRINGS. .SMEM DEF $SMEM PTR TO SESSION MTR'S SCB (-SCB ADDRESS) .STRK DEF $STRK PTR TO COMMUNICATIONS BASE PAGE ON DISC .SSCT DEF $SSCT SECTOR OF COMMUNICATIONS BASE PAGE ON DISC * D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D14 DEC 14 D15 DEC 15 D16 DEC 16 D64 DEC 64 * * CHASE AN INDIRECT ADDRESS CHAIN TO ITS END, USING ONLY A & E REGISTERS. * CHASE NOP RSS FIRST CHECK THE INDIRECT BIT. LOADI LDA A,I GET CONTENTS OF ADDRESS IN A. RAL,CLE,SLA,ERA CLEAR 15 & SKIP IF IT WAS ALREADY CLEAR. JMP LOADI BIT 15 WAS SET(BUT HAS BEEN CLEARED). JMP CHASE,I WE FOUND A WORD WITH BIT 15 CLEAR. * * CHASE AN INDIRECT ADDRESS CHAIN TO ITS END, USING ONLY B & E REGISTERS. * CHASB NOP RSS LDB B,I RBL,CLE,SLB,ERB JMP *-2 JMP CHASB,I * * * JSB SYSAD TO GET SYSTEM ADDRESSES. * SYSAD NOP LDA .RTN GET POINTER TO $RTN JSB CHASE RESOLVE ITS INDIRECTS. STA .RTN REPLACE ORIGINAL POINTER. LDA .PNTR GET POINTER TO $PNTR SYS ENTRY POINT. JSB CHASE RESOLVE INDIRECTS. STA .FREE SAVE AS STARTING POINTER INTO FREE LIST. * LDA .ALC JSB CHASE DO THE SAME FOR $ALC. STA .ALC * LDA .REIO HEAD OF RE-ENTRANT I/O LIST JSB CHASE RESOLVE THE INDIRECTS STA .REIO SAVE THE HEAD OF THE LIST * * LDA .STRG GET POINTER TO .STRG JSB CHASE RESOLVE ITS INDIRECTS. STA .STRG IT IS READY FOR USE. * LDA .CLAS JSB CHASE DO SAME FOR STA .CLAS CLASS I/O POINTER. * LDA .SMEٽM JSB CHASE GET POINTER TO STA .SMEM SESSION CONTROL BLOCK * XLA .STRK,I TRACK ADDRESS OF COMM. BASE PAGE ON LU2 STA .STRK * XLA .SSCT,I SECTOR ADDRESS OF COMM. BASE PAGE ON LU2 ADA D14 ADD 14 TO GET NEAR SAM DATA ON BASE PAGE STA .SSCT * JMP SYSAD,I * * LDA NWAIT * JSB WAIT TO WAIT FOR NWAIT*(10 MICROSECONDS) * WAIT NOP CMA,INA LOOP COUNTER= - NWAIT TENMU JMP *+1 JMP *+1 A 10 MICROSECOND (2100 TIMING) JMP *+1 LOOP EXECUTED NWAIT TIMES. INA,SZA COUNTER=0 ? JMP TENMU NO. JMP WAIT,I * * LDA NMBR NUMBER/ADDRESS TO BE LIMIT CHECKED. * JSB LIM TO SEE IF 500 <= NMBR <= 500+100-1 = 577 * LOLIM OCT 500 FWA OR LOWER LIMIT (MAY BE LOLIM DEF B500,I ) * LENTH OCT 100 LENGTH (MAY BE LENTH DEF B100,I ). * ERRTN JMP ERROR RETURN TO P+3 IF OUT OF LIMITS. * RETURN TO P+4 IF 500 <= NMBR <= 577 * (A) PRESERVED IN EITHER CASE. * NOTE: LOLIM AND LENTH (AFTER RESOLVING ANY INDIRECTS) MUST BE * NON-NEGATIVE NUMBERS. IF NOT THEIR NUMERIC VALUES (BIT 15 * WILL BE SET IF THEY ARE NEGATIVE) WILL BE INTERPRETED AS * INDIRECT ADDRESSES AND LEAD US ON A WILD GOOSE CHASE. * * IS THIS ADDRESS WITHIN BUFFER LIMITS(FWA=500,LENTH=100,LWA=577) * IS THIS EQT # VALID (1ST=1, LENTH=29, LAST=29 ). * LIM NOP JSB GIVES PTR TO LOLIM. STA NMBR SAVE THE INPUT NUMBER TO BE CHECKED. LDB LIM,I GET LOWER LIMIT(OR PTR) FROM P+1. ISZ LIM POINT TO P+2 JSB CHASB RESOLVE INDIRECTS(IF ANY). (B)=LOLIM. STB LOLIM SAVE LOWER LIMIT. CMB,INB (B)= - LOLIM ADB A (B)= NMBR - LOLIM LDA LIM,I GET LENGTH (OR POINTER) JSB CHASE RESOLVE INDIRECTS. ADA LOLIM FORM UPPER LIMIT OR LWA. ADA =D-1 STA UPLIM ISZ LIM POINT TO P+3 ( ERROR RETURN ):. SSB (B)>=0 ? NMBR >= LOLIM ? JMP ERX NO. (B)<0. NMBR=0 ? UPLIM >= NMBR ? JMP ERX NO. (B)<0. NMBR > UPLIM. ISZ LIM RAISE RETURN ADDRESS TO P+4. ERX LDA NMBR RETURN NMBR TO CALLER. JMP LIM,I NMBR NOP LOLIM NOP FWA OR 1ST NUMBER UPLIM NOP LWA OR LAST LEGAL NUMBER * * LDA NUMBR * JSB LULIM TO SEE IF NUMBR IS WITHIN LU LIMITS. * ERRTN JMP ERROR RETURN TO P+1 IF NUMBR IS NOT AN LU. * RETURN TO P+2 IF 0<=NUMBR<=LUMAX * (A) PRESERVED IN EITHER CASE. * LULIM NOP JSB LIM DEC 1 LOWER LU LIMIT(EXCLUDE BIT BUCKET) DEF LUMAX,I RANGE OF LU NUMBERS. RSS NOT AN LU. ISZ LULIM YES, IT IS WITHIN LU LIMITS. JMP LULIM,I * * LDA PTR GET A POINTER * JSB IDLIM CHECK IF IT IS AIMED WITHIN ID SEG AREA. * RETURN TO P+1 IF OUT OF LIMITS. (A) PRESERVED. * RETURN TO P+2 IF WITHIN LIMITS. (A) PRESERVED. * IDLIM NOP LDB KEYWD GET FWA OF KEYWORD TABLE. XLB B,I GET FWA OF 1ST PROG ID SEGMENT. CMB,INB NEGATE THE FWA AND STB IDFWA SAVE IT FOR SUBTRACTION TO GET LENGTH. CMB,INB I NEED + FWA FOR THE LIM CALL. STB SEG1 ADB =D-2 AIM AT LWA-1 OF KEYWD TABLE. XLB B,I GET FWA OF LAST PROG ID SEGMENT. ADB IDFWA FWA LAST - FWA 1ST ALMOST EQUALS LENGTH. INB NOW (B) = LENGTH OF PROG ID SEGMENT AREA. STB LSEG JSB LIM LIM ROUTINE PRESERVES THE POINTER IN A REGISTER. SEG1 NOP LOW LIMIT IS 1ST ID SEG (JUST AFTER KEYWD TABLE). LSEG NOP LENGTH OF PROG ID SEG AREA. JMP *+2 ERROR RETURN FOR INVALID POINTER. ISZ IDLIM RETURN TO P+2 IF POINTER IS VALID. JMP IDLIM,I RETURN WITH ORIGINAL IN A REGISTER.g IDFWA NOP MINUS FWA ID SEG AREA SAVED HERE. * * FOLLOWING PICTURE DESCRIBES WHY THE ABOVE KEYWORD TABLE CALCULATIONS * WORK. 1ST PROG ID SEG IMMEDIATELY FOLLOWS KEYWD TABLE IN MEMORY. * * ADDRESS CONTENTS COMMENT * 20112 20321 KEYWD 1 HAS ADDR OF ID SEG 1 * 20113 20356 KEYWD 2 HAS ADDR OF ID SEG 2 * * 20317 26207 N-1 OF KEYWD GIVES ADDR OF ID SEG N-1 * 20320 0 NTH KEYWD = 0 TO TERMINATE TABLE. * 20321 22623 WD 1 OF ID SEG 1 (AIMED AT BY KEYWD 1) * 20322 CONTINUE WITH ALL OF THE PROG ID SEGS * * 26207 FWA OF LAST ID SEG. * 26210 2ND WORD OF LAST ID SEG. * * LDA PTR CHECK POINTER FOR VALIDITY * JSB ID.BU IS IT AIMED AT EITHER SAM OR PROG ID SEG ? * RETURN TO P+1 IF INVALID. (A) PRESERVED. * RETURN TO P+2 IF VALID. (A) PRESERVED. * ID.BU NOP JSB IDLIM IS POINTER AIMED AT PROG ID SEG AREA ? JMP *+2 NO. TRY SAM. JMP PLUS2 YES. RETURN TO P+2. JSB BULIM IS POINTER AIMED AT S.A.M. ? JMP *+2 NO. POINTER IS INVALID. PLUS2 ISZ ID.BU RETURN TO P+2 IF POINTER IS VALID. JMP ID.BU,I RETURN WITH ORIGINAL POINTER IN A REGISTER. * * LDA ADDR * JSB BULIM TO SEE IF ADDR WITHIN 1 OF SAM BUFFERS. *ERRTN JMP ERROR RETURN TO P+1 IF NOT IN ANY SAM BUFFER. * RETURN TO P+2 IF ADDR WITHIN ANY OF SAM BUFFERS. * (A) WILL BE PRESERVED, (B) DESTROYED. * NOTE: MUST CALL PREBL FIRST. THEN BULIM READY FOR REPEATED USE. * BULIM NOP JSB LIM IS (A) WITHIN LIMITS OF SAM 1 AREA ? DEF SAM1,I FWA DEF LSAM1,I LENGTH JMP *+2 OUTSIDE SAM 1. TRY NEXT AREA. JMP BUYES WITHIN SAM 1. WE ARE DONE. JSB LIM HOW ABOUT SAM 2 ? DEF SAM2,I DEF LSAM2,I JMP *+2 JMP BUYES JSB LIM SAM 3 ?  DEF SAM3,I DEF LSAM3,I JMP BULIM,I RETURN TO P+1. BUYES ISZ BULIM JMP BULIM,I RETURN TO P+2 * * PREPARE BUFFER LIMITS. CALL PREBL (FTN CALLABLE) * * FOR RTE IV TK 0, SECT 16 OF SYSTEM DISC(LU 2) CONTAINS THE * BASE PAGE COMMUNICATION AREA OF THE SYSTEM. AT BOOT UP TIME * 6 WORDS OF THE CURRENT EQT AREA(1662B-1667B) CONTAIN * 3 WORD PAIRS, EACH REPRESENTING FWA & LENGTH OF ONE OF THE * 3 POSSIBLE AREAS OF SYSTEM AVAILABLE MEMORY. SINCE THIS WILL * DISAPPEAR AFTER BOOT UP, I MUST READ THE DISC TO GET SAM * ADDRESSES. THEY BEGIN AT WORD 49 DECIMAL OF THE DISC SECTOR. * THE DEC NUMBERS IN SAM & LSAM LOCATIONS ARE FOR TESTING PURPOSES ONLY. * ENT PREBL PREBL NOP ISZ PREBL JSB EXEC CALL EXEC(1,2,BF,64,.STRK,.SSCT) DEF *+7 READ 1 SECTORS(64 WDS ) INTO BF. DEF D1 DEF D2 DEF BF DEF D64 DEF .STRK DEF .SSCT JMP PREBL,I BF BSS 48 IGNORE BASE PAGE COMMO AREA OF SECTOR. SAM1 DEC 10 ADDR OF BUFFER BELOW RES LIBRARY. LSAM1 DEC 1 LENGTH SAM2 DEC 20 ADDR OF BUFFER BELOW FG CORE RES AREA. LSAM2 DEC 2 SAM3 DEC 30 ADDR OF BUFFER BELOW FG DISC RES AREA. LSAM3 DEC 3 BSS 10 REMAINDER OF THE 64 WDS REQUESTED. .SAM DEF SAM1 POINTER TO SAM ADDRESSES. * * CALL ISAM(NN,IFWA,ISIZE) TO GET FWA & LENGTH OF THE NNTH SAM BUFFER. * ENT ISAM NN NOP IFWA NOP ISIZE NOP ISAM NOP JSB .ENTR DEF NN LDB NN,I GET SAM # ADB =D-1 COUNT FROM 0 INSTEAD OF 1. BLS DOUBLE IT FOR WORD PAIRS. ADB .SAM ADD FWA OF THE SAM ADDRESSES. LDA B,I GET SAM FWA STA IFWA,I & RETURN IT TO CALLER. INB POINT TO SAM LENGTH LDA B,I GET SAM LENGTH STA ISIZE,I & RETURN IT TO CALLER. JMP ISAM,I * * CALL UNBUF(LU) TO UNBUFFER DEVICE LU. THEN LATER IN PROGRAM : * CALL REBUF TO RESTORE DEVICE TO ITwS ORIGINAL STATE(BUFFERED OR NOT). * ENT UNBUF LUUU NOP UNBUF NOP JSB .ENTR DEF LUUU LDB LUUU,I GET LU NUMBER JSB LU2EQ CONVERT LU TO PTR TO EQT ENTRY. JMP UNBUF,I ERROR RETURN FOR LU OUT OF RANGE. ADB D3 POINT TO WORD 4 OF EQT ENTRY. STB UNPTR LDA UNPTR,I GET WORD 4 & STA WORD4 SAVE IT FOR REBUF. AND =B137777 ZERO OUT THE BUFFER BIT (BIT 14). JSB JAM PUT NEW WORD 4 INTO EQT ENTRY. JMP UNBUF,I UNPTR NOP POINTER AND EQT WORD SAVED WORD4 NOP BY UNBUF FOR USE BY REBUF. * * CALL REBUF TO RESTORE WORD 4 TO THE EQT ENTRY. * NOTE: YOU SHOULD HAVE CALLED UNBUF FIRST. * ENT REBUF REBUF NOP JSB .ENTR DEF REBUF LDB UNPTR DID HE CALL UNBUF PREVIOUSLY? SZB,RSS IF UNPTR=0 JMP REBUF,I THEN RETURN LDA WORD4 GET OLD WORD 4 SAVED BY UNBUF. JSB JAM PUT IT BACK INTO EQT ENTRY. JMP REBUF,I * * LDB ADDR * LDA DATA * JSB JAM TO STORE DATA IN ADDR BELOW THE MEMORY PROTECT FENCE. * JAM NOP DST SAV2 JSB $LIBR DOWN WITH THE FENCE. NOP DLD SAV2 STA B,I STORE DATA INTO LOW CORE. JSB $LIBX PUT THE FENCE UP AGAIN. DEF *+1 DEF *+1 JMP JAM,I SAV2 BSS 2 * * LDB LU# * JSB LU2EQ CONVERT LU NUMBER TO EQT NUMBER & POINTER. * JMP BADLU ERROR RETURN IF LU NUMBER OUT OF RANGE. * JMP OKLU RETURN WITH (A)=EQT NUMBER, (B)=FWA OF EQT ENTRY. * LU2EQ NOP STB A JSB LIM IS LU WITHIN LIMITS ? DEC 1 DEF LUMAX,I JMP LU2EQ,I OUT OF LIMITS. ISZ LU2EQ LU GOOD. ADA =D-1 ADA DRT (A)=FWA DRT + LU-1 LDA A,I GET DRT ENTRY FOR THIS LU. AND =B77 ISOLATE EQT # STA #EQ ADA =D-1 MPY D15 (A)= 15*(EQ-1) ADA EQTA (A)= FWA OF THIS EQT ENTRY. STA B LDA #EQ  JMP LU2EQ,I #EQ NOP HED RTE IV MEMORY MAP & HOW TO LOCATE SAM AREAS. * FOLLOWING IS A SAMPLE MAP OF A SYSTEM, SHOWING SAM LOCATIONS * * WORD CONTENTS MEANING * NUMBER * * * 54 * 001554 LENGTH OF SAM 3 AREA. * 53 * 004224 FWA OF SAM 3 AREA * 52 * 000000 LENGTH OF SAM 2 AREA (UNUSED IN THIS GEN). * 51 * 064000 FWA OF SAM 2 AREA. (UNUSED IN THIS GEN). * 50 * 006061 LENGTH OF SAM 1 AREA. * 49 * 005717 FWA OF SAM 1 AREA. * * * FOR THE SAME RTE IV GENERATION THE SYSTEM MEMORY MAP WAS AS FOLLOWS: * SAMPLE CONFIGURATION....DEPENDENT ON SYSTEM GENERATION * * * * SAM 2 WOULD BEGIN HERE IF IT HAD BEEN REQUESTED. * 64000 * ----------------------------------------------------- * * SAM 1 AREA (6061 WORDS) * 55717 * ----------------------------------------------------- * * * * SYSTEM (EXEC, SCHED, ETC.) * * * 27325 * ----------------------------------------------------- * * TABLE AREA 2 IN SYS & MOST USER MAPS (NOT BIG PARTITIONS) * * HAS KEYWORD TABLE, PROG ID SEGMENTS, ETC. * 17636 * ----------------------------------------------------- * * SYSTEM DRIVER AREA * 14000 * ----------------------------------------------------- * * BG COMMON * * RT COMMON * * SSGA * 12000 * ----------------------------------------------------- * * APPARENTLY WASTED MEMORY * 11373 * ----------------------------------------------------- * * DRIVER PARTITION * 6000 * ----------------------------------------------------- * * SAM 3 (1554 WORDS) * 4224 * ----------------------------------------------------- * * TABLE AREA 1 (PRESENT IN ALL USER MAPS AND SYSTEM MAP). * * INTERRUPT TABLE * * DEVICE REF TABLE * * EQT TABLE * * $TB32 (SYSTEM DISC DgESCRIPTION[7905 7920]) * 2000 * ----------------------------------------------------- * * SYSTEM BASE PAGE * 0 * ----------------------------------------------------- END ASMB,R,B,L,C * TUE, 6 JAN 75. NAM SORTR,7 SORT ADJACENT ARRAYS IN COMMON * DOES NUMERIC SORT ON 1-WORD FIELD IN (NAMES) * CALLED FROM FTN BY: CALL ALPHA(IADD,ITOTL,5,200) * IN THIS EXAMPLE: * IADD=FWA OF 1ST ARRAY(CONTAINING THE SORT KEY WORDS) * ITOTL= NUMBER OF ITEMS TO BE SORTED. * 5=NR OF EQUAL LENGTH ADJACENT ARRAYS IN COMMON * 200=LENGTH OF EACH ARRAY. ENT SORTR EXT .ENTR NAMES BSS 1 =FWA OF 1ST ARRAY(SORT KEYS). IFILE BSS 1 =NUMBER OF ITEMS IN EACH ARRAY(IFILE<=LENTH) NSWAP NOP =# OF ARRAYS =# OF WORDS TO BE SWAPPED. LENTH NOP =LENGTH OF EACH ARRAY(ALL ARE OF EQUAL LENGTH). SORTR NOP JSB .ENTR DEF NAMES CLA STA RPEAT LDA IFILE,I CMA,INA STA CNTR1 CNTR1=-IFILE LOOP1 EQU * LDA CNTR1 ADA IFILE,I (A)=CNTR1+IFILE=CURRENT WORD NUMBER. ADA NAMES (A)=FWA NAMES+CURRENT WD # STA ADDR1 STA PNTR1 PNTR1,ADDR1 PT TO NAME(I) LDA CNTR1 CPA RPEAT CNTR1=0? JMP OUT YES. QUIT. INA SZA,RSS IS CNTR1= -1 ? JMP OUT YES. QUIT. STA CNTR2 NO. SET CNTR2=CNTR1. LOOP2 EQU * LDA CNTR2 ADA IFILE,I (A)=CNTR2+IFILE=CURRENT WORD NUMBER. ADA NAMES STA ADDR2 STA PNTR2 PNTR2,ADDR2 PT TO NAME(J) LDA =D-1 SET CNTR3 TO PROCESS A 1 WD SORT KEY. STA CNTR3 LDA ADDR1 LOOP3 EQU * LDB ADDR2,I GET NAME(J) 1ST WORD CMB,INB (B)=-NAME(J) ADB A,I (B)=NAME(I)-NAME(J) INA ISZ ADDR2 SSB JMP END2 SZB JMP SWTCH ISZ CNTR3 JMP LOOP3 JMP END2 SWTCH EQU * LDA NSWAP,I SET COUNTER FOR NUMBER t& CMA,INA OF WORDS TO BE SWAPPED. STA CNTR4 LDA ADDR1 STA PNTR1 LOOP4 EQU * LDA PNTR1,I LDB PNTR2,I SWP STA PNTR1,I STB PNTR2,I LDA PNTR1 EACH PNTR MUST BE AIMED AT ADA LENTH,I CORRESPONDING WORD OF NEXT ARRAY. STA PNTR1 LDA PNTR2 ADA LENTH,I STA PNTR2 ISZ CNTR4 JMP LOOP4 END2 EQU * ISZ CNTR2 JMP LOOP2 ISZ CNTR1 JMP LOOP1 OUT EQU * JMP SORTR,I CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 = -NUMBER WORDS IN SORT KEY(ALWAYS=-1) CNTR4 BSS 1 = -NUMBER WORDS TO BE SWAPPED(=-NSWAP) PNTR1 BSS 1 PNTR2 BSS 1 RPEAT BSS 1 ADDR1 BSS 1 ADDR2 BSS 1 IFLAG OCT 200 A EQU 0 B EQU 1 END FJ c! 24999-18244 2024 S 0100 &DLB SOURCE             H0101 ASMB,L NAM DLRP .CBT RPL 105766B END ASMB,R,L,Z,Q HED DL MAIN * * NAME: DL * SOURCE: 24999-18244 * RELOC: 24999-16244 * PGMR: D.H.P. * IFZ NAM DL,3,74 24999-16245 REV.1940 791001 RTE-IVA (& RTE-III) XIF * IFN NAM DL,3,74 24999-16244 REV.2024 800605 RTE-IVB XIF * * THE PURPOSE OF THIS PROGRAM IS TO DETERMINE THE LENGHT OF AVAILABLE * BACKGROUND AND PASS THE LENGTH TO DLSUB WHICH DOES ALL THE WORK. * AVAILABLE BACKGROUND IS USED FOR STORAGE OF THE FILE NAMES USED IN DL. * * ASSEMBLE WITH 'Z' OPTION FOR RTE-IVA (AND RTE-III) * ASSEMBLE WITH 'N' OPTION FOR RTE-IVB * EXT EXEC,COR.A,DLSUB IFN EXT $CL1,$CL2,FG.LU,.ENTR,$DATC ENT IFGLU XIF * * MAIN ENTRY POINT FOR DL * * SET FOR TOTAL BACKGROUND SWAPPING (USED IN RTE-3 ONLY) DL JSB EXEC DEF *+3 DEF D22 DEF D3 * LDA XEQT GET ID SEGMENT ADDRESS * * GET BACKGROUND ADDRESS JSB COR.A GO GET FIRST WORD AVAIL BACK GND STA BDEF A = FWA BACKGROUND * * CALCULATE AVAILABLE BACKGROUND CMA,INA A = FWABK ADA BKLWA A = BKLWA - FWABK STA LGTH BACKGROUND LENGTH * * CHECK IF ENOUGH ROOM * ADA M128 MAKE SURE A SECTOR WILL FIT SSA,RSS JMP DL.1 STA LGTH SEND NEGATIVE LENGTH TO DLSUB JMP DL.5 AND DO IT NOW * DL.1 EQU * IFZ LDA TATSD GET # TRACKS ON SYS DISC ADA M1 MINUS 1 STA LTRAK SAVE XIF IFN LDA $CL2 GET STARTING SECTOR OF CL ADA D2 BUMP TO MSC SECTOR STA ISEC XIF JSB EXEC READ SECTOR WITH MSC DEF DL.4 DEF D1 READ DEF D2 LU 2 DEF BDEF,I BUFFER DEF D128 IFN DEF $CL1 TRACK FOR SESSION DEF ISEC SECTOR FOR SESSION XIF IFZ DEF LTRAK DEF D0  XIF * DL.4 LDA BDEF ADA D126 LDA A,I IFN LDB $DATC ADB M2000 SSB JMP DL.41 SZA,RSS JMP DL.41 MSC IS '0' XOR DCMSK INA XIF DL.41 STA MSC * * GO TO MAIN PORTION OF DL DL.5 JSB DLSUB CALL DLSUB(FWAM,LGTH) DEF *+4 BDEF NOP DEF LGTH DEF MSC SKP * * * TERMINATE DL THEN TERMINATE JSB EXEC DEF *+2 DEF D6 IFN * * GIVE FORTRAN INTERFACE FOR FG.LU ROUTINE. * SESLU NOP SYSLU NOP L3 NOP BUF NOP IFGLU NOP JSB .ENTR DEF SESLU JSB FG.LU DEF RTNFG DEF SESLU,I DEF SYSLU,I DEF L3,I DEF BUF,I RTNFG JMP IFGLU,I XIF * D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D6 DEC 6 D22 DEC 22 D126 DEC 126 D128 DEC 128 M1 DEC -1 M128 DEC -128 M2000 DEC -2000 DCMSK DEC 31178 LGTH NOP LENGTH OF UNUSED BACKGROUND MSC NOP MASTER SECURITY CODE ISEC NOP SECTOR OF MSC LTRAK NOP DIRECTORY TRK OF LU 2 (RTE-IVA) XEQT EQU 1717B ADDRESS OF CURRENT ID SEG. TATSD EQU 1756B NO. OF TRKS. ON SYSTEM DISC. BKLWA EQU 1777B ADDRESS OF LWAM * A EQU 0 END DL FTN4,L SUBROUTINE DLSUB(NAMES,LGTH,MSC) +, REV.2024 800605 RTE-IVB C---- C THIS PROGRAM LISTS ALL OR SELECTED FILE NAMES. C TO USE TYPE ON,DL,(P1),(P2),(P3),(P4),(P5),(P6) C C # (P1)= FILE NAMR FILTER MAY INCLUDE SECURITY,CART.,TYPE C C (P2)= LIST UNIT (DEFAULT YOUR CONSOLE)[:SF = SHORT FORM] C [:LF = LONG FORM](DEFAULT) C P3 IS USED TO INVOKE SPECIAL LISTING OPTIONS TO DL. C C J (P3)= 'OF' LIST OFF. DO NOT LIST FILES. C F (P3)= 'EN' LIST END OF DIRECTORY # FILES GIVEN BY 'P4' C I (P3)= 'OP' LIST ONLY FILES THAT ARE OPEN C L (P3)= 'PU' LIST FILES THAT HAVE BEEN PURGED C T C C P4 IS PRIMNARILY USED TO DETERMINE THE OUTPUT FORMAT C OF DL. IT ALSO INVOKES SOME SPECIAL OPTIONS. C C J (P4)= NUMBER OF FILES TO BE LISTED IF P3 IS 'EN'(DEFAULT ALL) C C (P4)= 'HE' TO HAVE AN EXPANDED HEADING PRINTED. C R (P4)= 'FC' TO HAVE NUMBER OF FILES PRINTED C I (P4)= 'BO' TO HAVE HEADING AND FILE INFO PRINTED C *F (P4)= 'SC' TO SCAN ALL SECURITY CODES ON A GIVEN PLATTER C * (P4)= 'PU' TO PURGE ALL FILES LISTED C * (P4)= 'DI' GIVES DIRECTORY TRACK, SECTOR, AND WORD OF THE FILE C (P4)= 'DS' GIVES DISC USAGE SUMMARY OF ALL DISCS QUARRIED.FILE C C * NOT ALLOWED IF SHORT FORM REQUESTED. C C P5 REVERSE FILTER FLAGS C C (P5)= 'RF' REVERSE FILE NAME FILTER C (P5)= 'RS' REVERSE SECURITY CODE FILTER C (P5)= 'RT' REVERSE FILE TYPE FILTER C (P5)= 'RA' REVERSE ALL FILTERS C C (P6)= 'AL' CHECK ALL CARTRIDGES MOUNTED IN THE SYSTEM C C # THE FILE NAME FILTER HAS BEEN ENHANCED IN DL TO ALLOW A SEARCH C FOR A STRING OF CHARACTERS ANYWHERE IN THE FILE NAME. FOR FURTHER C EXPLAINATION OF THIS FEATURE SEE THE DOCUMENTATION FILE ON 'DL'. C C ADDITONAL PROBLEMS NOT TO BE RESOLVED: C C WHEN ASKING FOR OPEN FILES ONLY (P4 ='OP') THE NUMBER OF EXTENTS C WILL NOT BE SHOWN. ANY OTHER TYPE OF LISTING WILL SHOW THE EXTENTS C HOWEVER. THIS IS BECAUSE FMGR DOES NOT KEEP OPEN FLAGS ON EXTENTS, C ONLY ON THE MAIN FILE. C------------------------------------------------------------------- C C C C LOGICAL HEAD,RECRD,FGO,SGO,TGO,FFLAG,SFLAG,TFLAG,ENORPU LOGICAL SLSW,SFFLG,SKEXT,NOSC C INTEGER SUPFLG,CRNAME(3),CRLOOP,COLON,LBUFF(40) C C C DIMENSION NAMES(4,1),IDCB(144),ICLST(4,64),LPROG(8,3) DIMENSION IBUFF(16,8),JBUFF(10),ITIME(6),IMSC(5),LACR(3) DIMENSION IBTRK(6),ISCBUF(144),IB(2),IC(3),IFILT(6) C EQUIVALENCE (IB(1),REG),(IBREG,IB(2)),(ITIME(1),ITIME1) C C SAVE SOME MEMORY. C EQUIVALENCE(ISCBUF,IDCB) EQUIVALENCE(JBUFF(1),JBUF1),(JBUFF(2),JBUF2)6,(JBUFF(3),JBUF3), # (JBUFF(4),JBUF4),(JBUFF(5),JBUF5),(JBUFF(6),JBUF6), # (JBUFF(7),JBUF7),(JBUFF(8),JBUF8),(JBUFF(9),JBUF9), # (JBUFF(10),JBUF10),(LACR(3),LACR3) EQUIVALENCE(IC(3),ICSUB3),(ICLST(1,1),ICLST1),(LPROG(1,1),LPROG1) EQUIVALENCE(IBUFF(4,1),IBUF41),(IBUFF(6,1),IBUF61), # (IBUFF(7,1),IBUF71),(IBUFF(8,1),IBUF81), # (IBUFF(9,1),IBUF91),(IBUFF(10,1),IBU101), # (IBUFF(5,1),IBUF51),(IBUFF,LBUFF) DATA IC/177400B,377B,2H::/,IDISK/1/,TBLK/0.0/,LPROG/24*2H / DATA IPURG/0/,IFILT/6*0/,ITYPE/-1/,REG/0.0/,IVETO/0/ DATA ISKPSC/0/,SUPFLG/0/,ISTRC/1/,JCR/0/,IPCNT/0/ DATA JCRIF/0/,JFILT/0/,COLON/2H::/,IOP/0/,IP/0/ DATA RECRD/.TRUE./,FGO/.TRUE./,SGO/.TRUE./,TGO/.TRUE./ DATA FFLAG/.TRUE./,SFLAG/.TRUE./,TFLAG/.TRUE./,NOSC/.TRUE./ DATA LACR /2*2H ,-1/,SLSW/.FALSE./,MINUS/1H-/,SFFLG/.FALSE./ C C SET UP INPUT AND OUTPUT UNITS AND C INITIALIZE VARIABLES C LUIN = LOGLU(ISES) WRITE(LUIN,150) 150 FORMAT(" /DL - REV 2024") C IF(LGTH .LT. 0)GO TO 1280 IDIM2 = LGTH/4 IPL = 1 ICL = 3 IMESS = 0 C C SET UP DEFAULT ASSIGNMENTS C ASSIGN 820 TO IPNTH ASSIGN 1110 TO IRTN ASSIGN 1060 TO IPNTX ASSIGN 1100 TO IOPNT ASSIGN 1140 TO IPNT ASSIGN 1160 TO IPNT0 LUINE = LUIN + 400B C C GET THE TURN ON STRING C CALL GETST(IDCB,-60,ILOG) C C IF NO PARAMETERS WHERE PASSED JUST ASK FOR THE FILTER C 4 IF(IDCB .NE. 2H?? .AND. IDCB .NE. 2HHE)GO TO 5 IF(ILOG .NE. 2)GO TO 5 WRITE(LUIN,15) 15 FORMAT(/ +" ENTER: Namr filter[,List dev.,List opt.,Special opt.,Reverse " +"filter,ALL]"// +" WHERE: List opt. is ,Special opt. is"6X",Reverse filter is,"/ +7X"'OF' LIST OFF ,'HE' EXPAND HEADING ,'RF' Rev. NAME FILTER"/ +7X"'OP' OPEN FILES ,'FC' FILE CNT & SIZE ,'RS' Rev. SC FILTER"/  +7X"'PU' PURGED FILES,'BO' BOTH 'HE' & 'FC','RT' Rev. TYPE FILTER"/ +24X",'SC' SCAN SEC CODE ,'RA' Rev. ALL FILTERS"/ +24X",'PU' PURGE FILES"/ +24X",'DI' DIRCT. LOCATION"/ +24X",'DS' DISC USAGE SUMMARY"/ +7X"'EN' END OF DIR. , # OF FILES TO LIST"// +7X" ALL PARAMETERS OPTIONAL (EXCEPT NAMR FILTER)"/) GO TO 6 5 IF(ILOG .NE. 0)GO TO 20 6 WRITE(LUIN,10) 10 FORMAT(" ENTER FILE NAMR FILTER : _") REG = REIO(1,LUINE,IDCB,-60) ILOG = IBREG IF(ILOG .EQ. 0)RETURN GO TO 4 20 IF(NAMR(JBUFF,IDCB,ILOG,ISTRC))140,30 30 IPCNT = IPCNT + 1 GO TO(40,90,100,110,120,135),IPCNT 40 IPTYPE = IAND(JBUF4,3) IF(IPTYPE .EQ. 0)GO TO 80 IST = ISTRC - 1 I = 1 CALL STGFD(IDCB,IST,COLON,1,I,IFLGTH) IF(I .NE. 0)GO TO 50 IFLGTH = IST - 1 IF(ILOG .EQ. IST)IFLGTH = IST GO TO 60 50 IFLGTH = IFLGTH - 1 60 IWD = IFLGTH/2 + 1 IF(IWD .GT. 6)IWD = 6 DO 70 I=1,IWD IFILT(I) = IDCB(I) 70 CONTINUE 80 IPTYPE = ISOL8(JBUF4,2,3) IF(IPTYPE .EQ. 0)ISKPSC = -1 C C SET UP THE 'NO SEC. CODE' LIST OPTION. C IF THE USER SPECIFIED A SEC. CODE. C LET HIM SEE WHAT HE SPECIFIED. C IF(ISKPSC .NE. -1)NOSC = .FALSE. IPFIL = JBUF5 JCR = JBUF6 C C MASTER SEC. CODE GIVEN IN 4TH SUB PARAM. C WILL OVER RIDE THE 'NOSC' FLAG C IF(JBUF8 .EQ. MSC)NOSC = .FALSE. IPTYPE = ISOL8(JBUF4,6,7) IF(IPTYPE .GT. 0)ITYPE = JBUF7 GO TO 20 90 IPTYPE = IAND(JBUF4,3) IF(IPTYPE .EQ. 1)LUOUT = JBUFF IF(JBUF5 .EQ. 2HSF)SFFLG = .TRUE. IF(JBUF5 .EQ. 2HLF)SFFLG = .FALSE. IF(JBUF6 .EQ. 2HNO)NOSC = .TRUE. GO TO 20 100 JFILT = JBUFF GO TO 20 110 JCRIF = JBUFF GO TO 20 120 DO 130 I=1,3 IF(JBUFF(I) .EQ. 2HRF)FGO = .FALSE. IF(JBUFF(I) .EQ. 2HRS)SGO = .FALSE. IF(JBUFF(I) .EQ. 2HRT)TGO = .FALSE. IF(JBUFF(I) .NE. 2HR<A)GO TO 130 FGO = .FALSE. SGO = .FALSE. TGO = .FALSE. 130 CONTINUE GO TO 20 135 IF(JBUFF .EQ. 2HAL)IOP = 1 140 IF(JFILT .EQ. 2HOF)SUPFLG = 1 ENORPU = (JFILT .EQ. 2HEN) .OR. (JFILT .EQ. 2HPU) IF(LUOUT.EQ.0)LUOUT = LUIN LUPAG=IOR(LUOUT,1100B) IF(.NOT. SFFLG .AND. .NOT.NOSC)GO TO 155 C C SET PRINT STATEMENT PER 'NOSC' FLAG C ASSIGN 821 TO IPNTH ASSIGN 1061 TO IPNTX ASSIGN 1101 TO IOPNT ASSIGN 1141 TO IPNT ASSIGN 1161 TO IPNT0 IF(JCRIF.NE.2HPU.AND.JCRIF.NE.2HDI.AND.JCRIF.NE.2HSC)GO TO 155 WRITE(LUIN,145) 145 FORMAT(" OPTION NOT AVAILABLE TO YOU") GO TO 170 C C WHO'S MOUNTED C 155 CALL FSTAT(ICLST,256,0,IOP) C C GOING TO PURGE OR LIST SECURITIES ONLY ?? C IF(JFILT.EQ.2HEN)GO TO 260 IF(JCRIF.EQ.2HSC)GO TO 240 IF(JCRIF.NE.2HPU)GO TO 260 WRITE(LUIN,160) 160 FORMAT(" **** CAUTION ****"/" YOU ARE ABOUT TO PURGE ALL FILES " $"LISTED WITH THIS PROGRAM"/" DO YOU WANT TO PROCEED ? _") CALL REIO(1,LUINE,NHUH,-2) IF(NHUH.EQ.2HYE)GO TO 190 170 WRITE(LUIN,180) GO TO 1270 180 FORMAT(" DL ABORTED") C C CHECK IF VETO OPTION WANTED C 190 WRITE(LUIN,200 ) 200 FORMAT(" VETO OPTION ? _") CALL REIO(1,LUINE,NHUH,-2) IF(NHUH .EQ. 2HYE)IVETO = 1 WRITE(LUIN,210) 210 FORMAT(" ENTER MASTER SECURITY CODE: _") ISTRC = 1 REG = REIO(1,LUIN,IMSC,-10) CALL NAMR(JBUFF,IMSC,IBREG,ISTRC) IF(JBUFF.EQ.MSC)GO TO 230 WRITE(LUIN,220) GO TO 170 220 FORMAT(" ILLEGAL MASTER SECURITY CODE") 230 IPURG = 99 IF(IVETO .EQ. 1)GO TO 260 240 IF(JCR.NE.0)GO TO 260 WRITE(LUIN,250) 250 FORMAT(" YOU MUST SPECIFY A CARTRIDGE FOR THIS OPTION _") ISTRC = 1 REG = REIO(1,LUINE,IMSC,-10) CALL NAMR(JBUFF,IMSC,IBREG,ISTRC) JCR = JBUFF GO TO 240 C C CHECK FOR # OF CARTRIDGES MOUNTED C 260 JBUFF = 0 DO 270 NUMCT=1,31 IF(ICLST(1,NUMCT).EQ.0) GO TO 280 270 CONTINUE C C SET # OF CARTRIDGES AND CHECK FOR CARTRIDGE WANTED C 280 LU= ICLST1 NUMCT=NUMCT-1 IF(JCR.EQ.0)GO TO 320 IF(JCR.GT.0)GO TO 290 ICL = 1 JCR = -JCR C C FIND THE LU NUMBER OF THE CARTRIDGE WANTED C 290 DO 300 KCKNT=1,NUMCT IF(ICLST(ICL,KCKNT).NE.JCR)GO TO 300 LU=ICLST(1,KCKNT) JCR=ICLST(3,KCKNT) IDISK=KCKNT GO TO 320 300 CONTINUE LUCR = 2HCR IF(ICL .EQ. 1)LUCR = 2HLU WRITE(LUIN,310)LUCR,JCR 310 FORMAT(1X,A2" = ",I5," IS NOT MOUNTED") GO TO 1270 320 IF(JCR.NE.0)NUMCT = 1 GO TO 340 330 NUMCT = IPL -1 JCRIF = 2HFC HEAD = .FALSE. ISKPSC = 0 C C START LOOP FOR EACH CARTRIDGE C 340 IF(JCRIF .NE. 2HDS)GO TO 342 CALL JULIA(ITIME) IF(IFILT .NE. 0)GO TO 346 IFLGTH = 2 IFILT = 40B 346 WRITE(LUOUT,344)ITIME 344 FORMAT(/16X"DISC CARTRIDGE UTILAZATION SUMMARY "6A2/ #/25X"AVAILABLE"10X, #"A F T E R P A C K"/3X,"CRN LU LABEL SCT/ BLKS/ DIR." #" %USED BLKS/ DIR. %USED NEXT LAST DIR"/ #19X"TRK"9X"ENT."16X"ENT."10X"TRK TRK TRK"/ #2X,77("-")) 342 DO 1240 CRLOOP=1,NUMCT IF(SLSW)CALL IFGLU(LU,MINUS,0,IDCB) SLSW = .FALSE. ISKIP=32767 IF(IPL.EQ.1)GO TO 350 IPFIL = ISCBUF(CRLOOP) GO TO 740 C C GET LU # OF CARTRIDGE WANTED C 350 IF(CRLOOP.EQ.1)GO TO 360 LU=ICLST(1,IDISK) C C SET SECTOR FOR PERIPHERAL OR SYSTEM DISC C C GET THE LAST TRACK THE FMGR HAS IN THE CURRENT CARTRIDGE. C 360 ITRAK=ICLST(2,IDISK) IDISK=IDISK+1 LTRAK = ITRAK 370 ISEC=0 IBLK=0 C C GET FILE DIRECTORY INFORMATION. C CALL EXEC(100001B,LU,IBUFF,128,ITRAK,ISEC) GO TO 1300 C C SKIP THE INITIALIZE STUFF IF WE ARE DOING THE 'SC' TRICK C 375 IF(IPL.GT.1)GO TO 470 IF(ISKIP.NjE.32767)GO TO 540 C C SAVE CR NAME & NUMBER C DO 390 JJ=1,3 CRNAME(JJ) = IBUFF(JJ,1) LACR(JJ) = 2H 390 CONTINUE CRNAME = IAND(CRNAME,77777B) ICR = IBUF41 LACR3 = -1 C C CHECK FOR BAD TRACKS AND RECORD THEM C DO 400 IJK=1,6 IKL=IJK+10 IF(IBUFF(IKL,1).EQ.0)GO TO 410 IBTRK(IJK)=IBUFF(IKL,1) 400 CONTINUE IBTCT=6 GO TO 420 410 IBTCT=IJK-1 420 ISPT=IBUF71 LDTRK = IBUF81 NXTTRK = IBU101 C C COMPUTE TOTAL NUMBER OF TRACKS FOR LU C TNTKS = LDTRK-IBUF51 C C GET THE NUMBER OF AVAILABLE TRACKS C TREM=IBUF81-IBU101 ISREM=0 C C IF ON SECTOR ZERO SUBTRACT ONE TRACK C IF(IBUF61.EQ.0) GO TO 430 TREM=TREM-1 C C COMPUTE AVAILABLE SECTORS C ISREM=IBUF71-IBUF61 C C COMPUTE TOTAL BLKS AVAILABLE C 430 BREM=((TREM*ISPT)+ISREM)/2 C C GET TOTAL # BLKS FOR LU AND COMPUTE % USED AREA C TNBLKS = (TNTKS*ISPT)/2 PCUSED = ((TNBLKS-BREM)/TNBLKS) * 100.0 C C GET NUMBER OF DIRECTORY TRACKS AND COMPUTE THE NUMBER OF C DIRECTORY ENTRIES AVAILABLE C IDTRK=-IBUF91 IDENT=IDTRK*ISPT*4-1 C C LOCK OUTPUT DEVICE C 440 IF(LUIN.EQ.LUOUT) GO TO 460 IREG=LURQ(100001B,LUOUT,1) IF(IREG.EQ.0)GO TO 460 C C LOCK UNSUCCESSFUL, SO REPORT C IF (IMESS .EQ. 0)WRITE (LUIN,450) LUOUT 450 FORMAT (1X"WAITING FOR LU# "I3) C IMESS = 1 CALL EXEC(12,0,2,0,-3) IF(IFBRK(IDMMY))1270,440,440 460 CALL ASCII(ICR,LACR3) IF(LACR3 .EQ. 20040B)CALL CNUMD(ICR,LACR) HEAD=(JCRIF.EQ.2HHE).OR.(JCRIF.EQ.2HBO).OR.(JCRIF.EQ.2HSC) IF(HEAD.EQ..FALSE.)GO TO 500 C C GET THE TIME FROM THE REAL-TIME CLOCK. C 470 CALL JULIA(ITIME) C C PRINT THE HEADING C WRITE(LUOUT,480)ITIME IF(IPL .GT. 1)GO TO 500 IF(IPURG.EQ.99)GO TO 520 480 FORMAT(67X,6A2) WRITE(LUOUT,490)CRNAME,LACR,LU,IBUF71,IBUF51,IBU101, #IBUF61,ITRAK,IDTRK,BREM,PCUSED 490 FORMAT(1X,31("*"),5X,3A2,5X,31("*")/ #32X,"CR=",3A2," LU=",I3// #30X,"SECTORS/TRACK = ",I3/ #" 1ST TRACK ="I4,2X"NEXT TRACK ="I4,10X,"NEXT SECTOR = ",I3/ #18X,"LAST TRACK ="I4,11X,"DIR TRACKS = ",I3// #28X,"BLOCKS AVAILABLE = ",I6,2X,F6.2,"% USED") GO TO 540 500 IF(IPURG.EQ.99)WRITE(LUOUT,510) 510 FORMAT("**** FILES PURGED ON ***") IF(IPURG.EQ.99)GO TO 470 IF(SUPFLG.GT.0)GO TO 540 IF(JCRIF .EQ. 2HDS)GO TO 540 IF(NUMCT .GT. 1)GO TO 540 520 WRITE(LUOUT,530)CRNAME,LACR,LU 530 FORMAT(/25X,5("*"),5X,3A2,5X,5("*")/30X,"CR=",3A2," LU=",I3/) 540 JVAR=2 IFILE=1 IUSED=0 IASEC=0 ICCNT = 0 IF(JCRIF.EQ.0)ISKIP=0 C C START THE LOOP TO GET FILES. C 550 DO 710 J=JVAR,8 C C RECORD USED SECTORS OF PURGED FILES C IF(IBUFF(1,J).EQ.0) GO TO 730 IF(IBUFF(1,J).GT.0) GO TO 560 IASEC = IASEC+IBUFF(7,J) IF(JFILT .NE. 2HPU)GO TO 700 560 IF(JFILT.EQ.2HEN.AND.ISKIP.EQ.32767) GO TO 690 C IF(JFILT.EQ.2HEN)GO TO 660 C C FILTER FILES FOR SELECTIVE LISTING C IF(IFILT.EQ.0)GO TO 570 CALL NAMCK(IBUFF(1,J),6,IFILT,IFLGTH,IFLAG) FFLAG = .NOT. FGO IF(IFLAG .LT. 0)FFLAG = FGO 570 IF(ISKPSC.LT.0)GO TO 580 SFLAG = .NOT. SGO IF(IPFIL.EQ.IBUFF(9,J))SFLAG = SGO 580 IF(ITYPE.EQ.-1) GO TO 590 TFLAG = .NOT. TGO IF(ITYPE.EQ.IBUFF(4,J))TFLAG = TGO 590 RECRD = FFLAG .AND. SFLAG .AND. TFLAG IF(RECRD)600,690 600 IF(JCRIF.NE.2HSC)GO TO 640 ISCBUF(IPL) = IBUFF(9,J) IF(IPL.EQ.1)GO TO 620 DO 610 IPF=1,IPL-1 IF(ISCBUF(IPF).EQ.IBUFF(9,J))GO TO 690 610 CONTINUE 620 IPL = IPL+1 C C CHECK FOR ARRAY OVERFLOW C IF(IPL .LE. 144)GO TO 640 IPL = IPL - 1 WRITE(LUIN,630)IPL 630 FORMAT(" /DL : MORE THAN "I4" SECURITY CODES") GO TO 170 640 IF(JFILT.NE.2HOP)GO TO 670 DO 650 JK=1,7 "IF(IBUFF(JK+9,J).NE.0)GO TO 670 650 CONTINUE GO TO 690 C C RECORD FILE NAMES AND INCREAMENT COUNTERS. C 660 ISKIP = ISKIP-1 IF(ISKIP.GE.0)GO TO 690 670 IF(JFILT .EQ. 2HPU .AND. IBUFF(1,J) .GT. 0)GO TO 690 DO 680 K=1,3 NAMES(K,IFILE)=IBUFF(K,J) 680 CONTINUE C C SAVE TRACK AND SECTOR OF THE FILE C KTRAK=(LTRAK-ITRAK)*2048 KTRAK=IOR(KTRAK,(J-1)*256) NAMES(4,IFILE)=IOR(KTRAK,ISEC) IFILE=IFILE+1 IF(IFILE.GT.IDIM2)GO TO 1210 IF(IBUFF(1,J) .EQ. -1)GO TO 700 690 ICCNT=ICCNT+1 700 IUSED=IUSED+1 710 CONTINUE C C RESET TRACK AND SECTOR FOR THE NEXT EIGHT FILES. C JVAR=1 IBLK=IBLK+1 IF(IBLK.LE.ISPT/2-1) GO TO 720 IF(ITRAK .EQ. LDTRK)GO TO 730 ITRAK=ITRAK-1 IBLK=IBLK-ISPT/2 720 ISEC=IBLK*14-((IBLK*14)/ISPT)*ISPT CALL EXEC(1,LU,IBUFF,128,ITRAK,ISEC) GO TO 550 C C COMPUTE DIRECTORY ENTRIES AVAILABLE, BLKS AVAILABLE AFTER PACK, C AND DIRECTORY ENTRIES AVAILABLE AFTER PACK C 730 IF(JFILT.NE.2HEN.OR.ISKIP.NE.32767)GO TO 750 ISKIP = ICCNT - JCRIF 740 ITRAK = LTRAK GO TO 370 750 IFILE=IFILE-1 IDUN=IDENT-IUSED ABLK=BREM+(IASEC/2) C C COMPUTE USED AFTER PACK C PCUAPK = ((TNBLKS-ABLK)/TNBLKS) * 100.0 IADUN=IDENT-ICCNT IF(JCRIF .NE. 2HDS)GO TO 758 IF(BREM .EQ. ABLK)GO TO 755 WRITE(LUOUT,756)LACR,LU,CRNAME,ISPT,BREM,IDUN,PCUSED,ABLK,IADUN, #PCUAPK,NXTTRK,LTRAK,IDTRK GO TO 790 755 WRITE(LUOUT,757)LACR,LU,CRNAME,ISPT,BREM,IDUN,PCUSED,NXTTRK, #LTRAK,IDTRK 756 FORMAT( #1X,3A2,I4,1X,3A2,I4,I7,"/",I5,F7.2,I7,"/",I5,F7.2,I6,I6,2X,I3) 757 FORMAT( #1X,3A2,I4,1X,3A2,I4,I7,"/",I5,F7.2,2X,18("-"),I6,I6,2X,I3) 758 IF(HEAD.EQ..FALSE.)GO TO 790 WRITE(LUOUT,760)IDUN 760 FORMAT(23X,"DIRECTORY ENTRIES AVAILABLE = ",I5/) IF(BREM.NE.ABLK)WRITE(LUOUT,770)ABLK,PCUAPK 770 FORMAT(23X,"BLOCKS AVAILABLE AFTER PACK = k ",I6,2X,F6.2"% USED") IF(IDUN.NE.IADUN)WRITE(LUOUT,780)IADUN 780 FORMAT(17X,"DIRECTORY ENTRIES AVAILABLE AFTER PACK = ",I5/) C C PRINT ANY BAD TRACKS!!! C IF(IBTCT.GT.0)WRITE(LUOUT,800)(IBTRK(IJK),IJK=1,IBTCT) 800 FORMAT(30X,"BAD TRACK LIST"/6(35X,I3/)) 790 IF(IFBRK(IDUMY))1250,810 810 IF(IFILE.EQ.0) GO TO 1240 IF(JCRIF.EQ.2HSC .AND. JFILT .NE. 2HEN)GO TO 330 IF(IPL .GT. 1)GO TO 815 IF(NUMCT.GT.1 .AND. (.NOT.HEAD))WRITE(LUOUT,530)CRNAME,LACR,LU 815 IF(SUPFLG.GT.0)GO TO 830 IF(SFFLG)GO TO 825 WRITE(LUOUT,IPNTH) 820 FORMAT(3X,"NAME",3X,"TYPE",2X,"BLKS\LU EXT RECLEN", #3X,"SECURITY",3X,"TRACK",2X,"SECTOR OPEN TO") 821 FORMAT(3X,"NAME",3X,"TYPE",2X,"BLKS\LU EXT RECLEN", #3X,"TRACK",2X,"SECTOR OPEN TO") C C IF JFILT = 'EN' OR 'PU' SKIP THE SORT C 825 IF (ENORPU)GO TO 830 C C ALPHABETIZE THE FILES C CALL ALPHA(NAMES,IFILE,IXCNT) C C START LOOP TO PRINT THE FILE NAMES. C C CHECK FOR SHORT FORM REQUEST C 830 IF(.NOT. SFFLG)GO TO 839 C C SET INITIAL POINTERS, LOOP SIZE, AND INDEXES C LK = 2 LFILE = IFILE - IXCNT INDEX = LFILE/8 LEXTRA= MOD(LFILE,8) LOOP = INDEX IF(LEXTRA .GT. 0)LOOP = LOOP + 1 DO 831 JK=1,40 LBUFF(JK) = 20040B 831 CONTINUE C C START LOOP TO PRINT FILES IN THE SHORT FORM C LNDEX = 0 DO 837 JK=1,LOOP LXCNT = LEXTRA LNDEX = LNDEX + 1 JNDEX = 0 C C START INNER LOOP TO GET THE NAME WE WANT BASED ON 'JNDEX' C DO 835 IF=LNDEX,IFILE SKEXT = .FALSE. JF = IF - 1 ICNT = 0 IF(LXCNT .GE. 0) ICNT = 1 IF(IF .EQ. 1)GO TO 833 C C CHECK FOR EXTENT C IF((NAMES(1,JF) .EQ. NAMES(1,IF)) .AND. + (NAMES(2,JF) .EQ. NAMES(2,IF)) .AND. + (NAMES(3,JF) .EQ. NAMES(3,IF)))SKEXT = .TRUE. C C SET JNDEX TO RECORD FIRST NAME AFTER ANY EXTENTS C IF(IF .NE. LNDEX)GO TO)k 832 JNDEX = INDEX + ICNT -1 IF(SKEXT) LNDEX = LNDEX + 1 C 832 IF(SKEXT .AND. JFILT .NE. 2HEN)GO TO 835 JNDEX = JNDEX + 1 IF(JNDEX .NE. INDEX+ICNT)GO TO 835 JNDEX = 0 833 LXCNT = LXCNT - 1 C C RECORD THE FILE NAME IN THE OUTPUT BUFFER C DO 834 NA=1,3 LBUFF(NA+LK) = NAMES(NA,IF) 834 CONTINUE IF(LBUFF(LK+1) .EQ. -1)LBUFF(LK+1) = 2H-- LREC = LK + 3 LK = LK + 4 IF(LXCNT.EQ.0.AND.JK.EQ.LOOP)GO TO 837 IF(LK .LT. 32)GO TO 835 CALL EXEC(2,LUOUT,LBUFF,LREC) LK = 2 835 CONTINUE 837 CONTINUE IF(LK .NE. 2)CALL EXEC(2,LUOUT,LBUFF,LK-1) GO TO 1230 839 KFILE = 0 DO 1180 K=1,IFILE IEXN =-1 C C GET TRACK AND SECTOR OF THE FILE. C IWORK=NAMES(4,K) ITRAK=LTRAK-(IWORK/2048) KI=1+IAND(IWORK,3400B)/256 ISEC=IAND(IWORK,177B) IF(K .EQ. 1)GO TO 840 IF(ITRAK .NE. ILTRK)GO TO 840 IF(ISEC .NE. ILSEC)GO TO 840 GO TO 860 C C GET FILE AND INFORMATION ON IT. C 840 CALL EXEC(1,LU,IBUFF,128,ITRAK,ISEC) 850 ILTRK = ITRAK ILSEC = ISEC 860 IEXCK = IAND(200B,IWORK) IF(.NOT. ENORPU)GO TO 870 IF(IBUFF(4,KI).EQ.0)GO TO 900 IEXCK=IBUFF(6,KI)/256 C C CHECK FOR EXTENTS C 870 IF(IEXCK)900,900,880 880 IF(JBUF1.EQ.0) GO TO 890 IF((JBUF1.NE.IBUFF(1,KI)).OR.(JBUF2.NE.IBUFF(2,KI)) #.OR.(JBUF3.NE.IBUFF(3,KI))) GO TO 1000 C C RECORD EXTENT NUMBER AND CALCULATE NECESSARY INFORMATION C IF IT IS EXTENT ZERO. C IF(ENORPU)GO TO 900 890 IEXN = ISOL8(IBUFF(6,KI),8,15) IF(IEXN.GT.ITEMP)ITEMP=IEXN IF(ENORPU)GO TO 910 IF(IEXN)1170,910,1170 900 IF(JBUF1.NE.0)GO TO 1000 910 IF(IBUFF(8,KI).EQ.0) IBUFF(8,KI)=128 IF(NOSC)IBUFF(9,KI)=20040B CALL ASCII(IBUFF(9,KI),IP) IF(IBUFF(1,KI) .EQ. -1)IBUFF(1,KI) = 2H-- IBUFF(7,KI)=IBUFF(7,KI)/2 IBUFF(6,KI)=IAND(177B,IBUFF(6,KI)) IF(JFILT.EQ.2HEN.OR.JCRIF.NE.2HDI)GO TO 920 IBUFF(8,KI) = (KI-1)*16 IBUFF(5,KI) = ITRAK IBUFF(6,KI) = ISEC 920 IF(K.EQ.IFILE.AND.ENORPU)K=K+1 C C CHECK TO SEE IF FILE IS OPEN TO ANYONE. C IF(LPROG1.EQ.2H )GO TO 940 DO 930 LC=1,3 LPROG(1,LC)=20040B 930 CONTINUE 940 DO 970 JJ=1,7 IF(IBUFF(JJ+9,KI).EQ.0)GO TO 970 IKEY = IGET(1657B) - 1 IOFSET = IAND(377B,IBUFF(JJ+9,KI)) IADDR = IGET(IKEY + IOFSET) + 14B DO 950 JK=1,3 950 LPROG(LKNT+1,JK)=IGET(IADDR+JK-1) IND = 40B IF(IBUFF(JJ+9,KI).LT.0)IND=55B LPROG(LKNT+1,3)=IOR(IND,IAND(177400B,LPROG(LKNT+1,3))) LKNT = LKNT+1 IF(LKNT.GE.2)LKNT1=2 DO 960 JK=1,3 960 LPROG(LKNT+1,JK)=2H 970 CONTINUE IF(ENORPU.AND.IEXN.EQ.0)GO TO 1070 IF(IEXN.EQ.-1) GO TO 990 C C FILL THE TEMPORY BUFFER C DO 980 JK=1,9 980 JBUFF(JK)=IBUFF(JK,KI) JBUF10=IP GO TO 1170 990 IF(ITEMP.EQ.0)GO TO 1070 C C PRINT THE FILES AND INFORMATION C 1000 IF(SUPFLG.GT.0)GO TO 1010 WRITE(LUOUT,IPNTX) JBUF1,JBUF2,JBUF3,JBUF4, #JBUF7,ITEMP,JBUF8,JBUF9,JBUF10,JBUF5,JBUF6, #((LPROG(JJ,JK),JK=1,3),JJ=1,LKNT1) TBLKAD = JBUF7*(ITEMP+1) ASSIGN 1010 TO IRTN GO TO 1080 1010 ASSIGN 1110 TO IRTN TBLK=TBLK+TBLKAD IF(IPURG.NE.99)GO TO 1050 IF(IVETO .EQ. 0)GO TO 1040 ASSIGN 1050 TO NOPRGE ASSIGN 1040 TO IPGAD 1020 WRITE(LUIN,1030 ) 1030 FORMAT(" PURGE ? (YES, NO, ABORT) _") NHUH = 0 CALL REIO(1,LUINE,NHUH,-1) IF(NHUH .EQ. 1HY)GO TO IPGAD IF(NHUH .EQ. 1HA)GO TO 1270 C C SUBTRACT BLOCKS AND FILE COUNT IF NOT PURGED C TBLK = TBLK - TBLKAD KFILE = KFILE + ITEMP + 1 GO TO NOPRGE 1040 CALL PURGE(IDCB,IERR,JBUFF,JBUF9,ICR) CALL IFMGR(IERR,10,LUIN,JBUFF) 1050 ITEMP = 0 JBUF1=0 IF(K.EQ.IFILE.AND.ENORPU.AND.IEXCK.NE.0)GO TO 890 K IF((K.GE.IFILE).AND.(IEXCK.NE.0))GO TO 1180 IF(IEXCK)910,910,890 1060 FORMAT(2X,3A2,2X,I3,4X,I5," +",I3,2X,I5,3X,I6,"=",A2,3X,I4,4X,I3, #4X,3A2,1X,3A2) 1061 FORMAT(2X,3A2,2X,I3,4X,I5," +",I3,2X,I5,2A2,I4,4X,I3, #4X,3A2,1X,3A2) 1070 IF(IBUFF(4,KI).EQ.0 .AND. JCRIF .NE. 2HDI)GO TO 1150 IF(SUPFLG.GT.0)GO TO 1130 WRITE(LUOUT,IPNT) IBUFF(1,KI),IBUFF(2,KI),IBUFF(3,KI), #IBUFF(4,KI),IBUFF(7,KI),IBUFF(8,KI),IBUFF(9,KI),IP, #IBUFF(5,KI),IBUFF(6,KI),((LPROG(JJ,JK),JK=1,3),JJ=1,LKNT1) TBLKAD = IBUFF(7,KI) 1080 DO 1090 M=1,3 N=M*2 IF(LKNT.GT.N)WRITE(LUOUT,IOPNT)((LPROG(JJ,JK),JK=1,3),JJ=N+1,N+2) 1090 CONTINUE LKNT = 0 LKNT1 = 0 GO TO IRTN 1100 FORMAT(64X,3A2,1X,3A2) 1101 FORMAT(52X,3A2,1X,3A2) 1110 TBLK = TBLK + TBLKAD IF(IPURG.NE.99)GO TO 1130 IF(IVETO .EQ. 0)GO TO 1120 ASSIGN 1130 TO NOPRGE ASSIGN 1120 TO IPGAD GO TO 1020 1120 CALL PURGE(IDCB,IERR,IBUFF(1,KI),IBUFF(9,KI),ICR) CALL IFMGR(IERR,10,LUIN,IBUFF(1,KI)) 1130 IF(IBUFF(4,KI) .EQ. 0)GO TO 1170 1140 FORMAT(2X,3A2,2X,I3,4X,I5,7X,I5,3X,I6,"=",A2,3X,I4,4X,I3,4X #3A2,1X,3A2) 1141 FORMAT(2X,3A2,2X,I3,4X,I5,7X,I5,2A2,I4,4X,I3,4X #3A2,1X,3A2) GO TO 1170 C C PRINT TYPE ZERO FILE C 1150 IF(SUPFLG.GT.0)GO TO 1170 IFUNC = (IAND(IBUFF(5,KI),7700B))/64 I0LU = IAND(IBUFF(5,KI),77B) WRITE(LUOUT,IPNT0) IBUFF(1,KI),IBUFF(2,KI),IBUFF(3,KI) #,IBUFF(4,KI),IFUNC,I0LU,IBUFF(9,KI),IP 1160 FORMAT(2X,3A2,2X,I3,4X,O3,I2,15X,I6,"=",A2) 1161 FORMAT(2X,3A2,2X,I3,4X,O3,I2,2A2) 1170 IF((K.GE.IFILE).AND.(ITEMP.NE.0))GO TO 1000 C C GO GET THE NEXT FILE NAME C IF(IFBRK(IDUMY))1250,1180 1180 CONTINUE IFILE = IFILE - KFILE BLKPT = ISPT/2 ITRK= TBLK/BLKPT ISC=AMOD(TBLK,BLKPT) ISC=ISC*2 TBLK = 0 IF(JCRIF.EQ.2HDI)GO TO 1230 CALL ASCII(IPFIL,IP) IF(IPL.GT.1.AND.SUPFLG.GT.0)WRITE(LUOUT,1190)IPFIL,IP 1190 FORMAT(" SECURITY CODE ",I6,"=",A2," HAS A") IF(JCRIF.EQ.2HHE.OR.JCRIF.EQ.0.OR.JFILT.EQ.2HEN)GO TO 1230 WRITE(LUOUT,1200)IFILE,ITRK,ISC 1200 FORMAT(/" TOTAL OF ",I4," FILES USING",I4," TRACKS AND ", 1I3," SECTORS (64 WORD SECTORS)"//) GO TO 1230 1210 WRITE(LUIN,1220)IDIM2 1220 FORMAT(" DIRECTORY TOO LARGE MORE THAN",I5," ENTRIES") C C GO GET THE NEXT CARTRIDGE C 1230 IF(IPL.GT.1.AND.SUPFLG.EQ.0)CALL EXEC(3,LUPAG,-1) 1240 CONTINUE IF(SLSW) CALL IFGLU(LU,MINUS,0,IDCB) IF(SFFLG)GO TO 1250 WRITE(LUOUT,1260) 1250 CALL EXEC(3,LUPAG,-1) 1260 FORMAT(17(" *"),"END DL",16("* ")) 1270 RETURN 1280 WRITE(LUIN,1290) 1290 FORMAT(" /DL : PARTITION TO SMALL INCREASE SIZE OF DL !") RETURN C C CHECK FOR IO12 ERROR FROM DISK READ C 1300 CALL ABREG(IA,IB) IF(IA .NE. 2HIO)GO TO 1320 IF(IB .NE. 2H12)GO TO 1320 IERR = IFGLU(LU,LU,0,IDCB) SLSW = .TRUE. IF(IERR .EQ. 0)GO TO 370 WRITE(LUIN,1310)IERR,LU 1310 FORMAT(" /DL :"I5" ERROR TRYING TO MAP LU"I3" INTO SST") GO TO 1240 1320 WRITE(LUIN,1330)IA,IB 1330 FORMAT(2A2,2X," DL ABORTED") RETURN END SUBROUTINE ASCII(BINARY,IA),CHECK FOR LEGAL ASCII 790720 INTEGER BINARY,RBYTE RBYTE = IAND(BINARY,377B) LBYTE = IAND(BINARY,77400B) IF(IA .NE. -1)GO TO 10 IF(RBYTE .LT. 40B .OR. RBYTE .GT. 137B)GO TO 5 IF(LBYTE .LE. 20000B .OR. LBYTE .GE. 60000B)GO TO 5 IA = BINARY RETURN 5 IA = 20040B RETURN 10 IF(RBYTE.LT.40B.OR.RBYTE.GT.176B)RBYTE = 40B IF(LBYTE.LT.20000B)LBYTE = 20000B IF(LBYTE.GE. 77400B)LBYTE = 20000B IA = IOR(LBYTE,RBYTE) RETURN END ASMB,R,L * 1730 HRS THU 14 JUN 79 NAM NAMCK,7 REV. 1924 790614 CHECK FILE NAME ENT NAMCK EXT .ENTR * * THIS SUBROUTINE RETURNS A FLAG (0,-1) TO DL DEPENDING * ON HOW A GIVEN STRING(KNOWN AS THE FILTERt) COMPARES TO ANOTHER * STRING(KNOWN AS THE FILE NAME). * * CALLING SEQUENCE: * * CALL NAMCK(IBUF,ICHAR,JBUF,JCHAR,IFLAG) * * WHERE: * IBUF = THE FILE NAME TO BE CHECKED * ICHAR= NO. OF CHARACTERS IN IBUF * JBUF = SMALLER BUFFER CONTAINING SEARCH FILTER * JCHAR= NO. OF CHARCTERS IN JBUF * IFLAG= -1 IF STRING FOUND; 0 IF NOT FOUND * * VARIABLE DEFINITION: * * BADDR = BYTE ADDRES FOR INPUT BUFFER * SADDR = BYTE ADDRES FOR INPUT FILTER BUFFER * ICNT = -(NUMBER CHARACTERS IN SOURCE BUFFER) * JCNT = -(NUMBER CHARACTERS LEFT IN SEARCH FILTER) * STGCT = CHAR. COUNT IN CURRENT STRING CHECK BUFFER * Y-REG = CHECK STRING BUFFER ADDRESS * * IBUF NOP FILE NAME BUFFER ICHAR NOP NO. OF CHAR. IN IBUF JBUF NOP FILTER STRING JCHAR NOP NO. OF CHAR. IN JBUF IFLAG NOP IFLAG SET TO -1 IF STRING FOUND NAMCK NOP ENTRY POINT JSB .ENTR DEF IBUF CLA CLEAR STA STGCT CURRENT STRING COUNTER STA PLSFG RESET PLUS FLAG CCA SET OUTER CMPAR LOOP STA OUTLG TO ONE TIME LDA ICHAR,I GET FILE NAME BUFFER LGTH. CMA,INA SET NEG. STA ICNT AND SAVE LOCAL LDA JCHAR,I GET THE FILTER LENGTH CMA MAKE NEGITIVE STA JCNT SAVE COUNTER (-1) LDA IBUF RAL STA BADDR SAVE AS BYTE ADDRESS LDB JBUF RBL STB SADDR SAVE THE BYTE ADD. FOR FILTER NXBT ISZ JCNT CHECK FOR END OF FILTER BUFFER RSS JMP DONE DONE THEN LBT GET THE NEXT FILTER CHAR. CPA APLUS CHECK FOR PLUS JMP PLUS CPA AMINS CHECK FOR '-'S JMP MINUS LDA STGCT CHECK FOR BEGINNING SZA OF A STRING JMP NX.1 LDY SADDR f YES, SO SAVE FILTER BUFFR ADD. IN Y LDX BADDR AND THE SOURCE BUFFR ADD. IN X NX.1 ISZ STGCT BUMP STRING COUNTER ADA ICNT CHECK FOR POSSIBLE STRING CHECK SSA,RSS OVER RUN JMP DONE IF ABOUT TO OVER RUN-GO CHECK JMP NXBT GO GET NEXT BYTE SPC 2 * MINUS ISZ BADDR BUMP SOURCE STRING BUFFER POINTER LDA STGCT CHECK IF STRING CHECK PENDING SZA JMP MIN.1 YES, SO GO DO IT ISZ SADDR BUMP FILTER BUFFER ADD TOO. ISZ ICNT ANY CHARATERS LEFT ? JMP NXBT YES, SO GET NECT BYTE JMP EXFND NO, SO EXIT FOUND SPC 1 MIN.1 STB SADDR SAVE THE FILTER BUFFER POINTER LDA PLSFG CHECK FOR "+" FLAG SZA,RSS SET ? JMP MIN.2 YES LDA ICNT FORM OUTER LOOP COUNTER ADA STGCT OUTLG = ICNT + STGCT SSA,RSS SEE IF LEGAL LOOP COUNTER JMP EXNFD NO, SEE EXIT NOT FOUND STA OUTLG OK, SAVE MIN.2 JSB CHECK GO CHECK STRING INA BUMP SOURCE BUFFER STA BADDR ADDRESS LDB SADDR CLA RESET THE '"+"' STA PLSFG FLAG CMA AND THE OUTER STA OUTLG LOOP COUNTER LDA ICNT INA JMP NXT GO CLEAN UP SPC 1 PLUS STB SADDR SAVE FILTER BUFFER POINTER LDA STGCT SEE IF CURRENT STRING SZA TO PROCESS JMP PL.1 YES STB PLSFG NO, SET '"+"' HAS OCCURED FLAG JMP NXBT NO, SO JUST GET NEXT BYTE PL.1 LDA PLSFG CHECK FOR '"+"' FLAG SZA,RSS JMP PL.2 FLAG NOT SET SO SET TO ONE TIME * LDA ICNT SET OUTER LOOP COUNTER ADA STGCT TO CHECK ALL OF BUFFER ADA M1 SSA,RSS CHECK IF 1 CMPAR WILL DO. PL.2 CCA YES, SO SET OUTER LOOP TO -1 STA OUTLG SAVE OUTER LOOP COUNTER JSB CHECK STA PLSFG SET '" +"' FLAG NON ZERO JMP CONT * * CHECK STRING * CHECK NOP ENTER CHECK ROUTINE HERE AGAIN CXA GET SOURCE BUFFER ADD. FROM X-REG. CYB GET FILTER ADD. FROM Y-REG. CBT STGCT CMPAR STRING JMP CHECK,I RETURN TO CALLER NOP ISZ OUTLG SEE IF WE ARE DONE RSS NO, JMP EXNFD YES, GO SET NOT FOUND FLAG * ISX BUMP SOURCE BUFFER ADDRESS ISZ ICNT AND SOURCE CHAR. COUNT JMP AGAIN AND GO AGAIN * EXNFD CLA STA IFLAG,I JMP NAMCK,I AND RETURN * CONT STA BADDR SAVE THE SOURCE BUFFER ADD. LDB SADDR RESTORE FILTER BUFFER POINTER LDA ICNT UPDATE CHAR COUNT NXT ADA STGCT SSA,RSS JMP EXCHK STA ICNT CLA RESET THE STRING STA STGCT COUNTER LDA JCNT SSA JMP NXBT JMP EXFND * EXCHK LDA JCNT SSA JMP EXNFD * EXFND CCA STA IFLAG,I JMP NAMCK,I * DONE LDA STGCT CEHCK IF PENDING STRING SZA,RSS JMP EXFND NO, SO JUST EXIT FOUND LDA PLSFG CHECK FOR PLUS FLAG SZA,RSS JMP DN.1 LDA ICNT STA OUTLG SAVE LOOP COUNTER ADA STGCT CHECK FOR ILLEGAL STRING LENGTH SZA,RSS CHECK FOR ZERO JMP *+3 IF STGCT + ICNT <= 0 SSA,RSS AND NEGITIVE NUMBER JMP EXNFD PLUS NUMBER: NO GOOD DN.1 JSB CHECK YES, SO GO CHECK STRING JMP EXFND STRING FOUND * * CONSTANTS AND STORGE PLSFG NOP PLUS FLAG SET BADDR NOP SOURCE STRING ADD. POINTER SADDR NOP FILTER STRING ADD. POINTER OUTLG NOP OUTER LOOP COUNTER ICNT NOP SOURCE CHAR. COUNT JCNT NOP FILTER CHAR. COUNT STGCT NOP CURRENT STRING COUNTER M1 DEC -1 AMINS OCT 55 APLUS OCT 53 END ASMB,R,L,C NAM ALPHA,7 REV.2020 750120 * DOoES AN ALPHABETIC SORT ON 3-WORD FIELD IN (NAMES) IFILE FIELDS LONG. * IT ALSO SETS BIT 8 OF THE TRACK SECTOR WORD IF IT IS AN EXTENT. * CALLED FROM FTN BY: CALL ALPHA(NAMES,IFILE) * * MODIFIED TO COUNT NUMBER OF EXTENTS ENCOUNTERED 4/14/80 DHP * ENT ALPHA EXT .ENTR NAMES BSS 1 IFILE BSS 1 XCNT BSS 1 EXTENT COUNT ALPHA NOP JSB .ENTR DEF NAMES CLA STA RPEAT STA EXCNT SET EXTENT COUNT TO ZERO LDA IFILE,I CMA,INA STA CNTR1 LOOP1 EQU * LDA CNTR1 ADA IFILE,I ALS,ALS ADA NAMES STA ADDR1 STA PNTR1 LDA CNTR1 CPA RPEAT JMP OUT INA SZA,RSS JMP OUT STA CNTR2 LOOP2 EQU * LDA CNTR2 ADA IFILE,I ALS,ALS ADA NAMES STA ADDR2 STA PNTR2 LDA DM3 STA CNTR3 LDA ADDR1 LOOP3 EQU * LDB ADDR2,I CMB,INB ADB A,I INA ISZ ADDR2 SSB JMP END2 SZB JMP SWTCH ISZ CNTR3 JMP LOOP3 STA B LDA A,I IOR IFLAG SET A FLAG STA B,I IF A FILE LDA ADDR2,I EXTENT AND IFLAG SZA,RSS ISZ EXCNT LDA ADDR2,I IOR IFLAG STA ADDR2,I JMP END2 SWTCH EQU * LDA DM4 STA CNTR4 LDA ADDR1 STA PNTR1 LOOP4 EQU * LDA PNTR1,I LDB PNTR2,I SWP STA PNTR1,I STB PNTR2,I ISZ PNTR1 ISZ PNTR2 ISZ CNTR4 JMP LOOP4 END2 EQU * ISZ CNTR2 JMP LOOP2 ISZ CNTR1 JMP LOOP1 OUT EQU * LDA EXCNT STA XCNT,I SAVE EXTENT COUNT JMP ALPHA,I CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 CNTR4 BSS 1 PNTR1 BSS 1 PNTR2 BSS 1 RPEAT BSS 1 ADDR1 BSS 1 ADDR2 BSS 1 IFLAG OCT 200 EXCNT NOP DM4 DEC -4 DM3 DEC -3 A EQU 0 B EQU 1 END ASMB,R,L,B,C HED ** FILE MANAGER ERROR PROCESSOR ** NAM IFMGR,7 ENT IFMGR EXT EXEC,.ENTR * * THIS FUNCTION CHECKS FOR FILE MANAGER ERRORS. IF THE ERROR * CODE IS < 0, THE ERROR MESSAGE IS PRINTED ON THE SPECIFIED TTY. * * IF ID IS >= 0, THE ERROR CODE IS RETURNED AS THE FUNCTION VALUE. * * IF ID IS < 0 AND THE ERROR CODE IS < 0, THEN THE PROGRAM IS * ABORTED. * * FORTRAN USEAGE EXAMPLE: * IF (IFMGR (IERR,ID,LTTY,NAME)) 100,200 * * ASSEMBLY CALLING SEQUENCE * JSB IFMGR * DEF *+4 * DEF IERR * DEF ID * DEF LTTY * DEF NAME * ON RETURN A = IERR * * WHERE THE USER SUPPLIED VARIABLES ARE: * * IERR = ERROR PARAMETER RETURNED FROM FILE MANAGER CALL. * ID = CALL IDENTITY CODE (NEGATIVE TO ABORT IF ERROR EXISTS) * 1 = APOSN * 2 = CLOSE * 3 = CREAT * 4 = FCONT * 5 = FSTAT * 6 = LOCF * 7 = NAMF * 8 = OPEN * 9 = POSNT * 10 = PURGE * 11 = READF * 12 = RWNDF * 13 = WRITF * LTTY = LOGICAL UNIT NUMBER OF DEVICE TO LIST ERROR * NAME = NAME OF FILE THAT HAD ERROR * * PARAMETER ADDRESSES * IERR NOP ERROR CODE ID NOP FILE MANAGER CALL ID LTTY NOP LOGICAL UNIT TO OUTPUT ERROR MESSAGES. NAME NOP NAME OF FILE THAT HAD ERROR IFMGR NOP JSB .ENTR USE .ENTR TO GET DEF IERR ADDRESSES OF PARAMETERS LDA IERR,I GET ERROR CODE SSA,RSS FILE MANAGER ERROR? JMP IFMGR,I NO,RETURN TO USER * * ERROR - CONVERT ERROR TO ASCII AND PUT IT INTO OUTPUT BUFFER * MPY M1 MULTIPLY ERROR BY -1 & THEN DIV .10 DIVIDE BY TEN TO GET TENS DIGIT. STA ERROR SAVE TEMPORARILY MPY .10 MULTIPLY BY 10 AND DIVIDE BY DIV .1 .1 TO GET TENS VALUE ONLY ADA IERR,I ADD ERROR CODE,RESULT = - UNITS CMA,INA MAKE UNITS POSITIVE LDB ERRO1R GET TENS DIGIT BLF,BLF ROTATE IT TO HIGH BYTE OF WORD IOR B OR IT WITH UNITS IOR ASC00 OR IN ASCII CONSTANT STA ERROR PUT ASCII ERROR CODE IN MSG BUFFER * * ADD CALL ID AND FILE NAME TO BUFFER * LDA ID,I GET ID CODE SSA IS IT NEGATIVE? CMA,INA YES - MAKE POSITIVE STA B IS CODE ADB M14 GREATER SSB,RSS THAN 13? CLA YES - OUTPUT $$$$$ FOR ID STA B SAVE ERROR CODE ALS MULTIPLY BY 2 AND ADA B ADD IT TO ITSELF (X3) ADA CALL ADD BUFR STARTING ADRS TO OFFSET LDB EMES SET POINTER TO STB PNTR ID NAME CLB SET FLAG TO INDICATE NAME STB FLAG BUFFER HAS TO BE TRANSFERRED. NFILE LDB M3 SET COUNTER TO STB CNTR TRANSFER 3 WORDS LOOP LDB A,I GET ID WORD & PUT IT STB PNTR,I IN ERROR MESSAGE BUFFER INA ILNDEX ID AND ISZ PNTR ERROR MESSAGE POINTERS ISZ CNTR TRANSFER COMPLETE? JMP LOOP NO - TRANSFER NEXT WORD LDB FLAG SZB NAME ARRAY TRANSFERRED? JMP LP1 YES - OUTPUT MESSAGE ISZ FLAG NO - SET FLAG TO SAY YES LDA NAME GET ADDRESS OF ARRAY IN A LDB NAMEB PUT OUTPUT BUFFER STB PNTR ADDRESS IN B JMP NFILE TRANSFER FILE NAME * * PUT IN PROGRAM NAME * LP1 LDB 1717B ADB .12 LDA B,I STA PRGNM INB LDA B,I STA PRGNM+1 INB LDA B,I AND M1774 IOR COLON STA PRGNM+2 * * OUTPUT ERROR MESSAGE * OUT JSB EXEC OUTPUT THE ERROR MESSAGE DEF *+5 DEF WRITE DEF LTTY,I DEF PRGNM DEF M40 * * CHECK FOR ABORT PROGRAM * LDA IERR,I PUT ERROR CODE IN CASE WE RETURN LDB ID,I GET ID CODE SSB,RSS DOe| WE ABORT? JMP IFMGR,I NO - RETURN * * ABORT PROGRAM * JSB EXEC WRITE DEF *+5 "PROGRAM ABORTED!" DEF WRITE ON THE DEF LTTY,I LOCAL TTY DEF ABORT DEF M16 JSB EXEC ASK RTE DEF *+2 TO TERMINATE THE PROGRAM DEF .6 * * CONSTATNTS, STORAGE ALLOCATION, AND MESSAGES * A EQU 0 A REGISTER B EQU 1 B REGISTER * * CONSTANTS * COLON OCT 72 .1 DEC 1 .6 DEC 6 .10 DEC 10 .12 DEC 12 M1 DEC -1 M3 DEC -3 M14 DEC -14 M16 DEC -16 M40 DEC -40 M1774 OCT 177400 * * MISC. CONSTANTS * ASC00 ASC 1,00 WRITE DEC 2 * * CNTR NOP UTILITY COUNTER FLAG NOP ID/NAME TRANSFER FLAG PNTR NOP TRANSFER POINTER TO MESSAGE BUFFER * * FILE MANAGER CALLS * CALL DEF *+1 SUP PRESS THE GARBAGE ASC 3,$$$$$ ID1 ASC 3,APOSN ID2 ASC 3,CLOSE ID3 ASC 3,CREAT ID4 ASC 3,FCONT ID5 ASC 3,FSTAT ID6 ASC 3,LOCF ID7 ASC 3,NAMF ID8 ASC 3,OPEN ID9 ASC 3,POSNT ID10 ASC 3,PURGE ID11 ASC 3,READF ID12 ASC 3,RWNDF ID13 ASC 3,WRITF * * ERROR MESSAGE * PRGNM BSS 3 ASC 1, ERMES BSS 3 ASC 4,ERROR - ERROR NOP ASC 5, IN FILE NAM. BSS 3 NAMEB DEF NAM. EMES DEF ERMES * * ABORT ERROR MESSAGE ABORT ASC 8,PROGRAM ABORTED! * * * END ASMB,R,B,L NAM ISOL8,7 ISOLATE,RIGHT JUSTIFY BITS. 18 JAN 77. ENT ISOL8 EXT .ENTR * * I=ISOL8(J,11,8) ISOLATES BITS 11,10,9,8 FROM J AND RETURNS THEM * IN THE LEAST SIGNIFICANT BITS OF I. HIGH BITS OF * I ARE ZEROED OUT. * I=ISOL8(J,8,11) DOES THE SAME THING. * * I=ISOL8(J,15,0) RETURNS I=J * I=ISOL8(J,16,1) RETURNS I = J ROTATED 1 BIT RIGHT * J NOP I1 NOP I2 NOP ISOL8 NOP JSB .ENTR DEF J LDA I1,I CMA,INA (A)= -I1 ADA I2,I (A)= I2-I1 SSA (A)>0 ? !I2>I1 ? JMP RVERS NO. I1>I2. LDB I1,I YES. I2>I1. GET I1. JMP CONT RVERS LDB I2,I I2 IS THE LEAST OF I1,I2. CMA,INA (A)>=0. CONT CMB,INB LEAST OF I1,I2 COUNTS ROTATIONS. STA MASK# MASK NUMBER >= 0. LDA J,I GET THE WORD TO BE OPERATED ON. * RLOOP SZB,RSS DONE? ROTATION COUNTER ROSE TO ZERO ? JMP ISOL YES. RAR NO. MOVE BITS-OF-INTEREST ONE PLACE RIGHT. INB BUMP ROTATION COUNTER. JMP RLOOP * ISOL LDB .MASK ADB MASK# (B) POINTS TO DESIRED MASK. AND B,I ZERO OUT UNWANTED BITS. JMP ISOL8,I RETURN WITH (A)=RIGHT JUSTIFIED ISOLATED BITS. * MASK# NOP .MASK DEF *+1 OCT 000001 OCT 000003 OCT 000007 OCT 000017 OCT 000037 OCT 000077 OCT 000177 OCT 000377 OCT 000777 OCT 001777 OCT 003777 OCT 007777 OCT 017777 OCT 037777 OCT 077777 OCT 177777 * A EQU 0 B EQU 1 S EQU 1 END ASMB,R,B,L * 1730 HRS THU 14 JUN 79 NAM STGFD,7 IDENTIFY CHARACTER STRINGS IN A BUFFER 790614 ENT STGFD EXT .ENTR,.CBT * * THIS PROGRAM IS USED TO FIND AN EMBEDED ASCII STRING * IN A GIVEN BUFFER. * * MODIFIED =STGCK TO RETURN CHARACTER POSITION OF THE * EMBEDDED STRING WITHIN THE GIVEN BUFFER. BY DAN ANTZOULATOS. * * CALLING SEQUENCE: * * CALL STGFD(IBUF,ICHAR,JBUF,JCHAR,IMANY,IWHER) * * WHERE: * IBUF = THE LARGER BUFFER TO BE CHECKED * ICHAR= NO. OF CHARACTERS IN IBUF * JBUF = SMALLER BUFFER CONTAINING SEARCH STRING * JCHAR= NO. OF CHARCTERS IN JBUF (<=TO ICHAR) * IMANY= A) THE SIZE OF IWHER WHEN ITS PASSED TO * THIS ROUTINE. * B) AS A RETURN VALUE IT IS SET TO THE NUMBER * OF TIMES IT HAS FOUND THE STRING. * IWHER= AN ARRAY WH@OSE ELEMENTS CONTAIN THE POSITION * OF THE FIRST CHARACTER OF JBUF EACH TIME JBUF IS * FOUND. EXAMPLE: IF IMANY(RETURNED VALUE)=3 THEN * IWHER(3)=POSITION OF THE THIRD JBUF IN IBUF. * * IBUF NOP TOTAL INPUT BUFFER ICHAR NOP NO. OF CHAR. IN IBUF JBUF NOP BUFFER CONTAINING STRING TO CHECKED JCHAR NOP NO. OF CHAR. IN JBUF IMANY NOP INO. OF TIMES STRING WAS FOUND. IWHER NOP POSITION OF STRING IN THE BUFFER. STGFD NOP ENTRY POINT JSB .ENTR DEF IBUF LDA IMANY,I GET THE NUMBER OF TIMES JBUF MIGHT BE FOUND. SZA,RSS CHECK FOR ZERO CHECK JMP STGFD,I AND RETURN STA MANY CLA CLEAR STA IMANY,I STA NANY LDA ICHAR,I CMA SET UP LOOP ADA JCHAR,I SSA,RSS CHECK FOR ENOUGH JMP STGFD,I CHARACTERS STA CCNT OK, SAVE LOOP COUNTER STA INCNT LDA IBUF GET TOTAL RECORD ADDRESS RAL FORM BYTE ADDRESS STA CBUF SAVE FOR LATER CHECK LDB JBUF GET STRING BUFFER ADDRESS RBL FORM BYTE ADDRESS JSB .CBT DEF JCHAR,I NOP JSB FOUND NOP NOP ISZ CCNT RSS JMP STGFD,I ISZ CBUF LDA CBUF JMP CHECK * FOUND NOP LDA NANY ADVANCE THE NUMBER OF TIMES JBUF INA HAS BEEN FOUND. STA NANY STA IMANY,I SAVE THE NEW COUNT CCB GET THE RIGHT ELEMENT ADB IWHER OF IWHER. ADB NANY STB ITOTL LDB CCNT COMPLIMENT CCNT AND CMB ADB INCNT ADD INCNT IN ORDER TO CMB,INB GET THE POISITION OF JBUF STB ITOTL,I CPA MANY HAVE WE FOUND JBUF 'MANY' TIMES YET ? JMP STGFD,I WE'VE FOUND IT & RETURN JMP FOUND,I GO BACK AND LOOK FOR ANOTHER ONE. * * CONSTANTS AND STORGE CCNT NOP INCNT NOP CBUF NOP MANY NOP NANY NOP ITOTL NOP END END$  d 24999-18245 1932 S 0100 &DLA              H0101 5VASMB,L NAM DLRP .CBT RPL 105766B END ASMB,R,L,Z,Q HED DL MAIN * 0845 HRS WED 23 MAY 79 IFZ NAM DL,3,74 24999-16245 REV.1932 790917 RTE-IVA (& RTE-III) XIF * IFN NAM DL,3,74 24999-16244 REV.1935 790917 RTE-IVB XIF * * THE PURPOSE OF THIS PROGRAM IS TO DETERMINE THE LENGHT OF AVAILABLE * BACKGROUND AND PASS THE LENGTH TO DLSUB WHICH DOES ALL THE WORK. * AVAILABLE BACKGROUND IS USED FOR STORAGE OF THE FILE NAMES USED IN DL. * * ASSEMBLE WITH 'Z' OPTION FOR RTE-IVA (AND RTE-III) * ASSEMBLE WITH 'N' OPTION FOR RTE-IVB * EXT EXEC,COR.A,DLSUB IFN EXT $CL1,$CL2 XIF * * MAIN ENTRY POINT FOR DL * * SET FOR TOTAL BACKGROUND SWAPPING (USED IN RTE-3 ONLY) DL JSB EXEC DEF *+3 DEF D22 DEF D3 * LDA XEQT GET ID SEGMENT ADDRESS * * GET BACKGROUND ADDRESS JSB COR.A GO GET FIRST WORD AVAIL BACK GND STA BDEF A = FWA BACKGROUND * * CALCULATE AVAILABLE BACKGROUND CMA,INA A = FWABK ADA BKLWA A = BKLWA - FWABK STA LGTH BACKGROUND LENGTH * * CHECK IF ENOUGH ROOM * ADA M128 MAKE SURE A SECTOR WILL FIT SSA,RSS JMP DL.1 STA LGTH SEND NEGATIVE LENGTH TO DLSUB JMP DL.5 AND DO IT NOW * DL.1 EQU * IFZ LDA TATSD GET # TRACKS ON SYS DISC ADA M1 MINUS 1 STA LTRAK SAVE XIF IFN LDA $CL2 GET STARTING SECTOR OF CL ADA D2 BUMP TO MSC SECTOR STA ISEC XIF JSB EXEC READ SECTOR WITH MSC DEF DL.4 DEF D1 READ DEF D2 LU 2 DEF BDEF,I BUFFER DEF D128 IFN DEF $CL1 TRACK FOR SESSION DEF ISEC SECTOR FOR SESSION XIF IFZ DEF LTRAK DEF D0 XIF * DL.4 LDA BDEF ADA D126 LDA A,I STA MSC * * GO TO MAIN PORTION OF DL~ DL.5 JSB DLSUB CALL DLSUB(FWAM,LGTH) DEF *+4 BDEF NOP DEF LGTH DEF MSC SKP * * * TERMINATE DL THEN TERMINATE JSB EXEC DEF *+2 DEF D6 * D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D6 DEC 6 D22 DEC 22 D126 DEC 126 D128 DEC 128 M1 DEC -1 M128 DEC -128 LGTH NOP LENGTH OF UNUSED BACKGROUND MSC NOP MASTER SECURITY CODE ISEC NOP SECTOR OF MSC LTRAK NOP DIRECTORY TRK OF LU 2 (RTE-IVA) XEQT EQU 1717B ADDRESS OF CURRENT ID SEG. TATSD EQU 1756B NO. OF TRKS. ON SYSTEM DISC. BKLWA EQU 1777B ADDRESS OF LWAM * A EQU 0 END DL FTN4,L SUBROUTINE DLSUB(NAMES,LGTH,MSC),REV. 1938 790917 RTE-IVA C---- C THIS PROGRAM LISTS ALL OR SELECTED FILE NAMES. C TO USE TYPE ON,DL,(P1),(P2),(P3),(P4),(P5) C C (P1)= FILE NAMR FILTER MAY INCLUDE SECURITY,CART.,TYPE C C (P2)= LIST UNIT (DEFAULT YOUR CONSOLE) C C P3 IS USED TO INVOKE SPECIAL LISTING OPTIONS TO DL. C C J (P3)= 'OF' LIST OFF. DO NOT LIST FILES. C F (P3)= 'EN' LIST END OF DIRECTORY # FILES GIVEN BY 'P4' C I (P3)= 'OP' LIST ONLY FILES THAT ARE OPEN C L (P3)= 'PU' LIST FILES THAT HAVE BEEN PURGED C T C C P4 IS PRIMARILY USED TO DETERMINE THE OUTPUT FORMAT C OF DL. IT ALSO INVOKES SOME SPECIAL OPTIONS. C C J (P4)= NUMBER OF FILES TO BE LISTED IF P3 IS 'EN'(DEFAULT ALL) C C (P4)= 'HE' TO HAVE AN EXPANDED HEADING PRINTED. C R (P4)= 'FC' TO HAVE NUMBER OF FILES PRINTED C I (P4)= 'BO' TO HAVE HEADING AND FILE INFO PRINTED C F (P4)= 'SC' TO SCAN ALL SECURITY CODES ON A GIVEN PLATTER C (P4)= 'PU' TO PURGE ALL FILES LISTED C (P4)= 'DI' GIVES DIRECTORY TRACK, SECTOR, AND WORD OF THE FILE C C P5 REVERSE FILTER FLAGS C C (P5)= 'RF' REVERSE FILE NAME FILTER C (P5)= 'RS' REVERSE SECURITY CODE FILTER C (P5)= 'RT' REVERSE FILE TYPE FILTER C (P5)= 'RA' REVERSE ALL FILTERS C C * THE FILE NAME FILTER HAS BEEN ENHANCED IN DL TO ALLOW A SEARCH C FOR A STRING OF CHARACTERS ANYWHERE IN THE FILE NAME. FOR FURTHER C EXPLAINATION OF THIS FEATURE SEE THE DOCUMENTATION FILE ON 'DL'. C C ADDITONAL PROBLEMS NOT TO BE RESOLVED: C C WHEN ASKING FOR OPEN FILES ONLY (P4 ='OP') THE NUMBER OF EXTENTS C WILL NOT BE SHOWN. ANY OTHER TYPE OF LISTING WILL SHOW THE EXTENTS C HOWEVER. THIS IS BECAUSE FMGR DOES NOT KEEP OPEN FLAGS ON EXTENTS, C ONLY ON THE MAIN FILE. C------------------------------------------------------------------- C C C LOGICAL HEAD,RECRD,FGO,SGO,TGO,FFLAG,SFLAG,TFLAG C INTEGER SUPFLG,CRNAME(3),CRLOOP,COLON C C C DIMENSION NAMES(4,1),IDCB(144),ICLST(4,32),LPROG(8,3) DIMENSION IBUFF(16,8),JBUFF(10),ITIME(6),IMSC(5) DIMENSION IBTRK(6),ISCBUF(144),IB(2),IC(3),IFILT(6) C EQUIVALENCE (IB(1),REG),(IBREG,IB(2)),(ITIME(1),ITIME1) C C SAVE SOME MEMORY. C EQUIVALENCE(ISCBUF,IDCB) EQUIVALENCE(JBUFF(1),JBUF1),(JBUFF(2),JBUF2),(JBUFF(3),JBUF3), # (JBUFF(4),JBUF4),(JBUFF(5),JBUF5),(JBUFF(6),JBUF6), # (JBUFF(7),JBUF7),(JBUFF(8),JBUF8),(JBUFF(9),JBUF9), # (JBUFF(10),JBUF10) EQUIVALENCE(IC(3),ICSUB3),(ICLST(1,1),ICLST1),(LPROG(1,1),LPROG1) EQUIVALENCE(IBUFF(4,1),IBUF41),(IBUFF(6,1),IBUF61), # (IBUFF(7,1),IBUF71),(IBUFF(8,1),IBUF81), # (IBUFF(9,1),IBUF91),(IBUFF(10,1),IBU101) DATA IC/177400B,377B,2H::/,IDISK/1/,TBLK/0.0/,LPROG/24*2H / DATA IPURG/0/,IFILT/6*0/,ITYPE/-1/,REG/0.0/,IVETO/0/ DATA ISKPSC/0/,SUPFLG/0/,ISTRC/1/,JCR/0/,IPCNT/0/ DATA JCRIF/0/,JFILT/0/,COLON/2H::/ DATA RECRD/.TRUE./,FGO/.TRUE./,SGO/.TRUE./,TGO/.TRUE./ DATA FFLAG/.TRUE./,SFLAG/.TRUE./,TFLAG/.TRUE./ C C SET UP INPUT AND OUTPUT UNITS AND C INITIALIZE VARIABLES C LUIN = LOGLU(ISES) WRITE(LUIN,150) 150 FORMAT(" /DL - REV 1932") C IF(LGTH .LT. 0)GO TO 1280 IDIM2 = LGTH/4 IPL = 1 ICL = 3 IMESS = 0 ASSIGN 1110 TO IRTN LUINE = LUIN + 400B C C GET THE TURN ON STRING C CALL GETST(IDCB,-60,ILOG) C C IF NO PARAMETERS WHERE PASSED JUST ASK FOR THE FILTER C 4 IF(IDCB .NE. 2H?? .AND. IDCB .NE. 2HHE)GO TO 5 IF(ILOG .NE. 2)GO TO 5 WRITE(LUIN,15) 15 FORMAT(/ +" ENTER: Namr filter[,List dev.,List opt.,Special opt.,Reverse " +"filter,ALL]"// +" WHERE: List opt. is ,Special opt. is"6X",Reverse filter is,"/ +7X"'OF' LIST OFF ,'HE' EXPAND HEADING ,'RF' Rev. NAME FILTER"/ +7X"'OP' OPEN FILES ,'FC' FILE CNT & SIZE ,'RS' Rev. SC FILTER"/ +7X"'PU' PURGED FILES,'BO' BOTH 'HE' & 'FC','RT' Rev. TYPE FILTER"/ +24X",'SC' SCAN SEC CODE ,'RA' Rev. ALL FILTERS"/ +24X",'PU' PURGE FILES"/ +24X",'DI' DIRCT. LOCATION"/ +7X"'EN' END OF DIR. , # OF FILES TO LIST"// +7X" ALL PARAMETERS OPTIONAL (EXCEPT NAMR FILTER)"/) GO TO 6 5 IF(ILOG .NE. 0)GO TO 20 6 WRITE(LUIN,10) 10 FORMAT(" ENTER FILE NAMR FILTER : _") REG = REIO(1,LUINE,IDCB,-60) ILOG = IBREG IF(ILOG .EQ. 0)RETURN GO TO 4 20 IF(NAMR(JBUFF,IDCB,ILOG,ISTRC))140,30 30 IPCNT = IPCNT + 1 GO TO(40,90,100,110,120),IPCNT 40 IPTYPE = IAND(JBUF4,3) IF(IPTYPE .EQ. 0)GO TO 80 IST = ISTRC - 1 I = 1 CALL STGFD(IDCB,IST,COLON,1,I,IFLGTH) IF(I .NE. 0)GO TO 50 IFLGTH = IST - 1 IF(ILOG .EQ. IST)IFLGTH = IST GO TO 60 50 IFLGTH = IFLGTH - 1 60 IWD = IFLGTH/2 + 1 DO 70 I=1,IWD IFILT(I) = IDCB(I) 70 CONTINUE 80 IPTYPE = ISOL8(JBUF4,2,3) IF(IPTYPE .EQ. 0)ISKPSC = -1 IPFIL = JBUF5 JCR = JBUF6 IPTYPE = ISOL8(JBUF4,6,7) IF(IPTYPE .GT. 0)ITYPE = JBUF7 GO TO 20 90 IPTYPE = IAND(JBUF4,3) IF(IPTYPE .EQ. 1)LUOUT = JBUFF GO TO 20 100 JFILT = JBUFF GO TO 20T 110 JCRIF = JBUFF GO TO 20 120 DO 130 I=1,3 IF(JBUFF(I) .EQ. 2HRF)FGO = .FALSE. IF(JBUFF(I) .EQ. 2HRS)SGO = .FALSE. IF(JBUFF(I) .EQ. 2HRT)TGO = .FALSE. IF(JBUFF(I) .NE. 2HRA)GO TO 130 FGO = .FALSE. SGO = .FALSE. TGO = .FALSE. 130 CONTINUE 140 IF(JFILT .EQ. 2HOF)SUPFLG = 1 IF(LUOUT.EQ.0)LUOUT = LUIN LUPAG=IOR(LUOUT,1100B) C C WHO'S MOUNTED C CALL FSTAT(ICLST) C C GOING TO PURGE OR LIST SECURITIES ONLY ?? C IF(JFILT.EQ.2HEN)GO TO 260 IF(JCRIF.EQ.2HSC)GO TO 240 IF(JCRIF.NE.2HPU)GO TO 260 WRITE(LUIN,160) 160 FORMAT(" **** CAUTION ****"/" YOU ARE ABOUT TO PURGE ALL FILES " $"LISTED WITH THIS PROGRAM"/" DO YOU WANT TO PROCEED ? _") CALL REIO(1,LUINE,NHUH,-2) IF(NHUH.EQ.2HYE)GO TO 190 170 WRITE(LUIN,180) GO TO 1270 180 FORMAT(" DL ABORTED") C C CHECK IF VETO OPTION WANTED C 190 WRITE(LUIN,200 ) 200 FORMAT(" VETO OPTION ? _") CALL REIO(1,LUINE,NHUH,-2) IF(NHUH .EQ. 2HYE)IVETO = 1 WRITE(LUIN,210) 210 FORMAT(" ENTER MASTER SECURITY CODE: _") ISTRC = 1 REG = REIO(1,LUIN,IMSC,-10) CALL NAMR(JBUFF,IMSC,IBREG,ISTRC) IF(JBUFF.EQ.MSC)GO TO 230 WRITE(LUIN,220) GO TO 170 220 FORMAT(" ILLEGAL MASTER SECURITY CODE") 230 IPURG = 99 IF(IVETO .EQ. 1)GO TO 260 240 IF(JCR.NE.0)GO TO 260 WRITE(LUIN,250) 250 FORMAT(" YOU MUST SPECIFY A CARTRIDGE FOR THIS OPTION _") READ(LUIN,*)JCR GO TO 240 C C CHECK FOR # OF CARTRIDGES MOUNTED C 260 JBUFF = 0 DO 270 NUMCT=1,31 IF(ICLST(1,NUMCT).EQ.0) GO TO 280 270 CONTINUE C C SET # OF CARTRIDGES AND CHECK FOR CARTRIDGE WANTED C 280 LU= ICLST1 NUMCT=NUMCT-1 IF(JCR.EQ.0)GO TO 320 IF(JCR.GT.0)GO TO 290 ICL = 1 JCR = -JCR C C FIND THE LU NUMBER OF THE CARTRIDGE WANTED C 290 DO 300 KCKNT=1,NUMCT IF(ICLST(ICL,KCKNT).NE.JCR)GO TO 300 LU=ICLST(1,KCKNT) JCR=ICLST(3,KCKNT) IDISK=KCKNT GO TO 320 300 CONTINUE LUCR = 2HCR IF(ICL .EQ. 1)LUCR = 2HLU WRITE(LUIN,310)LUCR,JCR 310 FORMAT(1X,A2" = ",I5," IS NOT MOUNTED") GO TO 1270 320 IF(JCR.NE.0)NUMCT = 1 GO TO 340 330 NUMCT = IPL -1 JCRIF = 2HFC HEAD = .FALSE. ISKPSC = 0 C C START LOOP FOR EACH CARTRIDGE C 340 DO 1240 CRLOOP=1,NUMCT ISKIP=32767 IF(IPL.EQ.1)GO TO 350 IPFIL = ISCBUF(CRLOOP) GO TO 740 C C GET LU # OF CARTRIDGE WANTED C 350 IF(CRLOOP.EQ.1)GO TO 360 LU=ICLST(1,IDISK) C C SET SECTOR FOR PERIPHERAL OR SYSTEM DISC C C GET THE LAST TRACK THE FMGR HAS IN THE CURRENT CARTRIDGE. C 360 ITRAK=ICLST(2,IDISK) IDISK=IDISK+1 LTRAK = ITRAK 370 ISEC=0 IBLK=0 IF(LU.NE.2)GO TO 380 ISEC=14 IBLK=1 C C GET FILE DIRECTORY INFORMATION. C 380 CALL EXEC(1,LU,IBUFF,128,ITRAK,ISEC) C C SKIP THE INITIALIZE STUFF IF WE ARE DOING THE 'SC' TRICK C IF(IPL.GT.1)GO TO 470 IF(ISKIP.NE.32767)GO TO 540 C C SAVE CR NAME & NUMBER C DO 390 JJ=1,3 CRNAME(JJ) = IBUFF(JJ,1) 390 CONTINUE CRNAME = IAND(CRNAME,77777B) ICR = IBUF41 C C CHECK FOR BAD TRACKS AND RECORD THEM C DO 400 IJK=1,6 IKL=IJK+10 IF(IBUFF(IKL,1).EQ.0)GO TO 410 IBTRK(IJK)=IBUFF(IKL,1) 400 CONTINUE IBTCT=6 GO TO 420 410 IBTCT=IJK-1 420 ISPT=IBUF71 LDTRK = IBUF81 C C GET THE NUMBER OF AVAILABLE TRACKS C TREM=IBUF81-IBU101 ISREM=0 C C IF ON SECTOR ZERO SUBTRACT ONE TRACK C IF(IBUF61.EQ.0) GO TO 430 TREM=TREM-1 C C COMPUTE AVAILABLE SECTORS C ISREM=IBUF71-IBUF61 C C COMPUTE TOTAL BLKS AVAILABLE C 430 BREM=((TREM*ISPT)+ISREM)/2 C C GET NUMBER OF DIRECTORY TRACKS AND COMPUTE THE NUMBER OF C DIRECTORY ENTRIES s AVAILABLE C IDTRK=-IBUF91 IDENT=IDTRK*ISPT*4-1 C C IF SYSTEM CARTRIDGE, DEVREASE # OF ENTRIES AVAILABLE BY EIGHT. C IF(LU.EQ.2) IDENT=IDENT-8 C C LOCK OUTPUT DEVICE C 440 IF(LUIN.EQ.LUOUT) GO TO 460 IREG=LURQ(100001B,LUOUT,1) IF(IREG.EQ.0)GO TO 460 C C LOCK UNSUCCESSFUL, SO REPORT C IF (IMESS .EQ. 0)WRITE (LUIN,450) LUOUT 450 FORMAT (1X"WAITING FOR LU# "I3) C IMESS = 1 CALL EXEC(12,0,2,0,-3) IF(IFBRK(IDMMY))1270,440,440 460 HEAD=(JCRIF.EQ.2HHE).OR.(JCRIF.EQ.2HBO).OR.(JCRIF.EQ.2HSC) IF(HEAD.EQ..FALSE.)GO TO 500 C C GET THE TIME FROM THE REAL-TIME CLOCK. C 470 CALL JULIA(ITIME) C C PRINT THE HEADING C WRITE(LUOUT,480)ITIME IF(IPL .GT. 1)GO TO 500 IF(IPURG.EQ.99)GO TO 520 480 FORMAT(67X,6A2) WRITE(LUOUT,490)CRNAME,ICR,LU,IBUF71,IBU101,IBUF61,BREM 490 FORMAT(1X,31("*"),5X,3A2,5X,31("*")/ #32X,"CR=",I5," LU=",I4// #30X,"SECTORS/TRACK = ",I3/ #18X,"NEXT TRACK = ",I3,10X,"NEXT SECTOR = ",I3/ #28X,"BLOCKS AVAILABLE = ",I6) GO TO 540 500 IF(IPURG.EQ.99)WRITE(LUOUT,510) 510 FORMAT("**** FILES PURGED ON ***") IF(IPURG.EQ.99)GO TO 470 IF(SUPFLG.GT.0)GO TO 540 520 WRITE(LUOUT,530)CRNAME,ICR,LU 530 FORMAT(/25X,5("*"),5X,3A2,5X,5("*")/30X,"CR=",I5," LU=",I4/) 540 JVAR=2 IFILE=1 IUSED=0 IASEC=0 ICCNT = 0 IF(JCRIF.EQ.0)ISKIP=0 C C START THE LOOP TO GET FILES. C 550 DO 710 J=JVAR,8 C C RECORD USED SECTORS OF PURGED FILES C IF(IBUFF(1,J).EQ.0) GO TO 730 IF(IBUFF(1,J).GT.0) GO TO 560 IASEC = IASEC+IBUFF(7,J) IF(JFILT .NE. 2HPU)GO TO 700 560 IF(JFILT.EQ.2HEN.AND.ISKIP.EQ.32767) GO TO 690 C IF(JFILT.EQ.2HEN)GO TO 660 C C FILTER FILES FOR SELECTIVE LISTING C IF(IFILT.EQ.0)GO TO 570 CALL NAMCK(IBUFF(1,J),6,IFILT,IFLGTH,IFLAG) FFLAG = .NOT. FGO IF(IFLAG .LT. 0)FFLAG = FGO <@570 IF(ISKPSC.LT.0)GO TO 580 SFLAG = .NOT. SGO IF(IPFIL.EQ.IBUFF(9,J))SFLAG = SGO 580 IF(ITYPE.EQ.-1) GO TO 590 TFLAG = .NOT. TGO IF(ITYPE.EQ.IBUFF(4,J))TFLAG = TGO 590 RECRD = FFLAG .AND. SFLAG .AND. TFLAG IF(RECRD)600,690 600 IF(JCRIF.NE.2HSC)GO TO 640 ISCBUF(IPL) = IBUFF(9,J) IF(IPL.EQ.1)GO TO 620 DO 610 IPF=1,IPL-1 IF(ISCBUF(IPF).EQ.IBUFF(9,J))GO TO 690 610 CONTINUE 620 IPL = IPL+1 C C CHECK FOR ARRAY OVERFLOW C IF(IPL .LE. 144)GO TO 640 IPL = IPL - 1 WRITE(LUIN,630)IPL 630 FORMAT(" /DL : MORE THAN "I4" SECURITY CODES") GO TO 170 640 IF(JFILT.NE.2HOP)GO TO 670 DO 650 JK=1,7 IF(IBUFF(JK+9,J).NE.0)GO TO 670 650 CONTINUE GO TO 690 C C RECORD FILE NAMES AND INCREAMENT COUNTERS. C 660 ISKIP = ISKIP-1 IF(ISKIP.GE.0)GO TO 690 670 IF(JFILT .EQ. 2HPU .AND. IBUFF(1,J) .GT. 0)GO TO 690 DO 680 K=1,3 NAMES(K,IFILE)=IBUFF(K,J) 680 CONTINUE C C SAVE TRACK AND SECTOR OF THE FILE C KTRAK=(LTRAK-ITRAK)*2048 KTRAK=IOR(KTRAK,(J-1)*256) NAMES(4,IFILE)=IOR(KTRAK,ISEC) IFILE=IFILE+1 IF(IFILE.GT.IDIM2)GO TO 1210 IF(IBUFF(1,J) .EQ. -1)GO TO 700 690 ICCNT=ICCNT+1 700 IUSED=IUSED+1 710 CONTINUE C C RESET TRACK AND SECTOR FOR THE NEXT EIGHT FILES. C JVAR=1 IBLK=IBLK+1 IF(IBLK.LE.ISPT/2-1) GO TO 720 IF(ITRAK .EQ. LDTRK)GO TO 730 ITRAK=ITRAK-1 IBLK=IBLK-ISPT/2 720 ISEC=IBLK*14-((IBLK*14)/ISPT)*ISPT CALL EXEC(1,LU,IBUFF,128,ITRAK,ISEC) GO TO 550 C C COMPUTE DIRECTORY ENTRIES AVAILABLE, BLKS AVAILABLE AFTER PACK, C AND DIRECTORY ENTRIES AVAILABLE AFTER PACK C 730 IF(JFILT.NE.2HEN.OR.ISKIP.NE.32767)GO TO 750 ISKIP = ICCNT - JCRIF 740 ITRAK = LTRAK GO TO 370 750 IFILE=IFILE-1 IDUN=IDENT-IUSED ABLK=BREM+(IASEC/2) IADUN=IDENT-ICCNT IF(HEAD.EQ..FALSE.)GO $TO 790 WRITE(LUOUT,760)IDUN 760 FORMAT(23X,"DIRECTORY ENTRIES AVAILABLE = ",I5/) IF(BREM.NE.ABLK)WRITE(LUOUT,770)ABLK 770 FORMAT(/23X,"BLOCKS AVAILABLE AFTER PACK = ",I6) IF(IDUN.NE.IADUN)WRITE(LUOUT,780)IADUN 780 FORMAT(17X,"DIRECTORY ENTRIES AVAILABLE AFTER PACK = ",I5/) C C PRINT ANY BAD TRACKS!!! C 790 IF(IBTCT.GT.0)WRITE(LUOUT,800)(IBTRK(IJK),IJK=1,IBTCT) 800 FORMAT(30X,"BAD TRACK LIST"/6(35X,I3/)) IF(IFBRK(IDUMY))1250,810 810 IF(IFILE.EQ.0) GO TO 1240 IF(JCRIF.EQ.2HSC .AND. JFILT .NE. 2HEN)GO TO 330 IF(SUPFLG.GT.0)GO TO 830 WRITE(LUOUT,820) 820 FORMAT(3X,"NAME",3X,"TYPE",2X,"BLKS\LU EXT RECLEN", #3X,"SECURITY",3X,"TRACK",2X,"SECTOR OPEN TO") IF(JFILT.EQ.2HEN)GO TO 830 IF(JFILT.EQ.2HPU)GO TO 830 C C ALPHABETIZE THE FILES C CALL ALPHA(NAMES,IFILE) C C START LOOP TO PRINT THE FILE NAMES. C 830 DO 1180 K=1,IFILE IEXN =-1 C C GET TRACK AND SECTOR OF THE FILE. C IWORK=NAMES(4,K) ITRAK=LTRAK-(IWORK/2048) KI=1+IAND(IWORK,3400B)/256 ISEC=IAND(IWORK,177B) IF(K .EQ. 1)GO TO 840 IF(ITRAK .NE. ILTRK)GO TO 840 IF(ISEC .NE. ILSEC)GO TO 840 GO TO 860 C C GET FILE AND INFORMATION ON IT. C 840 CALL EXEC(1,LU,IBUFF,128,ITRAK,ISEC) 850 ILTRK = ITRAK ILSEC = ISEC 860 IEXCK = IAND(200B,IWORK) IF(JFILT.NE.2HEN)GO TO 870 IF(IBUFF(4,KI).EQ.0)GO TO 900 IEXCK=IBUFF(6,KI)/256 C C CHECK FOR EXTENTS C 870 IF(IEXCK)900,900,880 880 IF(JBUF1.EQ.0) GO TO 890 IF((JBUF1.NE.IBUFF(1,KI)).OR.(JBUF2.NE.IBUFF(2,KI)) #.OR.(JBUF3.NE.IBUFF(3,KI))) GO TO 1000 C C RECORD EXTENT NUMBER AND CALCULATE NECESSARY INFORMATION C IF IT IS EXTENT ZERO. C IF(JFILT.EQ.2HEN)GO TO 900 890 IEXN = IBUFF(6,KI)/256 IF(IEXN.GT.ITEMP)ITEMP=IEXN IF(JFILT.EQ.2HEN)GO TO 910 IF(IEXN)1170,910,1170 900 IF(JBUF1.NE.0)GO TO 1000 910 IF(IBUFF(8,KI).EQ.0) IBUFF(8,KI)=128 CALL ASCII(IBUFF(9,KI),IP) IF(IBUFF(1,KI) .EQ. -1)IBUFF(1,KI) = 2H-- IBUFF(7,KI)=IBUFF(7,KI)/2 IBUFF(6,KI)=IAND(177B,IBUFF(6,KI)) IF(JFILT.EQ.2HEN.OR.JCRIF.NE.2HDI)GO TO 920 IBUFF(8,KI) = (KI-1)*16 IBUFF(5,KI) = ITRAK IBUFF(6,KI) = ISEC 920 IF(K.EQ.IFILE.AND.JFILT.EQ.2HEN)K=K+1 C C CHECK TO SEE IF FILE IS OPEN TO ANYONE. C IF(LPROG1.EQ.2H )GO TO 940 DO 930 LC=1,3 LPROG(1,LC)=20040B 930 CONTINUE 940 DO 970 JJ=1,7 IF(IBUFF(JJ+9,KI).EQ.0)GO TO 970 IADDR = (IAND(77777B,IBUFF(JJ+9,KI)))+14B DO 950 JK=1,3 950 LPROG(LKNT+1,JK)=IGET(IADDR+JK-1) IND = 40B IF(IBUFF(JJ+9,KI).LT.0)IND=55B LPROG(LKNT+1,3)=IOR(IND,IAND(177400B,LPROG(LKNT+1,3))) LKNT = LKNT+1 IF(LKNT.GE.2)LKNT1=2 DO 960 JK=1,3 960 LPROG(LKNT+1,JK)=2H 970 CONTINUE IF(JFILT.EQ.2HEN.AND.IEXN.EQ.0)GO TO 1070 IF(IEXN.EQ.-1) GO TO 990 C C FILL THE TEMPORY BUFFER C DO 980 JK=1,9 980 JBUFF(JK)=IBUFF(JK,KI) JBUF10=IP GO TO 1170 990 IF(ITEMP.EQ.0)GO TO 1070 C C PRINT THE FILES AND INFORMATION C 1000 IF(SUPFLG.GT.0)GO TO 1010 WRITE(LUOUT,1060) JBUF1,JBUF2,JBUF3,JBUF4, #JBUF7,ITEMP,JBUF8,JBUF9,JBUF10,JBUF5,JBUF6, #((LPROG(JJ,JK),JK=1,3),JJ=1,LKNT1) ASSIGN 1010 TO IRTN GO TO 1080 1010 ASSIGN 1110 TO IRTN TBLK=TBLK+JBUF7*(ITEMP+1) IF(IPURG.NE.99)GO TO 1050 IF(IVETO .EQ. 0)GO TO 1040 ASSIGN 1050 TO NOPRGE ASSIGN 1040 TO IPGAD 1020 WRITE(LUIN,1030 ) 1030 FORMAT(" PURGE ? (YES, NO, ABORT) _") CALL REIO(1,LUINE,NHUH,-2) IF(NHUH .EQ. 2HYE)GO TO IPGAD IF(NHUH .EQ. 2HAB)GO TO 1270 GO TO NOPRGE 1040 CALL PURGE(IDCB,IERR,JBUFF,JBUF9,ICR) CALL IFMGR(IERR,10,LUIN,JBUFF) 1050 ITEMP = 0 JBUF1=0 IF(K.EQ.IFILE.AND.JFILT.EQ.2HEN.AND.IEXCK.NE.0)GO TO 890 IF((K.GE.IFILE).AND.(IEXCK.NE.0))GO TO 1180 IF(IEXCK)910,910,890 1060 FORMAT(2X,3A2,2X,I3,4X,I5," +",I2,3X,I5,3X,I6,"=",A2,4X,I3,4X,I3, #4X,3A2,1X,3A2) 1070 IF(IBUFF(4,KI).EQ.0 .AND. JCRIF .NE. 2HDI)GO TO 1150 IF(SUPFLG.GT.0)GO TO 1130 WRITE(LUOUT,1140) IBUFF(1,KI),IBUFF(2,KI),IBUFF(3,KI), #IBUFF(4,KI),IBUFF(7,KI),IBUFF(8,KI),IBUFF(9,KI),IP, #IBUFF(5,KI),IBUFF(6,KI),((LPROG(JJ,JK),JK=1,3),JJ=1,LKNT1) 1080 DO 1090 M=1,3 N=M*2 IF(LKNT.GT.N)WRITE(LUOUT,1100)((LPROG(JJ,JK),JK=1,3),JJ=N+1,N+2) 1090 CONTINUE LKNT = 0 LKNT1 = 0 GO TO IRTN 1100 FORMAT(64X,3A2,1X,3A2) 1110 IF(IPURG.NE.99)GO TO 1130 IF(IVETO .EQ. 0)GO TO 1120 ASSIGN 1130 TO NOPRGE ASSIGN 1120 TO IPGAD GO TO 1020 1120 CALL PURGE(IDCB,IERR,IBUFF(1,KI),IBUFF(9,KI),ICR) CALL IFMGR(IERR,10,LUIN,IBUFF(1,KI)) 1130 IF(IBUFF(4,KI) .EQ. 0)GO TO 1170 TBLK=TBLK+IBUFF(7,KI) 1140 FORMAT(2X,3A2,2X,I3,4X,I5,7X,I5,3X,I6,"=",A2,4X,I3,4X,I3,4X #3A2,1X,3A2) GO TO 1170 C C PRINT TYPE ZERO FILE C 1150 IF(SUPFLG.GT.0)GO TO 1170 IFUNC = (IAND(IBUFF(5,KI),7700B))/64 I0LU = IAND(IBUFF(5,KI),77B) WRITE(LUOUT,1160) IBUFF(1,KI),IBUFF(2,KI),IBUFF(3,KI) #,IBUFF(4,KI),IFUNC,I0LU,IBUFF(9,KI),IP 1160 FORMAT(2X,3A2,2X,I3,4X,O3,I2,15X,I6,"=",A2) 1170 IF((K.GE.IFILE).AND.(ITEMP.NE.0))GO TO 1000 C C GO GET THE NEXT FILE NAME C IF(IFBRK(IDUMY))1250,1180 1180 CONTINUE BLKPT = ISPT/2 ITRK= TBLK/BLKPT ISC=AMOD(TBLK,BLKPT) ISC=ISC*2 TBLK = 0 IF(JCRIF.EQ.2HDI)GO TO 1230 CALL ASCII(IPFIL,IP) IF(IPL.GT.1.AND.SUPFLG.GT.0)WRITE(LUOUT,1190)IPFIL,IP 1190 FORMAT(" SECURITY CODE ",I6,"=",A2," HAS A") IF(JCRIF.EQ.2HHE.OR.JCRIF.EQ.0.OR.JFILT.EQ.2HEN)GO TO 1230 WRITE(LUOUT,1200)IFILE,ITRK,ISC 1200 FORMAT(/" TOTAL OF ",I4," FILES USING",I4," TRACKS AND ", 1I2," SECTORS (64 WORD SECTORS)"//) GO TO 1230 1210 WRITE(LUIN,1220)IDIM2 1220 FORMAT(" DIRECTORY TOO LARGE MORE THAN",I5," ENTRIES") C C GO GET THE NEXT CARTRIDGE C 1230 IF(IPL.GT.1.AND.SUPFLG.EQ.0)CALL EXEC(3,LUPAG,-1) 1240 CONTINUE WRITE(LUOUT,1260) 1250 CALL EXEC(3,LUPAG,-1) GO TO 1270 1260 FORMAT(17(" *"),"END DL",16("* ")) 1270 RETURN 1280 WRITE(LUIN,1290) 1290 FORMAT(" /DL : PARTITION TO SMALL INCREASE SIZE OF DL !") RETURN END SUBROUTINE ASCII(BINARY,IA) INTEGER BINARY IA = IAND(BINARY,377B) LBYTE = IAND(BINARY,77400B) IF(IA.LT.40B.OR.IA.GT.176B)IA = 40B IF(LBYTE.LT.20000B)LBYTE = 20000B IF(LBYTE.EQ.77400B)LBYTE = 20000B IA = IOR(LBYTE,IA) RETURN END ASMB,R,L * 1730 HRS THU 14 JUN 79 NAM NAMCK,7 REV. 1924 790614 CHECK FILE NAME ENT NAMCK EXT .ENTR * * THIS SUBROUTINE RETURNS A FLAG (0,-1) TO DL DEPENDING * ON HOW A GIVEN STRING(KNOWN AS THE FILTER) COMPARES TO ANOTHER * STRING(KNOWN AS THE FILE NAME). * * CALLING SEQUENCE: * * CALL NAMCK(IBUF,ICHAR,JBUF,JCHAR,IFLAG) * * WHERE: * IBUF = THE FILE NAME TO BE CHECKED * ICHAR= NO. OF CHARACTERS IN IBUF * JBUF = SMALLER BUFFER CONTAINING SEARCH FILTER * JCHAR= NO. OF CHARCTERS IN JBUF * IFLAG= -1 IF STRING FOUND; 0 IF NOT FOUND * * VARIABLE DEFINITION: * * BADDR = BYTE ADDRES FOR INPUT BUFFER * SADDR = BYTE ADDRES FOR INPUT FILTER BUFFER * ICNT = -(NUMBER CHARACTERS IN SOURCE BUFFER) * JCNT = -(NUMBER CHARACTERS LEFT IN SEARCH FILTER) * STGCT = CHAR. COUNT IN CURRENT STRING CHECK BUFFER * Y-REG = CHECK STRING BUFFER ADDRESS * * IBUF NOP FILE NAME BUFFER ICHAR NOP NO. OF CHAR. IN IBUF JBUF NOP FILTER STRING JCHAR NOP NO. OF CHAR. IN JBUF IFLAG NOP IFLAG SET TO -1 IF STRING FOUND NAMCK NOP ENTRY POINT s:JSB .ENTR DEF IBUF CLA CLEAR STA STGCT CURRENT STRING COUNTER STA PLSFG RESET PLUS FLAG CCA SET OUTER CMPAR LOOP STA OUTLG TO ONE TIME LDA ICHAR,I GET FILE NAME BUFFER LGTH. CMA,INA SET NEG. STA ICNT AND SAVE LOCAL LDA JCHAR,I GET THE FILTER LENGTH CMA MAKE NEGITIVE STA JCNT SAVE COUNTER (-1) LDA IBUF RAL STA BADDR SAVE AS BYTE ADDRESS LDB JBUF RBL STB SADDR SAVE THE BYTE ADD. FOR FILTER NXBT ISZ JCNT CHECK FOR END OF FILTER BUFFER RSS JMP DONE DONE THEN LBT GET THE NEXT FILTER CHAR. CPA APLUS CHECK FOR PLUS JMP PLUS CPA AMINS CHECK FOR '-'S JMP MINUS LDA STGCT CHECK FOR BEGINNING SZA OF A STRING JMP NX.1 LDY SADDR YES, SO SAVE FILTER BUFFR ADD. IN Y LDX BADDR AND THE SOURCE BUFFR ADD. IN X NX.1 ISZ STGCT BUMP STRING COUNTER ADA ICNT CHECK FOR POSSIBLE STRING CHECK SSA,RSS OVER RUN JMP DONE IF ABOUT TO OVER RUN-GO CHECK JMP NXBT GO GET NEXT BYTE SPC 2 * MINUS ISZ BADDR BUMP SOURCE STRING BUFFER POINTER LDA STGCT CHECK IF STRING CHECK PENDING SZA JMP MIN.1 YES, SO GO DO IT ISZ SADDR BUMP FILTER BUFFER ADD TOO. ISZ ICNT ANY CHARATERS LEFT ? JMP NXBT YES, SO GET NECT BYTE JMP EXFND NO, SO EXIT FOUND SPC 1 MIN.1 STB SADDR SAVE THE FILTER BUFFER POINTER LDA PLSFG CHECK FOR "+" FLAG SZA,RSS SET ? JMP MIN.2 YES LDA ICNT FORM OUTER LOOP COUNTER ADA STGCT OUTLG = ICNT + STGCT SSA,RSS SEE IF LEGAL LOOP COUNTER JMP EXNFD NO, SEE EXIT NOT FOUND STA OUTLG OK, SAVE MIN.2 JSB CHECK GO CHECK STRING li INA BUMP SOURCE BUFFER STA BADDR ADDRESS LDB SADDR CLA RESET THE '"+"' STA PLSFG FLAG CMA AND THE OUTER STA OUTLG LOOP COUNTER LDA ICNT INA JMP NXT GO CLEAN UP SPC 1 PLUS STB SADDR SAVE FILTER BUFFER POINTER LDA STGCT SEE IF CURRENT STRING SZA TO PROCESS JMP PL.1 YES STB PLSFG NO, SET '"+"' HAS OCCURED FLAG JMP NXBT NO, SO JUST GET NEXT BYTE PL.1 LDA PLSFG CHECK FOR '"+"' FLAG SZA,RSS JMP PL.2 FLAG NOT SET SO SET TO ONE TIME * LDA ICNT SET OUTER LOOP COUNTER ADA STGCT TO CHECK ALL OF BUFFER ADA M1 SSA,RSS CHECK IF 1 CMPAR WILL DO. PL.2 CCA YES, SO SET OUTER LOOP TO -1 STA OUTLG SAVE OUTER LOOP COUNTER JSB CHECK STA PLSFG SET '"+"' FLAG NON ZERO JMP CONT * * CHECK STRING * CHECK NOP ENTER CHECK ROUTINE HERE AGAIN CXA GET SOURCE BUFFER ADD. FROM X-REG. CYB GET FILTER ADD. FROM Y-REG. CBT STGCT CMPAR STRING JMP CHECK,I RETURN TO CALLER NOP ISZ OUTLG SEE IF WE ARE DONE RSS NO, JMP EXNFD YES, GO SET NOT FOUND FLAG * ISX BUMP SOURCE BUFFER ADDRESS ISZ ICNT AND SOURCE CHAR. COUNT JMP AGAIN AND GO AGAIN * EXNFD CLA STA IFLAG,I JMP NAMCK,I AND RETURN * CONT STA BADDR SAVE THE SOURCE BUFFER ADD. LDB SADDR RESTORE FILTER BUFFER POINTER LDA ICNT UPDATE CHAR COUNT NXT ADA STGCT SSA,RSS JMP EXCHK STA ICNT CLA RESET THE STRING STA STGCT COUNTER LDA JCNT SSA JMP NXBT JMP EXFND * EXCHK LDA JCNT SSA JMP EXNFD * EXFND CCA STA IFLAG,I JMP NAMCK,I * DONE LDA STGC&lT CEHCK IF PENDING STRING SZA,RSS JMP EXFND NO, SO JUST EXIT FOUND LDA PLSFG CHECK FOR PLUS FLAG SZA,RSS JMP DN.1 LDA ICNT STA OUTLG SAVE LOOP COUNTER ADA STGCT CHECK FOR ILLEGAL STRING LENGTH SZA,RSS CHECK FOR ZERO JMP *+3 IF STGCT + ICNT <= 0 SSA,RSS AND NEGITIVE NUMBER JMP EXNFD PLUS NUMBER: NO GOOD DN.1 JSB CHECK YES, SO GO CHECK STRING JMP EXFND STRING FOUND * * CONSTANTS AND STORGE PLSFG NOP PLUS FLAG SET BADDR NOP SOURCE STRING ADD. POINTER SADDR NOP FILTER STRING ADD. POINTER OUTLG NOP OUTER LOOP COUNTER ICNT NOP SOURCE CHAR. COUNT JCNT NOP FILTER CHAR. COUNT STGCT NOP CURRENT STRING COUNTER M1 DEC -1 AMINS OCT 55 APLUS OCT 53 END ASMB,R,B,L,C NAM ALPHA,7 REV A 750120 * DOES AN ALPHABETIC SORT ON 3-WORD FIELD IN (NAMES) IFILE FIELDS LONG. * IT ALSO SETS BIT 8 OF THE TRACK SECTOR WORD IF IT IS AN EXTENT. * CALLED FROM FTN BY: CALL ALPHA(NAMES,IFILE) ENT ALPHA EXT .ENTR NAMES BSS 1 IFILE BSS 1 ALPHA NOP JSB .ENTR DEF NAMES CLA STA RPEAT LDA IFILE,I CMA,INA STA CNTR1 LOOP1 EQU * LDA CNTR1 ADA IFILE,I ALS,ALS ADA NAMES STA ADDR1 STA PNTR1 LDA CNTR1 CPA RPEAT JMP OUT INA SZA,RSS JMP OUT STA CNTR2 LOOP2 EQU * LDA CNTR2 ADA IFILE,I ALS,ALS ADA NAMES STA ADDR2 STA PNTR2 LDA DM3 STA CNTR3 LDA ADDR1 LOOP3 EQU * LDB ADDR2,I CMB,INB ADB A,I INA ISZ ADDR2 SSB JMP END2 SZB JMP SWTCH ISZ CNTR3 JMP LOOP3 STA B LDA A,I IOR IFLAG SET A FLAG STA B,I IF A FILE LDA ADDR2,?I EXTENT IOR IFLAG STA ADDR2,I JMP END2 SWTCH EQU * LDA DM4 STA CNTR4 LDA ADDR1 STA PNTR1 LOOP4 EQU * LDA PNTR1,I LDB PNTR2,I SWP STA PNTR1,I STB PNTR2,I ISZ PNTR1 ISZ PNTR2 ISZ CNTR4 JMP LOOP4 END2 EQU * ISZ CNTR2 JMP LOOP2 ISZ CNTR1 JMP LOOP1 OUT EQU * JMP ALPHA,I CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 CNTR4 BSS 1 PNTR1 BSS 1 PNTR2 BSS 1 RPEAT BSS 1 ADDR1 BSS 1 ADDR2 BSS 1 IFLAG OCT 200 DM4 DEC -4 DM3 DEC -3 A EQU 0 B EQU 1 END ASMB,R,N,L,C HED JULIAN TIME ROUTINES 14JUN79 ANT IFZ NAM JULIA,7 TIME ROUTINE A.T. 14JUN79 <<21MX ONLY!>> ENT JULIA XIF IFN NAM JULIS,7 TIME ROUTINE A.T. 14JUN79 <<21MX ONLY!>> ENT JULIS XIF EXT EXEC,.ENTR * * THIS PROGRAM CONVERTS THE RTE ORDINAL DAY TIME TO "MILITARY" * TIME IN ONE OF TWO FORMATS. THE TIME AND DATE IS THEN PRINTABLE IN * A2 FORMAT. THE VALUES OF THE DAY AND MONTH ARE ALSO RETURNED IN THE * A AND B REGISTERS. * * ASSEMBLY OPTION Z ASSEMBLY OPTION N * FOR TIME TO MINUTES FOR TIME TO SECONDS * AMSB CALL--> JSB JULIA JSB JULIS * DEF *+2 DEF *+2 * DEF TBUF DEF TBUF * * * FTN4 EXAMPLE> PROGRAM TEST PROGRAM TEST * DIMENSION ITBUF(6) DIMENSION ITBUF(8) * CALL JULIA(ITBUF) CALL JULIS(ITBUF) * CALL ABREG(IDAY,IMONTH) CALL ABREG(IDAY,IMONTH) * WRITE (LU,1000)ITBUF WRITE (LU,1000)ITBUF * 1000 FORMAT("TIME="6A2".") 1000 FORMAT("TIME="8A2".") * END END t% * * OUTPUT--> TIME=2305 06AUG76. OR TIME=23:05:15 06AUG76. * * ON RETURN: A=DAY OF THE MONTH B=MONTH# (1 TO 12) * X=L.S.D. OF YEAR Y=NEXT BYTE ADDRESS OF OUTPUT BUFFER * * * WRITTEN BY: ALAN TIBBETTS * HEWLETT-PACKARD DATA SYSTEMS DIV. * CUPERTINO, CA. * TEMP EQU * MSEC NOP SECS NOP MINS NOP HRS NOP DAYS NOP YEAR NOP * OBUF NOP JULIA EQU * JULIS EQU * RETRN NOP JSB .ENTR GET RETURN ADDRESS DEF OBUF * JSB EXEC GO SEE WHAT TIME IT IS *** DEF *+4 * DEF D11 * DEF MSEC * DEF YEAR *** * * NOW TRANSFER STUFF TO USER * LDB OBUF GET ADDRESS OF USERS BUFFER CLE,ELB MAKE INTO BYTE ADDRESS * LDA HRS GET THE HOUR OF THE DAY JSB B2DEC CONVERT IT AND STORE IT IFN LDA COLON SBT PUT IN A COLON FOR A SEPARATOR XIF LDA MINS GET THE MINUTES PAST THE HOUR JSB B2DEC CONVERT IFN LDA COLON SBT LDA SECS CONVERT THE SECONDS IF JULIS JSB B2DEC XIF LDA BLNK SBT STORE TIME/DATE SEPARATOR CBX SAVE THE POINTER * * TEST FOR LEAP YEAR AND COMPUTE DAY OF MONTH * LDA YEAR IS THIS A LEAP YEAR? AND D3 CHECK LEAST 2 BITS CLB CBY (WILL NEED Y=0 LATER) SZA,RSS IF 0, YEAR WAS EVENLY DIVISIBLE BY FOUR INB SO MAKE FEBRUARY BE 29 DAYS INSTEAD OF ADB D28 THE NORMAL 28 DAYS STB MOTBL+1 AND STORE IT. * * FOR THE PURIST, DIVIDING BY 4 TO TEST FOR LEAP YEARS IS * NOT A SUFFICIENT TEST, BUT THIS EASY TEST WILL NOT CAUSE AN * ERROR UNTIL 2100 A.D. * LDA DAYM NOW FIGURE OUT DAY OF MONTH STA TEMP SET UP POINTER TO TABLE OF DAYS IN MO. LDA DAYS GET DAY OF YEAR CMA,INA MAKE IT NEGATIVE * MLP1 ISY COUNT THE MONTHS IN Y REG. ISZ TEMP BUMP MONTH POINTER ADA TEMP,I SUBTRACT ONE MONTH'S DAYS SSA WILL GO NEGATIVE IF ONE MONTH TOO FAR JMP MLP1 * CMA,INA RESTORE REMAINDER ADA TEMP,I NOW HAVE DAYS IN MONTH STA DAYS SAVE TO PASS BACK IN A REG. * * NOW PASS THE REMAINDER TO USER * CXB GET THE OUTPUT POINTER BACK JSB B2DEC CONVERT DAYS TO ASCII CYA GET MONTH NUMBER (1 TO 12) FROM Y STA TEMP ALS MULTIPLY IT BY 3 ADA TEMP (3 TO 36) ADA DMOT ADD BYTE ADDRESS ADJUSTED BY -3 MBT D3 AND MOVE THE 3 LETTERS POINTED TO BY AREG LDA YEAR GET THE YEAR ADA M1900 << THIS IS RESTRICTIVE TO 20TH CENTURY! >> JSB B2DEC CONVERT IT AND STORE IN USERS BUFFER * XBY SET B=MONTH NUMBER, Y=BYTE POINTER LDA DAYS SET A=DAY OF THE MONTH JMP RETRN,I FINISHED * B2DEC NOP BINARY TO DECIMAL CONVERSION CBX CLB ASSUMING THE NUMBER IS OF FORM A=N*10+M, DIV D10 DIVIDE BY 10 TO SEPARATE N AND M, THEN XBX ADD ASCII 0 TO MAKE THEM PRINTABLE ADA K60 SBT STORE THE M.S. DIGIT FROM AREG TO USER. CXA GET THE L.S. DIGIT BACK ADA K60 MAKE IT ASCII SBT AND STORE IT TOO. JMP B2DEC,I * M1900 DEC -1900 REVISE IN YEAR 2000, PLEASE. D3 DEC 3 D10 DEC 10 D11 DEC 11 D28 DEC 28 K60 OCT 000060 ASCII ZERO BLNK ASC 1, TWO ASCII BLANKS IFN COLON ASC 1,:: TWO ASCII COLONS XIF SUP DAYM DEF MOTBL-1 MOTBL DEC 31,28,31,30,31,30,31,31,30,31,30,31 DMOT DBR *-1 THREE LESS THAN THE BYTE ADDRESS OF *+1 ASOC 18,JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC BSS 0 REVEAL LENGTH OF PROGRAM END ASMB,R,L,B,C HED ** FILE MANAGER ERROR PROCESSOR ** NAM IFMGR,7 ENT IFMGR EXT EXEC,.ENTR * * THIS FUNCTION CHECKS FOR FILE MANAGER ERRORS. IF THE ERROR * CODE IS < 0, THE ERROR MESSAGE IS PRINTED ON THE SPECIFIED TTY. * * IF ID IS >= 0, THE ERROR CODE IS RETURNED AS THE FUNCTION VALUE. * * IF ID IS < 0 AND THE ERROR CODE IS < 0, THEN THE PROGRAM IS * ABORTED. * * FORTRAN USEAGE EXAMPLE: * IF (IFMGR (IERR,ID,LTTY,NAME)) 100,200 * * ASSEMBLY CALLING SEQUENCE * JSB IFMGR * DEF *+4 * DEF IERR * DEF ID * DEF LTTY * DEF NAME * ON RETURN A = IERR * * WHERE THE USER SUPPLIED VARIABLES ARE: * * IERR = ERROR PARAMETER RETURNED FROM FILE MANAGER CALL. * ID = CALL IDENTITY CODE (NEGATIVE TO ABORT IF ERROR EXISTS) * 1 = APOSN * 2 = CLOSE * 3 = CREAT * 4 = FCONT * 5 = FSTAT * 6 = LOCF * 7 = NAMF * 8 = OPEN * 9 = POSNT * 10 = PURGE * 11 = READF * 12 = RWNDF * 13 = WRITF * LTTY = LOGICAL UNIT NUMBER OF DEVICE TO LIST ERROR * NAME = NAME OF FILE THAT HAD ERROR * * PARAMETER ADDRESSES * IERR NOP ERROR CODE ID NOP FILE MANAGER CALL ID LTTY NOP LOGICAL UNIT TO OUTPUT ERROR MESSAGES. NAME NOP NAME OF FILE THAT HAD ERROR IFMGR NOP JSB .ENTR USE .ENTR TO GET DEF IERR ADDRESSES OF PARAMETERS LDA IERR,I GET ERROR CODE SSA,RSS FILE MANAGER ERROR? JMP IFMGR,I NO,RETURN TO USER * * ERROR - CONVERT ERROR TO ASCII AND PUT IT INTO OUTPUT BUFFER * MPY M1 MULTIPLY ERROR BY -1 & THEN DIV .10 DIVIDE BY TEN TO GET TENS DIGIT. STA ERROR SAVE TEMPORARILY MPY .10 MULTIPLY BY 10 AND DIVIDE BY DIV .1 .1 TO GET TENS VALUE ONLY ADA IERR ,I ADD ERROR CODE,RESULT = - UNITS CMA,INA MAKE UNITS POSITIVE LDB ERROR GET TENS DIGIT BLF,BLF ROTATE IT TO HIGH BYTE OF WORD IOR B OR IT WITH UNITS IOR ASC00 OR IN ASCII CONSTANT STA ERROR PUT ASCII ERROR CODE IN MSG BUFFER * * ADD CALL ID AND FILE NAME TO BUFFER * LDA ID,I GET ID CODE SSA IS IT NEGATIVE? CMA,INA YES - MAKE POSITIVE STA B IS CODE ADB M14 GREATER SSB,RSS THAN 13? CLA YES - OUTPUT $$$$$ FOR ID STA B SAVE ERROR CODE ALS MULTIPLY BY 2 AND ADA B ADD IT TO ITSELF (X3) ADA CALL ADD BUFR STARTING ADRS TO OFFSET LDB EMES SET POINTER TO STB PNTR ID NAME CLB SET FLAG TO INDICATE NAME STB FLAG BUFFER HAS TO BE TRANSFERRED. NFILE LDB M3 SET COUNTER TO STB CNTR TRANSFER 3 WORDS LOOP LDB A,I GET ID WORD & PUT IT STB PNTR,I IN ERROR MESSAGE BUFFER INA ILNDEX ID AND ISZ PNTR ERROR MESSAGE POINTERS ISZ CNTR TRANSFER COMPLETE? JMP LOOP NO - TRANSFER NEXT WORD LDB FLAG SZB NAME ARRAY TRANSFERRED? JMP LP1 YES - OUTPUT MESSAGE ISZ FLAG NO - SET FLAG TO SAY YES LDA NAME GET ADDRESS OF ARRAY IN A LDB NAMEB PUT OUTPUT BUFFER STB PNTR ADDRESS IN B JMP NFILE TRANSFER FILE NAME * * PUT IN PROGRAM NAME * LP1 LDB 1717B ADB .12 LDA B,I STA PRGNM INB LDA B,I STA PRGNM+1 INB LDA B,I AND M1774 IOR COLON STA PRGNM+2 * * OUTPUT ERROR MESSAGE * OUT JSB EXEC OUTPUT THE ERROR MESSAGE DEF *+5 DEF WRITE DEF LTTY,I DEF PRGNM DEF M40 * * CHECK FOR ABORT PROGRAM * LDA IERR,I PUT ERROR CODE IN CASE WE RETURN LDB ID,I GET ID CODE SSB,RSS DO WE ABORT? JMP IFMGR,I NO - RETURN * * ABORT PROGRAM * JSB EXEC WRITE DEF *+5 "PROGRAM ABORTED!" DEF WRITE ON THE DEF LTTY,I LOCAL TTY DEF ABORT DEF M16 JSB EXEC ASK RTE DEF *+2 TO TERMINATE THE PROGRAM DEF .6 * * CONSTATNTS, STORAGE ALLOCATION, AND MESSAGES * A EQU 0 A REGISTER B EQU 1 B REGISTER * * CONSTANTS * COLON OCT 72 .1 DEC 1 .6 DEC 6 .10 DEC 10 .12 DEC 12 M1 DEC -1 M3 DEC -3 M14 DEC -14 M16 DEC -16 M40 DEC -40 M1774 OCT 177400 * * MISC. CONSTANTS * ASC00 ASC 1,00 WRITE DEC 2 * * CNTR NOP UTILITY COUNTER FLAG NOP ID/NAME TRANSFER FLAG PNTR NOP TRANSFER POINTER TO MESSAGE BUFFER * * FILE MANAGER CALLS * CALL DEF *+1 SUP PRESS THE GARBAGE ASC 3,$$$$$ ID1 ASC 3,APOSN ID2 ASC 3,CLOSE ID3 ASC 3,CREAT ID4 ASC 3,FCONT ID5 ASC 3,FSTAT ID6 ASC 3,LOCF ID7 ASC 3,NAMF ID8 ASC 3,OPEN ID9 ASC 3,POSNT ID10 ASC 3,PURGE ID11 ASC 3,READF ID12 ASC 3,RWNDF ID13 ASC 3,WRITF * * ERROR MESSAGE * PRGNM BSS 3 ASC 1, ERMES BSS 3 ASC 4,ERROR - ERROR NOP ASC 5, IN FILE NAM. BSS 3 NAMEB DEF NAM. EMES DEF ERMES * * ABORT ERROR MESSAGE ABORT ASC 8,PROGRAM ABORTED! * * * END ASMB,R,B,L NAM ISOL8,7 ISOLATE,RIGHT JUSTIFY BITS. 18 JAN 77. ENT ISOL8 EXT .ENTR * * I=ISOL8(J,11,8) ISOLATES BITS 11,10,9,8 FROM J AND RETURNS THEM * IN THE LEAST SIGNIFICANT BITS OF I. HIGH BITS OF * I ARE ZEROED OUT. * I=ISOL8(J,8,11) DOES THE SAME THING. * * I=ISOL8(J,15,0) RETURNS I=J * I=ISOL8(J,16,1) RETURNS I = J ROTATED 1 BIT RIGHT * J NOP I1 NOP I2 NOP ISOL8 NOP JSB .ENTR DEF J LDA !I1,I CMA,INA (A)= -I1 ADA I2,I (A)= I2-I1 SSA (A)>0 ? I2>I1 ? JMP RVERS NO. I1>I2. LDB I1,I YES. I2>I1. GET I1. JMP CONT RVERS LDB I2,I I2 IS THE LEAST OF I1,I2. CMA,INA (A)>=0. CONT CMB,INB LEAST OF I1,I2 COUNTS ROTATIONS. STA MASK# MASK NUMBER >= 0. LDA J,I GET THE WORD TO BE OPERATED ON. * RLOOP SZB,RSS DONE? ROTATION COUNTER ROSE TO ZERO ? JMP ISOL YES. RAR NO. MOVE BITS-OF-INTEREST ONE PLACE RIGHT. INB BUMP ROTATION COUNTER. JMP RLOOP * ISOL LDB .MASK ADB MASK# (B) POINTS TO DESIRED MASK. AND B,I ZERO OUT UNWANTED BITS. JMP ISOL8,I RETURN WITH (A)=RIGHT JUSTIFIED ISOLATED BITS. * MASK# NOP .MASK DEF *+1 OCT 000001 OCT 000003 OCT 000007 OCT 000017 OCT 000037 OCT 000077 OCT 000177 OCT 000377 OCT 000777 OCT 001777 OCT 003777 OCT 007777 OCT 017777 OCT 037777 OCT 077777 OCT 177777 * A EQU 0 B EQU 1 S EQU 1 END ASMB,R,B,L * 1730 HRS THU 14 JUN 79 NAM STGFD,7 IDENTIFY CHARACTER STRINGS IN A BUFFER 790614 ENT STGFD EXT .ENTR,.CBT * * THIS PROGRAM IS USED TO FIND AN EMBEDED ASCII STRING * IN A GIVEN BUFFER. * * MODIFIED =STGCK TO RETURN CHARACTER POSITION OF THE * EMBEDDED STRING WITHIN THE GIVEN BUFFER. BY DAN ANTZOULATOS. * * CALLING SEQUENCE: * * CALL STGFD(IBUF,ICHAR,JBUF,JCHAR,IMANY,IWHER) * * WHERE: * IBUF = THE LARGER BUFFER TO BE CHECKED * ICHAR= NO. OF CHARACTERS IN IBUF * JBUF = SMALLER BUFFER CONTAINING SEARCH STRING * JCHAR= NO. OF CHARCTERS IN JBUF (<=TO ICHAR) * IMANY= A) THE SIZE OF IWHER WHEN ITS PASSED TO * THIS ROUTINE. * B) AS A RETURN VALUE IT IS SET TO THE NCUMBER * OF TIMES IT HAS FOUND THE STRING. * IWHER= AN ARRAY WHOSE ELEMENTS CONTAIN THE POSITION * OF THE FIRST CHARACTER OF JBUF EACH TIME JBUF IS * FOUND. EXAMPLE: IF IMANY(RETURNED VALUE)=3 THEN * IWHER(3)=POSITION OF THE THIRD JBUF IN IBUF. * * IBUF NOP TOTAL INPUT BUFFER ICHAR NOP NO. OF CHAR. IN IBUF JBUF NOP BUFFER CONTAINING STRING TO CHECKED JCHAR NOP NO. OF CHAR. IN JBUF IMANY NOP INO. OF TIMES STRING WAS FOUND. IWHER NOP POSITION OF STRING IN THE BUFFER. STGFD NOP ENTRY POINT JSB .ENTR DEF IBUF LDA IMANY,I GET THE NUMBER OF TIMES JBUF MIGHT BE FOUND. SZA,RSS CHECK FOR ZERO CHECK JMP STGFD,I AND RETURN STA MANY CLA CLEAR STA IMANY,I STA NANY LDA ICHAR,I CMA SET UP LOOP ADA JCHAR,I SSA,RSS CHECK FOR ENOUGH JMP STGFD,I CHARACTERS STA CCNT OK, SAVE LOOP COUNTER STA INCNT LDA IBUF GET TOTAL RECORD ADDRESS RAL FORM BYTE ADDRESS STA CBUF SAVE FOR LATER CHECK LDB JBUF GET STRING BUFFER ADDRESS RBL FORM BYTE ADDRESS JSB .CBT DEF JCHAR,I NOP JSB FOUND NOP NOP ISZ CCNT RSS JMP STGFD,I ISZ CBUF LDA CBUF JMP CHECK * FOUND NOP LDA NANY ADVANCE THE NUMBER OF TIMES JBUF INA HAS BEEN FOUND. STA NANY STA IMANY,I SAVE THE NEW COUNT CCB GET THE RIGHT ELEMENT ADB IWHER OF IWHER. ADB NANY STB ITOTL LDB CCNT COMPLIMENT CCNT AND CMB ADB INCNT ADD INCNT IN ORDER TO CMB,INB GET THE POISITION OF JBUF STB ITOTL,I CPA MANY HAVE WE FOUND JBUF 'MANY' TIMES YET ?  JMP STGFD,I WE'VE FOUND IT & RETURN JMP FOUND,I GO BACK AND LOOK FOR ANOTHER ONE. * * CONSTANTS AND STORGE CCNT NOP INCNT NOP CBUF NOP MANY NOP NANY NOP ITOTL NOP END END$ ! e 24999-18246 2024 S 0100 &DXREF SOURCE             H0101 FTN4,L PROGRAM DXREF(3,74),24999-16246 REV.2024 800529 C C NAME: DXREF C SOURCE: 24999-18246 C RELOC: 24999-16246 C PGMR: G.J.S.,D.H.P C C MODIFIED TO SELECTIVELY SEARCH FOR EXT'S, ENT'S AND C CHECK FOR ARRAY OVERFLOW (300 MAX FOR BOTH). . .771117 C C MODIFIED TO OPTIONALLY DELETE ENTRY POINT LIST AND EXTERNAL C REFERANCES AND TO SELECTIVELY SEARCH MODULE NAMES. .760708 C C OFTEN IT IS NECESSARY TO KNOW THINGS ABOUT A PROGRAM SUCH C AS ENTRY POINTS, REQUIRED EXTERNAL REFERENCES, DEFAULT TYPE, C PRIORITY, OR COMMON BLOCK ALLOCATION, BUT THE SOURCE IS NOT C AVAILABLE. ALL THIS INFORMATION IS CONTAINED IN THE FIRST FEW C RECORDS OF THE RELOCATABLE FILE, BUT IS DIFFICULT TO DECIPHER C FROM A STRAIGHT OCTAL/ASCII DUMP. C C THE CAPABILITY TO RECOVER THIS INFORMATION IS OF PARTICULAR C IMPORTANCE IN BUILDING OR MODIFYING LIBRARIES AND IN PLANNING C GENERATOR COMMAND FILES. C C THUS WAS BORN "DXREF" WHICH IS SCHEDULED AS FOLLOWS: C C RU,DXREF[,NAMR][,LIST][,OPTIONS][,OPTIONS] C C WHERE: NAMR IS THE FILE NAME OR LU WHICH CONTAINS THE C RELOCATABLE TO BE 'XREFED'. C (OR) THE BATCH FILE NAME WHICH CONTAINS THE FILE C NAMES TO BE 'XREFED'.(DEFAULT: ASK USER) C C [LIST] OPTIONAL LIST OUTPUT LU.(DEFAULT: YOUR CRT) C C [OPTIONS] ANY COMBINATION OF THE FOLLOWING 2 LETTER C CODES. (ONLY 3 PER PARAMETER) C (DEFAULT: ASK USER) C C "LI" THIS WILL CAUSE DXREF TO ASK YOU FOR A C LIST OPTION WHICH WILL ALLOW YOU TO TURN C OFF LISTING OF ENTRY POINTS, EXTERNAL C REFERANCES, OR BOTH. C C "MO" THIS WILL CAUSE DXREF TO PROMPT YOU FOR A C 'FILTER' WHICH WILL ALLOW SELECTIVE LISTING C OF MODULES WITHIN A FILE. C C ݜ "EN" THIS WILL TELL DXREF TO ASK YOU FOR AN 'ENTRY POINT' C FILTER. THIS ALLOWS SEARCHING FOR AN ENTRY POINT. C C "EX" AND THIS TELLS DXREF TO ASK YOU FOR AN EXTERNAL REF. C FILTER. C C C "AL" THIS WILL TELL DXREF TO PROMPT YOU FOR ALL THE C FILTERS MENTIONED ABOVE. C C "BA" THIS WILL TELL DXREF TO USE THE GIVEN NAME IN THE C RUN STRING OR THE CURRENT FILE GIVEN AS THE BATCH C FILE TO BE USED AS THE INPUT FOR FILE NAMES C (SEE DESCRIPTION OF NAMR ABOVE). C C "RE" THIS INSTRUCTS DXREF TO CONTINUE ASKING FOR THE C FILTERS WHICH WHERE ASKED FOR INITIALLY. C C "SE" THIS TELLS DXREF TO ASK FOR ALL THE FILTERS C INITIALLY. C C "NO" (OR 'CR')EXIT OPTION SETTING PHASE. C C NOTE: ALL OPTIONS CAN BE CHANGED INTERACTIVELY. JUST TYPE C 'CO'(CHANGE OPTIONS) WHEN DXREF ASKS FOR FILE NAME AND C YOU WILL ENTER THE 'CHANGE OPTIONS MODE'. C (A '?' OR 'Y' WILL GIVE A LIST OF THE OPTIONS AND C THEIR CURRENT STATE. ADDITIONALLY YOU CAN 'TOGGLE' C THE CURRENT STATE BYE ENTERING THE CORRESPONDING C MNUMONIC.) C C THE 'SE' OPTION IS USEFUL WHEN SEARCHING FOR ONE PARTICULAR C MODULE, ENTRY POINT, OR EXTERNAL REFRENCE. ALL FILTERS AND C LIST OPTIONS ARE SET INITIALLY AND ARE NOT ASKED AGAIN. C THEREBY ALLOWING EASY SEARCHES OF MANY FILES FOR A SPECIFIC C PIECE OF INFORMATION. C C THE SAME FILE (OR BATCH FILE) CAN BE LOOKED AT AGAIN BY ENTERING C A SINGLE COLON(:) INSTEAD OF A FILE NAME. THIS ALLOWS SEARCHES C THROUGH ONE PARTICULAR FILE FOR MANY DIFFERINT PIECES OF INFORMATION. C A NOTE OF CAUTION HOWEVER: A DOUBLE COLON(::) WILL TERMINATE DXREF. C C*********************************************************************** C C  OPTIONAL PARAMETERS HAVE SPECIAL MEANINGS IN DXREF. IF THE C SECURITY CODE IS SUPPLIED, AN EXCLUSIVE OPEN WILL BE ATTEMPTED, C OTHERWISE A NON-EXCLUSIVE OPEN WILL BE USED. IF THE CARTRIDGE C NUMBER IS NOT SPECIFIED, CARTRIDGES WILL BE SEARCHED IN THE ORDER C IN WHICH THEY APPEAR IN THE CARTRIDGE DIRECTORY AND THE FIRST C OCCURRENCE OF THE NAMED FILE WILL BE CROSS-REFERENCED. IF A C CARTRIDGE NUMBER IS GIVEN, ONLY THAT CARTRIDGE WILL BE SEARCHED. C DEFAULT THE FILE TYPE, AND DXREF WILL CHECK TO SEE IF THE FILE IS C TYPE 5, INDICATING A RELOCATABLE FILE. IF NOT, THE OPERATOR WILL C BE NOTIFIED AND ASKED IF HE WISHES TO CONTINUE. IF THE FILE TYPE C IS GIVEN IN THE NAMR PARAMETER, THE FILE WILL BE OPENED AS THAT C TYPE AND NO TYPE CHECK WILL BE MADE. C C FILE MANAGER ERRORS WILL BE REPORTED ON THE INTERACTIVE DEVICE C AND THE OPERATOR WILL BE AGAIN PROMPTED FOR THE LU#/FILE NAME. C THE OPERATION MAY BE TERMINATED AT THIS POINT BY ENTERING A DOUBLE C COLON FOR THE FILE NAME. ORDERLY TERMINATION AT ANY OTHER TIME C MAY BE ACCOMPLISHED BY SETTING THE PROGRAM'S BREAK FLAG. C C C C LOGICAL BATCH,FIRST,SPFILI,FILENM,ASKFIL,LMO,LEN,LEX,LLI, *FILOPN,FTIME,REPEAT,ONETIM,BANAME,ENTFL,EXTFL,FMOD,FENT,FEXT, *ENREC,EXREC C DIMENSION ILUST(128),IB(2),IFILT(6),NAM(64),IDCB(144), *LFNBUF(21) INTEGER TTY,SECURE,CARTDG,ERROR,OPTION,TYPE,OK,RTYPE, *FNAME(4),BLOCK(64),DCB(144),PBUF(10),ENTS(3,300), *EXTS(3,300),SUPFLG,OPFLG,BREG,AREG, *ENFLT(6),EXFLT(6),ENSKP,EXSKP,BLOCK4, *BLOCK2,BLOCK7,BLOCK8,BLOCK9,BLOC18,LEMA(3),EMASZ, *BLOCK6,PBUF4,PBUF5,PBUF6,PBUF7,BAFILE(4), *BASEC,BACART,BATYPE EQUIVALENCE (LENGTH,BREG),(ENTS,ILUST), *(BLOCK(4),BLOCK4),(IB(2),BREG),(IB(1),REG,AREG), *(BLOCK(2),BLOCK2),(BLOCK(7),BLOCK7),(BLOCK(8),BLOCK8), *(BLOCK(9),BLOCK9),(BLOCK(18),BLOC18),(BLOCK(6),BLOCK6), *(PBUF(4),PBUF4),*(PBUF(5),BLOC5),(PBUF(6),PBUF6), *(PBUF(7),PBUF7) DATA ENFLT/0,2*2H::/,EXFLT/0,2*2H::/,ONETIM/.TRUE./ DATA BATCH/.FALSE./,FIRST/.TRUE./,SPFILI/.FALSE./ DATA ISTRC/1/,ASKFIL/.TRUE./,LLI/.FALSE./,LMO/.FALSE./, *LEN/.FALSE./,LEX/.FALSE./,FILENM/.FALSE./,FILOPN/.FALSE./, *FTIME/.FALSE./,REPEAT/.FALSE./,FNAME(4)/2H /, *BAFILE/2HNO,2H F,2HIL,2HE /,BANAME/.FALSE./,INITA/300/, *FMOD/.FALSE./,FENT/.FALSE./,FEXT/.FALSE./ C C STANDARD LU SETUP FOR INTERACTIVE AND LIST DEVICES. C TTY = LOGLU(LUTRUE) CALL GETST(DCB,-80,ILOG) ITTY = TTY + 400B LP = TTY ISKIP = 0 OPFLG = 0 LINES = 0 ASSIGN 90 TO JRTN ASSIGN 95 TO KRTN C C DECODE THE TURN ON STRING C DO 90 I=1,4 IF(NAMR(PBUF,DCB,ILOG,ISTRC))90,10 10 ITYPE = IAND(PBUF4,3) GO TO (20,50,60,60),I 20 IF(ITYPE .LE. 1)GO TO 40 FILENM = .TRUE. DO 30 J=1,3 FNAME(J) = PBUF(J) 30 CONTINUE SECURE = PBUF5 CARTDG = PBUF6 TYPE = PBUF7 GO TO JRTN 40 FNAME = PBUF FILENM = .FALSE. GO TO JRTN C C CHECK FOR LIST DEVICE C 50 IF(ITYPE .EQ. 1)LP = PBUF GO TO 90 C C CHECK FOR FILTERS C 60 IF(ITYPE .LE. 1)GO TO 90 LOOP = 3 70 DO 80 J=1,LOOP IF(PBUF(J) .EQ. 2HLO)LLI = .NOT. LLI IF(PBUF(J) .EQ. 2HMO)LMO = .NOT. LMO IF(PBUF(J) .EQ. 2HEN)LEN = .NOT. LEN IF(PBUF(J) .EQ. 2HEX)LEX = .NOT. LEX IF(PBUF(J) .EQ. 2HRE)REPEAT = .NOT. REPEAT IF(PBUF(J) .EQ. 2HSE)FTIME = .NOT. FTIME IF(PBUF(J) .EQ. 2HBA)BATCH = .NOT. BATCH IF(PBUF(J) .NE. 2HAL)GO TO 80 LLI = .TRUE. LMO = .TRUE. LEN = .TRUE. LEX = .TRUE. 80 CONTINUE IF(.NOT. LMO)IFILT = 0 IF(.NOT. LEN)ENFLT = 0 IF(.NOT. LEX)EXFLT = 0 OPFLG = 0 ASKFIL = .TRUE. IF(PBUF .EQ. 2HNO)ASKFIL = .FALSE. IF(LLI.OR.LMO.OR.LEN.OR.LEX.OR.FTIME)OPFLG = 1 )IF(OPFLG .EQ. 1)ASKFIL = .FALSE. 90 CONTINUE C C SAVE BATCH FILE NAME IN ITS PROPER PLACE C IF(BATCH .AND. FILENM)GO TO 132 C C CHECK IF WE ASK FOR FILTERS ? C 95 IF(.NOT.ASKFIL)GO TO 115 C 100 WRITE(TTY,110) 110 FORMAT(" FILTER OPTIONS ? _") REG = REIO(1,ITTY,PBUF,10) IF(BREG .EQ. 0)GO TO 115 IF(PBUF .NE. 2HLL .AND. PBUF .NE. 2HLI)GO TO 112 CALL CODE(BREG*2) READ(PBUF,*)LP,LP 112 LOOP = BREG LCHK = IOR(IAND(PBUF,77400B),40B) IF(LCHK .NE. 1H? .AND. LCHK .NE. 1HY)GO TO 70 114 ASSIGN 95 TO KRTN WRITE(TTY,120)LP,LLI,LMO,LEN,LEX,REPEAT,FTIME,BATCH,BAFILE 120 FORMAT(/" ENTER ANY SEQUENCE OF THE FOLLOWING 2 LETTER CODES"/ #6X"STATE"/ #" LIST = "I3/ #" LO - ("L1") ASK FOR LISTING OPTIONS"/ #" MO - ("L1") ASK FOR FILTERING BY MODULE NAME"/ #" EN - ("L1") ASK FOR FILTERING BY ENTRY POINT NAME"/ #" EX - ("L1") ASK FOR FILTERING BY EXTERNAL REFERANCE"/ #" RE - ("L1") REPEAT FILTER QUESTIONS AS SET ABOVE"/ #" SE - ("L1") SET ALL FILTERS INITIALLY ONLY"/ #" BA - ("L1") "4A2"WILL BE USED AS BATCH FILE"/ #" AL - ASK FOR ALL FILTERS"/ #" NO - (OR 'CR') LEAVE FILTER OPTIONS AS IS"// #" NOTE: ANY CODE ENTERED WILL TOGGLE CURRENT STATE"/) GO TO 100 C C CHECK FOR DEFAULT, LU, OR FILE NAME. C 115 NAMCNT = 0 IF(BATCH .AND. BANAME)GO TO 142 IF (FNAME .LE. 0) GO TO 202 IF (FNAME .LE. 255) GO TO 220 IF (FILENM)GO TO 220 GO TO 202 C C COPY BATCH DCB TO NEW ONE AND READ BATCH FILE C 125 DO 130 J=1,16 IDCB(J) = DCB(J) 130 CONTINUE ASSIGN 137 TO KRTN C C SAVE BATCH FILE NAMR C 132 DO 135 J=1,4 BAFILE(J) = FNAME(J) 135 CONTINUE BASEC = SECURE BACART= CARTDG BATYPE= TYPE BANAME= .TRUE. GO TO KRTN C C RESTORE BATCH FILE NAME TO FNAME C 142 DO 145 J=1,4 FNAME(J) = BAFILE(J) 145 CONTINUE 6 SECURE = BASEC CARTDG = BACART TYPE = BATYPE FIRST = .TRUE. GO TO 220 C C 137 SPFILI = .FALSE. BATCH = .TRUE. FIRST = .TRUE. FILOPN = .FALSE. CALL RWNDF(IDCB,IERR) OK = 0 WRITE(TTY,140) 140 FORMAT("/DXREF: SUPPRESS FILE NAME REPORTING ? _") READ(TTY,410)OK IF(OK .EQ. 1HY)SPFILI = .TRUE. C C READ NEXT RECORD FROM BATCH FILE C 150 CALL READF(IDCB,IERR,BLOCK,15,LENGTH) IF(IERR .LT. 0)GO TO 160 BREG = LENGTH * 2 C C GET OUT IF EOF FOUND C IF(LENGTH .LT. 0)GO TO 175 IF(.NOT.FIRST)CALL CLOSE(DCB) FIRST = .FALSE. OPFLG = 0 GO TO 215 C C PROCESS READF ERROR C 160 WRITE(TTY,170)IERR 170 FORMAT("/DXREF: READF ERROR "I3" IN BATCH FILE") C C EOF OR READ PROBLEM IN BATCH FILE C 175 BATCH = .FALSE. CALL CLOSE(IDCB) GO TO 185 C C COME HERE ON 'BREAK' C 180 FMOD = .FALSE. IFTIME = 0 IF(REPEAT)OPFLG = 1 IF(.NOT. BATCH)GO TO 200 185 CALL CLOSE(DCB) FILOPN = .FALSE. GO TO 202 C C ASK OPERATOR FOR INPUT LU/FILE NAME AND PARSE. C 200 IF(BATCH)GO TO 150 202 IF(ONETIM)WRITE(TTY,205) 205 FORMAT("/DXREF: ('CO' => CHANGE OPTIONS: '::' TO STOP)") ONETIM = .FALSE. WRITE (TTY,210) 210 FORMAT ("/DXREF: ENTER INPUT FILE NAME (LU): _") REG=REIO (1,ITTY,BLOCK,-20) IF(BREG.EQ.1.AND.BLOCK.EQ.1H:.AND.FILOPN)GO TO 220 IF(BREG.EQ.1.AND.BLOCK.EQ.1H:.AND.BATCH)GO TO 137 IF(BREG.NE.1. OR.BLOCK.NE.1H:)GO TO 206 WRITE(TTY,203) 203 FORMAT(" NO FILE CURRENTLY OPEN") GO TO 202 206 FILENM = .FALSE. BATCH = .FALSE. IF(BREG.EQ.2.AND.BLOCK.EQ.2HCO)GO TO 114 C C CHECK FOR TERMINATE REQUEST C IF (BLOCK .EQ. 2H::) GO TO 850 IF (BLOCK .EQ. 2H/E .AND. BREG .EQ. 2) GO TO 850 IF (BREG .EQ. 0) GO TO 850 CALL CLOSE(DCB) 215 FILOPN = .FALSE. ISTRC = 1 =g CALL NAMR(PBUF,BLOCK,BREG,ISTRC) ASSIGN 220 TO JRTN ITYPE = IAND(PBUF4,3) GO TO 20 220 IF(FNAME .EQ. 0)GO TO 850 IF(FILOPN)CALL RWNDF(DCB) IF(OPFLG.EQ.1)GO TO 240 GO TO 370 C C ASK FOR LIST OPTION AND SPECIAL SEARCH OPTIONS C 240 OPFLG = 0 IF(REPEAT)OPFLG = 1 IF(FTIME)GO TO 250 IF(.NOT. LLI)GO TO 280 250 WRITE(TTY,260) 260 FORMAT("/DXREF: LIST OPTION : ENT, EXT, BOTH, OR NONE _") READ(TTY,270)SUPFLG 270 FORMAT(A2) IF(FTIME)GO TO 290 280 IF(.NOT. LMO)GO TG 310 290 WRITE(TTY,300) 300 FORMAT("/DXREF: ENTER MODULE NAME FILTER" #6X"( - = DON'T CARE): _") CALL FILTR(TTY,IFILT,LIFILT) IF(FTIME)GO TO 320 310 IF(.NOT. LEN)GO TO 340 320 WRITE(TTY,330) 330 FORMAT("/DXREF: ENTER ENTRY POINT NAME FILTER" *" ( - = DON'T CARE): _") CALL FILTR(TTY,ENFLT,LENFLT) IF(FTIME)GO TO 350 340 IF(.NOT. LEX)GO TO 370 350 WRITE(TTY,360) 360 FORMAT("/DXREF: ENTER EXTERNAL NAME FILTER" *4X"( - = DON'T CARE): _") CALL FILTR(TTY,EXFLT,LEXFLT) C C OPEN THE FILE AND CHECK ITS TYPE & CARTRIDGE. C 370 FTIME = .FALSE. IF(FNAME.LE.255)GO TO 480 C C IF SEC. CODE GIVEN, OPEN EXCLUSIVELY C OPTION = 1 IF (SECURE .NE. 0) OPTION = 0 IF(FILOPN)GO TO 450 CALL OPEN (DCB,ERROR,FNAME,OPTION,SECURE,CARTDG) IF (ERROR .LT. 0) GO TO 430 FILOPN = .TRUE. IF(CARTDG.GT.0)GO TO 390 CALL LOCF(DCB,IDUM,IDUM,IDUM,IDUM,IDUM,JLU) CALL FSTAT(ILUST) DO 380 JK=1,31 JJ = (JK-1)*4 + 1 IF(JLU.NE.ILUST(JJ))GO TO 380 CARTDG = ILUST (JJ + 2) GO TO 390 380 CONTINUE C C FILE IS NOW OPEN. CHECK IF IN BATCH C 390 IF(BATCH .AND. FIRST)GO TO 125 IF(ERROR.EQ.TYPE.OR.ERROR.EQ.5)GO TO 450 C C IGNORE FILE IF NOT TYPE 5 OR NOT EXPLICITLY STATED (BATCH) C IF(.NOT.BATCH) GO TO 395 ASSIGN 200 TO IRTN LTYPE = ERROR ij WRITE(TTY,392) 392 FORMAT("FILE NOT PROCESSED") GO TO 460 C C IF NOT IN BATCH AND FILE TYPE NOT 5 OR SUPPLIED C ASK IF WE CAN USE AS BATCH FILE. C 395 WRITE(TTY,400) FNAME,ERROR 400 FORMAT("/DXREF: FILE ",4A2," IS TYPE ",I5,". OK TO USE AS" #" BATCH FILE ? _") READ (TTY,410) OK 410 FORMAT(A1) IF(OK.EQ.1HY)GO TO 125 C C IF NOT BATCH FILE, HOW ABOUT 'DXREFING' IT. C WRITE(TTY,420) 420 FORMAT("/DXREF: OK TO PROCESS THEN ? _") READ (TTY,410) OK IF(OK.EQ.1HY)GO TO 450 GO TO 200 430 WRITE (TTY,440) ERROR,FNAME 440 FORMAT (" FMGR ERROR ",I4," OPENING ",4A2,".") GO TO 200 450 NAMCNT = 0 INITA = 300 LTYPE = ERROR ASSIGN 480 TO IRTN C C CHECK IF WE'RE SUPPRESSING FILE NAME REPORTING C IF(SPFILI)GO TO 480 460 CALL CODE WRITE (LFNBUF,470) FNAME,SECURE,CARTDG,LTYPE IACRT = -1 CALL ASCII(CARTDG,IACRT) IF(IACRT .EQ. 2H )GO TO 465 LFNBUF(16) = 2H: LFNBUF(17) = 2H LFNBUF(18) = IACRT 465 IF (TTY .EQ. LP)GO TO 468 IF(LINES .GT. 1)CALL EXEC(3,LP+1100B,-1) CALL EXEC(2, LP,LFNBUF,21) 468 CALL EXEC(2,TTY,LFNBUF,21) 470 FORMAT (" * FILE NAME: ",4A2,":",I5,":",I5,":",I5) LINES = 1 GO TO IRTN C C GET AN INPUT RECORD. C 480 IF (IFBRK(IDUMMY) .NE. 0) GO TO 180 IF (FNAME .LE. 255) GO TO 490 CALL READF (DCB,ERROR,BLOCK,64,LENGTH) IF(ERROR .GE. 0)GO TO 500 WRITE(TTY,485)ERROR,FNAME 485 FORMAT("/DXREF: READF ERROR "I3" IN "4A2) GO TO 200 490 REG=EXEC (1,300B+FNAME,BLOCK,64) C C CHECK FOR EOF C ICHK = IAND(240B,AREG) IF(ICHK.NE.0)GO TO 200 500 IF (LENGTH .NE. -1) GO TO 510 IFTIME = 0 GO TO 200 C C SKIP ZERO(0) LENGTH RECORD C 510 IF (LENGTH .EQ. 0) GO TO 480 C C CHECK FOR "DBL" (DATA BLOCK) RECORD. C RTYPE=IAND (BLOCK2,160000B) IF (RTYPE .EQ. 60000B) GO TO 480 C C CHECK FOR "NAM" RECORD. C IF(RTYPE.NE.20000B.AND.ISKIP.EQ.0)GO TO 480 IF (RTYPE .NE. 20000B) GO TO 560 NAMCNT=NAMCNT+1 ENTFL = .FALSE. EXTFL = .FALSE. ISKIP = -1 C C FILTER MODULES FOR SELECTIVE LISTING C IF(IFILT .EQ. 0)GO TO 520 CALL NAMCK(BLOCK4,5,IFILT,LIFILT,ISKIP) IF(ISKIP.EQ.0)GO TO 480 520 BLOCK=(BLOCK/256) C C SAVE NAME INFO FOR LATER PRINT OUT C DO 530 I=1,BLOCK NAM(I) = BLOCK(I) 530 CONTINUE FMOD = .TRUE. FENT = .TRUE. FEXT = .TRUE. ENREC= .FALSE. EXREC= .FALSE. IF (NAM .LT. 18)NAM(18) = 20040B LNPROG=BLOCK7 NBPALL=BLOCK8 NCMMON=BLOCK9 LSTENT=1 LSTEXT=1 DO 550 I=1,INITA DO 540 J=1,3 ENTS(J,I)=20040B EXTS(J,I)=20040B 540 CONTINUE 550 CONTINUE GO TO 480 C C CHECK FOR "ENT" RECORD. C 560 IF (RTYPE .NE. 40000B) GO TO 600 IF(ENTFL)GO TO 480 IF(.NOT.ENREC) FENT = .FALSE. ENREC = .TRUE. NUMBER=IAND(BLOCK2,17B) DO 590 I=1,NUMBER ISUBSC=4*I IF(ENFLT .EQ. 0)GO TO 570 CALL NAMCK(BLOCK(ISUBSC),5,ENFLT,LENFLT,ENSKP) IF(ENSKP .EQ. 0)GO TO 590 570 IF(SUPFLG.EQ.2HEX.OR.SUPFLG.EQ.2HNO)GO TO 585 DO 580 J=1,3 ENTS(J,LSTENT)=BLOCK(J-1+ISUBSC) IF (J .EQ. 3) ENTS(J,LSTENT)=IOR(IAND(ENTS(J,LSTENT),177400B),40B) 580 CONTINUE LSTENT=LSTENT+1 FENT = .TRUE. C C CHECK FOR ARRAY OVERFLOW C IF(LSTENT .LT. 300)GO TO 590 ENTFL = .TRUE. GO TO 830 585 FENT = .TRUE. 590 CONTINUE GO TO 480 C C CHECK FOR "EXT" RECORD. C 600 IF (RTYPE .NE. 100000B) GO TO 640 IF(EXTFL)GO TO 480 IF(.NOT.EXREC) FEXT = .FALSE. EXREC = .TRUE. NUMBER=IAND(BLOCK2,37B) DO 630 I=1,NUMBER ISUBSC=4+3*(I-1) IF(EXFLT .EQ. 0)GO TO 610 CALL NAMCK(BLOCK(ISUBSC),5,EXFLT,LEXFLT,EXSKP) IF(EXSKP .EQ. 0)GO TO 630 610 IF (SUPFLG.EQ.2HEN.OR.SUPFLG.EQ.2HNO)GO TO 625 DO 620 J=1,3 EXTS(J,LSTEXT)=BLOCK(J-1+ISUBSC) IF (J .EQ. 3) EXTS(J,LSTEXT)=IOR(IAND(EXTS(J,LSTEXT),177400B),40B) 620 CONTINUE LSTEXT=LSTEXT+1 FEXT = .TRUE. C C CHECK FOR ARRAY OVERFLOW C IF(LSTEXT .LT. 300)GO TO 630 EXTFL = .TRUE. GO TO 830 625 FEXT = .TRUE. 630 CONTINUE GO TO 480 C C CHECK FOR "EMA" RECORD. C 640 IF (RTYPE .NE. 140000B) GO TO 645 BLOCK6 = IOR(40B,IAND(BLOCK6,77400B)) DO 642 I=1,3 LEMA(I) = BLOCK(I+3) 642 CONTINUE MSEGSZ = IAND(BLOCK7,13B) EMASZ = IAND(BLOCK2,17777B) GO TO 480 C C CHECK FOR "END" RECORD. C 645 IF (RTYPE .NE. 120000B) GO TO 810 LSTENT=LSTENT-1 LSTEXT=LSTEXT-1 CALL ALPHD(ENTS,LSTENT) CALL ALPHD(EXTS,LSTEXT) NLINES=4 IF (LSTENT .GT. NLINES) NLINES=LSTENT IF (LSTEXT .GT. NLINES) NLINES=LSTEXT C C CHECK TO SEE IF WE SKIP PRINTOUT C C SET THE 'PRINT OUT FLAG' FALSE FOR THE FOLLOWING CONDITIONS C C 1. IF NO RECORD OF THAT TYPE FOUND C AND C 2. A FILTER WAS SPECIFIED => FLAG = .FALSE. C IF(.NOT.ENREC .AND. ENFLT .NE. 0)FENT = .FALSE. IF(.NOT.EXREC .AND. EXFLT .NE. 0)FEXT = .FALSE. IF(FMOD .AND. FENT .AND. FEXT)GO TO 650 GO TO 480 650 IF(IFTIME .GT. 0)GO TO 680 IFTIME = 1 IF(.NOT.SPFILI)GO TO 660 ASSIGN 660 TO IRTN GO TO 460 660 WRITE(LP,670) 670 FORMAT(/3X,"MODULE",37X,"ENTRY PTS",5X,"EXTERNALS"/, *3X,"------",37X,"---------",5X,"---------" ) 680 WRITE (LP,690) NAMCNT,(NAM(I),I=4,6),(NAM(J),J=10,17), *(NAM(K),K=18,NAM) 690 FORMAT (1X,I3,2X,3A2,",",I3,",",I5,",",I1,",",I4,4(",",I2), *2(/12X,30A2)) LINES = LINES + 6 IF(NAM .GT. 48)LINES = LINES + 1 DO 770 I=1,NLINES L = 2H * IF (LSTEXT .LT. I .AND. LSTENT .LT. I)L=20040B IF (IFBRK(IDUMMY) .NE. 0) GO TDO 180 IF (LNPROG .EQ. 0) GO TO 710 WRITE (LP,700)LNPROG,L,(ENTS(J,I),J=1,3),L,(EXTS(K,I),K=1,3),L 700 FORMAT (11X"PROGRAM LENGTH (IN WORDS)=",I5,A2,4X,3A2,2X,A2,4X, #3A2,2X,A2) LNPROG=0 LINES = LINES + 1 GO TO 770 710 IF (NCMMON .EQ. 0) GO TO 730 WRITE (LP,720)NCMMON,L,(ENTS(J,I),J=1,3),L,(EXTS(K,I),K=1,3),L 720 FORMAT (21X,"WORDS IN COMMON="I5,A2,4X,3A2,2X,A2,4X,3A2,2X,A2) NCMMON=0 LINES = LINES + 1 GO TO 770 730 IF (NBPALL .EQ. 0) GO TG 745 WRITE (LP,740)NBPALL,L,(ENTS(J,I),J=1,3),L,(EXTS(K,I),K=1,3),L 740 FORMAT(16X"BASE PAGE ALLOCATION="I5,A2,4X,3A2,2X,A2,4X,3A2,2X,A2) NBPALL=0 LINES = LINES + 1 GO TO 770 745 IF (EMASZ .EQ. 0) GO TO 750 WRITE(LP,748)LEMA,MSEGSZ,EMASZ,L,(ENTS(J,I),J=1,3),L, $(EXTS(K,I),K=1,3),L 748 FORMAT(5X"EMA BLOCK "3A2"(MSEG="I2")="I5" PAGES"A2,4X,3A2,2X,A2, $4X,3A2,2X,A2) EMASZ=0 LINES = LINES + 1 GO TO 770 750 IF (LSTEXT .LT. I .AND. LSTENT .LT. I)GO TO 770 WRITE (LP,760) ((ENTS(J,I),J=1,3),(EXTS(K,I),K=1,3)) LINES = LINES + 1 760 FORMAT (43X,"*",4X,3A2,3X,"*",4X,3A2,3X,"*") 770 CONTINUE C C SET INITIALIZE COUNTER TO ONLY WHAT WAS USED C INITA = NLINES C C AND RESET 'FOUND' FLAGS C FMOD = .FALSE. LINES = LINES + 2 IF(LSTENT.EQ.0.AND.LSTEXT.EQ.0)GO TO 790 WRITE (LP,780) 780 FORMAT (13X,30("* "),/) GO TO 480 790 WRITE(LP,800) 800 FORMAT(/) GO TO 480 C C UNDEFINED RECORD TYPE INDICATED HERE. C 810 WRITE (LP,820) BLOCK2 820 FORMAT (" RECORD TYPE ",K6," NOT PROCESSED.") GO TO 480 830 WRITE(TTY,840)ENTFL,EXTFL GO TO 480 840 FORMAT(" ENT("L1") OR EXT("L1") ARRAY OVERFLOW (300 MAX)") C C ORDERLY DEPARTURE. C 850 CALL CLOSE (DCB) IF(BATCH)CALL CLOSE (IDCB) IF(LINES .GT. 0 .AND. LP .NE. TTY)CALL EXEC(3,LP+1100B,-1) WRITE (TTY,860 ) 860 FORMAT ("$END DXiREF.") END SUBROUTINE FILTR(TTY,IFILT,LEN) +,24999-16246 REV.2024 791009 DIMENSION IB(2),IFILT(6) INTEGER TTY,BREG,AREG EQUIVALENCE (IB(2),BREG),(IB(1),REG,AREG) C C INITIALIZE IFILT C DO 100 I=1,6 IFILT(I) = 2H-- 100 CONTINUE C REG = REIO(1,TTY+400B,IFILT,-12) LEN = BREG IODD = (BREG/2)+1 IF(MOD(BREG,2).NE.0)IFILT(IODD)=IOR(IFILT(IODD),55B) C DO 110 I=1,IODD IF(IFILT(I) .NE. 2H--)RETURN 110 CONTINUE IFILT = 0 RETURN END SUBROUTINE ASCII(BINARY,IA) +, REV.1929 790720 C C THIS ROUTINE PERFORMS TWO(2) FUNCTIONS: C C 1. CHECK THE CONTENTS OF A WORD TO ENSURE BOTH BYTES C ARE UPPER CASE PRINTING ASCII, IF EITHER BYTE FAILS C TWO ASCII BLANKS (20040B) WILL BE SENT BACK TO THE C CALLER. THIS MODE IS INVOKED BY SETTING THE SECOND C PARAMETER TO -1 WHEN CALLED. C C 2. GIVEN A BINARY VALUE. CHECK FOR UPPER AND LOWER CASE C PRINTING ASCII, IF NOT, SET THE OFFENDING BYTE TO AN C ASCII BLANK. C INTEGER BINARY,RBYTE RBYTE = IAND(BINARY,377B) LBYTE = IAND(BINARY,77400B) IF(IA .NE. -1)GO TO 10 IF(RBYTE .LT. 40B .OR. RBYTE .GT. 137B)GO TO 5 IF(LBYTE .LE. 20000B .OR. LBYTE .GE. 60000B)GO TO 5 IA = BINARY RETURN 5 IA = 20040B RETURN 10 IF(RBYTE.LT.40B.OR.RBYTE.GT.176B)RBYTE = 40B IF(LBYTE.LT.20000B)LBYTE = 20000B IF(LBYTE.GE. 77400B)LBYTE = 20000B IA = IOR(LBYTE,RBYTE) RETURN END END$ ASMB,R,B,L,C NAM ALPHD,7 REV.1939 790928 * DOES AN ALPHABETIC SORT ON 3-WORD FIELD IN (NAMES) IFILE FIELDS LONG. * (A BUBBLE SORT METHOD IS USED.) * CALLED FROM FTN BY: CALL ALPHA(NAMES,IFILE) ENT ALPHD EXT .ENTR NAMES BSS 1 IFILE BSS 1 ALPHD NOP JSB .ENTR ESTABLISH ADDRESSES DEF NAMES LDA IFILE,I SET -NUMBL]ER OF NAMES CMA,INA AS COUNTER STA CNTR1 * * LOOP1 SETS ADDRESSES AND POINTERS FOR FIRST FIELD * CHECKS FOR END OF SORT * LOOP1 EQU * LDA CNTR1 SET NEW INDEX ADA IFILE,I INTO NAME ARRAY MPY D3 (3 WORDS/NAME) ADA NAMES STA ADDR1 SAVE THE ADDRESS STA PNTR1 AND AS A POINTER LDA CNTR1 CPA D0 CHECK FOR NONE LEFT JMP OUT OR ZERO INITIALLY INA SZA,RSS JMP OUT DONE !!! STA CNTR2 CNTR2=CNTR1 + 1 * * LOOP2 SETS ADDRESSES AND POINTERS FOR SECOND FEILD * LOOP2 EQU * LDA CNTR2 COMPUTE ADDRESS OF ADA IFILE,I SECOND FIELD MPY D3 ADA NAMES STA ADDR2 STA PNTR2 LDA DM3 SET UP COUNTER FOR FIELD STA CNTR3 COMPARISION LDA ADDR1 LOOP3 EQU * START THE COMPARISION LDB ADDR2,I CMB,INB NAME1 - NAME2 < 0 ? ADB A,I INA NEXT WORD OF NAME1 ISZ ADDR2 NEXT WORD OF NAME2 SSB NAME1 < NAME2 ? JMP END2 PROPER ORDER SZB SAME ? JMP SWTCH NO, SWITCH IT. ISZ CNTR3 IF FIRST WORDS = JMP LOOP3 CONTINUE LOOP JMP END2 ALL FIELDS ARE =. SWTCH EQU * LDA DM3 SET UP FOR 3 WORD STA CNTR4 SWITCH LDA ADDR1 1ST NAME STA PNTR1 SAVE FOR LOOP LOOP4 EQU * LDA PNTR1,I START SWAP LOOP LDB PNTR2,I SWP STA PNTR1,I STB PNTR2,I ISZ PNTR1 BUMP ADDRESS FOR NAME1 ISZ PNTR2 BUMP ADDRESS FOR NAME2 ISZ CNTR4 DONE? JMP LOOP4 NO END2 EQU * YES ISZ CNTR2 DONE WITH LOOP2 JMP LOOP2 NOPE. ISZ CNTR1 ALL DONE JMP LOOP1 OUT EQU * YES, GET OUT JMP ALPHD,I CNTR1 BSS 1 CNTR2 BSS 1 CNTR3 BSS 1 CNTR4 BSS 1 PNTR1 BSS 1 yPNTR2 BSS 1 ADDR1 BSS 1 ADDR2 BSS 1 D0 DEC 0 DM3 DEC -3 D3 DEC 3 A EQU 0 END ASMB,R,B,L,C NAM COMMA,7 REV A 751031 * * FRI 31 OCT 75 WRITTEN BY DONALD H. POTTENGER REV A * ENT COMMA EXT .ENTR * THIS SUBROUTINE, GIVEN AN ADDRESS AND LENGTH OF A BUFFER, * WILL CHECK FOR IMBEDDED COLONS AND REPLACE THEM WITH COMMAS * FOR THE SYSTEM PARSE ROUTINE. THIS HAS OBVIOUS ADVANTAGES * FOR THE USER WHO IS USED TO USING COLONS AS DELIMITERS AS IN * THE FILE MANAGER NAMR PARAMATERS. * * THE BUFFER CAN BE ANY LENGTH AND SHOULD SPECIFY * THE NUMBER OF CHARACTERS IN THE BUFFER. * BUFAD NOP BUFFER ADDRESS BUFLA NOP BUFFER LENGTH COMMA NOP WHERE IT ALL BEGINS JSB .ENTR GO GET THE ADDRESSES DEF BUFAD OF THE PARAMATERS LDA BUFLA,I HOW ABOUT THE LENGTH? CLE,ERA IS IT AN ODD CHARACTER COUNT? SEZ NO, ITS ALL READY TO GO INA YES, INCREASE THE WORD COUNT BY ONE CMA,INA LET'S MAKE IT NEG. FOR COUNTING STA BUFL AND SAVE IT SZA,RSS IS IT A ZERO LENGTH BUFFER? JMP COMMA,I WELL GET THE HECK OUT OF HERE THEN. START LDA BUFAD,I ORIGINAL NAME HUH ? STA TEMP LET'S GET A WORD AND GET ON WITH IT AND M177 HOW ABOUT THE LOW BYTE? CPA LOCOL A COLON? JMP LFIX YES, GO MAKE IT A COMMA PAR1 LDA TEMP NO, PREPARE TO CONTINUE AND M774 THIS TIME LOOK AT THE HI BYTE CPA HICOL A COLON? JMP HFIX YES, GO MAKE IT A COMMA JMP TERM1 NO, LETS SAVE WHAT WE HAVE AND GO ON LFIX LDA TEMP GET ORIGINAL WORD ADA M16 MAKE THAT COLON A COMMA STA TEMP AND SAVE JMP PAR1+1 GO CHECK HI BYTE HFIX LDA TEMP GET PRESENT VALUE ADA M7000 MAKE THE HI BYTE COLON A COMMA RSS AND SAVE IN ORIGINAL BUFFER TERM1 LDA TEMP D LETS GET THE CURRENT VALUE STA BUFAD,I AND SAVE IN ORIGINAL BUFFER ISZ BUFAD INCREMENT THE BUFFER ADDRESS ISZ BUFL ANY MORE WORDS? JMP START YES, HERE WE GO AGIAN JMP COMMA,I NOPE, LETS GET OUT!! SKP * * CONSTANTS AND STORAGE * BUFL NOP TEMP NOP M177 OCT 177 M774 OCT 77400 LOCOL OCT 72 HICOL OCT 35000 M16 OCT -16 M7000 OCT -7000 END ASMB,R,L * 1730 HRS THU 14 JUN 79 NAM NAMCK,7 REV. 1924 790614 CHECK FILE NAME ENT NAMCK EXT .ENTR * * THIS SUBROUTINE RETURNS A FLAG (0,-1) TO DL DEPENDING * ON HOW A GIVEN STRING(KNOWN AS THE FILTER) COMPARES TO ANOTHER * STRING(KNOWN AS THE FILE NAME). * * CALLING SEQUENCE: * * CALL NAMCK(IBUF,ICHAR,JBUF,JCHAR,IFLAG) * * WHERE: * IBUF = THE FILE NAME TO BE CHECKED * ICHAR= NO. OF CHARACTERS IN IBUF * JBUF = SMALLER BUFFER CONTAINING SEARCH FILTER * JCHAR= NO. OF CHARCTERS IN JBUF * IFLAG= -1 IF STRING FOUND; 0 IF NOT FOUND * * VARIABLE DEFINITION: * * BADDR = BYTE ADDRES FOR INPUT BUFFER * SADDR = BYTE ADDRES FOR INPUT FILTER BUFFER * ICNT = -(NUMBER CHARACTERS IN SOURCE BUFFER) * JCNT = -(NUMBER CHARACTERS LEFT IN SEARCH FILTER) * STGCT = CHAR. COUNT IN CURRENT STRING CHECK BUFFER * Y-REG = CHECK STRING BUFFER ADDRESS * * IBUF NOP FILE NAME BUFFER ICHAR NOP NO. OF CHAR. IN IBUF JBUF NOP FILTER STRING JCHAR NOP NO. OF CHAR. IN JBUF IFLAG NOP IFLAG SET TO -1 IF STRING FOUND NAMCK NOP ENTRY POINT JSB .ENTR DEF IBUF CLA CLEAR STA STGCT CURRENT STRING COUNTER STA PLSFG RESET PLUS FLAG CCA SET OUTER CMPAR LOOP STA OUTLG TO ONE TIME LDA ICHAR,I GET FILE NAME BUFFER LGTH. CMA,INkiA SET NEG. STA ICNT AND SAVE LOCAL LDA JCHAR,I GET THE FILTER LENGTH CMA MAKE NEGITIVE STA JCNT SAVE COUNTER (-1) LDA IBUF RAL STA BADDR SAVE AS BYTE ADDRESS LDB JBUF RBL STB SADDR SAVE THE BYTE ADD. FOR FILTER NXBT ISZ JCNT CHECK FOR END OF FILTER BUFFER RSS JMP DONE DONE THEN LBT GET THE NEXT FILTER CHAR. CPA APLUS CHECK FOR PLUS JMP PLUS CPA AMINS CHECK FOR '-'S JMP MINUS LDA STGCT CHECK FOR BEGINNING SZA OF A STRING JMP NX.1 LDY SADDR YES, SO SAVE FILTER BUFFR ADD. IN Y LDX BADDR AND THE SOURCE BUFFR ADD. IN X NX.1 ISZ STGCT BUMP STRING COUNTER ADA ICNT CHECK FOR POSSIBLE STRING CHECK SSA,RSS OVER RUN JMP DONE IF ABOUT TO OVER RUN-GO CHECK JMP NXBT GO GET NEXT BYTE SPC 2 * MINUS ISZ BADDR BUMP SOURCE STRING BUFFER POINTER LDA STGCT CHECK IF STRING CHECK PENDING SZA JMP MIN.1 YES, SO GO DO IT ISZ SADDR BUMP FILTER BUFFER ADD TOO. ISZ ICNT ANY CHARATERS LEFT ? JMP NXBT YES, SO GET NECT BYTE JMP EXFND NO, SO EXIT FOUND SPC 1 MIN.1 STB SADDR SAVE THE FILTER BUFFER POINTER LDA PLSFG CHECK FOR "+" FLAG SZA,RSS SET ? JMP MIN.2 YES LDA ICNT FORM OUTER LOOP COUNTER ADA STGCT OUTLG = ICNT + STGCT SSA,RSS SEE IF LEGAL LOOP COUNTER JMP EXNFD NO, SEE EXIT NOT FOUND STA OUTLG OK, SAVE MIN.2 JSB CHECK GO CHECK STRING INA BUMP SOURCE BUFFER STA BADDR ADDRESS LDB SADDR CLA RESET THE '"+"' STA PLSFG FLAG CMA AND THE OUTER STA OUTLG LOOP COUNTER LDA ICNT INA JMP NXT GO3 CLEAN UP SPC 1 PLUS STB SADDR SAVE FILTER BUFFER POINTER LDA STGCT SEE IF CURRENT STRING SZA TO PROCESS JMP PL.1 YES STB PLSFG NO, SET '"+"' HAS OCCURED FLAG JMP NXBT NO, SO JUST GET NEXT BYTE PL.1 LDA PLSFG CHECK FOR '"+"' FLAG SZA,RSS JMP PL.2 FLAG NOT SET SO SET TO ONE TIME * LDA ICNT SET OUTER LOOP COUNTER ADA STGCT TO CHECK ALL OF BUFFER ADA M1 SSA,RSS CHECK IF 1 CMPAR WILL DO. PL.2 CCA YES, SO SET OUTER LOOP TO -1 STA OUTLG SAVE OUTER LOOP COUNTER JSB CHECK STA PLSFG SET '"+"' FLAG NON ZERO JMP CONT * * CHECK STRING * CHECK NOP ENTER CHECK ROUTINE HERE AGAIN CXA GET SOURCE BUFFER ADD. FROM X-REG. CYB GET FILTER ADD. FROM Y-REG. CBT STGCT CMPAR STRING JMP CHECK,I RETURN TO CALLER NOP ISZ OUTLG SEE IF WE ARE DONE RSS NO, JMP EXNFD YES, GO SET NOT FOUND FLAG * ISX BUMP SOURCE BUFFER ADDRESS ISZ ICNT AND SOURCE CHAR. COUNT JMP AGAIN AND GO AGAIN * EXNFD CLA STA IFLAG,I JMP NAMCK,I AND RETURN * CONT STA BADDR SAVE THE SOURCE BUFFER ADD. LDB SADDR RESTORE FILTER BUFFER POINTER LDA ICNT UPDATE CHAR COUNT NXT ADA STGCT SSA,RSS JMP EXCHK STA ICNT CLA RESET THE STRING STA STGCT COUNTER LDA JCNT SSA JMP NXBT JMP EXFND * EXCHK LDA JCNT SSA JMP EXNFD * EXFND CCA STA IFLAG,I JMP NAMCK,I * DONE LDA STGCT CEHCK IF PENDING STRING SZA,RSS JMP EXFND NO, SO JUST EXIT FOUND LDA PLSFG CHECK FOR PLUS FLAG SZA,RSS JMP DN.1 LDA ICNT STA OUTLG SAVE LOOP COUNTER ADA STGCT CHECK FOR ILLEGAL STRING LENGTH pljf SZA,RSS CHECK FOR ZERO JMP *+3 IF STGCT + ICNT <= 0 SSA,RSS AND NEGITIVE NUMBER JMP EXNFD PLUS NUMBER: NO GOOD DN.1 JSB CHECK YES, SO GO CHECK STRING JMP EXFND STRING FOUND * * CONSTANTS AND STORGE PLSFG NOP PLUS FLAG SET BADDR NOP SOURCE STRING ADD. POINTER SADDR NOP FILTER STRING ADD. POINTER OUTLG NOP OUTER LOOP COUNTER ICNT NOP SOURCE CHAR. COUNT JCNT NOP FILTER CHAR. COUNT STGCT NOP CURRENT STRING COUNTER M1 DEC -1 AMINS OCT 55 APLUS OCT 53 END Bl f} 24999-18247 1938 S 0100 &SCB              H0101 .lFTN4,L C C PROGRAM: SCB C C WRITTEN BY: CARL E. DAVIDSON - 110278 C HEWLETT-PACKARD C DATA SYSTEMS DIVISION C CUPERTINO, CALIFORNIA C C MODIFIED 2-13-79, TO NOT PRINTOUT PASSWORD C C C C DESCRIPTION C ----------- C C THIS PROGRAM DUMPS THE SESSION CONTROL BLOCK (SCB) CONTENTS C FOR A SPECIFIED SESSION TO THE SESSION CONSOLE OR OTHER C DESIGNATED LIST DEVICE. C C C INSTRUCTIONS C ------------ C C SCB IS SCHEDULED AS FOLLOWS: C C RU,SCB[,LIST[,SESID]] C C WHERE: C C LIST = DESTINATION LOGICAL UNIT FOR SCB LISTING C (DEFAULT IS SESSION CONSOLE) C C SESID = SESSION IDENTIFIER FOR DESIRED SCB C (DEFAULT IS CURRENT SESSION) C C C ENVIRONMENT AND RESOURE REQUIREMENTS C ------------------------------------ C C SCB OPERATES ONLY IN THE RTE-IV SESSION MONITOR ENVIRONMENT C AND REQUIRES THE FOLLOWING EXTERNAL SUBROUTINES/FUNCTIONS: C C NAME DESCRIPTION C ---- ----------- C C IGETB BYTE GET UTILITY C MOVCA BYTE MOVE UTILITY C BLANC FILLS WORDS W BLANKS C JASC BINARY TO ASCII C GTSAD GETS SCB ADDRESS C C C PROGRAM SCB(3,75),24999-16247 REV.1938 790213 IMPLICIT INTEGER(A-Z) INTEGER BUFR(200),PARM(5),FRMT(50),DCB(144),ARECD(128) INTEGER USER(5),GROUP(5),PASS(5) LOGICAL SHALF CALL RMPAR(PARM) LIST=PARM(1) IF(LIST.EQ.0) LIST=LOGLU(DMY) LOG=LOGLU(DMY) C C IF REQUESTED SCB IS FOR OTHER THAN THE CURRENT SESSION, C GET SCB ADDRESS. C SESID=PARM(2) IF(SESID.EQ.0) GO TO 1 CALL GTSAD(SESID,ADRES) IF(ADRES.EQ.-1) WRITE(LOG,100) IF(ADRES.EQ.-1) GO TO 8000 IF(ADRES.EQ.0) WRITE(LOG,400)PARM(2) 400 FORMAT(/,X,"SYSTEM LU#",I3," NOT LOGGED ON") IF(ADRES.EQ.0) GO TO 9001 ADRES=ADRES+15 C C GET CONTENTS OF SESSION CONTqROL BLOCK. C 1 CALL GTSCB(BUFR,200,LEN,ADRES) IF(LEN.EQ.-1) WRITE(LOG,100) IF(LEN.EQ.-1) GO TO 8000 100 FORMAT(/,X,"** SCB RUNS UNDER SESSION ONLY **") C C OPEN ACCOUNTS FILE. C CALL OPEN(DCB,ERROR,6H+@CCT!,1,-31178) IF(ERROR.LT.0) WRITE(LOG,500)ERROR 500 FORMAT(/,X,"FMP ERROR ",I4," IN SCB WHILE OPENING ACCOUNTS FILE") IF(ERROR.LT.0) GO TO 8000 C C COMPUTE ACCOUNT FILE RECORD NUMBER FOR RECORD CONTAINING C DIRECTORY ENTRY FOR SESSION'S ACCOUNT. C CALL READF(DCB,ERROR,ARECD,128,LTH,1) IF(ERROR.LT.0) WRITE(LOG,600)ERROR 600 FORMAT(/,X,"FMP ERROR ",I4," IN SCB WHILE READING FROM ACCOUNTS" C" FILE") IF(ERROR.LT.0) GO TO 8000 BASE=ARECD(5) ORDNL=BUFR(2)+1 REC=BASE+(ORDNL/8)-1 IF(MOD(ORDNL,8).NE.0) REC=BASE+(ORDNL/8) C C GET RECORD CONTAINING DIRECTORY ENTRY FOR SESSION'S ACCOUNT. C CALL READF(DCB,ERROR,ARECD,128,LTH,REC) IF(ERROR.LT.0) WRITE(LOG,600)ERROR IF(ERROR.LT.0) GO TO 8000 C C COMPUTE ENTRY NUMBER (1-8) IN CURRENT RECORD CONTAINING 16-WORD C DIRECTORY ENTRY FOR SESSION'S ACCOUNT. C ENTRY=MOD(ORDNL,8) IF(MOD(ORDNL,8).EQ.0) ENTRY=8 C C MOVE 16-WORD DIRECTORY ENTRY INTO FIRST 16 WORDS OF ARRAY "ARECD". C CALL MOVCA(ARECD(16*ENTRY-15),1,ARECD(1),1,32) C C GET USER AND GROUP NAMES FOR SESSION'S ACCOUNT. C NUSR=IGETB(ARECD(1),1) CALL BLANC(USER(1),5) CALL MOVCA(ARECD(2),1,USER(1),1,NUSR) NGRP=IGETB(ARECD(1),2) CALL BLANC(GROUP(1),5) CALL MOVCA(ARECD(7),1,GROUP(1),1,NGRP) C C GET PASSWORD FROM SESSION'S USER ACCOUNT ENTRY. C SHALF=.FALSE. IF(ARECD(15).LT.0) SHALF=.TRUE. IF(ARECD(15).LT.0) ARECD(15)=IAND(ARECD(15),77777B) CALL READF(DCB,ERROR,ARECD,128,LTH,ARECD(15)) IF(ERROR.LT.0) WRITE(LOG,600)ERROR IF(ERROR.LT.0) GO TO 8000 IF(SHALF) CALL MOVCA(ARECD(65),1,ARECD(1),1,128) NPAS=IGETB(ARECD(1),2) v CALL BLANC(PASS(1),5) IF(NPAS.NE.0) CALL MOVCA(ARECD(2),1,PASS(1),1,NPAS) IF(NPAS.EQ.0) NPAS=2 C C DUMP USER NAME, GROUP NAME AND PASSWORD TO LIST DEVICE. C CALL EXEC(3,1100B+LIST,-1) WRITE(LIST,700)USER,GROUP,BUFR(1) 700 FORMAT(3X,"USER: ",5A2,X,"GROUP: ",5A2 C/,3X,"CURRENTLY LOGGED ONTO SYSTEM LU#",I3) C C DUMP SCB LIST HEADER TO LIST DEVICE. C WRITE(LIST,200) 200 FORMAT(/,3X,"-SCB-",11X,"-----DECIMAL------",/, C3X,"INDEX OCTAL UPPER LOWER WORD ASCII",9X, C"DESCRIPTION",/, C3X,"----- ------- ----- ----- ------ -----",2X,25("-")) C C INITIALIZE FORMAT SPECIFICATIONS ARRAY. C CALL CODE WRITE(FRMT,300) 300 FORMAT("(5X,I2,3X,@6,4X,I3,3X,I3,X,I6,4X,A2,2X,") C C DUMP SCB CONTENTS TO LIST DEVICE. C DO 150 I=1,LEN INDEX=I+2 UPPER=IGETB(BUFR(I),1) LOWER=IGETB(BUFR(I),2) ASCII=BUFR(I) C C IF UPPER OR LOWER BYTE CONTAINS NON-PRINTING ASCII CHARACTERS C REPLACE WITH A BLANK BEFORE OUTPUT. C IF((UPPER.LT.40B).OR.(UPPER.GT.176B)) C ASCII=IAND(ASCII,377B)+20000B IF((LOWER.LT.40B).OR.(LOWER.GT.176B)) C ASCII=IAND(ASCII,177400B)+40B C C MASK DESCRIPTION INFORMATION FOR CURRENT SCB ENTRY INTO C FORMAT SPECIFICATIONS ARRAY. C DO 5 J=21,50 5 FRMT(J)=2H IF(INDEX.NE.3) GO TO 15 CALL MOVCA(24H5X,"SESSION IDENTIFIER"),1,FRMT(20),2,24) GO TO 99 15 IF(INDEX.NE.4) GO TO 20 CALL MOVCA(29H3X,"ACCT. DIRECTORY ENTRY #"),1,FRMT(20),2,29) GO TO 99 20 IF(INDEX.NE.5) GO TO 25 CALL MOVCA(22H6X,"CAPABILITY LEVEL"),1,FRMT(20),2,22) GO TO 99 25 IF((INDEX.LT.6).OR.(INDEX.GT.9)) GO TO 30 CALL MOVCA(20H7X,"ERROR MNEMONIC"),1,FRMT(20),2,20) GO TO 99 30 IF((INDEX.LT.10).OR.(INDEX.GT.11)) GO TO 35 CALL MOVCA(15H9X,"CPU USAGE"),1,FRMT(20),2,15) GO TO 99 35 IF(INDEX.NE.12) GO TO 40 CALL MOVCA(14H10X,"USER ID"),1q,FRMT(20),2,14) GO TO 99 40 IF(INDEX.NE.13) GO TO 45 CALL MOVCA(15H10X,"GROUP ID"),1,FRMT(20),2,15) GO TO 99 45 IF(INDEX.NE.14) GO TO 50 CALL MOVCA(16H9X,"DISC LIMIT"),1,FRMT(20),2,16) GO TO 99 50 IF(INDEX.NE.15) GO TO 55 CALL MOVCA(18H8X,"- SST LENGTH"),1,FRMT(20),2,18) GO TO 99 55 IF((INDEX.LT.16).OR.(INDEX.GT.-BUFR(13)+15)) GO TO 65 IF(BUFR(I).NE.-1) GO TO 60 CALL MOVCA(15H9X,"SST SPARE"),1,FRMT(20),2,15) GO TO 99 60 CALL MOVCA(29H2X,"SYS LU# / SES LU# "),1,FRMT(20),2,29) CALL JASC(UPPER+1,FRMT,51,3) CALL JASC(LOWER+1,FRMT,64,3) GO TO 99 65 IF(INDEX.NE.-BUFR(13)+16) GO TO 70 CALL MOVCA(21H6X,"- DISC CAPACITY"),1,FRMT(20),2,21) GO TO 99 70 IF(BUFR(I).NE.0) GO TO 75 CALL MOVCA(16H9X,"DISC SPARE"),1,FRMT(20),2,16) GO TO 99 75 CALL MOVCA(30H2X," / / LU# "),1,FRMT(20),2,30) IF(IAND(BUFR(I),40000B).NE.40000B) GO TO 80 CALL MOVCA(5HGROUP,1,FRMT(27),1,5) GO TO 85 80 CALL MOVCA(7HPRIVATE,1,FRMT(26),2,7) 85 IF(IAND(BUFR(I),100000B).NE.100000B) GO TO 90 CALL MOVCA(5HADDED,1,FRMT(22),2,5) GO TO 95 90 CALL MOVCA(5HEXIST,1,FRMT(22),2,5) 95 DLU=IAND(BUFR(I),377B) CALL JASC(DLU,FRMT,65,3) 99 WRITE(LIST,FRMT)INDEX,BUFR(I),UPPER,LOWER,BUFR(I),ASCII 150 CONTINUE GO TO 9000 8000 WRITE(LOG,800) 800 FORMAT(/,X,"SCB ABORTED") GO TO 9001 9000 CALL EXEC(3,1100B+LIST,-1) CALL EXEC(3,1100B+LIST,-1) 9001 WRITE(LOG,900) 900 FORMAT(X,"$END SCB") END END$ ASMB HED ** S/P IGETB (21MX ONLY) F. GAULLIER 07/SEP/77 NAM IGETB,7 . 92903-16001 REV.1805 760907 * * SOURCE 92903-18020 * SPC 2 ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PWROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** SPC 2 EXT .ENTR ENT IGETB * * THIS PROGRAM GETS A BYTE IN A STRING, RIGHT JUSTIFIED * THE RETURNED WORD : - RIGHT : THIS BYTE * - LEFT : ALL ZERO * DM1 DEC -1 * .BUFF NOP BUFFER ADDRESS .N NOP REL. ADDR. OF BYTE * IGETB NOP JSB .ENTR DEF .BUFF LDB .BUFF CLE,ELB ADB DM1 ADB .N,I LBT JMP IGETB,I * END ASMB HED ** S/P MOVCA (21MX ONLY) F. GAULLIER 07/SEP/77 NAM MOVCA,7 . 92903-16001 REV.1805 760907 * * SOURCE 92903-18040 * SPC 2 ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** SPC 2 EXT .ENTR ENT MOVCA SUP * * THIS PROGRAM MOVES A STRING * 21MX INSTRUCTIONS ARE USED * DM1 DEC -1 * .BUF1 NOP .N1 NOP .BUF2 NOP .N2 NOP .NC NOP * MOVCA NOP JSB .ENTR DEF .BUF1 * LDA .BUF1 CLE,ELA ADA DM1 ADA .N1,I LDB .BUF2 CLE,ELB ADB DM1 ADB .N2,I MBT .NC,I JMP MOVCA,I END ASMB HED S/P BLANC (21MX ONLY) PS 24/08/77 NAM BLANC,7 . 92903-16001 REV.1805 770824 * * SOURCE 92903-18006 * SPC 2 ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OU\T THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** SPC 2 EXT .ENTR ENT BLANC * * THIS ROUTINE BLANKS A BUFFER * BUF NOP NMOT NOP * BLANC NOP JSB .ENTR DEF BUF CCA ADA NMOT,I SSA JMP BLANC,I STA NMOT LDB BL STB BUF,I INIT. FIRST WORD SZA,RSS JMP BLANC,I LDA BUF STA 1 INB MVW NMOT JMP BLANC,I * BL OCT 20040 END FTN4 SUBROUTINE JASC(IVAL,IBUF,JBYT .,NBYTE),. 92903-16001 REV.1805 770721 C C SOURCE 92903-18031 C C C C ************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C ************************************************************** C C C********************************************************************* C* * C* THIS SUBROUTINE IS USED TO CONVERT ANY INTEGER * C* NUMBER (POSITIVE OR NEGATIVE) IN AN ASCII STRING . * C* * C* PARAMETERS : * C* * C* IVAL : INTEGER VALUE * C* IBUF : BUFFER TO STORE ASCII STRING * C* IBYT : FIRST BYTE # TO STORE STRING * C* IF IBYT IS NEGATIVE LEADING BLANKS IN * C* STRING ARE CHANGED TO ZEROS * C* NBYTE : # OF BYTES OF THE STRING  * C* * C********************************************************************* C C DIMENSION IBUF(1),ITEMP(3) C IBYT=JBYT IF(JBYT.LT.0) IBYT=-JBYT IF((IBYT.LT.1).OR.(NBYTE.LT.1)) RETURN CALL BLAN(IBUF,IBYT,NBYTE) JVAL=IVAL IF(IVAL.LT.0) JVAL=-IVAL CALL CNUMD(JVAL,ITEMP) DO 100 I=1,6 IF(IGET1(ITEMP,I).NE.1H ) GO TO 200 100 CONTINUE 200 IF(IVAL.GE.0) GO TO 300 I=I-1 CALL PUTCA(ITEMP,1H-,I) 300 IF(7-I.GT.NBYTE) RETURN CALL MOVCA(ITEMP,I,IBUF,IBYT+NBYTE-7+I,7-I) IF(JBYT.GT.0) RETURN DO 350 K=IBYT,IBYT+NBYTE-1 IF(IGET1(IBUF,K).EQ.1H ) CALL PUTCA(IBUF,1H0,K) 350 CONTINUE RETURN END END$ ASMB,L * * UTILITY SUBROUTINE: GTSAD * * WRITTEN BY: CARL E. DAVIDSON - 112978 * * * DESCRIPTION * ----------- * * GTSAD IS A FORTRAN CALLABLE SUBROUTINE WHICH RETURNS THE SCB * STARTING ADDRESS ASSOCIATED WITH THE SESSION IDENTIFIER PASSED * BY THE CALLER. * * * CALLING SEQUENCE * ---------------- * * CALL GTSAD(SESID,ADDR) * * WHERE: * * SESID = SESSION IDENTIFIER * * ADDR = SCB ADDRESS RETURNED HERE * (SET TO: 0 IF SESID NOT LOGGED ON, * -1 IF NOT IN SESSION) * * NAM GTSAD,7 GET SCB ADDRESS UTILITY - 112978 ENT GTSAD EXT $SHED,.ENTR,$SMVE PARAM BSS 2 GTSAD NOP JSB .ENTR GET CALLER'S PARAMETER ADDRESSES DEF PARAM LDA PARAM,I GET SESSION IDENTIFIER STA SESID LDA PARAM+1 GET CALLER'S ADDRESS ADDRESS STA SCBAD CLA CLEAR CALLER'S ADDRESS PARAMETER STA SCBAD,I LDA $SHED GET SCB LIST HEAD ADDRESS STA NXADR SZA ARE WE IN SESSION? JMP NXSCB YES, ALL'S WELL CCA NO, SET CALLER'S ADDRESS PARAMETER STA SCBAD,I 0.* TO -1 JMP GTSAD,I AND EXIT. NXSCB JSB $SMVE GET FIRST FOUR WORDS DEF RETRN OF NEXT SCB. DEF READ (READ) DEF NXADR (NEXT SCB ADDRESS) DEF OFFST (BEGINNING WITH FIRST WORD) DEF SCB (INTO BUFFER "SCB") DEF NWRDS (4 WORDS) RETRN LDA SCB+3 GET SESSION ID FOR THIS SCB CPA SESID IS THIS THE ONE WE'RE LOOKING FOR? JMP GTCHA YES LDA SCB NO, GET NEXT SCB'S ADDRESS STA NXADR SZA IS THIS THE END OF THE LIST? JMP NXSCB NO, GET NEXT SCB JMP GTSAD,I YES, THAT'S ALL FOLKS! GTCHA LDA NXADR RETURN SCB ADDRESS TO CALLER STA SCBAD,I AND JMP GTSAD,I EXIT. * * PROGRAM CONSTANTS * SESID BSS 1 CALLER'S SESSION IDENTIFIER SCBAD BSS 1 CALLER'S ADDRESS PARM. ADDRESS NXADR BSS 1 ADDRESS OF NEXT SCB IN LIST READ DEC 1 $SMBE OP CODE (1=READ, 2=WRITE) OFFST DEC 0 $SMVE BUFFER OFFSET SCB BSS 4 $SMVE BUFFER NWRDS DEC 4 $SMVE NUMBER OF WORDS TO MOVE END GTSAD (C0 g t 24999-18248 1938 S 0100 &VERIF              H0101 ZFTN4,L PROGRAM VERIF(3,80),24999-16248 REV.1938 790921 INTEGER CLIST(125),AGAIN,DBEOF DIMENSION IDCB1(144),IDCB2(144),IBUF1(128),IBUF2(128) DIMENSION IP(5),NAME1(9),NAME2(9) DIMENSION INF1(6),INF2(6),MCR(3),MTYPE(5) COMMON IBUF1,IBUF2 EQUIVALENCE (IP(1),LUI),(IP(2),LUO),(NAME1(4),INF1), $(NAME2(4),INF2),(IP(3),IDBUG),(IP(4),DBEOF) C DATA MCR/2H O,2HN ,2HCR/,MTYPE/2H T,2HYP,2HE ,2HIS,2H / C CALL RMPAR(IP) IF(LUI.EQ.0) LUI = 1 IF(LUO.EQ.0) LUO = LUI IREC = 0 IANS = 0 ITERR = 0 WRITE(LUI,2) 2 FORMAT(" /VERIF: REV 1938"/) C 5 CALL FNAME(NAME1,ISC,ICR,LUI,ITYPE) C IF(NAME1 .GT. 77B)GO TO 20 C IF(NAME1 .LE. 0)GO TO 999 CALL DCBDM(IDCB1,NAME1,ITYPE) NAME1(3) = KCVT(NAME1) NAME1(1) = 2HLU NAME1(2) = 2H # DO 10 I=1,5 INF1(I) = MTYPE(I) 10 CONTINUE INF1(6) = ITYPE IF(ITYPE .EQ. 0)ITYPE = 2HAS GO TO 30 C 20 IF(NAME1 .EQ. 2H::)GO TO 999 CALL OPEN(IDCB1,IERR,NAME1,1,ISC,ICR) IF(IFMGR(IERR,8,LUI,NAME1))5,22 22 IF(ICR .NE. 0)GO TO 25 C C OPEN THE FILE AND CHECK ITS TYPE & CARTRIDGE. C CALL LOCF(IDCB1,IDUM,IDUM,IDUM,IDUM,IDUM,JLU) CALL FSTAT(CLIST) DO 24 JK=1,31 JJ = (JK-1)*4 + 1 IF(JLU.NE.CLIST(JJ))GO TO 24 ICR = CLIST (JJ + 2) GO TO 25 24 CONTINUE C 25 DO 35 I=1,3 INF1(I) = MCR(I) 35 CONTINUE CALL CNUMD(ICR,INF1(4)) C 30 IF(IANS .EQ. 2HYE)GO TO 60 31 CALL FNAME(NAME2,ISC,ICR,LUI,ITYPE) C IF(NAME2 .GT. 77B)GO TO 50 C IF(NAME2 .LE. 0)GO TO 999 CALL DCBDM(IDCB2,NAME2,ITYPE) NAME2(3) = KCVT(NAME2) NAME2(1) = 2HLU NAME2(2) = 2H # DO 40 I=1,5 INF2(I) = MTYPE(I) 40 CONTINUE INF2(6) = ITYPE IF(ITYPE .EQ.0)ITYPE = 2HAS GO TO 60 C 50 IF(NAME2 .EQ. 2H::)GO TO 999 CALL OPEN(IDCB2,IERRu,NAME2,1,ISC,ICR) IF(IFMGR(IERR,8,LUI,NAME2))30,52 52 IF(ICR .NE.0)GO TO 55 C C OPEN THE FILE AND CHECK ITS TYPE & CARTRIDGE. C CALL LOCF(IDCB2,IDUM,IDUM,IDUM,IDUM,IDUM,JLU) CALL FSTAT(CLIST) DO 54 JK=1,31 JJ = (JK-1)*4 + 1 IF(JLU.NE.CLIST(JJ))GO TO 54 ICR = CLIST (JJ + 2) GO TO 55 54 CONTINUE C 55 DO 56 I=1,3 INF2(I) = MCR(I) 56 CONTINUE CALL CNUMD(ICR,INF2(4)) C 60 IF(IANS .EQ. 2HYE .AND. LEN2 .EQ. -1)GO TO 65 CALL READF(IDCB1,IERR,IBUF1,128,LEN1) IF(IERR .NE. -12)GO TO 62 LEN1 = -1 GO TO 64 62 IF(IFMGR(IERR,11,LUI,NAME1))999,64 64 IF(LEN1 .EQ. 0)GO TO 60 IF(IANS .EQ. 2HYE)GO TO 68 C 65 CALL READF(IDCB2,IERR,IBUF2,128,LEN2) IF(IERR .NE. -12)GO TO 66 LEN2 = -1 GO TO 67 66 IF(IFMGR(IERR,11,LUI,NAME2))999,67 67 IF(LEN2 .EQ. 0)GO TO 65 IF(IANS .EQ. 2HYE)GO TO 68 IREC = IREC +1 68 IANS = 0 IF(IFBRK(IDUM))999,70 C 70 IF(LEN1.NE.LEN2) GO TO 700 C IF(LEN1)200,80,80 C 80 NDERR = 0 IEOF = 0 DO 100 I=1,LEN1 C IF(IBUF1(I).NE.IBUF2(I)) NDERR = NDERR + 1 C 100 CONTINUE IF(NDERR .NE.0)GO TO 800 GO TO 60 C 200 IFILE = IFILE + 1 IF(ITERR.EQ.0)GO TO 490 WRITE(LUI,220)NAME1,NAME2,ITERR IF(LUI.NE.LUO)WRITE(LUO,220)NAME1,NAME2,ITERR 220 FORMAT(" /VERIF: ",9A2," IS DIFFERENT FROM"/ $ 10X,9A2," IN ",I5," RECORDS.") IF(DBEOF.NE.0)WRITE(LUI,230)IFILE 230 FORMAT(" FILE # ",I5) GO TO 999 490 IF(DBEOF.EQ.0)GO TO 495 IF(IEOF .EQ. 1)GO TO 495 WRITE(LUI,230)IFILE IEOF = 1 GO TO 60 495 WRITE(LUI,500) 500 FORMAT(/" COMPARE GOOD") GO TO 999 C 700 IEOF = 0 IF(LEN1 .NE. -1) GO TO 760 ASSIGN 5 TO AGAIN IF(LUI.NE.LUO)WRITE(LUO,740)NAME1 WRITE(LUI,740)NAME1 WRITE(LUI,742) 740 FORMAT(/" /VERIF: EOF READ ON ",9A2) 742 FORMAT(" CONTINUE COMPARISON ? _") 745 READ(LUI,750)IANS 750 FORMAT(A2) IF(IANS .EQ. 2HYE)GO TO AGAIN IF(DBEOF .NE. 0)GO TO 999 GO TO 200 760 IF(LEN2 .NE. -1)GO TO 770 ASSIGN 31 TO AGAIN IF(LUI.NE.LUO)WRITE(LUO,740)NAME2 WRITE(LUI,740)NAME2 WRITE(LUI,742) GO TO 745 770 WRITE(LUI,515)IREC,NAME1,LEN1,NAME2,LEN2 IF(LUI.NE.LUO)WRITE(LUO,515)IREC,NAME1,LEN1,NAME2,LEN2 515 FORMAT(" /VERIF: RECORD LENGTH UNEQUAL, RECORD #",I5, 1/2(/1X,9A2," LENGTH = ",I3)/) IF(IDBUG .NE. 0)CALL DMPAL(NAME1,NAME2,LEN1,LEN2,LUO) ITERR = ITERR + 1 GO TO 60 C 800 WRITE(LUI,520)NDERR,IREC IF(LUI.NE.LUO)WRITE(LUO,520)NDERR,IREC 520 FORMAT(" /VERIF: "I5" DATA COMPARE ERRORS, RECORD #",I5/) IF(IDBUG .NE. 0)CALL DMPAL(NAME1,NAME2,LEN1,LEN2,LUO) ITERR = ITERR + 1 GO TO 60 C 999 IF(NAME1 .GT. 77B)CALL CLOSE(IDCB1) IF(NAME2 .GT. 77B)CALL CLOSE(IDCB2) END SUBROUTINE FNAME(NAME,ISC,ICR,LUI,ITYP) INTEGER PBUF(4,8),IPBUF(33) DIMENSION IBUF(10),IREG(2),NAME(3) EQUIVALENCE (IB,IREG(2)),(X,IREG),(PBUF,IPBUF) DATA IBUF/10*2H / C C WRITE(LUI,500) 500 FORMAT("FILE NAME OR LU,(FORMAT) _") X = REIO(1,LUI+400B,IBUF,-20) IF(IBUF.EQ.2H::)GO TO 999 CALL COMMA(IBUF,IB) CALL PARSE(IBUF,IB,PBUF) 999 DO 20 J=1,3 NAME(J)=PBUF(J+1,1) 20 CONTINUE C C IF LU IS SPECIFIED SET SECOND PARAM. TO TYPE FORMAT C IF(PBUF .EQ. 2) GO TO 50 ITYP = PBUF(2,2) RETURN C C FILE SPECIFIED SO, SET THE SECURITY CODE AND CARTRIDGE # C 50 ISC = PBUF(2,2) ICR = PBUF(2,3) RETURN END SUBROUTINE DCBDM(IDCB,LU,ITYPE) DIMENSION IDCB(144) C C CLEAR THE DCB TO ZEROES. C DO 10 I=1,144 10 IDCB(I) = 0 C C WHAT TYPE OF DEVICE IS THIS DCB FOR ? C CALL EXEC(13,LU,IDEV) C IDEV = IAND(IDDEV,37400B)/256 C IF(IDEV.EQ.0) GO TO 100 IF(IDEV.EQ.1) GO TO 200 IF(IDEV.EQ.5) GO TO 100 IF(IDEV.EQ.11B) GO TO 200 IF(IDEV.EQ.15B) GO TO 500 IF(IDEV.EQ.23B) GO TO 600 C C UNRECOGNIZED DEVICE TYPE C SET IDCB(1) TO -1 & RETURN TO CALLER. C IDCB(1) = -1 RETURN C C FOR DVR00 CRT C 100 IDCB(7) = 100001B GO TO 350 C C FOR DVR01 PHOTO READER C 200 IDCB(7) = 100000B 350 IDCB(6) = 1 IDCB(5) = 1000B + LU GO TO 1000 C C FOR DVR15 MARK SENSE READR C 500 IDCB(7) = 100000B IDCB(6) = 1 IDCB(5) = 100B + LU GO TO 1000 C C FOR DVR23 9 TRACK MAG TAPE C 600 IDCB(7) = 100001B IDCB(6) = 100001B IDCB(5) = 100B + LU IDCB(4) = 100B + LU IF(ITYPE .EQ. 0)IDCB(4) = LU GO TO 1001 C C FINISH THIS SET UP. C 1000 IDCB(4) = LU IF(ITYPE.EQ.2HBA) IDCB(4) = LU + 2300B IF(ITYPE.EQ.2HBR) IDCB(4) = LU + 300B IF(ITYPE.EQ.2HBN) IDCB(4) = LU + 100B C 1001 IDCB(10) = IGET(1717B) C END SUBROUTINE DMPAL(NAME1,NAME2,LEN1,LEN2,LU) C 1200 HRS THU 07 APR 77 DIMENSION IBUF1(128),IBUF2(128),NAME1(9),NAME2(9) DIMENSION ITEMP(37),IASC(9) COMMON IBUF1,IBUF2 EQUIVALENCE (ITEMP(29),IASC) C 1 FORMAT(" ") WRITE(LU,10)NAME1 10 FORMAT(1X,9A2/) C DUMP RECORD OF NAME1 C DO 773 J=1,LEN1,8 L = J + 7 IF(L .GT. LEN1)L=LEN1 C DO 766 K=1,37 ITEMP(K) = 20040B 766 CONTINUE CALL CODE WRITE(ITEMP,1766)(IBUF1(K),K=J,L) CALL ASCII(IBUF1(J),8) CALL CODE WRITE(IASC,1767)(IBUF1(K),K=J,L) WRITE(LU,1768)ITEMP 773 CONTINUE C WRITE(LU,1) WRITE(LU,10)NAME2 C DUMP RECORD OF NAME2 C DO 883 J=1,LEN2,8 L = J + 7 IF(L .GT. LEN2)L=LEN2 C DO 866 K=1,37 ITEMP(K) = 20040B 866 CONTINUE CALL CODE P WRITE(ITEMP,1766)(IBUF2(K),K=J,L) CALL ASCII(IBUF2(J),8) CALL CODE WRITE(IASC,1767)(IBUF2(K),K=J,L) WRITE(LU,1768)ITEMP 883 CONTINUE WRITE(LU,1) RETURN C 1766 FORMAT(8(1X,K6)) 1767 FORMAT("*",8A2) 1768 FORMAT(37A2) END END$ ASMB,R,L,B,C HED ** FILE MANAGER ERROR PROCESSOR ** NAM IFMGR,7 ENT IFMGR EXT EXEC,.ENTR * * THIS FUNCTION CHECKS FOR FILE MANAGER ERRORS. IF THE ERROR * CODE IS < 0, THE ERROR MESSAGE IS PRINTED ON THE SPECIFIED TTY. * * IF ID IS >= 0, THE ERROR CODE IS RETURNED AS THE FUNCTION VALUE. * * IF ID IS < 0 AND THE ERROR CODE IS < 0, THEN THE PROGRAM IS * ABORTED. * * FORTRAN USEAGE EXAMPLE: * IF (IFMGR (IERR,ID,LTTY,NAME)) 100,200 * * ASSEMBLY CALLING SEQUENCE * JSB IFMGR * DEF *+4 * DEF IERR * DEF ID * DEF LTTY * DEF NAME * ON RETURN A = IERR * * WHERE THE USER SUPPLIED VARIABLES ARE: * * IERR = ERROR PARAMETER RETURNED FROM FILE MANAGER CALL. * ID = CALL IDENTITY CODE (NEGATIVE TO ABORT IF ERROR EXISTS) * 1 = APOSN * 2 = CLOSE * 3 = CREAT * 4 = FCONT * 5 = FSTAT * 6 = LOCF * 7 = NAMF * 8 = OPEN * 9 = POSNT * 10 = PURGE * 11 = READF * 12 = RWNDF * 13 = WRITF * LTTY = LOGICAL UNIT NUMBER OF DEVICE TO LIST ERROR * NAME = NAME OF FILE THAT HAD ERROR * * PARAMETER ADDRESSES * IERR NOP ERROR CODE ID NOP FILE MANAGER CALL ID LTTY NOP LOGICAL UNIT TO OUTPUT ERROR MESSAGES. NAME NOP NAME OF FILE THAT HAD ERROR IFMGR NOP JSB .ENTR USE .ENTR TO GET DEF IERR ADDRESSES OF PARAMETERS LDA IERR,I GET ERROR CODE SSA,RSS FILE MANAGER ERROR? JMP IFMGR,I NO,RETURN TO USER * * ERROR - CONVERT ERROR TO ASCII AND PUT IT INTO OUTPUT BUFFER * MPY M1 MULTIPLY ERROR BY -1 & THEN d DIV .10 DIVIDE BY TEN TO GET TENS DIGIT. STA ERROR SAVE TEMPORARILY MPY .10 MULTIPLY BY 10 AND DIVIDE BY DIV .1 .1 TO GET TENS VALUE ONLY ADA IERR,I ADD ERROR CODE,RESULT = - UNITS CMA,INA MAKE UNITS POSITIVE LDB ERROR GET TENS DIGIT BLF,BLF ROTATE IT TO HIGH BYTE OF WORD IOR B OR IT WITH UNITS IOR ASC00 OR IN ASCII CONSTANT STA ERROR PUT ASCII ERROR CODE IN MSG BUFFER * * ADD CALL ID AND FILE NAME TO BUFFER * LDA ID,I GET ID CODE SSA IS IT NEGATIVE? CMA,INA YES - MAKE POSITIVE STA B IS CODE ADB M14 GREATER SSB,RSS THAN 13? CLA YES - OUTPUT $$$$$ FOR ID STA B SAVE ERROR CODE ALS MULTIPLY BY 2 AND ADA B ADD IT TO ITSELF (X3) ADA CALL ADD BUFR STARTING ADRS TO OFFSET LDB EMES SET POINTER TO STB PNTR ID NAME CLB SET FLAG TO INDICATE NAME STB FLAG BUFFER HAS TO BE TRANSFERRED. NFILE LDB M3 SET COUNTER TO STB CNTR TRANSFER 3 WORDS LOOP LDB A,I GET ID WORD & PUT IT STB PNTR,I IN ERROR MESSAGE BUFFER INA ILNDEX ID AND ISZ PNTR ERROR MESSAGE POINTERS ISZ CNTR TRANSFER COMPLETE? JMP LOOP NO - TRANSFER NEXT WORD LDB FLAG SZB NAME ARRAY TRANSFERRED? JMP LP1 YES - OUTPUT MESSAGE ISZ FLAG NO - SET FLAG TO SAY YES LDA NAME GET ADDRESS OF ARRAY IN A LDB NAMEB PUT OUTPUT BUFFER STB PNTR ADDRESS IN B JMP NFILE TRANSFER FILE NAME * * PUT IN PROGRAM NAME * LP1 LDB 1717B ADB .12 LDA B,I STA PRGNM INB LDA B,I STA PRGNM+1 INB LDA B,I AND M1774 IOR COLON STA PRGNM+2 * * OUTPUT ERROR MESSAGE * OUT JSB EXEC OUTPUT THE ERROR MESSAGE DEF *+5 DEF WRITE DEF LTTY,I DEF PRGNM DEF M40 * * CHECK FOR ABORT PROGRAM * LDA IERR,I PUT ERROR CODE IN CASE WE RETURN LDB ID,I GET ID CODE SSB,RSS DO WE ABORT? JMP IFMGR,I NO - RETURN * * ABORT PROGRAM * JSB EXEC WRITE DEF *+5 "PROGRAM ABORTED!" DEF WRITE ON THE DEF LTTY,I LOCAL TTY DEF ABORT DEF M16 JSB EXEC ASK RTE DEF *+2 TO TERMINATE THE PROGRAM DEF .6 * * CONSTATNTS, STORAGE ALLOCATION, AND MESSAGES * A EQU 0 A REGISTER B EQU 1 B REGISTER * * CONSTANTS * COLON OCT 72 .1 DEC 1 .6 DEC 6 .10 DEC 10 .12 DEC 12 M1 DEC -1 M3 DEC -3 M14 DEC -14 M16 DEC -16 M40 DEC -40 M1774 OCT 177400 * * MISC. CONSTANTS * ASC00 ASC 1,00 WRITE DEC 2 * * CNTR NOP UTILITY COUNTER FLAG NOP ID/NAME TRANSFER FLAG PNTR NOP TRANSFER POINTER TO MESSAGE BUFFER * * FILE MANAGER CALLS * CALL DEF *+1 SUP PRESS THE GARBAGE ASC 3,$$$$$ ID1 ASC 3,APOSN ID2 ASC 3,CLOSE ID3 ASC 3,CREAT ID4 ASC 3,FCONT ID5 ASC 3,FSTAT ID6 ASC 3,LOCF ID7 ASC 3,NAMF ID8 ASC 3,OPEN ID9 ASC 3,POSNT ID10 ASC 3,PURGE ID11 ASC 3,READF ID12 ASC 3,RWNDF ID13 ASC 3,WRITF * * ERROR MESSAGE * PRGNM BSS 3 ASC 1, ERMES BSS 3 ASC 4,ERROR - ERROR NOP ASC 5, IN FILE NAM. BSS 3 NAMEB DEF NAM. EMES DEF ERMES * * ABORT ERROR MESSAGE ABORT ASC 8,PROGRAM ABORTED! * * * END ASMB,R,B,L,C NAM COMMA,7 REV A 751031 * * FRI 31 OCT 75 WRITTEN BY DONALD H. POTTENGER REV A * ENT COMMA EXT .ENTR * THIS SUBROUTINE, GIVEN AN ADDRESS AND LENGTH OF A BUFFER, * WILL CHECK FOR IMBEDDED COLONS AND REPLACE THEM WITH COMMAS * FOR THE SYSTEM PARSE ROpUTINE. THIS HAS OBVIOUS ADVANTAGES * FOR THE USER WHO IS USED TO USING COLONS AS DELIMITERS AS IN * THE FILE MANAGER NAMR PARAMATERS. * * THE BUFFER CAN BE ANY LENGTH AND SHOULD SPECIFY * THE NUMBER OF CHARACTERS IN THE BUFFER. * BUFAD NOP BUFFER ADDRESS BUFLA NOP BUFFER LENGTH COMMA NOP WHERE IT ALL BEGINS JSB .ENTR GO GET THE ADDRESSES DEF BUFAD OF THE PARAMATERS LDA BUFLA,I HOW ABOUT THE LENGTH? CLE,ERA IS IT AN ODD CHARACTER COUNT? SEZ NO, ITS ALL READY TO GO INA YES, INCREASE THE WORD COUNT BY ONE CMA,INA LET'S MAKE IT NEG. FOR COUNTING STA BUFL AND SAVE IT SZA,RSS IS IT A ZERO LENGTH BUFFER? JMP COMMA,I WELL GET THE HECK OUT OF HERE THEN. START LDA BUFAD,I ORIGINAL NAME HUH ? STA TEMP LET'S GET A WORD AND GET ON WITH IT AND M177 HOW ABOUT THE LOW BYTE? CPA LOCOL A COLON? JMP LFIX YES, GO MAKE IT A COMMA PAR1 LDA TEMP NO, PREPARE TO CONTINUE AND M774 THIS TIME LOOK AT THE HI BYTE CPA HICOL A COLON? JMP HFIX YES, GO MAKE IT A COMMA JMP TERM1 NO, LETS SAVE WHAT WE HAVE AND GO ON LFIX LDA TEMP GET ORIGINAL WORD ADA M16 MAKE THAT COLON A COMMA STA TEMP AND SAVE JMP PAR1+1 GO CHECK HI BYTE HFIX LDA TEMP GET PRESENT VALUE ADA M7000 MAKE THE HI BYTE COLON A COMMA RSS AND SAVE IN ORIGINAL BUFFER TERM1 LDA TEMP LETS GET THE CURRENT VALUE STA BUFAD,I AND SAVE IN ORIGINAL BUFFER ISZ BUFAD INCREMENT THE BUFFER ADDRESS ISZ BUFL ANY MORE WORDS? JMP START YES, HERE WE GO AGIAN JMP COMMA,I NOPE, LETS GET OUT!! SKP * * CONSTANTS AND STORAGE * BUFL NOP TEMP NOP M177 OCT 177 M774 OCT 77400 LOCOL OCT 72 HICOL OCT 35000 M16 OCT -16 M7000 Ud640OCT -7000 END ASMB,R,B,L,C * 1200 HRS WED 06 APR 77 NAM ASCII,7 MAKES BUFFER LEGEL ASCII CHARACTERS 770406 * ENT ASCII EXT .ENTR * BUFR NOP ASCII BUFFER LEN NOP LENGTH OF BUFFER ASCII NOP ENTRY POINT JSB .ENTR DEF BUFR LDA LEN,I SET UP LOOP CMA,INA COUNTER STA CNTR START LDA BUFR,I GET WORD FROM THE BUFFER AND B177 MASK FOR RIGHT BYTE STA RBYTE SAVE ADA M40 CHECK FOR LEGEL CHAR. SSA,RSS JMP NEXT OK, GO CHECK LEFT BYTE LDA B40 STA RBYTE SET TO ASCII SPACE NEXT LDA BUFR,I GET CURRENT WORD AGAIN AND B7740 MASK FOR HIGH BYTE STA LBYTE SAVE ADA M2000 CHECK FOR LEGALITY SSA,RSS JMP FIN OK LDA B2000 STA LBYTE FIN LDA RBYTE IOR LBYTE STA BUFR,I ISZ BUFR ISZ CNTR JMP START JMP ASCII,I RETURN * * RBYTE NOP LBYTE NOP CNTR NOP * B40 OCT 40 B177 OCT 177 B2000 OCT 20000 B7740 OCT 77400 M40 OCT -40 M2000 OCT -20000 END 6 h v 24999-18295 2024 S 0100 &CMX2L SOURCE             H0101 ASMB,R,Q,C NAM CMX2L,3,99 24999-16295 REV.2024 HED CMX2L EXTERNAL INTERFACE ROUTINES (IO) SUP PRESS EXTRA LISTING * *PROGRAM SECTION AND ROUTINES TO *ESTABLISH COMMUNICATION TO USER *AND HIS FILES. * EXT CLOSE,LOGLU,EXEC,OPENF,LOCF,CREAT,NAMR EXT GETST,PNAME,REIO A EQU 0 B EQU 1 CMX2L NOP JSB LOG GET LOG DEVICE DEF OPRLU SAVE IN OPRLU JSB GETST GET COMMAND STRING DEF *+4 DEF STRNG CHAR BUF FOR INPUT FROM TERM DEF N80 UP TO 80 CHARS IN BUF DEF ERRTN ERROR FLAG LDB ERRTN PUT LENGTH OF STRING IN B LIKE EXEC STB SLONG LENGTH IN CHARS OF ACTUAL READ STB PRMTF SET PROMPT FLAG * NO PROMPT IF ANY COMMAND LINE PARMS LDA P1 INITIAL PARSE START POINT STA ISTRC * *PUT PROGRAM INVOCATION NAME ON TERMINAL MESSAGE LINES * JSB PNAME DEF *+2 DEF PNBUF * *NOW THAT HAVE NAME PUT IN *CMX2L MESSAGES * LDA N8 JSB COPY DBR CMX1+1 DBR CMX2+1 DBR CMX3+1 DBR CMX4+1 DBR CMX5+1 DBR CMX6+1 DBR CMX7+1 * *GET INPUT FILE NAME AND MOVE TO FILE BUF AREA * JSB GTIN INPUT ROUTINE AND PARSER OF FILES DEF FILE1 6 WORD BUF FOR FILENAME FTYPE SC CR DEF PRIN PROMPT MSG START IF NOT IN COMMAND LINE * *OPEN INPUT FIRST * JSB OPNIN * * GET LIST FILE NAME AND MOVE TO BUFFER AREA * JSB GTIN DEF FILE3 DEF PRLST * *OPEN LIST FILE * JSB OPLST * * GET OUTPUT FILE NAME AND MOVE TO BUFFER AREA * JSB GTIN DEF FILE2 DEF PROUT * * OPEN OUTPUT FILE * JSB OPOUT * *OPEN INPUT INCLUDES TYPE CHECK AND REPROMPT FOR SOME ERRORS * * *OPEN LIST FILE * *SAME ROUTINE AS OPEN OUTPUT * * *OPEN OUTPUT INCLUDES CHECK FOR SAME AS INPUT (REPROMPT) * PROMPT FOR OVERWRITE, AND TYPE CHECK * REPROMPT OCCURS EXsLCEPT FOR FMP ERRORS * * *BEGIN MAIN BODY OF PROGRAM HERE * SPC 3 ENT OPRLU ENT CMX1,CMX2,CMX3,CMX4,CMX5,CMX6,CMX7 ENT @NMX1,@NMX2,@NMX3,@NMX4,@NMX5,@NMX6 ENT @NMX7,FLERR,PMSGT,FILE1,IDCB1,IERR1 ENT FILE2,ODCB2,IERR2,BRCE EXT MANLP EXT READF,INLNG,INBUF ENT FILE3,LDCB3,IERR3 EXT @BINB JSB MANLP * *END OF PROGRAM NORMAL CLOSE * EXIT JSB CLOS2 EXIT FROM PROGRAM JSB EXEC DEF *+2 EXIT TO SYSTEM DEF P6 HED GETIN ROUTINE TO GET FILE NAMES FROM TERMINAL * *GETIN * OPERAND 1 ADDRESS TO STORE FILENAME TYPE SC CR * OPERAND 2 PROMPT MESSAGE TO USE IF NULL STRING ON INPUT * NO DEFAULTS ALLOWED * GTIN NOP LDA GTIN,I FIRST PARM ADDRESS ISZ GTIN STEP TO SECOND PARM LDB GTIN,I SECOND PARM ADDRESS ISZ GTIN SET TO RETURN ADDRESS STA @FIL SAVE FILEBUF ADDRESS STB @MSG SAVE MESSAGE ADDRSS * *NOINPUT REPROMPT FOR INPUT FROM TERM * NOIN LDA PRMTF ALLOW DEFAULT 0 LU IF NO PARM GIVEN SZA AND NO PROMPT ALLOWED JMP GTLP DO NOT PROMPT FOR PARM LDA P1 RESET PARSE CHAR COUNT STA ISTRC JSB PMSGT PRINT PROMPT DEF @MSG,I JSB RDTRM READ TERMINAL RESPONSE GTLP JSB NAMRR PARSE INSTRING SSA JMP GTIN,I RETURN USING DEFAULT IF NO PARM GIVEN LDA IPBUF+3 SEE IF NULL PARM WAS INPUT SZA,RSS JMP GTIN,I RETURN USING DEFAULT IF NO PARM GIVEN LDA ADIPB MOVE FILENAME TYPE SC CR (6 WORDS) LDB @FIL JSB .MVW DEF P6 NOP LDB @FIL ADB P3 MASK FOR 2 LSB'S OF TYPE LDA B,I AND =B3 STA B,I JMP GTIN,I NORMAL RETURN HED READ TERMINAL ROUTINE * * READS TERMINAL INTO STRNG * RDTRM NOP JSB REIO READ TERMINAL INTO STRING DEF *+5 DEF P1 DEF OPRLU sDEF STRNG DEF N80 80 CHARS MAX STB SLONG STORE LENGTH IN SLONG JMP RDTRM,I * *LOG ROUTINE * LOG NOP JSB LOGLU GET THE TERMINAL LU DEF *+2 DEF DUMMY IOR M400 MERGE ECHO BIT FOR TERM IO LDB LOG,I SAVE AT OPERAND 1 STA B,I ISZ LOG SET TO RETURN ADDRESS JMP LOG,I RETURN DUMMY DEC 0 * *NAMRR ROUTINE TO PARSE INPUT FILENAMES * NAMRR NOP JSB NAMR DEF *+5 DEF IPBUF DEF STRNG DEF SLONG DEF ISTRC SHOULD BE SET TO 1 FOR FIRST CALL JMP NAMRR,I RETURN HED OPEN INPUT FILE * *OPEN INPUT FILE AND VERIFY TYPE 3 OR 4 IF NOT LU * LU IS OK USE OPENF * OPNIN NOP JSB OPENF OPEN INPUT DEF *+7 DEF IDCB1 INPUT DATA CONTROL BLOCK DEF IERR1 INPUT FILE ERROR FLAG DEF FILE1 FILE NAME DEF OPTIN OPEN OPTION INPUT B610 DEF F1SC SECURITY DEF F1DSC CARTRIGE SSA,RSS ANY ERRORS JMP TYPIN NO CHECK TYPE OF FILE JSB FLERR FLERR NEVER RETURNS! DEF FILE1 FILENAME CAUSING ERROR PARM TYPIN JSB CKINP CHECK INPUT FOR ASMB LINE JMP OPNIN,I ASMB LINE FOUND NORMAL RETURN JSB CLOSE CLOSE FILE CAUSING TYPE ERROR DEF *+2 DEF IDCB1 JSB PMSGT PRINT NO ASMB LINE ERROR MESSAGE DEF ASMBM LDA P0 RESET CHAR COUNT TO FORCE STA ISTRC READ ON NEW DATA BY PARSE LDB PRMTF IF NOT PROMPTING THEN SZB JMP EXIT EXIT * ELSE PROMPT JSB GTIN DEF FILE1 DEF PRIN INPUT FILE PROMPT MESSAGE JMP OPNIN+1 RETRY OPEN INPUT HED OPEN OUTPUT * *OPEN OUTPUT FILE * CHECK FOR SAME NAME AS INPUT * REPROMPT IF SAME NAME * CHECK FOR ALREADY EXISTS * PROMPT FOR GO AHEAD IF EXISTS * CHECK FOR FILE TYPE OF 3 OR 4 OR 0 (LU ONLY) * REPROMPT IF TYPE ERROR * ANY FMP ERROR NOT EXPECTED EXIT PROGRAM * OPOUT NOP * INIT NUMBER OF BLOCKS TO ZERO TO SIGNAL * CLOSE ROUTINE TYPE OF CLOSE TO USE * IF OUTFILE IS NEW * ALLOCATE ALL AVAILABLE SPACE TO IT * AND ON CLOSE TRUNCATE TO ACTUAL FILE SIZE * IF OUTFILE IS OLD * USE EXTENTS FOR EXTRA LENGTH AND USE NORMAL * CLOSE * LDA P0 STA OBLKS *INPUT = OUTPUT CHECK LDA F2 USE COMPARE WORDS INSTRUCTION LDB F1 JSB .CMW DEF P3 INCLUDE ONLY NAME IN THIS CHECK NOP JSB EQUAL NOT LEGAL NOP NOT EQUAL OK * *MAKE SURE NOT SAME AS LIST FILE * LDA F2 LDB F3 JSB .CMW DEF P3 SEE IF NAMES MATCH NOP JSB EQU2L GO CHECK CARTRIGE NUM'S NOP NOT EQUAL OK JSB OPENF OPEN OUTPUT FILE MAY BE AN LU DEF *+7 DEF ODCB2 DEF IERR2 ERROR FLAG FOR OUT FILE DEF FILE2 FILE NAME DEF OUTPN OUTPUT FILE OPTIONS B610 DEF F2SC SECURITY DEF F2DSC CARTRIGE SSA,RSS CHECK ERROR RETURN JMP TST2 NO ERROR ON OPEN CHECK TYPE AND PROMPT CPA N6 SEE IF FILE NOT FOUND JMP CRET CREATE IF FILE NOT PRESENT YET JSB FLERR ELSE FATAL ERROR FLERR EXITS WITHOUT RETURN DEF FILE2 FILE NAME PARM CRET JSB CREAT CREATE FILE SHOULD BE NON EXISTANT DEF *+8 DEF ODCB2 OUTPUT DATA CONTROL BLOCK DEF IERR2 OUTPUT ERROR FLAG DEF FILE2 OUTPUT FILE NAME DEF P20 SIZE = 20 BLOCKS TO START DEF P4 FILE TYPE = SOURCE DEF F2SC SECURITY CODE DEF F2DSC CARTRIGEW SSA,RSS ERROR OR NUMBER OF BLOCKS/2 JMP NOERR JSB FLERR FATAL FILE ERROR DEF FILE2 FILE NAME PARM NOERR CLE,ERA A NOW = BLOCKS STA OBLKS SAVE TOTAL BLOCKS ALOCATED FOR CLOSE ROUTINE JMP OPOUT,I NORMAL RETURN TST2 CPA P0 IF TYPE ZERO FILE JMP OPOUT,I CPA P3 JMP OPRMT PROMPT OVERWRITE OF EXISTANT FILE CPA P4 JMP OPRMT PROMPT OVERWRITE OF EXISTANT FILE JSB CLOSE CLOSE FILE WITH TYPE ERROR DEF *+2 DEF ODCB2 OUTPUT DATA CONTROL BLOCK JSB TYMSG PRINT TYPE ERROR MESSAGE DEF FILE2 FILE NAME PARAMETER LDA P0 FORCE NEW INPUT STA ISTRC * *PROMPT ONLY IF PROMPT FLAG 0 * LDB PRMTF SZB JMP EXIT ELSE EXIT PROGRAM JSB GTIN GET NEW OUTPUT FILENAME DEF FILE2 DEF PROUT PROMPT MESSAGE JMP OPOUT+1 RETRY OUTPUT OPEN * *PROMPT OVERWRITE * * *SEE IF PROMPT FLAG SET BEFORE PRINTING PROMPT * OPRMT LDA PRMTF SZA IF 0 THEN PROMPT JMP OPOUT,I FLAG NOT SET RETURN * *THEN PROMPT BEFORE OVERWRITING * LDA F2 PUT FILENAME IN PROMPT MESSAGE LDB @OVRT JSB .MVW DEF P3 NOP JSB PMSGT PRINT MESSAGE DEF OVRWT JSB RDTRM READ RESPONSE LDA @BSTR SEE IF RESPONSE YES LDB @BYES JSB .CBT DEF P3 ONLY 3 CHARS CHECKED REMAINDER IGNORED NOP JMP OPOUT,I YES NORMAL RETURN EXISTANT FILE NOP JSB CLOSE CLOSE FILE WE DON'T WANT DEF *+2 DEF ODCB2 OUTPUT DATA CONTROL BLOCK LDA P0 FORCE NEW INPUT STA ISTRC JSB GTIN GET NEW OUTPUT FILE DEF FILE2 DEF PROUT MESSAGE FOR PROMPT JMP OPOUT+1 RETRY OPEN OF OUTPUT * *EQUAL RESTART * * *EQUAL INPUT = OUTPUT * EQUAL NOP * *SEE IF CART NUM'S EQUAL * LDA FILE2 IF FILE IS 0 LU ALLOW IT SZA,RSS JMP EQUAL,I ALLOW ZERO LU LDA F2DSC COMPARE CART OF OUT AND IN CPA F1DSC JMP EQERR IF EQUAL THEN ERROR HAS OCCURED SZA,RSS CANNOT ALLOW DEFAULT OF EITHER CAR_{T NUM JMP EQERR LDA F1DSC SZA,RSS JMP EQERR JMP EQUAL,I UNIQUE CART NUM'S YEA * *IF ANY OF THE FILES IS A DUPLICATE *THE RESULT IS EITHER AN INFINITE LOOP *(INPUT = OUT OR LIST) OR GARBAGE *(OUT=LIST) *PRINT ERROR AND PREVENT THIS CONDITION * EQERR JSB PMSGT PRINT ERROR MESSAGE DEF EOFIN MESSAGE FOR EQUAL * *EXIT PROGRAM * JMP EXIT * *HANDLE OUT = LIST CASE * EQU2L NOP LDA FILE2 SZA,RSS IF 0 LU ALLOW JMP EQU2L,I LDA F2DSC CPA F3DSC COMPARE CART NUM OF OUT AND LIST JMP EQERR IF EQUAL ERROR * *NEITHER CART NUM CAN BE DEFAULT 0 * SZA,RSS JMP EQERR LDA F3DSC SZA,RSS JMP EQERR JMP EQU2L,I DIFF CART NUM'S OK! HED OPEN LIST FILE ROUTINE * *OPEN LIST FILE * CHECK FOR SAME NAME AS INPUT * REPROMPT IF SAME NAME * CHECK FOR ALREADY EXISTS * PROMPT FOR GO AHEAD IF EXISTS * AND NOT GIVEN ON THE COMMAND LINE * CHECK FOR FILE TYPE OF 3 OR 4 OR 0 (LU ONLY) * REPROMPT IF TYPE ERROR * ANY FMP ERROR NOT EXPECTED EXIT PROGRAM * OPLST NOP * INIT NUMBER OF BLOCKS TO ZERO TO SIGNAL * CLOSE ROUTINE TYPE OF CLOSE TO USE * IF OUTFILE IS NEW * IF OUTFILE IS OLD * USE EXTENTS FOR EXTRA LENGTH AND USE NORMAL * CLOSE * LDA P0 STA OBLKS *INPUT = OUTPUT CHECK LDA F3 USE COMPARE WORDS INSTRUCTION LDB F1 JSB .CMW DEF P3 INCLUDE ONLY NAME IN THIS CHECK NOP JSB EQULA NOT LEGAL NOP NOT EQUAL OK JSB OPENF OPEN OUTPUT FILE MAY BE AN LU DEF *+7 DEF LDCB3 DEF IERR3 ERROR FLAG FOR OUT FILE DEF FILE3 FILE NAME DEF OUTPN OUTPUT FILE OPTIONS B610 DEF F3SC SECURITY DEF F3DSC CARTRIGE SSA,RSS CHECK ERROR RETURN JMP TST2A NO ERROR ON OPEN CHECK TYPE AND PROMPT CPA N6 W\SEE IF FILE NOT FOUND JMP CRETA CREATE IF FILE NOT PRESENT YET JSB FLERR ELSE FATAL ERROR FLERR EXITS WITHOUT RETURN DEF FILE3 FILE NAME PARM CRETA JSB CREAT CREATE FILE SHOULD BE NON EXISTANT DEF *+8 DEF LDCB3 OUTPUT DATA CONTROL BLOCK DEF IERR3 OUTPUT ERROR FLAG DEF FILE3 OUTPUT FILE NAME DEF P20 SIZE = 20 BLOCKS TO START DEF P4 FILE TYPE = SOURCE DEF F3SC SECURITY CODE DEF F3DSC CARTRIGEW SSA,RSS ERROR OR NUMBER OF BLOCKS/2 JMP NORRE JSB FLERR FATAL FILE ERROR DEF FILE3 FILE NAME PARM NORRE CLE,ERA A NOW = BLOCKS STA OBLKS SAVE TOTAL BLOCKS ALOCATED FOR CLOSE ROUTINE JMP OPLST,I NORMAL RETURN TST2A CPA P0 IF TYPE ZERO FILE JMP OPLST,I CPA P3 JMP OPMRT PROMPT OVERWRITE OF EXISTANT FILE CPA P4 JMP OPMRT PROMPT OVERWRITE OF EXISTANT FILE JSB CLOSE CLOSE FILE WITH TYPE ERROR DEF *+2 DEF LDCB3 OUTPUT DATA CONTROL BLOCK JSB TYMSG PRINT TYPE ERROR MESSAGE DEF FILE3 FILE NAME PARAMETER LDA P0 FORCE NEW INPUT STA ISTRC * *PROMPT ONLY IF PROMPT FLAG IS 0 * LDB PRMTF SZB JMP EXIT EXIT IF NO PROMPT TO BE DONE JSB GTIN GET NEW OUTPUT FILENAME DEF FILE3 DEF PRLST PROMPT MESSAGE JMP OPLST+1 RETRY OUTPUT OPEN * *PROMPT OVERWRITE IF NECESSARY * * *SEE IF PROMPT FLAG SET BEFORE PRINTING PROMPT * OPMRT LDA PRMTF SZA IF FLAG 0 THEN PROMPT JMP OPLST,I FLAG NOT SET RETURN * *THEN PROMPT BEFORE OVERWRITING * LDA F3 PUT FILENAME IN PROMPT MESSAGE LDB @OVRT JSB .MVW DEF P3 NOP JSB PMSGT PRINT MESSAGE DEF OVRWT JSB RDTRM READ RESPONSE LDA @BSTR SEE IF RESPONSE YES LDB @BYES O JSB .CBT DEF P3 ONLY 3 CHARS CHECKED REMAINDER IGNORED NOP JMP OPLST,I YES NORMAL RETURN EXISTANT FILE NOP JSB CLOSE CLOSE FILE WE DON'T WANT DEF *+2 DEF LDCB3 OUTPUT DATA CONTROL BLOCK LDA P0 FORCE NEW INPUT STA ISTRC JSB GTIN GET NEW OUTPUT FILE DEF FILE3 DEF PRLST MESSAGE FOR PROMPT JMP OPLST+1 RETRY OPEN OF OUTPUT * *EQUAL RESTART * EQULA NOP LDA FILE3 IF NULL ALLOW SZA,RSS JMP EQULA,I LDA F3DSC SEE IF CART NUMS DIFF CPA F1DSC JMP EQERR IF EQUAL ERROR AND EXIT SZA,RSS NEITHER CART CAN BE DEFAULT 0 JMP EQERR LDA F1DSC SZA,RSS JMP EQERR JMP EQULA,I UNIQUE CART NUM'S OK!! HED TYMSG AND FLERR AND CNV99 * *TYMSG TYPE ERROR MESSAGE * TYMSG NOP LDA TYMSG,I GET FILENAME ADDRESS WORD ISZ TYMSG STEP TO RETURN POINT LDB @SBPT ADDRESS OF SUBSTITUTION POINT JSB .MVW DEF P3 PUT FILE NAME IN MESSAGE NOP JSB PMSGT PRINT MODIFIED MESSAGE DEF EOFTY TYPE ERROR MESSAGE JMP TYMSG,I NORMAL RETURN @SBPT DEF EOFTY+4 SUBSTITUTION POINT IN MSG FOR FILENAME @OVRT DEF OVRWT+7 SUBSTITUTION POINT IN MSG FOR FILENAME * *FLERR PROGRAM PRINTS FMGR ERROR MSG * EXITS FROM PROGRAM BACK TO SYSTEM * FLERR NOP USE JSB CALL TO PASS PARMS CMA,INA MAKE ERROR POSITIVE JSB CNV99 CONVERT TO 2 DIGIT ASCII STA EMGR+4 STORE IN ERROR NUMBER IN MSG LDA FLERR,I GET FILE NAME ADDRESS LP33 SSA,RSS RESOLVE INDIRECT IF PRESENT JMP OK33 ELA,CLE,ERA CLEAR INDIRECT BIT LDA A,I JMP LP33 OK33 LDB @SUBP ADDRESS WHERE TO STORE JSB .MVW DEF P3 PUT FILENAME IN MESSAGE NOP JSB PMSGT PRINT ERROR MESSAGE DEF EMGR JSB CLOS2 CLOSE ALL FILES JSB EXEC RETURN TO SYSTEM DEF *+2 DEF P6 @SUBP DEF EMGR+10 POINT IN MESSAGE FOR FILENAME * *CNV99 * CNV99 NOP CLB DIV P10 SZA ADA M20 ADA M40 FORCE LEADING BLANK IF ZERO ALF,ALF PUT IN LEFT HALF IOR B IOR M60 PUT IN CODE FOR ZER0 CHAR JMP CNV99,I RETURN ASCII IN A REG HED CLOSE ALL FILES FOR THIS PROGRAM * *CLOS2 * NORMAL CLOSE INPUT * TRUNCATE CLOSE OF OUTPUT IF CREATED BY PROGRAM * NORMAL CLOSE OF OUTPUT IF ALREADY PRESENT WHEN PROG RUN * CLOS2 NOP JSB CLOSE CLOSE INPUT DEF *+2 DEF IDCB1 INPUT DATA CONTROL BLOCK * *CLOSE LISTING * JSB CLOSE CLOSE LISTING DEF *+2 DEF LDCB3 * *CLOSE OUTPUT * JSB CLOSE DEF *+2 DEF ODCB2 *RETURN JMP CLOS2,I HED PRINT MESSAGE ON THE TERMINAL PMSGT * *PMSGT THIS ROUTINE PRINTS MESSAGES ON THE TERMINAL * OPERAND 1 ADDRESS OF START OF MESSAGE FIELD * * MESSAGE FIELD * 1 WORD LENGTH OF MESSAGE IN WORDS * MESSAGE IN ASCII FORM * PMSGT NOP LDA PMSGT,I GET ADDRESS OF MESSAGE FIELD ISZ PMSGT STEP TO RETURN ADDRESS RSLP SSA,RSS RESOLVE ANY INDIRECT ADDRESS PARMS TO * ALLOW INDEXING OF MESSAGE! JMP RSVD RESOLVED ELA,CLE,ERA CLEAR INDIRECT BIT WANT ADDRESS NOT DATA LDA A,I JMP RSLP RSVD STA @NMWD ADDRESS OF NUMBER WORDS IN MESSAGE INA STA @DMSG WORD ADDRESS OF MESSAGE * *PRINT PROG INVOCATION NAME TO TERMAINAL * LDA OPRLU IOR =B2000 MERGE NO CRLF ON OUTPUT STA OPLU2 JSB REIO WRITE THE MESSAGE DEF *+5 DEF P2 PRINT MESSAGE DEF OPLU2 NO CRLF OPTION DEF PNBUF 4 WORDS FOR FILENAME DEF P4 JSB REIO PRINT MESSAGE DEF *+5 DEF P2 PRINT DEF OPRLU DEF @DMSG,I MESSAGE DEF @NMWD,I NUMBER WORDS JMP PMSGT,I RETURN HED COPY ROUTINE * *COPY PUTS PROG NAME IN *CMX2L MESSAGES * COPY NOP STA ICNT SAVE LOOP COUNTER LOOPC ISZ ICNT JMP *+2 JMP COPY,I RETURN IF DONE LDA @BPNB GET BYTE ADDRESS OF PROG NAME BUFFER LDB COPY,I GET BYTE ADDRESS OF DESTINATION JSB .MBT DEF P6 MOVE 6 CHAR PROG NAME TO DEST NOP ISZ COPY STEP TO NEXT DEST PARM JMP LOOPC @BPNB DBL PNBUF PNBUF ASC 4,CMX2L EXTRA BLANKS USED BY PMSGT ROUTINE HED CHECK FOR ASMB STATEMENT * *CKINP * CKINP NOP JSB READF READ FIRST LINE OF INPUT DEF *+6 DEF IDCB1 DEF IERR1 DEF INBUF DEF P75 DEF LENIN SSA,RSS SEE IF ERROR JMP CKASB NO ERROR JSB FLERR ERROR RETURN DEF FILE1 CKASB LDB LENIN CHECK FOR ENDFILE SSB JMP ASNFD ASMB LINE NOT FOUND ON INPUT CLE,ELB CONVERT LENGTH TO CHARS STB INLNG SAVE INPUT LENGTH IN CHARS * *SEE IF ASMB STARTS STATEMENT * LDA @ASMB LDB @BINB BYTE ADDRESSES TO COMPARE JSB .CBT DEF P4 NOP JMP ASMFD FOUND ASMB STATEMENT NOP BAD FILE * *RETURN SKIP ONE FOR ERROR ASNFD ISZ CKINP ASMFD JMP CKINP,I RETURN @ASMB DBL AMSBM AMSBM ASC 2,ASMB * HED MESSAGES TO TERM AND FILE *TERMINAL MESSAGES PRIN DEC 13 ASC 13,ENTER INPUT:SC:CR OR LU# PROUT DEC 13 ASC 13,ENTER OUTPUT:SC:CR OR LU# EMGR DEC 12 ASC 12,FMGR -XX ON FILE YYYYYY BRCE DEC 3 ASC 3,ABORTS EOFIN DEC 29 ASC 18,DUPLICATE FILES OR LU'S NOT ALLOWED. ASC 11, CR MUST BE SPECIFIED EOFTY DEC 15 ASC 15,FILE XXXXXX NOT TYPE 3 OR 4 OVRWT DEC 16 ASC 16, OVERWRITE? XXXXXX ( YES OR NO ) ASMBM DEF 15 ASC 15,'ASMB' NOT STARTING FIRST LINE PRLST DEF 14 ASC 14,ENTER LISTFILE:SC:CR OR LU# *TERMINAL AND OUTPUT @NMX1 DEF CMX1+9 CMX1 DEC 11 ASC 11,*CMX2L ERRORS = XXXX @NMX2 DEF CMX2+10 CMX2 DEC 12 ASC 12,*CMX2L WARNINGS = XXXX @NMX3 DEF CMX3+22 CMX3 DEC 24 ASC 24,*CMX2L EXTENDED INSTRUCTION CONVERSIONS = XXXX @NMX4 DEF CMX4+19 CMX4 DEC 21 ASC 21,*CMX2L FLOATING POINT CONVERSIONS = XXXX @NMX5 DEF CMX5+17 CMX5 DEC 19 ASC 19,*CMX2L SCIENTIFIC CONVERSIONS = XXXX @NMX6 DEF CMX6+18 CMX6 DEC 20 ASC 20,*CMX2L FAST FORTRAN CONVERSIONS = XXXX @NMX7 DEF CMX7+14 CMX7 DEC 16 ASC 16,*CMX2L DMS CONVERSIONS = XXXXXX *DATA AREA M20 OCT 20 M40 OCT 40 M60 OCT 60 M400 OCT 400 N1 DEC -1 N6 DEC -6 N8 DEC -8 N80 DEC -80 P0 DEC 0 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P6 DEC 6 P10 DEC 10 P20 DEC 20 P75 DEC 75 BYES ASC 2,YES @BYES DBL BYES @BSTR DBL STRNG BYTE ADDRESS OF INSTRING ADIPB DEF IPBUF F1 DEF FILE1 F2 DEF FILE2 F3 DEF FILE3 *VARIABLES PRMTF NOP 0 IF PROMPT TO TERM IS TO BE USED LENIN NOP INPUT LINE LENGTH IN WORDS ACTUALLY READ ICNT NOP LOOP COUNTER USED BY COPY ROUTINE OPLU2 NOP OUTPUT OPTION FOR PRMSGT @DMSG NOP ADDRESS OF MESSAGE SAVE LOC @MSG NOP ADDRESS OF MESSAGE SAVE LOC @FIL NOP ADDRESS OF FILE NAME LOC @NMWD NOP ADDRESS OF NUMBER OF WORDS IN MESSAGE IRB NOP FIRST FREE BLOCK IN OUT FILE IREC NOP FIRST FREE REC IN OUT FILE ITRUN NOP NUMBER OF BLOCKS TO TRUNCATE OBLKS NOP NUMBER OF BLOCKS ALLOCATED AT CREATION OPRLU DEC 1 TERMINAL LU OPTIN OCT 610 OPTION FOR OPEN INPUT OUTPN OCT 610 OPTION FOR OPEN OUTPUT SLONG NOP LENGTH OF STRNG BUFFER CONTENTS * IN BYTES ISTRC DEC 1 NUMBER OF START CHAR FOR NAMR PARSE *FILE BUFFERS ERRTN NOP ERROR FLAG FOR TERM INPUT IPBUF BSS 40 80 CHAR INPUT BUFFuER USED NAMR STRNG BSS 40 80 CHAR INPUT BUFFER * FILE1 DEC 0 DEFAULT INPUT IS 0 LU (BIT BUCKET) NOP NOP TYPE1 NOP NAMR FILE NAME TYPE F1SC NOP SECURITY CODE F1DSC NOP CARTRIGE IERR1 NOP INPUT ERROR FLAG * FILE2 DEC 0 OUT DEFAULT IS BIT BUCKET NOP NOP TYPE2 NOP NAMR FILE NAME PARSE TYPE F2SC NOP F2DSC NOP IERR2 NOP OUTPUT ERROR FLAG * FILE3 DEC 0 LIST DEFAULT IS BIT BUCKET NOP NOP TYPE3 NOP NAMR FILE NAME TYPE F3SC NOP SECURITY CODE F3DSC NOP CARTRIGE IERR3 NOP LISTING ERROR FILE * * IDCB1 BSS 144 INPUT DATA CONTROL BLOCK ODCB2 BSS 144 OUTPUT DATA CONTROL BLOCK LDCB3 BSS 144 LISTING DATA CONTROL BLOCK EXT .CBT EXT .CMW EXT .MBT EXT .MVW END CMX2L ASMB,R,Q,C *MAIN LOOP OF PROGRAM CMX2L * *THIS ROUTINE PROCESSES LINES OF INPUT SOURCE AND FORMS OUTPUT *UNTIL * END OF FILE ON INPUT * BREAK RECEIVED BY CMX2L * FMP ERROR DURING INPUT OR OUTPUT * END STATEMENT ENCOUNTERED IN INPUT SOURCE * * *DO UNTIL ONE OF THE ABOVE CONDITIONS OCCURS * NAM MANLP ENT MANLP EXT CNUMD,@BINB,ADEXT,CMX1,CMX2,CMX3,CMX4,CMX5 EXT CMX6,CMX7,@NMX1,@NMX2,@NMX3,@NMX4,@NMX5,@NMX6 EXT @NMX7,FILE1,FLERR,IDCB1,IERR1,IFBRK,INBUF,ISTPR EXT OUTPT,PMSGT,PRMPR,READF,SERCH EXT INLNG,OUTML EXT BRCE ENT RESA,RESB A EQU 0 B EQU 1 SUP PRESS PRINTING MANLP NOP * *CHECK TO SEE IF BREAK ONE TIME EACH PASS OF LOOP * JMP PSTLP START LOOP FIRST LINE ALREADY READ IN * BY THE OPEN ROUTINE PROGL JSB BREAK JSB READF READ INPUT LINE INTO INBUF DEF *+6 DEF IDCB1 INPUT DATA CONTROL BLOCK DEF IERR1 INPUT ERROR FLAG DEF INBUF INPUT BUFFER NOTE CURRENTLY CONTAINED * * IN ROUTINE INSTRUCTION PARSE DEF P75 MAX INPUT LINE 150 CHARS DEF LENIN ACTUAL WORDS READ -1 IF EOF SSA,RSS SEE IF ERROR JMP CKEOF OK SEE IF ENDFILE JSB FLERR EXIT FROM PROGRAM DEF FILE1 PARM FOR FILE NAME CAUSING ERROR CKEOF LDB LENIN CHECK FOR END FILE ON INPUT SSB JMP NOEND ENDFILE OCCURED THEREFORE NO END STATEMENT IN INPUT * *PARSE INPUT BUFFER FOR INSTRUCTION IF PRESENT * CLE,ELB CONVERT TO CHARS OF INPUT FOR PARSE ROUTINE STB INLNG SAVE LENGTH IN INLNG (CHARS) PSTLP JSB ISTPR PARSE INPUT * *NO INSTRUCTION GO TO WRITE INPUT TO OUTPUT * SSB JMP WRLIN * *IF INSTRUCTION = 'END' THEN GO PROCESS END * STB ISTLN SAVE INSTR LENGTH IN CHARACTERS STA @BIST SAVE BYTE ADDRESS OF START OF INSTRUCTION CPB P3 SEE IF INSTRUCTION HAS CORRECT LENGTH JMP LNOKE LENGTH OK CHECK FOR END JMP ISTPC PROCESS VALID INSTRUCTION LNOKE LDB @BEND JSB .CBT DEF P3 NOP JMP ENDLP END DETECTED GO FINISH PROCESS NOP ELSE PROCESS INSTRUCTION * *CHECK FOR RPL INSTRUCTION * LDA @BIST LDB @BRPL JSB .CBT DEF P3 IS INSTRUCTION RPL? NOP JMP RPLHL YES PROCESS RPL INSTRUCTION NOP NO * *CHECK FOR EXT INSTRUCTION * LDA @BIST LDB @BEXT JSB .CBT DEF P3 IS INSTRUCTION EXT NOP JMP EXTHL YES PROCESS EXT INSTRUCTION NOP NO * *CHECK FOR MIC INSTRUCTION * LDA @BIST LDB @BMIC JSB .CBT DEF P3 NOP JSB MICHL PROCESS MIC WARNING NOP * *CHECK FOR EMA INSTRUCTION * LDA @BIST LDB @BEMA JSB .CBT DEF P3 NOP JSB EMAHL PROCESS EMA WARNING NOP * *FIND INSTRUCTION IF PRESENT IN THE INSTRU3CTION TABLES * ISTPC LDA @BIST SET PARM FOR SEARCH ROUTINE JSB SERCH SEARCH FOR INSTRUCTION IN TABLE DEF ISTLN PARM OF INSTRUCTION LENGTH * *IF NO INSTRUCTION IS FOUND GOTO WRITE LINE * SSA JMP WRLIN * *INSTRUCTION FOUND SET INSTRUCTION USED MARK * STB @ISTT SAVE WORD ADDRESS OF TABLE ENTRY OF INSTRUCTION ADB P4 STEP TO INSTR MARK AND TYPE WORD LDA B,I IOR P1 SET INSTR USED MARK STA B,I SAVE IN TABLE AND =B177400 SELECT INSTRUCTION TYPE FIELD ALF,ALF PUT IN LOW BYTE AND =B7 MASK FOR CODE SETS LIMIT OF 8 TYPES CURRENTLY ADA EIGNM USE ADDRESS DISPLACEMENT TO INCREMENT * CORRECT INSTRUCTION TYPE COUNTER LDB A,I INB STB A,I * *EIGNM ADDRESS OF FIRST ENTRY OF INSTRUCTION TYPE COUNTERS * *IGNM 0 NUMBER EIG INSTRUCTION CONVERTED *FPNM 1 NUMBER FLOAT INSTRUCTIONS CONVERTED *SISNM 2 NUMBER OF SCIENTIFIC INSTRUCTIONS *FASTF 3 NUMBER OF FAST FORTRAN INSTRUCTIONS *DMSNM 4 NUMBER OF DMS INSTRUCTIONS CONVERTED * 5-7 UNUSED INSTRUCTION TYPES CURRENTLY * * *WRITE LABEL FROM INPUT TO OUTPUT * *CALC NUMBER OF CHARS IN LABEL * LDA @BINB CMA,INA ADA @BIST NUM CHARS IN LABEL IN A NOW * NOTE DEPENDS ON @BIST POINTING TO SPOT IN * INPUT BUFFER STA NMCAR SAVE NUMBER OF CHARS IN LABEL LDA @BINB WRITE LABEL JSB OUTPT DEF P3 START NEW LINE DEF NMCAR NUMBER OF CHARS IN LABEL * *WRITE SPACE JSB SPACE . * LDA @BJSB JSB OUTPT DEF P2 APPEND TO OLD OUTPUT DEF P6 6 CHARACTERS * *WRITE INSTRUCTION * LDA @BIST JSB OUTPT DEF P2 APPEND TO OLD LINE DEF ISTLN NUMBER OF CHARS IN INSTRUCTION * *INIT LOOP TO PROCESS ANY POSSIBLE PARMS THE INSTR MAY HAVE * LDA NMCAR ADA ISTLN Em STA PRSST CHAR POSITION IN STRING TO START PARM PARSE LDB @ISTT ADB P3 ADDRESS OF NUMBER OF PARMS NEEDED LDA B,I GET NUMBER OF PARMS AND DUMMIES AND =B377 MASK FOR NUMBER PARMS ONLY CMA STA ICNT SAVE LOOP COUNTER LDA P0 STA PN INIT PARM NUMBER FOR ASTERIX FIX ROUTINE * *DO ICNT = -(NUMBER PARMS+1) TO -1 BY 1 * DOLOP ISZ ICNT JMP *+2 JMP EDLOP DONE WITH LOOP ISZ PN COUNT PARM NUMBER * *CALL PARSE PARM * *PNPRM IS ENTRY POINT WHEN ,I FOUND BECAUSE ,I IS NOT COMPLETE PARM * PNPRM JSB PRMPR DEF INBUF INPUT BUFFER MUST BE TERMINATED WITH NULL TO STOP SFB IST * USED BY PARM PARSE ROUTINE DEF INLNG INPUT BUFFER LENGTH IN CHARS DEF PRSST CHARACTER POSSITION OF START OF PARM PARSE * FIRST CHAR POSITION IS 0 STA @BSTP SAVE BYTE ADDRESS OF START OF PARM * *CHECK TO SEE IF PARM ACTUALLY FOUND * SSB JMP NOPRM NO PARM FOUND STB PRMLN SAVE PARM LENGTH IN CHARACTERS * *CALL FIX ASTERIX * THIS ROUTINE MAKES THE ASTERIX REFER TO THE ORIGINAL * SOURCE LOCATION * THUS PARM 1 * GOES TO *-1 * AND PARM 2 * GOES TO *-2 ETC * NOTE ROUTINE MOVES PARM TO NEW BUFFER OF 80 CHARS * JSB ASTRX * * * SEE IF PARM IS A LITERAL * LITCK LDB @BSTP JSB .LBT CPA =B75 SEE IF FIRST CHARACTER IS = SIGN JSB LITHL IF LITERAL PRINT WARNING MESSAGE * *PUT PARM IN OPERAND FIELD OF DEF STATEMENT * *WRITE DEF * LDA @BDEF JSB OUTPT DEF P1 PRINT OLD START NEW DEF P10 10 CHARACTERS * *WRITE PARM * LDA @BSTP JSB OUTPT DEF P2 APPEND TO OLD OUTLINE DEF PRMLN PARM LENGTH IN CHARACTERS JMP DOLOP DO NEXT PARM? * *NOPARM WHEN ONE EXPECTED * NOPRM LDA @BEXO PRINT ERROR MESSAGE JSB OUTPT DEF P1 PRINT OLD START NEW DEF P38 LENGTH OF MESSAGE LDA @BNOP PRINT NOP STATEMENT JSB OUTPT DEF P5 PRINT ERROR MESSAGE ON LIST ONLY DEF P10 * *INCREMENT ERROR COUNT * ISZ ERCNT JMP DOLOP DO NEXT PARM? @BEXO DBL EXO EXO ASC 19,****ERROR EXPECTING OPERAND: NOP USED @BNOP DBL NOP NOP ASC 5, NOP * *END OF LOOP FOR PARMS FINISH UP *THIS LINE OF INPUT SOURCE * EDLOP LDA INLNG IF NOT END OF INPUT WRITE REST OF INPUT CMA,INA ADA PRSST SSA,RSS IF POS NO MOVE CHARS IN INPUT JMP CKDMY CHECK FOR NEEDED DUMMY PARMS * *WRITE REST OF INPUT LINE TO OUTPUT * CMA,INA GET POSITIVE NUM CHARS LEFT STA ENLNG SAVE LDA @BINB ADA PRSST CALC START ADDRESS OF REST OF INPUT JSB OUTPT DEF P2 APPEND DEF ENLNG LENGTH TO ADD * *CHECK FOR DUMMY PARMS * CKDMY LDA @ISTT ADDRESS OF TABLE ENTRY START ADA P3 LDA A,I AND =B177400 MASK FOR DUMMY PARMS SZA,RSS JMP LSTWR NO DUMMY ALMOST DONE THIS LINE * *ONLY ALLOW SINGLE DUMMY FOR NOW *USE NOP STATEMENT FOR DUMMY OP POSSITION * *WRITE NOP * LDA @BNOP JSB OUTPT DEF P1 PRINT OLD START NEW DEF P10 TEN CHARS * *WRITE REMAINING CONSTRUCTED LINE * LSTWR LDA P0 JSB OUTPT DEF P0 PRINT OLD DEF P0 * *END OF INPUT LINE LOOP GET NEXT LINE * JMP PROGL SKP * *WRITE LINE * WRLIN LDA @BINB WRITE INPUT TO OUT UNMODIFIED JSB OUTPT DEF P3 START NEW DEF INLNG INPUT LINE LENGTH IN CHARS LDA P0 JSB OUTPT DEF P0 PRINT OLD DEF P0 JMP PROGL GET NEXT LINE? SKP *ROUTINES TO FINISH UP * *NOEND GIVES END STATEMENT WHEN NONE FOUND ON INPUT * NOEND ISZ ERCNT INCREMENT ERROR COUNT * *PRINT ERROR MESSAGE ON LIST FILE ONLY * LDA @BENG BYTE ADDRESS OF MESSAGE JSB OUTPT DEF P3 START NEW LINE DUMP OLD DEF P38 38 CHAR MESSAGE LDA P0 PRINT LINE ON LIST ONLY JSB OUTPT DEF P4 DEF P0 LDA @ENDS PUT END STATEMENT INTO INPUT BUFFER LDB @INBF JSB RESA RESOLVE INDIRECT ADDRESS JSB RESB RESOLVE INDIRECT ADDRESS JSB .MVW DEF P5 NOP LDA P10 SET INPUT BUFFER LENGTH STA INLNG INPUT BUFFER LENGTH IN CHARS * *NORMAL POINT FOR PROCESSING AFTER DETECTION OF END * *CALL ROUTINE TO ADD EXT STATEMENTS AS NEEDED * ENDLP JSB ADEXT * *CONVERT NUMBERS OF CONVERSIONS ETC TO ASCII * AND PUT IN MESSAGES FOR TERM AND FILE] * JSB CNUMD CONVERT TO DECIMAL DEF *+3 DEF ERCNT DEF @NMX1,I ADDRESS WHERE TO STORE ASCII JSB CNUMD DEF *+3 DEF WRNCT DEF @NMX2,I JSB CNUMD DEF *+3 DEF IGNM DEF @NMX3,I JSB CNUMD DEF *+3 DEF FPNM DEF @NMX4,I JSB CNUMD DEF *+3 DEF SISNM DEF @NMX5,I JSB CNUMD DEF *+3 DEF FASTF DEF @NMX6,I JSB CNUMD DEF *+3 DEF DMSNM DEF @NMX7,I * *PRINT MESSAGES ON TERMINAL AND ON OUTPUT FILE * * PRINT ON TERMINAL * JMP BTHPT PRINT BOTH WITH ONE ROUTINE @CMX1 DEF CMX1 @CMX2 DEF CMX2 @CMX3 DEF CMX3 @CMX4 DEF CMX4 @CMX5 DEF CMX5 @CMX6 DEF CMX6 @CMX7 DEF CMX7 * *PRINT ON FILE * BTHPT LDA @CMX1 JSB OUTML LDA @CMX2 JSB OUTML LDA @CMX3 JSB OUTML LDA @CMX4 JSB OUTML LDA @CMX5 JSB OUTML LDA @CMX6 JSB OUTML LDA @CMX7 JSB OUTML * *WRITE END STATEMENT LINE * LDA @BINB JSB OUTPT DEF P3 START NEW DEF INLNG NUMBER CHARS LDA P0 JSB OUTPT DEF P0 PRINT OLD LINE  DEF P0 JMP MANLP,I BODY OF PROG DONE * RETURN TO USER INTERFACE TO CLOSE FILES AND EXIT * *LITERAL HANDLER * LITHL NOP LDA @BWRN PRINT WARNING MESSAGE JSB OUTPT DEF P1 PRINT OLD START NEW DEF P36 36 CHARS ISZ WRNCT INCREMENT WARNING COUNT * *THE MESSAGE IS TO PRINT ON LIST FILE ONLY * *FORCE THAT * LDA 0 JSB OUTPT DEF P5 PRINT OLD START NEW LIST ONLY DEF P0 ZERO CHARS IN NEW STATEMENT JMP LITHL,I RETURN TO PROCESS AS ORDINARY PARM FOR NOW @BWRN DBL WRN WRN ASC 18,***WARNING LITERAL IN DEF STATEMENT @ENDS DEF ENDS+1 ENDS DEC 5 ASC 5, END @BENG DBL ENMG ENMG ASC 19,****ERROR NO END STATEMENT; END ADDED * SKP * *EMAHL PROGRAM TO PROCESS WARNING MESSAGES FOR EMA * EMAHL NOP LDA @BWEM GET MESSAGE JSB OUTPT DEF P3 DEF P50 ISZ WRNCT INCREMENT WARNING COUNT * *FORCE PRINT ON LIST ONLY * LDA P0 JSB OUTPT DEF P5 DEF P0 JMP EMAHL,I RETURN FROM ROUTINE @BWEM DBL EMA EMA ASC 19,***WARNING EMA PSEUDO INSTRUCTION NOT ASC 6,IMPLEMENTED @BEMA DBL *+1 ASC 2,EMA * *MICHL PROCEDURE FOR HANDLING MIC INSTRUCTION * MICHL NOP LDA @BWMC JSB OUTPT PRINT MESSAGE DEF P3 DEF P55 55 CHARS IN MESSAGE ISZ WRNCT COUNT WARNING * *FORCE PRINT LIST ONLY * LDA P0 JSB OUTPT DEF P5 DEF P0 JMP MICHL,I RETURN @BWMC DBL *+1 ASC 18,***WARNING MIC PSEUDO INSTUCTION MAY ASC 10, NOT BE IMPLEMENTED @BMIC DBL *+1 ASC 2,MIC SKP * *SPECIAL FIX ASTERIX PROGRAM * *WORKS FOR PARMS OF UP TO 5 ONLY * ASTRX NOP LDA PRMLN CMA GET LENGTH PARM STA LPCNT LDB @BSTP INIT REG FOR CHAR SEARCH LDA @BAST STA @DEST ASTLP ISZ LPCNT JMP *+2 e JMP ASTDN READ WHOLE PARM JSB .LBT CPA ASTX SEE IF ASTERIX JMP AST DO ASTERIX CASE STB TEMP DO NORMAL CHAR CASE LDB @DEST JSB .SBT MOVE CHAR TO OUT BUFFER STB @DEST SAVE ADDRESS LDB TEMP JMP ASTLP DO NEXT CHAR ASTDN LDA @BAST SET START OF PARM ADDRESS STA @BSTP JMP ASTRX,I RETURN AST STB TEMP ASTERIX FOUND LDB @DEST JSB .SBT PUT ASTERIX IN OUT PARM ISZ PRMLN INCREASE LENGTH PARM ISZ PRMLN LDA PN CHECK PARM NUMBER AND =B7 MAKE SURE NOT LARGER THAN 7 ADA PNAD FETCH WORD CONTAINING PROPER CHARS LDA A,I JSB .SBT PUT IN MINUS SIGN ALF,ALF JSB .SBT PUT IN NUMBER ASCII STB @DEST LDB TEMP JMP ASTLP GET NEXT CHAR * *ASTRIX TABLE * ASTX OCT 52 ASTRIX @BAST DBL ASTBF ASTBF BSS 40 80 CHAR PARM BUFFER PNAD DEF PNA+0 PNA ASC 8,0-1-2-3-4-5-6-7- SKP * *PROCESS RPL INSTRUCTION * IF RPL INSTRUCTION IS FOR DEFINEING * MICROINSTRUCTION WILL CAUSE ERROR ON * L SERIES COMPUTERS * RPLHL NOP * *INIT PARMS FOR PARM PARSE OF LABEL FIELD * LDA P0 STA PRSST START WITH FIRST CHARACTER * *PARSE PARM FOR LABEL ASSUMPTION IS MADE *THAT VALID LABEL EXISTS CAN BE DONE *BECAUSE NO LABEL WILL RESULT IN RPL *BEING PARSED AS LABEL * JSB PRMPR DEF INBUF DEF INLNG DEF PRSST * *SEE IF PARM FOUND * SSB JMP WRLIN NO PARM JUST PRINT THIS LINE STB PRMLN SAVE LENGTH OF PARM IN CHARS * *SEARCH TABLE FOR INSTR MATCHING LABEL * *IF LABEL HAS LEADING PERIOD REMOVE IT * LDB A JSB .LBT GET FIRST CHAR OF LABEL CPA PERID IS THE CHAR A PERIOD JMP *+2 YES REMOVE IT JMP NOPRD NO PERIOD CHECK FULL LABEL *NOTE ONLY VALID IF FULL LABEL INSTR&UCTION IS *ALOG ALOGT ATAN COS EXP SIN SQRT TAN TANH *DBLE DDINT SNGL *ALL OTHER FULL LABEL INSTRUCTIONS ARE DON'T CARES * LDA PRMLN ADA N1 STA PRMLN REDUCE LENGTH OF PARM WHEN ZAP PERIOD JMP CNT44 NOPRD ADB N1 RESET B TO TAKE FIRST CHAR OF LABEL CNT44 LDA B SET A REG TO START OF LABEL FOR SERCH *NOTE A REG SET TO BYTE ADDRESS OF INSTRUCTION TO FIND JSB SERCH DEF PRMLN SSA SEE IF IN TABLE JMP WRLIN NOT IN TABLE PRINT LINE * *IF IN TABLE PRINT WARNING MESSAGE ON LIST FILE * LDA @BRWN JSB OUTPT DEF P3 START NEW LINE DEF P58 LENGTH OF MESSAGE IN CHARS LDA P0 JSB OUTPT FORCE PRINT OF MESSAGE ON LIST ONLY DEF P4 PRINT OLD ON LIST DEF P0 NO NEW LINE ISZ WRNCT INCREMENT WARNING COUNT JMP WRLIN WRITE INPUT LINE (CONTAINS RPL INSTRUCTION) * *MESSAGE * @BRWN DBL RWN RWN ASC 15,***WARNING RPL MICROCODE CALL ASC 14,NOT IMPLEMENTED ON L SERIES SKP * *EXT HANDLER * *PARSES AND PROCESSES OPERANDS OF EXT STATEMENT TO * PREVENT MULTIPLE DEFINITIONS OF INSTRUCTIONS * BY ADEXT ROUTINE * EXTHL NOP * *CALC NUMBER OF CHARS TO SKIP BEFORE PARM PARSE * LDA @BINB CMA,INA ADA @BIST LENGTH OF LABEL + ADA ISTLN LENGTH OF INSTRUCTION= STA PRSST NUMBER OF CHARS TO SKIP BEFORE PARSING * *DO PARM PASE UNTIL NO MORE PARMS * PRLOP JSB PRMPR DEF INBUF DEF INLNG DEF PRSST *SEE IF PARM FOUND *WHEN ALL PARMS DONE PRINT EXT LINE UNCHANGED * SSB JMP WRLIN GO WRITE EXT LINE STB PRMLN IF PARM SAVE LENGTH OF PARM * *SEE IF PARM BEGINS WITH A PERIOD * IF IT DOES DELETE PERIOD FROM PARM AND SEE IF IN * INSTRUCTION TABLE * LDB A PUT ADDRESS OF PARM START IN B JSB .LBT GET FIRST CHAR OF PARM CPA PERID SEE IF PERIOD S JMP *+2 SINCE PERIOD SEE IF IN INSTRUCTION TABLE JMP PRLOP NOT PERIOD GET NEXT PARM LDA PRMLN DELETE PERIOD FROM PARM ADA N1 SUBTRACT 1 FROM LENGTH OF PARM STA PRMLN SAVE NEW LENGTH LDA B PUT BYTE ADDRESS OF START OF PARM IN A REG FOR SERCH * *SEE IF PARM IS IN INSTRUCTION TABLE * *NOTE A REG SET TO BYTE ADDRESS OF INSTRUCTION TO FIND JSB SERCH DEF PRMLN SSA IF NOT IN LIST JMP PRLOP THEN GET NEXT PARM * *WHEN PARM FOUND IN LIST MARK INSTRUCTION USED BYTE *TO SHOW THAT EXT ALREADY ISSUED * ADB P4 LDA B,I GET INSTR MARK IOR P2 SET EXT DONE BIT STA B,I SAVE BACK IN TABLE JMP PRLOP DO NEXT PARM SKP * *BREAK * * BREAK NOP JSB IFBRK SEE IF BREAK DEF *+1 SSA JMP EMBR BREAK RECEIVED JMP BREAK,I NORMAL RETURN EMBR JSB PMSGT PRINT BREAK MESSAGE DEF BRCE JMP MANLP,I RETURN TO SETUP PROGRAM FOR CLEAN EXIT * *DATA *CONSTANTS FIRST * N1 DEC -1 P0 DEC 0 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P58 DEC 58 P10 DEC 10 P36 DEC 36 P38 DEC 38 P50 DEC 50 P55 DEC 55 P75 DEC 75 PERID OCT 56 PERIOD FOR EXTHL ROUTINE @BDEF DBL DFE DFE ASC 5, DEF @BEND DBL DNE DNE ASC 2,END @BJSB DBL BSJ BSJ ASC 3, JSB . @INBF DEF INBUF SPACE OCT 40 SPACE CHARACTER @BEXT DBL BEXT BEXT ASC 2,EXT @BRPL DBL BRPL BRPL ASC 2,RPL * *VARIABLES * EIGNM DEF IGNM TABLE OF INSTRUCTION TYPE CONVERSIONS WRNCT NOP DO NOT REORDER!!! ERCNT NOP IGNM NOP FPNM NOP SISNM NOP FASTF NOP DMSNM NOP NOP 5 EXTRA ENTRIES TO PREVENT ERRORS NOP 6 NOP 7 @BIST NOP SAVE OF BYTE ADDRESS OF INSTR START @BSTP NOP SAVE OF BYTE ADD OF PARM START @DEST NOP TEMP POINTER USED BY ASTRX @ISTT NOP SAVE WORD ADD OF INSTR TAB ENTRY ENLNG NOP NUM EXTRA CHARS TO ADD TO OUTLINE AFTER * PARM PARSE ICNT NOP LOOP COUNTER IN GET PARMS LOOP ISTLN NOP INSTRUCTION LENGTH IN CHARS LENIN NOP ACTUAL NUM WORDS READ INTO INBUF LPCNT NOP LOOP COUNTER FOR ASTERIX ROUTINE NMCAR NOP NUMBER CHARS IN A LABEL PN NOP NUM OF PARM BEING PROCESSED BY PARM LOOP PRCNT NOP LOOP COUNTER FOR PRMBL ROUTINE PRMLN NOP LENGTH OF PARM GIVEN BY PARM PARSE PRSST NOP NUMBER OF CHARS TO SKIP FOR PARM PARSE TEMP NOP TEMPORARY STORAGE OF B REG FOR ASTRX ROUTINE SKP * *RESA RESB ROUTINES TO RESOLVE ADDRESS TO DIRECT ADDRESS * RESA NOP SSA,RSS JMP RESA,I RETURN ELA,CLE,ERA ZAP INDIRECT BIT LDA A,I JMP RESA+1 KEEP TRYING * RESB NOP SSB,RSS JMP RESB,I ELB,CLE,ERB CLEAR INDIRECT BIT LDB B,I JMP RESB+1 EXT .CBT EXT .LBT EXT .MVW EXT .SBT END ASMB,R,L,T,C HED INSTRUCTION PARSE NAM ISTPR * *INSTRUCTION PARSE * A REGISTER START OF INSTR BYTE ADDRESS RETURNED * B REGISTER NUMBER OF CHARS IN INSTRUCTION * ON RETURN IF B = -1 NO INSTRUCTION FOUND * A NOT USED BECAUSE BYTE ADDRESS * MAY SET BIT 15 * * STRING PARSED FOR INSTUCTION IS * INBUF * LENGTH IS INLNG IN CHARACTERS * * COMMON DATA AREA WITH CALLING ROUTINES ENT INBUF,INLNG,@BINB ENT ISTPR A EQU 0 B EQU 1 ISTPR NOP LDA INBUF CHECK FIRST CHARACTER AND =B177400 MASK FOR FIRST CHAR CPA ASTRX IF ASTRIX IS COMMENT LINE JMP EXIT2 NO INSTRUCTION FOUND CPA SPACE JMP SPACF IF SPACE FIRST NON SPACE START INSTR LBL LDA SPC LABEL FIND FIRST SPACE LDB @BINB SET B TO BYTE ADDRESS OF STRING  JSB .SFB SCAN FOR SPACE NOTE NULL IS END SEARCH MARK JMP SPFND SPACE FOUND JMP EXIT2 NO INSTRUCTION START FOUND SPACF LDB @BINB FIND FIRST NONSPACE FOR INSTR START SPFND LDA B SPLP LDB @BSPS LOOP UNTIL NONSPACE FOUND JSB .CBT DEF P40 COMPARE 40 SPACES AT A TIME NOP JMP SPLP NOT FOUND YET TRY NXT 40 SPACES NOP A CONTAINS BYTE ADDRESS OF FIRST NONSPACE STA STIST SAVE AS START INSTRUCTION LDB @BINB SEE IF NONSPACE IN INPUT STRING ADB INLNG GET BYTE ADDRESS OF END OF STRING CMB,INB ADB A IF B NEG OK FOUND START INSTRUCTION SSB,RSS JMP EXIT2 NO INSTRUCTION FOUND LDA SPC FIND END INSTRUCTION LDB STIST USE SCAN FOR BYTE JSB .SFB END MARK IS NULL AT END OF INBUFER JMP CKLEN FOUND SPACE SEE IF IN LEGAL STRING JMP EOFLN TERM FOUND USE END OF INPUT AS END OF INSTR CKLEN LDA @BINB ADA INLNG CMA,INA ADA B SSA,RSS JMP EOFLN USE END OF LINE FOR END INSTRUCTION EXIT1 LDA STIST B CONTAINS END OF INSTR+1 CMA,INA ADB A B NOW CONTAINS LENGTH INSTRUCTION LDA STIST JMP ISTPR,I NORMAL RETURN FROM INSTRUCTION * END OF INSTRUCTION = END OF LINE EOFLN LDB @BINB ADB INLNG JMP EXIT1 B CONTAINS END OF INSTR+1 *NO INSTRUCTION TO BE HAD EXIT2 LDB N1 JMP ISTPR,I RETURN WHEN ERROR HAS OCCURED *CONSTANTS ASTRX OCT 25000 SPACE OCT 20000 SPC OCT 40 SPACE WITH NUL FOR TERM CHAR N1 DEC -1 P40 DEC 40 @BINB DBL INBUF @BSPS DBL SPSTR SPSTR ASC 20, *VARIABLES STIST NOP START OF INSTRUCTION BYTE ADDRESS SAVE AREA INLNG NOP LENGTH OF ACTUAL STIRNG INBUF BSS 75 UP TO 150 CHAR INPUT STRING NOP END MARK FOR SCAN FOR BYTE INSTRUCTIONS EXT .CBT EXT .SFB END ASMB8,R,Q,C * *PARM PARSE ROUTINE USED IN CMX2L SYSTEM * *PARMS CAN BE SEPARATED BY COMMAS OR SPACES *SPACES FOLLOWING , + - OR ( ARE IGNORED. * *OP1 STRING TO PARSE WORD ADDRESS *OP2 LENGTH OF STRING WORD ADDRESS CHARS *OP3 ADDR OF NUM CHARS TO SKIP BEFORE PARSING * ON RETURN IS RESET TO SKIP CHARS SCANNED THIS PASS * *A REG ON RETURN START PARM BYTE ADDRESS *B REG ON RETURN * -1 NO PARM FOUND * >0 PARM LENGTH IN CHARS * * NOTE ', ,' IS A NULL PARM BY THESE RULES * *THIS ROUTINE IS BASED ON A SYNTAX DIAGRAM OF A LEGAL *PARM * *EACH CHARACTER IS EXAMINED ONE AT A TIME TO DECIDE THE *CORRECT COURSE OF ACTION * *THE DECISION STRUCTURE * * DECISION 1 * COMMA GOTO DECISION 1 * SPACE GO TO DECISION 1 * CHAR START PARM GOTO DECISION 2 * ENDSTRING GOTO NULL PARM * DECISION 2 * SPACE OR ENDSTRING GOTO ENDPARM FOUND * CHAR GOTO DECISION 2 * '+ - (' NOT END YET GOTO DECISION 3 * COMMA SAVE POSSIBLE END OF PARM GOTO DECISION 4 * MAY BE INDIRECT * DECISION 3 * SPACE GOTO DECISION 3 * ENDSTRING GOTO ENDPARM * ALL ELSE GOTO DECISION 2 (EFFECTIVELY IGNORES SPACES) * DECISION 4 (CHECK FOR POSSIBLE INDIRECT) * 'I' GOTO DECISION 5 * SPACE GOTO DECISION 4 (IGNORE SPACES) * ANY OTHER CHAR GOTO BACKUP-WAS-ENDPARM * DECISION 5 * ENDSTRING OR SPACE OR COMA * GOTO ENDPARM (WAS INDIRECT!) * NOT STRICTLY TRUE BUT FOR THIS PROGRAM * ANY OTHER CHAR GOTO BACKUP-WAS-ENDPARM * WHEN CALCULATING SKIP CHARS PIKUP PREV CHAR * NAM PRMPR ENT PRMPR EXT RESA A EQU 0 B EQU 1 PRMPR NOP LDA PRMPR,I GET ADDRESS OF STRING JSB RESA WANT DIRECT ADDRESS ONLY! STA @STRG SAVE IN ADDRESS OF STRING ISZ PRMPR GET LENGTH LDA PRMPR,I LDA A,I STA STBLN SAVE LENGTH STRING IN CHARS ISZ PRMPR GET NUM CHARS TO SKIP LDA PRMPR,I LDA A,I STA PRSTA SAVE NUM CHARS TO SKIP * *IF START PARSE BEYOND END OF STRING NO PARSE * CMA,INA ADA STBLN STA LP1CT SAVE NUMBER OF CHARS TO LOOK AT SSA IF NEG NO PARMS JMP NLPRM * *FIND START OF POSSIBLE PARM * LDA @STRG CLE,ELA CONVERT TO BYTE ADRESS ADA PRSTA ADDRESS TO START PARSE STA @PRMS ASSUME FOR NOW THIS IS START PARM * @PRMS IS CURRENT SEARCH POINT OF PARM SCAN * *DO DECISION 1 OF PARM PARSE *USE LOOP STRUCTURE TO DETECT IF END OF STRING FOUND * LDA LP1CT COMPLIMENT NUM CHAR TO EXAMINE CMA FOR ISZ INSTRUCTION STA LP1CT LDB @PRMS SET B REG TO ADDRESS CURRENT CHAR * *DECISION POINT 1 * LP1 ISZ LP1CT ENDSTRING? JMP *+2 NO JMP NLPRM YES JSB .LBT EXAMINE CURRENT CHAR CPA SPACE SPACE? JMP LP1 YES CONTINUE DECISION 1 CPA COMA COMMA? JMP LP1 YES CONTINUE DECISION 1 * *START OF PARM FOUND * ADB N1 SAVE BYTE ADDRESS OF START OF PARM STB @STPR START PARM ADDRESS INB SET B TO NEXT CHARACTER TO EXAMINE * *DECISION POINT 2 * LP2 ISZ LP1CT ENDSTRING? JMP *+3 NO INB GET LAST CHAR IN PARM JMP ENPRM YES END PARM FOUND JSB .LBT GET CURRENT CHAR SET B TO NEXT CHAR CPA SPACE SPACE? JMP ENPRM YES END OF PARM FOUND CPA COMA COMMA? JMP DEC4 YES GOTO DECISION 4 MAYBE INDIRECT CPA PLUS CHECK '+ - (' CHARS JMP DEC3 CPA MINS '-' JMP DEC3 CPA LPèREN '(' JMP DEC3 JMP LP2 ANY OTHER CHAR CONTINUE PARM * *DECISION POINT 3 (IGNORE SPACES FOLLOWING + - (' * DEC3 ISZ LP1CT ENDSTRING? JMP *+3 INB GET LAST CHAR IN PARM JMP ENPRM YES END PARM FOUND * NOTE AT THIS POINT PARM SYNTAX HAS BEEN * VIOLATED AND ERROR MESSAGE WILL BE GENERATED BY * ASSEMBLER! JSB .LBT EXAMINE CURRENT CHARACTER CPA SPACE SPACE? JMP DEC3 YES IGNORE IT JMP LP2 ANY OTHER CHAR CONTINUE GETTING PARM * *DECISION POINT 4 * DEC4 STB BKSAV SAVE POSSIBLE ENDPARM ADDRESS * IN CASE THIS IS END OF PARM LP4 ISZ LP1CT ENDSTRING? JMP *+2 NO JMP BKPRM YES BKSAV WAS END OF PARM JSB .LBT EXAMINE CURRENT BYTE CPA SPACE SPACE? JMP LP4 YES IGNORE IT CPA SYMI 'I'? JMP DEC5 YES SEE IF INDIRECT JMP BKPRM ANY OTHER CHAR * BKSAV WAS END OF PARM * *DECISION POINT 5 * DEC5 ISZ LP1CT ENDSTRING? JMP *+3 NO INB GET I CHAR INTO PARM JMP ENPRM YES CORRECT ENDPARM (WAS INDIRECT) JSB .LBT EXAMINE CURRENT CHAR CPA SPACE SPACE? JMP ENPRM YES CORRECT ENDPARM (WAS INDIRECT) CPA COMA COMA? JMP ENPRM YES WILL TAKE AS INDIRECT BUT IS ERROR REALLY * *FALL INTO ENDPARM WAS BKSAV * *NOTE WANT TO SCAN CURRENT CHAR ON NEXT PASS * BKPRM LDA @STRG START WITH WORD ADDRESS OF STRING CLE,ELA CMA ADA BKSAV NUMBER OF CHARS TO SKIP LDB PRMPR,I ADDRESS OF NUM CHARS TO SKIP PARM STA B,I UPDATE NUM CHARS SKIP FOR NEXT PASS ISZ PRMPR SET TO RETURN ADDRESS * *CALC PARM LENGTH * LDB @STPR BKSAV-@START PARM-1=PARM LENGTH CMB ADB BKSAV LDA @STPR RETURN BYTE ADDRESS START PA֞RM JMP PRMPR,I RETURN TO CALLING ROUTINE * *END PARM NORMAL * ENPRM STB @PRMS * *CALC NUMBER OF CHARS TO SKIP ON NEXT PASS * LDA @STRG CLE,ELA CONVERT WORD TO BYTE CMA SCAN CURRENT CHAR ON NEXT PASS ADA B LDB PRMPR,I ADDRESS OF SKIP CHARS PARM STA B,I UPDATE SKIP CHARS PARM ISZ PRMPR SET TO RETURN ADDRESS * *CALC LENGTH OF PARM * LDB @STPR CMB DON'T WANT CHAR THAT STOPS PARM ADB @PRMS B CONTAINS PARM LENGTH * DUE TO PROGRAM STRUCTURE ALWAYS>0 LDA @STPR RETURN BYTE ADDRESS OF START OF PARM JMP PRMPR,I RETURN * *NULL PARM OR NO STRING LEFT * NLPRM LDA @STRG CLE,ELA WORD TO BYTE ADDRESS CMA,INA ADA @PRMS CALC NUMBER OF CHARS TO SKIP LDB PRMPR,I ADDRESS OF SKIP CHARS PARM STA B,I SAVE NUM CHARS TO SKIP FOR NEXT PASS ISZ PRMPR SET TO RETURN ADDRESS LDB N1 SET NULL PARM RETURN FLAG JMP PRMPR,I RETURN * *DATA * N1 DEC -1 COMA OCT 54 COMMA CHARACTER LPREN OCT 50 LEFT PARENTHESIS MINS OCT 55 MINUS SIGN PLUS OCT 53 PLUS SIGN SPACE OCT 40 SPACE CHARACTER SYMI OCT 111 CAPITAL I CHARACTER * *VARIABLES * @PRMS NOP CURRENT CHAR OF PARMS SCAN @STPR NOP START OF PARM BYTE ADDRESS @STRG NOP WORD ADDRESS OF STRING BEING SCANNED BKSAV NOP SAVE FOR ADDRESS OF POSSIBLE END OF PARM LP1CT NOP -NUMBER OF CHARS LEFT TO SCAN-1 PRSTA NOP NUMBER OF CHARS TO SKIP BEFORE SCAN STBLN NOP LENGTH OF STRING IN CHARS INCLUDES SKIPED CHARS EXT .LBT END ASMB,R,Q,C NAM SERCH * *SERCH * A REG CONTAINS BYTE ADDRESS OF INSTR TO FIND IN TABLE * OP1 IS ADDRESS OF LENGTH OF THE INSTR TO USE * * THIS ROUTINE USES A BINARY SEARCH * AND BYTE COMPARE TO FIND THE INSTR IN THE TABLE * * INSTR FOUND * A REG CONTAINS 0 * B REG CONTAINS WORD ADDRESS IN TABLE OF START OF MATCHING ENTRY * * INSTR NOT FOUND * A REG CONTAINS -1 * B IS RANDOM * * TABLE ENTRY * 3 WORDS INSTR LEFT JUSTIFIED * 1 BYTE NUMBER OF DUMMY ENTRIES FOR INSTR * 1 BYTE NUMBER OF PARMS FOR INSTR (ADDRESS'S) * 1 WORD INSTR USED MARK LOCATION INIT 0 * EXT TABLE,STMIN,STMAX ENT SERCH A EQU 0 B EQU 1 SERCH NOP STA INSTR SAVE BYTE ADDRESS OF INSTR LDA SERCH,I GET ADDRESS OF LENGTH PARM LDA A,I GET LENGTH STA INLEN SAVE LENGTH IN INLEN ISZ SERCH STEP TO RETURN ADDRESS LDA STMAX STA MAX SET INITIAL ENTRY NUMBERS OF LIST TO SEARCH LDA STMIN STA MIN * *NORMALIZE INPUT TO TABLE LENGTH OF 3 WORDS PER ENTRY * *IF IN LENGTH > 6 CHARS NOT FOUND * LDA N7 ADA INLEN SSA,RSS IF NEG THEN LENGTH < 6 CONTINUE JMP NOTFD ELSE ENTRY NOT FOUND LDA @BLK BLANK COMPARE AREA LDB @IST JSB .MVW DEF P3 NOP LDA INSTR MOVE INSTRUCTION INTO COMPARE AREA LDB @BIST USE BYTE ADDRESSING TO GET RIGHT NUM CHARS JSB .MBT DEF INLEN NOP * *LOOP TO SEARCH TABLE FOR INSTR * LP1 LDB MIN FOR EACH LOOP DISPLACEMENT IN CMB,INB TABLE FOR COMPARE LOCATION = ADB MAX (MAX-MIN)/2 CLE,ERB TRUNCATE FRACTION SZB,RSS IF ZERO DISPLACEMENT NOT IN LIST JMP NOTFD ADB MIN B NOW CONTAINS ENTRY NUMBER *NOTE THERE IS NO 0'TH ENTRY *NOTE THERE IS NO N'TH ENTRY WHERE N=STMAX STB DISP STORE ENTRY NUMBER BLS MULTIPLY ENTRY TIMES 5 TO GET CLE,ELB DISPLACEMENT IN WORDS ADB DISP THIS METHOD SHOULD BE FAST ON L ADB TABAD B NOW HAS TABLE ENTRY WORD ADDRESS LDA @IST WORD ADDRESS OF INSTR TO FIND JSB .CMW DEF P3 PCOMPARE WORDS SHOULD BE FASTER NOP * THAN COMPARE BYTES JMP FOUND EQUALS EXIT JMP LESS INSTR LESS THAN TABLE ENTRY MORE LDB DISP RESET BOUNDS OF TABLE AND RETRY STB MIN JMP LP1 LESS LDB DISP STB MAX JMP LP1 * *PROCESS RESULT OF SEARCH * FOUND ADB N3 B NOW CONTAINS WORD ADDRESS OF START OF MATCH ENTRY LDA P0 SET FOUND FLAG JMP SERCH,I RETURN NOTFD LDA N1 SET NOT FOUND FLAG JMP SERCH,I RETURN * *DATA AREA * INLEN BSS 1 LENGTH OF INSTR SHOULD BE <6 INSTR BSS 1 BYTE ADDRESS OF INSTR TO LOOK FOR MIN BSS 1 CURRENT MIN ENTRY BOUNDARY NUMBER MAX BSS 1 CURRENT MAX ENTRY BOUNDARY NUMBER DISP BSS 1 DISPLACEMENT IN TABLE IN ENTRY NUMBERS P0 DEC 0 N1 DEC -1 N7 DEC -7 N3 DEC -3 P3 DEC 3 TABAD DEF TABLE-5 WANT ABSOLUTE ADDRESS HERE DISPLACED FOR NO 0 ENTRY @BLK DEF BLK BLK ASC 3, @IST DEF IST @BIST DBL IST IST BSS 3 BUFFER LOCATION FOR INSTRUCTION TO FIND EXT .CMW EXT .MBT EXT .MVW END ASMB,R,Q,C * *INSTRUCTION TABLE * *ENTRY * 3 WORDS INSTR LEFT JUSTIFIED * 1 BYTE NUM OF DUMMY ENTRIES FOR INSTR * 1 BYTE NUM OF PARMS FOR INSTR (ADDRESS'S) * 1 BYTE CODE FOR INSTRUCTION TYPE * 0 EXTENDED INSTRUCTION * 1 FLOATING POINT INSTRUCTION * 2 SCIENTIFIC INSTRUCTION * 3 FAST FORTRAN * 4 DMS INSTRUCTION * 5-255 UNUSED CODES * 1 BYTE MARK WORD FOR INSTRUCTION USED * NAM TABLE ENT STMIN,STMAX,TABAD ENT TABLE STMIN DEC 0 MINUMUM ENTRY NUMBER -1 * ENTRIES RUN FROM 1 TO N STMAX DEC 122 NUM OF ENTRIES (N) +1 * ACCOUNTS FOR NONEXISTANT O'TH AND N'TH ENTRIES TABAD DBL TABLE-5 ACCOUNT FOR jENTRY 1 AT ADDRESS 0 NOP FIX FOR ASSEMBLER SICE WON'T ALLOW NEG DISPLACEMENTS NOP NOP SUP PRESS PRINTING SKP BEGIN TABLE ON CLEAR PAGE TABLE ASC 3,.DCM FF OCT 1 OCT 1400 ASC 3,.MAP FAST FORT FF OCT 0 OCT 1400 ASC 3,ADX INSTR LEFT JUSTIFIED IN 6 CHAR FIELD DEC 1 1 OPERAND NOP INSTR USED MARK ASC 3,ADY NOP NOP ASC 3,ALOG SCIENTIFIC NOP OCT 1000 ASC 3,ALOGT SCIENTIFIC NOP OCT 1000 ASC 3,ATAN SCIENTIFIC NOP OCT 1000 ASC 3,CAX NOP NOP ASC 3,CAY NOP NOP ASC 3,CBS DEC 2 NOP ASC 3,CBT OCT 401 1 DUMMY 1 PARM NOP ASC 3,CBX NOP NOP ASC 3,CBY NOP NOP ASC 3,CMW OCT 401 1 DUMMY 1 PARM NOP ASC 3,COS SCIENTIFIC OCT 0 OCT 1000 ASC 3,CXA NOP NOP ASC 3,CXB NOP NOP ASC 3,CYA NOP NOP ASC 3,CYB NOP NOP ASC 3,DBLE FF OCT 3 OCT 1400 ASC 3,DDINT FF OCT 3 OCT 1400 ASC 3,DFER FF OCT 2 OCT 1400 ASC 3,DJP DMS INSTRUCTION OCT 1 OCT 2000 ASC 3,DJS DMS INSTRUCTION OCT 1 OCT 2000 ASC 3,DSX NOP NOP ASC 3,DSY NOP NOP ASC 3,ENTP FF OCT 0 OCT 1400 ASC 3,ENTR FF OCT 0 OCT 1400 ASC 3,EXP SCIENTIFIC NOP OCT 1000 ASC 3,FAD FLOATING POINT INSTRUCTION OCT 1 1 OPERAND OCT 400 FLOAT INSTRUCTION TYPE ASC 3,FDV OCT 1 OCT 400 ASC 3,FIX OCT 0 OCT 400 ASC 3,FIXD FP NOP  OCT 400 ASC 3,FLT OCT 0 OCT 400 ASC 3,FLTD FP NOP OCT 400 ASC 3,FLUN FF OCT 0 OCT 1400 ASC 3,FMP OCT 1 OCT 400 ASC 3,FSB OCT 1 OCT 400 ASC 3,GOTO FF OCT 0 OCT 1400 ASC 3,ISX NOP NOP ASC 3,ISY NOP NOP ASC 3,JLY DEC 1 NOP ASC 3,JPY DEC 1 NOP ASC 3,JRS DMS INSTRUCTION OCT 2 OCT 2000 ASC 3,LAX DEC 1 NOP ASC 3,LAY DEC 1 NOP ASC 3,LBT NOP NOP ASC 3,LBX DEC 1 NOP ASC 3,LBY DEC 1 NOP ASC 3,LDX DEC 1 NOP ASC 3,LDY DEC 1 NOP ASC 3,LFA DMS NOP OCT 2000 ASC 3,LFB DMS NOP OCT 2000 ASC 3,MBF DMS NOP OCT 2000 ASC 3,MBI DMS NOP OCT 2000 ASC 3,MBT OCT 401 1 DUMMY 1 PARM NOP ASC 3,MBW DMS NOP OCT 2000 ASC 3,MVW OCT 401 1 DUMMY 1 PARM NOP ASC 3,MWF DMS NOP OCT 2000 ASC 3,MWI DMS NOP OCT 2000 ASC 3,MWW DMS NOP OCT 2000 ASC 3,PAA DMS NOP OCT 2000 ASC 3,PAB DMS NOP OCT 2000 ASC 3,PACK FF OCT 0 OCT 1400 ASC 3,PBA DMS NOP OCT 2000 ASC 3,PBB DMS NOP OCT 2000 ASC 3,PWR2 FF OCT 0 OCT 1400 ASC 3,RSA DMS NOP OCT 2000 ASC 3,RSB DMS NOP OCT 2000 ASC 3,RVA DMS NOP OCT 2000 ASC 3,RVB DMS NOP OCT 2000 ASC 3,SAX DEC 1 NOP ASC 3,SAY DEC i1 NOP ASC 3,SBS DEC 2 NOP ASC 3,SBT NOP NOP ASC 3,SBX DEC 1 NOP ASC 3,SBY DEC 1 NOP ASC 3,SETP FF OCT 0 OCT 1400 ASC 3,SFB NOP NOP ASC 3,SIN SCIENTIFIC NOP OCT 1000 ASC 3,SJP DMS OCT 1 OCT 2000 ASC 3,SJS DMS OCT 1 OCT 2000 ASC 3,SNGL FF OCT 2 OCT 1400 ASC 3,SQRT SCIENTIFIC NOP OCT 1000 ASC 3,SSM DMS OCT 1 OCT 2000 ASC 3,STX DEC 1 NOP ASC 3,STY DEC 1 NOP ASC 3,SYA DMS NOP OCT 2000 ASC 3,SYB DMS NOP OCT 2000 ASC 3,TADD FP OCT 3 OCT 400 ASC 3,TAN SCIENTIFIC NOP OCT 1000 ASC 3,TANH SCIENTIFIC NOP OCT 1000 ASC 3,TBS DEC 2 NOP ASC 3,TDIV FP OCT 3 OCT 400 ASC 3,TFTD FP OCT 1 OCT 400 ASC 3,TFTS FP OCT 1 OCT 400 ASC 3,TFXD FP OCT 1 OCT 400 ASC 3,TFXS FP OCT 1 OCT 400 ASC 3,TMPY FP OCT 3 OCT 400 ASC 3,TSUB FP OCT 3 OCT 400 ASC 3,UJP DMS OCT 1 OCT 2000 ASC 3,UJS DMS OCT 1 OCT 2000 ASC 3,USA DMS NOP OCT 2000 ASC 3,USB DMS NOP OCT 2000 ASC 3,XAX NOP NOP ASC 3,XAY NOP NOP ASC 3,XBX NOP NOP ASC 3,XBY NOP NOP ASC 3,XCA DMS OCT 1 OCT 2000 ASC 3,XCB DMS OCT 1 OCT 2000 ASC 3,XCOM FF OCT 1 OCT 1400 ASC 3,XFER FF OCT 0 OCT 1400 ASC 3,XL&2A DMS OCT 1 OCT 2000 ASC 3,XLB DMS OCT 1 OCT 2000 ASC 3,XMA DMS OCT 0 OCT 2000 ASC 3,XMB DMS NOP OCT 2000 ASC 3,XMM DMS NOP OCT 2000 ASC 3,XMS DMS NOP OCT 2000 ASC 3,XPAK FF OCT 1 OCT 1400 ASC 3,XSA DMS OCT 1 OCT 2000 ASC 3,XSB DMS OCT 1 OCT 2000 END ASMB,R,L,T,C * *ADEXT PROG * THIS PROGRAM IS PART OF CMX2L * IT READS THE INSTR TABLE AND CHECKS FOR * INSTRUCTION USED MARKS * FOR EACH MARK FOUND THE PROGRAM * PRINTS OUT * EXT .INSTR * NAM ADEXT EXT OUTMG,STMAX,TABLE EXT RESB ENT ADEXT A EQU 0 B EQU 1 ADEXT NOP LDA STMAX GET NUMBER OF ENTRIES IN TABLE CMA,INA STA LPCNT INITIALIZE LOOP COUNTER LDB @TABL B POINTS AT START OF INSTR ENTRY JSB RESB NEED DIRECT ADDRESS FOR INDEXING! * *DO LPCNT =-(NUM INSTRUCTIONS+1) TO -1 BY 1 * LOOP1 ISZ LPCNT JMP *+2 JMP ADEXT,I WHEN DONE WITH TABLE RETURN ADB P4 STEP TO INSTR USED WORD LDA B,I GET MARK AND INSTR TYPE AND P3 CHECK ONLY INSTRUCTION USED MARK AND EXT MARK SZA JSB PEXT INSTRUCTION USED PRINT EXT INB STEP TO NEXT TABLE ENTRY JMP LOOP1 * *PRINT EXT STATEMENT * PEXT NOP CPA P1 IF NOT ALREADY EXT THEN DO EXT JMP *+2 NO EXT FOUND ADD ONE JMP PEXT,I MARK SET RETURN STB TEMP ADB N4 GET INSTRUCTION MENOMIC LDA B LDB @MS MOVE MENOMIC INTO EXT MESSAGE JSB .MVW DEF P3 NOP LDA @MSNM JSB OUTMG PRINT MESSAGE TO OUTPUT FILE LDB TEMP JMP PEXT,I DO NEXT ENTRY * *DATA * N4 DEC -4 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 X LPCNT NOP LOOP COUNTER TEMP NOP TEMPORARY STORAGE FOR B REGISTER @TABL DEF TABLE WORD ADDRESS OF FIRST ENTRY IN INSTR TABLE @MS DEF MSNM+7 POINT FOR SUBSTITUTION OF INSTR MENOMIC @MSNM DEF MSNM MSNM DEC 9 ASC 9, EXT . EXT .MVW END ASMB,R,Q,C * THIS SUBROUTINE IS A GENERAL OUTPUT ROUTINE USED FOR ASSEMBLING * OUTPUT RECORDS. * PRINTS TO LIST FILE AND OUT FILE * LIST LDCB3 * OUT ODCB2 * OUTPT * OPERAND 1 ADDRESS OF OPTION CODE * 0 PRINT OLD LINE * 1 PRINT OLD LINE START NEW LINE * 2 APPEND NEW LINE TO OLD LINE * 3 START NEW LINE * 4 PRINT OLD LINE LIST ONLY * 5 PRINT OLD START NEW PRINT ON LIST ONLY * 6 ALIAS TO OPTION 2 * 7 ALIAS TO OPTION 3 * OPERAND 2 ADDRESS OF NUMBER OF INPUT CHARACTERS * A REG IS SET TO BYTE ADDRESS OF STRING TO OUTPUT * * NOTE: MAX LENGTH OF OLDLINE AT ANY GIVEN TIME 75 WORDS 150 CHARS * NOTE: ODCB2 DATA CONTROL BLOCK EXTERNAL RECOMENDED LENGTH 144 WORDS * NOTE: FLERR EXTERNAL ROUTINE TO GENERATE APPROPRIATE ERROR MESSAGE * FMP ERROR CODE RETURNED IN A REGISTER * NAM OUTPT ENT OUTPT EXT WRITF,ODCB2,FLERR,FILE2,IERR2 EXT LDCB3,FILE3,IERR3 A EQU 0 B EQU 1 SUP PRESS PRINTING OUTPT NOP STA @BIN SAVE A REGISTER ADDRESS PARM LDA OUTPT,I GET OPTION ADDRESS ISZ OUTPT SET TO LENGTH PARM LDA A,I GET OPTION CODE STA OPTN SAVE OPTION FOR OUTPUT VERSUS LIST TEST AND =B3 SELECT ONLY VALID OPTION BITS ADA @JPTB USE ADDRESS JUMP TABLE TO DECODE OPTION LDA A,I GET ADDRESS OF ROUTINE TO EXECUTE JMP A,I @JPTB DEF *+1 DEF PNTO PRINT OLD DEF POSN PRINT OLD START NEW DEF ANOL APPEND NEW TO OLD DEF STNL START NEW LIWNE * ALL OPTIONS REFER TO CONSTRUCTION OF OUTPUT * BUFFER FOR OUTPUT TO FILE OR LU DEVICE PNTO JSB WRIT PRINT OLD LINE ISZ OUTPT SET TO RETURN ADDRESS JMP OUTPT,I RETURN POSN JSB WRIT PRINT OLD START NEW STNL JSB CLRLN CLEAR OLD OUTBUF ANOL JSB STNW APPEND NEW LINE ISZ OUTPT SET TO RETURN ADDRESS JMP OUTPT,I RETURN * *WRIT ROUTINE WRITES OUTBUFFER TO FILE * WRIT NOP LDA OIL GET OUTBUF LENGTH IN CHARS SZA,RSS IF ZERO LENGTH TO OUT JMP WRIT,I THEN RETURN SLA,ARS CONVERT TO WORDS INA IF WAS ODD PRINT EXTRA WORD STA WRDLN SAVE IN WORDLENGTH JSB WRITF WRITE THE BUFFER DEF *+5 DEF LDCB3 LIST DATA CONTROL BLOCK DEF IERR3 LIST ERROR FLAG DEF OUTBF OUTBUFFER DEF WRDLN OUT BUFFER LENGTH IN WORDS SSA,RSS SEE IF ERROR ON OUTPUT FILE JMP WROT SEE IF WRITE TO OUTPUT JSB FLERR ERROR RETURN DEF FILE3 PARM FOR FLERR * *WRITE TO OUT FILE IF NECESSARY * WROT LDA OPTN GET OPTION AND M4 CHECK BIT 2 SZA IF BIT 3 SET DONOT WRITE TO OUTPUT JMP WRIT,I RETURN NO OUTPUT WRITE * *WRITE TO OUTPUT FILE * JSB WRITF DEF *+5 DEF ODCB2 OUTPUT DATA CONTROL BLOCK DEF IERR3 ERROR PARM FOR OUTPUT FILE DEF OUTBF OUTPUT BUFFER DEF WRDLN BUFFER LENGTH IN WORDS SSA,RSS SEE IF ERROR JMP WRIT,I NORMAL RETURN WRITE LIST AND OUTPUT JSB FLERR ERROR EXIT FROM PROGRAM DEF FILE2 FILE NAME PARM * *CLRLN CLEARS OUTBUF POINTERS TO ALLOW NEW LINE * CLRLN NOP LDA P0 STA OIL JMP CLRLN,I RETURN * *STNW APPENDS INPUT TO OUTPUT BUFFER * STNW NOP LDA OUTPT,I GET NUM CHARS TO TRANSFER LDA A,I STA NMCHR * *CHECK FOR OUTPUT BUFFER TOO LONG 150 CHARS MAX * X ADA OIL CMA,INA ADA P150 SSA,RSS IF NEG TOO LONG JMP OKLG OK DO IT LDA OIL TRUNCATE TO 150 CHARS CMA,INA ADA P150 SZA,RSS JMP STNW,I RETURN IF ZERO CHARS TO MOVE STA NMCHR ELSE UPDATE NUM CHARS TO MOVE OKLG LDA @BIN GET SOURCE ADDRESS LDB @BOUT GET DEST ADDRESS ADB OIL JSB .MBT DEF NMCHR MOVE TO OUTBUF NOP LDA @BSPC APPEND TRAILING SPACE * EXTRA SPACE ALLOWS WORDS OUTPUT WITHOUT * SPECIAL HANDLING JSB .MBT DEF P1 NOP LDB OIL FIX OUTPUT LINE CHAR LENGTH ADB NMCHR STB OIL JMP STNW,I RETURN * *DATA * P0 DEC 0 P1 DEC 1 M4 OCT 4 P150 DEC 150 OPTN NOP INPUT CONTROL OPTION @BIN NOP BYTE ADDRESS OF INPUT @BOUT DBL OUTBF BYTE ADDRESS OF OUTPUT BUFFER @BSPC DBR SPC ADDRESS OF SPACE TO APPEND TO ENDLINE SPC OCT 40 NMCHR NOP NUMBER OF CHARACTERS IN INPUT BUFFER OIL DEC 0 OUTPUT LINE LENGTH IN CHARS WRDLN NOP OUTPUT LINE LENGTH IN WORDS OUTBF ASC 25, ASC 26, EXT .MBT END ASMB,R,L,T,C NAM OUTMG ENT OUTMG EXT OUTPT A EQU 0 B EQU 1 *OUTMG PRINTS STANDARD MESSAGES ON OUTPUT FILE USING * PROGRAM OUTPT PART OF CMX2L SYSTEM * * RECEIVES WORD ADDRESS OF MESSAGE RECORD IN A REG * MESSAGE RECORD FIRST WORD IS NUMBER OF WORDS IN MESSAGE * A ADDRESS MAY BE INDIRECT * OUTMG NOP * *RESOLVE ADDRESS TO ALLOW INDEXING TO MESSAGE * RESLP SSA,RSS JMP RESL DONE HAVE FINAL ADDRESS AND =B077777 CLEAR INDIRECT BIT LDA A,I GET NEXT ADDRESS IN CHAIN JMP RESLP RESL LDB A,I GET NUMBER WORDS IN MESSAGE CLE,ELB CONVERT WORDS TO CHARACTERS STB CHRNM SAVE NUMBER CHARS IN MESSAGE INA STEP TO ADDRESS OF MESSAGE CLE,ELA CONVERT TO BYTE ADDRESS JSB OUTPT DEF P3 NEW LINE DEF CHRNM LENGTH LDA P0 JSB OUTPT DEF P0 PRINT LIE DEF P0 JMP OUTMG,I RETURN * *DATA * P0 DEC 0 P3 DEC 3 CHRNM NOP NUM CHARS IN MESSAGE END ASMB R,Q NAM REPLA ENT .CBS,.CBT,.CMW,.LBT,.MBT,.MVW,.SFB,.TBS .CBS RPL 105774B .CBT RPL 105766B .CMW RPL 105776B .LBT RPL 105763B .MBT RPL 105765B .MVW RPL 105777B .SFB RPL 105767B .TBS RPL 105775B END ASMB,R,Q,C * *PROGRAM OUTPUTS A MESSAGE TO LIST DEVICE OR FILE AND * TO TERMINAL NO OUTPUT TO OUTPUT FILE * * REG A WORD ADDRESS OF START OF MESSAGE BUF * MESSAGE BUFFER * WORD 1 NUMBER OF WORDS IN MESSAGE * WORD 2-N MESSAGE * LIST DCB IS LDCB3 * TERM IS OPRLU * OUTPT IS OUTPUT BUFFERING ROUTINE OF CMX2L * NAM OUTML ENT OUTML EXT RESA,OUTPT,REIO,OPRLU A EQU 0 B EQU 2 OUTML NOP JSB RESA RESOLVE POSSIBLE INDIRECT ADDRESS LDB A,I GET NUMBER WORDS IN MESSAGE STB NMWRD SAVE NUMBER WORDS CLE,ELB CONVERT TO CHARS IN MESSAGE STB CHRNM SAVE NUMBER OF CHARS IN MESSAGE INA STEP TO FIRST WORD OF MESSAGE STA @DMSG SAVE WORD ADDRESS OF START OF MESSAGE CLE,ELA CONVERT TO BYTE ADDRESS FOR OUTPT JSB OUTPT PRINT MESSAGE ON LIST DEVICE DEF P3 NEW LINE DEF CHRNM NUMBER OF CHARS LDA P0 FORCE PRINTING OF BUFFER JSB OUTPT DEF P4 PRINT ON LIST FILE ONLY DEF P0 JSB REIO PRINT TO TERMINAL DEF *+5 DEF P2 PRINT DEF OPRLU TERMINAL LU DEF @DMSG,I MESSAGE DEF NMWRD NUMBER OF WORDS JMP OUTML,I RETURN * *DATA * P0 DEC 0 P2 DEC 2 P3 DEC 3 P4 DEC 4 NMWRD NOP NUMBER OF WORDS IN MESSAGE CHRNM NOP \ NUMBER OF CHARS IN MESSAGE @DMSG NOP WORD ADDRESS OF FIRST WORD OF MESSAGE END l i* 24999-18296 2024 S 0100 &LMOD SOURCE             H0101 FTN4,L PROGRAM LMOD(3,89), 24999-16296 REV.2024 79.11.01 IMPLICIT INTEGER (A-Z) COMMON/TERM/LU,LIST COMMON/INPUT/LENG,INPUT(40) COMMON/SNDAT/NENTS,NLIBS,LWABG,FWABG,FWART, . SYBP,BGBP,RTBP,FWAC,LCOM,SYSID,CKSUM COMMON/SNAP/SNAP(9),SNERR,DCBSN(144),RECSN(128) COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128) COMMON/RTE/SYTYPE LOGICAL NAMR,PARM,SKIP,FMPER,NEWFIL,QUIT,FOPEN REAL STATUS,STRNG,GETEM,REIO DIMENSION ABREG (2) EQUIVALENCE (ABREG(1),RESULT), (ABREG,STATUS), . (ABREG(2),SIZE) DATA LEN/40/, POS/1/, EMPTY/1/, ECHO/400B/, . RD/1/, WR/2/, HONEST/2000B/, . EXCLS/0/, EOF/-1/, SPACE/40B/ C FUNCTION STATEMENTS PARM (BUF,POS) = .NOT. (NAMR(BUF,INPUT,SIZE,POS)) STRNG (BUF,LN) = EXEC (14,1,BUF,LN) GETEM (BUF,LN) = REIO (RD,LU+ECHO,BUF,LN) C START OF PROGRAM. GET TERMINAL LOGICAL UNIT. THEN GET C RUN STRING. IF EMPTY, REQUEST FROM TERMINAL LU = LOGLU (DUMMY) LIST = LU C SYTPE CONTAINS $OPSY. ADJUST FOR PROPER FUDGE FACTOR TO C MAKE EXEC READ/WRITE TO DISC DRIVER. TYPE = IGET (SYTYPE) SYTYPE = 177400B IF (TYPE.EQ.-31) SYTYPE = 7700B STATUS = STRNG (INPUT,-2*LEN) CALL EXEC (2,LU,40H RTE-L MEMORY/DISC UTILITY VERS 79.11.01,-40) CALL EXEC (2,LU,17H TYPE ?? FOR HELP,-17) C MOVE POS PAST FIRST TWO COMMAS (:RU,PROG,) SKIP = PARM (SNAP,POS) SKIP = PARM (SNAP,POS) C ABOVE TWO STATEMENTS OMITTED FOR RTE-M IF (RESULT .NE. EMPTY) GO TO 20 10 POS = 1 CALL EXEC (WR,LU+HONEST,26H SNAP FILE, SYSTEM FILE:,-26) STATUS = GETEM (INPUT,-2*LEN) C GET 1ST TWO PARAMETERS FROM RUN STRING OR FROM TERMINAL LU. C IF OK, PROCEED. EITHER NAMR MAY BE A DEVICE RATHER A FILE. 20 IF (.NOT.(PARM(SNAP,POS)) .OR. .NOT.(PARM(SYSTM,POS))) GO TO 10 NEWFIL = FOPEN (SNAP) IF (.NOT. NEWFIL) GO TO 99 LENGTH = FREAD (SNAP,1) IF (LENGTH .NE. 12) GO TO 99 CALL MOVE (RECSN,NENTS,12) NEWFIL = FOPEN (SYSTM) IF (.NOT. NEWFIL) GO TO 99 C REPEAT 50 CONTINUE CALL EXEC (WR,LU+HONEST,2H>>,1) STATUS = GETEM (INPUT,-2*LEN) LENG = SIZE CALL CMDLN (INPUT,SIZE,QUIT) C UNTIL QUIT IF (.NOT.QUIT) GO TO 50 99 CALL CLOSE (DCBSN) CALL CLOSE (DCBSY) END BLOCK DATA IMPLICIT INTEGER (A-Z) LOGICAL REL,DECML COMMON/TERM/LU,LIST COMMON/INPUT/LENG,INPUT(40) COMMON/RBUF/RBUF(33) COMMON/NSECTS/NSECTS COMMON/BASE/BASE,REL,DECML,MODE COMMON/SNDAT/NENTS,NLIBS,LWABG,FWABG,FWART, . SYBP,BGBP,RTBP,FWAC,LCOM,SYSID,CKSUM COMMON/SNAP/SNAP(9),SNERR,DCBSN(144),RECSN(128) COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128) COMMON/IO/INPT,OUTP,NAME(3),SC,CART DATA REL/.FALSE./ DATA DECML/.FALSE./ DATA BASE/0/ DATA MODE/0/ DATA LU/1/ DATA SC/0/,CART/0/ DATA NSECTS/96/ DATA INPT/2HME/,OUTP/2HME/ END LOGICAL FUNCTION FOPEN (BUFF) IMPLICIT INTEGER (A-Z) LOGICAL FMPER DIMENSION BUFF(11) CALL OPEN (BUFF(11),BUFF(10),BUFF,0,BUFF(5),BUFF(6)) FOPEN = (.NOT.(FMPER (5HOPENF ,BUFF))) RETURN END INTEGER FUNCTION FREAD (BUFF,NUM) IMPLICIT INTEGER (A-Z) LOGICAL FMPER DIMENSION BUFF(372) CALL READF (BUFF(11),BUFF(10),BUFF(155),128,LEN,NUM) FREAD = LEN IF (FMPER (5HREADF ,BUFF)) FREAD = - 2 RETURN END SUBROUTINE CMDLN (INPUT,SIZE,QUIT) IMPLICIT INTEGER (A-Z) LOGICAL REL,DEC,PARMS DIMENSION INPUT(1),LOC(2) COMMON/TERM/LU,LIST COMMON/RBUF/RBUF(33) C COMMON/SNAP/SNAP(9),SNERR,DCBSN(144),RECSN(128) COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128) COMMON/BASE/BASE,REL,DEC,MODE DIMENSION NUMBR (4),PBUF (10) LOGICAL QUIT,REL,DEC,DECML CALL PARSE (INPUT,SIZE,RBUF) IF (.NOT.(RBUF(1).EQ.0)) GO TO 100 C NULL ENTRY GO TO 777 100 IF (.NOT.(RBUF(1).EQ.1)) GO TO 200 C NUMERIC ENTRY - INTERPRET AS OCTAL INPUT CALL UPDAT GO TO 999 200 IF (RBUF(2).NE.2H/E) GO TO 210 QUIT = .TRUE. GO TO 999 210 IF (RBUF(2).NE.2HLI) GO TO 220 CALL SYMBL (LU,VALUE,RBUF(6)) GO TO 999 220 IF (RBUF(2).NE.2HDI) GO TO 240 CALL STABL GO TO 999 240 IF (RBUF(2).NE.2H??) GO TO 250 CALL CLIST GO TO 999 250 IF (RBUF(2).NE.2HDL) GO TO 260 CALL DLIST GO TO 999 260 IF (RBUF(2).NE.2HDM) GO TO 270 CALL DMODF GO TO 999 270 IF (RBUF(2).NE.2HIO) GO TO 280 CALL SETIO GO TO 999 280 IF (RBUF(2).NE.2HDS) GO TO 290 CALL FWORD GO TO 999 290 IF (RBUF(2).NE.2HFI) GO TO 300 CALL FWORD GO TO 999 300 IF (RBUF(2).NE.2HNS) GO TO 310 CALL SECTS GO TO 999 310 IF (RBUF(2).NE.2HLM) GO TO 315 CALL MEMRY GO TO 999 315 IF (RBUF(2).NE.2HLR) GO TO 320 CALL MEMRY GO TO 999 320 IF (RBUF(2).NE.2HMD) GO TO 330 CALL MDUMP GO TO 999 330 IF (RBUF(2).NE.2HBA) GO TO 340 CALL SETBA GO TO 999 340 IF (RBUF(2).NE.2HTR) GO TO 350 CALL TRACE GO TO 999 350 IF (RBUF(2).NE.2HCA) GO TO 360 CALL CALC GO TO 999 360 IF (RBUF(2).NE.2HDV) GO TO 370 CALL DVT GO TO 999 370 IF (RBUF(2).NE.2HIF) GO TO 380 CALL IFT GO TO 999 380 IF (RBUF(2).NE.2HID) GO TO 390 CALL ID GO TO 999 390 CONTINUE 777 CALL EXEC (2,LU,8H WHAT?? ,4) 999 REL = .FALSE. DEC = .FALSE. RETURN END SUBROUTINE MOVE (BUF1,BUF2,LEN) IMPLICIT INTEGER (A-Z) DIMENSION BUF1(1),BUF2(1) DO 100 I = 1, LEN 100 BUF2 (I) = BUF1 (I) RETURN END END$ ASMB,R,L NAM RTE,7 Pick up $OPSY ENT RTE EXT $OPSY RTE DEF $OPSY+0 END FTN4,L INTEGER FUNCTION GPARM (NUM,DFLT) IMPLICIT INTEGER (A-Z) COMMON/TERM/LU COMMON/RBUF/RBUF(33) P = 4 * NUM + 1 GPARM = RBUF (P+1) IF (RBUF(P) .EQ. 0) GPARM = DFLT RETURN END LOGICAL FUNCTION PARMS (NUM) IMPLICIT INTEGER (A-Z) COMMON/TERM/LU COMMON/RBUF/RBUF(33) PARMS = .TRUE. DO 10 J = 1,NUM IF (RBUF(4*J+1).EQ.0) PARMS = .FALSE. 10 CONTINUE IF (.NOT.PARMS) . CALL EXEC (2,LU,25H INSUFFICIENT PARAMETERS!,-25) RETURN END LOGICAL FUNCTION PATCH (ADDR,VALUE,PLACE) IMPLICIT INTEGER (A-Z) LOGICAL STATUS,FWRIT COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128) COMMON/TERM/LU LOC = IABS (ADDR) IF (PLACE .NE. 2HME) GO TO 20 CALL IPUT (LOC,VALUE) PATCH = .TRUE. GO TO 900 20 IF (PLACE .NE. 2HDI) GO TO 900 REC = LOC/128 + 1 WORD = MOD (LOC,128) + 1 LEN = FREAD (SYSTM,REC) RECSY (WORD) = VALUE PATCH = FWRIT (SYSTM,REC,128) 900 RETURN END LOGICAL FUNCTION FWRIT (BUF,RECNO,LEN) IMPLICIT INTEGER (A-Z) LOGICAL FMPER DIMENSION BUF (282) FWRIT = .FALSE. CALL WRITF (BUF(11),BUF(10),BUF(155),LEN,RECNO) FWRIT = .NOT. FMPER (5HWRITF ,BUF) RETURN END LOGICAL FUNCTION GETEM (LOC,VALUE,PLACE) IMPLICIT INTEGER (A-Z) COMMON/TERM/LU COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128)  COMMON/IO/INPT,OUTPT,NAME(3),SEC,CART GETEM = .FALSE. 5 IF (LOC.GT.1) GO TO 10 C A, B REGISTERS OUT OF BOUNDS GO TO 900 10 IF (PLACE .NE. 2HME) GO TO 20 VALUE = IGET (LOC) GETEM = .TRUE. GO TO 900 20 IF (PLACE .NE. 2HDI) GO TO 900 REC = LOC/128 + 1 WORD = MOD (LOC,128) + 1 LEN = FREAD (SYSTM,REC) VALUE = RECSY (WORD) IF (LEN .GE. 0) GETEM = .TRUE. 900 RETURN END END$ FTN4,L SUBROUTINE DIGITS (VALUE,BASE,OUTPT) IMPLICIT INTEGER (A-Z) DIMENSION OUTPT (3), TEMP (5) IF (BASE .EQ. 10) GO TO 5 SIGN = 1H0 WORD = IAND (VALUE,77777B) IF (VALUE .LT. 0) SIGN = 1H1 GO TO 10 5 SIGN = 1H WORD = IABS (VALUE) IF (VALUE .LT. 0) SIGN = 1H- 10 DO 20 I = 5,1,-1 TEMP (I) = MOD (WORD,BASE) 20 WORD = WORD/BASE S = 0 CALL SETDB (OUTPT,S) CALL CPUT (SIGN) DO 30 I = 1, 5 30 CALL CPUT ((TEMP(I)+60B)*256 + 40B) RETURN END END$ FTN4,L LOGICAL FUNCTION SHOW (LU,LOC,PLACE) IMPLICIT INTEGER (A-Z) LOGICAL DISPL DIMENSION MESS (40) SHOW = DISPL (LOC,PLACE,MESS,VALU) CALL INVRS (LOC,VALU,MESS(20),20,NWORD) IF (SHOW) CALL EXEC (2,LU,MESS,19+NWORD) RETURN END END$ FTN4,L LOGICAL FUNCTION DISPL (LOC,PLACE,USER,VALU) C FORMAT BUFFER AS OCTAL,DECIMAL,ACSII AND SHOW DISC/MEM SOURCE C USER IS ASSUMED TO HAVE AT LEAST 19 WORDS AND IS FILLED BY C DISPL IMPLICIT INTEGER (A-Z) DIMENSION LOC (2),USER(19) LOGICAL GETEM,TEST,REL,DEC COMMON/BASE/BASE,REL,DEC,OFSET DIMENSION MESS (19) EQUIVALENCE (MESS(5),MEMR), (MESS(10),OCTAL), (MESS(14),DECML), . (MESS(18),CHARS) DATA MESS/3*2H ,2H (,3*2H ,2H ,2H: ,10*2H / C NOTE: LOC < 0 MEANS SHOW ABS(LOC) BUT USE LOC(2) AS ADDR TO DISPAY BA = 8 MESS (w8) = 2H ) ADDR = LOC DISP = ADDR IF (.NOT.REL) GO TO 10 DISP = LOC (2) IF (DEC) BA = 10 MESS (8) = 2HR) 10 TEST = GETEM (ADDR,VALUE,PLACE) VALU = VALUE IF (.NOT.TEST) GO TO 900 MESS (2) = PLACE MESS (3) = 2HSC IF (MESS(2).EQ.2HME) MESS(3) = 2HM IF (REL) DISP = DISP + OFSET CALL DIGITS (DISP,BA,MEMR) CALL DIGITS (VALUE,8,OCTAL) CALL DIGITS (VALUE,10,DECML) CHARS = ASCII (VALUE) CALL MOVE (MESS,USER,19) 900 DISPL = TEST RETURN END END$ FTN4,L SUBROUTINE SHOWB (LU,INDEX,VALUE) C SHOW DISC BUFFER AT INDEX. INDEX STARTS WITH 1. IMPLICIT INTEGER (A-Z) DIMENSION MESS (16) EQUIVALENCE (MESS(2),WORD), (MESS(5),OCTAL), (MESS(9),DECML), . (MESS(13),CHARS) DATA MESS/2H (,2H ,2H):,13*2H / WORD = KCVT (INDEX) CALL DIGITS (VALUE,8,OCTAL) CALL DIGITS (VALUE,10,DECML) CHARS = ASCII (VALUE) MESS (1) = 2H ( MESS (3) = 2H): IF (INDEX.GT.0) GO TO 100 MESS (1) = 2H MESS (2) = 2H MESS (3) = 2H 100 CALL EXEC (2,LU,MESS,16) RETURN END END$ FTN4,L SUBROUTINE BITS (WORD,LIST) IMPLICIT INTEGER (A-Z) DIMENSION BUF (12) S = 0 CALL SETDB (BUF,S) CALL CPUT (1H ) DO 10 J = 16,1,-1 IF (MOD(J,3).EQ.0) CALL CPUT (1H ) CHAR = 1H0 TEST = ROTATE (WORD,J) IF (TEST.LT.0) CHAR = 1H1 10 CALL CPUT (CHAR) CALL EXEC (2,LIST,BUF,-S) RETURN END END$ ASMB,L NAM ROTAE,7 INTEGER FUNCTION TO ROTATE WORD ENT ROTAE EXT .ENTR WORD BSS 1 16 BIT WORD TO ROTATE NBITS BSS 1 NUMBER BITS TO ROTATE RIGHT ROTAE NOP JSB .ENTR DEF WORD GET PARAMETERS LDA NBITS,I NUMBER OF BITS AND =B17 PERMIT ONLY LOW{ 4 BITS TO SPECIFY ROTATE LDB WORD,I GET WORD TO ROTATE SWP SWAP REGISTERS SZB,RSS JMP ROTAE,I ZERO BITS TO ROTATE. LEAVE ALONE. CMB,INB SET B TO NEGATIVE OF COUNT * LOOP RAR ROTATE RIGHT 1 BIT INB,SZB JMP LOOP * JMP ROTAE,I END FTN4,L INTEGER FUNCTION OCTAL (P) IMPLICIT INTEGER (A-Z) COMMON/INPUT/LENG,INPUT(40) DIMENSION BUF(10),PBUF(10) INCNT = 1 OUCNT = 0 CALL SETSB (INPUT,INCNT,LENG) CALL SETDB (BUF,OUCNT) CMCNT = P - 1 PBUF = 0 C P = PARAMETER NUMBER. COUNT NUMBER OF COMMAS = P - 1 10 IF (CMCNT.EQ.0) GO TO 20 CHAR = KHAR (CHAR) IF (CHAR.EQ.1H, ) CMCNT = CMCNT - 1 IF (CHAR.EQ.0) GO TO 700 GO TO 10 20 CHAR = KHAR (CHAR) IF (CHAR.EQ.1H, .OR. CHAR.EQ.0 .OR. CHAR.EQ.1HD ) GO TO 30 CALL CPUT (CHAR) GO TO 20 30 CALL ZPUT (2HB, ,1,2) POS = 1 CALL NAMR (PBUF,BUF,OUCNT,POS) 700 OCTAL = PBUF RETURN END FTN4,L SUBROUTINE UPDAT IMPLICIT INTEGER (A-Z) LOGICAL SHOW,PATCH,TEST,REL,DEC DIMENSION ANSR (5),MESS(10),CHECK(3),VERIF(22),LOC(2) COMMON/RBUF/RBUF(33) COMMON/IO/INPT,OUTP COMMON/TERM/LU COMMON/BASE/BASE,REL,DEC,MODE COMMON/SNDAT/NENTS,NLIBS,LWABG,FWABG,FWART,SYBP,BGBP,RTBP, . FWAC,LCOM,SYSID,CKSUM COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128) EQUIVALENCE (MESS(9),PLACE) DATA MESS/2H ,2HPA,2HTC,2HH ,2HMA,2HDE,2H T,2HO ,2*2H / DATA CHECK/2HPA,2HTC,2HH / DATA VERIF/10*2H ,2HTO,10*2H ,2H ?/ DATA NULL/0/ LOC = RBUF (2) IF (RBUF(6).EQ.1HR ) REL = .TRUE. IF (RBUF(10).EQ.1HD ) DEC = .TRUE. IF (.NOT.DEC) LOC = OCTAL (1) LOC (2) = LOC (1) IF (REL) LOC = LOC + BASE 5 IF (LOC.LT.2) GO TO 900 C IF ((LOC - FWABG).LT. 0) GO TO 20 \ C *NCALL EXEC (2,LU,13HOUT OF BOUNDS,-13) + MAY PUT BACK IN C GO TO 900 / 20 CONTINUE IF (.NOT.(SHOW(LU+2000B,LOC,INPT))) GO TO 900 CALL REIO (1,LU+400B,ANSR,-10) CALL ABREG (STATUS,SIZE) CALL PARSE (ANSR,SIZE,RBUF) RESULT = RBUF C ANSWER IS OF FORM cr = Advance to next mem/disc loc C N cr = Patch current output shown by C IO command and exit whether or C not patch actually made. C ,/E = Exit (1st parameter null) C INCR = INCREMENT (+ OR -) ON NULL RETURN INCR = + 1 IF (RBUF (6).EQ.2H^ ) INCR = - 1 C ADVANCE/DECREMENT WILL BE MADE ON NULL UNLESS SECOND C PARAMETER IS /E IF (RESULT.NE.NULL) GO TO 30 IF (RBUF(6).EQ.2H/E) GO TO 900 LOC = LOC + INCR LOC (2) = LOC (2) + INCR GO TO 5 30 PLACE = OUTP CALL EXEC (2,LU+2000B,CHECK,3) CALL SHOW (LU,LOC,PLACE) CALL DIGITS (RBUF(2),8,VERIF(13)) CALL DIGITS (RBUF(2),10,VERIF(17)) VERIF(21) = ASCII (RBUF(2)) CALL EXEC (2,LU+2000B,VERIF,22) CALL REIO (1,LU+400B,REPLY,1) IF (REPLY.NE.2HYE) GO TO 900 TEST = PATCH (LOC,RBUF(2),PLACE) IF (.NOT.TEST) GO TO 900 MESS (10) = 2HSC IF (PLACE.EQ.2HME) MESS(10) = 2HM CALL EXEC (2,LU,MESS,10) CALL SHOW (LU,LOC,PLACE) 900 RETURN END END$ ASMB,L NAM ASCII,7 MAKE WORD INTO TWO ASCII CHARS EXT .ENTR ENT ASCII A EQU 0 B EQU 1 WORD BSS 1 ASCII NOP JSB .ENTR DEF WORD LDA WORD,I ALF,ALF AND =B377 JSB CNVRT ALF,ALF STA CHARS LDMA WORD,I AND =B377 JSB CNVRT IOR CHARS JMP ASCII,I CNVRT NOP STA B ADB =B-40 SSB LDA =B40 ADB =B-140 SSB,RSS LDA =B40 JMP CNVRT,I CHARS NOP END FTN4,L LOGICAL FUNCTION FMPER (SUBR,PBUF),REPORT FMP ERRORS IMPLICIT INTEGER (A-Z) COMMON/TERM/LU DIMENSION PBUF(10), SUBR (3), MBUFR (19) C PBUF IS THE OUTPUT PARSE BUFFER FROM NAMR FUNCTION. C FMPER CODE IS STORED IN PBUF (10). C SUBR IS THE FMP SUBR FROM WHICH ERROR WAS RETURNED. C MESSAGE = "FFFFFF: FMP ERROR - NN IN FILE AAAAAA" C WORD = 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 DATA MBUFR/2H ,2H ,2H ,2H: ,2HFM,2HP ,2HER,2HRO, . 2HR ,2H- ,2H ,2H I,2HN ,2HFI,2HLE,2H , . 2H ,2H ,2H / DATA WR/2/, ASCII/3/ C FUNCTIONS TYPE (K) = IAND (K,3) C START OF LOGICAL FUNCTION TO REPORT FMP ERRORS FMPER = .FALSE. IF (PBUF(10) .GE. 0) GO TO 99 FMPER = .TRUE. MBUFR ( 1) = SUBR ( 1) MBUFR ( 2) = SUBR ( 2) MBUFR ( 3) = SUBR ( 3) MBUFR (11) = KCVT (-PBUF(10)) MBUFR (17) = PBUF ( 1) MBUFR (18) = PBUF ( 2) MBUFR (19) = PBUF ( 3) IF (TYPE(PBUF(4)).EQ.ASCII) GO TO 10 IF (PBUF(1) .GE. 0) GO TO 5 PBUF(1) = - PBUF(1) MBUFR (16) = 2H - 5 CALL CNUMD (PBUF,MBUFR(17)) 10 CALL EXEC (WR,LU,MBUFR,19) 99 RETURN END END$ FTN4,L LOGICAL FUNCTION ISEQL (STR1,STR2,LEN) IMPLICIT INTEGER (A-Z) DIMENSION STR1(1),STR2(1) ISEQL = .FALSE. DO 100 I = 1, LEN IF (STR1(I).NE.STR2(I)) GO TO 900 100 CONTINUE ISEQL = .TRUE. 900 RETURN END END$ ASMB,Q,C NAM INVRS,7 MOD FOR L-SERIES J. BRIDGES 10.18.79 * * THIS ROUTINE INVERSE ASSEMBLES HP 21MX * INSTRUCTIONS * * THE CALLING SEQUENCE IS AS FOLLOWS * * JSB INVRS * DEF RTRN * DEF ADDRSS LOGICAL ADDRESS OF INSTRUCTION * DEF VALUE INSTRUCTION AT ADDRSS * DEF IBUF OUTPUT BUFFER * DEF ISIZE SIZE OF OUTPUT BUFFER * DEF IWRDS RETURNED NO OF WORDS FILLED * RTRN ... * * FORTRAN CALL: * * CALL INVRS(IADRS,VALUE,IBUF,ISIZE,IWRDS) * * ENT INVRS EXT .ENTR,.DIV,.SBT * * A EQU 0 B EQU 1 * * ADDRS BSS 1 VALUE BSS 1 BUFAD BSS 1 BSIZE BSS 1 WCNT BSS 1 INVRS NOP JSB .ENTR DEF ADDRS LDA BUFAD RAL MAKE BYTE ADDRESS STA BUFAD STA BPNTR LDB BSIZE,I GET BUFFER SIZE RBL MAKE INTO BYTES ADA B COMPUTE END OF BUFFER STA BFEND LDA ADDRS,I STA IADR SAVE ADDRESS OF INSTRUCTION LDA B2 SET NO OF WORDS/ENTRY STA INCR IN INCREMENT JSB LOAD FETCH INSTRUCTION STA INSTR STA TEMP AND B70K IS IT A MEMORY REFERENCE SZA JMP MRGI YES GO GET IT LDA INSTR NO ELA,ALF PUT SIGN IN E REG RAL AND BITS 10&11 IN BITS 0&1 SEZ IF E SET(I.E. SIGN) MUST BE I/O OR EIG JMP IOGI * AND B3 SET UP OP CODE TABLE COUNTER LDB M18 SHIFT ROTATE SLA LDB M12 ALTER SKIP STB CNTR ADA GRTBL GET ADDRESS OF GROUP TABLE LDB A,I * LOOP1 LDA TEMP FETCH REMAINING BITS OF INSTRUCTION AND B,I ARE ALL REQUIRED BITS SET XOR B,I SZA,RSS JMP FOND1 YES GO GET MNEMONIC LOP1A ADB INCR BUMP ADDRESS ISZ CNTR JMP LOOP1 * NFND LDA BUFAD IF WE FALL THROUGH NOT COMPLETELY STA BPNTR DEFINED SO JUST PRINT OCTAL LDA INSTR JSB PN JMP EXIT * IADR BSS 1 INCR BSS 1 INSTR BSS 1 TEMP BSS 1 CNTR BSS 1 BPxNTR BSS 1 * B2 OCT 2 B3 OCT 3 B70K OCT 70000 M12 DEC -12 M18 DEC -18 BFEND BSS 1 * GRTBL DEF *+1 DEF SRGA DEF ASGA DEF SRGB DEF ASGB * MRGA1 DEF MRG-4 * FOND1 JSB POPCD PRINT MNEMONIC LDA B,I REMOVE OPCODE FROM AND B1777 INSTRUCTION XOR TEMP STA TEMP AND B1777 ARE ANY BITS LEFT SZA,RSS JMP EXIT NO,THEN RETURN LDA COMMA JSB TYO PRINT COMMA JMP LOP1A GO LOOK FOR REST * B1777 OCT 001777 COMMA OCT 54 * MRGI LDA INSTR ALF,RAL AND B17 RAL TIMES 2 ADA MRGA1 COMPUTE TABLE POSITION LDB A JSB POPCD PRINT MNEMONIC LDA INSTR COMPUTE ADDRESS AND B2000 MERGE WITH PROPER PAGE SZA LDA IADR XOR INSTR AND B76K XOR INSTR JSB PADR PRINT ADDRESS JMP EXIT * B17 OCT 17 B2000 OCT 2000 B76K OCT 76000 * IOGI LDB IOGTB FETCH TABLE OF LOOP FOR I/O SLA,RSS IF EIG INSTEAD LDB DSGTB THEN GET TABLE FOR EIG'S STB PNTR PARMETERS LDB PNTR,I SET B TO START ISZ PNTR LOOP2 LDA PNTR,I GET COUNT FOR THIS TYPE SSA JMP LOP2A IF NEGATIVE CONTINUE * SZA,RSS IF ZERO THEN DONE JMP NFND LDA B3 STA INCR ELSE SET INCREMENT TO 3 LDA PNTR,I AND MAKE COUNT NEGATIVE CMA,INA * LOP2A STA CNTR ISZ PNTR LOOP3 LDA INSTR FETCH INSTRUCTION XOR B,I SEARCH FOR MATCH AND PNTR,I MASK UNWANTED BITS SZA,RSS JMP FOND2 ADB INCR BUMP ADDRESS IN OPCTBL ISZ CNTR DONE WITH THIS TYPE JMP LOOP3 NO CONTINUE ISZ PNTR JMP LOOP2 YES GO TO NEXT TYPE * * PNTR BSS 1 * FOND2 JSB POPCD GO PRINT MNEMONIC LDA PNTR,I FETCH MASK CMA IF EXACT NO OPERAND IN SAME WORD O AND B77 SZA,RSS JMP OPRND * AND INSTR STRIP OFF OPERAND STA TEMP SAVE FOR COMMA C TEST LDB PNTR,I IS MASK FOR CPB DSMSK A DOUBLE SHIFT GROUP SZA AND OPERAND EQUAL 0 RSS LDA B20 YES MAKE OPERAND IT 16 AND B77 AND MASK C BIT JSB PNUMB GO PRINT NUMBER LDA TEMP AND B1000 IS A COMMA C REQUIRED SZA,RSS NO RETURN JMP EXIT LDA COMMA JSB TYO PRINT COMMA LDA "C JSB TYO PRINT "C" JMP EXIT * * * PRINTS MULTI WORD OPERANDS * OPRND LDA TFLAG TRACING SZA,RSS JMP EXIT NO THEN RETURN * * MUTIWORD PRINT HERE * JMP EXIT * * TFLAG OCT 0 * B20 OCT 20 B77 OCT 77 B1000 OCT 1000 "C OCT 103 * * * PRINT ONE CHARACTER * TYO NOP STB TEMP2 SAVE B REG LDB BPNTR CPB BFEND JMP EXIT IF FULL THEN COMPLETE JSB .SBT ELSE STORE BYTE STB BPNTR UPDATE POINTER LDB TEMP2 RESTORE B REG JMP TYO,I * IOGTB DEF *+1 DEF OVFG DEC -4 OVERFLOW GROUP OCT 177777 DEC -1 CLF OCT 177700 DEC -12 I/O GROUP OCT 176700 OCT 0 INDICATES END OF IO TABLE DSGTB DEF *+1 DEF DSG DEC -6 DOUBLE SHIFT GROUP DSMSK OCT 5760 DEC -90 REST OF BASE SET OCT 5777 * MICROCODED INSTRUCTIONS DEC 27 POSITIVE COUNT MEANS CHANGE INCREMENT OCT 5777 OCT 0 THIS INDICATES END * LOAD NOP LDA VALUE,I JMP LOAD,I * TEMP2 BSS 1 * * PRINT MNEMONIC POPCD NOP STB TEMP3 INB LDA B,I FETCH FIRST 3 CHARS JSB DSQZ GO PRINT THEM LDA INCR CPA B2 DOES MNEMONIC HAVE MORE THAN 3 CHARS JMP POP1 NO,GO TO RETURN LDB TEMP3 7 ADB B2 YES FETCH NEXT 3 CHARS LDA B,I JSB DSQZ GO TO PRINT THEM POP1 LDB TEMP3 RESTORE B REG JMP POPCD,I RETURN * * DSQZ NOP CLB A=SQOZE CODE JSB .DIV DEF D1600 JSB CONV A=FIRST CHAR,B=2ND,3RD LDA B CLB JSB .DIV SPLIT SECOND 2 CHARS DEF D40 JSB CONV LDA B JSB CONV JMP DSQZ,I * * A REG = ONE SQOZE CHARACTER * CONV NOP SZA,RSS IF ZERO THEN TERMINATE DSQZ JMP DSQZ,I * CPA B45 IS IT A "." CCA YES SET TO CONVERT TO 56B ADA M13B IS IT A LETTER SSA,RSS ADA B7 YES ADD 101B ADA B72 NO ADD 57B JSB TYO GO PRINT IT JMP CONV,I RETURN * B7 OCT 7 B45 OCT 45 B72 OCT 72 M13B OCT -13 D40 DEC 40 D1600 DEC 1600 * TEMP3 BSS 1 * * * A =ADDRESS TO BE PRINTED * * PADR NOP PRINT ADDRESS STA SIGN SAVE INDIRECT BIT ELA,CLE,ERA REMOVE SIGN BIT * ************INSERT SYMBOL SEARCH HERE * JSB PNUMB GO PRINT NUMBER LDA SIGN SSA,RSS IS ",I" REQUIRED JMP PADR,I NO THEN RETURN * LDA COMMA YES THEN PRINT ",I" JSB TYO LDA "I JSB TYO JMP PADR,I AND RETURN * "I OCT 111 RADIX DEC 8 * SIGN BSS 1 * * A =NUMBER TO BE PRINTED * PNUMB NOP STA TEMP3 LDA BLANK JSB TYO PRINT BLANK LDA TEMP3 JSB PN PRINT NUMBER JMP PNUMB,I * PN NOP LDB TBADD SET TEMP BUFFER STB TBPTR PN1 CLB CLEAR B FOR DIV JSB .DIV DEF RADIX ADB M12B CONVERT TO ASCII SSB,RSS ADB B7 ADB B72 JSB SRBT PUT IN TEMP BUFFER SZA IF QUOTIENT NON ZERO CONTINUE JMP PN1 * LDB TBADD ELSE MOVE TO OUTPUT BUFFER  CMB,INB SET UP CHAR COUNT ADB TBPTR STB TEMP3 * PN2 ISZ TBPTR BUMP POINTER LDA TBPTR,I FETCH CHARACTER JSB TYO PRINT CHARACTER ISZ TEMP3 JMP PN2 CONTINUE UNTIL ALL ARE MOVED JMP PN,I AND THEN RETURN * * SRBT NOP SAVE CHARACTERS IN REVERSE ORDER STB TBPTR,I CCB ADB TBPTR DECREMENT POINTER STB TBPTR JMP SRBT,I AND RETURN * BLANK OCT 40 M12B OCT -12 * TBPTR BSS 1 BSS 16 TBADD DEF *-1 * EXIT LDA BLANK FILL WITH BLANK CHAR JSB TYO LDA BUFAD COMPUTE WORD COUNT CMA,INA ADA BPNTR ARS STA WCNT,I JMP INVRS,I AND RETURN * * MRG EQU * MEMORY REFERENCE GROUP AND 0 OCT 044216 JSB 0 OCT 100624 XOR 0 OCT 154204 JMP 0 OCT 100262 IOR 0 OCT 075304 ISZ 0 OCT 075554 ADA 0 OCT 043373 ADB 0 OCT 043374 CPA 0 OCT 052533 CPB 0 OCT 052534 LDA 0 OCT 105673 LDB 0 OCT 105674 STA 0 OCT 134773 STB 0 OCT 134774 SRGA EQU * SHIFT ROTATE GROUP ALF OCT 044100 ELA OCT 060473 ERA OCT 061053 ALR OCT 044114 RAR OCT 130324 RAL OCT 130316 ARS OCT 044475 ALS OCT 044115 OCT 40 CLE OCT 052277 SLA OCT 134273 OCT 27 ALF OCT 044100 OCT 26 ELA OCT 060473 OCT 25 ERA OCT 061053 OCT 24 ALR OCT 044114 OCT 23 RAR OCT 130324 OCT 22 RAL OCT 130316 OCT 21 ARS OCT 044475 OCT 20 ALS OCT 044115 SRGB EQU * BLF OCT 047200 ELB OCT 060474  RBR OCT 130374 RBL OCT 130366 BRS OCT 047575 BLS OCT 047215 OCT 4040 CLE OCT 052277 SLB OCT 134274 OCT 4027 BLF OCT 047200 OCT 4026 ELB OCT 060474 OCT 4025 ERB OCT 061054 OCT 4024 BLR OCT 047214 OCT 4023 RBR OCT 130374 OCT 4022 RBL OCT 130366 OCT 4021 BRS OCT 047575 OCT 4020 BLS OCT 047215 ASGA EQU * ALTER SKIP GROUP CCA OCT 051523 CLA OCT 052273 CMA OCT 052343 SEZ OCT 133674 CCE OCT 051527 OCT 2100 CLE OCT 052277 CME OCT 052347 SSA OCT 134723 SLA OCT 134273 INA OCT 075213 SZA OCT 135353 RSS OCT 131645 ASGB EQU * CCB OCT 051524 CLB OCT 052274 CMB OCT 052344 OCT 6040 SEZ OCT 133674 OCT 6300 CCE OCT 051527 OCT 6100 CLE OCT 052277 OCT 6200 CME OCT 052347 SSB OCT 134724 SLB OCT 134274 INB OCT 075214 SZB OCT 135354 OCT 6001 RSS OCT 131645 OVFG EQU * OVERFLOW GROUP CLO OCT 052311 STO OCT 135011 SOS OCT 134505 SOC OCT 134465 CLF EQU * CLEAR FLAG CLF 0 OCT 052300 IOG EQU * I/O GROUP CLC 0 OCT 052275 STC 0 OCT 134775 OTB 0 OCT 120374 OTA 0 OCT 120373 LIB 0 OCT 106204 LIA 0 OCT 106203 MIB 0 OCT 111304 MIA 0 OCT 111303 SFS 0 OCT 133735 SFC 0 OCT 133715 STF 0 OCT 135000 HLT 0 OCT 072016 DSG 2EQU * DOUBLE SHIFT GROUP OCT 003100 RRR 1 WORD OCT 131574 OCT 003040 LSR 1 WORD OCT 107044 OCT 003020 ASR 1 WORD OCT 044544 OCT 002100 RRL 1 WORD OCT 131566 OCT 002040 LSL 1 WORD OCT 107036 OCT 002020 ASL 1 WORD OCT 044536 EIG1 EQU * 1 WORD EXTENDED AND DMS GROUP OCT 003741 CAX 1 WORD OCT 051432 OCT 003751 CAY 1 WORD OCT 051433 OCT 007741 CBX 1 WORD OCT 051502 OCT 007751 CBY 1 WORD OCT 051503 OCT 003744 CXA 1 WORD OCT 053233 OCT 007744 CXB 1 WORD OCT 053234 OCT 003754 CYA 1 WORD OCT 053303 OCT 007754 CYB 1 WORD OCT 053304 OCT 007761 DSX 1 WORD OCT 056052 OCT 007771 DSY 1 WORD OCT 056053 OCT 007760 ISX 1 WORD OCT 075552 OCT 007770 ISY 1 WORD OCT 075553 OCT 003747 XAX 1 WORD OCT 153132 OCT 003757 XAY 1 WORD OCT 153133 OCT 007747 XBX 1 WORD OCT 153202 OCT 007757 XBY 1 WORD OCT 153203 OCT 007763 LBT 1 WORD OCT 105576 OCT 007764 SBT 1 WORD OCT 133476 OCT 007767 SFB 1 WORD OCT 133714 OCT 007100 FIX 1 WORD OCT 063432 OCT 007120 FLT 1 WORD OCT 063616 OCT 003727 LFA 1 WORD OCT 106013 OCT 007727 LFB 1 WORD OCT 106014 OCT 007703 MBF 1 WORD OCT 110660 OCT 007702 MBI 1 WORD OCT 110663 OCT 007704 MBW 1 WORD OCT 110701 OCT 007706 MWF 1 WORD OCT 112370 OCT 007705 MWI 1 WORD OCT 112373 OCT 007707 MWW 1 WORD OCT 112411 OCT 003712 PAA 1 WORD OCT 122103 OCT 007712 PAB 1 WORD OCT 122104 OCT 003713 PBA 1 WORD OCT 122153 OCT 007713 PBB 1 WORD OCT 122154 OCT 003730 RSA 1 WORD OCT 131623 OCT 007730 RSB 1 WORD OCT 131624 OCT 003731 RVA 1 WORD OCT 132013 OCT 007731 RVB 1 WORD OCT 132014 OCT 003710 SYA 1 WORD OCT 135303 OCT 007710 SYB 1 WORD OCT 135304 OCT 003711 USA 1 WORD OCT 143123 OCT 007711 USB 1 WORD OCT 143124 OCT 003722 XMA 1 WORD OCT 154043 OCT 007722 XMB 1 WORD OCT 154044 OCT 007720 XMM 1 WORD OCT 154057 OCT 007721 XMS 1 WORD OCT 154065 EIG2 EQU * 2 WORD EXTENDED AND DMS GROUP OCT 010400 DIV 2 WORDS OCT 055230 OCT 014200 DLD 2 WORDS OCT 055376 OCT 014400 DST 2 WORDS OCT 056046 OCT 010200 MPY 2 WORDS OCT 111763 OCT 015000 FAD 2 WORDS OCT 062706 OCT 015060 FDV 2 WORDS OCT 063120 OCT 015040 FMP 2 WORDS OCT 063662 OCT 015020 FSB 2 WORDS OCT 064224 OCT 015746 ADX 2 WORDS OCT 043422 OCT 015756 ADY 2 WORDS OCT 043423 OCT 011742 LAX 2 WORDS OCT 105532 OCT 011752 LAY 2 WORDS OCT 105533 OCT 015742 LBX 2 WORDS OCT 105602 OCT 015752 LBY 2 WORDS OCT 105603 OCT 015745 LDX 2 WORDS OCT 105722 OCT 015755 LDY 2 WORDS OCT 105723 OCT 011740 SAX 2 WORDS OCT 133432 OCT 011750 SAY 2 WORDS OCT 133433 OCT 015740 SBX 2 WORDS OCT 133502 OCT 015750 SBY 2 WORDS OCT 133503 OCT 015743 STX 2 WORDS OCT 135022 OCT 015753 STY 2 WORDS OCT 135023  OCT 015714 SSM 2 WORDS OCT 134737 OCT 011726 XCA 2 WORDS OCT 153223 OCT 015726 XCB 2 WORDS OCT 153224 OCT 011724 XLA 2 WORDS OCT 153773 OCT 015724 XLB 2 WORDS OCT 153774 OCT 011725 XSA 2 WORDS OCT 154423 OCT 015725 XSB 2 WORDS OCT 154424 EIG2J EQU * 2 WORD JUMPS OCT 015762 JLY 2 WORDS OCT 100223 OCT 015772 JPY 2 WORDS OCT 100463 OCT 015732 DJP 2 WORDS OCT 055272 OCT 015733 DJS 2 WORDS OCT 055275 OCT 015734 SJP 2 WORDS OCT 134172 OCT 015735 SJS 2 WORDS OCT 134175 OCT 015736 UJP 2 WORDS OCT 142372 OCT 015737 UJS 2 WORDS OCT 142375 EIG3 EQU * 3 WORD JRS OCT 017715 JRS 3 WORDS OCT 100575 OCT 017766 CBT 3 WORDS OCT 051476 OCT 017765 MBT 3 WORDS OCT 110676 OCT 017776 CMW 3 WORDS OCT 052371 OCT 017777 MVW 3 WORDS OCT 112341 OCT 017774 CBS 3 WORDS OCT 051475 OCT 017773 SBS 3 WORDS OCT 133475 OCT 017775 TBS 3 WORDS OCT 136575 MIC EQU * MICRO CODED MACROS OCT 005201 DBLE 0 FORTRAN CALLABLE OCT 054566 OCT 056700 OCT 005202 SNGL 0 FORTRAN CALLABLE OCT 134421 OCT 104600 OCT 025203 .XMPY 4 WORD(S) OCT 166247 OCT 123770 OCT 025204 .XDIV 4 WORD(S) OCT 166236 OCT 075700 OCT 017205 .DFER 3 WORD(S) OCT 164600 OCT 061040 OCT 025213 .XADD 4 WORD(S) OCT 166233 OCT 054660 OCT 025214 .XSUB 4 WORD(S) OCT 166255 OCT 141640 OCT 177221 .GOTO 31 SPECIAL PROCESSING OCT 165001 OCT 137550 OCT 175222 ..MAP 30 SPECIAL PROCESSING OCT 166437 OCT A044320 OCT 167223 .ENTR 29 SPECIAL PROCESSING OCT 164660 OCT 137740 OCT 167224 .ENTP 29 SPECIAL PROCESSING OCT 164660 OCT 137620 OCT 015225 .PWR2 2 WORD(S) OCT 165561 OCT 127570 OCT 007226 .FLUN 1 WORD(S) OCT 164726 OCT 142600 OCT 015227 .SETP 2 WORD(S) OCT 165727 OCT 137620 OCT 015230 .PACK 2 WORD(S) OCT 165533 OCT 052210 OCT 007220 .XFER 1 WORD(S) OCT 166240 OCT 061040 OCT 015206 .XPAK 2 WORD(S) OCT 166252 OCT 044010 OCT 005207 XADD 0 FORTRAN CALLABLE OCT 153106 OCT 053600 OCT 005210 XSUB 0 FORTRAN CALLABLE OCT 154447 OCT 045400 OCT 005211 XMPY 0 FORTRAN CALLABLE OCT 154062 OCT 155300 OCT 005212 XDIV 0 FORTRAN CALLABLE OCT 153303 OCT 144000 OCT 015215 .XCOM 2 WORD(S) OCT 166235 OCT 117730 OCT 015216 ..DCM 2 WORD(S) OCT 166426 OCT 052330 OCT 005217 DDINT 0 FORTRAN CALLABLE OCT 054703 OCT 115260 OCT 005257 .EMAP 0 FORTRAN CALLABLE OCT 164657 OCT 044320 OCT 005240 .EMIO 0 FORTRAN CALLABLE OCT 164657 OCT 075250 OCT 005241 MMAP 0 FORTRAN CALLABLE OCT 111543 OCT 121200 END END MCEND EQU * END END ASMB,R,L NAM OCVT,7 Convert to two digit octal ASCII ENT OCVT EXT .ENTR WORD BSS 1 OCVT NOP JSB .ENTR DEF WORD LDA WORD,I GET WORD AND MASK1 LOW OCTAL DIGIT STA 1 SAVE IN B REG LDA WORD,I AND MASK2 HIGH OCTAL DIGIT ALF,RAL 5 BITS TO THE LEFT ADA 1 ADA ZEROS JMP OCVT,I MASK1 OCT 7 MASK2 OCT 70 ZEROS ASC 1,00 END FTN4,L SUBROUTINE MEMRY ,Process LM and LR commands IMPL ICIT INTEGER (A-Z) LOGICAL PARMS COMMON/TERM/LU COMMON/RBUF/RBUF(33) COMMON/BASE/BASE,REL,DEC,MODE IF (.NOT.PARMS(1)) GO TO 900 FWA = OCTAL (2) CNT = GPARM (2,1) LST = GPARM (3,LU) IF (RBUF(2).NE.2HLM) GO TO 100 CALL LMEM (FWA,CNT,0,.FALSE.,LST) RETURN 100 CALL LMEM (FWA,CNT,BASE,.FALSE.,LST) 900 RETURN END FTN4,L SUBROUTINE LMEM (FIRST,COUNT,ADDR,DECML,LST) C IF ADDR # 0, USE AS BASE. IF DECML, SET DEC TRUE IMPLICIT INTEGER (A-Z) DIMENSION FWA (2),MESS(12) LOGICAL REL,DEC,DECML COMMON/BASE/BASE,REL,DEC,OFSET COMMON/TERM/LU,LIST DATA MESS/2H R,2HEL,2H D,2HIS,2HPL,2HAY ,2H F,2HRO,2HM ,3*2H / FWA = FIRST SAVE = BASE BASE = ADDR IF (BASE.EQ.0) GO TO 20 REL = .TRUE. FWA (2) = FWA IF (DECML) DEC = .TRUE. FWA = FWA + BASE 20 CONTINUE IF (.NOT.REL) GO TO 25 CALL DIGITS (FWA,8,MESS(10)) CALL EXEC (2,LST,MESS,12) CALL EXEC (2,LST,2H ,1) 25 CALL LSTM (FWA,COUNT,LST) REL = .FALSE. DEC = .FALSE. BASE = SAVE 900 RETURN END SUBROUTINE LSTM (FWA,COUNT,LIST) IMPLICIT INTEGER (A-Z) LOGICAL REL,DEC DIMENSION FWA (2),LOC(2),CTR(2),MESS (38) COMMON/BASE/BASE,REL,DEC COMMON/IO/INPT,OUTP DATA MESS/2H (,2H ,2H) / CTR = FWA LWA = FWA + COUNT - 1 IF (LWA .LT. FWA) LWA = FWA N = 0 CTR (2) = FWA (2) DO 100 LOCN = FWA,LWA IF (IFBRK(D)) 900,10 10 CTR (1) = LOCN CALL GETEM (CTR,VALUE,INPT) CALL DISPL (CTR,INPT,MESS(4),D) N = N + 1 MESS (2) = KCVT (N) CALL INVRS (CTR,VALUE,MESS(23),16,NWRD) CALL EXEC (2,LIST,MESS,22+NWRD) 100 CTR (2) = CTR (2) + 1 900 RETURN END END$ FTN4,L SUBROUTINE IFT ,Display IFT 6 IMPLICIT INTEGER (A-Z) COMMON/TERM/LU COMMON/RBUF/RBUF(33) COMMON/IO/INPT,OUTPT DIMENSION HEAD (14) DATA HEAD/2H I,2HD.,2H ,2H ,2H# ,2HEX,2HT ,2HWO,2HRD,2HS , $ 2H= ,2H ,2H ,2H / LST = GPARM (2,LU) IFTN = GPARM (1,1) N = IFTN CALL SYMBL (0,IFTS,6H$IFTA ) CALL GETEM (IFTS,IFTA,INPT) CALL SYMBL (0,TOTAL,6H$IFT# ) IF (IFTN.GT.TOTAL .OR. IFTN.LE.0) GO TO 900 10 CALL GETEM (IFTA+6,WD7,INPT) EXTN = IAND (WD7,777B) N = N - 1 IF (N.EQ.0) GO TO 20 IFTA = IFTA + 7 + EXTN GO TO 10 20 CALL CNUMD (EXTN,HEAD (12)) CALL GETEM (IFTA+5,TYPE,INPT) TYPE = ROTATE (TYPE,8) TYPE = IAND (TYPE,77B) HEAD (3) = OCVT (TYPE) CALL EXEC (2,LST,HEAD,14) CALL LSTM (IFTA,7,LST) IF (EXTN.EQ.0) GO TO 900 CALL EXEC (2,LST,2H ,1) CALL EXEC (2,LST,15H IFT EXTENSION:,-15) CALL LSTM (IFTA+7,EXTN,LST) 900 RETURN END FTN4,L SUBROUTINE DVT ,Display DVT IMPLICIT INTEGER (A-Z) COMMON/IO/INPT,OUTPT COMMON/TERM/LU COMMON/RBUF/RBUF(33) DIMENSION HEAD (14) DATA HEAD/2H D,2HD.,2H ,2H ,2H# ,2HDV,2HR ,2HPA,2HRM,2HS , $ 2H= ,2H ,2H ,2H / LST = GPARM (2,LU) N = GPARM (1,1) CALL SYMBL (0,DVTS,6H$DVTA ) CALL GETEM (DVTS,DVTA,INPT) CALL SYMBL (0,DVNUM,6H$DVT# ) IF (N.GT.DVNUM .OR. N.LE.0) GO TO 900 10 CALL GETEM (DVTA+20,WD21,INPT) WD21 = ROTATE (WD21,9) NP = IAND (WD21,177B) N = N - 1 IF (N.EQ.0) GO TO 20 DVTA = DVTA + 22 + NP GO TO 10 20 CALL CNUMD (NP,HEAD (12)) CALL GETEM (DVTA+5,TYPE,INPT) TYPE = ROTATE (TYPE,8) TYPE = IAND (TYPE,77B) HEAD (3) = OCVT (TYPE) CALL EXEC (2,LST,HEAD,14) CALL LSTM ̸(DVTA,22,LST) CALL EXEC (2,LST,2H ,1) CALL EXEC (2,LST,11H DVR PARMS:,-11) CALL LSTM (DVTA+22,NP,LST) 900 RETURN END FTN4,L SUBROUTINE ID ,Display ID IMPLICIT INTEGER (A-Z) COMMON/TERM/LU COMMON/IO/INPT,OUTPT IDN = GPARM (1,1) LST = GPARM (2,LU) CALL SYMBL (0,IDS,6H$IDA ) CALL GETEM (IDS,IDA,INPT) CALL SYMBL (0,TOT,6H$ID# ) CALL GETEM (TOT,TOTAL,INPT) IF (IDN.GT.TOTAL .OR. IDN.LE.0) GO TO 900 CALL SYMBL (0,IDME,6H$IDSZ ) CALL GETEM (IDME,IDSZ,INPT) FWA = (IDN - 1) * IDSZ + IDA CALL LSTM (FWA,IDSZ,LST) 900 RETURN END FTN4,L SUBROUTINE CALC IMPLICIT INTEGER (A-Z) LOGICAL PARMS COMMON/TERM/LU COMMON/RBUF/RBUF(33) IF (RBUF(33).GT.2) GO TO 100 CALL SHOWB (LU+2000B,-1,RBUF(6)) CALL BITS (RBUF(6),LU) GO TO 900 100 IF (.NOT.PARMS(3)) GO TO 900 WD1 = GPARM (1,1) OP = GPARM (2,2H/ ) WD2 = GPARM (3,1) IF (OP.EQ.2H+ ) ANS = WD1 + WD2 IF (OP.EQ.2H- ) ANS = WD1 - WD2 IF (OP.EQ.2H* ) ANS = WD1 * WD2 IF (OP.EQ.2H/ ) ANS = WD1 / WD2 CALL SHOWB (LU+2000B,-1,ANS) CALL BITS (ANS,LU) 900 RETURN END END$ FTN4,L SUBROUTINE TRACE IMPLICIT INTEGER (A-Z) LOGICAL PARMS DIMENSION MESS (24), LABEL (23) COMMON/TERM/LU COMMON/IO/INPT,OUTP EQUIVALENCE (ADLOC,MESS(2)),(CNLOC,MESS(6)), . (ADLINK,MESS(18)),(CNLINK,MESS(22)) DATA MESS/2H (,2H ,2H ,2H ,2H):,2H ,2H ,2H , . 8*2H , . 2H (,2H ,2H ,2H ,2H):,2H ,2H ,2H / DATA LABEL/2H F,2HWA,2H O,2HF ,2HME,2HM ,2H B,2HLK, . 8*2H , . 2H C,2HON,2HTE,2HNT,2HS ,2HLI,2HNK/ IF (.NOT.PARMS(1)) GO TO 900 LABEL (5) = INPT LABEL (6) = 2HM IF (INPT.EQ.2HDI) LABEL (6) =2HSC FWA = OCTAL (2) OFSET = GPARM (2,0) TERM = GPARM (3,0) LIST = GPARM (4,LU) LOC = FWA CALL EXEC (2,LIST,LABEL,23) CALL EXEC (2,LIST,2H ,1) 10 LINK = LOC + OFSET CALL GETEM (LOC,VLOC,INPT) CALL GETEM (LINK,VLINK,INPT) CALL DIGITS (LOC,8,ADLOC) CALL DIGITS (VLOC,8,CNLOC) CALL DIGITS (LINK,8,ADLINK) CALL DIGITS (VLINK,8,CNLINK) CALL EXEC (2,LIST,MESS,24) IF (VLINK.EQ.FWA .OR. VLINK .EQ. TERM) GO TO 900 LOC = IAND (VLINK,77777B) IF (LOC.EQ.FWA) GO TO 900 IF (IFBRK(D)) 900,10 900 RETURN END END$ FTN4,L SUBROUTINE SETBA IMPLICIT INTEGER (A-Z) COMMON/TERM/LU COMMON/BASE/BASE,REL,DEC,MODE COMMON/RBUF/RBUF(33) DIMENSION MESS(9) DATA MESS/2H B,2HAS,2HE ,2HAD,2HDR,2H =,3*2H / IF (RBUF(5).NE.0 ) GO TO 20 CALL CNUMO (BASE,MESS(7)) CALL EXEC (2,LU,MESS,9) GO TO 900 20 BASE = OCTAL (2) 900 RETURN END END$ FTN4,L SUBROUTINE SECTS IMPLICIT INTEGER (A-Z) COMMON/NSECTS/NSECTS COMMON/TERM/LU COMMON/RBUF/RBUF(33) DIMENSION MESS (11) DATA MESS/2H# ,2HSE,2HCT,2HOR,2HS/,2HTR,2HAC,2HK=,3*2H / IF (RBUF(5).EQ.0) GO TO 100 NSECTS = RBUF (6) GO TO 900 100 CALL CNUMD (NSECTS,MESS(9)) CALL EXEC (2,LU,MESS,11) 900 RETURN END END$ FTN4,L SUBROUTINE SETIO IMPLICIT INTEGER (A-Z) COMMON/IO/INPT,OUTPT,NAME(3),SEC,CART COMMON/RBUF/RBUF(33) COMMON/TERM/LU DIMENSION MESS (11) DATA MESS/2HIN,2HPU,2HT=,2H ,2H ,2H/O,2HUT,2HPU,2HT=/ IF (.NOT.(RBUF(5).EQ.0 .AND. RBUF(9) .EQ.0)) GO TO 100 MESS(4) = INPT MESS(10) = OUTPT MESS (5) = 2HM MESS (11) = 2HSC IF (MESS(4).EQ.2HDI) MESS (5) = 2HSC IFD (MESS(10).EQ.2HME) MESS (11) = 2HM CALL EXEC (2,LU,MESS,11) GO TO 900 100 IF (RBUF(6).EQ.2HME .OR. RBUF(6).EQ.2HDI) INPT = RBUF(6) IF (RBUF(10).EQ.2HME .OR. RBUF(10).EQ.2HDI) OUTPT = RBUF(10) 900 RETURN END END$ FTN4,L LOGICAL FUNCTION SYMBL (LIST,VALUE,NAME) C IF LIST = 0 DONT DONT LIST SYMBOL VALUE. ALWAYS RETURN C VALUE IN PARAMETER OF THAT NAME. IMPLICIT INTEGER (A-Z) DIMENSION NAME (3) LOGICAL ISEQL, IFBRK, DISPL COMMON/RBUF/RBUF(33) COMMON/TERM/LU COMMON/IO/INPT,OUTPT COMMON/SNAP/SNAP(9),SNERR,DCBSN(144),RECSN(128) COMMON/SNDAT/NENTS,NLIBS,LWABG,FWABG,FWART, . SYBP,BGBP,RTBP,FWAC,LCOM,SYSID,CKSUM DIMENSION MESS (24),TYPES(5) EQUIVALENCE (NUMBR,MESS(3)) DATA MESS/2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / DATA TYPES/2HMR,2HUN,2HCM,2HAB,2HRP/ CALL RWNDF (DCBSN,SNERR) CALL FREAD (SNAP,1) DO 100 I = 1,NENTS IF (IFBRK(DUM)) 900,10 10 LEN = FREAD (SNAP,I) IF (LEN .LT. 0) GO TO 900 IF (.NOT.(ISEQL(NAME,RECSN(2),RECSN(1)))) GO TO 100 SYMBL = .TRUE. VALUE = RECSN (6) IF (LIST .EQ. 0) GO TO 900 MESS (1) = TYPES (RECSN(5)+1) CALL CNUMO (VALUE,NUMBR) SIZE = 5 IF (DISPL(VALUE,INPT,MESS(6),D).AND.(MESS.NE.2HRP)) $ SIZE = SIZE + 19 CALL EXEC (2,LU,MESS,SIZE) GO TO 900 100 CONTINUE SYMBL = .FALSE. IF (LIST .EQ. 0) GO TO 900 CALL EXEC (2,LU,10H NOT FOUND,-10) 900 RETURN END END$ FTN4,L SUBROUTINE STABL IMPLICIT INTEGER (A-Z) LOGICAL IFBRK, DISPL, TEST COMMON/RBUF/RBUF(33) COMMON/TERM/LU COMMON/IO/INPT,OUTPT COMMON/SNAP/SNAP(9),SNERR,DCBSN(144),RECSN(128) COMMON/SNDAT/NENTS,NLIBS,LWABG,FWABG,FWART, . SYBP,BGBP,RTBP,FWAC,LCOM,SYSID,CKSUM DIMENSION MESS (12),TYPES(5),SYMBL(3),OBUF(32) EQUIVALENCE (NUMBR,MESS(3)),(MESS(7),SYMBL),(MESS,OBUF(2)) DATA MESS/2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H / DATA TYPES/2HMR,2HUN,2HCM,2HAB,2HRP/ DATA OBUF/2H / CALL RWNDF (DCBSN,SNERR) CALL FREAD (SNAP,1) LIST = LU IF (RBUF(5) .NE. 0) LIST = RBUF (6) DO 100 I = 1,NENTS IF (IFBRK(DUM)) 900,10 10 LEN = FREAD (SNAP,I+1) IF (LEN .LT. 0) GO TO 900 MESS (1) = TYPES (RECSN(5)+1) CALL CNUMO (RECSN(6),NUMBR) CALL MOVE (RECSN(2),SYMBL,3) TEST = DISPL (RECSN(6),INPT,OBUF(14),D) SIZE = 13 IF (TEST .AND. (MESS(1).NE.2HRP)) SIZE = SIZE + 19 CALL EXEC (2,LIST,OBUF,SIZE) 100 CONTINUE 900 RETURN END END$ FTN4,L SUBROUTINE CLIST IMPLICIT INTEGER (A-Z) COMMON/RBUF/RBUF(33) COMMON/TERM/LU EQUIVALENCE (LIST,RBUF(10)), (COMND,RBUF(6)) IF (RBUF(9).NE.1) LIST = LU IF (RBUF(5).EQ.0) COMND = 2H CALL HELP (COMND,LIST) RETURN END END$ ASMB,L NAM HELP,7 SUP ENT HELP EXT .ENTR,PRINT A EQU 0 B EQU 1 CHARS BSS 1 CHAR CODE FOR COMMAND LU BSS 1 LIST DEVICE LU HELP NOP JSB .ENTR DEF CHARS LDB .MESS ADDR OF MESSAGE LIST LOOP LDA B,I GET ASCII CODE OR ZERO INB POINT TO ADDRESS OF MESSAGE SZA,RSS JMP NG NOT FOUND * CPA CHARS,I JMP OK FOUND IT * INB POINT TO NEXT CODE JMP LOOP NG LDA .WHAT STA ADDR JMP DOIT OK LDA B,I GET ADDRESS STA ADDR DOIT JSB PRINT DEF RETN ADDR NOP DEF LU,I RETN JMP HELP,I * BIT15 OCT 100000 .MESS DEF MESS MESS ASC 1, NEED MASTER LIST OF COMMANDS DEF MLIST ASC 1,?? DEF ?? ASC 1,/E EXIT DEF NONE ASC 1,N  VIEW/MODIFY ADDR DEF N ASC 1,LI DEF LI ASC 1,MD DEF MD ASC 1,DI DEF DI ASC 1,DS DEF DS ASC 1,FI DEF FI ASC 1,LM DEF LM ASC 1,LR DEF LR ASC 1,BA DEF BA ASC 1,TR DEF TR ASC 1,CA DEF CA ASC 1,NS DEF NS ASC 1,IO DEF IO ASC 1,DL DEF DL ASC 1,DM DEF DM ASC 1,DV DEF DV ASC 1,IF DEF IF ASC 1,ID DEF ID DEC 0 END OF LIST * $ TERMINATES LINE * @ CONTINUES LINE * \ TERMINATES LIST MLIST ASC 10, INPUT Function$ $ ASC 5, ?? Help$ ASC 5, /E Exit$ ASC 12, N See/modify system $ ASC 14, LI List Symbol from SNAP $ ASC 9, LM List Memory $ ASC 18, LR List memory relative to BASE $ ASC 8, TR TRace list$ ASC 13, CA CAlculate or display$ ASC 19, BA Set BASE addr for LR command $ ASC 9, MD Memory Dump $ ASC 15, DI Display snap & contents $ ASC 8, DL List disc $ ASC 9, DM Disc Modify $ ASC 13, IO See/set input/output$ ASC 19, FI FInd (search) system for values $ ASC 14, DS Search disc for values$ ASC 9, DV Device Table$ ASC 11, IF Interface Table $ ASC 8, ID ID Segment$ ASC 20, NS See/set # sectors/track (for DS)$ $ ASC 17, Type ??,INPUT for more help$\ * END OF MASTER HELP LIST FI ASC 18, FI,1st addr,last addr,<3 words max@ ASC 15, or ASCII word of 6 chars> $\ MD ASC 12, MD,1st addr,last addr$\ ?? ASC 13, ??[,command][,list LU]$\ LI ASC 16, Symbol value (octal) shown as:$ ASC 18, RP = value replaces JSB symbol $ ASC 15, MR = memory resident addr$ ASC 13, CM = addr in COMMON$\ DS ASC 13, DS,LU,TRAK,<3 words max @ ASC 14,or ASCII word of 6 chars> $\ DL ASC 14, DL,LU,TR[,SECT][,# SECTS]$\ NS ASC 14, NS[,# sectors (64 word)]$\ DI ASC 8, DI[,list LU] $\ TR ASC 20, TR,fwa[,ofset][,terminator][list LU] $\ CA ASC 17, CA,P1[,Operator (+,-,*,/)][,P2]$\ LM ASC 16, LM,1st ADDR[,count][,list lu]$\ LR ASC 16, LR,1st ADDR[,count][,list lu] $ ASC 16, ADDR added to base (See BA) $ ASC 14, LRX > dec disp rel loc $\ BA ASC 10, BA[,New BAse addr]$ ASC 12, Use for LR command $\ IO ASC 17, IO[,MEm or DIsc][,MEm or DIsc]$\ DV ASC 6, DV,DVT # $\ IF ASC 6, IF,IFT # $\ ID ASC 6, ID,ID # $\ .NONE DEF NONE NONE ASC 8, NO MORE HELP!$\ DM ASC 11, DM,LU,track[,sector]$ ASC 19, DISC MOD SUBPROCESSOR (PROMPT = --) $ ASC 18, Reads disc tr/sect into 64 wd buff$ ASC 10, LI = List Buffer$ ASC 18, N = See/modify word N in buffer$ ASC 18, This is just like N command$ ASC 18, for system. View or modify $ ASC 18, buffer and exit in same way$ ASC 17, /E = Exit subprocessor. If any$ ASC 19, patch to buffer, you will be $ ASC 20, asked if you wish to write the $ ASC 20, buffer to the disc before exit$\ N ASC 6, N[,R[,D]] $ ASC 18, R : N is added to BASE address $ ASC 19, D : In R mode, read N as decimal $ ASC 19, N = octal addr. Location of addr is $ ASC 18, input (memory or system file) $ ASC 20, shown by IO command. Contents are $ ASC 19, shown in octal, decimal & ascii.$ ASC 7, Enter:$ $ ASC 16, cr View next address$ ASC 15, cr = return key$ ASC 19, N cr Patch current loc to N $ ASC 19, (trailing B for octal) $ ASC 17, ,/E cr Exit from view mode$ ASC 1, $ ASC 20, Patches go to output shown by IO$ \ .WHAT DEF NOCOM NOCOM ASC 12, NOT A VALID COMMAND $\ END MLIST FTN4,L SUBROUTINE PRINT (ADDR,LU) IMPLICIT INTEGER (A-Z) DIMENSION OBUF (40) PTR = 1 CALL SETSB (ADDR,PTR,32000) 50 SIZE = 0 CALL SETDB (OBUF,SIZE) 100 CHAR = KHAR (CHAR) IF (CHAR .EQ. 1H\ ) GO TO 900 IF (CHAR .EQ. 1H@ ) GO TO 100 IF (CHAR .EQ. 1H$ ) GO TO 200 CALL CPUT (CHAR) IF (SIZE .EQ. 80) GO TO 200 GO TO 100 200 CALL EXEC (2,LU,OBUF,-SIZE) GO TO 50 900 RETURN END END$ FTN4,L SUBROUTINE MDUMP IMPLICIT INTEGER (A-Z) LOGICAL PARMS COMMON/TERM/LU COMMON/IO/INPT,OUTP DIMENSION BUF(8),OBUF(40),MESS(19) DATA OBUF/2H (,2H ,2H):/ DATA MESS/2H L,2HOC,5*2H ,2HTH,2HRU,5*2H ,2HFR,2HOM,2H / IF (.NOT.PARMS(2)) GO TO 900 LIST = GPARM (3,LU) FWA = OCTAL (2) LWA = OCTAL (3) FWA = FWA - MOD (FWA,8) LWA = LWA + 8 - MOD (LWA+8,8) -1 LINE = 0 NUMB = 0 MESS (18) = INPT MESS (19) = 2HSC IF (INPT.EQ.2HME) MESS (19) = 2HM DO 100 MEM = FWA, LWA, 64 IF (IFBRK(D)) 900,10 10 LAST = MIN0 (MEM+63,LWA) IF (LAST.LE.MEM) GO TO 100 DO 90 LOC = MEM, LAST, 8 LINE = MOD (LINE,8) NUMB = MOD (NUMB,80) IF (LINE.NE.0) GO TO 20 CALL CNUMO (MEM,MESS(4)) N = MIN0 (LOC+63,LWA) CALL CNUMO (N,MESS(11)) CALL EXEC (2,LIST,2H ,1) CALL EXEC (2,LIST,MESS,19) 20 DO 30 L = 0,7 30 CALL GETEM (LOC+L,BUF(L+1),INPT) CALL FLINE (BUF,OBUF(3),SIZE) OBUF (2) = KCVT (NUMB) OBUF (3) = IAND (OBUF(3),377B) + 24400B CALL EXEC (2,LIST,OBUF,-(SIZE+4)) LINE = LINE + 1 90 NUMB = NUMB + 10 100 CONTINUE 900 RETURN END END$ FTN4,L SUBROUTINE FWORD IMPLICIT INTEGER (A-Z) LOGICAL ISEQL,FLAG,PARMS COMMON/IO/INPT,OUTP COMMON/RBUF/RBUF(33) COMMON/NSE ACTS/NSECTS COMMON/RTE/SYTYPE COMMON/SNDAT/NENTS,NLIBS,LWABG,FWABG COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128) COMMON/TERM/LU DIMENSION MBUF (66) DIMENSION WORDS (3),OBUF(20) DATA OBUF/2H S,2HEC,2HT:,2H ,2H ,2H ,2HWD,2H: ,12*2H / NWORDS = 0 FLAG = .FALSE. IF (.NOT.PARMS(3)) GO TO 900 C IF FIRST PARM PARSED AS NUMERIC, ASSUME THE REST DID ALSO C AND SEE HOW MANY (UP TO 3). OTHERWISE PICK UP 3 WORDS FROM C ASCII PARSE. IF (RBUF(13).EQ.1) GO TO 10 WORDS (1) = RBUF (14) WORDS (2) = RBUF (15) WORDS (3) = RBUF (16) NWORDS = 3 GO TO 25 10 NWORDS = RBUF (33) - 3 DO 20 J=1,NWORDS 20 WORDS (J) = RBUF (J*4+10) 25 IF (RBUF(2).EQ.2HDS) GO TO 500 START = OCTAL (2) LAST = OCTAL (3) DO 100 J = START,LAST,64 DO 30 L = 0,65 30 CALL GETEM (J+L,MBUF(L+1),INPT) IF (IFBRK(D)) 999,35 35 DO 40 L = 0,63 IF (J+L .GT. FWABG) GO TO 40 IF (.NOT.(ISEQL(MBUF(L+1),WORDS,NWORDS))) GO TO 40 CALL SHOW (LU,J+L,INPT) FLAG = .TRUE. 40 CONTINUE 100 CONTINUE GO TO 900 500 DISK = GPARM (1,0) + SYTYPE TR = GPARM (2,0) DO 600 SECNO = 0, NSECTS -1 IF (IFBRK(D)) 999,505 505 SN = 2 * (SECNO/2) CALL EXEC (1,DISK,RECSY,128,TR,SN) LAST = 64 IF (IAND(SECNO,1).EQ.0) GO TO 507 CALL MOVE (RECSY(65),RECSY,64) IF (SECNO.GT.NSECTS-3) GO TO 507 LAST = 65 - NWORDS CALL EXEC (1,DISK,RECSY(65),64,TR,SN+2) 507 DO 510 K = 1, LAST IF (.NOT.(ISEQL(RECSY(K),WORDS,NWORDS))) GO TO 510 FLAG = .TRUE. CALL CNUMD (SECNO,OBUF(3)) OBUF (3) = 2HT: OBUF(9) = KCVT (K) CALL DIGITS (RECSY(K),8,OBUF(11)) CALL DIGITS (RECSY(K),10,OBUF(15)) OBUF(19) = ASCII (RECSY(K))  CALL EXEC (2,LU,OBUF,20) 510 CONTINUE 600 CONTINUE 900 IF (.NOT.FLAG) CALL EXEC (2,LU,11H NOT FOUND!,-11) 999 FLAG = .FALSE. RETURN END END$ FTN4,L SUBROUTINE FLINE (INBUF,OBUF,OSIZE) C FORMAT LINE FOR ASCII DISPLAY C NNNNNN NNNNNN NNNNNN NNNNNN NNNNNN NNNNNN NNNNNN NNNNNN*AAAAAAAAAAAAAAAA C !<-------- OCTAL NUMBERS ----------------------------->!<-- ALPHA ---->! IMPLICIT INTEGER (A-Z) DIMENSION INBUF (8), OBUF (37), TEMP (24) DATA MAXCH/77440B/ C NOTE: OSIZE = NUMBER OF CHARS PUT INTO OBUF. WILL BE C EXACTLY 74. THEREFORE CALLING PROG SHUD DIMENSION C OBUF TO AT LEAST 37 WORDS DO 70 L = 0, 7 70 CALL DIGITS (INBUF(L+1),8,TEMP(3*L+1)) OSIZE = 0 CALL SETDB (OBUF,OSIZE) DO 73 L = 0, 7 CALL CPUT (1H ) 73 CALL ZPUT (TEMP(3*L+1),1,6) CALL CPUT (1H* ) PTR = 1 CALL SETSB (INBUF,PTR,16) DO 75 K = 1, 16 CHAR = KHAR (CHAR) IF (CHAR .LT. 1H .OR. CHAR .GT. MAXCH) CHAR = 1H 75 CALL CPUT (CHAR) CALL CPUT (1H ) RETURN END END$ FTN4,L SUBROUTINE DMODF IMPLICIT INTEGER (A-Z) LOGICAL FLAG,PARMS COMMON/DM/DM COMMON/RTE/SYTYPE COMMON/RBUF/RBUF(33) DIMENSION ANSR(5),OUTPT(40) COMMON/HEADR/HD1(3),DKLU(3),HD2(4),TRACK(3),HD3(4),SECTR(3) COMMON/TERM/LU COMMON/SNAP/SNAP(9),SNERR,DCBSN(144),RECSN(128) COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),RECSY(128) DIMENSION BUFR (128) C DM,LU,TR,SECT C NOTE: SYTYPE = 7700B FOR RTE-L, 177400B FOR RTE-IV CALL CLOSE (SNAP) CALL CLOSE (SYSTM) FLAG = .FALSE. IF (.NOT.PARMS(2)) GO TO 900 DISK = GPARM (1,0) TR = GPARM (2,0) SECT = GPARM (3,0) 10 SN = 2*(SECT/2) CALL EXEC (1,DISK+SYTYPE,BUFR,128,TR,SN) INDX = IAND (SECT,1) CALL MOv VE (BUFR(1+64*INDX),RECSY(1),64) CALL CNUMD (DISK,DKLU) CALL CNUMD (TR,TRACK) CALL CNUMD (SECT,SECTR) CALL EXEC (2,LU,HD1,20) 15 CALL EXEC (2,LU,16HTYPE ?? FOR HELP,-16) 20 CALL EXEC (2,LU+2000B,2H--,1) CALL REIO (1,LU+400B,ANSR,-10) CALL ABREG (STATUS,SIZE) CALL PARSE (ANSR,SIZE,RBUF) IF (RBUF.EQ.1) GO TO 25 IF (RBUF(2).EQ.2H/E) GO TO 200 IF (RBUF(2).NE.2H??) GO TO 21 CALL HELP (2HDM,LU) GO TO 20 21 IF (RBUF(2).NE.2HLI) GO TO 15 CALL EXEC (2,LU,1H ,1) CALL EXEC (2,LU,HD1,20) DO 22 L = 1,57,8 CALL FLINE (RECSY(L),OUTPT,LEN) 22 CALL EXEC (2,LU,OUTPT,-LEN) GO TO 20 25 INDEX = RBUF (2) 30 IF (INDEX .GT. 64 .OR. INDEX .LT. 1) GO TO 15 CALL SHOWB (LU+2000B,INDEX,RECSY(INDEX)) CALL REIO (1,LU+400B,ANSR,-10) CALL ABREG (STATUS,SIZE) CALL PARSE (ANSR,SIZE,RBUF) IF (RBUF .EQ. 0) GO TO 40 FLAG = .TRUE. RECSY(INDEX) = RBUF(2) CALL EXEC (2,LU+2000B,29HPATCH MADE TO SECTOR BUFFER: ,-29) CALL SHOWB (LU,INDEX,RECSY(INDEX)) 40 IF (RBUF(5).NE.0) GO TO 100 INDEX = INDEX + 1 GO TO 30 100 IF (RBUF(6).EQ.2H/E .OR. RBUF(10).EQ.2H/E) GO TO 20 200 IF (.NOT.FLAG) GO TO 900 CALL EXEC (2,LU+2000B,15HWRITE TO DISC? ,-15) CALL REIO (1,LU+400B,ANSR,-10) IF (ANSR.NE.2HYE) GO TO 900 CALL MOVE (RECSY,BUFR(1+64*INDX),64) CALL EXEC (2,DISK+SYTYPE,BUFR,128,TR,SN) CALL EXEC (2,LU,7H DONE !,-7) 900 RETURN CALL FOPEN (SNAP) CALL FOPEN (SYSTM) END FTN4,L SUBROUTINE DLIST IMPLICIT INTEGER (A-Z) LOGICAL PARMS DIMENSION ANSR (5),OBUF (40), TEMP (24) COMMON/HEADR/HD1(3),DKLU(3),HD2(4),TRACK(3),HD3(4),SECTR(3) COMMON/TERM/LU COMMON/RTE/SYTYPE COMMON/SYSTM/SYSTM(9),SYERR,DCBSY(144),REC!SY(128) IF (.NOT.PARMS(2)) GO TO 900 10 DISK = GPARM (1,0) C NOTE: SYTYPE = 7700B FOR RTE-L, 177400B FOR RTE-IV DLU = DISK + SYTYPE TR = GPARM (2,0) SECT = GPARM (3,0) NSECTS = GPARM (4,1) LIST = GPARM (5,LU) SNUM = SECT DO 100 I=1,NSECTS IF (IFBRK(D)) 900,20 20 SN = 2 * (SNUM/2) CALL EXEC (1,DLU,RECSY,128,TR,SN) IF (IAND(SNUM,1).EQ.1) CALL MOVE (RECSY(65),RECSY,64) CALL CNUMD (DISK,DKLU) CALL CNUMD (TR,TRACK) CALL CNUMD (SNUM,SECTR) CALL EXEC (2,LIST,2H ,1) CALL EXEC (2,LIST,HD1,20) DO 80 J = 1,57,8 CALL FLINE (RECSY(J),OBUF,OSIZE) 80 CALL EXEC (2,LIST,OBUF,-OSIZE) 100 SNUM = SNUM + 1 900 RETURN END BLOCK DATA IMPLICIT INTEGER (A-Z) COMMON/HEADR/HEADR(20) DATA HEADR/2H ,2HLU,2H: ,2H ,2H ,2H ,2H ,2H , . 2HTR,2H: ,2H ,2H ,2H ,2H ,2HSE,2HCT, . 2H: ,2H ,2H ,2H / END END$ o j$ 24999-18298 2024 S 0100 &TBGDR TBG LOST TICK COUNTER             H0101 ASMB,A,L * * WRITTEN BY BALLARD BARE 4/12/80 * * LAST CODE CHANGE 800519 * * ALSO SEE PROGRAMS " TBGST AND LOST " * TO ENTER THE PATCH SEE PROGRAM * " PATCH " IN THE SSK. * * THIS ABSOLUTE CODE IS USED AS A PRIVILEGED DRIVER FOR A TBG. * IT WILL SAVE THE SYSTEM STATUS AND CHECK FOR LOSSES OF TBG TICKS * FROM TBG CARD ABOVE THE PI FENCE CARD. * * TO IMPLEMENT THIS " DRIVER " IT WILL BE NECESSARY TO CONFIGURE * A PRIVILEGED FENCE IN SELECT CODE 11 OR ABOVE AND PUT A TBG * CARD BELOW THE FENCE. * * BEFORE PATCHING IN THIS ROUTINE, MAKE THE NECESSARY ADDRESS CHANGES * FOR THE SYSTEM USED. THE POINTS WERE ADDRESS CORRECTIONS NEED TO BE * MADE WILL BE SURROUNDED WITH *. THE ADDRESS TO USE CAN BE FOUND * WITH CMM4 OR GEN MAP WITH ENTRY POINTS LISTED. YOU WILL NEED 175B * WORDS OF BLANK AREA ( OR 202B WORDS IF YOU DON'T HAVE .DFER IN * MICROCODE ) AND 1 WORD ON BASE PAGE FOR A LINK. * ORG 0 DUMMY ORG FOR ASMB * * MPTFL EQU 1770B MP FLAG (ON/OFF 0/1) * * ************************************************************************ TBGSY EQU 14B PUT IN HERE THE SELECT CODE OF YOUR SYSTEM TBG. ************************************************************************ * * ************************************************************************ TBG EQU 11B SELECT CODE OF PRIVILEGED TBG. ************************************************************************ * * ORG TBG PATCH THE TRAP CELL WITH JSB LINK,I JSB LINK,I THIS WILL GET TO THE DRIVER ON TBG INTERRUPT. * ********************************************************************* ORG 1250B INSERT ADDRESS IN BASE PAGE, TO PUT IN THE * LINK ********************************************************************* * * LINK DEF TBGDR CREATE THE LINK USED BY THE TRAP CELL. * * STAR2T OF ROUTINE. * ************************************************************************ ORG 1251B PUT IN ADDRESS WERE THE PATCH WILL GO IN THE SYSTEM * MAP. ( REMEMBER 175B WORDS ( OR 202B WORDS IF .DFER * MICROCODE ISN'T THERE ) ARE NEEDED. ************************************************************************ * * TBGDR NOP THIS WILL CONTAIN THE P REGISTER VALUE. * THIS VALUE WILL BE THE RETURN ADDRESS OF * THE PROGRAM THAT WAS CURRENTLY EXECUTING. CLF 0 TURN OFF INTERRUPTS. STC TBG,C SET UP THE TBG FOR THE NEXT TICK. * * START SAVING SYSTEM STATUS. * STA SAVA SAVE THE A REGISTER. RSA GET DMS STATUS. STA DMST SAVE THE DMS STATUS IN DMST. STB SAVB SAVE THE B REGISTER. CLA ERA MOVE THE E REG. INTO BIT 15 OF THE A REG. SOC SKIP IF O IS CLEAR. INA IF O ISN'T CLEAR, INCREMENT A. STA SAVEO SAVE THE E AND O REGISTERS. * *======================================================================= * * NOW LOOK FOR LOST TBG TICKS. * LIA TBGSY GET THE STATUS OF THE SYSTEM TBG. AND MASK MASK OFF BIT 4. ( 20B) SZA,RSS IF BIT 4 ISN'T SET THE ERROR FLAG ON THE SYSTEM TBG JMP RESET WASN'T SET SO JMP TO RESET AND CONTINUE. * *======================================================================= * * IF HERE THE ERROR FLAG WAS SET SO WE INCREMENT THE TICK LOST * COUNTER. * ISZ COUNT ADD 1 TO THE COUNT FOR THE NEXT TIME THROUGH. NOP JUST IN CASE WE COUNT ALL THE WAY AROUND, HAVE * A NOP HERE SO WE AT LEAST GET THE RIGHT PROGRAM * NAME. THE NUMBER OF TICKS LOST WILL BE WRONG. JMP EXIT RESTORE STATUS AND EXIT. * *=======================================================================| * * IF HERE THE ERROR FLAG ISN'T CURRENTLY SET. * RESET LDA COUNT GET THE CURRENT NUMBER OF TICKS LOST. SZA,RSS IF NONE WERE LOST THEN DON'T MOVE THE BUFFER JMP NMOVE THAT CONTAINS ALL THE LOST TICK INFORMATION. * *======================================================================= * * THE BUFFER IS ONLY MOVED AFTER A SEQUENCE OF TICK LOSSES. * LDA ADDR7 FIRST WORD ADDRESS OF BUFFER TO MOVE. LDB ADDR FIRST WORD ADDRESS OF DESTINATION. MVW D42 MOVE 42 WORDS, 7 PLACES TO MAKE ROOM FOR * THE NEW DATA FROM THIS TIME LOSS. * STB FLAG THIS FLAG WILL INDICATE IF A LOSS HAS OCCURED * PROGRAM LOST WILL CLEAR WHEN IT HAS RETRIEVED * THE DATA. * CLA HERE WE RESET THE COUNT. STA COUNT * *======================================================================= * * IF THE ERROR FLAG WASN'T SET RECORD ALL THE NECESSARY INFORMATION * SHOULD TICKS BE LOST THIS TIME. * NMOVE CLB STB PROG PUT A ZERO IN PROG SO PROGRAM " LOST " CAN * IDENTIFY IF THE SYSTEM CAUSED THE TIME LOSS. * IF THE SYSTEM DIDN'T CAUSE TE LOSS THE PROGRAM * WILL BE PUT IN PROG. LDA 1717B GET THE ID SEG. ADDR. OF THE EXECUTING PROG. SZA,RSS IF NO PROGRAM WAS RUNNING LEAVE THE PROGRAM NAME JMP NONAM FULL OF ZERO'S. THE REASON WE STORE THE NAME * RATHER THAN JUST THE ID SEGMENT ADDRESS IS THAT * BY THE TIME WE EXAM THE ADDRESS ANOTHER PROGRAM * COULD BE IN IT. ADA D12 OFFSET TO THE PROGRAM NAME IN THE ID SEGMENT. * ************************************************************************ * * NOW PREFORM A 3 WORD MOVE IF YOU HAVE MICROCODE * FOR .DFER ( OCTAL 105205 ) * OCT 105205 PREFORM .DFER 3 WORD MOVE. * DEF tPROG ADDRESS OF DESTINATION OF 3 WORD MOVE. * DEF 0,I ADDRESS OF SOURCE OF 3 WORD MOVE. * ********* WARNING IF YOU DON'T HAVE THE MIRCOCODE FOR .DFER *********** * COMMENT OUT THE ABOVE 3 LINES AND UNCOMMENT THE * THE FOLLOWING 8 LINES. * LDB 0,I GET THE CONTENTS OF WORD 1 OF THE ID SEG NAME. STB PROG STORE THE VALUE IN PROG. INA BUMP A TO THE NEXT WORD OF THE ID SEGMENT. LDB 0,I STB PROG+1 INA SAME AS ABOVE 3 LINES. LDB 0,I STB PROG+2 * ************************************************************************ * NONAM LDA TBGDR GET THE RETURN ADDRESS. (POINT OF SUSPENSION). STA LOC SAVE IT IN LOC. LDA DMST GET THE MAP STATUS. STA DMST1 SAVE IT IN DMST1. LDA $LIA4,I GET $LIA4 (LAST INTERRUPTING SELECT CODE). STA LIA4 SAVE IT IN LIA4. * * *======================================================================= * * RESTORE THE SYSTEM STATUS AND EXIT. * EXIT LDA SAVEO CLO SLA,ELA RESTORE THE E REGISTER AND SKIP IF O WERE ZERO. STF 1 SET THE O REGISTER IF IT WERE SET. * LDB SAVB RESTORE THE B REGISTER. LDA MPTFL GET THE MEMORY PROTECT FENCE FLAG. SZA JMP NO.MP GO TO NO MEMORY PROTECT IF MEMORY PROTECT WERE OFF. LDA SAVA RESTORE THE A REGISTER. STF 0 TURN ON THE INTERRUPT SYSTEM. STC 5 TURN ON MEMORY PROTECT. JRS DMST TBGDR,I RESTORE THE REGISTER STATUS AND RETURN. * * THIS PART OF THE EXIT IS TAKEN IF MEMORY PROTECT WERE OFF. * ************************************************************************ * * * WARNING ANY CHANGE TO CODE SIZE OR CONTENT BELOW THIS LINE MAY * * INTERFER WITH PROGRAM " LOST'S " ABILITY TO FIND THE BUFFER. * * * ************************************************************************ * NO.MP LDA SAVA THE A REGISTER. STF 0 TURN ON THE INTERRUPT SYSTEM. JRS DMST TBGDR,I RESTORE THE REGISTER STATUS AND RETURN. * * * * NOW DEFINE THE CONSTANTS AND MEMORY LOCATIONS USED FOR STORAGE. * * SAVA NOP LOCATION TO SAVE A REGISTER. DMST NOP LOCATION TO SAVE THE MAP STATUS. SAVB NOP LOCATION TO SAVE B REGISTER. SAVEO NOP LOCATION TO SAVE THE E AND O REGISTER. * * ************************************************************************ $LIA4 OCT 43147 PUT IN THE LOCATION OF $LIA4 FOR YOU SYSTEM. ************************************************************************ * ADDR DEF BUFF THE LOCATION OF THE STORAGE BUFFER. ADDR7 DEF BUFF+7 D42 DEC 42 D12 DEC 12 OFSET USED TO GET NAME FROM ID SEGMENT. MASK OCT 20 MASK FOR TBG STATUS WORD. * * THE NEXT 42 LOCATIONS WILL STORE INFORMATION FOR UP TO 6 SETS OF * TICK LOSSES. ( NOTE 7 VALUES ARE RECORDED ON EACH SET OF LOSSES.) * BUFF REP 42 NOP * * * THE NEXT 7 LOCATIONS ARE TEMPORARY STORAGE FOR THE INFORMATION BEFORE * TO BE SURE YOU TYPED IN THE CORRECT ADDRESS. * LOSS OF TICKS IS DETECTED. ONCE THE LOSS IS DETECTED AND COMPLETED * THESE LOCATIONS ARE MOVED INTO THE 42 WORD BUFFER. * PROG NOP LOCATION TO STORE CURRENT PROGRAMS NAME. NOP NOTE THAT IS TAKES 3 WORDS. NOP LOC NOP LOCATION TO STORE THE RETURN ADDRESS FOR * EXAMINATION. DMST1 NOP LOCATION TO STORE MAP STATUS FOR EXAMINATION. LIA4 NOP LOCATION TO STORE CONTENTS OF $LIA4 FOR EXAMINATION. COUNT NOP LOCATION TO STORE PRIVILEGED TICK COUNT FOR * EXAMINATION. FLAG NOP STORAGE LOCATION FOR THE TICK LOSS FLAG. ILOC DEF ILOC STORE THE ADDRESS OF THIS LOCATION IN THIS LOCATION * SO THAT PROGRAM " LOST " CAN FIND THE BUFFER WITH * FAIR AMOUNT OF EASE. END ASMB,L NAM TBGST TBG START UP ROUTINE, 800412 * * WRITTEN BY BALLARD C. BARE 4/12/80 * * THIS PROGRAM GOES PRIVILEGED AN STARTS UP THE TBG. * BE SURE TO EQUATE THE VALUES OF TBG AND TBGSY, TO YOUR SYSTEM * CONFIGURATION. * EXT EXEC,$LIBR,$LIBX * TBG EQU 11B EQUATE TBG TO THE PRIVILEGED TBG. * ************************************************************************ * TBGSY EQU 14B EQUATE TBGSY TO THE SYSTEM TBG. * ************************************************************************ * B EQU 1 EQUATE B TO 1 (THE B REGISTER.) * TBGST NOP ENTRY POINT. JSB $LIBR GO PRIVILEGED. NOP CLC TBGSY,C STOP THE SYSTEM TBG. LDA D10 OTA TBGSY OUTPUT A 10 TO THE TBG FOR 10 MILLISEC RESOLUTION. STC TBGSY,C RESTART THE SYSTEM TBG. * ************************************************************************ * * THIS LOOP WILL HOLD OFF THE START OF THE PRIVILEGED TBG FOR * APROX. 5 MILLISECONDS IN AN E SERIES AND 8 MILLISECONDS IN AN * M SERIES. * LDB M18E3 LOAD B WITH -1800. (STARTING LOOP VALUE) LOOP ISZ B INCREMENT AND SKIP IF 0. (2.03 MICRO SEC IN E) * (2.59 MICRO SEC IN M) * JMP LOOP GO BACK IF LOOP NOT DONE. (.735 MICRO SEC IN E) * (1.94 MICRO SEC IN M) * ********************************************************************** * OTA TBG OUTPUT A 10 TO THE TBG FOR 10 MILLISEC RESOLUTION. STC TBG,C START IT UP. JSB $LIBX OUT OFF PRIVILEGED MODE. DEF *+1 DEF *+1 JSB EXEC PROGRAM COMPLETION CALL. DEF *+2 DEF D6 EXEC 6 CALL. D6 DEC 6 D10 A?DEC 10 M18E3 DEC -1800 END TBGST END PROGRAM FTN4,L PROGRAM LOST(),TBG TICK LOSS PROCESSOR, 800502 C C WRITTEN BY BALLARD BARE 4/12/80 C C THIS PROGRAM WILL REPORT THE RESULTS OF TBGDR ( THE TICK LOST C CATCHER.) C C THE RUN STRING FOR THE PROGRAM IS AS FOLLOWS: C C RU,LOST,P1,P2,P3 C C WHERE : P1 = LIST DEVICE (DEFAULT IS THE LOG LU) C P2 = THE RATE AT WHICH TO SCAN FOR LOSSES IN 10'S OF C MILLISECONDS. (DEFAULT IS 0 OR SCHEDULE ONLY ONCE.) C P3 = WHEN SET TO " C " WILL CLEAR THE BUFFER. C C*********************************************************************** C C DEFINE THE INPUT BUFFER, THE DATA BUFFER AND A NAME BUFFER. INTEGER IPRAM(5),IBUFF(42),INAME(3) C C*********************************************************************** C C PICK UP THE INPUT PARAMETERS. CALL RMPAR(IPRAM) C C C THE FIRST PARAMETER IS THE LIST DEVICE. DEFAULT IS THE LOG LU. LU = IPRAM(1) IF( LU .EQ. 0 ) LU = LOGLU(IDMY) C C KEEP THE LU OF THE LOG DEVICE FOR MESSAGES. LU1 = LOGLU(IDMY) C C THE SECOND PARAMETER IS THE TIME SCHEDULING PARAMETER. C ITIME = IPRAM(2) C C C THE THIRD VALUE IF SET TO C WILL CLEAR THE BUFFER TO ALL 0'S. C FIRST FIND THE BUFFER. 20 CALL IFIND( IADDR ) IF( IADDR .NE. 0 ) GO TO 30 C C IF THE BUFFER CANNOT BE FOUND TELL THE USER AND EXIT. WRITE(LU1,200) 200 FORMAT(1X,"THE TIME TICK LOSS BUFFER CANNOT BE FOUND, LOST " 1 "ENDED.",/) GO TO 999 C C FIRST GET THE ADDRESS OF THE LOST TICK FLAG. THEN CHECK IF WE C SHOULD CLEAR THE BUFFER AND THE FLAG. NOTE THE FLAG IS 61 C LOCATIONS PAST THE START OF THE BUFFER. C 30 IAFLG = IADDR + 61B IF( IPRAM(3) .NE. 2HC ) GO TO 40 C C CLEAR THE BUFFER. THEN THE FLAG. CALL ICLER( IADDR, LU1 ) CALL IXPUT( IAFLG, 0 ) C C END THE PROGRAM GO TO 999 C C*********************************************************************** C C TIME SCHEDULE LOST, NOTE THAT WE HAVE FOUND THE BUFFER AND WON'T C LOOK FOR IT AGAIN UNLESS " LOST " IS ABORTED. C 40 ICODE = 12 + 100000B IRESL = 1 MTPLE = ITIME IOFST = -1 C CALL EXEC( ICODE, 0, IRESL, MTPLE, IOFST ) GO TO 555 C C*********************************************************************** C C CHECK AT THIS POINT FOR THE BREAK FLAG TO BE SET, C AND IF IT IS SET EXIT THE PROGRAM WITHOUT SAVING RESOURCES. 45 IF( IFBRK(IDMY) ) 999, 50 C C C 50 IFLAG = IXGET( IAFLG ) C C IF NO LOSSES OCCUR END THE PROGRAM SAVING RESOURCES. IF( IFLAG .EQ. 0 ) GO TO 90 C C IF IT WAS SET CLEAR IT AND CONTINUE. C CALL IXPUT ( IAFLG, 0) C C*********************************************************************** C C NOW PICK UP THE BUFFER FROM THE SYSTEM MAP. C C STORE A TEMPORARY VALUE TO CHANGE AS IADDR IS USED AGAIN. C ITEMP = IADDR DO 60 I=1,42 IBUFF(I)=IXGET(ITEMP) ITEMP=ITEMP+1 60 CONTINUE D WRITE(1,1000) IBUFF D1000 FORMAT(1X,8K8,/) C C C************************************************************************* C C IF TICKS WERE LOST SET UP THE HEADER INFORMATION. C WRITE(LU,300) 300 FORMAT(//,1X," PROGRAM P REGISTER DMS STAT LAST SC TICKS" 1" LOST",/) C C NOW WRITE OUT THE INFORMATION FOUND IN THE BUFFER. C DO 70 I=1,6 C C C IF NO PROGRAM WAS ACTIVE AT THE TIME OF THE LOSS THEN IT MUST C BE THE SYSTEM THAT CAUSED THE LOSS, I.E. THE SYSTEM WILL BE THE C DEFAULT NAME. C INAME(1) = 2HSY INAME(2) = 2HST INAME(3) = 2HEM C C WHEN THE BUFFER IS EMPTY EXIT. C IF( IBUFF( 49 - (I*7) ) .EQ. 0 ) GO TO 80 C C IF THE ID SEGMENT ADDRESS IS 0 THEN THE SYSTEM WAS RUNNING AiT C THE TIME OF THE LOSS SO DEFAULT THE NAME, OTHERWISE WRITE THE C NAME IN THE BUFFER. C ID = 43 - (I*7) IF( IBUFF(ID) .EQ. 0 ) GO TO 65 C INAME(1) = IBUFF( ID ) INAME(2) = IBUFF( ID + 1 ) INAME(3) = IBUFF( ID + 2 ) INAME(3) = IAND( INAME(3), 177400B ) + 40B C 65 WRITE(LU,400) INAME,IBUFF( 46 - (I*7) ),IBUFF( 47 - (I*7) ), 1 IBUFF( 48 - (I*7) ),IBUFF( 49 - (I*7) ) C 400 FORMAT(3X,3A2,1X,K10,2X,K10,I7,2X,I10) C 70 CONTINUE C C PUT IN A COUPLE OF SPACES. C 80 WRITE(LU,500) 500 FORMAT(//) C C C IF ITIME WAS 0 THEN RUN THE PROGRAM ONLY ONCE AND DON'T C SAVE THE RESOURCES. 90 IF( ITIME .EQ. 0 ) GO TO 999 C C*********************************************************************** C C END THE PROGRAM AT THIS POINT SAVING RESOURCES. C CALL EXEC(6,0,1) C C ON THE NEXT SCHEDULE OF THE PROGRAM WE WILL BE AT THIS POINT. C C C SEE IF THE USER RE-RAN LOST TO CLEAR THE BUFFER. C IF HE DID CLEAR THE BUFFER AND THE FLAG. THEN CONTINUE. CALL RMPAR(IPRAM) IF( IPRAM(3) .NE. 2HC ) GO TO 95 CALL ICLER ( IADDR, LU1 ) CALL IXPUT ( IAFLG, 0 ) C C INITIALIZE THE FOURTH ADDRESS IN THE ID SEGMENT BACK TO 0. C IF WE DON'T IPRAM(3) WILL BE LEFT SET TO C, IF WE EVER SET C IT. C GET THE ADDRESS OF THIS PROGRAMS ID SEGMENT. 95 IADDP = IXGET( 1717B ) C C OFFSET TO THE ADDRESS WERE IPRAM(3) IS STORED. IADDP = IADDP + 3 CALL IXPUT( IADDP, 0 ) C GO TO 45 C 555 CALL ABREG( IA, IB ) C WRITE(LU1,600) IA, IB 600 FORMAT(1X,2A2," ERROR WHILE TRYING TO TIME SCHEDULE LOST, LOST " 1"ABORTED.",//) C C C*********************************************************************** C 999 END C C SUBROUTINE ICLER( IADDR, LU1 ),DATA ARRAY CLEAR ROUTINE, 800412 C C THIS SUBROUTINE WILL CLEAR T}{<:6HE BUFFER AREA SPECIFIED. C C C C*********************************************************************** C C CREATE A TEMPORARY ADDRESS TO CHANGE SO WE DON'T CHANGE IADDR. C ITEMP = IADDR C DO 30 I=1,42 C D WRITE(LU1,1000) ITEMP D1000 FORMAT(1X,"ADDR=",K8,) CALL IXPUT ( ITEMP,0 ) ITEMP = ITEMP + 1 C 30 CONTINUE C C GO BACK TO THE MAIN C RETURN C END C C SUBROUTINE IFIND( IADDR ), TICK LOSS BUFFER FIND ROUTINE, 800417 C C THIS SUBROUTINE WILL FIND THE BUFFER ADDERSS OF THE TIME TICK C LOSS BUFFER. C C C*********************************************************************** C C C WARNING ANY CHANGE BELOW THE NO.MP SECTION OF TBGDR WILL EFFECT C IFIND'S ABILITY TO FIND THE BUFFER ADDRESS. C C*********************************************************************** C C C SCAN THROUGH THE SYSTEM MAP TO FIND THE BUFFER. C DO 10 I=174,32767 C ILOC = IXGET(I) C C IF THE CONTENTS OF ILOC EQUALS IT'S ADDRESS THEN THIS MAY BE THE C BUFFER. IF NOT KEEP SCANNING. C IF( ILOC .NE. I ) GO TO 10 IF( IXGET(I-63B) .NE. 20B ) GO TO 10 IF( IXGET(I-64B) .NE. 14B ) GO TO 10 IF( IXGET(I-65B) .NE. 52B ) GO TO 10 IF( IXGET(I-100B) .NE. 102100B ) GO TO 10 IADDR = ILOC - 62B RETURN 10 CONTINUE C C IF WE DIDN'T FIND THE BUFFER SET IADDR TO 0 TO TELL " LOST " C AND RETURN. IADDR = 0 RETURN END END$ < kz 24999-18301 2024 S 0100 &MFGET SOURCE             H0101 FTN4,L,C PROGRAM MFGET(3,90),24999-16301 REV.2024 11-20-79 C C C THIS PROGRAM ALLOWS ALL OR PART OF THE FILES SAVED C IN "JSAVE" FORMAT TO BE ADDED TO AN EXISTING FMP DISC, C WITHOUT AFFECTING THE OTHER FILES ON THAT DISC. C IT IS INTENDED FOR USE IN THOSE INSTANCES WHERE A HALF-DOZEN OR C MORE FILES ARE REQUIRED(CASES FOR WHICH USE OF 'FGETR' IS C INCONVENIENT OR TOO TIME-CONSUMING). C C C THE DIRECTORY TRACK(S) ON THE MAG TAPE ARE READ AND STORED C ON "SCRATCH" DISC TRACKS. THE USER IS GIVEN AN OPPORTUNITY TO C DELETE THE ENTRIES FOR FILES HE DOES NOT WANT TO ADD TO C THE DISC. ENTRIES MAY BE DELETED INDIVIDUALLY, OR "DELETE ALL C ENTRIES UP TO BUT NOT INCLUDING" A GIVEN FILE NAME. AN INDIVIDUAL C ENTRY MAY BE RENAMED. C C COMMANDS ARE: C C DL[,LU] DIRECTORY LISTING(DEFAULT LU = TERMINAL) C PU,NAME DELETE FILE NAME FROM DIRECTORY C DELETE,NAME[,EXT#] MARK ALL FILES IN DIRECTORY UP THRU BUT C NOT INCLUDING 'NAME', SO THAT THE PASSED-OVER C FILES WILL NOT BE ADDED TO THE FILE SYSTEM C WHEN THE 'ADD' COMMAND IS USED. C A FILE EXTENT NUMBER MAY OPTIONALLY BE SPECIFIED. C THE DEFAULT IS ZERO. C C RN,OLDNAM,NEWNAM CHANGE THE NAME OF A FILE, SO THAT WHEN IT C IS ADDED TO THE EXISTING DISC, IT WILL HAVE A NEW C NAME. C ADD[,SC[,CR]] ALL FILES NOT EXPLICITLY EITHER PURGED OR C REMOVED VIA THE "MARK" COMMAND WILL C BE ADDED TO THE EXISTING FILE SYSTEM. C SPECIFIES THE FILE SECURITY CODE. IF C DEFAULTED, THEN THE ORIGINAL SECURITY CODE OF C THE FILE AS SAVED ON TAPE WILL BE USED. C IF ZERO IS SPECIFIED, THEN NO SECURITY CODE C WILL BE USED. C SQPECIFIES THE CARTRIDGE REFERENCE NUMBER. DEFAULTING C THIS PARAMETER ALLOWS THE FILES TO BE ADDED ANYWHERE C THERE IS ENOUGH ROOM. C C MA,NAME SET A FLAG SO 'NAME' WON'T BE C TAKEN WHEN 'ADD' COMMAND IS ISSUED. C NOTE: THIS IS NOT THE SAME AS A 'PURGE' C BECAUSE THE FLAG CAN BE CLEARED LATER. C USE MA,------ TO MARK ALL FILES, THEN CLEAR THE FLAGS ON C SPECIFIC FILES BY NAME. C CL,NAME CLEAR THE "DON'T TAKE" FLAG FROM FILE. C C EX END C END END C /E END C C NOTE: THE MINUS SIGN (-) MAY BE USED AS A C "MATCH ANYTHING" CHARACTER IN A FILE NAME, A LA FMGR C 'DL' COMMAND, EXCEPT THAT IT ALSO MATCHES BLANKS. C C C C REQUIRES TWO SUBROUTINES: C IFENT & ASCII. IFENT SEARCHES THE C CURRENT COPY OF THE 'DIRECTORY', STORED ON C "SCRATCH" DISC TRACKS, FOR A MATCH C TO A GIVEN FILE , RETURNING THE C POSITION IF FOUND, OR ZERO. FOR A DESCRIPTION C OF ARGUMENTS, SEE ITS LISTING. C ASCII DOES A BINARY-TO-ASCII CONVERSION C WITH LEADING ZEROS LEFT. THE ROUTINE IS CODED IN C ASSEMBLY. THE CALLING SEQUNCE IS C CALL ASCII(I,J,K) C C I IS THE BINARY NUMBER C J IS THE ADDRESS OF THE RESULT (3 WORDS) C K IS THE BASE WE WANT THE RESULT IN C C C 7-2-79 LAW MODIFIED TO ADJUST FOR SHORT (<96 SECTOR) TRACKS C C 11-20-79 LAW MODIFIED TO HANDLE DISCS WHERE THE DIRECTORY C TRACKS HAVE MORE SECTORS ON THEM THAN THE C SCRATCH TRACKS. DIMENSION ID(144),LT(40) DIMENSION LU(5),IREG(2),MBUF(30),IPBUF(33),IMBUF(33) DIMENSIO=N IBUF(8193),JBUF(14000B),IANS(2) DIMENSION MESS1(9),MESS2(9),MESS3(26),MESS4(12) DIMENSION MESS5(13) DIMENSION MESS6(11) DIMENSION MES10(10),MES11(10) DIMENSION MES12(6),LIN(25),LIN1(5) DIMENSION LIN2(35) LOGICAL IFEXI INTEGER FILE,DELTF INTEGER SCRT1,SCRL1,TTRK,SCRLU,SCRTRK INTEGER SCODE INTEGER ITYPE(2) INTEGER CRN INTEGER SECBUF(128) INTEGER SECTOR C NOTE: THE DIMENSION OF ARRAYS C 'LUDISC', 'TRACKS', 'TRAK2' AND 'LU2TK' DEFINE C LIMITS ON THE NUMBER OF DIRECTORY TRACKS WHICH C CAN BE HANDLED. TO ALLOW MORE, C INCREASE THE DIMENSIONS OF THESE ARRAYS C AND CHANGE THE INITIALIZATION VALUE OF C 'MAXDIR'. C INTEGER LUDISC(5),LU2TK(5) INTEGER TRACKS(5),TRAK2(5) C EQUIVALENCE (IPBUF(2),IPBUF2), (IPBUF(6),IPBUF6) EQUIVALENCE (IPBUF(5),IPBUF5) EQUIVALENCE (IPBUF(10),IPBF10) EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) EQUIVALENCE (JBUF,IBUF(2)) EQUIVALENCE (MBUF,IMBUF(2)) C C DEFINE MAXIMUM # DIRECTORY TRACKS ALLOWED. DATA MAXDIR/5/ C DEFINE SECTOR-SKIPPING VALUE DATA NSKIP/14/ C DEFINE TRACK LENGTH DATA JLNTH/8192/ DATA IMBUF/6412B/,IMBUF(32)/2H ?/,IMBUF(33)/2H _/ DATA MESS1/6412B,2H ,2HMA,2HG ,2HTA,2HPE,2H L,2HU:,2H _/ DATA MESS2/2HFM,2HGR,2H E,2HRR,2H / DATA MESS3/2HFI,2HLE,2H: ,0,0,0,2H :,0,0,0,2H :,0,0,0,0,2H :/ DATA MESS4/2H ,2HTH,2HAT,2H'S,2H N,2HOT,2H A,2H M,2HAG,2H T, *2HAP,2HE!/ DATA MESS5/2HTO,2HO ,2HMA,2HNY,2H D,2HIR,2HEC,2HTO,2HRY &,2H T,2HRA,2HCK,2HS!/ DATA MESS6/2H ,2HMA,2HX ,2H= ,2H50,2H, ,2HMI,2HN ,2H= ,2H1!/ DATA MES10/6412B,2H ,2HMA,2HG ,2HTA,2HPE,2H F,2HIL,2HE:,2H _/ DATA MES11/2H F,2HIL,2HE ,2HCR,2HEA,2HTI,2HON,2H E,2HRR,2H1OR/ DATA MES12/6412B,2H ,2HCO,2HMM,2HAN,2HD?/ DATA LIN/2H ,2HNA,2HME,2H ,2H T,2HYP,2HE , *2H#B,2HLK,2HS/,2HLU,2H S,2HCO,2HDE,2H T,2HRA, *2HCK,2H S,2HEC,2H ,2HOP,2HEN,2H T,2HO / DATA LIN1/2H ,2HCR,2H,3*2H / DATA LIN2/2H ,2H I,2HLA,2HB=,3*2H ,2H N,2HXT,2HR=, *2*2H ,2H N,2HXS,2HEC,2*2H ,2H #,2HSE,2HC/,2HTR,2*2H , *2H L,2HAS,2HT ,2HTR,2H= ,2*2H ,2H #,2HDR,2H T,2HR=,2H / C DATA ICLS/0/ C CALL RMPAR(LU) IF(LU.LT.1)LU=1 LUTTY=LU+400B C C GET MAG TAPE LU C 10 CALL REIO(2,LUTTY,MESS1,9) X=REIO(1,LUTTY,MBUF,10) CALL PARSE(MBUF,IB*2,IPBUF) MTLU=IPBUF(2) C CALL EXEC(13,MTLU,ISTAT) C CHECK DEVICE TYPE IF(IAND(ISTAT,37400B)*2.EQ.23000B)GO TO 14 C THAT'S NOT A MAG TAPE! CALL REIO(2,LUTTY,MESS4,12) GO TO 10 C 14 REWIND MTLU FILE=1 C C FIND OUT THE FILE NUMBER TO USE. C 21 CALL REIO(2,LUTTY,MES10,10) X=REIO(1,LUTTY,MBUF,10) CALL PARSE(MBUF,IB*2,IPBUF) NFILE=IPBUF(2) IF((NFILE.GT.0).AND.(NFILE.LE.50))GO TO 22 CALL REIO(2,LUTTY,MESS6,11) GOTO 21 C C POSITION THE TAPE C 22 DELTF=NFILE-FILE IF(DELTF.EQ.0)GO TO 30 C ICON=MTLU+1300B IF(DELTF.GT.0)GO TO 23 DELTF=-DELTF ICON=MTLU+1400B C 23 DO 24 I=1,DELTF CALL EXEC(19,ICON,II,ICLS) CALL EXEC(21,ICLS,II,JJ,KK,LL) 24 CONTINUE C IF(ICON.LT.1400B)GO TO 30 CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+1300B) C C GET HEADER AND CHECK IF THAT'S WHAT HE WANTS C 30 FILE=NFILE+1 CALL REIO(1,MTLU,MBUF,30) 31 CALL EXEC(2,LUTTY,IMBUF,33) CALL REIO(1,LUTTY,IANS,2) IF(IANS.EQ.2HYE)GO TO 40 IF(IFEXI(IANS)) GOTO 100 IF(IANS.NE.2HNO)GO TO 31 FILE=FILE-1 CALL EXEC(3,MTLU+1400B) CALL EXEC(3,MTLU+1300B) GO TO 21 C C C C C  THE TAPE IS POSITIONED SO THAT THE C FIRST RECORD CONTAINS THE FIRST DIRECTORY C TRACK. C READ THEM IN AND STORED THEM ON C "SCRATCH" TRACKS. C 40 CONTINUE C NOTE: JTRACK = INDEX INTO ARRAY OF SCRATCH TRACKS C WHERE THE DIRECTORY TRACKS READ FROM THE TAPE ARE C STORED. C TTRK = FLAG INDICATING WHEN THESE C DIRECTORY RECORDS ARE SO LARGE THAT C TWO TRACKS ARE REQUIRED (-1 WHEN SET, C ELSE 0) C JLS = LENGTH OF FIRST PORTION OF TRACK C TO WRITE (LESSER OF: TAPE DIRECTORY RECORD LNTH, C OR SCRATCH TRACK SIZE, IN WORDS). C JJX = SUBSCRIPT OF DIRECTORY TRACK ARRAY FOR WRITING C 2ND PORTION C JLX = LENGTH OF 2ND PORTION C JSECT = NUMBER OF THE SECTOR IN THE TAPE RECORD C AT WHICH WE SWITCH OVER TO THE C 2ND PORTION OF THE SCRATCH AREA. C JTRACK = 1 MR=0 42 M=1 ISEC=0 JSEC=0 JLS = JLNTH TTRK = 0 C C C OBTAIN A DISC TRACK FOR "SCRATCH" USE C CALL EXEC(4,1,SCRTRK,SCRLU,JSECT) 415 CONTINUE CALL EXEC(1,MTLU,IBUF,JLNTH+1) C CHECK THAT SCRATCH TRACK IS AT LEAST AS LARGE C AS THE DIRECTORY TRACK FROM THE TAPE. C IF NOT, GET ANOTHER TRACK. CALL ABREG(IA,IB) JJ = JSECT * 64 IF ( JJ .GE. IB) GOTO 420 C SCRATCH TRACK IS SHORTER. GET ANOTHER ONE. CALL EXEC(4,1,SCRT1,SCRL1,ISEC1) TTRK = -1 JLS = JJ JJX = JJ + 1 JLX = IB - JJ C C 420 CONTINUE C IF MAG TAPE RECORD IS SMALLER THAN THE SIZE OF THE C BUFFER WE HAVE~ ALLOCATED, ADJUST ACCORDINGLY. C IB = IB -1 IF(IB .LT. JLNTH) JLNTH = IB C OBTAIN A DISC TRACK, AND COPY DIRECTORY THERE. C AGAIN, IF TRACKS ARE TWO SHORT, GET ANOTHER. CALL EXEC(4,1,TRACKS(JTRACK),LUDISC(JTRACK),ISECT) CALL EXEC(2,LUDISC(JTRACK),JBUF,JLS,TRACKS(JTRACK),0) IF(TTRK) 423, 424 423 CONTINUE CALL EXEC(4,1,TRAK2(JTRACK),LU2TK(JTRACK),ISECT) CALL EXEC(2,LU2TK(JTRACK),JBUF(JJX),JLX,TRAK2(JTRACK),0) C 424 CONTINUE C IF THIS IS THE FIRST DIRECTORY TRACK, C THEN THE FIRST 16 WORDS ARE THE C PACK LABEL INFORMATION. IF(JTRACK .NE. 1) GOTO 425 NDIREC = -JBUF(9) C PROTECT AGAINST TOO MANY DIRECTORY TRACKS IF(NDIREC .GT. MAXDIR) GOTO 979 NDSPT = JBUF(7) NDBPT = NDSPT/2 LTRK = JBUF(5) 425 CONTINUE JTRACK = JTRACK + 1 IF(JTRACK .LT. (NDIREC+1)) GOTO 415 LTRACK = LTRK -1 C C C C C ******************************************************************** C 15 CONTINUE ISEC = 0 JSEC = 0 CALL REIO(2,LUTTY,MES12,6) CALL REIO(1,LUTTY,IBUF,-80) CALL ABREG(IA,IB) CALL PARSE(IBUF,IB,IPBUF) C C GOTO COMMAND PROCESSOR C IF(IPBUF2 .EQ. 2HDL) GOTO 2000 IF(IPBUF2 .EQ. 2HAD) GOTO 3000 IF(IPBUF2 .EQ. 2HPU) GOTO 4500 IF(IPBUF2 .EQ. 2HDE) GOTO 5000 IF(IPBUF2 .EQ. 2HSK) GOTO 5500 IF(IPBUF2 .EQ. 2HCL) GOTO 5700 IF(IPBUF2 .EQ. 2HMA) GOTO 5800 IF(IPBUF2 .EQ. 2HMK) GOTO 5800 IF(IPBUF2 .EQ. 2HRN) GOTO 4000 IF(IPBUF2 .EQ. 2H??) GOTO 9000 C CHECK FOR END IF(IFEXI(IPBUF2)) GOTO 100 ASSIGN 989 TO IFRMT CALL MSGFR(IFRMT,LUTTY) GOTO 15 C TOO MANY DIRECTORY TRACKS 979 CONTINUE CALL EXEC(2,LUTTY,MESS5,13) GOTO 100 989 FORMAT("ILLEGAL COMMAND. USE ?? TO  GET HELP") C C C ********* DIRECTORY LISTING C 2000 CONTINUE ISEC = 0 C LIST = IPBUF6 IF(LIST .LT. 1) LIST = LUTTY C C READ DIRECTORY FROM "SCRATCH" TRACKS C DO 2113 JJ = 1,NDIREC M = 1 CALL RDIRC(LUDISC,LU2TK,TRACKS,TRAK2,JJ,JBUF,TTRK,JJX,JLS,JLX) IF(JJ .NE. 1) GOTO 2045 C C LIST CARTRIDGE INFORMATION FIRST C M = 17 CALL ASCII(JBUF(4),LIN1(3),10) LIN1(3)=IAND(LIN1(3),177B)+36400B CALL EXEC(3,1100B+LIST,-1) CALL EXEC(2,LIST,LIN1,5) LIN2(5)=IAND(JBUF(1),77777B) LIN2(6)=JBUF(2) LIN2(7)=JBUF(3) CALL ASCII(JBUF(10),MBUF,10) LIN2(11)=MBUF(2) LIN2(12)=MBUF(3) CALL ASCII(JBUF(6),MBUF,10) LIN2(16)=IAND(MBUF(2),177B)+36400B LIN2(17)=MBUF(3) CALL ASCII(JBUF(7),MBUF,10) LIN2(22)=IAND(MBUF(2),177B)+36400B LIN2(23)=MBUF(3) IA=JBUF(8)-JBUF(9)-1 CALL ASCII(IA,MBUF,10) LIN2(29)=MBUF(2) LIN2(30)=MBUF(3) CALL ASCII(NDIREC,MBUF,10) LIN2(35)=MBUF(3) CALL REIO(2,LIST,LIN2,35) CALL EXEC(3,1100B+LIST,1) CALL EXEC(3,1100B+LIST,1) C C LIST INFORMATION FOR EACH FILE. C 2045 DO 2103 N=M,128,16 C C COMPUTE THE FILE INFO OFFSET C MR=N+ISEC*64 C C IF ELEMENT = -1 FILE WAS PURGED IGNORE C IF(JBUF(MR).EQ.-1)GO TO 2103 C C IF = 0 END OF DIRECTORY GET OUT C IF(JBUF(MR).EQ.0)GO TO 15 C C DO DL FORMATTING STUFF C DO 193 IA=1,25 193 LIN(IA)=2H LIN(2)=JBUF(MR) LIN(3)=JBUF(MR+1) LIN(4)=JBUF(MR+2) CALL ASCII(JBUF(MR+3),LIN(5),10) IF(IAND(LIN(5),77400B).EQ.30000B)LIN(5)=IAND(LIN(5),177B) 1+20000B IF(JBUF(MR+3).EQ.0)GO TO 236 IA=JBUF(MR+6)/2 CALL ASCII(IA,LIN(8),10) IF(IAND(LIN(8),77400B).EQ.30000B)LIN(8)=IAND(LIN(8),177B) w 1+20000B CALL ASCII(JBUF(MR+4),LIN(15),10) LIN(15)=20040B IA=IAND(JBUF(MR+5),377B) CALL ASCII(IA,MBUF,10) LIN(18)=MBUF(2) IF(IAND(LIN(18),77400B).EQ.30000B)LIN(18)=IAND(LIN(18) 1,177B)+20000B LIN(19)=MBUF(3) IA=0 IF(JBUF(MR+5).LT.0)IA=200B IA=IA+IAND(77400B,JBUF(MR+5))/256 IF(IA.EQ.0)GO TO 237 CALL ASCII(IA,MBUF,10) LIN(21)=IAND(MBUF(2),177B)+25400B LIN(22)=MBUF(3) GO TO 237 236 CALL ASCII(JBUF(MR+4),MBUF,10) LIN(10)=MBUF(3) 237 CALL ASCII(JBUF(MR+8),LIN(12),10) IF(IAND(LIN(12),77400B).EQ.30000B)LIN(12)=IAND(LIN(12) 1,177B)+20000B IF(JBUF(MR+9) .LT. 0) LIN(25) = 2HDT CALL REIO(2,LIST,LIN,25) C CHECK FOR 'BREAK' IF(IFBRK(IA)) 15,2103 C C C 2103 CONTINUE M = 1 C C ISEC=MOD(ISEC+NSKIP,NDSPT) IF(ISEC .NE. 0) GOTO 2045 2113 CONTINUE GOTO 15 C C ******************************************************************** C C ADD ALL FILES NOT OTHERWISE REMOVED FROM THE 'DIRECTORY' C TO EXISTING FILE SYSTEM. C C ******************************************************************** 3000 CONTINUE JOFF = 17 SCODE = IPBUF6 CRN = IPBF10 C DO 3390 I= 1, NDIREC SECTOR = 0 3005 CONTINUE JT = TRACKS(I) JLU = LUDISC(I) JSCT = SECTOR C DO WE HAVE TO GO TO 2ND PORTION? IF(SECTOR .LT. JSECT) GOTO 3010 C YES, WWITCH TO OTHER SCRATCH TRACKS, C WHERE 2ND PORTION OF TAPE RECORD IS STORED. JT = TRAK2(I) JLU = LU2TK(I) JSCT = SECTOR - JSECT C 3010 CONTINUE CALL EXEC(1,JLU,SECBUF,128,JT,JSCT) DO 3300 K=JOFF,128,16 C IGNORE NON-PURGED ENTRIES, TYPE-0 FILES, C ENTRIES FOR EXTENTS, AND CHECK FOR END OF DIRECTORY. C IF(SECBUF(K) .EQ. 0) GOTO 15 IF(SECBUF(K+3)/ .LT. 1) GOTO 3300 IF(IAND(SECBUF(K+5),177400B) .NE. 0) GOTO 3300 IF(SECBUF(K) .EQ. -1) GOTO 3300 IF(SECBUF(K+9) .LT. 0) GOTO 3300 3020 CONTINUE IEXTNT = 0 NSECS = SECBUF(K+6) ITYPE=SECBUF(K + 3 ) ITYPE(2)=SECBUF(K+7) C C FIND ALL EXTENTS TO THIS FILE, SO C IT CAN BE CREATED WITH THE CORRECT SIZE. C 3030 CONTINUE IFLAG = 0 JFLAG = 0 IEXTNT = IEXTNT + 1 JK = IFENT(JBUF,SECBUF(K),TRACKS,LUDISC,NDIREC,IFLAG, &NDSPT,IEXTNT,NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX) IF(JK .GT. 0) GOTO 3030 C NOW, CALCULATE CORRECT FILE SIZE, C AND OBTAIN OTHER FILE INFORMATION JBASE = ((NSECS+1)/2) ISIZE = JBASE * IEXTNT KFTRAK = SECBUF(K+4) KFSEC = IAND(SECBUF(K+5),377B) C C PRINT FILE NAME,SECURITY CODE, CR, TYPE, SIZE C DO 3033 JJ = 0,2 3033 MESS3(JJ+4) = SECBUF(K+JJ) ISCODE = SCODE IF(IPBUF5 .EQ. 0) ISCODE = SECBUF(K+8) CALL ASCII(ISCODE,MESS3(8),10) CALL ASCII(CRN ,MESS3(12),10) CALL ASCII(ITYPE ,MESS3(17),10) MESS3(21) = 2H : CALL ASCII(ISIZE ,MESS3(22),10) CALL EXEC(2,LUTTY,MESS3,26) C C CREATE THE FILE C C FILE TYPE & RECORD SIZE AS C SPECIFIED IN PSEUDO-DIRECTORY C FILE SIZE AS DETERMINED BY SUM OF C # BLOCKS IN BASE FILE + ALL EXTENTS C C SECURITY CODE AS DETERMINED BY: C 1) COMMAND, IF SPECIFIED C 2) OTHERWISE, FILE ENTRY IN PSEUDO-DIRECTORY C CALL CREAT(ID,IRE,SECBUF(K),ISIZE,ITYPE,ISCODE,CRN) IF(IRE.GE.0)GO TO 3040 C C THERE WAS A FILE CREATION ERROR. C CALL ASCII(IRE,MESS2(6),10) CALL EXEC(2,LUTTY,MESS2,9) GOTO 3300 C C CLOSE THE FILE SO WE CAN OPEN IT FOR UPDATE. C @3040 CONTINUE CALL CLOSE(ID) IEXTNT = 0 C C OPEN THE FILE AS TYPE ONE SO WE MAY JUST C TRANSFER WHOLE RECORDS C CALL OPEN(ID,IRE,SECBUF(K),4,ISCODE,CRN) C C C DO WE WANT THIS RECORD? C 3060 CONTINUE IF ( LTRACK .EQ. KFTRAK) GO TO 3200 C IS PROPER RECORD FARTHER AHEAD ON TAPE? IF(LTRACK .LT. KFTRAK) GOTO 3070 C MUST HAVE HAD TO READ AHEAD ON C TAPE IN ORDER TO PICK UP EXTENTS. C BACKSPACE TAPE. 3065 CONTINUE CALL EXEC(3,MTLU+200B) 3066 CONTINUE LTRACK = LTRACK - 1 CALL EXEC(3,MTLU+200B) IF(LTRACK .LT. KFTRAK) GOTO 3066 GOTO 3071 3070 CONTINUE LTRACK = LTRACK + 1 3071 CONTINUE CALL EXEC(1,MTLU,IBUF,JLNTH+1) CALL WDIRC(SCRLU,SCRL1,SCRTRK,SCRT1,1,JBUF,TTRK,JJX,JLS,JLX) CALL EXEC(13,MTLU,ISTAT) IF(IAND(ISTAT,200B) .NE. 0) GOTO 3294 GOTO 3060 C C C HAVE READ TRACK CONTAINING THE C FIRST BLOCK OF FILE. C CALCULTE OFFSET INTO FILE. C 3200 CONTINUE CALL RDIRC( SCRLU,SCRL1,SCRTRK,SCRT1,1,JBUF,TTRK,JJX,JLS,JLX) IA=64*KFSEC+1 C C TRANSFER THE CORRECT NUMBER OF SECTORS DO 3280 N=1,JBASE C CHECK FOR 'BREAK' IF(IFBRK(JK)) 3294,3202 3202 CONTINUE CALL WRITF(ID,IRE,JBUF(IA),128) IA=IA+128 C C END OF TRACK? C IF(IA.LT.JLNTH)GO TO 3280 C YES, READ NEXT TRACK LTRACK = LTRACK + 1 CALL EXEC(1,MTLU,IBUF,JLNTH+1) CALL WDIRC (SCRLU,SCRL1,SCRTRK,SCRT1,1,JBUF,TTRK,JJX,JLS,JLX) CALL EXEC(13,MTLU,ISTAT) IF(IAND(ISTAT,200B).NE.0)GO TO 3294 IA=1 3280 CONTINUE C SAVE CURRENT TRACK CONTENTS C SO DIRECTORY CAN BE SEARCHED FOR EXTENTS CALL WDIRC(SCRLU,SCRL1,SCRTRK,SCRT1,1,JBUF,TTRK,JJX,JLS,JLX) 3282 CONTINUE IEXTNT = IEXTNT + 1 C IF THERE ARE ANY MORE EXTENTS, ADD THEM TO FILE. IFLAG = 0 JFLAG = 0 JK = IFENT(JBUF,SECBUF(K),TRACKS,LUDISC,NDIREC,IFLAG,NDSPT &,IEXTNT,NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX) KFTRAK = JBUF(JK+4) KFSEC = IAND(JBUF(JK+5),377B) C C NOW, RESTORE CURRENT TRACK BUFFER CONTENTS C CALL RDIRC (SCRLU,SCRL1,SCRTRK,SCRT1,1,JBUF,TTRK,JJX,JLS,JLX) IF(JK .NE. 0) GOTO 3060 3294 CALL CLOSE(ID) 3300 CONTINUE JOFF = 1 SECTOR = MOD(SECTOR+NSKIP,NDSPT) IF(SECTOR .NE. 0) GOTO 3005 C 3390 CONTINUE GOTO 15 C C ************************************************************************** C C RE-NAME AN ENTRY AND ALL OF ITS EXTENTS. C C ************************************************************************** C 4000 CONTINUE IEXTNT = 0 4005 CONTINUE IFLAG = 0 JFLAG = 0 JK = IFENT(JBUF,IPBUF6,TRACKS,LUDISC,NDIREC,IFLAG,NDSPT,IEXTNT, & NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX) C DOES FILE EXIST? IF((JK .EQ. 0) .AND. (IEXTNT .EQ. 0)) GOTO 4520 C YES. HAVE WE TRANSFERRED LAST EXTENT? IF(JK .EQ. 0) GOTO 15 C NO. RE-NAME FILE DO 4010 K = 1,3 4010 JBUF(JK+K-1) = IPBUF(K+9) CALL WDIRC(LUDISC,LU2TK,TRACKS,TRAK2,IFLAG,JBUF,TTRK,JJX,JLS,JLX) IEXTNT = IEXTNT + 1 GOTO 4005 C *********************************************************************** C C PURGE AN ENTRY FROM THE DIRECTORY C 4500 CONTINUE JFL = 0 4503 CONTINUE IEXTNT = IPBF10 4505 CONTINUE IFLAG = 0 JFLAG = -1 JK = IFENT(JBUF,IPBUF6,TRACKS,LUDISC,NDIREC,IFLAG,NDSPT,IEXTNT, & NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX) C DOES FILE EXIST? IF(JK .EQ. 0) GOTO 4515 C 'PURGE' THIS ENTRY. JBUF(JK) = -1 JFL = 1 CALL WDIRC(LUDISC,LU2TK,TRACKS,TRAK2,IFLAG,JBUF,TTRK,JJX,JLS,JLX) IEXTNT = IEXTNT + 1 GOTO 4505 C C NO ENTRY FOUND. 4515 CONTINUE C WAS ANY ENTRY FOUND? IF((IEXTNT .EQ. 0) .AND. (JFL .EQ. 0)) GOTO 4520 IF(IEXTNT .EQ. 0) GOTO 15 GOTO 4503 4519 FORMAT("FILE NOT FOUND") 4520 CONTINUE ASSIGN 4519 TO IFRMT CALL MSGFR(IFRMT,LUTTY) GOTO 15 C C *************************************************************************** C C DELETE ALL ENTRIES UP TO BUT NOT INCLUDING THE C GIVEN FILE. C C *************************************************************************** C 5000 CONTINUE IFLAG = -1 JFLAG = 0 IEXTNT = IPBF10 JK =IFENT(JBUF,IPBUF6,TRACKS,LUDISC,NDIREC,IFLAG,NDSPT,IEXTNT, &NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX) ASSIGN 5001 TO IFRMT IF(JK .EQ. 0) CALL MSGFR(IFRMT,LUTTY) GOTO 15 5001 FORMAT("WARNING: FILE NOT FOUND!") C C ****************************************************************** C C SET A DIFFERENT SECTOR-SKIPPING VALUE C C ****************************************************************** 5500 CONTINUE NSKIP = IPBUF6 IF(NSKIP .LT. 1) NSKIP = 14 GOTO 15 C C *********************************************************************** C C CLEAR THE "DON'T TAKE" FLAG FROM AN ENTRY C 5700 CONTINUE JFLAG = 1 JFL = 0 5703 CONTINUE IEXTNT = IPBF10 5705 CONTINUE IFLAG = 0 JK = IFENT(JBUF,IPBUF6,TRACKS,LUDISC,NDIREC,IFLAG,NDSPT,IEXTNT, & NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX) C DOES FILE EXIST? IF(JK .EQ. 0) GOTO 5715 JFL = 1 IEXTNT = IEXTNT + 1 GOTO 5705 C 5715 CONTINUE C WAS ANY ENTRY FOUND? IF((IEXTNT .EQ. 0) .AND. (JFL .EQ. 0)) GOTO 4520 GOTO 15 C C **********************************F************************************* C C MARK AN ENTRY AS "DON'T TAKE" C 5800 CONTINUE JFL = 0 JFLAG = 2 5803 CONTINUE IEXTNT = IPBF10 5805 CONTINUE IFLAG = 0 JK = IFENT(JBUF,IPBUF6,TRACKS,LUDISC,NDIREC,IFLAG,NDSPT,IEXTNT, & NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX) C DOES FILE EXIST? IF(JK .EQ. 0) GOTO 15 IEXTNT = IEXTNT + 1 GOTO 5805 C C C *********************************************************************** C C PROVIDE HELP FOR THE USER. C C **************************************************************************** 9000 CONTINUE ASSIGN 9901 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9902 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9903 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9904 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9905 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9906 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9907 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9908 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9909 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9910 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9911 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9912 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9913 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9914 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9915 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 99151 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9916 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9917 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9918 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9919 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9920 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9921 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9922 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9923 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9924 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9925 TO IFRMT CALL MSGFR(IFRMT,LUTTY) ASSIGN 9926 TO IFRMT CALL MSGFR(IFRMT,LUTTY) GOTO 15 9901 FORMAT("COMMANDS ARE:") 9902 FORMAT("DL[,LU] DIRECTORY LISTING(DEFAULT LU = TERMINAL)") 9903 FORMAT("PU,NAME[,EXT#] DELETE FILE NAME FROM DIRECTORY") 9904 FORMAT( &"DELETE,NAME[,EXT#] MARK ALL FILES IN DIRECTORY UP THRU BUT") 9905 FORMAT(" NOT INCLUDING 'NAME' SO THAT THEY WILL") 9906 FORMAT(" NOT BE INCLUDED WHEN FILES ARE ADDED TO") 9907 FORMAT(" EXISTING DISC.") 9908 FORMAT("RN,OLDNAM,NEWNAM CHANGE THE NAME OF A FILE,") 9909 FORMAT(" SO THAT WHEN IT IS ADDED TO THE") 9910 FORMAT(" EXISTING DISC, IT WILL HAVE A NEW") 9911 FORMAT(" NAME.") 9912 FORMAT("ADD[,SC[,CR]] ALL FILES NOT EXPLICITLY EITHER PURGED") 9913 FORMAT(" OR REMOVED VIA THE 'DELETE' OR 'REMOVE'") 9914 FORMAT(" COMMANDS WILL BE ADDED TO THE EXISTING") 9915 FORMAT(" FILE SYSTEM,WITH SECURITY CODE SC, ON") 99151 FORMAT(" CARTRIDGE 'CR'.") 9916 FORMAT(" DEFAULTING SPECIFIES THAT FILES MAY") 9917 FORMAT(" BE ADDED WHEREVER THERE IS ENOUGH ROOM.") 9918 FORMAT("SK,N SET # SECTORS SKIPPED IN DIRECTORY TO N") 9919 FORMAT(" (DEFAULT IS 14, USABLE FOR MOST") 9920 FORMAT(" DIRECTORIES)") 9921 FORMAT("MA,NAME MARK FILE 'NAME' AS 'DON'T TAKE'") 9922 FORMAT("CL,NAME CLEAR THE 'DON'T TAKE' FLAG FROM FILE") 9923 FORMAT(" 'NAME'") 9924 FORMAT("EX END") 9925 FORMAT("EN END") 9926 FORMAT("/E END") C C FILE ERROR C REPORT ERROR NUMBER. C 120 CALL ASCII(-IRE,MES11(11),10) MES11(12)=26440B CALL REIO(2,LUTTY,MES11,13) C C C EXIT. C 100 CONTINUE REWIND MTLU END FUNCTION IFEXI(IANS) LOGICAL IFEXI IFEXI = .FALSE. IF(IANS .EQ. 2HEX) IFEXI = .TRUE. IF(IANS .EQ. 2HEN) IFEXI = .TRUE. IF(IANS .EQ. 2H/E) IFEXI = .TRUE. RETURN END SUBROUTINE RDIRC(LUDISC,LU2TK,TRACKS,TRAK2,JJ,JBUF,TTRK,JJX, &JLS,JLX) C C SUBROUTINE TO READ DIRECTORY TRACKS FROM THE SCRATCH-TRACK C AREA OF THE DISC. IF TTRK < 0, THEN TWO TRACKS ARE C READ C INTEGER LUDISC(1),LU2TK(1),TRACKS(1),TRAK2(1),JBUF(8192), &TTRK C CALL EXEC(1,LUDISC(JJ),JBUF,JLS,TRACKS(JJ),0) IF(TTRK .GE. 0) RETURN CALL EXEC(1,LU2TK(JJ),JBUF(JJX),JLX,TRAK2(JJ),0) RETURN END SUBROUTINE WDIRC(LUDISC,LU2TK,TRACKS,TRAK2,JJ,JBUF,TTRK,JJX, &JLS,JLX) C C SUBROUTINE TO WRITE DIRECTORY TRACKS BACK TO THE SCRATCH-TRACK C AREA OF THE DISC. IF TTRK < 0, THEN TWO TRACKS ARE WRITTEN. C INTEGER LUDISC(1),LU2TK(1),TRACKS(1),TRAK2(1),JBUF(8192),TTRK CALL EXEC(2,LUDISC(JJ),JBUF,JLS,TRACKS(JJ),0) IF(TTRK .GE. 0) RETURN CALL EXEC(2,LU2TK(JJ),JBUF(JJX),JLX,TRAK2(JJ),0) RETURN END END$ ASMB,L,C NAM ASCII BINARY TO ASCII WITH ZEROS ENT ASCII EXT .ENTR A EQU 0 B EQU 1 NUM NOP PUT NOP E NOP ASCII NOP JSB .ENTR GET CALLING PARMS DEF NUM CLA STA FLAG LDA DM3 STA CNT LDA PUT SAVE DESTINATION ADDRESS ADA .2 STA PUTT LDA NUM,I STA NUMM LDA E,I STA BASE CPA .8 JMP LOP LDA NUMM SSA,RSS JMP LOP CCB CMA,INA STA NUMM STB FLAG LOP LDA NUMM CLB DIV BASE ADB B60 STB PUTT,I CLB DIV BASE STA NUMM LDA B ADA B60 ALF,ALF IO@R PUTT,I STA PUTT,I LDA PUTT ADA DM1 STA PUTT ISZ CNT JMP LOP LDA FLAG SZA,RSS JMP ASCII,I ISZ PUTT LDA B377 AND PUTT,I IOR MIN STA PUTT,I JMP ASCII,I CNT NOP DM3 DEC -3 DM1 DEC -1 .2 DEC 2 .8 DEC 8 B60 OCT 60 B377 OCT 377 MIN OCT 26400 BASE NOP NUMM NOP PUTT NOP FLAG NOP END FTN4,L,C FUNCTION IFENT(IBUF,NAME,TRACKS,LUDISC,NDIREC,FLAG,NDSPT,IEXTNT, &NSKIP,JFLAG,TRAK2,LU2TK,TTRK,JJX,JLS,JLX),11-20-79 C C FUNCTION TO FIND A DIRECTORY ENTRY WHICH MATCHES FILE C "NAME". C C TTRK = FLAG, INDICATING WHETHER THE SCRATCH TRACKS ARE C SUFFICIENT TO CONTAIN ALL OF ONE TAPE DIRECTORY C RECORD. IF SO, TTRK = 0, ELSE -1 INDICATES C THAT 2ND PORTION IS STORED ON TRACKS AND C LUS DESCRIBED BY TRAK2 & LU2TK, RESPECTIVELY. C C IBUF = TRACK BUFFER C C NAME = 6-CHARACTER FILE NAME C C TRACKS = ARRAY CONTAINING TRACK ADDRESSES OF THE SCRATCH AREA C WHERE THE DIRECTORY TRACKS ARE STORED. IF THE ORIGINAL C TAPE RECORDS WERE LARGER THAN THE SCRATCH TRACKS, C THEN THIS IS THE AREA WHERE THE FIRST PORTION IS STORED. C C LUDISC = ARRAY CONTAINING THE DISC LUS FOR 'TRACK'. AGAIN, IF C THE SCRATCH TRACKS COULDN'T CONTAIN ALL OF THE DIRECTORY C RECORDS, THEN THIS IS THE LU OF THE FIRST PORTION. C C LU2TK = SAME AS 'LUDISC', BUT DESCRIBES 2ND PORTION OF C SCRATCH-TRACK AREA WHERE DIRECTORY RECORDS ARE C STORED. C C TRAK2 = SAME AS 'TRACKS', BUT DESCRIBES 2ND PORTION OF C SCRATCH-TRACK AREA WHERE DIRECTORY RECORDS ARE STORED. C C NDIREC = NUMBER OF DIRECTORY TRACKS C C FLAG = -1 THEN ALL ENTRIES FOUND WHICH DO NOT C COMPARE TO 'NAME' WILL BE 'PURGED'. C = 0 THEN DO NOT PURGE ENTRIES WHICH DO NOT M/ATCH. C C NDSPT = NUMBER OF SECTORS PER TRACK ON DIRECTORY C C NSKIP = NUMBER OF SECTORS SKIPPED BETWEEN BLOCKS ON C DIRECTORY. C C JJX = SUBSCRIPT OF ARRAY IN TRACK BUFFER WHERE C 2ND PORTION BEGINS C C JLS = # WORDS IN FIRST PORTION OF TRACK BUFFER C C JLX = SIZE OF 2ND PORTION, IN WORDS C JFLAG = CONTROL FLAG: C IF # 0 THEN IGNORE ALL ENTRIES WITH C THEIR "DON'T TAKE" FLAGS SET C C IEXTNT = EXTENT NUMBER OF FILE BEING LOOKED FOR. C C C IF FOUND, IFENT RETURNS WITH THE ARRAY INDEX OF THE C ENTRY IN 'IBUF', AND 'FLAG' RETURNS WITH THE INDEX IN C 'TRACK' AND 'LUDISC'. C C IF NOT FOUND, IFENT RETURNS WITH 0. C C INTEGER IBUF(6144),NAME(3),TRACKS(1),LUDISC(1) INTEGER TRAK2(1),LU2TK(1),TTRK INTEGER SECTOR,FLAG LOGICAL WRFLG C JEXTNT = 256 * IEXTNT IFENT = 0 JOFF = 17 DO 1000 I = 1,NDIREC SECTOR = 0 WRFLG = .FALSE. CALL RDIRC(LUDISC,LU2TK,TRACKS,TRAK2,I,IBUF,TTRK,JJX,JLS,JLX) 100 CONTINUE IOFSET = 64 * SECTOR I22 = IOFSET + 128 IOFSET = IOFSET + JOFF DO 200 K = IOFSET,I22,16 IF(IBUF(K) .EQ. -1) GOTO 200 IF(IBUF(K) .EQ. 0) GOTO 140 IF(IBUF(K+3) .LT. 1) GOTO 150 IF(IAND(IBUF(K+5),177400B) .NE. JEXTNT) GOTO 150 IF((JFLAG .EQ. 0) .AND. (IBUF(K+9) .LT. 0)) GOTO 200 C DOES FILE NAME MATCH? DO 125 J = 1,3 N1 = NAME(J) N2 = IBUF(K+J-1) C CHECK FOR (-) CHAR IF(IAND(N1,77400B) .EQ. 26400B) N1 = IAND(N1,177B) + & IAND(N2,77400B) IF(IAND(N1,177B) .EQ. 55B) N1 = IAND(N1,77400B) + IAND(N2,177B) IF(N1 .NE. N2) GOTO 150 125 CONTINUE C C FOUND IT! C IFENT = K FLAG = I IF((JFLAG .NE. 1) .AND. (JFLAG .NE. 2)) GOTO 140 C WE'RE BEING ASKED TO CLEAR OR SET THE C ljf "DON'T TAKE" FLAG WRFLG = .TRUE. IF(JFLAG .EQ. 1) IBUF(K+9) = 0 IF(JFLAG .EQ. 2) IBUF(K+9) = -1 GOTO 200 140 CONTINUE IF(WRFLG) CALL WDIRC(LUDISC,LU2TK,TRACKS,TRAK2,I,IBUF,TTRK, & JJX,JLS,JLX) RETURN 150 CONTINUE C C THIS IS A FILE ENTRY, BUT THE NAME DOESN'T MATCH. C SHOULD I PURGE IT? C IF(FLAG .NE. -1) GOTO 200 IBUF(K) = -1 WRFLG = .TRUE. 200 CONTINUE JOFF = 1 SECTOR = MOD(SECTOR + NSKIP,NDSPT) IF(SECTOR .NE. 0) GOTO 100 C FILE HAS NOT BEEN FOUND ON THIS DIRECTORY TRACK. C IF IT'S BEEN MODIFIED, WRITE IT BACK TO THE DISC. IF(WRFLG) CALL WDIRC(LUDISC,LU2TK,TRACKS,TRAK2,I,IBUF,TTRK, & JJX,JLS,JLX) 1000 CONTINUE C DIDN'T FIND IT. IFENT = 0 RETURN END END$ 0l l 24999-18310 2024 S 0100 &CDGN : MEM RES. DUMP PRG FOR CDA4 (CTU)             H0101 ASMB,R,L,C HED CDGN [#DUMP] - GENNED IN DUMP TO CART NAM #DUMP,1 24999-16310 REV.2024 800116 EXT EXEC EXT $MRMP POINTER TO MEM RES MAP * * "CDGN" - (KNOWN AS #DUMP) - A "STANDALONE" PROGRAM THAT * DUMPS A CRASHED SYSTEM TO CARTRIDGE TAPE. IT RESIDES IN THE * MEMORY RESIDENT AREA, BUT REQUIRES NO RTE SERVICES. * * THE PROGRAM DUMPS 32K OF MEMORY, THE DRIVER PARTITIONS AND THE * FOUR SYSTEM MAPS, FOLLOWED BY THE CONTENTS OF THE SYSTEM AND * USER ADDRESS SPACES. NOTE THAT THE DUMP ORDER IS: THE FIRST 32K, * THE MAPS, THE NEXT 16K, AND THE PAGES OF THE SYSTEM AND USER * ADDRESS SPACES THAT ARE NOT IN THE FIRST 32K OF THE DRIVER PARTITIONS. * * THE END OF THE DRIVER PARTITIONS IS FOUND BY EXAMINING C(C($MRMP)), * WHICH CONTAINS THE PAGE ADDRESS OF THE FIRST PAGE AFTER * THE END OF THE DIRVER PARTITIONS. IF C(C($MRMP)) IS LESS THAN 32, * THEN NO DRIVER PARTITIONS ARE DUMPED (THEY ARE ALL IN THE FIRST 32K). * IF C(C($MRMP)) IS BETWEEN 32 AND 64, THEN THAT VALUE LESS 32 IS USED. * IF C(C($MRMP)) IS OVER 64, PAGES 32 - 47 ARE DUMPED AS DRIVER PARTITIONS * * BLOCKS IN THE SYSTEM AND USER MAPS THAT ARE IN THE FIRST 32K OR THE * DRIVER PARTITIONS ARE NOT DUMPED TWICE. * * A HALT 42 INDICATES A NONRECOVERABLE WRITE ERROR. BY HITTING * RUN YOU CAN TRY AGAIN. * A HALT 70 INDICATES A PAUSE TO CHANGE TAPES * (AFTER THE MAPS, AFTER THE DRIVERS, AND AFTER THE SYSTEM A.S.) * A HALT 77 INDICATES A NORMAL COMPLETION. * (AFTER THE USER ADDRESS SPACE) * * TO RUN -- SET THE P REGISTER TO THE ADDRESS OF \DUMP IN THE * SYSTEM (THIS IS GENNED IN). SET THE S REGISTER TO THE SELECT * CODE OF THE 26XX TERMINAL. THE DUMP WILL BE TO THE LEFT CTU. * NOTE THAT THE PROGRAM IS ALREADY LOADED INTO MEMORY, AND NO * BOOT LOAD IS NECESSARY. * * THIS PROGRAM IS PART OF THE CRASH DUMP ANALYSIS PACKAGE * * JEF 01/16/80 * * 4 A EQU 0 B EQU 1 SC EQU 25B * * IF USER RUNS WITH "RU,#DUMP", JUST DO A TERMINATION * TO PROTECT HIM * #DUMP JSB EXEC TERMINATE PROGRAM DEF *+2 DEF D6 * * CONFIGURE * INIT EQU * CDGN STA DADDR SAVE \DUMP ADDRESS LIA 1 LOAD DISPLAY REG INTO A REG ADA SFS1 BUILD INST SFS SC STA FIX1 ADA LIA2 BUILD INST LIA SC STA FIX3 ADA OTA3 BUILD INST OTA SC STA FIX4 ADA STC4 BUILD INST STC SC,C STA FIX5 STA FIX2 ***** * * MAIN ROUTINE * ***** * * FIGURE OUT HOW MANY PHYSICAL PAGES TO DUMP - * IF $MRMP IS BETWEEN 32 AND 63, USE THAT; IF IT IS LESS * THAN 32, USE 32; OTHERWISE USE 48K. * * LDA $MRMP,I LOAD MR BASE PAGE ADDR AND B1777 MASK OUT PROTECT BITS LDB A STA TMP & SAVE ADA M32 SSA >= 32? LDB D32 NO - USE 32 LDA TMP ADA M64 SUBTRACT 64 SSA,RSS MR BP >= 64? LDB D48 YES - SET DUMP LIMIT TO 48K STB DLIM SAVE CLB SET STB CPAGE CURRENT PAGE NUMBER * * WRITE PAGES TO THE CART - THE MAPS ARE WRITTEN AFTER * THE FIRST 32K. PAUSE AFTER THE MAPS ARE WRITTEN AND AFTER * WE ARE DONE DUMPING PHYSICAL MEMORY. * PH JSB POUT PUT OUT PAGE ISZ CPAGE BUMP PAGE # LDB CPAGE CPB D32 IS PAGE 32 NEXT? JSB MAPS YES - WRITE MAPS CPB DLIM LAST PAGE? RSS JMP PH NO - DO MORE JSB EOF PUT AN EOF ON THE CART HLT 70B LET THE USER CHANGE CARTS * * DUMP THE CONTENTS OF THE SYSTEM AND USER MAPS * DO NOT DUMP PAGES THAT ALREADY HAVE BEEN DUMPED * IN THE FIRST 32K OR THE DRIVER PARTITIONS * LDA B2000 INIT STA MADDR LOOP WL LDA MADDR,I GET PAGE # AND B1777 MASK OUT READ/WRITE PROTECT STA TMP HOLD CMA,INA CHECK ADA DLIM IF PAGE HAS TO CMA,SSA,INA,SZA BE DUMPED JMP NEXT NO - PAGE WAS ALREADY DUMPED LDB TMP YES - WRITE JSB POUT PAGE NEXT ISZ MADDR BUMP PAGE LDA MADDR NUMBER CPA B2040 ARE WE THROUGH THE SYSTEM MAP? JMP HPAUS YES - WRITE AN EOF AND PAUSE CPA B2100 ARE WE ALL DONE? RSS JMP WL NO - CONTINUE JSB EOF WRITE AN EOF ON THE TAPE STOP HLT 77B WE'RE DONE JMP STOP (EVEN IF THEY HIT RUN AGAIN) * HPAUS JSB EOF WRITE AN EOF ON THE TAPE HLT 70B PAUSE JMP WL CONTINUE WITH MAPS * * SUBROUTINE TO WRITE AN EOF ON THE CART * EOF DEF *-* ENTRY POINT LDB ESC JSB OTWD LDB P5 JSB OTWD LDA C JSB OTBYT JMP EOF,I RETURN * * MAPS RETRIEVES THE SYSTEM MAP FROM \DUMP * IN THE FIRST 32K AND THEN WRITES ALL FOUR MAPS * TO THE CART. * MAPS NOP LDA D2 MAP CAX PHYS PAGES 1+2 LDA D1 AS LDB A SYS PAGES XMS 1+2 LDA BADDR SAVE USA MAPS PAA PBA LDA D32 SET PHYS PAGES 0 - 31 CAX AS USER MAP CLB XMS LDA D32 MOVE CAX 32 WORDS LDA DADDR FROM \DUMP LDB B2000 TO PAGE 1 MWF (SYS MAP) LDB D1 WRITE JSB MSETM -SET MAP- LDB B2000 MAPS JSB WRIT HLT 70B PAUSE TO CHANGE CARTS LDB CPAGE RESTORE VALUE JMP MAPS,I RETURN * * POUT WRITES A PAGE OF MEMORY TO THE TAPE/CART * THE B REGISTER HAS THE PAGE NUMBER * POUT NOP JSB MSETM SET MAP LDB B4000 INIT STB DPAD ADDR PCONT JSB WRIT WRITE 128 WORDS LDB DPAD INCR DUMP ADDR ADB B200 BY 128 STB DPAD CPB B6000 DONE? JMP POUT,I YES - RETURN JMP PCONT * * MSET SETS THE MAP REGISTER SPECIFIED BY WPAG * TO THE PAGE SPECIFIED BY THE B REGISTER * MSETM NOP LDA D1 MAP CAX THE PAGE SPECIFIED LDA WPAG TO WPAG XMS JMP MSETM,I RETURN * * WRIT WRITES 128 BYTES FROM THE ADDRESS SPECIFIED * BY THE A REGISTER (MAPPING MUST ALREADY BE DONE) * WRIT NOP STB ADR SAVE PARM * * PUT OUT ESCAPE SEQUENCE * ESCQ LDA EPTR RESET POINTER STA *+1 ESLP LDB ESC GET A WORD OF THE ESC SEQ ISZ *-1 MOVE TO NEXT WORD JSB OTWD OUTPUT CURRENT WORD CPB EOT IS IT END OF ESC SEQ? RSS YES-GO WAIT FOR ACK JMP ESLP NO-DO NEXT ESC SEQ WORD * * ACKNOWLEDGE * WACK LDA ENQ SEND ENQ JSB OTBYT JSB INBYT GET ACK CPA ACK IS IT ACK? CLE,RSS YES-SKIP JMP WACK NO-LOOP * * * OUTPUT RECORDS * * LDA M128 GET COUNTER #WDS/REC STA TMP OTLP LDB ADR,I O.W. GET IT OUT OF SYS MAP JSB OTWD WRITE THE WORD ISZ ADR GET THE NEXT ADDRESS ISZ TMP DONE WITH REC? JMP OTLP NO-DO NEXT WORD LDA DC1 YES-SEND DC1 JSB OTBYT JSB INBYT GET TAPE STATUS CPA S S-SUCCESS? (F-FAIL) JMP *+3 YES-SKIP HLT 42B NO-HALT JMP INIT 2ND CHANCE TO RUN JSB INBYT WAIT FOR CR JMP WRIT,I RETURN * * OUTPUT ONE WORD * OTWD NOP OUTPUT ONE' WORD TO CTU CCE START WITH UPPER HALF LDA B PUT DATA IN A REG ALF,ALF PUT IN LOWER POSITION AND B377 MASK OUT UPPER HALF JSB OTBYT OUTPUT BYTE SEZ,RSS SECOND HALF WRITTEN? JMP OTWD,I YES-RETURN LDA B N0-PUT DATA IN A REG CLE SET LOWER HALF FLAG JMP OTWD+4 WRITE IT * * INPUT ONE BYTE * INBYT NOP INPUT ONE BYTE JSB SETUP FIX UP I O INTERFACE CARD LDA RCV PUT IN RECEIVE MODE JSB OUT FIX2 STC SC,C DO IT FIX3 LIA SC PUT THE BYTE INTO A-REG SSA,RSS VALID? JMP *-2 NO. GET ANOTHER. AND B377 MASK OUT UPPER HALF JMP INBYT,I RETURN * * OUTPUT ONE BYTE * OTBYT NOP OUTPUT ONE BYTE STA OVAL SAVE VALUE TO SEND JSB SETUP FIX UP I O INTERFACE CARD LDA XMIT PUT IN TRANSMIT MODE JSB OUT LDA OVAL GET VALUE TO SEND JSB OUT SEND THE BYTE FIX5 STC SC,C PUT CARD IN DATA MODE FIX1 SFS SC IS I/O DONE? JMP *-1 NO-WAIT JMP OTBYT,I RETURN * * DO ONE OTA * OUT NOP FIX4 OTA SC JMP OUT,I * * SET UP THE INTERFACE CARD * SETUP NOP LDA MSET MASTER RESET JSB OUT LDA CHMD PUT IN CHAR MODE JSB OUT LDA FRAM CHAR FRAME CONTROL JSB OUT JMP SETUP,I RETURN * * * SFS1 OCT 102300 TO BUILD SFS COMMAND LIA2 OCT 000200 TO BUILD LIA COMMAND OTA3 OCT 000100 TO BUILD OTA COMMAND STC4 OCT 001100 TO BUILD STC,C COMMAND * * M128 DEC -128 B377 OCT 377 * OVAL NOP ADR NOP M32 DEC -32 M64 DEC -64 D48 DEC 48 DLIM DEF *-* NUMBER OF PHYSICAL PAGES TO DUMP CPAGE DEF *-* PAGE BEING DUMPED B2000 OCT 2000 TMP DEF *-* B1777 OCT 1777 MADDR DEF *-* ADDRESS WITHIN MAP TABLE B2040 OCT 2040 AD_$"DRESS OF 33RD PAGE IN MAP TABLE B2100 OCT 2100 ADDRESS OF 65TH PAGE IN MAP TABLE D1 DEC 1 D2 DEC 2 D6 DEC 6 D32 DEC 32 DADDR DEF *-* ADDRESS OF ENTRY POINT BADDR OCT 102040 FOR DUMPING MAPS TO 2040 B4000 OCT 4000 B200 OCT 200 B6000 OCT 6000 DPAD DEF *-* ADDRESS OF NEXT RECORD TO WRITE WPAG DEF 2 MAP REGISTER # TO USE FOR I/O * * MSET OCT 150077 MASTER RESET FRAM OCT 30003 CHAR FRAME CONTROL RCV OCT 40340 PUT IN RECEIVE MODE XMIT OCT 40740 PUT IN TRANSMIT MODE CHMD OCT 10040 PUT IN CHAR MODE * * EPTR LDB ESC * * ESC OCT 015446 ASCII "ESC" "&" OCT 070061 ASCII LOWER CASE "P" "1" OCT 062062 ASCII LOWER CASE "D" "2" OCT 032466 ASCII "5" "6" EOT OCT 053421 ASCII UPPER CASE "W" "DC1" P5 OCT 070065 ASCII LOWER CASE "P" "5" C OCT 000103 ASCII UPPER CASE "C" ENQ OCT 000005 ASCII "ENQ" ACK OCT 000006 ASCII "ACK" DC1 OCT 000021 ASCII DEVICE CONTROL 1 S OCT 000123 ASCII UPPER CASE "S" * * END #DUMP $ m x 24999-18311 2024 S 0100 &TDGN : MEM RES. DUMP PRG FOR CDA4 (MT)             H0101 ASMB,R,L,C HED TDGN [#DUMP] - GENNED IN DUMP TO TAPE NAM #DUMP,1 24999-16311 REV.2024 800116 EXT EXEC EXT $MRMP POINTER TO MEM RES MAP * * "TDGN" - (KNOWN AS #DUMP) - A "STANDALONE" PROGRAM THAT * DUMPS A CRASHED SYSTEM TO MAG TAPE. IT RESIDES IN THE MEMORY * RESIDENT AREA, BUT REQUIRES NO RTE SERVICES * * THE PROGRAM DUMPS 32K OF MEMORY, THE DRIVER PARTITIONS AND THE * 4 SYSTEM MAPS, FOLLOWED BY THE CONTENTS OF THE SYSTEM AND * USER ADDRESS SPACES. NOTE THAT THE DUMP ORDER IS: THE FIRST 32K, * THE MAPS, THE NEXT 16K, AND THE PAGES OF THE SYSTEM AND USER * ADDRESS SPACES THAT ARE NOT IN THE FIRST 32K OR THE DRIVER PARTITIONS. * * THE END OF THE DRIVER PARTITIONS IS FOUND BY EXAMINING C(C($MRMP)), * WHICH CONTAINS THE PAGE ADDRESS OF THE FIRST PAGE AFTER * THE END OF THE DRIVER PARTITIONS. IF C($MRMP) IS LESS THAN 32, * THEN NO DRIVER PARTITIONS ARE DUMPED (THEY ARE ALL IN THE FIRST 32K). * IF C(C($MRMP)) IS BETWEEN 32 AND 64, THEN THAT VALUE LESS 32 IS USED. * IF C(C($MRMP)) IS OVER 64, PAGES 32 - 47 ARE DUMPED AS DRIVER PARTITIONS * * BLOCKS IN THE SYSTEM AND USER MAPS THAT ARE ALSO IN THE FIRST * 32K OR THE DRIVER PARTITIONS ARE NOT DUMPED TWICE. * * A HALT 41 INDICATES TAPE NOT READY. (NOT AT LOAD POINT) * A HALT 42 INDICATES A NONRECOVERABLE WRITE ERROR. * A HALT 43 INDICATES UNABLE TO WRITE END OF FILE. * BY HITTING RUN YOU CAN TRY AGAIN. * A HALT 77 INDICATES A NORMAL COMPLETION. * * TO RUN -- SET THE P REGISTER TO THE ADDRESS OF \DUMP IN THE * SYSTEM (THIS IS GENNED IN). SET THE S REGISTER TO THE SELECT * CODE OF THE MAG TAPE. NOTE THAT THE PROGRAM IS ALREADY LOADED * INTO MEMORY, AND NO BOOT LOAD IS NECESSARY. * * THIS PROGRAM IS PART OF THE CRASH DUMP ANALYSIS PACKAGE * * 24999- REV 1902 * * TEF 12/23/78 * JEF 01/16/80 * * A EQU 0 B EQU 1 S EQU 1 O* * PUT A TRAP IN IN CASE ANYONE TRIES TO "RU,#DUMP" * #DUMP JSB EXEC CALL EXEC DEF *+2 RETN ADDR DEF D6 PROGRAM TERMINATION * * SELECT CODE OF M.T. INITIALIZATION * TDGN STA DADDR SAVE \DUMP ADDRESS LIA S GET THE LOWER M.T. SELECT CODE STA DC SET THE DATA CHANNEL INA STA CC SET THE COMMAND CHANNEL * * SET-UP I/O INSTRUCTIONS FOR M.T. * LDA OTA.1 IOR CC STA OTA.1 STA OTA.2 STA OTA.4 STA OTA.5 STA OTA.6 LDA STC.2 IOR DC STA STC.2 INA STA STC.4 STA STC.5 STA STC.6 LDA LIA.1 IOR CC STA LIA.1 STA LIA.2 STA LIA.4 * * INITIALIZE THE M.T. INTERFACE * MEM1 LDA CLR CLEER THE INTERFACE OTA.1 OTA 00 LDA SLECT UNIT SELECT OTA.2 OTA 00 * * CHECK THE M.T. INITIAL STAT * LIA.2 LIA 00 AND ALL7 MASK OFF THE DENSITY BIT CPA BIT6 ONLY THE LOAD POINT BIT SHOULD BE SET JMP READY HLT 41B JMP LIA.2 * * FIGURE OUT HOW MANY PHYSICAL PAGES TO DUMP - * IF $MRMP IS BETWEEN 32 AND 63, USE THAT; IF IT IS * LESS THAN 32, USE 32; OTHERWISE DUMP 48K * READY LDA $MRMP,I LOAD MR BASE PAGE ADDR AND B1777 MASK OUT PROTECT BITS LDB A B REG HAS # TO USE STA TMP & SAVE ADA M32 SSA >= 32? LDB D32 NO - USE 32K LDA TMP ADA M64 SUBTRACT 64 SSA,RSS MR BP >= 64? LDB D48 YES - SET DUMP LIMIT TO 48K STB DLIM SAVE CLB SET STB CPAGE CURRENT PAGE NUMBER * * WRITE PAGES TO TAPE - THE MAPS ARE WRITTEN AFTER * THE FIRST 32K. * PH JSB POUT PUT OUT PAGE ISZ CPAGE BUMP PAGE # LDB CPAGE CPB D32 IS P$AGE 32 NEXT? JSB MAPS YES - WRITE MAPS CPB DLIM LAST PAGE? RSS JMP PH NO - DO MORE * * DUMP THE CONTENTS OF THE SYSTEM AND USER MAPS * DO NOT DUMP PAGES THAT ALREADY HAVE BEEN DUMPED * IN THE FIRST 32K OR THE DRIVER PARTITIONS * LDA B2000 INIT STA MADDR LOOP WL LDA MADDR,I GET PAGE # AND B1777 MASK OUT READ/WRITE PROTECT STA TMP HOLD CMA,INA CHECK ADA DLIM IF PAGE HAS TO CMA,SSA,INA,SZA BE DUMPED JMP NEXT NO - PAGE WAS ALREADY DUMPED LDB TMP YES - WRITE JSB POUT PAGE NEXT ISZ MADDR BUMP PAGE LDA MADDR NUMBER CPA B2100 ARE WE ALL DONE? RSS JMP WL NO - CONTINUE * * NOW WRITE AN END OF FILE * LDA WEOF WRITE AN EOF ON M.T. OTA.4 OTA 00 STC.4 STC 00,C LIA.4 LIA 00 AND ALL7 CPA O4200 EOF + ODD # OF BYTES XFERRED JMP MEM5 JSB CKSTA JMP LIA.4 HLT 43B JMP LIA.4 MEM5 LDA REWOF REWIND TO OFF-LINE OTA.5 OTA 00 STC.5 STC 00,C HLT 77B SUCCESSFUL COMPLETION * * MAPS RETRIEVES THE SYSTEM MAP FROM \DUMP * IN THE FIRST 32K AND THEN WRITES ALL FOUR MAPS * TO THE TAPE. * MAPS NOP LDA D2 MAP CAX PHYS PAGES 1+2 LDA D1 AS LDB A SYS PAGES XMS 1+2 LDA BADDR SAVE USA USER PAA PORT A PBA AND PORT B MAPS LDA D32 MAP PHYS PAGES 0-31 CAX AS USER MAP CLB XMS LDA D32 MOVE CAX 32 WORDS LDA DADDR FROM \DUMP LDB B2000 TO PAGE 1 MWF (SYS MAP) AC LDB D1 WRITE JSB MSET -SET MAP- LDB B2000 MAPS JSB WRIT LDB CPAGE RETORE CPAGE JMP MAPS,I RETURN * * POUT WRITES A PAGE OF MEMORY TO THE TAPE * THE B REGISTER HAS THE PAGE NUMBER * POUT NOP JSB MSET SET MAP LDB B4000 INIT STB DPAD ADDR PCONT JSB WRIT WRITE 128 WORDS LDB DPAD INCR DUMP ADDR ADB B200 BY 128 STB DPAD CPB B6000 DONE? JMP POUT,I YES - RETURN JMP PCONT * * MSET SETS THE MAP REGISTER SPECIFIED BY WPAG * TO THE PAGE SPECIFIED BY THE B REGISTER * MSET NOP LDA D1 MAP CAX THE PAGE SPECIFIED LDA WPAG TO WPAG XMS JMP MSET,I RETURN * * SET UP DMA WITH THE 3 CONTROL WORDS : * * CW1 --- M.T. SELECT CODE * CW2 --- STARTING ADDRESS * CW3 --- NO. OF WORDS TO BE TRANSFERRED * * WRIT WRITES 128 BYTES FROM THE ADDRESS SPECIFIED * BY THE B REGISTER (MAPPING MUST ALREADY BE DONE) * WRIT NOP LDA DC IOR BIT13 CLEAR CONTROL AT END OF XFER OTA 6 OUTPUT CW1 TO DCPC CHANNEL 1 CLC 2 OTB 2 OUTPUT CW2 STC 2 LDA M128 ALWAYS DO 128 WORDS OTA 2 OUTPUT CW3 * * INITIATE M.T. & DMA * LDA WREC WRITE 1 RECORD COMMAND OTA.6 OTA 00 STC.6 STC 00,C STC.2 STC 00,C STC 6,C INITIATE DMA * * WAIT FOR COMPLETION OF DMA TO M.T. * SFS 6 JMP *-1 * * DMA TO M.T. COMPLETED , CHECK FOR STAT FROM M.T. * LIA.1 LIA 00 GET STAT FROM COMMAND CHANNEL AND ALL7 MASK OFF DENSITY BIT SZA,RSS JMP WRIT,I NO ERROR , EXIT JSB CKSTA CHECK STAT OF M.T. JMP LIA.1 LDA STAT HLT 42B UNRECOVERABLE WRITE ERROR JMP MEM1 START FROM BEGINNING * * SUBROUTINE TO CHECK THE STAT OF nM.T. * CKSTA NOP STA STAT SAVE STAT AND BIT8 CHECK FOR CONTROLLER BUSY FLAG SZA JMP CKSTA,I LDA STAT AND BIT3 CHECK FOR REJECT FLAG SZA JMP CKSTA,I LDA STAT AND BIT9 CHECK FOR TRANSPORT BUSY FLAG SZA JMP CKSTA,I ISZ CKSTA JMP CKSTA,I * * MAG TAPE COMMANDS FOR OUTPUT * CLR OCT 110 SLECT OCT 1400 WREC OCT 31 WEOF OCT 211 REWOF OCT 105 * BIT3 OCT 10 BIT6 OCT 100 BIT8 OCT 400 BIT9 OCT 1000 O4200 OCT 4200 BIT13 OCT 20000 ALL7 OCT 77777 * CC OCT 0 DC OCT 0 STAT OCT 0 M128 DEC -128 M32 DEC -32 M64 DEC -64 D48 DEC 48 D6 DEC 6 CODE FOR PROGRAM TERMINATION DLIM DEF *-* NUMBER OF PHYSICAL PAGES TO DUMP CPAGE DEF *-* PAGE BEING DUMPED B2000 OCT 2000 TMP DEF *-* B1777 OCT 1777 MADDR DEF *-* ADDRESS WITHIN MAP TABLE B2100 OCT 2100 ADDRESS OF 65TH PAGE IN MAP TABLE D1 DEC 1 D2 DEC 2 D32 DEC 32 DADDR DEF *-* ADDRESS OF ENTRY POINT BADDR OCT 102040 FOR DUMPING MAPS TO 2040 B4000 OCT 4000 B200 OCT 200 B6000 OCT 6000 DPAD DEF *-* ADDRESS OF NEXT RECORD TO WRITE WPAG DEF 66 MAP REGISTER # TO USE FOR I/O * END #DUMP END$ A n x 24999-18313 2024 S 0100 &\DMP : SYSTEM ENTRY POINT \DUMP             H0101 wdASMB,R,L NAM \DUMP,0 24999-16313 REV.2024 800116 ENT \DUMP ENTRY POINT EXT $MRMP POINTER TO MEMORY RESIDENT MAP * A EQU 0 B EQU 1 **************************************************************************** * * THIS CODE, IN CONJUNCTION WITH THE MEMORY RESIDENT PROGRAM #DUMP, * WILL PRODUCE A DUMP OF A CRASHED SYSTEM. TO RUN, LOAD THE P REGISTER * WITH THE ADDRESS OF THE ENTRY POINT \DUMP. THE S REGISTER CONTAINS * THE SELECT CODE OF THE DUMP DEVICE. * * THIS CODE LOCATES THE MEMORY RESIDENT PROGRAM #DUMP AND EXECUTES * IT. IT ALSO SAVES THE MEMORY STATUS REGISTER AND THE SYSTEM MAP. * NOTE THAT THE SYSTEM MAP IS WRITTEN OVER THIS CODE. * * * JEF 01/16/80 **************************************************************************** MSTAT DEF *-* CONTENTS OF MEM STATUS REGISTER * \DUMP RSA SAVE STB MSTAT MEM STATUS REG LDB 1657B GET ADDR OF STB KTBL KEYWORD TABLE L1 LDB KTBL,I GET ADDR OF ID SEGMENT SZB,RSS IS THIS THE END OF THE TABLE? JMP HLT YES - GO AND HALT ADB D12 NO - POINT TO NAME * * CHECK THE NAME IN THE ID SEGMENT * LDA B,I GET WORD CPA NAM1 MATCH? RSS JMP NIX NO INB LDA B,I NEXT WORD CPA NAM2 MATCH? RSS JMP NIX NO INB LDA B,I NEXT WORD AND HIBYT KEEP HIGH CHAR CPA NAM3 MATCH? JMP FOUND YES - THIS IS THE ID SEGMENT NIX ISZ KTBL NO - BUMP TO NEXT ENTRY JMP L1 AND GO TRY IT HLT HLT 0 IF THE ENTRY WASN'T FOUND... JMP HLT * D3 DEF 3 D7 DEF 7 D12 DEF 12 KTBL DEF *-* NAM1 ASC 1,#D "#DUMP" NAM2 ASC 1,UM NAM3 OCT 050000 LETTER P HIBYT OCT 177400 MASK TO GET THE HIGH BYTE HIBIT OCT 100000   TO OR INTO STADR FOR SYA STADR DEF \DUMP FOR SYA INSTRUCTION * * WE HAVE FOUND THE PROGRAM - GET THE ENTRY POINT * FOUND LDB KTBL,I ID SEG ADDR ADB D7 + 7 LDB B,I IS THE PRIMARY ENTRY POINT ADB D3 BUMP BY THREE TO SKIP SAFETY STB ENTP LDA STADR SAVE IOR HIBIT -OR IN DIRECTION- SYA SYSTEM MAP LDA $MRMP LOAD SYA MEM RES MAP LDA STADR LOAD \DUMP ADDR SJP ENTP,I AND GO EXECUTE THE ROUTINE * ENTP DEF *-* THE ENTRY POINT END }  ov 25117-80661 1523 S 0122 RTE DVR47 DRIVER             H0101 8ASMB,R,B,L,T,C * NAM DVR47 ENT I.47,C.47 * * THIS DRIVER IS DESIGNED TO OPERATE THE DIGITAL MULTI- * FUNCTION METER / SCANNER SUBSYSTEM. * * THE STANDARD EQUIPMENT CONSISTS OF: * * 1. HP 3480-OPT 004 DVM * 2. HP 3484-OPT HO4,041,042,043 * 3. HP 2911A CROSSBAR SCANNER * 4. HP 2911B-OPT. 033 SCANNER CONTROL * 5. HP 02116-6123 CROSSBAR SCANNER I/O CARD * 6. HP 28037-60003 CONTROLLER MICROCIRCUIT CARD * 7. HP 28037-60004 DATA SOURCE INTERFACE CARD * * THE FORTRAN CALL TO DVR47 IS: * * CALL EXEC (1,IDRT,DATA,NUMB,IPROG,ISCAN) * * WHERE: IDRT = SUBSYSTEM LOGICAL UNIT NUMBER * DATA = USERS DATA BUFFER ADDRESS * NUMB = NUMBER OF READINGS (1 IF NOT DIGITIZE) * NOTE: THIS IS NOT THE # OF CPU WORDS! * IPROG= MULTIFUNCTION UNIT PROGRAM WORD * ISCAN= SCANNER PROGRAM WORD * * PROGRAM WORD: BITS MEANING * (IPROG) ---- ------- * * 15 DMA (OPTIONAL W/SAMPLE&HOLD) * * 14-12 NOT USED * * 11-9 EXTERNAL PACER: 0= NO * 1= YES * * 8-6 FILTER: 0= NO FILTER * 1= FILTER A * 2= FILTER B * * 5-3 FUNCTION: 0= DC * 1= AC(AC) * 2= OHMS * 3= AC(DC) * 4= SAMP/HOLD (NO DELAY) * 5= SAMP/HOLD (W/DELAY) * * 2-0 RANGE: 0= --- , 10 MOHM * 1= 1000V, 1 MOHM * 2= 100V, 100 KOHM * 3= 10V, 10 KOHM *  4= 1V, 1 KOHM * 5= 100MV, 100 OHM * * * * SCANNER PROGRAM: BITS MEANING * (ISCAN) ---- ------- * * 15 BLOCK SCAN ENABLE= 1 * * 14-12 DELAY: 0= 27MS * 1= 27MS * 2= 27MS * 3= 27MS * 4= 42MS * 5= 62MS * 6= 145MS * 7= 500MS * * 11-9 NOT USED * * 8-0 CHANNEL NUMBER (INTEGER) * * * THE FORTRAN CALL TO CLEAR ALL DVM PROGRAM LINES IS: * * CALL EXEC (1,IDRT,0) * * WHERE: IDRT = SUBSYSTEM LOGICAL UNIT NUMBER * * SKP * * INITITION SECTION * I.47 NOP LDB EQT6,I CHECK FOR CPB D1 READ REQUEST JMP SETIO OK- CONFIGURE I/O ERROR CLA,INA,RSS REJECT ERROR LDA D5 DMA NEEDED! CLB JMP I.47,I RETURN * SETIO INA IOR OTA FORM "OTA PGM" STA OTA1 STORE OUTPUT INSTRUCTION STA OTA6 XOR B1100 FORM "STC PGM,C" STA STCC1 STORE XOR B1200 FORM "LIA PGM" STA LIA1 STORE XOR B1400 FORM "CLF PGM" STA CLF1 STORE INA XOR B1000 FORM "STF SCAN" STA STF1 STORE XOR B700 FORM "OTA SCAN" STA OTA5 STORE XOR B5000 FORM "OTB SCAN,C" STA OTB1 STORE XOR B5000 FORM "STC SCAN" IOR B100 STA STC2 STORE * LDB EQT7,I CLEAR DVM SZB PROGRAM LINES ? JMP BUFR NO, CHECK BUFFER LENGTH CLA OTA6 OTA 0 CLEAR LINES LDA D4 SET IMMEDIATE COMPLETION CCB SET B REG. TO -1 JMP I.47,I RETURN * BUFR LDA EQT8,I GET NUMBER OF READINGS ADA DM1 SUBTRACT 1 SSA IS COUNT 1 OR GREATER ? JMP ERR02 NO, REJECT * LDA EQT10,I GET SCANNER PROGRAM ALF AND B7 ISOLATE DELAY STA B SAVE ADA DM3 SSA CODE <3 ? LDB B3 YES, SET DELAY= 27 MS ADA DM5 SSA,RSS CODE >7 ? JMP ERR02 YES, REJECT OTB1 OTB 0,C OUTPUT DELAY CODE * LDA EQT10,I GET SCANNER PROGRAM AND B7777 ISOLATE CHANNEL # CLB DIV D10 CONVERT STB WORD CLB TO DIV D10 ALF BCD ADA B ALF ADA WORD STF1 STF 0 ENABLE CHANNEL BITS OTA5 OTA 0 OUTPUT CHANNEL STC2 STC 0 ENCODE SCANNER * LDA EQT9,I GET PROGRAM WORD LDB DM6 JSB DECOD DECODE RANGE STB WORD SAVE LDA EQT9,I GET PROGRAM WORD ASR 3 LDB DM6 JSB DECOD DECODE FUNCTION BLF,BLS LDA WORD COMBINE: IOR B RANGE & FUNCTION CPB B1000 SAMPLE & HOLD DELAY ? IOR B400 YES, ADD DELAY BIT STA WORD SAVE AND B100 ISOLATE OHMS SZA OHMS ? JMP *+5 LDA EQT9,I NO,IS AND B7 RANGE 0 ? SZA,RSS JMP ERR02 YES, REJECT LDA EQT9,I GET PROGRAM WORD ASR 6 LDB DM3 JSB DECOD DECODE FILTER SZB,RSS FILTER PROGRAMMED ? JMP *+5 LDA WORD AND B240 YES, IS AC SZA JMP ERR02 YES, REJECT LDA B ASL 10 IOR WORD COMBINE: RANGE, FUNCTION, FILTER STA WORD SAVE SZB,RSS IF JMP *+6 SAMPLE & HOLD AND B400 PROGRAMMED SZA,RSS WITH m JMP *+3 FILTER, ERR02 LDA D2 REJECT JMP ERROR+2 * CLA STA DMAFL CLEAR DMA FLAG LDA EQT9,I GET PROGRAM WORD ASR 9 LDB DM2 JSB DECOD DECODE PACER LDA WORD SZB,RSS PACER ? JMP *+6 AND B400 YES, IS SAMPLE/HOLD SZA,RSS PROGRAMMED ? JMP ERR02 NO, REJECT LDA B100K STA DMAFL SAVE ENCODE CONTROL CLB LDA EQT9,I GET DVM PROGRAM WORD AND B20 SZA,RSS OHMS? JMP COMB NO! LDA EQT9,I AND B300 SZA FILTER ? JMP COMB LDA EQT9,I AND B7 ADA DM2 SSA 1 OR 10 MOHM RANGE ? LDB B2000 YES, FORCE FILTER COMB LDA WORD IOR B FORCE FILTER BIT ? IOR DMAFL EXTERNAL ENCODE ? IOR B20K ADD HOLD BIT STA WORD SAVE PROGRAM WORD IOR B10K CLF1 CLF 0 PROG. ENCODE RESET OTA1 OTA 0 OUTPUT PROGRAM WORD LDA EQT8,I GET # OF READINGS CMA,INA STA EQT11,I NEG. READING COUNT INA,SZA,RSS WAS COUNT 1 ? JMP RTDMA YES, RETURN DMA CHAN. LDA WORD GET PROGRAM WORD AND B6340 DC, NO FILTER ? SZA JMP RTDMA NO, RETURN DMA CHAN. LDA EQT10,I GET SCANNER PROGRAM SSA BLOCK SCAN ? JMP RTDMA YES, RETURN DMA CHAN. LDA EQT9,I GET DVM PROGRAM WORD AND B40 SZA SAMPLE AND HOLD ? JMP *+4 NO! LDA EQT9,I YES, DMA REQUESTED ? SSA,RSS JMP RTDMA NO, RETURN DMA CHAN. JSB DMAA DMA ASSIGNED YET ? JMP ERROR+1 NO! * IOR OTA FORM "OTA DMA" STA OTA2 STORE ADA DM4 FORM "OTA DMA-4" STA OTA3 STORE STA OTA4 XOR B100 FORM "STC DMA-4" STA STC1 STORE XOR B4000 FORM "CLC DMo"A-4" STA CLC1 STORE * LDA EQT4,I INITIALIZE DMA AND B77 ISOLATE DSI CHAN. # IOR CW1 OTA2 OTA DMA OUTPUT CONTROL WORD 1 CLC1 CLC DMA-4 LDA EQT7,I GET FWA OF USER BUFFER IOR B100K OTA3 OTA DMA-4 OUTPUT CONTROL WORD 2 STC1 STC DMA-4 LDA EQT8,I GET NUMBER OF READINGS ADA A DOUBLE IT AND CMA,INA MAKE NEGITIVE OTA4 OTA DMA-4 OUTPUT CONTROL WORD 3 CLA,INA SET STA DMAFL DMA FLAG * BYDMA LDB DM1 SET B REG = -1 LDA EQT9,I GET PROGRAM WORD AND B30 ISOLATE AC(DC) CODE CPA B30 AC(DC) ? LDB DM5 YES, SET B REG = -5 LDA EQT9,I GET PROGRAM WORD AND B327 ISOLATE OHMS CODE CPA B120 10 MOHM, FIL A ? LDB DM10 YES, SET B REG = -10 CPA B220 10 MOHM, FIL B ? LDB DM20 YES, SET B REG = -20 STB EQT13,I ESTABLISH DELAY COUNTER * LDA DMAFL SAVE DMA RAR FLAG IN BIT 15 IOR EQT7,I GET BUFFER ADDRESS STA EQT12,I ESTABLISH WORKING POINTER LDA WORD STA EQT7,I SAVE PROGRAM WORD LDB CNTR1 SET TIME OUT COUNTER IN B REG. LIA1 LIA 0 TEST FOR SLA,RSS PROGRAM JMP LEAVE ACKNOWLEDGE FLAG ISZ B INCREMENT TIME JMP LIA1 OUT COUNTER LDA B3 SET A REG. = 3 JMP I.47,I ERROR RETURN * RTDMA JSB DMAA WAS A DMA CHAN ASSIGNED? JMP BYDMA NO! LDB INTBA YES! B=FWA INT TABLE SLA CH7 ? INB YES! B=FWA INT TABLE+1 CLA CLEAR STA B,I TABLE ENTRY STA DMAFL AND DMA FLAG JMP BYDMA * LEAVE CCA STA EQT9,I SET FIRST READING FLAG STCC1 STC 0,C ENABLE SCANNER FLAG CLA JMP I.47,I RETURN * DECOD NOP CONVERT CODE TO SINGLE LINE AND B7 5aISOLATE CODE ADB A IS IT VALID ? SSB,RSS JMP ERR02 NO ,REJECT CLB SZA,RSS CODE = 0 ? JMP DECOD,I YES,RETURN CLB,INB SET B REG = 1 ADA DM1 SUBTRACT 1 FROM CODE SZA,RSS DONE ? JMP DECOD,I YES, B REG = SINGLE LINE CODE BLS JMP *-4 * DMAA NOP TO DETERMINE DMA STATUS DLD INTBA,I GET FWA'S OF EQT HOLDING DMA CPA EQT1 CH6 ASSIGNED ? LDA D6 YES! CPB EQT1 CH7 ASSIGNED ? LDA B7 YES! CPA D6 ADJUST RSS THE CPA B7 RETURN ISZ DMAA ADDRESS JMP DMAA,I & RETURN * * SKP * * COMPLETION SECTION * C.47 NOP CPA D6 EXIT JMP P.1+1 IF CPA B7 DMA JMP P.1+1 INTERRUPT IOR CLC STA *+1 CLEAR CONTROL CLC 0 ON INT SOURCE * LDB EQT1,I IS THIS A SZB SPURIOUS INTERRUPT ? JMP *+3 NO STB EQT15,I YES, PREVENT TIMEOUT JMP P.2 AND CONTINUE * LDA EQT4,I AND B77 ISOLATE DSI CHANNEL IOR CLC XOR B200 FORM "LIB DSI" STA LIB1 STORE XOR B4000 FORM "LIA DSI" STA LIA2 STORE XOR B1200 FORM "STC DSI,C" STA STCC4 STORE INA FORM "STC PGM,C" STA STCC5 STORE XOR B1100 FORM "OTA PROG" STA OTA7 STORE XOR B300 FORM "LIA PROG" STA LIA3 STORE INA XOR B200 FORM "STC SCAN" STA STC3 STORE * LDA EQT6,I GET INTERRUPT SOURCE FLAG SZA,RSS SCANNER INTERRUPT JMP *+4 NO! CLA STA EQT6,I CLEAR SCANNER INTERRUPT JMP STCC4 LDA EQT9,I SZA,RSS FIRST READING ? JMP *+3 NO! ISZ EQT13,I INCR#EMENT DELAY COUNTER JMP STCC4 MORE DELAY NEEDED! LDA EQT8,I GET # OF READINGS CPA D1 ONE ? JMP DATA YES! LDA EQT7,I GET PROGRAM WORD ASR 10 AND B3 SZA FILTER PROGRAMMED ? JMP DMACK YES! LDA EQT7,I GET PROGRAM WORD OTA7 OTA 0 REMOVE EXT. TRIG. DELAY LDB CNTR1 SET TIME OUT COUNTER LIA3 LIA 0 TEST FOR SLA,RSS PROGRAM JMP DMACK ACKNOWLEDGE ISZ B FLAG JMP LIA3 CLA,INA JMP C.47,I NO FLAG, REJECT * DMACK LDA EQT12,I SSA DMA FLAG SET ? JMP DMAON YES! CLA STA EQT9,I CLEAR FIRST READING FLAG DATA LDA EQT12,I GET CURRENT ELA,CLE,ERA STA POINT USER BUFFER ADDRESS LIA2 LIA 0 LOAD FIRST DATA WORD LIB1 LIB 0 LOAD SECOND DATA WORD DST POINT,I STORE READING ISZ EQT11,I ADVANCE READING COUNTER RSS JMP P.1 ALL DONE!!! * ISZ EQT12,I INCREMENT ISZ EQT12,I BUFFER ADDRESS LDA EQT10,I GET SCANNER PROGRAM WORD SSA,RSS BLOCK SCAN JMP STCC4 NO, START NEXT READING STC3 STC 0 YES ,ADVANCE CHANNEL STCC5 STC 0,C ENABLE SCANNER FLAG CLA,INA SET SCANNER STA EQT6,I INTERRUPT FLAG JMP P.2 WAIT * DMAON JSB DMAA CHECK DMA STATUS JMP ERROR+1 IOR CLC FORM "CLC DMA" STA CLC2 STORE XOR B5000 FORM "STC DMA,C" STA STCC2 STORE STCC2 STC DMA,C INITIATE DMA CLA SPECIAL CPA DUMMY PROCESSING REQUIRED ? JMP STCC4 NO, START MEASUREMENT CLC2 CLC DMA CLEAR DMA CONTROL LDB INTBA GET LDA CHAN INTERRUPT TABLE CPA B7 CONTENTS INB FOR THE LDA B,I DMA CHANNEL IOR B100K SET STA B,I 0.* BIT 15= 1 CLA STCC4 STC 0,C ENCODE DVM * P.2 CLA ISZ C.47 SET UP AND PERFORM JMP C.47,I CONTINUATION RETURN * P.1 CLA,RSS LDA B100K SET BIT 15= 1 LDB EQT8,I GET # OF READINGS ADB B DOUBLE IT JMP C.47,I COMPLETION RETURN SKP * * SYSTEM BASE PAGE COMMUNICATION AREA * . EQU 1650B EQT1 EQU .+8 EQT4 EQU .+11 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 .. EQU 1771B EQT12 EQU .. EQT13 EQU ..+1 EQT15 EQU ..+3 * CHAN EQU 1673B INTBA EQU 1654B DUMMY EQU 1737B * * SKP * * CONSTANTS, COUNTERS, AND STORAGE * A EQU 0 B EQU 1 B3 OCT 3 B7 OCT 7 B20 OCT 20 B30 OCT 30 B40 OCT 40 B77 OCT 77 B100 OCT 100 B120 OCT 120 B200 OCT 200 B220 OCT 220 B240 OCT 240 B300 OCT 300 B327 OCT 327 B400 OCT 400 B700 OCT 700 B1000 OCT 1000 B1100 OCT 1100 B1200 OCT 1200 B2000 OCT 2000 B1400 OCT 1400 B4000 OCT 4000 B5000 OCT 5000 B6340 OCT 6340 B7777 OCT 7777 B10K OCT 10000 B20K OCT 20000 B100K OCT 100000 CNTR1 DEC -250 CW1 OCT 120000 D1 DEC 1 D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D10 DEC 10 DM1 DEC -1 DM2 DEC -2 DM3 DEC -3 DM4 DEC -4 DM5 DEC -5 DM6 DEC -6 DM10 DEC -10 DM20 DEC -20 DMAFL NOP POINT NOP WORD NOP CLC CLC 0 OTA OTA 0 DMA EQU 6B * END ^q0 p } 25117-80687 1805 S 0122 7970B 7TRK RTE DRIVER (DVR24)             H0101 ASMB,R,L,C NAM DVR24 ENT I.24,C.24 * * * M. SCHOENDORF 8/31/73 REV. B * M. SCHOENDORF 3/28/74 REV. C * G. SPRADER 5/ 2/74 REV. D * R. CHIPMAN REV. 1813 * * * * SOURCE TAPE 25117-80687 * HED ** HP 7970 7 TRACK MT RTE DRIVER ** ,[HJF,4/16/72] * INITIATION SECTION. SPC 1 I.24 NOP ENTRY POINT LDB EQT11,I LOAD THE "EOT" FLAG WORD. M5600 ELB *SHIFT THE FLAG INTO "E". LDB CHAN LOAD THE "DMA" CHANNEL NUMBER. ELB,CLE,RBR *INCLUDE THE "EOT" FLAG BIT. STB EQT11,I *STORE THE "EOT" FLAG WORD JSB SETIO SET I/O INSTRUCTIONS FOR MT. STA C.24 SET THE INITIATOR FLAG LDA N3 LOAD: A=-3. STA EQT10,I SET THE ERROR RETRY COUNTER. LDA EQT6,I LOAD REQUEST CONTROL WORD AND DEC64 ISOLATE MODE BIT CCE,SZA BCD? CLA,CME NO! ERA YES! STA BCD,I BCD FLAG = 100000 FOR BCD LDA EQT6,I LOAD THE REQUEST CONTROL WORD. AND DEC3 ISOLATE THE REQUEST CODE. CPA DEC3 *IS REQUEST A CONTROL REQUEST? JMP R3 *YES, GO EXAMINE FUNCTION CODE. SLB,RBR *IS UNIT IN LOCAL MODE? JMP I.A.3 YES, GO DOWN THE UNIT. SLA,ARS *NO; IS THE REQUEST TO READ? JMP READ YES, CONTINUE. RBR,SLB NO; IS WRITE ENABLE RING IN? JMP I.A.3 NO, GO REJECT THE REQUEST. JSB CEOT *GO CHECK FOR END-OF-TAPE (EOT). JSB NBUFL GO GET THE NEGATIVE WORD COUNT. SZB,RSS IS THE BUFFER LENGTH = 0? JMP I.A.4 YES, GIVE IMMEDIATE COMPLETION. * M5000 BLS *CONVERT TO CHARS(-) LDA BCD,I *GET THE BCD FLAG. SSA,RSS *BINARY MODE ? JMP M1100-1 *YES! SKIP LIMIT CHECK . SEZ ODD # OF CHARACTERS? ADB M1 *YES! ADD ONE CHARACTER . ADB M4 *B= -[# OF CHARACTERS] + 4 ADB P130  *YES! SSB *MORE THAN 134 CHARACTERS? CLB *YES FORCE 134! ADB M134 *NO! LDA B *A= -[# OF CHARACTERS TO WRITE] CMA,SZA *ONE OR CPA M1 * TWO CHARACTERS ? LDA DEC3 *YES! ADJUST FOR FOUR CMA,RSS * CHARACTERS TO BE WRITTEN. LDA B *A= -[# OF CHARACTERS TO WRITE] M1100 ARS *A= -[# OF WORDS] STA EQT13,I *SAVE THE NEGATIVE WORD COUNT. LDA BCD,I GET BCD FLAG REJ CLE,SSA,RSS *BCD MODE ? JMP BINRY *NO! GO WRITE BINARY * * CONVERT FROM ASCII TO BCD * LDA EQT7,I *GET ADDRESS OF USERS BUFFER STA PAKUN *USE PAKUN AS POINTER * * ASSIGN AN INTERNAL (DRIVER) BUFFER * TO A DMA CHANNEL * JSB WBUF *GET INTERNAL BUFFER ADDRESS STA BPNTR *SAVE IT. * INA * STA CLC.0 *SAVE INTERNAL BUF ADDRESS + 1 . LDA DBLNK *GET DOUBLE BLANK. STA CLC.0,I *SET INTO 2ND WORD. * LOOP LDA PAKUN,I GET UPPER CHAR ALF,ALF MOVE DOWN AND M77 CUT OFF UPPER CHARACTER ADA TBLAD ADD TABLE ADDRESS LDA A,I GET EQUIV AND M37.4 *KEEP UPPER SIX BITS. INB,SZB ALL DONE? JMP *+4 NO, GO AND DO NEXT XOR O20 YES, PUT BCD BLANK IN LAST CHAR CCB SET B=-1 TO FORCE EXIT JMP SECND STORE LAST WORD STA STAT. STORE TEMPORARILY LDA PAKUN,I GET LOWER CHAR AND M77 CUTOFF UPPER CHAN ADA TBLAD ADD TABLE ADDRESS LDA A,I GET EQUIV ALF,ALF MOVE AROUND AND M77 KEEP SIX. IOR STAT. ADD IN UPPER CHAR SECND STA BPNTR,I PLACE CHARS IN DVR BUFFER ISZ PAKUN INCREMENT USER BUFFER POINTER ISZ BPNTR INCREMENT DVR BUFF POINTER INB,SZB DONE? JMP LOOP NO, GO BACK JSB WBUF *GET INTERNAL BJUFFER ADDRESS CLE,RSS *RESTORE READ/WRITE FLAG TO WRITE SPC 1 BINRY LDA EQT7,I LOAD OUTPUT BUFFER ADDRESS STA EQT7,I *SAVE OUTPUT BUFFER ADDRESS[REJ] JSB IODMA GO PERFORM THE OPERATION. LDB M301 LOAD: WRITE COMMAND CODE ADB BCD,I ADD BIT 15 IF BCD MODE LDA .1 *LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF REJ *REJECT INTERRUPT RETURN ADDRESS. * DBLNK OCT 010020 N3 DEC -3 N6 DEC -6 M134 DEC -134 M1 OCT 1 M4 OCT 4 P130 DEC 130 M301 OCT 301 M37.4 OCT 37400 O20 OCT 20 BCD BLANK * * WBUF NOP *ENTRY. LDA EQT11,I *GET THE DMA CHANNEL WORD. AND M7 *ISOLATE THE DMA CHANNEL #. ADA N6 *SUBTRACT SIX. ADA BUFRS *ADD THE INTERNAL BUFFER POINTER. LDA A,I *A=ADDRESS OF DVR INTERNAL BUFFER. JMP WBUF,I *RETURN. * * BUFRS DEF *+1 DEF OBUF1 (USED BY DMA CH 6) IFZ DEF OBUF2 (USED BY DMA CH 7) XIF DEF OBUF1 (USED BY DMA CH 7) * .1 DEF ..1 ..1 JSB CHECK *ANY PARITY ERRORS? ..4 LDB DEC5 YES, LOAD: BACKSPACE COMMAND. LDA .5 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..4 *REJECT INTERRUPT RETURN ADDRESS. * ..5 LDA .20 LOAD THE INTERRUPT RETURN. LDB M121 LOAD: GAP COMMAND CODE JSB FUNCT GO INITIATE THE FUNCTION. .5 DEF ..5 REJECT, INTERRUPT ADDRESS RETURN. * * * .20 DEF ..20 ..20 LDA EQT5,I LOAD THE MT UNIT STATUS. AND M22 GET PARITY & TIMING BITS SZA WERE THERE ANY ERRORS? JMP W.ERR YES, GO ABORT THE REQUEST. JSB CEOT NO, GO CHECK FOR END-OF-TAPE. JMP BINRY *TRY TO WRITE AGAIN SPC 2 READ CPA EQT8,I IS THE BUFFER LENGTH = ZERO(0)? JMP SKIP. YES, GO CHECK THE MODE. JSB EOTF NO, GO CHECK FOR "EOT" CONDITION. ..6 JSB NBUFL GO GET THE NEGATIVE WORD COUNT. CCE *SET "E" TO INDICATE DMA INPUT. LDA EQT7,I LOAD THE USER BUFFER ADDRESS. JSB IODMA GO PERFORM THE OPERATION. LDB M203 LOAD: READ COMMAND CODE ADB BCD,I ADD BIT 15 IF BCD MODE LDA .7 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. .6 DEF ..6 REJECT, INTERRUPT ADDRESS RETURN. * M203 OCT 203 * .7 DEF ..7 ..7 LDA BCD,I *GET XMISSION COMPLETE FLG. RAR,SLA *CONVERSION DONE YET? RSS JMP TLOG *NO! JSB CHECK *CHECK FOR R/W PARITY ERRORS. ..7.5 ISZ EQT10,I IS THIS THE LAST RETRY? JMP *+2 *NO! SKIP. JMP FINI *UPDATE THE TRANSMISSION LOG. ..8 LDB DEC5 LOAD: BACKSPACE COMMAND LDA .6 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..8 REJECT, INTERRUPT ADDRESS RETURN. * DEC5 DEC 5 * SKIP. LDA EQT6,I LOAD THE FUNCTION REQUEST CODE. AND DEC64 ISOLATE THE MODE BIT. SZA IS THE MODE BINARY? JMP FSR YES, GO SKIP FORWARD 1 RECORD. CLB I.A.4 LDA DEC4 LOAD: A=4. IMMEDIATE COMP. JMP I.24,I RETURN TO THE USER;B=X-LOG SPC 2 R3 LDA EQT6,I GET THE REQUEST CONTROL WORD. AND M1700 *ISOLATE THE FUNCTION CODE. CPA M600 IS IT A DYNAMIC STATUS REQUEST? JMP I.A.4-1 *YES, GIVE AN IMMEDIATE RETURN. SLB,RBR IS THE UNIT IN LOCAL MODE? JMP I.A.3 YES, THEN DOWN UNIT. CPA M200 *NO; IS IT A BACKSPACE REQUEST? JMP BSR YES, CONTINUE. CPA M300 NO; IS IT FORWARD SPACE REQUEST? JMP FSR YES, CONTINUE. CPA M400 NO; IS IT A REWIND REQUEST? JMP REW YES, CONTINUE. CPA DEC64 NO; WRITE END-OF-FILE REQUEST? JMP EOF YES, CONTINUE. CPA M1200 NO; IS IT A GAP REQUESښT? JMP GAP YES, CONTINUE. CPA M1300 NO; IS IT FORWARD SPACE FILE? JMP FSF YES, CONTINUE. CPA M1400 NO; IS IT BACKSPACE FILE? JMP BSF YES, CONTINUE. CPA M500 IS IT A REWIND/STANDBY REQUEST? JMP RWS YES, CONTINUE. JMP I.A.2 NO, GO REJECT THE REQUEST. * M77 OCT 77 DEC64 DEC 64 @100 M200 OCT 200 M300 OCT 300 M400 OCT 400 M600 OCT 600 M1200 OCT 1200 M1300 OCT 1300 M1400 OCT 1400 M1700 OCT 1700 * BSR JSB CSOT *GO CHECK FOR "BOT" CONDITION. JSB RWCHK CHECK IF REWINDING ..9 LDB DEC5 LOAD: BACKSPACE COMMAND LDA .10 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..9 REJECT, INTERRUPT ADDRESS RETURN. .10 DEF ..10 * FSR JSB CEOT GO CHECK FOR "EOT" CONDITION. ..11 LDA .TLOG LOAD THE INTERRUPT RETURN. LDB DEC3 LOAD: FORWARD SPACE COMMAND CODE. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..11 REJECT, INTERRUPT ADDRESS RETURN. * REW JSB CSOT *GO CHECK FOR "BOT" CONDITION. JSB RWCHK *SEE IF UNIT ALREADY REWINDING. ..12 LDB M11 LOAD: REWIND COMMAND CODE LDA .10 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..12 REJECT, INTERRUPT ADDRESS RETURN. * M11 OCT 11 * * RWS STA EQT10,I *SET REW/STANDBY FLAG. JSB RWCHK *SEE IF UNIT ALREADY REWINDING. LDA STORE *GET THE HARDWARE STATUS. ALF,ALF *MOVE "BOT" RAL,RAL * TO SIGN. SSA,RSS *IS TAPE AT LOAD POINT? JMP ..RWS *NO! LDA .RWS *SET INTERRUPT RETURN ADDRESS. LDB DEC3 *GET FORWARD SPACE CODE. JSB FUNCT *INITIATE THE FUNCTION. DEF *-3 *REJECT INTERRUPT ADDRESS. * ..RWS LDB M31 *LOAD REWIND/OFF-LINE COMMAND. LDA .10 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTI/=ON. DEF RWS+2 *REJECT, INTERRUPT ADDRESS RETURN. * .RWS DEF ..RWS M31 OCT 31 * RWCHK NOP *ENTRY. LDA STORE *GET HARDWARE STATUS. ALF,RAL *MOVE REWIND BIT TO SIGN. SSA *UNIT CURRENTLY REWINDING ? JMP I.A.4-1 *YES! RETURN IMMEDIATELY! JMP RWCHK,I *NO. CONTINUE. * FSF JSB CEOT GO CHECK FOR "EOT" CONDITION. ..14 LDA .TLOG LOAD THE INTERRUPT RETURN. LDB M1.43 JSB FUNCT GO INITIATE THE FUNCTION. DEF ..14 REJECT, INTERRUPT ADDRESS RETURN. .TLOG DEF TLOG0 * M1.43 OCT 100043 * * BSF JSB CSOT *GO CHECK FOR "BOT" CONDITION. JSB RWCHK CHECK IF REWINDING ..15 LDA .10 LOAD THE INTERRUPT RETURN. LDB M1.45 JSB FUNCT GO INITIATE THE FUNCTION. DEF ..15 REJECT, INTERRUPT ADDRESS RETURN. * M1.45 OCT 100045 * * GAP RBR,SLB IS WRITE RING PROVIDED? JMP I.A.3 NO, GO REJECT THE REQUEST. JSB CEOT YES, GO CHECK FOR END-OF-TAPE. ..23 LDA .22 LOAD THE INTERRUPT RETURN. LDB M121 LOAD: GAP COMMAND CODE JSB FUNCT GO INITIATE THE FUNCTION. DEF ..23 REJECT, INTERRUPT ADDRESS RETURN. * M22 OCT 22 M121 OCT 121 * * .22 DEF ..22 ..22 LDA EQT5,I LOAD THE MT UNIT STATUS. AND M22 GET PARITY & TIMING BITS SZA WERE THERE ANY ERRORS? JMP W.ERR YES, GO ABORT THE REQUEST. JMP TLOG0 NO, GO UPDATE TRANSMISSION LOG. * EOF RBR,SLB IS WRITE RING PROVIDED? JMP I.A.3 NO, GO REJECT THE REQUEST. ..13 JSB EOTF GO CHECK FOR END-OF-TAPE. ..17 LDB S1161 LOAD: WRITE EOF COMMAND LDA .18 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..17 REJECT, INTERRUPT ADDRESS RETURN. * S1161 OCT 100161 * .18 DEF ..18 ..18 LDA EQT5,I LOAD THE MT UNIT STATUS. AND M22 GET PARITY & TIMING BITS SZA,RSS WERE THERE ANY ERRORS? JMP TLOG. NO, GO UPDATE TRANSMISSION LOG. ..19 LDB DEC5 YES, LOAD: BACKSPACE COMMAND LDA .13 LOAD THE INTERRUPT RETURN. JSB FUNCT GO INITIATE THE FUNCTION. DEF ..19 REJECT, INTERRUPT ADDRESS RETURN. .13 DEF ..13 SPC 2 STAT. NOP ENTRY POINT. LIA1C LIA CMND GET MIXED UP BITS FROM 13182A STB CONFG SAVE B STA STORE SAVE MIXED BITS AND M3012 REW,NOT READY,REJ,P/E STA B PUT A IN B TO BUILD STATUS LDA STORE NEXT BITS AND M160 EOF,BOT,EOT ALS MOVE ONE LEFT ADB A ADD TO STATUS LDA STORE NEXT BITS AND M401 OFF LINE, CONTROLLER BUSY ALF,ALF SWAP BITS ROUND ADB A ADD TO STATUS LDA STORE NEXT BIT AND DEC4 TIMING ERROR ALS,ALS MOVE LEFT TWO ADB A ADD TO STATUS LDA STORE LAST BIT AND M200 PROTECTED ALF,ALF 12 LEFT + 1 RIGHT ALF,ARS = 5 RIGHT ADA B A = STATUS LDB CONFG RESTORE B JMP STAT.,I *RETURN * M160 OCT 160 M401 OCT 401 M3012 OCT 3012 * CEOT NOP ENTRY POINT. LDA EQT5,I LOAD THE MT UNIT STATUS. AND M40 EOT STATUS BIT CLE,SZA,RSS IS MT UNIT AT END-OF-TAPE (EOT)? JMP CEOT,I NO, RETURN. I.A.2 LDB C.24 LOAD THE INTERRUPT FLAG LDA DEC2 LOAD: A=2;ILLEG CONTL/EOT SSB,RSS INTERRUPT RETURN? JMP C.24,I YES, GIVE A COMPLETION RETURN JMP I.24,I NO, RETURN TO USER SPC 1 I.A.3 LDA DEC3 LOAD: A=3;NOT READY JMP I.24,I RETURN TO THE USER * DEC2 DEC 2 DEC3 DEC 3 DEC4 EQU M4 M40 OCT 40 * NBUFL NOP ENTRY POINT. LDB EQT8,I LOAD THE BUFFER LENGTH REQUEST. CCE,SSB,RSS IS THE LENGTH IN WORDS? CMB,CLE,INB,RSS SI!CONVERT THuO NEGATIVE; SKIP. ERB NO, CONVERT TO WORDS. STB EQT13,I *STORE THE NEGATIVE WORD COUNT. JMP NBUFL,I RETURN: B=(-)WORD COUNT * E=0=>WDS OR EV # CHRS * E=1=>ODD # CHARS SPC 2 * JSB SETIO *SET THE MT I/O INSTRUCTIONS. SPC 2 TLOG LIA CMND *LOAD THE HARDWARE STATUS. AND DEC64 *ISOLATE THE "EOF" BIT. SZA WAS IT AN END-OF-FILE (EOF) ? JMP TLOG0 *RETURN 0 XMISSION LOG. W.CNT LIA DMA-4 LOAD THE WORD COUNT REGISTER. SZA DID "DMA" GO TO COMPLETION? IOR DMASK *NO! RESTORE THE LOST BITS [-] . LDB EQT6,I LOAD THE REQUEST CONTROL WORD. RBR,ERB SHIFT THE WRITE BIT TO "E". CMA,SEZ,INA,SZA DID THE WRITE COMPLETE? JMP W.ERR NO, GO ABORT THE REQUEST. LDB EQT13,I *YES! GO GET NEGATIVE WORD COUNT. ADB A LET "B" = -(WORDS TRANSMITTED). STB CTEMP *SAVE THE ACTUAL COUNT. ISZ BCD,I *BUMP THE XMISSION COMPLETE FLAG. LDA EQT6,I *GET THE REQUEST WORD. CCE,SLA,RSS *READ REQUEST ? JMP STEER *NO! LDA BCD,I GET BCD FLAG SSA,RSS *BCD MODE ? JMP STEER *NO! CONTINUE. SPC 1 * * START BCD TO ASCII CONVERSION * SPC 1 LDB CTEMP YES, LOAD NEG WORD COUNT STB MBUFC STORE COUNT LDA EQT7,I GET USER BUFFER ADDRESS STA UNPAK USE UNPAK AS POINTER RSS * NEWCH ISZ UNPAK *ADVANCE BUFFER POINTER. LDA UNPAK,I *GET TWO CHARACTERS. ALF,ALF USE UPPER BCD CHAR AND M77 GET 6 BITS ADA TBLAD ADD TABLE ADDRESS LDA A,I GET ASCII EQUIV. AND M377 USE LOWER 8 BITS. ALF,ALF MOVE BACK UP STA STAT. STORE TEMPORARILY LDA UNPAK,I GET OTHER CHAR AND M77 ADA TBLAD LDA #A,I AND M377 IOR STAT. ADD IN UPPER CHAR STA UNPAK,I PUT BACK IN BUFFER ISZ MBUFC DONE? JMP NEWCH NO, GO BACK * STEER JSB DMAI *DMA INTERRUPT ? ISZ BCD,I *YES! INCREMENT XMISSION FLAG. LDA EQT11,I *GET THE DMA CHANNEL #. JMP SPURI *RETURN. * CTEMP NOP WORD COUNT STORAGE * DMAI NOP *ENTRY. LDA C.24 *GET COMPLETION ENTRY POINT. SSA *POST INTERRUPT PHASE? JMP NDMAI *NO! LIA 4 *GET INTERRUPT SOURCE CODE. CPA M6 *INT FROM DMA CH6 ? JMP DMAI,I *YES! RETURN "P+1" . CPA M7 *INT FROM DMA CH7 ? JMP DMAI,I *YES! RETURN "P+1" . NDMAI ISZ DMAI *ADVANCE RETURN ADDRESS. JMP DMAI,I *RETURN "P+2" . * CHECK NOP *ENTRY POINT. JSB CEOT *CHECK FOR EOT. LDA BCD,I *GET MODE WORD. ELA *PRESERVE CLA,SEZ * MODE BIT IN ERA * CASE OF STA BCD,I * REJECT. LIA3C LIA CMND *LOAD THE MT UNIT STATUS. AND DEC2 *GET PARITY BIT. CLE,SZA *PARITY ERROR? JMP CHECK,I *YES! RETURN. * FINI LDB CTEMP *RESTORE WORD COUNT IN B. SSB CMB,INB LDA EQT8,I LOAD THE USER BUFFER LENGTH. SSA WAS THE REQUEST FOR CHARACTERS? BLR *YES! CREATE [+] CHARACTERS. LDA EQT10,I *GET THE RETRY COUNTER. SZA *WERE 3 TRYS NEEDED? JMP END *NO! <3 ; RETURN TO SYSTEM. LDA DEC3 *YES! A=3 ; XMISSION ERROR! JMP END+1 *GIVE COMPLETION RETURN. * M377 OCT 377 * EOTF NOP ENTRY POINT. LDA EQT5,I LOAD THE MT UNIT STATUS. AND M40 EOT STATUS BIT CCE,SZA,RSS IS MT UNIT AT END-OF-TAPE (EOT)? JMP EOTF,I NO, RETURN. LDA EQT11,I YES, LOAD THE "EOT" FLAG WORD. ELA,RAR SHIFT THE "EOT" FLAG TO "E". STA EQT11,I STORE THE "EOT" FLAG. SEZ,CCE WAS END-OF-TAPE ALREADY REACHED? JMP I.A.2 YES, GO REJECT THE REQUEST. JMP EOTF,I NO, RETURN. * DMASK OCT 140000 "DMA" WORD COUNT MASK * CSOT NOP ENTRY POINT. LDA EQT5,I LOAD THE MT UNIT STATUS. AND DEC64 SOT STATUS BIT SZA,RSS *IS THE MT UNIT AT "BOT" ? JMP CSOT,I NO, RETURN. ..10 CLA ENTER: A=0. STA EQT11,I CLEAR THE "EOT" FLAG. TLOG0 CLB,RSS ENTER: B=0; SKIP. TLOG. CLB,INB ENTER: B=1. LDA C.24 LOAD THE INTERRUPT FLAG SSA IS CONTROL FROM INTERRUPT? JMP I.A.4 NO, GIVE IMMEDIATE COMPLETION. END CLA ENTER: A=0. CLC.G CLC CMND *CLEAR CMND CONTROL. JMP C.24,I GIVE A COMPLETION RETURN SPC 2 IODMA NOP ENTRY POINT. ISZ S.DMA CLEAR THE "DMA" SKIP FLAG; SKIP. S.DMA OCT -1 "DMA" SKIP FLAG. CLC2F CLC DMA-4 PREPARE THE ADDRESS REGISTER. RAL,ERA SET THE READ/WRITE BIT. OTA3E OTA DMA-4 OUTPUT THE BUFFER ADDRESS. LDA CSOT *LOAD MT DATA CHANNEL NUMBER. IOR M20K *INCLUDE THE CLC OPTION . OTA1C OTA DMA ASSIGN THE DMA CHANNEL. LDA EQT13,I *LOAD THE NEGATIVE WORD COUNT. STC2F STC DMA-4 *PREPARE WORD COUNT REGISTER OTA4E OTA DMA-4 OUTPUT THE WORD COUNT. JMP IODMA,I RETURN. * M20K OCT 020000 * REJCT CCA ENTER: A=-1. STA S.DMA SET THE "DMA" SKIP FLAG. LDA FUNCT,I LOAD REJECT INTERRUPT ADDRESS. LDB M110 LOAD THE CLEAR COMMAND CODE. RSS SKIP. * FUNCT NOP ENTRY POINT. STA EQT9,I STORE THE RETURN ADDRESS. CLC1D CLC DATA *CLEAR DATA CONTROL. OTB1C OTB CMND OUTPUT THE COMMAND CODE. LIA2C LIA CMND *GET HARDWARE STATUS. RAR,RAR SHIFT I/O REJECT BIT TO 0. RAR,SLA WAS THE COMMAND REJECTED? JMP REJCT YES, GO ISSUE A CLEAR REQUEST. CLA,CCVE NO, ENTER: A=0; E=1. CPA S.DMA IS THE REQUEST A READ OR WRITE? JMP R.W YES, GO INITIALIZE THE TRANSFER. CPB M110 *CLEAR COMMAND? JMP C.RTN-1 *YES! * * RETURN DMA CHANNEL TO SYSTEM * LDA CHAN A=DMA CHANNEL JSB FITAB GET INTERRUPT TABLE ADDRESS LDA B,I *GET INT TABLE ENTRY ELA,CLE,ERA *REMOVE THE SIGN BIT. STA B,I *SET NEW TABLE ENTRY. STC1C STC CMND,C *INITIALIZE MT UNIT CONTROL. * C.RTN LDA C.24 LOAD THE INTERRUPT CONTROL FLAG INA,SZA,RSS IS CONTROL THROUGH INTERRUPT? JMP I.24,I NO, RETURN TO THE USER JMP A,I YES, SYSTEM INTERRUPT RETURN. * R.W EQU * CLF1D CLF DATA *CLEAR DATA CHANNEL FLAG. RWCON STC CMND,C *INITIALIZE MT UNIT CONTROL. STC1E STC DMA,C *INITIALIZE DMA CHANNEL JMP C.RTN *RETURN. * * * ENTRY: A=DMA CHANNEL # FITAB NOP LDB INTBA LOAD INT TABLE ADDRESS CPA M7 IS "DMA" CH 7 BEING USED? INB YES! INCR TABLE ADDRESS JMP FITAB,I * EXIT: B=ADDRESS OF INTERRUPT TABLE ENTRY * SETIO NOP ENTRY POINT. LDA EQT4,I *GET MT CHANNEL WD. AND M77 *ISOLATE THE DATA CHANNEL. STA CSOT *STORE MT DATA CHANNEL NUMBER. IOR CLC *FORM A "CLC DATA". STA CLC1D *SET THE INSTRUCTION. STA *+1 *PUT CLC DATA IN NEXT LOCATION NOP * AND EXECUTE XOR M5600 *FORM "CLF DATA" . STA CLF1D *STORE THE INSTRUCTION. XOR M600 *FORM "STC DATA,C" . INA *FORM A "STC CMND,C". STA STC1C *STORE THE INSTRUCTION. STA RWCON *STORE THE INSTRUCTION. XOR M5000 *FORM A "CLC CMND". STA CLC.G *STORE THE INSTRUCTION. XOR M4200 *FORM A "LIA CMND". STA LIA1C *STORE THE INSTRUCTION. STA LIA2C *STORE THE INSTRUCTION. STA LIA3C *STORE THE INSTRUCTION. STA TLOG *STORE THE INSTRUCTION. XOR M4300 *FORM A "OTB CMND". STA OTB2C *STORE THE INSTRUCTION. STA OTB1C *STORE THE INSTRUCTION. LDA EQT11,I *GET THE ELA,CLE,ERA * DMA CHANNEL #. IOR STCC *FORM A "STC DMA,C". STA STC1E *SET THE INSTRUCTION. XOR M1100 *FORM A "OTA DMA". STA OTA1C *SET THE INSTRUCTION. ADA N4 *"SUBTRACT": "DMA" - 4 . STA OTA3E *STORE THE INSTRUCTION. STA OTA4E *STORE THE INSTRUCTION. XOR DEC64 *FORM A "STC DMA-4". STA STC2F *STORE THE INSTRUCTION. XOR M200 *FORM A "LIA DMA-4". STA W.CNT *STORE THE INSTRUCTION. XOR M4200 *FORM A "CLC DMA-4". STA CLC2F *STORE THE INSTRUCTION. JSB DMAI *DMA INTERRUPT ? JMP IOSET *YES! BYPASS STATUS CHECK. LDA EQT4,I *LOAD THE UNIT NUMBER. AND M300 *ISOLATE THE UNIT NUMBER. ALF,ALF *ROTATE UNIT TO RAL,RAL * LOW A-REG. CMA *SET AS COUNTER. LDB M400 *PRE-SET B-REG. BLS *SET B TO UNIT INA,SZA *THIS UNIT? JMP *-2 *NO! TRY NEXT ONE. ADB M400 *YES! COMPLETE THE WORD. OTB2C OTB CMND *OUTPUT THE MT UNIT SELECT CODE. JSB STAT. *GET MT STATUS IN "A" AND M377 *ISOLATE BITS 7-0 . LDB A *SAVE THE STATUS IN "B" . LDA EQT5,I *LOAD THE STATUS WORD FROM EQT. AND M1774 *REMOVE THE OLD STATUS. IOR B *INCLUDE THE NEW STATUS. STA EQT5,I *UPDATE THE STATUS WORD IN EQT . IOSET CCA *SET A= -1 . STA S.DMA *SET THE "DMA" SKIP FLAG. JMP SETIO,I *RETURN: A= -1 , B=STATUS * M1774 OCT 177400 N4 DEC -4 M7 OCT 7 M6 DEC 6 M110 OCT 110 M4200 OCT 4200 M4300 OCT 4300 CONFG NOP * SKP * COMPLETION SECTION. SPC 1 C.24 NOP ENTRY POINT LDB EQT11,I LOAD THE "DMA" CHANNEL NUMBER. RBܤL,CLE,ERB REMOVE THE "EOT" FLAG BIT. CPA B *DMA INTERRUPT? JMP GO *YES! START PROCESSING. LDB EQT1,I LOAD THE DEVICE LIST POINTER SZB,RSS DID A SPURIOUS INTERRUPT OCCUR? JMP SPURI YES! IGNORE THE INTERRUPT. JSB SETIO *SET I/O INSTRUCTIONS FOR MT. ERB *SHIFT LOCAL BIT TO "E". LDB EQT10,I *LOAD THE REWIND/STANDBY FLAG. LDA EQT9,I *LOAD THE CONTINUATION ADDRESS. SSA,RSS *INDIRECT ADDRESS ? JMP *+3 *NO! CONTINUE . LDA A,I *GET THE JMP *-3 * EFFECTIVE ADDRESS . SEZ,CLE IS THE MT UNIT IN "LOCAL"? CPB M500 YES;IS THE INTERRUPT FROM "RWS"? JMP A,I YES, GO CONTINUE PROCESSING. * W.ERR CLA,INA ENTER: A=1.(NOT READY) CLB ENTER: B=0. JMP C.24,I COMPLETION RETURN SPC 2 M500 OCT 500 SPC 2 * SPURI LDB A SAVE THE CHANNEL NUMBER. IOR CLC *CONFIGURE "CLC XX" STA CLC.0 *SET THE INSTRUCTION. CLC.0 CLC 00B CLEAR CONTROL. CLA STA EQT15,I PREVENT TIMEOUT LDB BCD,I *GET THE I/O XMISSION FLAG. ERB *SET THE CONTINUATION/COMPLETION FLG. LDA C.24 *GET THE RETURN ADDRESS. SEZ,INA,RSS *CONTINUATION RETURN ? JMP A,I *YES! JSB CHECK *ANY R/W PARITY ERRORS? JMP ..7.5 *READ PARITY ERROR! * * GO LDB DUMMY *LOAD SPECIAL INTERRUPT FLAG. SZB,RSS *PRIVILEGED INTERRUPT ACTIVE ? JMP TLOG-1 *NO! CONTINUE. JSB FITAB *YES! GET INTERRUPT TABLE ADDRESS. STB CONFG *SAVE TABLE ADDRESS. LDB B,I *LOAD THE TABLE ENTRY. ELB,CLE,ERB *REMOVE BIT 15 . STB CONFG,I *STORE NEW TABLE ENTRY. JMP TLOG-1 *START PROCESSING. * * * BEGIN "LOCAL STORAGE". SPC 1 A EQU 00000B "A" REGISTER ADDRESS DEFINITION. B EQU 00001B "B" REGISTER ADDRESS DEFINITION. BPNTR  TRNEQU SETIO CLC CLC 00B DMA EQU 06B "DMA" CHANNEL NUMBER 1. MBUFC EQU NBUFL PAKUN EQU CHECK STCC STC 00B,C STORE EQU PAKUN UNPAK EQU CHECK DATA EQU 00B DATA CHANNEL NUMBER. CMND EQU DATA+01B COMMAND CHANNEL NUMBER. SKP * SYSTEM BASE PAGE COMMUNICATION AREA: SPC 2 . EQU 1657B EQT1 EQU .+1 EQT4 EQU .+4 EQT5 EQU .+5 EQT6 EQU .+6 EQT7 EQU .+7 EQT8 EQU .+8 EQT9 EQU .+9 EQT10 EQU .+10 EQT11 EQU .+11 .. EQU 1770B EQT12 EQU ..+1 EQT13 EQU ..+2 EQT15 EQU ..+4 SPC 2 BCD EQU EQT12 BCD FLAG WORD, =100000 FOR BCD CHAN EQU 1673B CURRENT "DMA" CHANNEL NUMBER. DUMMY EQU 1737B INTBA EQU 1654B *FWA OF INTERRUPT TABLE SUP SPC 1 SPC 1 HED ********** CONVERSION TABLE *********** * * ASCII => BCD / BCD => ASCII * (HIGH) / (LOW) * TBLAD DEF *+1 * @ A B C D E F G ASC 08,L 11223344556677 * * H I J K L M N O ASC 08,8899!0"=#@$:%>&# * * P Q R S T U V W ASC 08,' (/)SRTSUTVUWVX * * X Y Z [ \ ] ^ ASC 08,WYXZY_=,^(-'?\Z" * * ! " # $ % & ' ASC 08,P-*J_KOL+M/N0O]P * * ( ) * + , - . / ASC 08,\Q ? ASC 08,HHIIM?..>)K[N<:^ HED <*** OUTPUT BUFFERS ***> OBUF1 EQU * OCT 10020,10020 (BCD BLANKS) BSS 65 IFZ OBUF2 EQU * OCT 10020,10020 (BCD BLANKS) BSS 65 XIF PLEN EQU *+1 PROGRAM LENGTH (OCTAL) END T q 25117-80763 A S 0122 RTE HP3480/85 SUBSYSTEM VERIFICATION TEST (V3485)             H0101 jFTN,L,T,B PROGRAM V3485 DIMENSION DATA(10) IDRT=7 WRITE(1,1000) DO 20 IFIL=0,1 WRITE(1,2000) C READ CHANNELS 1 TO 10 IN RANDOM MODE DO 10 I=1,10 10 CALL R3485(IDRT,DATA(I),1,I,21B+IFIL*64) C PRINT THE DATA WRITE(1,6000)(I,DATA(I),I=1,10) WRITE(1,3000) C READ CHANNELS ONE TO FIVE IN SEQUENTIAL MODE CALL R3485(IDRT,DATA(1),5,1,20B+IFIL*64) C READ CHANNELS SIX TO TEN IN SEQUENTIAL MODE CALL R3485(IDRT,DATA(6),5,6,20B+IFIL*64) C PRINT THE DATA WRITE(1,6000)(I,DATA(I),I=1,10) WRITE(1,4000) C READ CHANNEL SEVEN "TEN TIMES" IN DIGITIZE MODE CALL R3485(IDRT,DATA,10,7,22B+IFIL*64) C PRINT THE DATA WRITE(1,6000)(7,DATA(I),I=1,10) IF(IFIL)20,15,20 15 WRITE(1,7000) 20 CONTINUE WRITE(1,5000) 1000 FORMAT(3/,15X,"3485 VERIFICATION TEST",3/) 2000 FORMAT(2/,"RANDOM MODE:") 3000 FORMAT(2/,"SEQUENTIAL BLOCK MODE:") 4000 FORMAT(2/,"DIGITIZE MODE:") 5000 FORMAT("END OF TEST") 6000 FORMAT(5X,"CHANNEL # ",I2," = ",E11.5) 7000 FORMAT(4/,"WITH FILTER ENABLED,") 1 CONTINUE END END$  rx 25154-18008 B S 0100 TASMB TEST TAPE              H0101 +ASMB,R,B,L NAM TASMB ENT TASMB EXT CLRIO,RMPAR,PRTN,EXEC EXT .DIO.,.DTA.,.IAY.,.IIO. ********* THIS LINE SHOULD HAVE BEEN DELETED WITH EDIT ******** * * TASMB TEST TAPE * 25154-18008 * * IB BSS 5 LP DEF L L BSS 35 TASMB JSB CLRIO DEF *+1 JSB RMPAR DEF *+2 IBP DEF IB CLA,INA STA IA CLB JSB .DIO. DEF F0 DEF *+2 JSB .DTA. CLA,INA CLB JSB .DIO. DEF F1 DEF *+2 JSB .DTA. CLA,INA CLB,INB JSB .DIO. OCT 0 DEF *+4 JSB .IAY. DEF IB O5 OCT 5 CLA,INA CLB JSB .DIO. DEF F2 DEF *+2 JSB .DTA. CLA,INA CLB,INB JSB .DIO. OCT 0 DEF *+3 JSB .IIO. DEF IA CLA,INA CLB JSB .DIO. DEF F3 DEF *+2 JSB .DTA. CLA,INA CLB,INB JSB .DIO. DEF F4 DEF D CLA,INA STA Q C LDA Q ADA M1 ADA LP STA S JSB .IIO. DEF S,I LDA Q INA STA Q CMA,INA ADA O43 SSA,RSS JMP C D CLA,INA STA I P LDA IB CLB JSB .DIO. DEF F5 DEF M CLA,INA STA Q N LDA Q ADA M1 ADA LP STA S JSB .IIO. DEF S,I LDA Q INA STA Q CMA,INA ADA O43 SSA,RSS JMP N JSB .DTA. M LDA I INA STA I CMA,INA ADA IA SSA,RSS JMP P JSB PRTN DEF *+2 DEF IB JSB EXEC DEF O6 DEF O6 O6 OCT 6 O43 OCT 43 M1 OCT -1 IA BSS 1 Q BSS 1 S BSS 1 I BSS 1 SUP F0 ASC 11,(/," HP ASSEMBLER",/) F1 ASC 9,(" OUTPUT LUN? _") F2 ASC 12,(" NUMBER OF LINES? _") F3   ASC 14,(" ENTER A DATA STRING: _") F4 ASC 3,(35A2) F5 ASC 4,(X,35A2) END TASMB END$ R  sz 25154-18009 B S 0100 TFTN TEST TAPE              H0101 FTN,B,L PROGRAM TFTN C C TFTN TEST PROGRAM C 25154-18009 C DIMENSION IBUF(5),LINE(35) CALL RMPAR(IBUF) 5 FORMAT(/," HP FORTRAN",/) 10 FORMAT(" OUTPUT LUN? _") 20 FORMAT(" NUMBER OF LINES? _") 30 FORMAT(" ENTER A DATA STRING: _") 40 FORMAT(35A2) 50 FORMAT(X,35A2) IA=1 WRITE(1,5) WRITE(1,10) READ(1,*)IBUF WRITE(1,20) READ(1,*)IA WRITE(1,30) READ(1,40)(LINE(L),L=1,35) DO 100 I=1,IA II=IBUF(1) WRITE(II,50)(LINE(L),L=1,35) 100 CONTINUE CALL PRTN(IBUF) END END$ )N tz 25154-18010 B S 0100 TFTN4 TEST TAPE              H0101 FTN4,B,L PROGRAM TFTN4 C C TFTN4 TEST PROGRAM C 25154-18010 C DIMENSION IBUF(5),LINE(35) CALL RMPAR(IBUF) 5 FORMAT(/," HP FORTRAN 4",/) 10 FORMAT(" OUTPUT LUN? _") 20 FORMAT(" NUMBER OF LINES? _") 30 FORMAT(" ENTER A DATA STRING: _") 40 FORMAT(35A2) 50 FORMAT(X,35A2) IA=1 WRITE(1,5) WRITE(1,10) READ(1,*)IBUF WRITE(1,20) READ(1,*)IA WRITE(1,30) READ(1,40)(LINE(L),L=1,35) DO 100 I=1,IA II=IBUF(1) WRITE(II,50)(LINE(L),L=1,35) 100 CONTINUE CALL PRTN(IBUF) END END$ % u{ 25154-18011 B S 0122 TALGOL TEST TAPE              H0101 =HPAL,B,L,"TALGOL" & & TALGOL TEST TAPE & 25154-18011 & BEGIN INTEGER ARRAY IBUF[1:5]; INTEGER ARRAY LINE[1:35]; INTEGER IA,Z,Y,II; PROCEDURE RMPAR(I);INTEGER I;CODE; PROCEDURE PRTN(J);INTEGER J;CODE; FORMAT F0(/," HP ALGOL",/); FORMAT F1(" OUTPUT LUN? _"); FORMAT F2(" NUMBER OF LINES? _"); FORMAT F3(" ENTER A DATA STRING: _"); FORMAT F4(35A2); FORMAT F5(X,35A2); RMPAR(IBUF[1]); II_IBUF[1]; IA_1; WRITE(1,F0); WRITE(1,F1); READ(1,*,II); WRITE(1,F2); READ(1,*,IA); WRITE(1,F3); READ(1,F4,FOR Z_1 TO 35 DO LINE[Z]); FOR Y_1 STEP 1 UNTIL IA DO WRITE(II,F5,FOR Z_1 TO 35 DO LINE[Z]); IBUF[1]_II; PRTN(IBUF[1]); END$ L v| 25154-18012 B S 0100 RTE-II/BSM TEST TAPE              H0101 oF:SV,1 :SE,1,1G :ST,5,TSTED,AS :ST,5,TSTEDR,AS :ST,5,TSTAS,AS :ST,5,TSTFT,AS :ST,5,TSTFT4,AS :ST,5,TSTAL,AS :ST,5,TASMB,AS :ST,5,TFTN,AS :ST,5,TFTN4,AS :ST,5,TALGOL,AS :ST,5,JOB1,AS :ST,5,JOB2,AS :ST,5,JOB3,AS :ST,5,TJOB1,AS :ST,5,TJOB2,AS :ST,5,TJOB3,AS :ST,5,SHUTDN,AS :TE,* A DIR. LIST SHOULD BE PRODUCED. :DL,,XX :SV,0 :TR :SV,1 :TE,* USE EDIT TO MOD. TASMB. :MS,TASMB,EDIT :TE,* ENTER THE FOLLOWING EDIT COMMANDS: :TE,* /D,6 :TE,* /E :RU,EDIT,1,2,2 :TE,* EDIT EXECUTED! SAVE SOURCE BY :TE,* ENTERING THE FOLLOWING FMGR COMMANDS: :TE,* :LS,NN,XXXX :TE,* :PU,TASMB :TE,* :SA,LS,TASMB :SV,0 :TR :SV,1 :TE,* USE EDITR TO MODIFY TFTN4. :TE,* ENTER THE FOLLOWING EDITR COMMANDS: :TE,* /TFTN4 :TE,* /6 :TE,* /- :TE,* /ERTFTN4 :RU,EDITR :TE,* EDITR EXECUTED! :SV,0 :TR :SV,1 :TE,* PROCESS AND RUN TASMB. :LG,1 :MS,TASMB,ASMB :RU,ASMB,2,,64,99 :RU,LOADR,99 :RU,TASMB,1P :OF,TASMB,8 :TE,* ASSEMBLER EXECUTED! :SV,0 :TR :SV,1 :TE,* PROCESS AND RUN TFTN. :LG,1 :MS,TFTN,FTN :RU,FTN,2,,64,99 :RU,LOADR,99 :RU,TFTN,1G :OF,TFTN,8 :TE,* FORTRAN EXECUTED! :SV,0 :TR :SV,1 :TE,* PROCESS AND RUN TFTN4. :LG,1 :MS,TFTN4,FTN4 :RU,FTN4,2,,64,99 :RU,LOADR,99 :RU,TFTN4,1P :OF,TFTN4,8 :TE,* FORTRAN IV EXECUTED! :SV,0 :TR :SV,1 :TE,* PROCESS AND RUN TALGOL. :LG,1 :MS,TALGOL,ALGOL :RU,ALGOL,2,,64,99 :RU,LOADR,99 :RU,TALGOL,1P :OF,TALGOL,8 :TE,* ALGOL EXECUTED! :SV,0 :TR ASMB,R,B,L NAM TASMB ENT TASMB EXT CLRIO,RMPAR,PRTN,EXEC EXT .DIO.,.DTA.,.IAY.,.IIO. ********* THIS LINE SHOULD HAVE BEEN DELETED WITH EDIT ******** * * TASMB TEST TAPE * 25154-18008 * * IB BSS 5 LP DEF L L BSS 35 TASMB JSB CLRIO DEF *+1 JSB RMPAR DEF *+2 IBP DEF IB CLA,INA STA IA CLB JSB .DIO. DEF F0 DEF *+2 JSB .DTA. CLA,INA CLB JSB .DIO. DEF F1 DEF *+2 JSB .DTA. CLA,INA CLB,INB JSB .DIO. OCT 0 DEF *+4 JSB .IAY. DEF IB O5 OCT 5 CLA,INA CLB JSB .DIO. DEF F2 DEF *+2 JSB .DTA. CLA,INA CLB,INB JSB .DIO. OCT 0 DEF *+3 JSB .IIO. DEF IA CLA,INA CLB JSB .DIO. DEF F3 DEF *+2 JSB .DTA. CLA,INA CLB,INB JSB .DIO. DEF F4 DEF D CLA,INA STA Q C LDA Q ADA M1 ADA LP STA S JSB .IIO. DEF S,I LDA Q INA STA Q CMA,INA ADA O43 SSA,RSS JMP C D CLA,INA STA I P LDA IB CLB JSB .DIO. DEF F5 DEF M CLA,INA STA Q N LDA Q ADA M1 ADA LP STA S JSB .IIO. DEF S,I LDA Q INA STA Q CMA,INA ADA O43 SSA,RSS JMP N JSB .DTA. M LDA I INA STA I CMA,INA ADA IA SSA,RSS JMP P JSB PRTN DEF *+2 DEF IB JSB EXEC DEF O6 DEF O6 O6 OCT 6 O43 OCT 43 M1 OCT -1 IA BSS 1 Q BSS 1 S BSS 1 I BSS 1 SUP F0 ASC 11,(/," HP ASSEMBLER",/) F1 ASC 9,(" OUTPUT LUN? _") F2 ASC 12,(" NUMBER OF LINES? _") F3 ASC 14,(" ENTER A DATA STRING: _") F4 ASC 3,(35A2) F5 ASC 4,(X,35A2) END TASMB END$ FTN,B,L PROGRAM TFTN C C TFTN TESC!T PROGRAM C 25154-18009 C DIMENSION IBUF(5),LINE(35) CALL RMPAR(IBUF) 5 FORMAT(/," HP FORTRAN",/) 10 FORMAT(" OUTPUT LUN? _") 20 FORMAT(" NUMBER OF LINES? _") 30 FORMAT(" ENTER A DATA STRING: _") 40 FORMAT(35A2) 50 FORMAT(X,35A2) IA=1 WRITE(1,5) WRITE(1,10) READ(1,*)IBUF WRITE(1,20) READ(1,*)IA WRITE(1,30) READ(1,40)(LINE(L),L=1,35) DO 100 I=1,IA II=IBUF(1) WRITE(II,50)(LINE(L),L=1,35) 100 CONTINUE CALL PRTN(IBUF) END END$ FTN4,B,L PROGRAM TFTN4 C C TFTN4 TEST PROGRAM C 25154-18010 CCCCCCCCC THIS LINE SHOULD BE DELETED BY EDITR CCCCCCCCCC C DIMENSION IBUF(5),LINE(35) CALL RMPAR(IBUF) 5 FORMAT(/," HP FORTRAN 4",/) 10 FORMAT(" OUTPUT LUN? _") 20 FORMAT(" NUMBER OF LINES? _") 30 FORMAT(" ENTER A DATA STRING: _") 40 FORMAT(35A2) 50 FORMAT(X,35A2) IA=1 WRITE(1,5) WRITE(1,10) READ(1,*)IBUF WRITE(1,20) READ(1,*)IA WRITE(1,30) READ(1,40)(LINE(L),L=1,35) DO 100 I=1,IA II=IBUF(1) WRITE(II,50)(LINE(L),L=1,35) 100 CONTINUE CALL PRTN(IBUF) END END$ HPAL,B,L,"TALGOL" & & TALGOL TEST TAPE & 25154-18011 & BEGIN INTEGER ARRAY IBUF[1:5]; INTEGER ARRAY LINE[1:35]; INTEGER IA,Z,Y,II; PROCEDURE RMPAR(I);INTEGER I;CODE; PROCEDURE PRTN(J);INTEGER J;CODE; FORMAT F0(/," HP ALGOL",/); FORMAT F1(" OUTPUT LUN? _"); FORMAT F2(" NUMBER OF LINES? _"); FORMAT F3(" ENTER A DATA STRING: _"); FORMAT F4(35A2); FORMAT F5(X,35A2); RMPAR(IBUF[1]); II_IBUF[1]; IA_1; WRITE(1,F0); WRITE(1,F1); READ(1,*,II); WRITE(1,F2); READ(1,*,IA); WRITE(1,F3); READ(1,F4,FOR Z_1 TO 35 DO LINE[Z]); FOR Y_1 STEP 1 UNTIL IA DO WRITE(II,F5,FOR Z_1 TO 35 DO LINE[Z]); IBUF[1]_II; PRTN(IBUF[1]); END$ :JO,JOB1 :SV,1 :LG,1 :MS,TJOB1,FTN4 :RU,FTN4,2,64,64,99 :RU,LOADR,99,64 :RU,TJOB1 :OF,TJOB1 :SV,0 :EO :JO,JOB2 :SV,1 :LG,1 :MS,TJOB2,FTN4 :RU,FTN4,2,64,64,99 :RU,LOADR,99,64 :RU,TJOB2 :OF,TJOB2 :SV,0 :EO :JO,JOB3 :SV,1 :LG,1 :MS,TJOB3,FTN4 :RU,FTN4,2,64,64,99 :RU,LOADR,99,64 :RU,TJOB3 :OF,TJOB3 :SV,0 :EO FTN4,B,L PROGRAM TJOB1 DIMENSION IT(5) CALL EXEC(11,IT,IY) WRITE(6,10) 10 FORMAT(X,"THIS IS JOB 1.",/,X,"THE TIME IS:") WRITE(6,20)IY,IT(5),IT(4),IT(3),IT(2),IT(1) 20 FORMAT(6(5X,I4)) END END$ FTN4,B,L PROGRAM TJOB2 DIMENSION IT(5) CALL EXEC(11,IT,IY) WRITE(6,10) 10 FORMAT(X,"THIS IS JOB 2.",/,X,"THE TIME IS:") WRITE(6,20)IY,IT(5),IT(4),IT(3),IT(2),IT(1) 20 FORMAT(6(5X,I4)) END END$ FTN4,B,L PROGRAM TJOB3 DIMENSION IT(5) CALL EXEC(11,IT,IY) WRITE(6,10) 10 FORMAT(X,"THIS IS JOB 3.",/,X,"THE TIME IS:") WRITE(6,20)IY,IT(5),IT(4),IT(3),IT(2),IT(1) 20 FORMAT(6(5X,I4)) END END$ :SV,1 :LG,0 :LS,0 :PU,JOB1 :PU,JOB2 :PU,JOB3 :PU,TJOB1 :PU,TJOB2 :PU,TJOB3 :PU,TALGOL :PU,TFTN4 :PU,TFTN :PU,TASMB :PU,TSTAL :PU,TSTFT4 :PU,TSTFT :PU,TSTAS :PU,TSTEDR :PU,TSTED :PU,SETUP :PU,SHUTDN :PK :SV,0 :EX :XE,JOB1 :XE,JOB2 :XE,JOB3 B w 25154-80027 A S 0106 RDTS MASTER TO SLAVE TEST TAPE             H0101 2* ************************************************************ * * * REMOTE DATA TRANSMISSION SYSTEM * * MASTER TO SLAVE TEST DATA TAPE * * * * SOURCE: HP 25154-80027 * * LISTING: HP 25154-80027-1 * * PROCESS DOCUMENT: HP 91780-90003 * * * ************************************************************ * * * THIS ASCII TEST TAPE WAS READ BY THE MASTER * * PHOTOREADER(STATION BEING TESTED)AND IS LISTED * * ON THE SLAVE SYSTEM CONTROL DEVICE(STATION DOING * * THE TESTING). IT DEMONSTRATES SUCCESSFUL * * TRANSMISSION OF INFORMATION BY THE MASTER STATION * * TO THE SLAVE STATION. * * * ************************************************************ * #E  x~ 25154-80028 A S 0106 RDTS SLAVE TO MASTER TEST TAPE             H0101 ,!* * ************************************************************ * * * * * REMOTE DATA TRANSMISSION SYSTEM * * SLAVE TO MASTER TEST DATA TAPE * * * * * * SOURCE: HP 25154-80028 * * LISTING: HP 25154-80028-1 * * PROCESS DOCUMENT: HP 91780-90003 * * * * * ************************************************************ * * * * * THIS ASCII TEST TAPE IS BEING READ BY THE SLAVE * * PHOTOREADER(STATION DOING THE TESTING)AND IS * * LISTED ON THE MASTER LIST DEVICE(STATION BEING * * TESTED). * * * * * * * * * * * * * * * * * * * * * * SOMEWHERE BEFORE NOW THE OPERATOR SHOULD HAVE * * GOTTEN THE ATTENTION OF THE MASTER STATION(HIT * * ANY KEY ON THE SYSTEM CONTROL DEVICE)AND ENTERED * * THE FOLLOWING COMMAND: | * * * * * * *ON,#INRP * * * * * * AFTER A NOTICEABLE DELAY, THIS WILL INTERRUPT THE * * OUTPUT TO THE MASTER LIST DEVICE AND RETURN CONTROL * * TO THE MASTER SYSTEM CONTROL DEVICE WHERE A # PROMPT * * CHARACTER WILL APPEAR FOR THE OPERATOR. HE SHOULD * * THEN ENTER THE FOLLOWING COMMANDS(THE SYSTEM PROMPT * * IS SHOWN): * * * * ##C,,,1 * * #CTRL-D * * * * * * THE FIRST COMMAND WILL CHANGE THE LIST DEVICE * * TO THE SYSTEM CONTROL DEVICE(TTY/CRT). THE * * CTRL-D(OBTAINED BY PUSHING THE CTRL AND D KEYS * * TOGETHER)SIGNIFIES AN END-OF-FILE FOR THE TTY/CRT * * AND CAUSES COMPUTER PROCESSING TO RESUME. THE * * REST OF THE SLAVE'S PAPER TAPE WILL BE LISTED ON * * ON THE MASTER'S SYSTEM CONTROL DEVICE. * * * * * * * * * * THIS LISTING DEMONSTRATES THAT THE MASTER SYSTEM * * IS RECEIVING ASCII DATA FROM THE SLAVE. IF DATA * * CAN BE TRANSMITTED BETWEEN THE TWO SYSTEMS THEN * * WE CAN ASSUME THE MASTER'S REMOTE DATA TRANSMISSION * * SYSTEM WAS PUT TOGETHER CORRECTLY. IN ADDITION, * * BY USING #INRP TO CHANGE LIST DEVICES, WE HAVE * * DEMONSTRATED THAT THE RDTS INTERRUPT ROUTINE WAS * * INCORPORATED CORRECTLY WITHIN THE RTE/RTE-C SYSTEM. * * * * * * * * IF BOTH MASTER-TO-SLAVE AND SLAVE-TO-MASTER * * LISTINGS ARE CORRECT, THEN THIS CONCLUDES * * VERIFICATION OF THE RDTS GENERATION. * * * * * ************************************************************ * * #D ! y 28051-80001 B S 0122 K21-5321B DIGITAL CLOCK CLK 21             H0101 NB PGAMK à àHSUNŠSDSGNDϠVYPPҠPAN àHŠHPDGA̠KSUBSYSM.HŠUPMNԠNSSS àƠAK-53BDGA̠K566-600ɯϠADAND àNAŠAB. à àHŠPGAMUSSBSDVҠD.3ANDAS"GK""SAD". à à A̠SAD(00AND(SS(5B Š(00 AD(0 A̠SAD(3Bì A̠SAD(0000 Ԡ0 à àPNԠPAAMҠNMAN à 0(0 PAUS (SS(5030 0Š(03 (0 PAUS à 30Ơ(SS(0600 à àMŠƠDAYS à 0AD(NDAYNHUҬNMNNSìMS (NDAY-9990 0(NDAY-365 Š(0 GϠϠ50 5Š(0NDAYNHUҬNMNNSìMS Ơ(SS(3050 Š(0 50PAUS GϠϠ30 à àPUSŠANNUPԠS à 60Š(05 AD(0 Ơ(-3B66 6Ơ(-B656 65Š(09 GϠϠ50 6MUɽ0 Š(ԬMU Ơ(-3B090 0A̠GK(Sԩ Ơ(Sԩ090 0Š(06 90Ơ(SS(3050 à àMAԠSN à 00MAԠ("HPDGA̠KSUBSYSMVAN" "KɯϠSԠD?" 0MA("ϠDSPAYNSUNSSԠS.5PSSUN" 0MAԠ(K 03MAԠ("ϠADMŠƠDAY:"6"SԠSH00""ϠS PUSŠAN:""SԠSH0"5"PUSŠAND- -""Sà0"0"00MSà"".Sà""0M 3Sà5"0"0MSà""MSà6""MSà3 ""DSABŠ"" 5DSABŠNUPԬADDA̠0ϠHŠABVŠD.""ҠAMP 6HŠDŠҠAMSàPUSŠANUPUԠS3.""ϠBYPASS NMANPNUԬSԠSH50." 03  MAԠ(ج3"DAYS"ɲ"HUS"ɲ"MNS"ɲ"SS" 3"MS" 05MAԠ("NҠNUPԠDŠ_" 06MAԠ("NUPԠSԠAD-NϠAGUND" 0MAԠ("MŠҠ-SԠK" 0MAԠ("NϠPNԠMMAND" 09MAԠ("GA̠DŠ-NUPԠAŠϠAS" 0MA("SԠSHGSҠPNPSSUN" à ND ND$ Z  z 28063-80001 B S 0122 28063A MULTIPROGRAMMER SS FUNCT TEST (BASE PRGM)             H0101 O 5MP063-000VB 0M33ݬZ۱0ݬ۱ݬA۴ ƠZ3ݽHN000 3ƠZ3ݽHN500 ƠZ3ݽ3HN000 5ƠZ3ݽHN500 6ƠZ3ݽ5HN3000 ƠZ3ݽ6HN3500 9ƠZ۱ݽHN500 0ƠZ۱ݽ3HN5000 ƠZ۱ݽHN5500 ƠZ۱ݽ5HN6000 3ƠZ۱ݽ6HN6500 ƠZ۱ݽHN000 5ƠZ۱ݽHN500 6ƠZ۱ݽ9HN000 35PNԠAB("63AUNԠS" 0GSUB9500 5GSUB65 6ƠZ۱ݽGSUB30 9ƠZ۱ݽGSUB500 50GSUB5 0Ԡ۲ݽ35 5Ԡ۲ݽ5 0Ԡ۲3ݽ55 Ơ۲ݾ0GϠ95 ҠɽϠ6 3Ԡݽ۲3 NԠ 5Ԡ۲ݽ063. 95GSUB900 00GϠ535 5MPG(0A:GϠ9950 5MPGS(0 30ƠZ۱ݣUN 35DP(000 0UN 65DSPAY"NҠS" 0DSPAY"PU̠GN" DSPAY"PҠSUP" DSPAY"3SBD" 3DSPAY"YBD" 5DSPAY"5̠BD" DSPAY"6DGNPԠBD" 90DSPAY"D-ABD" 9DSPAY"VNԠBD" 9DSPAY"9690S" 99DSPAY"99MNAŠ" 300NPUԠZ۱ 30ƠZ۱ݽ99GϠ9950 305UN 30GSUB900 35DSPAY"SԠ" 30DSPAY"A" 35DSPAY"DH" 330DSPAY"3DY" 335DSPAY"Š" 30DSPAY"5AMP" 35DSPAY"6S" 355NPUԠZ3 360GSUB900 365DSPAY"9A" 30DSPAY"95A" 35NPUԠ33 30UN 00DSPAY"69Ϡ" 05NPUԠU 0GSUB900 0UN 500DSPAY"SYPUԠ" 505NPUԠ 50Ơؽ0UN 50SYPU(905 5SYPU(90 55Ơ33ݽHN5 5SYPU(9 50GϠ55 5SYPU(95 55UN 535M 536DSPAY"ADP-0"AB( 53ƠZ3ݽDSPAY"00" 50ƠZ3ݽDSPAY"003" 55ƠZ3ݽ3DSPAY"00" 550ƠZ3ݽDSPAY"005" 555ƠZ3ݽ5DSPAY"006" 560ƠZ3ݽ6DSPAY"00" 565ƠZ۱ݽDSPAY"00" 50ƠZ۱ݽ3DSPAY"009" [55ƠZ۱ݽDSPAY"0" 50ƠZ۱ݽ5DSPAY"00" 55ƠZ۱ݽ6DSPAY"0" 590ƠZ۱ݽDSPAY"03" 595ƠZ۱ݽDSPAY"0" 600ƠZ۱ݽ9DSPAY"05" 605ND 500M 50DSPAY 50DSPAY"DADPYҠSGNAUŠ" 506NPUԠ۲9 50Ơ۲9MPNԬɠYS.UN DBBADDɠHBUҠNGH SZBNGHSNN-Z SSBANDPSV? MPʱN.GA̠US MBNBMPMNԠҠUNS MPNԬɠUN ANP B00Ԡ00 DBSYNP DԠDBMDŠHHҠDV'SMD SZANMDŠSPNPDMA AҬSAAҠDDҠNԠ? MPD5YS. SASSSPA̠PNPDMAMD? MPDԷYS A SSASSSDPNҠMD? MPʱN.GA̠US PBB5HҠMDŠSSDPN? MPDԸYS. MPMPN.NMPABŠMDS D5SZBHҠMDŠSPNPDMA PBBҠDD? MPDԸYS. MPMPN.NMPABŠMDS DԷPBBHҠMDŠSSPA̠PNN? SSYS. MPMPN.NMPABŠMDS DԸDA.00SԠŠDAANY SAAGPANAG D9DAAHKHAA SBUPAANDUPU DԱ0DASñ SAMD A SBMUԠSԠANSMSSNMD MPD.65ɠUNϠ. .00Ԡ0000 USԠANDDAAANSMSSNMD .DԠPBB5ԠBUҠNGH? SSYS. MPʱN.GA̠US SBDƠSԠUSԠANDDAAAG DBSUBHANSMSSNMD DAGHADŠAG SZAAD? MPD0N. PBB5SDPN? DBB0YS.SԠPANB SBDMADDSPA̠NԠPNP? MPʱN.GA̠US SZBSSDMAPNP? NBYS.SԠPANB SBAGԠSAVŠPANB MPDԱ D0{PBBSPA̠NԠPNP? MPʱYS.GA̠US DԱB SBNԠHDAABUҠADDSS SADPBUƠANDNGH. SAPBU SBDN SBN SZBADD DԲB SBNԠHUSԠBUҠADDSS SAPBUƠSAV DBBADDɠHUSԠBUҠNGH SSBUSԠBUҠNGHPSV MPʱN. MBMAKŠNGAVŠUN SBNҠANDSAV DADHUSԠMNGHAA SBUPAUPUԠHAA ANASԠUPUԠUS SAAGPANAG MPDԱ0 DԠ00 DSUBNP GNP ANP GNP SPANSMSSNMD SPANASAUSϠUSԠMPD MPMP .00Ԡ000 SɠA SASƠSԠSNAG BNBSԠSAUSBS SBSASUSԠMPD MPSA NDBBNHUSԠBUҠNGH PBB3ԠBUҠNGH? SSYS. MPʱN.GA̠US SBNԠHUSԠBUҠADDSS SAPBUƠANDNGH. SBNҠSAV. DAS SZASSSNҠPNGNABD? DAB5N.DAUԠϠPNG SASSAGSNMD? MPN SANƠSԠNPUԠP̠AG SSSS0HAAҠVD? MPNN. SBPYàHAA? MPNN. MPNN. MPNN. SSYS. MPNN. DABSԠPANAG SAAGϠNPUԠUS MPD9 NDA3SԠUP SAMDŠSԠVŠAGMD DBB00SԠSAUSϠNϠUS MPS+3#VD. NDABSԠPANAG SAAGϠVNGUS N3DAAHNנHAA MP0 ҠNP SAASAVŠA BNBSԠSNDMŠAG DAұHSԯSND SAұԠAGANDSAV SASSSԠM? MPҲYS. AҬSASNDM SZҠN.UNP+3 ADBBYS.SԠHD SZҠMŠAG. ҲSBұSAVŠAG DAASŠA MPҬɠUN MDŠNP SUBNP GNP B3Ԡ3 SƠNP GNP MUԠNP MDŠNPSԠANSMSSNMD MPMUԬɠUN DMANP DADPBUƠHDAABUҠADDSS AAҠADDNPUԯUPUԠBԬ SAנANDSAV Ơ0DSABŠNUPԠSYSM DMAADADMAñHDMAHANN̠AGD ŬSZASSHANN̠AVAAB? MPNDMAN. SSAHANN̠BUSY? MPBUSYYS. SADMAƠSAVŠHANN̠SԠD AAҠADDBUSYB SADMAñANDS MPNK BUSYDADMAòHDMAHANN̠AGD SZASSHANN̠AVAAB? MPDMAAN. SSAHANN̠BUSY? MPDMAAYS. SADMAƠSAVŠHANN̠SԠD AAҠADDBUSYB SADMAòANDS NKSƠ0NABŠNUPԠSYSM DAױɠHNUPԠNKAND SADMAƬɠSŠNDMANUPԠ DAàNGUŠDMAɯϠNSUNS ҠDMA Ҡ.00 SASD Ҡ.050 SAD SAD3 SAD ADAMN SAD Ҡ.00 SASD ҠB00 SAAD SAAD3 -ADAB SAAD DAױHADSԠD DBנUPU SSBSSUS? Ҡ.00YS.ADDàNABŠB ADA0UPUԠN̠D Dà0 DAנUPU ADA0N SDSà0D DADNҠHBUҠNGH AD3A0UPU MANASAVŠUNԠ SAUNԠANSMSSNG SDSà0AVAŠDMA DABHנҠPA MPDMAɠUN NDMASƠ0NABŠNUPԠSYSM BSԠBϠA ADBAƠUSҠA DAB3SԠAϠSAYNϠDMAAVAAB MP B0Ԡ0 B5Ԡ5 DMAƠNP SñNP SñNP BԠ .00Ԡ0000 .3Ԡ300 SAԠDAUNԠHƠDSANSMD DBGAҠA̠AS SZBSSSԠNY? MPSAԱYS DBGɠUPDAŠANSMSSNG ҠBAND SAGɠS B ADBG DABɠUPDAŠSAUS AND.3AND ҠSAS SABɠS DBDMAƠHDMAAVADAG SZBSSDMAANSҠSAD? MPSAԱN. SBSSHANN̠6USD? SBDMAñYS.AҠBUSYB SBN. SBDMAòAҠH.BUSYB SAԱDA3 DBSƠHSNAG SZBNABD? SBYS.AGMD? SASñYS.SԠVŠAGMD AAҠAGS SADBSY SAD3 SAUNԠAҠAGS SADMA SAұ SAAG SAұ SAPN SAN SA SA SAPY SAMP3 MPԱ ND̈́SBGSԠANSMԠAGMD DBBS SBAGNDNGAG DAADAYMUSԠBŠUS SBUPAUPUԠD MPԲ DƠNP AGԠNP NҠNP PBUƠNP BԠ BԠ ҠBNBSԠSAUSBS SBSASUSԠMPD SASƠAҠSNNABDAG SAGAҠANGAG SAGAҠVDUSԠAG SBGSԠVŠAGMD SBDD.SAҠVҠANDSAUSDS D3NPàDMAƠDMAANSҠSAD MPSA .65NP 3à0 SAASAVŠA SBBSAVŠB AAS S NA SAASAVŠŬ DAAGHPANAG SAAҠUPUNGUS? MPUԠYS. SAAҠNPUNGUS? MPNYS. SAAҠNDNGANSMSSN? MPNDYS. SAAҠPNPDMAADUS? MPDAҠYS. SAAҠPNPDDADUS? MPDҠYS. SAAҠSPA̠PNPNҠAD? MPSNҠYS. SAAҠSDPNҠADUS? MPNҠYS. SAAҠPNPDMAŠUS? MPDAנYS. SAAҠSPA̠PNPDMA? MPDAנYS. SAAҠPNPDDŠUS? MPDנYS. SAAҠPNPNҠŠUS? MPNנYS. SAAҠSDPNҠŠUS? MPNנYS. SANAŠDAANYUS? MPŠYS. SBPYADHAA MPԱNԠ.GN MPԱNԠ. MPԱNԠ. DA.65SAVŠUN SAG<:6SԠVDUSԠAG SAS.65ADDSS *<SAS.65ADDSS DAASAV SAA3A DABGSS SAB DAA SAA DBDԠSŠUNADDSSNN65 SBN65NYPN DAD65HADDSSƠN65 SSASSND? MP+N. AŬAYS.MVŠNDԠB DAAɠHVŠADDSS MP-YAGAN ADAB3ADD3 MPAɠMPϠN65+3 ԠDƠ+ANMPABY Ơ0DSABŠNUPԠSYSM DAAS SAAA SƠ DAA3 DBB SƠ0NABŠNUPԠSYSM MPS.65ɠUN DԠDƠ D65DƠN65 A3NP ANP BNP ANP S.65NP DNҠNP DPBUƠNP BNP SҠNP NҠNP PBUƠNP SASNP AԠ0360 àԠ0060 NSBPAҠPAY? MPԱYS. SBҠSԠҠSNDD? MPNS. MPNSND. SAPBUƬɠSŠVDD SZUNԠNMNԠANSMSSNUN SZPBUƠNMNԠUSԠBUƠADDSS N0SZSҠASԠD? MPN3N. DBGHANGAG SZBS? N5ASSYS. DAAHNנHAA N6BNBSԠSAUSBSϠK NSBSAS MPNDK NDBNҠNUMBҠƠUS MBNBPAAMS ADBAϠAG SSASSPNN? MPPNYS. NB SSBҠBU? MPN3YS. SASҠMUSԠUN MPN3 N3DAàHSPHAA DBBSԠSAUSBSϠNA 4MPN NŬSSASSSHҠDVҠANG? BN. AAҠMVŠANGB SBGSԠANGAG SAMDŠSŠVDANSMSSNMD MPN0 ԲDASñ SS ԱDASñ SAMD DAASŠGSS SAA SƠ DAA DBB SBMUԠSԠANSMSSNMD MP.65ɠUN UPANP SADSAVŠDASASԠANSMD AA0UPUԠA MPUPAɠUN AGNP GNP òà0àSԠVŠAGMD MPGɠUN UԠSBҠSԠҠSNDPY? MP9S. MP5SND. SZNҠASԠPY? MPԷN. SBPYYS.ADPY MP3K. MPԲ. MPԱS. MPԱGN ԱDAB0SԠSAUSBSϠDAA MPԱANSMSSNNԠNAD ԲDANҠHBUҠNGHUN MANAS MAAS SANҠUN DADANSMԠAS MP0D 3DAD SZASSUPUԠUSԠNY? MPN6YS. AAҠANSMSSN SAUNԠUN DAGHADAG SZAADUS? MP5N. DAAGԠHMPPANBS MPD0 5DASUBHANSMSSNMD DB.00SԠPANB PAB5SDPN? MP6YS. BҠSԠPANB PAB3PNPN? MP6YS. BҠSԠPANB PABPNPDD? MP6YS. NBҠSԠPANB PABSPA̠PNPDMA? MP6YS. BҠSԠPANҠPNPDMA 6SBAGSԠPANAG BƬB SSBPNPDMA? MPDMAנYS. SBSPA̠PNPDMA? MPDMAנYS. BҬSBPNPDD? MPDDנYS. BҬSBPNPN? MPNנYS. MPNנSDPN NƠNP MP3NP ұNP ұԠNP UNԠNP DMAנ SBDMAAVAŠDMA DBAGHPANAG BƬB SBSSSPA̠PNPDMA? MPԲN. Ơ0DSABŠNUPԠSYSM SBGSԠAGϠSAԠANSMSSN DAADAY DAAMNMUM DAA DAAU-S DAA S3Sà0àSԠVŠMD SƠ0NABŠNUPԠSYSM MPԱ GNP ñà0SԠANSMԠAGMD MPGɠUN נNP MNԠ B0Ԡ0 ԷA SBPYADPY MPԸN. MPԲ ԸDAPBUƬɠHNԠUSԠD SZPBUƠNMNԠUSԠBUƠADDSS SZUNԠNMNԠANSMSSNUN 0SBUPAUPUԠD MPԱ 9SBPYADPY MP3N. MPԴ. MPԲS. DAB0.SԠSAUSBS ԱSASASϠSMUANUSUSS. A MPNDK ԲDABSԠSAUSBS MPԱUSԠNԠAPD. 3DANҠHUSԠNGH MP0ANDUPU ԴAAҠS SAұDAG SAԠAҠנUN MPԲ+ 5SBPYADPY MPԷN MP6 MPԲS ANA?.AҠSND SAұDAG. MPԱ 6ANAAҠSND SAұDAG MP3 ԷDBDƠHUSԠNYAG DASUBHANSMSSNMD ŬSZBUSԠNY? AAҠN.ADDANGB MP0UPUԠANSMSSNMD NDKSZAV?A0 MPNDN.ANSM DAMP5HVҠSAUS AҬSAAҠMSSDD? SSYS. MPSAԠN. SASSPNNPSS MPNDN. SAPGSԠPAA̠PNAG DABSԠPAN SAAGAGϠNDNG MPԱ NDDABHנHAA MPND PYNP PNԠNP ԠNP PGNP DNP BԠ00 NDDAPG SZAPAA̠PNAGS? MPNDYS. Ơ0DSABŠNUPԠSYSM AòA0àADSAUS AҬAҠPNN SAA̠PSS? MPND6YS. SSANנDNV? MPND3YS. B ND6SBMPSԠPNNPSSAG AA0AҠV BòB0àADSAUS SƠ0NABŠNUPԠSYSM BҬBҠPNN SBSSPSS? MPNDN. SBPGSԠPAA MPԱPNAG NDSBDD.SADPAA̠D AAҠPAA SAPGPNAG MPND5 ND3SƠ0NABŠNUPԠSYSM SBPYADD MPSAԠNԠ.&iGN MPSAԠNԠ MPSAԠNԠ ND5DAB. SBUPAUPUԠ MPSA NDDBMPPNN SZBPSSAGS? MPND5YS. SBADSADSAUS SASSVҠDSABD? MPSAԠN. BYS.A MPND6VҠAGAN ŠA SBPYADPY MP5SND. MPԱ? DAҠSBPAҠPAY? MPDAұ Dà0AҠDMAHANN MPN5+ DAұ SBDMASԠDMA DABUPU MP0נHAA DҠƠ0DSABŠNUPԠSYSM DAAHSNDHAA SBUPAANDUPU SSSS0DAADVD? MP-N. A3A0YS.ADD SADPBUƬɠSŠDAADNBU SZDPBUƠNMNԠDAABUƠADDSS SZUNԠNMNԠUN SZDNҠASԠD? MPSSN. SBPAҠPAY? MPDҲYS. SƠ0N.NABŠNUPԠSYSM MPN5+ DҲSBDԠSԠҠANSMSSN MPSS MPNP ADSNP AñA0àADSAUSD MPADSɠUN DD.SNP AA0ADDAAD BñB0àADSAUSD SADSUBSAVŠDAA SBSSVҠDSABD? MPDD.SɠN.UN BҬBҠPNN SBPSS? MPDDYS. B̬B̠SŠSAUS BSMVŠV BSDSABDB AA0AҠV DADSUBSŠDAA MPDD.SɠUN DDB̬B̠SŠDAA MPDD.SɠŖUN SNҠA0ADDAAD SBSDAASŠDAAD MPSҲASNԠASԠD SBPAҠPAY? MPSұYS. MPN5+N. SұSBDԠSԠҠANSMSSN MPԱ SҲDAAHNנHAA MP0ANDUPU SDAANP BSԠSŠAG SADPBUƬɠSŠDAADNBU SDAԱSZDPBUƠNMNԠDAABUƠADDSS SZUNԠNMNԠUN SZBSSSŠҠH? MPDAAɠH.UN SZDNҠASԠD? MPSDAAɠN.UNP+ SZSDAAYS.NMNԠUNADDSS MPSDAAɠUNP+ NҠSBPAҠPAY? MPԱYS. SBSDAAN.SŠDAAD MPSҲASNԠASԠD MPN5+ DAנSBADSADSAUS Dà0AҠDMAHANN SAMPANDSAV SASSVҠDSABD? MPԱN. AҬAҠPNN SASSPSS? MPDAױN. A̬SAMSSDPN? SAMP3SԠMSSDDAG MPԱ DAױDAMP3MSSDD SZASSAGS? MP+N. DAMPYS.ADDMSSD ҠBPN SAMPBԠϠSDSAUS A SBPYADPY MPSòK. MPDMAנ. SòSà0àSԠVŠMD A DBMPHVҠSAUS BҬSBMSSDD? SSYS. MPN6N. DAMP5HASԠVҠSAUS ҠBADDMSSDDB BNBSԠSAUSBS SBSASϠUSԠMPD MPNDK+3 MP5NP DԠNP ,A SAUNԠAҠUN SAנAҠPYAG DAPBUƠSԠDAA SADPBUƠBUҠADDSS DANҠAND SADNҠNGH. MPDԬɠUN DDנƠ0DSABŠNUPԠSYSM SBGSԠANSMԠAGMD DױDADPBUƬɠHDAADMBU SS3SS0ASԠDNASMD? MP-N. AA0UPUԠDAAD SZDPBUƠNMNԠDAABUҠADDSS SZUNԠNMNԠUN SZDNҠASԠD? MPDױN. SBGYS.SԠVŠAGMD SƠ0NABŠNUPԠSYSM MPԱ DנA SBPYADPY MPN6K. SBDԠ.SԠҠANSMSSN MPDD NנSBDAAHDAAD MP0ANDUPU NנA SBPYADPY MPױK. DAD.HASԠDAAD MP0ANDUPU ױSZDNҠPYϠASԠD? MPNנN. MPN5YS. DAANP BSԠHAG DADPBUƬɠHDAAD MPSDAԱ NנDAנPYAGS? SZA MPױYS. SBGN.SԠANSMԠAGMD SBDAAHDAAD SZDNҠASԠD? MPND+N. BYS. SBנSԠPYAG SBGSԠVŠAGMD SADPBUƠSAVŠDAAD SBDD.SAҠVҠAG DADPBUƠSŠDAAD MP0ANDUPU ױA SBPYADPY MPN6K. SBDԠ.SԠҠANSMSSN MPN NUMBNP B00Ԡ00 PYNP SANUMBA0HNPSSBŠPS SBDD.SADPYANDSAUS SBMP5SAVŠVҠSAUS SAPYSAVŠPY ҠAHKHHAAҠA SBBNҠUNԠBS DANUMB SZASSҠPSSBŠPS? MPPY6. SBHAҴHAAҠABҠNH? MPPY3A. MPPYB. DAPY?.HPYAGAN ҠàHKHHAAҠ SBBNҠUNԠBS SBHAҴHAAҠìDҠNN? MPPY. MPPYD. PY0DAұԠ?.SŠSԠ SAұSNDAG. DAPYHPYAGAN SZABKNN? MP+N. PNDBB00YS.SԠSAUS SBSASBSϠBKNN MP+ DANƠHNPUԠP̠AG SZASSS? MPԱN.GNŠHAA SZPYYS.SԠUNҠP+5 PYSZPY PYSZPY SZPY PY3AAҠנUN SA MPPYɠUN PYSZԠNMNԠנUN DA ADAMN0ADD- SZPYNMNԠUNADDSS SSAGHԠNSUVŠ? MPPYɠN.UNϠP+ AYS PY5DBB0SԠSAUSBS MPNϠPAY PY6ADBMN0NUMBҠƠBSS SSBҠSS? MPPY3A SZBNUMBҠƠBSS? MPPYB MPPY0? BNҠNP DBMN0MUNҠ SBBNԱ6BS. BAҠB BNԲSAAҠHKSBƠAAŠNŠB NBUNNNGUNԠƠBSS. SZBNԱA̠6BSƠAHKD? MPBNԲN. MPBNҬ640ɠYS.UN.BNUMBҠƠBS BNԱNP MN0Ԡ0 MN0Ԡ60 MNԠ6 B0Ԡ0 HAҴNPBNUMBҠƠBSS ADBMNNUMBҠƠBSS SSB3ҠSS? MPHAҴɠYS.HA.AҠìUNP+ ADBMNN.NUMBҠƠBSS SSBUA̠ϠҠGAҠHAN3? SZHAҴN.NHҠHA.UNP+3 SZHAҴYS.HA.BҠDUNP+ MPHAҴɠUN PAҠNP SBDD.SADDAADANDSAUS SBMP5SAVŠVҠSAUS SSBPAY? MPPAұYS. BN.A SBPNԠP..UN SZPAҠNMNԠUNADDSS MPPAҬɠUNP+ PAұSZPNԠNMNԠPŠUN DBPN ADBMN0ADD- SSBSSGHԠNSUVŠP..? MPPAҲYS. DABN.HנHAA DBAGPN BҬBҠP BҬBҠDMA SBSSAD? SBUPAN.UPUԠ MPPAҬɠUNP+ PAҲDABHנHAA MPPY5 AU0 BU ND \6  29004-80001 A S 0122 COUPLER SERIAL INTERFACE BCS DRIVER D.66             H0101 ASMBҬB̬ HD3NAŠBSDVҠD.66(3Է NAMD.66 NԠD.66.66 D.66NP SAASAVŠԠADDSS SBASAVŠUSԠDŠADDSS DAD.66SԠNNUAҠ SA.66ϠàUN DABɠHUSԠDŠD ANDM00SAŠUNN ŬSZAAҠUS? MP+3N. SAAYS.SԠAҠAG MP+ DBDBSYHDVҠBUSYAG SZBDVҠBUSY? MPʱYS. SBAAҠANNNUAҠ DBB PA.0BNAYADUS? BSŠYS.SԠPANAGϠ. PA.00ASɠADUS? BSŠYS.SԠPANAGϠ. PA.0BNAYŠUS? BSŬBSYS.SԠPANAGϠ6. PA.00ASɠŠUS? BSŬBSYS.SԠPANAGϠ. PA.30NMAZŠN̠US? MPѠYS.SԠPANAGϠ. SZSSASGA̠US? MPѠYS. ʠBSSUSԠDŠ.B0 ʱDBS.0DVҠBUSY.BNG ANAPANDD.A MPD.66ɠUNϠ NSANS M00Ԡ600 .0Ԡ000 .00Ԡ0000 .0Ԡ000 .00Ԡ0000 .30Ԡ3000 AàA0 BԠ .00Ԡ00 .0500Ԡ5000 .000Ԡ000 .050Ԡ500 B00Ԡ00 B00Ԡ00 ANP ANP AҠSBDD.SAҠSAUSANDDAADS MPSK ѠSBAGSAVŠPANAG DAAɠHSԠDŬSAŬ ANDBANDNGUŠɯϠNSUNS ҠA SAA SAN3 Ҡ.00 SAñ Ҡ.0500 SASò Ҡ.000 BSAñ SAò SA+ à0àSԠVŠAGMD Ҡ.050 SASS ҠB00 SASñ ҠB00 SAA Ҡ.0500 SABñ SABò SAB3 SADBSYSԠDVҠBUSYAG DBAMADDSS ŬNBԠD.(SAUS DABɠHԠSAUSD AAҠADDDVŠBUSYB SABɠANDS. NBMADDSSƠANSMSSN SBGGANDSAV. DBA SZBSSAҠUS? MPAҠYS. DBAGHPANAG BҬB SBNMAZŠUS? MPñYS. SBDD.SADVҠANDSAUSD DAM55NAZŠH-ϠAG SAHϠϠH DBAM ADBBBUҠADDSS DABɠHDAABUҠADDSS A̬ŬSAAND? DAAɠYS.HVŠADDSS SSANDԠAGAN? MP-3YS. NBMADDSSƠBUҠNGH DBBɠHBUҠNGH SZBSSZ? MPʠYS. SADPBUƠSŠDAABUҠADDSS SBUNԠSAVŠGNA̠UN SSBNGAV? MP+3YS. B̠N.NVԠϠHAAҠUN MBNBMPMN SBDNҠSŠASUN DBAGHPANAG BҬSBBҠASɠ MP0BNAY BҬSBBҠADUS? MP0YS. SBSSASɠ? MPײYS. DADPBUƬɠN.HS MPN3BNAYD 0DANנHNנHAA SAƠSԠADAG MPN3 NSANS M55gԠ555 S.0Ԡ00000 ANP ײDADNҠHBUҠNGH SADDƠHAAS? BYS.SԠHɠHAAҠAG NAM MANAADDSS AS ADADPBUƠASԠHAA DAAɠHASԠHAA SZBSSHɠҠϠHAA? AƬAƠH.AŠϠϠHA ANDB3SAŠϠHAA PAAԠHAAҠS? MP״YS. MPHA NSANS AԠԠ00 BԠ DBSYNP ״SANDNƠSԠNϠDNŠAG SZDNҠNMNԠBUҠNGH SZUNԠSUBAԠNŠMGNA̠UN MPHA .66NP òà0àSԠVŠAGMD SAASAVŠGSS SBB A SAA DAAGHPANAG SAAҠPYASɠ? MPAԠYS. SAAҠBNAYAD? MPBDYS. SAAҠNMAZŠUS? MPNYS. SAAҠASɠAD? MPADYS. SBPAҠPAYҠҠMPPҠPY? SZDN SZDNҠPYϠASԠHAA? SSN. MPSKYS. SZDPBUƠNMNԠBUҠADDSS DADPBUƬɠHNԠD MPN3 NDANSYNHN-SYNSNԠAG BA SBUNԠGNA̠UN SBDNҠANDUN SZAAGS? MPñYS SBDD.SADVҠANDSAUS SSBPAY? MPNYS. PANנNנPY? MPSKYS. NDASYNԠHSYNUN PABHAVŠYSBNAMPD? MPSMŠYS. SZSYNԠ ^NMNԠSYNUN DASYNHSYNHAA N3A0UPUԠHAA SADSŠASASԠD PAנ? SSYS. SANDSŠASASԠNN-נD NDAASŠGSS A DBB DAA SòSà0àSԠVŠNUPԠMD MP.66ɠUN NSANS SYNԠ00 UNԠNP AGNP GNP ANP BNP BԠ HϠNP DNҠNP DPBUƠNP DD.SNP AA0ADVҠD BñB0àADSAUSD AƬAƠGHԠUSY AƬAҠDAAD MPDD.S ñà0SԠANSMԠAGMD AA SANSYNN-SYNAG DAAA DAAMMMUM DAA DAAUS SSSS0ASԠDSU? MPNN. ñà0àSԠVŠAGMD Ơ0DSABŠNUPԠSYSM BòB0àADSAUS BҬB SBPNNPSS? MPN3YS. DASYNHSYNHAA AA0UPU B3B0àADSAUS SƠ0NABŠNUPԠSYSM BҬB SBPNNPSS? MPNYS MPN NSBNSYNSԠN-SYNAG A SñSà0SԠANSMԠNUPԠMD MPD.66ɠUN B3Ԡ3 ƠNP NנԠ00 B0Ԡ0 NSYNNP NDNƠNP NBSSSԠSNDPNAG N3DBNDNƠHSNDPNAG DAB0HPNNŠSAUSB SƠ0NABŠNUPԠSYSM SZBS? MPSA0YS. SANDNƠN.SԠSNDPNAG NSANSYN͗SԠN-SYNAG MPN SKANASSSԠSAUSϠANSMSSNK SMŠDABSԠSAUSϠMMUNAN MPSA0 AԠSBPAҠPAYҠҠMPPҠPY? DADNҠN.HBUҠNGHUN SZASSPYϠASԠHAA? MPSKYS. HAҠDADPBUƬɠHUNԠD DBHϠHH-ϠAG SBSSϠHA? MPϠYS. AƬAƠAŠHɠHAƠϠ MPM ϠSZDPBUƠNMNԠBUҠADDSS MANDB3SAŠBԠHAA BҠSԠN SBHϠHϠAG SZDNҠASԠHAA? MPN3N. DBNDNƠYS.HNϠDNŠAG SZBSSAGS? Ҡ.000N.ADDDNŠBԠϠHAA MPN3 NSANS .000Ԡ000 SYNԠNP נԠ00 DNP NDNP BԠ ADSBPAҠPAYҠҠMPPҠPY? ANDB3SAŠϠBԠHAA DBHϠHH-ϠAG SBSSϠHA? MPSϠYS. AƬAƠAŠBSϠHɠHA SADPBUƬɠANDS MPSM SϠDBDPBUƬɠHUNԠHɠHA ҠBMGŠNϠHA SADPBUƬɠANDS. SZDPBUƠNMNԠBUҠADDSS SMDBHϠSԠN BҠH SBHϠAG ADDANSYNHDAGAN AƬA̠DNŠB SZDNҠBUҠU? SSAN.DNŠBԠS? MP+3YS.YS. DANנN.HN MPN3HAA SSADNŠBԠS? ANASSYS.SԠSAUSBSϠK DABSԠSAUSϠN-DNŠDD SA0SAAGSAVŠSAUSBS DBDNҠ~HUN DAUNԠHGNA̠UN ŬSSASSDS? ASŬSAYS.DUBŠANDSKP MANAMPMNԠHAAҠUN ADABANUMBҠƠHAS.ANSMD DBUNԠDS SSBUSD? MP+N. SAASYS.NVԠHAAҠUNԠ NADS.ҠDDHAS.ADD ҠS.0SԠBNAYAG SAGɠSŠNUMBҠASANSMSSNG BMADDSS ADBGԠSAUSD DABɠUPDA AND.3 ҠAGSAUS SABɠD A SADBSY SANDN SA SAP SA SA SASYN DAñ SASò MPN .3Ԡ300 BDSBPAҠPAYҠҠMPPҠPY? ANDB3SAŠϠBS SADPBUƬɠSŠDNBU SZDPBUƠNMNԠBUҠADDSS SZDN MPAD PAҠNP SBDD.SADVҠANDSAUS SSBPAY? MPPA5YS. SANSYNN.SAVŠHAA BAҠPAY SBPԠҠUN PAננPY? MPPA6YS. SBԠAҠנUN AƬAƠDD SABԠS? MPPAҷYS. SBԠAҠDDUN AƬA DBƠHADAG SZBAGS? MPPA3YS.(AD PANנNנPY? MPPAҴYS. SZASSZϠPY?(PNN? MPNYS PAұDBPYHMPPҠPYUN SZBSNDMPPҠPY? MPSMŠYS. SZPY*($NMNԠMPPҠPYUN PAҲDAנHנHAA MPN3 PA3PANנNנPY? MPPAұYS. PAҴBAҠMPP SBPYPYUN MPPAҬɠUN. NSANS PYNP ԠNP PԠNP ԠNP MNԠ6 PA5DBPԠHPAYҠUN PBBGHԠNSUVŠS? MPSPŠYS. SZPԠNMNԠPAYҠUN MPPAҲ PA6DBPԠHPAYҠUN SZBPVUSPAY? MPSPŠYS. DBԠHנUN PBBGHԠNSUVŠS? MPSPŠYS. SZԠNMNԠנUNԠ6 DADHASԠDUPU MPN3 PAҷDBPԠHPAYҠUN ADBMNGA SSBSSHAN? MPSPŠYS. DBԠHDDUN PBBGHԠNSUV? MPSPŠYS. SZԠNMNԠDDUN DANDHASԠNN-נDUPU MPN3 B0Ԡ0 SPŠDAB0SԠSAUSBS MPSA0PAY AU0 BU ND 6*  29005-80001 1636 S 0122 12665 DIAGNOSTIC              H0101 ASMB,A,B,L,C HED 12665 DIAGNOSTIC PROGRAM -- BASIC TESTS ORG 2 * * 12665 DIAGNOSTIC PROGRAM * * SOURCE TAPES 29005-80001 (1 OF 2) DATE CODE 1636 * AND 29005-80002 (2 OF 2) DATE CODE 1636 * * STARTING ADDRESS 2 * * RESTARTING ADDRESS 100B * * REQUIRES TAPE READER ONLY, THE SWITCH REGISTERS ARE * USED FOR ENTERING THE NECESSARY INFORMATION REQUIRED * BY THE PROGRAM. THE FOLLGWING TABLE SHOWS THE PROGRAM * WORD ORGANIZATION. * * * ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ * BIT^15^14^13^12^11^10^ 9^ 8^ 7^ 6^ 5^ 4^ 3^ 2^ 1^ 0^ * ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^ ^ * / ^ ^ / / * DMA INDI- / / / / * CATOR / WIRED BIT / SELECT CODE * 1 - YES / LENGTH COMPUTER FROM 10 TO 77 * 0 - NO / 000- 1US 000- ILL. OCTAL * / 001- 2US 011-2114/15 BELOW 10B ILL. * / 010- 4US 001/010 ILL. HALT * 2570 IN- 011- 8US -2100/16 AT 2 * DICATOR 100-16US 100 - 21MX * 1 - YES 101-32US 101-21MX E-SERIES * 0 - NO 110- ILL. ILL. HALT * 111- ILL. AT 1 * ILL. HALT * AT 3 * * IF HALT HAPPENS AT 1, 2, 3, CORRECT THE SWITCH REGISTERS, * THEN "RUN" * IF HALT AT ANY OTHER LOCATION, LOOK THE ERROR MESSAGE TABLE * FOR DESCRIPTION OF ERROR, THE OPERATOR WILL THEN HAVE ONE * OPTION TO CHOOSE, * WITH BIT 15 1 -- SKIP THE SCOPE LOOP AND CONTINUE THE NEXT * TEST AFTER "RUN" * 0 -- GO INTO SCOPE SERVICE LOOP AFTER "RUN" * * AT THE COMPLETION OF DIAGNOSIS, THE COMPUTER WILL HALTax THE 77B. * TO COMPLETE THE PARITY CHECK IT IS REQUIRED FOR THE OPERATOR * TO CONNECT TEST POINT TP18 TO GROUND, THEN "RUN", THE * COMPUTER WILL HALT AT 76B IF THE PARITY LOGIC IS CORRECT, AND * HALT AT 54B INDICATES INCORRECT PARITY LOGIC. * * FOR COMPUTER TO COMPUTER SYSTEM CHECK, IT REQUIRES THAT THE * DIAGNOSTIC PROGRAM BE LOADED AND EXECUTED ONCE IN EACH COMPUTER * THEN TIE THESE TWO COMPUTERS TOGETHER THROUGH THE COMMUNICATION * CABLE. TO START THE TEST, SIMPLY LOAD * * ADDRESS 4000B INTO THE ORIGINATING COMPUTER * * ADDRESS 5000B INTO THE RESPONDING COMPUTER * * THEN "RUN" FOR BOTH COMPUTERS. * * HALT AT 70B WILL HAPPEN WHENEVER THERE IS ANY ERROR SPOTTED * IN THE TRANSMISSION. TO CONTINUE THE TEST SIMPLY "RUN" * * RETEST AFTER HALT AT 77B REQUIRES "RUN" ONLY * * ABBREVIATIONS US -- MICROSECOND * MS -- MILLISECOND * JMP 110B,I ORG 100B RESTART ADDRESS JMP 101B,I ORG 101B RESTART BASE PAGE LINKAGE DEF ITEST ORG 110B BASE PAGE LINKAGE DEF START ORG 2000B START LIA 1 READ CONTROL WORD FROM SW REGISTERS STA DIAGW SAVE DIAGNOSTIC CONTROL WORD ALF ROTATE FOUR PLACES AND M3 MASK THE LAST TWO BITS STA TEMP0 SAVE AND M1 MASK BIT 0 STA A2570 SET 2570 INDICATOR LDA TEMP0 FETCH RAR ROTATE A RIGHT ONE PLACE AND M1 MASK BIT 0 STA ADMA SAVE IN DMA INDICATOR LDA DIAGW FETCH CONTROL WORD ALF,ALF RAR AND M7 MASK BIT LENGTH INFORMATION STA BLNG LDA DIAGW FETCH CONTROL WORD ALF,ALF RAL,RAL AND M7 MASK COMPUTER TYPE INFORMATION SZA,RSS JMP *+2 JMP *+3 HLT1 HLT 1 ERROR! CHECK COMPUTER TYPE BITS 6 TO 8 JMP START RECONFIGURE STA CTYPE SAVE LDB M67 PREPARE LDA HIS TRAPS STA *+2 FOR LDA HI ILLEGAL STA 10B INTERRUPT ISZ *-1 FROM INA ANY INB,SZB DEVICE JMP *-4 LDA DIAGW FETCH CONTROL WORD AND M77 MASK SELECT CODE STA ADDR SAVE ADDRESS AND M70 MASK BITS 3,4,5 SZA,RSS CHECK FOR ACCEPTABLE CODE JMP *+2 JMP *+3 HLT2 HLT 2 ERROR! ILLEGAL SELECT CODE JMP START RECONFIGURE JSB ADIN CONFIGURE ADDRESS INTO INSTRUCTIONS JSB WDTMM CALCULATE THE TIME MULTIPLIER * * INITIAL TEST --- CHECK THE TRANSMITTING/RECEIVING * MODE F/F, THE FLAG F/F, THE FLAG * BUFFER F/F, THE CONTROL F/F, THE * INTERRUPT CIRCUITRY, AND ALL THE * ASSOCIATED GATES. * ITEST NOP CLC 0,C TURN-OFF INTERRUPT SYSTEM CLC1 CLC 0 SET CARD IN TRANSMITTING MODE LDB CNT3 WAIT INB FOR SZB AT LEAST JMP *-2 10 US SFS1 SFS 0 TEST FLAG SET JMP HLT10 JMP *+3 HLT10 HLT 10B ERROR! FLAG IS NOT SET JSB LOOP1 SFC1 SFC 0 TEST FLAG CLEAR JMP *+3 HLT11 HLT 11B ERROR! FLAG IS CLEARED JSB LOOP1 OTA1 OTA 0 CLEAR THE FLAG SFS2 SFS 0 TEST FLAG JMP *+3 HLT12 HLT 12B ERROR! FLAG IS SET JSB LOOP1 GO TO SERVICE LOOP SFC2 SFC 0 JMP HLT13 JMP *+3 HLT13 HLT 13B ERROR! FLAG IS NOT CLEARED JSB LOOP1 GO TO SERVICE LOOP LDB CNT1 FETCH COUNTS INB WAIT SZB ABOUT JMP *-2 1 MS * * 10 US ONE - SHOT TEST * CLCC1 CLC 0,C SET CARD IN RECEIVING MODE LIA1 LIA 0 x READ A DATA WORD, CLEAR FLAG CLC2 CLC 0 SET CARD IN TRANSMITTING MODE NOP WAIT SFS3 SFS 0 TEST FLAG SET JMP *+3 OK! HLT14 HLT 14B ERROR! FLAG IS SET TOO SOON JSB LOOP1 GO TO SERVICE LOOP LDB CNT2 WAIT INB AT LEAST SZB 10 JMP *-2 US SFS4 SFS 0 TEST FLAG JMP HLT15 JMP *+3 HLT15 HLT 15B ERROR! FLAG IS NOT SET YET JSB LOOP1 GO TO SERVICE LOOP * * INTERRUPT LOGIC TEST * CLC 0,C TURN-OFF INTERRUPT SYSTEM CLCC2 CLC 0,C SET CARD IN RECEIVING MODE LIA2 LIA 0 CLEAR FLAG STCC1 STC 0,C SET CONTROL SFC3 SFC 0 TEST FLAG CLEAR JMP HLT16 JMP *+3 HLT16 HLT 16B ERROR! FLAG IS NOT CLEARED JSB LOOP1 GO TO SERVICE LOOP LDA ERR SET ERROR IN STA ADDR,I TRAP CELL STF 0 TURN-ON INTERRUPT SYSTEM NOP WAIT NOP LDA OK SET OK IN STA ADDR,I TRAP CELL STC1 STC 0 SET CONTROL LDB CNT3 WAIT INB FOR SZB INTERRUPT JMP *-2 NOP HLT0 HLT 0 ERROR! WRONG INTERRUPT JSB LOOP1 GO TO SERVICE LOOP OKXX LDA HLT0 RESTORE IOR ADDR TRAP STA ADDR,I CELL CLF 0 TURN-OFF INTERRUPT SYSTEM * * TRANSMITTER/RECEIVER TEST * CLCC3 CLC 0,C SET CARD IN RECEIVING MODE LIA3 LIA 0 CLEAR FLAG SFC4 SFC 0 TEST FLAG CLEAR JMP HLT17 JMP *+3 HLT17 HLT 17B ERROR! FLAG IS NOT CLEARED JMP LOOP2 GO TO SERVICE LOOP LIAC1 LIA 0,C READ STATUS WORD LIAC2 LIA 0,C READ STATUS WORD * * AFTER READ DATA WORD AND STATUS WORD THE RECEIVER * ENABLED , MISSED WORD, RECEIVER IN PROCESS AND PARITY * FLIP-FLOPS SHOULD ALL BE CLEARED * SLA 2CHECK JMP HLT20 RECEIVER ENABLE JMP *+3 FLIP FLOP HLT20 HLT 20B ERROR! RECEIVER IS DISABLED JSB LOOP2 GO TO SERVICE LOOP SSA CHECK JMP HLT21 PARITY JMP *+3 F/F HLT21 HLT 21B ERROR! PARITY F/F IS SET JSB LOOP2 GO TO SERVICE LOOP RAR,RAR SSA CHECK JMP HLT22 MISSED WORD JMP *+3 F/F HLT22 HLT 22B ERROR! M.W. F/F IS SET JSB LOOP3 GO TO SERVICE LOOP SLA CHECK JMP HLT23 RECEIVER IN PROCESS JMP *+3 F/F HLT23 HLT 23B ERROR! R.I.P. F/F IS SET JSB LOOP2 GO TO SERVICE LOOP * * * TRANSMIT A WORD TO CHECK STATUS BITS, ONLY THE REC. * IN PROCESS F/F SHOULD CHANGE STATE * OTA2 OTA 0 TRANSMIT A WORD ISZ .5WTM WAIT FOR ABOUT JMP *-1 HALF A WORD TIME LIAC3 LIA 0,C READ STATUS SLA CHECK JMP HLT24 REC. JMP *+3 ENA. F/F HLT24 HLT 24B ERROR! RECEIVER IS DISABLED TOO JSB LOOP2 SOON; BIT TIME MAY BE WRONG RAR SLA CHECK JMP HLT25 M.W. F/F JMP *+3 HLT25 HLT 25B ERROR! M.W. F/F SHOULD NOT BE SET JSB LOOP3 GO TO SERVICE LOOP RAR SLA CHECK JMP *+3 R.I.P. F/F HLT26 HLT 26B ERROR! R.I.P. F/F IS NOT SET JSB LOOP2 EITHER F/F OR CLOCK IS BAD ISZ WTM WAIT FOR JMP *-1 ONE COMPLETE WORD TIME SFS5 SFS 0 TEST JMP HLT27 FLAG JMP *+3 SET HLT27 HLT 27B ERROR! FLAG DID NOT SET JSB LOOP2 GO TO SERVICE LOOP * LDA CNT RESTORE STA WTM TIMING LDA .5CNT MULTIPLIERS STA .5WTM * * READ STATUS BEFORE READ DATA, SHOULD FIND THAT * RECEIVER IS DISABLED * LIIAC4 LIA 0,C READ STATUS SLA TEST JMP *+3 R. ENA. F/F HLT30 HLT 30B ERROR! RECEIVER IS NOT DISABLED JSB LOOP2 GO TO SERVICE LOOP * * TRANSMIT ANOTHER WORD WOULD CAUSE M.W. F/F TO BE SET * OTA3 OTA 0 TRANSMIT ANOTHER WORD LDB CNT1 FETCH COUNTS FOR DELAY INB WAIT SZB ABOUT JMP *-2 1 MS LIAC5 LIA 0,C READ STATUS WORD AGAIN SLA CHECK JMP *+3 R.ENA. F/F HLT31 HLT 31B ERROR! RECEIVER IS NOT DISABLED JSB LOOP3 GO TO SERVICE LOOP RAR SLA CHECK M.W. F/F JMP *+3 OK! HLT32 HLT 32B ERROR! M.W. F/F IS NOT SET JSB LOOP3 GO TO SERVICE LOOP LIAC6 LIA 0,C READ STATUS AGAIN * * SHOULD CLEAR M.W. F/F,R.D. F/F REMAIN SET AND FLAG SET * SLA CHECK JMP *+3 R. ENA. F/F HLT33 HLT 33B ERROR! RECEIVER IS NOT DISABLED JSB LOOP2 GO TO SERVICE LOOP RAR SLA CHECK M.W. F/F AGAIN JMP HLT34 JMP *+3 OK! HLT34 HLT 34B ERROR! M.W. F/F IS NOT CLEARED JSB LOOP3 GO TO SERVICE LOOP SFS6 SFS 0 TEST FLAG JMP HLT35 JMP *+3 OK! HLT35 HLT 35B ERROR! FLAG DID NOT STAY SET JSB LOOP2 GO TO SERVICE LOOP * * READ DATA WORD SHOULD CLEAR FLAG , THEN READ STATUS * SHOULD CLEAR ALL FOUR STATUS BITS * LIA4 LIA 0 READ DATA WORD SFC5 SFC 0 TEST FLAG CLEAR JMP HLT36 JMP *+3 OK! HLT36 HLT 36B ERROR! FLAG DID NOT CLEAR JSB LOOP2 GO TO SERVICE LOOP LIAC7 LIA 0,C READ STATUS WORD SSA CHECK PARITY F/F JMP HLT37 JMP *+3 OK! HLT37 HLT 37B ERROR! PARITY F/F IS SET JSB LOOP2 GO TO SERVICE LOOP SLA CHECK R. ENA. F/F JMP HLT40 JMP *+3 OK! HLT40 HLT 40B 1 ERROR! RECEIVER IS NOT ENABLED JSB LOOP2 GO TO SERVICE LOOP RAR,RAR SSA JMP HLT41 JMP *+3 OK! HLT41 HLT 41B ERROR! M.W. F/F IS NOT CLEARED JSB LOOP3 GO TO SERVICE LOOP SLA CHECK I.P. F/F JMP HLT42 JMP *+3 HLT42 HLT 42B ERROR! I.P. F/F IS SET JSB LOOP2 * * THE FOLLOWING SUBROUTINE IS DESIGNED TO TEST * BLOCK TRANSMITTING AND RECEIVING WITH 1'S AND * 0'S PROPAGATING THROUGH THE TRANSMISSION WORDS * LDB CNT4 STB CNT5 SET COUNTER CLC3 CLC 0 SET CARD IN TRANSMIT MODE LDA ADATA STA IDATA SET START ADDRESS OF DATA BLOCK PLOOP NOP LDA IDATA,I LOAD DATA OTA4 OTA 0 TRANSMIT DATA LDB CNT1 INB WAIT SZB ABOUT JMP *-2 1 MS LIA5 LIA 0 READ DATA WORD STA TEMP0 LIBC1 LIB 0,C READ STATUS WORD SSB CHECK PARITY BIT JMP HLT43 JMP *+3 OK! HLT43 HLT 43B ERROR! PARITY F/F JSB LOOP2 GO TO SERVICE LOOP LDB A2570 READ 2570 INDICATOR SLB JMP P1 YES, CARD IS WIRED FOR 2570 CMA,INA ADA IDATA,I ADD ORIGINAL DATA TO THE COMPLE- * MENT OF THE RECEIVED DATA JMP P2 P1 NOP LDA IDATA,I LOAD ORIGINAL DATA AND M3777 MASK OFF THE UNWANTED BITS ALF SHIFT RAL 5 BITS LEFT STA TEMP1 SAVE LDA TEMP0 LOAD THE RECEIVED DATA CMA,INA CHANGE TO NEGATIVE NUMBER ADA TEMP1 ADD TO THE TRANSMITTED DATA P2 SZA TEST RESULT JMP *+2 JMP *+3 HLT44 HLT 44B ERROR! SUM IS NOT ZERO JSB LOOP2 LDA IDATA LOAD THE ADDRESS OF DATA INA INCREMENT ONE STA IDATA RESTORE THE CURRENT ADDRESS ISZ CNT5 INCREMENT ADDRESS COUNTER, TEST JMP PLOOP GO BACK TO TRANSMIT NEXT WORD LDA ADMA FETCH DMA INDICATOR SLA CHECK TO SEE IF DMAT IS NEEDED JSB DMAT GO ON TO TEST DMA IN AND OUT HLT 77B TEST COMPLETION JSB PARIT CHECK PARITY LOGIC JMP ITEST+1 HED 12665 DIAGNOSTIC PROGRAM -- ROUTINES AND SERVICE LOOPS * PREPARE WORD TIME MULTIPLIER * WDTMM NOP LDB CTYPE CPB A3 JMP P1415 CPB M1 JMP P0016 CPB A2 JMP P0016 CPB A4 JMP PMX CPB A5 JMP PXE JMP HLT1 UNRECOGNIZABLE COMPUTER TYPE P0016 LDA A2570 CHECK 2570 INDICATOR LDB A4 FETCH A4 SLA LDB A3 FETCH A3 JMP P3 P1415 LDA A2570 FETCH 2570 INDICATOR LDB A3 FETCH A3 SLA LDB A2 FETCH A2 JMP P3 PXE LDA A2570 FETCH 2570 INDICATOR LDB A9 SLA LDB A7 LDA DM4 STA CNT2 LDA DM5 STA CNT3 LDA DM300 STA CNT1 JMP P4 PMX LDA A2570 FETCH 2570 INDICATOR LDB A5 NO, FETCH A5 SLA LDB A4 FETCH A4 P3 LDA DM2 STA CNT2 LDA DM3 STA CNT3 LDA DM160 STA CNT1 P4 STB MPLR SET BASIC MULTIPLIER LDA BLNG LOAD BIT LENGTH INFORMATION ADA M6 SSA,RSS CHECK FOR ILLEGAL BIT LENGTH JMP HLT3 YES LDA BLNG NO, LOAD BIT LENGTH INFORMATION CMA,RSS BLS CHECK BITS AND DOUBLE COUNTER INA,SZA JMP *-2 P7 CMB,INB CHANGE TO NEGATIVE NUMBER STB CNT FINAL WORD TIME MULTIPLIER STB WTM BRS STB .5CNT HALF WORD TIME MULTIPLIER STB .5WTM JMP *+3 HLT3 HLT 3 JMP START RECONFIGURE JMP WDTMM,I RETURN TO MAIN PROGRAM * * DMA TEST ROUTINE * DMAT NOP DMA OUTPUT LDA ADDR PREPARE OT Y640A 6 CLC 2 DMA LDA CW2 OTA 2 TO STC 2 LDA CW3 OUTPUT A WORD OTA 2 CLCC4 CLC 0,C SET CARD IN RECEIVING MODE LIA6 LIA 0 CLEAR THE FLAG OF 12665 STC 6B,C ACTIVATE DMA OTA5 OTA 0 SET THE FLAG, CARD IS ACTIVATED NOP WAIT NOP FOR FLAG TO BE CLEARED SFS7 SFS 0 TEST FLAG JMP *+3 HLT45 HLT 45B ERROR! FLAG SHOULD BE CLEARED JSB LOOP5 GO TO DMA OUTPUT SERVICE LOOP LDB CNT1 BLS INB WAIT SZB ABOUT JMP *-2 2 MS CLC 6,C SFC6 SFC 0 TEST FLAG JMP *+3 HLT46 HLT 46B ERROR! FLAG IS NOT SET JSB LOOP5 GO TO SERVICE LOOP LIAC8 LIA 0,C READ STATUS SLA TEST R. ENA. F/F JMP *+3 HLT47 HLT 47B ERROR! R. ENA.F/F IS NOT SET JSB LOOP5 AND M1006 SZA TEST FOR ZERO JMP *+2 JMP *+3 HLT50 HLT 50B ERROR! JSB LOOP5 LIA7 LIA 0 READ DATA STA RWDA SAVE CMA,INA CONVERT TO NEGATIVE NUMBER ADA WDA ADD TO THE WORD TRANSMITTED BY DMA SZA CHECK JMP *+2 NO JMP *+3 OK HLT51 HLT 51B ERROR! WORD RECEIVED IS ERRONEOUS JSB LOOP5 GO TO DMA OUTPUT SERVICE LOOP * * END OF TAPE 29005-80001 * CONTINUATION OF PROGRAM ON TAPE 29005-80002 * 6  29005-80001 1636 S 0122 12665 DIAGNOSTIC              H0101 ASMB,A,B,L,C HED 12665 DIAGNOSTIC PROGRAM -- BASIC TESTS ORG 2 * * 12665 DIAGNOSTIC PROGRAM * * SOURCE TAPES 29005-80001 (1 OF 2) DATE CODE 1636 * AND 29005-80002 (2 OF 2) DATE CODE 1636 * * STARTING ADDRESS 2 * * RESTARTING ADDRESS 100B * * REQUIRES TAPE READER ONLY, THE SWITCH REGISTERS ARE * USED FOR ENTERING THE NECESSARY INFORMATION REQUIRED * BY THE PROGRAM. THE FOLLGWING TABLE SHOWS THE PROGRAM * WORD ORGANIZATION. * * * ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ * BIT^15^14^13^12^11^10^ 9^ 8^ 7^ 6^ 5^ 4^ 3^ 2^ 1^ 0^ * ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^ ^ ^ ^ * ^ ^ ^ ^ ^ * / ^ ^ / / * DMA INDI- / / / / * CATOR / WIRED BIT / SELECT CODE * 1 - YES / LENGTH COMPUTER FROM 10 TO 77 * 0 - NO / 000- 1US 000- ILL. OCTAL * / 001- 2US 011-2114/15 BELOW 10B ILL. * / 010- 4US 001/010 ILL. HALT * 2570 IN- 011- 8US -2100/16 AT 2 * DICATOR 100-16US 100 - 21MX * 1 - YES 101-32US 101-21MX E-SERIES * 0 - NO 110- ILL. ILL. HALT * 111- ILL. AT 1 * ILL. HALT * AT 3 * * IF HALT HAPPENS AT 1, 2, 3, CORRECT THE SWITCH REGISTERS, * THEN "RUN" * IF HALT AT ANY OTHER LOCATION, LOOK THE ERROR MESSAGE TABLE * FOR DESCRIPTION OF ERROR, THE OPERATOR WILL THEN HAVE ONE * OPTION TO CHOOSE, * WITH BIT 15 1 -- SKIP THE SCOPE LOOP AND CONTINUE THE NEXT * TEST AFTER "RUN" * 0 -- GO INTO SCOPE SERVICE LOOP AFTER "RUN" * * AT THE COMPLETION OF DIAGNOSIS, THE COMPUTER WILL HALTax THE 77B. * TO COMPLETE THE PARITY CHECK IT IS REQUIRED FOR THE OPERATOR * TO CONNECT TEST POINT TP18 TO GROUND, THEN "RUN", THE * COMPUTER WILL HALT AT 76B IF THE PARITY LOGIC IS CORRECT, AND * HALT AT 54B INDICATES INCORRECT PARITY LOGIC. * * FOR COMPUTER TO COMPUTER SYSTEM CHECK, IT REQUIRES THAT THE * DIAGNOSTIC PROGRAM BE LOADED AND EXECUTED ONCE IN EACH COMPUTER * THEN TIE THESE TWO COMPUTERS TOGETHER THROUGH THE COMMUNICATION * CABLE. TO START THE TEST, SIMPLY LOAD * * ADDRESS 4000B INTO THE ORIGINATING COMPUTER * * ADDRESS 5000B INTO THE RESPONDING COMPUTER * * THEN "RUN" FOR BOTH COMPUTERS. * * HALT AT 70B WILL HAPPEN WHENEVER THERE IS ANY ERROR SPOTTED * IN THE TRANSMISSION. TO CONTINUE THE TEST SIMPLY "RUN" * * RETEST AFTER HALT AT 77B REQUIRES "RUN" ONLY * * ABBREVIATIONS US -- MICROSECOND * MS -- MILLISECOND * JMP 110B,I ORG 100B RESTART ADDRESS JMP 101B,I ORG 101B RESTART BASE PAGE LINKAGE DEF ITEST ORG 110B BASE PAGE LINKAGE DEF START ORG 2000B START LIA 1 READ CONTROL WORD FROM SW REGISTERS STA DIAGW SAVE DIAGNOSTIC CONTROL WORD ALF ROTATE FOUR PLACES AND M3 MASK THE LAST TWO BITS STA TEMP0 SAVE AND M1 MASK BIT 0 STA A2570 SET 2570 INDICATOR LDA TEMP0 FETCH RAR ROTATE A RIGHT ONE PLACE AND M1 MASK BIT 0 STA ADMA SAVE IN DMA INDICATOR LDA DIAGW FETCH CONTROL WORD ALF,ALF RAR AND M7 MASK BIT LENGTH INFORMATION STA BLNG LDA DIAGW FETCH CONTROL WORD ALF,ALF RAL,RAL AND M7 MASK COMPUTER TYPE INFORMATION SZA,RSS JMP *+2 JMP *+3 HLT1 HLT 1 ERROR! CHECK COMPUTER TYPE BITS 6 TO 8 JMP START RECONFIGURE STA CTYPE SAVE LDB M67 PREPARE LDA HIS TRAPS STA *+2 FOR LDA HI ILLEGAL STA 10B INTERRUPT ISZ *-1 FROM INA ANY INB,SZB DEVICE JMP *-4 LDA DIAGW FETCH CONTROL WORD AND M77 MASK SELECT CODE STA ADDR SAVE ADDRESS AND M70 MASK BITS 3,4,5 SZA,RSS CHECK FOR ACCEPTABLE CODE JMP *+2 JMP *+3 HLT2 HLT 2 ERROR! ILLEGAL SELECT CODE JMP START RECONFIGURE JSB ADIN CONFIGURE ADDRESS INTO INSTRUCTIONS JSB WDTMM CALCULATE THE TIME MULTIPLIER * * INITIAL TEST --- CHECK THE TRANSMITTING/RECEIVING * MODE F/F, THE FLAG F/F, THE FLAG * BUFFER F/F, THE CONTROL F/F, THE * INTERRUPT CIRCUITRY, AND ALL THE * ASSOCIATED GATES. * ITEST NOP CLC 0,C TURN-OFF INTERRUPT SYSTEM CLC1 CLC 0 SET CARD IN TRANSMITTING MODE LDB CNT3 WAIT INB FOR SZB AT LEAST JMP *-2 10 US SFS1 SFS 0 TEST FLAG SET JMP HLT10 JMP *+3 HLT10 HLT 10B ERROR! FLAG IS NOT SET JSB LOOP1 SFC1 SFC 0 TEST FLAG CLEAR JMP *+3 HLT11 HLT 11B ERROR! FLAG IS CLEARED JSB LOOP1 OTA1 OTA 0 CLEAR THE FLAG SFS2 SFS 0 TEST FLAG JMP *+3 HLT12 HLT 12B ERROR! FLAG IS SET JSB LOOP1 GO TO SERVICE LOOP SFC2 SFC 0 JMP HLT13 JMP *+3 HLT13 HLT 13B ERROR! FLAG IS NOT CLEARED JSB LOOP1 GO TO SERVICE LOOP LDB CNT1 FETCH COUNTS INB WAIT SZB ABOUT JMP *-2 1 MS * * 10 US ONE - SHOT TEST * CLCC1 CLC 0,C SET CARD IN RECEIVING MODE LIA1 LIA 0 x READ A DATA WORD, CLEAR FLAG CLC2 CLC 0 SET CARD IN TRANSMITTING MODE NOP WAIT SFS3 SFS 0 TEST FLAG SET JMP *+3 OK! HLT14 HLT 14B ERROR! FLAG IS SET TOO SOON JSB LOOP1 GO TO SERVICE LOOP LDB CNT2 WAIT INB AT LEAST SZB 10 JMP *-2 US SFS4 SFS 0 TEST FLAG JMP HLT15 JMP *+3 HLT15 HLT 15B ERROR! FLAG IS NOT SET YET JSB LOOP1 GO TO SERVICE LOOP * * INTERRUPT LOGIC TEST * CLC 0,C TURN-OFF INTERRUPT SYSTEM CLCC2 CLC 0,C SET CARD IN RECEIVING MODE LIA2 LIA 0 CLEAR FLAG STCC1 STC 0,C SET CONTROL SFC3 SFC 0 TEST FLAG CLEAR JMP HLT16 JMP *+3 HLT16 HLT 16B ERROR! FLAG IS NOT CLEARED JSB LOOP1 GO TO SERVICE LOOP LDA ERR SET ERROR IN STA ADDR,I TRAP CELL STF 0 TURN-ON INTERRUPT SYSTEM NOP WAIT NOP LDA OK SET OK IN STA ADDR,I TRAP CELL STC1 STC 0 SET CONTROL LDB CNT3 WAIT INB FOR SZB INTERRUPT JMP *-2 NOP HLT0 HLT 0 ERROR! WRONG INTERRUPT JSB LOOP1 GO TO SERVICE LOOP OKXX LDA HLT0 RESTORE IOR ADDR TRAP STA ADDR,I CELL CLF 0 TURN-OFF INTERRUPT SYSTEM * * TRANSMITTER/RECEIVER TEST * CLCC3 CLC 0,C SET CARD IN RECEIVING MODE LIA3 LIA 0 CLEAR FLAG SFC4 SFC 0 TEST FLAG CLEAR JMP HLT17 JMP *+3 HLT17 HLT 17B ERROR! FLAG IS NOT CLEARED JMP LOOP2 GO TO SERVICE LOOP LIAC1 LIA 0,C READ STATUS WORD LIAC2 LIA 0,C READ STATUS WORD * * AFTER READ DATA WORD AND STATUS WORD THE RECEIVER * ENABLED , MISSED WORD, RECEIVER IN PROCESS AND PARITY * FLIP-FLOPS SHOULD ALL BE CLEARED * SLA 2CHECK JMP HLT20 RECEIVER ENABLE JMP *+3 FLIP FLOP HLT20 HLT 20B ERROR! RECEIVER IS DISABLED JSB LOOP2 GO TO SERVICE LOOP SSA CHECK JMP HLT21 PARITY JMP *+3 F/F HLT21 HLT 21B ERROR! PARITY F/F IS SET JSB LOOP2 GO TO SERVICE LOOP RAR,RAR SSA CHECK JMP HLT22 MISSED WORD JMP *+3 F/F HLT22 HLT 22B ERROR! M.W. F/F IS SET JSB LOOP3 GO TO SERVICE LOOP SLA CHECK JMP HLT23 RECEIVER IN PROCESS JMP *+3 F/F HLT23 HLT 23B ERROR! R.I.P. F/F IS SET JSB LOOP2 GO TO SERVICE LOOP * * * TRANSMIT A WORD TO CHECK STATUS BITS, ONLY THE REC. * IN PROCESS F/F SHOULD CHANGE STATE * OTA2 OTA 0 TRANSMIT A WORD ISZ .5WTM WAIT FOR ABOUT JMP *-1 HALF A WORD TIME LIAC3 LIA 0,C READ STATUS SLA CHECK JMP HLT24 REC. JMP *+3 ENA. F/F HLT24 HLT 24B ERROR! RECEIVER IS DISABLED TOO JSB LOOP2 SOON; BIT TIME MAY BE WRONG RAR SLA CHECK JMP HLT25 M.W. F/F JMP *+3 HLT25 HLT 25B ERROR! M.W. F/F SHOULD NOT BE SET JSB LOOP3 GO TO SERVICE LOOP RAR SLA CHECK JMP *+3 R.I.P. F/F HLT26 HLT 26B ERROR! R.I.P. F/F IS NOT SET JSB LOOP2 EITHER F/F OR CLOCK IS BAD ISZ WTM WAIT FOR JMP *-1 ONE COMPLETE WORD TIME SFS5 SFS 0 TEST JMP HLT27 FLAG JMP *+3 SET HLT27 HLT 27B ERROR! FLAG DID NOT SET JSB LOOP2 GO TO SERVICE LOOP * LDA CNT RESTORE STA WTM TIMING LDA .5CNT MULTIPLIERS STA .5WTM * * READ STATUS BEFORE READ DATA, SHOULD FIND THAT * RECEIVER IS DISABLED * LIIAC4 LIA 0,C READ STATUS SLA TEST JMP *+3 R. ENA. F/F HLT30 HLT 30B ERROR! RECEIVER IS NOT DISABLED JSB LOOP2 GO TO SERVICE LOOP * * TRANSMIT ANOTHER WORD WOULD CAUSE M.W. F/F TO BE SET * OTA3 OTA 0 TRANSMIT ANOTHER WORD LDB CNT1 FETCH COUNTS FOR DELAY INB WAIT SZB ABOUT JMP *-2 1 MS LIAC5 LIA 0,C READ STATUS WORD AGAIN SLA CHECK JMP *+3 R.ENA. F/F HLT31 HLT 31B ERROR! RECEIVER IS NOT DISABLED JSB LOOP3 GO TO SERVICE LOOP RAR SLA CHECK M.W. F/F JMP *+3 OK! HLT32 HLT 32B ERROR! M.W. F/F IS NOT SET JSB LOOP3 GO TO SERVICE LOOP LIAC6 LIA 0,C READ STATUS AGAIN * * SHOULD CLEAR M.W. F/F,R.D. F/F REMAIN SET AND FLAG SET * SLA CHECK JMP *+3 R. ENA. F/F HLT33 HLT 33B ERROR! RECEIVER IS NOT DISABLED JSB LOOP2 GO TO SERVICE LOOP RAR SLA CHECK M.W. F/F AGAIN JMP HLT34 JMP *+3 OK! HLT34 HLT 34B ERROR! M.W. F/F IS NOT CLEARED JSB LOOP3 GO TO SERVICE LOOP SFS6 SFS 0 TEST FLAG JMP HLT35 JMP *+3 OK! HLT35 HLT 35B ERROR! FLAG DID NOT STAY SET JSB LOOP2 GO TO SERVICE LOOP * * READ DATA WORD SHOULD CLEAR FLAG , THEN READ STATUS * SHOULD CLEAR ALL FOUR STATUS BITS * LIA4 LIA 0 READ DATA WORD SFC5 SFC 0 TEST FLAG CLEAR JMP HLT36 JMP *+3 OK! HLT36 HLT 36B ERROR! FLAG DID NOT CLEAR JSB LOOP2 GO TO SERVICE LOOP LIAC7 LIA 0,C READ STATUS WORD SSA CHECK PARITY F/F JMP HLT37 JMP *+3 OK! HLT37 HLT 37B ERROR! PARITY F/F IS SET JSB LOOP2 GO TO SERVICE LOOP SLA CHECK R. ENA. F/F JMP HLT40 JMP *+3 OK! HLT40 HLT 40B 1 ERROR! RECEIVER IS NOT ENABLED JSB LOOP2 GO TO SERVICE LOOP RAR,RAR SSA JMP HLT41 JMP *+3 OK! HLT41 HLT 41B ERROR! M.W. F/F IS NOT CLEARED JSB LOOP3 GO TO SERVICE LOOP SLA CHECK I.P. F/F JMP HLT42 JMP *+3 HLT42 HLT 42B ERROR! I.P. F/F IS SET JSB LOOP2 * * THE FOLLOWING SUBROUTINE IS DESIGNED TO TEST * BLOCK TRANSMITTING AND RECEIVING WITH 1'S AND * 0'S PROPAGATING THROUGH THE TRANSMISSION WORDS * LDB CNT4 STB CNT5 SET COUNTER CLC3 CLC 0 SET CARD IN TRANSMIT MODE LDA ADATA STA IDATA SET START ADDRESS OF DATA BLOCK PLOOP NOP LDA IDATA,I LOAD DATA OTA4 OTA 0 TRANSMIT DATA LDB CNT1 INB WAIT SZB ABOUT JMP *-2 1 MS LIA5 LIA 0 READ DATA WORD STA TEMP0 LIBC1 LIB 0,C READ STATUS WORD SSB CHECK PARITY BIT JMP HLT43 JMP *+3 OK! HLT43 HLT 43B ERROR! PARITY F/F JSB LOOP2 GO TO SERVICE LOOP LDB A2570 READ 2570 INDICATOR SLB JMP P1 YES, CARD IS WIRED FOR 2570 CMA,INA ADA IDATA,I ADD ORIGINAL DATA TO THE COMPLE- * MENT OF THE RECEIVED DATA JMP P2 P1 NOP LDA IDATA,I LOAD ORIGINAL DATA AND M3777 MASK OFF THE UNWANTED BITS ALF SHIFT RAL 5 BITS LEFT STA TEMP1 SAVE LDA TEMP0 LOAD THE RECEIVED DATA CMA,INA CHANGE TO NEGATIVE NUMBER ADA TEMP1 ADD TO THE TRANSMITTED DATA P2 SZA TEST RESULT JMP *+2 JMP *+3 HLT44 HLT 44B ERROR! SUM IS NOT ZERO JSB LOOP2 LDA IDATA LOAD THE ADDRESS OF DATA INA INCREMENT ONE STA IDATA RESTORE THE CURRENT ADDRESS ISZ CNT5 INCREMENT ADDRESS COUNTER, TEST JMP PLOOP GO BACK TO TRANSMIT NEXT WORD LDA ADMA FETCH DMA INDICATOR SLA CHECK TO SEE IF DMAT IS NEEDED JSB DMAT GO ON TO TEST DMA IN AND OUT HLT 77B TEST COMPLETION JSB PARIT CHECK PARITY LOGIC JMP ITEST+1 HED 12665 DIAGNOSTIC PROGRAM -- ROUTINES AND SERVICE LOOPS * PREPARE WORD TIME MULTIPLIER * WDTMM NOP LDB CTYPE CPB A3 JMP P1415 CPB M1 JMP P0016 CPB A2 JMP P0016 CPB A4 JMP PMX CPB A5 JMP PXE JMP HLT1 UNRECOGNIZABLE COMPUTER TYPE P0016 LDA A2570 CHECK 2570 INDICATOR LDB A4 FETCH A4 SLA LDB A3 FETCH A3 JMP P3 P1415 LDA A2570 FETCH 2570 INDICATOR LDB A3 FETCH A3 SLA LDB A2 FETCH A2 JMP P3 PXE LDA A2570 FETCH 2570 INDICATOR LDB A9 SLA LDB A7 LDA DM4 STA CNT2 LDA DM5 STA CNT3 LDA DM300 STA CNT1 JMP P4 PMX LDA A2570 FETCH 2570 INDICATOR LDB A5 NO, FETCH A5 SLA LDB A4 FETCH A4 P3 LDA DM2 STA CNT2 LDA DM3 STA CNT3 LDA DM160 STA CNT1 P4 STB MPLR SET BASIC MULTIPLIER LDA BLNG LOAD BIT LENGTH INFORMATION ADA M6 SSA,RSS CHECK FOR ILLEGAL BIT LENGTH JMP HLT3 YES LDA BLNG NO, LOAD BIT LENGTH INFORMATION CMA,RSS BLS CHECK BITS AND DOUBLE COUNTER INA,SZA JMP *-2 P7 CMB,INB CHANGE TO NEGATIVE NUMBER STB CNT FINAL WORD TIME MULTIPLIER STB WTM BRS STB .5CNT HALF WORD TIME MULTIPLIER STB .5WTM JMP *+3 HLT3 HLT 3 JMP START RECONFIGURE JMP WDTMM,I RETURN TO MAIN PROGRAM * * DMA TEST ROUTINE * DMAT NOP DMA OUTPUT LDA ADDR PREPARE OT Y640A 6 CLC 2 DMA LDA CW2 OTA 2 TO STC 2 LDA CW3 OUTPUT A WORD OTA 2 CLCC4 CLC 0,C SET CARD IN RECEIVING MODE LIA6 LIA 0 CLEAR THE FLAG OF 12665 STC 6B,C ACTIVATE DMA OTA5 OTA 0 SET THE FLAG, CARD IS ACTIVATED NOP WAIT NOP FOR FLAG TO BE CLEARED SFS7 SFS 0 TEST FLAG JMP *+3 HLT45 HLT 45B ERROR! FLAG SHOULD BE CLEARED JSB LOOP5 GO TO DMA OUTPUT SERVICE LOOP LDB CNT1 BLS INB WAIT SZB ABOUT JMP *-2 2 MS CLC 6,C SFC6 SFC 0 TEST FLAG JMP *+3 HLT46 HLT 46B ERROR! FLAG IS NOT SET JSB LOOP5 GO TO SERVICE LOOP LIAC8 LIA 0,C READ STATUS SLA TEST R. ENA. F/F JMP *+3 HLT47 HLT 47B ERROR! R. ENA.F/F IS NOT SET JSB LOOP5 AND M1006 SZA TEST FOR ZERO JMP *+2 JMP *+3 HLT50 HLT 50B ERROR! JSB LOOP5 LIA7 LIA 0 READ DATA STA RWDA SAVE CMA,INA CONVERT TO NEGATIVE NUMBER ADA WDA ADD TO THE WORD TRANSMITTED BY DMA SZA CHECK JMP *+2 NO JMP *+3 OK HLT51 HLT 51B ERROR! WORD RECEIVED IS ERRONEOUS JSB LOOP5 GO TO DMA OUTPUT SERVICE LOOP * * END OF TAPE 29005-80001 * CONTINUATION OF PROGRAM ON TAPE 29005-80002 * 6  29005-80002 1636 S 0122 12665 DIAGNOSTIC              H0101 * * 12665 DIAGNOSTIC PROGRAM * SOURCE TAPE 29005-80002 DATE CODE 1636 * CONTINUATION OF TAPE 29005-80001 * DMA INPUT * CLCC5 CLC 0,C SET CARD IN RECEIVING MODE LIA8 LIA 0 READ DATA LIAC9 LIA 0,C READ STATUS LDA ADDR PREPARE OTA 6 CLC 2 DMA LDA CW5 OTA 2 TO STC 2 LDA CW6 INPUT A WORD OTA 2 STC 6,C ACTIVATE DMA LDA A550 OTA6 OTA 0 OUTPUT THE WORD LDB CNT1 INB WAIT SZB ABOUT JMP *-2 1 MS OTA7 OTA 0 OUTPUT THE SAME WORD AGAIN LDB CNT1 INB WAIT SZB ABOUT JMP *-2 1 MS CLC 6,C TURN OFF DMA LDA RA550 FETCH THE RECEIVED DATA AND M1007 SZA CHECK FOR ZERO JMP *+2 JMP *+3 HLT52 HLT 52B ERROR! JSB LOOP6 GO TO DMA INPUTTING SERVICE LOOP LDA RA550 CHECK CMA,INA THE VALUE ADA A550 OF SZA THE JMP *+2 RECEIVED JMP *+3 WORD HLT53 HLT 53B ERROR! RECEIVED A WRONG WORD JSB LOOP6 GO TO DMA INPUT SERVICE LOOP JMP DMAT,I RETURN TO MAIN PROGRAM * * TRANSMIT MODE SCOPE SERVICE LOOP FOR FLAG AND * INTERRUPT LOGIC * LOOP1 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP? JMP ENDL1 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM CLCC6 CLC 0,C SET CARD TO RECEIVING MODE LIA9 LIA 0 CLEAR DATA WORD LAC10 LIA 0,C CLEAR STATUS WORD CLA STA ADDR,I NOP IN TRAD CELL CLC 0 GENERATE CRS FOR SYNC STCC2 STC 0,C TOGGLE IRQ CONTROL F/F, CLCC7 CLC 0,C NO CHANGE TO FLAG MODE F/F STC2 STC 0 SET CARD TO TRANSMIT MODE SFC7 SFC 0 NOP ISZ [WTM WAIT FOR JMP *-1 FLAG TO BE SET LDB CNT STB WTM RESTORE WORD TIME COUNTS STF 0 TURN ON INTERRUPT SYSTEM NOP IAK SHOULD BE GENERATED, * FLAG BUFFER F/F CLEARED CLC4 CLC 0 SET CARD TO TRANSMIT MODE SFS8 SFS 0 NOP LDB CNT3 INB WAIT SZB FOR FLAG JMP *-2 FLAG BUFFER F/F SHOULD BE SET OTA8 OTA 0 SHOULD CLEAR FLAG AND FLAG BUFFER F/F CLF 0 TURN OFF INTERRUPT SYSTEM ISZ WTM WAIT FOR JMP *-1 ONE WORD TIME LDB CNT STB WTM RESTORE WORD TIME COUNT STCC3 STC 0,C SET CARD TO RECEIVE MODE LAC11 LIA 0,C LIA10 LIA 0 CLEAR DATA WORD JMP LOOP1+10 ENDL1 JMP LOOP1,I RETURN TO MAIN PROGRAM * * RECEIVE MODE SCOPE SERVICE LOOP * LOOP2 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP? JMP ENDL2 YES CLC 0,C TURN OFF INTERRUPT SYSTEM CLCC8 CLC 0,C SET CARD TO RECEIVE MODE LIA11 LIA 0 LAC12 LIA 0,C CLEAR STATUS WORD CLC 0 GENERATE CRS FOR SCOPE SYNC CLCC9 CLC 0,C SET CARD TO RECEIVE MODE ,FLAG STCC4 STC 0,C SET TO RECEIVE MODE ,INTERRUPT CLA OTA9 OTA 0 OUTPUT A WORD ISZ WTM JMP *-1 WAIT LDB CNT STB WTM RESTORE COUNTS LIBC2 LIB 0,C READ STATUS WORD INTO B LIB1 LIB 0 READ DATA WORD INTO B INA OTA10 OTA 0 OUTPUT A WORD AGAIN ISZ WTM WAIT JMP *-1 LDB CNT STB WTM RESTORE COUNTS LAC13 LIA 0,C READ STATUS WORD LIA12 LIA 0 CLEAR DATA WORD JMP LOOP2+8 ENDL2 JMP LOOP2,I RETURN TO MAIN PROGRAM * * MISSED WORD SCOPE SERVICE LOOP * LOOP3 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP SCOPE LOOP? JMP ENDL03 YES CLC 0,C TURN-OFF INTERRUPT SYSTEM CCC10 CLC 0,C SET CARD TO RECEIVE MODE LIA13 LIA 0 READ DATA WORD LAC14 LIA 0,C READ STATUS WORD CLC 0 GENERATE CRS TO SYNC OTA11 OTA 0 OUTPUT A WORD ISZ WTM WAIT JMP *-1 LDB CNT STB WTM RESTORE COUNTS LAC15 LIA 0,C CLEAR STATUS WORD CLA OTA12 OTA 0 OUTPUT THE COMPLEMENTARY WORD ISZ WTM WAIT JMP *-1 LDB CNT STB WTM RESTORE COUNTS LAC16 LIA 0,C READ STATUS WORD LIA14 LIA 0 READ DATA WORD JMP LOOP3+8 ENDL3 JMP LOOP3,I RETURN TO MAIN PROGRAM * * PARITY ERROR SCOPE SERVICE LOOP * LOOP4 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP THE SERVICE LOOP? JMP ENDL4 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM LIA15 LIA 0 CLEAR DATA WORD LAC17 LIA 0,C CLC 0 GENERATE CRS FOR SYNC CLA CLEAR A OTA13 OTA 0 OUTPUT A WORD SFS9 SFS 0 TEST FLAG JMP *-1 WAIT FOR FLAG TO BE CLEAR LIB2 LIB 0 READ DATA LIBC3 LIB 0,C READ STATUS INA INCREMENT A OTA14 OTA 0 OUTPUT A AGAIN SFS10 SFS 0 TEST FLAG JMP *-1 WAIT FOR FLAG TO BE CLEARED LIB3 LIB 0 CLEAR DATA WORD LIBC4 LIB 0,C READ STATUS WORD JMP LOOP4+7 ENDL4 JMP LOOP4,I RETURN TO MAIN PROGRAM * * DMA OUTPUT SCOPE SERVICE LOOP * LOOP5 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP SERVICE LOOP? JMP ENDL5 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM CCC11 CLC 0,C SET CARD TO RECEIVE MODE LIA16 LIA 0 LAC18 LIA 0,C CLEAR STATUS WORD LDA CCW1 PREPARE OTA 6 CLC 2 DMA LDA CW8 OTA 2 TO OUTPUT STC 2 LDA CW9 TWO WORDS OTA 2 U STC 6,C ACTIVATE DMA CLC5 CLC 0 SET CARD TO TRANSMIT MODE LDA CNT WAIT ALS ADA CNT FOR STA WTM ISZ WTM THREE JMP *-1 LDA CNT WORD TIMES STA WTM CLC 6 TURN OFF DMA JMP LOOP5+4 LOOP BACK ENDL5 JMP LOOP5,I * * DMA INPUT SCOPE SERVICE LOOP * LOOP6 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP SERVICE LOOP? JMP ENDL6 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM CCC12 CLC 0,C SET CARD IN RECEIVE MODE LIA17 LIA 0 CLEAR DATA WORD LAC19 LIA 0,C CLEAR STATUS WORD LDA ADDR PREPARE OTA 6 CLC 2 DMA TO LDA CW11 OTA 2 INPUT STC 2 LDA CW12 A WORD OTA 2 STC 6,C ACTIVATE DMA CLA OTA15 OTA 0 OUTPUT A WORD ISZ WTM WAIT ONE JMP *-1 WORD TIME LDB CNT STB WTM RESTORE WORD TIME COUNTS. CLC 6 TURN OFF DMA JMP LOOP6+4 LOOP BACK ENDL6 JMP LOOP6,I RETURN TO MAIN PROGRAM * * ADDRESS INCLISION ROUTINE FOR CONFIGURING ALL * INSTRUCTIONS AND DMA CONTROL WORDS REQUIRING * THE CARD ADDRESS. * ADIN NOP CLC 0,C * PUT CARD ADDRESS INTO SFS INSTRUCTION JSB INCLU SFS 0 STA SFS1 STA SFS2 STA SFS3 STA SFS4 STA SFS5 STA SFS6 STA SFS7 STA SFS8 STA SFS9 STA SFS10 STA SFSI1,I STA SFSI2,I STA SFS13 * PUT CARD ADDRESS INTO SFC INSTRUCTION JSB INCLU SFC 0 STA SFC1 STA SFC2 STA SFC3 STA SFC4 STA SFC5 STA SFC6 STA SFC7 * PUT CARD ADDRESS INTO CLC INSTRUCTION JSB INCLU CLC 0 STA CLC1 STA CLC2 STA CLC3 STA CLC4 STA CLC5 * ! PUT CARD ADDRESS INTO CLC CLEAR FLAG INSTRUCTION JSB INCLU CLC 0,C STA CLCC1 STA CLCC2 STA CLCC3 STA CLCC4 STA CLCC5 STA CLCC6 STA CLCC7 STA CLCC8 STA CLCC9 STA CCC10 STA CCC11 STA CCC12 STA CCCI1,I STA CCCI2,I STA CCC15 * PUT CARD ADDRESS INTO STC INSTRUCTION JSB INCLU STC 0 STA STC1 STA STC2 * PUT CARD ADDRESS INTO STC CLEAR FLAG INSTRUCTION JSB INCLU STC 0,C STA STCC1 STA STCC2 STA STCC3 STA STCC4 * PUT CARD ADDRESS INTO OTA INSTRUCTION JSB INCLU OTA 0 STA OTA1 STA OTA2 STA OTA3 STA OTA4 STA OTA5 STA OTA6 STA OTA7 STA OTA8 STA OTA9 STA OTA10 STA OTA11 STA OTA12 STA OTA13 STA OTA14 STA OTA15 STA OTAI1,I STA OTAI2,I STA OTA18 * PUT CARD ADDRESS INTO LIA INSTRUCTION JSB INCLU LIA 0 STA LIA1 STA LIA2 STA LIA3 STA LIA4 STA LIA5 STA LIA6 STA LIA7 STA LIA8 STA LIA9 STA LIA10 STA LIA11 STA LIA12 STA LIA13 STA LIA14 STA LIA15 STA LIA16 STA LIA17 STA LIAI1,I STA LIAI2,I STA LIAI3,I STA LIA21 * PUT CARD ADDRESS INTO LIA CLEAR FLAG INSTRUCTION JSB INCLU LIA 0,C STA LIAC1 STA LIAC2 STA LIAC3 STA LIAC4 STA LIAC5 STA LIAC6 STA LIAC7 STA LIAC8 STA LIAC9 STA LAC10 STA LAC11 STA LAC12 STA LAC13 STA LAC14 STA LAC15 STA LAC16 STA LAC17 STA LAC18 STA LAC19 STA LACI1,I STA LACI2,I STA LAC22 * PUT CARD ADDRESS INTO LIB INSTRUCTION JSB INCLU LIB 0 STA sLIB1 STA LIB2 STA LIB3 STA LIBI1,I STA LIB5 * PUT CARD ADDRESS INTO LIB , CLF INSTRUCTION JSB INCLU LIB 0,C STA LIBC1 STA LIBC2 STA LIBC3 STA LIBC4 STA LBCI1,I STA LIBC6 * PUT CARD ADDRESS INTO OCTAL NUMBER 20000 JSB INCLU OCT 20000 STA CCW1 CONFIGURED FOR LOOP5 JMP ADIN,I RETURN TO MAIN PROGRAM * * INCLUSION ROUTINE * INCLU NOP LDA INCLU,I IOR ADDR ISZ INCLU JMP INCLU,I * * PARITY TEST ROUTING * PARIT NOP CLC 0,C TURN OFF INTERRUPT SYSTEM CCC15 CLC 0,C SET CARD IN RECEIVE MODE LIA21 LIA 0 CLEAR DATA LAC22 LIA 0,C CLEAR STATUS CLA OTA18 OTA 0 OUTPUT 0 SFS13 SFS 0 WAIT FOR THE JMP *-1 WORD TRANS. TO COMPLETE LIB5 LIB 0 READ DATA INTO B REG. LIBC6 LIB 0,C READ STATUS INTO B REGISTER SSB TEST PARITY BIT TO BE SET JMP *+3 HLT54 HLT 54B ERROR! PARITY BIT IS NOT SET JSB LOOP4 GO TO SERVICE LOOP HLT 76B PARITY LOGIC WORKED FINE JMP PARIT,I RETURN TO MAIN PROGRAM HED 12665 DIAGNOSTIC PROGRAM -- COMPUTER TO COMPUTER TEST * THE FOLLOWING SUBROUTINE IS DESIGNED TO CHECK THE * CARD TIED TO ANOTHER COMPUTER THROUGH A CABLE. IT * REQUIRES DIAGNOSTIC PROGRAM TO BE LOADED AND THE BASIC * TESTS BE EXECUTED ONCE IN EACH COMPUTER. THEN LOAD * ADDRESS 4000B INTO THE ORIGINATING COMPUTER AND * ADDRESS 5000B INTO THE RESPONDING COMPUTER * * COMMANDING ROUTINE * ORG 4000B STARTING ADDRESS OF ORIGINATING COMPUTER COMMD NOP CLC 0,C CCC13 CLC 0,C SET CARD IN RECEIVE MODE LIA18 LIA 0 CLEAR DATA WORD LAC20 LIA 0,C CLEAR STATUS WORD CLA INA OTA16 OTA 0 OUTPUT THE WORD IN A REG. OTA 1 STA TEMP0 SAVE THE WORD SFS11 SFS 0 WAIT FOR THE C8OMMUNICATION WORD JMP *-1 TO BE RECEIVED LIB4 LIB 0 READ DATA WORD STB TEMP1 SAVE THE RECEIVED WORD CPB TEMP0 CHECK THE RECEIVED WORD JMP *+2 OK! HLT70 HLT 70B ERROR! RECEIVED A WRONG WORD LIBC5 LIB 0,C READ STATUS WORD LDB CNT6 SET SKIPPING COUNTS INB INA,SZA CHECK FOR A REG. TO BE ZERO JMP *+2 NO! A IS NOT ZERO JMP EOL YES! A IS ZERO SZB CHECK B REG. FOR ZERO JMP *-5 NO! DO NOT SEND THE NEXT WORD YET JMP OTA16 SEND THE NEXT WORD EOL NOP HLT 77B JMP COMMD+1 * * RESPONDING ROUTING * ORG 5000B STARTING ADDRESS OF THE RESPONDING COMPUTER RESPN NOP CLC 0,C CCC14 CLC 0,C SET CARD TO RECEIVE MODE LIA19 LIA 0 CLEAR DATA WORD LAC21 LIA 0,C CLEAR STATUS WORD SFS12 SFS 0 WAIT FOR COMMUNICATION WORD JMP *-1 TO BE RECEIVED LIA20 LIA 0 READ DATA WORD OTA17 OTA 0 RETRANSMIT THE RECEIVED WORD OTA 1 JMP SFS12 HED 12665 DIAGNOSTIC PROGRAM -- CONSTANTS ORG 300B A2 OCT 2 A3 OCT 3 A4 OCT 4 A5 OCT 5 A7 OCT 7 A9 OCT 11 A550 OCT 550 A2570 OCT 0 ADATA DEF DATA ADDR OCT 0 ADMA OCT 0 BLNG OCT 0 CNT OCT 0 .5CNT OCT 0 CNT1 NOP CNT2 NOP CNT3 NOP CNT4 OCT -21 CNT5 OCT 0 CNT6 OCT -1 DM2 DEC -2 DM3 DEC -3 DM4 DEC -4 DM5 DEC -5 DM160 DEC -160 DM300 DEC -300 CTYPE OCT 0 CCW1 OCT 0 CW2 OCT 112 CW3 OCT -1 CW5 OCT 100113 CW6 OCT -2 CW8 OCT 114 CW9 OCT -2 CW11 OCT 100116 CW12 OCT -2 DATA OCT 0,1,3,7,17,37,77,177,377,777,1777,3777 OCT 7777,17777,37777,77777,177777 DIAGW OCT 0 ERR JMP ERRX,I HI HLT 10B HIS STA 10B IDATA DEF DATA M1 OCT 1 M3 OCT 3 M6 DEC -6 M7 OCT 7 M67 OCT -67 M70 OCT 70 M77 OCT 77 M3777 OCT 3777 M1006 OCT 100006 M1007 OCT 100007 MP 0.*LR OCT 0 OK JMP OKX,I RWDA OCT 0 TEMP0 OCT 0 TEMP1 OCT 0 WTM OCT 0 .5WTM OCT 0 ORG 112B WDA OCT 155555 ORG 113B RA550 OCT 0 ORG 115B WDB OCT 0 WDC OCT 0 ORG 117B RAWD OCT 0 ORG 111B OK INTERRUPT LINKAGE OKX DEF OKXX ORG 120B ERROR INTERRUPT LINKAGE ERRX DEF HLT0 SFSI1 DEF SFS11 SFSI2 DEF SFS12 CCCI1 DEF CCC13 CCCI2 DEF CCC14 OTAI1 DEF OTA16 OTAI2 DEF OTA17 LIAI1 DEF LIA18 LIAI2 DEF LIA19 LIAI3 DEF LIA20 LACI1 DEF LAC20 LACI2 DEF LAC21 LIBI1 DEF LIB4 LBCI1 DEF LIBC5 END $END 0  29005-80002 1636 S 0122 12665 DIAGNOSTIC              H0101 * * 12665 DIAGNOSTIC PROGRAM * SOURCE TAPE 29005-80002 DATE CODE 1636 * CONTINUATION OF TAPE 29005-80001 * DMA INPUT * CLCC5 CLC 0,C SET CARD IN RECEIVING MODE LIA8 LIA 0 READ DATA LIAC9 LIA 0,C READ STATUS LDA ADDR PREPARE OTA 6 CLC 2 DMA LDA CW5 OTA 2 TO STC 2 LDA CW6 INPUT A WORD OTA 2 STC 6,C ACTIVATE DMA LDA A550 OTA6 OTA 0 OUTPUT THE WORD LDB CNT1 INB WAIT SZB ABOUT JMP *-2 1 MS OTA7 OTA 0 OUTPUT THE SAME WORD AGAIN LDB CNT1 INB WAIT SZB ABOUT JMP *-2 1 MS CLC 6,C TURN OFF DMA LDA RA550 FETCH THE RECEIVED DATA AND M1007 SZA CHECK FOR ZERO JMP *+2 JMP *+3 HLT52 HLT 52B ERROR! JSB LOOP6 GO TO DMA INPUTTING SERVICE LOOP LDA RA550 CHECK CMA,INA THE VALUE ADA A550 OF SZA THE JMP *+2 RECEIVED JMP *+3 WORD HLT53 HLT 53B ERROR! RECEIVED A WRONG WORD JSB LOOP6 GO TO DMA INPUT SERVICE LOOP JMP DMAT,I RETURN TO MAIN PROGRAM * * TRANSMIT MODE SCOPE SERVICE LOOP FOR FLAG AND * INTERRUPT LOGIC * LOOP1 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP? JMP ENDL1 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM CLCC6 CLC 0,C SET CARD TO RECEIVING MODE LIA9 LIA 0 CLEAR DATA WORD LAC10 LIA 0,C CLEAR STATUS WORD CLA STA ADDR,I NOP IN TRAD CELL CLC 0 GENERATE CRS FOR SYNC STCC2 STC 0,C TOGGLE IRQ CONTROL F/F, CLCC7 CLC 0,C NO CHANGE TO FLAG MODE F/F STC2 STC 0 SET CARD TO TRANSMIT MODE SFC7 SFC 0 NOP ISZ [WTM WAIT FOR JMP *-1 FLAG TO BE SET LDB CNT STB WTM RESTORE WORD TIME COUNTS STF 0 TURN ON INTERRUPT SYSTEM NOP IAK SHOULD BE GENERATED, * FLAG BUFFER F/F CLEARED CLC4 CLC 0 SET CARD TO TRANSMIT MODE SFS8 SFS 0 NOP LDB CNT3 INB WAIT SZB FOR FLAG JMP *-2 FLAG BUFFER F/F SHOULD BE SET OTA8 OTA 0 SHOULD CLEAR FLAG AND FLAG BUFFER F/F CLF 0 TURN OFF INTERRUPT SYSTEM ISZ WTM WAIT FOR JMP *-1 ONE WORD TIME LDB CNT STB WTM RESTORE WORD TIME COUNT STCC3 STC 0,C SET CARD TO RECEIVE MODE LAC11 LIA 0,C LIA10 LIA 0 CLEAR DATA WORD JMP LOOP1+10 ENDL1 JMP LOOP1,I RETURN TO MAIN PROGRAM * * RECEIVE MODE SCOPE SERVICE LOOP * LOOP2 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP? JMP ENDL2 YES CLC 0,C TURN OFF INTERRUPT SYSTEM CLCC8 CLC 0,C SET CARD TO RECEIVE MODE LIA11 LIA 0 LAC12 LIA 0,C CLEAR STATUS WORD CLC 0 GENERATE CRS FOR SCOPE SYNC CLCC9 CLC 0,C SET CARD TO RECEIVE MODE ,FLAG STCC4 STC 0,C SET TO RECEIVE MODE ,INTERRUPT CLA OTA9 OTA 0 OUTPUT A WORD ISZ WTM JMP *-1 WAIT LDB CNT STB WTM RESTORE COUNTS LIBC2 LIB 0,C READ STATUS WORD INTO B LIB1 LIB 0 READ DATA WORD INTO B INA OTA10 OTA 0 OUTPUT A WORD AGAIN ISZ WTM WAIT JMP *-1 LDB CNT STB WTM RESTORE COUNTS LAC13 LIA 0,C READ STATUS WORD LIA12 LIA 0 CLEAR DATA WORD JMP LOOP2+8 ENDL2 JMP LOOP2,I RETURN TO MAIN PROGRAM * * MISSED WORD SCOPE SERVICE LOOP * LOOP3 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP SCOPE LOOP? JMP ENDL03 YES CLC 0,C TURN-OFF INTERRUPT SYSTEM CCC10 CLC 0,C SET CARD TO RECEIVE MODE LIA13 LIA 0 READ DATA WORD LAC14 LIA 0,C READ STATUS WORD CLC 0 GENERATE CRS TO SYNC OTA11 OTA 0 OUTPUT A WORD ISZ WTM WAIT JMP *-1 LDB CNT STB WTM RESTORE COUNTS LAC15 LIA 0,C CLEAR STATUS WORD CLA OTA12 OTA 0 OUTPUT THE COMPLEMENTARY WORD ISZ WTM WAIT JMP *-1 LDB CNT STB WTM RESTORE COUNTS LAC16 LIA 0,C READ STATUS WORD LIA14 LIA 0 READ DATA WORD JMP LOOP3+8 ENDL3 JMP LOOP3,I RETURN TO MAIN PROGRAM * * PARITY ERROR SCOPE SERVICE LOOP * LOOP4 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP THE SERVICE LOOP? JMP ENDL4 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM LIA15 LIA 0 CLEAR DATA WORD LAC17 LIA 0,C CLC 0 GENERATE CRS FOR SYNC CLA CLEAR A OTA13 OTA 0 OUTPUT A WORD SFS9 SFS 0 TEST FLAG JMP *-1 WAIT FOR FLAG TO BE CLEAR LIB2 LIB 0 READ DATA LIBC3 LIB 0,C READ STATUS INA INCREMENT A OTA14 OTA 0 OUTPUT A AGAIN SFS10 SFS 0 TEST FLAG JMP *-1 WAIT FOR FLAG TO BE CLEARED LIB3 LIB 0 CLEAR DATA WORD LIBC4 LIB 0,C READ STATUS WORD JMP LOOP4+7 ENDL4 JMP LOOP4,I RETURN TO MAIN PROGRAM * * DMA OUTPUT SCOPE SERVICE LOOP * LOOP5 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP SERVICE LOOP? JMP ENDL5 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM CCC11 CLC 0,C SET CARD TO RECEIVE MODE LIA16 LIA 0 LAC18 LIA 0,C CLEAR STATUS WORD LDA CCW1 PREPARE OTA 6 CLC 2 DMA LDA CW8 OTA 2 TO OUTPUT STC 2 LDA CW9 TWO WORDS OTA 2 U STC 6,C ACTIVATE DMA CLC5 CLC 0 SET CARD TO TRANSMIT MODE LDA CNT WAIT ALS ADA CNT FOR STA WTM ISZ WTM THREE JMP *-1 LDA CNT WORD TIMES STA WTM CLC 6 TURN OFF DMA JMP LOOP5+4 LOOP BACK ENDL5 JMP LOOP5,I * * DMA INPUT SCOPE SERVICE LOOP * LOOP6 NOP LIA 1 FETCH A WORD FROM SW. REG. SSA WANT TO SKIP SERVICE LOOP? JMP ENDL6 YES! CLC 0,C TURN OFF INTERRUPT SYSTEM CCC12 CLC 0,C SET CARD IN RECEIVE MODE LIA17 LIA 0 CLEAR DATA WORD LAC19 LIA 0,C CLEAR STATUS WORD LDA ADDR PREPARE OTA 6 CLC 2 DMA TO LDA CW11 OTA 2 INPUT STC 2 LDA CW12 A WORD OTA 2 STC 6,C ACTIVATE DMA CLA OTA15 OTA 0 OUTPUT A WORD ISZ WTM WAIT ONE JMP *-1 WORD TIME LDB CNT STB WTM RESTORE WORD TIME COUNTS. CLC 6 TURN OFF DMA JMP LOOP6+4 LOOP BACK ENDL6 JMP LOOP6,I RETURN TO MAIN PROGRAM * * ADDRESS INCLISION ROUTINE FOR CONFIGURING ALL * INSTRUCTIONS AND DMA CONTROL WORDS REQUIRING * THE CARD ADDRESS. * ADIN NOP CLC 0,C * PUT CARD ADDRESS INTO SFS INSTRUCTION JSB INCLU SFS 0 STA SFS1 STA SFS2 STA SFS3 STA SFS4 STA SFS5 STA SFS6 STA SFS7 STA SFS8 STA SFS9 STA SFS10 STA SFSI1,I STA SFSI2,I STA SFS13 * PUT CARD ADDRESS INTO SFC INSTRUCTION JSB INCLU SFC 0 STA SFC1 STA SFC2 STA SFC3 STA SFC4 STA SFC5 STA SFC6 STA SFC7 * PUT CARD ADDRESS INTO CLC INSTRUCTION JSB INCLU CLC 0 STA CLC1 STA CLC2 STA CLC3 STA CLC4 STA CLC5 * ! PUT CARD ADDRESS INTO CLC CLEAR FLAG INSTRUCTION JSB INCLU CLC 0,C STA CLCC1 STA CLCC2 STA CLCC3 STA CLCC4 STA CLCC5 STA CLCC6 STA CLCC7 STA CLCC8 STA CLCC9 STA CCC10 STA CCC11 STA CCC12 STA CCCI1,I STA CCCI2,I STA CCC15 * PUT CARD ADDRESS INTO STC INSTRUCTION JSB INCLU STC 0 STA STC1 STA STC2 * PUT CARD ADDRESS INTO STC CLEAR FLAG INSTRUCTION JSB INCLU STC 0,C STA STCC1 STA STCC2 STA STCC3 STA STCC4 * PUT CARD ADDRESS INTO OTA INSTRUCTION JSB INCLU OTA 0 STA OTA1 STA OTA2 STA OTA3 STA OTA4 STA OTA5 STA OTA6 STA OTA7 STA OTA8 STA OTA9 STA OTA10 STA OTA11 STA OTA12 STA OTA13 STA OTA14 STA OTA15 STA OTAI1,I STA OTAI2,I STA OTA18 * PUT CARD ADDRESS INTO LIA INSTRUCTION JSB INCLU LIA 0 STA LIA1 STA LIA2 STA LIA3 STA LIA4 STA LIA5 STA LIA6 STA LIA7 STA LIA8 STA LIA9 STA LIA10 STA LIA11 STA LIA12 STA LIA13 STA LIA14 STA LIA15 STA LIA16 STA LIA17 STA LIAI1,I STA LIAI2,I STA LIAI3,I STA LIA21 * PUT CARD ADDRESS INTO LIA CLEAR FLAG INSTRUCTION JSB INCLU LIA 0,C STA LIAC1 STA LIAC2 STA LIAC3 STA LIAC4 STA LIAC5 STA LIAC6 STA LIAC7 STA LIAC8 STA LIAC9 STA LAC10 STA LAC11 STA LAC12 STA LAC13 STA LAC14 STA LAC15 STA LAC16 STA LAC17 STA LAC18 STA LAC19 STA LACI1,I STA LACI2,I STA LAC22 * PUT CARD ADDRESS INTO LIB INSTRUCTION JSB INCLU LIB 0 STA sLIB1 STA LIB2 STA LIB3 STA LIBI1,I STA LIB5 * PUT CARD ADDRESS INTO LIB , CLF INSTRUCTION JSB INCLU LIB 0,C STA LIBC1 STA LIBC2 STA LIBC3 STA LIBC4 STA LBCI1,I STA LIBC6 * PUT CARD ADDRESS INTO OCTAL NUMBER 20000 JSB INCLU OCT 20000 STA CCW1 CONFIGURED FOR LOOP5 JMP ADIN,I RETURN TO MAIN PROGRAM * * INCLUSION ROUTINE * INCLU NOP LDA INCLU,I IOR ADDR ISZ INCLU JMP INCLU,I * * PARITY TEST ROUTING * PARIT NOP CLC 0,C TURN OFF INTERRUPT SYSTEM CCC15 CLC 0,C SET CARD IN RECEIVE MODE LIA21 LIA 0 CLEAR DATA LAC22 LIA 0,C CLEAR STATUS CLA OTA18 OTA 0 OUTPUT 0 SFS13 SFS 0 WAIT FOR THE JMP *-1 WORD TRANS. TO COMPLETE LIB5 LIB 0 READ DATA INTO B REG. LIBC6 LIB 0,C READ STATUS INTO B REGISTER SSB TEST PARITY BIT TO BE SET JMP *+3 HLT54 HLT 54B ERROR! PARITY BIT IS NOT SET JSB LOOP4 GO TO SERVICE LOOP HLT 76B PARITY LOGIC WORKED FINE JMP PARIT,I RETURN TO MAIN PROGRAM HED 12665 DIAGNOSTIC PROGRAM -- COMPUTER TO COMPUTER TEST * THE FOLLOWING SUBROUTINE IS DESIGNED TO CHECK THE * CARD TIED TO ANOTHER COMPUTER THROUGH A CABLE. IT * REQUIRES DIAGNOSTIC PROGRAM TO BE LOADED AND THE BASIC * TESTS BE EXECUTED ONCE IN EACH COMPUTER. THEN LOAD * ADDRESS 4000B INTO THE ORIGINATING COMPUTER AND * ADDRESS 5000B INTO THE RESPONDING COMPUTER * * COMMANDING ROUTINE * ORG 4000B STARTING ADDRESS OF ORIGINATING COMPUTER COMMD NOP CLC 0,C CCC13 CLC 0,C SET CARD IN RECEIVE MODE LIA18 LIA 0 CLEAR DATA WORD LAC20 LIA 0,C CLEAR STATUS WORD CLA INA OTA16 OTA 0 OUTPUT THE WORD IN A REG. OTA 1 STA TEMP0 SAVE THE WORD SFS11 SFS 0 WAIT FOR THE C8OMMUNICATION WORD JMP *-1 TO BE RECEIVED LIB4 LIB 0 READ DATA WORD STB TEMP1 SAVE THE RECEIVED WORD CPB TEMP0 CHECK THE RECEIVED WORD JMP *+2 OK! HLT70 HLT 70B ERROR! RECEIVED A WRONG WORD LIBC5 LIB 0,C READ STATUS WORD LDB CNT6 SET SKIPPING COUNTS INB INA,SZA CHECK FOR A REG. TO BE ZERO JMP *+2 NO! A IS NOT ZERO JMP EOL YES! A IS ZERO SZB CHECK B REG. FOR ZERO JMP *-5 NO! DO NOT SEND THE NEXT WORD YET JMP OTA16 SEND THE NEXT WORD EOL NOP HLT 77B JMP COMMD+1 * * RESPONDING ROUTING * ORG 5000B STARTING ADDRESS OF THE RESPONDING COMPUTER RESPN NOP CLC 0,C CCC14 CLC 0,C SET CARD TO RECEIVE MODE LIA19 LIA 0 CLEAR DATA WORD LAC21 LIA 0,C CLEAR STATUS WORD SFS12 SFS 0 WAIT FOR COMMUNICATION WORD JMP *-1 TO BE RECEIVED LIA20 LIA 0 READ DATA WORD OTA17 OTA 0 RETRANSMIT THE RECEIVED WORD OTA 1 JMP SFS12 HED 12665 DIAGNOSTIC PROGRAM -- CONSTANTS ORG 300B A2 OCT 2 A3 OCT 3 A4 OCT 4 A5 OCT 5 A7 OCT 7 A9 OCT 11 A550 OCT 550 A2570 OCT 0 ADATA DEF DATA ADDR OCT 0 ADMA OCT 0 BLNG OCT 0 CNT OCT 0 .5CNT OCT 0 CNT1 NOP CNT2 NOP CNT3 NOP CNT4 OCT -21 CNT5 OCT 0 CNT6 OCT -1 DM2 DEC -2 DM3 DEC -3 DM4 DEC -4 DM5 DEC -5 DM160 DEC -160 DM300 DEC -300 CTYPE OCT 0 CCW1 OCT 0 CW2 OCT 112 CW3 OCT -1 CW5 OCT 100113 CW6 OCT -2 CW8 OCT 114 CW9 OCT -2 CW11 OCT 100116 CW12 OCT -2 DATA OCT 0,1,3,7,17,37,77,177,377,777,1777,3777 OCT 7777,17777,37777,77777,177777 DIAGW OCT 0 ERR JMP ERRX,I HI HLT 10B HIS STA 10B IDATA DEF DATA M1 OCT 1 M3 OCT 3 M6 DEC -6 M7 OCT 7 M67 OCT -67 M70 OCT 70 M77 OCT 77 M3777 OCT 3777 M1006 OCT 100006 M1007 OCT 100007 MP 0.*LR OCT 0 OK JMP OKX,I RWDA OCT 0 TEMP0 OCT 0 TEMP1 OCT 0 WTM OCT 0 .5WTM OCT 0 ORG 112B WDA OCT 155555 ORG 113B RA550 OCT 0 ORG 115B WDB OCT 0 WDC OCT 0 ORG 117B RAWD OCT 0 ORG 111B OK INTERRUPT LINKAGE OKX DEF OKXX ORG 120B ERROR INTERRUPT LINKAGE ERRX DEF HLT0 SFSI1 DEF SFS11 SFSI2 DEF SFS12 CCCI1 DEF CCC13 CCCI2 DEF CCC14 OTAI1 DEF OTA16 OTAI2 DEF OTA17 LIAI1 DEF LIA18 LIAI2 DEF LIA19 LIAI3 DEF LIA20 LACI1 DEF LAC20 LACI2 DEF LAC21 LIBI1 DEF LIB4 LBCI1 DEF LIBC5 END $END 0  29006-80001 A S 0122 12813 DIAGNOSTIC              H0101 ASMBAB̬ HD3ADAGNSàPGAM--PAN G 3ADAGNSàPGAM AUGUSԠ9 SANGADDSSҠNGUNGPGAM-- SANGADDSS--00B NGUNGHŠPGAM .SAԠAԠADDSS .NHŠSHGSҬSԠSHS0-5ϠHŠ665Aɯ ADDSSANDSHS6-ϠHŠSԠNUMBҠƠHŠ3A. 3.PSSUNANDHŠMPUҠ̠HAԠANDDSPAYAHAԠ0. .AҠHŠSHGS. UNNNGHŠPGAM .GUNDPNHŠ665AANDPSSUN.HŠMPUҠ̠HA ANDDSPAYAHAԠ. .UNGUNDPANDPSSUN.HŠMPUҠ̠HAԠAND DSPAYAHAԠ. 3.GUNDPANDPSSUN.HŠMPUҠ̠HAԠANDDSPAYA HAԠ3. .UNGUNDP 5.PSSUNANDHŠMPUҠ̠HAԠANDDSPAYAHAԠ0. N:HAԠ0SHŠSANSH ƠHŠDAGNSàS SHGSҠPGAMN̠ SHN:SPS-(UNNNGHŠPGAMAŠMD. SHN:DAGNSàUNSNNUUSYƠSHSN. SH0N:DAGNSàPSNAADSԠMHŠSA ƠHŠSԠϠHŠPNԠƠAU. ҠHAS ƠSAŠDDDAGNSàNMAN̠BŠNANDN ϠSUSSVŠHAS.HŠSԠHAԠUSHNHŠҠS DD.BS3-5ƠHŠHAԠAŠHŠMSԠSGNANԠDGԠAND BS0-AŠHŠNԠMSԠSGNANԠDGԠƠA3-DGԠ ANSMSSNNUMB.PUSHUNANDHŠSNDHAԠ̠U.BS 0-ƠHŠHAԠAŠHŠASԠSGNANԠDGԠƠHŠANSMSSN NUMBҠANDBS3-5AŠHŠA̠NUMBҠƠHŠҠYP. ҠNUMBS: .NϠPY .PAYҠNPY 3.NԠPYPY̠BŠNANDN"B"GS. .UNPDPY HD3ADAGNSàPGAM--MANSS PGAMNGUAN MPN G00B MPSA N̠AADSHGS ANDMSKSAŠBS0-5 SAADDҠANDSAVŠN665AADDSS. SBADNADDADDSSϠɯϠNSUNS AADSHGSҬ ANDMSKSAŠBS6-9 AҬAҠGHԠUSYHMAND SAADDҠSAVŠN3AADDSS. SBADNADDADDSSϠ50ANSUNS. DAADD ADA.NAS3A SZAADDSS? MP+N DAADDҠYSSUBAԠN ADA.NAMND50A MP+3ADDSS DAADDҠADDN ADA.PAϠND50AADDSS SAADDҠADDADDSS SBADN3YàNSUN SAԠHԠ0B à0 0à0 BB0 AñA0 AS SAMԠMԠUN AGԠBԲ AҬAҠMSHGS SASSSKPPAYSS? MP0N DAMԠADD ADA.P5ϠM SAMԠUN MP̴ PAYҠUԠS: 0DADAA DB SB NP MP0 נ-50ANMAZDS: HԠB ̱DA DB SB NP MP̱ HD3ADAGNSàPGAM--MANSS SYN-NנS: ̲SBSYN DDBԠS: HԠB 3DADAA DB SB NP MP3 HԠ3B 3ADA DBN SB NP MP3A SBŠUSԠS: ̴SBSYN SBDA SBDñ MP̴ UMPҠײNPSNBS:  5SBSYN DADAA SBN SBDñ MP5 "A"MMANDS: 6SBSYN DAAD DBNSN SB SBDñ MP6 ""MMANDS: ̷SBSYN DAD DBN SB SBDñ MP̷ HD3ADAGNSàPGAM--MANSS SBŠUSԠNABŠSԠ: ̸SBSYN SB SBDñ MP̸ SBY SBDò MP̸ DADAA SBN SBD3 MP̸ SBŠUSԠNABŠSԠ: 9SBSYN SB SBDñ MP9 SB SBDò MP9 SBY SBD3 MP9 SBDA SBDô MP9 DADAA SBN SBD5 MP9 DADAA SBN SBD6 MP9 HD3ADAGNSàPGAM--MANSS VDDPAYS: ̱0SBSYN DADAA3 DBN SB SBDñ MP̱0 DADAA DBN SB SBDò MP̱0 DADAA5 DBN SB SBD3 MP̱0 DAàS50 ANDMSKS5ADN PAMSKS6SԠ5? MP̱0AYS DADAA6N SBN SBDô MP̱0 MP̱ ̱0ADADAA6 DBN SB SBDô MP̱0 ɠANDϠMMANDSANDDAASԠ: ̱SBSYN SB SBDñ MP̱ SB SBDò MP̱ SB SBD3 MP̱ SBDAD SBDô MP̱ HD3ADAGNSàPGAM--MANSS ɠANDϠMMANDSANDDAASԠ: ̱SBSYN & SB SBDñ MP̱ SB SBDò MP̱ SB SBD3 MP̱ DADAA DBDAA SB SBDô MP̱ ɠANDϠMMANDSANDDAASԠ3: ̱3SBSYN SB SBDñ MP̱3 SB SBDò MP̱3 SB SBD3 MP̱3 DADAA DBDAA SB SBDô MP̱3 HD3ADAGNSàPGAM--MANSS KAND̠MMANDSANDDAAS: ̱SBSYN SB SBDñ MP̱ SBK SBDò MP̱ DA DBN SB SBD3 MP̱ DADN DBDN SB SBDô MP̱ DA DBN SB SBD5 MP̱ DAD SBN SBD6 MP̱ SBDA SBD÷ MP̱ KMMANDS: ̱5SBSYN SB SBDñ MP̱5 SBK SBDò MP̱5 SB SBD3 MP̱5 SBDAD SBDô MP̱5 SB SBD5 MP̱5 SBDAD SBD6 MP̱5 HD3ADAGNSàPGAM--MANSS NMMANDS: ̱6SBSYN SB SBDñ MP̱6 SBK SBDò MP̱6 SB SBD3 MP̱6 SBDAD SBDô MP̱6 DAN DBN SB SBD5 MP̱6 SB SBD6 MP̱6 SBDA SBD÷ MP̱6 BMMANDDAAS ̱SBSYN SB SBDñ MP̱ SB SBDò H)MP̱ SBB SBD3 MP̱ SBDAD SBDô MP̱ HD3ADAGNSàPGAM--MANSS BMMANDS: ̱SBSYN SBB SBDñ MP̱ DA DBN SB SBDò MP̱ DA DBN SB SBD3 MP̱ DA DBN SB SBDô MP̱ DA\ DBN SB SBD5 MP̱ DADAA SBN SBD6 MP̱ HD3ADAGNSàPGAM--MANSS נS: ̱9SBSYN SB SBDñ MP̱9 SB SBDò MP̱9 SB SBD3 MP̱9 SBDAD SBDô MP̱9 DA DBDAA SB SBD5 MP̱9 SBDA SBD6 MP̱9 DA DBN SB SBD÷ MP̱9 DMMANDS: ̲0SBSYN SB SBDñ MP̲0 DAD DBN SB SBDò MP̲0 SB SBD3 MP̲0 SB SBDô MP̲0 DADAA SBN SBD5 MP̲0 DASYN DBN SB SBD6 MP̲0 HD3ADAGNSàPGAM--MANSS PNDAGNSàDMNAN AGԠBԱ AҠMSHGS SASSAUMAàSA? MPSAԠN AYSGԠBԲ AҬAҠMSHGS SASKPPAYSS? MPSA+YS MPSAԠN HD3ADAGNSàPGAM--SԠUNS. DUPUԠANDPYҠSԠUNŬPYPD. ҠNP SAB SBB SBPUԠUPUԠD SZSSPYVD? MP+YSHKPAY SBNŠNϬSԠNϠPYҠB SBHAԠPN? MPҬɠYS SBPŠN.PAY? MP+3NϬHKҠԠPY SBHAԠYS.PN? MPҬɠYSUN DABàN SBҠԠPY? MP+3YSUN+ SBHAԠN.PN? MPҬɠYSUN SZMԠBUMPMԠUN SZ SZ MPҬ DUPUԠANDPYҠSԠUNŬNϠPYPD. NNP SAB SBPUԠUPUԠD SZPYVD? MP+N.GDUN+ SBŠYSSԠPYҠB SBHAԠPN? MPNɠYSUN SZM SZNNϬUN+ SZN MPN HD3ADAGNSàPGAM--SԠUNS DUPUԠUN. PUԠNP ŠAҠNϠPYAG DAMŠSԠN SAMҠPYM DABϠGԠD A0A0ANDUPUԠ S0Sà0PYVD? MPA0YS SZMҠN.MŠUP? MPS0N.KPANG ŠYSSԠNϠPYAG MPPUԬɠANDUN A0A0àGԠSAUS B0B0GԠD BƬBƠANDGH BƬBҠUSY MPPUԬ ҠHAԠUN. HAԠNP SBPPNADS? MPHAԬɠYS DAMAŠSA ANDMSKBҠBԬ AƠMPUԠ A̬A̠NB3Ҡ5 SAMPANDSAVŠ DAMAŠSA ANDMSKDMԠSD ҠMPANDM ҠH0SԠ SAH̱+ DAMAŠSA ANDMSKMDMԠMSD AҬAҠGH AҠUSY ҠH0ANDM SAH̱SNDҠHA H̱NPSԠҠHAԬMԠUNԠMSD NPNDҠHAԬMԠUNԠSD SBPPNADS? MPHAԬɠYS H̲SZHA MPHAԬ PNҠUN. PNP AGԠSHGS SAP? SSYS SZPN MPP HD3ADAGNSàPGAM--SԠUNS SԠPYҠPAYҠUN. PŠNP SSASSPAY MPPŬɠNϬUN DAMԠYSGԠMԠUN ҠBANDADD SAMAŠPAYҠB SZPŠANDUN+ MPPŬ SԠҠԠPYUN. ҠNP PBAGɠԠPY? MPҬɠYSUN DAMԠNϬGԠMԠUN ҠB3ADD SAMAŠPAYҠB SZҠANDUN+ MPҬ SԠҠNϠPYҠUN. NŠNP SAMP DAMԠADDNϠPY ҠB3ҠB SAMAŠϠSM DAMPUN MPNŬ SԠҠUNPDPYUN. ŠNP SAMP DAMԠADDPY ҠB5ҠB SAMAŠϠM DAMPUN MPŬ SYNANSMSSNUN. SYNϠNP DASYNUPUԠSYN DBNנANDHK SBҠҠS MPSYN+ҠPUN NP MPSYNϬɠUN HD3ADAGNSàPGAM--SԠUNS àANSMSSNUN. ϠNP DAàUPUԠ DBNנANDHK SBҠҠS MP+PN NP SZϠDϠNԠP SZ MPϬ YàANSMSSNUN. YϠNP DAYàUPUԠY DBNנANDHK SBҠҠS MP+PN NP SZY SZYϠDϠNԠP MPYϬ ϠANSMSSNUN. ϠNP DAϠUPUԠ DBNנANDHK SBҠҠS MP+PN NP SZϠDϠNԠP SZ MPϬ ɠANSMSSNUN. ϠNP DAɠUPUԠ DBNנANDHK SBҠҠS MP+PN NP SZϠDϠNԠP SZ MPϬ HD3ADAGNSàPGAM--SԠUNS KANSMSSNUN. KϠNP DAKUPUԠK DBNנANDHK SBҠҠS MP+PN NP SZK SZK MPKϬɠDϠNԠP BANSMSSNUN. BϠNP DABUPUԠB DBNנANDHK SBҠҠS MP+PN NP SZBϠDϠNԠP SZB MPBϬ DN.ANSMSSNUN. DAϠNP DADAAUPUԠDAA DBNנANDHK SBҠҠS MP+PN NP SZDAϠDϠNԠP SZDA MPDAϬ DN.ANSMSSNUN. DADNP DADAAUPUԠDAA DBDAAANDHK SBҠҠS MP+PN NP SZDADDϠNԠP SZDAD MPDAD HD3ADAGNSàPGAM--SVŠUNS DMNԠANSMSSNUNԠUNS. DñNP DA.N SBD MPDñ DòNP DA.N SBD MPDò D3NP DA.N3 SBD MPD3 DôNP DA.N SBD MPDô D5NP DA.N5 SBD MPD5 D6NP DA.N6 SBD MPD6 D÷NP DA.N SBD MPD÷ DàNP ADAM SAM MPDì ADDSSNUSNUNŠ-665A ADNNP SBNUPUԠADDSS AA0NϠA SAA0 SBNUPUԠADDSS SàSà0NϠSà SAS0 SBNUNϠA AàA0 SAAñ SAA0 SBNUPUԠADDSS BB0NϠB SAB0 SAB SBNUPUԠADDSS àà0àNϠàج SA0 MPADN HD3ADAGNSàPGAM--SVŠUNS ADDSSNUSNUNŠ-3A ADNNP SBNUPUԠADDSS AԠ0NϠA SAAD SBNUPUԠADDSS BԠ0NϠB SAB SBNUPUԠADDSS àԠ03NϠ SA SBNUPUԠADDSS DԠ0NϠD SAD SBNULPUԠADDSS ŠԠ05NϠ SAD SBNUPUԠADDSS ɠԠNϠ SA SBNUPUԠADDSS KԠ3NϠK SAK SBNUPUԠADDSS ̠ԠNϠ SA SBNUPUԠADDSS NԠ6NϠN SAN SBNUPUԠADDSS ϠԠNϠ SA SBNUPUԠADDSS ADDؠNPNϠ AҬA AҬA SA MPADN ADDSSNUSNUNŬ3AYàNSUN ADN3NP SBNUPUԠADDSS YԠ03NϠY SAY MPADN3 NUSNUN NUNP DANUɠGԠNSUN ҠADDҠNUDŠADDSS SZNUUN MPNUɠ+ HD3ADAGNSàPGAM--NSANSANDVAABS ANSMSSNANDPYNSANS. NנԠ00 נԠ60 SYNԠ00 NSNԠ005 NϠԠ60 ADԠ0 BԠ0 àԠ03 YàԠ03 DԠ0 DԠ05 ɠԠ KԠ3 ̠Ԡ NԠ6 ϠԠ Ԡ00 DNŠԠ00 DԠ05 ɠԠ ؠԠ03AADDSS \Ԡ3 DAAԠ5 DAAԠ5 DAA3Ԡ0 DAAԠ3 DAA5Ԡ5 DAA6Ԡ55 DAAԠ5 DAAԠ3 HD3ADAGNSàPGAM--NSANSANDVAABS HҠNSANS. MŠԠ60 00.0MS 6.MS 3.MS B3Ԡ0000 BԠ0000BԠ AGԠ0ҠNDԠϠAGS B3Ԡ60000 B5Ԡ00000 .NԠ .NAԠ60 .NԠ6 .N3Ԡ5 .NԠ .N5Ԡ3 .N6Ԡ .NԠ .NAԠ6@B@<0 .PAԠ0 .P5Ԡ5 H0HԠ0 MSKԠ MSKԠ00 MSKS5Ԡ60SAS3AADDSSNNSUN MSKS6Ԡ0 MSKBԠ60000SASҠBԠNMԠUN MSKDԠSASASԠSGNANԠDGԠƠMԠUN MSKMDԠ0SASMSԠSGNANԠDGԠƠMԠUN VAABS. MAŠNPMԠUNԠANDҠB MҠNPNϠPYM BàNPDϠBŠMPADHPY BϠNPDϠBŠUPU MԠNPMԠUN MPNP ADDҠNP ND B  29007-80001 C S 0122 2313A BCS DRIVER (NON-DMA)D.62             H0101 UASMBҬB̬ HD33A(NN-DMABSDVҠD.6903V. NAMD.6 NԠD.6.6 SPà HSDVҠPASHŠ33ASUBSYSMNHŠBS NVNMN.ԠSADDYM ASSMBYANGUAG.ҠUSŠHANҠAG ҠϠHŠAG̯N-DVҠNAŠUNŠ(ɲ33. HŠASҠAҠANDSAUSAŠSANDADH SAUSBԠ0Ҡ930VADANDBԠҠPA AŠϠAS.SAUSSDYNAMà(BSAND5 ԠDMAYBHBŠSԩ. HŠADA̠SASS(BHHMPؠ930: SB.. ԠSUҠ). THIS REQUEST HAS THE * SPECIAL FORMAT: * * (EQ T7,I) 'CONTAINS A POINTER TO A GROUP OF * 3 OR 4 WORDS CONTAINING THE BUFFER ADDRESS(WORD 1), * LENGTH(WORD 2) AJtND TRACK/SECTOR(WORD 3 OR IF SIGN * BIT IS SET ON WORD 3 THEN IT IS THE SECTOR (THE SIGN * IS STRIPED) AND WORD FOUR IS THE TRACK) ADDRESS FOR * EACH TRANSFER. THE GROUP OF TRANSFER VECTORS IS * OPEN-ENDED AND IS TERMINATED BY A ZERO-WORD. * ALL TRANSFERS ARE MADE BEFORE A COMPLETION * RETURN TO IS MADE. SKP RWSUB NOP READ/WRITE ROUTINE ENTRY * E = 0 WRITE * E = 1 READ * * B = BUFFER ADDRESS * A = -LENGTH IN WORDS * * * STB UBUF SAVE BUFFER ADDRESS. STA LN.N SAVE LENGTH LDB TRACK GET THE TRACK AND BLF,BLF COMBINE WITH ADB UNIT THE UNIT CPB LTRUN SAME AS IN LOCAL BUFFER? LDB BM10 YES; B_-8. LDA HDSC CHECK THE HEAD SECTOR CPA LHDSC SAME AS IN LOCAL BUFFER? INB YES; !_B+1 LDA LN.N UNDER 129 WORDS SEZ,RSS IF WRITE JMP WRT1 GO DO WRITE TESTS * ADA D128 REQUESTED? CPB BM7 ALL CONDITIONS MET? SSA MET? JMP RD2 NO; GO READ * LDA LBUFA YES; SET FOR MOVE CPA UBUF IF DATA IS WANTED IN LOCAL JMP CLE BUFFER CLE AND RETURN * STA LBUFP SET UP FOR LDA LN.N MOVE LDB UBUF JSB MOVE AND MOVE DATA CLE CLE SET E FOR CONTINUATION JMP RWSUB,I RETURN * B40 EQU CLE * * * RD2 LDB UBUF READ; TO LOCAL CPB LBUFA BUFFER? STA LHDSC SHOW LOCAL SECTOR BUFFER ENPTY WRT1 SSB,RSS IF SAME TRACK JMP WRIT DIFFERENT TRACK SKIP * ADA D128 AND REQUEST TO WRITE MORE THAN 128 CLE,SSA,RSS WORDS OR CPB BM7 TO WRITE ON LOCAT SECTOR STB LHDSC YES; SET TO SHOW NONE IN WRIT LDA TRACK SET FOR SEEK JSB SEEK SEEK RECORD w LDB RDCM GET THE READ COMMAND SEZ,CME,RSS READ? LDB WRCM NO - USE WRITE COMMAND ADB UNIT SET UNIT BITS CLCC5 CLC CMND PRESET THE COMMAND CHANNEL OTBC2 OTB CMND SEND COMMAND TO THE CONTROLLER LDB UBUF GET BUFFER ADDRESS SEZ,RSS ADB ADDCM AND SET DIRECTION BIT STFD STF DATA SET UP THE INTERFACE SSB FOR THE STCD1 STC DATA,C TRANSFER LDA DMAC GET THE DMA CONTROL WORD DMASW NOP DMA SWITCH NOP IF CHAN #6 ELSE RSS JMP CHAN6 CHANNEL SIX; GO DO IT. * OTA 7 CHANNEL 7; SEND CONTROL WORD CLC 3 SET FOR BUFFER OTB 3 SEND BUFFER ADDRESS LDA LN.N GET LENGTH STC 3 SET FOR LENGTH OTA 3 SEND IT. STC 7,C START DMA STCC1 STC CMND,C START DISC CLC 7 INHIBIT DMA INTERRUPT JSB WAITI GO WAIT FOR INTERRUPT STF 7 FOURCE DMA COMPLETION LIA 3 SAVE DMA RESIDUE. JMP CHAN7 GO TO DO STATUS * CHAN6 OTA 6 CHANNEL SIX; CLC 2 SAME OTB 2 IDEA LDA LN.N AS STC 2 ABOVE. OTA 2 STC 6,C STCC2 STC CMND,C CLC 6 JSB WAITI STF 6 LIA 2 * CHAN7 JSB STAT DO STATUS JMP WRIT ERROR; RETRY * LDA UBUF WAS XFER TO LOCAL BUFFER CPA LBUFA ? RSS JMP RWSUB,I NO; RETURN * LDA HDSC UPDATE THE STA LHDSC LOCAL BUFFER LDA TRACK GET THE CURRENT TRACK ALF,ALF TO HIGH A ADA UNIT COMBINE WITH UNIT STA LTRUN SET TRACK/UNIT WORD JMP RWSUB,I RETURN * * TRACK NOP DMAC OCT 120000 HDSC NOP LHDSC OCT -1 LTRUN NOP LN.N NOP UBUF NOP RDCM OCT 20000 READ COMMAND WRCM OCT 10000 WRITE COMMAND D128 DEC 128 BM7 OCT -7 * * * SEEK NOP SEEK ROUTINEܻ * 1. SEEK RECORD WHOSE TRACK IS * IN A, UNIT HDSC * 2. KEEP LAST TRACK FLAG AND * DO ADDRESS RECORD IF SAME * TRACK/UNIT. CLCC2 CLC CMND CLEAR COMMAND. OTAD1 OTA DATA SEND CYLINDER NO. STCD2 STC DATA,C TO DATA CARD. LDB UNIT GET THE UNIT ADB LSTB ADD THE LAST SEEK TABLE ADDRESS STB CYL SAVE THE LAST SEEK ADDRESS LDB SEEKC GET THE SEEK COMMAND CPA CYL,I SAME AS LAST TIME? ADB ADDCM YES ADD THE ADDRESS COMMAND BIT ADB UNIT SET UNIT BITS OTBC1 OTB CMND SEND COMMAND STCC3 STC CMND,C START SEEK STA CYL,I SET LAST SEEK FLAG FOR NEXT TIME SWP WAIT SERVAL MORE CYCLES LDB HDSC GET THE HEAD AND SECTOR SFSD1 SFS DATA DATA READY? JMP NRERR NO; TAKE NOT READY EXIT * OTBD1 OTB DATA SEND HEAD/SECTOR INFO STCD3 STC DATA,C TELL CONTROLLER JMP SEEK,I RETURN * SEEKC OCT 30000 SEEK COMMAND LSTB DEF *+1 ADDRESS OF LAST SEEK TABLE OCT -1,-1,-1,-1 CYL NOP ADDRESS OF LAST SEEK FLAG FOR CURRENT UNIT. * * IGNOR STA EQT15,I ZERO TIME OUT JSB STATW DO STATUS JMP IGNO2 IGNOR THE RESULT * * * * * WAITI SUBROUTINE * A: SAVE E * B. IF FIRST EXIT SEND ACCEPT CODE * C. ELSE DO CONTINUATION RETURN * D. ON INTERRUPT SAVE RETURN * ADDRESS * E. NOT INTERRUPT FOR NEXT ENTRY * F. RESTOR E AND RETURN WAITI DEF IGNOR ELB B_E STB MOVE SAVE E CLA SET A FOR OPERATION INITIATED STA RTNCD - SET RETURN CODE TO SHOW COMPLETION AFTER INTERRUPT IGNO2 ISZ C.XX STEP TO CONTINUATION RETURN JMP C.XX,I RETURN TO RTIOC * * * C.XX NOP INTERRUPT ENTRY FROM RTIOC LDB MOVE RESTORE E-REG. ERB JMP WAITI,I RETURN TO CONTINUE PROSSING * RTNCD OCT 4 ADDCM OCT 100000 HEAD NOP UNIT NOP * * * * STATUS CHECK SECTION * STATUS SHOULD BE RETURNED IMMEDIATELY. * IF IT IS NOT A NOT READY RETURN IS MODE * THE ERROR COUNTER IS RESET FOR EACH CORRECT * STATUS. * THE STATUS WORD IN THE E QT IS SET AS FOLLOWS * 0 - ANY ERROR * 1 - DATA ERROR * 2 - SEEK CHECK (ADDRESS A NON-EXISTANT TRACK) * 3 - FLAGGED CYLINDER (3 AND 4 IMPLIES DEFECTIVE) * 4 - ADDRESS ERROR (3 ALONE IMPLIES WRITE PRO.) * 5 - END OF TRACK (DATA TOO LONG) * 6 - NOT READY (POWER, SERVO, MECHANICAL) * * * A WRITE PROTECT OR FLAGED CYLINDER ERROR WILL * FOURCE A PARITY ERROR RETURN * NOT READY WILL FOURCE A NOT READY RETURN * * OVERRUN WILL FORCE THE STATUS ROUTINE TO RETRY * THE TRANSFER AN INFINITE # OF TIMES. * * OTHER ERRORS WILL CAUSE THE STATUS ROUTINE TO * RETRY THE TRANSFER UP TO TEN TIMES. * * STAT NOP STA SEEK SAVE DMA RESIDUE. JSB STATW DO STATUS COMMAND STA STATW SAVE THE STATUS AND B377 MASK TO 8 BITS IOR B IN WITH THE NEW STA EQT5,I SET IT IN THE TABLE. B30 SLA,ALS ANY ERRORS JMP ANALZ YES; GO ANALIZE * LDA SEEK GET DMA RESIDUE AND CME,SZA RETRY IF NONZERO. JMP STAT,I ISZ STAT NO; LDB BM12 STB ERCTR RESET COUNTER RTRY CME JMP STAT,I RETURN * * STATW NOP CORE STAUTUS ROUTINE CLCC3 CLC CMND CLEAR THE CHANNEL STCD4 STC DATA,C SET UP DATA CHANNEL. LDB UNIT SEND DRIVE UNIT LIAC1 LIA CMND GET THE ATTENTION BITS IF ANY SZA,RSS ANY SET ?? JMP OTBC3 NO GO USE THE CURRENT UNIT * CLB YES SET TO FIND IT ULOOP SLA,RAR TEST THE BITS JMP OTBC3 FOUND ONE GO DO IT * INB STEP B AND JMP ULOOP GO TRY AGAIN * OTBC3 OTB CMND TO COMMAND CHANNEL. STCC5 STC CMND,C START STATUS. LDA EQT5,I GET STATUS WORD AND B1774 OUT WITH THE OLD SWP B SAVE IN B(ALSO DELAY). SFSD2 SFS DATA IF NOT BACK JMP NRERR THEN GO TO NOT READY. * LIAD1 LIA DATA GET STATUS. RAL,ARS SET 15 IF 14 IS SET SSA,RSS FIRST STATUS?? JMP STATW,I RETURN TO ANALIZE STATUS * STA LHDSC SHOW NO SECTOR IN CORE LDB I.XX WAS THE DRIVER DOWNED BY US?? SZB,RSS YES IF ZERO SO JMP $UPIO GO UP IT * LDB RTNCD WHO HAS CONTROL? SZB,RSS IGNORE IF C.XX ENTRY JMP IGNO2 ELSE IGNOR THE INTERRUPT * LDA SEEKC ELSE SET UP CONTROLER FOR OTAC2 OTA CMND ANOTHER STATUS STCC6 STC CMND,C AND THEN JMP CLCC3 GO REDO THE STATUS * * ANALZ LDB STATW GET THE SAVED STATUS WORD RBR,BLR CLEAR SIGN AND LEAST BITS CPB B10 IF WRITE PROTECT RSS OR CPB B30 BAD CYLINDER FLAG SET JMP PARER ISSUE PARITY ERROR * LSR 6 IF NOT SLB,RBR READY? JMP NRERR ISSUE NOT READY ERROR. * * * IT MAY BE POSSIBLE TO RECOVER * SO RETRY * * ALF,SLA IF STILL SEEKING JMP SKCK1 GO WAIT FOR ATTENTION * CPB B100 IF OVERRUN, THEN JMP RTRY TRY AN INFINITE # OF TIMES. * ISZ ERCTR STEP COUNT CLA,CME,RSS IF NOT LAST RETRY SKIP JMP }PARER ELSE ISSUE PARITY ERROR * ISZ CYL,I RBR,SLB SEEK CHECK?? JMP STAT,I YES RETRY NOW * JSB SEEK SEEK 0 SKCK1 JSB WAITI GO WAIT FOR INTERRUPT JSB STATW DO CORE STATUS REQUEST JMP STAT,I TAKE RETRY EXIT. * B400 OCT 400 B1774 OCT 177400 B377 OCT 377 BM12 OCT -12 ERCTR OCT -12 D202 DEC 202 EQT# DEC 1 SET ON FIRST ENTRY * * NRERR CLA,INA NOT READY -SET A=1 -POST INTERRUPT CLB SET BEEN STB I.XX HERE FLAG LDB RTNCD GET THE RETURN CODE SZB,RSS IF ZERO DO COMPLETION EXIT JMP COMEX * ISZ C.XX PARER LDA B3 A_3 ERROR RETURN COMEX LDB EQT9,I COMPLETION RETURN STA RTNCD SET THE RETURN CODE JMP NRRTN AND TAKE THE CENTRAL EXIT * * B3 OCT 3 LBUFA DEF BUF BUFA EQU LBUFA * * MOVE NOP MOVE SUBROUTINE * ENTER WITH A = -COUNT * B = DESTINATION/SOURCE * E = 1 FROM LOCAL BUF * E = 0 TO LOCAL BUF * LBUFP = LOCAL BUFFER ADD * FOR THIS MOVE CMA,INA SET COUNT POSITIVE STA COUNT SET COUNTER LDA LBUFP GET LOCAL BUFFER ADDRESS SEZ,RSS IF FROM USER BUFFER SWP SWAP THE ADDRESSES. JSB .MVW GO MOVE THE WORDS DEF COUNT NOP JMP MOVE,I NO; RETURN. * * LBUFP NOP COUNT NOP SKP * THE TRIPLET PROCESSOR TAKE SYSTEM OR USER * GENERATED TRIPLETS AND TRANSLATES THEM * INTO READ, WRITE, AND MOVE REQUESTS * * CALLING SEQUENCE: * * EQT8 NEG REQUEST LENGTH IN WORDS * EQT9 SYSTEM TRACK NUMBER (NOT ACTUAL) * EQT10 SYSTEM SECTOR NUMBER (NOT ACTUAL) * EQT1x1 REQUEST BUFFER ADDRESS. (SIGN BIT SET FOR READ) * * * $TB30 IS UESE TO TRANSLATE THE SYSTEM TRACK TO * AN ACTUAL UNIT AND CYLINDER NUMBER. * THE FORMAT IS: * * WORDS 1 TO 8 THE NUMBER OF TRACKS ON * UNITS 0-7 * WORDS 9 TO 16 THE FIRST TRACK ON UNITS * 0-7 * CONSTANTS FOR TIPLT * BM10 OCT -10 TB31A DEF TBXX MXSIZ NOP MAX NO OF WORDS PER TRACK * * * * TIPLT DLD EQT9,I GET TRACK AND SECTOR ADDRESSES SSA,RSS IF EITHER IS NEGATIVE SSB THEN JMP REJCT GO REJECT THE CALL * RRL 6 SECTOR * 64 CMB,INB SET NEGATIVE ADB EQT8,I ADD THE NO OF WORDS IN XFER ADB MXSIZ SUBTRACT FROM MAX WORD COUNT SSB TRACK WRAP AROUND? JMP REJCT YES GO REJECT THE REQUEST * LDA BM12 SET ERROR COUNTER STA TPER FOR 10 TRIES TIPRT LDA SUBCH GET THE SUBCHANNEL ADA TB31A ADD THE TABLE ADDRESS LDB A,I GET THE FIRST TRACK TO B ADB EQT9,I ADD THE ADDRESSED TRACK STB TRACK SAVE THE TRACK ADDRESS ADA B10 STEP TO THE NUMBER OF TRACKS ADDRESS LDB A,I GET THE NUMBER OF TRACKS LDA B SET IN B FOR POSSIBLE REJECT CMA,INA NEGATE THE NUMBER ADA EQT9,I ADD THE ADDRESSED TRACK NUMBER SSA IF POSITIVE THE ERROR JMP TIP0 NEGATIVE SO OK - CONTINUE * LDA EQT5,I SET THE IOR B40 END OF TAPE BIT IN THE STATUS STA EQT5,I EQT STATUS WORD JMP NRRTN EXIT ERROR * TIP0 LDB EQT8,I BRING IN THE STB TPLN LENGTH LDB EQT11,I AND THE STB TPBUF BUFFER ADDRESS LDB SUBCH GET THE SUBCHANNEL CLA,CLE SET A FOR AN ODD SUBCHANNEL SLB,RSS IF EVEN INA RESET A FOR HEAD 2 LDB EQT10,ѫI GET THE BRS ACTUAL SECTOR STB MOVE YES SAVE ADB NSEC IS IT ON THE ODD SSB,RSS SIDE OF THE DISC STB MOVE YES RESET ELA MOVE IN THE SECOND HEAD BIT ALF,ALF ROTATE HEAD TO BITS 8-9. STA HEAD SET HEAD WORD ADA MOVE ADD THE SECTOR STA HDSC SAVE FOR ADDRESS STA CHDSC AND FOR CYCLICK CHECK. * * LDA TPLN PRESET A FOR EVEN SECTOR LDB EQT10,I GET SECTOR CCE,SLB,RSS IF EVEN JMP TPNXT JUMP * LDB BUFA ELSE READ LDA DM128 128 WORDS TO JSB RWSUB LOCAL BUFFER LDA HLBUF SET MOVE BUFFER STA LBUFP ADDRESS LDB TPLN GET LENGTH ADB B100 LESS 64 LDA TPLN USE MIN OF REQUEST CLE,SSB AND LDA BM100 6 4 LDB TPBUF GET ADDRESS ELB,RBR CLEAR SIGN & SET READ/WRITE JSB MOVE GO MOVE THE WORDS. LDA DM128 SET TO WRITE LDB BUFA THE SECTOR SEZ,RSS WRITE REQUEST? JSB RWSUB YES; WRITE IT OUT. LDA BM100 UP DATE POINTERS TPA CMA,INA TO REFLECT STA MOVE LAST TRANSFER ADA TPBUF ADJUST BUFFER ADDRESS STA TPBUF LDA MOVE ADA B100 ROUND UP THE COUNT CLB CLEAR B FOR SHIFT LSR 7 SHIFT TO GET SECTOR COUNT ADA HDSC ADD TO THE CURRENT SECTOR STA HDSC SAVE FOR NEXT ACCESS AND B377 MASK TO SECTOR ONLY ADA NSEC SIDE TWO? IOR HEAD SET UP THE HEAD BITS IOR B400 SET SIDE TWO BIT SSA,RSS IF SIDE TWO STA HDSC RESET THE HEAD SECTOR ADDRESS LDA TPLN GET THE LENGTH ADA MOVE SUBTRACT THE NUMBER XFERED CLE,SSA,RSS IF NONE LEFT CHECK JMP CYCK FOR CYCLIC CHECK * STA TPLN SAVE LENGTH TPNXT LDB TPBUF GET BUFFER ADDRESS CLE,SSB READ? JMP TPRD YES; GO TRANSFER REST OF RECORD * ADA B100 NO; MORE THAN 64 WORDS LEFT CCE,SSA,RSS ? JMP TPB NO; GO TRANSFER LAST WORDS * LDA TPLN YES; TEST FOR MORE THAN LESS THAN AND B100 64 WORDS MOD 128 LEFT STA B SAVE FLAG ADA TPLN GET LENGTH TO SET FOR X-FER CLE,SZB IF LESS THAN 64 MOD 128 LEFT AND DM128 DELETE EXCELL OVER EVEN SECTORS LDB TPBUF GET BUFFER ADDRESS TPRD ELB,RBR SET READ/WRITE FLAG JSB RWSUB DO THE TRANSFER. LDA LN.N GET THE LENGTH AND JMP TPA GO UP DATE THE POINTERS * * TPB LDA DM128 WRITE OF LAST 64 WORD IN LDB BUFA FIRST HALF OF SECTOR STB LBUFP SET UP JSB RWSUB AND READ THE SECTOR LDA TPLN SET UP TO LDB TPBUF MOVE THE USER WORDS JSB MOVE GO MOVE TO THE BUFFER LDA DM128 WRITE THE BUFFER OUT AGAIN. LDB BUFA AGAIN JSB RWSUB * * * CYCK LDA EQT6,I REQUEST FOR CYCLIC AND B2002 CHECK CPA B2002 AND WRITE RSS YES SKIP JMP EOXF NO- RETURN * LDA CHDSC SET THE HEAD/SECTOR FOR STA HDSC SEEK LDA TRACK GET TRACK FOR SEEK JSB SEEK LDB EQT8,I CALCULATE THE CMB,INB NUMBER LDA EQT10,I OF B10 SLA SECTORS TRANSFERED ADB B100 START ODD - ADD 64 TO COUNT ADB B177 ROUND UP TO NEXT HIGHER SECTOR LSR 7 SECTOR COUNT TO B LDA CHCKC GET CHECK COMMAND ADA UNIT SET UNIT BITS CLCC4 CLC CMND PRESET THE COMMAND CHANNEL OTBD2 OTB DATA SEND SECTOR COUNT STCD5 STC DATA,C TO DATA OTAC1 OTA CMND SEND COMMAND STCC4 STC CMND,C START CHECK JSB WAITI GO WAIT CLA JSB STAT DO STATUS RSS RSS  BAD - SKIP JMP EOXF O-K RETURN * ISZ TPER STEP COUNTER JMP TIPRT TOO MANY? - NO TRY AGAIN * JMP PARER YES; TAKE PARITY ERROR EXIT. * * * HLBUF DEF BUF+64 TPLN NOP TPBUF NOP TPER NOP CHCKC OCT 60000 CYCLIC CHECK COMMAND CHDSC NOP SUBCH NOP B100 OCT 100 DM128 DEC -128 BM100 OCT -100 NSEC NOP B7 OCT 7 * * REJCT CLA,INA ILLEGAL CALL SO REJECT JMP I.XX,I IT SKP * INITIATOR ENTRY POINT I.XX NOP JMP CONFI CONFI CLEARS THIS WORD * LDA RSS SET UP LDB CHAN THE DMA SLB,RSS CHANNEL CLA SWITCH STA DMASW NOP IF CHANNEL 6, RSS IF 7. CCA ADA I.XX SET RETURN STA C.XX ADDRESS LDA B4 SET THE RETURN CODE STA RTNCD LDA EQT4,I GET THE UNIT RRR 6 FROM THE EQT AND B7 MASK TO UNIT NUMBER STA SUBCH SET THE SUBCHANNEL CLE,ERA SHIFT TO THE UNIT STA UNIT SET THE UNIT JSB STATW CHECK TO MAKE SURE DISC IS READY RRR 6 SHIFT THE READY BIT SLA READY?? JMP NRERR NO GO TAKE NOT READY EXIT * LDA EQT6,I GET AND ISOLATE AND B3 THE REQUEST CPA B3 CONTROL? CLA,INA,RSS YES; SET FOR REJECT AND SKIP JMP OK NO; CONTINUE * JMP NRRTN GO NOT READY REJECT. * OK LDA BM12 RESET STA ERCTR THE ERROR COUNTER LDA EQT6,I GET THE REQUEST CODE SYS2 LDB EQT7,I GET BUFFER ADDRESS SSA SYSTEM REQUEST? JMP SYS YES; GO DO SYSTEM THING. * LNTS LDA EQT6,I GET THE CON WORD AGAIN RAR,CLE,ELA SET READ WRITE BIT RBL,ERB SET SIGN OF BUFFER ADDRESS TO SHOW DIRECTION STB EQT11,I AND SAVE FOR TIPLT CALL LDA EQT8,I GET THE LENGTH. STA EQT12,I SAVE FOR EXIT SSA,_RSS MAKE NEGATIVE CMA,INA,RSS WORDS ARS AND STA EQT8,I SAVE B2002 SZA IF ZERO SKIP CALL JMP TIPLT CALL FOR X-FER * EOXF LDA EQT6,I GET REQUEST CODE SSA SYSTEM JMP SYS2 YES; GO GET NEXT TRIPLET * DONE LDB EQT12,I NO; DONE; GET TLOG CCE,SSB SET POSITIVE CMB,INB IF NEG. NRRTN LDA DIGNO GET THE DUMMY INTERRUPT ADDRESS STA WAITI AND SET IT. LDA RTNCD GET RETURN CODE (0 OR 4) CPA B4 IF 4 ISZ C.XX BUMP RETURN (DID -1 ON IT ABOVE) JMP C.XX,I ELSE JUST EXIT * DIGNO DEF IGNOR * SYS STB MOVE SYSTEM TRIPLET PROCESSOR INB STEP TO THE ADDRESS OF LDA B,I LENGTH AND STORE IT IN STA EQT8,I THE EQUIPMENT TABLE INB STEP TO THE DISC ADDRESS LDA B,I GET THE ADDRESS RAL,CLE,SLA,ERA IF SIGN BIT SET THEN INB,RSS THIS IS A PURE SECTOR ADDRESS AND B177 MASK THE SECTOR AND STA EQT10,I AND SET IT IN THE EQT XOR B,I GET THE TRACK ADDRESS ALF,ALF ROTATE TO LOW A RAL SEZ IF FULL WORD TRACK LDA B,I USE FULL WORD STA EQT9,I AND SET IN THE EQT INB STEP TO ADDRESS OF NEXT TRIPLET STB EQT7,I AND SET IT IN THE EQT LDB MOVE,I GET THE BUFFER ADDRESS SZB IF ZERO THEN DONE JMP LNTS GO DO THE TRANSFER. * * LDA RTNCD GET THE RETURN CODE SZA,RSS IF ZERO- JMP DONE GO RETURN * LDA UNIT GET THE ADA LSTB LAST TRACK SEEKED ON LDA A,I THE CURRENT UNIT AND JSB SEEK SEEK SAME CYL. JSB WAITI GO WAIT FOR A INTERRUPT JMP DONE EXIT * * B4 OCT 4 B177 OCT 177 SKP BUF BSS 128 LN EQU * ORG BUF CONFI STA B SAVE THE SELECT CODE IOR vOTA CONFIGURE STA OTAD1 ALL XOR B4000 THE STA OTBD1 I/O STA OTBD2 INSTRUCTIONS XOR B5100 STA STCD1 STA STCD2 STA STCD3 STA STCD4 STA STCD5 XOR B5000 XOR B4400 STA SFSD1 STA SFSD2 XOR B0600 STA LIAD1 XOR B0400 STA STFD XOR B221. STA DMAC INA NOW THE COMMAND CHANNEL XOR B226. STA OTAC1 STA OTAC2 XOR B4000 STA OTBC1 STA OTBC2 STA OTBC3 XOR B5100 STA STCC1 STA STCC2 STA STCC3 STA STCC4 STA STCC5 STA STCC6 XOR B5000 STA CLCC2 STA CLCC3 STA CLCC4 STA CLCC5 XOR B4200 STA LIAC1 CLB FIND LDA EQTA THE EQT CMA,INA NUMBER ADA EQT1 FOR THE UP REQUEST DIV .15 INA AND STA EQT# SET IT CLA CLEAR THE JUMP TO STA I.XX+1 THIS ROUTINE LDA TB31B GET THE ADDRESS OF THE TABLE ADDRESS LDA A,I GET THE ADDRESS RAL,CLE,SLA,ERA JMP *-2 STIL INDIRECT GO GET NEXT LEVEL * LDB A,I GET THE FIRST WORD OF THE TABLE CMB,SSB,INB,RSS SET POSITIVE IF NEG SKIP IF IT WAS POSITIVE INA,RSS IT WAS NEGATIVE SO STEP THE TABLE ADDRESS LDB SECTR IT WAS POSITIVE SO USE THE BASE PAGE SECTOR COUNT STA TB31A SET THE TABLE ADDRESS BRS,BRS ADDJUST TO NO. SECTORS PER SIDE CMB,INB SET NEGATIVE AND STB NSEC SET FOR THE DRIVER CMB,INB FIND THE BLF,BLF MAX NO STB MXSIZ OF WORDS PER TRACK AND SET JMP I.XX+1 * TB31B DEF TB31A ADDRESS OF THE TABLE ADDRESS OTA OTA 0 B221. OCT 22100 B226. OCT 22600 B4000 OCT 4000 B5100 OCT 5100 B5000 OCT 5000 B4400 OCT 4400 B0600 OCT 0600 B010VTRN0 OCT 0100 B0400 OCT 0400 B4200 OCT 4200 .15 DEC 15 TEST EQU LN-* ERROR HERE MEANS THE CONFIGURE ROUTINE * I TOO LONG. . EQU 1650B EQTA EQU . EQT1 EQU .+8 EQT4 EQU EQT1+3 EQT5 EQU EQT1+4 EQT6 EQU EQT1+5 EQT7 EQU EQT1+6 EQT8 EQU EQT1+7 EQT9 EQU EQT1+8 EQT10 EQU EQT1+9 EQT11 EQU EQT1+10 EQT12 EQU .+81 EQT15 EQU .+84 CHAN EQU .+19 I.31 EQU I.XX C.31 EQU C.XX CMND EQU 0 DATA EQU 0 A EQU 0 B EQU 1 SECTR EQU .+71 LNPG EQU LN DRIVER LENGTH END T  29015-80001 B S P0122 FH-RTGEN REAL TIME SYSTEM GENERATOR             H0101 ASMBAB̬àH-GN HDH-GNA̠MŠSYSMGNA AMDMAHV.H HSGNAҠ̬HSנGNA UNԠPAGŠNKSHNPSSBŠϠSAVŠBASŠPAG G00B AU0 BU SUP -HGHŠ- SϠDVS(YPԬHSP -DNS- ---------- ------- -SԠ- ADNKAGŠSUBUNS DSKDVS -0000- PGAMADNGN̠ -6000- ɯϠABŠGNAN PAAMҠNPUԠ -000- X AABŠPGAMNPUԠ NAZAN -00- DAAAAS SKP DNԠMA D:D-NAMŠ D:D-NAMŠ3 D3:D3-NAMŠ5USAGŠAG D:D-MMNNGH D5:D5-UNԠDSKADDSS D6(5:D6-MS D6(0-:D6-PY D6(00-06:D6-YP D:D-UNNVA̠( D:D-UNNVA̠( D9:D9-UNNVA̠(3 D0:D0-DSKNGHBGMANADDSS(BSNY SԠMA D:SԱ-NAMŠ D:SԲ-NAMŠ3 D3:S3-NAMŠ5DNA D:SԴ-DNԠADDSS D5:S5-BPNKADDSS PGAMYPS 0:SYSM :ԠSDN :ԠDSKSDN 3:BGDSKSDN :BGSDN 5:BGSGMN 6:BAY :UY -99:UNUSD SKP ҠDS :NVADYPYϠNAZANPAAMS :HKSUM 3:DUԠƠSUN :NVADDYP 5:DUPAŠNYPNS 6:NVADBPDŠNPGAM :SԯDNԠV :DUPAŠPGAMNAMS 9:PAAMҠNAMŠ 0:PAAMҠYPŠ :PAAMҠPY :PAAMҠUNNVA̠ 3:BGSGMNԠPDSBGDSàSDN :SYSAVMMҠBGBUNDAYS H&5:GA̠A̠BYAYPŠ6PGAM(MAYA̠YPŠ0AND6NY 6:BPNKAGŠAAV :DSKVנ(NԠDSKADDҠDSASԠAVA̠DSKADDҩ :MMYV 9:DB̠DDүPGAMVAY 0:DB̠SԠVנ(MŠHAN65DB̠DS :'$'NԠUNDNADҠSYMB̠AB :DSKADPAYDDŠ 3:NVADABPNKAGŠPY :NVADHANN̠N.NԠD 5:NVADDVҠNAMŠNԠD 6:NVADDBUPANDSNԠD :NVADDVŠNŠN. :NVADNUPԠàHANN̠N. 9:NVADNUPԠàHANN̠N.D 30:NVADNԠDMNMN 3:NVADԠN.NNԠD 3:NVADPGAMNAMŠNNԠD 33:NVADNYPNԠNNԠD 3:NVADABSUŠVAUŠNNԠD 35:BPNUPԠANV 36:NVADMNANGPANDNNԠD 3:NVADMMNNGHNSYSMBAYҠUY 3:ABSUŠSYSMHASVAYDAAABŠPGAM 39:GA̠A̠BYASYSMPGAMƠAYPŠSؠPGAM SKP SASANDNA̠SASMŠϠHSUNŠHH HKSHŠSHG.ANDNSUSHAԠԠSAD. SPà G0B BGNAAMԠϠAҠHŠSHG. ASNDZ AGԠHŠSHG SZASSƠZϠHN MPANSɠSAԠHŠGNA SBSPAŠPUԠHŠDNANנN DAPSŠASKҠHP DBMS0AҠSҠPUSHUN SBDKYɠϠHŠY HԠ MPBGNSԠAGAN SPà MS0DƠ+ ASà9AҠSҠPUSHUN MSASà9HANGŠBPNKAG? SKP G00B MPBGNGϠSԠHŠS DPҠBSSPԠADҠDVҠADDSS DKYBSSKYBADUPUԠDVҠADDSS DHSPBSSHSPUNHDVҠADDSS DYBSSYPŠNPUԠDVҠADDSS AMDƠND AMBSSNDAVA.MM-SԠBYDVS DMAGԠ000000(MPMAGAPŠDVҠADDҩ .U650BDNŠGNƠSYSMMAA SBPABS.ASԠD+ƠNKAGŠAA BPABS-.NGAVŠƠABV ANSDƠGNANSҠADDҠϠGN ANPԠDƠNPUԠADDSSƠPGAMNPUԠD PAMDƠPASADDҠƠPAAMҠNAZAN APASDƠPAAMADDSSƠPAAMҠNPUԠD AGNϠDƠGNϠADDҠƠɯϠGNAҠD AGADƠGA̠ADDҠƠGA̠SUB. AGNDƠGNAADDSSƠGNASUB. AGϠDƠGàADDSSƠGàSUB. AGNɠDƠGNԠADDҠƠGNԠSUB. AAPDƠNԠADDҠƠABPNKAGŠD NDADDƠDSKAADDSSƠDSKADDSSMD ADNDƠDSKɠDSKNPUԠDVҠADDSS ADUԠDƠDSKϠDSKUPUԠDVҠADDSS AADDƠADADDSSƠMANADBGN ADSDƠADSADDSSƠSUB-ADBGN ABPԠDƠBPUԠADDҠƠBPUPUԠD AԠDƠԠADDҠƠA̠SԠANGD ADDƠD3AҠPGAM-ADDAGS ADSNDƠDSNADDҠƠSANDNԠD AABDDƠABDϠADDҠƠABSUŠUPUԠSN AMDDƠMDϠADDSSƠMANNGUPUԠDV ANVDƠNVDADDSSƠDMA̯ASɠNV AϠDƠҠADDSSƠD-NGD ADϠDƠDҠADDSSƠSPA̠-NGD AMVŠDƠMVҠADDSSƠMV-DBUƠD AGNDDƠGNDADDҠƠDSGMNԠGNA AUDDƠUDADDҠƠDSGUPUԠN AZUԠDƠZUԠADDҠƠZϠUPUԠϠDSG ADSԠDƠDSԠADDҠƠDSKAKABŠD ANSDƠNSԠADDҠƠPGAMS-ADDS BDҠDƠADADDSSƠ00AD ABASàDƠDMSŠADDҠҠDSADҠ$$ AؠDƠԯSŠADDҠҠԠҠSADҠ$$ ABԠDƠSAԠADDSSƠBSAPAD ASBUƠDƠASPBƠADDSSƠ9-DBUҠNB ASԠDƠSԠDNŠSS-ҠSYS$$ AMSKDƠMASKNMNԠAKVAUŠ$$ AADDƠAD DMԠDƠDM̠ADDSSƠUNŠϠDMŠYPŠ6ϠYPŠ A6DƠ6ADDSSƠYPŠ6AҠUN AS̠DƠS̠ADDSSƠHŠS̠UN ASHƠDƠSHƠADDҠƠSHDUŠSAHUN SKP PGAMNSANԠAS ZϠԠ0 NDà- NDà- N3Dà-3 NDà- N5Dà-5 N6Dà-6 NDà- N9Dà-9 N0Dà-0 NDà- NDà- NDà- N60Dà-60 N6Dà-6 N00Dà-00 PDà P3Dà3 PDà P5Dà5 P6Dà6 PDà PDà P9Dà9 PDà PDà PDà P5Dà5 P6Dà6 PDà PDà PDà P3Dà3 PDà P5Dà5 PDà P33Dà33 P3Dà3 P6Dà6 P99Dà99 6UN6 ̱0UN ̱UN0 60Ԡ-60 ̲000Ԡ-000 MUP MUP MUP M3Ԡ3 M60Ԡ60 MԠ M0Ԡ0 MԠ M3Ԡ3 M060Ԡ06000 M0Ԡ000 M600Ԡ60000 MԠ M000Ԡ000 M00Ԡ00 M00Ԡ00 M006Ԡ006 M3Ԡ003 M00Ԡ00 M000Ԡ000 M600Ԡ600 M00Ԡ00 MԠ SKP DPSDƠ+ P000Dà0000 P000Dà000 P00Dà00 P0Dà0 PDà PSDƠ+ M000Ԡ0000 M000Ԡ000 M00Ԡ00 M0Ԡ0 Ԡ BANKԠ00BANK UBNKԠ0000UPPҠHAҠBANK MSGNԠ00000NGAVŠSGN DSKABԠ3ABSUŠDSKADDSS:03 SKP AҠBUҠHA̠ZS HŠBU̠SUBUNŠASA6-DBUҠHZS. ANGSUN: AGND BADDSSƠBU 2SBBU UN:NNSƠAANDBAŠDSYD. BU̠NP DAN6 SADNԠSԠBUҠNGH6 A SABɠAҠBUҠD NB SZDNԠA̠DSA? MP-3NϠ-NNUŠANG MPBU̬ɠUN SKP NנNŠ(ҬƩNY HŠSPAŠSUBUNŠSUSDϠSPAŠUPHŠPN. ANGSUN: AGND BGND SBSPA UN:NNSƠAANDBAŠDSYD. SPAŠNP ASԠHAAҠUNԠZ SBDKYɠUPUԠҬƠNY MPSPAŬɠUN SKP PN:Ҡ HŠҠSUBUNŠSUSDϠPNԠHŠDAGNSS ҠA̠ҠMSSAGS. ANGSUN: A-DGԠASɠҠD BGND SB UN:NNSƠAANDBAŠDSYD. ҠNPPNԠҠMSSAGS SAAM+3SԠҠDŠNϠMSSAG DAP6 DBAMҠAMҠMSSAGŠADDSS SBDKYɠPNԠҠMSSAG MPҬɠUN VABŠҠ ҠNP SBҠPNԠҠMSSAG H0HԠ0BAԠ-PGAMANNԠNNU MP-VABŠ AMҠDƠ+ ASà3ҠҠMSSAGŠҠ+D SPà 0ASà0DNԯSԠV ұ5ASà5GA̠A̠BYAYPŠ6PGAM ұ6ASà6BPNKAGŠAAV ұASàDSàV ұASàMMYV ұ9ASà9NVADDB̠DүPGVAY ҲASàDSàADPAYDDŠ 3ASà3SYSMVנNϠSAH SKP HŠNDؠANDDؠSUBUNSAŠUSDϠSԠHŠUN ADDSSSҠHŠNYNHŠPGAMDNYAN BKABŠ(DNԩ.HŠADDSSƠHŠNԠNY NHŠDNԠABŠSNANDNDN.NUNM DجDNԠNANSHŠADDSSƠHŠNԠAVAAB NYNDN.HŠADDSSƠHŠSԠNYSNAND NBDNԠANDHŠADDSSƠHŠNDƠDNԠSNAND NPDN. ƠHŠNԠDNԠNYVSNϠHŠASԠSԠNY DؠPNSADAGNSàANDSϠHŠVABŠ SUBUN. SԠNA̠DNԠADDSS NDؠSSHŠADDSSƠHŠSԠNYNHŠDN ABŠASHŠUNԠADDSS. ANGSUN: AGND BGND SBND UN:NNSƠAANDBAŠDSYD. NDؠNP DABDNԠBDNԠNA̠DNԠADDSS SADNԠSԠUNԠDNԠADDSS MPNDجɠUN SKP SԠDNԠADDSSSMDN DؠSSHŠADDSSSƠHŠUNԠ0-DNYNH DNԠABŠMHŠADDSSƠHŠUNԠNY(DNԩ. ANGSUN: AGND BGND SBD UN:NNSƠAANDBAŠDSYD. (N+:UNԠDNԠADDSSSAŠHŠADDSSS ƠHŠNԠAVAABŠDNԠNYҠH NDƠHŠDNԠABŠHASBNAHD. (N+:UNԠDNԠNYADDSSS(NԠNDƠDNԩ DؠNP DADNԠDNԠUNԠDNԠADDSS PAPDNԠNDƠDNԠS? SSYS-UNϠNԠNSUN SZDؠSԠUNADDSSҠN+ SADSԠADDSSƠNAMŠ NA SADSԠADDSSƠNAMŠ3 NA SAD3SԠADDSSƠNAMŠ5USŠAG NA SADSԠADDSSƠMPGNGH NA SAD5SԠADDSSƠUNԠDSKADD NA SAD6SԠADDSSƠMJSPүDSKY NA SADSԠADDSSƠàNV( NA SADSԠADDSSƠàNV( NA SAD9SԠADDSSƠàNV(3 NA SAD0SԠMANDNԠADDҠҠBS DADNԠDNԠUNԠDNԠADD DBA MANA ADAPSԠPSԠUNԠNDSԠADD SSASSSKPƠNϠVAP MPSҠPNԠVנMSSAG ADBN0SԠҠNԠDNԠADDSS SBDNԠSԠNԠDNԠADDSS MPDجɠUN SKP HŠNSԠANDSؠSUBUNSAŠUSDϠSԠHŠUN ADҠSYMB̠ABŠ(SԩADDSSS.HŠADDҠƠHŠNԠNY NSԠSNANDNS.NUNMDجSԠNANS HŠADDSSƠHŠNԠAVAABŠNYNSԬҠHŠADDSS ƠHŠNDƠS.HŠADDSSƠHŠSԠNYNS SAԠBSԠANDHŠADDSSƠHŠNԠAVAABŠNY SAԠPS. ƠHŠNԠNYNSԠVSNϠHŠUN DNԠNYSؠPNSADAGNSàANDS ϠHŠVABŠҠSUBUN. SԠNA̠SԠADDSS NSԠSSHŠADDSSƠHŠSԠNYNS. NSԠNP DABSԠBSԠSԠSԠADDSS SASԠSԠUNԠSԠADDSS MPNSԬɠUN SKP SԠSԠADDSSSMS SؠSSHŠUNԠSԠADDSSSMS. ANGSUN: AGND BGND SBS UN:NNSƠAANDBAŠDSYD. (N+:HŠNDƠSԠSAHDANDHŠUN SԠADDSSSAŠHŠADDSSSƠHŠNԠAVAAB NYNS. (N+:UNԠSԠADDSSSAŠSԠ(NԠNDƠSԩ. SؠNP DASԠGԠUNԠSԠADDSS PAPSԠNDƠSԠAB? SS SvZSؠNҠUNADDSS SASԱSԠDADD NA SASԲSԠDADD NA SAS3SԠD3ADD NA SASԴSԠDADD NA SAS5SԠD5ADD NA SASԠSԠNԠSԠADDSS MANA ADAPDNԠPDNԠADDҠUNԠDN SSASSSKP-NVADSԠNY MPSجɠUN SҠDA0 SBҠVABŠҠ SKP ANBASŠAB BADDƠ+ Ԡ0ABSUŠPGAMBAS P̠Ԡ0UNԠPGBASŠADDSS Ԡ0BPANADDSS MADԠ0UNԠMMNANBAS ABUƠDƠBU ADBUƠDƠDBU ABUƠDƠBUƬ ABUƠDƠBU AKBUƠDƠKBU ABUƠDƠBU PADDƠPS AMSԠDƠMS AMM5DƠMS+5 ASԠDƠS DNԠԠ0MPAYDUN BSԠDƠSԠADDҠƠSԠSԠNY SԠBSSUNԠSԠADD PSԠBSSADDҠƠNԠAVAABŠNY BDNԠBSSADDҠƠSԠDN DNԠBSSUNԠDN PDNԠBSSNԠAVAABŠDN MAàBSSMAؠHAҠUN HAҠBSSMPAYHAҠSAVŠAA NϠBSSA̠DG DSKSYBSSNA̠DSGMNԠDSKADDSS DSZŠBSSDSKSZŠ-N.ƠAKS DSKSàBSSADDSSƠDSKSAHAA PAKBSSNUMBҠƠDSKPDAKS DAUNBSSAUAYDSKSZ SDSBSSSSAKҠSYSMDS$ ADSԠ0SSAKҠAU.DSà$$ PàBSSADD.ƠPVGDɯϠAD$$ DSPBSSPSNƠSԠDSG.NS$ BHNBSSMŠBASŠGNAҠHN SAPƠBSSSAPPNGAG0NϯYS ASMBSSASԠDSYSAVA̠MM PAADBSSaHPAAMҠNPUԠDVҠADDSS YHBSSSYSMYHANN̠N. DNBSSDSKҠUN DSKADBSSUNԠDSKADDSS PGBSSPGAMAD.AG-0̯N DSNԠBSSDSKSGMNԠSҠUN DBSSDNԠADD:NAMŠ DBSSDNԠADD:NAMŠ3 D3BSSDNԠ3ADD:NAMŠ5USAGŠAG DBSSDNԠADD:MMNNGH D5BSSDNԠ5ADD:UNԠDSKADD D6BSSDNԠ6ADD:MSPYYP DBSSDNԠADD:àNV( DBSSDNԠADD:àNV( D9BSSDNԠ9ADD:àNV(3 D0BSSDNԠ0ADD:BGHBSMAN SԱBSSDADDҠ(Sԩ SԲBSSDADDҠ(Sԩ S3BSSD3ADDҠ(Sԩ SԴBSSDADDҠ(Sԩ S5BSSD5ADDҠ(Sԩ NGBSSNԯԠAG-0 NԠBSSSYMB̠UN UA̠BSSUNԠBUƠADDSS NԠBSSUNԠBUƠUN BUƠBSS6ADBU UADBSSUNԠDBUƠADDSS DNԠBSSUNԠDBUƠUN DBUƠBSS6AABŠDSKNPUԠBU BUƠBSS6DSKADҠSANUԠAA UAɠBSSUNԠBUƠUN NԠBSSUNԠBUƠUN BPBSSҠSDNԠBPBUND UBPBSSUPPҠSDNԠBPBUND BBPBSSҠBAKGUNDBPBUND UBBPBSSUPPҠBAKGUNDBPBUND UBPBSSAүԠDSàSBPNKAA$$ BPMAؠBSS SPà MPNP MPNP HNP HNP 0NP 00NP SPà PABASà SKP BUƠBSS6DSGMNԠBU UAKBSSUNԠKBUƠADDSS KNԠBSSUNԠKBUƠUN KBUƠBSS6KYDBU UAԠBSSHUNԠBUƠADDSS NԠBSSUNԠBUƠUN BUƠBSSMPAYBU UAPBSSUNԠPSԠADDSS AMADBSSUNԠMSԠADDSS MSԠBSSMMYMAPBU NԠBSSNGDSGMNԠUN SNԠBSSSHԠDSGMNԠUN MԠBSSMAMUMԠMNGH MBGBSSMAؠBGMNGH DSKYBSSUNԠKYDDSKADDSS DSKDBSSDSKDSGMNԠADDSS KYNBSSA̠KYDUN KYԠBSSUNԠKYDUNԠ$ PYPŠBSSPGAMYP SYBPBSSSԠDSYSBPNKAG SYSADBSSUNԠDSGMNԠADDSS B̠BSSUNԠBPàADD PB̠BSSNA̠BPàADD PP̠BSSNA̠PGàADD ADBSSUNԠŠANADDSS PMANBSSUNԠBGMANPSԠADDSS BSBADBSSBGSGMNԠBPàADD BSPADBSSBGSGMNԠPGàADD AGBSSPGAMS-ADDAG MANBSSUNԠMANDNԠADD HDGBSSHADNGMAԠAG DNԠBSSUNԠMANDNԠADDSS DSKDBSSDSKNPUԠADDSS AԠBSSADDSSƠUPMNԠAB ԠBSSN.NSNUPMNԠAB ASԠBSSADDҠƠDVŠNŠAB SԠBSSN.NSNDV..AB ANԠBSSADDSSƠNUPԠAB NԠBSSN.NSNNUPԠAB DSKNBSSDSKADDҠƠNԠDŠD NNBSSDUNԠƠNԠD U̠BSSUNԠSԠADDSS SԠBSS6USҠSYSMPGDNԠADDҠS DSKؠBSSUNԠAKADD.Ҡ"DBN" DNԠBSSUNԠDSKҠUN DMNDBSSDSKMMANDADDSS MADDҠBSSMMYMMANDADDSS MPPBSSUNԠABSUŠD ABNԠBSSUNԠABSUŠDSPAMN DSKMNBSSNA̠MANDSKADDSS BSSDPBSSNA̠DSKSMANBSSDSP PNԠBSSPMAYNYPN DBADBSSUNԠDB̠ADDSS KYBSSNSUNYPŠBY NSNBSSNSUNYPŠUN DBSSԠDNA NSҠBSSUNԠNSUN PAGNϠBSSUNԠPAGŠN. PNDBSSUNԠPAND PGHBSSPGAMNGH ҠBSSҠBPSԠBUND UPPҠBSSUPPҠBPSԠBUND ANADBSSUNԠPҠANGŠADDSS BGBSS DYPBSS DSKANPADDSSƠHGHSԠDSK DԲBSSNNSƠDSKƠDԠNY D3BSSNNSƠAUؠDSKƠD SHBSSADDSSƠDNԠƠPGMϠBŠSHDUD SHBSSADDҠƠDNԠƠABVŠPGM-NADSUN SH3BSSNGHƠSHDPGMSDSGMN SHBSSDADDSSƠHŠSHDUDPGM 09ASà09PAAMҠNAMŠ ұ0ASà0PAAMҠYPŠ ұASàPAAMҠPY ұASàPAAMҠNVA̠ ҲASà$àNԠUNDNS ҲASàNVADHANN̠N.NԠ Ҳ5ASà5NVADDVҠNAM Ҳ6ASà6NVADDBҠԠPAND ҲASàNVADDVŠ.N. ҲASàNVADNԠàHANN̠N. Ҳ9ASà9NVADNԠHANN̠N.D 30ASà30NVADNԠàMNMN 3ASà3NVADԠN.NNԠD 3ASà3NVADPGAMNAMŠNNԠ 33ASà33NVADNYPNԠNNԠD 3ASà3NVADABSVAUŠNNԠ 35ASà35BPNUPԠANV 36ASà36NVADNA̠PANDNNԠ 3ASà3NVADMMNNSYS.BҠUԠPGM 39ASà39GA̠SYSMUSŠƠYPŠ6PGAM MS0ASà9BGDSàSDNS MS3ASàSYSMSDNDS MS0ASàBPNKAGŠ MSDƠ+ ASàƠBANKDSGMNS? MSDƠ+ ASà3(NNũ MS5DƠ+ ASàUPMNԠABŠNY MS6DƠ+ ASàDVŠNŠAB MS36DƠ+ ASàHANGŠASYSAVMM? MSDƠ+ ASàPV.N.ADADD? MS50DƠ+ ASàSAԠSAH? MS0DƠ+ ASàSSAK? G HDSYSMBASŠPAGŠMMUNANAA SYSMBASŠPAGŠMMUNANAA SYSMABŠDNN AU.+0AƠUPMNԠAB ԣU.+ƠԠNS UMAؠU.+3ƠGA̠UNS(NDԩ DԠU.+AƠDVŠNŠAB NBAU.+AƠNUPԠAB NGU.+5ƠNUPԠABŠNS AԠU.+6AƠAKASSGNMNԠAB KYDU.+AƠKYDBK ɯϠMDUůDVҠMMUNAN ԱU.+ADDSSS ԲU.+9 3U.+0 ԴU.+ 5U.+UN 6U.+3 ԷU.+5-D ԸU.+5 9U.+6 Ա0U.+ ԱU.+NY ԱU.+ Ա3U.+ ԱU.+3 Ա5U.+ HANU.+9UNԠDMAHANN̠ BGU.+0ɯϠADDSSƠM-BASŠAD SYSYU.+ԠNYADDSSƠSYSMY SYSMUSԠPSSҠ''MMUNAN NԠU.+ƠUSԠPAAMS- NU.+3UNPNԠADDSS PU.+ADDSSS PU.+5 P3U.+6ƠUS PU.+ P5U.+PAAMS P6U.+9 PU.+30(SԠҠMAMUM PU.+3PAAMS DNNƠSYSMSS(UUS DMԠUtTRN.+3ADDSSƠ'DMAN'SԬ SKDDU.+33'SHDU'SԬ SUSP3U.+36'AVAABŠMMY'SԬ SUSPU.+3'DSàAAN'SԬ SUSP5U.+3'PAҠSUSPND'S T  29015-80002 B S P0122 FH-RTGEN REAL TIME SYSTEM GENERATOR             H0101 DNNƠUNGPGAMDSGMN' ԠU.+39DSGMNԠADD.ƠUNԠPG. NKU.+0'NKAG' MPU.+'MPAY(5-DS PϠU.+6'PY'D PNԠU.+'PMAYNYPN' SUSPU.+'PNԠƠSUSPNSN' AU.+9'AGS'AԠSUSPNSN BU.+50'BGS' ϠU.+5'ŠANDV SYSMMDUŠMMUNANAGS PANU.+5PAүKYBADANNAG PGU.+53PAҠMMUNANAG SAPU.+5ԠDSàSDNԠSAPPNGAG DUMMYU.+55ɯϠADDSSƠDUMMYN.AD DSDAU.+56DSàADD.ƠSԠDSGMN DSDPU.+5-PSNHNS DNNƠMMYAANBASS BPAU.+5AүԠDSàS.BPNKAA BPAU.+59AүԠDSàS.BPNKAA BPA3U.+60ABKGDSàS.BPNKAA BGU.+6AƠSDNԠBAYAA GU.+6AƠA-MŠAA MU.+63NGHƠA̠MŠMMNAA DAU.+6AƠүԠDSàSDNԠAA AVMMU.+65AƠSYSMAVAABŠMMY BKGU.+66AƠBAKGUNDAA BKMU.+6NGHƠBAKGUNDMMNAA BKDAU.+6AƠBKGDSàSDNԠAA UYPAAMS AGU.+69NGHƠAKASSGNMNԠAB ASDU.+0ƠAKSNSYSMDS SԲU.+SSAKNU(SYSM S3U.+SSAKNU3(AU. DSBU.+3DSàADDҠƠSBNYPS DSNU.+ƠSBNYPNS DSUԠU.+5DSàADDҠƠàUYPGS DSUNU.+6ƠàUYPGS GKU.+AD-N-G:USGAKƠKS GàU.+UNԠGϠAKSҠADDSS SUNU.+9SUŠŠUANDDSàADDSS MP̠U.+0MMYPԠNƠAG(0 vNNŠU.+5MMPԠNŠADDSS BKAU.+AƠMMYNBAKGUND HDԠUVŠSYSMGNAҠ G000B NA̠ANSҠSMADŠϠGNBYSNG00( NHŠSHGSҠANDPSSNGUN.ƠANYSA DDDUNGHŠNAZANPHASŬHŠNAZAN SNANBŠPAD. HŠNGMSSAGSAŠPNDDUNGHŠNAZAN PHASŬHHŠSPANSҠAHVADSNS. MSSAGŠSPNS HDSàHN?NҠA̠DGS SYSDSàSZ?NҠ3DMA̠DGS SAԠSAH?NҠ3DMA̠DGS N.PD?NҠDMA̠DGS SSAK?NҠ3DMA̠DGS$$ AUؠDSàSZ?NҠ3DMA̠DGS(ҠZϩ SSAK?NҠ3DMA̠DGS$$ BGHN?NҠA̠DGS PV.N.ADADD?NҠA̠DGS$$ SAPPNG?NҠYSҠN AMM?NҠ5A̠DGS PGMNP? BҠNP?NҠPԬMԬDƬҠY$$ PAMNP? NGSUSSU̠MPNƠHSSN HŠANSҠADDSSSMVDϠHŠNAZANSN ƠHŠADNGPHAS. GNà0àUNƠA̠ɯϬNUPS SBSPAŠNנN SBSPAŠNנN SԠDSKHANN HNDDAP DBMSSMSSADD:HDSKHN? SBPYPNԠMSSAGŬGԠPY DAPSԠҠA̠DGSNPU SBDNGԠDGSUNA MPHNDPAԠNPU SADHN̠SԠDSKHANN̠NUMB GԠSYSMDSKSZ SBSPAŠNנN SZDDAP DBMSSMSSADD:SYSDSKSZ? SBPYPNԠMSSAGŬGԠPY DAN3SԠҠ3D>bMA̠DGSNPU SBDNGԠDGSUNA MPSZDPAԠNPU SADSZŠSԠSYSMDSKSZ SBSPAŠNנN S̠DAP DBMS50MS50ADD:SAԠSAH? SBPYPNԠMSSAGŬGԠPY DAN3SԠҠ3DMA̠DGSNPU SBDNGԠDGSUNA MPS̠PAԠNPU SZASSƠZϠNPUԬUSŠDAUԠVAU MPDAԠ(DSàMD-PNԩ DBDSZŠƠNPUԠGAҠHANDSàSZŬ MBNBŠPAԠNPU ADBA A SSBSS MPS SS DAԠDADSZ AƬAƠAŠԠҠAKADDSS AҬAҠDVDŠBY$$ ANDM600SAŠAKADD.$$ SADSKSàSԠNA̠SAHADDSS SԠN.PDAKS SBSPAŠNנN PDDAP DBMSMSADD:N.PD? SBPYPNԠMSSAGŬGԠPY DANSԠҠDMA̠DGSNPU SBDNGԠDGSUNA MPPDPAԠNPU SAPAKSԠN.PDAKS GԠSSҠSYSMDS SBSPAŠNנNŠ$$ SñDAP6$$ DBMS0MS0ADD:SSAK?$$ SBPYPNԠMSSAGŬGԠPY$$ DAN3SԠҠ3DMA̠DGSNPU$$ SBDNGԠDGSUNA̠$$ MPSñPAԠNPUԠ$$ SASDSSԠSSҠSYSMDSà$$ GԠAUAYDSKSZ SBSPAŠNנN AUDSDAP DBMS33MS33ADD:AUؠDSKSZ? SBPYPNԠMSSAGŬGԠPY DAN3SԠҠ3DXMA̠DGSNPU$$ SBDNGԠDGSUNA MPAUDSPAԠNPU SADAUNSԠAUAYDSKSZ SZASSƠAU.DSàNԠPSNԬ$$ MPHN-SKPƠSSNPU.$$ GԠSSҠAU.DS SBSPAŠNנNŠ$$ SòDAP6$$ DBMS0PAԠ$$ SBPYSS$$ DAN3MSSAGŠAND$$ SBDNNPU.$$ MPSò$$ SAADSSԠSSƠSYSMDSà$$ SԠMŠBASŠGNAҠHANN SBSPAŠNנN HNԠDAP9 DBMS30MS30ADD:BGHN? SBPYPNԠMSSAGŬGԠPY DAPSԠҠA̠DGSNPU SBDNGԠDGSUNA MPHNԠPAԠNPU SABHNSԠBGHANN̠N. GԠPV.N.ADADD. SBSPAŠNנNŠ$$ DUMYDAP$$ DBMSMSADD:PV.N.AD?$$ SBPYPNԠMSSAGŬGԠPY$$ DAPSԠҠA̠DGSNPUԠ$$ SBDNGԠDGS$$ MPDUMY-ҬPAԠNPU.$$ SAPàSԠADD.ƠDUMMYAD.$$ SԠSAPPNGAG SBSPAŠNנN SAPDAP9 DBMS3MS3ADD:SAPPNG? SBPYPNԠMSSAGŬGԠPY DAN3 SBAGNɠMVŠ3HASϠBU SBAGAɠGԠNԠHAҠMBU PAZϠNDƠBU? SSYS-NNU MPSPҠNVADYSPPNS DABUƠGԠANSDHAS PAYHAҠHASY? MPSAPYYS-SԠSAP PANHAҠHASN? MPSAPNYS-SԠSAP0 SPҠSBNҠNVADYSPNS MPSAPPAԠNPU SAPYANASSSԠASKP SAPNASԠA0 SASAPƠSԠSAPPNGAG0NϯYS SԠASԠDAVA̠MMY SBSPAŠNנN SMADAP DBMSS3MSS3ADD:AMM? SBPYPNԠMSSAGŬGԠPY DAP5SԠҠ5A̠DGSNPU SBDNGԠDGSUNA MPSMAPAԠNPU SAASMSԠAMMҠSYSM SԠPGAMNPUԠUN SBSPAŠNנN PGMNDAP0 DBMSSMSSADD:PGMNP? SBPYPNԠMSSAGŬGԠPY SBSNԠGԠDŬANAYS MPPGMNPAԠUNԠNY SAPGMADSԠPGAMNPUԠDVҠADD SԠBAYNPUԠUN SBSPAŠNנN BNDAP0 DBMSS5MSS5ADD:BҠNP? SBPYPNԠMSSAGŬGԠPY SBSNԠGԠDŬANAYS MPBNPAԠNY SABADSԠBNPUԠDVҠADDSS SԠPAAMҠNPUԠUN SBSPAŠNנN PANDAP0 DBMSS6MSS6ADD:PAMNP? SBPYPNԠMSSAGŬGԠPY SBSNԠGԠDŬANAYS MPPANPAԠPAAMҠNPU SAPAADPAADPAMNPUԠDVҠADD SKP NGUŠDSKɯϠNSUNS DAN5 DBHPDSKGԠHGHPYADDSSS SBSDSKSԠHGHPYHANN̠NS. SZDHN̠SԠDSKHN̠N.Ϡ.P. gDAN9 SBSDSKSԠנPYDSKADDSSS A DSK5A0SԠDSKADDSS00 DSK6A0GԠSAUSD ANDMSAŠPԠB SZASKP-AKSPD MP+ SBSPAŠNנN DAP33 DBMS3MS3ADD:UNƠDSK. SBDKYɠPN:UNƠDSKP HԠ3BAԠҠPA MPDSK6PAԠHK DAASBUƬɠGԠADDSSƠBSAPBU ANDMSAŠPAGŠBS SAB DAASMGԠASYSMMMY ANDM060SAŠPAGŠNUMB SABUƠSAVŠPAGŠN.ƠBSAPD ҠBSԠANנBUҠADDSS SAASBUƬɠSԠBUҠADDҠNBSAP DASDSSԠƠSS-Ҡ$$ ADANSYSMDSàN$$ SAASԬɠBSAPAD.$$ MANA$$ ANDMNSUԠANDSԠUPDAŠAK$$ SAAMSKɠHSҠ0VAU.$$ ANASԠDSKADDSS0 DBABԠGԠADDSSƠBSAP SBADUԬɠUPUԠBSAPϠ0 ASԠDSKADDSS00 DBADBUƠGԠADDSSƠDBU SBADNɠADDSK00 DBADBUƠGԠADDSSƠDBU ADBP3ADUSԠҠHDN00 DABɠGԠDƠ00(BASàNԠPԩ SAABASìɠSԠBASàNYP.NNנD DAABԠGԠADDSSƠBSAPAD ANDMSAŠPAGŠBS ҠBUƠADDPAGŠN. SAAجɠSԠԠADҠNYP.ND ASԠDSKADDSS00 DBBDҠGԠADDSSƠ00BSAP SBADUԬɠPUԠUԠ00 DAANPԠGԠADDҠƠN.PG.D SAANSSԠUNԠANSҠADDSS SKP ,NAZŠADNG NPUԠA SADNSԠDSKҠUNԠϠZ SBSPAŠNנN SBSPAŠNנN MAGԠMP+9ƠMAGAPŠNԠDNDSKP- SBDMAGɠHSŬND Ԡ3MԠUN ANAANDSPA BϠ SBDMAGɠNUMB Ԡ. HԠ HԠHAS DAAMGԠASԠDAVA̠MMY ADAN9ADUSԠҠSԠDNԠNGH SABDNԠBDNԠADDҠƠSԠDN SAPDNԠPDNԠADDSSƠNԠDN DABSԠBSԠADDҠƠSԠSԠNY SAPSԠPSԠADDSSƠNDƠS DADSKSàGԠDSKADDSSƠSAHAA SADSKADSԠUNԠDSKADDSS DBADBUƠGԠADDSSƠDBU SBUADNAZŠUNԠDBUƠADDSS SBBU̠AҠDBU DAN6 SADNԠNAZŠUNԠDBUƠUN ASԠA- SAPGPGADNGAG- SԠҠPGBNDƠAD SҠ00-ADNԠSUŠPG SҠ0-MNAŠADNG SҠ0-ADBAYPGAM SNHԠBGԠSҬSԠNPUԠUN AGԠS SASKPƠMŠSϠAD MPSؠPSSNDƠADNDN SNDBPGMADGԠPGNPUԠDVҠADD ASSASKP-ADPGAMAP DBBADGԠBҠNPUԠDVҠADD SBPNADSԠNPUԠUNԠDVҠADD A SAGSԠԠAGGNŠ0 ADBNAYD DNDBABUƠABUƠADDҠƠBU SBBU̠AҠBU DADMAG PAPNAD SS MPPDV. DAN6 DBABU SBPNAD Ԡ000000 MPM MPPA. MPS PDV.DAN6 DBABUƠABUƠADDSSƠBU SBPNADɠGԠBNAYDMNPԠUN SZASԠҠDAMSNPU MPSҠNϠ-PSSD DAGGԠԠAG SZASKPƠMAؠ0ƠPMD MPDNGNŠ0DAMS MԠDAP DBMSSMSSADD: SBDKYɠPN: MPSNSԠSҬSԠNPUԠUNU PSSNPUԠD SҠA SAGSԠԠAGMAؠ0 DABU+GԠDDN AƬAҠAŠàϠנA ANDMSAŠ SAààDDNԠD SZASKPƠABSUŠD ADA6ADD-6B SSASSSԠҠà(5 MPҠNVADDYP SԠHKSUM DBBUƠGԠDNGH BƬBƠAŠϠנB MBNBSԠϠNG ADBP3ADD3ҠDUNԠNHKSUM SSBSSSԠҠSHԠ(3D MPҠSHԠ(-3DD SBDNԠSԠDDUN DABU+GԠD-NAZŠHKSUM DBABUƠABUƠA(BUƩ ADBP3SԠADDҠҠDƠU ADABɠADDDϠHKSUM NBNҠADD SZDNԠSKPƠNDƠD MP-3NNUŠHKSUMS PABU+SԠHGVNHKSUM MPDàPSSVADD NVADHKSUM PA.ŠDA0 SBҠPNԠҠMSSAG HԠ0BAԠҠPAҠNVBN DADMAGƠҠN PAPɘ+NADMASSSAG ASSHNSKP MPDNSŠADHŠD BMASSSAGŠS SBDMAGɠBAKSPA ԠN HԠD HԠAND MPDNADD ҠDA0 SBҠPNԠҠMSSAG HԠ0BAԠҠPAҠNVNN MPDNADD ASSYDSBYYP DàDAàGԠàDNԠD DBPGPGPGAMADNGAG PAPà?(NAM MPNAMҠPSSNAM SZBSKPƠNԠADNG MPNMҠDUԠƠSUN PAPà?(Nԩ MPNҠPSSNԠ PAP3à3?(DB̩ MPDBҠPSSDB̠ PAPà?(ԩ MPҠPSSԠ SKP PSSNDD ANASԠMASK ANDBU+SAŠMS AҠMVŠMSϠSGNPSN ҠD6ɠADDϠPYYP SAD6ɠSԠMSPYYP DADSKDGԠNԠDB̠ADDSS DBABUƠGԠADDSSƠBU SBADUԬɠUPUԠNDD DAADB̠GԠNԠDBSԠADDSS SAPADB̠SAVŠNDƠDBS AGԠMNANADD SAHAҠSԠUNԠ(MNVAU SԱDAMGԠMAؠANADD SAMAàSAVŠMAؠVAU DAABGԠADDҠƠDB̠S. SAADB̠SԠUNԠDBSԠADDSS SԲDAADB̠GԠADDSSƠNԠNY SZADB̠NҠADDҠҠNԠNY PAPADB̠NDƠS? MPS5YS-SԠҠNDƠS DBAɠGԠUNԠVAU MBNB ADBHAҠADDMNVAU SZBSSSKP-NԠUNԠVAU MPS3UPUԠUNԠD SSBSSSKP-GAҬUA̠ϠMN MPSԲGNŠSSHANMN DBAɠGԠUNԠVAU DABSAVŠVAUŠNA MBNB ADBMAàADDMAؠVAU MBSSBNBSZBSKP-NϠNנMA SAMAàSԠNנMA MPSԲGԠNԠVAU S3MAMPMNԠUNԠDBSԠADDSS ADAABADDADDҠƠDB̠S SADNԠSԠDB̠SԠDSPAMN DAPSԠDSKADDSS0 SBNDADɠNҠDB̠DSKADDSS SZDNԠSKP-NDƠSAHҠDB̠ MP-NҠDSKADDSS DBABUƠGԠADDSSƠBU SBADNɠGԠDMDSK SBDԠPAKPUԠUԠϠDSK DABU+MPU ANDMNGH ADABU+3PGAM SAH MPSԲGԠNԠVAU S5DAMAàGԠPVUSMA SAHAҠSԠNנMN PAMNDƠS?(NϠNנMAؠSԩ SS MPSԱNϠ-PSSNԠVAU A SAPGSԠPGADAGADNG SANGSԠAGҠBUԠNDUN DADSKDGԠADDSSƠNDD DBABUƠGԠADDҠƠBU SBADNɠGԠNDD SBDԠPAKPUԠUԠϠDSK DAHMPD? SZASSYS-SKP MPDNNϠ-GԠNԠN DBABUƠNPUԠNAMD SBADN DAHSŠNGH ҠMSGNNϠ SABU+6 DAHUPUԠNAM DBABUƠDAGAN SBADUԬ MPDNNנG NMҠDA03 SBҠPNԠҠMSSAG HԠ03BAԠҠPAҠNVNN MPDNADD SKP NAMDPSS NAMUfBU+3 NAM3UBU+ NAM5UBU+5 NPGUBU+6 NBPUBU+ NMUBU+ NYPUBU+9 NPϠUBU+0 NNԱUBU+ NNԲUBU+ NN3UBU+3 NNԴUBU+ NN5UBU+5 NN6UBU+6 NAMҠSZBSSSKPƠADNG MPNMҠDUԠƠSUN DABUƠGԠDNGH AƬAƠAŠϠנA PAPSԠҠNAMàDS MPSYPSԠNAMàҠ-GNAD PAP9SԠҠNAMà9DS SSYS-NNU MPҠNϠ-NVADDYP DAPGԠNנNAMàNGHD AƬAƠAŠϠHGHA SABUƠSԠNAMàNGHND SYPDANYPGԠUNԠPGAMYP SZASKP-UNԠYPŠSYSM MPNAMKDϠNԠSԠNAMDYP DADMAGƠNPUԠM PAPNADMASSSAG ASSGNҠHŠS AGԠSҠrPGAMYP AҬA AҠAŠϠנA ANDP5SAŠBS0-3 SANYPSԠPGAMYPŠNNAM SZAƠSYSMSԠPYϠZ DAP99 SANPϠSԠPY NAMKDBP3SԠDB̠DSKADDҠ03 SBDSKDSԠUNԠDB̠DSKADDSS B SBDSNԠAҠDSKSGMNԠUN SBNGAҠDSKSGMNԠUNԠAG SBPGSԠPGNԠADNG DAABGԠADDҠƠDB̠S. SAADB̠SԠUNԠDBSԠADDSS SBNDؠNAZŠDNԠADDSSS NNSBDؠSԠDNԠADDSSS MPNNAYS-NҠNAM DANAMGԠNAMŠ PADɠUA? SSYS-NNU MPNNNϠ-YNԠDN DANAM3GԠNAMŠ3 PADɠUA? SSYS-NNUō MPNNNϠ-YNԠDN DANAM5GԠNAMŠ5 ANDM00SAŠUPPҠHA PAD3ɠUA SSYS-NNU MPNNNϠ-YNԠDN DA0GԠҠDŠ-DUPAŠNAMS SBҠPNԠDAGNS DAP5 DBDGԠADDSSƠNAMŠNDN SBDKYɠPNԠDUPAŠPG.NAM MPPNAPAŠSԠƠDN NNADANAMGԠNAMŠ SADɠSԠNAMŠNDN DANAM3GԠNAMŠ3 SADɠSԠNAMŠ3NDN DANAM5GԠNAMŠ5 ANDM00SAVŠUPPҠHA SAD3ɠSԠNAMŠ5NDN DADNԠGԠADDSSƠNԠDN SAPDNԠSAVŠNԠDNԠADDSS PNADANYPGԠPGAMYP ANDMSAŠYP SAD6ɠSԠYPŠNDN DBNMGԠMMNNGH SBDɠSAVŠMMNNGH DBNBPGԠBPNGH SZBSSSKPƠBPNGHNN-Z MPSPҠSԠPY DA06GԠҠD SBҠPNԠDAGNS SPҠDANPϠGԠPY ANDMSAŠPY AƬAƠAŠϠUPPҠA ҠD6ɠADDPYϠYP SAD6ɠSԠPYYPŠNDN DADSKADDSKADUNԠDSKADD SAD5ɠSԠUNԠDSKADDҠNDN DBNPGMPD? SSBSSƠYSSKPSԠSH AHSŬAҠSH SAH DANNԱGԠSUND AƬAƠAŠϠUPPҠA AƬA̠AŠϠUPPҠ3BS ҠNNԲADDUNNVA SADɠSԠSUNDŬàMU DANN3GԠHUS AƬAƠAŠϠUPPҠA ҠNNԴADDMNUS SADɠSԠHUSMNUlS DANN5GԠSNDS AƬAƠAŠϠUPPҠA ҠNN6ADD0'SMSNDS SAD9ɠSԠSNDS0'SMSNDS A SAD0ɠAҠBSDNԠMANADDSS SBDԠPAKDUPUԠϠDSK MPDNGԠNԠD SKP DB̠àPSS DBҠDABU+3GԠANADDSS SAADB̬ɠSAVŠADDҠNDBS SZADB̠NҠDBSԠADDҠҠNԠNY DAADB̠GԠNԠDBSԠADDSS MANA ADAANDB̠ADDADDSSƠNDƠDB̠S SSASSSKP-DB̠V MP+3NϠDB̠V DAҲ0GԠҠDŠ-DB̠V SBҠPNԠDAGNS DADSKDGԠDB̠DSKADDSS DBABUƠGԠADDSSƠBU SBADUԬɠUPUԠDB̠D DADSKDGԠDSKADDSS SBNDADɠNҠADDSS SADSKDSԠNנDSKADDSS MPDNGԠNԠD SKP NԯԠDPSS NҠASSNԠPSS ҠAԠPSS SANGNGNԯԠAG DABU+SԠN.SYMBS ANDM3SAŠN.SYMBS MANA SANԠSԠSYMB̠UN DAABUƠABUƠA(BUƩ ADAP3P3+3 SNؠSASYMSԠSANGSYMB̠ADD NA SASYM3SԠHAS3ADD NA SASYM5SԠHAҠ5ADD SBNSԠNAZŠSԠADDSSS NرSBSؠSԠSԱ-S5 MPN3NDƠS DASYMɠGԠHAS PASԱɠUA? SSYS-NNU MPNرYNԠNY DASYM3ɠGԠHAS3 PASԲɠUA? SSYS-NNU MPNرYNԠNY DASYM5ɠGTRNԠHAҠ5 ANDM00SAŠUPPҠHA PAS3ɠUA? SSYS-NNU MPNرYNԠNY T  29015-80003 B S P0122 FH-RTGEN REAL TIME SYSTEM GENERATOR             H0101  DANGGԠNԯԠAG SZASSSKPƠN MPNشMPŠԠPSSNG PSSNԠ DASԴɠGԠDƠSԠNY SZASSSKPƠNN-ZϠ(DND MPNزMAKŠNYҠUNDND SSASKPƠNYMAD MPN6MAKŠNYҠBS DA05SԠDŠ-DUPAŠNYPN SBҠPNԠҠMSSAG DAP5 DBSԱSԱADDҠƠSYMB SBDKYɠPNԠDUPAŠNYSYMB MPNزGNŠDUPAŠN'S N6DAD6ɠGԠUNԠYP ANDMSAŠYP PAP3YPŠBGDSKSDN? SSYS-NNUŠ(ҩ MPNزMAKŠNYҠUNDND DAұ3SԠDŠNVADBGBSD SBҠVABŠ NزDADGԠMANDNԠADDSS SASԴɠNҠDNԠADDҠND MPN5 N3DASYMɠGԠHAS SASԱɠSԠHASNS DASYM3ɠGԠHAS3 SASԲɠSԠHAS3NS DASYM5ɠGԠHAҠ5 ANDM00SAŠUPPҠHA SAS3ɠSԠHAҠ5NS DAS5GԠD5ADD NA SAPSԠPSԠNԠSԠNYADDSS B SBS5ɠAҠD5NSԠNY(BH DANGGԠԯNԠAG SZASKPƠԠNY MPNزSԠDƠNԠNY DAD6ɠGԠYP ANDMSAŠYP DBDGԠMANDNԠADDSS PAP5YPŠBS? MBSSYS-SԠSԴBSƬSKP BNϠ-SԠSԴUNDND SBSԴɠYS-SԠADDSSNSԠD NشDAD6ɠGԠYP ANDMSAŠYP PAP5YPŠBGSGMN? SS:JYS-NNU MPN5NϠ-GNŠBGSGMANADD DADGԠUNԠDNԠADDSS SAMANSAVŠDNԠADDSS DASԴɠGԠDNԠADDSS SZASKPƠUNDND SSASKPƠDNԠADDSS MPN5GNŠUNDND SADNԠSԠDNԠADDSSҠD SBDؠSԠDNԠADDSSS HԠ0DNԠNԠUND DAD6ɠGԠYP SSASSSKPƠMAN MPNMANSԠAGҠGNNGBS ANDMSAŠYP PAP3YPŠBGDSKSDN? BSSSԠAGҠBSƬSKP NMANBSԠAGҠGNNGBS SBHAҠSԠAG0-GNůBS DAMANGԠUNԠDNԠADDSS SADNԠSԠҠNԠDNԠADDSSS SBDؠSԠUNԠDNԠADDSSS HԠ0ADDSSNVAD SZHAҠSKP-SԠDNԠADDҠҠBS MPN5GNŠƠNԠMANBGDSKS DASԴɠGԠBGMANADDSS SAD0ɠSԠMANDNԠADDҠNBSDN N5DASYMGԠSYMB̠ADD ADAP3ADUSԠҠBHNԠ DBNGGԠԯNԠAG SZBSKPƠԠNY NAADUSԠҠNԠà(-DNԩ SZNԠSԠSYMB̠UN MPSNؠPSSNԠSYMB SBDԠPAKDUPUԠϠDSK MPDNGԠNԠD SKP ŠààNDSK DԠPAKSHŠUNԠNNSƠBUƠNϠDBUƠANDDUMPS DBUƠHNԠNANS6DSƠAABŠNPU. ƠHŠNDDSBNGPSSDDԠSS PSSNGBAYPGAMSANDSSHŠN.ƠPAKD AABŠBAYDSND0ƠDNԠ USŠNMVNGHŠAABŠBAYϠHŠPD AAƠHŠDSKA^ҠHŠADNGPHASŠSMP. ANGSUN: AGND BGND SBD UN:NNSƠAANDBDSYD DԠNP DBABUƠGԠADDSSƠBU SBUA̠SAVŠUNԠBUƠADDSS DABUƠGԠDNGH AƬAƠAŠϠנA MANA SANԠSAVŠDNGHUN DDAUA̬ɠGԠDMBU SAUADɠSԠDNϠDBU SZDNԠSKPƠDBUƠU MPG̠SԠҠNDƠBU SBDDUԠUPUԠDBUƠϠDSK SSMԠUNԠDBUƠADDҠNMN G̠SZUADNҠUNԠDBUƠADDSS SZUA̠NҠUNԠBUƠADDSS SZNԠSKPƠBUƠMVDϠDBU MPDMVŠNԠDϠDBU DANGGԠNDAG SZASSSKPƠNDDAD MPDԬɠUN DADN PAN6BUҠMPY? SS SBDDUԠUPUԠϠDSK DAD6ɠGԠYP ANDMSAŠYP PAP5YPŠBGSGMN? MPDԬɠUN DADSNԠGԠA̠BҠDSKSҠUN SAD0ɠSԠA̠SҠUNԠNDN MPDԬɠUN SKP UPUԠDBUƠϠDSK HŠDDUԠSUBUNŠSHŠNNSƠDBUƠNH UNԠDSKS.NGHSDBUƠSAD HŠUNԠADDSSANDUNԠҠDBUƠAŠSԬ ANDHŠNԠDSKADDSSSSԠNϠDSKAD. ANGSUN: AGND BGND SBDDU UN:NNSƠAANDBAŠDSYD DDUԠNP DADSKADGԠUNԠDSKADDSS DBADBUƠGԠBUҠADDSS SBADUԬɠUPUԠDϠDSK DBADBUƠGԠADDSSƠDBU SBUADNAZŠDBUƠUNԠADDSS SBBU̠AҠDBU DAN6 SADNԠNAZŠUNԠDBUƠUN SZDSNԠUNԠD DADSKADGԠUNԠDSKADDSS SBNDADɠNҠUNԠDSKADDSS SADSKADSԠNנDSKADDSS MPDDUԬɠUN SKP PNԠMSSAGŬGԠPY HŠSUBUNŠPYNSHŠPNNGƠH MSSAGŬANGƠHŠNPUԠBUҬSNGҠHAAS ANSMDANDNAZANƠHŠBUҠSAN A̠NAZANMSSAGS. ANGSUN: ANϠHAAS(PS.NMSSAG BADDSSƠMSSAG SBPY UN:NNSƠAANDBAŠDSYD. PYNP SBDKYɠPNԠMSSAG DBABUƠGԠADDSSƠBU SBBU̠AҠBU DAP6 DBABUƠSԠBUҠADDSSҠNPU SBDYɠGԠPYMY SZASSSKPƠHAASANSMD MP-PAԠNPU SBAGNɬɠNAZŠBUƠSAN MPPYɠUN SKP NUMA̠NPUԠN HŠDNSUBUNŠANAYZSHŠNPUԠҠH HANN̠N.DSKSZSBGHANN̠N.ANDAS DƠAVAABŠMMY. ANGSUN: AMAؠN.ƠHAASPMDNSPNS. HŠSGNƠADMNSHŠNVSNM ASɠϠA̠(PS.ҠDMA̠(NG.. BGND SBDN UN: (N+:NNSƠAANDBAŠDSYD.ANNVAD HAAҠHASBNDDNHŠSPNSŬ HŠSPNSŠNANSANNVADN.HAAS. HŠMSSAGŠSϠBŠPADNUN. (N+:ANVDSU DNNP SBAGϬɠGԠA̯DMA̬UNA MP+NVADDG SBAGAɠGԠNԠHAҠMBU PAZϠHAҠZ?(NDƠBUҩ MP+3YS-NNU SBNҠNVADDGԠNY MPDNɠUN SZDNNҠUNADDSS DANϠGԠNVDNUMB MPDNɠUN SKP NVADYSPNS HŠNҠSUBUNŠPNSHŠDAGNSàҠNVAD SPNSSDUNGHŠNAZANSN. ANGSUN: AGND BGND SBN UN:NNSƠAANDBAŠDSYD. NҠNP DA0SԠNVADDVŠҠD SBҠPNԠҠMSSAG MPNҬɠUN SKP APHABàNPUԠN HŠSNԠSUBUNŠANAYZSHŠSPNSŠҠHŠPGAM BAYANDPAAMҠNPU. ANGSUN: AGND BGND SBSN UN: (N+:ANNVADSԠƠHAAS(NԠPԬMԬY ҠN.ƠHAASHASBNDD. AҠPNNGHŠDAGNSìAUNSMADŠ PMԠHŠMSSAGŠϠBŠPAD.HŠNNS ƠAANDBAŠDSYD. (N+:AADDSSƠDSGNADNPUԠDV BDSYD SNԠNP DANSԠMAؠN.DGSҠGNA SBAGNɠMVŠBUƠϠBU SBAGAɠGԠNԠHAҠMBU PAZϠHAҠZ?(NDƠBUҩ MP+3YS-NNU DNSBNҠNVADYSPNS MPSNԬɠUN- DABUƠGԠ-HAAҠD PAYYPYPŠY? MPYUNYS-UNԠSYP PAPYPYPŠPԠAD? MPPUNSԠUNԠPԠAD PAMYPYPŠMAGAP? MPMUNSԠUNԠMAGAP PADYPYPŠDSà? MPMUN-PSSASMAGAP. MPDNNVADPԬMԠҠY YUND}{ADYDYYNPUԠDVҠADDSS SS PUNDADPҠDPҠPԠADҠDVҠADD MPP.DV MUNAMԠҠD PADMAGDVҠADD? MPDNNϠ- SAMAGԠYS:AҠNDPMԠAG DADMAGDMAGMAGAPŠDVҠADD P.DVSZSNԠNҠUNADDSS MPSNԬɠUN SKP NSԠHN̠N.NNSUN HŠSDSKSUBUNŠSSHŠUNԠDSKHANN NS.NHŠɯϠNSUNS. ANGSUN: AN.DSϠBŠNGUD(NG. BADDSSƠNSUNADDҠS SBSDSK UN: ADSYD BNԠNSUNADDSS SDSKNP SADNԠSAVŠN.ƠNSUNS DABɠGԠNSUN ANDM00SAŠNSUND ҠDHN̠NSԠHANN̠N. SABɠSԠNSUNND NBNҠNSUNADDSS SZDNԠSKP-A̠NSUNSNG. MP-6NGUŠNԠNSUN MPSDSKɠUN SKP SԠUNDNDS HŠUNDNDNA̠NSANBŠSDA AHND--APŠNDNSDD. NGMPNƠHŠԠSNGHŠMPU HASϠPMԠHŠPAҠϠUNҠADDNA PGAMNPUԬҠNNUŠHHŠPSSNGƠPAAMS. SؠSBSPAŠNנN SBSPAŠNנN A SANNԠSԠSYMB̠UNԠ- SBNSԠNAZŠSԠADDSSS UNؠSBSؠSԠSԱ-S5 MPUԠNDƠS DASԴɠGԠDƠS MASSANASZASKPƠUNDNDҠBS MPUNؠYNԠSԠSYMB SZNNԠSԠҠSԠUNDƠ MPUؠNϠ-PUԠUԠSYMB̠NAM DAP0 DBMSSMSSADD:UNDƠS SBDKYɠPN:UNDƠS SBSPAŠNנN UؠDAP5 DBSԱSԱA(SYMB̩ SBDKYɠPNԠSYMB MPUNؠYNԠSYMB UԠSZNNԠSԠҠNϠUNDƠS MPNDؠNϠ-MԠMSSAG DAP DBMSS9MSS9ADD:NϠUNDƠS SBDKYɠPNԠMSSAG NDؠSBSPAŠNנN HԠBAԠҠPAҠNVNN AGԠSHGS SASSSKPƠSH0UP MPSNSԠҠPGAMҠBҠAD ASԠDSàHGH SADSKAϠZ SASHSԠSHDUDPGMAGϠZ DAMAGԠƠMԠҠDƠUSD SZAҠNPUԬSKPϠND MPPAMɠNϬNAŠPAAMҠNPU.$$ SBDMAGɠNDSANDBY Ԡ5MԠҠD.$$ MPPAMɠNAŠPAAMҠNPUԠSN SKP 0ASà0NVADYPY 0ASà0HKSUM 03ASà03DUԠƠSUN 0ASà0NVADD 05ASà05DUPAŠNYPNS 06ASà06NVADNAMà-BPNGH 0ASà0DUPAŠPGAMNAMS ұ3ASà3BGSGMNԠPDSBGMAN Ҳ0ASà0DB̠SԠV YYPASàY PYPASàP MYPASàM DYPASàD MSSDƠ+ ASàSYSDSàSZ? MSSDƠ+ ASàHDSàHN? MSS3DƠ+ ASà5AMM? MSSDƠ+ ASà5PGMNP? MSS5DƠ+ ASà5BҠNP? MSS6DƠ+ ASà5PAMNP? MSSDƠ+ ASà MSSDƠ+ MSS9DƠ+ ASàNϠUNDƠS MSDƠ+ ASàN.PD? MS30DƠ+ ASà5BGHN? MS3DƠ+ ASà5SAPPNG? MS3DƠ+ ASàUNƠDSÑ)PԠ-PSSUN MS33DƠ+ ASàAUؠDSàSZ? HPDSKDƠ+ɠHGHPYHANN̠NS. DƠNKG DƠDMA DƠDSK3 DƠDSK DƠDSKB נPYHANN̠NS. DƠDSK DƠDSK DƠDSK5 DƠDSK6 DƠDSK DƠDSK9 DƠDSKAG DƠDSK YHAҠASàY NHAҠASàN DHN̠BSSDSKɯϠHANN̠N.(A̩ PGMADBSSPGAMNPUԠDVҠADDSS BADBSSBNPUԠDVҠADD PNADBSSNPUԠDVҠADDSS GBSSNDAPŠAG-0GNMA NGBSSBUԠNDAG àBSSDDNAND SYMBSSHAҠADD SYM3BSSHAҠ3ADD SYM5BSSHAҠ5ADD NNԠBSSUNDNDSYMB̠UN ABDƠAؠDNŠADDSSSƠSAԠANDND ANDB̠ABS56BHŠDB̠SԠAA. ADB̠BSSUNԠDBSԠADDSS PADB̠BSSADDSSƠNDƠDBS G SKP G000B SԠPAAMSNϠDNS HŠPAAMҠNPUԠSNPMSAAN(ҠNDUN ƠHŠYPŬPYANDUNNVA̠ҠAHPGAM. AHPAAMҠDHASNŠƠHŠNGMAS: NAMŬYP NAMŬYPŬPY NAMŬYPŬPYUNNVA YPŠDMA̠DGS(-99 PYDMA̠DGS(0-99 UNNVA̠6PANDS -SUNDŠ(DMA̠DGS -UNMUPŠ(5DMA̠DGS 3-HUS(DMA̠DGS -MNUS(DMA̠DGS 5-SNDS(DMA̠DGS 6-0'SMSNDS(DMA̠DGS N:YPŠƠBGDSKSDNSHAVNGBGSGMNSMAYN BŠADHUԠDSYNGANSHP. PAAMSBSPAŠNנN DAP0 1 DBMSMSADD:PAAMS SBDKYɠPN:PAAMS SBSPAŠNנN DBPAADGԠPAAMNPUԠDVҠADDSS PBDYNPUԠUNԠY? SSYS-NNU HԠBAԠҠNSNƠPAAMS PASԠDBABUƠGԠADDSSƠBU SBBU̠AҠBU DAP6 DBABUƠGԠADDSSƠBU SBPAADɠGԠASɠPAAMҠD SZASSSKPƠHASNPU MP-PAԠPAAMҠNPU SAPANϠSAVŠPAAMҠDNGH SBGNԠNAZŠBUҠSAN DAN5 SBGNAMVŠHASMBUƠϠBU PAPMHAS? MPSBYS-SԠBAYYPŠNDN SBGA̠GԠNԠHAҠMBU PABANKHAҠBANK?(DMҠMMA MP+3YS-NNU PANҠDA09PAAMҠNAMŠ MPPA SBNDؠNAZŠDNԠADDSSS NDSBDؠSԠUNԠDNԠADDSSS MPPANҠYS-NVADNAM DADɠGԠNAMŠ PABUƠUA? SSYS-NNU MPNDNϠ-YNԠDN DADɠGԠNAMŠ3 PABU+UA? SSYS-NNU MPNDNϠ-YNԠDN DAD3ɠGԠNAMŠ5 ANDM00SAŠUPPҠHA PABU+UA? SSYS-NNU MPNDNϠ-YNԠNAM SԠYP DAN SBGàNVԠϠA MPPAҠNVADDG SBGA̠GԠNԠHAҠMBU PAZϠHAҠZ?(NDƠBUҩ SSYS-NMU PABANKHAҠBANK?(DMҠMMA MPSYPSԠPGAMYPŠNDN PAҠDAұ0PAAMҠYPŠ MPPA  SYPBƠHSSHŠSHDUDPGM DADAGAN PASHHN SBSHAҠSAG DBNϠGԠNVDNUMB DAD6ɠGԠPVUSYP ANDM600SԠPVUSYPŠZ ҠBNSԠNנYP SAD6ɠSԠNנYP DBDPSԠBϠDNԠADDSS ANDM0MASK0BS PAM0S? SSYS-SKP MPSYNϠ-NNU ҠD6ɠZϠ0BSAND SAD6ɠSԠDN SSASSƠSUBUNŠGN MPSYGNҠSUBUN ANDMGԠYPŠϠA SZAƠZϠ ADAN5MŠHAN SSASKP SBSHSŠSԠPGMDNԠNSHAG SYSBGA̠GԠNԠHAҠMBU PAZϠHAҠZϠ?(NDƠBUҩ MPPASԠYS-GԠNԠPAAMҠD SԠNנPGAMPY DANSԠUNԠҠDMA̠NVSN SBGàNVԠϠA MPPAPҠPY SBGA̠GԠNԠHAҠMBU PAZϠHAҠZϠ?(NDƠBUҩ SSYS-NNU PABANKHAҠBANK?(DMҠMMA MPSNҠSԠPY PAPҠDAұPAAMҠPY MPPA SNҠDAD6ɠGԠYP ANDMSAŠYP DBNϠGԠPY SZBSSSKP-PYND DBP99PAŠZϠPYH99 SZASSSKP-NԠSYSMPGAM BSԠSYSMPYϠZ BƬBƠAŠPYϠUPPҠB DAD6ɠGԠPVUSPY ANDM3SAŠPYSԠϠZ ҠBNSԠNנPY SAD6ɠSԠNנPY SBGA̠GԠNԠHAҠrMBU PAZϠHAҠZϠ?(NDƠBUҩ MPPASԠYS-GԠNԠPAAMҠD GԠSUND DANSԠҠDMA̠DGS SBNԠGԠDGSMBU AƬAƠAŠϠUPPҠA AƬA̠AŠϠUPPҠ3BSNA ANDM600SAŠUPPҠ3BSNA SADɠSԠNDNԠ GԠUNMUP DAN5SԠUNԠҠDMA̠NVSN SBNԠGԠDGSMBU ANDM600SAŠUPPҠ3BSNA SZASKPƠVADMUP MPPAҠNVADUNNVMA DANϠGԠNVDNUMB ҠDɠADDϠSUND SADɠSԠNDNԠ GԠHUS DANSԠҠDMA̠DGS SBNԠGԠDGSMBU AƬAƠAŠϠUPPҠA SADɠSԠNDNԠ GԠMNUS DANSԠҠDMA̠DGS SBNԠGԠDGSMBU ҠDɠADDϠHUS SADɠSԠNDNԠ GԠSNDS DANSԠҠDMA̠DGS SBNԠGԠDGSMBU AƬAƠAŠϠUPPҠA SAD9ɠSԠNDNԠ9 GԠNSƠMSNDS DANSԠҠDMA̠NVSN SBGàNVԠϠA MPPAҠNVADDG SBGA̠GԠNԠHAҠMBU PAZϠHAҠ0?(NDƠBUҩ SSYS-NNU MPPAҠNϠ-NVADDM DANϠGԠNVDNUMB ҠD9ɠADDϠSS SAD9ɠSԠNDNԠ9 MPPASԠGԠNԠPAAMҠD pUNNVA̠NPUԠN NԠNP SBGàNVԠϠA MPPAҠNVADDG SBGA̠GԠNԠHAҠMBU PABANKHAҠBANK?(DMҽMMA SSYS-NNU MPPAҠNϠ-NVADDM DANϠGԠNVDNUMB MPNԬɠUNHNUMBҠNA PAҠDAұPAAMҠNVA̠ PAҠSAMPŠSAVŠҠD SBPNԠSԠҠPNNGBU DAMPŠGԠҠD SBҠPNԠҠMSSAG SBSPAŠNנN MPPASԠADPAAMҠD PNԠBUƠUNSSMY PNԠNPPNԠNNSƠBU DBPAADGԠADDSSƠPAAMҠUN PBDYDVŠY? MP+YS-MԠPNNGNY DAPANϠPANϠPAAMҠDNGH DBABUƠABUƠBUҠADDSS SBDKYɠPNԠPAAMҠD MPPNԬɠUN SBSBPNԠSԠҠPNNG SBSPAŠNנN SKP SԠBAYMYPŠAS HSSNSUDHNHŠPAAMSHAV BNMPYADN.ԠMPUSHŠMAMUMNGH BHHŠA̠MŠANDBAKGUNDMMNAAS. NADDNԠDMSHSŠBAYPGAMSMBAY(6 ϠUY(ƠHYHAVŠNԠBNADBYSDNԠPGAMS. NAYԠSVSA-DSNƠDŠҠAHUS PGAM(PUSANADDNA̠6DSƠDSKSDNԩ GNAŠHŠDSGMNS.NAYԠSVSAKYD NANHŠADDSSƠAHDSGMN. ԠASϠSSUPHŠDNԠADDSSƠHŠPGAM BŠADDUSԠPҠϠHŠPGAMϠBŠPUԠNH SHDUDSԬƠANY. A SAKYNAҠA̠KYDUN = SASNԠAҠSHԠDSGUN SANԠAҠNGDSGUN SAMԠAҠԠMNGH SAMBGAҠBGMNGH SBNDؠNAZŠD SؠSBDؠSԠDNԠADDSSS MPMNMNAŠDSGMNԠUN DAD6ɠGԠYP ANDMSAŠYP DBDɠGԠMMNNGH PAPYPŠԠSDN? MPSàSԠԠMMNNGH PAPYPŠԠDSKSDN? MPSàSԠԠMMNNGH PAP3YPŠBGDSKSDN? MPSBàSԠBGMMNNGH PAPYPŠBGSDN? MPSBàSԠBGMMNNGH PAP5YPŠBGSGMN? MPSBàSԠBGMMNNGH PAZϠYPŠSYSM? SSYS-NNU PAP6YPŠBAY? SZBSSSKP-HASNVADMMN MPSؠPSSNԠDN DA3SԠDŠNVADMMN SBҠPNԠDAGNS DAP5 DBDGԠDNԠADDSS SBDKYɠPNԠPGNAMŠҠNVADM MPSؠPSSNԠDN SBàDAMBGGԠPVUSMAؠMMNNGH MANA ADABSԠAPGM-PVUSM SSASSSKPƠPVUSGA SBMBGSԠNנMAؠBGMMNNGH DAD6ɠGԠMS SSASSSKPƠMAN MPSؠPSSNԠDN SZKYNNҠA̠KYDUN ANDMSAŠYP PAPYPŠBGSDN? MPNSàYS-UNԠSHԠDSGMN NàSZNԠNҠA̠NGDSGMNԠUN MPSؠPSSNԠDN NSàSZSNԠNҠA̠SHԠDSGUN MPSؠPSSNԠDN SàDAMԠGԠPVUSMAؠMMNNGH MANA ADABSԠ6zTRNAPGM-PVUSM SSASSSKPƠPVUSGA SBMԠSԠNנMAؠԠMNGH DAD6ɠGԠMS SSASSSKPƠMAN MPSؠPSSNԠDN SZKYNNҠA̠KYDUN ANDMSAŠYP PAPYPŠԠSDN? MPNSàYS-UNԠSHԠDSGMN MPNàNϠ-UNԠNGDSGMN %eT  29015-80004 B S P0122 FH-RTGEN REAL TIME SYSTEM GENERATOR             H0101  MNSBSPA DAP3 DBMSMSADD:ƠBANKD'S$$ SBAADɠPNԠANDGԠPY DANGԠ$$ SBGàDMA̠DGSNVԠ$$ MPM-NVADNPU.$$ SZASSƠZϬADD$$ NAҠBKG.N-NŠADNG.$$ SABSAVŠ.$$ ADANԠADDϠNGDSGMNԠUN.$$ SANԠ$$ ADBKYNADDϠKYDUNԬ$$ NBADDҠMNA.$$ SBKYN$$ SBASHƬɠSԠUPHŠSHDUŠPGMPAAMS DAAAPGԠADDSSƠADNGSN SAANSSԠANSҠADDSSϠAD MPAAPɠADABSUŠSYSM MDAM3PNԠ$$ SBҠ"Ҡ0"$$ MPMN+ M3ASà0$$ SKP AҠUNDNDS PASSBNSԠNAZŠS S3SBSؠSԠSԠADDSSS MPNDBSԠUSAGŠAGS DASԴɠGԠDNԠADDSS SSASSSKP-UNDND MPS3GNŠDNDNYPN A SASԴɠAҠDNԠADDSS MPS3YNԠSԠNY HSUNŠSADAҠHŠSYSMSADDBUԠBŠH BAY. SPà AҠADAGSҠYPŠ6PGMS 6NP SBNDؠNAZŠD SؠSBDؠSԠDNԠADDSSS MP6ɠNDƠDNS DAD6ɠGԠYP ANDMSAŠYP PAP6YPŠBAY? SSYS-NNU MPSؠPSSNԠDN DAD3ɠ YPŠ6-GԠADAG AҬŬAADBԠϠŠ-ANDAD SAD3ɠSԠADAG SZSSASԠADD? MPSؠNϠ-NNU DA39YS-GA̠SYSMN SBҠҠ39 DAP5NנSNDHŠNAM DBDƠHŠADPGM SBDKY SPà SBNSԠNAZŠS SUؠSBSؠSԠUNԠSԠADDSSS MPSؠND-NNUŠDSAN DASԴɠGԠDNԠADDSS PADNԠBNGSϠUNԠPG? ASSYS-NNU MPSUؠNϠ-YNԠN SAS5ɠSԠNKϠZ. MPSUؠNNUŠSAH SPà DM̠NPDMŠUNADYPŠ6ϠYPŠ DABDNԠSԠUPHŠSAN SADNԠPAAMS DAP6ҠYPŠ6 SAPYPŠSAN DMSSBADSNɠGϠSԠDADDSSS MPDM̬ɠND-SϠUN DBD3ɠASPGM SBSSADD? SZD6ɠNϻHANGŠϠYPŠ. MPDMSYSNϠNNUŠSAN NDBDAAPASGԠADDҠƠPAAMҠNPUԠD SAANSSԠNA̠ANSҠADDSS MPPAAMGԠPAAMS SKP GNAŠɯϠABS HSSNƠDŠGNASHŠɯϠABS ҠHŠSYSM.HSŠNUDŠHŠUPMNԠABŠ(ԩ SANDADDVŠNŠABŠ(DԩANDNUPԠAB. HŠԠDSHAVŠHŠNGMA: NDVN (16 BIT WORD) * (I.E.,XXB,2XXB,OR 20XXB, WHERE "XX" IS * THE PRINTER LU) * * IF "H"=0, THE "V" BIT, IF SET, ENABLES * THE PRINTING OF THE FIRST CHARACTER IN * THE USER'S BUFFER. IF BOTH "H" AND "V" * ARE ZERO, THE FIRST CHARACTER IN THE * BUFFER IS USED FOR VERTICAL FORMAT CON- * TROL, AS FOLLOWS: * ::=SINGLE SPACE * 0::=DOUBLE SPACE * 1::=PAGE EJECT * *::=SUPPRESS SPACE * OTHERS::=SINGLE SPACE * AN 81 CHARACTER REQUEST LENGTH IS AL- * LOWED IN THIS MODE, SINCE THE FIRST * CHARACTER IS USED FOR FORMAT CONTROL. * * IF "H"=1, HONESTY MODE IS SPECIFIED. * THE CHARACTER STRING IS OUTPUT TO THE * PRINTER, AND THE USER IS RESPONSIBLE * FOR SUPPLYING HIS OWN CR, LF, OR FF * CHARACTERS. AN LF OR FF RESULTS IN AN * AUTOMATIC CR. IF THE LINE EXCEEDS 80 * CHARACTERS, ANY ADDITIONAL ONES WILL * WILL BE DISCARDED UNTIL A CR, LF OR * FF IS FOUND. * IBUFR=USER BUFFER ADDRESS * IBUFL=USER BUFFER LENGTH (POSITIVE FOR WORDS AND * NEGATIVE FOR CHARACTERS) * * * * * * * NAM DVR12 29028-60002 780103 REV 1805 ENT I.12,C.12 SKP * ENTRY/EXIT OF INITIATION SECTION SPC 2 I.12 NOP ENTRY/EXIT JSB SETIO CONFIGURE DRIVER A2700 CLA,CCE STA IC12 I.12 ENTRY FLAG STA EQT9,I STA EQT10,I CLEAR EQT TABLE AREAS LDB A3 SET REJECT CODE IN B JSB STAT CHECK STATUS JMP EXIT EXIT REJECT LDA EQT6,I FETCH CONTROL WORD AND A3 BITS 3-0 ARE REQUEST CODE CLB,INB SET REJECT CODE IN B CPA A2 PRINT REQUEST? JMP PRINT YES CPA A3 CONTROL REQUEST? JMP CNTRL YES EXIT LDA B REASON FOR EXIT IN B JMP I.12,I EXIT SKP * PROCESS CONTROL REQUEST SPC 2 CNTRL LDA EQT6,I FETCH CONTROL WORD ALF,ALF RAL,RAL AND A77 LDB A2 SET EXIT CODE CPA A11 LEGAL CONTROL REQUEST? JMP CNTR1 YES CPA A15 CONDITIONAL FORM FEED? RSS YES JMP EXIT NO, EXIT CLA,INA CPA COUNT AT TOP OF PAGE? JMP EXIT4 YES - BAIL OUT JMP PGEJT+1 NO - THEN GO TO TOP * CNTR1 LDA EQT7,I FETCH PARAM SSA PAGE EJECT? JMP PGEJT YES CMA,INA ADA D63 SSA UNDEFINED REQUEST? JMP EXIT4 YES, TAKE IMMED. COMPL. EXIT LDB EQT7,I SZB PARAM = 0? JMP SIM NO, GO PROCESS CONTROL REQUEST LDA EQT11,I YES, SET * FOR IOR A100 NEXT STA EQT11,I REQUEST EXIT4 LDA A4 IMMEDIATE COMPLETION JMP I.12,I EXIT SKP * PROCESS PRINT REQUEST SPC 2 PRINT LDB EQT7,I CONVERT BUFFER WORD ADDRESS RBL TO STB EQT7,I CHARACTER ADDRESS CLA LDB EQT8,I CONVERT NUMBER OF CHARACTERS OR CCE,SSB WORDS TO NEGATIVE CHARACTERS JMP *+3 CMB,INB BLS,CLE ERA SET B15 OF EQT11 TO INDICATE IOR EQT11,I REQUESTED WORDS OR CHARACTERS STA EQT11,I BACK STB EQT8,I SAVE COUNT ADB DM1 STB EQT9,I SET EQT9 TO ONE LESS INB LDA HFLAG HONESTY? IF SO, DON'T TRUNCATE SZA INPUT BUFFER TO 80 CHARACTERS JMP MUOUT ADB D80 LDA VFLAG TEST FOR "V" BIT SET SZA,RSS IF NOT SET, ALLOW 81 CHARACTERS INB SSB,RSS MAX OF 80 CHARS? JMP AWAY YES LDB D80 NO, SET TO 80 SZA,RSS IF "V" BIT NOT SET, SET CHARS TO 81 INB CMB,INB JMP BACK AWAY CPA A200 "V" BIT SET ? JMP MUOUT YES, OUTPUT CHARS JSB CHA FETCH FIRST CHAR (COLUMN 1) JMP ONELN NO MORE CHAR, EXIT CPB STAR *? JMP STARR YES LDA A200 CPB A60 0? (DOUBLE SPACE?) JMP DBSPC YES CPB A61 1? (PAGE EJECT?) RSS JMP MUOUT NO STA DBFLG YES JMP PGEJT DBSPC STA DBFLG JMP ONELN SEND SINGLE SPACE SPC 2 STARR LDA EQT11,I IOR A100 STA EQT11,I SET STAR NOW FLAG SPC 2 MUOUT JSB CHA FETCH CHARACTER JMP DONE ALL CHARS OUT JSB LFFCR CHECK FOR LF, FF, OR CR SZA,RSS JMP MU.1 NOT SPECIAL CHARACTER CPA A1 IS IT A LF? JMP LFX YES CPA A2 CR? JMP LFX+1 YES - OUTPUT IT CLA,INA FF - RESET LINE COUNT STA COUNT RSS LFX JSB LNCNT KICK LINE COUNTER FOR LF LDA DM81 STA EQT13,I RESET CHARACTER POINTER MU.0 LDA DM20 CHARACTER IS LF OR FF,SO  STA EQT12,I RESET BUFFER COUNT JMP OTB1 AND OUTPUT LF OR FF MU.1 ISZ EQT13,I 81ST CHARACTER? JMP MU.2 NO - OUTPUT IT CCA YES - RESET EOL COUNTER STA EQT13,I JMP MUOUT AND THROW CHARACTER AWAY MU.2 ISZ EQT12,I USE INTERRUPT EXIT? JMP OTB2 NO JMP MU.0 YES OTB2 OTB CH OUTPUT CHARACTER STC2 STC CH,C NOP DELAY 3 CYCLES BEFORE CHECKING JSB STAT STATUS JMP REJ JMP MUOUT SPC 2 DONE LDA HFLAG HONESTY? SZA NO - CONTINUE JMP EOLFN YES - GO TO COMPLETION LDA EQT11,I AND A100 SZA,RSS * NOW? JMP ONELN NO LDA EQT11,I YES, CLEAR AND A1767 * NOW STA EQT11,I AND JMP CARTN SEND HOLD SPC 2 CHA NOP FETCH CHARACTER ISZ EQT9,I MORE CHARACTERS? RSS JMP CHA,I NO, RETURN TO P+1 LDA EQT7,I CLE,ERA LDA A,I ISZ EQT7,I SEZ,RSS ALF,ALF AND A377 STA B JSB LFFCR LF, FF, OR CR? SZA JMP QRS+1 YES - SKIP VALIDITY CHECK LDA B ADA AM40 SSA CHAR < 40? JMP QRS YES ADA AM140 SSA,RSS CHAR > 177? QRS LDB A100 YES, OUTPUT @ SYMBOL ISZ CHA JMP CHA,I RETURN P+2 WITH CHAR IN B SPC 2 SIM CMB,INB SIMULATE TAPE LEVEL FORMAT STB EQT10,I ADB D55 SSB,RSS CARRIAGE CONTROLS 1-67B? JMP CLOP YES, LINE ADVANCE CMB NO, SIMULATE TAPE ADB TA LDA COUNT GET CURRENT LINE COUNT ADA B,I SUBTRACT INCREMENT SSA,RSS OVERFLOW? JMP *-2 NO - REPEAT STA EQT10,I YES - SAVE NEW INCREMENT CMA,INA ADA COUNT ADA DM60 IS TOTAL COUNT >60? SSA,RSS JMP PGEJT YES - PAGE EJECT BZJMP CLOP NO - OUTPUT REQUIRED NUMBER OF LINES SPC 2 TA DEF *+1 DM1 DEC -1 ONE LINE DEC -2 DOUBLE LINE DEC -3 TRIPLE LINE DEC -30 HALF PAGE DEC -15 QUARTER PAGE DEC -10 SIXTH PAGE DEC -59 PAGE BOTTOM DM60 DEC -60 PAGE EJECT SPC 2 PGEJT CLA,INA PAGE EJECT STA COUNT RESET LINE COUNT CLA STA EQT10,I LDB A14 JMP OTB1 CARTN LDB A15 JMP OTB1 ONELN CCA ONE LINE SPACE STA EQT10,I CLOP JSB LNCNT INCREMENT LINE COUNTER LDB A12 ISZ EQT10,I NOP OTB1 OTB CH JSB PAK PACK DATA INTO EQP TABLE STC1 STC CH,C CLA CPA IC12 JMP I.12,I OPERATION INITIATED STA IC12 ISZ C.12 JMP C.12,I CONTINUATION EXIT SKP * ENTRY/EXIT OF COMPLETION SECTION SPC 2 C.12 NOP ENTRY/EXIT ISZ IC12 C.12 ENTRY FLAG JSB SETIO CONFIGURE DRIVER JSB STAT CHECK STATUS JMP REJ EXIT REJECT CLA CPA DBFLG DOUBLE SPACE OR PG EJ? JMP *+3 NO STA DBFLG YES, RESET FLAG AND JMP MUOUT OUTPUT CHARS CPA EQT10,I MORE SPACES TO SIMULATE? RSS NO JMP CLOP YES CPA EQT9,I MORE CHARACTERS? RSS NO JMP MUOUT YES EOLFN JSB PAK LDB EQT8,I READY THE TLOG SSA CONVERT TO WORDS OR CHARACTERS JMP *+3 AS REQUIRED CMB,INB BRS CLA CLC CLC CH CLEAR CONTROL CPA HFLAG HONESTY? JMP C.12,I NO - EXIT P+1 CPA IC12 YES - CHECK IC12: IF STILL IN JMP EXIT4 INITIATOR, EXIT W/ IMMED. COMPL. JMP C.12,I EXIT P+1, COMPLETION RETURN REJ LDA A3 REJECT EXIT CODE CLB CPB IC12 JMP I.12,I INITIALIZATION RETURN STB IC12 CLA,INA JMP C.12,I COMPLETION RETURN SKP SPC 2 * SUBROUTINES AND CONSTANTS SPC 2 UNPAK NOP UNPACK EQT TABLE LDA EQT6,I AND A200 STA VFLAG SET VFLAG IF "V" BIT IS SET LDA EQT11,I AND A77 SZA,RSS SET 0 = 1 CLA,INA STA COUNT PRINTER LINE COUNT POINTER LDA EQT11,I AND A200 STA DBFLG DOUBLE LINE SKIP FLAG LDA EQT6,I CHECK FOR HONESTY ALF,RAL SSA,RSS CLA IF NOT, CLEAR HFLAG STA HFLAG IF SO, SET HFLAG SZA,RSS IS HFLAG SET? JMP *+3 NO UP1 RSS JMP UNPAK,I YES - EXIT LDB DM20 -20 DECIMAL CHAR STB EQT12,I PRINT BUFFER CHARACTER POINTER LDB DM81 NO HONESTY, SO RESET CHAR PNTR STB EQT13,I CLA STA UP1 NOP UP1 AFTER FIRST PASS JMP UNPAK,I SPC 2 PAK NOP PACK EQT TABLE LDA EQT11,I AND A1025 IOR COUNT IOR DBFLG STA EQT11,I JMP PAK,I SPC 2 LNCNT NOP INCREMENT LINE COUNT LDA COUNT INA CPA D61 CLA,INA RESET LINE COUNT STA COUNT JMP LNCNT,I SPC 2 SETIO NOP CONFIGURE DRIVER IOR LIA SELECT CODE IN A STA STAT1 ADA A1200 STA STC1 STA STC2 ADA A2700 CLA,CLE STA OTB1 STA OTB2 ADA A100 STA CLC JSB UNPAK SET ALL EQT CONSTANTS IN PRG JMP SETIO,I EXIT SPC 2 STAT NOP FETCH STATUS STAT1 LIA CH INPUT HARDWARE STATUS SZA,RSS HARDWARE BUSY OR NOT READY? ISZ STAT NO, RETURN P+2 JMP STAT,I YES, RETURN P+1 SPC 2 LFFCR NOP LF, CR, OR FF CHECK ROUTINE LDA HFLAG SZA,RSS HONESTY? JMP LFFCR,I NO - RETURN A=0 CLA CPB A12 IF LF, SET A=1 0.*INA CPB A15 IF CR, SET A=2 LDA A2 CPB A14 IF FF, SET A=-1 CCA JMP LFFCR,I SPC 2 LIA LIA 0 A1 OCT 1 A2 OCT 2 A3 OCT 3 A4 OCT 4 A11 OCT 11 A12 OCT 12 A14 OCT 14 A15 OCT 15 A60 OCT 60 A61 OCT 61 A77 OCT 77 A100 OCT 100 A200 OCT 200 A377 OCT 377 A1025 EQU LIA A1200 OCT 1200 A1767 OCT 177677 AM40 OCT -40 AM140 OCT -140 D55 DEC 55 D61 DEC 61 D63 EQU A77 D80 DEC 80 DM20 DEC -20 DM81 DEC -81 IC12 NOP COUNT NOP VFLAG NOP DBFLG NOP HFLAG NOP STAR OCT 52 SPC 2 A EQU 0 B EQU 1 CH EQU 10B SPC 2 EQT1 EQU 1660B RTE EQT1 EQT6 EQU 1665B RTE EQT6 EQT7 EQU 1666B RTE EQT7 EQT8 EQU 1667B RTE EQT8 EQT9 EQU 1670B RTE EQT9 EQT10 EQU 1671B RTE EQT10 EQT11 EQU 1672B RTE EQT11 EQT12 EQU 1771B RTE EQT12 EQT13 EQU 1772B RTE EQT13 END GS0  29030-80001 1710 S 0122 HP2892A CARD READER RTE DRIVER DVR11             H0101 HNASMB,R HED * RTE HP2892A CARD READER DRIVER, DVR11 *** NAM DVR11 29030-60001 REV 1710 3-1-77 ENT I.11,C.11 EXT $UPIO * SUP * SPC 4 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * ***HP 2892A RTE DVR 11*** * * SOURCE TAPE: 29030-80001 * RELOC. TAPE: 29030-60001 * SMALL PROG.MANUAL: 29030-95001 * * REVISION B * JUNE 1974 A.M. WERNICK * * REV. 1710 3-1-77 * * * THIS DRIVER CAN CONVERT EITHER EBCDIC OR BCD CARDS: SPC 1 * WHEN CONFIGURING THIS DRIVER INTO RTE SYSTEM, * ASSIGN CARD READER THREE LOGICAL UNIT NUMBERS * LU#N = READER,SUBCHANNEL 0 * LU#M = READER,SUBCHANNEL 1 * LU#L = READER,SUBCHANNEL 2 * TO CONVERT EBCDIC PUNCH SET - ADDRESS READER AS SUBCHANNEL 0 * TO CONVERT BCD PUNCH SET - ADDRESS READER AS SUBCHANNEL 1 * TO CONVERT EBCDIC-RDTS PUNCH SET - ADDRS READER AS SUBCHN 2 SPC 2 * THIS CARD READER DRIVER PROCESSES READ AND CONTROL REQ'S. * WRITE REQ'S AND ILLEGAL CONTROL REQ'S ARE REJECTED. SPC 1 * TO PROCESS A READ, STATUS IS FIRST CHECKED. IF IT IS * "OK TO PICK" A PICK COMMAND IS ISSUED AND A DMA TRANSFER * IS BEGUN. IF STATUS IS NOT "OK TO PICK" A NOT READY * RETURN IS MADE TO THE SYSTEM. * THE DMA TRANSFER IS INTO THE DRIVER'S INTERNAL BUFFER. * THE DRIVER IS ENTERED UPON DEVICE CONTROLLER INTERRUPT. * THE CARD DATA IS CONVERTED FROM COLUMN IMAGE TO THE FORMAT * * SPECIFIED BY THE READ REQUEST AND STORED INTO THE CALLING * PROGRAM'S BUFFER. * THE THREE FORMATS A READ REQUEST CAN SPECIFY ARE: * ASCIIu SUBFUNCTION 0 * PACKED BINARY SUBFUNCTION 3 * COLUMN BINARY SUBFUNCTION 1 SPC 1 * NO CONTROL REQUESTS ARE PROCESSED * * * *****EQT USAGE***** * * EQT5 STATUS BITS HAVE THE FOLLOWING * MEANINGS WHEN SET TO 1 : * * BIT 0 CARD READER IS ON LINE BUT NOT READY * OR CARD READER IS OFF LINE. * BIT 1 AN ILLEGAL CARD CODE WAS ENCOUNTERED * DURING THE PREVIOUS READ OPERATON OR * THE CARD READER HAD HARDWARE TROUBLE. * BIT 2 CARD READER IS OFF LINE. * BIT 3 TIMING ERROR OR PICK FAILURE WAS SENSED * DURING PREVIOUS READ OPERATION. * BIT 4 PICK FAILURE OR CARD MOTION ERROR WAS * SENSED DURING PREVIOUS READ OPERATION. * BIT 5 IF BOTH BITS 3 & 5 ARE ON, NO DATA WAS * TRANSMITTED DURING PREVIOUS READ OPERATION. * IF BIT 3 IS OFF & BIT 5 IS ON, THE PREVIOUS * READ REQUEST WAS REJECTED BECAUSE THE HOPPER * WAS EMPTY OR THE STACKER WAS FULL. * BIT 6 STACKER IS FULL. * BIT 7 THE PREVIOUS READ OPERATION LEFT THE INPUT * HOPPER EMPTY AND THE END OF FILE SWITCH * WAS ON DURING THE READ OPERATION. * * EQT6 FUNCTION BITS HAVE THE FOLLOWING MEANINGS: * * BIT 6 MODE BIT: 0=ASCII,1=BINARY * BIT 7 'V' BIT: 0=COLUMN BINARY,1=PACKED BINARY * * EQT7 USER BUFFER ADDRESS * * EQT8 USER BUFFER LENGTH * * EQT9 CURRENT DMA CHANNEL * * EQT10 CARD READER STATUS BITS ARE DEFINED AS FOLLOWS: * * BIT 0 CARD READER NOT READY,OFF LINE, OR BUSY * BIT 1 TROUBLE DURING READ * BIT 2 CARD READER OFF LINE * BIT 3 DATA LOST * BIT 4 NOT USED * BIT 5 HOPPER EMPTY OR STACKER FULL * BIT 6 STACKER FULL * BIT 7 END OF FILE AND HOPPER EMPTY * BIT 8 PICK STATUS * BIT 9 LIGHT/DARK READ ERROR * BIT 10 NOT USED * BIT 11 MOTION/PICK FAILURE * BIT 12 COMPUTER POWER TURN-ON/PRESET OR * END OF OPERATION INTERRUPT * BIT 13 NOT USED * BIT 14 NOT USED * BIT 15 END OF OPERATION * * *v EQT11 SUBCHANNEL FOR CONVERSION:0=STD EBCDIC * 1=BCD * 2=RDTS EBCDIC * * EQT12 END OF FILE/HOPPER EMPTY FLAG * * EQT13 CARD READER NOT READY/OFF LINE FLAG * * EQT15 DEVICE TIME OUT CLOCK * SKP * INITIATION SECTION. * * I.11 NOP ENTRY POINT. LDB CHAN STB EQT9,I STORE CURRENT DMA CHN JSB SETIO SET I/O INSTRUCTIONS FOR CR. STA EQT5,I SET NEW STATUS IN EQT TABLE LDA EQT4,I SET UP EQT4 SO THAT DRIVER IOR BIT12 CAN HANDLE ITS OWN STA EQT4,I TIME OUTS LDA I.11 SET COMMON EXIT STA C.11 LDA EQT6,I LOAD THE REQUEST CONTROL WORD. AND DEC3 ISOLATE THE REQUEST CODE. CPA DEC3 IS REQUEST A CONTROL REQUEST? JMP I.A.4 YES, EXIT SLA,ARS NO; IS THE REQUEST TO READ? JMP READ YES, CONTINUE. JMP C.11,I RETURN TO THE USER. A=1 ILL. R\W SPC 1 A.2 LDA DEC2 NO, LOAD DECIMAL 2 INTO A REG. JMP C.11,I RETURN TO THE USER. SPC 1 READ LDA EQT12,I GET EOF/HOPR EMTY FLG AND B200 GET BIT 7 SZA EOF AND HOPR EMTY? JMP EOF YES,EXIT STA EQT15,I CLEAR TO CLOCK READ0 STB EQT13,I CR NOT RDY/OFF LINE FLAG SLB IS THE CR NOT READY OR OFF-LINE? JMP NR YES, GO DOWN THE UNIT. LDA EQT4,I SAVE AND B100 SUBCHANNEL RAR FOR STA EQT11,I CONVERSION LDA INDEX LOAD THE CR CHANNEL NUMBER. DMA EQU 06B STANDARD "DMA" CHANNEL NUMBER. DMA.0 OTA DMA ASSIGN THE "DMA" CHANNEL. LDA BUFAD LOAD THE INTERNAL BUFFER ADDRESS. DMA.1 CLC DMA-4 PREPARE THE ADDRESS REGISTER. DMA.2 OTA DMA-4 OUTPUT THE BUFFER ADDRESS. LDA DM80 LOAD: A-80. DMA.3 STC DMA-4 PREPARE DMA FOR WORD COUNT DMA.6 OTA DMA-4 OUTPUT THE NEGATIVE WOeRD LENGTH. CR.0 STC CR,C ISSUE A PICK COMMAND TO THE CR. DMA.7 STC DMA,C ACTIVATE THE "DMA" CHANNEL. * DMA10 CLC DMA INHIBIT DMA INTERRUPT A.0 CLA,RSS CLEAR A REG. A.3 LDA DEC3 LOAD: A3. JMP C.11,I RETURN TO THE USER. SPC 1 NR LDB DM80 SET UP TIME OUT STB EQT15,I LDB EQT11 BYPASS TIMEOUT STB EQT15 CLEAR JMP A.3 EXIT SPC 1 EOF IOR EQT5,I UPDATE STATUS BIT 7 STA EQT5,I STORE NEW STATUS CLB STB EQT12,I CLEAR EOF/HOPR EMTY FLG ** JMP ON1 I.A.4 LDA EQT12,I GET EOF FLAG AND B200 LOOK AT BIT 7 (EOF) XOR EQT5,I IF SET WE HAVE NOT YET ISSUED NEXT READ TO RETURN STA EQT5,I EOF. IF NOT SET LEAVE STATUS AS IS ON1 LDA DEC4 JMP C.11,I RETURN ** SPC 2 BIT12 OCT 10000 SPC 2 SETIO NOP ENTRY POINT. STA INDEX STORE THE CR CHANNEL NUMBER. IOR LIA.0 MAKE LIA INSTRUCTION STA LIA.1 STA CR.3 ADA B100 OTA CARD READER STA CR.2 STA OTA.2 IOR B1100 STC,C CARD READER STA CR.0 ** LDA INDEX SET CLC ON CR FLAG IOR CLC.0 STA CLCCR ** LDA STF.0 CONFIGURE DMA STF INSTRUCTION IOR EQT9,I STA DMA.8 CR.2 OTA CR UPDATE THE CR STATUS REGISTER. ADA B500 OTA DMA STA DMA.0 IOR B1100 STC,C DMA STA DMA.7 ADA B3000 CLC DMA (10670D - 4 ) STA DMA10 LDA EQT9,I GET DMA CHANNEL ADA N4 IOR LIA.0 LIA DMA-4 STA DMA.9 ADA B100 OTA DMA-4 STA DMA.2 STA DMA.6 ADA B100 STA DMA.3 STC DMA-4 IOR CLC.0 CLC DMA-4 STA DMA.1 CR.3 LIA CR LOAD THE CR STATUS REGISTER. STA EQT10,I SAVE STATUS WORD AND M377 If GET BITS 0 - 7 ONLY CPA DEC3 ARE BITS 0 AND 1 0N , OTHERS OFF LDA B50 YES, SET BITS 3 AND 5 ON IOR EQT10,I ADD ORIGINAL STATUS BACK IN ALF PUT BIT 11 IN BIT 15 SSA PICK OR MOTION CHECK?? IOR B1400 YES, SET BITS 4 AND 5 TO 1 RAL PUT BIT 10 TO BIT 15 SSA COMPARE CHECK IOR B40 YES, SET BIT ZERO TO 1 ALF,ALF RESET STATUS WORD ALF,RAR TO ITS NORMAL CONFIGURATION ELA,RAR SHIFT THE "EOP" BIT TO "E". AND M377 ISOLATE BITS 7-0. LDB A SAVE THE STATUS IN "B". LDA EQT5,I LOAD THE STATUS WORD. AND M1774 REMOVE THE OLD STATUS. IOR B INCLUDE THE NEW STATUS. JMP SETIO,I RETURN. STF.0 STF 0 CLC.0 CLC 0 LIA.0 LIA 0 SPC 2 B100 OCT 100 B200 OCT 200 B700 OCT 700 CRSET NOP LAST EBCDIC CHAR SET SPC 2 * STD HP EBCDIC CHARS HWPTB DEF *+1 ASC 1,!$ ASC 1,;] ASC 1,+^ SPC 1 * RDTS EBCDIC CHARS OCT 56444 RDTS CHAR = VERT BAR,$ OCT 35536 RDTS CHAR = ;,] OCT 25441 RDTS CHAR = +,UNDERSCORE SPC 2 READ2 RBR,SLB WERE THERE ANY I/O ERRORS? JMP OPERR YES, GO FLAG OPERATOR ATTENTION. CPA EQT8,I NO; WAS A RECORD BEING SKIPPED? JMP R.ERR YES, GO INITIALIZE ONLINE FLAG. STA DMA.7 NO, INITIALIZE THE WORD COUNTER. DMA.9 LIA DMA-4 LOAD THE WORD COUNT REGISTER. CPA DM80 WAS ANY DATA TRANSMITTED? JMP NREDY NO, GO SET I/O ERROR STATUS. CMA,INA YES, WORD COUNT RESIDUE POSITIVE. ADA DM80 "SUBTRACT": 80 - RESIDUE. STA DMA.9 STORE THE WORD COUNT INDEX. LDB BUF LOAD INTERNAL BUFFER ADDRESS. STB DMA.8 STORE BUFFER ADDRESS INDEX. LDB EQT6,I LOAD THE FUNCTION REQUEST CODE. BLF,BLF SHIFT "M-BIT" TO BIT 15. RBL SH)IFT "M-BIT" TO BIT 15. SSB IS THE MODE BINARY? JMP BINRY YES, GO PROCESS BINARY CARD. CLB NO, ENTER: B0. STB DMA.2 INITIALIZE THE COLUMN COUNTER. STB DMA.1 INITIALIZE THE CHARACTER COUNTER. LDA EQT4,I GET THE SUBCHANNEL NO. AND B700 CPA B100 BCD? JMP OUTS YES-DONT FUSS WITH TABLE AND B200 STD EBCDIC OR RDTS EBCDIC? CPA CRSET SAME AS LAST CHAR SET? JMP OUTS YES, DONT OVERLAY TABLE STA CRSET STORE LAST CHAR SET FLG LDB HWPTB ADDRESS OF STD EBCDIC TABLE CPA B200 RDTS EBCDIC? ADB DEC3 YES, USE RDTS CHARS LDA 1,I GET 1ST CHAR FOR OVERLAY STA LASC1 OVERLAY 1ST CHAR INB ADDRESS OF NEXT CHAR LDA 1,I GET 2ND CHAR FOR OVERLAY STA LASC2 INB LDA 1,I STA LASC3 OUTS LDA DMA.9 RESTORE A REG SPC 1 LDB EQT8,I LOAD THE ORIGINAL REQUEST LENGTH. SSB IS THE REQUEST IN WORDS? CMB,INB,RSS NO, COMPLEMENT CHARACTER COUNT. RBL YES, CONVERT WORDS TO CHARACTERS. SSB CHARACTER LENGTH OVERFLOW? JMP .16K YES, CONTINUE. ADA B "SUBTRACT": REQUEST- CARD LENGTH. CMB,INB NEGATE THE CHARACTER COUNT. SSA IS THE REQUEST LESS THAN CARD? STB DMA.9 YES, STORE THE WORD COUNT INDEX. .16K LDA EQT7,I LOAD THE USER BUFFER ADDRESS. CLE,ELA SHIFT TO FORM CHARACTER ADDRESS. STA DMA.6 SAVE THE CHARACTER ADDRESS. LOOP LDA DMA.8,I LOAD THE DATA COLUMN. ISZ DMA.2 INCREMENT THE COLUMN COUNTER. SZA,RSS IF CHARACTER IS BLANK, MAKE IT ONE. JMP ZERO SET CHARACTER A BLANK. LDB DMA.2 LOAD THE CURRENT COLUMN COUNTER. STB DMA.1 UPDATE RETURN COLUMN COUNT. * AND B7000 MASK OFF ALL BUT BITS 12,11,0 CLB CLEAR B tSFOR LATER SZA,RSS ANY HIGH PUNCHES ? JMP NOHI NO, TEST FOR LOW PUNCHES * CPA B1000 BIT 0 PUNCHED ? LDB B40 YES, LOAD 32 CPA B2000 BIT 11 PUNCHED ? LDB DEC16 YES, LOAD 16 CPA B4000 BIT 12 PUNCHED ? LDB DEC48 YES, LOAD 48 SZB,RSS WAS ONLY ONE COLUMN PUNCHED ? JMP BAD NO, ILLEGAL PUNCH * NOHI STB DMA.0 SET HIGH FIELD WEIGHT XOR DMA.8,I ISOLATE LOWER BITS OF COLUMN SZA,RSS ANY LOW BITS PUNCHED ? JMP NOLOW NO, CHARACTER COMPLETED. * CCE,SLA BIT 9 SET ? LDB DEC9 YES, LOAD WEIGHT SLA,ARS BIT 9 SET ? JMP SET YES, TEST FOR MORE BITS. * SLA,ARS BIT 8 SET ? CLB,RSS YES,CLEAR B FOR LATER JMP CONTN BIT 8 WAS NOT SET. CLE,SZA,RSS WAS ONLY BIT 8 SET ? JMP BIT8 YES, EXIT TO FORM CHARACTER. * CONTN BSS 0 * LDB DEC7 LOAD WEIGHT COUNTER SLA,ARS IS BIT 7 SET ? JMP SET YES, CHECK FOR OTHER PUNCHES * LDB DEC6 SIX SLA,ARS IS BIT 6 SET ? JMP SET YES LDB DEC5 FIVE SLA,ARS IS BIT 5 SET ? JMP SET YES LDB DEC4 FOUR SLA,ARS IS BIT 4 SET ? JMP SET YES LDB DEC3 THREE SLA,ARS IS BIT 3 SET ? JMP SET YES LDB DEC2 TWO SLA,ARS IS BIT 2 SET ? RSS YES,SKIP JUMP. JMP ONE NO, BIT 1 MUST BE. SET SZA ANY OTHER PUNCHES ? JMP BAD.1 YES, ILLEGAL COMBINATION SEZ,RSS IS THE BIT 8 FLAG ON ? BIT8 ADB D8 YES, ADD WEIGHT FOR IT. BIT1 ADB DMA.0 ADD WEIG3HT FOR FIELD BITS. NOLOW SLB,BRS PLACE ODD BIT IN A-REG. CLA,INA SET ODD CHARACTER FLAG ADB TABLE FIND PLACE IN TABLE. ADB EQT11,I ADDS 40 FOR BCD IF REQUESTED CLE,SZA ODD CHARACTER ? CCE LDA B,I GET WORD WITH TWO CHARS. SEZ,RSS ODD CHARACTER ? ALF,ALF YES, PUT IT INTO BOTTOM. AND M377 ISOLATE THE CHARACTER. LEGAL BSS 0 ISZ DMA.8 INCREMENT BUFFER ADDRESS POINTER. LDB DMA.6 LOAD CHARACTER BUFFER ADDRESS. CLE,ERB SHIFT, FORM WORD BUFFER ADDRESS. SEZ,RSS IS NEW CHARACTER TO BE LOWER? ALF,SLA,ALF NO, SHIFT TO HIGH ORDER; SKIP. IOR B,I YES, INCLUDE THE HIGH ORDER PART. STA B,I STORE THE WORD IN USER BUFFER. ISZ DMA.6 INCREMENT BUFFER ADDRESS POINTER. ISZ DMA.9 IS THE BUFFER EXHAUSTED? JMP LOOP NO, GO PROCESS NEXT COLUMN. LDB DMA.1 YES, LOAD # NON-BLANK CHARACTERS. LDA EQT8,I LOAD THE ORIGINAL REQUEST TYPE. CLE,SSA,RSS WAS THE REQUEST IN CHARACTERS? ERB NO, CONVERT CHARACTERS TO WORDS. END CLA,SEZ WAS THE CHARACTER COUNT ODD? INB YES, INCREMENT THE WORD COUNT. JMP C.11,I GO TO COMPLETION RETURN. * ZERO LDA B40 LOAD ASCII BLANK JMP LEGAL STORE LEGAL CHARACTER * BAD LDB EQT11,I DO EXTRA SZB,RSS BCD TESTS? JMP BAD.1 NO * * CPA B3000 11 - 0 PUNCH ? JMP BCDEX YES, MAY BE ! CPA B5000 12 - 0 PUNCH ? JMP BCDQU YES, MAY BE ? * BAD.1 LDA EQT5,I SET ILLEGAL PUNCH STATUS IOR DEC2 STA EQT5,I QUES LDA M77 LOAD ASCII QUESTION MARK. JMP LEGAL STORE CHARACTER * ONE CLB,SEZ,INB,RSS SET WEIGHT, TEST BIT 8 FLAG ON ? JMP BAD.1 BIT 8 FLAG WAS ON, ILLEGAL PUNCH. JMP BIT1 JUST BIT 1 PUNCH[ED * DEC5 DEC 5 DEC6 DEC 6 B3000 OCT 3000 * * BCDEX XOR DMA.8,I TEST FOR OTHER BITS SZA JMP BAD.1 ILLEGAL PUNCHES LDA B41 LOAD ! JMP LEGAL STORE SPECIAL CHARACTER * BCDQU XOR DMA.8,I TEST FOR OTHER PUNCHES SZA JMP BAD.1 JMP QUES GO LOAD AND STORE ? * B41 OCT 41 ! B5000 OCT 5000 SKP BINRY CCE,SLB CONVERT FROM PACKED BINARY? JMP PAK.B YES, GO PROCESS PACKED BINARY. JSB INDEX NO, GO COMPUTE WORD COUNT INDEX. COL.B LDA DMA.8,I LOAD THE DATA COLUMN. ISZ DMA.8 INCREMENT BUFFER ADDRESS POINTER. STA DMA.6,I STORE THE WORD IN USER BUFFER. ISZ DMA.6 INCREMENT BUFFER ADDRESS POINTER. ISZ DMA.7 INCREMENT THE WORD COUNTER. ISZ DMA.9 IS THE BUFFER EXHAUSTED? JMP COL.B NO, CONTINUE. TLOG LDA EQT8,I LOAD THE ORIGINAL REQUEST TYPE. LDB DMA.7 LOAD THE TRANSMISSION LOG. CLE,SSA WAS THE REQUEST IN CHARACTERS? BLS YES, CONVERT WORDS TO CHARACTERS. JMP END GO ISSUE A COMPLETION RETURN. SPC 2 INDEX NOP ENTRY POINT. LDB EQT7,I LOAD THE USER BUFFER ADDRESS. STB DMA.6 SAVE THE USER BUFFER ADDRESS. LDB EQT8,I LOAD THE ORIGINAL REQUEST LENGTH. SSB,RSS IS THE REQUEST IN WORDS? CMB,INB,RSS YES, COMPLEMENT WORD COUNT; SKIP. BRS NO, CONVERT CHARACTERS TO WORDS. CMA,INA MAKE THE RECORD LENGTH POSITIVE. ADA B "SUBTRACT": RECORD COUNT-REQUEST. SSA,RSS IS THE REQUEST LESS THAN RECORD? STB DMA.9 YES, STORE THE REQUEST LENGTH. JMP INDEX,I RETURN. SPC 1 PAK.B LDA DMA.8,I LOAD THE FIRST DATA COLUMN. RAR,RAR SHIFT ROWS 12-5 TO LOWER. RAR,RAR SHIFT ROWS 12-5 TO LOWER. AND M377 ISOLATE THE RECORD WORD LENGTH. CMA,INA,SZA,RSS IS THE RECORD LENGTH ZERO(0)? Ρ JMP NREDY YES, GO FLAG WORD COUNT ERROR. STA DMA.9 NO, SAVE THE RECORD WORD LENGTH. JSB INDEX GO COMPUTE THE WORD COUNT INDEX. LDA DMA.9 LOAD THE WORD COUNT INDEX. ADA D60 "SUBTRACT": 60- WORD COUNT INDEX. SSA IS THE WORD COUNT > 60? JMP NREDY YES, GO FLAG WORD COUNT ERROR. LDB DMA.8,I NO, LOAD DATA COLUMN 1 OF 4. ISZ DMA.8 INCREMENT BUFFER ADDRESS POINTER. UNPAK BLF SHIFT COLUMN TO BITS 15-4. STB DMA.1 SAVE THE DATA COLUMN. LDA DMA.8,I LOAD DATA COLUMN 2 OF 4. ISZ DMA.8 INCREMENT BUFFER ADDRESS POINTER. ALF,ALF SHIFT ROW 12 TO BIT 3. LDB A SAVE THE DATA COLUMN. AND M17 ISOLATE ROWS 12-1. IOR DMA.1 INCLUDE COLUMN #1. JSB STORE GO STORE DATA WORD 1 OF 3. AND M1774 ISOLATE ROWS 2-9. STA DMA.1 SAVE THE PARTIAL DATA COLUMN. BLF,BLF SHIFT ROW 12 TO BIT 7. BLF SHIFT ROW 12 TO BIT 7. LDA B LOAD DATA COLUMN 3 OF 4. AND M377 ISOLATE ROWS 12-5. IOR DMA.1 INCLUDE COLUMN #2. JSB STORE GO STORE DATA WORD 2 OF 3. AND B17 ISOLATE ROWS 6-9. IOR B INCLUDE DATA COLUMN 4 OF 4. JSB STORE GO STORE DATA WORD 3 OF 3. JMP UNPAK GO PROCESS THE NEXT 4 COLUMNS. SPC 2 STORE NOP ENTRY POINT. STA DMA.6,I STORE THE BINARY DATA WORD. ISZ DMA.6 INCREMENT BUFFER ADDRESS POINTER. ISZ DMA.7 INCREMENT THE WORD COUNTER. LDA B LOAD THE PREVIOUS DATA COLUMN. LDB DMA.8,I LOAD THE NEXT DATA COLUMN. ISZ DMA.8 INCREMENT BUFFER ADDRESS POINTER. ISZ DMA.9 IS THE BUFFER EXHAUSTED? JMP STORE,I NO, RETURN. JMP TLOG YES, GO LOAD TRANSMISSION LOG. SPC 1 OPERR LDA DEC3 LOAD: A3. JMP R.ERR GO INITIALIZE THE ONLINE FLAG. SPC 1 NREDY LDA EQT5,I: LOAD THE STATUS WORD. IOR DEC2 INCLUDE THE I/O ERROR STATUS. STA EQT5,I UPDATE THE STATUS WORD. JMP R.ERR NO, GO INITIALIZE ONLINE FLAG. SPC 1 NEOF OCT 177537 BIT 7 MASK SKP * COMPLETION SECTION. SPC 1 C.11 NOP ENTRY POINT. * * A REG CONTAINS INTERRUPT SLOT * LDB EQT13,I IS AN INTERRUPT EXPECTED ? SLB JMP EXTRA NO, SET UP TIMEOUT & EXIT. ** LDB EQT1,I CHECK FOR SPURIOUS INTERRUPT. I.E SZB,RSS WHEN POWER TURNED OFF JMP EXTRA SPURIOUS INTERRUPT ** JSB SETIO SET I/O INSTRUCTIONS FOR CR. STA EQT12,I SAVE STATUS WORD IN EQT12 ALF,ALF PUT BIT 7 TO BIT 15 SSA IF BIT 7 NOT SET SKIP JMP BY IF SET THEN SKIP OTHER TESTS RAL,RAL SET BIT 5 TO 15 POSITION SSA,RSS IF NOT SET THEN NO CHANGE JMP BY CONTINUE RAL,RAL SET BIT 3 TO 15 POSITION SSA IS BIT 3 SET 1 JMP BY YES, SKIP CHANGE CLB NO,SET EQT10,I STB EQT10,I FOR HOP MTY/STACK FUL LDA EQT12,I RESTORE STATUS TO A-REGISTER AND BIT51 CLEAR BITS 5 AND 1 RSS SKIP NEXT LOAD BY LDA EQT12,I RESTORE STATUS TO A-REGISTER AND NEOF INCLUDE EOF/HOPR EMTY STATUS STA EQT5,I RESET EQT WORD TO NEW STATUS CLA,CME ENTER: A0; COMPLEMENT "EOP". DMA.8 STF DMA SET FLAG ELA,SLA IS THE END-OF-OPERATION FLAG ON? R.ERR CLB,RSS ENTER: B0; SKIP. JMP READ2 YES, GO PROCESS THE CARD IMAGE. LDA EQT10,I LOAD HE/SF FLAG WORD SZA,RSS IF SET 0 JMP A.2 THEN HE/SF, EXIT A 2 LDA EQT5,I GET STATUS WORD SLA,RSS IS BIT 0 SET TO 1 JMP A.0 YES, NO TROUBLE, EXIT A 0 RAR PUT BIT 1 TO 0 POSITION D8 SLA IS BIT 1 SET TO 0 ? JMP A.3 \EXIT A - 3 CLA,INA IF NONE OF ABOVE EXIT A - 1 JMP C.11,I SPC 1 EXTRA ISZ C.11 ADVANCE TO CONT. RETURN CLA CLEAR TO CLOCK STA EQT15,I ** OTA.2 OTA CR UPDATE CR STATUS LIA.1 LIA CR IF STILL NOT SLA,RSS READY IF BIT ZERO CLR JMP $UPIO GO UP CR CLCCR CLC CR INHIBIT ANY MORE SPURIOUS INTERRUPTS JMP NR NOW SET FOR NOT READY ** SKP CR EQU 11B FAKE CARD READER SELECT CODE BUF DEF I.BUF INPUT BUFFER ADDRESS DEFINITION. BUFAD DEF I.BUF,I "DMA" BUFFER ADDRESS FOR INPUT. B17 OCT 170000 N4 DEC -4 DEC2 DEC 2 DEC3 DEC 3 DEC4 DEC 4 DEC7 DEC 7 DEC9 DEC 9 DEC16 DEC 16 DEC48 DEC 48 M17 OCT 17 M377 OCT 000377 M1774 OCT 177400 D60 DEC 60 B40 OCT 40 B1400 OCT 1400 B50 OCT 50 B1000 OCT 1000 B2000 OCT 2000 B4000 OCT 4000 B7000 OCT 7000 B1100 OCT 1100 B500 OCT 500 M77 OCT 77 ASCII QUESTION MARK BIT51 OCT 177735 MASK FOR BITS 5 AND 1 DM80 DEC -80 I.BUF BSS 80 INTERNAL DATA BUFFER. LAST BSS 0 SPC 1 TABLE DEF *+1 ASCII LOOKUP TABLE START * * EBCDIC CARD PUNCH CHARACTER SET * ASC 13, 123456789:#@'="-JKLMNOPQR LASC1 ASC 1,!$ ASC 1,*) LASC2 ASC 1,;] ASC 15,0/STUVWXYZ\,%_>?&ABCDEFGHI[.<( LASC3 ASC 1,+^ SKP * BCD CARD PUNCH CHARACTER SET * ASC 16, 123456789?=':>?-JKLMNOPQR?$*];] ASC 16,0/STUVWXYZ?,(_\?+ABCDEFGHI[.)[<^ SKP SPC 2 EQT1 EQU 1660B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B EQT11 EQU 1672B EBCDIC OR BCD CHAN EQU 1673B CURRENT "DMA" CHANNEL NUMBER. EQT12 EQU 1771B EOF/HOPR EMTY FLAG EQT13 EQU EQT12+1 CR NOT RDY/OFF LINE FLAG EQT15 EQU EQT12+3 A EQU 0 B EQU 1 END NLHHN  29033-80001 B S P0222 RTE FMGR D.RTR             H0102 RSPà DPMMMVŠDSàPAAMSҠUNԠUN ANGSUN Ž0-SAVŠPAAMS Ž-MVŠPAAMSBAK DPMMNP DANSA DBSGN SBP.PAS NDà- NSàNP SԠDà96 ASҠNP KNP NҠNP BADNP BADNP BAD3NP BADNP BAD5NP BAD6NP NP DBK ADBAKMPUŠHŠADDSSƠAK SBҠSŠSԠHŠADDSS DBDUSAVŠHŠUNԠU SBDPSҠŠSDNԠSPD MPDPMM SPà5 AGHKSҠPNAGS ASSUMSAGAPNSϠHŠAGAA AGNP AAҠHŠPNUN SAUNAND DANSԠϠS SAUNHŠPNAGS DBAGAGԠHŠAGADDSS AGDABɠGԠPNAG A̬ŬAMVŠPSSBŠUSVŠB SBDMSԠҠDMAN SZUNSPPNAGUN NBSPϠNԠNY SZUNSPUNԻNDƠAGS? MPAGNϻYNԠN MPAGɠYSUN SPà5 DMHKϠSŠƠPGAMSDMAN DADDSSNA ANϠBŠSԠϠZ'SADDSSNB UNP+ƠNԠDMANԻSŠP+ DMNP SBMPSAVŠBG ŬSZASSƠZϠHNUSԠUNP+ ŬSSSϠSKPS PADƠPNϠHSPGMŠS MPDMSϠGϠ DBKYDMAKŠSUŠHŠAGPNS SBSUBϠAVAD DMDBSUBɠDSGMN PBAHSN? MPDM3YSNNU SZSUBNϠYHŠNԠN SZBƠNDHN MPDM MPDMNԠVADGϠAҠAG DM3ADA.ADDSSƠSjUSPNDPN DBAɠϠB MBŬNBSZBSSƠZϠ(DMANԩ_ DMSZDMSŠSKP DBMPSŠBG ASZHANGŠϠDMAN SABɠSԠϠZ SZAND SBSSԠŠAG MPDMɠUN SPà رANASS زDA. SS 6DA.6 SS ظDA. SS ر3DA.3 SS رDA. MANASS رDAN MP SPà .Dà .3Dà3 .Dà BԠ NDà- SԠNP UNNP UNNP BADƠBAD BADҠNP SKP AԠSBDPASADHŠSKNDY DADSԠUPUSVŠPNAG ҠSGNADDHŠUSVŠB SADSAVŠ AAҠHŠNԠAG SAGSàSAVŠԠҠHŠDY DAABUƠMVŠ SBMVűHŠSAVŠAA SBSDҠSԠϠADHŠDY SBN.SHҠSAHҠHŠNAM A0ŬSSNԠUNDSKP MPزUND-AKŠDUPNAMŠ SZASSƠDYU MPرAKŠ SBSADSԠHŠADDSSS DADAMVŠN SBMVű DADSԠHŠPNAG SAAGA DBBAGԠSԠBADAKADDSS HKBԠDABɠƠNDƠS SZASSHN MP̠NUNU MAŠSŠS ADANҠBADҠ SZSSPNԠ MP̠SԠBADAK NBN MPHKB ̠SBBADҠSԠBADAKPN DBNSàGԠHŠNԠAK DANҠANDS ASAAKAɠSԠHŠAK ADBGSàADDHŠNԠD SBSAɠSԠHŠSԯN DBSìɠGԠHŠUSԠSZ DABADҬz(ɠANDHŠSԠBADAK SZAƠGDSKP SSBSSSŠƠSԠƠDSàSKP MPAGϠAUAŠSZ A3NABADAKNSԠƠDSà SZBADҠSԠŠABVŠԠAND BYAGAN MPA SPà ASSBƠSԠƠDS MPA5MP SBNԯSMPUŠHŠNԠAKANDS SASADSҠ-SAVŠASԠAK DABADҬɠGԠASԠAVAABŠAK SZASSƠNԠBAD DAASҠHŠASԠNDS+ MANASUBAԠM ADASADASԠŠAK SSA0Ҡ+? MPAYSԠS DABADҬɠNϻN'Ԡ SZAASԠABADAK? MPA3YSYABVŠ DAGSàƠNԠA SZASSHNSKPϠҠ MPNԠSŠYNԠDS MP6NϠMҠNԠ SPà ADASADԠԠS A6SANҠUPDAŠHŠN SBNSàAKANDS SZSSԠHŠŠAG DASìɠGԠHŠUNPAM SBPMANDGϠSԠUPHŠUN SBSDҠSԠUPϠADS SASԠDYBK SBDNBAD .Dà ŠMVŠN SBDPMMNԠAKANDSԠDS SZSN-SԠϠ MPԠAND SPà A5DAAKAɠUSԠҠSԠƠDS MANAMPUŠH ADAASҠNUMBҠ MPYSԠSS DBSAɠAVAAB MBNBAND ADABS SASìɠNHŠŠNY SZASSƠZ MPNԠYNԠDS DAASҠSŠPSԠϠS BHŠDS MPA6ANDGϠAPԠUP SPà MVűϠMV#>ŠDYNSϯM HŠA̠SAVŠAADND HN. ANGSUN: Ž0ϠHSSAVŠAA ŽMHSSAVŠAA AADDSSƠHҠAA MVűMVS9DS MVŲMVS3DS MVűNP DBSGNSԠBϠMVŠDS SBP.PASA̠ϠMV N9Dà-99DS NAMŠBSS9 SàUNAM+5 MPMVűɠUN SPà MVŲNP DBSGNSԠBҠMV SBP.PASA̠ϠMV N3Dà-33 BSS3DS MPMVŲɠUN SPà GKNP GUNP GSàNP GSàNP SKP GNSBS̠SԠGAYƠA SBSDҠSԠUPϠASSHŠDY SBDPASADHŠPASSDDAA SBUDADUPDAŠDYASS MPؠNDGϠ ŠSԠŠҠDPMMA SZSԠSԠS? SSNϻSKP SBDPMMYSGϠAԠHŠDSàPAMS SZSSԠϠ SBSҠŠHŠSS MPDPAGϠGԠHŠNԠBK SPà S̠NP DABɠGԠHŠK DBMPƠKD PADϠA SZBSSANDԠDSàSPàSKP MPر0SŠAKŠҠ MPS̬ SPà5 DPADADHŠPASSDDAA DPASNP DAPGԠHŠADDSS ANDBSAŠHŠU SAGUANDS ҠPSAŠHŠAK AƬA̠AŠ A̬AƠנA SAGKANDS DAPGԠHŠSSAK A̬ŬAMNAŠHŠSGN SAGSàANDS ASԠҠS SAGSàZ DPASADUSHנHŠBKNԠN ^SBàADHŠSS DƠGN DƠ. DƠGU DƠBU DƠ. DƠGK DƠGS GNPB.DSà? SSNϻNNU MPرYSAKŠDSàҠ DAGSàUPDAŠH ADA.DSàADDSS PAGSàNDƠAK? AYS-USŠ0S. SAGSàSԠS ŬSZASSƠ SZGKSPAKADDSS MPDPASɠUN SKP SPà5 K5DAPNDƠDY DBP5ƠGNA PB.AND SSASSSGNBԠSԠSKP MP6SŠ-NԠUND SBDPASNנDYҠDSS-AD MP3GϠŠAND SPà3 PAKSBS̠SԠGAYƠA SBSPҠSԠUPHŠDSàPAAMS DAPGԠAVŠDUBŠS MANASZASSSԠNGAVŠƠZ MPPAKSKP SAUNSԠUN PAKSBUDADBUMPADDSS MPر0NDƠDY SZUNSPUNһDN? MPPAKNϻGϠBUMPAGN PAKSBDPASYSADHŠNנS. 3SZSSԠŠAG ԴAANDAK MPؠAPԠ SPà DNP MPNP MPNP DADNP AKNP SԠNP SNP AUNP DҠNP SKP KDAMPDSàMUSԠBŠSPD SZASS MPر0NԠSPD- SBSDҠSԠϠSAHҠPNAGS KSBDNBADNY MPKNDƠDY-GANԠK DANSԠUNҠҠNS SASH DAABUƠSԠA_ADDSSƠS KDBAɠND SSBƠPUGD MPK3GN SZBSSDY? MPKYSGANDK SBSADNϻSԠNYADDSSS SBAGSԠҠAGS DBUNANY SZBS? MPظYSԠK DADANϻGԠADDSSϠA K3ADA.6SPϠNԠNY SZSHNDƠBK? MPKNϻYNԠNY MPKYSYNԠBK SPà KSBDPSKGANABŻADDS DADDYAND BS ADBDADH K5SABɠK MP3 SPà5 UKAUNK-A MPK5ANDGϠSԠ SPà ر0DAN0 NASS ر0DAN0 MP SPà N0Dà-0 .6Dà6 B3Ԡ3 NDà- SKP NAMSBDPASHANGŠNAM-ADNנNAM DAABUƠMVŠԠ SBMVŲA̠SAVŠAA DAABUƠSԠUPHŠNAM SBMVűҠDUPHK SBSDҠSԠUPϠADHŠDY SBN.SHҠSAHҠDUPAŠNAM SSNԠUNDSϠSKP MPزAKŠDUPNAMŠ SBDKGϠGԠDYNY DAAGAɠPNUSVY A̬ŬAAҠUSVŠBԠANDSAVŠN PAPϠA? SZŬSSYSSKP MPر0Nϻ NAMDADAYSMV SBMVŲHŠNנNAMŠN SBSHSAHҠNԠƠHS MPNAMYSGϠSԠNנNAM SPà SHNPDҠSAHҠNSϠMDY SZSSԠHŠŠAG SBSHҠSAHҠN MPԴNԠUNDSϠ MPSHɠUNDUN SPà5 DKADADYNY-SԠAGS HKPNAGS. DKNP DAAUDϠŠAADY PADPSHAVŠHŠDSàSPS? SSYSSϠSKPSԠUP SBSPҠSԠUPHŠDSàPAAMS DADҠS SAAKAK DAPGԠHŠPASSD ANDB3S SASԠANDSԠ ҠPNנGԠH AƬAƠS ADAABUƠADDHŠBUҠADDSS SBSADSԠDYADDSSS SBSUBADHŠBK DADAMVŠHŠNYϠA SBMVűSAG MPDK SKP SPà5 SŠSBDKSŻGԠHŠS DANSԠҠNS SDBAGAɠND B̬ŬBAS PBDAG MPSUND SZAGANԻYԠYNԠN NASZAM? MPSYSK MPرNϻҠ-NԠPNϠA SPà SAUNDAҠH SAAGAɠAG DAPGԠUNAŠD SZAƠZϠHNSKPNϠAN SZSSUSVŠPN? MP3Nϻ SSASSƠPSVŠHN MPPUҠGϠPUGŠHŠNS ADASìɠAUAŠNנŠSZ SASSGNҠƠDDSҠUN SSAƠSUԠSSHANZ MP3HNGNҠ ŬSZASSƠZ MPPUGŠGϠPUG SAMPSAVŠHŠNנSZ SBAS?ASԠ? ŬSSNϬAҠŠSKP ŠYSSԠ DAMPSԠHŠNנSZ SASìɠNHŠDY SZSSƠNԠHŠASԠNY MPPUҠGϠPUGŠANYNS MPPUGSŠGϠUPDAŠDSàPAMS SPà5 NԯSNPAUAŠHŠNԠAKANDS DBSìɠGԠHŠŠSZ DASAɠGԠHŠNϠƠSSNHŠ ANDB3SA ADBASUM ASҠ6NDϠA DVSԠDVDŠBYHŠNSԠPҠAK ADAAKAɠADDHŠUNԠAKADDSS MPNԯSɠUNANԠAKBNԠS SPà5 SHҠNPNԠSAHUN DBDƠSԠUNADDSSN SBN.SHҠNAMŠSAHUN MPNSH0GϠϠNAMŠSAH DƠDƠ+UNADDSSҠNAMŠSHAH MPSHҬɠNԠUNDSϠ SBSADUNDSԠHŠADDSSS DBSHҠSPHŠUNADDSS ŬNBAND DASAɠMAKŠSUŠHSSNԠHŠMAN PASàSAMŠASMAN? MPSҠYSSϠYAGAN MPBɠUN SPà AS?NP DBYPŬɠƠYPŠSؠ PB.6HNA MPAS?ɠASNԠAS SBNԯSMPUŠHŠNԠAKANDS PANҠSAMŠAK? AYSA_ PBNSàSAMŠASNԠS? NASZAYSASԠSAMŠAKAS? MPAS?ɠNϻNԠASԠŠԠP+ SZAS?YSASԠ MPAS?ɠԠP+ SPà3 SPҠNPADANDSԠUPHŠDSàPAAMS SBSDҠSԠUPϠASSHŠD SBDNBADANDSԠPAMS N6Dà-6 MPSPҬɠUNϠA SPà .6Dà6 SKP PUGŠA PUG0SADAɠSԠPUGŠAG SBAS?ASԠ? MPPUҠNϻGϠHKҠNS PUGSADAɠMAKŠNYAVAAB DADASHSHŠS SASSԠϠŠUNԠBK PAABUƠNYNHŠUNԠBK? MPPUG5YSGϠADPVUSBK PUGADAN6NϻBAKUPϠPVUS SBSADNYNDSԠUNPUGD DBYPŬɠHKYP DADAɠNY PB.6ƠYPŠSؠ ŠDϠNԠAMPԠVY SZBYPŠZϠ-ƠSϠSKP SZNASZi640ASSPUGD? MPPUGYSYPVUSNY SPà SSAUNDNY-SԠH MPPUG3DSàSPàNY?-YSUMP PUGSBNԯSNϻAUAŠHŠNԠAKANDS MPA6GϠSԬŠ SPà PUG3DAAKAɠSԠϠSH BNԠAVAABŠS MPA6SSԠS SPà PUG5SBSҠŠUNԠS DBSԠGԠSҠADDSS SZBSSƠSAԠƠAK SZAKDYAK ADBNSUBAԠSS SSBƠNGAVŠHN ADBSԠADDHŠN.PҠAK SBSԠSԠNנSҠADDSS SBSUBADHŠBK DAABUƠSԠADDSS ADA.ASԠNY MPPUGNHŠBK SPà PUҠSBSHSAHҠNSϠPUG MPPUGŠGϠPUGŠN SKP P.PASNA ANGSUN _0ҠSUP _ϠMVŠU B_0ϠSԠADDSS B_00000ϠSԠPAAMS AADDSSƠM-ϠAA SBP.PAS Dà-NN.ƠPAAMSϠBŠMVD BSSNAASԠUPҠMVDU SPà .Dà AU0 BU .U650B KYDU.+ ASDU.+0 ԠU.+39 NU NDBGN ]6ASMBҬ̬ HDŠŠMANAGҠDYUNŠ NAMD.Ҭ ԠìPNP.PAS SUP ŠMPDYUNŠNVGAA HSPGAMSHŠNA̠MANAGҠƠHŠŠŠMANAGMN SYSM.ԠNSHŠDYANDPMSA̠S N. PGAMSHNGϠASSHŠDY SHDUŠ(HAԩHSPGAM. ASAŠASS(PPP3PP5AŠHŠPASSDPAAMS: .PN P.DA'SDSGMNԠADDSSHSGNBԠS P.ŬNAM((BԠ5NDASUSVŠPNƠS P3.0NAM(3 P.0NAM(56 P5.-U+ADGŠAB̬0ƠZϠSAHA̠MUNDADGS .S P.DA'SDSGMNԠADDSS P.0-(N.SSϠBŠDD+PUGŠNSNY P3.ҬU P.SԬSҠDYADDSS P5.0NDASS 3.A P.D P.ҬUDAAAKADDSS P3.-U+ADGŬ0SŠ.P5. P. P5.NDASA .HANGŠNAM P.D P.ҬUDAAAKADDSS P3.ҬU\ P.SԬSҠ\DYADDSSƠŠBNGNAMD P5.NDASNAMŠHANGŠA 6.SԬAҠKNDS P.D P. P3.-U+ADGŠ(0NԠGA̩DSàϠBŠKD P. P5.3ҠSԠ5ҠA .GNAŬPAKUPDAŠA P.D P.ҬUDAAAKADDSS P3.-U+ADGŠ(0NԠGA̩DSàϠBŠUPDAD P.SSïAKS(BԠ5ƠDSàDYUPDA P5.NDASGNAŠA. .NSNPN P.D P.NSNNUMB P3.ҬU\ P.SԬSҠ\DYADDSSƠMASҠNY P5.6NDASNSNUSԠ(ADũ 9.PAK :2P.D P.ҬUDAAAKADDSS P3.-U+ADGŠSŠGNA P.AVŠDYSҠ(NYϠBŠHANGD P5.9 SKP DAAAKMAԠҠAԠANDHANGŠNAM .NAM(\ .NAM(3ҠNנNAM 3.NAM(56 .YP 5. 6. .SSUSDҠ-ҠSԠƠDS .DSZŠ(YPŠS 9.SUYD DMASҠDUBŠDUYDS 5...65..05......0 AKޠUSS SïS UNPAAMS ұ.ҠDŠƠ0HNSàNAԠҠYPŠNPN Ҳ.ҬU\ 3.SԬSҠ\DYADDSS-PNAŠAS Ҵ.ҠŠADDSSNPNAŠAS 5.SïҬSҠ ҠDS 0ҠPSVŠ-NϠ -DSàDN -DUPAŠNAM -3ŠNԠUND -5ADNԠPNANDNԠNԠUND -6ADGŠNԠUND -ŠSUNYPN(ASϠҠԠK -9ŠUNYPNϠHŠSAMŠPGAM -ŠNԠPN(Sũ -3DSàKD -DYU -0GA̠PAAMSNA -0GA̠A̠SUNŠ(KNԠUSDSԩ SKP BUƠBSS PAMADƠP SPà BGNDABPAMADDSSϠA BŠSԠUPϠMVŠPAMS BAND SBP.PASGϠGԠHM N5Dà-5 PNP PNP P3NP PNP P5NP SPà DAPGԠHŠSԠPAM DBKYDANDHŠADDSSƠHŠDSG A̬ŬASԻAҠPSSBŠSGNB SADSAVŠDSGADDSS SԠDABɠSAH NBDADDSSN SZASSKYDS MPԲNDƠSԻҠ PADHSN? NASSYSSKP MPSԠNϻYNԠN DBAɠUNDGԠAԠDADDSS ADA.A_SAUSADDSS DAAɠA_SAUS PBԠƠANGNHSPGM BSԠB_0 AƬSAƠAԠBԠSS SZBANDANGҠHSPGMSKP MPԲSŠԠ-GA̠A SPà SBMP DAABUƠSԠKSAHҠS SADADNY SPà HŠKUNŠSAHSHŠDSàDYҠH NDDS. ҠHŠSԠA̠DADSHUDPNԠAԠH SԠDNABU.SUBSUNYK ̠UPDAŠDADAHA. HHŠPNƠHŠDSàDYUPDAŠHŠDS MUSԠBŠUND.NHSASŬԠSϠHŠAԠUN NԠAAKNANSHŠDYAK AUNANSHŠDYU ANANSHŠKD NSUBSUNԠASƠHŠDSàDAS0HŠN DSàSUND.ƠHŠDSàDASNԠ0 ANԠUNDԠSAKN. NԠDAP5GԠHŠD-BԠ5NDAŠDS DBPDNP5 SSBDNP5? MPK0YSSKP ŬSASSNϻP5SUNNVN? MPK3YSGϠAԠU DAP3NϻUSNP3 K0MAŬSSANA_0NDASADGŠAB MAŬNA_NDASU(SԠ+ DBMPGԠPVUSD SAMPSŠD MŬSZBƠNԠAZϬDNSND MP6A̠AKŠ-6 SPà A̬ASԠSGNBԠƠAAB̠SAH SAMPANDSԠҠMPA SPà K6SBDPSADHŠPAAMϥS DAMPSԠHŠUNDBԠNŠ MAŬNAAZϠD DBDADGԠUNԠDYADD. KDABɠGԠSԠD SZASSƠ0HNND MPK5SϠGϠHKҠDY SAAUUPDAŻSŠSAVŠU PAMPSHSHŠUDDS? ŠYSSԠŠϠϠNDAŠUND NBSPϠAKADDSSAND DABɠS SAAAKNAAK NBSP DABɠAB̠ANDH ҠSGNSԠSGNҠMPA SZNBSSSPϠKADDSSSKPƠUND PAMPSHSHŠUSDDS? MPKYSGϠ NBNϻSPϠNԠN MPKANDGϠHK SPà K3DAP3UANDAKNP3 ANDBMASKϠU SAMPSAVŠU SABSAVŠUNBҠS ҠP3MASKϠAK AƬA̠AŠ A̬AƠנAAND SADҠSAVŠHŠAK PBDPSDϠŠHAVŠHSNŠAADY? MPDDYSSϠGϠDDŠHŠUS MPK6NϠSϠGϠKҠ SPà KSBDADUND-UPDAŠUN SZDADADDSSҠNԠM DABɠKϠA SZAƠNԠKD PADҠKDϠA MPDDSKP DAMPSŠ SZASSMU-DSàSAH MPNԠNNU MPر3SŠԠKDDS SPà DDDAPƠPN SSAUS MPPNGϠPN DAP5S SSAHKUSԠD MPر0NGAVŠ- ADAN0 SSASS MPر0GAҠHAN9- ADAABADNDؠNϠHŠUNN MPAɠGϠUŠHŠUNN SPà ABADDƠABA+0 ABAMPSŠ0 MPAԠ MPNAM MPK3 MPر0 MPUK5 MPPN6 MPGN MPPN MPPAK9 SPà5 DPSADHŠDSàDY DPSԠ- SBSҠŠUNԠSҠBK NAA_ SADUSԠҠU-SYSDS AMPUŠASԠAK ADAASDADDSSAND SAAKS ASԠSԠADDSS SASԠZ SBSUBADHŠBK MPDPSɠUN SPà5 SҠŠUNԠBK SҠNP DASGԠŠAG SZנSԠUSԠDŠϠ SZAƠNԠNNSKP SBSUBSŠŠHŠBK ANASԠUSԠDŠ SAנAD MPSҬɠANDԠ(A SPà נNP DUNP SPà SUBUNŠϠADҠŠA-SҠBK SUBNP DDנHHŠNנPNS ADBP SBPM SASSƠŠHN MPSUGϠDϠ PBDUSŠ DBNSAMŠBKAS DAAKUNԠN PAAàHN NB DASԠN PASԠANS ŬNB PBN5UDS MPSUBɠUN SUSBàNԠSAMŠBKA̠ DƠNUN DƠנADŠD DƠPMU ABUƠDƠBUƠBU DƠ.DS DƠAKNAK DƠSԠS NAŠAҠHŠ SASAG DADUSԠUPASԠPNSҠNԠM SADU DAAKSAVŠHŠAK SAAàADDSKSANDH DASԠS SAA+ADDSS PB.DSà? MPSUBɠNϠ-UN SADUYSSԠNԠNŠAG MPرYS-AKŠDSàҠ SPà DUNP AàNP SԠNP SKP PNDDP3SԠNAMŠDSAND3 DSԠNAM+NϠHŠNAMŠBU DAPSԠNAMŠD A̬ŬASSPSSBŠSGNB SANAMŠNϠHŠNAMŠBU SBSDҠSԠUPϠADHŠDY SBN.SHҠGϠNDHŠ MPNԠNԠUND-YNԠDS SBSADUND-GϠSԠHŠADDSSS SBAGHKHŠPNAGS DBUNƠPNS PB.HNNϠMS MPظ DAPƠUSVŠPN ŬSSASSHNSKP MPPN3NNUSVŠSKP ŬSZBƠANYPNSHN MPظԠUSVŠPN PN3DBSàGԠHŠAGADDSSSSN PN5NBSAHҠPNSPԠNAGS DABɠGԠAGD SSAƠSGNBԠSԠHN MPظŠSUSVYPNϠSMŠN SZAHSD? MPPN5NϻGϠYNԠN DAPYSGԠHŠDADDSS A̬ASԠHŠUSVůNN-USV SABɠAGANDPUԠNHŠDY SASSԠϠŠHŠBK PNDAYPŬɠSԠUPHŠUNPAAMS ؠSBPMSԠHŠUNPAMS ԠSBSҠŠHŠS SBPNPASSHŠUNPAMS DƠ+AND DƠұHN ԲSBàMP DƠ+ DƠ.6 SPà NSNPNUN PNSBDKGϠADNHŠMASҠDYNY AAҠH SADPNAGD DAPSԠH SZoASSƠAҠHŠMANHN MPPNŠHAVŠԠAADY AƬAƠNSNNϠҠPSSB SAGSàNSNA SBSHҠSAHҠHŠUDN MPPԠNԠUNDSϠGϠSԠƠAD AƬAƠNԠNϠϠA ANDB3MASK PAPHS? MPPNYSSϠGϠUNHŠPAMS SҠDAYPŠNϠSϠNNU MPNSHҴHŠSAH SPà PԠDBP5ƠNԠPNS PB.ŠHŠGϠAԠHŠN MPA0GϠ DAN5SŠUNGA̠D MPؠGϠ SPà .Dà .Dà ANAMŠDƠNAM AAKNP SGNԠ00000 SPà SDҠUNŠϠSԠUPϠADADY SDҠNP SBSҠŠUNԠS ASԠS SASԠAGϠNDAŠSԠBK DAAAKSԠHŠAK SAAKADDSS DAAUANDHŠU SADUADDSS PA.ƠU ASSUSŠZ DANSŠ-(UDADADDS SASԠSԠHŠS MPSDҬɠUN NDà- N.SHҠDYSAHUN AGԠNAMŠNNAM UN PàԠ000 S UNS: P+NDƠDYANԠADD.(ƠA0NDƠSPAũ P+UNDUNANYADD. N.SHҠNP SBDNBADHŠDY MPN.SHҬɠNDƠDSàUN NSH0DAABUƠSԠAϠHŠBUҠADDSS DBNSԠUNԠҠHŠN.NABK SBUN NSHұŠSԠUNDAG(Ž DBANAMŠSԠHŠNAMŠADDSS SBMPNMP DBN3SԠҠ3-DNAM SBUN NSHҲDBAɠGԠANAMŠD SZBSSƠZϠ-NDƠDYa MPN.SHҬɠSϠ PBMPɠMAH? NASSYS-SԠҠNԠDSKP ŬNANϠ-SԠNԠUND-SPNAM SZMPSPANS SZUNANDUNԠMŠNAM MPNSHҲYSGϠDϠ BSZŬNBNϻUND? MPNSH3YSGϠAKŠUND NSHҴADA.3NϻSԠҠNԠNY SZUNDNŠHBK? MPNSHұNϻDϠNԠNY MPN.SH+YSGϠADNԠBK NSH3ADBN.SHҠUND-SPUNADDSS ADAN3ADUSԠϠSAԠƠNY MPBɠUN SADϠSԠUPADDSSSҠDYNYNBUƠA ADDSSPNDϠBYA SADNP B SBP.PAS N0Dà-0 DANP NP NP YPŠNP AKANP SANP SàNP ̠NP SàNP AGANP MPSAD SPà SPà PMNP SAұSԠSԠUNPAM DAAKAKU S̠6 ADAAUUN SAҲ DAABUƠS MANAAND ADADAS AƬAƠ ADASԠUN SA33 DAAKAɠAKƠŠ SAҴUN DASAɠGԠHŠSҠADDSS ANDB3SAŠ DBSԠGԠHŠNUMBҠƠSSAK BƬBƠAŠAND ADABMBNŠHHŠS SA5UN5 MPPM SPà ұNP ҲNP 3NP ҴNP 5NP SPà DNBADNԠDYBK DNBNP SBUDADUPDAŠHŠADDSSS MPDNBɠNDƠDYUN SBSUBADHŠBK SZDNBSPϠKUN SZSԠSԠBK? MPDNBɠNϻSϠUN SPà ${640 SBDPMM MPDNBɠUN UDAD--UPDAŠHŠDYADDSS UDADNP SBSҠŠUNԠBK DA.A_ ADASԠADDϠHŠS BPPAŠҠDVD DVSԠDVDŠBYHŠNϠƠSS0AK SBSԠSԠHŠNנSҠADDSS SZAƠNϠVҠ SZBƠSҠSZϠHNSKP(NנAK MPUDADSŠGϠ SPà BSԠϠDMNԠAK ASԠAҠҠUN ADBAKADDSS PBҠUԠƠDY? MPUDADɠYSSϠUN SBAKSԠHŠNנAK UDADSZUDADSPUN MPUDADɠAKŠҠUN SPà ҠNP NSADƠBU+5 m&6  29033-80002 B S P0122 RTE FMGR PRTN,CREAT,OPEN,PURGE             H0101 ASMBҬ̬ HDPNϠUNPAMSϠHŠSHDUNGPGAM NAMPN6 NԠPM NԠPN Ԡ$BҬ$B SPà HSUNŠSUSDϠPASSVŠPAAMSϠHŠPGAM HAԠSHDUDHŠAҠHA. HŠSHDUNGPGAMMAYVҠHSŠPAAMSHMPA. HŠAԠAGSADSϠHŠAҠSHUDHAVŠHGH PYHANHŠSHDUҠϠPVNԠASAP. ANGSUN: SBPN DƠ+SANDADANSUN DƠPAMADDSSƠHŠVŠUNPAMAS SBàPGAMSHUDMP DƠ+ DƠS SPà3 PNNPNYPN SB$BҠGϠDϠPVDGŠHNG UNԠNP DAPNGԠHŠADDSSƠHŠA̠PAMS DBAɠGԠUNADDSS SBNSAVŠ NASPϠPAMADDSS DAAɠGԠPAMADDSS A̬ŬSAAMVŠPSSBŠND MP-ƠNDԠYAGAN SAPNSAVŠHŠPAMADDSS DAKYDGԠHADƠHŠKYDS SAPMSAVŠԠAY MPNԱ+GϠSANHŠS SPà NԠBNBADDN ADBAϠԠϠGԠHŠAԠDADDSS SBDASϠHŠPAMSAVŠADDSSSAVŠ DBBɠGԠHŠD PBԠHSHŠSHDUNGPGAM? MPUNDKSGDGϠHKHŠSAUS NԱSZPMSPKYDADDSS DAPMɠGԠNԠNY SZAƠNDƠSԠ MPNԠNԠNDYNԠD SPà ԠDAPSԠHŠPNҠPNNY SAPN SB$BؠԠϠHŠSYSMԠUN DƠNUNADDSS SPà NNP DNP SAԠNP SPà UNDDBD5AUAŠASԠPAMADDSS ADBAϠB SS-BASԠSAVŠԠҠSNG ADBD0AUAŠHŠSAUSADDSS SBSAԠSAVŠ DBBɠGԠSAUSƠSHDU BƬSBSHŠANG? PNBŬSBBҠNASSҠPM MPNԱNϠYNԠPGM BƬBƠAŠBHŠS BƠƠHŠAYAUND SBSAԬɠSԠSAUSϠSHDUD VҠNASԠϠPMAA DBPNɠGԠSԠPAM SBAɠSԠPAM SZPNSPADDSS PAASԠASԠPAM? BNBSSYSB_ANDSKP MPVҠNϠGϠDϠNԠN ADAD5YSSԠϠBGADDSS DBDGԠADDSSƠPAMAA SBAɠSԠBGSAVŠϠPNԠϠPAMS MPԠDNŠUNϠPGM SPà3 PBŬSBB NASNASSPMNYAPN ASԠNP D5Ԡ5 D0Dà0 SPà PMNPPNA̠NYҠU SB$BҠPAMҠPASSHUԠANG NPHŠAԠB DANASGԠHŠPNA̠NSUN SAPNSԠԠNHŠD DAPMGԠHŠUNADDSS SAPNSԠԠNHŠMANNYPN MPUN+GϠϠMANNŠANDDϠHŠB SPà AU0 BUA+ KYDU65B ԠUB ND ASMBҬ̬ NAMAԬ NԠA ԠSŬ$PN.N ԠNAM..MPA Ԡ SUP AԠSHŠŠANMDUŠƠHŠA̠M ŠMANAGMNԠPAKAG. HŠANANGSUNŠS: A̠A(DBҬNAMŬSZŬYPŬSU Ϡ ҠA(DBҬNAMŬSZŬYPŬSU נHŠҠ: DBSHŠADDSSƠA-DAAYHH AԠ̠USŠASASAHAA. SZ<0HNHŠADɄ,ŠSAS PNDϠHSDAAN̠BK. ҠSHŠADDSSϠHHHŠҠD SUND.HSNMANSAS UNDNHŠAGS. ҠDSA: 0HŠAԠASSUSSU̠-HŠSSSUND -HŠDSàSDN -DUPAŠNAM -ŠϠNG -6ADGŠNԠUND -0NԠNUGHPAAMSNHŠA -3DSàKD -DYU -5GA̠NAM -6GA̠YPŠҠSZ NAMŠSA3-DAAYNANNGHŠNנ'SNAM. HŠNAMŠMUSԠNANNYGA̠AS HAASNUDNGMBDDDBANKS.MMAS +SGN-SGNAŠNԠAD. NADDNHŠS HAAҠMUSԠBŠNN-NUMàANDNN-BANK. SZŠA-DAAY.DSHŠSZŠN -DDUBŠSS.DSUSD NYҠYPŠSANDSHŠDNGH. YPŠSHŠŠYP--MUSԠBŠ0. S(PNA̩SHŠ'SSUYD. ƠS0HŠŠSŠPD. ƠS<0HŠŠSPNPD. ƠS0ҠSNԠDDHŠŠSPUB. U(PNA̩DSHŠAԠ: ƠU<0HNHŠDSàAԠGA̠UNԠ(-U. ƠU0HNHŠDSàHAB̠U. ƠU0ҠNԠDDHŠSԠAVAAB DSàHNUGHMSUSD. SKP DBNP ҠNP NAMŠNP SZŠNP YPŠDƠZ SàDƠZ UDƠZ SPà AԠNPNYPN SB.NҠANSҠHŠPAAMS DƠDB DAYPŠMAKŠSUŠHŠA PADZϠNUGH MPұ0NϠ-Ҡ SBSŠ@GϠSŠHŠDҠ(ƠPN DƠ+ DƠDB SZANϠ PANANDNԠPNҠ-K SSSϠSKPƠHSSHŠAS MPԠSŠԠSMŠSŠ SBNAM..GϠHKHŠNAM DƠ+ DƠNAMŬ SZAƠKSKP MPԠSŠԠ SPà DANAMŬɠGDNAMŠS SABUƠS SZNAMŠUP DDNAMŬɠSKNDY DSԠBU+NYNBU DAYPŬ SZAYPŠMUSԠB SSA0 MPұ6NԠ0 SABU+3 DBSZŬɠGԠHŠSZ BSDUBŠϠGԠ6-DSS SSBMUSԠBŠ0 BSԠϠ- SZBSSƠZ MPұ6 SBBU+6S SZSZŠSPϠDSZ PA.ƠNԠYPŠ ASSHN MPASKPSZŠS SҠ0SHԠϠAҠDVD DVSZŬɠƠVҠנHŠDSZŠϠSMA SàƠKSKP MPҴSŠҠŠϠAG ADASZŬ DBBU+3GԠYP PB.ƠYPŽ DA.SԠSZŠϠ PB.ƠYPŠϠSZŠMUSԠBŠGVN SSASSSZŠGVN? SSYSҠNԠYPŠϠSKP MPҴSŠ A3SABU+SԠDSZ DASìɠS SABU+SUYD SPà SBàG DƠѠN DƠ.AK DƠ.M DƠAKH DƠDUSYSM DƠMP ѠSBà DƠNH DƠ.DY DƠDUNY DƠBUƠN DƠ.H )tDƠAKAK DZϠDƠZϠAԠSҠZ NASԠϠDSàҠD PB.DSà SSNϻSKP MPԠYS DAAKMBN S̠6AK ADADUANDU SAMPҠD. SHPSBàSHDU DƠSHԠD. DƠ.9 DƠD.ҠA DƠԠH DƠMP DƠUɠPASSNG DƠMPH DƠ.AK SHԠSZASHDUŠK MPSHPNϻYAGAN SPà SBMPAҠYS DƠ+A̠MPA DƠBU+ϠGԠUNDS SBàAS DƠNH DƠ.5SYSM DƠ.AK DƠAK DƠDU NDABU+GԠD.ҠMPN SSADŠ-K MPԠNϻAKŠ DABU+5YSSԠUP SADBɠϠA DBDB$PN ŬNB DABU+6PN SABɠH DADB DBSì SB$PNSԠUPSԠƠDB DƠBU+ADDSSƠNϠƠSSAK MPԠDSàҠ- DAYPŬɠGԠYP ADAN3Ơ3ҠM SSASKPϠŠ MP0NԠANDMASS ASԠNNANDƠAGNDB DBDBGԠŠAG ADB.3ADDSS SABɠSԠNNAG ADB.3SPϠHŠBUҠANDSԠ SABɠNSԠDƠBU 0DABU+NϻUSŠD.ҠUNҠ ԠDBDZϠD SBSàS SBUA̠DS SBYPŠҠNԠA SAҬɠhSԠҠD MPAԬɠAND SPà3 ҴDANSԠ MPԠD ұ0DAN0AND MPԠ SPà3 ұ6DAN6GԠHŠҠD MPԠAKŠ SPà3 MPNP N6Dà-6 N0Dà-0 NDà- N3Ԡ-3 NԠ- .Ԡ .Dà .3Ԡ3 .Dà .9Dà9 .5Dà5 .3Dà3 .Dà DUNP AKNP ZϠNP UNԠU BUƠBSS9 D.ҠASà3D. SPà3 AU0 BU ԠUB SPà NDU SPà ND ASMBҬ̬ NAMPN NԠPN ԠìSŬMPAҬ$PN Ԡ.N SUP PNSHŠŠPNUNŠƠHŠA̠M ŠMANAGMNԠPAKAG HŠANANGSUNŠS: A̠PN(DBҬNAMŬPSU נHŠҠ: DBSA-DDAAN̠BK(AAY ϠBŠUSDHA̠ASSϠHŠ UNDҠHSPN. ҠSHŠUNҠDŠ(ASϠUNDNA NAMŠSHŠ6-HAAҠ(3DNAMŠAAY. P(PNA̩SHŠPNPNAGD PNSA: BԠMANNGƠS 0NN-USVŠPN UPDAŠPN ŠϠYPŠPN S(PNA̩SHŠPDSUYD. U(PNA̩SHŠDSàSPD. ƠU0HNUSŠDSàABDU ƠU<0HNUSŠDSàAԠGA̠UNԠ(-U PNSAŠASS: -DSà -6ŠNԠUND -NGSUYD -ŠSUNYPN(ƠUSVŠUSԩ SUNYPNϠHҠPGAMS -9AMPԠϠPNYPŠ0ASYPŠ -0NԠNUGHPAAMS -3DSàKD SKP DBNP ҠNP NAMŠDƠZ PDƠZ SàDƠZ UDƠZ SPà PNNPNYPN SB.NҠANSҠPAAMS DƠDBϠA̠AA DAN0 DBNAMŠDDŠG PBDZϠNUGHPAAMS? MPԠNϻҠ- SPà SBSŠS DƠ+ DƠDBɠPN SZASKPƠNϠS PANҠƠNԠPN ŬSS MPԠSŠAKŠҠ DANAMŬɠGԠNAMŠD DBPɠANDPN BUSVŠBԠϠ MŠNVԠAND A̬ASԠNSGNƠA SANAMűSԠҠA̠ϠD. SZNAMŠG DDNAMŬɠSԠ DSԠNAMű+NAMŠANDSԠҠD.ҠA DAԠGԠD ŠAND A̬AS SADSGNҠD.ҠA SDԠSBàSHDU DƠSND. DƠ.9HA DƠD.ҠϠPN ؠPHŠ DƠD+- DƠU SNSZASHDUŠK? MPSDԠNϻYAGAN SBMPAҠYSGԠHŠUN DƠ+DS DƠDϠA̠AA DADGԠҠD SSAƠ MPԠ DDD+SŠS DSԠDBɠHŠDBҠ$PN ϠSԠ DAPɠ AҬSAAҠNDA SϠUPDAŠPN AANDŠҠYPŠV-D SAUSAVŠAG DADBGԠDBADDSS DBSìɠANDSUYD SB$PNANDGϠSԠUPHŠDB DƠD+ADDSSƠNϠƠSSPҠAK MPPNҠ-SŠAND SSAƠPNP SSBANDDŠMSMAHHNSKP MPPNSŠGϠԠ-GDPN SPà DANSԠԠD PNSADND SBSŠGA̠PNSϠS DƠ+H DƠDBɠ PNDADSNDҠD DBUGԠSUBUNNAG SBƠNԠS SZAҠNԠYPŠZ MPԠHN SPà DBDBAUAŠDBSUBUNN ADB.3ADDSS SBDBSAVŠ DAPɠGԠHŠPNSUBUNN ANDB300MASKԠ SABANDSAVŠ DADBɠGԠHŠUNԠD ANDBSAVŠHŠU ADABADDNHŠNנSUBUNN SADBɠSԠԠNHŠDB AAҠAAND SPà ԠDBDZϠSԠH YPDAU SBNAM+-YPAAMS SAҬɠSԠHŠҠD MPPNɠANDUN SPà SPà3 DZϠDƠZ N0Dà-0 NDà- DNP NAMűBSS NDà- ZϠNP D.ҠASà3D. .3Dà3 B300Ԡ300 BԠ .9Dà9 SPà3 AU0 BU ԠUB SPà3 NDU ND ASMBҬ̬ NAMPUGŬ NԠPUG ԠPN Ԡ.NҬS SUP PUGŠSHŠŠDNUNŠҠHŠ ŠMANAGMNԠPAKAG HŠANANGSUNŠS: A̠PUG(DBҬNAMŬSU נHŠҠ: DBSA-DDAAN̠BK HHSUSDBYPUGŠASA KNGBU.DBS ҠHҠUSŠAҠAPUG. ҠSHŠҠUNAN. NAMŠSHŠNAMŠƠHŠŠϠBŠPUGD. SSHŠ'SSUYD. USHŠDSàHAԠHŠŠSN. ƠU0HNNDSàABDU ƠU<0HNNDSàAԠGA̠UNԠ(-U SUNDBYPUGŠA: DŠASN 0NϠS -DSàADŠ -6Š(ҠDSéNԠUND -GA̠SUYD -ŠSPNϠSMŠHҠPGAM -0NԠNUGHPAAMS -3DSàKD -6AMPԠϠPUGŠAYPŠ0 SKP DBNP ҠNP NAMŠDƠZ SàDƠZ UDƠZ SPà PUGŠNPNYPN SB.NҠDϠNYUN DƠDB DAN0NԠNUGHPAM DBNAMŠ PBDZϠ? MPԠYS- AAҠHŠUNAŠD SANGAND SPà SBPNNϻG DƠPNPN DƠDBɠUSVY DƠҬɠ DƠNAMŬɠA DZϠDƠZ DƠSìɠPASSHŠSUYD DƠUɠANDHŠDSàD PNSSAPN? MPԠYS SZASSNϻYPŠZ MPر6YS-GA̠PUG SPà DADBGԠADDSS ADA. DBAɠSUY SSBSSƠMSMAH MPطGϠSԠҠ SPà ADANADDSSƠŠNGH DAAɠGԠŠNGH ASSԠϠBKNGH SANGSԠҠUNAŠD SPà SSBSŠSŠHŠŠANDUNAŠϠZ <:6DƠ+(..PUGŠԩ DƠDBɠ DƠUDUMMYҠUN DƠNGUNAŠDADDSS DBҬɠGԠUNԠҠD SSBƠNNŠSKP DABSŠUSŠ ԠSAҬɠSԠHŠҠD DBDZϠS ؠP3H SBNAM+-ؠNY MPPUGŬɠAND SPà طDA.SԠ MANASSDŠANDSKP ر6DAN6 SAҬɠSԠDŠNUSҠAA MPSGϠSŠHŠ SPà3 NDà- N0Dà-0 .Dà N6Dà-6 NGNP ZϠNP D.ҠASà3D. SPà ԠUB AU0 BU SPà NDU ND <  29033-80003 B S P0122 RTE FMGR NAMF,READF,FSTAT             H0101 ܼASMBҬ̬ NAMNAMƬ Ԡì.NҬSŬNAM..PN NԠNAM NAMƠSHŠŠNAMŠHANGŠMDUŠƠH ŠŠMANAGMNԠPAKADG. ANGSUN: A̠NAM(DBҬNAMŬNNAMŬSU H: DBSADDAAN̠BK HSAASŠAҠHŠA. ҠSHŠҠUNAN SAŠUNDHŠANDN HŠAGS. DNDSA: 0NϠ -DSàDN -DUPAŠNAM -6ADGŠҠŠNԠUND -NVADSUYD -ŠUNYPN -0NԠNUGHPAAMS -3HŠUDDSàSKD -5GA̠NנNAM NNAMŠHŠNנ6HAAҠŠNAM SPNA̠-HŠŠSUYD UPNA̠-HŠSDSàD. PDNGNSANS NDà- .Dà N0Dà-0 SPà3 DBDƠZϠDN ҠDƠZϠPAAMA NAMŠDƠZϠADDSSS NNAMŠDƠZ SDƠZ UDƠZ SPà NAMƠNPNYPN SB.NҠHPAAMADDSSS DƠDBϠA̠S SPà DAN0ADҠNԠNUGHPAM DBNNAMŠNנNAMŠSUPPD? PBDZ MPԠNϻGϠ SPà SBNAM..YSNנNAM DƠNAM.ҠGA DƠNNAMŬɠҠAŠNAM? NAM.ҠSZA MPԠNϻ SBPNA DƠPN DƠDBɠPN DƠҬɠH DƠNAMŬɠ DƠZϠUSVY DƠSɠH DƠUɠUSҠPAMS PNSSASUSS=U̠PN? MPԠNϻ DADBYSHK ADA.H DBAɠSUY DAND SSBSSMAH? MPؠNϻSŠAND SBàG DƠұA DƠ.SYSM DƠ.AK DƠAK DƠU DƠDB ұSBà DƠҲH DƠ.N DƠUNAM DƠNNAMŬɠN DƠ.H DƠAKAK DƠZϠSҠZ ҲDDDBɠGԠDBϠB SBDBANDSAVŠ DAAKMAKU S̠6D ADAU SANAMŠD.ҠA SHSBàA DƠ3D. DƠ.9 DƠD.ҠHANG DƠԠH DƠNAMŠ DƠDBɠNAM DƠDB DƠ. 3SZASHDU MPSHN-HNYAGAN DABɠҠAGϠA SANAMŠSAVŠ SBàUN DƠҴH DƠ.5SYSM DƠ.AK DƠAK DƠU SPà ҴSSSKPҠNY ؠSANAMŠSAVŠҠD SBSŠS DƠұH DƠDBɠ ұDBNAMŠGԠҠD SZBƠNNŠSKP DABSŠUSŠ ԠSAҬɠSԠUN DBDZϠS ؠP3H SB-+NNAMŠADDSSS MPNAMƬɠԠϠUS SPà3 NGNSANS SPà DBNP UNP AKNP ZϠNP DZϠDƠZ SPà MPSNDNYBYDS SPà .Dà .Dà6 .Dà .5Dà5 .9Dà9 .Dà D.ҠASà3D. SPà ASSMBYADS SPà AU0 BU ԠUB SPà NDUPG.NGH SPà ND ASMBҬ̬ NAMADƬ NԠADƬ Ԡìү$.NҬP.PAS Ԡ$UB$KP ԠG$ SUP HSSHŠŠŠMANAGMNԠPAKAG ADŠSUBUN. HSUNŠ̠ADҠŠANYYŠ. ANGSUN: A̠AD(DBҬBUƬ̬̬N Ϡ ҠAD(DBҬBUƬ̬̬N ϠADϠ A̠(DBҬBUƬ̬N Ϡ Ҡ(DBҬBUƬ̬N Ϡ. נHŠҠ: DBSHŠDDAAN̠BK ҠHŠND. ҠSHŠҠUNAN SAŠASS: DŠҠNDN 0Ҡ0NϠ -AUDDSàҠDVŠSDN -5GA̠DNUMBҠ AMPԠϠADADNԠN -NVADSUYDŠ Š(ŠSADNY -0AUDPAAMҠSMSSNG -HŠDBSNԠPN -SƠҠƠSNSDNAD -GA̠USԠϠAYPŠZϠ ҠSŠҠ-UNDASUNN BUƠSHŠBUҠϠBŠUSDϠADҠ. ̠SHŠUSDANSҠNGHNDS. ̠SHŠNGHASADNDS. NSHŠUSDDNUMB ƠN0ҠƠN<0HŠAVŠD NUMBҠMHŠJUNԠPSN. NSGA̠NYPŠANDSNY. ϠPԠɠϠNS: ̠SPNA̠NYPŠANDS. NYPŠSSUSD NYPŠSHŠDNGHSUSD. ̠SPNA̠AԠA̠MS. NSPNA̠ANDSGNDNS ƠYPSHҠHANAND.ƠN SUPPDZϠSUSD. HŠSԠDNAŠSD. ŠؠԠŠҠNA̠S: $UBSUSDϠADҠŠDS MҠϠSƠYPŠ ABV.ԠHANDSA̠SҬ AKANDNԠSHNG HSŠSANDASϠSAND ADSBKSMHŠŠAS UD.ADSAŠNDNA NG$.AGBA̠AGHH MUSԠBŠNN-ZϠBŠAAD SUD. $UBANGSUNŠS: DBDS DADBADDSS ůŠůAD SB$UBA DƠUBUƠADDSSƠUS'SBU MPҠҠUN(ANDN --NMA̠UN SPà P$NSUSDϠAUAŠHŠPSN ƠYPŠANDS. P$NANGSUNŠS: DADBADDSS DBDNUMB SBP$NA NPBUҠSԠUNDH MPҠƠUN --NMA̠UN AAKBS ƠDà-ŠNYPN DAƠANSҠUNADDSS SAADƠϠADNY MPAD+ANDGϠϠADNY SPà3 DBNPDBPN ҠNPҠB BUƠԠ-USҠBUҠADDSS ۂDƠDMUSԠNGH ̠DƠZ0UNNGH NDƠZ0DNUMB ADƠNPADNYPN SB.NҠANSҠH DƠDBPAAMS DADBSԠUPH BŠDB SBP.PASADDSSS NDà- MPNPUSŠSԠϠAS MPNPMPSAG YPŠNPADDSSƠYP U0NPU(Ҡ0ũ AKUU0ASϠAK 0NPƠDŠ(0ũ BSԠU0ASϠS SPAàNPSPANGDŠ(0ũ SZŠUSPAàASϠŠSZ ̠NPDNGH SMϠNPSUYPNMD SïԠNPSSAK GNPPNAG ҠNPUNԠAK SԠNPUNԠS BUPԠNPUNԠPSN GNPADŠAG àNPDUN MPNP BUDNP SPà DAN0PSԠҠMSSNGPAM DBBUƠBUҠMUSԠB SSBSUPPD MPԠSŠMSSNGPAM DBGɠƠNԠPN DAN PBԠHN SS MPԠԠŠNԠPN DBƠGԠADŠAG DASMϬɠANDSUYD SSBSSƠ SSAAND MPSKBADSUY DANHN ԠDBN SBBUƠS DBDMBUƠPNA SB̠PAAM DBDZ0ADDSS SB̠ SBNN BA SBZ0 SBDM B SBƠSԠADŠAGAND SAҬɠSԠHŠҠD MPADƬɠUN SPà SK̠SHԠSGNϠנA SAG$USŠAADAG DB̬ɠGԠNҠ SAƠAD DBNɠGԠADN DAYPŬɠGԠYP PA. MPSԠGϠSԠҠ PA.ƠYPŠN ASSSKP MPSSŠGϠϠƠS ANDMASS SPà SAGɠNHBԠү$ŠҠYPŠNŠS DA.UŠNGHϠҠYPŠS SA̬ɠҠHŠPSNUN SPà SԠDA̬ɠGԠHŠUSԠNGH SSAƠƠUSԠHN MPKGϠԠNϠAN SZBPSNPN? SSBYSƠ<0 ADBìɠADDUNԠPSN SBMPSAVŠSU A ADABMUPYDNGH SSAƠNGDN MPؠAKŠҠ MPY̬ɠBYHŠDSDD SAMPSAVŠנPA ANDBMASKϠS SAGSԠHŠS ҠMPSŠHŠHGHPA ASҠ6VNSԠADDSSϠA SAMPSAV MAHK ADASZŬɠ SSAƠNԠƠSKP MPؠAKŠҠ DAMPSŠA ADABSԬɠADDHŠBASŠS DVSïԬɠDVDŠBYN.SԯAK ADAAKɠADDBASŠAK-AAK DSԠMPSAVŠNנүSҠADDSS PAҬɠƠSAM AAS PBSԬɠUN DB0PSN ŬSSBHN MPASSKP DBDBS SBү$ŠHŠUNԠBK MPԠƠNSSAY DDMPHNS DSԠҬɠHŠN SPàADDSS ASDAGSԠHŠS ADABUDADDBUҠADDSS DSABUPԬɠANDSԠHŠPN DAMPSԠH SAìɠNנDNUMB SPà SDABUPԠSԠHŠND ADAMSGNBԠN SABUPԠHŠBUҠPN DAYPŬɠGԠŠYP MANASZASSƠ0 MPYP00Ҡ NASZASSGϠDϠ0HNG MP.YP NASZASSƠYPŠ MPYGϠDϠADS NSDAGɠGԠHŠNŠAG ŬSZAƠN MPSPGϠSԠҠ DBDBSŠAD SBү$HŠBK MPԠҠ SPà SPDAYPŬɠGԠHŠYPŠAGAN נDB̬ɠGԠHŠDNGH(YPŠ PA.ƠYPŠ MP.נGϠDϠAD SPà YPŠ3ANDABVŠADŠP DAƠSԠADŠAG ANŠ0ŠAD DBBUPԬɠGԠUNԠD SSBSSƠ<0HN MPDNNϠ<0-SKP BSZSSƠƠAND MPSɠGϠAҠHŠADAG ƠDAGɠƠANDAD AҬAҠS AA̠ SAGɠBԠNDB 0ASԠUNNGH SA̬ɠҠ ASZƠSԠƠSKP ؠDANSŠƠ SSASSƠSԠƠHN SZìɠSPHŠDUN MPԠGϠ SPà SɠSBG$AҠHŠADAG DNBSZƠAD MPDűSKPŠHKS DA̬ɠGԠUSԠNGH MAŬSSANASSƠŠ MPҠGϠŠ ADABUPԬɠMPAŠNנNGHϠD DBG$GԠADAG ŬSZAƠNנNGHD SZBSSҠƠNԠUPDA MPDŲNNUŠ SPà 5DAN5@SŠUPDAŠ MPԠGϠ SPà DűDADMBUƠGԠNGHUNADDSS DŲBSZNBSSƠ DA̠USŠUSԠNGH SABUASԠADDSSƠBU DADBSԠHŠDBADDSS SB$UBGϠADSԠNGHD BUADƠ̬ MPԠҠ DBA .נDAƠGԠADŠAG AϠ ASZSSƠŠHNSKP MPԠŠSϠSKP DA̠HKƠNGHSUPPD PADMBUƠƠMPAŠHNNϠNGH ASSNԠSUPPDSϠŠANS DABSUPPDSϠHKҠD MANAϠNG ADA̬ɠBU SSASKPƠK DB̬ɠϠNGSϠUSŠSUPPDNGH SB̬ɠSԠASUNNGH ԠSASKPSAVŠSDUŠҠSKPAҠAD DADBDBϠA SB$UBADHŠD DƠBUƬɠϠUSҠBU MPԠҠ DBYPŬɠGԠŠYP PB.Ơ MPK-HNDNŠ-GϠ DADBSԠUPϠSKP DBSKPHŠSDU MBSSBNBSԠ+NϠDSSKPƠ0 MPNSKP<0SϠDN'ԠSKP SB$KPGϠSKPHŠDS MPԠҠ NSKPDAƠS ASԠ ASZSSADŠH DA̠ND SABUAAD DADBϠDUM BNBҠM SB$UBUS. BUAANP MPԠҠ- PABUAɠƠNMSMAH BSS MP5HNBADD- DAG$GԠADAG ŬSZASSƠNԠADNG MPҠGϠSԠƠN 0SZìɠSPHŠDUN KADNŠ-KS MPԠ k|SPà ҠSBBUPԬɠSԠƠNDB BB SBGɠNNANDƠAGNHŠDB MPK-GϠ SPà YDBG$GԠADŠAG SZBƠADNG MPNSGϠSԠҠN MPSPSŠGϠ. SPà YPŠ0ҠŠ--ANSҠM .YPDA̠GԠNGHADDSS DBAɠGԠNGH PADMBUƠƠNԠSUPPDHN DB.USŠ SB̠SAVŠAY ADBBUNDUP SҠGԠƠSSVD SBSKPSAVŠUNDDNGH ADBìɠƠDDS SBMPSAVŠNנD ADBNSUBAԠ(D'SSAԠAԠ BSNVԠϠ6DSS MBNBSUBA ADBSPAìɠMŠSZ SSBƠUԠƠ MPؠAKŠƠ SPà DASKPGԠUNDDNGH S̠SԠϠԠPSN DBƠAND SSBSSSԠ SA̠ SSBSSUN SA̬ɠNGHҠAD SPà DADB ANDB ADAP SAU SPà NҠDASԬɠMPUŠH MANAMAؠDҠHS ADASïԬɠASS S̠6AND SANSԠҠ MANASUBA DB̠M ADAB SSAƠϠMUH SBNSԠANSҠϠUSԠ SA̠SԠNUMBҠԠϠD AؠDAƠSԠUP BNBH SSASSUS NBD SBѠAND SBàA DƠNH DƠѠ DƠUҠ DƠBUƬɠɯ DƠNϯ DƠҬɠ_M DƠSԬɠUS NSZSKPDSà?? MPDSàYSGϠDϠDSàҠHK SZMPƠ MP0SKPƠSS SB̬ɠSԠHŠUNNGH SPà A̬ŬAPUԠHŠDNBԠN AƬA̠SHԠHŠƠB A̠ϠBԠ5 SSAƠƠBԠS MP00GϠDϠƠHNG SZBƠZϠDSADHNSKP MP0SŠGϠԠGD ANDB0MASKHŠHGHDҠYPŠB SZŬSZAƠNԠDNҠƠYPŠ<0HN MPYP00SŠYHŠ SPà 00 MP0DϠƠYPŠZϠ SPà DSàAPSԠҠ PBNDSà? SSNϻSKP MPԠYS ADBBUƠUPDAŠH SBBUƠBUҠADDSS ASԠUPҠPSSBŠAKSH SASԬɠSԠS SZҬɠSPHŠAKADDSS DA̠GԠMANNGNGH MASSANASZASKPƠNԠGAҠHNZ MPNҠMŠSϠGϠDϠHŠNԠBK SPà DAMPDNŠUPDA SAìɠHŠDUN MPKAND UN PàԠ000 S SPà3 0SBàŠYPŠZϠ DƠԠUNADDSS DƠ.3 DƠ0 DƠN ԠMPK SPà3 رDANSԠUPGA̠USԠAG MPԠGϠ SPà YP00DBƠƠAD SBMPSԠADŠAGҠƠS DA̬ɠGԠHŠADŠGA̠AG SSBSSƠ AҠSHԠHŠŠAGϠBԠ5 SSASSSԠHŠAG MPرGA̠USԠGϠ SPà AƠAD SSBHN MPYP0SKP PA̬ɠ? MP0YSGϠMAKŠN̠ SPà YP0SASKPSԠYPŠ0AG DAU0ɠGԠGA SAUҠUNԠANDS DA̬ɠGԠUSԠNGH SANANDS MPAؠGϠA̠ àϠNSԠANԠS NԠ- .Ԡ .Ԡ .3Ԡ3 .Dà MSGNDƠ0 DZ0DƠZ0 Z0NP DMBUƠDƠDM DMNP NDà- N0Dà-0 NԠ- NDà- N5Ԡ-5 BԠ B6Ԡ600 B0Ԡ0 BԠ B0Ԡ0 SPà5 SKPNP ѠNP UҠNP NNP SPà3 AU0 BU ԠUB SPà PNGU ND ASMBҬ̬ NAMSAԬ NԠSA Ԡì.N SPà SAԠADSHŠDYƠDSSϠH USҠSPD5DBU ANGSUN: SPà A̠SA(SAԩ SPà H:SAԠSA5DBUҠN HHHŠDY̠BŠAD. SPà5 SAԠNP SPà SAԠNPNYPN SB.NҠHH DƠSAԠADDSS SPà AMPUŠAS ADAASDSYSMDS SAAKAKNUMB SBàA̠ DƠN DƠ.AD DƠ.MU DƠSAԬɠϠHŠUSҠBU DƠ.55DS DƠAKMHŠASԠAK DƠ.0SҠ0 NMPSAԬɠUN SPà3 .Dà .Dà .5Dà5 .0NP AKNP56B SPà AU0 BU ASDU56B SPà NDU SPà ND uHFBBH  29033-80004 B S P0122 RTE FMGR RWNDF,POSNT APOSN,FCONT,LOCF             H0101 ASASMBҬ̬ NAMNDƬ NԠND Ԡ.NҬND$ Ԡү$ HŠMDUŠƠHŠŠŠMANAGҠPMS HŠNDҠSԠUNN AŠSSԠϠNԠ0DVAND$ AYPŠZϠUNԠSUNDVAANDàA ANGSUN A̠ND(DBҩ H: DBSHŠSDAAN̠BKAAY ҠSHŠҠUNAN. SAŠUNDNHŠAG AS. SDSA: 0NϠ -DBNԠPN SPà PŠNSANԠAA SPà .3Dà3 YPŠNP .Ԡ .Dà .5Dà5 SPà3 DBDƠDB ҠDƠDB SPà NDƠNPNYPN SB.NҠH DDMDƠDBPAMADDSSS SPà DBDBGԠDBADDSS ADB.NDؠϠYPŠAND SBYPŠSԠADDSS ADB.NDؠϠPNAGAND DABɠH PAԠPN? ANASSYSSԠANDDUNԯSKP MPNPNNϻAKŠҠ ADB.5NDؠϠDUNԠAND SABɠSԠDUN DAYPŬɠGԠYP ŬSZAƠNԠZ MPDSàGϠDϠDSàHNG SPà SZYPŠYPŠ0-SPϠU DAYPŬɠHUAND ANDBSAŠԠHN ADAB00ADDHŠNDB SAYPŠANDSAVŠҠ SPà SBàA̠à DƠNND DƠ.3YP DƠYPŠZϠ NASSSԠҠDŠANDSKPϠ NPNDANNԠPN-Ԡ- ԠSAҬɠSԠҠD DBDDMSԠNYADDSSS SBDBAN"D SBҠHN MPNDƬɠUN SPà MDNSANԠAA SPà BԠ B00Ԡ00 NDà- SPà3 DSàDBDBSԠUPAND SBү$ŠHŠBKƠNSSAY MPԠƠҠ SPà DBDBDSà-A AND$ SBND$ϠSԠUPDB MPԠҠUN MPNNMA̠UN SPà PSԠNSANԠAA SPà AU0 BU ԠUB SPà NDU SPà ND ASMBҬ̬ NAMPSNԬ NԠPSN Ԡì.NҬG$P.PASADƬ$KP PSNԠSHŠŠPSNUNŠҠH ŠŠMANAGMNԠPAKAG ANGSUN: A̠PSNԠ(DBҬNPҩ H: DBSHŠSDAAN̠BK ADDSS ҠSHŠҠUNADDSS PSNԠSA: 0NN -DSàDN -5ANGA̠DASNUND (NGHSAԠAHNDDDNԠMAH -0NԠNUGHPAAMS -DBNԠPN -ƠҠSƠSNSD NPƠ0HNSKPNPDS Ơ<0HNBAKSPAŠNPDS Ơ0HNNϠPAN Ҡ(PNA̩ƠNԠDDҠZ NPSAVŠHZ NPSABSUŠ(NPMUSԠBž0 SPà3 PŠSAG SPà N0Dà-0 NDà- DZҠDƠZ ZϠNP DBNP ҠNP NPDƠZ ҠDƠZ SPà PSNԠNPNYPN SB.NҠH DƠDBADDSSS DAN0NUGH DBNPPAMS PBDZҠSUPPD? MPԠNϬ SBG$UŠADSHŠSPANG BŠS DADBUP SBP.PASA Dà-5DB UNPADDSSS DUMNP YPŠNPYP UNPUҠYPŠ0 ƠNPƠDŠҠYPŠ0 SPAŠNPSPANGGA̠AGŠYPŠ0 NNDNP NNP NP PNNPPNAG ABàNP NNP BPԠNPBUҠPNҠYPŠ3ANDABV GNPADŠƠAG àNPDUN DANGԠNԠPN.DŠϠA DBPNɠGԠPNAGϠB PBԠPN ŬSSYSSKPSԠ MPԠNϻԠPN DABPԠGԠBUҠPNҠADDSS A̬ASԠNDԠB SABPԠSԠPN DAҬɠGԠAVŠABSUŠAG BASSUMŠABSU SZASSAV? DBìɠYSGԠUNԠDN. ADBNPɠADDHŠUSDMVMN SBABàSAVŠNנABSUŠADDSS MBNBSԠNGAVŠAND ADBìɠMPUŠAVŠDNUMB MBNBSZBSSSԠϠGHԠSGN-Z? MPKYS-GϠ SBUNϻSԠUN SPà DAYPŬɠGԠYPŠƠ MANASZASSYPŠZ? MPYP0YSGϠϠYPŠZϠUN NASZAYPŻ NASZASSҠ MPYYSGϠϠANDMASSPSN SPà MBSSBNBYPŠ3ҠABVŠ-AD MPSàSPAŠ-YSGϠDϠ. SPà YPŠ3ANDABVŠBAKSPAŠUN SPà BSàDABPԬɠGԠUNԠPSN NASZASԠ? MPBS3NϻGϠBAKSPA DAGɠYSGԠHŠAD AҬŬAҠAGANDAҠHŠƠB AA"̠HN SAGɠSŠHŠAG SZASԠS? MPBS5YSUNԠASAD BS3BNϻBAKSPAŠ DADBD SB$KPHH MPԠSKPUN DABPԬɠGԠHŠDNGH SANSAVŠ MABAKSPAŠ SABH DADBN SB$KPHH MPԠSKPUN DABPԬɠGԠN PANNSMAH? BS5ASSYSSKP MP5NϻҠ-5 ADAìɠDMNԠH SAìɠDUN SZUSPBAKSPAŠUNԠDN? MPBS3NϻDϠHŠNԠN MPK ADSPAŠYPŠZϠAND3ANDABVŠS SàSBUSԠUN SñSBADƠAD DƠAԠA DƠDBɠD DƠҬɠ DƠDUMA̠DUMMY DƠ.NŠDBU DƠN AԠSSAƠ MPԠ DBN SSB MP SZU MPSñ MP SPà N3Dà-3 SPà YPŠZϠSPAŠUN SPà YP0MBSSBNBƠADSPA MPSàGϠϠADUN SPà DAN3PSԠҠ DBSPAŬɠBAKSPAŠG SSBSSGA̠D MPԠBAKSPAŠNԠGA- SPà DAUɠGԠAND ANDBSAŠU ADAB00ADDBAKSPAŠUNN SANNDSԠҠA ASԠSԠƠDAG SP0SAPNNPN SBàA̠ DƠN DƠ.3BAK DƠNNDSPA NANDB00MASKƠB BDMN ADBìɠHŠDUN /SBì BSԠBϠADSPAŠ SZASSƠƠSԠҠS MP+3SŠSKPϠUNԠHŠD SZPNSKPƠƠNSԠD MPSàSŠGϠADSPA SZUDN? MPSP0NϻDϠNԠN MPKYSGϠ SPà N5Dà-5 B00Ԡ00 BԠ SPà 5DAN5NGHMSMAH MPԠSNDҠD SPà YPŠANDϠSPAŠUN HŠNנDN.SSԠNY NϠƠHKSDN NGAVŠҠZϠD NUMBSAŠPAD HANDSƠҠSN YDAABàGԠHŠABSUŠDN. ŬSZAƠZ SSAҠNGAV AŬNASԠϠN SAìɠSԠNנDN. SZƠUDϠNŠAKŠSƠ SPà KASSGD ؠDANƯSƠ SPà ԠDBDZҠ-S SBNPPNA SBҠADDSSS SAҬɠSԠҠAND MPPSNԬɠUN SPà NDà- PSԠSAG SPà .Dà .3Dà3 SPà AU0 BU ԠUB SPà NDU SPà ND ASMBҬ̬ NAMAPSN NԠAPSN Ԡ$KPN$ìG$.NҬ SPà HŠAPSNUNŠDSABSUŠŠPSNNG ƠŠS ANGSUN: A̠APSN(DBҬìSƩ SPà H: DBSHŠSDAAN̠BK ҠSANҠUNAG.PSSBŠS 0NϠ -DSàDN -5SPANGBYNDNDƠDNDN -9AMPԠϠPSNYPŠZϠ -0NԠNUGHPAAMS -DBNԠPN -SƠŠà< àHŠDNUMBҠϠBŠADN S(UDҠ3ABVŠNYH AVŠBKƠHŠNԠD ƠHŠBKSԠƠHŠN D(UDҠYPŠ3AND ABVŠNY SPà5 PŠNSANԠSAG SPà YPŠNP .Dà .Dà NDà- N3Dà-3 àUYP SPà5 DBNP ҠNP àNP SNP ƠNP SPà APSNNPNYPN SB.NҠHPAM DƠDBADDSSS SPà BNBSԠHŠAD SBG$AG DBDBMPU ADB.YP SBYPŠAND ADB.PNAGADDSSS DANS DBBɠDB PBԠPN? NASSYSSKP MPԠNϻ NASԠA9 DBYPŬɠSŠYP SZBSSZ? MPԠYS ADBN3ƠYPŠҠ DAàSԠҠDPAM SSBSSSŠS DAƠҠU̠PAM SZASSS MPұ0NԠNUGHPAMS- SSBƠҠ MPSԠGϠSԠDN. SPà SBƠUSŠƠ DƠԠG DƠDBɠUN DƠҬɠAV DƠàS DƠSADDSS ԠBA DADBSKP SB$KP MPԠSԠUPN$ DBSGԠUNԠBK MBNBSUBAԠM ADBSɠDSDBK SZBSSƠAADYH MPSԠSKPPSNA SBN3U$àPSNHN$ MPԠҠ- SԠDBDBGԠDB ADB.MPUŠBUҠPNҠADDSS SBASAV ADBƬɠMPUŠDSDD ADB.NNS SBAɠANDS ADA.SPϠHŠDADDSS DBìɠSԠDNUMB SZBZ SSBҠNG MPұԠ SBAɠSԠDNUMB ASSK- ұ0DAN0 ԠBA SBàPAM SBƠADDSSSҠNԠM SAҬɠSԠҠD MPAPSNɠUN. SPà ұDANSNDƠ MP SPà PSԠNSANS SPà NDà- .Dà .Dà N0Dà-0 SNP SPà AU0 BU ԠUB SPà NDU SPà ND ASMBҬ̬ NAMNԬ NԠN Ԡ.NҬ HSSHŠYPŠZϠN̠UNŠ HŠŠŠMANAGMNԠPAKAG. ASANDADŠN̠USԠSSSUD ϠHŠDVŠVAHŠàƠH PBSPNϠAYPŠZϠ. ANGSUN A̠N(DBҬNN H: DBSHŠDAAN̠BK HŠ. ҠSHŠANҠUND S. PSSBŠSA: 0NϠS -DBNԠPN -ƠSNSD 0NԠAYPŠZϠŠ(ҽYPũ NSN̠D-HŠDV USMUGDNϠHŠ 6BSƠHSD NSN̠DϠ-PNA ZϠSUSDƠNԠSPD NUNA BDVŠSAUS SPà3 PŠNSANԠAA .Ԡ .3Ԡ3 YPŠNP .Ԡ SPà3 DBDƠZϠPAAM ҠDƠZϠADDSS NDƠZϠAA NDƠZ SPà NԠNPNYPN SB.NҠHPAAMS DƠDB DBDBGԠDB ADB.ADDSS SBYPŠƠYP ADB.AND DBBɠPNAG PBԠPN? MPKYSNNU DANNϻSNDNԠPN ԠSAҬɠϠA DBDZϠS ؠPNY SB-+DBADDSS BAҠDUMMY SBZϠZ DBSAԠSAUSϠBAND MPNԬɠUN SPà MDNSANԠAA SPà NDà- DZϠDƠZ ZϠNP SAԠNP SPà BԠ SPà3 KDAYPŬɠGԠŠYP SZAZ? MPԠNϻԠ:YPŠNA SPà SZYPŠYSSPϠDHU DAYPŬɠGԠU ANDBANDSAŠHN SABSAV DANɠGԠHŠUNN ANDBMAKŠSUŠHŠנNDSZ ҠBPUԠHMGH SANSԠҠA SBàA̠à DƠND DƠ.3H DƠNN DƠNɠUNN NSASAԠSAVŠSAUSҠUN ANDB00MASKƠB SZAƠ? DANYSSNDƠNDN MPԠGϻ SPà3 PSԠNSANԠAA SPà BԠ00 B00Ԡ00 NDà- SPà AU0 BU ԠUB SPà NDU SPà ND ASMBҬ̬ NAMƬ NԠ EԠP.PAS.N SPà ƠUNSHŠUNԠSAUSƠA ŠŠϠHŠA. SPà HŠANANGSUNŠS: SPà A̠(DBҬìSƬSìUYé SPà נHŠҠ: SPà DBSHŠDAAN̠BKҠHŠ. ҠSHŠҠDŠUN. PSSBŠDSA: 0-NϠ --DBNԠPN -0-NԠNUGHPAAMS àSHŠDNUMBҠƠHŠNԠD. SSHŠAVŠSҠƠHŠNԠD. ƠSHŠSԠNHŠSҠƠHŠNԠD. SàSHŠN.ƠSSNHŠŠ(ҠNԩ. USHŠ'SGA̠UN. YSHŠ'SYP. àSHŠDSZ. SPà A̠PAAMSAҠàAŠPNA. SKP DBNP ҠDƠDM àDƠDM SDƠDM ƠDƠDM SàDƠDM UDƠDM YDƠDM àDƠDM ƠNPNY SB.NҠG DDBDƠDBPAAMSADDSSS DAN0NԠNUGH DBàPAM PBDDMS MPԠNԠNUGH- DADBSԠAϠGԠDB BŠSԠϠG BŠAUA̠DS SBP.PASA̠ϠPASS N6Dà-6DB UNPPAAMS ADNP YPNP KNP SàNP SàNP SZŠNP UNԠNP SïԠNP PSNP KNP SàNP BUPԠNP MPNP àNP NϠNP DBPSS DAN PBԠPN? MPKYSUMP ԠSAҬɠNϻSԠԠD DBN9SԠUP SBUNԠAND DBDDBS SBADDUMMY _bDBDDMPAAM SBADɠADDSSS SZAD SZUNԠN MP-3A MPƬɠ SPà3 KDBàGԠAND SBìɠSԠDN. DBSàS SBSìɠHŠŠSZŠNSS DAYPGԠHŠYP MANASZASSSԠNԠANDSԠҠZ MPYPSԠZϠSϠUMP ADA.ƠHŠҠGA SSAHN MPNAUMPNԠANDMASS AMPUŠHŠS ADAàANDBK MPYSZŠ SAMPYP ANDBNŠAND SAƬɠ ҠMPS ASҠN MPSSGϠSŠ NADADBMPU MANAUN ADABUPԠBUҠS ADAN6ADUSԠҠBUҠADDSS SAƬɠUNS DASàGԠAND MPYNϠMPUŠNԠS SAMPANDSAV DAKMPUŠAV MANAS ADAKK-K MPYSïԠ(K-KSïAK DBS MBNB ADAB(K-KS-S ADASà(K-KS-S+S ADAMPADDSSNPVUSNS ASDVDŠBY SSSASɠANDPASSϠA YPSԠDBYPGԠANDS SBYɠYP DAUGԠU(DSàũ SZBSSSԠADSà? DAKNϻUSŠYPŠ0U ANDBMASK SAUɠANDS DASZŠGԠHŠD SAìɠSZŠANDSԠ ANϠS MPԠUN SPà BԠ .Dà N0Dà-0 NDà- N9Dà-9 BԠ DDMDƠ+ DMNP AU0 BU ԠUB@ MAX ALLOWED LDA VOLT LDB VOLT+1 JSB .FMP MFACT NOP PRESET WITH ADRS OF 200/2000 JSB IFIX INTEGERIZE LDB VSIGN SSB NEGATIVE VOLTAGE ? CMA,INA YES- TAKE 2'S COMPLEMENT STA WORD1 SET UP OUTPUT WORD1 * * PROCESS CURRENT LIMIT * DLD ACL,I JSB .FDV DIVFA NOP STUFFED WITH ADRS OF 1/5/15 JSB IFIX INTEGERIZE SSA JMP ERR1 CURRENT LIMIT IS NEGATIVE CMA,INA STA SAVEA CLA LDB CLADD INITIALIZE POINTER TO STB TEMPA CURRENT LIMIT TABLE ENTRIES CLTBL LDB SAVEA GET NEXT CL TABLE VALUE ADB TEMPA,I SSB,RSS JMP CLFND CL FOUND INA ISZ TEMPA ISZ CLISZ PRESET TO -8 OR -6 JMP CLTBL JMP ERR1 CL > ALLOWABLE MAX * * FORMAT OUTPUT WORD1+1 * CLFND ALF,RAR LINE UP CL BITS IOR WORD1+1 BRING IN RESOLUTION BIT LDB M9 ADB AUNIT,I VERIFY VALIDITY OF UNIT # SSB,RSS JMP ERR1 UNIT # > 8 ADB .8 SSB JMP ERR1 UNIT # < 1 ADA 1 FORMAT STA WORD1+1 DVS ADDRESS SKP * * OUTPUT DATA BY CALLING DVR70 THRU THE REAL TIME EXECUTIVE * JSB EXEC CALL RTE DEF *+5 DEF .2 WRITE REQUEST DEF LUDVS LU OF DVS SUBSYSTEM DEF WORD1 OUTPUT BUFFER DEF .2 BUFFER LENGTH JMP DCVSH,I *** NORMAL EXIT *** SKP * * ENTRϏY TO SET POWER SUPPLY TO LOW RANGE * * TABLE OF CALL PARAMETER ADDRESSES BUNIT BSS 1 UNIT # (INTEGER) BV BSS 1 VOLTAGE(FL.PT.) BCL BSS 1 CURRENT LIMIT(FT.PT.) * DCVSL NOP ENTRY PT. FOR LOW V-RANGE JSB .ENTR FILL PARAMETER ADRS TABLE DEF BUNIT JSB GTABL GET FIRST ADDRESS OF DVS TABLE * * MOVE PRMTR ADRS & RETURN ADRS TO TABLE FOR DCVSH * LDA BUNIT STA AUNIT LDA BV STA AV LDA BCL STA ACL LDA DCVSL STA DCVSH * * CHOOSE HIGH V RESOLUTION & LOW V LIMIT * LDA B100 STA WORD1+1 LDB HRMFA SELECT V*2000 LDA A16 VOLTAGE LIMIT = 16.383 V JMP SLENT GO & EXECUTE DCVSH CODE SKP * * ERROR PROCESSING * ERR1 JSB ERROR PRINT ERROR MESSAGE ON SYS. TTY DEF *+5 DEF ONE DEF A479E DEF #ERRU DEF DCVSH JMP DCVSH,I * * GET FIRST ADDRESS OF DVS TABLE (CHAIN THROUGH INDIRECTS) * GTABL NOP CLA STA ERRCD CLEAR ERROR FLAG! LDA CTABL SSA,RSS JMP *+4 AND M7777 LDA 0,I JMP *-4 CMA,INA NOTE THAT FIRST IS ACTUALLY THE ADDRESS CMA BEFORE THE START OF THE TABLE. STA FIRST JMP GTABL,I M7777 OCT 77777 SKP * * ENTRY TO SET ALL DVS'S TO ZERO, * PREVENT INTERRUPTS & ERASE CURRENT LATCH HISTORY * DCVCL NOP * JSB .ENTR DEF DCVCL JSB GTABL GET FIRST ADDRESS OF DVS TABLE * SET ALL DVS'S IN SUBSYSTEM TO 0 VOLTS LDB B77 WILL BE BUMPED TO B100 FOR 1ST DVS STB ZERO+1 LDA FIRST STA WORD1 NEXT ISZ WORD1 ADDRESS OF DVS TYPE LDB WORD1,I SZB,RSS IS THIS THE LAST DVS JMP CLEAR ISZ ZERO+1 INCREMENT DVS SUBCHANNEL ADDRESS LDA ZERO+1 IS THIS CPA B110 THE 9TH DVS? JMP CLEAR YZYES * PROGRAM DVS'S TO 0 VOLTS JSB EXEC DEF *+5 DEF .2 DEF LUDVS DEF ZERO DEF .2 JMP NEXT * CLEAR STATUS WORDS & PREVENT INTERRUPTS FROM DVS CLEAR JSB EXEC DEF *+3 DEF .3 CONTROL REQUEST DEF LUDVS JMP DCVCL,I RETURN SKP * * ENTRY TO RETURN DVS STATUS INFORMATION * * TABLE OF RETURNED CALL PARAMETER ADDRESSES IAV BSS 1 ISTAT BSS 1 LATCH BSS 1 HSTRY BSS 1 * DCVRS NOP JSB .ENTR DEF IAV CLA STA ERRCD CLEAR ERROR FLAG * GET STATUS FROM WORD 5 OF DVS EQT JSB EXEC DEF *+4 DEF .13 STATUS REQUEST DEF LUDVS LU OF DVS SUBSYSTEM DEF ISTAT,I * GET AVAILABILITY BITS INTO LOWER 2 BITS OF IAV LDA ISTAT,I GET BITS 14 & 15 RAL,RAL AND .3 STA IAV,I SZA IF DVS SYSTEM IS NOT READY, RETURN JMP DCVRS,I WITH ONLY AVAILABILITY STATUS * GET HARDWARE STATUS WORD & HISTORY FROM DVS CARD JSB EXEC DEF *+5 DEF ONE READ CALL DEF LUDVS LU OF DVS SUBSYSTEM DEF STAT READ BUFFER DEF .2 BUFFER LENGTH * GET STATUS FROM WORD 5 OF DVS EQT JSB EXEC DEF *+4 DEF .13 STATUS REQUEST DEF LUDVS LU OF DVS SUBSYSTEM DEF ISTAT,I * RETURN STATUS LDA ISTAT,I AND .3 STA ISTAT,I LDA STAT AND B377 MASK OFF LOWER 8 BITS STA LATCH,I RETURN LATCH STATUS LDA STAT+1 AND B377 MASK OFF LOWER 8 BITS STA HSTRY,I RETURN LATCH HISTORY JMP DCVRS,I RETURN!! SKP * * CONSTANTS * .16 DEC 16.383502 VOLTAGE LIMIT TABLE .50 DEC 50.00001,100.00001 .1 DEC 1.,5.,15.,12.5 *** THE FOLLOWING CONSTANTS MUST NOT BE REARRANGED * IE. DEC 20,50,70,100,200,500,700,1000 *** CLMT DEC 20 CURRENT LIMIT TABLE DEC 50 DEC 70 DEC 10*V$"0 DEC 200 DEC 500 DEC 700 DEC 1000 *** *** THE ABOVE CONSTANTS MUST NOT BE REARRANGED * IE. DEC 20,50,70,100,200,500,700,1000 * CLADD DEF CLMT ADDR OF FIRST ENTRY IN CURR TBL HRMFA DEF HRMF ADDRESS OF HGH RES MULT FACT HRMF DEC 2000.002 HGH RES MULT FACT LRMFA DEF LRMF ADDRESS OF LOW RES MULT FACT LRMF DEC 200. LOW RES MULT FACT A.1 DEF .1 A50 DEF .50 A16 DEF .16 ONE DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .8 DEC 8 .13 DEC 13 B77 OCT 77 B100 OCT 100 B110 OCT 110 B377 OCT 377 LOWER 8 BITS M8 DEC -8 M9 DEC -9 .6128 DEC 6128 .6129 DEC 6129 .6131 DEC 6131 .6933 DEC 6933 ZERO DEC 0.0 WORD1 BSS 2 OUTPUT BUFFER * * EQUATED STORAGE * SAVEA EQU MFACT TEMPA EQU DIVFA VSIGN EQU BUNIT CLISZ EQU DCVCL ISZ FOR CURRENT LIMIT TABLE VOLT EQU BV NCNT EQU ISTAT LUDVS EQU #DCVU STAT EQU WORD1 * DEFINE ERROR PRINTOUT MNEMONIC A479E DEC 3 ASC 2,DCV FIRST BSS 1 CTABL DEF #DCVT * * END OF DRIVER LINK * END $  29100-18002 A S 0122 RTE-B DVS VERIF TEST  (6130 ETC)             H0101 o100 REM 110 REM DVS SUBSYSTEM RTE-B VERIFICATION TEST 120 REM LISTING: A-29100-18002-2 125 REM ERS: A-29100-18002-1 130 REM SOURCE: 29100-18002 135 REM 140 REM W.M.PARRISH 7/74 145 REM 148 PRINT 150 PRINT "DVS SUBSYSTEM VERIFICATION" 152 PRINT 200 REM CHECK S/S STATUS 205 PRINT "**CHECKING DVS SUBSYSTEM FOR AVAILABILITY**" 210 DCVRS(I1,I2,I3,I4) 220 IF I1=0 THEN 300 230 PRINT "SUBSYSTEM IS NOT READY -- CODE ="I1 240 PAUSE 250 GOTO 200 300 REM CHECK CLEAR CALL 305 PRINT "SUBSYSTEM AVAILABLE" 307 PRINT 310 PRINT "**CLEARING DVS SUBSYSTEM**" 315 PRINT "A TIME-OUT ERROR MEANS AT LEAST ONE DVS NOT RESPONDING" 317 PRINT "OR TIME-OUT NOT PROPERLY SPECIFIED" 320 DCVCL 330 PRINT "DVS SYSTEM CLEARED" 340 PRINT 400 PRINT "**CHECK VOLTAGE PROGRAMMING CALLS**" 410 PRINT "USE 0 FOR UNIT NUMBER TO STOP PROGRAM" 420 PRINT 430 PRINT "ENTER UNIT NUMBER, VOLTAGE (VDC) AND CURRENT LIMIT (MA)"; 440 INPUT U,V,C 450 IF U=0 THEN 800 460 IF (ABS(V)-16)>0 THEN 600 500 REM LOW RANGE 510 DCVSL(U,V,C) 520 WAIT (100) 530 DCVRS(J1,J2,J3,J4) 540 IF J2=0 THEN 430 550 GOSUB 1000 560 GOTO 430 600 REM HIGH RANGE 610 DCVSH(U,V,C) 620 GOTO 520 800 REM STATUS HISTORY CHECK 805 REM NOTE REVERSED ORDER ON CALL 810 DCVRS(J1,J2,J4,J3) 815 PRINT "LATCH HISTORY" 820 GOSUB 1020 830 PRINT "CLEARING DVS SUBSYSTEM" 840 DCVCL 850 STOP 1000 REM CHECK LATCH STATUS 1010 PRINT "AT LEAST ONE DVS LATCHED CODE=";J2 1015 PRINT "LATCH STATUS FOR DVS UNITS" 1020 GOSUB 2000 1030 FOR I=0 TO 7 1040 IBTST(J3,I,Z) 1050 PRINT Z" "; 1060 NEXT I 1070 RETURN 2000 REM DISPLAY NUMBERS OVER LATCH STATUS OR HISTORY ARRAYS 2010 FOR I=1 TO 8 2020 PRINT I" "; 2030 NEXT I 2040 PRINT 2050 RETURN 3000 END     29100-18004 A S 0122 RTE DEVICE SUBROUTINE  DFEXT             H0101 ASMB,R,L,C,F NAM DFEXT,7 29100-16004 REV.A * * *************************************************************** * * RELOC: 29100-16004 REV.A * ERS: 29100-16004-1 * LISTING: 29100-16004-2 * SOURCE: 29100-18004 * ************************************************************** * * * DFEXT CONTAINS DEFAULT EXTERNAL CONFIGURATION CONSTANTS FOR * RTE DEVICE SUBROUTINES. THEY ARE USED TO SATISFY * REMAINING EXTERNALS AFTER A SEARCH IS MADE OF THE * INSTRUMENT TAPE, WHICH CONTAINS USER ENTERED * CONFIGURATION CONSTANTS. * * CONTENTS: * * #ERRU----A SINGLE CONSTANT ENTRY POINTING TO THE CONTROL * CONSOLE (LU #1) AS THE DESTINATION DEVICE FOR * DEVICE SUBROUTINE ERROR MESSAGES. * * ************************************************************** * ENT #ERRU * #ERRU DEC 1 * END   29100-18005 A S 0122 RTE DEVICE SUBROUTINE  ERROR             H0101 ASMB,R,L,C,F * ******************************************************* * * RELOC. TAPE: 29100-16005 * ERS: 29100-16005-1 * LISTING: 29100-16005-2 * SOURCE TAPE: 29100-18005 REV A * ******************************************************* * NAM ERROR,7 29100-16005 REV.A * ENT ERROR,ERRCD,INERR,SERR EXT EXEC,.DIV,.ENTR * NUM NOP MNEM NOP LUN NOP ADDR NOP * ERROR NOP JSB .ENTR DEF NUM * LDA LUN,I SAVE LUN OF DESTINATION DEVICE STA DEVIC * LDA MPSA SET MP START STA MP * LDB MNEM,I GET MNEM LENGTH IN CHARS INB ADD CHAR FOR ROUNDING BRS MAKE IT WORDS CMB,INB MAKE NEGATIVE COPY ISZ MNEM MOVE POINTER TO TEXT LDA MNEM,I LOAD ASCII WORD JSB MPSTR STORE INTO OUTPUT BUFFER INB,SZB DONE ? JMP COPY NO. * LDB PLUS SET SIGN OF ERROR STB MP,I LDB MINUS GET POSSIBLE - SIGN LDA NUM,I GET ERROR NUMBER STA ERRCD AND SAVE IT SSA STB MP,I STORE - SIGN SSA CMA,INA MAKE ERROR NUMBER POSITIVE STA NUM SAVE ERROR NUMBER * ISZ MP MOVE POINTER * LDA BLANK LOAD 2 BLANKS REP 3 JSB MPSTR STORE BLANKS CCA ADA MP SAVE DECREMENTED POINTER STA FAKE * LDA NUM LOAD ERROR NUMBER LOOP CLB SET UP FOR DIVIDE JSB .DIV DEF D10 STA NUM SAVE RESULT SWP PUT B INTO A IOR BLDIG MAKE ASCII STA MP,I SAVE * CLB LDA NUM JSB .DIV DEF D10 STA NUM SAVE RESULT SWP PUT B INTO A ALF,ALF IOR DIGIT IOR MP,I STA FAKE,I STORE 2 ASCII NUMBERS CCA ADA FAKE  DECREMENT POINTER STA FAKE * LDA NUM GET RESULT SZA DONE ? JMP LOOP NO. * LDA IN GET INSERT JSB MPSTR STORE IN OUTPUT BUFFER LDA IN+1 JSB MPSTR * LDB XEQT GET CURRENT ID SEGMENT ADDRESS ADB D12 MOVE TO NAME AREA LDA B,I GET START OF NAME JSB MPSTR INB LDA B,I GET MIDDLE JSB MPSTR STORE INB LDA B,I GET END OF NAME AND H377 MASK OFF LOW CHARACTER IOR B40 ADD A BLANK JSB MPSTR STORE * LDA AT LOAD "AT" JSB MPSTR STORE INTO OUTPUT BUFFER * LDA ADDR,I GET CALL ADDRESS JSB INDCK REMOVE INDIRECTS STA ADDR SAVE * ALF POSITION AND B7 MASK IOR BLDIG MAKE IT A BLANK AND A DIGIT JSB MPSTR STORE * LDB ADDR GET NUMBER BLF POSITION JSB FAKE * LDB ADDR GET NUMBER AGAIN BLF,BLF RBL,RBL POSITION JSB FAKE * LDA MPA LOAD START OF BUFFER CMA,INA NEGATE ADA MP GET BUFFER LENGTH STA FAKE SAVE FOR WRITE * JSB EXEC WRITE BUFFER DEF *+5 DEF WCODE DEF DEVIC MPA DEF ERR DEF FAKE JMP ERROR,I RETURN * MPSTR NOP ROUTINE TO STORE A REG INTO BUFFER STA MP,I ISZ MP JMP MPSTR,I RETURN * FAKE NOP ROUTINE TO CONVERT 6 HIGH BITS IN B REG * TO DIGITS CLA RRL 3 LONG SHIFT 3 (EAU) ALF,RAL RRL 3 IOR DIGIT JSB MPSTR STORE INTO BUFFER JMP FAKE,I RETURN * * ENTRY POINT TO SET ERRCD TO DESIRED VALUE * PTR NOP * SERR NOP SET ERRCD TO PASSED VALUE JSB .ENTR DEF H PTR LDA PTR,I STA ERRCD JMP SERR,I * *ENTRY POINT TO FETCH ERRCD * VALU NOP * INERR NOP JSB .ENTR DEF VALU LDA ERRCD STA VALU,I JMP INERR,I RETURN IN THE A REGISTER * * INDCK NOP RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I * WCODE DEC 2 ERRCD NOP DEVIC BSS 1 IN ASC 2, IN LNGTH NOP XEQT EQU 1717B D10 DEC 10 D12 DEC 12 DIGIT OCT 30060 BLDIG OCT 20060 PLUS ASC 1, + MINUS ASC 1, - ERR ASC 3,ERROR BSS 33 MPSA DEF ERR+3 MP NOP AT ASC 1,AT * B7 OCT 7 H377 OCT 177400 B EQU 1 A EQU 0 B40 OCT 40 BLANK BLANK ASC 1, * END   29100-18006 A S 0122 RTE DEVICE SUBROUTINE  XERLU             H0101  ASMB,R,L,C,F * ************************************************************** * * RELOC. TAPE: 29100-16006 * ERS: 29100-16006-1 * LISTING: 29100-16006-2 * SOURCE TAPE: 29100-18006 * ************************************************************** * NAM XERLU,7 29100-16006 REV.A * ENT XERLU EXT #ERRU,.ENTR * NUM NOP * XERLU NOP JSB .ENTR RECEIVE PARAMETER ADDRESS DEF NUM LDA #ERRU FETCH CURRENT LU LDB NUM,I FETCH NEW LU SZB NEW LU SENT? (LU # 0) STB #ERRU YES. SAVE STA NUM,I REPORT OLD LU JMP XERLU,I RETURN END ?q  29100-18007 A S 0122 RTE DEVICE SUBROUTINE  BCD6             H0101 ASMB,R,L,C,B HED RTE-BASIC FLOATING POINT TO BCD UTILITY NAM BCD6,7 29100-16007 REV.A **************************************** * RTE-BASIC FLOATING POINT TO BCD UTILITY * 29100-16007 * REVISION A **************************************** * EXT. REF. SPEC. A-29100-16007-1 * LISTING A-29100-16007-2 * SOURCE TAPE 29100-18007 * RELOC. BIN. TAPE 29100-16007 * ENT BCD6 * EXT .IENT,.FSB,.ENTR,.DLD,.DST * * ****FLOATING POINT TO BCD CONVERSION**** * * FORTRAN CALL: CALL BCD6(VALUE,IBCD(1)) * ANSWER IN IBCD(1) AND IBCD(2) * * * ASSEMBLY LANGUAGE CALL: EXT BCD6 * . * . * JSB BCD6 * DEF *+3 * DEF DATA * DEF IBCD * * IBCD BSS 2 * (V3.1) * THIS IS NOT A GOOD ALGORITHM, BECAUSE OF ROUNDING * IN THE FLOATING POINT OPERATIONS. * VALUE BSS 1 IBCD BSS 1 BCD6 NOP JSB .ENTR DEF VALUE JSB .DLD DEF VALUE,I LP1 STA .T1. STB .T1.+1 JSB .FSB DEF .100K SUBTRACT 100000.0 SSA RESULT POS.? JMP *+3 NO. ISZ TCNTA YES. JMP LP1 DO AGAIN LDA TCNTA POSITION ALF FIRST STA TCNTA DIGIT. LDA .T1. RECOVER NO. LDB .T1.+1 LP2 STA .T1. STB .T1.+1 JSB .FSB DEF .10K SUBTRACT 10000.0 SSA RESULT POS.? JMP *+3 ISZ TCNTA JMP LP2 LDA .T1. LDB .T1.+1 JSB .IENT CONVERT REMAINING NOP LDB 0 LDA DPTR STA CONV LDA TCNTA STA .T1.+1 CLA STA TCNTA BCL STB .T1. SAVE CONVERSION SO Fm  AR ADB CONV,I SUBTRACT 10^N SSB JMP BCM NEGATIVE, DONE ENOUGH INA POSITIVE, JMP BCL DO MORE * BCM ALF POSITION DIGIT ISZ CONV CLB CPB CONV,I DONE? JMP BCX YES. LDB .T1. RECOVER VALUE JMP BCL CONVERT SOME MORE * BCX ADA .T1. LDB .T1.+1 GET MSD'S JSB .DST DEF IBCD,I STORE RESULT JMP BCD6,I ***RETURN*** * .100K DEC 1.0E+5 .10K DEC 1.0E+4 DPTR DEF *+1 DEC -1000,-100,-10,0 CONV BSS 1 .T1. BSS 2 TCNTA OCT 0 * END 4   29100-80001 A S 0122 RFMAP              H0101 ASMBҬB HDMAP---MAPMŠŠPAMS NAMMAP NԠMAPSPNSP Ԡ.NҬ$BҬ$B NASKU9NUMBҠƠASKS MB̠U503MMUNANSBUҠNGH MAP .AADϬ0-5- SSDƠNŠSAUS SSDƠPG.SAUS SS3DƠANS.G ASKDƠASK NNDƠPAM.BUҠNGH NAMDƠŠNAM ̠DƠŠ YPDƠŠYP SàDƠŠSUY SZDƠŠSZ NGDƠDSZ SPAŠDƠUNUSD SDDƠSAND NDƠPVAŠN MNDƠMMNN MAPNP SB.NҠHPAMS DƠSS DASSɠHNŠSAUS SZAK??? MPұNϬANSMSSN DANNɠHPAMBUҠNGH PASS3ɠMAHANSMSSNG??? MPMPYSPD ұANANϬANSMSSN MPMAPɠDD MPDAASKɠHASK SSANSUŠASK0 MPҲ MANANSUŠASK DƠ DƠYP DƠS DƠSZ DƠNG DƠSPA DƠSD DƠN DƠMN SASSDҠSAUS SZAANYS? MPԠYSD SBPNPNUSD DƠ+ DƠDBDAAN̠BK DƠSASҠSAUS DƠNAMŠNAM DƠ.0USŠDNDYPŬUS DƠSàSUYD DƠNSANPVAŠN SSASSANYS? MPSK.NϬNNU PAM6Ҡ-6NԠUND??? MPSK. MPSKҠNϬPԠҠ SK.SBPNYSYMMNN DƠ+ DƠDB DƠSAS DƠNAM DƠ.0 DƠS DƠMN SSAS? MPSKҠYSϠBAD SK.DADBNSUŠŠS PA.9DAAYP MPSK.3YSK DAM6NϬSSU SASASGA̠YPŠD MPSԠANUPU SK.3SBPSNԠPSN DƠ+5D DƠDB DƠSASҠSAUS DƠ.D DƠ.ABSUŠD SSAS?? MPSԠYSD SBADƠADүנPNS DƠ+6 DƠDBDAAN̠BU DƠSASҠSAUS DƠ̠USŠŠBU DƠ.DS DƠNGHAUA̠NGH SSAANYS? MPSԠYSANUPU DANGHNϬAD? PA. MPSK.NϬK DAM5YSSSUŠ SASASDŠ-5 MPSԠ SK.DA.SԠUPBU SANNANS.NG#IH SBSPנSNDN DƠ+3ϠMŠSAN DƠNN DƠSS AAҠSAUSD SASAS DASSHKNŠSAUS DBSS3ANSMSSNG PB.DSANSMD?? SZANŠK?? SZSASNϬDSAUS SԠSBSŠSŠ DƠ+ DƠDB DBSASHKҠSAUS SBSS SZBADҠ?? MPԠYSDԠ SSASSSŠҠ?? ANϬҠDŽ0 SKҠSASSD ԠSBSPŠNYSPƠMPN DƠ+ DƠSS SBàMNAŠASK DƠ+ DƠ.6 HԠ3B SAGŠNSANS .0Dà0 .Dà .Dà .6Dà6 .Dà .9Dà9 .Dà M5Dà-5 M6Dà-6 M6Dà-6 DBUMN+5 NGHBSS SASBSS SSUMN+3NŠSAUS SSUMN+PGAMSAUS SS3UMN+5ANSMSSNG ASKUMN+6ASK NNUMN+NԠPAMBUҠNGH NAMUMN+ŠNAM ̠UMN+Š YPUMN+3ŠYP SàUMN+ŠSUY SZUMN+5ŠSZ NGUMN+6DNGH SPAŠUMN+UNUSD SDUMN+5SAND NUMN+53SANPVAŠN MNUMN+5SANMMNN DBUMN+55DAAN̠BK MNUMN+99MMUN.BU.NGH. MBƠUMN+00MMUN.BU. SZŠU NDASK ԭ  29100-80009 A S 0122 TSK8$ CLOSE              H0101 ԂASMBҬB HDASK:SŠDAAŠNGUAN SK$:SŠDAA:SAN$ SAԠNGUAN HANGŠA̠UANSƠ$ϠHŠAPPPA SANDN.HSŠMHŠNG: ABìDŠҠ. NAMSK$0DNŠPGAMNAM ԠSP$ASSAŠNA SPŠUSP$AN DNŠMMUNANɯϠBUҠNGHDS. MNMUMSZŽ53.NϠMAMUMSDND.HANG A̠UANSƠϠHŠDSDVAU. MMNBKSMUSԠBŠMANANDҠAH MŠSANNHŠSYSM.ABKS MAYBŠMVD.HUSƠNϠSANSA DNDHNHŠDSBUVŠSYSMNY HŠSԠϠMMNBKSMUSԠBŠPSVD. MB̠UDNŠBUҠSZ MSNA(00SNA.( MSNB(00SNB.( MSN(00SN.( MSND(00SND.( MSN(00SN.( MSN(00SN.( SԠMMNBKҠHSASSMBY.HANGŠA ϠAPPPAŠSANDN MNUSN$ NDNGUAN UN̠SUPPSSSNG HDASK:SŠDAA DϠNԠHANGŠHŠNG ԠMAP ԠPNƬPSNԬS Ԡ ASK:SŠDAA .AADϬ0-- ASKSBMAPMAPPAMSҠSŠASK DƠ+6 DƠSS DƠSS DƠSS3 DƠASK DƠNN DƠNAM DƠ DƠYP DƠS DƠSZ {DƠNG DƠSPA DƠSD DƠN DƠMN SASSDҠSAUS SZAANYS? MPԠYSPԠ SBPNPNUSD DƠ+ DƠDBDAAN̠BK DƠSASҠSAUS DƠNAMŠNAM DƠ.USUPDAAMD DƠSàSUYD DƠNSANPVAŠN SSASSANYS? MPSK.NϬNNU PAM6Ҡ-6NԠUND?? MPSK. MPSKҠNϬDҠ SK.SBPNYSYMMNN DƠ+ DƠDB DƠSAS DƠNAM DƠ. DƠS DƠMN SSAS? MPSKҠYSϠBAD SK.DADBNSUŠŠS PA.9DAAYP MPSK.3YSK DAM6NϬSSU SASASGA̠YPŠD MPSԠANUPU SK.3SBPSNԠPSNϠD DƠ+5 DƠDB DƠSASҠSAUS DƠ.D DƠ.ABSDPS. SSAANYS?? MPSԠYSAB SBƠŠүנPNS DƠ+5 DƠDBDAAN̠BK DƠSASҠSAUS DƠ̠үנPҠBU. DƠ.DS SSAANYS? MPSԠYSD ANϬAҠҠSAUS SASAS SԠSBSŠSŠ DƠ+ DƠDB DBSASHKҠSAUS SBSS SZBADҠ?? MPԠYSDԠ SSASŠҠ?? SKҠSASSD ԠSBSPŠNYSPƠMP N DƠ+ DƠSS SBàMNAŠASK DƠ+ DƠ.6 HԠ3B SAGŠNSANS .Dà .6Dà6 .Dà .9Dà9 M6Dà-6 M6Dà-6 SASBSS DBUMN+5 SSUMN+3NŠSAUS SSUMN+PGAMSAUS SS3UMN+5ANSMSSNG ASKUMN+6ASK NNUMN+NԠPAMBUҠNGH NAMUMN+ŠNAM ̠UMN+Š YPUMN+3ŠYP SàUMN+ŠSUY SZUMN+5ŠSZ NGUMN+6DNGH SPAŠUMN+UNUSD SDUMN+5SAND NUMN+53SANPVAŠN MNUMN+5SANMMNN DBUMN+55DAAN̠BK MNUMN+99MMUN.BU.NGH. MBƠUMN+00MMUN.BU. SZŠU NDASK   29100-80010 A S 0122 TSK9$ DREAD/DRITE              H0101 3ASMBҬB HDASK9:DADDŠDAANGUAN SK9$:DAD.DŠDAA:SAN$ SAԠNGUAN HANGŠA̠UANSƠ$ϠHŠAPPPA SANDN.HSŠMHŠNG: ABìDŠҠ. NAMSK9$0DNŠPGAMNAM ԠSP$ASSAŠNA SPŠUSP$AN ԠSP$ASSAŠNA SPҠUSP$AN ԠSP$ASSAŠNA SPנUSP$AN DNŠMMUNANɯϠBUҠNGHDS. MNMUMSZŽ53.NϠMAMUMSDND.HANG A̠UANSƠϠHŠDSDVAU. MMNBKSMUSԠBŠMANANDҠAH MŠSANNHŠSYSM.ABKS MAYBŠMVD.HUSƠNϠSANSA DNDHNHŠDSBUVŠSYSMNY HŠSԠϠMMNBKSMUSԠBŠPSVD. MB̠UDNŠBUҠSZ MSNA(00SNA.( MSNB(00SNB.( MSN(00SN.( MSND(00SND.( MSN(00SN.( MSN(00SN.( SԠMMNBKҠHSASSMBY.HANGŠA ϠAPPPAŠSANDN MNUSN$ NDNGUAN UN̠SUPPSSSNG HDASK9:DADDŠDAA DϠNԠHANGŠHŠNG ԠMAP ԠPNSŬADƬ Ԡ ASK9:DADDŠDAA .AADϬ-3- ASK9SBMAPMAPPAMSҠSŠASK DƠ+6 DƠSS DƠSS DƠSS3 DƠASK DƠNN DƠNAM DƠ DƠYP DƠS DƠSZ DƠNG DƠSPA DƠSD DƠN DƠMN SASSDҠSAUS SZAANYS? MPԠYSPԠ SBPNPNUSD DƠ+ DƠDBDAAN̠BK DƠSASҠSAUS DƠNAMŠNAM DƠ.ŠYPŠASS DƠSàSUYD DƠNSANPVAŠN SSASSANYS? MPSK.NϬNNU PAM6Ҡ-6NԠUND?? MPSK. MPSKҠNϬDҠ SK.SBPNYSYMMNN DƠ+ DƠDB DƠSAS DƠNAM DƠ. DƠS DƠMN SSAS? MPSKҠYSϠBAD SK.DASZSԠUPVAABŠUN MA-VAABS- SASZ BUNNBUҠAG SBSBƠSUŠBU.N.AG SBDBƠDS.BU.N.AG SZGŠUSԠ? MPSK.3 SBGYSMANANŠAG DASSAԠŠASSA ADBϠŠDS MPSK. SK.3DAADSNϬSAԠŠASSA ADBADϠADDS SK.SAD SBS SK.5SBHHAVAAB MPSK.6NDƠDAA SBSUƠGVŠ MPSK.5NNU SK.6SBUSHUSHDS.BU SԠSBSŠSŠDAA DƠ+ DƠDB DBSSADŠS SZBDD?? MPԠYSPԠ SSASSKSŠҠ? ANϬAҠSAUS SKҠSASSYSD ԠSBSPŠNYSP DƠ+MPN DƠSS SBàMNAŠASK DƠ+ DƠ.6 HԠ3BNϠUN SKP HNP SZSZNDƠDAA?? SS MPHɠYSAKŠMPN ñSZGŠUSԠ? MPòNϬPSSAD AYSMANAN SAGŠAG SZSBƠANYDAANSUŠBU? MP3YSGϠPSS DAMBZNϬSԠUP ASASADMŠDAA SAMNNSUŠVNDUN SBSPҠDϠ DƠ+3 DƠMNBUҠADDҠNGH DƠSSSAUSBU ANA DBSSHKNŠSAUS SZBS?? MPҠYSDAB DBMBASUŠBUҽ SBSBADҠMMUNANBU DBSS3 SZBSSNSUŠDAAAS MPH BSSUŠBUҠNGH MB-VAABS- SBSBNG MP3 òSZSBƠANYDAANSUŠBU?? MP3YSGϠPSS SBADƠNϬADSMŠDAA DƠ+ DƠDBDAAN̠BK DƠSASҠSAUS DBUADƠDB6NPUԠBU DƠ.DS DƠDSANSMSSNG DƠDNԠD SSAANYS?? MPҠYSAB A DBDSNSUŠANSMSSN PB.GMAHSUSԠ?? SS MPҠNϬAB SZDKBUMPϠNԠD DADBUASUŠBUҽ ADASԠDSKɯϠBU SASBAD DASԠSUŠBUҠNGH AS ADAM65 SASBNG A SASԠAҠS 3SZSBNGNDƠBU?? MPô AYSSԠN SASBƠSUŠBUҠAG MPñGԠMŠDAA ôDASBADҬɠNϬHN SZSBADҠVAAB DBSBADҬ SZSBAD SZH MPHɠ SKP SUƠNP SAMPASAVŠUN SBMPBVAAB SUƱSZGDAAŠUSԠ?? MPSUƲ AYSMANAN SAGAG SZDBƠNԠDS.BUҠ?? MPSU3NϬPSSDAA SBADƠYSADUN DƠ+D DƠDBDAAN̠BK DƠSASҠSAUS DƠDB6DSKɯϠBU DƠ.DS6VAABS DƠDSANSMSSNG DƠDNԠD SSAS? MPҠYSAB A DBDSNSUŠANSMSSN PB.GMAHSUS SS MPҠNϬDSKɯϠ DADBUAKSԠUP ADASԠDS.BU.ADDҽ SADBADҠDSKɯϠBU+S DAS ASDS.BU.NGH ADAM65-VAABS- SADBNG AAҠS SAS MPSU3 SUƲSZDBƠNԠDS.BUҠ?? MPSU3 DAMBAYSDS.BUҽ SADBADҠMMUNANBU DAMBZDS.BU.NGH AS MA-VAABS- SADBNG SU3SZDBNGNDƠBUҠ?? MPSUƴ SBUSHYSUPUԠ MPSUƱNNU SUƴDAMPANϬANS SADBADҬɠN SZDBADҠVAAB DBMPB SBDBADҬɠDS. SZDBADҠBU MPSUƬɠ USHNP SZGŠUSԠ?? MPSH AYSMANAN SAGAGSAUS SBƠŠDAA DƠ+6DSK DƠDBDAAN̠BK DƠSASҠSAUS DƠDB6DSKɯϠBU DƠ.DS DƠDUNԠD SSAS? MPҠYSAB SZDNϬBUMPϠNԠD MPSH SHDAMBADMNŠ MANADSNɯϠBU ADADBAD SZASS0DUNԠ?? MPSH SAMNNϬSԠUPANSMSSN SBSPנSNDԠϠM DƠ+3 DƠMN DƠSS ANA DBSSHKҠS SZB??? MPҠYSAB DBSS3 PBMN??? SS MPҠҬAB SHASԠDSԬBU SADBƠNԠNDN MPUSHɠUN ҠSASSD MPSԠAB SKP SAGŠNSANS GUMN+6DAAADŠUSԠAG ADSUMN+5ADD ADϠUMN+6ADS SUMN+ŠD ϠUMN+ŠS DB6UMN+DSKɯϠBUҠADD MBADƠMBƠMMUN.BU.ADD MBZDƠMB̠MMUN.BU.NGH SBƠBSSSUŠBUҠNԠAG SBADҠBSSSUŠBUҠADDSS SBNGBSSSUŠBUҠNGH DBƠBSSDS.BUҠNԠAG DBADҠBSSDS.BUҠADDSS DBNGBSSDS.BUҠ$"NGH DBSSUNԠADŠD SԠBSSSԠHүנD SASBSS DSBSS MPABSS MPBBSS .Dà .6Dà6 .Dà M6Dà-6 M65Dà-65 SSUMN+3NŠSAUS SSUMN+PGAMSAUS SS3UMN+5ANSMSSNG ASKUMN+6ASK NNUMN+NԠPAMBUҠNGH NAMUMN+ŠNAM ̠UMN+Š YPUMN+3ŠYP SàUMN+ŠSUY SZUMN+5ŠSZ NGUMN+6DNGH SPAŠUMN+UNUSD SDUMN+5SAND NUMN+53SANPVAŠN MNUMN+5SANMMNN DBUMN+55DAAN̠BK MNUMN+99MMUN.BU.NGH. MBƠUMN+00MMUN.BU. SZŠU NDASK9 W$  29100-80011 A S 0122 ESP INTERRUPT PROCESSOR              H0101 )xASMBҬB HDSP$---SPNUPԠPSSҬSAN$ SPNUPԠPSS SAԠNGUAN HANGŠA̠UANSƠ$ϠHŠAPPPA APHASANDN.HSŠMH NG:ABìDŠҠ. NAMSP$0PGAMNAM DNŠMMUNANɯϠBUҠNGHDS. MNMUMSZŽ53.NϠMAMUMSDND.HANG A̠UANSƠϠHŠDSDVAU. MMNBKSMUSԠBŠMANANDҠAH MŠSANNHŠSYSM.ABKS MAYBŠMVD.HUSƠNYϠSANSA DNDHNHŠDSBUVŠSYSMNY HŠSԠϠMMNBKSMUSԠBŠPSVD. MB̠UMMUN.BUҠNGHMNA MSNA(00SNA.( MSNB(00SNB.( MSN(00SN.( MSND(00SND.( MSN(00SN.( MSN(00SN.( SUP MNUSN$ SNASà3SN:$ HŠASà0NŠҠNSP$ DNŠGA̠UNԠNUMBҠƠSA NNNԠNŠҠSAN$. HANGŠBϠAPPPAŠU. UUBGA̠UNԠƠNNN NDNGUAN UN̠SUPPSSSNG HDŠSPNUPԠPSS Ԡ SPɠBSS0 SP$HANDSNUPSҠHANN̠$ HNHANN̠$SNABD SBàADMŠUS'SPAAMS DƠ+6 DƠN DƠD DƠPBUƱ DƠH DƠ SBSAԠSԠҠBADSAUS DAPBUƲADUS SZASSSAUSNY? MPSPYSSPND PAMNDҠAҠ? EMPԠYS MPHANDYSYԠ! SUP MԠ- SKP NAB̠BSS0 SBà-NABŠHANN DƠ+3 DƠH DƠNABA SASSUSԠMPD? MPNAB̠NϬYAGAN. SPBSS0 A SAPBUƱ SAPBU3 SAPBUƲ SAUN SBàSHUDNANSMSSN DƠ+6 DƠ DƠD DƠPBUƱ DƠH DƠ ԠSBà DƠ+ DƠS SAԠNPSԠSAUSBS SABADSAUS? MPSAԬɠNϬUN SBà̠PA DƠ+5 DƠ DƠN DƠH DƠN MPԠNDANSMSSN NDà0 SKP HANDBSS0 DBPBU3 SZBSSZϠNGHŠ? MPSSԠYS SBBUƲ ANSMԠUSԠAND SBàADNAŠBU DƠ+6 DƠN DƠD DƠBU DƠU DƠZ SBSAԠHKSAUS SSԠSBGSԠANSMSSNG SBBN DAPBUƲHKҠBADA SSA MPNAB̠NDHANGŠANDNABŠAD B SBSAԠAҠNŠSAUSD DBPBUƱSԠMŠSAUS SBSAԠSԠMŠSAUS SAUNàSԠPSNԠUNND ANDBDUŠASNSSAY ҠNAM0MGŠK0 SANAMŲPUԠNASKNAM SBàAҠAD DƠ+3 DƠH DƠA SHDNP SBàSHDUŠUSDPGAM DƠ+3 DƠNN DƠNAMű SZA׍G ASPGAMSHDUD? MPSHDNϬYAGAN DAUNàADUNN SZASSASASKABD? MPԠN. PAVŠDSԠ? MPԠYSGNŠAB AYS SAUNàZϠUNN SNSSBàSHDUŠSAԠPGAM DƠ+3 DƠN DƠSN SZASHDUD? MPSNSNϬY MPԠYS SKP SAGŠNSANS PBUƱUMN PBUƲUMN+ PBU3UMN+ SAԠUMN+3 SAԠUMN+ GUMN+5 UNàUMN+6 BNUMN+ BUҠUMN+ SKP ZϠԠ0 BUҠDƠBU BUƲNP DƠPBUƱ HŠDà3 DϠNԠSPAAŠPVUSNS DԠABSU NABAABS00B+U00B+U AABS00B+U NŠDà ϠDà UҠDà VŠDà5 SؠDà6 NNŠDà9 NAM0ASàK0 NAMűASàS NAMŲNP NAM$ASà$ BԠ NDSP Ϝ  29100-80012 A S 0122 ESP READ/WRITE FUNCTION PROCESSOR             H0101 rASMBҬB HDSP:$---SPADŠUNN SPADŠUNN SAԠNGUAN HANGŠA̠UANSƠ$ϠHŠAPPPA APHASANDN.HSŠMH NG:ABìDŠҠ. NAMSP:$SUBUNŠNAM NԠSP$SPADNY NԠSP$SPŠNY NԠSP$SPNDNY DNŠMMUNANɯϠBUҠNGHDS. MNMUMSZŽ53.NϠMAMUMSDND.HANG A̠UANSƠϠHŠDSDVAU. MMNBKSMUSԠBŠMANANDҠAH MŠSANNHŠSYSM.ABKS MAYBŠMVD.HUSƠNYϠSANSA DNDHNHŠDSBUVŠSYSMNY HŠSԠϠMMNBKSMUSԠBŠPSVD. MB̠UMMUN.BUҠNGHMNA MSNA(00SNA.( MSNB(00SNB.( MSN(00SN.( MSND(00SND.( MSN(00SN.( MSN(00SN.( MNUSN$ DNŠGA̠UNԠNUMBҠƠSA NNNԠNŠҠSAN$. HANGŠBϠAPPPAŠU. UUBGA̠UNԠƠNNN UN̠SUPPSSSNG HDSPADŠUNN Ԡì.N PBUƱUMN PBUƲUMN+ PBU3UMN+ UNàUMN+6 A̠SPҠ(BU(ɩSA( BUҠNP SAҠNP SPҠNPADNYPN SB.N DƠBU DBSAҠADSAUSAAYADDSS SBSAԠSԠSAUSPNS NB SBSA NB SBG A SASAԬɠAҠSAUS DBBUҬɠADUSԠܘNGH SSBMAKŠPSV MBNBSS ŬSS ŬB SZ NB BGSԠҠPAMA SBPAMŠPAAMSϠM SBPAMADMŠUS PAϠŠ? SSYS. MPNDPSSBŠND DABUҬ SBSBUƠSԠBUҠNGH MPԠSԠUPԠNGH GNDABUҠSԠBUҠSA NA SABUS SBNŠADNŠPAAM SBàADDAA DƠ+6 DƠN DƠD BUSNP DƠBU DƠN SBSAԠSԠSAUS NDDABUҬɠSԠG ԠSSAPSVŠ? BSNϬMAKŠHAAҠUN SBG MPSPҠɠ NDBZϠG PAMND? SSYS SBԠNϬ SBUNàZϠUNN MPNDUN ԠBSS0 SSASSϠBGAŠ? SBԠYS DBPBU3ADMŠSZ SBBUɠSԠADNGH SZBZϠ? MPGNGϠNANDAD SBUNàUNԠ MPNDND ԠNPԠUS ANASԠԠSAUS SASAԬ A SAG SAUNàNDANS MPSPҠɠ BUɠNP MԠ- SKP SAԠNPSԠSAUS SABADSAUS? MPSAԬɠN ASԠBADNŠSAUS SASAԬ BAҠBҠPAMA SBPAM̠HҠND ԠAAҠGSS B MP SKP BUנNP SAנNP SPנNPŠNYPN SB.N oDƠBU DASPנSԠUNҠS SASP DBSAנADSAUSAAYADDSS SBSA NB SBSA NB SBG A SASAԬɠAҠNŠSAUS SABàAҠŠA DABUנSԠBUҠSA NA SABUS DABU׬ɠADUSԠNGH SABU̠SԠA̠BUҠ AGANBPAԠPNԠANDSԠBGҠPAM SBPAMŠPAAMS SBPAMADMŠUS PANŠŠ? SSYS. SBԠNϬSPUS DABU׬ɠADUSԠNGH SZASSAPUԠNZϠ MPZNŠYS̠M DABU̠SԠBUҠNGH SBSBU MPԠҠUN DABUɠSԠŠNGH SBƠSABU SBàŠDAA DƠ+6 DƠ DƠD DƠBUS DƠU DƠZ SBSAԠSԠSAUS ADBBàSUMSϠDA SBBàSAVŠҠNԠPASS DABUԠADUNԠŠNGH MANANGA ADABU̠ADDA̠BUҠ SSADNŠ? MPԠYS SZASS MPԠYS SABU̠NϬSԠNנA̠BUҠ DABUSSԠNנBUҠSA ADABU SABUS MPAGANDUԠHŠNԠBK ԠDABU׬ɠSԠG MPԠ ԠBSS0 DABUɠSԠA̠BUҠ SABU DAPBU3SԠŠNGH MPSBƠSUMŠNMA̠PAN ZNŠBSS0 SAUNàZϠUNN SBàŠNŠPAAMҠNY =DƠ+6 DƠ DƠD DƠZ DƠN DƠ MP BUSNP BUԠNP DƠ- NŠDà ZϠԠ0 BàNP BU̠NP SKP SBUƠNPSԠBUҠNGH SSAPSVŠ? MANASSNϬMAKŠPSV ŬSSPSVŠ.K. ŬAMAKŠHASNϠDS SZ NA SABUɠSԠDNGH MANASԠҠUԠƠANG ADAPBU3 SSASSNMA̠Ԡ? SZSBUƠYS MPSBUƬɠUN PAMNPŠPAAMSϠM SBPBU3SԠNԠůADNGHMA DAUNàADPSNԠUNN SZASSSUSԠVAD? MPNNϠNϠ!!!! DASAԬɠSԠNA̠SAUS SAPBUƱSԠҠANSMSSN DASAԬɠSԠNŠSAUS SAPBUƲ SBàŠPAAMS DƠ+6 DƠ DƠD DƠPBUƱ DƠH DƠ SASSҠ? MPԠYSND MPPAMɠUN NNϠDAϠADBADUSԠAG SASAԬɠSԠNA̠SAUS MPSPҠɠ SKP PAMNPADMŠUS PADAN SANԠSԠNA̠PAԠUN PBSBàADUS DƠ+6 DƠN DƠD DƠPBUƱ DƠH DƠ PAMASKY? MPPàYS SBSAԠSԠSAUS DAPBUƱSԠMŠSAUS SASAԬ DAPBUƲADUSԠYP MPPAMɠUN PàSZNԠPAԠDNŠ? MPPBNϬYAGAN DAUNàGԠUNN PAVŠDSԠ? SSYSSUSPND MPPBNϬKPYNG SBàYSSUSPND. DƠ+6 DƠV DƠZ DƠN DƠZ MPPADϠPAԠAGAN VDà NŠԠ-0 ϠԠ-300 NԠNP MASKԠ30 SAԠNP SAԠNP GNP NŠNPADNŠPAAM SB DƠ+6 DƠN DƠD DƠPBU3 DƠN DƠ PAMASKMŠNԠADY? MPԠYSND. DAPBU3SԠNԠANSMSSNNGH SABU MPNŬɠUN SKP SAŠNP SPŠNPNDNYPN SB.N DƠSA DASP SASPҠSԠUNADDSSҠS DBSAŠADSAUSADDSS SBSA NB SBSA NB SBG A SASAԬ DAUNàADPSNԠUNN SZASSAŠŠBUSY? MPNABNϬUN B SBPAMŠPAAMS SBPAMADMŠUS PANŠADMMŠ? MPZŠDϠZϠ PAMNDUSԠ? MPNABYSND. SBԠAA̠ ZŠBSS0 A SAPBUƱSԠZϠŠUN SBàŠPAAMҠNY DƠ+6 DƠ DƠD DƠPBUƱ DƠN DƠ NABSBàNABŠSNMD DƠ+3 DƠH DƠNABA SASS MPNAB A SASAԬ SAG SAUNàAҠUNN MPSPŠɠ DԠABSU NABAABS00B+U ϠDà HŠDà3 UҠDà VŠDà5 SԠSUMŠSNG HANGŠA̠R$"UANSƠ$ϠHŠAPPPA APHASANDN.HSŠMH NG:ABìDŠҠ. SP$USP SP$USP SP$USP NDNGUAN ND f$  29100-80013 A S 0122 REMOTE STATION ENABLE PROGRAM             H0101 RASMBҬB HDSN:$---SANNABŠPGAM MŠSANNAB SAԠNGUAN HANGŠA̠UANSƠ$ϠHŠAPPPA APHASANDN.HSŠMH NG:ABìDŠҠ. NAMSN:$0PGAMNAM DNŠGA̠UNԠNUMBҠƠSA NNNԠNŠҠSAN$. HANGŠBϠAPPPAŠU. UUBGA̠UNԠƠNNN NDNGUAN UN̠SUPPSSSNG HDŠSPSANNAB Ԡ SN:$ASANDNABSMNA̠$ SN:$SBàAҠHANN̠$ DƠ+3 DƠH DƠ$ SBàNABŠHAN$ DƠ+3 DƠH DƠNAB$ SASSUSԠMPŠ? MPSN:$NϬYAGAN SBàNMPAҠ? DƠ+5 DƠ DƠN DƠBU DƠBU SBà DƠ+ DƠS DԠABSU $ABS00B+U NAB$ABS00B+U SUP BUҠASà0SAN$NABD! BU̠Dà0 NŠDà ϠDà HŠDà3 SؠDà6 NDSN:$   29100-80014 A S P0122 91701A/B RTE CENTRALMODULE NAME: QUEUE             H0101 RASMBҬB NAMUUŬ0 NԠUU ԠUŬ AU0 BU UUŠNP DVҠUNSPNҠϠԠD DABPKUPԠADDSS NMNԠϠSAԠƠNԠ(5DԠNY ADAD ADDSAԠADDSSƠ DBԬ MBNB ADAB DVDŠBYԠNYNGHϠGԠԠNY B DVN ANDSAVŠ SAN PKUPƠDԠNS DAD NA DAA SA ADUSԠDԠNSϠAUNԠҠSANDAD DVS ADAD-6 MANA SAN SPϠSԠUSҠDNDDԠD DBDԬ ADBD6 PKUPNԠDԠD ԠԠƠNUPNGDV? ƠYS'VŠUNDԠHSŠPHUGHAB PDAB ANDM PAN MPUND NB SZN MPP AUҠSSUMAHNԠUND SB DƠ+5 DƠD DƠD DƠMSS3 DƠMS3 MPDN UNDDAN ADA NA SAU ADUSԬҠHKѬSYNHSZŠѠƠ AMŠMAS SBàPKUPHŠUS DƠ+6ANDS DƠDԠNBU DƠU DƠBU DƠB DƠD SASSANYҠNADNG? MPҠYSUPUԠҠMSG. SԠUPUSԠBUҠADDSS-NMNA̠AS DABA SAADD DABUƠNϠ-SHSANN-SANDAD SSAѠMAMDDBB SBSPҠBSAP?ƠSϠBUDAUS NנŠAŠADYϠNҠHŠUSԠNϠH UU ADDҠNANSHŠADDSSƠHŠUSԠ BŠNSDANDUS'SGA̠UNԠ SBUŠBUDHŠUSԠN DƠ+ DƠU DƠADD QIDƠDB ANYҠNU'SUNDAG HŠUSԠHASNנBNUUDUP SBàSHDUŠDSPϠDSPAH DƠ+3ƠDSPSDMAN-ƠSHDS DƠD0NԠSUSSU̠DSPSS DƠNAMŠAVŠ̠SŠHŠUS NYYNŠHN SPà5 DNŠSBàDAVAŠHŠUUNG DƠ+MDU DƠD6 SUBUNS. SPà5 ҠSBàUPUԠMMUNAN DƠ+5MSSAGŠϠHŠPA DƠDHN-NYHSNŠUS DƠD̠BŠS DƠMSS DƠMSS SNDҠZϠBAKϠMNA SԠHŠAGSҠ-B0HNPUԠNPYBU ұA SABU+ A SABU+3 NŠNA̠KYHDSAMSUBSAM NVҠADANDHUSAŠNԠNHŠBU NנSNDHŠҠPYBAKϠHŠMNA SB DƠ+6 DƠD DƠU DƠBU DƠD DƠMD NנASHŠANҠNHŠҠPY ANSMSSNAS??? SA MPDN YSHŠASANHҠҠNYNA̠PA UҠSB DƠ+5 DƠD DƠD DƠMSS DƠMS MPDN SPà5 SPҠNPBUDASANDADDAUԠ. SHSAMDBB̠US?ҠASYSMUS NԠNDNGMNҠAN? ƠHŠSHDƠHŠSԠDS0 SAMDDBB̠US ƠASPA̠USԠHŠSHDSUSD ASHŠNDؠƠAMPUDGϠ HŠSYSMUSԠAPABYANBŠNAGD BYMDANƠSYSѠϠNנƠUSS SҠADDNSϠSYSBNנSUBUNS BҠҠN SAŠHŠSHD(BS0- ANDSԠҠZ A̬A A ANDB00003 SZASS MPMDB SHDNNZϠSԠMAMUMSZ YSAMP MANA ADASYS SSA MPұ VADSHNDؠSBϠPSS SŠABŠNDؠ(SHD DAMP ADDABŠSAԠ- ADASYSA DAA SBA ԠAҠMPNGSYSMUS MPSPҬ SPà0 MDB̠DABU SAŠHŠUSDPGAMNUMB AKŠHŠPGAMNUMBҠHHSANA̠NUMB ANDMAKŠԠASɠBYSPNGHŠ BYSAND"'NGN"ANA̠60 SAŠHŠSԠDGԠANDADDHŠ60 ANDB00000 ҠB000060 SAMP NנPKUPSNDDGԠMVŠԠϠHŠHGH DҠBYŠANDADDHŠ60 DABU ANDB00000 AƬAS ҠB030000 NנPUԠHMGH ҠMP PUԠԠNHŠABADBU SANUM DAU AƬA ANDB00 ҠBY SAU SԠHŠUSԠADDSSϠHŠSPA̠ASŠBU DASPBA SAADD MPSPҬɠUN SPà5 ѱNP HSUSԠUNSHŠUϠHŠUS ANDMNAS DAU SABU+ AҠPUNGHŠUNHŠUSԠBU UNԠϠHŠUSNGMNA SB DƠ+6 DƠD DƠU DƠBU DƠD3 DƠMD MPŠMNA SAҠNANSMSSN? MPDN MPU SPà5 HSSAHADDD.DŽ63PAMB HDAUԠPYƠ HŠSGNBԠSSԠNHŠSAMSϠNϠPY ̠BŠSNԠBYAMSNŠHŠMNA̠N' KNנHAԠϠDϠHԠANYAY SPBADƠSPBU SPBUƠԠ00006 DàSUBSAM Dà63.DŽ63 Ԡ00000ԠUSD Ԡ000PYGVN Ԡ0NϠDAA Ԡ0000ѠDŠ.B. Ԡ005006ý0(Dé006.B. ASà3PG̠PGAMADMDU HŠNԠPAAM1ҠSN̠BYŠ(0U Ԡ0000 HŠNԠPAAMҠS.B.HŠSPҠ(N ASɩ UNP ASàP HŠNԠPAAMҠS.B.HŠSGN AS Ԡ0 HŠNԠPAAMҠSA.B.ASPAŠҠH AS"ZD"PGAMNUMB Ԡ0360 NUMNP NP SPà5 NSANSANDSAG SYSADƠSYSB- SYSBDƠѱSYSMUSԠ SYSѠDà BABUƠNP MDŠԠ0000 GNP UNP MԱASà3(3ɲ ADDҠNP DDà D3Dà3 DDà BUƠBSS5 B̠Dà5 NAMŠASà3DSP D0Dà0 D6Dà6 DDà B60Ԡ60 BADƠBU ԠԠ650 NDà5 DԠԠ65 NNP NҠNP MԠ0000 ̠NP MSSASàMMҠNPU MSSASà9MMҠUPU MSS3ASàGUNԠ MSS̠Dà-6 MS̠Dà- MS3̠Dà- MPNP BYŠԠ0000 SPà0 HŠNGBUҠNANSHŠMPDB ҠHŠŠUNYBNGASSD DBP53 Ԡ0 NDUU aq  29100-80015 A S P0122 91701A/B RTE CENTRALMODULE NAME: DISP             H0101 BASMBҬB NAMDSP0 NԠDSP ԠìDS DSPNP PSBDSSAHHŠUUŠ DƠ+3NԠUS DƠNUSԠADDSS(ҠZϩ DƠU ANYHNGUND? DANPKUPHŠADDSS SZASSANYHNGϠDSPAH? MPDNŠN-A̠DN SBàYS-DSPAHAM DƠ+5 DƠDŠSHDHAԠH DƠNAMŠMDUŠAMPASS DƠNHŠUSԠADDSS DƠUUSNGU MPPANYHNGPUԠN""DUNGAM? DNŠSB DƠ+ DƠD6 D6Dà6 NAMŠASà3AM DŠDà9 NNP UNP NDDSP   29100-80016 A S P0122 91701A/B RTE CENTRALMODULE NAME: TAM             H0101 ASMBҬB̬ NAMAM30 NԠAM Ԡ$BҬ$B Ԡ AU0 BU HDMMUNANSASSMN SPà0 AMNP PKUPSAMYPŠϠDMNŠMN DAB SAPAMBSAVŠUSԠADDSS NBPKUPHŠUƠHŠUSNG DABɠDVŠSŠԠMPAY SAUNUMVDAҠϠSԠNY SԠHŠDAUԠMNA̠YP ..HŠUSԠSNԠMAMDBB̠MNA ANDHUSANVŠASAUSPY DBPAMB SBBKA B SBMDB SԠUPHŠҠGS BNBҠYPŽMPSSAM SHŠSAMYPŠ0? DAPAMBɠGԠSAMYP NנHKUSԠGN-SԠMAMDBB ƠSϠSԠNϠUNAG HNAҠHŠMDBB̠NDAҠAG SSASS MP+ SBMDB ANDMSK SBN SZASS MP SHŠSAMYPŠϠBG ADASMADDNGAVŠƠƠDND SSASSSAMYPS+. MP ԠKSGD-NVKŠMN PKUPSAԠƠMNҠABŠϠNDDSPA- MNԠANDSHDUŠHŠMN HŠSHDUNGPSSBנSAGNA̠N ԠHASBNHSNϠMAKŠHŠADDN ƠMNSHҠHNHŠMŠŠASS MNҠ(AMASY. ƠNϠHҠMNSAŠϠBŠADDD HŠABVŠDŠUDBŠPADAԠHŠNԠ AMҠSGHYDUDVHAD DBD3SԠUPҠGS SBSAVB DAPAMBɠSŠSAMYP ADAB- MPYH ADAMNA SANAM SHDSB DƠ+ DƠD NAMŠNP DƠPAMB DƠU DƠMDB DƠSAVB DƠPAMB+ SHSB DƠ+ DƠD6 SPà5 ҠSBSAVB DANA SANAM M  PSHD SPà5 NҠNP SAPM3 SB$B NP DAPM3 SABKA SB$B DƠN SPà5 MNADƠMN MNҠASà3 ASà3 ASà3 ASà3 ASà3 ASà3AM ASà3 ASà3 SPà5 NSANSANDABS NADƠNM NMASà3 D6Dà6 PAMBNP UNP BKANP MDB̠NP PM3NP MSKԠ0 HŠԠ3 DŠDà9 SAVBNP SMDà-9 NDAM P   29100-80017 A S P0222 91701A/B RTE CENTRALMODULE NAME: RFAM             H0102 ?ASMBҬB̬ NAMAM30 Ԡ$BҬ$B Ԡ ԠPM Ԡү$ ԠVAADDSSƠVנŠN ԠDBAADDSSƠUNԠDBNUDS ԠMPA AU0 BU SZŠSHŠSZŠƠHŠBSSAVAABŠҠ HŠSԠANDAMDABS(HŠNGHƠHŠ BԠSUBUNŠSASϠADDDԠSA UNNƠHŠGUNDDSàSDNԠAA SZŠ SPà5 SZŠU005 SPà5 HDMŠŠASSMN SPà0 PAM6NP UNP MDB̠NP SAVBNP NP AMNPHSSHŠMŠŠASSMN NAY"BG"NANSADDSSƠUS BUҠADDSSϠBŠPSSD. ƠB-HSSASHDUŠMHŠM S:SMPY-SHDU. PBB- MPSH AHҠHANMNANGHSMDUŠSPAD NHŠMŠSԠSϠHAԠSAPPNG̠AKŠPA ƠAHGHҠPYPGAMNDSHŠ.HS ̠PSVŠNGYƠHŠŠSAŠAB. SBMPA DƠ+ DƠPAM6 DAPAM6 SAPAMB DAA SAPAMB+ HKHŠNGHƠHŠSԠABŠNY SPà5 DASԠHASHŠSYSM SZASSBNBDUPY? MPBԠN-GϠDϠ ̠MDBԠUS? DAPAMBSNPASSSA99ϠAM PAD99SNBԠUSSA MPSHGA̠AԠHSPNԠNM A̠NSϠHSPGAMAŠMŠŠASS USSANDASSUHMUSԠBŠADHUGHH ŠSAŠABŠ(Sԩ. DMNŠHŠUNNDŠƠHŠUS ANDiҠHK SԠUPҠGS DBD DAPAMBPKUPH ADABUNN DAA ANDB0003D-MASKUԠHŠSSSN ADABASŠNUMBҠANDADUSԠSϠԠS SADŠAVADKUPPN SSASHŠUNNDŠNGAV SBҠƠSϠԠSN SZASSSHŠUNND SBҠZ-ƠSϠ ADAMANSHŠUNNDŠAG SSASSHANHSŠDND?ƠS SBҠԠSN USŠBGSҠASҠNDA NŠHŠNAMŠSNԠNPAMB+6ҠHŠSAUS A SԠHŠNנŠNAMŠMUSԠBŠPKDUP ԠSSPԠASSDBUNDASNPAMBS HŠSҠPKUPSUSD-ԠSSAVDNHŠAAY NNAM DBPAMB ADBNAMD SBPKUP SANNAM SBPKUP SANNAM+ SBPKUP SANNAM+ SԠHŠMŠàA̠AGϠHŠDAU NDN B SBAG SԠUPANDA̠AMSԠPSS DAD ADASA DAA SBA SB DƠ+ DƠD9 DƠDS DƠPAM6 DƠMDB DƠAG DƠUҠŠSAUSàAS SԠUPHŠAMPSԠPSSSҠANDUŠ DAD ADASB DAA SBA SHB SB DƠNDA DƠD DƠD0SHDUŠANGPGAM DƠS DƠD0 DƠSԠN3HUS. NDA̠SBAM HDMŠŠASSS'S MSԠNP NנUSSAŠPSSDH ANנUSԠMUSԠBŠNSDƠAMDB PSSNGANMMN SAHAMDҠANMPYSԠASDNDBYA0 NHŠSԠNAMŠD. NUNPNϠPNSϠSԠAMDNAMŠD NMA̠UNSB+ ҠUNSB+(NϠMNkAMD BNBAҠNYUN DAAMAPKUPADDSSƠSԠAMD SAPNϠADDSSPKUPSԠD PDAPNϬɠƠNAMŠS PAB- MPNM SZASSZ-ƠNԠHSNYS MPMSԬɠNMA̠UN DAPNϠSPϠNԠNAMŠPN ADAAD SAPN NBNMNԠNYUN MPPƠNԠYAGAN NMԠDBB5ƠDN-NϠMNHŠNN SZMSԠNϠ"M"SS-UN MPMSԬ SPà5 SԠNP HSSҠKSHUGHHŠAMDAB ANDDMNSƠMŠHANNŠMNA HASAGVNŠPNUNY-ԠUNSH NUMBҠƠSPNNHŠVAABŠţ ANAZŠHŠNUMBҠƠS SAţPNϠZ DBAMAPKUPHŠDYADDSS PDABɠPKUPHŠSԠD PAB-HŠNԠDYNY MPSԬɠƠ-ŠAŠDN HSSAVADNYSϠHKNAMŠNMN UNԠƠԠMAHS PANNAM MP+3 ADBB5 MPP SԠDNAMŠMAHS-DSSND? NB DAB PANNAM+ MP+3 ADBB MPP SNDNAMŠDMAHS-DSHD? NB DAB PANNAM+ MP+3 ADBB3 MPP NAMŠMAHSSϠNMNԠNUMBҠƠMNAS HAԠUNYHAVŠHSŠPN SZţ GϠKҠM SBţ+ ADBD3SPϠNԠAMDNY MPP SPà5 MҠNP HSSUBUNŠSNDSBAKHŠ- HAԠUDDNAYMŠBAKMHŠMP HŠҠϠBŠPASSDBAKSNHŠAG. SAP SԠUPHŠàA̠ϠHŠDV DAMDBUDHŠMD ҠD SAMD DAD5BUDHŠDUN ܆SAB DAPAMBSԠUPHŠVUҠADDSS SABU NנUNƠHŠNUPSANDSԠUPHŠPY BU SB$B NP BSԠUNDABϠ0 ADAD SBA NA SBA NA DBPPKUPҠYP SBA UNNNUPSANDSNDԠBAK SB$B DƠ+ DƠ+ SNDASPƠԠSAADҠ DAD PADSԠ? MPSPYS PAD5SԠAAD? MPSPYS MPGҠN-NNU SNDSP SPSB DƠ+3 DƠD3 DƠU SNDԠBAK GҠSB DƠ+6 DƠD DƠU BUƠNP DƠB DƠMD MPSH SPà5 SŠNP SBSԠPNϠHҠMŠUSS? DAţPKUPNUMBҠƠUSSHϠHAV PAZϠŠPN-ƠNBDYDϠA MPSSSANDADS ADAMHSŠPN-MŠHAN? SSASSƠYSMAYBŠASPA̠S MPSASԠϠS SBDSԠHSŠPNϠ-SԠUS MPSSYSSANDADSŠUD MҠDAMPNϠSMBDYS-ANԠS SBM SASBDSԠSUҠUSҠAMUNGHS MP+HŠPN?ҠƠN MPM YSSPA̠SŠUDASS: HSSPA̠SŠSҠUSHŠDBϠB SԠUPPҠϠA-NŠHAԠԠAKSH PAŠƠHŠDSàSHDU SBSԲASԠUPHŠSNGDB DBDBA NB SBү$ SBM SNDPYPSPSS PSSBS3BPSPSSHŠS DADBAPKUPHŠADDSS ADAD5ƠHŠUND DAAɠҠDMMP SBMTHҠHNSNDHŠPY SSSBSԲAUŠSANDADS MPSŬ SPà5 S3ANP HSSҠPPSSSPUGŠANDNAMŠ SPA̠NSDANS ƠAPUGŠҠNAMŠSUDNAŠPN ϠϠҠMŠMNASHNASPA̠AS SS SBSԠMŠHANMNA̠HASHS DAţŠPNƠţSGA PAZ MPSԴZ ADAMHAN SSAƠSϠSNDBAKA- MPSԴؠƠNԠPSSASUSUSA SԴYDAMSԠUP-ҠD SBMҠANDUN HSŠSNYPNϠNŠMNA̠BUԠ MAYNԠBŠUҠUS-NHHASŠԠS AN SԴؠSBDS MP+ԠSUҠUS-ԠԠHU MPSԴYSMBDYS- SԴZSBSԲAUŠSANDADPPSS MPS3AɠSUBUNŠ SPà5 SԴANP SԠHŠPNAGϠNNUSV A SAG HSSҠHANDSPNUSSҠHŠSPA USVŠPNAS-ƠAŠSϠBŠPND USVYHNAHKSMADŠϠDMN ƠANYHҠMNA̠USSHAVŠԠPN UNY-ƠNNŠDϠԠSADANDHŠ MANAGҠ̠AHANYNNŠMNA̠DUPANS ƠHŠPNSNԠUSVŠԠSAD HUGHҠNMA̠PSSNG SԠƠUSVŠPN DBPAMBPKUPN̠BYŠҠS ADBD9PNA̠PAAM-ƠNԠPS DABɠ-NԠDAUԠ(USVŠPN ANDMSKSPA̠BUԠN̠BY SZASSƠ.B.0HNNDƠPAMB MPPDAUԠNDN ƠPSNԠPKUPHŠDSԠBԠ NB DABɠPKUPPASSDPAAMҠ ANDMSK3AҠA̠BUԠBԠ SZASSƠBԠS0USVŠPN MPPGϠMAKŠUSVŠPNS ƠNԠUSVŠPNHSUSԠANBŠ HUGHHŠGUAҠG HŠNנUSԠSNԠUSV-BUԠԠANB HNDNYƠHŠAŠNϠHҠMNASH HŠŠUSVYPNAADY DMNŠHנMANYMNASHAVŠHSŠPN SBS DAţPKUPƠMNAS PAZϠƠZϠA̠SԠϠԠԠHU MPSԲY PADƠNԠ0ҠMUSԠBŠNNUSV MPSԲVGϠHKUSҠҠؠPN MPSԲYMŠHANMUSԠBŠK SԲVDAţ+PKUPADDSSƠASԠD NAƠNAMŠANDNMNԠϠU DAAɠPKUPANDSԠؠAGB SSA(SGNBԩ-ƠSԠHN'S- MPSԲנPN-ƠNԠUS SԲYSBSԲA MPSԴAɠUNAҠGUAҠPSSNG HŠUSVŠPNSAŠHANDDH SԠSŠHנMANYGUYSHAVŠHSŠPN PSBS DAţƠHSNUMBҠS0ԠҠP PAZϠBAUSŠHSŠSNԠPN MPSԲUϠANYMNA PADƠԠSHNHŠŠMAY MPSԲZBŠPNϠHSUSҠAADY ƠPNϠMŠHANNŠHNANUSVŠPN ANNԠBŠAD SԲؠSBDSԠPNAD-SSŠUD? MP+YS-SԠUPDBҠSŠA MPSԲԠNϠDB-SŠNԠNDD SBSԲAGϠSԠUPDBҠS DBDBASԠUPHŠDBADDSS NBSPPASԠHŠAGD SBү$A̠SŠHUҠHŠPAMB SBMҠҠUN(AG- SBDA SԲԠDAMSԠUPPNҠAG SBM SԲZSBDSԠƠHŠNYUSҠϠHMHS MPSԲUŠSPNSUҠUSҠ'SK MPSԲؠHSŠ'SN SԠHŠPNAGϠUSV SԲUA SAG MPSԲYNNUŠPSSNG SԲנSBDSԠNDUԠƠNYSUS MP+YS-NNU MPSԲؠNϠUNҠMSG. DBţ+SԠUPϠAҠHŠؠPNAG NB DABɠPKUPUDA ANDMSKHŠ-PNAG SABɠHNPUԠԠBAK MPSԲYNנPSSHŠNNUSVŠPN SPà5 S5ANP HSSҠPSSSHŠASNYAS HSŠHHANSUԠNANUSVŠPN NDNUPNSUSSU̠MPN SHSŠPNϠANYNŠHҠHANHŠA SBSԠDMNŠHנMANYMNAS DAţHAVŠHSŠPN! PAZϠƠZϠ'ҠP MPS5Y PADƠNYS̠MAYBŠK MPS5ZBUԠNYƠUҠMNA-GϠS MŠHANNŠMNA̠HASԠSϠUSV PNN'ԠD-GVŠDUPAŠNAMŠ S5ؠDAM SBMҠGVŠSMUADMP S5ZSBDSԠNDUԠHϠHASԠAADY MPS5Y'SUSԠԠHUGH MPS5ؠSMBDYSŠSND- ƠA̠S̠N̠H S5YSBSԲADϠSANDADPPSS MPS5AɠANDUNAҠ'SDN SPà5 DSԠNP NUN: BGPNSϠHŠSAԠƠHŠAMDNY (NMA̠UNNY NMA̠UNNGSB BNANSҠDŠ(-NNԠUND ҠUN(NԠUN HŠAMDDY̠NנBŠSAHD AMAHUN̠A-SNUND(NDƠABũ SԠPKUPHŠABŠADDSS DBAMA PDAB PAB- MPNH HSSAVADNYSϠHKNAMŠHNU PANNAM MP+3 ADBB5 MPP SԠDNAMŠMAHSDSSND? NB DAB PANNAM+ MP+3 ADBB MPP SNDNAMŠDMAHS-DSHD? NB DAB PANNAM+ MP+3 ADBB3 MȿPP HDNAMŠDMAHS-DSUƠUSNG MNA NB DAB ANDMSKSPƠSAUSBS PAU ƠHŠNYHASBNUNDŠAŠ"DUN" MPDUN ƠNԠPBAKҠHŠNԠNY ADBB MPP ƠHŠNYSNԠNHŠABŠN̠MS H NHҠDAM SԠUPHŠҠAGNHŠBGNMN ϠHŠҠUNUN SZDS MPDSԬ DUNADBB-3 MPDSԬ SPà5 SAPNP HSSҠPSHŠAGSҠϠNANH AVŠNY(NHŠSԩƠHŠDBHAԠS ϠBŠDMDB.ASϠHŠSGNBԠ̠B SԠϠƠAϠAYMVŠSϠBŠMAD. ŠHŠŠGSҠSS SSAϠZϠƠHŠMVŠS ŠNŠAY ANDMSKPKUPHŠAV SASNàSAVŠHŠSԠNMN AUAŠADDSSƠSԠSԠDϠBŠMVD ADAB- MPYSNSԠUP ADASADDSNAN SASUàADSS SASN+SAVŠHŠSԠADDSS DBDBA SBDS SԠUPPUN DBSN MBNB SBN P3DADSԬɠPKUPDBDNAG$S SZDNB(ƠϠAYMVũ DBSUìɠHNSŠANS SASUìɠƠAϠAYMVŠS SZBNDàHUSNŠY SBDSԬɠSMP NMNԠPPNSNNU SZSUàNMNԠSUŠ SZDSԠDSNANUNS SZNҠNMNԠPUNҠ MPP3NNUŠUN̠DN SHŠNYMVDϠSԠUSU̠ҠASDBMPY DAŠƠMPYNϠNDϠSԠUP SZAHŠAMDPNҠBAUSŠ MPSAPɠDSN'ԠSԠANYM NנSԠŠPNҠNNYHAԠASNDB ϠNנSԠPSN DASN+ɠPKUPSԠSԠD AƬAƠSAŠHŠAMDNYPN AƬASNANDH-HNNV ANDMSKHSNYϠANNY ADAB-ADDSSҠD5ƠAMD MPYAD̠NY ADAAMA ADAD SASN+SŠAUADADDSS DASN+ɠPKUPD5ƠAMDNY ANDMSKAҠHŠDSԠPN DBSNàNנPKUPNנSԠNMNԠ BƬBƠAŠԠNϠBS-HN ҠBMGŠԠNϠD5ƠAMD SASN+ɠNYNAYPUԠԠBAK SԠSԠNYBUSY DASN+ ҠMSK5 HŠNGSADUPANƠԠP ҠASAPAҠA̠U-HNԠSNDD ANDMSKDNSԠNY ҠNҠϠHŠN.ƠNS ADAM SASN+ɠN MPSAPɠUN SPà0 AGŠNP AGŠSSAGŠƠA̠SUNYN ŠSUԠHŠDSԠN-HŠNYƠH VAADSԠNYSUNDNHŠAG. BNBNAZŠHŠNY SBMP+NUMBҠHN DANԠBUDAUNҠҠ MANAƠSԠNSN SANҠŠUNY DBSADPKUPADDSSƠSԠNY PDABɠNנPKHŠNSAԠAM ADAM SAB ANDMSK3ANDKҠHŠZϠAGŠNY PAZ SSDU MP+3 DAMP+ SA ADBSNNNUŠϠNMNԠHŠPN- SZMP+SUN̠HŠNŠAVŠS SZNҠHASBNAMND. MPP ̠UԠNYH HŠNYϠ̠UԠSN"" AŠHŠAMDNY DA̠NVԠHŠSԠNY ADAMϠANADDSS MPYSNPKUPHŠSԠD ADASADƠHŠNYHŠSA SABAD DAAɠHŠAMDPN AƬAƠNANDHN AƬAS ANDMSK NנAŠHŠŠDNUMB ADAMNVԠHŠAMDNYϠAN MPYAD̠ADDSSPKUPHŠH ADAAMADƠHAԠNYSA ADADHŠDSàPNҠNAND DBA DAAɠHN SԠ"NDS"AGB ҠMSK5 SAB ANDMSK SԠUPHŠNYNUMB SBAàAUAŠAKSҠADDS. SADSKAD+SAVŠAK SBDSKAD+SAVŠSҠ DAVAAŠHŠU ADADNHŠMDUŠUDS DAAɠPKԠUP ҠNDHNADDHŠSԠBS SADSKAD+3ANDSԠԠASDŠҠHŠA SB DƠ+ DƠDŠPAN DƠDSKAD+3N̠D BADNPBUҠADDSS ̠AKŠPA-HUSSPDNGHŠŠPAN A00DŠSUSDSϠHAԠNϠPAKNG DƠD00BUҠNGH DƠDSKAD+AK DƠDSKAD+SҠ ASHŠADSUSSU? DBD5SԠUPHŠҠGS SSAMP? MP-N ANDMSKYS---? SZAƠZϠNϠ SBҠ DA MPAGŬɠPNҠUN SPà5 HŠNGSҠPKSUPNŠDMPAMB HAԠSSPԠASSADBUNDAY ԠPSHŠADDSSƠHŠSԠBYŠNHŠBGS ԠUNSHŠMPDDNHŠAGS ANDHŠADUSDADDSSNHŠBGS ԠANHUSBŠADSAYҠNSUV DSBYNYSNGUPBN PKUPNP SBPUPADSŠHŠPKUPADDSS DABɠPKUPHŠSԠBY AƬAƠԠUSY ANDMSK6HנAAYHŠGABAGŠBY B@  29100-80034 A S 0122 LINE PRINTER DRIVER (2767) SIO 24K            H0101 *ASMBAB̬ìN HDSϠNŠPNҠDVҠ(HP6 G MP3 DƠNԠNAZANAN G0B DƠNPPGAMSAԯԠAN SPà N KŠU50000B Z KŠU0000B SKP GK+6000B SPà NԠANGUŠHŠDV ANDA SA DAñM ANDP00AND ҠS SAHAH DAò ANDP00AND Ҡ SAHSàH DA3 ANDP00AND Ҡ SAH3SSH DAô ANDP00AND Ҡ SAHàH DA5 ANDP00 Ҡ SAH5 HԠBHNHA MPN SPà AԠ P00Ԡ00 ñA0 òSà0 3SS0 ôà0 5A0 SKP G06B ABSK+0B GK+55B SPà NPNPNY MANA SA SSAHAAҠUNԠҠMMAND? MPBDHAҠUN SAB DAAADYPAGŠ SZBSSSMMANDNŠSPAŠҠPG? UADAANŠSPA SBUAUPUԠAND MPNPɠԠDV SPà BDADAD0 SSASSHAҠUNԠ0? MPP+N DAD0YSSԠϠ0 MPNP+ PDBB B̬ŬSBBSBUҠADDSSND? MPPYSHNԠV HUԠDABɠPKUPDMBU SZSSUPPҠHAA? AƬAƠYS BSAVŠHAAҠADDSSNB ANDA3 SAUAMPSAV ADAAM0 SSAHAҠ<0? MPѠYS ADAAM00N D  SSAHAҠ3? MP+3N ѠDAA00YSGԠSYMB SS DAUAPAŠHAA SBUAUPUԠϠPN NBNMNԠHAAҠADDSSAND ŬBSHBAKϠBUƠADDSS SZԠASԠHAAҠU? MPHUԠN MPUAYSPNԬSPAŠAND SPà UANPUPUԠHAASANDMMANDS SAMP H5A0 SZAPNҠNԠADYҠBUSY? MP-YS DAMP HA0 HSà0 H3SS0UPUԠMP? MP-NϬHANGNH Hà0YSADDHŠSNGAND MPUAɠԠNDY SPà AԠ AԠ A3Ԡ3 BU ԠNP D0Dà0 AM0Ԡ-0 A00Ԡ00 AM00Ԡ-00 MPNP ND f   29100-80035 A S 0122 MAG TAPE DRIVER (7970)  SIO 24K            H0101 ASMBAB̬ìN N HDKSϠHP90DVҬ30VB Z HD6KSϠHP90DVҬ30VB G0006B DƠMD-ASԠDAVAABŠMMY DƠMDDVҠNYPN SPà DVҠNAZANSN SPà PUPSŠƠHSSNSϠSԠHŠɯ NSUNSϠNŠADSGNADɯ ADDSSҠHŠ90MAGAPŠDV. SPà UNƠHSSNSBGUNAԠAN: SPà (MP3 (3DƠ.M SPà HSHS00-05ɯϠADDSS SPà HSSNSASDAҠHŠNAZAN SMPD. SPà G0000B MP00003BɠSԠSANG DƠ.MԠPNԠNAND3 SPà N KŠU50000BKVSN. Z KŠU0000B3KVSN. SPà GK+06000B SPà NGUŠɯ0NSUNS SPà NGHԠ00B SPà SSנU0BSNSŠSHGSҠADDSS. .MԠASSנGԠDAAHANN̠ADDSS SAUNSSAVŠHŠSHPNS. AND. SABSAVŠDAAHANN̠ADDSSNB ADAM.0"SUBA":S..-0B. SSASHANN̠NUMBҠ<0B? MPNGYSGϠSAԠNGUAN. ADAMAH"SUBA":S..-0B. SSASSSHANN̠NUMBҠ6B? MPNGYSGϠSAԠNGUAN. SPà DAñADAAàNSUNS ADAB SAM.3 SPà DAòADAAàNSUNS ADAB SAM.3 SPà DAôàDAANSUNS ADAB SAM.5 SAM.50 SAM.3 SPà DA5SSDAANSUNS ADAB SAM. SAM.6 SPà t| DAñSàDAAàNSUNS ADABNUDŠHŠHANN̠NUMB. SAM.9SŠHŠNSUN. SAM.SŠHŠNSUN. SPà DAñ3ƠDAANSUN. ADABNUDŠHŠHANN̠NUMB. SAM.SŠHŠNSUN. SPà DA6AMNDNSUNS ADAB SAS. SPà DA÷BMNDNSUNS ADAB SAS.0 SPà DAøSàMNDNSUNS ADAB SAP SAM.0SŠHŠNSUN. SPà DA9SSMNDNSUNS ADAB SAM.0 SAM. SPà DAñ0AMNDNSUNS ADAB SAM. SAM. SPà DAñSàMNDàNSUNS ADAB SAM. SAM.6 SPà DA0BMNDNSUN. ADAB SA.B SPà DA3àMNDNSUN. ADAB SAM. SAM.6 SPà DAUNSADHŠSHPNS. A̬A̠SHԠBԠϠBԠ0. SAA̠SMAMUMUNԠ3? MPNGYSһSA. A̠SHԠUNԠMAMUMϠ-0. AND.3SAŠHŠMAMUMUNԠNUMB. PA.3AŠHŠU(MԠUNS? MPSPYSMNAŠNGUAN. DBS0NϬADHŠS0MMAND. SBS3SԠUNԠ3ϠBŠUNԠ0. PADòAŠHŠH(3MԠUNS? MPSPYSMNAŠNGUAN. SBS̲NϬMAKŠUNԠUUNԠ0. PADñAŠHŠ(MԠUNS? MPSPYSMNAŠNGUAN. SBS̱NϬMAKŠUNԠUUNԠ0. SPà SPHԠBNDƠDVҠNGUAN. SPà DA.S̱xADHŠSԠUNԠMMAND. SAS̱SŠHŠMMAND. DA.S̲ADHŠSԠUNԠMMAND. SAS̲SŠHŠMMAND. DA.S3ADHŠSԠUNԠ3MMAND. SAS3SŠHŠMMAND. MP.M SPà .Ԡ M.0Ԡ-0 MAHԠ-60 UNSNP .S̱Ԡ0000SԠUNԠMMAND. .S̲Ԡ0000SԠUNԠMMAND. .S3Ԡ0000SԠUNԠ3MMAND. SPà ɯϠNSUNS SPà 0BMND ñADAA òADAA 3àMND ôàDAA 5SSDAA 6AMND ÷BMND øSàMND 9SSMND ñ0AMND ñSàMND ñSàDAA ñ3ƠDAA SPà NDƠASABŠNAZANSN SPà .P.̠U005BDVҠNGH. GK+035B-.P. SPà ..A.ƠSϠMԠDVҠMUSԠBŠ66B. SPà ..A.ƠSϠMԠDVҠMUSԠBŠ<ط35B. SKP ANGSUN:(ůAD SPà DA ABSOLUTE PROGRAM LOADER * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * RTE-C APLDR * E. WONG * REV.A E.WONG 25MAY73 * REV.B E.WONG 3AUG73 * REV.C D.L.S. 10MAR75 COPYRIGHT * * SOURCE : 29101-80004 * RELOC : 29101-60004 * LISTING: 29101-80004-2 * * NAM APLDR,1,60 ENT APLDR EXT $LIBR,$LIBX,EXEC * A EQU 0 B EQU 1 KEYWD EQU 1657B BPA1 EQU 1742B BPA2 EQU 1743B RTORG EQU 1746B RTCOM EQU 1747B AVMEM EQU 1751B BKLWA EQU 1777B SUP * * * APLDR IS SCHEDULED BY THE SYSTEM WHEN OPERATOR INPUTS * ONE OF THE FOLLOWING: * PL,LU * LO,PNAME,LU,FL,KB * RP,PNAME,LU,FL,KB * * THE SCHEDULE CALL PASSES THE PARAMETERS IN THE FOLLOWING * ORDER: * P1 - KEYBOARD LU # / FUNCTION CODE * P2 - FILE NUMBER / INPUT-OUTPUT LU # * P3 - CHARACTER #1 / CHARACTER #2 * P4 - CHARACTER #3 / CHARACTER #4 * P5 - CHARACTER #5 / * * WHERE FUNCTION CODE IS: * 0 - PROGRAM LIST * 1 - LOAD PROGRAM * 2 - REPLACE PROGRAM * * * * APLDR NOP LDA DKBFN GET ADDR OF BUFFER STA TEMP1 SAVE TEMPORARILY LDA MD5 STA TEMP2 RMPLP LDA B,I GET PARAM FROM ID SEG STA TEMP1,I SAVE IN BUFFER INB ISZ TEMP1 ISZ TEMP2 JMP RMPLP * LDA NAM50 MAKE SURE 6 CHAR AND LHALF IS ZERO. STA NAM50 * CLA LDB FILLU GET FILE NO.&I/O LU LSR 8 SAVE LEFT HALF STB FILE Q AS FILE NUMBER. * ALF,ALF SAVE RIGHT HALF STA LU AS I/0 LU. * LDB KBFUN GET KYBD UNIT AND FUNC LSR 8 SAVE LEFT HALF SZB,RSS IF ZERO, LDB CONSL USE DEFAULT STB KYBDU AS KEYBOARD UNIT. * ALF,ALF GET FUNC FROM RIGHT HALF SZA,RSS IS IT LIST? 0 JMP LIST CPA B1 IS IT LOAD? 1 JMP LOAD CPA B2 IS IT REPLACE? 2 JMP REPL JMP ABORT NO, IT IS ERROR. * DKBFN DEF KBFUN MD5 DEC -5 * HED L0: LOAD PROGRAM LOAD LDA NAM12 IF NO NAME GIVEN SZA,RSS SKIP DUPLIC NAME JMP *+3 CHECKING JSB DUPID CHECK IF DUPLICATE DEF NAM12 ID NAME. * JSB STRID NOT DUPLI, FIND LOAD2 JSB SRCID A BLANK DFNUL DEF ZERO ID SEG. JMP LOADD NO BLANK ID SEG. JMP LOAD2 KEEP LOOKING. STA CURID GOT IT, SAVE ADDR. * LOAD3 JSB IHILO INIT HI,LO ADDRS LDA DWRD1 INIT SPEC REC STA WORD1 DUMMY ID ADDR. LDA DWRD2 STA WORD2 LDA RSS INITIALIZE SWITCH STA ABS12 FOR SPEC. REC. STA LDRCT INIT LEADER COUNT STA IDOFS INDICATE NO ABS YET. * LDA LU GET LU PARAM, SZA,RSS IF ZERO LDA DINPT USE DEFAULT IOR B2300 FOR THE ABS STA LU INPUT UNIT. * * * * READ ABSOLUTE RECORD * * ABS0 JSB EXEC MAKE REQUEST DEF *+5 TO DEF B1 READ DEF LU ABS RECORD DEF ABSBF INTO BUF DEF D64 OF MAX SIZE. * AND B240 CHECK FOR EOF/EOT SZA,RSS IS IT EOF? JMP ABS0A NO LDA LDRCT YES, IS IT SZA,RSS JUST LEADER? JMP LOAD5 IS EOF. JMP ABS0 IGNORE LEADER * ABS0A SZB,RSS ANYTHING TRANSMITTED? JMP ABS0 NO * STA LDRCT SET LDRCT FOR EOT LDB ABSCT GET WORD COUNT. BLF,BLF SHIFT TO LOW BITS STB ABSSZ SAVE REC SIZE CMB,INB STB TEMP1 SAVE NEG COUNT LDB ABSAD GET ADDR, START CKSM. LDA DABSD STA TEMP2 SET DATA ADDR. ABS0B LDA TEMP2,I GET A WORD ADB A ADD TO CKSM ISZ TEMP2 BUMP TO NEXT ISZ TEMP1 BUMP COUNT JMP ABS0B REPEAT TIL DONE. * LDA TEMP2,I CPA B COMPARE CKSMS JMP ABS1 MATCHES LDB ERR10 CHECKSUM ERROR- JMP ERPR4 ERR MSG THEN ABORT * * * * FIND WHERE ABSOLUTE RECORD FITS IN CORE * * ABS1 LDA ABSAD OK, SO FETCH ADDR CPA B2 IS IT SPECIAL RECORD? JMP ABS12 YES AND BPMSK IS IT BASE PAGE? CPA ABSAD JMP ABS2 YES, BASE PAGE. * LDA RTORG GET DEFAULT LOWEST ADDR STA TEMP LDA AVMEM GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DMAIN GET PTRS TO MAIN HI/LO LDB D22 SET OFFSET FOR MAIN JMP ABS3 ADDRS IN ID SEG. * ABS2 LDA BPA1 GET DEFAULT LOWEST ADDR STA TEMP LDA BPA2 GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DBASE GET PTRS TO BASE HI/LO LDB D24 SET OFFSET FOR BASE PAGE * * * * FIND THE HI AND LO MEMORY BOUNDS OF FREE CORE * * ABS3 STB IDOFS SAVE OFFSET TO GET ADDRS STA TEMP4 SAVE ADDR OF LFREE ADA B2 STA TEMP5 SAVE ADDR OF HFREE LDA TEMP CMA,INA CHECK IF ABS REC < FWABP USER LINKS ADA ABSAD SSA JMP ABS14 ABS < FWABP, ERROR LDA ABSAD ADA ABSSZ CMA,INA CHECK IF ABS REC > LWAM USER SPACE ADA TEMP1 SSA JMP ABS14 ABS > LWAM, ERROR LDA TEMP4,I CPA TEMP RSS ADDRS ALREADY SET? JMP ABS6 YxES, SKIP SEARCH FOR HI/LO * JSB STRID INIT ID SEARCH. ABS4 JSB SRCID SEARCH EACH ID DEF ZERO EXCEPT BLANK ONES, JMP ABS6 FOR THE HI/LO RSS RSS ADDRS WHICH JMP ABS4 DEFINE FREE CORE. CPA CURID IS THIS ID FOR PRG? JMP ABS4 YES, IGNORE THIS ID BOUNDS ADA IDOFS STA TEMP SET ADDR OF ID ADDR. * CMA CHECK IF ID SEG > 22 WORDS ADA ADRID,I SSA JMP ABS4 NEG, IGNORE IF RTE ID SEG. CLA STA TEMP1 CLEAR OVERLAP FLAG * LDA TEMP,I GET ID LOW CMA,INA ADA ABSAD IS ID LOW > ABS REC? SSA JMP ABS4B LOW>ABS, CHECK MORE ISZ TEMP1 LOW<=ABS, CHECK IF OVERLAP JMP ABS5 BY CHECKING IF HI>=ABS * ABS4B LDA TEMP,I GET ID LOW AGAIN CMA SUBTRACT IT ADA TEMP5,I FROM LAST HFREE SSA AND JMP ABS5 IF IT IS LDA TEMP,I LOWER THEN KEEP IT DST TEMP5,I AS NEW HFREE * ABS5 ISZ TEMP LDA TEMP,I GET ID HIGH ADDR CMA,INA ADA ABSAD SSA,RSS ID HIGH < ADDR OF REC? JMP ABS5B HI<=ABS, CHECK MORE CLA,INA HI>ABS, MIGHT OVERLAP CPA TEMP1 DOES ABS OVERLAP? JMP ABS13 YES, GIVE OF ERR JMP ABS4 NO, IGNORE * ABS5B LDA TEMP,I GET ID HI CMA,INA SUBTRACT IT ADA TEMP4,I FROM LAST LFREE SSA,RSS AND IF IT IS JMP ABS4 LDA TEMP,I HIGHER, WE KEEP IT DST TEMP4,I AS NEW LFREE JMP ABS4 REPEAT FOR EACH ID * * * * ALREADY GOT MEMORY BOUNDS; SEE IF ABS CAN FIT * * ABS6 LDA ABSAD GET ADDR OF ABS REC LDB ABSSZ ADB A GET ADDR OF END OF ABS REC JSB CKBND CHECK BOUNDS WITH LFREE,HFREE JMP ABS13 ERROR. * * * * COPY ABS RECORD TO CORE IF WITHIN BOUNDS * * ABS10 LDA ABSSZ SET UP ABSSZ CMA,INA FOR TRANSFER STA TEMP OF RECORD. LDA DABSD SET UP BUFFER STA BADDR ADDR OF DATA WORDS. LDB ABSAD SET UP CORE ADDR. ABS11 LDA BADDR,I GET A DATA WORD. JSB SYSET PUT INTO CORE. INB ISZ BADDR ISZ TEMP JMP ABS11 REPEAT UNTIL DONE. JMP ABS0 GO GET ANOTHER RECORD * * * * PROCESS SPECIAL TRAILER RECORDS. * * ABS12 RSS NOP-ED AFTER 1ST ENTRY.! JMP AB12B SO ONLY DO THIS ONCE. LDA MD28 STA TEMP1 SET COUNTER LDB DDMID TO CLEAR OUT CLA AB12A STA B,I SPECIAL RECORDS INB ISZ TEMP1 JMP AB12A STA ABS12 NOP SWITCH * AB12B DLD ABSD1 PICK UP 2 DATA WORDS STA WORD1,I PUT 1ST INTO DUMMY ID. STB WORD2,I PUT 2ND INTO DUMMY ID. ISZ WORD1 BUMP DUMMY ID ISZ WORD2 LOCATIONS. JMP ABS0 * * * * REACHED END-OF-FILE ON PROGRAM INPUT * * LOAD5 LDB IDOFS CHECK IF ANY ABS CPB RSS WAS READ YET. JMP IDERR ERROR IF NONE. LDA WORD1 SPEC REC MUST BE AT END CPA DWRD2 WAS IT THERE? JMP LOAD6 YES. IDERR LDA B5 NO. LDB ERR13 NO SPECIAL RECORDS, JMP ERPR4 PRINT ERR MSG/ABORT * LOAD6 DLD NAM12 NAME GIVEN IN COMMAND? SZA,RSS JMP LOAD7 NO, USE NAME FROM SPEC REC DST PNM12 YES, USE NAME FROM COMMAND LDA NAM50 GET 5TH CHAR STA PNM50 JMP LOAD8 WE DID DUP.CHECK ALREADY. LOAD7 JSB DUPID NAME GIVEN IN SPECIAL RECORD, DEF PNM12 CHECK FOR DUPLICATE. * LOAD8 LDB SZCOM GET SIZE OF COMMON SZB,RSS JMP LOD8A SKIP CHECK IF NO COMMON LDA FWAC GET FWA COMMON CMA SUBTR FROM ADA RTORG FWA REAL-TIME COMMON SSA,RSS FWACAVMEM? JMP LOADE YES, ERROR. * LOD8A LDA DMAIN GET FREE AREA POINTERS STA TEMP4 FOR THE MAIN AREA DLD PRGMN GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * LDA DBASE GET FREE AREA POINTERS STA TEMP4 FOR THE BASE PAGE AREA DLD PRGBP GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * * * * MOVE ID SEGMENT TO SYSTEM AREA * * LOD8B LDA PNM50 GET 5TH CHAR AND LHALF MASK OUT TYPE INA FORCE TO TYPE 1 STA PNM50 LDA MD28 DONE LOAD, COPY ID SEG. STA TEMP SET UP COUNT. LDA DDMID SET UP ADDR STA BADDR FOR DATA WORDS. LDB CURID SET ADDR FOR CORE LOC. JMP *+3 DON'T MOVE LINKAGE WORD * LOAD9 LDA BADDR,I JSB SYSET MOVE A WORD TO ID SEG INB ISZ BADDR ISZ TEMP JMP LOAD9 REPEAT TILL DONE. * LDA MSG1+1 SET UP DONE STA BUF MESSAGE WITH LDA MSG1+2 PROG NAME STA BUF+1 LDA MSG1+3 STA BUF+2 LDB DWRD1+1 GET ADDR OF PROG NAME LDA LINE2 GET ADDR IN MSG FOR NAME INA JSB MVNAM MOVE NAME TO MSG LDA D10 STA TEMP3 JSB DSPLA DISPLAY MESSAGE JMP STOP END APLDR. * * * ERROR RETURNS FROM LOADING SECTION * ABS13 JSB REMER MEMORY ERROR JSB IHILO CLEAR HI,LO ADDR JMP ABS1 GO RE-ESTABLISH HI/LO. * ABS14 LDB ERR12 ABSLWAM JMP ERPR4 SO ABORT * LOADC LDA B,I GET NAM12 FROM ID SZA,RSS PROG REMOVED YET? JMP LOD8B YES. JSB REMER FINAL MEMORY ERROR JMP LOD8A C CHECK AGAIN * LOADD LDA DBLNK NO BLANK STA MT.ID+1 ID SEG LDA A00 SET ZEROES IN MSG STA MT.ID+2 LDA D11 LDB MT.ID SET UP MESSAGE ERMPR JSB STUFP PRINT MESSAGE JMP ABORT THEN ABORT. * LOADE LDB ERR11 ABS USED TOO MUCH COMMON ERPR4 LDA B2 GET COUNT TO JMP ERMPR PRINT ERR MSG, ABORT SKP * **************************** * SUBROUTINES USED IN LOAD AND ABSOLUTE RECORD PROCESSORS * **************************** * * DUPID CHECKS FOR DUPLICATE PROGRAM NAME, ISSUES ERROR * MESSAGE AND ATTEMPTS TO CHANGE PROGRAM NAME. ABORTS IF * STILL NOT UNIQUE. * JSB DUPID * DEF PNAME * * DUPID NOP SEARCH FOR DUPLICATE LDA DUPID,I ID NAME. STA DUPNM SAVE ID NAME. ISZ DUPID DUP1 JSB STRID INIT ID SCANNER. DUP2 JSB SRCID FIND ID SEG DUPNM NOP WITH SAME NAME JMP DUPID,I NO DUPLICATE. JMP DUP2 REPEAT TIL DONE. LDA ERR02 DUPLIC. PROG ERR LDB DUPNM JSB ERROR * LDA C$$ CHANGE NAME ONLY ONCE CPA DUPNM,I IF NAME ALREADY CHANGED, JMP ABORT THEN ABORT, STA DUPNM,I ELSE SEARCH AGAIN. JMP DUP1 * * **************************** * * SYSET SETS A WORD INTO A CORE LOCATION. * LDA WORD * LDB ADDR * JSB SYSET * * SYSET NOP SYSTEM WORD SETTER. JSB $LIBR TURN OFF THE NOP INTER. SYS. STA B,I STORE WORD INTO SYS. JSB $LIBX RESTORE INTER SYS DEF SYSET AND RETURN. * * *********************************** * * IHILO INITIALIZES DEFAULT HIGH AND LOW BOUNDS * OF FREE MEMORY. * JSB IHILO * * IHILO NOP INITIALIZE HI/LO ADDRS LDA BKLWA TO FIND HIGHEST F STA HMAIN AND LOWEST LDA B1647 STA HBASE ADDRS OF UNUSED LDA RTORG CORE WHICH MAY BE STA LMAIN USED FOR LOADING LDA BPA1 STA LBASE ABS PROGRAMS CLA STA LMID STA HMID STA LBID STA HBID JMP IHILO,I RETURN * * ******************************* * * CKBND CHECKS PROGRAM BOUNDS AGAINST THAT OF FREE * CORE (TEMP4 POINTS TO FREE CORE POINTERS). * LDA PRGLO LOW ADDR OF CORE USED * LDB PRGHI HI ADDR * JSB CKBND * * * CKBND NOP CHECK BOUNDS OF PROG DST TEMP AGAINST BOUNDS OF FREE CORE DLD TEMP4,I GET LFREE CMA,INA SUBTR FROM ADA TEMP LOW ADDR SSA ADDR>=LFREE? JMP CKBND,I NO, ERROR * LDA TEMP4 ADA B2 DLD A,I GET HFREE CMA SUBTR FROM ADA TEMP1 HI ADDR SSA ADDR<=HFREE? ISZ CKBND RETURN TO P+2 IF NO ERROR JMP CKBND,I RETURN TO P+1 IF ERROR * * ************************** * * REMER ISSUES "REM XXX" ERROR MESSAGE IF NEED TO REMOVE * A PROGRAM TO GET SPACE IN CORE, THEN SUSPENDS APLDR. * IF SPACE BELONGS TO THE SYSTEM, APLDR IS ABORTED. * LDB PNAME PROG WHICH MUST BE REMOVED * JSB REMER * * REMER NOP -REM XXXXX- ERROR SZB,RSS MEMORY ERROR. JMP ABS14 OUTSIDE AVAILABLE MEM LDA ERR01 GIVE -REM XXXXX- MESSAGE JSB ERROR JSB EXEC CALL EXEC DEF *+2 TO SUSPEND DEF B7 THE APLDR. JMP REMER,I RETURN * * ****************************** * * MD28 DEC -28 * B240 OCT 240 B1647 OCT 1647 B2300 OCT 2300 * * D24 DEC 24 D64 DEC 64 * BPMSK OCT 1777 C$$ ASC 1,$$ NAME CHANGE CHAR. * ABSSZ NOP NvFILE NOP CURID NOP IDOFS NOP BADDR NOP LDRCT NOP WORD1 NOP WORD2 NOP * * DO NOT CHANGE ORDER OF FOLLOWING * LMAIN NOP LMID NOP HMAIN NOP HMID NOP LBASE NOP LBID NOP HBASE NOP HBID NOP DMAIN DEF LMAIN ADDR OF HI/LO ADDR FOR MAIN DBASE DEF LBASE ADDR OF HI/LO ADDR FOR BASE PAGE * * DWRD2 DEF DWR2,I DWRD1 DEF *+1,I DUMMY ID ADDRESSES DEF PNM12 NAM12 DEF PNM50 NAM50/TYPE DEF RESML RESOL/MULT DEF HRS HR DEF SEC SEC DEF PRGMN LOW MAIN DEF PRGBP LOW BASE DEF FWAC FWA COMMON DDMYD DEF JMPXF JMP XFER * DWR2 DEF PNM34 NAM34 DEF PRIOR PR DEF SPAR1 SPARE WORD DEF MIN MIN DEF MSEC MSEC DEF PRGM2 HMAIN DEF PRGB2 HBASE DEF SZCOM SIZE COMMON DEF XFER XFER ADDR * HED RP: REPLACE PROGRAM REPL LDA NAM12 IS IT A SZA,RSS BLANK NAME? JMP REPNO YES, ERROR * REP00 JSB STRID INIT ID SEARCH REP01 JSB SRCID TO FIND ID SEG DFNAM DEF NAM12 WITH SAME NAME JMP REPNO NO SUCH PROG JMP REP01 STA CURID GOT IT, SAVE ID ADDR STB TEMP SAVE ADDR OF ID NAME * JSB $LIBR TURN OFF INT. SYS. NOP ADA D8 LDA A,I POINT OF SUSPENSION SZA IS ZERO? JMP REP03 NO, SUSPEND APLDR ADB B3 LDA B,I SZA IS STATUS DORMANT? JMP REP03 NO, SUSPEND APLDR ADB B2 LDA B,I ALF,CLE,ERA SEZ IN TIME LIST? JMP REP03 YES, SUSPEND APLDR * DLD ZERO CLEAR OUT NAME DST NAM12 -IN CALL SO WE CAN STA NAM50 USE NAME FROM ABS PROG DST TEMP,I CLEAR ID SEGMENT LDB TEMP ADB B2 FOR REPLACEMENT STA B,I BY THE RP COMMAND JSB $LIBX RESTORE INT SYS DEF *+1 DEF LOAD3 GO LOAD PROG * * ERROR RETURNS FROM REPLACE * REP03 JSB $LIBX RESTORE INT SYS DEF *+1 DEF *+1 LDA ERR04 PUT NAME INTO LDB DFNAM -OF XXXXX- BECAUSE JSB ERROR NON-ZERO SUSP OR T-LIST JSB EXEC SUSPEND APLDR DEF *+2 DEF B7 JMP REP00 TRY TO REPLACE AGAIN * REPNO LDA ERR03 NO SUCH PROG LDB DFNAM PUT NAME IN ERR MSG JSB ERROR PRINT ERR MSG JMP ABORT THEN ABORT HED PL: PROGRAM LIST * LIST PROGRAMS. * LIST LDA LU GET LU PARAM. SZA,RSS IF ZERO, LDA DLIST USE DEFAULT. STA LU SET LIST UNIT. * JSB SPACE PRINT LDA D19 HEADING. LDB HEAD1 JSB PRINT JSB SPACE * LDA DBLNK SET UP OUTPUT BUFFER. STA BUF STA BUF+4 STA BUF+6 STA BUF+13 * CLA CLEAR OUT BLANK ID SEG. STA TEMP5 COUNTER. * JSB STRID INIT ID SCANNER. LIST2 JSB SRCID SEARCH ID SEGS DEF ZERO JMP LIST7 EOF JMP LIST3 NON BLANK ID SEG ISZ TEMP5 BLANK ID SEG JMP LIST2 GO SEE NEXT ONE. * LIST3 STB TEMP1 SAVE NAME ADDR STA TEMP SAVE ID ADDR LDA LINE PUT PROG NAME INA INTO LINE JSB MVNAM * LDB TEMP ADB B6 GET PRIORITY LDA B,I WORD JSB DIV10 DIVIDE BY 10 STA BUF+5 * LDB TEMP ADB D22 GET PROG ADDRS. STB TEMP LDA M2 SET -2 TO GET STA TEMP4 MAIN AND BASE PAGE. LDB LINE INITIALIZE ADDR ADB B7 FOR NUMBER STUFFING. LIST4 LDA TEMP,I GET LOW ADDR. JSB CONV CONVERT TO ASCII. ISZ TEMP LDA TEMP,I GET HIGH ADDR. ADA M1 -1 TO GET REAL HIGH ADDR JSB CONV CONV\ERT TO ASCII. * INB LEAVE A SPACE. ISZ TEMP ISZ TEMP4 JMP LIST4 GO GET NEXT PAIR OF ADDRS. * LDA D20 LDB LINE JSB PRINT PRINT PROG INFO. * JMP LIST2 GO GET NEXT ID SEG. * LIST7 LDA TEMP5 GET # OF BLANK ID SEGS JSB DIV10 DIVIDE BY 10 STA MT.ID+2 LDA D11 LDB MT.ID JSB PRINT PRINT "# BLANK ID SEGMENTS" * DONE LDA B2 PRINT "DONE" LDB MSG1 AFTER THE "APLDR:" JMP STOP1 * ABORT LDA B4 PRINT "ABORTED" LDB ERR99 AFTER THE "APLDR:" STOP1 JSB STUFP STOP JSB EXEC CALL EXEC DEF *+2 TO END DEF B6 APLDR. * SKP * SUBROUTINES FOR APLDR. * * ***************************** * * SPACE PRINTS A BLANK LINE ON LIST DEVICE. * JSB SPACE * * SPACE NOP PRINT BLANK CLA LINE. LDB MSG1 (B)=DUMMY BUFFER JSB PRINT JMP SPACE,I * * ***************************** * * PRINT PRINTS A LINE ON LIST DEVICE. * LDA WORDS NO. OF WORDS * LDB ADDR ADDR OF TEXT * JSB PRINT * * PRINT NOP STA TEMP1 STB MADDR JSB EXEC CALL EXEC DEF *+5 TO PRINT DEF B2 ON LIST DEVICE DEF LU MADDR NOP DEF TEMP1 JMP PRINT,I * * ******************************** * * STUFP STUFFS A MESSAGE WITH THE IDENTIFIER "APLDR:" AND * PRINTS IT ON CONSOLE. * LDA WORDS * LDB ADDR * JSB STUFP * * STUFP NOP STUFF MESSAGE INTO STB TEMP SPECIAL IDENTIFIER LDB B4 ADD 4 TO ADB A MESSAGE LENGTH STB TEMP3 FOR TOTAL LENGTH CMA,INA STA TEMP2 NEGATIVE COUNT. LDB MSG0 STFLP LDA TEMP,I STA B,I INB ISZ TEMP ISZ TEMP2 JMP STFLP JSB DSPLA DISPLAY MESSAGE JMP STUFP,I RETURN * * ****************************** * * DSPLA PRINTS A MESSAGE ON THE CONSOLE. THE MESSAGE * ADDRESS IS IN MSG AND THE WORD LENGTH IS IN TEMP3. * JSB DSPLA * * DSPLA NOP JSB EXEC DEF *+5 DEF B2 CALL EXEC DEF KYBDU TO WRITE DEF MSG MESSAGE ON DEF TEMP3 OPERATOR CONSOLE. JMP DSPLA,I RETURN * * ****************************** * * MVNAM MOVES A PROGRAM NAME (3 WORDS) AND FILLS AN * ASCII BLANK IN THE DESTINATION NAME. * LDA DEST ADDR OF DESTINATION FOR NAME * LDA SORC ADDR OF SOURCE NAME * JSB MVNAM * * MVNAM NOP MOVE PROG NAME STA TEMP4 TO GIVEN DESTINATION LDA B,I STA TEMP4,I MOVE CHAR1,2 ISZ TEMP4 INB LDA B,I STA TEMP4,I MOVE CHAR3,4 ISZ TEMP4 INB LDA B,I AND LHALF PUT ASCII BLANK IOR B40 IN CHAR6 STA TEMP4,I THEN MOVE JMP MVNAM,I RETURN * * ******************************* * * ERROR PUTS A PROGRAM NAME INTO AN ERROR MESSAGE * THEN PRINTS IT ON THE CONSOLE. * LDA ERRAD ADDR OF ERROR MESSAGE * LDB PNAME ADDR OF PROGRAM NAME * JSB ERROR * * ERROR NOP PUT NAME INTO STB TEMP5 ERR MSG THEN DLD A,I PRINT IT DST BUF MOVE ERR MSG TO OUTPUT AREA LDB TEMP5 GET ADDR OF NAME LDA LINE2 TO PUT INTO MSG JSB MVNAM LDA D9 STA TEMP3 SET LENGTH FOR JSB DSPLA DISPLAY JMP ERROR,I RETURN * * ***************************** * * STRID INITIALIZES ID SEGMENT SEARCH ROUTINE. * * STRID NOP INITIALIZE ID SCANNER. LDA KEYWD GET KEYWORD ADDRESS STA ADRID STORE AS ID ADDRESS. JMP STRID,I RETURN * * ***************************** * * SRCID FETCHS AN ID SEGMENT AND SEES IF MATCH/NO MATCH/BLANK. * JSB SRCID * DEF PNAME ADDR OF NAME TO SEARCH FOR * * * * A CONTAINS ADDR OF ID SEGMENT * B CONTAINS ADDR OF NAME IN ID SEGMENT * SRCID NOP SEARCH ID SEGMENTS LDA SRCID,I FOR A CERTAIN NAME. STA TEMP1 SAVE ADDR OF NAME ISZ SRCID SET RETURN AT P+2 LDB ADRID,I PICK UP AN ID ADDR SZB,RSS IS IT END OF ID SEGS? JMP EOFID YES ADB D12 BUMP TO NAME IN ID STB TEMP2 SAVE ADDR OF NAME LDA B,I CPA TEMP1,I CHECK NAME 1,2 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I CPA TEMP1,I CHECK NAME 3,4 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I AND LHALF STA STRID SAVE TEMPORARILY LDA TEMP1,I AND LHALF CPA STRID COMPARE NAME 5 ISZ SRCID MATCHES, SET RETURN P+4 * NOMAT ISZ SRCID NO MATCH, RETURN P+3 LDA ADRID,I READY FOR RETURN. ISZ ADRID LDB TEMP2 EOFID JMP SRCID,I RETURN. * * ***************************** * SUBROUTINE: CONV (CONVERT 15-BIT BINARY NUMBER * TO 6-CHAR (LEADING BLANK) ASCII FORM OF OCTAL NUMBER * CALLING SEQUENCE: * (A)-BINARY VALUE FOR CONVERSION * (B)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (P) JSB CONV * (P+1) (RETURN): * (A) DESTROYED. * (B) ADDRESS OF NEXT STORAGE * CONV NOP STB TEMP1 SAVE STORAGE AREA ADDRESS LDB A RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA TEMP2 = -3. LDA B40 MAKE FIRST CHARACTER A SPACE. CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA TEMP3 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR TEMP3 PACK IN UPPER CHARACTER STA TEMP1,I AND STORE IN STORAGE AREA. ISZ TEMP1 ADD 1 TO STORAGE AREA ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ TEMP2 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDB TEMP1 FINISHED, SET (B)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * * *********************************** * * DIV10 CONVERTS A VALUE TO ASCII CHARACTERS * (DECIMAL CONVERSION, 99 MAX). * LDA VALUE * JSB DIV10 * * DIV10 NOP DIVIDE BY 10 (99 MAX) CLB RETURN ASCII IN (A) DIV D10 ALF,ALF MOVE TO LEFT HALF ADA B ADD REMAINDER ADA A00 MAKE ASCII JMP DIV10,I RETURN SKP * CONSTANTS AND STORAGE. * UNS M3 OCT -3 M2 OCT -2 M1 OCT -1 * B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B40 OCT 40 B60 OCT 60 * D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D19 DEC 19 D20 DEC 20 D22 DEC 22 * A00 ASC 1,00 CONSL EQU B1 OPERATOR CONSOLE. DINPT EQU B5 DEFAULT INPUT UNIT. DLIST EQU B6 DEFAULT LIST UNIT. LHALF OCT 177400 ZERO OCT 0,0,0 ADRID NOP KYBDU NOP LU NOP * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP |ZXT* KBFUN NOP 5-WORD TABLE. FILLU NOP NAM12 NOP NAM34 NOP NAM50 NOP * SKP * MESSAGES FROM APLDR WITH LOVE. * * ERR01 DEF *+1 ASC 2,REM * ERR02 DEF *+1 ASC 2,DUP * ERR03 DEF *+1 ASC 2,NO * ERR04 DEF *+1 ASC 2,OF * ERR10 DEF *+1 ASC 2,CKSM * ERR11 DEF *+1 ASC 2,COM * ERR12 DEF *+1 ASC 2,MEM * ERR13 DEF *+1 ASC 2,ID? * ERR99 DEF *+1 ASC 4,ABORTED * * MSG1 DEF *+1 ASC 3,DONE- * * MT.ID DEF *+1 ASC 11, BLANK ID SEGMENTS * HEAD1 DEF *+1 ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE * * DBLNK EQU ERR04-1 DOUBLE BLANK WORD DABSD DEF ABSBF+2 DDMID DEF DMYID LINE DEF MSG+4 LINE2 DEF MSG+6 MSG0 EQU LINE * MSG ASC 9, APLDR: BUF EQU MSG+4 * ABSBF BSS 64 * ABSCT EQU ABSBF ABSAD EQU ABSBF+1 ABSD1 EQU ABSBF+2 ABSD2 EQU ABSBF+3 * DMYID EQU ABSBF+35 JMPXF EQU DMYID-4 SPAR1 EQU DMYID-3 FWAC EQU DMYID-2 SZCOM EQU DMYID-1 PRIOR EQU DMYID+6 XFER EQU DMYID+7 PNM12 EQU DMYID+12 PNM34 EQU DMYID+13 PNM50 EQU DMYID+14 RESML EQU DMYID+17 MSEC EQU DMYID+18 SEC EQU DMYID+19 MIN EQU DMYID+20 HRS EQU DMYID+21 PRGMN EQU DMYID+22 PRGM2 EQU DMYID+23 PRGBP EQU DMYID+24 PRGB2 EQU DMYID+25 * BSS 0 SIZE OF APLDR * * END APLDR NjZ 0 29101-80005 B S C0122 RTE-C RELOCATING LOADER MAIN CONTROL             H0101 NASMB,B,R,L,C HED RTS RELOCATING LOADER/2100 * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * THE TERM RTS/2100 IS SYNONYMOUS WITH RTE-C AND * THE TERMS ARE USED INTERCHANGEABLY THROUGHOUT * THIS DOCUMENT * ********************************************************* * * RTE-C LOADER MAIN CONTROL * REV.A JACK COOLWY 15MAY73 * REV.B D.L.S. 10MAR75 COPYRIGHT * ********************************************************* * NAM LOADR * * ENTRY POINT NAMES * ENT PNAME,PNAMA,PRAMS ENT LOADR * * EXTERNAL REFERENCE NAMES * EXT LOEND EXT PRCMD EXT BPLOC,LOCC,BPAG4 EXT B2,MD24,MD60,UPCM EXT CNTR,?XFER,OPT.3 EXT FWABP,LTG,ABRC1,FWAM,FWAC,COML EXT PACK,PUNCH,LST EXT LISTO,ASR33,B7 EXT DIAG,ABORT * B EQU 1 * SUP ********************************************************** * THE FUNCTION OF THIS LOADER IS TO RELOCATE AND LINK * RELOCATABLE BINARY MODULES TOGETHER, AND PREPARE * THEM FOR EXECUTION ON AN RTS SYSTEM. AFTER * LOADING THIS LOADER INTO CORE USING THE BBL OR BBDL, * THE SIO DRIVERS TO BE USED ARE LOADED AND CONFIGURED * THE SNAPSHOT CAN THEN BE READ IN FROM THE PHOTO * READER BY TYPING TR ON THE TTY. * THIS SNAPSHOT CONTAINS THE DEFAULT * MEMORY BOUNDS, SYSTEM COMMON, AND DEFINES THE * CORE-RESIDENT LIBRARY ROUTINES FOR THE TARGET RTS * SYSTEM. * SYMBOL TABLE ENTRY FORMAT: * * WORD 5 - OCT 0 (LINK OR FIXUP TABLE ADDRESS) * 4 - DEF SYMBOL (HOLDS SYMBOL VALUE) * 3 - OCT XX000 CHAR 5 AND FLAGS * 2 - % ASC 1, CHARS 3,4 OF NAME * 1 - ASC 1, CHARS 1,2 OF NAME * SHOULD ONLY BE REFERENCED VIA POINTERS LST1 THRU LST5, * USING SUBROUTINES LSTI AND LSTP. * ************************************************************************ * LOADR JMP BEGIN SET ENTRY POINT AT 100 BSS 4 DEF LOEND SET UP LOC 105B WITH LAST WRD USED BSS 2 BEGIN NOP START UP LOADER LDA ABJMP SET UP LOC 100 FOR STA LOADR SUBSEQUENT STARTUPS LIA 1 GET SSW CONTENTS SSA,RSS IF BIT 15 IS CLA NOT SET, ASR33=0 STA ASR33 SET, ASR33 = NON-ZERO LDA 106B GET LAST WORD OF FREE MEMORY STA OPT.3 SAVE STA LTEMP LDA M1020 ZERO BASE PAGE LINK TABLE STA CNTR LDB BPAG4 GET ADDRESS OF THE LINK TABLE CLA STA B,I INB ISZ CNTR JMP *-3 STA PNAME STA ?XFER CLEAR "HAVE MAIN" FLAG STA LOCC STA BPLOC STA COML INITIALIZE "COMMON USED " FLAG STA LST INITIALIZE SYM TAB LENGTH LDA LISTO RESET THE BIT TO OUTPUT MAP AND B7 HEADING (BIT # 3), BUT KEEP STA LISTO BITS 0-2. JSB LTG PUNCH LEADER. LDB ONMSG PRINT MESSAGE JSB DIAG "LOADER STARTED" JSB PRCMD PROCESS LOADER COMMANDS JMP RESET RETURN HERE AFTER ABORT LDA PRCMD NORMAL RETURN ADA M1 SET UP PRCMD TO ALLOW STA PRCMD RESTART AT LOC 100 AS WELL AS RUN BUTTON LDA LOCC SZA,RSS IF NO MODULES RELOCATED, JMP NOINP DONT OUTPUT SPECIAL RECORDS LDA B2 STA ABRC1 STORE ADDRESS OF TIE-OFF RECORDS DLD PNAME GET PROGRAM NAME JSB TYOFF PUNCH CHARS 1,2,3,4 OF NAME LDA PNAME+2 AND UPCM IOR PRAMS CHAR 5,TYPE LDB PRAMS+1 GET PRIORITY JSB TYOFF LDA PRAMS+2 RAR,RAR RES. CODE RAR 4 IOR PRAMS+3 CLB SPARE JSB TYOFF DLD PRAMS+4 ADA MD24 24-COMPLEMENT HOURS ADB MD60 60-COMPLEMENT MINUTES JSB TYOFF OUTPUT HOURS AND MINUTES DLD PRAMS+6 GET SECONDS & TENS OF MSECS ADA MD60 60-COMPLEMENT SECS ADB M100 100-COMPLEMENT T.MSECS JSB TYOFF OUTPUT SECONDS AND TENS OF MILLISECONDS LDA FWAM GET LOW MAIN LDB LOCC GET HIGH MAIN JSB TYOFF OUTPUT LDA FWABP GET LOW BASE PAGE LDB BPLOC GET HIGH BASE PAGE JSB TYOFF OUTPUT LOW & HIGH BASE PAGE LDA FWAC LDB COML JSB TYOFF LDA JMP3 LDB ?XFER GET TRANSFER ADDRESS JSB TYOFF JSB LTG NOINP HLT 77B RESET LDA LTEMP STA 106B JMP BEGIN RESTART SPC 1 ABJMP JMP ABORT JMP3 JMP 3,I LTEMP NOP M1020 DEC -1020 LENGTH OF BP LINKS TABLE(EXCL.LOC 0-4) M100 DEC -100 M1 DEC -1 PNAMA DEF PNAME PNAME REP 3 PROGRAM NAME NOP BSS 3 MODULE LENGTHS FOR MAIN PRAMS DEC 3 DEFAULT TYPE DEC 99 DEFAULT PRIORITY REP 6 DEFAULT OTHER PARAMS NOP SPC 2 TYOFF NOP PUNCH TWO-WORD TIE-OFF RECORD JSB PACK WORD 1 FROM (A) LDA B WORD 2 FROM (B) JSB PACK JSB PUNCH JMP TYOFF,I ONMSG DEF *+1 DEC 14 ASC 7,LOADER STARTED * SPC 2 END LOADR @ % 29101-80006 B S C0422 RTE-C RELOCATING LOADER SUB CONTROL             H0104 ASMB,R,L,B,C * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * THE TERM RTS/2100 IS SYNONYMOUS WITH RTE-C AND * THE TERMS ARE USED INTERCHANGEABLY THROUGHOUT * THIS DOCUMENT * ************************************************************************ * * RTE-C LOADER SUBORDINATE CONTROL * REV.A JACK COOLEY 15MAY73 * REV,B D.L.S. 11MAR75 COPYRIGHT * * ******************************************************************** * HED RTS RELOCATION SUBORDINATE CONTROL NAM RTRLC * * ENTRY POINT NAMES * ENT LST,.MEM.,.MEM1,.MEM2,.MEM3,.MEM4,.MEM5,.MEM6 ENT IBUFR,PUNCH,OPT.3,ABRC1,PLK,?XFER,PLKS,LSTA1 ENT UEXFL,SSTBL,LST1,LST2,LST3,LST4,LST5,LTG ENT MEMRY,PRCMD,PACK,BPLOC,LOCC ENT LINK,ASR33,B7,PCHX,DIAG ENT MOVEX,B2,B4,MD24,MD60,UPCM,FWAM,FWAC,COML ENT CNTR,BPAGA,MD6,FWABP ENT BPAG4,LISTO ENT LOUT,NAMR.,ABORT ENT LOEND * * EXTERNAL REFERENCE NAMES * EXT PNAME,PNAMA,PRAMS * A EQU 0 B EQU 1 SUP ************************************************************************ * * THESE ROUTINES ARE USED BOTH IN THE RTS LOADER ITSELF AND IN * THE RTS GENERATOR RTSGN. THESE ROUTINES,CALLED A SUBORDINATE * CONTROL MODULE, COMPRISE A COMMAND PROCESSOR FOR LOADER COMMANDS. * THIS MODULE IS CALLED AS IF IT WERE A SUBROUTINE WITH NO * PARAMETERS AND TWO RETURNS. THE (P+1) RETURN IS USED FOR ABNORMAL * TERMINATION CONDITIONS, WHILE THE (P+2) RETURN IS USED FOR NORMAL * RETURNS VIA THE END COMMAND.THE CALLING SEQUENCE IS AS FOLLOWS: * * JSB ePRCMD * RETURN1 RELOCATION ABORTED RETURN * RETURN2 NORMAL RETURN * ******************************************************************** HED RTS LOADER UTILITY SUBROUTINES ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BSS 1 BLINE NOP LDA LBUFA STA BLINE-1 LDA MD24 LDB BLANK STB BLINE-1,I ISZ BLINE-1 INA,SZA JMP *-3 JMP BLINE,I ***** * ** RBIN ** READ RELOCATABLE BINARY INPUT FROM SIO DRIVER TO (LBUF) * CALLING SEQUENCE: * * JSB RBIN * RETURN * * NOTE: NUMBER OF WORDS TRANSMITTED IS COMPLEMENTED AND STORED IN * THE FIRST WORD OF THE BUFFER, OVERLAYING FIRST INPUT WORD ***** RBIN NOP LDA MD60 LDB LBUFA JSB 101B,I CMA,INA GET NEG. # DATA WORDS IN RECORD STA LBUF STORE JMP RBIN,I ***** * ** IBUFR ** INITIALIZE THE ABSOLUTE RECORD BUFFER (ABREC) SO IT MAY * BE FILLED UP FOR LATER OUTPUT * CALLING SEQUENCE: * JSB IBUFR * RETURN * ***** IBUFR NOP CLA ZERO OUT STA ABREC WORD COUNT STA CKS AND CHECKSUM LDA ABL2 INITIALIZE STA ABL1 NEXT WORD POINTER JMP IBUFR,I * MEMRY DEF FWABP STMP1 NOP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMETER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA IMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RETURN1 NOTHING BUT BLANKS TO END OF LINE * RETURN2 DELIMETER FOUND * * NOTE: IF NO VALID DELIMITER IS FOUND (OR COMMA WITH NOTHING BUT * BLANKS TO THE END OF LINE) A DIRECT JUMP TO THE COMMAND * ERROR ROUTINE WILL RESULT. THUS CONTROL MAY NOT BE RETURNED ***** DELIM NOP JSB QGETC GET THE NEXT CHAR JMP DELIM,I END OF LINE , RETURN (P+1) LDB KM2 INITIALIZE STB STMP1 COMMA COUNTER CPA B40 IS THIS A BLANK? JMP DEL01 YES CPA B54 NO, IS IT A COMMA? RSS JMP CMER NO, ERROR ISZ STMP1 DEL01 JSB NXTC GET NEXT NON BLANK CHAR JMP DEL02 END OF LINE CPA B54 GOT ONE, IS IT A COMMMA? RSS JMP DEL03 NO ISZ STMP1 YES, IS IT THE SECOND ONE? JMP DEL01 NO, GET NEXT NON BLANK CHARACTER DEL03 JSB BAKUP YES, BACK UP BUFFER POINTERS ISZ DELIM AND EXIT (P+2) JMP DELIM,I DEL02 ISZ STMP1 WAS THERE A COMMA? JMP DELIM,I NO, EXIT (P+1) JMP CMER YES, ERROR ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP LDA QQCNT DECREMENT CHAR COUNT ADA M1 STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB M1 DECREMENT POINTER STB QQPTR JMP BAKUP,I ***** * THE ABSOLUTE RECORD BUFFER * ABREC OCT 0 ABRC1 BSS 49 BUFFER FOR ABSOLUTE RECORD * ***** * ** PACK ** INSERT A WORD INTO THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * LDA WORD TO BE PLACED IN RECORD * JSB PACK * RETURN * * NOTE: .B. IS NOT ALTERED BY THIS SUBROUTINE ***** PACK NOP STA ABL1,I STORE WORD AT NEXT LOCATION ISZ ABL1 IN BUFFER, INCREASE ADDRESS. ADA CKS ADD WORD TO CHECKSUM STA CKS AND RESTORE WORD ISZ ABREC COUNT WORD JMP PACK,I AND EXIT. ***** * ** PUNCH ** OUTPUT THE RECORD IN THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * JSB PUNCH * RETURN * * NOTE: THIS SUBROUTINE INSERTS CHECKSUM AND WORDCOUNT BEFORE OUTPUT ***** PUNCH NOP ENTRY/EXIT LDA CKS ADD LOAD ADDRESS TO CHECK-SUM ADA ABREC+1 AND SET RECORD SUM STA ABL1,I IN LAST WORD OF RECORD.  LDA ABREC ADD 2 TO RECORD WORDCOUNT ALF,ALF POSITION AS FIRST CHAR. AND STA ABREC SET. ALF,ALF REPOSITION, ADD 3 FOR TOTAL ADA B3 LENGTH AND SET FOR CMA,INA LDB .ABR JSB PCHX JSB IBUFR SET UP OUTPUT JMP PUNCH,I EXIT- ***** * ** PCHX ** PUNCH OUT THE CONTENT OF A SPECIFIED BUFFER * IF USING AN ASR33 TTY, THE COMPUTER WILL HALT (07) WHEN * SWITCHING FROM KEYBOARD TO PUNCH MODE. * CALLING SEQUENCE: * * LDA LENGTH, POSITIVE IF CHARS, NEGATIVE IF WORDS * LDB BUFFER ADDRESS * JSB PCHX * RETURN * ***** PCHX NOP ENTRY: LDA,LDB,JSB. STA TMP SAVE (A) LDA ASR33 ARE WE USING ASR33 TTY? SZA,RSS JMP NO33 NO, DO OUTPUT USPCH HLT 7B YES, HALT IF NOT IN PUNCH MODE CLA STA USPCH CLEAR USPCH TO SET PUNCH MODE LDA HLT.K AND SET HALT FOR STA USKBD SWITCH TO KEYBOARD MODE NO33 LDA TMP RESTORE (A) JSB 103B,I DO OUTPUT JMP PCHX,I * TMP NOP ASR33 NOP HLT.K HLT 70B ***** * ** PRCMD ** MAIN ENTRY POINT FOR THE SUBORDINATE CONTROL MODULE. * CONTROL IS PASSED TO TYMOD OR NXTCM TO GET THE NEXT * COMMAND. THAT COMMAND IS PARSED, AND CONTROL IS PASSED * TO ITS ASSOCIATED PROCESSING ROUTINE. IF A FATAL ERROR * IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING * PRCMD AT (P+1). THE ONLY OTHER EXIT IS VIA THE END * COMMAND (P+2). AFTER PROCESSING ANY OTHER COMMAND, * CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. * ***** PRCMD NOP PROCESS RTE LOADER/2100 COMMANDS TYMOD LDA TTYIN INITIALIZE TO STA CMDLU TTY MODE NXTCM JSB CMDIN GET NEXT COMMAND LINE LDA CTACN LDB CTABL JSB SCAN SCAN 1ST ELEMENT FOR MATCH JMP CMER COMMAND ERROR. ADA PTABL JUMP TO PROCESSOR LDA A,I JMP A,I * CMER1 DEF *+1 OCT 5 ASC 3,CMND? ***** * CONTROL COMES HERE ON DETECTING A COMMAND ERROR. THE MESSAGE * 'CMND?' IS OUTPUT, INPUT IS SWITCHED TO TTY, AND GET NEXT CMD. ***** CMER LDB CMER1 OUTPUT CMND? MESSAGE JSB DIAG JMP TYMOD GET NEXT COMMAND FROM TTY HED RTS LOADER TABLES ***** * * BRANCH TABLE FOR COMMAND PROCESSORS. * ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRIES IN * COMMAND PNEUMONIC TABLE. * ***** PTABL DEF * DEF BNDST BOUNDS STATEMENT DEF MAPST MAP STATEMENT DEF RELST RELOCATE STATEMENT DEF SERST SEARCH STATEMENT DEF NXTCM OUTPUT STATEMENTS IGNORED DEF DSPST DISPLAY STATEMENT DEF TR TRANSFER DEF TR TR DEF EOL END STATEMENT DEF SETST SET STATEMENT DEF LNKST LINKS STATEMENT ***** * * COMMAND PNEUMONIC TABLE * * BITS 15-8 # CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE * OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS TABLE IS * OF PARAMOUNT IMPORTANCE. IF ANY KEYWORD IS EXACTLY THE SAME * AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST * APPEAR FIRST. (FOR EXAMPLE TRANSFER APPEARS BEFORE TR) * ***** CTACN ABS CTABS-CTABN NEG NBR ENTRIES IN TABLE CTABL DEF CTABS CTABS ABS 3000B+ABOUD-CMTBL BOUNDS ABS 1400B+AMAP-CMTBL MAP ABS 4000B+ARELC-CMTBL RELOCATE ABS 3000B+ASEAR-CMTBL SEARCH ABS 3000B+AOTPU-CMTBL OUTPUT ABS 3400B+ADISP-CMTBL DISPLAY ABS 4000B+ATRAN-CMTBL TRANSFER ABS 1000B+ATR..-CMTBL ABBR. OF TRANSFER ABS 1400B+AEND.-CMTBL END ABS 1400B+ASET.-CMTBL SET ABS 2400B+ALINK-CMTBL LINKS CTABN EQU * KTABS ABS 2400B+AFWAB-CMTBL FWABP ABS 2400B+ALWAB-CMTBL LWA BP ABS 2000B+AFWAM-CMTBL FWAM ABS 2000B+ALWAM-CMTBL LWAM ABS 2000B+AFWAC-CMTBL FWAC ABS 2000B+ALWAC-CMTBL LTABS ABS 2000B+ALOCC-CMTBL LOCC ABS 3000B+ABPLC-CMTBL BPLOCC ABS 2400B+AXFER-CMTBL .XFER ABS 2400B+ATBLE-CMTBL TABLE ABS 3000B+AUNDE-CMTBL UNDEFS MTABS ABS 3400B+AMODS-CMTBL MODULES ABS 3400B+AGLOS-CMTBL GLOBALS ABS 2400B+ALINK-CMTBL LINKS ABS 1400B+AOFF.-CMTBL OFF ATABS ABS 1400B+AYES.-CMTBL YES ABS 1000B+ANO..-CMTBL NO TSTRT ABS 2400B+ASTRT-CMTBL STATR TAT ABS 1000B+AAT..-CMTBL AT TTO ABS 1000B+ATO..-CMTBL TO STABL DEF TSTRT ATTBL DEF TAT TOTBL DEF TTO LTABL DEF LTABS KTABL DEF KTABS MTABL DEF MTABS ATABL DEF ATABS ***** * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS ON NO IMPORTANCE ***** CMTBL DEF * ABOUD ASC 3,BOUNDS AMAP ASC 2,MAP ARELC ASC 4,RELOCATE ASEAR ASC 3,SEARCH AOTPU ASC 3,OUTPUT ADISP ASC 4,DISPLAY ATBLE ASC 3,TABLE AUNDE ASC 3,UNDEFS AMODS ASC 4,MODULES AGLOS ASC 4,GLOBALS ALINK ASC 3,LINKS AOFF. ASC 2,OFF ATRAN ASC 4,TRANSFER ATR.. ASC 1,TR AEND. ASC 2,END AFWAM ASC 2,FWAM ALWAM ASC 2,LWAM AFWAB ASC 3,FWABP ALWAB ASC 3,LWABP AFWAC ASC 2,FWAC ALWAC ASC 2,LWAC ALOCC ASC 2,LOCC ABPLC ASC 3,BPLOCC AXFER ASC 3,?XFER AYES. ASC 2,YES ANO.. ASC 1,NO ASTRT ASC 3,START AAT.. ASC 1,AT ASET. ASC 2,SET ATO.. ASC 1,TO * PRPTA DEF *+1 ASC 1,-- * PTR NOP CNTR NOP PTR2 NOP CCNT NOP QQCN1 NOP QQPT. NOP TEMP NOP NCHAR NOP CNT NOP SKP HED SCANNER ROUTINE ***** * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHEEuR,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COMMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. SCAN3 LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I HED INPUT COMMAND LINE ***** * ** CMDIN ** INPUT NEXT COMMAND LINE USING SIO DRIVERS * CALLING SEQUENCE: * * JSB CMDIN * RETURN * * NOTE: CMDIN CHECKS FOR '-' IF REQUIRED AND DOES A JMP CMER IF NOT * TH?ERE. IT ALSO SKIPS COMMENTS AND ADVANCES INPUT BUFFER * POINTERS PAST THE '-' IF IT APPEARS IN THE INPUT BUFFER. * * THE IDENTIFIER CMDLU IS USED TO SET UP TTY VS PHOTORDR INPUT * * CMDLU=JSB 104B,I FOR KEYBOARD(TTY) INPUT * NO COMMAND ID CHAR. REQUIRED. NO ECHO. * * =JSB 101B,I FOR BATCH INPUT(E.G., PHOTOREADER, * OR CASSETTE). * COMMAND ID REQUIRED IN COLUMN. 1, AND ECHO TO LIST UN * IMPLIED. * * RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED * ***** CMDIN NOP CLA RESET INCOMING CHARACTER STA QQCNT POINTERS LDA QBUFA STA QQPTR LDA CMDLU TTY? CPA TTYIN TTY? RSS JMP CMD1 NO--SKIP PROMPT CLA,INA LDB PRPTA JSB LOUT CMD1 LDB QBUFA GET COMMAND INPUT LINE LDA D72 CMDLU JSB 104B,I GET NEXT COMMAND LINE STA QQCHC SZA EOT? JMP CMD2 CPA NDATA NEED TO SKIP LEADER? JMP CMD1 YES LDA TTYIN AUTOMATIC TRANSFER TO TTY. STA CMDLU JMP CMDIN+5 * CHECK INPUT LINE FOR COMMAND IDENTIFIER CHAR CMD2 LDA CMDLU ECHO? CPA TTYIN JMP *+4 NO LDA QQCHC YES; GET CHARACTER COUNT, LDB QBUFA AND BUFFER ADDRESS JSB LOUT AND ECHO ON LIST DEVICE LDA QBUFA,I GET 1ST CHARACTER. STA NDATA CLEAR SKIP LEADER FLAG. ALF,ALF AND B177 CPA STAR COMMENT? JMP CMDIN+1 YES LDB CMDLU CPB TTYIN JMP CMD3 YES--COMMAND ID OPTIONAL CPA B55 IS COMMAND ID (-) THERE? RSS JMP CMER NO--PRINT ERROR & SWITCH TO TTY. ISZ QQCNT JMP CMDIN,I CMD3 CPA B55 IS COMMAND ID SUPPLIED? ISZ QQCNT YES--BUMP CHAR. POINTER JMP CMDIN,I TTYIN JSB 104B,I INSTR. FOR KEYBOARD COMMAND INPUT PRDR JSB 101B,Il " " STANDARD " " STAR OCT 52 COMMENT CHARACTER SPC 1 HED SEARCH SYMBOL TABLE FOR MATCH ROUTINE ***** * ** SSTBL ** SEARCH SYMBOL TABLE * CALLING SEQUENCE * * LDA ADDRESS OF 5 CHAR NAME TO MATCH * JSB SSTBL * RETURN1 SYMBOL NOT FOUND * RETURN2 FOUND, LST1-LST5 POINT TO MATCHED ENTRY * * NOTE: THE NAME INPUT FOR MATCH MUST START ON A WORD BOUNDARY ***** SPC 1 SSTBL NOP STB CMDIN SAVE TEMPORARILY JSB LSTI INITIALIZE SYMBOL TABLE SSTB1 JSB LSTP SET LST ENTRY ADDRESSES JMP SSTBL,I END OF TABLE--ERROR RETURN LDB CMDIN RETRIEVE ADDRESS OF TARGET MATCH LDA B,I CPA LST1,I CHARS. 1&2 MATCH? INB,RSS JMP SSTB1 NO--GET NEXT ENTRY LDA B,I CPA LST2,I INB,RSS JMP SSTB1 LDA B,I XOR LST3,I AND UPCM CHECK CHAR. 5 SZA JMP SSTB1 * MATCH FOUND -- MAKE SUCCESS RETURN ISZ SSTBL JMP SSTBL,I * MOVE3 NOP * ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 ISZ MOVE3 BUMP OUTP';<:6UT POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBERED CHAR? RSS JMP MOVE.,I NO, BUFFER IS OK IOR B40 NO,APPEND A BLLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I SPC 1 HED *** COMMAND PROCESSORS *** 3<***** * ** TRANSFER COMMAND PROCESSOR * ***** * NDATA NOP * TR LDA TTYIN SWITCH CPA CMDLU INPUT LDA PRDR DEVICE STA CMDLU CLA SET SKIP LEADER FLAG STA NDATA JMP NXTCM AND GET NEXT COMMAND ***** * ** RELOCATE ** SEARCH COMMAND PROCESSORS * ***** RELST CLA,RSS SET SEARCH FLAG OFF. SPC 1 SERST CLA,INA SET SEARCH FLAG ON. SPC 1 STA LIBFL STORE FLAG CLA STA NREC CLEAR #GOOD RECORDS COUNTER STA RIC STA XNAM STA SERNM LDA LOCC HAS LOCC BEEN SET YET? SZA JMP *+5 YES LDA FWAM NO--SET TO FWAM STA LOCC LDA FWABP ALSO SET BASE PAGE STA BPLOC JSB NXTC GET NEXT NON-BLANK CHAR JMP LDRIN NO MORE CPA B50 LEFT PAREND? RSS YES JMP CMER NO--COMMAND ERROR LDA BLANK BLANK OUT XNAM STA XNAM+1 STA XNAM+2 LDA XNAMA JSB MOVE. * JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NO MORE CPA B51 RIGHT PAREN? JMP LDRIN YES JMP CMER NO, ERROR JMP LDRIN XNAMA DEF XNAM LBUFA DEF LBUF ***** * ** DISPLAY COMMAND PROCESSOR * ***** DSPST JSB BLINE BLANK PRINT LINE LDA QQPTR SAVE STA STMP BUFFER LDA QQCNT POINTERS STA SVAL LDA LBUFA MOVE NAME OF ENTITY TO BE DISPLAYED JSB MOVE. INTO THE OUTPUT BUFFER LDA STMP STA QQPTR RESTORE BUFFER POINTERS LDA SVAL STA QQCNT LDA MD11 LDB KTABL JSB SCAN IS THIS A KEYWORD? JMP DSP10 NO, IT MUST BE AN IDENTIFIER CPA D11 UNDEFS? JMP OLSTU CPA D10 TABLE? JMP OLSTE CPA B3 LDB FWAM CPA B4 LDB LWAM CPA B1 LDB FWABP CPA B2 LDB LWABP CPA B5 LDB FWAC L CPA B6 LDB LWAC CPA D8 LDB BPLOC CPA D9 LDB .XFER CPA B7 LDB LOCC GET CURRENT LOCATION COUNTER JMP DSP20 YES SPC 2 DSP10 LDB LBUFA JSB SSTBL SEARCH SYMBOL TABLE JMP DSP30 SYMBOL IS UNDEFINED LDB LST4,I GET VALUE DSP20 LDA LBUF+2 SET EQUAL SIGN(=) IN 6TH CHAR AND UPCM OF PRINT LINE IOR B75 STA LBUF+2 LDA LBUF4 JSB CONV CONVERT THE VALUE TO ASCII LDA D12 DSP25 LDB LBUFA JSB LOUT PRINT THE LINE JMP NXTCM FINISHED, GET NEXT COMMAND DSP30 LDA MD5 MOVE "UNDEFINED" TO LBUF LDB DSP40 JSB MOVEX LBUF4 DEF LBUF+3 LDA D15 JMP DSP25 * DSP40 DEF *+1 ASC 5,UNDEFINED ***** * ** MAP COMMAND PROCESSOR * * LISTO--CORE MAP LISTING FLAG * BIT 0 GLOBAL VARIABLES * 1 MODULES * 2 LINKS * 3 HEADING HAS BEEN PRINTED ***** MAPST LDA LISTO AND D8 STA LISTO MAP1 LDA MD4 LDB MTABL JSB SCAN JMP CMER STA B LDA LISTO CPB B1 MODULES? IOR B2 CPB B2 GLOBALS? IOR B1 CPB B3 LINKS? IOR B4 CPB B4 OFF? CLA RESET POINTER STA LISTO JSB DELIM ADVANCE PAST DELIMITERS RSS JMP MAP1 LDA LISTO SZA,RSS ANY OPTIONS ON? JMP NXTCM NO, GET NEXT COMMAND AND D8 HAS HEADING BEEN PRINTED? SZA JMP NXTCM YES, GET NEXT COMMAND LDA LISTO RESTORE IOR D8 STA LISTO LDA HEAD1 LDB HEAD1+1 JSB 102B,I LDA HEAD1 LDB HEAD2 JSB 102B,I LDA HEAD1 LDB HEAD3 JSB 102B,I JMP NXTCM GET NEXT COMMAND SPC 1 HEAD1 DEC 47 # CHARS. IN EACH PRINT LINE. DEF *+1 ASC 24, PROGRAM ENTRY LOW HIGH LOW HIGH HEAD2 DEF *+P1 ASC 24, MODULE POINT MAIN MAIN BASE BASE HEAD3 DEF *+1 ASC 24, ---------------------------------------------- LISTO NOP LIST OPTIONS FLAG. ***** * ** BOUNDS COMMAND PROCESSOR * ***** BNDST LDA MD6 LDB KTABL JSB SCAN JMP CMER NO MORE KEYWORDS ADA M1 ADA MEMRY COMPUTE ADDRESS STA NCHAR SAVE ADDRESS TEMPORARILY JSB NXTC GET NEXT NON BLANK CHAR JMP CMER CPA B75 EQUAL SIGN? RSS JMP CMER NO,ERROR GOTEQ JSB NSCAN GET OCTAL NUMBER JMP CMER NO MORE CHARS. JMP CMER NOT NUMERIC SSA IS IT POSITIVE OR ZERO? JMP BER1 NO. ISSUE ERROR AND IGNORE. STA NCHAR,I LEGAL ADDRESS, POST VALUE AND JSB DELIM JMP NXTCM JMP BNDST LOOK FOR NEW PARAMETERS SPC 1 BER1 LDB BER2 ISSUE "IL BND" ERROR JSB DIAG JMP NXTCM AND GET NEXT COMMAND * BER2 DEF *+1 DEC 6 ASC 3,IL BND ***** * ** SET COMMAND PROCESSOR * ***** SETST CLA STA STMP LDA M2 LDB LTABL LOCC OR BPLOCC? JSB SCAN JMP SET01 NO, MUST BE SYM TAB ENTRY ADA RBTA YES, SAVE ADDRESS TO STA STMP PUT VALUE INTO JMP SET02 SET01 JSB BLINE BLANK OUT THE BUFFER LDA LBUFA THEN MOVE NAME TO BUF JSB MOVE. FOR LATER CHECKING SET02 CCA LDB TOTBL LOOK FOR "TO" JSB SCAN JMP CMER NOT FOUND, ERROR JSB NSCAN GET VALUE JMP CMER JMP CMER STA SVAL SAVE VALUE LDB STMP IF SYM TAB ENTRY, SZB,RSS JMP SET03 THEN JUMP TO SET03 STA STMP,I ELSE SET VALUE INTO LOCC JMP NXTCM OR BPLOCC AND GET NEXT COMMAND SET03 LDB LBUFA LOOK FOR SYMBOL IN JSB SSTBL SYMBOL TABLE JMP SET04 NOT FOUND LDA SVAL IF FOUND, STA LST4,I STORE VALUE, JMP NXTCM AND GET NEXT COMMAND SET04 LDA LST5 CHECK CMA,INA FOR ADA OPT.3 SYMBOL SSA TABLE JMP LER5 OVERFLOW LDA SVAL STA LST4,I STORE THE VALUE CLA STA LST5,I INITIALIZE LINK POINTER ISZ LST BUMP ENTRIES COUNTER LDB LBUFA LDA B,I STA LST1,I STORE FIRST 2 CHARS INB LDA B,I STA LST2,I STORE SECOND TWO CHARS INB LDA B,I AND UPCM ZER OUT EXT ID NBR STA LST3,I AND STORE FIFTH CHAR JMP NXTCM THEN GET NEXT COMMAND * STMP NOP SVAL NOP ***** * ** LINKS START AT ** COMMAND PROCESSOR * ***** LNKST CCA LDB STABL JSB SCAN LOOK FOR "START" JMP CMER CCA LDB ATTBL JSB SCAN LOOK FOR "AT" JMP CMER JSB NSCAN GET LINK ADDRESS JMP CMER JMP CMER STA LINKA AND SAVE IT JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER CPA B54 IS IT A COMMA? RSS YES, GOOD JMP CMER NO, ERROR JSB NSCAN GET LINK VALUE JMP CMER JMP CMER STA LINKV AND SAVE IT JSB LSTI INITIALIZE SYMBOL TABLE POINTERS LNK01 JSB LSTP ADVANCE TO NEXT ENTRY JMP NXTCM NO MORE, GET NEXT COMMAND LDB LINKA LDA LST4,I CPA LINKV STB LST5,I JMP LNK01 * LINKA NOP LINKV NOP * ***** * ** NXTC ** GET NEXT NON-BLANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP *-3 YES ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I MD4 DEC -4 ***** * ** LTG ** LEADER-TRAILER GENERATOR * CALLING SEQUENCE: * * JSB LTG * RETURN * ***** LTG NOP LDA .ABR SET (ABREC) INA  = ADDRESS STA ABREC OF ABREC LDB MD46 SET ABREC+1 CLA TO STA ABREC,I ABREC+46 ISZ ABREC = ZERO INB,SZB JMP *-3 STA ABREC CLEAR ABREC LDA MD46 LDB .ABR JSB PCHX JSB IBUFR JMP LTG,I EXIT. * CKS OCT 0 HOLDS COMPUTED CHECKSUM ABL1 DEF ABREC+2 HOLDS CURRENT BUFFER ADDRESS ABL2 DEF ABREC+2 .ABR DEF ABREC MD46 DEC -46 ***** * ** DIAG ** OUTPUT MESSAGES THAT ARE STORED WITH THE CHAR COUNT * IMMEDIATELY PRECEEDING THE BUFFER. * CALLING SEQUENCE: * * LDB ADDRESS OF BUFFER MINUS 1, WHICH CONTAIN BUFFER LENGTH * JSB DIAG * RETURN * ***** DIAG NOP ENTRY: LDB,JSB LDA B,I INB JSB LOUT OUTPUT DIAGNOSTIC JMP DIAG,I RETURN. * * * DIAGNOSTIC OUTPUT SECTION * LER3 LDB ERR03 MEMORY OVERFLOW JMP ERROR * LER4 LDB ERR04 LINKAGE AREA OVERFLOW JMP ERROR * LER5 LDB ERR05 SYMBOL TABLE OVERFLOW ERROR JSB DIAG PRINT DIAGNOSTIC ABORT LDB RAMSG PRINT MESSAGE JSB DIAG FOR RELOCATION ABORTED CLA STA NDATA CLEAR LEADER ALLOWED FLAG STA UEXFL CLEAR UNDEF EXTERNS FLAG STA NAMR. ALLOW A NAM RECORD STA DIRFL DEFAULT IS FOR FORCED INDIRECT JSB LSTI INITIALIZE SYM TAB POINTERS LOOP1 JSB LSTP GO TO NEXT SYM TAB ENTRY JMP PRCMD,I NO MORE, RETURN (P+1) LDA LST3,I CLEAR AND UPCM EXTERNAL STA LST3,I ID NUMBER JMP LOOP1 DO FOR ALL SYM TAB ENTRIES * RAMSG DEF *+1 OCT 6 ASC 3,REL AB * ERR03 DEF *+1 OCT 6 ASC 3,MEM OV * ERR04 DEF *+1 OCT 6 ASC 3,BPG OV * ERR05 DEF *+1 OCT 6 ASC 3,SYM OV * ERR06 DEF *+1 OCT 6 ASC 3,COM OV * ERR07 DEF *+1 OCT 6 ASC 3,DU ENT * * ILBP LDB ILBP. JMP ERROR ILBP. DEF *+1 OCT 6 ASC 3,IL BPL SPC 2 ***** * ** LOUT ** OUTPUT TO TTY * CALLING SEQUENCE: * * LDA POSITIVE # OF CHARS TO OUTPUT * LDB ADDRESS OF BUFFER * JSB LOUT * RETURN * * NOTE: IF USING ASR33 TTY, COMPUTER WILL HALT (70) WHEN * SWITCHING FROM PUNCH TO KEYBOARD MODE. ***** LOUT NOP STA TMP SAVE (A) LDA ASR33 ARE WE USING ASR33 TTY? SZA,RSS JMP NOT33 NO,DO OUTPUT USKBD HLT 70B YES, HALT IF NOT IN KBD MODE STB TMP2 SAVE (B) CLA,INA WHEN SWITCHING TO KEYBOARD MODE, LDB B40 FORCE A CRLF TO COMPENSATE JSB 102B,I FOR INFO ECHOED WHEN PUNCHING LDB TMP2 RESTORE (B) LDA JMPL AFTER THE SWITCH STA USKBD CLEAR THE HALT LDA HLT.P AND SET HALT FOR STA USPCH SWITCH TO PUNCH MODE NOT33 LDA TMP RESTORE (A) JSB 102B,I DO OUTPUT JMP LOUT,I * HLT.P HLT 7B JMPL JMP NOT33 TMP2 NOP * HED *** ROUTINES FOR PROCESSING RECORDS ****** SPC 2 ***** * ** NAM RECORD PROCESSOR *** RIC = 1 * * THIS ROUTINE IS CALLED TO ASSIGN SPACE FOR A PROGRAM * TO BE LOADED. THE NAM RECORD IS MOVED FROM LBUF TO * NBUF BEFORE THIS ROUTINE IS CALLED. * SPECIAL CONVENTIONS APPLY TO FORTRAN AND ALGOL * PROGRAMS. IN A FORTRAN PROGRAM (IDENTIFIED BY 1 IN * SIGN POSITION OF WORD 7 OF NAM RECORD) THE PROGRAM * LENGTH IN WORD 7 MAY BE GREATER THAN THE ACTUAL LENGTH. * THEREFORE THE UPPER BOUND IS NOT SET UNTIL LOADING * OF DATA BLOCKS. ***** NAMR NOP LDA NBUF+10 CHECK BASE PAGE LENGTH SSA JMP ILBP ILLEGAL BASE PAGE LENGTH(<0) LDB NBUF+11 GET COMMON LENGTH. SZB,RSS JMP NM1 NO COMMON LDA FWAC SZA,RSS JMP NM6 ALLOCATE 1ST COMMON CMA,INA ADA LWAC INA STA COML CMB,INB ADB A CHECK FOR COMMON LENGTH OVERFLOW SSB,)RSS JMP NM1 LENGTH GOOD LDB ERR06 COMMON BLOCK ERROR JMP ERROR SPC 2 NM6 STB COML ALLOCATE 1ST COMMON LDA LOCC MOVE PROGRAM RELOCATION BASE UP. STA FWAC ADA COML STA LWAC INA STA LOCC RESET LOCATION COUNTER NM1 LDA BPLOC SET LOWER BOUND OF BASE PAGE AREA STA BPPTR INITIALIZE BASE PAGE POINTER LDA LOCC SET LOWER BOUND OF PROGRAM AREA STA PAPTR INITIALIZE PROGRAM AREA POINTER LDA FWAC STA COMOR LDA NBUF+9 GET PROGRAM LENGTH STA FTNFL SET FORTRAN LOADING FLAG - BIT 15 CPA M1 ALGOL PROGRAM? JMP NAMR,I YES. LIMITS SET DURING LOADING. * * ALLOCATE BASE PAGE STORAGE * LDA NBUF+10 GET BASE PAGE AGAIN SZA,RSS IF NO BP ALLOCATION, JMP NM2 CHECK FOR PROGRAM ALLOCATION. ADA BPLOC COMPUTE LAST LOCATION & STA B CHECK FOR OVERFLOW ADA M1 CMA,INA ADA LWABP SSA NEGATIVE MEANS OVERFLOW JMP LER4 OF BASE PAGE AREA STB BPPTR SET UPPER LIMIT B. P. * * ALLOCATE PROGRAM AREA STORAGE * NM2 LDA NBUF+9 GET PROGRAM LENGTH SZA,RSS IF PROGRAM LENGTH = 0, JMP NAMR,I LDB FTNFL COMPILER-GENERATED? SSB JMP NAMR,I YES,LIMITS SET DURING DBL PROCESSING ADA LOCC COMPUTE HIGH ADDRESS & STA B CHECK FOR OVERFLOW CMA,INA ADA LWAM SSA NEGATIVE RESULT MEANS OVERFLOW JMP LER3 MEMORY OVERFLOW ERROR STB PAPTR SET UPPER BOUND JMP NAMR,I SPC 1 COML OCT 0 HOLDS INITIAL COMMON LENGTH SPC 2 ***** * ** ENT ** EXT RECORD PROCESSORS * * ENT RECORD PROCESSOR (RIC = 2) * EXT RECORD PROCESSOR (RIC = 4) * * PURPOSE OF THIS SECTION IS TO PROCESS ENTRY POINTS * AND EXTERNAL SYMBOLS, ADD SYMBOLS TO THE * LOADER SYMBOL TABLE, AND *  SET A FLAG IF AN ENTRY POINT FROM A LIBRARY * LOAD MATCHES AN UNDEFINED EXTERNAL SYMBOL. * CONTROL RETURNED FROM THIS SECTION TO -LDRIN-. * * WORDS USED FOR TEMPORARY STORAGE: * * LBUF - RECORD TYPE FLAG: 1 = ENT, 0 = EXT * LBUF+1 - NEGATIVE COUNT OF ENT/EXT ENTRIES IN RECORD. * LBUF+2 - FIRST WORD ADDRESS OF CURRENT ENTRY. ***** EXTR CLA,RSS EXT: FLAG=0 ENTR CLA,INA ENT: FLAG=1 STA LBUF SAVE RECORD TYPE LDA LBUF+1 GET AND ISOLATE AND B77 RECORD ITEM COUNT. CMA,INA SET NEGATIVE FOR STA LBUF+1 COUNTER IN PROCESSING LDA LBUFA SET LBUF+2 = ADDRESS OF ADA B3 FIRST ENTRY STA LBUF+2 IN RECORD JSB LSTI INITIALIZE LST PROCESSOR ENTX1 JSB LSTP SET LST ENTRY ADDRESSES JMP ENTX6 END OF LST - MAKE NEW ENTRY * * CHECK LST AND RECORD ENTRIES FOR MATCHING SYMBOLS * LDB LBUF+2 (B) = RECORD ENTRY ADDR. LDA B,I GET WORD 1 REC. ENTRY, CPA LST1,I COMPARE TO WORD 1 LST ENTRY INB,RSS EQUAL, SET FOR WORD 2. JMP ENTX1 NOT =, CHECK NEXT ENTRY LDA B,I CHECK WORD 2 OF CPA LST2,I THE ENTRIES INB,RSS =, SET FOR WORD 3. JMP ENTX1 NOT =, CHECK NEXT ENTRY. LDA B,I CHECK UPPER CHAR XOR LST3,I IN WORD 3. AND UPCM SZA SKIP IF SYMBOLS MATCH JMP ENTX1 NOT =, CHECK NEXT ENTRY. LDA LBUF IF RECORD TYPE SZA,RSS JMP EXT0 IS EXT, GO POST ORDINAL. * * SYMBOL MATCH IN ENT RECORD * LDA UDFE IS ENT DEFINED? CPA LST4,I JMP ENT21 NO. SET VALUE FROM RECORD. LDB SERFG YES, LOADING FROM LIBRARY SZB JMP ENTX5 IGNORE DUPLICATE FROM LIBRARY. LDB ERR07 JSB DIAG COMPLAIN ABOUT DUPLICATE LDB LBUF+2 LDA B5 PRINT "OFFENDING" ENT SYMBOL JSB LOUT JMP ENTX5 * * ADD ENTRY POINT ADDRESS TO 640 LST ENTRY. * ENT21 CLA CLEAR "LIBRARY LOAD" FLAG. STA SERFG ENT22 LDA B,I GET WORD 3 OF RECORD ENTRY STA LST3,I AND STORE IN LST WORD 3. INB GET WORD 4 OF RECORD ENTRY LDB B,I (ENTRY VALUE). CMB NEGATE TO INDICATE UNRELOCATED STB LST4,I SAVE IN LST FOR LATER ACTION. * * ENTRY FROM INPUT LOADING * * * ADVANCE TO NEXT RECORD ITEM * ENTX5 LDB LBUF+2 GET OLD RECORD ENTRY ADDRESS ADB B3 ADD 3 FOR NEXT EXT ENTRY. ADB LBUF ADD ONE MORE FOR ENT RECORD. STB LBUF+2 SET ADDRESS OF NEXT ENTRY. ISZ LBUF+1 INDEX ENTRY COUNT - JMP ENTX1-1 MORE TO PROCESS. JMP LDRIN FINISHED- GET NEXT RECORD. y6* * NO MATCH IN LST FOR RECORD ENTRY SYMBOL - ADD * NEW ENTRY - CHECK FIRST FOR MEMORY CONFLICT. * OPT.3 NOP END OF MEMORY POINTER. * ENTX6 LDA LST5 CMA,INA ADA OPT.3 SSA JMP LER5 OVERFLOW LDB LBUF+2 (B) = RECORD ENTRY ADDR. LDA B,I MOVE WORDS 1 AND 2 OF RECORD STA LST1,I ENTRY TO WORDS INB 1 AND 2 NEW LST ENTRY LDA B,I (WORD 3 WILL BE SET LATER) STA LST2,I INB (B) = ADDR. OF WORD 3, REC. ENTRY LDA UDFE STA LST4,I DENOTE UNDEFINED. CLA STA LST5,I DENOTE NO LINK ASSIGNED ISZ LSTA,I ADD 1 TO LST ENTRY COUNT. LDA LBUF GET RECORD TYPE FLAG SZA JMP ENT22 ENT; GO POST VALUE. EXT0 LDA B,I GET WORD 3 OF RECORD ENTRY, STA LST3,I STORE TO POST EXT ORDINAL. LDA DIRFL FORCED INDIRECT FLAG 0-FORCED INDIRECT SZA 1-MAKE DIRECT LINK IF YOU CAN JMP ENTX5 NON-ZERO, POSTPONE LINK ASSIGNMENT LDA LST5,I HAS A LINK ALREADY BEEN ASSIGNED? SZA JMP ENTX5 YES, CONTINUE PROCESSING LDA LST4,I NO, ALLOCATE ONE CPA UDFE LINK ROUTINE RECOGNIZES UNDEFINED AS CLA 0 IN .A.(VALUE OF SYMBOL PARAM) JSB LINK ALLOCATE THE LINK STB LST5,I AND UPDATE SYMBOL TABLE JMP ENTX5 THEN CONTINUE JMP ENTX5 GO PROCESS NEXT ITEM. * * ER10 LDB LST1,I MOVE SYMBOL INTO STB ER10B ERROR MESSAGE. LDB LST2,I STB ER10B+1 LDB LST3,I STB ER10B+2 LDB ERR10 JSB DIAG LDA NBUF+2 STORE OPCODE ONLY. JMP DBL3 * ERR10 DEF *+1 OCT 21 ASC 6, UNDEF EXT: ER10B BSS 3 DIRFL NOP DIRECT FLAG, 1=DIRECT OPTION, 0=ALWAYS INDIRECT ***** * ** RELEN ** RELOCATE ENTRY POINT ADDRESS * CALLING SEQUENCE: (B) = UNRELOCATED ENT VALUE * (A)=CONTENTS OF LST3(RELOCATIO+N BASE) * JSB RELEN * RETURN: (A) = LINK ADDRESS, IF ANY * (B) = RELOCATED ENT ADDRESS * * PURPOSE: RELOCATES ENT ADDRESS AS DESIGNATED * BY THE RELOCATION FIELD (R) IN BITS * 00-01 OF (LST3). 0 = PROGRAM, 1 = BASE * PAGE, 2 = COMMON, 3 = ABSOLUTE. * ALSO POSTS VALUE IN LINK TABLE. * BITS 07-00 OF (LST3) ARE CLEARED. ***** RELEN NOP ENTRY/EXIT POINT AND B7 GET R-FIELD ADA RBTO ADB A,I RELOCATE SYMBOL VALUE STB LST4,I POST ENTRY VALUE IN LST. LDA LST5,I GET LINK ADDRESS, IF ANY SZA,RSS IS LINK ASSIGNED? JMP RELEN,I NO. EXIT. ADA BPAGA C174 STB A,I YES. POST VALUE IN LINK TABLE. LDA LST5,I RECOVER LINK ADDRESS JMP RELEN,I EXIT SKP ***** * ** LSTI / LSTP ** SYMBOL TABLE ACCESSING SUBROUTINES * * PURPOSE: TO SET IN WORDS LST1 - LST5 THE * ADDRESSES OF THE FIVE WORDS IN AN * ENTRY IN THE LST (LOADER SYMBOL TABLE) * * INITIAL SETUP IS MADE BY THE ROUTINE * -LSTI- THIS SECTION INITIALIZES * THE NEGATIVE COUNT OF THE NUMBER * OF ENTRIES IN THE LST AND SETS LST5 POINTING TO * THE "-1"TH ENTRY. SPC 1 * THE SECTION -LSTP- SETS THE FIVE * ADDRESSES OF THE NEXT LST ENTRY * IN LST1-LST5. IT ALSO INDEXES THE * ENTRY COUNTER. WHEN THE COUNTER = ZERO * EXIT FROM LSTP IS TO P+1 OF THE CALL * AND LST1-LST5 CONTAIN THE ADDRESSES * FOR A NEW ENTRY. IF THE COUNT AFTER * INDEXING IS NOT ZERO, EXIT IS TO * P+2 OF THE CALL. SPC 1 * CALLING SEQUENCE: (P-1) JSB LSTI * (P) JSB LSTP * (P+1) (END OF LST RETURN) * (P+2) (NEXT ENTRY ADDRESSES * SET RETURN) ;OSPC 2 * - INITIALIZER- SPC 1 LSTI NOP LDA LSTA,I GET NUMBER OF LST ENTRIES - SET CMA NEGATIVE THE VALUE + 1. STA LSTPX STORE LDA LSTA SET ADDRESS+1 OF WORD 1 OF FIRST STA LST5 JMP LSTI,I EXIT SPC 2 * - PROCESSOR - SPC 1 LSTP NOP LDA LST5 INA STA LST1 INA STA LST2 INA STA LST3 INA STA LST4 INA STA LST5 ISZ LSTPX INDEX ENTRY COUNTER. ISZ LSTP NOT END OF LST - SET P+2 EXIT JMP LSTP,I -EXIT- TO P+1 IF END OF LST. SPC 2 * LSTA1 DEF LST+1 LSTA DEF LST DEFINE STARTING ADDRESS OF LST LSTPX OCT 0 HOLDS ENTRY COUNTER(NEG. #+1). LST1 OCT 0 LST2 OCT 0 LST3 OCT 0 LST4 OCT 0 LST5 NOP ******************************************************************** * THE BASE PAGE LINKS TABLE (STORED IN BPAGE) * HAS ROOM FOR 1020 WORDS, CORRESPONDING * TO CORE ADDRESSES(OCTAL) 4-1777. * LOCATIONS 0-1 ARE INACCESSIBLE ANYWAY, AND LOCATIONS * 2,3 ARE RESERVED FOR RTS PROGRAM DESCRIPTION RECORDS. * BSS 4 PROTECT AGAINST FWABP<4 * BPAGE BSS 1020 BASE PAGE LINKS TABLE BPAGA DEF BPAGE-4 OFFSET HED DBL RECORD PROCESSING * DATA BLOCK RECORD PROCESSOR (RIC = 3) SPC 2 * THIS SECTION RELOCATES THE LOAD ADDRESS OF A DATA * BLOCK AND RELOCATES AND STORES THE WORDS IN IT. * * A RELOCATION BYTE IS ASSOCIATED WITH EACH * INSTRUCTION OR DATA WORD IN A DBL RECORD. * THIS 3-BIT BYTE CONTAINS ONE OF THE * FOLLOWING RELOCATION INDICATORS: SPC 1 * 000 - ABSOLUTE * 001 - PROGRAM RELOCATABLE * 010 - BASE PAGE RELOCATABLE * 011 - COMMON RELOCATABLE * 100 - EXTERNAL SYMBOL REFERENCE (NO OFFSET) * 101 - TWO-WORD GROUP. WORD 1 CONTAINS OPCODE, * RELOCATION BYTE FOR OFFSET, AND AN OPTIONAL * EXTERNAL SYMBOL ORDINAL. WORD 2 CONTAINS THE * /b OFFSET (ADDRESS). THE RELOCATION BYTE CAN BE: * 00 - PROGRAM * 01 - BASE PAGE * 10 - COMMON * 11 - ABSOLUTE * * THIS SECTION USES THE RELOCATION BASE * TABLE (RBT) TO RELOCATE THE LOAD * ADDRESS AND DATA WORDS. THE RELOCATION * BASES IN THE RBT ARE SET BY THE NAM * RECORD PROCESSOR. THE TABLE IS STRUCTURED * AS: * RBTA DEF *+1 * RBT OCT 0 (ABSOLUTE) * PREL (PROGRAM ORIGIN - FWA) * BPREL (BASE PAGE ORIGIN (FROM ORB) * COMOR (COMMON AREA ORIGIN) * OCT 0 (ABSOLUTE AGAIN) * * IF A FORTRAN GENERATED PROGRAM IS BEING LOADED, * A CHECK FOR MEMORY OVERFLOW IS MADE BEFORE * EACH DBL RECORD IS PROCESSED. IF OVERFLOW OCCURS, * AN IMMEDIATE TERMINATION OF LOADING IS MADE * BY TRANSFERRING TO THE ERROR ROUTINE. OTHERWISE, * THE NEW FWA OF THE MEMORY AREA IS SET AND * LOADING CONTINUES. THE DBL RECORDS FOR A FTN * OBJECT PROGRAM ARE GENERATED IN ASCENDING * ORDER - I.E. THE LOAD ADDRESS OF EACH DBL RECORD * IS LARGER THAN THE PREVIOUS - AND THE LAST DBL * RECORD LOADED IS THE LAST PROGRAM SEGMENT (I.E., * A BSS DOES NOT FOLLOW) SO THE NEW FWA OF AVAIL. * MEMORY IS KNOWN AFTER THE LAST DBL RECORD IS * PROCESSED. ******************************************************************** SPC 2 ***** * ** DBL RECORD PROCESSOR * ***** SPC 2 DBLR LDA LBUF+1 RELOCATE THE ASR 6 DBL AND B3 LOAD XOR B1 ADDRESS STA QGETC SAVE RELOCATION BASE CODE ADA RBTO LDA A,I NOW GET RELOCATED ADDRESS ADA LBUF+3 AND ADD RECORD RELOCATION STA LBUF STORE RELOCATED RECORD ADDRESS STA ABREC+1 STORE ABSOLUTE RECORD ADDRESS. LDA LBUF+1 GET # OF AND B77 INSTRUCTIONS CMA,INA AND MAKE NEGATIVE STA LBUF+1 STORE INSTRUCTION COUNT * * CHECK FOR MEMORY OVERFLOW OF FTN OR ALGOL PGM * CMA,INA RESET WORD COUNT TO POSITIVE. ADA LBUF ADD LOAD ADDR. TO WORD COUNT. LDB FTNFL FORTRAN OR ALGOL PROGRAM? SSB,RSS JMP DBL0 NO. LIMIT CAME FROM NAM REC. LDB QGETC GET RELOCATION CODE SZB PROGRAM RELOCATION BASE? JMP DBL0 NO, CONTINUE PROCESSING STA PAPTR YES, SAVE HIGH MAIN ADDRESS CMA,INA ADA LWAM SSA A NEGATIVE RESULT MEANS OVERFLOW JMP LER3 AND TERMINATION OF LOADING. DBL0 LDA LBUF5 GET ADDRESS OF WORD 5 OF DBL * RECORD (FIRST RELOC. BYTE WORD) STA LBUF+2 IN LBUF+2. DBL1 LDB LBUF+2,I SET RELOCATION BYTE WORD STB LBUF+3 IN LBUF+3. LDA M5 SET BYTE COUNTER STA NBUF = -5 ISZ LBUF+2 SET ADDRESS FOR FIRST DATA WORD. DBL2 LDA LBUF+3 GET RELOC. BYTE WORD - ROTATE ALF,RAR 3-BIT BYTE FOR NEXT INSTR. TO STA LBUF+3 LOW A AND RESTORE WORD. AND B7 ISOLATE BYTE. CPA B4 IF BYTE = 4, THEN GO TO EXTERNAL JMP DBL4 REFERENCE SECTION. CPA B5 IF BYTE = 5, THEN GO TO 2-WORD JMP DBL6 MEMORY REFERENCE GROUP SECTION. ADA RBTA BYTE = 0-3. ADD ADDR. OF RBT LDA A,I TO BYTE AND GET BASE VALUE. ADA LBUF+2,I ADD DATA WORD TO RELOCATION BASE DBL3 JSB PACK ISZ LBUF+1 INDEX DATA WORD COUNT JMP DBL9 MORE IN RECORD. JSB PUNCH OUTPUT THE ABSOLUTE RECORD. JMP LDRIN PROCESS NEXT INPUT RECORD. * DBL9 ISZ LBUF ADD 1 TO LOAD ADDRESS. ISZ LBUF+2 ADD 1 TO RECORD ADDRESS ISZ NBUF INDEX REL-BYTE COUNTER JMP DBL2 MORE BYTES IN WORD JMP DBL1 GET NEXT BYTE WORD. * * * RELOCATION BASE TABLE ( RBT ) * * THE ORDER OF THESE ENTRIES MUST BE MAINTAINED RBTO DEF LOCC RBTA DEF B0 B0 NOP ABSOLUTE RELOCATION BASE LOCC NOP PRaOGRAM RELOCATION BASE BPLOC NOP BASE PAGE RELOCATION BASE COMOR OCT 0 COMMON RELOCATION OCT 0 ABSOLUTE * * CODE 4: ADDRESSABLE INSTRUCTION OR DEF REFERENCING * AN EXTERNAL SYMBOL (WITHOUT OFFSET). ADDRESSABLES * USE PRIOR LINK AS FIRST CHOICE SO AS TO RE-USE * LINKS OUT OF CURRENT AREA. DEFS USE DIRECT ADDRESS * AS FIRST CHOICE. * DBL4 LDA LBUF+2,I GET INSTR. WORD STA NBUF+2 SAVE IT JSB ORDSR SEARCH FOR EXT ORDINAL LDA NBUF+2 AND C074 GET OPCODE SZA,RSS DEF? JMP DBL45 YES. USE VALUE IF DEFINED. LDB LST5,I GET LINK ADDRESS SZB IS LINK ASSIGNED? JMP DBL46 YES. USE IT. DBL45 LDB LST4,I GET VALUE CPB UDFE DEFINED? CLA,RSS NO. JMP DBL10 YES, LINK MAY NOT BE NEEDED LDB LST5,I GET LINK ADDRESS SZB,RSS IS LINK ASSIGNED? JSB LINK NO. GET ONE. STB LST5,I SAVE LINK ADDRESS. DBL46 LDA NBUF+2 GET INSTRUCTION SSA FORWARD REFERENCES INDIRECTLY TO JMP ER10 EXTERNALS ARE NOT YET SUPPORTED. AND C174 REMOVE EXT ORDINAL IOR C1000 SET FOR INDIRECT IOR B COMBINE ADDRESS JMP DBL3 GO STORE INSTRUCTION * DBL10 CLA STA RTMP1 SET UP RTMP FOR NO LINK CASE JSB SPLIC BUILD INSTR,ALLOC LINK IF LDB RTMP1 NEEDED,AND STORE VALUE SZB (IF NOT ZERO) STB LST5,I IN SYMBOL TABLE ENTRY JMP DBL3 * RTMP1 NOP * ORDSR NOP AND B377 ISOLATE EXT ORDINAL STA NBUF+1 SAVE ORDINAL SZA,RSS EXT PRESENT? JMP ORDSR,I NO. EXIT. JSB LSTI INITIALIZE LST PROCESSOR DBL5 JSB LSTP SET LST ENTRY ADDRESSES. JMP ILEXT ORDINAL MUST EXIST LDA LST3,I GET WORD 3 OF LST ENTRY, ISOLATE AND B377 BITS 07-00, AND COMPARE VALUE TO CPA NBUF+1 SAVED EXT ORDINAL RSS R JMP DBL5 NOT FOUND, KEEP SEARCHING LST LDA LST4,I FOUND SSA,RSS IS IT REALLY AN EXT ID #? JMP ORDSR,I YES, RETURN JMP DBL5 NO, KEEP LOOKING * * CODE 5: 2-WORD GROUP FOR MEMORY REFERENCE OR * EXTERNAL REFERENCE WITH OFFSET. * DBL6 LDA LBUF+2,I GET WORD 1 (OP-CODE,REL. BYTE) STA NBUF+2 SAVE IT RAR,RAR JSB ORDSR ANY EXTERNAL? ISZ LBUF+2 POINT AT OFFSET LDB LBUF+2,I GET OFFSET LDA NBUF+2 GET WORD 1 AND B3 SAVE REL BYTE ADA RBTO ADB A,I RELOCATE OPERAND LDA NBUF+1 SZA,RSS ANY EXTERNAL? JMP DBL62 NO. LDA LST4,I CPA UDFE IS EXTERNAL DEFINED? JMP ER10 NO. COMPLAIN. ADB LST4,I YES, ADD VALUE. DBL62 JSB SPLIC JMP DBL3 STORE IT. ***** * ** SPLIC ** * * THIS ROUTINE COMBINES OPCODES WITH ADDRESSES IN * ADDRESSABLE INSTRUCTIONS. BASE PAGE LINKS ARE USED * AS REQUIRED TO HANDLE PAGE CROSSINGS. ***** SPLIC NOP LDA NBUF+2 RECOVER OPCODE AND C174 STA NBUF+2 SAVE INSTRUCTION RAL,CLE,SLA,ERA IF INSTR IS INDIRECT, SET ADB C1000 INDIRECT BIT IN ADDRESS. SZA,RSS ADDRESSABLE INSTRUCTION? JMP DBL6B NO. GO STORE VALUE. C074 STB A GET OPERAND ADDRESS AND C076 GET PAGE ADDRESS SZA,RSS IN BASE PAGE? JMP DBL8 YES. XOR LBUF COMPARE WITH LOAD ADDRESS AND C076 SAVE MODULE/PAGE ADDRESS. SZA,RSS JMP DBL7 OPERAND IS IN SAME PAGE. LDA B DIFFERENT: (A)_OPERAND ADDRESS JSB LINK GET BASEPAGE LINK STB RTMP1 SAVE LOCATION OF LINK * POTENTIAL LOSSAGE HERE! LDA NBUF+2 (B) =LOCATION OF LINK,(A) = INSTR. IOR C1000 SET INDIRECT BIT DBL6B IOR B COMBINE ADDRESS JMP SPLIC,I * * OPERAND IN SAME PAGE AS INSTRUCTION. * DBL7 LDA B c GET OPERAND ADDRESS AND AMASK ISOLATE PAGE AREA ADDRESS. IOR B2000 SET Z BIT = 1 (CURRENT PAGE) DBL7A IOR NBUF+2 COMBINE OPCODE, IND JMP SPLIC,I * * REFERENCE TO BASE PAGE OPERAND * DBL8 LDA B GET OPND JMP DBL7A * ILEXT LDB ILEX1 OUTPUT "IL EXT" ERROR JMP ERROR * * CONSTANT AND STORAGE SECTION FOR -DBLR-. * ILEX1 DEF *+1 OCT 6 ASC 3,IL EXT ASC 3,IL.EXT M5 OCT -5 B377 OCT 377 AMASK OCT 101777 SAVE INDIRECT C076 OCT 76000 B2000 OCT 2000 LBUF5 DEF LBUF+4 * SKP ***** * ** LINK ** ALLOCATE LINK WORD * * PURPOSE: TO SEARCH BASE PAGE LINK TABLE * FOR AN EXISTING OPERAND ADDRESS MATCHING * THE PARAMETER OPERAND AND TO ALLOCATE * A WORD TO CONTAIN THE OPERAND ADDRESS * IF A MATCH IS NOT FOUND. SPC 1 * THE OPERAND ADDRESS PARAMETER IS STORED * IN THE LINKAGE WORD IF A MATCH IS NOT * FOUND IN THE LINKAGE AREA. SPC 1 * THE OPERAND ADDRESS PARAMETER IS IN * THE A-REGISTER ON ENTRY TO LINK. THE * LOCATION OF THE WORD IN THE LINKAGE * AREA CONTAINING THE OPERAND IS RETURNED * TO THE CALLER IN THE B-REGISTER. * * ENTRY: (A) = OPERAND ADDRESS FOR SEARCH THRU LINKS * TABLE(BPAGE), OR 0 IF VALUE IS UNDEFINED * AND THE ALLOCATION OF A LINK IS TO BE * FORCED. * SPC 2 LINK NOP ENTRY/EXIT POINT STA LINK3 SAVE OPERAND LDB BPPTR GET HIGHET BASE PAGE LOC STION SZA IS THE LINK AREA TO BE SEARCHED? LDB FWABP YES,START AT BOTTOM LINK1 CPB BPPTR HAS ENTIRE LINK AREA BEEN SEARCHED? JMP LINK2 MATCH, GOTO ALLOCATE WORD. LDA B ADA BPAGA LDA A,I GET LINK WORD CPA LINK3 MATCH? JMP LINK,I YES INB JMP LINK1 SPC 2 LINK2 STB A CMB,INB ADB LWABP OVERFLOW? SSB JMP LER4 YES NO LINK ROOM. ADA BPAGA GET ADDRESS IN BASE PAGE LINK TABLE LDB LINK3 STORE VALUE STB A,I IN THERE LDB BPPTR RETURN WITH LINK ADDRESS IN (B) ISZ BPPTR INCREMENT BASE PAGE BOUND JMP LINK,I EXIT WITH LINK ADDRESS IN (B) LINK3 NOP TEMP FOR OPND ADDRESS HED **** RECORD PROCESSING CONTROL ****** ******************************************************************** * THIS SECTION CONTROLS THE INPUT OF OBJECT * PROGRAMS FROM THE STANDARD INPUT AND PROGRAM * LIBRARY DEVICES. THE TRANSFER OF CONTROL TO * THE APPROPRIATE RECORD PROCESSORS IS MADE * FROM THIS SECTION. EACH PROCESSOR (EXCEPT * NAM PROCESSOR) RETURNS TO THE LABEL -LDRIN-. * * INPUT RECORD, LEGALITY CHECK AND CHECKSUM SECTION ******************************************************************** EOFT LDA RIC LEADER? SZA JMP NXTCM TRAILER; END OF FILE LDRIN LDA RIC WAS LAST RECORD AN END RECORD? CPA B5 JMP NXTCM GET NEXT COMMAND INCHK JSB RBIN GET NEXT RELOCATABLE RECORD SZA,RSS EOT? JMP EOFT END OF FILE. RBR,SLB,RBR WAS THERE A MT PARITY ERROR? JMP LER1 YES. RBR,RBR SHIFT THE TIMING BIT TO 0. SLB WAS THERE A MT TIMING ERROR? JMP LER1 YES. * * CHECK RECORD LEGALITY * LDA LBUF+1 GET WORD 2 OF RECORD, ALF,RAR ROTATE RIC FIELD TO AND B7 LOW A AND ISOLATE CODE. STA RIC SAVE CODE FOR PROCESSING. SZA IF RIC = 0, SKIP ADA M6 SUBTRACT 6 TO TEST FOR 1 TO 5. SSA,RSS IF RESULT IS POSITIVE OR JMP LER2 ZERO, ERROR. ILLEGAL RECORD. * * LEGAL RECORD - COMPUTE AND CHECK CHECKSUM * LDA LBUF GET NEG. #DATA WORDS. STA CONV ADA B3 SET UP COUNTER SSA,RSS (PROTECTION AGAINST JMP LER1 LT 4 WORD VRECORD.) STA LBUF SET COUNTER LDB LBUFA SET B = ADDRESS ADB B3 OF WORD 4. LDA LBUF+1 START CKSM WITH I. D. WORD ADA B,I ADD INB REMAINING ISZ LBUF WORDS IN JMP *-3 RECORD - SUM IN A CPA LBUF+2 COMPARE WITH RECORD CHECKSUM JMP LDRC EQUAL, ASSUME RECORD GOOD. SPC 2 * CHECKSUM ERROR SPC 1 LER1 LDB ERR01 CHECKSUM ERROR RSS LER2 LDB ERR02 ILLEGAL RECORD CODE (RIC). JSB DIAG JSB BUMSG BACKUP? JMP ABORT NO, ABORT RELOCATION JMP INCHK YES READ NEXT RECORD * BUASC DEF *+1 OCT 7 ASC 4,BACKUP? ***** * ** BUMSG ** HANDLE RECOVERABLE ERRORS WITH 'BACK UP' OPTION * CALLING SEQUENCE: * * JSB BUMSG * RETURN1 ANSWER WAS 'NO' * RETURN2 ANSWER WAS 'YES' * ***** BUMSG NOP BMSG1 LDB BUASC PRINT JSB DIAG "BACKUP?" LDB QBUFA GET LDA D72 INPUT JSB 104B,I FROM STA QQCHC TTY CLA STA QQCNT RESET COUNTER LDA QBUFA AND RESET STA QQPTR BUFFER POINTER LDA M2 LOOK FOR LDB ATABL "YES" OR "NO" JSB SCAN IS INPUT A KEYWORD? JMP BMSG1 NO,ASK AGAIN CPA B1 ISZ BUMSG YES, EXIT (P+2) JMP BUMSG,I NO, EXIT (P+1) * SPC 2 * PROCESS VALID RECORD LDRC ISZ NREC BUMP COUNT # GOOD RECORDS. LDA RIC (A) = RECORD TYPE LDB SERFG (B) = LIBRARY LOAD FLAG CPA B1 IF RIC = 1, THEN GO TO PROCESS JMP LDRC3 NAM RECORD. SSB,RSS JMP SERJP IF LOADING, CONTINUE PROCESSING CPA B5 IF NOT LOADING, RSS AND IF THIS IS AN END RECORD, JMP INCHK LDA SERNM AND IF THIS IS THE NAMED MODULE SSA IN A SEARCH (NAME) COMMAND JMP NXTCM THEN GET THE NEXT COMMAND JMP INCHpB@ LWAM * CLEAR RTS BP AREA LDA SYMAD GET START OF SYS MEMORY ADA N1 ADJUST FOR LWAM RSS SETA1 LDA TEMP3 DEFAULT TO LWAM STA .MEM4 UPPER LOAD BOUNDS * SET PRIV CHAN IN BP LDA PIOC PRIV. INT CHANNEL STA SETAD,I PUT IN BUFFER LDA DUMMY ADDRESS WHERE TO GO IN BP LDB A JSB SETCR GO SET IT IN BP * GO REL SYS MODULES JSB SPACE NEW LINE LDA P12 PRINT: LDB MES2 "REL SYS MODS" JSB AOTLY,I PRINT * RELOCATE FROM RTS/2100 LOADER LDA LWAM SET START OF INT PROG NAME TBL STA OPT.3 LAST ADDRESS OF LST STORAGE LDA P2 STA .XFER NON ZERO TO LOAD SYS MODULES JSB CLBPL CLEAR BASE PAGE LINKS STA PNAME CLEAR NAME FLAG STA LOCC CLEAR LOCC IN LOADER STA BPLOC SAME FOR BPLOC JSB PRCMD GO RELOCATE SYS MODULES JMP BEGIN ERROR FROM LOADER, TRY AGAIN LDA LOCC UPDATE FWAM STA .MEM3 FWAM LDA BPLOC UPDATE FWABP STA .MEM1 LDA LST STA LSTSV SAVE FOR RELOCATION ERROR LDA UEXFL WERE THERE ANY UNDEFINED? SZA,RSS JMP *+4 NO CONTINUE RELSE LDA ERR33 YES,PRINT: JSB ERROR "ERR AD" JMP BEGIN START RTSGN OVER LDB A$STR JSB SSTBL WAS $STRT LOADED? JMP RELSE NO, ERROR, LDA LST4 YES, GET STARTING ADDRESS LDA A,I STA STRAD SAVE IT FOR CLEAN-UP AT END OF RTSGN LDB A$CIC $CIC NAME JSB SSTBPL WAS $CIC LOADED? JMP RELSE NO, ERROR, START OVER LDA LST4 BUILD A BP LINK FOR $CIC LDA A,I STA SETAD,I OUTPUT BP LINK LDA .MEM1 FOR $CIC LDB A JSB SETCR LDB LST5 LDA .MEM1 STA A$CIA SAVE FOR JSB INSTRUCTION STA B,I ISZ .MEM1 BUMP TO NEXT LINK JMP AGNIO,I YES, GO BUILD I/O TABLES * * * * NUMERICAL INPUT CONTROL * * THE DOCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., TBG CHANNEL NO., AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB DOCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * DOCON NOP JSB AGETO,I GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB AGETA,I GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB INERR INVALID DIGIT ENTRY JMP DOCON,I RETURN ISZ DOCON INCR RETURN ADDRESS LDA OCTNO GET CONVERTED NUMBER JMP DOCON,I RETURN SKP * * INVALID TTY RESPONSE * * THE INERR SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INERR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INERR NOP LDA ERR10 SET INVALID DEVICE ERROR CODE JSB ERROR PRINT ERROR MESSAGE JMP INERR,I RETURN * * " CLEAR BASE PAGE LINKS * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CLBPL * * * RETURN: A IS CLEARED, B IS DESTROYED * * CLBPL NOP LDA N1020 CLEAR STA WDCNT BASE PAGE CLA LDB BPAG4 LINKAGE STA B,I AREA INB FOR LOADER. ISZ WDCNT JMP *-3 JMP CLBPL,I ALL DONE, RETURN SKP * * ALPHABETIC INPUT CONTROL * * THE SINIT SUBROUTINE ANALYZES THE RESPONSE FOR THE PROGRAM, * LIBRARY, AND PARAMETER INPUT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SINIT * * RETURN: * (N+1): AN INVALID SET OF CHARACTERS (NOT 1(TTY),5(PTR)) * OR NO. OF CHARACTERS HAS BEEN DETECTED. * AFTER PRINTING THE DIAGNOSTIC, A RETURN IS MADE TO * PERMIT THE MESSAGE TO BE REPEATED. THE CONTENTS * OF A AND B ARE DESTROYED. * (N+2): A = ADDRESS OF DESIGNATED INPUT DRIVER * B = DESTROYED * SINIT NOP CLA,INA SET MAX NO. DIGITS FOR GETNA JSB AGETN,I MOVE LBUF TO TBUF JSB AGETA,I GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE CODIN JSB INERR INVALID TTY RESPONSE JMP SINIT,I RETURN - ERROR LDA TBUF GET 2-CHARACTER CODE CPA TYTYP TYPE = TTY? JMP TYUN YES - UNIT IS TELETYPE CPA PTTYP TYPE = PT READER? JMP PTUN SET UNIT = PT READER JMP CODIN INVALID PT, MT OR TY TYUN LDA DRTTY DRTTY = TTY INPUT DRIVER ADDRESS RSS PTUN LDA DRPTR DRPTR = PT READER DRIVER ADDR PT.DV ISZ SINIT INCR RETURN ADDRESS JMP SINIT,I RETURN * TYTYP OCT 61 PTTYP OCT 65 * MES27 DEF MS27 MES34 DEF SYMES SYMES ASC 6,FWA SYS MEM? MS27 ASC 4,FWA BP? MESS3 DEF *+1 ASC 5,LWA MEM? MESS6 DEF *+1 ASC 5,PRAM INPT?  MES30 DEF *+1 ASC 5,TBG CHNL? A$STR DEF *+1 ASC 3,$STRT A$CIC DEF *+1 ASC 3,$CIC * * ERPNT NOP PRINT CONTENTS OF LBUF LDB PARAD GET ADDRESS OF PARAMETER UNIT CPB DRTTY DEVICE = TTY? JMP *+4 YES - OMIT PRINTING ON TTY LDA PARNO PARNO = PARAMETER RECORD LENGTH LDB ALBUF ALBUF = BUFFER ADDRESS JSB DRKEY,I PRINT PARAMETER RECORD JMP ERPNT,I RETURN HED RTSGN GENERATE I/O TABLES A-29101-60007-1 REV.B ORR * * GENERATE I/O TABLES * * THIS SECTION OF CODE GENERATES THE I/O TABLES * FOR THE SYSTEM. THESE INCLUDE THE EQUIPMENT TABLE (EQT), * STANDARD DEVICE REFERENCE TABLE (DRT), AND INTERRUPT TABLE. * * THE EQT RECORDS HAVE THE FOLLOWING FORMAT: * * N1,DVRN2<,D><,B><,T=> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * * IF T= IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST NEXT BE ENTERED. * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN OPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE k`ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) * * GENIO CLA STA IDNOS ID'S MADE STA STRPN START UP PROGRAM FLAG STA CEQT NOS OF EQT'S STA PROCT NOS OF INT PROG ENTRIES JSB SPACE NEW LINE LDA .MEM3 FWAM STA AEQT EQT STARTING ADDRESS STA PPREL LDA P7 PRINT: LDB MES25 "EQT TBL" JSB AOTLY,I JSB SPACE NEW LINE * SEQT JSB SPACE LDA CEQT EQT COUNT INA LDB MES6A STUFF INTO PRINT BUFFER JSB STFNM LDA P9 PRINT: LDB MES6 "EQT XX =?" JSB AREAD,I AND INPUT DRIVER REQUEST LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA PTERM CHARS= END ? JMP SSQTI YES, TRY TO END CPA REQT REPEAT? JMP GENIO YES * JSB GINIT INITIALIZE BUFFER SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,U IOERR LDA ERR24 SET CODE = INVALID CHNL IN EQT JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * DVERR LDA ERR25 SET CODE = INVALID DRIVER NAME JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * CLDBU LDB OCTNO GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS ADB N8 IS CHANNEL EQ. LESS SSB,RSS "w THAN 10? JMP GOOD NO-CONTINUE ADB P4 YES--TEST=4 SZB SC FOR POWER FAIL? JMP IOERR NO, CHANNEL ERROR GOOD CLA STA TIMWD CLEAR TIME WORD STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG ISZ CHNGE NEED TO RESET ENTRY POINT NAMES?? JMP NORM LDA CDEC FETCH ASCII C. STA ASCDR+1 RESET COMP NAME ADA B3000 CREATE ASCII I. STA ASIDR+1 RESET INIT. NAME NORM CCA STA TFLAG CLEAR TIME-OUT FLAG LDA N2 JSB GETNA MOVE TWO CHAR TO TBUF CPA CHADV CHAR=DV RSS YES CONTINUE JMP DVERR INVALID DRIVER NAME CLA,INA SET UP FOR CALL TO GETNA JSB GETNA MOVE CHAR 3 TO TBUF CPA CHA.R CHAR=R JMP STYPE YES GET DRIVER NAME IOR C0 OR IN C-BLANK STA ASCDR+1 SET UP ENTRY POINT NAME ADA B3000 SET UP IYXX STA ASIDR+1 SET ENTRY POINT NAME CCA SET ENTRY POINT RESET FLAG STA CHNGE * STYPE LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF STA ASTYP SAVE 2 ASCII CHARS FOR I.XX,C.XX STA ASCYP SAVE FOR C.XX COMPARE CCA ADA CURAL ADJUST CURRENT LBUF ADDR STA CURAL RESET CURAL TO CONVERT TYPE LDA P2 JSB GETOC GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME LDB OCTNO GET DRIVER TYPE BLF,BLF ROTATE TO UPPER B STB IOTYP SET DRIVER TYPE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * CCA STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG * INDBU CCA STA CMFLG SET COMMA FLAG = NO COMMA IN JSB GETAL GET NE`XT CHAR FROM LBUF CPA CHARD CHAR = D? JMP SEDMA YES - SET DMA CODE CPA CHARB CHAR = B? JMP SETBU YES - SET BUFFERING CODE CPA CHART CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG UNERR LDA ERR10 SET CODE = INVALID D,B,T JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED JSB GETAL GET NEXT CHAR CPA AEQUL IS IT "=" ? RSS YES ACCEPT TIME VALUE JMP UNERR NO, ITS AN ERROR LDA N5 5 CHAR VALUE JSB GETOC FETCH TIME OUT TIME JMP UNERR NUMBER IS NO GOOD SZA WAS ZERO INPUT? CMA ONE'S COMPLEMENT FOR THAT RTS STA TIMWD SAVE FOR OUTPUT EQTST JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED LDA BIT14 SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * LISCN LDB ASIDR ADDRESS OF I.XX BUFFER JSB SSTBL IS IT IN THE SYMBOL TABLE? JMP DVERR NO LDA LST4 YES, GET THE ADDRESS LDA A,I STA I.XX SAVE FOR OUTPUT LDB ASCDR ADDRESS OF C.XX BUFFER JSB SSTBL IS IT IN SYMBOL TABLE? JMP NOCXX NO, USE ADDRESS OF I.XX LDA LST4 YES, GET ADDRESS LDA A,I STCXX STA C.XX SAVE DRIVER EXIT POINT * LDB ALBUF CLEAR OUTPZUT BUFFER JSB BUFCL OCT 0 LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. STA LBUF+3 OUTPUT BUFFER LDA I.XX STA LBUF+1 INT. ADDRESS LDA C.XX STA LBUF+2 COMPLETE ADDRESS * LDA IOTYP GET EQUIPMENT TYPE CODE AND M7000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,I CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE STA LBUF+4 LDA TIMWD WAS A TIME INPUT ? SZA STA LBUF+13 YES, SAVE IT IN EQT LDA PPREL GET CURRENT EQT ADDRESS LDB A ADB P14 ADDRESS OF END OF EQT STB PPREL JSB SETCR OUTPUT IN ABS ISZ PPREL BUMP TO NEXT EQT ENTRY ISZ CEQT INCR EQT ENTRY COUNT JMP SEQT PROCESS NEXT EQT RECORD * SPC 1 NOCXX LDA I.XX C.XX NOT FOUND SO USE JMP STCXX I.XX ADDRESS * SSQTI LDA CEQT ANY EQT'S BEEN LOADED? SZA JMP SSQT YES, CAN END LDA ERR10 NO,AT LEAST ONE REQUIRED JSB ERROR PRINT: "ERR PA" JMP SEQT START OVER * * * * SET DEVICE REFERENCE TABLE (SQT) * SSQT JSB SPACE NEW LINE LDA CEQT GET NO. OF EQT'S ALF MULT X16 LDB CEQT NO. OF EQT'S CMB,INB ADA B SUB. FOR X15 ADA .MEM3 ADD ORIG REL ADDRESS STA PPREL UPDATE REL ADDRESS STA ASQT SAVE SQT ADDRESS CLA,INA STA CSQT SET SQT COUNT = 1 LDA P13 LDB MES26 MES26 = ADDR: *DEV REF TABLE JSB AOTLY,I PRINT: * DEVICE REFERENCE TABLE * DEVRE LDA CSQT GET CURRENT DEV REF NO. LDB MES28 JSB STFNM STUFF NUM IN BUFFER JSB SPACE NEW LINE LDA P11 LDB MES28 MES28 = ADDR: XX = EQT #? JSB 6kAREAD,I GET SQT RECORD FROM TTY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA PTERM CHARS = /E? JMP SINTI YES - SET INTERRUPT TABLE CPA RDRT REPEAT DRT? JMP SSQT YES, START OVER CPA REQT REPEAT EQT? JMP GENIO YES, GO BACK JSB GINIT RE-INITIALIZE LBUF SCAN LDA N3 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP NOSUB IGNOR SUBCHANNEL LDA CMFLG COMMA ENCOUNTERED? SZA YES - GO GET SUBCHANNEL JMP NOSUB NO - DEFAULT IT TO ZERO INA JSB GETOC GET ONE OCTAL DIGIT JMP DRERR JSB GETAL GET NEXT CHAR CPA ZERO END OF BUFFER? RSS YES JMP DRERR NO, SHOULD BE BUT ISN'T LDA OCTNO GET SUB CHANNEL RSS SKIP OVER DEFAULT NOSUB CLA DEFAULT TO ZERO STA TEMPS SAVE SUB CHANNEL ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 13 - 11 STA TEMPH SAVE SUBCHANNEL NO. LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? RSS YES - CONTINUE JMP SETQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. CMA,INA COMPLEMENT CURRENT DEV. REF. NO. LDB AEQT GET ADDRESS OF EQT INA,SZA,RSS SKIP - DEV. REF. NOT 1 JMP *+4 SET TTY CHANNEL NO. = FIRST EQT ADB P15 ADJUST CURRENT EQT ADDRESS INA,SZA SKIP - EQT FOUND JMP *-2 CONTINUE CURRENT EQT SEARCH  STB LBUF+1 SET EQT ADDR IN TTY CHANNEL LDA TBCHN TBG CHANNEL STA LBUF PUT IN OUT PUT BUFFER LDA TBG ADDRESS WHERE TO GO LDB SYSTY JSB SETCR OUTPUT IN ABSOLUTE * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. STA LBUF FOR OUTPUT LDA PPREL ABS ADDRESS LDB A JSB SETCR GO BUILD ABS DATA ISZ PPREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT JMP DEVRE GET NEXT SQT ENTRY DRERR LDA ERR27 SET CODE = INVALID DEV. REF. NO. JSB ERROR PRINT DIAGNOSTIC JMP DEVRE REPEAT INPUT * TEMPL NOP TEMPH NOP TEMPS NOP * SINTI LDA CSQT HAVE ANY DRT'S BEEN ENTERED? ADA N1 STA CSQT SSA,RSS JMP SINTT YES, GO TO INT PROCESSING JMP DRERR NO, ERROR , START OVER * SKP * ROUTINE TO INPUT TO BUFFER FROM TTY * * READ NOP JSB LOUT LDA WONLY WRITE ONLY FLAG SZA,RSS WRITE ONLY REQUEST? JMP *+4 NO CLA STA WONLY CLEAR WONLY JMP OTNLY,I LDA P64 LDB ALBUF GET ADDRESS OF LBUF JSB PARAD,I ENTRY FROM TTY SZA,RSS SKIP - DATA INPUT JMP *-4 REPEAT INPUT STA PARNO INA CLE,ERA ADA ALBUF BUILD ADDRESS OF NEXT CLB STB A,I RESTOR WITH BLANK (0) JSB ERPNT CHECK FOR ECHO OF INPUT JSB GINIT INITIALIZE LBUF SCAN JMP READ,I RETURN * * * * OUTPUT ONLY ROUTINE * OTNLY NOP STB WONLY SET THE WRITE ONLY FLAG JMP READ+1 * HED RTSGN I/O TABLE GENERATION ROUTINES A-29101-60007-1 REV.B * * GET CHAR FROM LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * GETNA AND GETOC. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB G)B@ OR = CURRENT TIME FSB TSTIM SSA JMP INSRT ENTRY TIME < CURRENT TIME ORDR2 DLD TMPAR ENTRY TIME > CURRENT TIME FSB ENPTR,I SSA JMP INSRT GIVEN TIME < ENTRY TIME JMP NEXT GIVEN TIME > OR = ENTRY TIME ORDR1 DLD ENPTR,I FSB TSTIM SSA JMP ORDR2 ENTRY TIME < CURRENT TIME JMP NEXT GIVEN TIME > CURRENT TIME * ** HERE TO INSERT NEW ENTRY AT TSPTR * INSRT DLD TMPAR SET UP DST TSPTR,I TIME PART OF ENTRY LDB TSPTR ADB B2 SET UP LDA SNPAR SEQUENCE NUMBER STA 1,I PART OF ENTRY LDA TSNXT UPDATE STA 1 TSNXT POINTER ADA B3 STA TSNXT CPB TSPTR CHECK IF NEW ENTRY NEXT TO EXEC RSS YES JMP INSR1 NOS MAKE TRAP ENTRY NOW * ** HERE IF NEW ENTRY WILL EXECUTE NEXT * DLD TSTIM GET NEW FSB TSPTR,I MINUS TIME TILL NEXT EXECUTION SZA,RSS IF TO GO NOW, JMP INSR3 ALLOW TSCNT TO BE ZERO SSA IF POSITIVE JMP INSR3 FSB FLDAY SUBTRACT ONE DAY INSR3 DST TSCNT THEN SET UP COUNTER WITH NEW VAL * ** HERE TO MAKE TRAP TABLE ENTRY * INSR1 LDA SNPAR JSB FINDS DOES A TRAP ENTRY ALREADY EXIST JMP INSR2 NO, MAKE ONE LDB TRPTR YES, SET ENABLE BIT INB  LDA 1,I IOR BIT15 STA 1,I JMP BSCED,I RETURN INSR2 LDA SNPAR SET UP STA SEQNO SEQUENCE NUMBER CLA STA TRPNO TRAP NUMBER (DEFAULT = 0) LDA D99 STA PRINO PRIORITY (DEFAULT = 99) JSB TRMAK MAKE TRAP TABLE ENTRY RSS NO ROOM JMP BSCED,I DONE, RETURN LDA AD2 JSB BSERR JMP BSCED,I TRNOE LDA AD5 TIME SCHED TABLE FULL JSB BSERR JMP BSCED,I SKP ***** * ** TIMCK ** ROUTINE TO CHECK TIME SCHED TABLE * * JSB TIMCK * RETURN * ***** * TIMCK NOP JSB TIME SAVE DEF *+2 DEF TIMT1 CURRENT TIME TIMC3 FSB TSTIM GET-TIME ELAPSED FROM LAST CHECK SSA,RSS CORRECT JMP TIMC4 FOR CHANGE FAD FLDAY OF DAY TIMC4 FAD TSCNT UPDATE SECONDS TO EXECUTION DST TSCNT SSA,RSS HAS THAT TIME ELAPSED? JMP TIMC1 YES DLD TIMT1 NO, UPDATE TIME OF LAST CHECK DST TSTIM JMP TIMCK,I AND RETURN * ** HERE IF TASK AT TOP IS TO BE SCHEDULED * TIMC1 LDB TSNXT ADB M1 LDA 1,I GET SEQ NBR ADB M2 BACK UP TSNXT TO STB TSNXT DELETE ENTRY JSB FINDS LOOK FOR ENTRY WITH THAT SEQ NBR JMP TIMCE NOT FOUND LDB TRPTR LDA 1,I FOUND, IOR BIT15 SET TRAP BIT STA 1,I STA TRFLG SET UP TO POLL TABLE * ** HERE TO SET UP NEXT ENTRY * LDB TSNXT SET POINTER ADB M3 TO NEXT STB TSPTR ENTRY DLD TSTIM USE OLD VALUE OF CURRENT TIME FSB TSPTR,I SINCE THIS TASK MAY HAVE TO BE SSA EXECUTED NOW ALSO JMP TIMC2 FSB FLDAY IF POSITIVE, SET UP FOR TOMORROW TIMC2 DST TSCNT SET UP NEW COUNTER DLD TIMT1 GET REAL CURRENT TIME VALUE JMP TIMC3 AND TRY AGAIN TIMCE LDA AD6 JSB BSERR JSB .STOP SKP ******************* PRIORITY STACK ************** * PRSTK DEF *+1 POINTER TO FIRST ENTRY D100 DEC 100 FIRST ENTRY IS PRIORITY 100 BSS 21 ALLOW 21 ACTUAL ENTRIES PREND DEF * POINTER TO END OF STACK AREA+1 TRPRI NOP POINTER TO TOP ENTRY ON STACK * ************************************************** ****************** TIME SCHED TABLE ************* * * WORD 1&2: FLOATING POINT TIME (SEC) * * WORD 3 SEQUENCE NUMBER * TSTBL DEF *+1 POINTER TO BEGINNING OF TABLE BSS 48 ALLOW 16 ENTRIES TSEND DEF * POINTER TO END+1 OF TABLE TSPTR NOP GENERAL USE TABLE POINTER TSNXT NOP POINTER TO NEXT FREE ENTRY TSTIM BSS 2 TIME OF LAST UPDATE OF TIME SCHD TSCNT BSS 2 -# SECONDS TILL SCHED NEXT TASK * * ********************************************************* SKP **************************************************** * **************** CONSTANTS ************************* SCHED DEC 5 ASC 3,SCHED BSCT2 NOP TEMPORARY LYNNO NOP CONTENT OF .B. IN TRAP CALLS TFLAG NOP =-1 IF GIVEN SEQ NBR NEGATIVE ENPTR NOP POINTER TO NEXT ENTRY (IN TIMCK) SNPAR NOP TIMT1 BSS 2 TEMPORARY FLDAY DEC 86400. FLOATIN POINT # SEC IN DAY F.100 DEC 100. F.60 DEC 60. TMPAR BSS 2 WHOLE BSS 2 HHMM BSS 2 HH BSS 2 MM BSS 2 SS BSS 2 MAXNG EQU MNEG MAXIMUM NEG FLOAT PT NBR B2 EQU .2 B3 EQU .3 .5 DEC 5 D99 DEC 99 AD2 DEF .2 AD3 DEF .3 AD4 DEF .4 AD5 DEF .5 AD6 DEF .6 **************************************************** SKP **************************************************************** * * * RTE-B TIME STATEMENT * * **************************************************************** * * * *THIS ROUTINE IS A FORTRAN AND BASIC CALLABLE ROUTINE THAT *RETURNS THE TIME OF DAY IN FLOATING POINT SECONDS TO THE *NEAHFBREST 100 MS (OR TENTH OF A SECOND).THE VALUE OF ZERO *REPRESENTS MIDNIGHT. * * JSB TIME ASSEMBLY LANGUAGE * DEF *+2 * DEF TI * * 100 TIME(T) BASIC * * ON RETURN A/B=TIME IN TENS OF MS * * * TM BSS 1 TIME NOP JSB .ENTR DEF TM DLD $TIME GET TIME FROM SYSTEM CLE CLEAR FOR ADD ADA PRS1 CONVERT TO POSITIVE 24HRS SEZ INB ADB PRS2 DIV .6000 A=MINS,B=SECS STA MINS ASR 16 POSITION FOR DIV DIV D100 A=SECS,B=10S OF MS STB MS10 FLT DST TM,I TEMPORARY TIME LDA MINS FLT FMP F.60 MINS IN SECONDS FAD TM,I DST TM,I LDA MS10 MS IN SECONDS FLT FDV F.100 FAD TM,I DST TM,I JMP TIME,I RETURN * .6000 DEC 6000 PRS1 OCT 153000 PRS2 OCT 203 MS10 BSS 1 MINS BSS 1 END .H ): 29102-80004 B S P0222 RTE-B SYSTEM SUPERVISOR BSUPV             H0102 ASMB,R,L,C,F HED BSUPV---BASIC SUPERVISOR A-29102-60004-1 REV. B NAM BSUPV,7 29102-60004 REV. B ****************************************************** * * BSUPV * * LIST: A-29102-60004-1 * SOURCE: 29102-80004 REV.B * RELOC: 29102-60004 * ****************************************************** * * ENT INIT,GTLYN ENT SWLST,LYNCK,LYNC1,LSTIT ENT CHAR,CHARN,DELM,CRLF,ATEMP ENT PGOLM,LIMCK,LOLIM,HILIM,CKLLN,INTIN ENT SWDEV,XQCMD ENT ONS,FROMS,ABREV,XSYNF ENT SCR,FRMTO ENT LSTR,PLSTA,LOKCK,CRLF1 * EXT PROGF,PROGL EXT INBAD,INCNT,BLANK,TYPE,GTCHR EXT LISTA,LISTR,LINE,MFASE,SBUFA EXT .BUFA EXT TFLAG,LIST EXT INDCK EXT PRNIN,TSTIT EXT TBSRH,TBLPT,LNGTH EXT DIGCK,INTCK EXT FNDPS EXT DRQST EXT SYE25,CALER,INVSC EXT MAXSN EXT .1,.2,.3,.7,.10,.32,.48 EXT M1,M2,M3,M8 EXT DEVCT,SETLP * ******************************************************* * ** LOKCK ** DUMMY VERSION, TYPE M, ONE EACH * LOKCK NOP JMP LOKCK,I * ******************************************************* SKP * ************************************************** * * START APPROPRIATE PHASE OF BASIC * ************************************************** * ** INIT JSB RTINT SET UP FWAM,LWAM FOR RTE TYPE SYSTEMS LDA KEYIA INITIALIZE INPUT DEVICE STA READR TO KEYIN DEVICE LDA BUFA STA .BUFA INIT TTY BUFFER POINTER LDA LWAM JSB INDCK STA LWAM ADA M110 STA SBUFA INIT SYNTAX BUFFER POINTER JSB PRNIN INITIALIZE OUTPUT BUFFER POINTER PATCH JMP SETUP BECOMES "STF 0" JSB EFASE EXECUTION PHASE? RSS NO JMP MFASE YES LDA M8 STA TFLAG LOKCK THROW OUT OPERATOR INPUT LDB RDYA JSB DSPLY DISPLAY "READY"  JSB CRLF GTLYN LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR JSB LINE ACCEPT A BASIC LINE JMP GTLYN * SKP * * ONCE ONLY CODE FOLLOWS - AREA THEN USED FOR I/O BUFFER * SETUP LDA FWAM JSB INDCK STA FWAM LDB PROGF CPB PROGL START ADDR=END ADDR? JMP SCRCH YES, SET BOTH TO FWAM, INFORM USER CMA,INA ADA PROGF SSA PROGF < FWAM? JMP SCRCH YES LDA PROGL CMA,INA ADA LWAM SSA PROGL >= LWAM? JMP SCRCH YES ITSOK SSB ADDRESS NEGATIVE? JMP SCRCH YES, GO TXPE "SCR" CPB PROGL HAS LAST LINE BEEN DONE? JMP GOMAN YES, GO TYPE "READY" LDA 1 INCREMENT LINE'S ADDRESS INA BY LENGTH OF LINE ADB 0,I TO GET NEXT LINE ADDRESS LDA 0,I CHECK LINE LENGTH ADA M3 SSA WAS INCREMENT POSITIVE? JMP SCRCH NO ADA M110 SSA WAS INCREMENT REASONABLE? JMP ITSOK YES SCRCH JSB SCR GOMAN LDA PAT STA PATCH FROM SETUP ON IS ONCE-ONLY CODE LDA SETLP STA LPCNT SET UP NBR OF LINE PRTR COLUMNS JMP PATCH * PAT NOP BSS SETUP+37-* 37TH WD OF I/O BUFFER HERE * * END OF ONCE ONLY CODE * SKP * *************************************************** * * SETUP FOR I/O, SWITCH TO REQUESTED ROUTINE * * CALL SEQ: JSB SWLST * DEF (ROUTINE ADDR) * RETURN: P+2: NORMAL EXIT * **************************************************** * SWLST NOP LDA LISTA SOURCE POINTER LDB LISTR DEST POINTER JSB MOVE SAVE PREVIOUS LIST DEVICE STATUS LDA SWLST,I SOURCE POINTER JSB INDCK LDB LISTA DEST POINTER JSB MOVE POST NEW LIST DEVICE STATUS LDA SPTR,I GET OUTPUT FUNCTION CODE STA CRLF1 INITIALIZE FUNCTION WORD PARAMS STA LYNC1 ISZ SPTR POINT AT SUBROUTINE ENTRY LDA SPTR STA LISTR PUT LIST SUBRTN PTR IN LISTR ISZ SWLST SKIP OVER PARAM JMP SWLST,I * MOVE NOP ADA M3 ADB M3 STA SPTR STB DPTR LDB M2 LDA SPTR,I STA DPTR,I ISZ SPTR ISZ DPTR INB,SZB JMP *-5 JMP MOVE,I * SKP * **************************************************** * * CHECK LINE POSITION & DO ASCII OUTPUT * * CALL SEQ: JSB LYNCK * RETURN: P+1: COMPLETION * *************************************************** * LYNCK NOP STA TEMPA STB TEMPB LDA LYNCK ASSUMES JSB LYNCK FOLLOWS ENTRY ADA M2 TO OUTPUT ROUTINE STA *+2 PASS DEVICE STATUS TO SWLST JSB SWLST BSS 1 UPDAT LDA TEMPA CMA,INA ADA TYPE STA TYPE UPDATE CARRIAGE POSITION CLA JSB TSTIT SZA,RSS DID TSTIT DO CR-LF? JMP UPDAT YES LDA TEMPA LDB TEMPB JSB DOIO LYNC1 BSS 1 SET UP BY SWLST JMP LYNCK,I * *************************************************** * * LSTIT IS AN ASC OUTPUT ROUTINE SWITCH * PLIST WILL START IC TO ASC CONV IN BASIC * ************************************************** * LSTIT NOP JSB LSTR,I DO LISTING TASK JMP LSTIT,I & RETURN * PLIST NOP LDA PLIST SET UP RETURN STA LIST LDA LSTAD JSB INDCK ADA .2 STA PLIST LDA HILIM PASS LIMITS LDB LOLIM JMP PLIST,I GOTO LIST+2 * * SKP ***************************************************** * * CHAR WILL FETCH THE NEXT INPUT CHAR * CHARN WILL FETCH THE NEXT NON-BLANK CHAR * ***************************************************** * CHAR NOP LDA .10 SET UP FOR STA BLANYK FIXED FORMAT SCAN JSB CHRIN GET INPUT JMP CHAR,I * CHARN NOP LDA .32 SET UP FOR STA BLANK FREE FORMAT SCAN JSB CHRIN GET INPUT JMP CHARN,I * CHRIN NOP CHRN1 JSB GTCHR FETCH NEXT CHAR STA ATEMP CPA .10 EOF? JMP CHRN2 JSB DELM NO, DELIMITER? JMP CHRIN,I YES, IGNORE CLB NO, CLEAR STB CONT. CONT. FLAG JMP CHRIN,I & RETURN CHRN2 LDB CONT. YES, IS CONT. SZB,RSS ENABLED ?? JMP CHRIN,I NO, RETURN LDA M2 YES, GIVE 2 LDB BLNKA BLANKS JSB DSPLY & JSB DRQST GET MORE INPUT JMP CHRN1 * SKP * **************************************************** * * DELM WILL TEST FOR A DELIMITER * **************************************************** * DELM NOP CPA .32 BLANK ? JMP DELM,I YES, P+1 RETURN CPA O54 COMMA ? JMP DELM1 YES ISZ DELM NEITHER, TAKE JMP DELM,I P+2 RETURN DELM1 ISZ CONT. INSURE CONT. FLAG IS ON JMP DELM,I (FOR INPUT OUTSIDE OF CHRIN) * ************************************************ * * DO CARRIAGE RETURN, LINE FEED OUTPUT * ************************************************ * CRLF NOP USED AS FLAG BY "LIST" IN BASIC LDA M2 LDB RDYA CPA CRLF1 KLUDGE TO ALLOW BLOCKING UP JMP LYNC1,I OUTPUT, THIS DOES FLUSH JSB DOIO DO CARRIAGE RETURN, LINE FEED CRLF1 BSS 1 SET UP BY SWLST CLA STA TYPE DENOTE NEW LINE JMP CRLF,I * SKP * ****************************************************** * * FIND REQUESTED PROGRAM CORE LIMITS * * CALL SEQ: (A)=NEXT CHAR * JSB PGOLM * RETURN: P+1: EOF DETECTED * P+2: MORE INPUZT TO COME * (A)=NEXT CHAR * LOLIM=LOW CORE LIMIT * HILIM=HI CORE LIMIT * ***************************************************** * PGOLM NOP JSB LIMCK FETCH PROGRAM LIMITS STA ATEMP SAVE NEXT CHAR LDA LOLIM JSB FNDPS FIND POSITION NOP OF 1ST STATEMENT NOP STB LOLIM SAVE IT LDA HILIM INA JSB FNDPS FIND POSITION NOP OF LAST STATEMENT NOP STB HILIM SAVE IT LDA ATEMP RETRIEVE NEXT CHAR CPA .10 EOF ?? JMP PGOLM,I YES, TAKE P+1 RETURN ISZ PGOLM JMP PGOLM,I NO, TAKE P+2 EXIT * * SKP * ******************************************************** * * FETCH PROGRAM LIMITS FROM INPUT BUFFER * ACCORDING TO THE FOLLOWING SYNTAX: * ...... * ...... * ...... * * CALL SEQ: (A)=NEXT CHAR * JSB LIMCK * RETURN: (A)=NEXT CHAR * LOLIM=LO LIMIT * HILIM=HI LIMIT * ******************************************************** * LIMCK NOP CLB,INB SET UP STB LOLIM DEFAULT LIMITS LDB .9999 1-9999 STB HILIM LDB M2 STB CNT1 LDB .10 SET UP FOR STB BLANK FIXED FORMAT SCAN RSS JSB CHAR FETCH NEXT CHAR LIM1 JSB DELM DELIMITER ? JMP *-2 YES, IGNORE JSB DIGCK DIGIT ? JMP LIMCK,I NO,EXIT ADA .48 YES, JSB INTIN FETCH # DEF MAXSN & STB HILIM SAVE IT ISZ CNT1 DONE ? RSS JMP LIM2 STB LOLIM NO, CONTINUE JMP LIM1 LIM2 INB INSURE CMB,INB LOLIM<=HILIM ADB LOLIM SSB,RSS JMP SYE25 IT'S NOT, ERROR LDhB .32 OK, SET UP FOR STB BLANK FREE FORMAT INPUT RSS FETCH NEXT JSB CHARN NON-DELIMITER JSB DELM CHARACTER JMP *-2 (A)=NEXT CHAR JMP LIMCK,I & RETURN * SKP * **************************************************** * * CHECK LEGAL LINE # LIMITS OF INPUT * * CALL SEQ: (A)=CHAR COUNT * (B)=BUFFER ADDRESS * JSB CKLLN * RETURN: P+1: OUTSIDE OF LIMITS * P+2: WITHIN LIMITS * *************************************************** * CKLLN NOP CMA SET UP FOR STA INCNT GETCR RBL ROUTINE STB INBAD LDB LOLIM INPUT LIMITS CPB .1 OTHER THAN RSS 1-9999 ??? JMP CKLL1 LDB HILIM CPB .9999 JMP CKLL2 NO, TAKE P+2 EXIT CKLL1 JSB GETCR YES, FETCH NEXT CHAR JMP CKLLN,I NULL RECORD, TAKE FAIL EXIT CPA .32 IGNORE PRECEEDING JMP CKLL1 BLANKS JSB INTIN GET CURRENT LINE # DEF MAXSN LDA LOLIM CMA,INA ADA 1 SSA #>=LOLIM ? JMP CKLLN,I NO, P+1 CMB,INB ADB HILIM SSB #<=HILIM ? JMP CKLLN,I NO, P+1 CKLL2 ISZ CKLLN JMP CKLLN,I YES, P+2 * * SKP * ***************************************************** * * INTIN WILL BUILD AN INTEGER FROM INPUT * * CALL SEQ: (A)=CURRENT CHAR * JSB INTIN * DEF (MAX #) * RETURN: (B)=INTEGER * ***************************************************** * INTIN NOP STA ATEMP SAVE CUR. CHAR. LDA INTIN,I FETCH JSB INDCK MAXIMUM STA INTI1 ALLOWABLE ISZ INTIN LIMIT LDA SBPTR SAVE STA TEMP1 SBPTR LDA TEMAD STATUS STA SBPTR LDA ATEMP RECOVER CUR.CHAR. JSB INTCK FETCH INTEGER INTI1 BSS 1 STA ATEMP LDA TEMP1 RESTORE STA SBPTR SBPTR STATUS LDA ATEMP JMP INTIN,I * SKP *************************************************** * * SEARCH COMMAND DEVICE TABLE FOR VALID SYNTAX * * CALL SEQ: (A)=CURRENT CHAR * (B)=-TAB LENGTH * JSB SWDEV * DEF (TABLE START ADDRESS) * RETURN: P+2: FAIL RETURN * (A)=CURRENT CHAR * P+3: SUCCES RETURN * (A)=CURRENT CHAR * (B)=TABLE POSITION * TBLPT=ENTRY ADDRESS * ************************************************** * SWDEV NOP STA ATEMP SAVE CURRENT CHAR LDA SWDEV,I FIND TABLE START JSB INDCK STA SWDV1 ISZ SWDEV SWDV0 LDA ATEMP RETRIEVE CURRENT CHAR SZB,RSS ANY ENTRIES ? JMP SWDEV,I NO, TAKE FAIL EXIT JSB TBSRH YES, SEARCH DEVICE SWDV1 NOP TABLE JMP SWDV3 NOT FOUND * JSB CHARN FOUND,FETCH NEXT CAHR JSB DELM IGNORE DELIMITERS JMP *-2 STA ATEMP SAVE A LDA COUNT FIND JSB INDCK CURRENT ADA M2 COUNT LDB 0,I SWDV2 CMB & ADB LNGTH COMPUTE CMB,INB TABLE POSITION LDA ATEMP ISZ SWDEV MOVE TO SUCCES RETURN JMP SWDEV,I & EXIT * SWDV3 LDB LNGTH SWDV4 LDA SWDV1,I ALLOW 0 LENGTH SYMBOL AND .7 AS VALID TABLE ENTRY SZA,RSS 0 LENGTH ? JMP SWDV5 ADA .3 NO, MOVE TO NEXT ENTRY ARS ADA SWDV1 STA SWDV1 INB,SZB END OF TABLE ? JMP SWDV4 NO, CONTINUE JMP SWDV0 YES, NO MATCH * SWDV5 LDA SWDV1 0 LNGTH SYMBOL FOUND STA TBLPT |k SAVE ENTRY ADDRESS JMP SWDV2 * SKP ******************************************************* * * EXECUTE SPECIFIED COMMAND * * CALL SEQ: (A)=NEXT CHARACTER * (B)=EXECUTION TABLE POSITION * JSB XQCMD * DEF (EXECUTION TABLE START) * NOP (USED FOR STORAGE BY XQCMD) * RETURN: P+3: COMPLETION RETURN * P+4: CONTINUATION RETURN (WHEN REQUIRED) * ********************************************************* * XQCMD NOP STA ATEMP SAVE CURRENT CHAR ADB M1 FIND EXECUTION RBL,SLB TABLE ADDRESS JSB CALER LDA XQCMD,I JSB INDCK ADB 0 (B)=EXECUTION TABLE ENTRY ISZ XQCMD STB XQCMD,I SAVE IT IN USER SUPPLIED STORAGE INB LDA 1,I GET ADDRESS OF I/O ROUTINE JSB INDCK FROM BRTBL ISZ XQCMD LDB XQCMD SAVE IT IN CALLER STB 0,I SUPPLIED STORAGE INA STA TEMPX LDB TBLPT GET ADDRESS OF MNEM ENTRY AND LDB 1,I EXTRACT THE LOGICAL UNIT NO. LSR 9 AND RIGHT JUSTIFY LDA ATEMP RECOVER CURRENT CHAR JMP TEMPX,I TRANSFER TO REQUESTED ROUTINE * SKP **************************************************** * * CHECK OCCURANCE OF "ON" OR "FROM" SYNTAX * IF XSYNF=1 ON/FROM/TO MUST OCCUR IN COMMAND SYNTAX * IF XSYNF=1 ON/FROM MUST OCCUR IN COMMAND SYNTAX * IF XSYNF=0 ON/FROM MAY BE OMITTED FROM COMMAND * * CALL SEQ: JSB ONS * RETURN: P+1: FOUND, (A)=NEXT CHAR * * CALL SEQ: JSB FROMS * RETURN: P+1: FOUND, (A)=NEXT CHAR * * ***************************************************** * ONS NOP CHECK "ON" SYNTAX LDB ONA JSB SYNCH CLB SET ON/FROM FLAG TO ZERO STB FRMTO FRMTO FLAG=0 FOR "ON" LDB DEVCT GET -# OF DEVICE MNEM.  JMP ONS,I OK, RETURN * FROMS NOP CHECK "FROM" SYNTAX LDB FROMA JSB SYNCH CLB,INB FRMTO FLAG=1 FOR "FROM" STB FRMTO LDB DEVCT GET -# OF DEVICE MNEM. JMP FROMS,I OK, RETURN * SYNCH NOP STB SYNC1 CCB JSB TBSRH SEARCH INPUT BUFFER SYNC1 NOP JMP SYNC2 NOT FOUND JSB CHARN FETCH NEXT NON-BLANK CHAR JSB DELM DELIMITER ? JMP *-2 YES, IGNORE CPA .10 EOF ?? JMP INVSC YES, INPUT ERROR JMP SYNCH,I NO, OK EXIT SYNC2 LDB XSYNF IS SYNTAX REQUIRED SZB ??? JMP INVSC YES, ERROR JMP SYNCH,I NO, OK EXIT SKP * *************************************************** * * ALLOW SYNTAX ABREVIATION * * CALL SEQ: JSB ABREV * DEF (ABREVIATED SYNTAX) * RETURN: P+1: FOUND * P+2: NOT FOUND, (A)= NEXT CHAR * ************************************************** * ABREV NOP LDA ABREV,I STA ABRE1 ISZ ABREV JSB CHARN CCB JSB TBSRH ABRE1 BSS 1 ISZ ABREV JMP ABREV,I * SKP **************************************************** * * SCRATCH SUBROUTINE * * CALL SEQ: JSB SCR * RETURN: P+1: NORMAL * *************************************************** * SCR NOP LDA FWAM STA PROGF STA PROGL JMP SCR,I * SKP * * STORAGE & CONSTANTS & OTHER THINGS OF INTEREST * SUP BUFA DEF SETUP I/O BUFFER ADDRESS LSTAD DEF LIST INDEX TO LIST ROUTINE IN BASIC COUNT DEF LNGTH INDEX TO TABLE POSITION IN TBSRH LSTR DEF PLIST INIT TO PLIST PLSTA DEF PLIST ADDRESS OF PLIST ROUTINE * CONT. NOP KBD INPUT CONTINUATION FLAG ATEMP NOP CURRENT CHARACTER XSYNF OCT 1 ON.FROM SYNTAX SWITCH, INIT. TO YES LOLIM NO P LOW LIMIT HILIM NOP HIGH LIMIT * O54 OCT 54 .9999 DEC 9999 M110 DEC -110 * RDYA DEF *+1 BASIC'S "READY" MESSAGE OCT 6412 ASC 3,READY * BLNKA DEF *+1 INPUT CONTINUATION PROMPT ASC 1, * ONA DEF *+1 "ON" SYNTAX OCT 2 ASC 1,ON * FROMA DEF *+1 "FROM" SYNTAX OCT 4 ASC 2,FROM * * TEMAD DEF TMP TMP BSS 1 TEMP1 BSS 1 TEMPA BSS 1 TEMPB BSS 1 TEMPX BSS 1 CNT1 BSS 1 SPTR BSS 1 DPTR BSS 1 FRMTO BSS 1 HED ****** DOIO ****** A-29102-60004-1 REV. B * ********************************************* * DOIO * * ******************************************** * * ENT DOIO * EXT EXEC EXT B2000,B777,.63,M1,.1,.2 * DOIO NOP STA LENTH STB BUFAD STORE ADDRESS OF BUFFER LDB DOIO,I GET CONTROL WORD ISZ DOIO LDA 1 AND FMASK EXTRACT FUNCTION CODE ALF STA ICODE AND STORE IT AWAY LDA 1 AND CMASK EXTRACT CONTROL INFO STA ICNWD AND STORE IT AWAY AND DMASK EXTRACT LOGICAL UNIT NBR CPA .2 RSS JMP SETX LDA M1 ADA ICNWD STA ICNWD LU 2 CHANGE TO LU 1 SETX LDA ICODE SET X BIT FOR HONESTY MODE ON CPA .1 INPUT JMP DOIT LDA ICNWD IOR BIT10 STA ICNWD DOIT JSB EXEC MAKE EXEC CALL DEF *+5 DEF ICODE DEF ICNWD BUFAD DEF BUFAD DEF LENTH AND .32 BIT 5 SET MEANS EOF SZA MAKE SURE EOF SHOWS CLB ZERO LENGTH RECORD STB 0 SET CHAR COUNT IN AREG JMP DOIO,I LENTH NOP ICODE NOP ICNWD NOP BIT10 EQU B2000 FMASK OCT 170000 CMASK EQU B777 DMASK EQU .63 HED * BASIC I-O ROUTINES FOR RTE-B * A-29102-60004-1 REV. B * **************************************[SB@<********** * * READR * * ************************************************ * * FCINP EQU 10400B FUNCTION CODE FOR INPUT FCOUT EQU 24000B FUNCTION CODE FOR OUTPUT * **************************************************** * * ENTRY POINTS: * * ENT LOAD,LOADA,L.RDR ENT EREED,RDNBR,REDNO ENT L.PUN,LEADR,ERCRD,RCRD ENT LIST.,L.LST,ELIST ENT DSPLY,DSPLA,EDSPL ENT KEYIA,KEYIN,EINP,ETTYS ENT LPPOS * * * EXTERNAL REFERENCES: * EXT .10,INVSC,MO100,READR EXT EINPT EXT TFLAG,ZERO,EFASE,EFIO,READS EXT EREAD EXT GETCR,BCKSP,SBPTR,M1 EXT FSC,M2,SYMCK,COMM1,ERROR,.STOP EXT TEMPS EXT MO133 EXT PRINS,EPRIN EXT .1 EXT SEQNO EXT M6,.7,.23 * * ******************************************************* * SKP \~B SKP ***** * GET INPUT PROGRAM (FROM COMMAND) ***** L.RDR NOP CPA .10 EOF ? RSS JMP INVSC NO, ERROR LDA FRMTO SZA,RSS L.RDR AND "ON" INCOMPATIBLE JMP INVSC LDA STFCI SET UP I/O IOR 1 CODE STA FNCTW LDA PLODA SWITCH BASIC TO GET STA READR NEXT RECORD FROM PLOAD ROUTINE LDA L.RDR INA SET RETURN FOR CONTINUATION JMP 0,I LET BASIC PROCESS INPUT * PLOAD NOP JSB LOAD GET A RECORD LDB TMPB2 FETCH BUF ADDR JSB CKLLN LINE LIMITS SATISFIED ? JMP LOAD1 NO, IGNORE IT LDA TFLAG YES,GIVE IT TO BASIC JMP PLOAD,I FOR PROCESSING * * OTHER NAMES FOR L.RDR * PHOT1 EQU L.RDR PHOT2 EQU L.RDR * CARD1 EQU L.RDR CARD2 EQU L.RDR * ** MAKE THEM ENTRY POINTS ALSO * ENT PHOT1,PHOT2,CARD1,CARD2 * SKP ***** * PROVIDE PUNCHED PROGRAM OUTPUT ***** L.PUN NOP JSB SETOT SET UP FOR OUTPUT DEVICE LDA MO133 GIVE LEADER JSB LEADR JSB LSTIT GIVE PROGRAM LDA MO133 JSB LEADR GIVE TRAILER JMP L.PUN,I RETURN ***** * PROVIDE PROGRAM LISTING ***** L.LST NOP JSB SETOT SET UP FOR OUTPUT DEVICE JSB LSTIT LIST PROGRAM JSB LSKIP GIVE FORM FEED JMP L.LST,I & RETURN ***** * SET UP FOR OUTPUT DEVICE ***** * SETOT NOP CPA .10 EOF? RSS JMP INVSC NO,ERROR LDA FRMTO SZA OUTPUT AND "FROM" ARE INCOMPATIBLE JMP INVSC LDA STFCO IOR 1 STA WORD JSB SWLST DEF CTTYS JMP SETOT,I * ** OTHER NAMES FOR OUTPUT * PNCH1 EQU L.PUN PNCH2 EQU L.PUN * LP1 EQU L.LST LP2 EQU L.LST * CRT1 EQU L.LST CRT2 EQU L.LST CRT3 EQU L.LST CRT4 EQU L.LST * TTY1 EQU L.LST TTY2 EQU L.LStT TTY3 EQU L.LST TTY4 EQU L.LST * ** MAKE THEM ENTRIES TOO * ENT PNCH1,PNCH2,LP1,LP2 ENT CRT1,CRT2,CRT3,CRT4 ENT TTY1,TTY2,TTY3,TTY4 SKP ***** * ** COME HERE UPON RECOGNIZING THE STRING "READ" AT * SYNTAX TIME, OR WHEN EXECUTING A READ STATEMENT * ***** EREED NOP JSB EFIO EXECUTION PHASE? JMP CKRED NO, GO CHECK SYNTAX JMP EREAD YES, CODE IS IN BASIC INTERPRETER ***** ** HERE AT SYNTAX TIME ***** CKRED JSB GETCR GET NEXT CHAR JMP CKTT1 (END OF INPUT LINE) CPA NUMSN IS THAT CHAR A "#"? JMP CKTT2 YES, SET UP FOR READ# CKTT1 JSB BCKSP NO, BACKUP OVER THAT CHAR JMP READS AND PROCESS NORMAL READ STATEMENT CKTT2 LDB SBPTR GET ADDRESS OF CALL ADB M1 IN SYNTAX BUFFER LDA 1,I AND INCREMENT BRANCH TABLE INA OFFSET BY ONE STA 1,I THEN PUT IT BACK JSB FSC GET FORMULA FOR LU# CPA .10 END OF STATEMENT? JMP READS YES, PROCESS NORMALLY FROM HERE LDB M2 NO, IS THE DELIMITER JSB SYMCK A COMMA DEF COMM1 OR SEMICOLON? RSS JMP READS YES, PROCESS NORMALLY FROM HERE JSB ERROR NO, ERROR 21 DEF *+3 DEF .21 DEF ZERO JSB .STOP ***** * ** HERE TO EXECUTE READ# STATEMENT * ***** RDNBR NOP JSB SEQNO GET NEW LU NUMBER STA TMPA2 SAVE LU NUMBER ISZ TEMPS MOVE INTERP CODE PTR BY END FORMULA ADA STFCI MAKE NEW FUNCT CONTROL WORD STA FNCTW AND PUT IT IN THE CALL TO DOIO LDA TMPA2 RECALL LU NUMBER JSB GETOF GET TABLE OFFSET FOR DEVICE ADA INTBL ADD TABLE ADDRESS LDA 0,I THEN GET ADDRESS OF ROUTINE STA READR AND SET UP FOR INPUT JMP EINPT FROM HERE TREAT AS INPUT STMT ***** * HERE FOR PRINT STATEMENT ***** ELIST NOP JSB EFIO EXECUTION PHASE ?  JMP CKTTY SYNTX PHASE CK FOR PRINT# JSB SWLST YES, SWITCH TO LST DEVICE DSPLA DEF DSPLY JMP EPRIN GO EXECUTE STATEMENT * CKTTY JSB GETCR GET NEXT CHAR JMP NOLUK (END OF INPUT LINE) CPA NUMSN IS THAT CHAR "#" JMP UBET YES, SETUP FOR PRINT# NOLUK JSB BCKSP NO,BACKUP OVER THAT CHAR JMP PRINS AND PROCESS NORMALLY UBET LDA SBPTR GET ADDRESS OF ADA M1 CALL IN SYNTX BUFFER LDB 0,I AND INCREMENT BRANCH TBL ADB .1 OFFSET BY ONE STB 0,I THEN PUT IT BACK JMP PRINS FROM THERE PROCESS NORMALLY ***** * HERE FOR INPUT STATEMENT ***** EINP NOP JSB EFIO EXECUTION PHASE ? JMP READS NO, GO CHECK SYNTAX LDA KEYIA YES, SET UP FOR STA READR KBD INPUT JMP EINPT GO EXECUTE INPUT STATEMENT ***** * HERE TO EXECUTE PRINT# ***** ETTYS NOP JSB SEQNO GET NEW LU # STA TMPA2 ADA STFCO MAKE NEW FUNCT CONTROL WORD STA WORD AND STORE IT AWAY LDA TMPA2 GET LU NUMBER JSB GETOF ADA OUTBL GET ADDRESS OF TABLE ENTRY LDA 0,I THEN GET ADDRESS OF OUTPUT RTN STA ETT1 AND SET UP OUTPUT JSB SWLST SET UP FOR APPROPIATE DEVICE ETT1 DEF CTTYS JMP EPRIN THEN PROCESS NORMALLY HED ****** INPUT ROUTINES ****** A-29102-60004-1 REV. B ***** * READ A RECORD FROM READR ***** LOAD NOP STA TMPA2 SAVE MAX COUNT (-CHARS, BCS CONV.) STB TMPB2 SAVE BUFFER ADDRESS LOAD1 LDA TMPA2 LDB TMPB2 JSB REDNO GET A RECORD CPA ZERO ANY DATA ? JMP EOT NO, JUST LEADER/TRAILER STA TFLAG YES, NEXT TIME WILL BE TRAILER JMP LOAD,I * EOT LDB TFLAG SSB JMP LOAD1 LEADER; GO READ MORE STA TFLAG ASSUME LEADER FOR NEW TAPE NEXT JMP L.xRDR,I EXIT TO COMPLETION RETURN ***** ** HERE TO GET INPUT LINE ***** REDNO NOP CMA,INA MAKE CHAR COUNT NEGATIVE JSB DOIO DO THE INPUT FNCTW NOP THIS WORD SET UP BY RDNBR JMP REDNO,I ***** * HERE FOR INPUT FROM LU# 1 ***** KEYIN NOP CMA,INA SET CHAR COUNT NEG. STA TMPA2 SAVE A STB TMPB2 SAVE B JSB EFASE EXECUTION PHASE ?? JMP SKPIT NO CCA LDB QMRKA OUTPUT QUESTION MARK JSB DSPLY SKPIT LDA TMPA2 RECOVER CHAR COUNT LDB TMPB2 JSB DOIO GET INPUT ABS FCINP+1 INPUT WITH ECHO FROM LU# 1 JMP KEYIN,I * HED * SMALL ROUTINES FOR EACH OUTPUT A-29102-60004-1 REV. B * ***** * FOR LU# 4 ***** NOP STORAGE FOR CARRIAGE POSITION DEC -73 72 CHARS/LINE ABS FCOUT+4 RCRD NOP JSB LYNCK DO ASCII OUTPUT JMP RCRD,I ***** * FOR LU# 6 ***** LPPOS NOP STORAGE FOR CARRIAGE POSITION LPCNT DEC -81 ABS FCOUT+6 LIST. NOP JSB LYNCK ASCII OUTPUT JMP LIST.,I ***** * FOR LU# 1 * NOP DEC -73 ABS FCOUT+1 DSPLY NOP JSB LYNCK JMP DSPLY,I ***** * FOR MULTI-DEVICE OUTPUT * ***** NOP DEC -73 THIS CODE WORD NOP SETS UP CTTYS NOP A NEW JSB LYNCK "DEVICE" JMP CTTYS,I FOR OUTPUT HED ****** UTILITY ROUTINES ****** A-29102-60004-1 REV. B * ***** * OUTPUT LEADER/TRAILER ***** LEADR NOP STA ERCRD SAVE COUNT LDA LYNC1 GET OUTPUT FUNCTION CODE STA LEAD1 LEAD CCA ONE FRAME LDB ZEROA JSB DOIO ASSUME DEVICE ALREADY SWITCHED LEAD1 BSS 1 ISZ ERCRD DONE?? JMP LEAD NO JMP LEADR,I ***** * DO A PAGE EJECT ***** LSKIP NOP LDA WORD GET FUNC CONTROL WORD AND .63 ISOLATE LU # CPA .1 IF LU #1 JMP LSKIP,I RETURN IMMEDIATELY CCA 1 CHAR LDB SKPCD JSB CTTYS OUTPUT SKIP CODE JSB CRLF KEEP IN SYNC WITH LP JMP LSKIP,I ***** * ** GETOF ** CONVERT LU # TO OFFSET IN TABLE * * LDA LOGICAL UNIT NUMBER * JSB GETOF * RETURN .A.=OFFSET * * NOTE: AN ERROR RESULTS IF LU IS 0 OR NEGATIVE * ANY LU > 6 RETURNS AN OFFSET OF 7 * ***** * GETOF NOP ADA M1 IF LU IS SSA 0 OR NEGATIVE, JMP LUERR ISSUE ERROR ADA M6 IF LU IS SSA,RSS 7 OF GREATER JMP USE7 THEN RETURN OFFSET OF 7 ADA .7 RSS USE7 LDA .7 JMP GETOF,I * LUERR JSB ERROR DEF *+3 DEF .23 DEF ZERO JSB .STOP HED **** CONSTANTS AND STORAGE **** A-29102-60004-1 REV. B ********************************************************* * ** CONSTANTS AND STORAGE * *************************************************** * .21 DEC 21 NUMSN OCT 43 ERCRD NOP ZEROA DEF ZERO EDSPL EQU ELIST SKPCD DEF *+1 OCT 6000 FORM FEED KEYIA DEF KEYIN QMRKA DEF *+1 ASC 1,? TMPA2 BSS 1 TMPB2 BSS 1 LOADA DEF LOAD PLODA DEF PLOAD STFCI ABS FCINP STFCO ABS FCOUT ************************************************* * * TABLES TO SET UP PRINT# AND READ# LU'S * ********************************************************** OUTBL DEF * DEF DSPLY DEF CTTYS DEF CTTYS DEF RCRD DEF CTTYS DEF LIST. DEF CTTYS * INTBL DEF * DEF KEYIN DEF REDNO DEF REDNO DEF REDNO DEF REDNO DEF REDNO DEF REDNO * *********************************************************** HED RTE-B BASIC CONTROL A-29102-60004-1 REV. B **************************************** * RTE-B BASIC CONTROL |**************************************** * SPC 5 ENT START * EXT .STOP * START JMP INIT JSB .STOP SPC 5 * ENT RUNIT,.RUN * EXT XH,XL,EENDA,PEXMA * RUNIT NOP RUN THE PROGRAM .RUN CLA STA XH INA STA XL LDA EENDA STA PEXMA JMP INIT SKP ENT ELINK * EXT PXMKA,PEXMA * ELINK LDB PXMKA STB PEXMA JMP INIT SPC 5 ENT EPAUS * EXT M10 * FCNRD EQU 10401B READ CONTROL WORD * EPAUS NOP EXECUTE "PAUSE" LDA M10 LOAD -# OF CHARACTERS LDB PAZA JSB DSPLY OUTPUT "PAUSE" EP1 CLA,INA READ ONE WORD LDB CTRLA JSB DOIO READ ABS FCNRD LDB CTRL GET OPERATOR MESSAGE CPB GO IS IT CONTINUE JMP EPAUS,I YES! CPB AB IS IT ABORT? JSB .STOP YES JMP EP1 * PAZA DEF PAZ PAZ OCT 6412 ASC 3,PAUSE OCT 6412 CRLF * CTRLA DEF *+1 CTRL BSS 1 GO ASC 1,GO AB ASC 1,AB * ENT TRACE * EXT TRAP * TRACE NOP JSB TRAP JMP TRACE,I SKP * * BRANCH AND MNEMONIC TABLE ADDRESS POINTERS * * ENT SRULA,ADRED,CMDAD,ASBTB,SBTBE,FCNTB,XNFOA,STDCA ENT FWAM,LWAM * EXT SRULE,MNEM,CMDS,SBTBL,LSBTB,FCNEX,XNFO,STDCL * SRULA DEF SRULE START OF SPECIAL CALL MNEMONICS ADRED DEF MNEM START OF CALL MNEMONICS CMDAD DEF CMDS START OF COMMAND MNEMONICS SBTBE DEF LSBTB END OF FUNCTION TABLE ASBTB DEF SBTBL START OF BRANCH TABLE FCNTB DEF FCNEX START OF FUNCTION TABLE XNFOA DEF XNFO START OF PARAMETER TYPE TABLE STDCA DEF STDCL END OF SUBROUTINE CALL FWAM NOP FIRST WORD AVAILABLE MEMORY LWAM NOP LAST WORD AVAILABLE MEMEORY HED RTE-B CATCH-ALL MODULE A-29102-60004-1 REV. B SUP PRESS ASCII LISTING **************************************** * RTE-B CATCH-ALL MODULE **************************************** * * ENT RTINT,NORML,OVDVR,.IENT ENT EINT,.FLUN ENT .LOGA,.EXPA * EXT ERROR,.STOP EXT B377,M8,M16,.PACK EXT .15,.23,M1 EXT INDCK,.PEXP,MANT1,MANT2 EXT STRT5,PROGF,PROGL,FCORE,SYMTF,SYMTA EXT M4,ERROR,INDCK,ZERO EXT .1,.2,.4 EXT ALOG,EXP ** AVMEM EQU 1751B FWA SYSTEM BUFFER BKGRG EQU 1752B FWA BACKGROUND BKLWA EQU 1777B LWA BACKGROUND XEQT EQU 1717B ADDRESS OF BASICS ID SEGMENT ** ** INITIALIZE FWAM,LWAM FOR RTE TYPE SYSTEMS ** * RTINT NOP CLA STA START SETUP SO RE-ENTRY POINT IS BSTOP LDA XEQT GET THE ADDRESS OF BASICS ID SEG ADA .23 GET ADDRESS OF MEMORY BOUNDS LDA 0,I GET LAST WORD OF BASIC INA STA FWAM LDA BKLWA CHECK FOR AVAILABLE BACKGROUND CMA,INA IF NONE THERE THEN ADA BKGRG ASSUME RTE-C OR RTE-B AND SZA THEN RUN IN FOREGROUND JMP RT1 THERE IS BACKGROUND! LDA AVMEM THERE ISNT! ADA M1 RT2 STA LWAM SET UP LWAM FOR BASIC USER AREA JMP RTINT,I RETURN * RT1 LDA BKLWA JMP RT2 * .LOGA OCT 100100 DEF ALOG * .EXPA OCT 100100 DEF EXP * * SKP * * * RTE-B DUMMY OVERLAY DRIVER * * * OVDVR NOP *** ENTER *** STA TMPA3 SAVE AREG STB TMPB3 SAVE BREG LDA OVDVR,I GET CALL TABLE ENTRY ADDRESS JSB INDCK MAKE INTO DIRECT ADDRESS LDB 0,I GET FUNC. CTRL. WRD. INA POINT AT ENTRY POINT OF DRIVER LDA 0,I GET ENTRY ADDRESS JSB INDCK MAKE INTO DIRECT ADDRESS STA TEMP ISZ OVDVR SSB HAS FUNC. GOT JSB ERR0 ON IT JMP OV1 YES! LDA OVDVR STA TEMP,I FAKE JSB TO ENTRY FROM POSITION ISZ TEMP OF DEF FOLLOWING "JSB OVDVR" LDA TMPA3 RESTORE AREG LDB TMPB3 JMP TEMP,I CALL THE DRIVER * OV1 LDA TMPA3 RESTORE REGS LDB TMPB3 JSB TEMP,I EXECUTE FUNCTION RSS IS THERE AN ERROR RETURN JMP OVDVR,I NO! AND .15 MAKE INTO DECIMAL ADA .60 AND ADD IN ERROR # OFFSET STA TT2 SAVE FUNCTION NUMBER JSB ERROR PRINT ERROR MESSAGE DEF *+3 DEF TT2 OF THE FORM DEF ZERO "ERROR NN IN LINE XX" JSB .STOP RETURN TO READY IN BASIC * * * * * NORMALIZE (A), (B), AND EXPONENT * * * * NORML NOP SET STA TT2 LEFT SHIFT-COUNTER CLA TO ZERO STA TT1 LDA TT2 SZA,RSS ON SZB ZERO JMP NORM3 CLEAR STA .PEXP EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN * NORM2 ISZ TT1 COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LETF INTO (E) SEZ,SSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 ERA SHIFT TO ERB,CLE NORMALIZED MANTISSA STA MANT1 NO, LDA TT1 COMPUTE CMA,INA CORRECTED ADA .PEXP EXPONENT STA .PEXP VALU LDA MANT1 JMP NORM1 * * THE FOLLOWING THREE ITEMS MUST REMAIN IN THE EXACT ORDER .60 DEC 60 TT1 BSS 1 TT2 BSS 1 TMPA3 EQU TT1 TMPB3 EQU TT2 TEMP BSS 1 * * * * SKP *** UNPACK LOW WORD OF NUMBER ** * .FLUN NOP LDA 1 (A) = (B) AND B377 GET EXPONENT CMB SUBTRACT OFF ADB 0 EXPONENT FROM CMB MANTISSA IN (B) SLA,RAR NEGATIVE EXPONENT? IOR MSK4 (77600) YES, PROPAGATE SIGN JMP .FLUN,I EXIT * *** INTEGERIZE FLOATING POINT NUMBER ** * IFIX NOP STF 1 SET OVERFLOW FLAG STA NORML SAVE (A) JSB .FLUN SSA EXPONENT NON-NEGATIVE? JMP IFIX3 NO. RETURN 0 OR -1. ADA M16 SSA EXPONENT LESS THAN 16? CLF 1 YES. CLEAR OVERFLOW. ADA M8 SSA,RSS EXPONENT LESS THAN 24? JMP IFIX,I NO. ERROR EXIT, NO FRACTION. ADA M8 BINARY POINT TO RT END OF B STA .FLUN SAVE SHIFT COUNT LDA NORML RETRIEVE HIGH MANTISSA JMP IFIX2 * IFIX1 CLE,SLA,ARS LONG RIGHT SHIFT CME SLB,ERB STF 1 SET OVERFLOW IF 1 LOST IFIX2 ISZ .FLUN DONE? JMP IFIX1 NO, SHIFT MORE ISZ IFIX DONE, SKIP RETURN JMP IFIX,I * IFIX3 LDA NORML NEGATIVE EXPONENT; RETRIEVE (A) CLE,SSA CCA,RSS TRUNCATE TO -1 OR 0 CLA,RSS CCB,RSS CLB JMP IFIX2+2 SKIP RETURN * SKP * * SUBROUTINE TO COMPUTE THE ENTIER OF A * NUMBER WHOSE EXPONENT IS LESS THAN 15 * THIS ROUTINE HAS SPECIAL PROPERTIES FOR BASIC: * OVERFLOW IS SET (ON NORMAL RETURN) IF ANY BIT LOST * E IS SET IF HIGH FRACTION BIT LOST * .IENT NOP JSB IFIX JMP .IENT,I OVERFLOW XOR 1 (A) SHOULD BE FULL OF SIGN BITS SSA (B) SHOULD HAVE A SIGN TOO JMP .IENT,I IT DOESN'T, ERROR EXIT. CPA 1 IF (A) WAS ZERO, JMP *+3 ALL WAS OK. CMA IF (A) WAS -1, CPA 1 ISZ .IENT ALSO OK; SKIP RETURN. JMP .IENT,I LEAVE WITH RESULT IN A, B. * SKP * EINT NOP STB TEMP SAVE (B) JSB IFIX JMP EINT1 NOT FIXABLE JSB .PACK BUILD FLTG RESULT DEC 31 JMP EINT,I * EINT1 LDB TEMP RETURN ORIGINAL NUMBER LDA NORML JMP EINT,I * SKP ******************************************************** * * BASIC DOUBLE STORE AND TEST ROUTINE * ******************************************************* * ENT .DST * * .DST NOP STA XTEMP SAVE INFO STB XTMP1 TO BE STORED LDA TBLAD POINT AT STA PTR RESTRICTED AREA TABLE LDA M4 4 RESTRICTED AREAS STA CTR LDA .DST,I JSB INDCK REMOVE INDIRECT CHAIN STA ADR PROPOSED STORE ADDRESS ISZ .DST SET UP FOR EXIT JSB CHECK CHECK FOR ADR IN RESTRICTED AREA ISZ CTR MORE AREAS? JMP *-2 YES CHKOK LDA XTEMP ALL CLEAR, DO THE STORE STA ADR,I ISZ ADR LDB XTMP1 STB ADR,I JMP .DST,I * CHECK NOP LDA PTR,I GET LOWER LIMIT ISZ PTR LDB PTR,I GET UPPER LIMIT ISZ PTR SET UP FOR NEXT TIME CMA,INA ADA ADR INA SSA (ADR)+1 < LOWER LIMIT? JMP CHKXT YES, OUTSIDE LIMITS THEN CMB,INB ADB ADR SSB,RSS (ADR) >= UPPER LIMIT? CHKXT JMP CHECK,I YES, OUTSIDE LIMITS ISZ CTR INSIDE LIMITS, SIMPLE VARIABLE? JMP ERR NO, ERROR LDB SYMTF START AT BEGINNING OF SYMBOL TABLE NEXT CPB SYMTA ANY MORE ENTRIES? JMP ERR NO, ADR DIDN'T MATCH ANY SMPLE VAR LDA 1,I FETCH VARIABLE NAME AND .15 ISOLATE TYPE FIELD CPA .15 FUNCTION? JMP FN YES, TWO WORD ENTRY CPA .1 1 DIMENSIONAL ARRAY? JMP ARAY YES, SKIP THE ENTRY CPA .2 2 DIMENSIONAL ARRAY? JMP ARAY YES, SKIP THE ENTRY INB POINT AT SIMPLE VAR ADDRESS CPB ADR DO WE WANT TO STORE HERE? JMP CHKOK YES, THEN ALL IS WELL FN ADB .2 SMPL VARS HAVE 3 WORDS PjER ENTRY JMP NEXT CHECK NEXT ENTRY * ARAY ADB .4 ARRAYS HAVE 4 WORDS PER ENTRY JMP NEXT CHECK NEXT ENTRY * ERR JSB ERROR DEF *+3 DEF .1 DEF DST JSB .STOP DOOM. * TBLAD DEF TABLE,I * TABLE DEF ZERO BASIC INTERPRETER DEF STR5A * DEF PROGF INTERP. CODE DEF PROGL * DEF FCORE STACK AREA DEF SYMTF * DEF SYMTF SIMPLE VARIABLE AREA DEF SYMTA * STR5A DEF STRT5 DST DEC 3 ASC 2,DST XTEMP EQU TT1 XTMP1 EQU TT2 PTR BSS 1 CTR BSS 1 ADR BSS 1 MSK4 OCT 77600 * HED RTE-B CALL STATEMENT EXECUTION A-29102-60004-1 REV. B **************************************** * RTE-B BASIC CALL STATEMENT EXECUTION * **************************************** * ENT ECALL,CLXIT ENT XITPT,PTBLA,DSTA,FLOTA,CLXTA * EXT TEMPS,B777,HSTPT,SETSX,PRADD EXT OPMSK,B4000,FORMX,FNDSB,FCORE,TSTPT EXT ERRCD,XEC4,FLOAT,FRTFX,FRTF2 EXT B1000,BHSTP,B177,SCALL EXT .STOP SUP * *** *** ** EXECUTE CALL ** *** *** * ECALL CLA CLEAR PARAMETER AREA STA PTBL STA PTBL+1 STA PTBL+2 STA PTBL+3 STA PTBL+4 STA PTBL+5 STA PTBL+6 STA ARGCT STA ERRCD LDA TEMPS LDA 0,I AND B777 ISOLATE INTERNAL CALL NUMBER STA SCALL SAVE TEMPORARILY LDA HSTPT SAVE HIGH CORE STA MWDNO STACK POINTER LDA PTBLA STA EFMT INITIALIZE PARAMETER POINTER ECAL1 ISZ TEMPS LDA TEMPS LDA 0,I AND OPMSK ISOLATE OPERATOR CPA B4000 RT PAREN (END OF PARAMS)? JMP ECAL2 YES. LDB TEMPS INB LDA 1,I AND OPMSK CPA B1000 QUOTE STRING BEING PASSED? JMP ECAL6 YES JSB FORMX EVALUATE PARAMETER. ECAL3 LDA HSTPT LDA 0,I STA EFMT,I SET UP DEF TABLE FOR .ENTR STA RTRN SAVE ADDRESS OF LAST PARAM ISZ ARGCT ISZ EFMT JMP ECAL1 * ECAL2 LDB ARGPA ADB ARGCT INITIALIZE DEF *+N STB ARGP LDB CLXTA STB XITPT LDB SCALL GET CALL TBL ENTRY NUMBER JSB FNDSB FIND STB ARGCT SAVE B IN ARGCT TEMPORARILY INB LDB 1,I GET CALL TABLE POINTER STB TMPX2 SAVE CALL TBL ENTRY ADDRESS LDB ARGCT RESTORE B FROM ARGCT CMB ADB STDCA LDA SCALL SSB,RSS STANDARD CALL? JSB FRTFX NO, GO DO FORTRAN FIX CCA LOAD ADDRESS OF ADA MWDNO PARAMETER ADDRESSES JSB TMPX2,I CALL EXTERNAL SUBROUTINE OR FUNCTION ARGP DEF *+0 PTBL OCT 0,0,0,0,0,0,0 JMP *+1,I XITPT DEF CLXIT FRTFX MAY CHANGE THIS FLTIT JSB FLOAT FOR FORT. FCNS. RETURNING INTEGER DSTL JSB .DST FOR FORTRAN FUNCTIONS, RETURN RESULT RTRN BSS 1 ADDRESS OF LAST PARAM CLXIT LDA FCORE STA TSTPT RESTORE LDA MWDNO STA HSTPT POINTERS LDB ARGCT CMB ADB STDCA SSB,RSS STANDARD CALL? JSB FRTF2 NO, FIX RETURNED PARAMS LDB ERRCD SZB,RSS ANY ERROR? JMP XEC4 NO. EXECUTE NEXT STATEMENT. ISZ TEMPS LDB PRADD CPB TEMPS ANY FAIL STATEMENT? JSB .STOP NO. ABORT EXECUTION. ISZ TEMPS JMP SETSX GO PROCESS STATEMENT * ECAL6 LDA 1 SAVE POINTER JSB BHSTP ALLOCATE PLACE FOR POINTER STA 1,I PUT " STRING POINTER ON STACK LDA 0,I AND B177 ISOLATE STRING CHARACTER COUNT INA ARS ADA 1,I COMPUTE ADDRESS OF END OF STRING STA TEMPS TO FIND NEXT CALL PARAMETER JMP ECAL3 * * PTBLA DEF PTBL DSTA DEF DSTL FLOTA DEF FLTIT CLXTA DEF CLXIT ARGPA DEF ARGP+1 ADDRESS OF LAS.NLHT ARG +1 ARGCT BSS 1 NUMBER OF PARAMETERS MWDNO BSS 1 TMPX2 BSS 1 CONTAINS THE ADDRESS OF EXTERNAL SUBROUTINE * EFMT EQU TMPX2 * END START oN +I 29102-80005 B S P0122 RTE-B SYSTEM COMMANDS CMNDS             H0101 oASMBҬ̬ì HDMNDS---BASàMMANDN̠A-90-60005-V.B NAMMNDS90-60005V.B PUUSYSMN̠DVŠUPU PUNUUPUNHDVŠUPU DUU5ADҠDVŠNPU SUU6SԠDVŠUPU MNDS S:A-90-60005- SU:90-0005 :90-60005V.B NԠ$D̬$UN$SԬ$M NԠ$AD$SAVŬ$MG NԠ$Ƭ$SKPƬ$ ԠHANDMMK ԠDGKNN..3 ԠNSMS ԠSDVMDPGM ԠAMPMHM ԠNԬNVSìABVSA Ԡ.0SҬPSA Ԡ.UNSҬDSM Ԡ.SԬ.PUN.D ԠDVBDV Ԡ$MŬM Ԡ SKP HŠ:D̠ OR = TABLE SSA VALUE, THEN JMP SGN2 SET UP GAIN ISZ AFCTR INCREMENT GAIN ISZ AFCTR TABLE POINTER ISZ CNTR LAST ENTRY? JMP SGN1 NO, CONTINUE LOOKING SPC 1 SGN2 LDA ADRS,I FETCH GAIN ENTRY AND ASL 3 SHIFT GAIN BITS INTO "B" LDB CNTR PUT NEW ADB .7 GAIN IN "B" ASR 3 SHIFT GAIN BITS BACK INTO "A" SPC 2 JSB $LIBR TURN OFF INTERRUPT SYSTEM NOP AND UPDATE STA ADRS,I CONFIGURATION TABLE ENTRY JSB $LIBX TURN INTERRUPT SYSTEM BACK DEF ENTRY ON AND RETURN SKP * "NORM" PERFORMS A SYSTEM NORMALIZE ON THE SPECIFIED UNIT * IF NO UNIT NUMBER IS SPECIFIED OR ZERO THE FIRST SUBSYSTEM * IN THE CONFIGURATION TABLE IS ASSUMED * UNIT NOP NORM NOP JSB .ENTR FETCH PARAMETER DEF UNIT ADDRESS LDA NORM SAVE RETURN STA ENTRY ADDRESS LDB UNIT FIND SUBSYSTEM JSB FNDLU LOGICAL UNIT NUMBER SPC 1 JSB EXEC ************************************* DEF *+5 SYSTEM DEF .2 NORMALIZE DEF LU REQUEST DEF .1 DEF .1 ************************************** * AND =B200 SZA,RSS SZB,RSS IF TRANSMISSION LOG JMP ERR1 EQUALS ZERO GIVE ERROR 1 JMP ENTRY,I ELSE, RETURN SPC 3 * "FNDLU" FINDS THE LOGICAL UNIT NUMBER CORRESPONDING TO THE * SUBSYSTEM NUMBER SPECIFIED IN THE CALL. IF THE NUMBER IS ZERO * OR NEGATIVE AN ERROR IS GIVEN, OR IF THE UNIT NUMBER IS NOT DEFINED * AN ERROR IS ALSO GIVEN * FNDLU NOP CLA,INA ASSUME UNIT 1 SZB IF UNIT SPECIFIED LDA B,I FETCH IT SSA,RSS COMPLEMENT AND CMA,INA,SZA,RSS JMP ERR2 IF <=0 THEN GIVE ERROR 2 STA CNTR SAVE COMP. FOR LOOP COUNTER LDB ..ADC FETCH ADDRESS OF CONFIG. TABLE ADA B,I LEGITIMATE UNIT SSA ADDRESS? JMP ERR2 NO - GIVE ERROR # 2 INB,RSS BUMP TBL PNTR TO 1ST SUBSYS. ENTRY SPC 1 NXTSS ADB B,I FETCH NEXT SUBSYSTEM ENTRY ISZ CNTR UNIT FOUND? JMP NXTSS NO, CONTINUE SEARCH SPC 1 INB FETCH SUBSYSTEM LDB B,I LOGICAL UNIT NUMBER STB LU AND SAVE JMP FNDLU,I RETURN SKP * "AIRDV" PEFORMS ANALOG INPUT FROM THE CHANNELS SPECIFIED IN * A REAL ARRAY. THE RESULTS ARE CONVERTED TO FLOATING POINT VOLTS * AND RETURNED IN ANOTHER REAL ARRAY. * * CALLING SEQUENCE: * CALL AIRDV(NUM1,RCHN,VOLT,ERR) * WHERE: NUM1 - NUMBER OF CHANNELS TO BE READ ( IF N<0 THEN * PERFORM PACED CONVERSION) * RCHN - REAL ARRAY CONTAINING CHANNEL NUMBERS * VOLT - REAL ARRAY FOR CONVERTED DATA * ERR - ERROR RETURN PARAMETER * BIT 0 = OVERFLOW ON AT LEAST ONE READING * BIT 1 = PACE ERROR ON AT LEAST ONE READING * NUM1 NOP RCHN NOP VOLT NOP ERR NOP AIRDV NOP JSB .ENTR FETCH PARAMETER DEF NUM1 ADDRESSES LDA AIRDV 8FSAVE RETURN STA ENTRY ADDRESS LDA NUM1,I FETCH NUMBER OF CHANNELS JSB SETUP GO TO PARAMETER CHECK SPC 2 AIRD1 DLD RCHN,I LOAD NEXT CHANNEL NUMBER FIX CHANGE TO INTEGER JSB FCHN FIND HARDWARE ADDRESS IOR =B100000 SET TO RANDOM MODE IOR PACED OR IN PACE BIT STA CHANL AND SAVE SSB IF GAIN IS NEGATIVE JMP RDHL GO TO HIGH LEVEL READ XOR =B140000 SET UP GAIN STA GCHN CHANNEL ENTRY SPC 1 JSB EXEC ***************************** DEF *+5 LOW DEF .2 LEVEL DEF LU RANDOM DEF RBUF1 READ DEF .2 ***************************** JMP AIRD2 GO TO VOLTAGE CONVERSION SPC 2 RDHL JSB EXEC ************************* DEF *+5 HIGH DEF .2 LEVEL DEF LU RANDOM DEF RBUF2 READ DEF .1 ***************************** SPC 1 AIRD2 SZB,RSS IF TRANSMISSION LOG EQUALS JMP ERR1 ZERO, GIVE ERROR 1 SPC 1 LDB RDNG FETCH READING JSB CONV PERFORM CONVERSION ISZ RCHN BUMP CHANNEL ISZ RCHN ADDRESS ISZ CNTR LAST CHANNEL JMP AIRD1 NO, CONTINUE JMP ENTRY,I YES, RETURN SPC 4 SETUP NOP CLB INITIALIZE ERROR STB ERR,I TO ZERO SSA IF NEGATIVE LDB =B10000 SET STB PACED PACE BIT SSA IF NEGATIVE CMA,INA MAKE POSITIVE STA NUM AND SAVE CMA,INA,SZA,RSS COMPLEMENT # OF CHANNELS JMP ERR2 IF ZERO GIVE ERROR STA CNTR SAVE FOR LOOP COUNTER CMA COMPUTE ADDRESS OF ALS LAST ELEMENT IN ADA VOLT ARRAY VOLT STA TEMP AND SAVE JSB .DST USE BASIC'S DOUBLE STORE DEF TEMP,I TO CHECK ARRAY BOUNDS JMP SETUP,I SKP * "FCHN" IS A SUBROUTINE WHICH FINDS THE ENTRY IN THE 2313 * CONFIGURATION TABLE WHICH CORRESPONDS TO A GIVEN CHANNEL NUMBER * * CALLING SEQUENCE : * "A" CONTAINS THE SOFTWARE ANALOG CHANNEL NUMBER * RETURNED : * "A" CONTAINS THE HARDWARE ADDRESS OF THE DESIRED MPX CHANNEL * "LU" _ LOGICAL UNIT NUMBER OF THE SUBSYSTEM CONTAINING "A" * "ADRS" _ ADDRESS OF THE CONF. TABLE ENTRY FOR "A" * "GAIN" _ GAIN FOR THE CHANNEL (-1 IF HIGH LEVEL) * "REMCH" _ # OF CHANNELS REMAINING IN ENTRY * * IF THE CHANNEL IS OUTSIDE THE BOUNDS OF THE TABLE "FCHN" * BRANCHES TO "ERR2" * FCHN NOP CMA,SSA,INA,SZA COMPLEMENT CHANNEL NUM. RSS IF LESS THAN OR JMP ERR2 EQUAL TO ZERO GIVE ERROR #2 STA MCHN SAVE -(CHANNEL NUM.) STA NMCHN CCA ASSUME STA GAIN HIGH LEVEL LDA ..ADC FETCH ADDRESS OF FIRST STA .ADC INA SUBSYSTEM ENTRY IN CONF. TABLE CLB "B"_ CURRENT SUBSYSTEM # JMP STFCH SEARCH FOR SUBSYS. CONTAINING CHAN. SPC 1 NXSUB STA NMCHN SAVE # OF CHNLS PAST LAST SUBSYS. INB INCREMENT NUMBER OF SUBSYSTEMS CPB .ADC,I LAST SUBSYSTEM? JMP ERR2 YES - GO TO CHANNEL NOT FOUND LDA ADRS FETCH ADDRESS OF ADA ADRS,I NEXT SUBSYSTEM STFCH STA ADRS AND SAVE ADA .2 IS LAST CHANNEL IN LDA A,I CURRENT SUBSYSTEM BEYOND ADA MCHN THE DESIRED SSA CHANNEL? JMP NXSUB NO - GO TO NEXT SUBSYSTEM SPC 1 * SUBSYSTEM CONTAINING CHANNEL FOUND. THE FOLLOWING CODE * SEARCHES THE SUBSYSTEM ENTRY FOR ACTUAL CHANNEL ENTRY * LDA ADRS FETCH THE INA LOGICAL UNIT NUMBER LDB A,I OF THE SUBSYSTEM STB LU AND SAVE ADB =B100 SET UP DMA LU STqB DMALU AND SAVE ADA .2 COMPUTE ADDRESS OF HIGH LEVEL STA ADRS1 SINGLE ENDED CHANNEL COUNT STA ADRS AND SAVE LDB NMCHN FETCH -(CHANNEL IN THIS SUBSYSTEM) RSS NXTEN ISZ ADRS BUMP ENTRY ADDRESS LDA ADRS,I FETCH AND MASK AND =B3777 NEXT ENTRY ADB A CHANNEL IN SSB THIS ENTRY? JMP NXTEN NO, CONTINUE SEARCH SPC 1 INB ENTRY FOUND, STB REMCH SAVE CHANNELS REMAINING ISZ NMCHN COMPUTE -(CHNLS-1) NOP CLA LDB ADRS1 FETCH HL-SE ADDRESS CPB ADRS IF ENTRY IS HIGH LEVEL - SE JMP HLSE1 GO TO COMPUTE LOCATION INB IF ENTRY IS CPB ADRS HIGH LEVEL DIF. JMP HLDIF GO TO COMPUTE DIF. LOCATION * CHANNEL MUST BE LOW LEVEL THEN, SO COMPUTE GAIN LDB ADRS,I FETCH RRL 3 GAIN STA GAIN AND SAVE SPC 2 * TO CONVERT CHANNEL NUMBER TO 2313 HARDWARE ADDRESS THE * FOLLOWING ALGORITHM IS APPLIED: * * BOX = (N-1)/384 (384= 12 SLOTS * 32 CHANNELS/SLOT) * * SLOT.CHANNEL = REMAINDER FROM THE ABOVE QUOTIENT * * WHERE "N" IS THE SUBSYSTEM RELATIVE CHANNEL ADDRESS. SINCE * MULTIPLEXERS CANNOT OCCUPY SLOTS 0-2 IN BOX 0, * 96 MUST BE ADDED TO CHANNEL NUMBERS. * ALSO DIFFERENTIAL INPUT CHANNELS MUST BE COUNTED TWICE. * HLDIF LDA ADRS1,I COMPUTE ADA NMCHN NUMBER HLSE1 ADA NMCHN OF CMA,INA CHANNELS ADA .96 START SLOT =3 CLB COMPUTE DIV .384 HP 2313 ALF,ALF BOX, SLOT ALS AND CHANNEL IOR B ADDRESS LDB GAIN RETURN WITH ADDRESS IN JMP FCHN,I "A" AND GAIN IN "B" SPC 1 .32 DEC 32 .96 DEC 96 .384 DEC 384 SKP * "CONV" IS A SUBROUTINE WHICH CONVERTS 2313 READINGS TO * FLOATING POINT VOLTS. * * CALLING SEQUENCE: * "B" - 2313 READING * * RETURNED: * THE COMPUTED VOLTAGE IS PUT IN THE ADDRESS SPECIFIED BY * "VOLT" AND THEN "VOLT" IS INCREMENTED TO POINT AT THE NEXT * FLOATING POINT LOCATION. * * ERR HAS BIT 0 SET IF OVERFLOW AND BIT 1 SET IF PACE ERROR. * ALSO ON OVERFLOW, + OR - 1E37 IS RETURNED FOR VOLTAGE. * CONV NOP LDA ERR,I LOAD CURRENT ERROR VALUE BRS,SLB,BRS SHIFT READING AND TEST FOR PACE ERROR IOR .2 SET PACE ERROR BIT STA ERR,I SAVE CURRENT VALUE OF ERR BRS,CLE,BRS TOTAL SHIFT 4 PLACES CPB =B3777 IF POS. OVERFLOW, E_1 CCE,RSS AND GO TO OVERFLOW CPB =B174000 IF NEG. OVERFLOW, E_0 JMP OVRFL AND GO TO OVERFLOW LDA B MOVE READING TO A REG. LDB GAIN COMPUTE BLS ADDRESS OF ADB DFCTR CONVERSION FACTOR STB TEMP AND SAVE FLT FLOAT THE 2313 READING FMP TEMP,I MULTIPLY BY CONVERSION FACTOR STVLT DST VOLT,I STORE VOLTAGE IN ARRAY ISZ VOLT COMPUTE NEXT ISZ VOLT FLOATING POINT ADDRESS JMP CONV,I RETURN SPC 1 OVRFL SZA,RSS SET OVERFLOW BIT IOR .1 STA ERR,I IN "ERR" DLD =F1E37 RETURN POSITIVE SEZ,RSS OR NEGATIVE JSB ..FCM INFINITY FOR JMP STVLT READING SKP SKP *************************** DFCTR DEF FACTR+2 FACTR DEC .005,5E-6,1E-5,2E-5,4E-5 DEC 5E-5,1E-4,2E-4,4E-4 RBUF1 OCT 3 ---------------------------------- OCT 2 Q BUFFER DEF GCHN FOR LOW LEVEL RBUF2 OCT 5 --------- OCT 1 Q BUFFER DEF CHANL FOR HIGH LEVEL DEF RDNG ---------------------------------- RDNG NOP SPC 1 M7 DEC -7 .7 OCT 7 SPC 1 GCHN NOP GAIN GAIN NOP BUFFER SPC 1 SKP * "AISQV?" PERFORMS ANALOG INPUT IN SEQUENTIAL ORDER. THE RESULTS * ARE CONVERTED TO FLOATING POINT VOLTS AND RETURNED IN A REAL ARRAY. * * CALLING SEQUENCE: * CALL AISQV(NUM2,SCHAN,VOLT2,ERR1) * WHERE: NUM2 - NUMBER OF CHANNELS TO BE READ ( IF N<0 THEN * PERFORM PACED CONVERSION) * SCHAN - STARTING CHANNEL OF SCAN (IF SCHAN<0 THEN * PERFORMS NUM2 READINGS FROM CHANNEL -SCHAN) * VOLT2 - REAL ARRAY FOR CONVERTED DATA * ERR - ERROR RETURN PARAMETER * BIT 0 = OVERFLOW ON AT LEAST ONE READING * BIT 1 = PACE ERROR ON AT LEAST ONE READING * NUM2 NOP SCHAN NOP VOLT2 NOP ERRA NOP AISQV NOP JSB .ENTR FETCH PARAMETER DEF NUM2 ADDRESSES LDA VOLT2 MOVE VOLT ARRAY ADDRESS LDB ERRA ERROR ADDRESS TO STA VOLT LOCATIONS USED BY UTILITIES STB ERR SHARED BY AIRDV AND AISQV LDA NUM2,I FETCH NUMBER OF CHANNELS JSB SETUP GO TO PARAMETER CHECK LDA VOLT2 SET UP INPUT BUFFER ADA NUM ADDRESS TO LAST HALF OF STA VOLT1 FLOATING PNT. ARRAY "VOLT2" SPC 2 LDA SCHAN,I SAVE START CHANNEL AS NXTSC STA SINGL SINGLE CHAN. FLAG SSA IF NEGATIVE CMA,INA MAKE POSITIVE JSB FCHN FETCH CHANNEL HARDWARE ADDRESS IOR DIGTZ FORM DIGITIZE COMMAND STA CHANL WORD AND SAVE IOR PACED OR IN PACE BIT SSB,RSS IF LOW LEVEL JMP LLSQ GO PROCESS LDB SINGL IF SINGLE CHANNEL SSB SCAN GO TO JMP HLSQR HIGH LEVEL EXEC CALL IOR =B160000 GENERATE SEQUENTIAL LDB ADRS COMMAND, SETTING CPB ADRS1 BIT 0 IF IOR .1 SINGLE ENDED SCAN SPC 1 LDB REMCH LENGTH OF SCAN ADB CNTR IS THE SMALLER CMB,SSB,INB,RSS OF -CNTR CLB OR THE REMAINDER K ADB REMCH OF THE CHANNELS STB NUM IN THIS ENTRY SPC 1 HLSQR STA SEQ SAVE MODE SPC 1 JSB EXEC **************************** DEF *+5 PERFORM DEF .2 HIGH DEF DMALU LEVEL DEF SBUF2 SCAN DEF .3 *********************** AND =B200 SZA,RSS SPC 1 SQCON SZB,RSS IF TRANSMISSION LOG EQUALS JMP ERR1 ZERO, GIVE ERROR 1 * THE FOLLOWING INSTRUCTIONS CONVERT THE DATA JUST READ IN * TO FLOATING POINT AND UPDATE POINTERS "VOLT", AND "VOLT1" * TO POINT AT REMAINING STORAGE. LDA NUM COMPLEMENT CMA,INA NUMBER OF CHANNELS STA LOOPC READ FOR LOOP COUNTER SPC 1 SQC1 LDB VOLT1,I FETCH NEXT READING JSB CONV CONVERT TO FLOATING POINT ISZ VOLT1 BUMP DATA ADDRESS ISZ LOOPC LAST CHANNEL " JMP SQC1 NO - CONTINUE SPC 1 LDB NUM UPDATE -(NUMBER OF CHNLS) ADB CNTR REMAINING SSB,RSS IF CNTR=0 , END OF JMP ENTRY,I SCAN SO RETURN STB CNTR OTHERWISE SAVE LDA NUM COMPUTE NEW ADA SINGL START CHANNEL CMB,INB SAVE POSITIVE NUMBER OF STB NUM CHANNELS REMAINING JMP NXTSC GO TO NEXT SCAN SPC 4 LLSQ XOR =B160000 SET UP STA GCHN GAIN ENTRY XOR =B160000 RESTORE "A" TO DIGITIZE LDB SINGL IF NOT SINGLE SSB,RSS CHANNEL SCAN, IOR =B160000 CHANGE TO SEQUENTIAL STA SEQ AND SAVE SSB IF SINGLE CHANNEL SCAN JMP LLSQR GO PERFORM SCAN AND =B37 COMPUTE THE NUMBER CMA,INA OF CHANNELS REMAINING ADA .32 ON THE ADDRESSED ARS LOW LEVEL CARD ADA CNTR SCAN LENGTH CMA,SSA,INA IS EQUAL CLA TO THE SMALLEST OF ADA CNTR THE FOLLOWING: ADA REMCH 1. # CHNLS LEFT ON CARD CMA,SSA,INA,RSS CLA 2. # CHNLS LEFT IN SCAN ADA REMCH STA NUM 3. # CHNLS LEFT IN TABLE ENTRY SPC 1 LLSQR JSB EXEC *********************** DEF *+5 PERFORM DEF .2 LOW DEF DMALU LEVEL DEF SBUF1 SCAN DEF .5 ************************ SPC 1 JMP SQCON CONVERT DATA TO FLOATING VOLTS SPC 4 SBUF1 OCT 3 ----------------------------- OCT 2 DEF GCHN SBUF2 OCT 3 OCT 1 DEF CHANL OCT 3 OCT 0 DEF SEQ OCT 4 NUM NOP NUMBER OF READINGS VOLT1 NOP DATA STORAGE OCT 3 CLEAN OCT 1 UP OPERATION DEF DIGTZ TO RELEASE LL MPX SPC 4 DIGTZ OCT 120000 M1 DEC -1 SKP * "PACER" SETS UP THE SYSTEM PACER, OR IF THE PACE RATE IS ZERO * TURNS OFF THE SYSTEM PACER. * * CALLING SEQUENCE: * * CALL PACER(RATE,MULT,MODE [,UNIT]) * WHERE: * RATE - BASIC PACER RATE (0 <= RATE <= 256) * MULT - DECADE MULTIPLIER TIMES THE BASIC 1 MICROSECOND * RATE ( 0 <= MULT <= 7 ) * MODE - EXTERNAL/START STOP MODE (BITS 11 AND 12 OF PACER * COMMAND WORD - SEE 12755A MANUAL) * UNIT - SUBSYSTEM NUMBER (OPTIONAL - ASSUMED 1) * RATE NOP MULT NOP MODE NOP UNIT1 NOP PACER NOP JSB .ENTR FETCH PARAMETER DEF RATE ADDRESSES LDA PACER SAVE RETURN STA ENTRY ADDRESS LDB UNIT1 FETCH LOGICAL JSB FNDLU UNIT NUMBER SPC 1 CLB CHECK ALL LDA RATE,I PARAMETERS ASR 5 FOR THE FOLLOWING IOR MULT,I LIMITS: ARS RATE 0 - 255 IOR MODE,I MODE 0 - 3 ARS,ARS MULT 0 - 7 SZA IF ANY PARAMETER OUT OF JMP ERR2 RANGE GIVE ERROR 2 SPC )1 CLA,INA ASSUME ONE STA ENTNM WORD ENTRY LDB DCMD2 FETCH OUTPUT BUFFER ADDRESS LDA MODE,I IF MODE = 0 SZA,RSS AND RATE IS NOT 0 CPA RATE THEN GO TO GENERATE JMP NZMOD PACER COMMAND WORD ADB M1 ELSE, GENERATE A 10 MS DELAY INA BEFORE PROGRAMMED ISZ ENTNM RATE STARTS SPC 1 NZMOD STB DEFBF STORE QUEUE BUFFER ADDRESS LSL 3 GENERATE IOR MULT,I PACER LSL 8 COMMAND IOR RATE,I WORD IOR =B60000 AND STA CMD2 SAVE SPC 1 JSB EXEC ************************ DEF *+5 SET DEF .2 UP DEF LU PACER DEF QBUF DEF .1 ******************************* * AND =B200 SZA JMP ERR1 SPC 1 SZB IF ZERO TRANS. LOG GIVE ERROR 1 JMP ENTRY,I SPC 4 * ERROR ROUTINES FOR 2313 INTERFACE * ERR1 - ERROR NUMBER 1 * ERR2 - ERROR NUMBER 2 * ERRC - ERROR NUMBER (A REGISTER) * ERR1 CLA,INA,RSS SET ERROR TO 1 ERR2 LDA .2 SET ERROR TO 2 ERRC STA ERRNM SAVE ERROR NUMBER JSB ERROR CALL DEF *+3 BASIC DEF ERRNM ERROR DEF ERRMS ROUTINE SPC 1 JMP ENTRY,I RETURN SKP ERRMS DEC 3 ERROR MESSAGE IN ASCII ASC 2,ADC STRING NOTATION SPC 1 QBUF OCT 3 ENTNM NOP DEFBF NOP DCMD2 DEF CMD2 OCT 61412 10 MS START IMMEDIATE CMD2 NOP SKP A EQU 0 B EQU 1 NMCHN EQU NUM1 CNTR EQU NUM2 ERRNM EQU FCHN LU EQU ERRA SINGL EQU AIRDV SEQ EQU GN1 CHANL EQU CHN2 REMCH EQU SGAIN .ADC EQU RATE ADRS EQU NORM ADRS1 EQU SETUP MCHN EQU SCHAN TEMP EQU GCHN AFCTR EQU RGAIN ENTRY EQU AISQV .1 EQU RBUF2+1 .2 EQU RBUF1+1 .3 EQU RBUF1 .5 EQU RBUF2 PACED EQU CHN1 LOOPC EQU FCHN C*DMALU EQU PACER END ASMB,R,L,C,F,B HED BASIC DEVICE SUBROUTINES FOR HP2313B NAM AOV,7 ENT AOV EXT .ENTR,EXEC,ERROR,..DAC SUP A EQU 0 B EQU 1 * * AOV PERFORMS ANALOG OUTPUT TO THE HP2313B DUAL DAC CARD USING * RTE DRIVER DVR62. * * CALLING SEQUENCE: * CALL AOV(NUM,CHAN,VOLT,ERR) * WHERE: * NUM - ABS(NUM) = NUMBER OF OUTPUT VALUES * NUM < 0 PACED OUTPUT * NUM > 0 UNPACED OUTPUT * CHAN - FLOATING POINT ARRAY OF ANALOG OUTPUT CHANNEL NUMBERS * VOLT - FLOATING POINT ARRAY OF OUTPUT VOLTAGES * ERR - NUMBER OF OUTPUT VALUES EXCEEDING MAXIMUM * * IF AN OUTPUT VALUE EXCEEDS THE MAXIMUM, THE MAXIMUM VALUE OF THE * CORRESPONDING SIGN IS OUTPUT AND THE ERROR NOTED IN IERR. * NUM NOP CHAN NOP VOLT NOP ERR NOP AOV NOP JSB .ENTR FETCH PARAMETER DEF NUM ADDRESSES CLB INITIALIZE ERROR STB ERR,I FLAG TO ZERO LDA NUM,I FETCH NUMBER OF CHNLS SZA,RSS IF ZERO JMP ERR2 RETURN SSA IF NEGATIVE LDB =B10000 SET PACE BIT STB PACED AND SAVE SSA,RSS IF POSITIVE CMA,INA COMPLEMENT AND STA NUM SAVE FOR LOOP COUNTER SKP * ANALOG OUTPUT LOOP STARTS HERE AOV1 DLD VOLT,I FETCH OUTPUT FMP =F3200. VOLTAGE AND CONVERT FIX TO INTEGER SOS IF OVERFLOW IS CLEAR JMP STVLT STORE VOLTAGE LDB VOLT,I ELSE, SET DAC TO SSB MAXIMUM POSITIVE CMA OR NEGATIVE VOLTAGE ISZ ERR,I BUMP ERROR COUNTER SPC 1 STVLT AND =B177760 MASK UPPER 12 BITS STA OUTV AND SAVE IN OUTPUT BUFR SPC 1 DLD CHAN,I FETCH CHANNEL NUMBER FIX CONVERT TO INTEGER CMA,SSA,INA,SZA AND COMPLEMENT RSS IF < = 0 THEN JMP ERR2 GIVE ERROR #2 ɐ STA CNTR SAVE -( CHANNEL NUM. ) LDB ..DAC FETCH DAC TABLE ADDRESS ADA B,I IF ADDRESSED SSA CHANNEL IS NOT DEFINED JMP ERR2 GIVE ERROR SPC 1 RSS FDAC STA CNTR SAVE -(#CHANNELS REMAINING) INB BUMP DAC TABLE ADDRESS LDA B,I FETCH NEXT TABLE ENTRY AND =B7 AND MASK OF #CHNLS-1 ADA CNTR ADDRESSED CHANNEL SSA,INA,SZA IN THIS ENTRY? JMP FDAC NO, CONTINUE SEARCH SPC 1 LDA B,I FETCH CHANNEL ENTRY CLB EXTRACT LU ASL 6 FROM ENTRY STB LU AND SAVE ASR 4 SHIFT AND AND =B7740 MASK BOX AND SLOT NUMBER LDB CNTR FETCH CHANNEL CMB NUMBER AND BLF "OR" INTO IOR B COMMAND WORD IOR PACED OR IN PACE BIT IOR =B40001 OR IN COMMAND CODE STA CMND SAVE COMMAND WORD SPC 1 JSB EXEC ************************* DEF *+5 DEF .2 PERFORM DEF LU ANALOG DEF QBUF OUTPUT DEF .1 ************************** * AND =B200 SZA,RSS SPC 1 SZB,RSS IF TRANSMISSION LOG EQUALS JMP ERR1 ZERO, GO TO ERROR 1 SPC 1 ISZ VOLT UPDATE ISZ VOLT VOLTAGE ISZ CHAN AND ISZ CHAN CHANNEL ARRAY POINTERS ISZ NUM LAST CHANNEL? JMP AOV1 NO, CONTINUE JMP AOV,I YES, RETURN SPC 2 ERR1 CLA,INA,RSS ERROR #1 HERE ERR2 LDA .2 ERROR #2 HERE STA ERRNM SAVE ERROR NUMBER JSB ERROR CALL DEF *+3 BASIC'S DEF ERRNM ERROR DEF ERRMS ROUTINE JMP AOV,I AND RETURN SPC 2 ERRMS OCT 3 ASC 2,AOV QBUF OCT 3 .2 OCT 2 DEF CMND SPC 1 CMND NOP OUTV NOP PACETRND NOP ERRNM EQU PACED CNTR NOP LU NOP .1 OCT 1 END 5T 4G 29102-80029 A S 0122 RTE-B 12604 DSI SUB-SYSTEM             H0101 LASMBҬ̬ì HD60BDSɠNKҠBASàϠŠDVҠDVҴ0 NAM6090-6009V.A NԠDS S:90-6009- SNG:90-6009- SUŠAP:90-009 .AP:90-6009 D.BŠ3AP̠V.A NA̠UYUNSUSD SASDBYŠSYSM Ԡ SASDBYBASàANDBASàBAY ԠBƬNVҬD SASDBYANGP.AABŠB. ԠAԬ.DSԬ.N NGUANNMAN NYҠBASàBANHANDMNMNàABŠGNA: DS(ɬɬҬҩSUBDS NYMAԠANDUNN DS(UNVƩ UDSɠADGA̠UNԠN. NNUMBҠƠDGSϠBŠNVD(06 V ƠN0SNDDADNBDMA N0VAUŠƠSؠMSԠSGNANԠDAADGS Ơ ƠN0SԠDADNBDMA N6UNNDG NҠASԠSGNANԠDAADGS DSɠҠMSSAGS Ҡ:PAAMҠ :DAA.NԠDAANVD PGAMMAN UNԠNP NDGNP VAUNP UNàNP DSɠNPNY SB.NҠHPAAMADDSSS DƠUN A SADAҠҠD SANԠAҠҠUN SAGAҠDGԠAG DAUNԬɠHGA̠UNԠN. SAUNANDSAV MANA SSASSUNԠ<0? MPұYS.PAM! SBàN.ADMDV DƠ+5 DƠ. DƠUN DƠSD DƠ. BD0DANDGɠHNUMƠDGSϠNV SZA0:BDUPU? MPDG6N.NԠHK DAMSDYS.SAVŠNDBDD SBA SB.DS DƠVAU DASDSAVŠSԠBDD SBA SB.DS DƠUNì MPDSɬɠBDUPUԠԪ DG6MANASԠUPҠҠN.ƠDGS ADA.5 SANDG DAMSD DBSD SZNDGɠ6DGS? MPDGԷN.NԠHK AƬAƠYS.UNàϠBS0-3 ANDBMASKANDSŠUN SAMP MPNS DGԷSZNDGɠDGS? MPDGԸN.NԠHK ҠYS.SԠUP6DAADGS SZGSԠGϠ MPN DGԸSZNDGɠDGS? MPұN.PAM! ҠYS.SԠUP6DAADGS NԠSBSDSŠSDAADGS B PBGDGS? ̠SHԠVƠDGSNϠB ̠SHԠVƠDGԠNϠB SBMPSŠVƠDG(S AƬAƠGԠMSDAADGNBS0- BNB PBGDGS? AƠYS. ANDB3MASKƠMSDAADGS ADAB00SԠUNàDŠϠҠNV SAMSDSŠMSDGSUN NSDAMSDAD6DAADGSN DBSDABGS SBNVNVDGSϠA MPҲDAA! SB.DS DƠVAUɠSŠNVDVAUŠN'V' A DBMPADUNïҠVƠDGS SBBƠNVϠA MPҲDAA! SB.DSԠSŠN''  DƠUNì MPDSɬɠNVSNԪ ҠPNG ҲSZN ұSZN SB DƠ+3 DƠN DƠMN MPDSɬɠҠԪ NSANS .Dà .Dà .5Dà5 BԠ B3Ԡ3 B00Ԡ00 MNàDà3 ASàDS SAG NԠNPҠUN UNNPGA̠UNԠN. SDNPDAABU MSDNP GNPDGԠAG NDGɠNPN.ƠNDGS MPNPMPUN ND  5= 29103-80002 A S P0122 SXL              H0101 ASMBج̬ 00SP̬̬MϬԬ 00NAMŠS(399 NAMS̬399 .A.U0 .B.U NԠUMAN NԠŴ NԠSK ԠSG ԠSMAN Ԡ.MP ԠPSH ԠDNG ŴԠ000000 SKԠ000000 .Ԡ00000 .Ԡ00003 .3Ԡ00006 .Ԡ00005 003! 00!ŠSYSMSS-ADҠMANN 005! 006! 00ԠSANBŠNSAN(!SANN 00ԠSNؠBŠNSAN(!SYNAؠANAYZ 009ԠDDBŠNSAN(59 00ԠSGNԠBŠNSAN(6!NDؠƠSGN 0ԠSGSMANBŠUNNNA 0Ԡ.MPҬìSPGPSHBŠSUBUNŬNA 03ԠUMANBŠAB̬GBA 0ԠDNGBŠNGҬNA 05ԠŴBŠNGҬGBA̻ 06NAZŠŴϠ0 0ԠSKBŠNGҬGBA̠!ANSҠŠSAKPN 0NAZŠSKϠ0 09! 00S:A̠.MPҠ!GԠNPUԠPAAMS S̠NP SB.MP DƠ+ 0UMN:A̠$(SG(SGNԩ UMNSBSG DƠ+ DƠ. SB.A. DƠ+ 0UMAN:A̠$(SG(DD!GԠNԠSAMN UMANSBSG DƠ+ DƠ. SB.A. DƠ+ 03A̠$(SG(SAN!GԠUSHDD SBSG DƠ+ DƠ.3 SB.A. DƠ+ 0A̠$(SG(SNة!DϠSYNAؠANAYSS SBSG DƠ+ DƠ. SB.A. DƠ+ 05A̠SMAN!DϠSMANàANAYSS SBSMAN DƠ+ 06A̠PSH!UŠMMAND SBPSH   DƠ+ 0NԠDNGHNGϠUMANSŠGϠUMN DADNG SZA MPUMN MPUMAN 0NDS NDS 09ND$ P  6= 29103-80003 B S 0122 SGMTR              H0101 3ASMB,R,L,C NAM SGMTR,8 6/19/75 SXL SEGMENTER ROUTINE .A. EQU 0 .B. EQU 1 ENT SEGNM ENT SEG ENT SGIN2 ENT EXBAS EXT .ENTR EXT EXEC SEGNM ASC 2,SG01 CURRENT SEGMENT OCT 46005 NAME BUFFER; TYPE =5 EXBAS NOP S DEC 1 INITIAL SEGMENT:SG01L .2 OCT 176000 .10 DEC 8 .S DEF S D10 DEC 10 *003 ! *010 LET EXEC BE SUBROUTINE,EXTERNAL *012 LET EXBAS BE INTEGER,GLOBAL *013 ! *014 ! * ENTER HERE DIRECTLY FROM NEW SEGMENT FWS NOP SGIN2 NOP JSB .ENTR DEF FWS *017 GOTO SEG1 JMP SEG1 *018 END *019 ! *020 SEG: FUNCTION(INDEX)GLOBAL INDEX NOP SEG NOP JSB .ENTR DEF INDEX *021 ! *022 !LOAD REQUESTED SEGMENT INTO CORE IF NOT ALREADY THERE *023 !INDEX::REQUESTED SUBROUTINE NUMBER *024 ! LDA FWS HAS A SEGMENT BEEN LOADED YET? SZA,RSS SKIP IF YES JMP SEG2 NO--USE INITIAL VALUE OF S SEG1 LDA FWS,I GET ADDRESS OF DIRECTORY TABLE. ADA INDEX,I * 0 <= TABLE VALUE <2000K THEN USE AS INDEX FOR * NEW SEGMENT NAME. LDA .A.,I STA S *027 IFNOT S AND 176000K THEN GOTO SEG2 AND .2 SZA,RSS JMP SEG2 LDA .S LDA 0,I CHASE RAL,CLE,SLA,ERA DOWN JMP *-2 INDIRECTS JMP SEG,I AND RETURN WITH 15-BIT ADDRESS SEG2 LDA S CLB DIV D10 CONVERT 2-DIGIT DECIMAL ALF,ALF ROTATE QUOTIENT TO HIGH 8 BITS ADA .B. PUT REMAINDER IN LOW 8 BITS ADA =B30060 CONVERT TO TWO-DIGIT ASCII STA SEGNM+1 *036 CALL EXEC(8,SEGNM) JSB EXEC DEF *+3 DEF .10 DEF SEGNM *037 END *038 END END    7> 29103-80004 A S P0122 SPROC              H0101 7ASMBج̬ 00SP̬̬MϬԬ 00NAMŠSP( NAMSPì .A.U0 .B.U NԠASAK NԠAVAU NԠSMAN NԠPSH Ԡ.N ԠPP ԠSAK ԠSG ԠSPG ԠP ԠPP ASAKԠ000000 AVAUԠ000000 SAKԠ000000 ԠBSS .6BSS .BSS .DƠGN .9DƠNK .0DƠGN .DƠNK 003! 00!PSSPASNGSNGSANDPSHSNGS 005! 006ԠSMB̠BŠPSUDϬNA 00ԠASAKBŠNGҬGBA̠!ANSAK 00ԠAVAUBŠNGҬGBA̠!ANUNŠVAU 009ԠPPBŠUNNNA̠!SNGSANPUGŠUY 00ԠSAKBŠPSUDϬNA̠!SAKUY 0ԠSGBŠUNNNA̠!SGMNANUY 0ԠSPGBŠSUBUNŬNA̠!SAKSNGPUG 03ԠSYPBŠPSUDϬNA 0ԠPBŠPSUDϬNA 05NAZŠASAKAVAUSAKϠ3(0 06ԠPҬPPҠBŠNGҬNA 0! 0SP:SUBUN(NSҬGNNK NSҠNP GNNP NKNP SPàNP SB.N DƠNS 09! 00ASAKAVAU_0 A SAASAK SAAVAU 0AAYSD_PP(NSҩ?UNݠ\ HNƠ<0HNSAK(ASAK_Ԭ\ SAVAU_0$(SG(ԩ$(GNݬ\ SŠ$(NK .SBPP DƠ+ DƠNSҬ SZ MPSPì SA SZASS MP. DA SSASS MP. DA SBSAK DƠ+ DƠASAK MP.3 .A SAAVAU SBSG DƠ+ N]DƠ SB.A. DƠ+ DBGN SA.6 SB.B. DƠ+ .3MP.5 .DANK SB. SB.A. DƠ+ .5MP. 0ND 03! 0SMAN:SUBUNŠGBA SMANNP SB.N DƠSMAN 05P_0 A SAP 06NԠPPҠHNUN DAPP SZASS MPSMAN 0SP(PPҬGNNK SBSP DƠ+ DƠPP DƠ. DƠ.9 0P_SAK(SAK SBSAK DƠ+ DƠSAK SAP 09UN MPSMAN 030ND 03! 03GN:SUBUN GNNP SB.N DƠGN 033! 03SAK(SAK_AVAU DAAVAU SBSAK DƠ+ DƠSAK 035A̠SPG(ASAK SBSPG DƠ+ DƠASAK 036UN MPGN 03ND 03! 039NK:SUBUN NKNP SB.N DƠNK 00! 0SAK(ASAK_SAK(SAK SBSAK DƠ+ DƠSAK SBSAK DƠ+ DƠASAK 0UN MPNK 03ND 0! 05! 06PSH:SUBUNŠGBA PSHNP SB.N DƠPSH 0SP(PҬGNNK SBSP DƠ+ DƠP DƠ.0 DƠ. 0UN MPPSH 09ND 050! 05GN:SUBUN GNNP SB.N DƠGN 05! 053ƠAVAUHNSAK(ASAK_AVAU DAAVAU SZASS MP. DAAVAU  SBSAK DƠ+ DƠASAK 05UN .MPGN 055ND 056! 05NK:SUBUN NKNP SB.N DƠNK 05! 059UN MPNK 060ND 06ND ND 06ND$ 0 8@ 29103-80005 1715 S 0122 LDUMM ASM              H0101 ֈASMB,R,L NAM LDUMM,8 REV G 770415 ENT UFREB ENT LOCC ENT BPLOC ENT XCOM ENT DFLCM ENT FWAM ENT LWAM ENT FWABP ENT LWABP ENT FWAC ENT LWAC ENT NXTPG ENT XFER ENT LCOMM ENT NBPLK ENT LWAM1 ENT MAXA ENT MINA ENT MAXAB ENT MINAB ENT XBPLK ENT XMAXA ENT LINKF ENT UNDF1 ENT UNDFS ENT UNDX1 ENT UNDFX ENT EXTX1 ENT EXTX ENT LISTO ENT ABRTF ENT FILEX ENT BPLKS ENT GUESS ENT NGESS ENT NLINK ENT SEC ENT XSEC ENT PXFER ENT XGESS ENT ERCO ENT FREBE ENT .LCAT ENT .POSN ENT .READ ENT ENTR1 ENT DCB4 ENT DCBB4 ENT SLNKS ENT XLNKS ENT SYSIZ ENT XMINA ENT ERR ENT FPNAM ENT DCB ENT DCBBO ENT SODCB ENT SODC4 ENT OBT,CMDLN ENT CHAR,SOURC,SPTR ENT REV EXT RIC,STAK,PRFOP,SMBL ENT CCPTR,PTPTR ENT INLU,EKOLU,LSTLU,OUTLU,DNFLG ENT IAILU * * UFREB NOP 'USED' BP LINKS STACK POINTER. XCOM NOP COMMON LENGTH EACH MODULE DFLCM NOP DEFAULT COMMON FLAG INLU NOP IAILU NOP INTERACTIVE INPUT LU FLAG, =0 IF NON-IA EKOLU NOP LSTLU NOP OUTLU NOP DNFLG NOP CCPTR NOP PTPTR NOP REV NOP REVISION CODE STRING POINTER CHAR NOP SOURC NOP SPTR NOP OBT ASC 1, - BSS 40 COMMAND INPUT BUFFER LOCC OCT 000000 BPLOC OCT 000000 FWAM OCT 000000 LWAM OCT 000000 FWABP OCT 000000 LWABP OCT 000000 FWAC OCT 000000 LWAC OCT 000000 NXTPG OCT 000000 XFER OCT 000000 LCOMM OCT 000000 NBPLK OCT 000000 LWAM1 }< OCT 000000 MAXA OCT 000000 MINA OCT 000000 MAXAB OCT 000000 MINAB OCT 000000 XBPLK OCT 000000 XMAXA OCT 000000 CMDLN NOP LINKF OCT 000000 UNDF1 OCT 000000 UNDFS OCT 000000 UNDX1 OCT 000000 UNDFX OCT 000000 EXTX1 OCT 000000 EXTX OCT 000000 LISTO OCT 000000 ABRTF OCT 000000 FILEX OCT 000000 BPLKS OCT 000000 GUESS OCT 000000 NGESS OCT 000000 NLINK OCT 000000 SEC OCT 000000 XSEC OCT 000000 PXFER OCT 000000 XGESS OCT 000000 ERCO OCT 000000 FREBE OCT 000000 .LCAT OCT 000000 .POSN OCT 000000 .READ OCT 000000 ENTR1 NOP DCB4 DEF DCB+3 SLNKS OCT 000000 XLNKS OCT 000000 SYSIZ DEC 2 # SYMBOL TABLE PAGES -1 XMINA OCT 000000 ERR NOP FPNAM OCT 000000 DCB OCT 020040 OCT 020040 OCT 020040 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 BSS 127 DCBBO OCT 020040 OCT 020040 OCT 020040 DCBB4 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 BSS 127 SODCB OCT 020040 OCT 020040 OCT 020040 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 OCT 000000 * * THE FOLLOWING INITIALIZATIp/ ON CODE IS PART OF THE * DATA CONTROL BLOCK AREA FOR SODCB * * IT IS USED FOR OBTAINING ON,SXL PARAMETERS * RATHER THAN CALLING RMPAR * B EQU 1 M5 DEC -5 .PTR DEF INLU SPC 1 ENT .RMPR .RMPR NOP ENTRY/EXIT LDA .RMPR,I GET RETURN ADDRESS STA .RMPR SAVE LDA B,I GET PARAMETER STA .PTR,I SAVE ISZ .PTR INB ISZ M5 JMP *-5 JMP .RMPR,I BSS 115 SODC4 DEF SODCB+3 *031 END END  9A 29103-80006 A S P0122 ULIBR              H0101 &ASMBҬ̬ NAMUBҬ NԠ..N Ԡ.D .A.U0 .B.U ԱBSS ԲBSS 3BSS ..NҠNP DA..NҬ SAԱADD.ƠSԠ.P. SZ..N DB..NҬ SBԲNYPNԠƠPSUD-VA. SZ..NҠSԠ MAŬNA DB.B. B̬B SBԲɠSԠԠƠPSUD-VA. ADAԲ NA SAԲ(N.Ơ.P.+ B̬ŬB SB3(ADD.ƠSԠA.P.- DB.B. MBNB ADB3-((N.ƠA.P.+ ADA.B. MBNB(N.ƠA.P.+ SSAƠ<0MŠA.P.'SS... DBԲUSŠ.P.UN MBŬNB-(P.UN+ DA3 A̬ASԠA.P.PNҠND SA3 PNBSZBSSNSHD? MP..NҬɠYSSϠ SZ3BUMPA.P.PN SB.DԠHA.P. DƠ3 SAԱɠSԠ.P. SZԱ MPP ND  :@ 29103-80007 A S P0122 DIAG              H0101 p(ASMBج̬ 00SP̬̬MϬԬ 00NAMŠDAG(!DAGNSàS NAMDAG .A.U0 .B.U NԠDAG Ԡ.N ԠSG ԠUMAN ҠBSS DAԠBSS .Ԡ00003 003ԠDGSԠBŠNSAN(3 00ԠSGBŠUNNNA 005ԠUMANBŠAB̬NA 006DAG:SUBUN(NϬDAAGBA NϠNP DAANP DAGNP SB.N DƠN 00_Nϻ DANϬ SA 00DA_DAA!SAVŠPAAMSAY. DADAA SADA 009A̠$(SG(DGSԩ(ҬDAԩ!ADSNGSGMNԦPNԠDAGN SBSG DƠ+ DƠ. SB.A. DƠ+3 DƠ DƠDA 00GϠUMAN MPUMAN 0ND 0ND ND 03ND$ C ;A 29103-80008 A S P0122 SPTRU              H0101 :ASMBج̬ 00SP̬̬MϬԬ 00NAMŠSPU( NAMSPU .A.U0 .B.U NԠP NԠPP NԠP NԠPP NԠDP NԠDP NԠDPP NԠDP NԠS Ԡ.N Ԡ..N ԠGK ԠPUK PPҠBSS AGBSS ɠBSS ʠBSS KBSS DPPƠBSS PVBSS PƠBSS .Ԡ00000 .3Ԡ00000 .6BSS PPVBSS .BSS PVBSS PƠBSS .3Ԡ0 .6Ԡ0003 .Ԡ00000 .Ԡ00 .5BSS PPVBSS DPVBSS DPPVBSS .3BSS DPVBSS SVBSS 003! 00!SNGPNҠUYUNS: 005!P(PSUDϩADSҠSADNSNG 006!ANDNMNSHŠPN. 00!PP(UNNADSADANDNMNSH 00!PNҬPUGNGANYBKS 009!HHAŠMPY. 00!P(PSUDϩSAMŠASPBUԠҠHAA 0!SNGS.AHAAҠSNG 0!PNҠNANSHŠADDSS 03!HŠUNԠDHHŠSGN 0!BԠSԠƠHŠHAAҠSN 05!HŠGHԠHAƠƠHŠD. 06!PP(UNNSAMŠASPPBUԠҠHAA 0!SNGS. 0!DP(UNNADSADSNGNHŠVS 09!DN.USASND 00!AGUMNԠHHSAPNҠ 0!HŠSԠDƠHŠSNG. 0!DPP(UNNMVSASԠDMSNGAND 03!UNSPVUSD. 0!DP(UNNSAMŠASDPBUԠҠHAA 05!SNGS. 06!SҠ(UNNNAZSASNG. 0! 0ԠGKPUKBŠSUBUNŬNA 09! 030ԠPPҬAGɬʬKDPPƠBŠNGҠ!MPAS 03! 03RԠMSKBŠNGҬNSAN(K!N-H 033!NSNUMBҠƠDSNABK 03ԠSBԠBŠNGҬNSAN(00000K!SGNB 035ԠNSBԠBŠNGҬNSAN(K 036ԠHMSKBŠNGҬNSAN(00K!ԠHAƠMASK 03ԠHMSKBŠNGҬNSAN(3K!GHԠHAƠMASK 03ԠMàBŠNGҬNSAN(00K!MNAҠHAA 039! 00P:PSUD(PҩGBA̬ PҠNP PNP SAPV ASZ MA SAP SB..N DƠP DƠP 0ԠPҠBŠNG 0!PҠSPNҠϠNԠPSNNSNGϠB 03!ADMҠNN. 0!VAUŠSDϠBŠADҠN. 05!00000KSNAҠAHDASAMNA. 06!ƠMNAҠSNUNDHNADNGVAU 0!SSԠϠZϠANDUNSMADŠHPNҠUNHANGD. 0!ƠŠSAMPDHPҽ0ANנSNGS 09!AD. 050! 05ƠPƠHNGϠϠP DAP SZA MPP 05NԠPҠHNGϠA̱ DAPҬ SZASS MPA̱ 053PV_$P DAPҬ DA.A. SAPV 05P_P+ DAPҬ NA SAPҬ 055Ơ(PҠANDMSKMSKHNPP_PһP_$P AND. PA. SS MP. DAPҬ SAPP DAPҬ DA.A. SAPҬ 056ƠPVSBԠHNGϠA̱ .DAPV PA.3 MPA̱ 05UN DAPV MPP 05A̱:PV_0 A̱A SAPV 059UN MPP 060P:NԠPҠHNGK(Pҩ PDAPҬ SZA MP. SBYGK DƠ+ DƠPҬ 06D$P_PVP_P+ .DAPҬ DBPV SB.A. DAPҬ NA SAPҬ 06Ơ(PҠANDMSKMSKHNGK($Pҩ\ P_$P AND. PA. SS MP.5 DAPҬ SA.6 SBGK DƠ+ DƠ.6 DAPҬ DA.A. SAPҬ 063$P_SB .5DAPҬ DB.3 SB.A. 06UN DAPV MPP 065ND 066! 06PP:UNN(PPGBA̬ PPNP PPNP SB.N DƠPP 06ԠPPBŠNG 069!PPKSHŠSAMŠASHŠADMƠPP 00!HAԠHŠSNGSPUGDASԠSSANND. 0!HŠNDƠHŠSNGSADHŠNŠSNG 0!SPUGDANDBHHŠVAUŠANDHŠPN 03!AŠSԠϠ0. 0! 05PPVPP_0 A SAPPV SAPP 06PPV_P(PP?PUK(PPPP_0 SBP DƠ+ DƠPP SZSS MP. SA. SBPUK DƠ+ DƠPP A SAPP DA. .SAPPV 0ƠPPҠHNPUK(PPҩ DAPP SZASS MP.9 SBPUK DƠ+ DƠPP 0ƠPPHNUNSŠUN .9DAPP SZASS MP.0 DAPPV MPPP .0DAPPV MPPP 09ND 00! 0P:PSUD(PҩGBA̬ PҠNP PNP SAPV ASZ MA SAP SB..N DƠP DƠP 0ԠPҠBŠNG 03!PSHŠSAMŠASPPԠHAԠԠPAS 0!NHAAҠSNGSNSADƠDSNGS. 05!HAASNHŠVAUŠDAŠGHԠUSD. 06!MàSUSDASAMNA. 0!HŠԠHAƠƠADSDS. 0! 09ƠP<0HNAG_SBԻP_PҠANDNSBݬ\ SAG_0 DAPҬ SSASS MP. DA.3 SAAG DAPҬ AND.3 SAPҬ MP. .A SAAG 090ƠPƠHNGϠϠP .DAP SZA MPP 09NԠPҠHNGϠA̲ DAPҬ SZASS MPA̲ 09PV_HMSKANDƠAGHN$PҬ\ SŠ($P- DAAG SZASS MP. DAPҬ DA.A. MP.5 .DAPҬ DA.A. AƬA .5AND.6 SAPV 093ƠPVMàHNP_PҠҠAG\ GϠA̲ PA. SS MP. DAPҬ ҠAG SAPҬ MPA̲ 09ƠAGHN_P(Pҩ\ SŠP_PҠҠSB .DAAG SZASS MP.9 SBP DƠ+ DƠPҬ SA MP.0 .9DAPҬ Ҡ.3 SAPҬ 095UN .0DAPV MPP 096A̲:PV_0 A̲A SAPV 09UN MPP 09P:NԠPҠHNGK(Pҩ PDAPҬ SZA MP. SBGK DƠ+ DƠPҬ 099ƠAGԫHNP(Pҩ_($PҠANDHMSK(PVANDHMSK\ $P_SBݬ\ S$P_((PVANDHMSK-<\ ҠMû\ P_PҠҠSB .DAAG SZASS MP. DAPҬ DA.A. AND. SA.5 DAPV AND.6 Ҡ.5 SBP DƠ+ DƠPҬ DAPҬ DB.3 SB.A. MP.3 .DAPV AND.6 AƬA Ҡ. DBPҬ SA.B. DAPҬ Ҡ.3 SAPҬ 00UN .3DAPV MPP 0ND 0! 03PP:UNN(PPGBA̬ PPNP PPNP SB.N DƠPP 0ԠPPBŠNG 05!PPSHŠSAMŠASPPPԠHAԠԠPAS 06!NHAAҠSNGS. 0! 0PP_0 A SAPP 09PPV_P(PP?PUK(PPPP_0\ UN SBP DƠ+ DƠPP SZSS MP.6 SBPUK DƠ+ DƠPP A SAPP DAPPV MPPP .6SAPPV 0ƠPPҠHNPUK(PPҩ DAPP SZASS MP. SBPUK DƠ+ DƠPP UN .DAPPV MPPP ND 3! DP:SUBUN(DPҬPҩGBA̬ DPҠNP PҠNP DPԠNP SB.N DƠDP 5ԠDPҬPҠBŠNG 6!DPԠDMNSHŠUNԠPN.ƠHŠUN !PNҠUASHŠNhA̠PNҠANUNS !MAD. 9! 0ƠDPҽPҠHNUN DADPҬ PAPҬ SS MP. MPDPԬ K_DP .DADPҬ SAK NԠKANDMSKHNK_PҠҠMSK\ AAYSDϠ۠\ Ơ$KDPҠHN\ GϠϠDPԱ\ SŠK_$KҠMSK AND. SZA MPDPԱ DAPҬ Ҡ. SAK .9DAK PADPҬ MPDPԱ DAK Ҡ. SAK MP.9 3DPԱ:DP_K- DPԱA ADAK SADPҬ UN MPDPԬ 5ND 6! DP:UNN(DPҬPҩGBA̬ DPҠNP PҠNP DPNP SB.N DƠDP ԠDPҬPҠBŠNG 9!DPADSHŠDPҠϠHŠNŠASԠAD 30!HP.ƠHŠBGNNNGƠHŠSNGS 3!NUNDDPVSSԠϠ0ANDANAUN 3!SMAD. 33! 3DP(DPҬPҩ?GϠA3 SBDP DƠ+3 DƠDPҬ DƠPҬ SZ MPA3 35_DP DADPҬ SA 36DP(ɬPҩ?GϠA3 SBDP DƠ+3 DƠ DƠPҬ SZ MPA3 3DPV_$ DAɬ SADPV 3UN MPDP 39A3:DPV_0 A3A SADPV 0UN MPDP ND ! 3DPP:UNN(DPPPPGBA̬ DPPNP PPNP DPPNP SB.N DƠDPP M ԠDPPPPBŠNG 5!DPPKSHŠSAMŠASDPPԠHŠNDƠHŠSNG 6!SMVDBAKANDMPDBKSAŠPUGD. _DPP DADPP SA DPP_0 A SADPP 9DPPV_DP(ʬPP?DPP_ SBDP DƠ+3 DƠ DƠPP SZSS MP.3 SA.3 ANA SADPP DA.3 .3SADPPV 50$_SB DA.3 SAʬ 5Ơ+DPPHNPUK(DPP DA NA PADPP MP.33 SBPUK DƠ+ DƠDPP 5DPP_ .33DA SADPP 53ƠDPPƠHNUNSŠUN DADPP SZASS MP.3 DADPPV MPDPP .3DADPPV MPDPP 5ND 55! 56DP:UNN(DPҬPҩGBA̬ DPҠNP PҠNP DPNP SB.N DƠDP 5ԠDPҬPҠBŠNG 5!DPSHŠSAMŠASDPPԠHAԠԠPAS 59!NHAAҠSNGS. 60! 6ƠDP<0HNAG_SBݬ\ SŠAG_0 DADPҬ SSASS MP.35 DA.3 SAAG MP.36 .35A SAAG 6_DPҠANDNSB .36DADPҬ AND.3 SA 63_PҠANDNSB DAPҬ AND.3 SA 6DP(ɬʩ?GϠA̴ SBDP DƠ+3 DƠ DƠ SZ MPA̴ 65ƠɽʠHNƠAG0HNƠP<0HN\ GϠA̴ݠ DA PA SS MP.3 0.* DAAG SZA MP.3 DAPҬ SSA MPA̴ 66DP_ƠAGHN(DPҠANDNSBԩ\ SŠ(ɠҠSBԩ .3DAAG SZASS MP.39 DADPҬ AND.3 MP.0 .39DA Ҡ.3 .0SADPҬ 6DPV_HMSKANDƠAGHN$ɬSŠ$- DAAG SZASS MP. DAɬ MP. .DAɬ AƬA .AND.6 SADPV 6UN MPDP 69A̴:DPV_0 A̴A SADPV 0UN MPDP ND ! 3S:UNN(SPҩGBA SPҠNP SҠNP SB.N DƠSP ԠSPҠBŠNG 5!SҠGSABKƠKSPAŠANDUNSA 6!PNҠϠԠNBHSAGUMNԠANDS !VAU.HŠSԠDƠHŠBKSS !ϠMNA.HSUNŠSNNDD 9!NAZŠASNGSNA̠PNҬAND 0!SUNԠPN. ! GK(SPҩ SBGK DƠ+ DƠSPҬ 3SV_SP DASPҬ SASV $SV_SB DA.3 SASV 5UN DASV MPSҬ 6ND ND ND ND$ C0 < I 29103-80009 A S P0122 PAGER              H0101 ASMBج̬ 00SP̬̬MϬԬ 00NAMŠPAG( NAMPAGҬ .A.U0 .B.U NԠUN NԠPAG NԠS NԠS NԠAS NԠKP NԠPD NԠPDSZ NԠS NԠK NԠSSZ NԠSZ NԠD NԠZZZ NԠPAG NԠPGPG NԠGAB NԠGM Ԡ.N Ԡ.MPY Ԡ.DV Ԡ..N ԠBAS ԠDAG Ԡ UNԠBSS PAGŠBSS SԠBSS SԠBSS ASԠBSS KPBSS PDBSS00 PDSZBSS SԠԠ00000 KBSS SSZBSS SZŠBSS DBSS ZZZBSS PAGVBSS PAGƠBSS .3Ԡ000 .BSS .5Ԡ0600 KBSS SàBSS .6BSS .BSS .Ԡ00000 .9Ԡ00000 .0BSS .BSS .Ԡ00000 ADDҠBSS PDNؠBSS KBSS DADBSS .3Ԡ0 ɠBSS .Ԡ .DƠPD .9Ԡ00006 .0Ԡ000000 .Ԡ000003 .3BSS .BSS PGADBSS .Ԡ60 DPNϠBSS .30BSS .3Ԡ00000 MBSS NBSS ѠBSS .3Ԡ00000 003! 00!HSMDUŠHANDSAANƠDYNAMàŠAAҠSYMBS 005!ANDҠKSPA.SYMB̠AANSMHANZDHUAVUA 006!ADDSSNGPAGNGSHMŠHŠKSPAŠSMHANZDHUA 00!DSZŠABSUŠADDSSSHM. 00! 009ԠUNԠBŠNGҬGBA 00ԠBASBŠNGҬNA!SԠDŠMMY 0ԠPAGŠBŠNGҬGBA̠!AGSԠPAGŠNUMB 0ԠUNԠBŠNGҠ!ASԠUSAGŠUN 03ԠSԠBŠNGҬGBA̠!Š7KSPAŠSԠPN 0ԠSԠBŠNGҬGBA̠!SMASԠADDSSNԠUSD 05ԠASԠBŠNGҬGBA̠!AGSԠADDSSNԠUSD 06ԠKPBŠNGҬGBA̠!AGSԠUSABŠADDSSMD 0ԠPD(00BŠNGҠ!PAGŠDYҠSYMB̠AB 0ԠPDSZBŠNGҬGBA 09ԠSԠBŠNGҬGBA!SSN-DBK 00NAZŠSԠϠ! 0ԠDAGBŠSUBUNŬNA 0ԠàBŠSUBUNŬNA 03ԠKBŠNGҬGBA̠!SԠNSNAK 0ԠSSZBŠNGҬGBA̠!N.ƠAKSNNSN 05ԠSZŠBŠNGҬGBA̠!N.ƠSSAK 06ԠDBŠNGҬGBA 0ԠPDBŠNGҠ(00GBA 0ԠZZZBŠNGҬGBA 09! 030!MAMUMS..PAGSADSUA̠ϠHŠSZŠ 03!PDAAYҠSSƠHŠ-ŠSAG. 03! 033PAG:PSUD(PAGA3GBA PAGA3NP PAGŠNP SAPAGV ASZ MA SAPAG SB..N DƠPAGA3 DƠPAG 03! 035!NSSYDSPAGŠDƠVUA̠ADDSS 036! 03ƠPAGƠ\ HNPAGA3_(PAGA3ANDKҠ((PAGV-E 29103-80011 A S P0122 PRFOP              H0101 :ASMBج̬ 00SP̬̬MϬԬ 00NAMŠPP(!PSSAABŠBNAYŠPA NAMPP .A.U0 .B.U NԠPP NԠ NԠNNS NԠN NԠPV NԠNAM NԠN NԠ.V NԠABNY NԠBNY NԠBP0 NԠBPñ NԠBP3 NԠNGH NԠBNYA Ԡ.N ԠNұ ԠNBPK Ԡر Ԡ ԠUND ԠUNDر ԠBPK Ԡ.AD ԠV ԠS ԠGUSS ԠA ԠA ԠMM ԠSAK ԠSG ԠDAG ԠSPG ԠNNK Ԡ ԠASAK àBSS NNSBSS NàBSS PVBSS NAMؠBSS NɠBSS .VƠBSS ABNYDƠBNY BNYBSS60 BASPDƠPBAS PBASŠBSS BBASŠBSS BASŠBSS ABASŠԠ000000 NGHBSS BNYADƠBNY .SAVŠBSS9 NAMSؠBSS .Ԡ0 SHHBSS BNYBSS .DƠBNY .3Ԡ000003 PGHBSS PNBSS PAGŠBSS NP̱BSS NP̲BSS APAGBSS GBBSS àBSS SBSS ƠBSS AàBSS ASBSS AƠBSS DƠBSS BBSS SHBSS BKUPBSS NBKBSS NHBSS AàBSS AàBSS MBSS NؠBSS .Ԡ00006 .6Ԡ00000 .Ԡ0000 .9Ԡ00000 .0Ԡ00006 .Ԡ00000 .3Ԡ000063 .5Ԡ0000 BNBSS BNBSS .Ԡ000005 .Ԡ00003 .9BSS .0Ԡ00003 NGSSBSS .Ԡ00003 003!DNŠNDؠϠBŠUSDϠBANHŠPPҠSGMNԠҠAH 00!YP: 005ԠSKPҠBŠNSAN(6 006ԠNAMҠBŠNSAN(9!NAMҠSUBUNŠND 00ԠNԠBŠNSAN(50 00ԠԠBŠNSAN(5 009ԠDB̠BŠNSAN(5 00ԠNDҠBŠNSAN(5 0ԠNDҲBŠNSAN(6 0ԠNұNBPKرجUNDجUNDرBPKBŠNGҬNA 03Ԡ.ADVSìGUSSAìAìMMBŠNGҬNA 0ԠìNNSNìPVNAMجNɠBŠNGҬGBA 05Ԡ.VƠBŠNGҬGBA 06ԠABNYBŠNGҬGBA̻ 0NAZŠABNYϠBNY 0ԠSAKBŠPSUDϬNA 09ԠSGPPBŠUNNNA 00ԠDAGSPGMV.BŠSUBUNŬNA 0! 0!ANBASS: 03!PBASŠҠPGAMAABŠDAA 0!BBASŠҠBASŠPAGŠAABŠDAA 05!BASŠҠMMNAABŠDAA 06!ABASŠҠABSU(NϠANBASũ 0! 0ԠBASPPBASŬBBASŬBASŬABASŠBŠNG 09NAZŠBASPϠPBASŻ 030NAZŠABASŠϠ0 03ԠBP0BPñBP3BŠAB̬GBA 03ԠNGHBŠNGҬGBA 033ԠBNYBŠNG(60GBA 03ԠBNYABŠNGҬGBA̻ 035NAZŠBNYAϠBNY 036Ԡ.SAVŠBŠNG(9 03ԠNNKìASAKBŠNGҬNA 03PP:SUBUNŠGBA PPNP SB.N DƠPP 039NAMS_SAK(ASAKANDK!GԠMDUŠNAMŠSԠPN SBSAK DƠ+ DƠASAK AND. SANAMS 00SHH_(-SAK(ASAK-!GԠMASҠSAHAG SBSAK DƠ+ DƠASAK MAmNA B ADB.A. SBSHH 0! 0BNY_BNY+3 DA. ADA.3 SABNY 03BP0:N_BNY BP0DABNY SAN 0A̠$(SG(NAMҩ\ADNAMDPSSҠSGMN (NAMجNAMSجPGHPNVPAGŬNP̱\ NP̲APAGGBìSƬAì\ ASAƬDƬBSHSHH\ BKUP.SAVŬNBKNHAìAìMPBASŬ\ BASŬBBASŬNجNұ SBSG DƠ+ DƠ. SB.A. DƠ+33 DƠNAM DƠNAMS DƠPGH DƠPN DƠV DƠPAG DƠNP̱ DƠNP̲ DƠAPAG DƠGB DƠ DƠS DƠ DƠA DƠAS DƠA DƠD DƠB DƠSH DƠSHH DƠBKUP DƠ.SAV DƠNBK DƠNH DƠA DƠA DƠM DƠPBAS DƠBAS DƠBBAS DƠN DƠNұ 05! 06!UNHŠMSGMNSׯNנDNBNY. 0! 0BPñ:ƠàHNA̠DAG(5NAMة!DSUNŠ BPñDA PA.6 SS MP.5 SBDAG DƠ+3 DƠ. DƠNAM 09ƠSH<0HNGϠSKP .5DASH SSA MPSKP 050N_BNY DABNY SAN 05ƠýHNA̠$(SG(Nԩ\PSSҠNԠ: (BASPSHNة DA PA.9 SS MP. SBSG DƠ+ DƠ.0 SB.A. DƠ+ DƠBASP DƠSH DƠN 05ƠSHHNGϠSKP!ƠS̠SAHNGHNGϠSK .DASH SZA MPSKP 053ƠýHNA̠$(SG(ԩ\PSSԠD (ة DA PA. SS MP. SBSG DƠ+ DƠ.3 SB.A. DƠ+ DƠ 05Ơý3HNA̠$(SG(DB̩\PSSDB̠D (NP̱NP̲BASPNHAPAG .DA PA.3 SS MP. SBSG DƠ+ DƠ.5 SB.A. DƠ+6 DƠNP̱ DƠNP̲ DƠBASP DƠNH DƠAPAG 055Ơý5HNA̠$(SG(NDҩ\PSSNDD (PGHNHNP̱NP̲GBNBKV\ DƬBKUPìSƬ\ AìASAƬ.SAVŬBPBASŬPNBNBN\ A̠$(SG(NDҲ\ (PGHVBASPDƬBBNBN .DA PA. SS MPBP3 SBSG DƠ+ DƠ. SB.A. DƠ+ DƠPGH DƠNH DƠNP̱ DƠNP̲ DƠGB DƠNBK DƠV DƠD DƠBKUP DƠ DƠS DƠ DƠA DƠAS DƠA DƠ.SAV DƠB DƠPBAS DƠPN DƠBN DƠBN SA.9 SBSG DƠ+ DƠ.0 SB.A. DƠ+ DƠPGH DƠV DƠBASP DƠD DƠB DƠBN DƠBN 056BP3:A̠SPG(NAMSة BP3SBSPG DƠ+ DƠNAMS 05UN MPPP 05SKP:A̠$(SG(SKPҩ\ (B.SAVŬAìAìMNGSS SKPSBSG DƠ+ DƠ. SB.A. DƠ+ DƠB DƠ.SAV DƠA DƠA DƠM DƠNGSS 059ND 060ND ND 06ND$ D& ? I 29103-80012 A S P0122 DTSTR              H0101 AASMBج̬ 00SP̬̬MϬԬ 00NAMŠDS( NAMDSҬ .A.U0 .B.U NԠSAK NԠSPG Ԡ.N Ԡ..N ԠGK ԠPUK ԠPUԴ SAKVBSS SAKƠBSS ɠBSS .Ԡ00000 .5Ԡ0 ؠBSS 003! 00!HSMDUŠNANSPDUSҠANGANDASSNG 005!SAKSNKSPA. 006! 00ԠGKBŠSUBUNŬNA̠!ҠBANNGKSPAŠBK 00ԠPUKBŠSUBUNŬNA̠!ҠUNNGKSPAŠBK 009ԠPUԴBŠSUBUNŬNA̠!UNSHA-BKS 00! 0!SAK::PUSHPP 0! 03SAK:PSUDϠ(SA3GBA̬ SA3NP SAKNP SASAKV ASZ MA SASAK SB..N DƠSA3 DƠSAK 0NԠSAKƠHNGϠSA̱ DASAK SZASS MPSA̱ 05NԠSA3ANDKHN\PUSH GK(ɩ_+$_SA3SA3_ DASA3 AND. SZA MP. SBGK DƠ+ DƠ DA ADA. SA DASA3 SAɬ DA SASA3 06SA3_SA3- .A ADASA3 SASA3 0$SA3_SAKV DBSAKV SB.A. 0UN DASAKV MPSAK 09! 00SA̱:NԠSA3HNSAKV_0UNݬSŠSAKV_$SA3!PP SA̱DASA3 SZA MP.3 A SASAKV MPSAK .3DASA3 DA.A. SASAKV 0N(SA3_SA3++ANDKHN\ _SA3SA3_$SA3PUK(ɩ DASA3 NA SASA3 NA AND.f   SZA MP. DASA3 SA DASA3 DA.A. SASA3 SBPUK DƠ+ DƠ 0UN .DASAKV MPSAK 03ND 0! 05! 06!SPGUNSBKSƠDSHҠSNGSҠSAKS 0!HŠŠKSPAŠAAZNGSAGUMNԠNUN. 0!HŠASԠBKNHҠSUNDBYHANNGHUHŠBKS 09!UN̠HŠASԠDNABKSZ. 030! 03SPG:SUBUNŠ(SPԩGBA SPԠNP SPGNP SB.N DƠSP 03SP_SPԠANDK!MASKƠHA.-SGNB DASPԬ AND.5 SASPԬ 033NԠSPԠHNUN SZASS MPSPG 03Ơ$(SPԠҠK<0HNA̠PUԴ(SPԩUN DASPԬ Ҡ. DA.A. SSASS MP. SBPUԴ DƠ+ DƠSPԬ MPSPG 035HŠSPԠDϠSP_$(_SPݠҠPUK(ة .DASPԬ SZASS MP. DASPԬ SA Ҡ. DA.A. SASPԬ SBPUK DƠ+ DƠ MP. 036UN .MPSPG 03ND 03! 039NDDS ND 00ND$ "#  @G 29103-80013 A S P0122 PUT4              H0101 "ASMBج̬ 00SP̬̬MϬ 00NAMŠPUԴ( NAMPUԴ .A.U0 .B.U NԠPUԴ Ԡ.N Ԡ.D ԠŴ ԠPUK ɠBSS .Ԡ00 ʠBSS KBSS 003! 00ԠŴBŠNGҬNA 005ԠPUKBŠSUBUNŬNA 006! 00PUԴ:SUBUNŠ(PPҩGBA̠!DAAS-DBKS PPҠNP PUԴNP SB.N DƠPP 00! 009_PPҠAND0K DAPPҬ AND. SA 00_Ŵ SB.D DƠŴ SA 0HŠK_$ݠDϠ\ Ơ(KAND0Kɠ\ HN$_$KPUK(KGϠPݬ\ SŠ_K .DAʬ SAK SZASS MP.3 DAK AND. PA SS MP. DAK SAʬ SBPUK DƠ+ DƠK MPP .DAK SA MP. 0$PP_Ŵ .3DAPPҬ DBŴ SB.A. 03Ŵ_PP DAPPҬ SAŴ 0P:PP_0 PԠA SAPPҬ 05UN MPPUԴ 06! 0ND 0ND ND 09ND$ O AG 29103-80014 A S P0122 FU5S              H0101 cAASMBج 00SP̬̬MϬԬ 00NAMŠU5S( NAMU5S .A.U0 .B.U NԠSMB Ԡ..N ԠGAB SMBVBSS SMBƠBSS ɠBSS ʠBSS .3Ԡ000 .Ԡ000003 003ԠGABBŠSUBUNŬNA 00SMB:PSUD(SGBA SNP SMB̠NP SASMBV ASZ MA SASMB SB..N DƠS DƠSMB 005_S DAS SA 006GAB(ɬʩ SBGAB DƠ+3 DƠ DƠ 00ƠSMBƠ\ HN$_SMBV$(-(ɠANDK+3_ݬ\ SŠSMBV_$ DASMB SZASS MP. DASMBV SAʬ DA AND.3 MANA ADA ADA. BNB SB.A. MP. .DAʬ SASMBV 00UN .DASMBV MPSMB̬ 009ND 00ND ND 0ND$ m BH 29103-80015 A S P0122 SG01L              H0101 ASMBج NAMSG0̬5 NԠSG ԠUMAN ԠSGN ԠBANK ԠAM Ԡ ԠSNS Ԡ ԠSP ԠS ԠDG ԠN ԠBNK ԠDG ԠN ԠDN ԠSAN B̠DƠ DƠBANK DƠAM DƠ DƠSNS DƠ DƠSP DƠS DƠDG DƠN DƠBNK DƠDG DƠN DƠDN DƠSAN DƠ DƠ DƠ DƠ DƠ DƠ DƠ DƠ DƠ DƠ DƠ3 DƠ DƠ5 DƠ5 DƠ5 DƠ5 DƠ6 DƠ DƠ DƠ DƠ DƠ DƠ9 DƠ9 DƠ9 DƠ9 DƠ9 DƠ9 DƠ9 DƠ9 DƠ9 DƠ9 DƠ0 DƠ DƠ DƠ DƠ DƠ3 DƠ3 DƠ3 DƠ DƠ DƠ5 DƠ6 DƠ DƠ DƠ9 DƠ0 DƠ0 DƠ0 DƠ DƠ DƠ SGNP SBSGN DƠ+ DƠB NDSG  CI 29103-80016 A S P0122 PARSE              H0101 -ASMBج̬ 00SP̬̬MϬԬ 00NAMŠPAS( NAMPASŬ .A.U0 .B.U NԠPAS Ԡ.N ԠSAK ԠSG ԠHA SBSS PPBSS GPBSS VPBSS DƠBSS .Ԡ000003 .Ԡ00000 .Ԡ000000 003! 00!PASNGAGHM 005ԠSAKBŠPSUDϬNA 006ԠSGDԠBŠUNNNA 00ԠSPPGPVPDƠBŠNG 00ԠHAҠBŠNGҬNA 009ԠPUSHPPBŠSUBUN 00! 0PAS:SUBUN(ԬAGNԬANìADé\ ԬGBA ԠNP AGNԠNP ANàNP ADàNP PASŠNP SB.N DƠ 0! 03GP_Ի DAԬ SAGP 0SPPVP_0!NAZAN A SAS SAPP SAVP 05A̠$(ANé(!GԠSԠHAA DAANì SB.A. DƠ+ 06! 0B:HŠD_$(GP+ݾ0DϠ\DNŠP PUSHPP_SGP_DƻVP_0 BDAGP NA DA.A. SAD MANA SSASS MP. SBPUSH DƠ+ DAS SAPP DAD SAGP A SAVP MPB 0NԠHAҠHNGϠM .DAHA SZASS MPM 09ƠDƠHNA̠$(SG($GP(HAҩ?GϠϠMݬ\P-M SŠƠHAң$GPHNGϠϠMݠ!MAH DAD SZASS MP.3 SBSG DƠ+ DƠGP SB.A. DƠ+ DƠHA SZ MPM MP. .3DBHA PBGP SS MPM 00! 0;VP_ƠHA<0HNHAҬSŠ-HAݠ!SԠVSAK .DAHA SSASS MP.5 DAHA MP.6 .5DAHA MANA .6SAVP 0A̠$(ANé(!GԠNԠHAA DAANì SB.A. DƠ+ 03G:DϠPUSHGP_$(GP+3VP_0ݠ!SUSS GSBPUSH DƠ+ DAGP ADA. DA.A. SAGP A SAVP 0H:ƠGP0HNGϠϠB!GϠϠDNŠP HDAGP MANA SSA MPB 05A̠$(AGNԩ(SPPGPVP!GNA DAAGNԬ SB.A. DƠ+5 DƠS DƠPP DƠGP DƠVP 06ƠSHNGϠϠG!GϠAHAD DAS SZA MPG 0NԠHAҠHNUNSŠUN!DN DAHA SZA MP. MPPASŬ . MPPASŬ 0! 09M:DϠGP_ƠGPHN$(GP+SŠ0ݻ\ VP_0ݠ!GԠANA MDAGP SZASS MP.9 DAGP ADA. DA.A. MP.0 .9DA. .0SAGP A SAVP 030ƠGPHNGϠϠH!GϠϠDƠP DAGP SZA MPH 03DϠPPNԠSHNUNݠ!BAKAK SBPP DƠ+ DAS SZA MP.3 MPPASŬ 03ƠVP0HNUN\D SŠƠVP<0HNA̠$(ADé(ݠ!D .3DAVP MANA SSASS MP.5 MPPASŬ .5DAVP SSASS MP. DAADì SB.A. DƠ+ 033GϠϠM]B !YAGAN .MPM 03ND 035! 036PUSH:SUBUN PUSHNP SB.N DƠPUSH 03DϠSAK(S_VPSAK(S_GPSAK(S_PP DAVP SBSAK DƠ+ DƠS DAGP SBSAK DƠ+ DƠS DAPP SBSAK DƠ+ DƠS 03UN MPPUSH 039ND 00! 0PP:SUBUN PPNP SB.N DƠPP 0DϠPP_SAK(SGP_SAK(SVP_SAK(S SBSAK DƠ+ DƠS SAPP SBSAK DƠ+ DƠS SAGP SBSAK DƠ+ DƠS SAVP 03UN MPPP 0ND 05ND ND 06ND$ s DL 29103-80017 A S P0122 SCNMN              H0101 )ASMBج̬ 00SP̬̬MϬԬ 00NAMŠSNMN( NAMSNMN .A.U0 .B.U NԠSAN NԠN NԠD Ԡ.N Ԡ.D ԠPAS ԠSPG ԠDAG ԠS ԠDP ԠSG ԠP ԠSAK ԠSGM ԠP ԠHA ԠSU ԠSP DŠBSS .DƠGN .DƠN .3DƠD .BSS .5Ԡ000000 .6Ԡ000005 SBSS ASҠBSS .Ԡ00000 PPBSS GPBSS VPBSS 003! 00!SANNҠMANMDUŬNANNG: 005!SAN:SANUNNADBYMPҠ 006!NìDìGNԬDԠUNSBŠPASSD 00!HŠPASNGAGHM(NԠGBA̩. 00! 009ԠPASŬSPGDAGàBŠSUBUNŬNA 00ԠSҬDPSGBŠUNNNA 0ԠPPSAKBŠPSUDϬNA 0ԠSGMPҬHAҬSUìSPҠBŠNGҬNA 03SAN:SUBUNŠGBA SANNP SB.N DƠSAN 0P_S(Dũ SBS DƠ+ DƠD SAP 05PAS(SGMGNԬNìDé\ ?GϠϠA SB.D DƠSGM SA. SBPAS DƠ+5 DƠ. DƠ. DƠ. DƠ.3 SZ MPA 06A̠SPG(SUé SBSPG DƠ+ DƠSU 0UN MPSAN 0! 09A:HA_P(SPҩ A̠ SBP DƠ+ DƠSP SAHA 00GϠDAG5 MPDAG5 0NDSAN 0! 03N:SUBUNŠGBA NàNP SB.N FDƠN 0HA_P(SPҩ?(0 SBP DƠ+ DƠSP SZ DA.5 SAHA 05UN MPNì 06NDN 0 0!DAGNSàDŠ5:GA̠HAAҬҠNϠү 09DAG5:A̠DAG(5HAҩ DAG5SBDAG DƠ+3 DƠ.6 DƠHA 030! 03D:SUBUNŠGBA DàNP SB.N DƠD 03HA_DP(SPҬSUé SBDP DƠ+3 DƠSP DƠSU SAHA 033UN MPDì 03NDD 035! 036GN:SUBUN(SKPPGV SKPNP PNP GNP VNP GNԠNP SB.N DƠSKP 03ԠSKPPGVBŠNG 03S_SKP DASKP SAS 039AS_0 A SAAS 00SAK(ASҩ_00000K DA. SBSAK DƠ+ DƠAS 0AAYSDPP_SAK(SGP_SAK(S\ VP_SAK(S\ NԠPPPHNGϠϠGNұ\ SAK(ASҩ_VP . SBSAK DƠ+ DƠS SAPP SBSAK DƠ+ DƠS SAGP SBSAK DƠ+ DƠS SAVP DAP PAPP SS MPGNұ DAVP SBSAK DƠ+ DƠAS MP. 0GNұ:$(SG($GP(ASҬDŬV GNұSBSG DƠ+ DƠGP SB.A. DƠ+ DƠAS DƠD DƠV 03P_PP DAPP SAP 0G_GP DAGP SAG 05|L SKP_S DAS SASKP 06UN MPGNԬ 0NDGN 0! 09ND ND 050ND$  EM 29103-80018 C S 0122 SCGRM ASMB (NO SPL)             H0101 ;ASMB NAMSGM NԠSGM SGM:SNSԬ+SANNҠGAMMA SGMDà DƠ+3 Ԡ0 Ԡ0 SG:Ҭ-+ SGDà5 Ԡ DƠ+ Ԡ0 BANKSG+SG Dà DƠSG DƠ+ DƠSG AMSG5SG Dà DƠSG5 Ԡ0 DƠSG SG:BNKì-+ SGDà0 Ԡ Ԡ0 DƠ+ BNKì-- Dà0 Ԡ Ԡ DƠ-3 SG5:NìBD+ SG5Dà DƠBD DƠ+ Ԡ0 DNԬSG9+ Dà3 DƠSG9 DƠ+ Ԡ0 SPì- Dà6 Ԡ Ԡ0 Ԡ0 BD:'-'++ BDDà Ԡ DƠSG DƠ+ DGԬ-+ Dà Ԡ DƠ+ DƠ-3 'D' Ԡ0 Ԡ0 Ԡ0 Ԡ0 SG:DGԬ-+ SGDà Ԡ Ԡ0 DƠ+ DGԬ-- Dà Ԡ Ԡ DƠ-3 SG9:Ҭ-+ SG9Dà3 Ԡ Ԡ0 DƠ+ Ҭ-+ Dà3 Ԡ DƠ+ DƠ-3 DGԬ--- Dà Ԡ Ԡ DƠ- ND    FM 29103-80019 A S P0122 SCNSM              H0101 /ASMBج̬ 00SP̬̬MϬԬ 00NAMŠSNSM( NAMSNSM .A.U0 .B.U NԠP NԠSNS NԠBANK NԠAM NԠN NԠDN Ԡ.N Ԡ.MPY ԠSPG ԠGAB ԠGM ԠD ԠP ԠSYP ԠSVU ԠPP ԠNSY ԠDP ԠS ԠHA MPBSS .3Ԡ00003 .BSS .5Ԡ0 NҠBSS .Ԡ00000 .0BSS NBSS ADؠBSS .Ԡ00000 NBSS SGNBSS .3Ԡ0000 .Ԡ000055 .9Ԡ .0Ԡ0000 NBSS NԠBSS .BSS .3Ԡ00000 .Ԡ000000 .6BSS .Ԡ0000 .BSS DNVBSS SPҠBSS NPҠBSS DBSS ɠBSS SDBSS .9Ԡ00000 SNPҠBSS .3Ԡ00000 PKSMVBSS PKBSS PKBSS DMYBSS PKMPBSS 003! 00!SANNҠSMANàUNS 005! 006ԠSPGGABGMNìDàBŠSUBUNŬNA 00ԠPSYPSVUABBŠPSUDϬNA 00ԠPPNSYDPSҠBŠUNNNA 009ԠHAҠBŠNGҠNA 00ԠNSBԠBŠNGҬNSAN(K 0ԠPMNԬPAKBŠSUBUN 0ԠDNPKSMBŠUNN 03! 0SNS:SUBUN(SSSSSS3GBA SSNP SSNP SS3NP SNSԠNP SB.N DƠSS 05AAYSDMP_PP(SS?GϠϠSN .SBPP DƠ+ DƠSS SZ MPSN SAMP MP. 06SN:P(SS_(-MP-< SNDAMP MANA AƬA SBP DƠ+4 DƠSS 0Ơ-MP3KHND(HA_0 DAMP MANA PA.3 SS MP. SBD DƠ+ A SAHA 0UN .MPSNSԬ 09NDSNS 00! 0P:SUBUN(PPP3GBA PNP PNP P3NP PNP SB.N DƠP 0ԠPPP3BŠNG 03P(PMP_DN(PKSM(P SBPKSM DƠ+ DƠP SA. SBDN DƠ+ DƠ. SBP DƠ+ DƠP SAMP 0P3_MPANDNSB AND.5 SAP3 05UN MPP 06ND 0! 0! 09! 030BANK:SUBUN(BNKBNKBNK3GBA BNKNP BNKNP BNK3NP BANKNP SB.N DƠBNK 03ԠBNKBNKBNK3BŠNG 03N_0 A SAN 033AAYSDMP_PP(BNK?GϠϠḆݻ\ N_N+ .6SBPP DƠ+ DƠBNK SZ MPḆ SAMP DAN NA SAN MP.6 03Ḇ:P(BNK_0000KҠN ḆDA. ҠN SBP DƠ+ DƠBNK 035BNK3_N DAN SABNK3 036UN MPBANK 03NDBANK 03! 039AM:SUBUN(AMAMAM3GBA AMNP AMNP AM3NP AMNP SB.N DƠAM 00ԠAMAMAM3BŠNG 0ƠMP_P(MP_AMݩݾ0HN۠\ SPG(AMAM3_MPݬ\ SŠA̠P(AMAMAM3 DAA5=M SAMP SA.0 SBP DƠ+ DƠ.0 SAMP MANA SSASS MP. SBSPG DƠ+ DƠAM DAMP SAAM3 MP.9 .SBP DƠ+ DƠAM DƠAM DƠAM3 0UN .9MPAM 03NDAM 0! 05! 06N:SUBUN(NԱNԲN3GBA NԱNP NԲNP N3NP NàNP SB.N DƠNԱ 0ԠNԱNԲN3BŠNG 0N_NԱ DANԱ SAN 09AD_ DA. SAAD 050N_0 A SAN 05SGN_ ANA SASGN 05!UNԠƠDGS 053AAYSD۠ƠMP_-P(N?GϠNñݣ"D"HN\ ƠMP"-"HN\DPMNUSMSNG NԱ_NSGN_-ݬ\SUPҠNG. SŠN_N+ݬ\ SŠAD_0 . SBP DƠ+ DƠN SZ MPNñ MANA SAMP PA.3 MP. DAMP PA. SS MP.5 DAN SANԱ A SASGN MP.6 .5DAN NA SAN .6MP. .DA.0 SAAD .MP. 05Nñ:N_NԱ NñDANԱ SAN 055N_0 A SAN 056PAԠNMSDϠN_NԪAD+(-P(NANDK DAN SA. .A ADA. SA. SSA MP.5 DAN 1SB.MPY DƠAD SA.6 SBP DƠ+ DƠN MANA AND. ADA.6 SAN MP. 05P(NԲMP_DN(PKSM(NԱ .5SBPKSM DƠ+ DƠNԱ SA.6 SBDN DƠ+ DƠ.6 SBP DƠ+ DƠNԲ SAMP 05N3_MPANDNSB AND.5 SAN3 059SYP(MP_SYP(MPҠ SBSYP DƠ+ DƠMP Ҡ.3 SBSYP DƠ+ DƠMP 060SVU(MP_NԪSGN!PUԠNVAU DAN SB.MPY DƠSGN SBSVU DƠ+ DƠMP 06UN MPNì 06NDN 063! 06DN:SUBUN(DDD3GBA DNP DNP D3NP DNԠNP SB.N DƠD 065ԠDDD3BŠNG 066P(DMP_DN(PKSM(D SBPKSM DƠ+ DƠD SA. SBDN DƠ+ DƠ. SBP DƠ+ DƠD SAMP 06D3_MPANDNSB AND.5 SAD3 06UN MPDNԬ 069NDDN 00! 0! 0DN:UNN(SYM SYMNP DNNP SB.N DƠSYM 03ԠSYMBŠNG 0SP_0 A SASP 05DƱ:NP_SYM DƱDASYM SANP 06D_P(NPҩ SBP DƠ+ DƠNP SAD 0DƲ:SP_NSY(SPҩ?GϠϠN DƲSBNSY DƠ+ DƠSP SZ MPN SASP 0GAB(SPҬɩ SBGAB DƠ+3 DƠSP DƠ 09SD_$(+ DA ADA.9 DA.A. SASD 00ƠSD<0HNGAB(SDSNPҩSD_$SNP SSASS MP.30 SBGAB DƠ+3 DƠSD DƠSNP DASNPҬ SASD 0ƠSDDHNGϠϠDƲ .30DASD PAD SS MPDƲ 0D3:D_P(NPҩ?GϠϠD D3 SBP DƠ+ DƠNP SZ MPD SAD 03ƠSDAND00KHNGϠϠDƲ DASD AND.3 SZA MPDƲ 0SD_$(SNP_SNP+ݩ DASNP NA SASNP DA.A. SASD 05ƠSDDHNGϠϠD3SŠGϠϠDƱ PAD SS MPDƱ MPD3 06N:A̠GM(0SPҩ NҠSBGM DƠ+3 DƠ. DƠSP 0N_ ANA SAN 0AAYSDD_P(NPҩ?GϠϠNԱݻ\ N_N+ .3 SBP DƠ+ DƠNP SZ MPNԱ SAD DAN NA SAN MP.3 09NԱ:GAB(SPҬɩ NԱSBGAB DƠ+3 DƠSP DƠ 090ƠNҽHN$(+_DGϠϠD DAN PA.3 SS MP.33 DA ADA.9 DBD SB.A. MPD 09GM(NҬSNPҩ .33SBGM DƠ+3 DƠN DƠSNP 09$(+_SNP DA d ADA.9 DBSNP SB.A. 093GAB(SNPҬSNPҩ SBGAB DƠ+3 DƠSNP DƠSNP 09NP_SYM DASYM SANP 095Ҡ_ϠNҠD$SNP_PP(SYM\ SNP_SNP+ ANA SA MP.35 .3DA NA SA .35DA MANA ADAN SSA MPD SBPP DƠ+ DƠSYM SASNPҬ DASNP NA SASNP MP.3 096D:SPG(SYM DؠSBSPG DƠ+ DƠSYM 09DNV_SP DASP SADNV 09UN MPDN 099ND 00! 0PKSM:UNN(PKPҩ PKPҠNP PKSMNP SB.N DƠPKP 0ԠPKPҠBŠNG 03PK_S(PK SBS DƠ+ DƠPK SAPK 0PAK(PKPҬPK SBPAK DƠ+3 DƠPKPҬ DƠPK 05DMY_DP(PKPK SBDP DƠ+3 DƠPK DƠPK SADMY 06$PK_$PKҠ00K DAPK Ҡ.3 SAPK 0PKSMV_PK DAPK SAPKSMV 0UN MPPKSM 09ND 0! PAK:SUBUN(PұPҲ PұNP PҲNP PAKNP SB.N DƠPұ ԠPұPҲBŠNG 3N_0 A SAN PAK:PKMP_-(PP(Pұ?UNݩ-< PAKSBPP DƠ+ DƠPұ SZ MPPAK MANA AƬA SAPKMP 5N_N+ DAN NA SAN 6G*($P(PҲ_PKMPҠ-PP(Pұ?P(PҲ_PKMP\ UN SBPP DƠ+ DƠPұ SZSS MP.3 DAPKMP SBP DƠ+ DƠPҲ MPPAK .3MANA ҠPKMP SBP DƠ+ DƠPҲ N_N+ DAN NA SAN GϠϠPAK MPPAK 9ND 0! ND ND ND$ }* G S 29103-80020 A S P0122 SCNPT              H0101 -ASMBج̬ 00SP̬̬MϬԬ 00NAMŠSNP( NAMSNPԬ .A.U0 .B.U NԠ NԠN NԠSP NԠBNK NԠDG NԠDG NԠ Ԡ.N .Ԡ00005 .6Ԡ3 .Ԡ60 .9Ԡ00000 .Ԡ0 .3Ԡ06 .6Ԡ0 .Ԡ0 .9Ԡ65 .Ԡ36 .Ԡ3 .Ԡ 003!SANNҠPSUD-MNA̠UNS 00! 005! 006:SUBUN(ҩGBA̬ ҠNP ҠNP SB.N DƠ 00ԠҠBŠNG 00Ơҽ5KHNUNSŠUN DAҬ PA. SS MP. MPҬ . MPҬ 009ND 00! 0! 0N:SUBUN(NҩGBA̬ NҠNP NҠNP SB.N DƠN 03ԠNҠBŠNG 0ƠNң5KHNUNSŠUN DANҬ PA. MP.3 MPNҬ .3 MPNҬ 05NDN 06SP:SUBUN(SPéGBA̬ SPàNP SPàNP SB.N DƠSP 0!SPA̠HAAS:+-( 0ƠSPýKHNƠSPý<3KHNUN!APԠANYHNG DASPì ADA.6 SSA MP.5 DASPì ADA. SSASS MP.5 MPSPì 09UN .5 MPSPì 00ND 0! 0BNK:SUBUN(BNKGBA̬ BNKNP BNKàNP SB.N DƠBNK 03ԠBNKBŠNG 0ƠBNK0KHNUNSŠUN DABNK PA.9 3SS MP. MPBNKì . MPBNKì 05NDBNK 06! 0DG:SUBUN(DGԩGBA̬ DGԠNP DGԠNP SB.N DƠDG 0ԠDGԠBŠNG 09ƠDGԽ60KHNƠDGԽASMBҬ̬ NAMSM .B.U .A.U0 NԠSM Ԡ.NҬNSYSMA SƱNP SؠԠ0003 SMSAUNNA̠DϠDMNŠƠA HAAҠSNGMAHSANYSYMB̠NHŠSYMB̠AB (UNYDNDNYPNԠNAMSNY. UNS0ƠNϠMAHUS S..ADDSSƠMAHƠNŠUD. SҠNP SMNP SB.N DƠS SAԠSYMB̠ABŠSAN DASؠSAԠƠSANAҠPUNUAN SASƱ GԠNԠSYMB'SADDSS 039SƲ:SƱ_NSY(SƱ?UN0 SƲSBNSY DƠ+ DƠSƱ ASZ MPSMɠNϠMŠSYMBSUNZ 00ƠSMA(SƱSҩHNUNSƱ!MAHUDND SBSMA DƠ+3 DƠSƱ DƠSҬ SZASS MPSƲHSSYMB̠DDN'ԠMAHGԠNԠN DASƱUNSYMB̠ABŠADDSS MPSMɠҠ0ƠNϠMAHUD. ND ߠ jp 29103-80055 A S P0122 BLOK              H0101 z4ASMBج̬ 00SP̬̬MϬԬ 00NAMŠBK( NAMBK .A.U0 .B.U NԠBK Ԡ.N Ԡ.D ԠABU ԠPP ԠBNY ײBSS ױBSS ADDSBSS UNԠBSS .Ԡ00005 3BSS HKBSS DAABSS GBSS .Ԡ .5Ԡ00000 .6Ԡ000003 .Ԡ00006 .BSS .9Ԡ00000 003BK:SUBUN(SGGBA SGNP BKNP SB.N DƠSG 00! 005!SUBUNŠϠAŠDSNHŠABSUŠ 006!MHŠNKSSNG"SG". 00!"SG"SPUGDN. 00! 009!SGSASNGƠNANADSUBSNGSHŠS 00!DNAHSUBSNGSHŠADDSSƠHŠSUBSNG 0!HŠSUBSNGSAŠDMDBYADNANNG-ҠHŠND 0!ƠHŠSNG 03! 0!PDU:HŠADDSSƠAHSUBSNGSBANDASH 05!ADDSSƠHŠABSUŠDNKADDSSSAŠBAND 06!MHŠNKSSNGUSNGHŠUNNPPUP 0!5DS.ANABSUŠDSMADŬNUDNGD 0!NGHABSUŠADADDSSANDHKSUMNBB-MPA- 09!BŠMAԬHNVҠHŠBUҠBMSU̠ҠASUBSNG 00!SHAUSD.DSAŠNϠHŠABSUŠ 0!UN̠HŠNKSSNGHASBNHAUSD. 0! 03ԠABUԠBŠSUBUNŬNA 0ԠPPBŠUNNNA 05ԠBNYBŠNGҬNA 06ײ_ױ_BNY+!NAZŠBUҠPNS SB.D DƠBNY SAױ NA SAײ 0B:ADDS_PP(SG?UNݠ!ADDSSƠSUBSNG. BSBPP DƠ+ DƠSG SZ MPBK SAADDS 0B:UN_!UN. BDA. SAUN 093_ײ+ DAײ NA SA3 030HK$ײ_ADDS DAADDS SAHK SAײ 03$ױ_0 A SAױ 03B3:DAA_PP(SG?G_0GϠPݽ-HNG_GϠP B3SBPP DƠ+ DƠSG SZSS MP. A SAG MPP .SADAA PA. SS MP.3 ANA SAG MPP 033HK_HK+$3_DAAݠ!SŠDAAKPHKSUM. .3DADAA SA3 ADAHK SAHK 033_3+ DA3 NA SA3 035$ױ_$ױ+00K!NS.UN. DAױ ADA.5 SAױ 036ADDS_ADDS+ DAADDS NA SAADDS 03UN_UN-ݽ0HNGϠB3 A ADAUN SAUN SSASS MPB3 03G_3!BUҠU̠NDN. DA.6 SAG 039P:$3_HK!HKSUMNϠD. PԠDAHK SA3 00A̠ABU(50-UNԬBNY DAUN MANA ADA. SA. SBABU DƠ+3 DƠ. DƠBNY 0NԠGHNUN!SNGHAUSD. DAG SZASS MPBK 0ƠGHNGϠB!SAԠNנSUBSNG. DAG PA.9 MPB 03GϠB MPB 0ND 05ND ND 06ND$   ks 29103-80056 A S P0122 STMA              H0101 2ASMBج̬ 00SP̬̬MϬԬ 00NAMŠSMA( NAMSMA .A.U0 .B.U NԠSMA Ԡ.N ԠP ԠGAB SMAVBSS NPҠBSS ADDҠBSS DBSS .Ԡ00000 HAҠBSS .3Ԡ00000 .Ԡ000 .5Ԡ0003 .BSS .9Ԡ00000 .0Ԡ 003!UNNϠDMNŠƠHŠSYMB̠AԠSADNHŠSYMB̠AB 00!MAHSHŠHAAҠSNGS. 005! 006! 00ԠPBŠPSUDϬNA 00ԠGABBŠSUBUNŬNA 009! 00SMA:UNN(SADSҩGBA SADNP SҠNP SMANP SB.N DƠSAD 0NP_S DASҬ SANP 0GAB(SADADDҩ!GԠŠADDSSƠSYMB SBGAB DƠ+3 DƠSAD DƠADD 03D_$(ADD+ DAADD ADA. DA.A. SAD 0NԠD<0HNGϠSNҠ!ҠHAAҠNAM SSASS MPSN 05GAB(DADDҩ!NDADDSSƠNAM. SBGAB DƠ+3 DƠD DƠADD 06D_0 A SAD 0S:HA_P(NPҩ?(DAND00KHN\ GϠSUìSŠGϠA S SBP DƠ+ DƠNP SZSS MP. DAD AND.3 SZASS MPA MPSU .SAHA 0D_$ADD DAADDҬ SAD 09((D-7 RETURN END ! RWPAG:SUBROUTINE(PNO,PAD,RWCOD) ! ! SUBROUTINE TO READ/WRITE SYMBOL TABLE PAGES ! ! PNO=PAGE NUMBER ! PAD=PAGE ADDRESS ! RWCOD=1(READ), OR 2(WRITE) ! RTRK_FETRK+(PNO/TSIZE) RSEC_(PNO-(TSIZE*(RTRK-FETRK)))<-1* CALL EXEC(RWCOD, LID,$PAD,128,RTRK,RSEC) RETURN END ! PDXAD:SUBROUTINE ! ! CONVERTS PAGE DIRECTORY INDEX (>0) TO ABSOLUTE ADDRESS OF PAGE CADDR_EXBAS+((PDINX-1)-<7) RETURN END ! ADPDX:SUBROUTINE ! ! CONVERTS ABSOLUTE (CORE) PAGE ADDRESS ! TO PAGE DIRECTORY INDEX ( > 0) ! PDINX_(((CADDR-EXBAS)AND 77600K)->7)+1 RETURN END ! OLDPG:SUBROUTINE ! ! DETERMINES CORE ADDRESS OF EXTENSION PAGE WHICH HAS BEEN IN ! CORE FOR THE LONGEST PERIOD WITHOUT BEING REFERENCED ! ! ! THIS IS DONE BY SEARCHING EACH PAGE IN CORE FOR THE MINIMUM ! VALUE OF THE LAST-USAGE COUNTER. ! DO[OLDAD,PDINX_0; K_77777K] WHILE PD([PDINX_PDINX+1])=>0 DO \ [PDXAD;IF K>$([I_CADDR+2])THEN[OLDAD_CADDR; K_$I]] IF OLDAD THEN RETURN ! ! NOTE: CONTROL IS PASSED TO ER50 (SYMBOL TABLE OR WORKSPACE ! OVERFLOW) FOR ANY ONE OF THE FOLLOWING REASONS: ! 1. "PRGPG" CALLED BUT NO PAGES IN CORE, ! 2."GETRM" CALLED TO CREATE NEW PAGE, BUT ! THE MAXIMUM PAGE HAS ALREADY BEEN ALLOCATED, ! 3. OLDPG CALLED BUT NO PAGES LEFT IN CORE. ! ER50: DIAG(50,0) END ! PRGPG:SUBROUTINE(GADPR)GLOBAL ! ! ! THIS SUBROUTINE IS CALLED TO ROLL A SYMBOL TABLE PAGE ! OUT TO THE DISC, TO MAKE ROOM FOR ANOTHER, OR TO MAKE ! WORKSPACE AVAILABLE. ! ! GADPR = CORE ADDRESS OF PAGE TO BE ROLLED OUT. ! ! IF SPECIFIED PAGE IS DIFFERENT THAN ITS DISK IMAGE (IF ANY), ! IT IS WRITTEN ON THE DISK. THE APPROPRIATE PAGE DIRECTORY ! SLOT IS SET TO ZERO. ! ! IF GADPR

126 \ THEN [PRGAD_FIRST; FIRST_FIRST+128],\ ELSE [OLDPG; PRGAD_OLDAD; PRGPG(PRGAD)] ! ZZZ:CREATE/LOAD PAGE FLAG. 0=PAGE TO BE CREATED ONLY. ! ZZZ # 0 PAGE TO BE READ FROM DISC IF ZZZ THEN CALL RWPAG(PAGE(LDPNO),PRGAD,1),\ ELSE [$PRGAD_4; $(PRGAD+1)_127] $(PRGAD+3)_0 CADDR_PRGAD ADPDX PD(PDINX)_LDPNO RETURN END ! GETAB:SUBROUTINE (VRTAD,CORAD) GLOBAL ! ! CONVERTS VIRTUAL ADDRESS (VRTAD) TO CORE ADDRESS (CORAD). ! PAGE IS ALWAYS IN CORE ON RETURN. ! GET1: LDPNO_VRTAD AND 77600K PDINX_1 GET2: IF PD(PDINX)=LDPNO \ THEN[PDXAD; CORAD_CADDR+(VRTAD AND 177K);\ $(CADDR+2)_[LUCNT_(LUCNT+1) AND 77777K];RETURN] IF PD(PDINX)<0 THEN[ZZZ_-1; LDPAG; GOTO GET2] GET3: PDINX_PDINX+1 GOTO GET2 END ! GETRM:SUBROUTINE(NO,VRTUL) GLOBAL ! ! IF NO=0 A 4 WORD SYMBOL BLOCK IS ALLOCATED FROM SYMB PAGE(TOP DWN) ! IF NO>0 A (NO) WORD BLOCK IS ALLOCATED FROM SYMB PAGE (BOTTOM UP) ! NEW PAGES ARE CREATED AS REQUIRED ! GRM1: M_0 PAGE(M)_LPAGE GETAB(M,N) Q_[IF NO THEN NO, ELSE 4] IF -($N+Q)+$(N+1)+1=>0 THEN GOTO GRM2 ZZZ,LDPNO_0 IF [LPAGE_LPAGE+1] => PDSIZ THEN GOTO ER50 PAGE(LDPNO)_LPAGE LDPAG GETAB(LDPNO,Q) GOTO GRM1 GRM2: IF NO \ THEN[VRTUL_M+$([I_N+1])-NO+1; M_-NO+N+$I+1; $I_$I-NO],\ ELSE[VRTUL_M+$N;M_N+$N;$N_$N+4] VRTUL_VRTUL OR 100000K WHILE Q DO [$M_0;M_M+1;Q_Q-1] $(N+3)_1 RETURN END ! END END$   29103-80127 A S P0122 ALLOC SPL             H0101 ̔SP̬̬MϬԬ NAMŠA( ԠPGPGBŠSUBUNŬNA ԠKPASԬSԬSԠBŠNGҬNA ! ! GK:SUBUN(GPҩGBA ƠSԠHNGP_SԻS_$GPһGϠG9 NԠ(AS-Sԩ6HNS_S-PGPG(Sԩ GP_AS- AS_GP- ƠAS0 DO \DEFINE LOOP [PUSH; PTOP_S; GTOP_DEF; VTOP_0] IFNOT CHAR THEN GOTO M IF DEF THEN[CALL $(SEG($GTOP))(CHAR) ?[GO TO M]],\P-TERM ELSE [IF CHAR#$GTOP THEN GO TO M] !MATCH ! VTOP_[IF CHAR<0 THEN CHAR, ELSE -CHAR] !SET V STACK CALL $(AINCC)() !GET NEXT CHARACTER G: DO [PUSH; GTOP_$(GTOP+3); VTOP_0] !SUCCESSOR H: IF GTOP>0 THEN GO TO B !GO TO DEFINE LOOP CALL $(AGNRT)(S,PTOP,GTOP,VTOP) !GENERATE IF S THEN GO TO G !GO AHEAD IFNOT CHAR THEN RETURN, ELSE FRETURN !DONE ! M: DO [GTOP_[IF GTOP THEN $(GTOP+2),ELSE 0]; \ VTOP_0] !GET ALTERNATE IF GTOP THEN GO TO H !GO TO DEF LOOP DO [POP; IFNOT S THEN FRETURN] !BACKTRACK IF VTOP>0 THEN FRETURN,\ DELETE ELSE [IF VTOP<0 THEN [CALL $(ADECC)()]] !DECC GO TO M !TRY AGAIN END ! PUSH: SUBROUTINE DO [STAK(S)_VTOP; STAK(S)_GTOP; STAK(S)_PTOP] RETURN END ! POP: SUBROUTINE DO [PTOP_STAK(S); GTOP_STAK(S); VTOP_STAK(S)] RETURN END END END$ .U  29103-80134 C S 0122 SCNMN              H0101 +SPL,L,M,O,T,C ! 11/14/75 REV C NAME SCNMN(8) ! ! SCANNER MAIN MODULE, CONTAINING: ! SCAN: SCAN FUNCTION CALLED BY COMPILER EXEC ! INCC,DECC,GENRT,DELET ROUTINES TOBE PASSED TO ! THE PARSING ALGORITHM (NOT GLOBAL). ! LET P.ARS,STPRG,DIAG,EXEC BE SUBROUTINE, EXTERNAL LET ISTR,DCP,SEG BE FUNCTION, EXTERNAL LET IWP,ICP,STAK BE PSEUDO, EXTERNAL LET SCGRM,CCPTR,CHAR,SOURC,SPTR BE INTEGER,EXTERNAL SCAN: SUBROUTINE GLOBAL CCPTR_ISTR(CCODE) P.ARS(@SCGRM,@GENRT,@INCC,@DECC) \ ?[GO TO FAIL] CALL STPRG(SOURC) RETURN ! FAIL: CHAR_ICP(SPTR); GOTO DIAG5 END SCAN ! INCC: SUBROUTINE GLOBAL CHAR_ICP(SPTR)?(0) RETURN END INCC ! DIAGNOSTIC CODE 5: ILLEGAL CHARACTER, OR NO CR/LF DIAG5: CALL DIAG(5,CHAR) ! DECC: SUBROUTINE GLOBAL CHAR_DCP(SPTR,SOURC) RETURN END DECC ! GENRT: SUBROUTINE(STKP,P,G,V) LET STKP,P,G,V BE INTEGER S_STKP ASTR_0 STAK(ASTR)_100000K ALWAYS DO[PTOP_STAK(S);GTOP_STAK(S); \ VTOP_STAK(S); \ IFNOT P=PTOP THEN GO TO GENR1; \ STAK(ASTR)_VTOP] GENR1: $(SEG($GTOP))(ASTR,CCODE,V) P_PTOP G_GTOP STKP_S RETURN END GENRT ! END END$ ~p  29103-80142 A S P0122 SNPST SPL             H0101 SP̬̬MϬԬ NAMŠSNPS( ! !SNAPSAMNԠSMANàUN ! ԠPBŠNSAN(60 ԠSNPPBŠNSAN(6 ԠPBŠNSAN(5 ԠASAKDBDBAVAUBŠNGҬNA ԠàBŠSUBUNŬNA ԠKDBBŠSUBUNŬNA ԠSAKSYPSVUPBŠPSUDϬNA ԠSҠBŠUNNNA ԠUNAMŬҬSàBŠNG NAZŠɠϠU S:SUBUN $_SAK(ASAK?(0 U_SAK(ASAK!HנAAYNDVAU UN ND DAV:SUBUN(DԱ P(ԩ_DԱ UN ND ! SNPS:SUBUNŠGBA̠!SNAPSAMNԠSMANàUN _S(AVAU!NAZŠPSHSNG PAԠMSD\ A̠S_+ U_!SԠDAUԠSNAPŠU NԠNAMŠHNGϠSNP5!AKŠDB (SYP(NAMũANDHNGϠSNP6!YPŠ0 !AŠPSH A̠DAV(SéA̠DAV(ҩA̠DAV(- A̠DAV(NAMũA̠DAV(-A̠DAV(P SNP:A̠DAV(SNPPA̠DAV(P UN ! !AKŠDBҠYPŠ0S SNP6:U_SVU(NAMũ SNP5:A̠KDB($DBU000K+U0 A̠(3000K+U!PUNHAD GϠSNP ND ND ND$   29103-80143 1715 S 0122 FKDCB SPL             H0101 ĆSPL,L,M,O,T,C NAME FKDCB(8) "REV G 770321" ! ! SUBROUTINE TO FAKE DATA CONTROL BLOCK POINTERS FOR TYPE 0 FILES ! FKDCB: SUBROUTINE(DCB,LU,EOFCD,BSPCO,RWCOD) GLOBAL LET EXEC BE SUBROUTINE,EXTERNAL DCB,$(@DCB+2)_0 !SET"FAKED DCB" FLAG.TYPE =0 $(@DCB+3)_LU OR 400K !LOGICAL UNIT $(@DCB+4)_EOFCD !EOF CODE $(@DCB+5)_BSPCO !BACKSPACE CODE $(@DCB+6)_RWCOD !READ/WRITE CODE $(@DCB+7)_100000K !OPENED "SUCCESSFULLY" $(@DCB+9)_$1717K !ID SEGMENT ADDRESS CALL EXEC(3,700K+LU) !SET END-OF-TAPE RETURN END END END$   29103-80145 1715 S 0122 LDUM2 SPL             H0101 SPL,L,M,O,T,C NAME LDUM2(8) "REV G 770325" ! ! RELOCATE/SEARCH STATEMENT SEMANTIC ROUTINES ! ! FOR EACH FILE, POLISH OUTPUT IS: ! ! AVALU: ! ! ********************************************************************* ! * * * * * * ! *S.T.PTR TO* * +1) * LIST * * ! * * * * PTR) * * ! ********************************************************************* ! ! LET ASTAK,AVALU BE INTEGER,EXTERNAL LET ISTR BE FUNCTION,EXTERNAL LET ATRB,STYP,STAK,IWP BE PSEUDO,EXTERNAL LET ASTAV,ASPOP,WDTAV,STPRG,ASTAV BE SUBROUTINE,EXTERNAL ! DEFINE GLOBAL CONSTANTS LET LOCC,BPLOC,FWAM,LWAM,FWABP,LWABP,FWAC,LWAC,NXTPG, XFER,\ LCOMM,LINKF,UNDF1,UNDFS,UNDX1,UNDFX,EXTX1,EXTX,LISTO,ABRTF,\ FILEX,BPLKS,NBPLK,GUESS,NGESS,LWAM1,NLINK,MAXA,MINA,\ MAXAB,MINAB,XBPLK,XGESS,XSEC BE INTEGER ,EXTERNAL ! PNAME: SUBROUTINE GLOBAL ! TYPE A GIVEN NAME AS "PROGRAM NAME" ASTAV !MOVE PROGRAM NAME TO AVALU RETURN END ! PRLST: SUBROUTINE GLOBAL ! PASSES A STRING OF PROGRAM NAMES TO PRFLS P1_ISTR(P0) !INITIALIZE STRING ASPOP?[GOTO PRL1] ! FORM STRING OF PROGRAM NAMES. POP COMMAS FROM ASTAK. ALWAYS DO[IWP(P1)_STAK(ASTAK)?[GOTO PRL1]; ASPOP?[GOTO PRL1]]! PRL1: WDTAV(P0) !PASS STRING(POSSIBLY EMPTY) TO PRFLS RETURN END ! PRFLS: SUBROUTINE GLOBAL P1_ISTR(P0)! INITIALIZE FILES STRING PRFL1: P3_ISTR(P4) !INITIALIZE PROGRAM STRING IWP(P3)_STAK(ASTAK) !PUT FILE NAME INTO STRING IWP(P3)_STAK(ASTAK)?(0) PRFL2: IWP(P1)_P4 ASPOP?[GOTO PRFL3] !POP COMMA, OR F-RETURN IF NONE LEFT GOTO PRFL1 ! ! PUT FILE/PROGRAM STRING POINTER INTO AVALU ! PRFL3: WDTAV(P0) RETURN END FNAME: SUBROUTINE GLOBAL ASTAV    !MOVE FILE NAME TO AVALU RETURN END ! ID1: SUBROUTINE GLOBAL ASTAV RETURN END ! ! PSEUDO-TERMINAL ROUTINES FOR GRAMMAR ! SMPCN: SUBROUTINE(SMPC1) GLOBAL,FEXIT LET STYP BE PSEUDO,EXTERNAL IF(STYP(SMPC1) AND 1) THEN RETURN!ACCEPT SIMPLE CONSTANTS FRETURN END ! NAEM: SUBROUTINE (NAEM1) GLOBAL,FEXIT ! SYMBOL CAN BE USED AS A NAME IF IT ISN'T A SPECIAL CHARACTER ! OPERATOR. IF(STYP(NAEM1)AND 1) THEN GOTO NFAIL!REJECT CONSTANTS IF (NAEM1 AND 77777K)>34K THEN RETURN !ALLOW RSERVED WORDSDS. NFAIL:FRETURN END END END$ Z   29103-80146 A S P0122 FSEMU SPL             H0101 ۛSP̬̬MϬԬ NAMŠSMU( ! !USҠSMANàUNS ԠSYPSAKSA׬SASBŠPSUDϬNA ԠASAKAVAUBŠNGҬNA ASAV:SUBUNŠGBA̬Ԡ!ASAK--AVAU. Ա_SAK(ASAK?UNݠ!PPASAKA̠UNƠMPY NԠAVAUHNAVAU_ԱUN ƠAVAU<0HNԲ_0SA(Բ_AVAUAVAU_Բ!SAԠSNG ƠԱ<0HNSA(AVAU_Ա\APPNDSYMB̠ADDSS SŠSAS(AVAU_Ա!APPNDSNG UN ND DAV:SUBUN(PAԩGBA̠!ANYD--AVAU NԠAVAUHNAVAU_PAԻUN ƠAVAU<0HNԱ_0SA(Ա_AVAUAVAU_Ա SA(AVAU_PA UN ND ! ! ! ! ! ASPP:SUBUNŠGBA̬ !PPSPNYƠASAKANDDSADS.UNƠMPY. _SAK(ASAK?UN UN ND ND ND$ +%  29103-80147 A S P0122 FU9 SPL             H0101 pSP̬̬MϬԬ NAMŠU9( ԠPUKBŠSUBUNŬNA ԠGKSPGBŠSUBUNŬNA ! SA:PSUD(SPҩGBA NԠSPҠHNGK(DשSPҬDS_D׻\ $DS_SAV_GϠSA5 ƠSPҽDSHNY_DנAND0KZ_DנANDKGϠSA3 DSY_SP HZ_$(Y+DϠY_Z UN̠$(D_Y+Zݩ00000KDϠZ_Z+ SA3:$D_SAV ƠZ6HN_GϠSA׷ GK(Dש $(Y+_D _0 SA5:$(D+_0 SA׷:$(D_D+ݩ_00000K UN ND ! ! NS:PSUDϠ(SPԬNDةGBA̬ NԠSPԠHNGϠNS9 ƠSPԽSPԲHNƠNDؽNDز+HN\ ZY__Բ+\ (ԲAND6HN_$Ի\ GϠNS3 _SP Y_ND NS:NԠؠHNGϠNS9 ƠYHNY_Y-_$(+GϠNSݬ\ SŠY_Y-Z_0 NS:_+Z NS3:Ơ$Խ00000KHNGϠNS9 ƠZYHNZ_Z+GϠNS ƠNSƠHN$_NSV\ SŠNSV_$ Բ_ NDز_ND SPԲ_SP UN NS9:NSV_0 UN ND ! ! SAS:PSUDϠ(SPGBA _0 SAS:_+ SA(SP_NS(SASVש?GϠSAS GϠSAS SAS:SPG(SASV UN ND ! ! ND ND$ W`  29103-80151 A S P0122 POLG SPL             H0101 SP̬̬MϬԬ NAMŠPG(!AůPSNUNSҠB.G !BANDGUNHŠAKSҠANDSԠƠH !NԠDNHŠBAYANDADGϠSSPVY. !PBANDP.GPMANABSUŠPSNϠSAԠA !SNDPASSVҠAABŠƠBNAYMHŠBAYAND !ADANDGϠAASSPVY. !BHUSŠAKSҠANDSԠNMANBANDM !APVUSAŠA.NNA̠NMANHAҬSSAVD !SNŠHŠSN'ԠANYMNHŠANGSUN. ԠàBŠSUBUNŬNA SUP:SUBUN ԠHAҠBŠNGҬNA ԠDBҠBŠNGҬNA Dñ_DB_DB6_DB5_DB_DB3_DB_\ DB_DB++++++++9 UN ND B:SUBUN(BDBBҬìSƩGBA ԠBDBBŠNG( A̠SUP _$DB!AK S_$DB!S _$DB3!S HA_$DB5!SAVŠPGSUN UN ND ! !AŠAD-N-GϠAA ! G:SUBUN(GDBGҬGìGSGƩGBA ԠGDBBŠNG( A̠SUP G_$DB!AK GS_$DB!S G_$DB3!S UN ND ! !PSNBAY ! PB:SUBUN(PDBPҬPìPSPƩGBA ԠPDBBŠNG( A̠SUP $DB5_HAҠ!PUԠBAKPGSUN $DB_Pà!AK $DB_PS!S $DB3_PƠ!S A̠($Dñ6PìPS UN ND ! !PSNAD-N-GϠAA ! P.G:SUBUN(.GDB.GҬ.Gì.GS.GƩGBA Ԡ̻  .GDBBŠNG( A̠SUP $DB_.Gà!AK $DB_.GS!S $DB3_.GƠ!S $DB_0!PUԠNADUMMYPAKDSàAD. A̠($DB$Dñ6$DB.GS!UPDAŠPAKNGBU .G_0 UN ND ND ND$ ԬSP NSP̬56   29103-80152 A S P0122 REDGL SPL             H0101 وSP̬̬MϬԬ NAMŠDG(!ADAD-N-GϯSYSMBAY ! !AD̠ADSHŠSYSMAABŠUYUNS ! ԠGàBŠNSAN(66K!UNԠAD-N-GϠAK ԠDDSKàBŠSUBUNŬNA ԠSUPBŠSUBUNŠ!SUPPNS AD:SUBUN(DBҬDUƬ̬NHGBA ԠDBBŠNG(!DAAN̠BK.DNA̠ !"DB(" _0!NϠS A̠SUP NԠ$DB5HN\NSHDADNGBAY NH_-UN A̠DDSK(DUƬ$DB$DB$DB3$DB5$DB6$DB\ NH$Dñ $Dñ UN ND ! !ADAD-N-GϠAA ! ADG:SUBUN(GDBGҬGBUƬG̬GNHGBA ԠGDBBŠNG(!SAMŠASDB( A̠SUP !HNPAKDDSàAKSҠNNSƠ66NBASŠPAGŬ !HNSMUAŠANNDƠŠANDUN $DB$GàHNGNH_-UN A̠DDSK(GBUƬ$DB$DB$DB3$DB$DB5$DB6\ $DBGNH$Dñ UN ND ! !AŠBAYPSN ! SUP:SUBUN ԠDBҠBŠNGҬNA Dñ_DB_DB6_DB5_DB_DB3_DB_\ DB_DB++++++++9 UN ND ND ND$ ]  29103-80156 1715 S 0122 ENDR SPL             H0101 SPL,L,M,O,T,C NAME ENDR(8) "REV G 770415" ! ! END RECORD PROCESSOR ! LET BPRC1,BPRC0 BE LABEL,EXTERNAL LET .BKUP,NXTI,NAMX,UNDX1,EXTX1 BE INTEGER,EXTERNAL ! DECLARE 'USED' BASE PAGE LINKS STACK, CONTAINING THE ! LINKS WHICH WERE ALLOCATED FROM THE "FREE" BASE PAGE LINKS ! STACK, BUT WHICH WILL NOT NECESSARILY BE USED ON THE SECOND ! PASS. LET UFREB BE INTEGER,EXTERNAL LET ABINY BE INTEGER,EXTERNAL ! ENDR: SUBROUTINE(PLGTH,LENTH,NCPL1,NCPL2,LGB1,NBLK1,REV,\ TDIFF,RREC,RRS,ROFF,AREC,\ ARS,AOFF,.SAVE,OFREB,PBASE,PLEN7,BINY2,NXTII)GLOBAL LET BINY BE INTEGER(60),EXTERNAL LET SWTCH,BLNK,STPRG,MOVE.,POSN.,RVERF,\ PRENT,OCTAQ,EXEC,DIAG,PBPLK BE SUBROUTINE,EXTERNAL LET PRT BE SUBROUTINE LET LOCC,BPLOC,LISTO,GUESS,SEC,NBPLK,ERR,MAXAB,XMAXA,ERCO,\ NXTPG,LWAM1,LWABP,LSTLU,.POSN,DCB4,DCBB4,FREBE,NGESS,XBPLK,\ RIC,XGESS,XSEC,BINY,LSTLU BE INTEGER,EXTERNAL LET B76,IWPP,ISTR,MAX BE FUNCTION,EXTERNAL LET ICP,IWP,STAK BE PSEUDO,EXTERNAL ! CALL SWTCH BIN17_[BIN13_ABINY+12]+4 IF PLGTH<0 THEN PLGTH_LENTH !USE ACTUAL LENGTH IF COMPILER-GENERA ! ! IS BACKUP NECESSARY? ! NOT PERFORMED IF INPUT OR OUTPUT FILE NON-DISC, OR IF ! SECOND PASS ALREADY DONE, OR IF GUESS AREA COMPLETELY USED. ! IF NGESS=NCPL1 THEN GOTO ENDR1 !GUESS AREA ALL USED. IFNOT .BKUP THEN GOTO ENDR1! THIS IS THE SECOND PASS IFNOT$(DCB4+2) THEN GOTO ENDR1 !INPUT FILE NON-DISC IFNOT $(@DCBB4+2) THEN GOTO ENDR1 !"OUTPUT " " " ! ! BACKUP PASS CALLED FOR. BACKUP POINTERS AND REPOSITION INPUT ! AND OUTPUT FILES. ! .BKUP_0 CALL $(.POSN)($DCB4,ERR,RREC,RRS,ROFF)!POSITION R.B. FILE CALL POSN.(DCBB4,ERR,AREC,ARS,AOFF)!" ABS. FILE X_UNDX1 !BACKUP TEMPORARY UNDEFINEDS AND FIXUPS ALWAYS DO[I1_IWP(X)?[GOTO E1];REF1_IWP(X);FIX_IWP(X);\ CALL STPRG($(REF1 OR 7)); $REF1_100000K] ! E1: CALL MOVE.(.SAVE,NBPLK,9) $XBPLK_100000K; CALL STPRG($(XBPLK OR 7)) PBASE,LOCC_LOCC-[TDIFF_NGESS-NCPL1]! BACK DOWN LOCC NGESS_NCPL1;NCPL1,NCPL2_0 ! CALL STPRG(GUESS); CALL STPRG(SEC); CALL STPRG(FREBE) ALWAYS DO \ BE SURE ALL LINKS TAKEN FROM "FREE BASE PAGE CALL PBPLK ( STAK(UFREB)? [GOTO E3] , 0) ! ARE CLEARED TO ZERO. E3: GUESS_ISTR(XGESS); IWP(XGESS)_LOCC-NGESS SEC_ISTR(XSEC); IWP(XSEC)_[PLEN7_PLGTH]+LOCC NXTPG_[XPAGE_B76(LOCC)]+2000K IF LGB1 THEN[IWP(XBPLK)_-1; IWP(XBPLK)_BPLOC+LGB1] ALWAYS DO[STAK(FREBE)_STAK(OFREB)?[GOTO E2]] ! ! GET 1ST DBL OR END RECORD ! E2: CALL RVERF IF RIC<3 THEN GOTO E2 IF RIC=4 THEN GOTO E2 GOTO BPRC1 !GO GET PROPER RECORD PROCESSOR ! ENDR1: CALL STPRG(UFREB) ! GET RID OF 'USED' LINKS STACK. BINY2_$(ABINY+1) !SAVE WORD 2 OF END RECORD NXTII_$NXTI IFNOT(LISTO AND 2) THEN GOTO ENDRC CALL BLNK (BINY,40) X1_0;X_NAMX ALWAYS DO\ MOVE NAME AND COUNT CHARACTERS [C_ICP(X)?[GOTO EN01];\ IF X1 AND 1 THEN \ODD-NUMBERED CHAR. $NXTI_($NXTI AND 77400K)OR C,\MAKE SURE BUFFER IS BLANK-FILLED ELSE[NXTI_NXTI+1;$NXTI_C-<8 OR 40K];\ X1_X1+1] ! ! PUT IN REVISION CODE, IF ANY ! EN01: NXTI_NXTI+1 ! SKIP OVER TIME PARAMETERS ! T_REV; REPEAT 8 TIMES DO I_IWP(T)?[GOTO EN00] ! ! IF NAM HAS EVEN # CHARS, PUT LEADING BLANK AHEAD OF REV CODE. ! IFNOT (X1 AND 1) THEN [X1_X1+2; NXTI_NXTI+1] ALWAYS DO[$NXTI_IWP(T)?[GOTO EN00];\ X1_X1+2; NXTI_NXTI+1] EN00: IF X1>8 THEN\ [IF (LISTO AND 2) THEN CALL PRT(10+X1)] CALL OCTAQ($BIN13,LOCC) ! ENDRC: X_GUESS; FS_SEC G_IWP(X)?(0) !ADDRESS 1ST WORD GUESS AREA. LG_G+NCPL1-1 !LAST WORD OF GUESS AREA. FS_IWP(FS)?(0) !ADDRESS 1ST WORD OF SECOh3 NDARY AR X1_[LOCC_LOCC+PLGTH]-1 !LAST ADDRESS OF PROGRAM CALL OCTAQ($BIN17,X1) !CONVERT IT TO OCTAL CALL OCTAQ($(ABINY+20),BPLOC) NXTPG_B76([LOCC_LOCC+NCPL2]+2000K) BPLOC_BPLOC+LGB1+NBPLK-NBLK1 CALL OCTAQ($(ABINY+24),BPLOC-1) IF (LISTO AND 2) THEN CALL PRT(56) ! ! CHECK IF 'LINKS' OPTION SELECTED, AND IF SO, PRINT OUT LIMITS ! FOR GUESS AND SECONDARY AREAS. ! IF (LISTO AND 20K) THEN\ PRINT GUESS,SECONDARY AREA LIMITS [IF NCPL1 THEN\ [ CALL OCTAQ($BIN13,G); CALL OCTAQ($BIN17,LG);\ CALL PRT(38)]; IF NCPL2 THEN\ [IFNOT NCPL1 THEN CALL PRT(1);\PRINT BLANK LINE CALL OCTAQ($BIN13,FS); CALL OCTAQ($BIN17,LOCC-1);\ CALL PRT(38)]] ! ! CHECK IF MEMORY OVERFLOWED. ! XMAXA_MAX(XMAXA,LOCC) IF XMAXA>LWAM1 THEN CALL DIAG(8,NAMX) IF MAXAB>LWABP THEN CALL DIAG(9,NAMX) !BP OVERFLOW IF ERCO THEN CALL DIAG(ERCO,NAMX) CALL STPRG(EXTX1) RETURN ! END PRT: SUBROUTINE(PRT1) !OUTPUT PRINT LINE:PRT1=#CHARS. I_(PRT1+1)>-1 CALL EXEC(2,LSTLU,BINY,I) !OUTPUT PRINT LINE TO COREMAP FILE CALL BLNK(BINY,I) RETURN END END END$   29103-80158 A S P0122 MAXR SPL             H0101 SP̬̬MϬԬ NAMŠMA( MA:UNN(MAرMAزGBA MAV_ƠMAرMAزHNMAرSŠMAز UN ND MN:UNN(MɱMɲGBA MNV_ƠMɱ-6 IF (LINKF AND 4000K) \ RTE-II. ROUND BP TO EVEN SECTOR THEN SIZE_SIZE +(SIZE AND 1) SIZE_-(((SIZE + ((MAXAB-MINAB+64)>-6)+3)>-1)) CALL WDTAV(SC); CALL WDTAV(CR); CALL WDTAV(-6) CALL WDTAV(FNAME); CALL WDTAV(SIZE); CALL WDTAV(CRTOP) GOTO AE0 END ! CNTST: SUBROUTINE GLOBAL LET ASTAK,AVALU BE INTEGER,EXTERNAL AVALU_STAK(ASTAK)?(0) RETURN END END END$ '   29103-80176 A S P0122 RELST SPL             H0101 SP̬̬MϬԬ NAMŠS( !MDUŠϠPSSADSAMN ԠBYBŠNSAN(0050K!"BY" Ԡ.GBŠNSAN(0050K!".G" ԠUA̠BŠNSAN(0003K!"" ԠNԲBŠNSAN(55!SNDAYNAZAN ԠPPBŠNSAN(!PSSŠPA ԠPNPBŠNSAN(53!PNŠPA ԠPBŠNSAN(5!NDؠƠ"P"UN ԠPNBBŠNSAN(65!PNBAYPA ԠPNGBŠNSAN(66!"ADGϠ" ԠSPGMSB̬BNKBŠSUBUNŬNA ԠDAVBŠSUBUN ԠSҠBŠUNNNA ԠSAKPSVUBŠPSUDϬNA ԠSàBŠSUBUN!ADSAHMMNPSS !DNŠGBA̠NSANS ԠNKƬجҬAVAUASAKNNK\ BŠNGҬNA S:SUBUNŠGBA SHH_-!SԠSAHAG"" S UN ND SS:SUBUNŠGBA SHH_-!SԠSAHAG"N" S UN ND S:UNN!UNSVYHҠVAUŠƠASAK SV_SAK(ASAK UNSAK(ASAK ND ! S:SUBUN Ѭѱ_S!SKP"A"ANDGԠŠNAM _S(AVAU!NAZŠPSHSNG DS:PP0_P(ѩ?GϠDS _P(P !NSԠPSHDŠϠNAZŠ-BNAY !PSSNG(NYƠNԠDNŠAADY N(NKƠAND0000KHNA̠DAV(NԲ\ NK_NKƠҠ0000K !NSԠPSHDŠϠPNHŠ DAV(ة!ŠNAMŠPN !PUԠNPSHҠPNNGŬ !PNPSҠSHҠHAN"BY"AND".G" !PNGSҠ"BY"PNGSҠ".G" ! _ƠؽBYHNPNBS\ Ơؽ.GHNPNGSŠPNP A̠DAV(ɩ!PUԠNSԠϽ  ƠMDUNAMS A̠DAV(SHH!PUԠNSAHAG. _P(PҠ00000K!SԠSGNBԠƠS A̠SPG(P0!PUGŠHŠSNG A̠DAV(ɩ!PUԠNSԠƠMDUŠNAMS A̠DAV(PP!PSSŠPA A̠DAV(P!SŠŠPAҠD !ƠŠNAMŠ"BY"HNPUԠNAN !A"PNBAY"PAҠDŬ !PKUPNSϠ-SDNԠBAY !UNS. ƠؽBYHNA̠DAV(ة\ A̠DAV(PNBA̠DAV(P GϠDS DS:A̠SPG(ѱ G_S!GԠAGԠADDSS ƠGԠUA̠HNG_0NNK_SAK(ASAK\ GϠDS NNK_S!GԠNKS NNK_SAK(ASAK!GԠNKSSUPPD DS:ƠGԾ0HN_G ƠNNKHNNK_NKƠҠ UN ND!-1) GOTO SRTRN ! ERROR # 11 -- FILE MANAGER OPEN ERROR LET M11 BE INTEGER(12) INITIALIZE M11 TO "OPEN ERR " SER11: T1_[T_[T3_@M11]+3]+6; GOTO SR10 ! ERROR 12 -- SET $() WHERE EXPR EVALUATES < 2 LET M12 BE INTEGER(12) INITIALIZE M12 TO "EVAL.ERR,EXPR= (8) " SER12: T_@M12+7 CALL OCTAQ($T,DATA) CALL .XEC(2,M12,12) GOTO SRTRN ! ERROR 13 -- BP LNTH IN NAM RECORD <0 LET M13 BE INTEGER(6) INITIALIZE M13 TO "ILL.BP LNTH " SER13: CALL .XEC(2,M13,6) GOTO SER4. ! ERROR # 14 -- COMMON BLOCK ERROR LET M14 BE INTEGER(20) INITIALIZE M14 TO "COMMON LNTH ERR,LNTH= ,NOW= " SER14: T1_[T_@M14+11]+6 CALL OCTAQ($T,XCOM); CALL OCTAQ($T1,LCOMM) CALL .XEC(2,M14,20); DATA_0 GOTO SER4. ! ERROR # 15 -- NAM OUT OF SEQUENCE LET M15 BE INTEGER(8) INITIALIZE M15 TO "NAM OUT OF SEQ." SER15: CALL .XEC(2,M15,7 ) GOTO SER4. ! ERROR 16 -- FILE READ OR WRITE ERROR LET M16 BE INTEGER(22) INITIALIZE M16 TO "FILE READ OR WRITE ERR= FILE = " SER16: T1_[T_@M16+12]+6 CALL DECV($T,ERR,I); CALL MOVE.($DATA,$T1,3) CALL .XEC(2,M16,22) GOTO SRTRN ! ERROR # 17 -- NO COMMAND ID CHARACTER AND NON-KEYBOARD CMND INPUT LET M17 BE INTEGER(5) INITIALIZE M17 TO "NO CMND ID" SER17: CALL .XEC(2,M17,5) GOTO SRTRN ! ERROR # 18 -- ABORT BECAUSE OF UNDEFINEDS(ABORT IF UNDEFS SET) LET M18 BE INTEGER(6) INITIALIZE M18 TO "UNDEFS ABORT" SER18: CALL .XEC(2,M18,6) GOTO SRTT ! ERROR 19 -- NO MAIN P~ROGRAM LET M19 BE INTEGER(6) INITIALIZE M19 TO "NO MAIN PRGM" SER19: CALL .XEC(2,M19,6) GOTO SRTRN ! ERROR 20 --DUPLICATE ABSOLUTE FILE LET M20 BE INTEGER(7) INITIALIZE M20 TO "DUPL.ABS.FILE" SER20: CALL .XEC(2,M20,7); GOTO SRTRN ! !ERROR 21 ABORT SXL SER21: GOTO SRTT LET M50 BE INTEGER(9) INITIALIZE M50 TO "WORKSPACE OVERFLOW" ! ERROR 50 -- WORKSPACE OVERFLOW SER50: CALL .XEC(2,M50,9) GOTO SRTT ! SRTRN: IFNOT(ABRTF AND 2) THEN GOTO TRTTY SRTT: CALL .XEC(2,ABRT,6) CALL EXEC(5,-1) !RELEASE DISC TRACKS $(@DCBB4+15)_0 !SET CURRENT EXTENT# TO 0 FOR PURGING IF DCBB4 THEN CALL CLOSE(DCBB4,ERR,48)!PURGE ABS. FILE IF(LISTO AND 27K)THEN CALL EXEC(3,1100K+LSTLU,-1) ALWAYS DO\ CLOSE ALL TRANSFER FILES [CALL ILOSE($SODC4,ERR);\ IF TRSTK THEN CALL TRBAK, ELSE CALL EXEC(6)] TRTTY: CALL LOCF($SODC4,ERR,REC,RS,OFF,JSEC,JLU,JTY) IF IAILU = 0 THEN \ DON'T STACK IF FILE = TTY [CALL ILOSE($SODC4,ERR); T_@JTY; REPEAT 6 TIMES DO\ [STAK(TRSTK)_$T; T_T+1]; T_SODC4; REPEAT 3 TIMES DO\ [T_T-1; STAK(TRSTK)_$T]; \ INLU_401K; CALL FKDCB($SODC4,INLU,0,0,100000K)] GOTO UMAIN END PSER: SUBROUTINE(PROG) LET PSERM BE INTEGER(14) INITIALIZE PSERM TO "FILE NAME= NAME= " T1_[T_@PSERM+5]+6 CALL MSTBL(FILEX,$T,I); IF PROG THEN\ [T2_CCON(PROG); CALL UNSTR(PROG,$T1,T2); I_17] CALL .XEC(2,PSERM,((I+11)>-1)) GOTO SRTRN END END END$   29103-80182 A S P0122 UNSTR SPL             H0101 SP̬̬MϬԬ NAMŠUNS( ԠPBŠPSUDϬNA !SNG--AAYNVSN UNS:SUBUNŠ(PҬAAYNMAةGBA !AKSHAS.MASNG"P"ANDPAKSHMN !AAY"AAY"ϠϠAD.NϠMŠHANNMAؠHAS !BŠANSDANDHŠAAY̠BŠBANK-DƠHŠAŠ ԠPBŠPSUDϬNA _AAY P_P ìK_ PAԠNMAؠMSDϠHUUN Ơý0KHNGϠUN!BANK-. _(P(P?(0KANDK UN:(KANDHN$_(- = <6-DIGIT OCTAL VALUE> ! OR: ! = UNDEFINED ! LET XNDFS BE CONSTANT(100104K) !"UNDEFS" LET XNDFD BE CONSTANT(100110K) !"UNDEFINED" LET SLOCC BE CONSTANT(100250K) !"LOCC" LET SXFER BE CONSTANT(100514K) !".XFER" LET TABLE BE CONSTANT(100214K) !"TABLE" LET LOCC,ASTAK,BINY,ABINY BE INTEGER,EXTERNAL LET DSUDF,STPRG,UNSTR,OCTAQ,EXEC,MSTBL,BLNK\ BE SUBROUTINE,EXTERNAL LET STAK,SVLU,STYP BE PSEUDO,EXTERNAL LET NXSY BE FUNCTION,EXTERNAL LET BINY BE INTEGER(60),EXTERNAL LET IAILU,INLU BE INTEGER,EXTERNAL ! CK: SUBROUTINE(CKBUF,CKN) CALL EXEC(2,LU,CKBUF,CKN) ! PRINT THE LINE CALL BLNK(CKBUF,CKN) ! FOLLOWED BY A BLANK LINE RETURN END ! S: FUNCTION !DISCARDS NEXT VALUE IN ASTAK ! AND RETURNS 2ND VALUE SV_STAK(ASTAK); RETURN STAK(ASTAK) END ! DSPST: SUBROUTINE GLOBAL CALL BLNK(BINY,40) J_S !POP "DISPLAY" AND GET NAME LU_S !POP "ON" AND GET LOGICAL UNIT LU_[ IF LU THEN SVLU(LU)\ !GET LOGICAL UNIT NUMBER ,ELSE [IFNOT IAILU THEN 1\ ,ELSE INLU]] DSP1: IF J=XNDFS THEN GOTO DSP4 !DISPLAY UNDEFS IF J=TABLE THEN GOTO DSP8 !DISPLAY TABLE. CALL MSTBL(J,$(ABINY+1),N) N_((N+3)>-1) BINY([N_N+1])_" =" IF(STYP(J) AND 30K)=30K THEN\ DEFINED ENTRY POINT NAME [T_SVLU(J); GOTO DSP2],\ ELSE[ IF J<=SXFER THEN\ CHECK FOR KEYWORD [IF J=>SLOCC THEN[T_$(@LOCC+((J-SLOCC)>-2)); GOTO DSP2]]] ! ! SYMBOL IS NOT AN ENTRY POINT NAME WHICH IS CURRENTLY DEFINED. !    CALL MSTBL(XNDFD,BINY(N+1),J); N_N+5; GOTO DSP3 DSP2: CALL OCTAQ(BINY(N+1),T); N_N+3 DSP3: CALL CK(BINY,N) DSP: RETURN DSP4: CALL DSUDF(LU,0,BINY,J) !PRINT UNDEFINEDS RETURN ! ! DISPLAY TABLE ! DSP8: J_0 !START S.T. SEARCH FOR E.P. NAMES DSP10: J_NXSY(J)?[GOTO DSP] !GET NEXT SYMBOL IF(STYP(J) AND 30K)#30K THEN GOTO DSP10 CALL MSTBL(J,BINY(2),N) IF N<6 THEN N_6 N_3+(N>-1); BINY(N)_" =" CALL OCTAQ(BINY(N+1),SVLU(J)) N_N+4; CALL CK(BINY,N); GOTO DSP10 END END END$ O   29103-80189 C S 0122 DSUDF SPL             H0101 gSP̬̬MϬԬ NAMŠDSUD( !V-à ! ԠUPUNSҬSPGMSB̬BNKBŠSUBUNŬNA ԠKBŠSUBUN ԠSNAMSVUSYPPBŠPSUDϬNA ԠNBŠUNNNA̠!UNSHAS.NSNG. ԠUNDƱBNYBŠNGҬNA ! DSUD:SUBUN(UAҬBUƬNSGBA ! !SUBUNŠϠPNԠNAS("NϠUNDS"ƠNNũ ! ԠUBŠNGҠ!DSPAYGA̠UN ԠAҠBŠNGҠ!AG:Ơ0HN"DN"AH ԠNSBŠNGҠ!UND<0ƠNϠSUNDND !ASANNYPNԠƠVAUŠZ ԠBUƠBŠNG(0 ԠMSGBŠNG(5 NAZŠMSGϠ"NϠUNDS" ԠMSGBŠNG( NAZŠMSGϠ"UNDS" ! P_UNDƱ!SAVŠSNGPN NS_-!NUMBҠƠSUN. Ա__BU+ DSU:A̠BNK(BUƬ0!PUԠBANKSNPNԠN NP_P(Pԩ?GϠNSHݠ!GԠNAMŠSNG.0ƠDND. D_P(PԩP_P(Pԩݠ!GԠSԠ.UPS NԠNPԠHNGϠDSU!NYNϠNGҠUNDND NNS_NS+ݠHN\PNԠ"UNDS" A̠K(MSG NHA_0 NS_N(NPԩ+!GԠHAAҠUN ƠNS LWABP THEN CALL DIAG(9,NAMX) ] ! CHECK FOR MAXIMUM COMMON IF [XCOM_$([T_T+1])] THEN CALL SCOMM T_T+1 ! PROCESS REVISION CODE. ! THE REVISION CODE WILL HAVE IN IT ALL PARAMETERS BEYOND THE ! COMMON LENGTH. A_BINYA+RLNGH!GET END OF RECORD ADDRESS I_ISTR(REV) !INITIALIZE REVISION CODE STRING UNTIL T=A DO[IWP(I)_$T;T_T+1] ! MAKE GUESS AS TO PRIMARY AREA. F1: NXTPG_[PAGE_B76(LOCC)]+2000K!COMPUTE PAGE ADDRESSES IFNOT(LINKF AND 1) THEN GOTO FP3!BASEPAGE ONLY MODE IF PLGTH = -1 THEN[CALL SGESS?[GOTO FP3];FGESS;GOTO FP3] ! CHECK IF A GUESS AREA NEEDS TO BE CREATED IF PAGE=B76(LOCC+PLEN7) THEN GOTO FP1!NO PAGE CROSSING. SGESS?[A_NXTPG-LOCC;B_PLEN7-A;NGESS_(MIN((A>-1),B))>-2] FGESS FP1: SEC_ISTR(XSEC) IWP(XSEC)_LOCC+PLEN7 FP3: NXTPG_[PAGE_B76(LOCC)]+2000K LAPAG_B76(LOCC+PLEN7)!COMPUTE LASTPAGE THIS MODULE FP5: PBASE_LOCC; BBASE_BPLOC; CBASE_FWAC!SET RELOCATION BASES EXTX_ISTR(EXTX1); ENTRX_ISTR(ENTR1); UNDFX_ISTR(UNDX1) ! SAVE OLD STACK CONTENTS O( F BASE PAGE LINKS STACK, IN CASE A ! BACKUP PASS IS CALLED FOR. PTR_FREBE ALWAYS DO[IFNOT $PTR THEN GOTO FP9;\ STAK(OFREB)_IWP(PTR)?[GOTO FP9]] FP9: CALL RVERF !GET NEXT RECORD. GOTO BPRC1 END SGESS: SUBROUTINE FEXIT,DIRECT IFNOT NLINK THEN FRETURN NGESS_SVLU(NLINK) RETURN END FGESS: SUBROUTINE DIRECT GUESS_ISTR(XGESS) IWP(XGESS)_LOCC LOCC_LOCC+NGESS RETURN END END END$   29103-80198 C S 0122 SCOMM SPL             H0101 aSP̬̬MϬԬ !Và NAMŠSMM( !SUBUNŠϠHANDŠMMNDAANSNUDNGDAUS. SMM:SUBUNŠGBA ԠMBŠNGҠNA!NGHƠUNԠMMNDAA ԠDMBŠNGҬNA!MMNDAUDAG ԠAìAìAMìMMMNABŠNGҬNA ԠϠBŠNGҬNA̠!ҠDŠAG !HKҠDAUS. ƠAàHNGϠSM!AàHASBNDND ƠAàHNGϠSM5!AàNYHASBNDND. !DAUԠDNNƠMMNHNNHҠAàNҠAàHAS !BNDND:PAŠMMNSANGAԠUNԠVAUŠ !ìANDNASŠàVҠHŠMMNBK SM:A__A_+DMMM_M- UN SM:ƠAàHN\BHDNDHKҠMMNNGH MM_A-A+ƠMM7) AND 377K !TRACK ADR.RES.LIB.ENTRY POINTS. SEC_SEC AND 177K LU_2 !LIBRARY IS ALWAYS ON SYSTEM DISC NSPTK_$1757K !#SECTORS/TRACK ON LU2 CNTR_$DSCLN Yz !COUNTER #RES.LIB.ENTRY POINTS. NBLK_(((((CNTR-<2)+ 77K))->6)AND 177K)!COUNT MAX#BLOCKS TO SEARCH ! ! READ SECTOR OF RESIDENT LIBRARY ENTRY POINT NAMES. ! OPLB1: IF[NBLK_NBLK-1]<0 THEN GOTO OPL20 CALL RDSK !READ NEXT BLOCK OF RES.LIB.ENTRY CNTR_[T3_CNTR]-NENTS ! SET COUNTER TO MINIMUM OF # ENTRY PTS THIS BLOCK AND ! # ENTRY POINTS REMAINING. IF T3 > NENTS THEN T3_NENTS T_DCB13 !SET BLOCK POINTER OPLB2: T_T+4 !ADVANCE POINTER LNKAD_$([TP3_[TP2_T+2]+1])!GET SYMBOL VALUE/LINK ADDRESS REPFL,TYPE_$TP2 AND 7!GET SYMBOL TYPE.SET REPLACEMENT INSTR.FLAG IF [T3_T3-1] < 0 THEN GOTO OPLB1! CHECK FOR END OF BLOCK IFNOT[ FSYMB_FSYMB+1]\ FIRST SYMBOL ENCOUNTERED THEN [ IF LNKAD=2001K THEN \ MUST CERTAINLY BE RTE-II LINKF_ LINKF OR 4000K] IF TYPE = 1 THEN\ "VALUE" IS DISC-RESIDENT ADDRESS. IGNORE. GOTO OPLB2 OPLB5: STRG_UNDF1 ! ! BEGIN SEARCH:: COMPARE EACH SYMBOL IN THE UNDEFINEDS STRING ! WITH THE SYMBOL POINTED TO BY "T". IF A MATCH OCCURS, ! THEN DEFINE THE SYMBOL AND RESOLVE THE FIXUPS. IF NO ! MATCH IS FOUND, THEN DEFINE THE SYMBOL ANYWAY ONLY IF ! ITS TYPE IS 4 (REPLACEMENT INSTRUCTION CODE). IN THIS EVENT, ! THE SYMBOL MUST BE "FAKED" TO APPEAR TO BE A STRING, SO ! THAT THE SYMBOL TABLE-MANIPULATION ROUTINES MAY BE USED. ! OPLB6: STRX_STRG !SAVE NAME POINTER NAM_IWP(STRG)?[ GOTO OPNL7] ! GET UNDEFS NAME STRING PTR REF1_IWP(STRG) ! GET UNDEFS 1ST REFERENCE FIX_IWP(STRG) ! GET UNDEFS FIXUP LIST PTR IFNOT NAM THEN GOTO OPLB6 ! SKIP ENTRIES ALREADY DEFINED IFNOT [MFLAG_MAT2($T,NAM,5)] \ NO MATCH. TRY NEXT UNDEF. THEN GOTO OPLB6 ! ! ! MATCH FOUND. ! ! OBTAIN TYPE CODE, AND PROCESS ACCORDING TO TYPE: ! ! TYPE PROCESSED AS: ! 0 NORMAL ENzTRY POINT. FOR RTE-I, TABLE ENTRY WORD 4 ! CONTAINS THE LINK; $(WORD 4) CONTAINS THE SYMBOL ! VALUE. FOR RTE-II, WORD 4 CONTAINS THE SYMBOL ! VALUE(THE RESIDENT BASE PAGE LINKS AREA MUST BE ! SEARCHED FOR A LINK [ONE MAY NOT EXIST]). ! ! EXAMPLES: EXEC, $LIBR,$LIBX ! ! ! 1 DISC-RESIDENT (IN UTILITY LIBRARY). "VALUE" IS DISC ! ADDRESS IN LIBRARY OF MODULE. SXL IGNORES THIS ! DIRECTORY. ! ! 4 REPLACEMENT-TYPE ENTRY POINTS. ALL REFERENCES ! TO THE SYMBOL ARE REPLACED BY THE INSTRUCTION ! CODE FOUND IN THE "VALUE". EXAMPLES: EAU ! AND FLOATING-POINT INSTRUCTIONS. ! OL10: IF TYPE = 4 THEN [VALUE_$(TP3); TYPS_70K; GO TO CFX] TYPS_ 30K; REPFL_-1 IF (LINKF AND 4000K) \CHECK WHETHER VALUE IS SYMBOL OF LINK THEN [VALUE_LNKAD;LNKAD_0;\RTE-II \ SCAN RESIDENT BASE PAGE LINKS AREA FOR MATCH \ IF NO LINK FOUND, USE THE ONES IN THE \ FIXUP LIST. FOR LOOPV_10 TO ($BPA1-1) DO\ [ IF $LOOPV=VALUE THEN\ GOTO CFX]],\ ELSE VALUE_$LNKAD ! RTE-I ! ! RESOLVE FIXUP LIST ! CFX: IF FIX THEN CALL CFXUP(FIX,VALUE,LNKAD,BINY,REPFL) ! ENTER SYMBOL IN SYMBOL TABLE CALL GETRM(0,ENTAD) !GET SYMBOL TABLE SPACE STYP(ENTAD)_TYPS SVLU(ENTAD)_VALUE SATR(ENTAD)_FILEX ! GET ROOM FOR SYMBOL P_T !SET UP BUFFER POINTER IF ($(T+1) AND 77400K) > 20000K \SYMBOL > 2 CHARS. THEN [CALL GETRM(3,NAMAD); SMBL(ENTAD+2)_NAMAD],\ ELSE NAMAD_ENTAD+2 ! ENTAD = SYMBOL TABLE POINTER VIRTUAL ADDRESS ! NAMAD = SYMBOL NAME VIRTUAL ADDRESS ! MOVE SYMBOL NAME TO VIRTUAL MEMORY ! SN2: IF([J_[WORD_$P] AND 77400K]) <= 20000K\SYMBOL ENDED W/ PREVIOUS THEN[SMBL(NAMAD-1)_SMBL(NAMAD-1) OR 200K; GOTO SN3]! WORD IF(WORD AND 177K) <= 40K \ SYMBOL ENDS WITH HIGH-WORD THEN WORD_J OR 200K SMBL(NAMAD)_WORD !STORE CHARACTERS IN VIRTUAL MEMORY IF (WORD AND 200K) THEN GOTO SN3 P_P+1 NAMAD_NAMAD+1 GOTO SN2 ! IF SYMBOL IS A MATCH TO AN UNDEFINED, PURGE ! THE NAME STRING AND DELETE IT FROM ! THE UNDEFINEDS LIST SN3: IF (LISTO AND 1) \ LIST ENTRY PTS OPTION THEN CALL PRENT(ENTAD,VALUE,BINY,REF1) IFNOT MFLAG THEN GOTO OPLB2 CALL STPRG($STRX) !PURGE NAME STRING & DELETE FROM UNDEFS LIST IFNOT LNKAD THEN GOTO OPLB2!NO LINK FOUND IFNOT SLNKS THEN XLNKS_ISTR(SLNKS),ELSE IWP(XLNKS)_-1 IWP(XLNKS)_LNKAD IWP(XLNKS)_VALUE GOTO OPLB2 ! ! NO MATCH TO $T EXISTS IN UNDEFINEDS STRING. ! IF SYMBOL IS TYPE 4, DEFINE IT ANYWAY. ! OPNL7: IF (TYPE OR (LINKF AND 2000K))# 4 THEN GOTO OPLB2 ! ! BIT 10 OF LINKF IS SET AFTER THE FIRST SYSTEM LIBRARY ! SCAN TO PREVENT TYPE 4 ENTS FROM BEING ENTERED MORE ! THAN ONCE. ! MFLAG,FIX,REF1_0 ! GOTO OL10 ! ! FINISHED WITH CORE-RESIDENT LIBRARY ROUTINES. ! SET UP DISC POINTERS ETC. TO READ RELOCTABLE UTILITY LIBRARY ! PROGRAMS. OPL20: $(DCB4+1),TRAK_(([SEC_$DSCUT])->7)AND 377K !TRACK $(DCB4+4),SEC_SEC AND 177K !SECTOR $(DCB4),$(DCB4+3),ERR_0 $(DCB4+2),LU_2 !SYSTEM LIB.ALWAYS ON LU2 $(DCB4+5)_-($DSUNN) !NEG.#PROGS COUNTER $(DCB4+6)_NSPTK !#SECTORS/TRACK(64-WORD) CALL RDSK LINKF_LINKF OR 2000K !SET FIRST-LIBR. PASS FLAG RETURN END ! ! READ DISC ROUTINE ! RDSK: SUBROUTINE DCB17_[DCB13_DCB4+12]+4!POINTER TO 128-WORD PACKING BUFFER CALL EXEC(1,LU,$DCB17,LENTH,TRAK,SEC)  IFNOT[SEC_SEC+1] 7!TRACK $(DCB4+6),NSPTK_$(1755K+LU) !#SECTORS/TRACK $(DCB4+7)_0 ERR_[IF $LGOTK THEN 0,ELSE -6] CALL RDSK !GET 1ST SECTOR RETURN END LET BLNK,MSTBL,EXEC BE SUBROUTINE,EXTERNAL LET FILEX,ASTAK,LISTO,LSTLU,DCB BE INTEGER,EXTERNAL LET STAK BE PSEUDO,EXTERNAL LET BUF BE INTEGER(4) INITIALIZE BUF TO 4(" ") STUP: SUBROUTINE FILEX_STAK(ASTAK) !GET FILE NAME S.T. POINTER CALL BLNK(DCB,3) CALL MSTBL(FILEX,DCB,T) CALL MSTBL(FILEX,BUF(2),T) IF LISTO AND 4 THEN CALL EXEC(2,LSTLU,BUF,4) RETURN END END END$ '   29103-80212 C S 0122 CLOP SPL             H0101 eSP̬̬MϬԬ NAMŠP(!ƠAABŠŠSŠ !V-B5 ԠPKUDƬSŠBŠSUBUNŬNA ԠҬDBBŠNGҬNA P:SUBUNŠGBA A̠S($DBҩ A̠PKUDƠ!PAKUNDNDSSNG. UN ND ND ND$ ܋  29103-80214 C S 0122 DBL SPL             H0101 +SP̬̬MϬԬ NAMŠDB(!DB̠DPSS !Và ԠìSPGDAGABUԬSHVƠBŠSUBUNŬNA ԠSVUPBŠPSUDϬNA ԠNDPMAجMNNKB6BŠUNNNA !DNŠGBA̠NSANS ԠAMABPNPGNKƬNGSSAMMNAϬ\ رABNY\ MNABBŠNGҬNA ԠNɠBŠNGҬNA ԠABUƠBŠNG(50 ԠMAجMNBŠUNNNA ԠSBԠBŠNSAN(00000K!SGNB. ԠBPñBŠAB̬NA NAZŠDϠABU BY:UNNDԠ!GԠNԠANBY. !UNSNԠANBY !$BYPUNԠANBYSD.HSSDYN- !AMAYMDDBYHSUNŠASAHBYŠSUND !SϠHAԠHŠנ3BSAŠHŠNԠBY. !BNԽUNԠƠUND.SԠAҠ5. !NUNNSҠNSUNDŬSBԽNSUNSGNB. ƠBNԽ5HNBYP_NɻBN_0N_N+ SB_(NS_$NݠAND00000K BN_BN+ UN($BYP_($BYP-<3ݠAND ND ! ! DB:SUBUN(NP̱NP̲BASPNHAPAG\ GBA ԠBNYBŠNG(NA A̠SH!SHADŠPNSAUND. D3_D_D++ _ABNY+N_AD_N+ BN_5 !GԠBASŠϠSAԠADNG. YP_(((($ԩ-6AND3Ҡ D_NNS_$ԠANDK+HK$DADDS_$(YP+BASP+$AD $D_(NNSԠ-LWABP THEN -1,ELSE 0]!SET BASE PAGE FULL FLAG. ! ! SEARCH PRIMARY CURRENT PAGE AREA FOR LINK WHICH IS ON SAME ! PAGE AS REFERENCE WORD. ! LIN2: CALL PGCK(GUESS,SGPAG,CP1F,LOCC)?[GOTO LIN4] RETURN LIN4: CALL PGCK(SEC,SC2PG,CP2F,MIN(NXTPG,LWAM1))?[GOTO LINK7] RETURN ! ! SEARCH "SECRET BASE PAGE LINKS STRING". IF MATCH NOT FOUND, ! TOUGH. THIS STRING CAN ONLY BE DEFINED BY LINKS CREATION ! STATEMENT ! LINK7: X_SLNKS SC3PG_IWP(X)?[GOTO LINK8] CALL CHEK(SC3PG)?[GOTO LINK8] RETURN SC3PG !FOUND A SECRET LINK. ! ! MUST ALLOCATE A LINK._ ! LINK8: IF LINKF AND 1 THEN GOTO CURRN,ELSE GOTO BASEP!BRANCH ON LINK MOD LET BP,CP1,CP2 BE SUBROUTINE,DIRECT ! SUBROUTINES TO ALLOCATE LINKS FROM BASEPAGE,PRIMARY OR SECONDARY ! AREAS. ! THEY WILL TRANSFER DIRECTLY TO LNK12 IF A LINK CAN BE ALLOCATED F ! FROM THE RESPECTIVE AREAS, AND WILL RETURN ONLY IF NONE ! CAN BE ALLOCATED. ! BASEP: CALL BP !TRY TO ALLOCATE FROM BASE PAGE FRETURN !IN THIS MODE, ONLY THIS CHOICE POSSIBLE ! CURRN: IF EXTF THEN CALL BP !ATTEMPT BASE PAGE LINK FOR EXTS CALL CP1 !ELSE PRIMARY AREA ! CALL CP2 !TRY TO ALLOCATE FROM SECONDARY AREA. GOTO BASEP !IF NONE OF ABOVE POSSIBLE. ! ! END BP: SUBROUTINE DIRECT!TRY ALLOCATING FROM BASEPAGE AREA. SBPAG_STAK(FREBE)?[GOTO BP5] STAK(UFREB) _ SBPAG ! KEEP TRACK OF THE LINKS OBTAINED FROM ! "FREBE" CALL PBPLK(SBPAG,VALUE); GOTO LNK11 BP5: IF BPF THEN RETURN !BASE PAGE AREA FULL. IWP(XBPLK)_VALUE NBPLK_NBPLK+1 MAXAB_MAX(MAXAB,SBPAG) GOTO LNK11 END CP1: SUBROUTINE DIRECT!TRY ALLOCATING FROM PRIMARY AREA IF CP1F THEN RETURN !PRIMARY AREA FULL. IWP(XGESS)_VALUE LINKV_SGPAG !LINK ADDRESS NCPL1_NCPL1+1 GOTO LNK12 END CP2: SUBROUTINE DIRECT!TRY ALLOCATING FROM SEC. LINKS AREA IF CP2F THEN RETURN !SECONDARY AREA FULL. IWP(XSEC)_VALUE LINKV_SC2PG !LINK ADDRESS NCPL2_NCPL2+1 GOTO LNK12 END CHEK: SUBROUTINE(CHE) FEXIT,DIRECT !SUBROUTINE TO SCAN EITHER ! BASE PAGE, OR EITHER CURRENT PAGE LINK STRING, DEPENDING ON WHICH ! OF THESE "X" POINTS TO, TO DETERMINE IF ANY OF THE LINKS IN THE LINK ! STRING MATCHES "VALUE." A NORMAL RETURN, WITH CHE = ADDRESS OF THE ! IS MADE IF A MATCH OCCURS, OTHERWISE AN F-RETURN IS MADE, WITHH CHE1 ! POINTING TO THE PLACE IN THE STRING WHERE THE LINK VALUE IS TO ! GO, IF IT IS APPLICABLE. ! ! IF ANY LINK IN THE LINKS STRING IS FOUND TO BE -1,THEN IT ! MARKS THE END OF THAT GROUP. ANOTHER GROUP MAY START, THE ! NEXT WORD IN THE STRING BEING THE START ADDRESS OF THE NEXT ! LINKS GROUP. THIS ALLOWS DATA TO BE MIXED WITH LINKS ! RELATIVELY INDISCRIMINATELY. ! CHEK0: IFNOT[CHEKV_IWP(X)?[FRETURN]] < -1 THEN\ [IF CHEKV < 2 THEN GOTO CHEK1] IF CHEKV#VALUE THEN GOTO CHEK1 !REJECT LINK IF <2 OR IF NO MATCH RETURN CHEK1: CHE_CHE+1 IF CHEKV #(-1) THEN GOTO CHEK0 CHE_IWP(X)?[FRETURN] GOTO CHEK0 END PGCK: SUBROUTINE(LSTRG,CPG,CPF,PLAST) FEXIT,DIRECT ! SUBROUTINE TO CHECK IF A LINKS STRING IS ON THE CURRENT ! PAGE(RPAGE), AND TO SET THE PAGE-STRING CLOSED FLAG(CPF) IF ! NOT, AND TO DETERMINE IF A LINK ALREADY EXISTS ON THAT STRING. X_LSTRG !SET DYNAMIC POINTER TO BEG. OF STRING CPG_IWP(X)?[GOTO CLOSE]!GET ADDRESS OF STRING; CLOSE IF NO STRING IF B76(CPG)#RPAGE THEN GOTO CLOSE!STRING NOT ON RIGHT PAGE CALL CHEK(CPG)?[GOTO MCLOS]!SEARCH STRING FOR MATCH;MAYBE CLOSE I LINKV_CPG !RETURN ADDRESS OF MATCHING LINK RETURN MCLOS: IF CPG < PLAST THEN FRETURN !STILL ROOM LEFT IN LINK AREA CLOSE: CPF_-1 !SET AREA CLOSED FLAG FRETURN END END END$ [  29103-80217 1715 S 0122 RDCRD SPL             H0101 SPL, L, M, O, T, C NAME RDCRD(8) "REV G 770324" ! ! SUBROUTINE TO READ NEXT LINE RD: SUBROUTINE LET SOURC,SPTR BE INTEGER,EXTERNAL LET SODC4,CMDLN,CHAR,OBT,INLU,EKOLU BE INTEGER,EXTERNAL LET SODCB BE INTEGER,EXTERNAL LET READF BE SUBROUTINE,EXTERNAL LET EXEC,TRBAK,DIAG BE SUBROUTINE,EXTERNAL LET ISTR BE FUNCTION,EXTERNAL LET ICP BE PSEUDO,EXTERNAL LET CONTN BE INTEGER !CONTINUATION CHARACTER INITIALIZE CONTN TO "&" LET COMID BE CONSTANT(26400K) !COMMAND ID CHAR(-) LET PRMPT BE INTEGER(2) !PROMPT CHARACTER INITIALIZE PRMPT TO 3407K,"-_" LET IAILU BE INTEGER,EXTERNAL !INTERACTIVE INPUT DEVICE FLAG LET EQT5 BE INTEGER LET DRT BE CONSTANT(1652K) ! R0: CHAR,T_@OBT+1 IAILU _ 0 LU77 _ INLU AND 77K EQT5 _ $($DRT+LU77-1) AND 77K IF LU77 # 0 AND EQT5 # 0 THEN [\ MUST BE A VALID LU CALL EXEC(13,LU77,EQT5);\ !GET STATUS OF INPUT DEVICE IF [EQT5_(EQT5 -> 8) AND 77K] = 5\ IF TYPE = 5 THEN CHECK THEN [EQT5_(($($DRT+LU77-1) -<5) AND 37K)];\ FOR SUBCH 0 IF EQT5 = 0 THEN [\ !SET INTERACTIVE FLAG ON, IAILU _ 1;\ CALL EXEC (2,INLU,PRMPT,2)]] ! AND PRINT PROMPT CALL READF($SODC4,ERR,$T,40,CMDLN) IF CMDLN<0 THEN [CALL TRBAK; GOTO R0]!EOF--TRANSFER BACK IF ERR<0 THEN CALL DIAG(16,@SODCB) IF EKOLU THEN CALL EXEC(2,EKOLU,OBT,CMDLN+1) ! ! CHECK FOR COMMENT IF[C_ $T AND 77400K] =25000K\"*"; IGNORE COMMENTS THEN GOTO R0 !IGNORE COMMENTS ! ! CHECK FOR COMMAND IDENTIFIER CHARACTER ! IF C# COMID THEN[ IF IAILU =0 THEN\ CALL DIAG(17,0)],\!COMMAND ID REQUIRED BUT NOT FOUND ELSE $T_($T AND 177K) OR 20000K!SET COMMAND ID CHAR TO BLANK RETURN END ! RDCRD: SUBROUTINE GLOBAL ! SUBROUTINE TO READ NEXT STATEMENT    SOURC_ISTR(SPTR) R1: CALL RD !GET NEXT LINE L_CMDLN<-1; WHILE L DO\ [C_$T; IFNOT (L AND 1) THEN C_C-<8,\ ELSE T_T+1;IF[C_C AND 177K]=CONTN THEN GOTO R1;\ ICP(SPTR)_C; L_L-1] ICP(SPTR)_15K !PUT IN CARRIAGE RETURN SPTR_SOURC !START AT HEAD OF STRING RETURN END END END$   29103-80218 A S P0122 CRTOP SPL             H0101 SP̬̬MϬԬ NAMŠP( ! !AŠŠPSHPA ! !NNSƠASAKHNAD(MPƠSAKDN ! !NGAVŠBKSZ !S..PNҠϠŠNAM !NGAVŠYPŠ(--6Ҡ- !S..PNҠϠADGŠDN(HHSNUMé !S..PNҠϠSUYD(HHSASϠNUMé ! ! ԠSAKSVUBŠPSUDϬNA ԠDAGBNKMSB̬AԠBŠSUBUNŬNA ԠASAKDBDBҠBŠNGҬNA ԠSZŬYPŬҬSàBŠNG S:UNN UN(SV_SAK(ASAKݠHNSVU(SV\ SŠ0ݩ ND P:SUBUNŠGBA SZ_-SAK(ASAK!GԠPS.BKSZ A̠BNK(DB3A̠MSB(SAK(ASAKDBYPũ!BANKMVŠ !GԠŠNAMŠANDMVŠϠDAAN̠BKNAMŠAA YP_-SAK(ASAK!GԠPS.ŠYP !GԠADGŠ.D.ANDSUYDŠVAU _SS_S ! !NנAŠHŠ A̠A($DBҬDBSZŬYPŬSìҩ Ơ<0HNA̠DAG(0DB!AŠŠ UN ND ND ND$   29103-80221 C S 0122 SNPOP SPL             H0101 gSP̬̬MϬԬ NAMŠSNPP( !V-à ! !SNAPSAMNԠPSHUN ! !SNAPN-1 !ASSIGN # PAGES / TRACK IFNOT SESIZ THEN\ NO TRACKS AVAILABLE.PRINT WAITING MSG & [CALL .XEC(2,WATG,14); CALL EXEC(7);\ SUSPEND GOTO RT3]    !RETRY ON OPERATOR "GO" RT1: PDSIZ_MIN(240, TSIZE*SESIZ) RETURN END END END$   29103-80226 C S 0122 INIT1 SPL             H0101 lSP̬̬MϬԬ !Và0 NAMŠNԱ( ԠMMҬPNDAGKDBMV.BŠSUBUNŬNA ԠSVUSYPBŠPSUDϬNA ԠSҠBŠUNNNA ԠSDôDBDBBDNGNUKUSUUUBŠNGҬ\ NA ԠSDBìBPìҬNKƬUNDƱUNDSSϬ\ BPKSNBPKMAAMNAMAAPҬBŬSNKSNKSMNA\ ҬPNAMPVSKMAABMNABBŠNGҬNA ԠàBŠSUBUNŬNA ! !DNŠADDSSSƠHSԠSYSMPAAMS: ! ԠDSBBŠNSAN(6K!-SDNԠBAYNYPNS ԠDSUԠBŠNSAN(63K!DS-SDNԠUYBAYADD ԠSԲBŠNSAN(5K!SSAKSYS.DS NԱ:SUBUNŠGBA DNGNBPKSKBPìҬMAABMNABMNA\ MAAìUNDƱBPKSMAAUNDSPҬBŬSNKS\ NKSMNAPNAMPV_0 ƠNKƠAND0000KHNGϠNԲ!SUPU'SNYN. NK_NKƠ\SԠBԠƠ- Ơ$DSB<$DSUԠHN0\- SŠ000K!- NԠNUHNNU_5!DAUԠNPUԠUN NԠSUHNSU_6SŠS_K NԠUUHNUU_ !HKƠSԠ3PAAMSAŠAŠNAM ƠNU0000KHN\YS--MVŠHASϠSUŠD..B. P_NU\ƠŠNAM<6HAS.BANK- PAԠ3MSD\ ۠($PҠAND00K<0000KHN\ $P_0000K\ Ơ($PҠANDK<0KHN\ $P_(($PҩAND00K+0K\ P_P+ݻ\ A̠MV.(NUSDB3\MVŠNAMŠϠSUŠDB NU_0SUKU_0UU_\ A̠PN($SDôҬSDBƠҠ<0HN\ NU_0KA̠KDB($SDôNU000000K\ A̠DAG(6SDBݬ\ SƠNUHNNU_0KA̠KDB($SDôٖ  NU0\ 00000K NԲ:NK_(NKƠAND3KҠ0000K A̠MMҠ!SUPDAUԠPGAMBUNDS UN ND ND ND$ S   29103-80227 A S P0122 MEMR SPL             H0101 SP̬̬MϬԬ NAMŠMM( !SUBUNŠϠUNDAUԠBUNDSƠAVAABŠMMY. ! ! !DNŠNSANSҠŠBAKGUNDDSàSDNԠPGAMS. ! Ԡ.AMBŠNSAN(K!ABKD Ԡ.AMBŠNSAN(5K!A" Ԡ.ABBŠNSAN(K Ԡ.ABBŠNSAN(6K!ABP6K Ԡ.AàBŠNSAN(5K Ԡ.MBŠNSAN(53K !NDSYSM-DPNDNԠNSANS ԠAMAMABPABPAìAìMMBŠNGҬNA ԠAMBŠNGҬNA !HKƠMMYBUNDSNSANSDNDPVUSYAS !UDBŠPSSBŠҠSGMNԠPSSNG. MM:SUBUNŠGBA NԠAMHNAM_$.AM NԠAMHNAM_$.AM NԠABPHNABP_$.AB NԠABPHNABP_.AB NԠAMHNAM_$.AM UN ND ND ND$ &  29103-80228 1715 S 0122 MAPST SPL             H0101 SPL,L,M,O,T,C NAME MAPST(8) "REV G 770325" ! MAP OPTION ROUTINE SEMANTICS. ! ! LISTO IS THE LIST OPTIONS FLAG , CODED AS FOLLLOWS: ! BIT 0 (1) GLOBALS ! 1 (2) MODULES ! 2 (4) FILES ! 3(10) HEADING HAS BEEN PRINTED. ! 4(20) LINKS ! LET OFFS BE CONSTANT(100404K) !"OFF" LET FILS BE CONSTANT(100234K) !"FILES" LET GLBS BE CONSTANT(100240K) !"GLOBALS" LET MODS BE CONSTANT(100224K) !"MODULES" LET LINKS BE CONSTANT(100100K) !"LINKS" LET ON BE CONSTANT(100220K) !"ON" LET ALL BE CONSTANT(100410K) !"ALL" LET LSTLU,ERR,ASTAK,LISTO BE INTEGER,EXTERNAL LET EXEC BE SUBROUTINE,EXTERNAL LET STAK,SVLU BE PSEUDO,EXTERNAL LET MSG1 BE INTEGER(31) ! TITLE LET MSG2 BE INTEGER(19) ! MESSAGE LET MSG3 BE INTEGER(35) ! BUFFERS LET DATE BE INTEGER (5) INITIALIZE MSG1 TO\ " FILE PROGRAM GLOBAL FIRST LAST BASE PAGE REF.BY " INITIALIZE MSG2 TO\ " NAME MODULE VARS. ADDRS. ADDRS." INITIALIZE MSG3 TO " ",34("--") INITIALIZE DATE TO " SXL REV G" S: SUBROUTINE !POP TWO VALUES FROM ASTAK SV_STAK(ASTAK) T_STAK(ASTAK)?(0) RETURN END !RETURN F-RETURN STATUS IN (E) REG. ! MAPST: SUBROUTINE GLOBAL LISTO_LISTO AND 10K !CLEAR MAP OPTIONS FLAG MP1: CALL S?[GOTO QUIT] !GET NEXT TWO ITEMS FROM ASTAK IF SV=ON THEN GOTO QUIT IF T=FILS THEN LISTO_LISTO OR 4 !"FILES" IF T=MODS THEN LISTO_LISTO OR 2 !"MODULES" IF T=GLBS THEN LISTO_LISTO OR 1 !"GLOBALS" IF T=LINKS THEN LISTO_LISTO OR 20K IF T= OFFS THEN LISTO_LISTO AND 10K IF T = ALL THEN LISTO_LISTO OR 27K GOTO MP1 !LOOP ON GETTING OPTIONS. ! QUIT: IF T THEN LSTLU_SVLU(T) IF LISTO AND 27K THEN[\ IFNOT(LISTO A6  ND 10K)THEN\ PRINT HEADER [CALL EXEC(3,LSTLU+1100K,-1); CALL EXEC(2,LSTLU,DATE,5);\ CALL EXEC(2,LSTLU,MSG1,31);\ CALL EXEC(2,LSTLU,MSG2,19);\ CALL EXEC(2,LSTLU,MSG3,35);\ LISTO_LISTO OR 10K]] RETURN END END END$ 7   29103-80229 C S 0122 LNKST SPL             H0101 kSP̬̬MϬԬ !Và NAMŠNKS( ԠDԠBŠNGҬNSAN(00500K!"D" ԠUNԠBŠNSAN(000K!"UN"NS.. ԠSBԠBŠNSAN(00000K!SGNB. ! !NK:NKMDŠAG !BԠMANNG !BԠVAUŠMANNG !50NDԠNKNGMD !DԠNKNGMD !00BASŠPAGŠNY !UNԠPAG !0NAZANƠGA̠UNSNԠPMDY. !""""HASBNPMD. !0- !- !00SԠPASSƠ-SDNԠSYSMNYPNSN !PMD. !SԠPASS-S.NYPSHASBNPMD. ! ! ԠSAKBŠPSUDϬNA ԠAVAUASAKBŠNGҬNA ԠNKƠBŠNGҬNA S:UNN!GԠVAUŠƠASAK UNSAK(ASAK ND NKS:SUBUNŠGBA !PP"NKSN" SV_S SV_S NK_ƠSUNԠHNSŠ0ݠҠ(NKƠAND6000K AAYSDϠ\HKҠ"D" ƠS?UNݠDԠHNNK_NKƠҠSB ND ND ND$   29103-80231 A S P0122 MAT2 SPL             H0101 mSP̬̬MϬԬ NAMŠMAԲ( ! MAԲ:UNN(BUҬSجNGBA ! !UNNϠHKAHAAҠSNGAGANSԠAŠBU. !HAASAŠVDASBԠDAABYSƠAZϠAMŬ !ҠASɠBANK(0KҠMMA(5KSUNDNBUҬMP- !ASNMNASSUSSUYƠHŠHAAҠSNGS !MPYҠAUŠMNASƠN. !HSŬAMAMUMNHAASSHKD. ! ԠBUҠBŠNG(!ŠHAAҠBU ԠSؠBŠNGҠ!HAAҠSNGPN ԠNBŠNGҠ!MAMUMHAASϠHK. ԠPBŠPSUDϬNA̠!NMNԠHAAҠPN ! SP_Sؠ!SAVŠSNGPNҠNNAY. BP_BU Ҡ_ϠNDϠHUMAԲ _$BPҠ!GԠBUҠàHAA (ɠANDHN_-7? JMP HLT73 NO! GO TELL OPERATOR. LIA 1 GET SW. REG. AGAIN. ALF,ALF SHIFT SECOND RAL,RAL SC AROUND TO LOWER BYTE. AND B77 MASK TO SECOND IBI SC. STA IBH2 SAVE IT FOR TESTING. SZA,RSS IS THERE A SECOND SC? JMP NOSC1 NO! GO HALT NORMALLY. AND B70 MASK TO UPPER SC DIGIT. SZA IS SC > 7 ? JMP NOSC1 YES! CONTINUE NORMALLY. HLT73 HLT 73B NO! TELL OPERATOR HE ENTERED JMP CONFG ILLEGAL SC AND THEN RETURN. NOSC1 CLA OTA 1 CLEAR SW REG HLT 70B TEST SC'S ENTERED PROPERLY. LIA 1 GET SW.REG. WITH MYADDR(S). STA SAVEA SAVE IT FOR LATER USE. AND B77 MASK TO FIRST MYADDR. CPA B37 ADDRESS 37 IS NOT ALLOWED JMP HLT73 TRY AGAIN STA MYA1 SAVE IT. LDA SAVEA GET ORIGINAL SW. REG. ALF,ALF ROTATE SECOND MYADDR INTO RAL,RAL POSITION FOR MASK. AND B77 MASK TO SECOND MYADDR. CPA B37 ADDRESS 37 IS NOT ALLOWED JMP HLT73 TRY AGAIN STA MYA2 SAVE IT. CLA OTA 1 CLEAR SW REG HLT 71B MYADDR(S) ENTERED. LIA 1 GET PPPID INPUT FROM SW.REG. AND B377 MASK TO FIRST PPPID. STA PID1 SAVE IT. LIA 1 GET SW. REG. AGAIN. ALF,ALF SHIFT SECOND PPPID AROUND AND B377 AND MASK IT OFF. STA PID2 SAVE IT. LDA IBH2 IS THERE A SECOND SC SZA UNDER TEST? JMP NOSSC YES! GO HALT 74B. LDA IBH1 NO! UPDATE ALL INPUT PARAMETERS STA IBH2 SO THAT ONLY ONE IBI LDA MYA1 WILL BE TESTED BECAUSE OPERATOR STA MYA2 INDICATED ONLY ONE IBI IS LDA PID1 PRESENT. STA PID2 NOSSC CLA OTA 1 CLEAR SW REG HLT 74B END OF CONFIGURATION. SKP * * START OF MAIN DIAGNOSTIC * STARX LDA HALTC GET TRAP CELL HALT. LDB TWO GET FIRST TRAP CELL LOCATION. TRAPL STA B,I PUT A HALT IN THE TRAP CELL. CPB B77 STORED LAST TRAP CELL? JMP SKIN YES! GO TO TESTING. INB NO! UPDATE TRAP CELL POINTER. JMP TRAPL GO STORE THE NEXT TRAP CELL. SKIN CLA INITIALIZE THE STA PASCT PASS COUNT. LDB BIT10 SEE IF OPERATOR SUPPRESSED NON- JSB SWRT ERROR MESSAGES. DID HE? JMP CKTSM YES! SKIP PRINTING. CLE LDA DSN GET DSN LDB HDMX ADDR OF MESSAGE STRING JSB O2AS,I CONVERT OCTAL TO ASCII. JSB PCRLF GO PRINT CR-LF. CLA,CLE LDB INTMS GET INFORMATION AND MESSAGE POINTER. JSB FMTR,I GO PRINT MESSAGE. CKTSM JSB GETTM SEE IF OPERATOR WANTS TS MODULE. CLA CLEAR THE STA CTLWD CONTROL WORD. LDA B7760 GET THE INITIAL TEST MASK. STA MASK SAVE IT FOR TEST. CCA INITIALIZE PASS STA PSIND INDICATOR. MAINL JSB NOTWM SET ERROR REPORTING MODE. JSB SWAP GO SET UP TEST INFORMATION. CLA SET UP INITIAL STA ERRCD ERROR HALT NUMBER. * * TEST FLAG AND SKF LOGIC OF IBI * CLC INTP,C SHOULD SET IFC FLG FF. JSB CLCCF CLEAR FLAG ON IBI. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB SFCIB IS I-O FLAG CLEAR? E000 DEF FLGER NO! REPORT ERROR. JSB CONT SET ACTIVE AND OCT 100205 SRQFLGEN. I-O FLAG SHOULD SET. JSB SFSIB DID FLAG SET? E001 DEF FLGER NO! REPORT ERROR. IO.02 SFS IBI SKF SHOULD OCCUR. RSS IT DIDN'T. ERROR. JMP SK6 IT DID . CONTINUE. JSB SENDM REPORT ERROR. E002 DEF FLGER NO SKF ON SFS. SK6 ISZ ERRCD UPDATE ERROR CODE. JSB CLCCF SHOULD CLEAR IFC FLG FF. IO.03 SFC IBI SKF SHOULD OCCUR. RSS IT DIDN'T. REPORT ERROR. JMP SK7 IT DID SO CONTINUE NORMALLY. JSB SENDM REPORT ERROR. E003 DEF FLGER NO SKF ON SFC. SK7 ISZ ERRCD UPDATE ERROR CODE. SKP * * TEST INTERRUPT LOGIC * JSB STUFJ SET UP RETURN JMP IN THE DEF RTN1 IBI TRAP CELL. CLC INTP,C SET IFC FLG FF. JSB TIMOT ALLOW IFC TIME TO SETTLE. JSB CONT SET SRQFLGEN TO SET OCT 100205 THE IBI FLAG FF. IO.04 STC IBI SET THE CONTROL FF. STF INTP TURN I/O SYSTEM ON THEN CLF INTP TURN IT OFF. NOP IBI SHOULDN'T INTERRUPT. JMP XSCTT IT DIDN'T.GO TO NEXT TEST. RTN1 JSB SENDM IT DID SO REPORT ERROR. E004 DEF IENFL IEN LOW DIDN'T HOLD OFF INT. XSCTT ISZ ERRCD UPDATE ERROR CODE. * * TEST FOR ILLEGAL SELECT CODE DECODE. * LDB BIT3 START WITH SC 10. SCLOP CLC INTP,C ISSUE CRS TO IBI. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB CONT SET ACTIVE AND OCT 100205 SRQEN. LDA IO.04 GET I-O INSTRUCTION. AND B77 MASK TO SC. CPB A IS THIS THE IBI TEST SC? JMP EXCTT YES! SKIP TEST. LDA CLC NO! SET UP AND NB77 A CLC IBI,C IOR B INSTRUCTION. STA CLC PUT IT IN LINE. CLC CLC IBI,C ISSUE CLRINTFLG TO IBI. JSB SFSIB WAS FLAG CLEARED ILLEGALLY? E005 DEF SCFL YES! REPORT ERROR. JSB DECEC DECREMENT ERROR CODE. EXCTT CPB B77 IS TEST FINISHED? JMP BIO6C YES! GO EXIT. INB NO! UPDATE TO NEXT SC JMP SCLOP AND GO TEST IT. * * CHECK CONTROL FF LOW * HOLDS OFF AN INTERRUPT. * BIO6C ISZ ERRCD UPDATE ERROR CODE. JSB STUFJ PUT RETURN JMP IN IBI DEF RTN2=/ TRAP CELL. IO.06 STC IBI SET CONTROL FF ON IBI. STF INTP TURN ON INTERRUPT SYSTEM. IO.15 CLC IBI CLEAR CONTROL FF ON IBI. NOP ALLOW TIME TO INTERRUPT. JMP XINTT NO INT? GO DO NEXT TEST. RTN2 JSB SENDM INT? SEND ERROR MESSAGE. E006 DEF CLCFL CNTL LOW DIDN'T HOLD OFF INT. XINTT ISZ ERRCD UPDATE ERROR CODE. * * CHECK IBI CAN INTERRUPT * JSB STUFJ SET UP RETURN JMP DEF RTN5 IN IBI TRAP CELL. IO.16 STC IBI SET CONTROL FF ON IBI. NOP IBI SHOULD INTERRUPT HERE. JSB SENDM NO INTERRUPT SO E007 DEF INTFL REPORT ERROR. RTN5 ISZ ERRCD UPDATE ERROR CODE. JSB STUFJ SET UP RETURN JMP IN DEF RTN6 IBI TRAP CELL. STF INTP TURN ON INTERRUPT SYSTEM. NOP NO INT SHOULD OCCUR. JMP CINST IT DIDN'T! CONTINUE. RTN6 JSB SENDM IT DID! REPORT ERROR. E010 DEF IAKFL IAK DID NOT WORK. * * TEST INITIAL STATUS OF IBI1 AND IBI2. * CINST CLF INTP TURN OFF INT. SYSTEM. ISZ ERRCD UPDATE ERROR CODE. LDA PSCAE UPDATE ERROR MESSAGE STA PARAM CONTROL WORD. JSB CLCCF INITIALIZE I-O. JSB INITF INITIALIZE OBR LOGIC. LDB ISTAT GET EXPECTED IBI STATUS WORD. JSB STAT GET IBI STATUS. IS IT OK? E011 DEF ISTAF NO! INITIAL STATUS FAILURE. SKP * * TEST THE SET AND CLEAR CONTROL WORD * CAPABILITIES OF THE ACTIVE,REN,ATN,TALK * AND LISTEN FLIP-FLOPS. * JSB PRWMS SET UP ERROR REPORTING MODE. STO SET MESG INDICATOR. LDA B760 SET UP STA MASK TEST MASK. LDA MTABL SET STA MTAB1 UP LDA CTABL MESSAGE, STA CTAB1 CONTROL DATA AND LDA ETABL EXPECTED STA ETAB1 DATA TABLE POINTERS. TL01B LDA MTAB1,I GET ERROR MESSAGE POINTER. STA E012 PUT IT IN LINE. LDA CTAB1,I -c GET CONTROL WORD FROM TABLE. STA INLCO PUT IT IN LINE. LDB ETAB1,I GET EXPECTED STATUS. JSB CONT OUTPUT CONTROL WORD TO IBI . INLCO NOP CONTORL WORD. JSB STAT GET STATUS FROM IBI . E012 DEF * ERROR MESG POINTER. *E012 - E027* ISZ CTAB1 INCREMENT CONTROL WORD POINTER. LDA CTAB1,I GET CONTROL WORD. CPA MIN1 IS THIS THE END OF THE TABLE? JMP TL02A YES! GO TO NEXT TEST. ISZ ETAB1 NO! INCREMENT EXPECTED DATA TABLE. SOS OVERFLOW SET? JMP SK8 NO! GO UPDATE MESG TABLE PNTR. CLO YES! CLEAR OVERFLOW AND SKIP JMP TL01B MESG PNTR UPDATE. SK8 STO SET OVERFLOW. ISZ MTAB1 UPDATE MESSAGE TABLE PNTR. JMP TL01B GO CONTINUE TESTING. SKP * * THIS SECTION TESTS THE IFC ONE-SHOT LOGIC * CAN CLEAR ATN AND SET ACTIVE. * TL02A JSB CONT SET ATN AND OCT 64 CLEAR ACTIVE JSB IFCMD SET IFC. LDB B31 EXPECTED STATUS. JSB STAT GET IBI STATUS. IS IT OK? E030 DEF IFCF1 NO! IFC OS FAILURE. * * NOW TEST IFC OS STAYS ON FOR APPROXIMATELY * 40 MICROSECONDS. * JSB IFCMD TRIGGER IFC. JSB CACTV CLEAR ACTIVE. JSB STAT GET IBI STATUS. ACTIVE CLEAR? E031 DEF IFCF1 YES! IFC FAILED AFTER 40 US. * * INSURE IFC OS EVENTUALLY CLEARS * JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB CACTV CLEAR ACTIVE. LDB B11 GET EXPECTED STATUS. JSB STAT DID ACTIVE CLEAR? E032 DEF IFCF1 NO! REPORT ERROR. * * THIS SECTION TESTS THE ABILITY OF CRS TO * SET IFC AND CLEAR REN. * JSB CONT SET THE OCT 3 REN FF. CLC INTP,C ISSUE CRS. JSB TIMOT ALLOW IFC TIME TO SETTLE. LDB B31 GET EXPECTED STATUS. JSB STAT IS ACTIVE SET & REN CLEAR? E033 DEF RNIFC NO! REN OR IFSHFBC FAILURE. SKP * * THIS SECTION TESTS THE EORFLG * AND EORFLGEN LOGIC * LDB BIT12 SET TEST STB MASK MASK TO 10000. JSB SPPMD SET ATN FF AND EOI FF. JSB SINPD STROBE EOR FF. JSB STAT GET IBI STATUS. IS EOR FF SET? E034 DEF EOR NO! EOR FAILURE. * * ATN SHOULD BE CLEAR FROM STROBE INPUT DATA, * THUS DISABLING EOI. * JSB CLCCF CLEAR EOR FF. JSB SATN SET ATN AND CLEAR EOI. JSB SINPD STROBE EOR FF CLEAR. CLB GET EXPECTED STATUS. JSB STAT GET IBI STATUS. IS EOR FF CLEAR? E035 DEF EOR NO! EOR FAILURE. * * NOW CHECK THAT CLC IBI,C CLEARS THE EOR FF. * JSB SPPMD SET END OR IDENTIFY AND ATN. JSB SINPD STROBE EOR FF SET. JSB CLCCF CLC IBI,C CLEARS THE EOR FF. JSB STAT GET IBI STATUS. IS EOR FF CLEAR? E036 DEF EOR NO! EOR FAILURE. * * CHECK NO ATN DISABLES EOI TO IB * JSB SEOI CLEAR ATN, SET EOI. JSB SINPD CLOCK EOI LOW. JSB STAT DID EOI CLEAR? E037 DEF EOR NO! REPORT ERROR. * * THIS SECTION CHECKS THE EOI FF CAN BE CLEARED. * JSB SATN SET ATN FF. CLEAR EOI FF. JSB SINPD STROBE EOR FF. SHOULD CLEAR IT. JSB STAT GET IBI STATUS. IS EOR CLEAR? E040 DEF EOR NO! EOR FAILURE. JSB STALK SET TALK MODE. JSB SEOI SET EOI FF. JSB IFCMD TRIGGER IFC. CLEARS EOI. JSB TIMOT ALLOW IFC TO SETTLE OUT. JSB SINPD STROBE EOR FF. SHOULD CLEAR IT. JSB STAT GET IBI STATUS. IS EOI CLEAR? E041 DEF EOR NO! EOR FAILURE. SKP H  59310-18003 1728 S 0122 HPIB DIAG.              H0101 * * CHECK IBI FLAG LOGIC IS ENABLED * BY EORFLG AND EORFLGEN. * JSB NOTWM SET ERROR REPORTING MODE. JSB CLCCF CLF ON IBI. JSB SFCIB SFC ON IBI. IS IT CLEAR? E042 DEF IOFLG NO! I-O FLAG ERROR. JSB CACTV DISABLE PPREQ. JSB SPPMD SET ATN AND EOI. JSB SINPD SET EOR FF. JSB SFCIB FLAG SHOULD NOT BE SET. IS IT? E043 DEF IOFLG YES! I-O FLAG ERROR. * * CHECK ABILITY TO SET THE IBI FLAG VIA EORFLG. * JSB CONT SET EOR OCT 10200 FLAG ENABLE. JSB SFSIB I-O FLAG SHOULD BE SET. IS IT? E044 DEF EOFEN NO! EORFLG ERROR. * * INSURE CRS CLEARS EORFLGEN. * CLC INTP,C CRS SHOULD CLEAR EORFLGEN. JSB TIMOT ALLOW IFC TO SETTLE. JSB CLCCF CLC IBI,C. JSB SPPMD SET JSB SINPD EOR FF. JSB SFCIB FLAG SHOULD NOT SET. DID IT? E045 DEF EOFEN YES! EORFLG ERROR. * * CHECK ABILITY TO CLOCK EORFLGEN LOW. * JSB CLCCF CLEAR EOR FF. JSB CONT SET OCT 10200 EORFLGEN. JSB CG3MC CLEAR MODE CONTROL (EORFLGEN). JSB SPPMD SET ATN AND EOI FF'S. JSB SINPD CLOCK EOR FF HIGH. JSB SFCIB FLAG SHOULD NOT SET. DID IT? E046 DEF EOFEN YES! EORFLG ERROR. * * CHECK EORFLG LOW DOESN'T SET IBI FLAG. * JSB CLCCF CLEAR EOR FF. JSB CONT SET OCT 10200 EORFLGEN. JSB SFCIB FLAG SHOULD NOT SET. DID IT? E047 DEF EOFEN YES! EORFLG ERROR. SKP * * THIS SECTION TESTS THE ABILITY TO CHECK * STATUS ON THE DAV,RFD AND DAC SIGNALS. * JSB PRWMS SET ERROR REPORTING MODE. LDA B7000 SET UP STA MASK TEST MASK. JSB IFCMD INITIALIZE IBI(DAV CLEARS). JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. LDB B3000 GET EXPECTED STATUS. JSB STAT IS RFD-DAC HIGH,DAV CLEAR? E050 DEF HANDS NO! REPORT ERROR. JSB 5INITF SET RFD FF. JSB SLSTN SET LISTEN. CLB FORM EXPECTED STATUS. JSB STAT IS DAV,RFD AND DAC LOW? E051 DEF HANDS NO! REPORT ERROR. JSB LIAIB CLEAR RFD FF. LDB BIT10 GET EXPECTED STATUS. JSB STAT IS RFD HIGH,DAV-DAC LOW? E052 DEF HANDS NO! REPORT ERROR. JSB INITF SET RFDFF. CLB FORM EXPECTED STATUS. JSB STAT IS RFD,DAC & DAV CLEAR? E053 DEF HANDS NO! REPORT ERROR. JSB CONT SET ATN,EOI OCT 10270 AND EORFLGEN. JSB SINPD CLOCK EOR FF HIGH. JSB INITF CLEAR RFD FF. JSB SEOI CLEAR ATN. JSB STAT ALL HANDSHAKE SIGNALS CLEAR? E054 DEF HANDS NO! REPORT ERROR. JSB CONT SET ATN AND EOI AND OCT 270 CLEAR MODE CONTROL. LDB BIT10 GET EXPECTED STATUS. JSB STAT ONLY RFD SHOULD BE HIGH. E055 DEF HANDS NO! REPORT ERROR. JSB CONT SET OCT 10200 EORFLGEN. JSB CLCCF CLEAR EOR FF. JSB STAT ONLY RFD SHOULD STILL BE HIGH. E056 DEF HANDS NO! REPORT ERROR. JSB INITF SET RFD FF. JSB CTLSN CLEAR LISTEN MODE. LDB B3000 GET EXPECTED STATUS. JSB STAT RFD & DAC HIGH? E057 DEF HANDS NO! REPORT ERROR. LDB BIT10 GET EXPECTED STATUS. JSB SLSTN SET LISTEN. JSB SATN SET ATTENTION. JSB STAT RFD STILL HIGH? E060 DEF HANDS NO! REPORT ERROR. SKP * * THIS SECTION TESTS THE ORAFLG AND ORAFLGEN LOGIC * JSB SDMOD FORCE RFD JSB SLSTN LOW. JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDB BIT13 GET EXPECTED STATUS. STB MASK SET UP TEST MASK. JSB STAT GET IBI STATUS. ORAFLG HIGH? E061 DEF ORAFL NO! ORA FLG ERROR. CLA OUTPUT ZEROS JSB DATOT TO IB DATA BUS. CLEAR OWRL FF. CLB GET EXPECTED STATUS. JSB STAT GET IBI STATUS, ORAFLG LOW? E062 DEF ORAFL NO! ORAFLG ERROR. JSB NOTWM SET ERROR REPORTING MODE. CLC INTP,C CLEAR ORAFLGEN IN CASE IT WAS SET. JSB TIMOT ALLOW IFC TO SETTLE. JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. JSB SFCIB IS FLAG SET? E063 DEF ORAFL YES! ORAFLG ERROR. * * TEST ABILITY TO SET ORAFLGEN. * JSB CONT SET OCT 20200 ORAFLGEN. JSB SFSIB I-O FLAG SET? E064 DEF ORAFL NO! ORAFLG ERROR. * * TEST ABILITY TO CLEAR ORAFLGEN. * JSB CG3MC CLEAR ORAFLGEN. JSB CLCCF CLC IBI,C. SHOULD STAY CLEAR. JSB SFCIB WAS ORAFLGEN CLEARED? E065 DEF ORAFL NO! ORAFLG ERROR. * * CHECK CRS CLEARS ORAFLGEN. * JSB CONT SET OCT 20200 ORAFLGEN. CLC INTP,C CRS SHOULD CLEAR ORAFLGEN. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB CLCCF CLC IBI,C. FLAG SHOULD STAY CLEAR. JSB SFCIB DID CRS CLEAR ORAFLGEN? E066 DEF ORAFL NO! ORAFLG ERROR. * * THIS SECTION WILL TEST THE IRLFLGEN AND * IRL FLG LOGIC. * THE PREVIOUS CLC INTP,C SHOULD HAVE INSURED PAKEN WAS CLEAR. * JSB PRWMS SET ERROR REPORTING MODE. JSB SINPD CLOCK IRL FF HIGH. LDB BIT14 GET EXPECTED STATUS. STB MASK SET UP TEST MASK. JSB STAT DID IRL FF GET SET? E067 DEF IRLFL NO! IRL FLG ERROR. SKP * * CHECK ABILITY TO CLEAR IRL FF. * LDB B100 RESET THE STB ERRCD ERROR CODE. JSB LIAIB CLEAR IRL FF. INPUT BYTE CNTR * SHOULD STAY LOW FROM PACKEN. CLB GET EXPECTED STATUS. JSB STAT DID IRL FF CLEAR? E100 DEF IRLFL NO! IRL FLG ERROR. * * CHECK ABILITY TO SET IRL FF. * JSB SINPD CLOCK IRL FF HIGH. LDB BIT14 GET EXPECTED STATUS. JSB STAT DID IRL FF GET SET? E101  DEF IRLFL NO! IRL FLG ERROR. JSB LIAIB IF PACKEN CLEAR THEN INPUT BYTE JSB SINPD CNTR CLEAR. CLEAR IRL FF. JSB STAT DID IRL FF CLEAR? E102 DEF IRLFL NO! IRL FLG ERROR. JSB CLCCF CLC IBI,C. JSB SINPD SET IRL FF FROM INPUT BYTE CNTR. JSB NOTWM SET ERROR REPORTING MODE. JSB SFCIB IBI FLAG CLEAR? E103 DEF IRLFL NO! IRL FLG ERROR. * * CHECK ABILITY TO SET IRLFLGEN. * JSB CONT SET OCT 40200 IRLFLGEN. JSB SFSIB IS IBI FLAG SET NOW? E104 DEF IRLFL NO! IRL FLG ERROR. * * CHECK CRS CLEARS IRLFLGEN. * CLC INTP,C CRS SHOULD CLEAR IRLFLGEN. JSB CLCCF CLC IBI,C. JSB SFCIB IBI FLAG SHOULD BE CLEAR. E105 DEF IRLFL NO! IRL FLG ERROR. * * CHECK ABILITY TO CLEAR IRLFLGEN. * JSB CONT SET OCT 40200 IRLFLGEN. JSB CG3MC CLEAR IRLFLGEN. JSB CLCCF CLC IBI,C. JSB SFCIB IS IBI FLAG STILL CLEAR? E106 DEF IRLFL NO! IRL FLG ERROR. SKP * * THIS SECTION TESTS THE SRQFLGEN,SRQFLG,RFDFF,OBRLFF, * NSRQFLG,GENSRQEN AND SERIAL POLL MODE LOGIC. * * CHECK ABILITY TO SET AND CLEAR SRQFLG. * JSB IFCMD SET IFC AND ACTIVE. JSB TIMOT ALLOW IFC TO SETTLE. JSB PRWMS SET ERROR REPORTING MODE. LDB BIT15 GET EXPECTED STATUS. STB MASK SET UP TEST MASK. JSB STAT SRQFLG HIGH? E107 DEF SRQFL NO! REPORT ERROR. JSB CACTV CLEAR ACTIVE. CLB GET EXPECTED STATUS. JSB STAT SRQFLG LOW? E110 DEF SRQFL NO! REPORT ERROR. * * CHECK ABILITY TO CLEAR SRQFLGEN. * JSB CONT SET OCT 100200 SRQFLGEN. JSB CG3MC CLEAR ALL FLAG ENABLES. JSB NOTWM SET ERROR REPORTING MODE. JSB SACTV SET ACTIVE. SRQFLG HIGH. JSB SFCIB I-O FLAG CLEAR? E111 DEF SRQFL NO! REPORT ERROR * * CHECK ABILITY TO SET SRQFLGEN. * JSB CONT SET SSRQE OCT 100200 SRQFLGEN. JSB SFSIB DID IT SET? E112 DEF SRQFL NO! REPORT ERROR. * * CHECK CRS CLEARS SRQFLGEN. * CLC INTP,C SHOULD CLEAR SRQFLGEN. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB CLCCF CLC IBI,C. JSB IFCMD TRIGGER IFC. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB SFCIB DID CRS CLEAR SRQFLGEN? E113 DEF SRQFL NO! REPORT ERROR. SKP * * CHECK CONTROL WORD BIT 7 LOGIC WHICH ENABLES * CLOCKS TO TO FLGEN LOGIC. * JSB CONT SHOULD NOT SET SRQFLGEN OCT 100000 WITHOUT CONTROL BIT 7 SET. JSB SFCIB FLAG SHOULD BE CLEAR. IS IT? E114 DEF SRQFL NO! REPORT ERROR. LDA SSRQE OUTPUT DATA WORD WHICH JSB DATOT SHOULD NOT SET SRQFLGEN. JSB SFCIB I-O FLAG SHOULD NOT SET. DID IT? E115 DEF SRQFL YES! REPORT ERROR. JSB CONT SET OCT 100200 SRQFLGEN. JSB SFSIB I-O FLAG SHOULD SET. DID IT? E116 DEF SRQFL NO! REPORT ERROR. * * CHECK NSRQFLG CAN GENERATE IBI FLAG AND * CHECK NSRQFLG LOGIC. * JSB CLCCF SHOULD CLEAR IFCFLG. JSB SFCIB NO I-O FLAG WITH IFCFLG CLEAR. E117 DEF SRQFL IF SET REPORT ERROR. * * CHECK GENSRQEN LOGIC * JSB PRWMS SET ERROR REPORTING MODE. JSB CONT SET OCT 1200 GENSRQEN. JSB STALK CLEAR LISTEN FF. JSB LIAIB CLOCK RFDFF LOW. SRQFLG HIGH. LDB BIT15 GET EXPECTED STATUS. STB MASK SET TEST MASK. JSB STAT IS SRQFLG HIGH? E120 DEF SRQFL NO! REPORT ERROR. JSB STLAT SET TALK AND LISTEN FF'S. CLB GET EXPECTED STATUS. JSB STAT IS SRQFLG LOW? E121 DEF SRQFL NO! REPORT ERROR. JSB CG3MC CLEAR GENSRQEN. JSB STALK CLEAR LISTEN MODE. JSB STAT IS SRQFLG LOW? E122 DEF SRQFL NO! REPORT ERROR. ,JSB CONT SET OCT 1200 GENSRQEN. JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. JSB STAT IS SRQFLG LOW? E123 DEF SRQFL NO! REPORT ERROR. SKP * * CHECK CRS CLEARS GENSRQEN * CLC INTP,C CRS SHOULD CLEAR GENSRQEN. JSB TIMOT WAIT FOR IFC TO SETTLE. JSB LIAIB CLEAR RFD FF. JSB CLCCF ISSUE CLRINTFLG TO IBI. JSB STAT DID CRS CLEAR GENSRQEN? E124 DEF SRQFL NO! REPORT ERROR. * * CHECK FOR CROSSTALK ERROR IN THE MODE CONTROL LOGIC. * JSB CONT SET ALL MODE CONTROLS OCT 6600 EXCEPT GENSRQEN. JSB STAT I-O FLAG STILL CLEAR? E125 DEF SRQFL NO! REPORT ERROR. JSB CONT SET OCT 1200 GENSRQEN. JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. JSB STAT SRQFLG CLEAR? E126 DEF SRQFL NO! REPORT ERROR. * * CHECK INPUT BYTE CNTR AND RFDFF LOGIC. * JSB CONT SET PACKEN AND OCT 5200 GENSRQEN. JSB LIAIB CLEAR RFD FF. LDB BIT15 GET EXPECTED STATUS. JSB STAT SRQFLG SET? E127 DEF SRQFL NO! REPORT ERROR. JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. JSB SINPD CLEAR RFDFF. E130 JSB STAT SRQFLG HIGH? DEF SRQFL NO! REPORT ERROR. JSB SINPD SHOULD CLOCK RFDFF HIGH. CLB GET EXPECTED STATUS. JSB STAT SRQFLG LOW? E131 DEF SRQFL NO! REPORT ERROR. JSB CONT CLEAR OCT 2 REN. LDA BIT8 SET UP TEST STA MASK MASK. JSB STAT DOES SRQ DRAG REN LOW ON IB? E132 DEF RENF YES! REPORT ERROR. SKP * * CHECK OBRL FF INPUTS TO THE NSRQFLG LOGIC. * JSB SLSTN SET LISTEN FF. JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. JSB DATOT SET OBRL FF. LDB BIT15 GET EXPECTED STATUS. JSB STAT SRQFLG HIGH? E133 DEF SRQFL NO! REPORT ERROR. JSB INIT F INITIALIZE OBR LOGIC FOR OUTPUT. CLB GET EXPECTED STATUS. JSB STAT DID OBRL FF CLEAR? E134 DEF SRQFL NO! REPORT ERROR. JSB DATOT SET OBRL FF. LDB BIT15 GET EXPECTED STATUS. JSB STAT DID OBRL FF SET? E135 DEF SRQFL NO! REPORT ERROR. JSB STALK SET TALK FF. CLB GET EXPECTED STATUS. JSB STAT IS SRQFLG CLEAR? E136 DEF SRQFL NO! REPORT ERROR. JSB CG3MC CLEAR GENSRQEN. JSB CTLSN CLEAR TALK MODE. JSB STAT SRQFLG LOW? E137 DEF SRQFL NO! REPORT ERROR. * * CHECK ABILITY OF SPMFLG AND ACTIVE * LOGIC TO SET IBI FLAG. * JSB IFCMD GENERATE IFC. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB SACTV CLEAR ACTIVE FF. JSB SATN SET ATN. LDA B30 SET JSB DATOT SPM FF. JSB CACTV CLEAR ACTIVE. LDB BIT15 GET EXPECTED STATUS. JSB STAT SRQFLG HIGH(NACTIVE AND SPM)? E140 DEF SRQFL NO! REPORT ERROR. JSB IFCMD CLEAR SPM FF. JSB TIMOT ALLOW IFC TO SETTLE. JSB CACTV CLEAR ACTIVE. CLB GET EXPECTED STATUS. JSB STAT DID SPM FF CLEAR? E141 DEF SRQFL NO! REPORT ERROR. SKP * * CHECK NO DATA COMBINATION (EXCEPT 30B) WILL SET * THE SPM FF. * JSB SATN SET ATN. CLA INITIALIZE DATA. PTLOP CPA B30 IS THIS "SET THE SPM FF DATA"? JMP NOTST YES! DON'T TEST PATTERN. JSB SACTV GATE DATA TO IB. JSB DATOT SHOULD NOT SET SPM FF. JSB CACTV CLEAR ACTIVE. STA CTLWD PUT DATA IN CONTROL WORD. JSB STAT DID SPM FF SET? E142 DEF SPMFF YES! REPORT ERROR. RSS SKIP ERROR CODE UPDATE. NOTST ISZ ERRCD UPDATE ERROR CODE. CPA B177 END OF DATA? JMP CKSPM YES! EXIT. JSB DECEC NO! DECREMENT ERROR NUMBER. INA DO A TNOTHER JMP PTLOP PATTERN. * * CHECK 30B DATA WILL SET THE SPM FF. * CKSPM JSB SACTV SET ACTIVE. LDA B30 SET JSB DATOT SPM FF. JSB CACTV CLEAR ACTIVE. LDB BIT15 GET EXPECTED STATUS. JSB STAT DID SPM FF SET? E143 DEF SPMFF NO! REPORT ERROR. * * CHECK 31B WILL CLEAR THE SPM FF * JSB CLCCF CLEAR IFCFLG FF. JSB SACTV GATE DATA TO IB. LDA B31 CLEAR JSB DATOT SPM FF. JSB CACTV CLEAR ACTIVE. CLB GET EXPECTED STATUS. JSB STAT DID SPM FF CLEAR? E144 DEF SPMFF NO! REPORT ERROR. JSB SACTV SET ACTIVE MODE. LDA B30 SET JSB DATOT SPM FF. JSB STAT SRQ FLG LOW? E145 DEF SRQFL NO! REPORT ERROR. SKP * * THIS SECTION WILL TEST THE PPPID(SW1) * AND MYADDR(SW2) LOGIC. * JSB CLCCF CLEAR IFCFLG FF. LDA B17 SET UP STA MASK DATA TEST MASK. CLA SAVE EXPECTED STA PATTN STATUS WORD. PPLOP JSB DATOT OUTPUT DATA. LDB PATTN GET EXPECTED STATUS JSB STAT PPPID OK? E146 DEF PPFL2 NO! REPORT ERROR. CPA B377 END OF DATA PATTERNS? JMP NXTST YES! GO DO NEXT TEST. JSB DECEC NO! DECREMENT ERROR COUNT. CCE SET E-REG FOR SHIFT. ELA SHIFT PATTERN. ISZ PATTN UPDATE EXPECTED STATUS. JMP PPLOP GO TRY ANOTHER PATTERN. * * CHECK IFCFLG FF FORCES PPPID TO 11B. * NXTST JSB IFCMD SET IFC. JSB TIMOT ALLOW IFC TO SETTLE. LDB B11 GET EXPECTED STATUS. JSB STAT IS PPPID=11B? E147 DEF PPFL2 NO! REPORT ERROR. * * CHECK PPP ID ENABLED ONTO IB. * JSB CTLSN DISABLE OUTPUT DATA TO IB. JSB SINPD CLOCK IB DATA TO INPUT REGISTER. CLB EXPECTED DATA. JSB CDATA GET ACTUAL DATA. IS IT OK? E150 DE_F BUSDF NO! IB DATA NOT ONES. JSB CONT SET GENSRQEN AND OCT 1300 CLEAR TALK AND LISTEN. JSB LIAIB CLEAR RFD FF. JSB SPPMD SET ATN AND EOI. CLA OUTPUT ZERO TO JSB DATOT IBI. JSB SINPD IB DATA SHOULD BE ZERO. LDB EXPID GET EXPECTED PPPID. JSB CDATA GET ACTUAL DATA. DOES IT COMPARE? E151 DEF PPFL2 NO! REPORT ERROR. SKP * * CHECK MY ADDRESS LOGIC INCLUDING THE ABILITY * TO SET AND CLEAR THE TALK AND LISTEN MODES. * THIS SECTION ALSO INSURES THE IBI RESPONDS * TO ONLY ONE ADDRESS. * CCA MARK STA NOLSN NO LISTEN AND STA NOTAK NO TALK INDICATORS. CLA INITIALIZE TLLOP STA PATTN TALK ADDR PATTERN. JSB CTLSN CLEAR LISTEN. JSB SATN SET ATN. LDA PATTN GET ADDRESS PATTERN. JSB DATOT OUTPUT ADDRESS. JSB STFIB GET IBI JSB LIAIB STATUS. AND B140 MASK TO TALK-LISTEN STATUS BITS. SZA IS TALK OR LISTEN SET? JMP PROTL YES! GO CHECK FOR ERROR. TLOOP ISZ PATTN UPDATE TEST PATTERN. LDA PATTN GET TEST PATTERN. CPA BIT7 END OF TEST? JMP NXTFC YES! GO DO NEXT TEST. JMP TLLOP NO! GO CHECK NEXT DATA. SKP * * INSURE ADDR LOGIC DID NOT RESPOND TO BIT5-6=0 * PROTL STA SAVIO SAVE ACTUAL INPUT. CLB FORM EXPECTED STATUS. LDA PATTN GET OUTPUT PATTERN. AND B140 MASK TO TALK-LISTEN CNTL BITS. SZA WAS IS IT A TALK OR LISTEN? JMP SK9 YES! CONTINUE NORMALLY. LDA SAVIO NO! RESTORE ACTUAL STATUS. JSB SENDM SEND ERROR MESSAGE. E152 DEF MYADR TALK-LSTN SET W/O CNTL. SK9 LDA PATTN GET OUTPUT DATA AGAIN. AND B37 MASK TO ADDRESS. ISZ ERRCD UPDATE ERROR NUMBER. CPA EXMYA DOES ADDRESS COMPARE? JMP SK10 Z YES! CONTINUE NORMALLY. LDA SAVIO RESTORE ACTUAL STATUS. JSB SENDM SEND ERROR MESSAGE. E153 DEF MYADR ILLEGAL MYADDR DECODED. SK10 JSB DECEC DECREMENT ERROR CODE. LDA PATTN GET ADDRESS PATTERN AGAIN. AND B40 STRIP TO BIT 5. SZA WAS THIS A LISTEN ADDRESS? STA NOLSN YES! SAVE ADDRESS. LDA PATTN GET ADDRESS. AND B100 STRIP TO BIT 6. SZA WAS THIS A TALK ADDRESS? STA NOTAK YES! SAVE ADDRESS. JMP TLOOP GO DO ANOTHER PATTERN. NXTFC JSB NOTWM SET ERROR REPORTING MODE. ISZ ERRCD UPDATE ERROR CODE. LDA NOLSN GO SEE IF A LISTEN E154 JSB CKMYA ADDRESS WAS FOUND. JSB DECEC DECREMENT ERROR CODE. LDA NOTAK GO SEE IF A TALK E155 JSB CKMYA ADDRESS WAS FOUND. SKP * * CHECK THE UNLISTEN AND UNTALK LOGIC. ALSO, CHECK THE * REST OF THE TALK AND LISTEN LOGIC. * * CHECK IFC WILL CLEAR LISTEN * JSB PRWMS SET ERROR REPORTING MODE. LDA B100 SET UP STA MASK TEST MASK. JSB STLAT SET TALK AND LISTEN FF'S. JSB IFCMD SHOULD CLEAR TALK-LISTEN FF. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB STAT DID IFC CLEAR LISTEN? E156 DEF LSTNF NO! REPORT ERROR. * * CHECK IFC WILL CLEAR TALK. * LDA B40 CHANGE STATUS MASK STA MASK TO LOOK AT TALK FF. JSB STAT DID IFC CLEAR TALK? E157 DEF TALKF NO! REPORT ERROR. * * CHECK UNTALK WILL CLEAR TALK * JSB SDMOD CLEAR ATN. LDA EXMYA GET CALCULATED MYADDR. INA CHANGE TO CREATE UNTALK. IOR B100 FORM TALK ADDR DATA. STA HOLDD SAVE FOR LATER TEST. JSB STALK SET TALK FF. JSB DATOT OUTPUT TALK ADDR DATA. JSB SATN CLOCK TALK FF LOW. STA CTLWD PUT DATA IN CONTROL WORD. JSB STAT DID TALK CLEAR? E160 DEF TALKF t NO! UNTALK DIDN'T WORK. * * CHECK FOR NO TALK ADDR W/O DAV * JSB SLSTN SET LISTEN MODE. LDA EXMYA GET TALK ADDRESS. IOR B100 FORM MY TALK ADDRESS. JSB DATOT OUTPUT IT. JSB STAT TALK SHOULD NOT SET. E161 DEF TALKF TALK SET W/O ATN OR DAV. SKP * * CHECK FOR NO UNTALK W/O DAV. * JSB STALK SET TALK FF. LDA HOLDD GET UNTALK ADDR. JSB DATOT SHOULD NOT CLEAR TALK. LDB B40 GET EXPECTED STATUS. JSB STAT DID TALK CLEAR? E162 DEF TALKF YES! UNTALK W/O DAV. * * CHECK FOR NO LISTEN W/O DAV. * LDA B100 SET TEST MASK TO STA MASK LISTEN MODE. LDA EXMYA FORM IOR B40 LISTEN ADDRESS. JSB DATOT OUTPUT LISTEN DATA. CLB LISTEN SHOULD NOT SET JSB STAT W/O DAV. DID IT? E163 DEF LSTNF YES! REPORT ERROR. * * CHECK LISTEN DOES NOT OCCUR W/O DAV. * JSB STLAT SET TALK AND LISTEN FF'S. LDA B177 OUTPUT JSB DATOT UNLISTEN DATA. LDB B100 EXPECTED STATUS. JSB STAT DID LISTEN CLEAR W/O DAV? E164 DEF LSTNF YES! REPORT ERROR. * * THIS SECTION TESTS ALL LOGIC INVOLVED IN * TRANSFERRING DATA TO AND FROM THE IB. * CLA SAVE DATA STA HOLDD FOR TEST. DLOP1 JSB CTLSN CLEAR TALK AND LISTEN. JSB SATN READY DATA LINES TO IB. ISZ HOLDD UPDATE DATA. LDA HOLDD GET DATA TEST PATTERN. CPA BIT9 END OF TEST? JMP PACKT GO DO PACK-WORD TEST. JSB DATOT OUTPUT PATTERN TO IB. JSB SINPD STROBE DATA IN FROM IB. LDA HOLDD GET EXPECTED DATA. STA CTLWD PUT DATA IN CONTROL WORD. AND B377 MASK TO LOWER BYTE. STA B SAVE DATA. JSB CDATA CHECK INPUT DATA. IS IT OK? E165 DEF BUSDF NO! REPORT FAILURE. JSB DECEC DECREMENT ERROR CODE. ˻ JMP DLOP1 GO DO ANOTHER PATTERN SKP * * NOW TEST THE ABILITY TO SEND AND RECEIVE * 16-BIT WORDS VIA THE IB. * PACKT ISZ ERRCD UPDATE ERROR CODE. CLA SET DATA STA HOLDD PATTERN. JSB CONT SET OCT 4200 PACKEN. JSB LIAIB SET INPUT-BYTE CNTR. DLOP2 JSB CTLSN CLEAR LISTEN AND TALK. JSB SATN SET ATTENTION. ISZ HOLDD UPDATE DATA PATTERN. LDA HOLDD GET DATA PATTERN JSB DATOT PUT UPPER BYTE ON IB. JSB DATOT PUT LOWER BYTE ON IB. JSB SINPD PACK IN JSB SINPD ACTUAL WORD OFF IB. STA CTLWD PUT DATA IN CONTROL WORD. LDB HOLDD GET EXPECTED WORD. BLF,BLF SHIFT DATA TO UPPER BYTE. ADB HOLDD MERGE IN LOWER BYTE. JSB CDATA VERIFY DATA. IS IT OK? E166 DEF BUSDF NO! REPORT FAILURE. CPB MIN1 LAST PATTERN CHECKED? JMP SK11 YES! EXIT. JSB DECEC NO! DECREMENT ERROR CODE. JMP DLOP2 TRY ANOTHER PATTERN. * * CHECK PACKEN LOW CLEARS INPUT REGISTER * BITS 8-15 * SK11 JSB CG3MC CLEAR PACKEN. JSB LIAIB GET INPUT DATA. CPA B377 DID PACKEN CLEAR IR8-15? JMP EOTST YES! EXIT. LDB B377 NO! GET EXPECTED DATA. JSB SENDM REPORT ERROR. E167 DEF BUSDF INPUT REG # 377B. SKP * * CHECK THE ENABLE OF THE ASCIIMODE LOGIC * EOTST LDA BIT7 SET ERROR CODE STA ERRCD TO 200 FOR HLT 106000. LDA BIT8 SET THE STATUS STA MASK TEST MASK. JSB CONT SET THE REN FF OCT 603 AND ASCIIMODE. LDA THREE LOAD THE OBR WITH 3(LOCAL). CLB EXPECTED STATUS. E200 JSB ASCOT CHECK ASCII COMMAND. JSB CONT SET THE OCT 3 REN FF. LDB BIT8 GET EXPECTED STATUS. JSB STAT OBRL FF DISALLOW ASCIIMODE? E201 DEF ASCIM NO! REPORT ERROR. NLH LDA B43 OBR BIT 5 SHOULD NOT ALLOW LOCAL. E202 JSB ASCOT CHECK ASCII COMMAND. LDA B103 OBR BIT 6 SHOULD NOT ALLOW LOCAL. E203 JSB ASCOT CHECK ASCII COMMAND. JSB CG3MC CLEAR ASCIIMODE. LDA THREE ASCIIMODE LOW SHOULD NOT ALLOW LOCAL. E204 JSB ASCOT CHECK ASCII COMMAND. * * INSURE CRS CLEARS ASCIIMODE. * CLB FORM EXPECTED STATUS. JSB CONT SET ASCIIMODE HIGH OCT 603 AND REN HIGH. CLC INTP,C GENERATE CRS. JSB TIMOT WAIT FOR IFC TO SETTLE. LDA TWO ASCIIMODE SHOULD BE CLEAR FROM CRS. E205 JSB ASCOT CHECK ASCII COMMAND. SKP bN  59310-18004 1728 S 0122 HPIB DIAG.              H0101 * * CHECK EOR INPUT TO EORFLG FF * JSB CLCCF CLEAR EORFLG FF. JSB CONT SET ASCIIMODE OCT 603 AND REN HIGH. LDA B12 SHOULD JSB DATOT GENERATE EOR AND EOI. JSB SATN ENABLE DATA TO IB. JSB SINPD CLOCK EORFLG FF HIGH. LDB BIT12 EXPECTED STATUS. STB MASK SET TEST MASK. JSB STAT IS EORFLG FF SET? E206 DEF ASCIM NO! REPORT ERROR. * * CHECK ASCIIMODE INPUTS TO EOI AND EOR LOGIC. * JSB CLCCF CLEAR EOR FF. JSB CG3MC CLEAR ASCIIMODE. JSB SATN ENABLE DATA TO IB. LDA B12 SET ASCIIMODE EOR JSB DATOT INTO OBR. JSB SINPD CLOCK EORFLG FF LOW. CLB NO EORFLG JSB STAT WITH ASCIIMODE LOW? E207 DEF ASCIM NO! REPORT ERROR. SKP * * CHECK DECODE OF EOR AND EOI(ASCIIMODE) * JSB CONT SET ASCIIMODE OCT 603 AND REN HIGH. STB HOLDD INITIALIZE TEST PATTERN. ALOP1 JSB SDMOD CLEAR ATN AND EOI. LDA HOLDD GET TEST DATA. CPA B12 IS THIS EOR DATA? JMP NXTAT YES! DON'T TEST IT. CPA B33 IS THIS ASCIIMODE IFC DATA? JMP NXTAT YES! DON'T TEST IT. JSB DATOT OUTPUT DATA. JSB SINPD CLOCK EORFLG FF. STA CTLWD SAVE OUTPUT DATA. JSB STAT DID ILLEGAL EOI GET GENERATED? E210 DEF ASCIM YES! REPORT ERROR. JSB SATN ENABLE DATA TO IB. JSB SINPD CLOCK EORFLG FF. STA CTLWD SAVE OUTPUT CONTROL WORD. JSB STAT DID ILLEGAL EOR OCCUR? E211 DEF EOR YES! REPORT ERROR. LDA HOLDD GET DATA TEST PATTERN. CPA B37 END OF DATA PATTERNS? JMP NXAT YES! GO DO NEXT TEST. JSB DECEC DECREMENT JSB DECEC ERROR CODE TWICE. NXTAT ISZ HOLDD UPDATE DATA PATTERN. JMP ALOP1 GO DO ANOTHER TEST. * * CHECK UPPER DECODE BITS OF IB EOR DECODE[ LOGIC * NXAT LDA B52 GET EOR TEST PATTERN. JSB DATOT OUTPUT DATA TO IB. JSB SINPD CLOCK EORFLG FF. JSB STAT DID ILLEGAL EOR OCCUR? E212 DEF EOR YES! REPORT ERROR. LDA B112 GET NEXT EOR TEST PATTERN. JSB DATOT OUTPUT DATA TO IB. JSB SINPD CLOCK EORFLG FF. JSB STAT DID ILLEGAL EOR OCCUR? E213 DEF EOR YES! REPORT ERROR. SKP * * CHECK ASCIIMODE IFC. * STB HOLDD INITIALIZE DATA PATTERN. JSB CACTV CLEAR ACTIVE. LDA BIT4 SET UP STA MASK TEST MASK. ALOP2 JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT LDA HOLDD GET TEST DATA CPA B33 IS THIS THE IFC ASCIIMODE DATA? JMP NXATA YES! DON'T TEST IT. E214 JSB ASCOT CHECK ASCII COMMAND. CPA B37 END OF DATA PATTERNS? JMP EATST YES! EXIT. JSB DECEC NO! DECREMENT ERROR NUMBER. NXATA ISZ HOLDD UPDATE DATA PATTERN. JMP ALOP2 DO ANOTHER PATTERN. * * CHECK ASCIIMODE IFC CAN BE TRIGGERED * EATST JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDA B33 GET IFC ASCIIMODE COMMAND. LDB BIT4 GET EXPECTED STATUS. E215 JSB ASCOT CHECK ASCII COMMAND. * * CHECK ASCIIMODE REMOTE COMMAND * JSB CONT SET OCT 2 LOCAL MODE. LDA BIT8 SET UP STA MASK TEST MASK. CLB INITIALIZE STB HOLDD TEST DATA PATTERN. ALOP3 JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDA HOLDD GET DATA PATTERN. CPA TWO IS THIS A REMOTE COMMAND? JMP EALP2 YES! DON'T TEST IT. E216 JSB ASCOT CHECK ASCII COMMAND. CPA B37 END OF DATA PATTERNS? JMP NXAL2 YES! DO NEXT TEST. JSB DECEC NO! DECREMENT ERROR NUMBER. EALP2 ISZ HOLDD UPDATE TEST PATTERN. JMP ALOP3 GO DO NEXT PATTERN. SKP * * CHECK 2B WILL SET ASCIIMODE REMOTE * NXAL2 tJSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDA TWO OUTPUT ASCIIMODE REMOTE TO IB. LDB BIT8 GET EXPECTED STATUS. E217 JSB ASCOT CHECK ASCII COMMAND. * * CHECK ASCIIMODE LOCAL ILLEGAL DECODE * CLA INITIALIZE STA HOLDD TEST DATA PATTERN ALOP4 JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDA HOLDD GET TEST PATTERN. CPA THREE IS THIS A LOCAL COMMAND? JMP LOPA4 YES! DON'T TEST. E220 JSB ASCOT CHECK ASCII COMMAND. CPA B37 END OF DATA PATTERNS? JMP NXAL4 YES! GO DO NEXT TEST. JSB DECEC NO! DECREMENT ERROR CODE. LOPA4 ISZ HOLDD UPDATE TEST PATTERN. JMP ALOP4 GO DO NEXT TEST PATTERN. * * CHECK ASCIIMODE DECODE OF SET ATN * NXAL4 JSB SDMOD CLEAR ATTENTION. LDA BIT7 SET UP STA MASK TEST MASK. CLB SET EXPECTED STATUS. STB HOLDD INITIALIZE TEST DATA. ALOP5 JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDA HOLDD GET TEST DATA. CPA B33 IS THIS AN IFC COMMAND? JMP NXAL5 YES! DON'T TEST DATA. CPA B16 IS THIS A SET ATN COMMAND? JMP NXAL5 YES! DON'T TEST DATA. E221 JSB ASCOT CHECK ASCII COMMAND. CPA B37 END OF DATA PATTERNS? JMP NXALT YES! GO DO NEXT TEST. JSB DECEC DECREMENT ERROR COUNT. NXAL5 ISZ HOLDD UPDATE DATA PATTERN. JMP ALOP5 GO TEST NEXT PATTERN. SKP * * CHECK ABILITY TO GENERATE AN ASCIIMODE * SET ATN. * NXALT JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDB BIT7 SET EXPECTED STATUS. LDA B16 OUTPUT AN ASCIIMODE SET ATN. E222 JSB ASCOT CHECK ASCII COMMAND. * * CHECK ASCIIMODE DECODE OF CLEAR ATN. * CLA INITIALIZE STA HOLDD TEST DATA PATTERN. ALOP6 JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDA HOLDD GET DATA PATTERN. CPA B33 IS THIS AN IFC COMMAND? 8R JMP NXAL6 YES! DON'T TEST IT. CPA B17 IS THIS A CLEAR ATN COMMAND? JMP NXAL6 YES! DON'T TEST IT. E223 JSB ASCOT CHECK ASCII COMMAND. CPA B37 END OF DATA PATTERNS? JMP NXTS6 YES! GO DO NEXT TEST. JSB DECEC NO! DECREMENT ERROR COUNT. NXAL6 ISZ HOLDD UPDATE DATA PATTERN. JMP ALOP6 DO NEXT DATA PATTERN. * * CHECK ABILITY TO GENERATE AN ASCIIMODE * CLEAR ATN * NXTS6 JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. CLB EXPECTED STATUS. LDA B17 OUTPUT A CLEAR ATN COMMAND. E224 JSB ASCOT CHECK ASCII COMMAND. SKP * * THIS SECTION CHECKS THE ASCIIMODE DAV OPERATION * * CHECK ILLEGAL DECODE OF DAV * JSB CLCCF CLEAR IFCFLG FF. JSB CTLSN CLEAR TALK AND LISTEN. LDA BIT15 SET UP STA MASK TEST MASK. JSB CONT SET ACTIVE,GENSRQEN OCT 1605 AND ASCIIMODE. STB HOLDD INITIALIZE DATA PATTERN. LDB BIT15 GET EXPECTED STATUS(SRQFLG SET) ALOP7 JSB INITF INITIALIZE OBR LOGIC FOR OUTPUT. LDA HOLDD GET TEST PATTERN CPA TWO IS THIS A REMOTE COMMAND? JMP NXAL7 YES! DON'T TEST IT. CPA THREE IS THIS A LOCAL COMMAND? JMP NXAL7 YES! DON'T TEST IT. CPA B16 IS THIS AN ATN COMMAND? JMP NXAL7 YES! DON'T TEST IT CPA B17 IS THIS A CLEAR ATN COMMAND? JMP NXAL7 YES! DON'T TEST IT. CPA B33 IS THIS AN IFC COMMAND? JMP NXAL7 YES! DON'T TEST IT. E225 JSB ASCOT CHECK ASCII COMMAND. CPA B37 END OF DATA PATTERNS? JMP NXTS7 YES! EXIT. JSB DECEC NO! DECREMENT ERROR CODE. NXAL7 ISZ HOLDD UPDATE DATA PATTERN. JMP ALOP7 GO TEST NEXT PATTERN. * * CHECK ASCIIMODE DAV AND BE GENERATED * NXTS7 LDA BIT11 SET UP STA MASK TEST MASK. CLB GET EXPECTED STATUS. LDA TWO ʩOUTPUT AN ASCIIMODE REMOTE. E226 JSB CKDAV GO CHECK FOR DAV. LDA THREE FORM AN ASCIIMODE LOCAL E227 JSB CKDAV GO CHECK DAV EXECUTED. LDA B16 FORM ASCIIMODE SET ATN. E230 JSB CKDAV CHECK DAV EXECUTED. LDA B17 FORM ASCIIMODE CLEAR ATN. E231 JSB CKDAV CHECK DAV EXECUTED. LDA B33 FORM ASCIIMODE IFC. E232 JSB CKDAV CHECK DAV EXECUTED. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JMP *+1,I CONTINUE TESTING DEF NXPAG ON THE NEXT MEMORY PAGE. SKP ORG 4000B * * THIS SECTION TESTS THE ABILITY OF THE IBI * TO TRANSMIT DATA TO AND FROM THE IB USING * THE TALK-LISTEN MODE. * NXPAG JSB CLCCF CLC IBI,C. JSB NOTWM SET ERROR REPORTING MODE. JSB CONT SET ATN,TALK,LISTEN OCT 20375 AND ORAFLGEN. JSB INITF INITIALIZE OBR LOGIC. LDA B252 GET DATA PATTERN. JSB DATOT TALK-LISTEN SHOULD SET ORAFLAG. JSB SDMOD SET DATA MODE. JSB SFSIB DID ORA FLAG SET? E233 DEF ORAFL NO! REPORT ERROR. JSB CONT SET OCT 40200 IRLFLGEN. JSB CLCCF CLC IBI,C. JSB SFSIB IRL FLAG SHOULD SET FLAG. E234 DEF IRLFL NO! REPORT ERROR. JSB PRWMS SET ERROR REPORTING MODE. JSB SINPD CLOCK DATA IN FROM IB. LDB B252 GET EXPECTED DATA. STB CTLWD SAVE DATA OUTPUT WORD. JSB CDATA WAS DATA TRANSFERRED? E235 DEF HANDS NO! REPORT ERROR. JSB NOTWM SET ERROR REPORTING MODE. JSB STALK CLEAR LISTEN ONLY. LDA B125 DATA SHOULD JSB DATOT NOT TRANSFER WITH NO LISTEN. JSB CLCCF CLC IBI,C. JSB SFCIB IRL FLAG SHOULD NOT SET. E236 DEF IRLFL IT DID! REPORT ERROR. JSB CONT SET OCT 20200 ORAFLGEN. JSB SFCIB ORA FLAG SHOULD NOT SET. E237 DEF ORAFL IT DID! REPORT ERROR. JSB PRWMS SET ERRO?R REPORTING MODE. JSB CDATA OBR SHOULD BE UNCHANGED. E240 DEF HANDS NO! REPORT ERROR. JSB CTLSN CLEAR TALK AND LISTEN. JSB SLSTN SET LISTEN,CLEAR TALK. JSB DATOT OUTPUT COMPLEMENTED PATTERN. JSB CDATA CHECK NO XFER OCCURRED. E241 DEF HANDS IT DID! REPORT ERROR. SKP * * THIS SECTION CHECKS FOR A SHORT BETWEEN REN AND DIO8 * LDA BIT8 FORM STA MASK TEST MASK. JSB CONT SET ATN OCT 65 AND ACTIVE. CCA PUT ZEROS ONTO JSB DATOT THE IB (ONES IN THE OBR). CLB EXPECTED STATUS. JSB STAT DOES DIO8 DRAG REN LOW? E242 DEF RENF YES! REPORT FAILURE. SKP * * THIS SECTION TESTS THE * DMA RELATED LOGIC OF THE IBI. * JSB NOTWM SET ERROR REPORTING MODE. LDA CPTO GET COMPUTER OPTIONS WORD. AND FOUR MASK TO DMA OPTION BIT. SZA,RSS IS DMA PRESENT? JMP NODMA NO! DON'T RUN THIS SECTION. JSB LIAIB CLEAR IRL FF. JSB INITF CLEAR DMAOUTREQFLG. JSB CG3MC CLEAR DMARWSEL FF. SRQ NOW HIGH. JSB ITDMA INITIALIZE DMA. SFS DMA DMA DONE? E243 JSB DMAER NO! NO SRQ FROM IBI. ISZ ERRCD UPDATE ERROR CODE. JSB CLCCF SET DMAOUTREQFLG. JSB ITDMA INITIALIZE DMA. SFC DMA NO XFER WITH NO SRQ? E244 JSB DMAER NO! ILLEGAL SRQ. ISZ ERRCD UPDATE ERROR CODE. JSB CONT SET OCT 2200 DMARWSEL. JSB INITF CLEAR DMAOUTREQFLG. SFC DMA NO XFER SHOULD'VE OCCURRED. E245 JSB DMAER IT DID! ILLEGAL SRQ. ISZ ERRCD UPDATE ERROR CODE. JSB CLCCF SET DMAOUTREQFLG. JSB CG3MC CLEAR DMARWSEL. JSB SINPD SET IRL FLAG. SFC DMA NO XFER SHOULD OCCUR. DID IT? E246 JSB DMAER YES! ILLEGAL SRQ. ISZ ERRCD UPDATE ERROR CODE. JSB CONT  SET OCT 2200 DMARWSEL. SFS DMA FLAG SHOULD BE SET FROM SRQ. E247 JSB DMAER NO SRQ. ISZ ERRCD UPDATE ERROR CODE. SKP * EXECUTE THE PRESET IBI TEST * NODMA LDA B257 UPDATE STA ERRCD ERROR CODE. LDB B8A12 SUPPRESS OPERATOR JSB SWRT INTERVENTION TESTS? JMP CHK2I-1 YES! GO HALT. LDB BIT10 NO! SUPPRESS NON- JSB SWRT ERROR MESSAGES? JMP DOPRE YES! GO HALT. CLA,CLE READY FORMATTER. LDB PRMSG PRESET MESG POINTER. JSB FMTR,I PRINT MESSAGE. DOPRE JSB CONT SET OCT 3 REN. JSB DEBON DEBOUNCE SW.REG. H256 OCT 106056 PRESS PRESET,RUN. LDB B31 GET EXPECTED STATUS. JSB STAT PRESET WORK? E257 DEF PRERR NO! REPORT ERROR. RSS SKP * THIS SECTION VERIFIES PROPER OPERATION OF THE * PPREQ AND PPLEX LOGIC. * ISZ ERRCD UPDATE ERROR CODE. CHK2I LDB BIT3 JSB SWRT NEW IBI? RSS YES! DO PPREQ TEST. JMP FINIT NO! EXIT. JSB CLCCF CLEAR IBI FLAG. JSB IFCMD SET IFCFLG. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB CG3MC CLEAR ALL FLG ENABLES. JSB SACTV SET ACTIVE. JSB SPPMD SET PPLEX. JSB SFSIB PPLEX+PPREQ SHOULD SET FLAG. E260 DEF PPREQ NO? REPORT ERROR. JSB CACTV CLEAR ACTIVE. JSB CLCCF CLEAR IBI FLAG. JSB IFCMD SET IFCFLG. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. JSB CACTV CLEAR ACTIVE. JSB SPPMD SET ATN AND EOI. JSB SFCIB DID ILLEGAL PPLEX OCCUR? E261 DEF PPREQ YES! REPORT ERROR. JSB SEOI CLEAR ATN. JSB SACTV SET ACTIVE. JSB SFCIB PPLEX LOW WITH ATN LOW? E262 DEF PPREQ NO! REPORT ERROR. JSB SATN SET ATN. CLEAR EOI. JSB SFCIB PPLEX LOW WITH EOI LOW? E263 DEF IPPREQ NO! REPORT ERROR. JSB CLCCF CLEAR IFCFLG. JSB SPPMD SET ATN AND EOI. JSB SFCIB PPREQ LOW WITH PPPID=0? E264 DEF PPREQ NO! REPORT ERROR. SKP * END OF TEST * FINIT LDA IBH1 GET FIRST SC. CPA IBH2 ONLY ONE SC UNDER TEST? JMP CABTS YES! GO TO CABLE TEST. LDA PSIND GET PASS INDICATOR. SZA,RSS IS THIS THE LAST PASS? JMP MANL,I NO! GO DO SECOND PASS. HED CABLE TEST * * CABLE TEST SECTION * * SINCE ANY SHORTS IN THE CABLE WOULD HAVE BEEN CAUGHT * BY THE PREVIOUS SECTION OF DIAGNOSTIC, THIS TEST SECTION * ONLY TESTS THE CABLE'S ABILITY TO TRANSMIT A ZERO LOGIC * LEVEL FOR EACH SIGNAL. * CABTS LIA 1 GET SW. REG. OPTIONS. SLA,RSS IS BIT 0 SET? JMP CKH77 NO! GO CHECK FOR END OF TEST. LDA B250 UPDATE STA ERRCD ERROR CODE. LDB IBH1 GET FIRST SC. CPB IBH2 ARE THE SC'S THE SAME? RSS YES! GO HALT. JMP DOCTS NO! DO CABLE TEST. JSB DEBON INSURE NO SR BITS ARE PRESSED. E250 OCT 106050 NO TEST WITH ONE SC. JMP CABTS GO CHECK AGAIN. DOCTS LDA NIOTB GET I-O INST. TABLE POINTER. JSB INTIO GO UPDATE I-O INSTRUCTIONS. ISZ ERRCD UPDATE ERROR NUMBER. * * THIS SECTION TESTS THE ABILITY OF THE * CABLE TO TRANSMIT IFC. * JSB PRWMS SET ERROR REPORTING MODE. JSB CONX SET ACTIVE ON THE OCT 5 FIRST IBI. JSB IFCMD SHOULD CLEAR ACTIVE ON FIRST IBI. JSB TIMOT ALLOW TIME FOR IFC TO SETTLE. LDB BIT4 SET UP TEST STB MASK MASK. CLB FORM EXPECTED STATUS. JSB STAT DID IFC CLEAR ACTIVE? E251 DEF CABLF NO! REPORT ERROR. SKP * * THIS SECTION TESTS THE ABILITY OF THE * CABLING TO XMIT DATA AND TO HANDSHAKE. * JSB LIAIB INITIALIZE THE JSB CONX SEC#OND IBI OCT 7 FLAGS FOR DATA TRANSFER. JSB CONT SET ATN OCT 65 AND ACTIVE ON SECOND IBI. LDA MYA2 GET SECOND IBI MYADDR. IOR B100 FORM TALK ADDRESS. JSB DATOT OUTPUT IT TO THE IB. LDA MYA1 GET FIRST IBI MYADDR. IOR B40 FORM LISTEN ADDRESS. JSB DATOT OUTPUT IT TO THE IB. JSB SDMOD SET DATA MODE. LDA MIN2 GET TEST PATTERN. CABLP STA PATTN SAVE THE PATTERN. AND B377 MASK TO LOWER 8 BITS. STA SAVAH SAVE BYTE FOR COMPARISON LATER. JSB DATOT OUTPUT PATTERN TO IB. JSB LIAIB SYNC DATA TRANSMISSION. JSB LIAIB BRING IN DATA FROM FIRST IBI. CPA SAVAH WAS IT THE SAME AS XMITTED? JMP SK12 YES! CONTINUE NORMALLY. LDB SAVAH NO! GET EXPECTED DATA. JSB SENDM REPORT ERROR. E252 DEF CABLF DATA DIDN'T XMIT. SK12 LDA PATTN GET TEST PATTERN. RAL ROTATE IT. CPA NBIT8 IS TEST DONE? RSS YES! SKIP TO NEXT TEST. JMP CABLP NO! GO TEST NEXT PATTERN. * * THIS SECTION TESTS THE ABILITY OF THE CABLING * TO TRANSMIT REN. * ISZ ERRCD UPDATE ERROR CODE. LDB BIT8 GET EXPECTED STATUS. STB MASK SET TEST MASK. JSB CONT SET OCT 3 REN ON SECOND IBI. JSB STAT DID FIRST IBI RECEIVE IT? E253 DEF CABLF NO! REPORT ERROR. SKP * * THIS SECTION TESTS THE ABILITY OF THE * CABLING TO TRANSMIT SRQ. * JSB CLCCF CLEAR SECOND IBI FLAG. JSB NOTWM SET ERROR REPORTING MODE. IO.X3 CLC IBI,C CLEAR IFCFLG ON FIRST IBI. JSB CONX SET TALK AND LISTEN TO CLEAR OCT 100335 SRQFLG ON FIRST IBI. JSB CONT SET SRQEN AND OBRLFLG OCT 1307 AND CLEAR TALK-LISTEN ON SECOND IBI. JSB DATOT SET OBRLFLG. JSB SFSIB FIRST IBI FLAG SHOULD SET. E254 DEF CABLF NO! SRQ DID NOT XMIT. * * THIS SECTION TESTS THE ABILITY OF THE * CABLING TO TRANSMIT ATN. * JSB PRWMS SET ERROR REPORTING MODE. LDB BIT7 SET UP TEST STB MASK MASK AND EXPECTED STATUS. JSB CONT SET ATN ON OCT 65 SECOND IBI. JSB STAT DID FIRST IBI RECEIVE ATN? E255 DEF CABLF NO! REPORT ERROR. CKH77 ISZ PASCT UPDATE PASS COUNT. NOP ROLLOVER PROTECTION. * * END OF TEST * LDB BIT10 SUPPRESS NON- JSB SWRT ERROR MESSAGES? JMP CKIB YES! GO HALT. CLE FOR CONVERSION ROUTINE. LDA PASCT GET PASS COUNT. LDB PASPT GET STRING POINTER. JSB O2AS,I CONVERT PASS COUNT TO ASCII. CLA,CLE READY FORMATTER. LDB PASSN GET MESSAGE POINTER. JSB FMTR,I PRINT PASS COUNT. CKIB LDB BIT12 DOES OPERATOR WANT TO JSB SWRT LOOP ON TEST? JMP CMORG YES! GO FLASH OVERFLOW. JSB GETTM SEE IF OPERATOR WANTS TS MODULE. LDA PASCT GET PASS COUNT. HLT77 HLT 77B END OF TEST. JMP STAR,I GO TO START OF TEST. HED HPIB TROUBLESHOOTING MODULE * * THIS SECTION IS INCLUDED TO AID THE OPERATOR * IN TROUBLESHOOTING EITHER AN IBI OR AN IB DEVICE * USING THE IBI AS SYSTEM CONTROLLER. * ORG 5000B IBTSM LDB CONSC GET CONSOLE SC. SZB,RSS IS THERE A CONSOLE? JMP GOHT7 NO! GO HALT 77 FOR END OF TEST. LDB FOUR DOES OPERATOR WANT TO JSB SWRT USE THE SECOND IBI SC? JMP GSCSC YES! GET SECOND IBI SC. LDB IBH1 NO! GET FIRST IBI SC. RSS SKIP SECOND SELECT CODE. GSCSC LDB IBH2 GET SECOND SELECT CODE. LDA IOTBL GET IBI I-O INST TABLE PNTR. JSB INTIO GO INITIALIZE IBI I-O INST'S. CLA,CLE READY FORMATTER. LDB TSINM GET INTRODUCTION MESSAGE. JSB FMTR,I PRINT MESSAGE. ESCRN JSB PCRLF GO PRINT CR-LF. TYINL CLA,CLE READY FORMATTER. LDB PRMPT PRINT JSB FMTR,I PROMPT MESSAGE. JSB GCHAR GO GET A CHARACTER. CPA ASCA IS IT AN "A" FOR ABORT? JMP GOHT7 YES! GO HALT 77 FOR END OF TEST. CPA ASCS IS IT A "S" FOR STATUS REPORT? JMP PSTAT YES! GO PRINT IBI STATUS. CPA ASCI IS IT AN "I" FOR INPUT DATA? JMP PDATA YES! GO GET DATA WORD FROM IBI. CPA B103 IS IT A "C" FOR CONTROL IBI. JMP GOCWD YES! GO GET THE CONTROL WORD. CPA ASCD IS IT A "D" FOR DATA OUTPUT? JMP GODWD YES! GO GET DATA WORD. INPER CLA,CLE NO! READY FORMATTER. LDB ERMSG PRINT JSB FMTR,I "INPUT ERROR" MESSAGE. JMP TYINL GO GET ANOTHER CHARACTER. SPC 3 GOCWD JSB FORMD GO FORM THE CONTROL WORD FROM OPERATOR. JSB STFIB READY CONTROL MODE ON IBI. JSB DATOT OUTPUT CONTROL TO IBI. JMP TYINL GET NEXT CHARACTER. SPC 3 GODWD JSB FORMD GO FORM DATA WORD FROM OPERATOR. JSB DATOT OUTPUT DATA TO IBI. JMP TYINL GET NEXT CHARACTER. SKP PSTAT JSB STFIB SET IBI TO CONTROL MODE. JSB LIAIB GET STATUS WORD FROM IBI. JSB PRINT GO PRINT IT ON TTY. JMP TYINL GET NEXT CHARACTER. SPC 3 PDATA JSB LIAIB GET DATA WORD FROM IBI. JSB PRINT GO PRINT IT ON TTY. JMP TYINL GET NEXT CHARACTER. SPC 3 PRINT NOP CLE READY CONVERSION ROUTINE. LDB BUFFR SET BUFFER POINTER. JSB O2AS,I CONVERT NUMBER TO ASCII. CLA,CLE READY FORMATTER. LDB BUFFR SET BUFFER POINTER. JSB FMTR,I GO PRINT NUMBER. JMP PRINT,I RETURN SPC 3 FORMD NOP LDA INPUT GET INPUT BUFFER POINTER. STA PNTR SAVE IT. CLA PUT LDB MIN6 ZEROS STA PNTR,I IN ISZ PNTR THE INB,SZB INPUT JMP *-3 BUFFER. LDB MIN6 GET CHARACTER INPUT COUNT. BADIN STB SAVPB SAVE CHARACTER COUNT. JSB GCHAR GO GET A CHARACTER. LDB SAVPB RESTORE CHARACTER COUNT. SZA,RSS DID OPERATOR PRESS LINE FEED? JMP PRCES YES! GO PROCESS INPUT NUMBER. CPA ASCE NO! WAS E KEY PRESSED? JMP ESCRN YES! EXIT INPUT. STA SAVIN NO! SAVE INPUT. AND B170 IS INPUT CPA B60 A NUMBER <=7? RSS YES! GO PUT IT IN BUFFER. JMP INPER NO! INPUT ERRORAND GET NEXT INPUT. LDA SAVIN RESTORE INPUT. STB SAVPT SAVE CHAR. COUNT. ADB EOBUF FORM CHAR POINTER IN BUFFER. STA B,I PUT CHAR IN BUFFER. LDB SAVPT RESTORE CHARACTER COUNT. INB,SZB SIX CHARACTERS ENTERED? JMP BADIN NO! GO GET ANOTHER NUMBER. JSB PCRLF PRINT A CR-LF ON CONSOLE. SKP PRCES LDB BUFFR GET THE DESTINATION BUFFER PNTR. LDA INPUT GET THE SOURCE BUFFER POINTER. STA LPNTR SAVE IT. JSB STUFA GO PACK SIX JSB STUFA ASCII CHARACTERS INTO JSB STUFA A THREE WORD BUFFER. CCA,CLE READY ASCII TO OCTAL CONVERSION. LDB BUFFR GET ASCII BUFFER POINTER. JSB ASCON,I CONVERT. JMP FORMD,I EXIT ROUTINE. SPC 3 STUFA NOP LDA LPNTR,I GET AN ASCII NUMBER. ALF,ALF SHIFT IT TO UPPER BYTE. ISZ LPNTR UPDATE SOURCE BUFFER PNTR. IOR LPNTR,I MERGE IN NEXT ASCII NUMBER. STA B,I PUT PACKED DATA IN DEST. BUFFER. ISZ LPNTR UPDATE SOURCE BUFFER POINTER. INB UPDATE DESTINATION BUFFER POINTER. JMP STUFA,I RETURN. SPC 3 GCHAR NOP CLA,INA SET UP FOR ONE CHAR. INPUT. STA PARAM CLEAR UPPER BYTE OF INPUT BUFFER. LDB _NLHCHRIN GET POINTER TO INPUT BUFFER. JSB SLOIN,I GO GET A CHARACTER FROM CONSOLE. LDA PARAM GET INPUT CHARACTER. ALF,ALF SHIFT IT TO LOWER BYTE. AND B177 STRIP OFF ANY PARITY. JMP GCHAR,I RETURN. SPC 3 GOHT7 LDB BIT12 TEST FOR LOOP JSB SWRT ON DIAGNOSTIC. JMP CMORG YES? GO LOOP. JMP HLT77 NO? GO HALT 77B. FWAA EQU * END FWAA EQU * END STA *+1 PUT HALT IN LINE. HLT 0 ERROR HALT. ISZ SENDM MOVE PAST CONTROL WORD JMP SENDM,I OF JSB AND RETURN. -N  59310-18005 2026 S C0122 &DVR37 HP-BI DRIVER              H0101 VDASMB,Q,C,Z IFZ HED DVR37, NO SRQ ALARM SERVICE NAM DVR37,0 59310-16002 REV.2026 800407 EQTX=18+7*D NSRQ XIF * IFN HED DVR37, WITH SRQ ALARM SERVICE NAM DVR37,0 59310-16003 REV.2026 800407 EQTX=18+7*D SRQ XIF * ENT I.37,C.37 EXT $LIST * ***************************************************** * (C) COPYRIGHT HEWLETT-PACKARD CO., 1975 * * ALL RIGHTS RESERVED * ***************************************************** * * DVR37 - RTE HP-IB DRIVER * * RELOC: 59310-16002 (NO SRQ SERVICE) * RELOC: 59310-16003 (WITH SRQ SERVICE) * SOURCE: 59310-18005 * ***************************************************** * R.FAJARDO, 760329 * * * ASSEMBLE WITH N OPTION FOR SRQ ALARM SERVICE * ASSEMBLE WITH Z OPTION TO EXCLUDE SRQ SERVICE * ******************************************************** * *1926 PCO * 1. OUCH1+1 CHANGED FROM JMP LOSE2 TO JMP L.RTN . * PROBLEM WAS FALSE IFC'S, PARTICULARLY WITH 2240. * SOLUTION IS TO IGNORE IFC COMMAND ON BUS. * 2. ADD SUPRESS LINE FEED NEXT OPERATION. (BIT 7 IN BEQT1) * PROBLEM WAS THAT THIS FUNCTION WAS NEEDED TO HAVE THE MINIMUM * SET OF FEATURES FOR LINE PRINTER SUPPORT WITH THE HPIB DRIVER. * SOLUTION WAS TO USE BIT 7 IN BEQT1 TO FLAG THE SUPPRESSION * AND THEN CHECK THIS BIT BEFORE TO CRLF IS SENT AT THE END OF * AND OUTPUT OPERATION (IN RESPONSE TO BIT 3 BEING SET IN EQT11). * BIT 7 IS SET BY CALL EXEC (3,ICNWD,0) WHERE BITS 10-6 OF ICNWD * = 11 AND BITS 5-0 =LU. * IF THE BIT 7 IS SET, THEN ONLY "CR" CAN BE APPENED TO NEXT WRITE * OPERATION, FUNCTION CODE = 2. BIT7 IS CLEARED AFTER THE DATA HAS * BEEN SENT FOR NEXT WRITE OPERATION. SET OR NOT. * * !!CAUTION!! NO CHECK IS MADE IN OUTPUT CONTINUATOR SECTION TO * DETERMINE IF APPENDED "LF" IS BEING SUPPRESSED FOR DATA MODE * OR COMMAND MODE. IF "LF" IS EVER APPENDED TO COMMAND MODE, * A CHECK WILL HAVE TO BE IMPLEMENTED. * ************************************************************************* SKP INTBA EQU 1654B FWA INTERRUPT TABLE DUMMY EQU 1737B PRIVILEDGED INTERRUPT I/O * EQT1 EQU 1660B DEVICE SUSPEND LIST POINTER EQT2 EQU 1661B DRIVER INITIATION SECTION ADDR EQT3 EQU 1662B DRIVER COMPLETION SECTION ADDR EQT4 EQU 1663B DRIVER I/O ASSIGNMENTS, EQT5 EQU 1664B DRIVER STATUS INFORMATION EQT6 EQU 1665B CURRENT I/O REQUEST, EQT7 EQU 1666B DATA BUFR ADDR/CONTROL PARM EQT8 EQU 1667B DATA BUFR LNG/CONTROL PARM EQT9 EQU 1670B CONTROL BUFR ADDR EQT10 EQU 1671B CONTROL BUFR LNG EQT11 EQU 1672B DRIVER CONTROL WORD, EQT12 EQU 1771B EQT ENTRY COUNT, EQT13 EQU 1772B EQT EXTENSION ADDR EQT14 EQU 1773B DEVICE TIME OUT VALUE EQT15 EQU 1774B DEVICE TIME OUT CLOCK * SUP SKP * * EQT ENTRY WORD FORMATS AS FOLLOW: * ******EQT4 - FORMAT: D BPS TUU UUU CCC CCC * D=DMA ASSIGNED, 1=YES * B=BUFFERING ON, 1=YES * P=PWR FAIL SERVICED BY DVR, 0=NO * S=TIME OUT SERVICED BY DVR, 1=YES * T=TIME OUT OCCURANCE, 1=YES * U=UNIT OR SUBCHAN, THIS REQUEST * C=I/O CHANNEL, THIS REQ. * ******EQT5 - FORMAT: A ATT TTT TSS SSS SSS * A=AVAILABILITY * T=DEVICE TYPE, 37 * S=STATUS BYTE * ******EQT6 - FORMAT: C C0Z 0FF FFF 000 0RR * C=REQUEST TYPE, 0/1/2/3:STANDARD/BUFFERED/SYSTEM/CLASS * F=SUBFUNCTION * R=I/O REQUEST, 1/2/3:READ/WRITE/CNTRL * Z=0/1 SINGLE/DOUBLE BUFR REQUEST * ******EQT11 - FORMAT: S A0E B00 HL0 00C MDI * S=SRQ SERVICE IN PROGRESS, 1=YES * A=I/O REQUEST ABORTED TO SERVICE SRQ, 1=YES * E=EXPECT/ISSUE EOR WITH I/O, 1=YES * B=EXPECT/ISSUE EOR WITH LAST DATA BYTE, 1=YES * H=ENABLE ASCII MODE I/O CARD LOGIC, 1=YES * L=SUPRESS LINE FEED. ONLY BIT 7 IN BEQT1 IS CHECKED. * C=ENABLE CRLF POST PROCESSING, 1=YES * M=DATA MODE, 1=ASCII, 0=BINARY * D=DMA ACTIVE ON PENDING REQUEST, 1=YES * I=I/O DIRECTION, 1=INPUT, 0=OUTPUT * ******EQT12 - FORMAT: S PAB BBB BEE EEE EEE * S=SRQ PENDING FLAG * P=ALARM PROG SCHEDULING ACTIVE * A=SRQ INTERRUPT ARMING FLAG * B=# ACTIVE BEQT ENTRIES, 0-31 * E=# EQT EXTENSION WORDS, 19-255 * ******EQT13 - FORMAT: I AAA AAA AAA AAA AAA * I=INITIATOR/CONTINUATOR FLAG * A=EQT EXTENSION ADDRESS * SKP * ******BEQT1 - FORMAT S RDI JOP EL0 0UU UUU * S=0=DISABLE PRIORITY RESPONSE TO SRQ INTERRUPT * R=0=DISABLE I/O RESTART ATTEMPT * D=0=DISABLE DMA USAGE * I=1=REQUIRE EOR FROM DEVICE. * J=1=EXPECT EOR WITH LAST DATA BYTE * O=1=ISSUE EOI TO DEVICE * P=1=ISUE EOI WITH LAST DATA BYTE * E=1=ALLOW OCCURENCE OF ERROR TO ABORT CURRENT PROGRAM * L=SUPRESS LF ON NEXT OUTPUT * U=UNIT NUMBER * ******BEQ2 = FORMAT SC111111 C2222222 * S=1=ALARM PROGRAM IS TO BE SCHEDULED. * C111111 =CHARACTER 1 OF ALARM PROGRAM NAME * C2222222=CHARACTER 2 OF ALARM PROGRAM NAME * BEQ3 - FORMAT C3333333 C4444444 * C3333333=CHARACTER 3 OF ALARM PROGRAM NAME * C4444444=CHARACTER 4 OF ALARM PROGRAM NAME * BEQ4 = FORMAT C5555555 00000000 * C5555555=CHARACTER 5 OF ALARM PROGRAM NAME * BEQT5- FORAMT 00000000 SSSSSSSS * SSSSSSSS=LAST READ SERIAL POLL STATUS * BEQT6- FORMAT V VVV VVV VVV VVV VVV * V=VALUE TO BE PASSED TO ALARM PROGRAM. * BETQ7- FORMAT F CCC CCC CPP PPP PPP * F=1 THEN P=ERROR STATUS OF LAST OPERATION. * F=0 THEN CP = TRANSMISSION LOG LAST OPERATION. * SKP * * I/O INITIATOR SECTION * I.37 NOP CLB NO CLC,C JSB SETUP CNFG I/O & BEQT ADDRS JSB MINE REGAIN HP-IB CONTROL JSB DMA? SZA HAVE WE DMA? JMP I37A LDA EQT6,I NO, DO WE NEED IT? AND B3 CPA B3 JMP I37A CONTROL RETQUEST, NO. LDA BEQT1,I I/O REQUEST, RAL,RAL DMA REQUIRED? SSA,RSS JMP I37A LDA B5 YES, GO GET IT JMP I.37,I I37A EQU * * IFN **IF SRQ SERVICE***** CLA * * LDB EQT11,I *SRQ SERVICE BUSY? * SSB * * JMP I.37,I * YES, AWAIT COMPLETION XIF ********************* * LDA EQT13,I INDICATE IOR BIT15 INITIATOR STA EQT13,I SECTION LDA EQT4,I CLAIM IOR BIT12 TIME OUT STA EQT4,I PROCESSING * * RSTRT CLA,CCE CLEAR: STA EQT11,I DRIVER CNTRL WORD STA STSWD,I PENDING EQT STATUS WORD STA XLOG,I PENDING TRANSMISSION LOG LDB BEQT1 ADB B6 STA 1,I BEQT7 JSB STATS INTERRUPT FLAG FROM PREVIOUS OP. * LDA EQT6,I AND B3 GET REQUEST CPA B3 JMP I.CRQ CONTROL! SKP * * I/O REQUESTS HERE * I000 LDA EQT6,I LOAD I/O CTL WORD ALF SHIFT Z-BIT TO LSB AND B1 MASK STA ZBIT AND SAVE SZA,RSS Z=1? JMP *+4 NO. SKIP TEST OF CNTL BUFF LENGTH. * LDA EQT10,I LOAD CTL BUFR LNGTH SZA LENGTH=0? JMP I005 NO. GO SEND CNTRL BFFR. LDB UNIT YES,LOAD SUBCHANNEL SZB,RSS SUBCHANNEL=0? JMP I015 YES,CHECK FOR DATA LDA ZBIT NO,LOAD Z-BIT CPA B1 Z-BIT=1? NOTE: CNTRL BFFR LNGTH =0. JMP I015 YES,CHECK FOR DATA LDA EQT8,I NO,LOAD DATA BUFR LNGTH SZA LENGTH=0? JMP I010 NO,GENERATE AUTO ADDR CMNDS LDA EQT6,I YES,LOAD EQT WORD 6 AND B2103 MASK I/O REQ CODE CPA B2 REQUEST CODE=2(WRITE REQ)? X=M=0? JMP I010 YES,GENERATE AUTO ADDR CMNDS & CR-LF JMP L.XIT NO,EXIT * * 0 ISSUE CONTROL BUFFER * I005 SSA CTL BUFR LGTH NEG(CHARS)? CMA,INA,RSS YES,MAKE POSITIVE & SKIP ALS NO,WORDS. CNVRT TO +CHARS LDB EQT9,I LOAD CMND BUFR ADDRESS JMP I012 AND OUTPUT * I010 LDA EQT6,I FETCH READ-WRITE FLAG. BIT0=1 IF READ. * LDB #ULBT FETCH UNL, BUS TALK SLA TEST IF COMPUTER READ. LDB #ULBL YES. CHANGE TO UNL, BUS LISTEN. * STB CMDBA,I STORE WORD IN COMMAND BUFFER. * LDB #DLSC FETCH DEV LISTEN, SEC SLA TEST IF COMPUTER READ. LDB #DTSC YES. CHANGE TO DEVICE TALK, SEC. * LDA UNIT FECTCH UNIT NUMBER. ALF,ALF POSITION TO UPPER BYTE. ADB 0 FORM DEVICE TALK OR LISTEN ADDRESS. * LDA EQT9,I FETCH SECONDARY AND B37 MASK UPPER BITS TO PREVENT DISASTER. ADB 0 COMPLETE FORMING DEV,SEC. * STB CMDBA+1,I STORE WORD IN COMMAND BUFFER. * LDB EQT9,I FETCH SECONDARY ADDRESS AGAIN. LDA B3 PREPARE TO SEND UNL,BUS,DEV SZB TEST IF THERE WAS A SECONDARY ADDRESS. INA YES. SET COUNT FOR UNL,BUS,DEV,SEC * LDB CMDBA FETCH THE BUFFER ADDRESS. I012 JSB DOIO DO OUTPUT OCT 60 * * SET UP DATA TRANSFER * I015 LDA EQT8,I SZA ANY DATA? JMP I020 YES, GIVE IT CPA UNIT DIRECT I/O REQ? JMP L.XIT YES,EXIT CPA ZBIT Z-BIT=0? JMP I020 YES,ISSUE DATA JMP L.XIT NO,EXIT I020 SSA CMA,INA,RSS MAKE +CHAR CNT ALS STA T1 LDA EQT6,I EXTRACT I/O REQ AND B3 & FORM CPU XOR B3 TLK/LSN CMND, ALF,RAR DATA MODE IOR B100 STA I028A LDA EQT6,I ERA,RAL (E)=I/O DIRECTION ASR 6 AND B21 EXTRACT SUB-FUNCTION STA 1 LDA BEQT1,I INIT| DVR CNTRL WORD: AND BIT13 GET DMA REQUIREMENT ALF BIT 1: DMA ACTIVE, 1=YES RAR,ELA BIT 0: I/O DIRECTION, 1/0 SLB,RSS TRANSLATE M BIT IOR B4 BIT 2: ASCII/BINARY, 1/0 SLB,RSS ASCII OR BINARY? SLA,RSS A. OUTPUT OR INPUT? CPB B20 B. O. ASCII HONEST (TRANSPARENT) ? IOR BIT8 I. H. SET BIT 8 (ASCII CARD LOGIC ON) IF STA EQT11,I NH. ASCII INPUT OR ASCII HONEST OUTPUT. * SLA DETERMINE EOR REQUIREMENTS OUTPUT AND JMP I021 INPUT. CLA OUTPUT, CPB B1 BINARY RECORD WITH EOI? LDA BEQT1,I YES, USE CNFG WORD RAL,RAL NO, EOR NOT REQUIRED JMP I022 * I021 LDA B14K INPUT, SLB BINARY OR ASCII? LDA BEQT1,I BINARY, USE CNFG WORD * I022 AND B14K PUT CNFG BITS, IF ANY, IN EQT 11 IOR EQT11,I STA EQT11,I POST REQUIREMENTS * * CHECK FOR BACK ARROW. SUPRESS ARROW AND LF IF * ASCII NON HONEST (TRANSPARENT) MODE. * SZB ASCII RECORD? JMP I028 NO. SLA,RSS YES, DIRECTION? CPB T1 WRITE REQUEST! JMP I026 READ REQUEST! OR 0 LNG WRITE! CCA ADA T1 CHECK "_" CROCK ARS ADA EQT7,I FIND BUFR END LDA 0,I LDB T1 CMB,SLB,INB,RSS ODD CHAR? ALF,ALF YES, POSITION AND B377 & AXE CPA B137 "_" ? INB YES, DROP CNT CMB,INB STB T1 CPA B137 "_" ? JMP I028 YES, NO CRLF * I026 LDA EQT11,I FLAG CRLF IOR B10 POST-PROC. STA EQT11,I REQUIREMENT * I028 LDA T1 LDB EQT7,I DO I/O OP JSB DOIO I028A NOP (CNTRL WORD) IOR XLOG,I MAINTAIN ERR STATUS (IF ANY) STA XLOG,I POST XMIS LOG * LDA EQT11,I CLEAR "SUPRESS LF" IF OUTPUT REQUEST. SLA OUTPUT? (EQT6 WOULD BE BETTER CHECK.) * JMP L.XIT NO. MAKE EXIT. * LDA BIT7 YES. CMA FORM MASK TO CLEAR BIT 7. * AND BEQT1,I CLEAR THE SUPRESS LF FLAG. STA BEQT1,I * JMP L.XIT MAKE EXIT. * SKP * * DISPATCH CONTROL REQUESTS * I.CRQ LDA EQT6,I EXTRACT SUB-FUNCTION ASR 6 AND B37 STA 1 LDA UNIT GET DEVICE ADDR CLE,SZA,RSS UNIT 0? JMP IBCRQ YES, BUS CONTROL SZB,RSS NO, DEVICE CONTROL JMP ID00 DEVICE CLEAR CPB B1 JMP ID01 DEVICE EOR CPB B6 JMP ID06 DEVICE STATUS CPB B11 JMP ID11 DEVICE LINE/FORM FEED CPB B16 JMP IB16 REN TRUE IFN **IF SRQ SERVICE***** CPB B20 * * JMP ID20 *ARM ALARM PROG * CPB B21 * * JMP ID21 *CLEAR ALARM PROG * XIF ********************* CPB B25 JMP ID25 SET DEVICE CNFG.WORD CPB B27 JMP ID27 CLEAR DEVICE CNFG.WORD JMP L.XIT ELSE, IGNORE * IBCRQ SZB,RSS JMP IB00 BUS CLEAR CPB B1 JMP IB01 BUS EOR CPB B6 JMP IB06 BUS STATUS CPB B16 JMP IB16 REN TRUE CPB B17 JMP IB17 REN FALSE CPB B25 JMP ID25 CONFIGURE BUS CPB B27 JMP IB27 UNCONFIGURE BUS CPB B30 JMP IB30 PARALLEL POLL JMP L.XIT * SKP * * SELECTED DEVICE CLEAR * ID00 ALF,ALF FORM CMNDS: IOR #LSDC UNT,UNL,LSN,SDC STA CMDBA+1,I * LDA EQT6,I TEST FOR OF,PRGM,1 ELA CMA,SEZ,SSA BIT15(E)=0? OR BIT14(SIGN)=1? JMP L.XIT NO. REQUEST TYPE = 2 (SYSTEM). * LDA B4 YES. REQUEST TYPE #2. LDB CMDBA LOAD BYTE iCNT. AND BUF. ADDR. ID00A JSB DOIO & ISSUE OCT 60 (CMND MODE) JMP L.XIT * * ISSUE DEVICE EOR * ID01 IOR #LSN FORM CMNDS: ALF,ALF STA CMDBA+1,I UNT,UNL,LSN LDA B3 LDB CMDBA JSB DOIO ISSUE NOW OCT 60 IB01 CLA,INA LDB .0A JSB DOIO GIVE EOR OCT 150 (DATA MODE) JMP L.XIT * * DEVICE STATUS * ID06 LDB BEQT2,I FIRST CHECK IF THERE IS ALARM PROGRAM SSB,RSS WAITING TO BE SCHEDULED. (BIT 15 SET)? JMP ID06A NO. GO READ NEW SERIAL POLL. * ELB,CLE,ERB YES. CLEAR THE FLAG AND THEN RETURN THE STB BEQT2,I SERIAL POLL STATUS READ IN RESPONSE LDB BEQT1 TO THE SRQ. ADB B4 LDA 1,I STA STSWD,I JMP L.XIT * ID06A IOR #TLK FORM CMNDS TO READ SERIAL POLL STATUS: IOR #SPE. STA CMDBA+1,I UNT,UNL,SPE,TLK LDA B4 LDB CMDBA JSB DOIO NOTIFY CNTRLR OCT 60 ISZ EQT11,I INDICATE INPUT CLA,INA & LDB STSWD JSB DOIO TAKE STATUS OCT 120 (DATA MODE, CPU LSN) LDA STSWD,I ALF,ALF POSITION STATUS BYTE STA STSWD,I CLA STA EQT11,I INDICATE OUTPUT LDA B2 LDB A#SPD JMP ID00A SERIAL POLL DISABLE SKP * * DEVICE LINE/FORM FEED * ID11 LDB EQT7,I LOAD CTL PARAMETER SZB,RSS PARAMETER=0? JMP ID11C YES, SET SUPRESS LF FOR NEXT WRITE. IOR #LSN NO,MERGE LSN CMND WITH SUBCH ALF,ALF SHIFT TO UPPER BYTE STA CMDBA+1,I AND SAVE IN CMND BUFR LDA B3 LOAD CMND BUFR LNGTH LDB CMDBA LOAD CMND BUFR ADDR JSB DOIO GO OUTPUT UNT,UNL,LSN CMNDS OCT 60 LDA EQT7,I LOAD CTL PARAMETER CMA,SSA,INA,RSS JMP ID11B GO ISSUE A FORM FEED * STA EQT7,I SAVE LF CTR(- # OF CRLF'S)] ID11A LDA B14 LOAD DRIVER CTL WORD STA EQT11,I AND SAVE IN EQT11 CLA JSB DOIO GO OUTPUT CR/LF OCT 110 ISZ EQT7,I LAST CR/LF? JMP ID11A NO,OUTPUT ANOTHER JMP L.XIT YES,EXIT * ID11B CLA,INA SET BUFR LNGTH=1 LDB FORMA LOAD FORM FEED CMND ADDRESS JSB DOIO ISSUE FORM FEED CMND ONCE OCT 110 JMP L.XIT AND EXIT * ID11C LDA BEQT1,I SET BIT7 IN BEQT1 TO SUPRESS LINE FEED. IOR BIT7 STA BEQT1,I JMP L.XIT * SKP IFN **IF SRQ SERVICE***** * * ARM SRQ ALARM PROG (IF "ASMB,...,N") * ID20 LDB EQT7,I GET ALARM PROG BUFFER ADDRESS LDA T2A GET ADDRESS OF TEMPORARY BUFFER. JSB ID20M MOVE PROG NAME AND VALUE TO TEMP BUFFER. * JSB $LIST OCT 217 GET ID ADDRESS OF ALARM PROGRAM DEF T2 SZA ID ADDRESS FOUND? JMP LOSE4 NO, GO LOSE! NO SUCH PROGRAM * LDA BEQT2 YES, MOVE PROG NAME AND VALUE INTO BEQT. LDB T2A JSB ID20M * LDA EQT12,I LOAD EQT WORD 12,SET SRQ INTERRUPT IOR BIT13 ARMING FLAG BIT 13 STA EQT12,I AND STORE IN EQT WORD 12 * JMP L.XIT * ID20M NOP MOVE 4 WORDS FROM BUFF B TO BUFF A. STA T1 SAVE DESTINATION ADDRESS. STB T3 SAVE FROM ADDRESS. * LDB M4 GET DOWN COUNT VALUE. * ID20N LDA T3,I STA T1,I * ISZ T3 ISZ T1 * INB,SZB INCR DOWN COUNT AND TEST FOR END. JMP ID20N * STA T1,I STORE 4TH WORD IN 5TH LOCATION ALSO. * JMP ID20M,I ALL WORDS MOVED. * XIF * * CLEAR DEVICE EQT EXTENSION * ID27 CLA 0 CNFG WORD ENTRY STA BEQT1,I * * CLEAR ACTIVE SQR ALARM PROGRAM * ID21 CLA LDB BEQT2 LOAD ADDR OF ALARM PROG NAME BUFFER STA 1,I AND CLEAR 1ST PAIR OF CHARS INB xC INCREMENT TO ADDR OF 3RD WORD IN BEQT STB T1 AND STORE CLB DST T1,I CLEAR 2ND AND 3RD PAIR OF CHARS JMP L.XIT * * ESTABLISH DEVICE/BUS CNFG WORD * ID25 LDA EQT7,I GET CNFG WORD AND HI11 & IOR UNIT MERGE DEVICE ADDR STA BEQT1,I JMP L.XIT SKP * * GENERAL HP-IB CLEAR * IB00 LDB EQT6,I REQUEST FROM SYSTEM ELA CMA,SEZ,SSA BIT15(E)=0? OR BIT14(SIGN)=1? JMP L.XIT NO. REQUEST TYPE = 2 (SYSTEM). * CLA,INA YES. REQUEST TYPE # 2. ISSUE IFC. JSB CNTLR & LDA HI10 DELAY NO LESS INA,SZA THAN 100 USEC JMP *-1 JSB MINE REGAIN CNTRL LDB EQT7,I SZB IF OPT.PARM#0 JMP L.XIT DO IFC ONLY! CLA,INA LDB A#DCL ADD UNIVERSAL JMP ID00A DEVICE CLEAR * * DO PARALLEL POLL * IB30 LDA B70 ISSUE PPE CMND JSB CNTLR LDA B6 STROBE DIO LINES JSB CNTLR TO INPUT REG. IO5 LIA BUS & TAKE DATA BYTE JMP IB06A & POST IN EQT * * TAKE HP-IB STATUS * IB06 JSB STATS GET STATUS WORD, (E)=0 ASR 4 ISOLATE BUS SIGNAL LINE AND B377 & BUS FUNCTION STATUS IB06A STA STSWD,I & POST IN EQT JMP L.XIT * * REN TRUE/FALSE * IB16 LDA B3 REN TRUE RSS IB17 LDA B2 REN FALSE JSB CNTLR JMP L.XIT * * CLEAR BUS CONFIGURATION * IB27 LDA EQT12,I LOAD EQT WORD 12 AND B377 MASK # OF EQT EXTENSION WORDS STA EQT12,I AND RESTORE LDA DFCFG LOAD DEFAULT BUS CNFG WORD LDB EQT4,I LOAD EQT WORD 4 SSB DMA BIT 15=0? IOR BIT13 NO,SET DMA BIT IN DFLT WORD STA BCNFG,I AND SAVE IN BUS CNFG WORD JMP L.XIT * SKP * * I/O CONTINUATOR SECTION * C.37 NOP STA I.37 =INTERRUPT SK&OURCE CLB,INB ENABLE CLC,C JSB SETUP CNFG I/O & BEQT ADDRS JMP OUCH IFC DETECTED! IFN **IF SRQ SERVICE***** LDA T1 RETRIEVE STATUS * LDB EQT11,I * SSB SRQ SERVICE ACTIVE? * JMP C37C YES, RESUME OPERATIONS SSA SRQ INTERRUPT? * JMP C.SRQ YES, POSSIBLE ALARM* XIF ********************* * C37A LDA EQT1,I SZA I/O IN PROGRESS? JMP C37B YES. IFN **IF SRQ SERVICE***** LDA EQT12,I * RAL,SLA SRQ PENDING? * JMP C.SRQ YES, SERVICE NOW. * SSA ALARM PROG WAITING? * JSB C.SCH YES, SCHEDULE IT * XIF ********************* JMP C.OFF NO, LEAVE * C37B LDA T1 LDB EQT11,I RBR,SLB,RBL DMA I/O ACTIVE? JMP C.DMA YES, SPECIAL HANDLING * C37C RAL,RAL SLB,RSS INPUT REQUEST? JMP C37D SLA YES, EXPECT IRL FLAG JMP C.IRL INPUT READY. JMP C37E C37D SSA NO, EXPECT ORA FLAG JMP C.ORA OUTPUT ACCEPTED. * C37E LDA EQT4,I ALF TIME OUT? SSA,RSS JMP L.RTN NO, DISMISS IFN **IF SRQ SERVICE***** LDA BIT15 SSB SERIAL POLL HUNG? * JMP CONT. BAD, BAD, LEROY BUS... XIF ********************* SLB INPUT REQUEST? BLF,SLB EOR REQUIRED? JMP LOSE1 DEVICE QUIT. JMP C.IR3 ASSUME COMPLETE SKP * * INTERFACE CLEAR SERVICE * OUCH LDA EQT1,I I/O IN PROGRESS? SZA JMP OUCH1 YES. IFN **IF SRQ SERVICE***** LDB EQT11,I * SSB SRQ SERVICE ACTIVE? * JMP C.SR8 YES, NO LONGER... * XIF \ ********************* JMP C.OFF NO, IGNORE OUCH1 JSB MINE REGAIN CNTRL JMP L.RTN IGNORE IFC STATUS PER 1926 PCO SKP IFN **IF SRQ SERVICE** * * SERVICE REQUEST HANDLING (IF "ASMB,...,N") * C.SRQ LDA EQT1,I SZA,RSS I/O IN PROGRESS? JMP C.SR1 NO, GO POLL LDB BEQT1,I SRQ ALLOWED TO SSB KILL I/O OP? JMP C.SR0 LDA EQT12,I NO, DELAY SERVICE IOR BIT15 STA EQT12,I JMP C37A * C.SR0 LDA BIT14 YES, INDICATE SUCH C.SR1 IOR BIT11 (IN CASE OF EOR) STA EQT11,I LDA EQT12,I CLEAR PENDING ELA,CLE,ERA SRQ NOTIFICATION STA EQT12,I JSB SBEQT GET #BEQT ENTS & BEQT ADDR CMA,INA,SZA,RSS ANY? JMP CSR3A NO, DISABLE SRQ INTRPT STA BQCNT,I * C.SR2 STB BEQTA,I STORE DEVICE EQT EXT START ADDR INB INCREMENT TO 2ND WORD IN CURRENT EQT EXT LDA 1,I LOAD 2ND WORD SZA IS SRQ ALARM PROG SET UP FOR THIS DEVICE? JMP C.SR4 YES C.SR3 ADB B6 NO,GO TO 1ST WORD IN NEXT DEVICE EQT EXT ISZ BQCNT,I JMP C.SR2 LDA EQT11,I SSA SRQ SERIAL POLL ACTIVATED? JMP C.SR7 YES, GO CHECK FOR CLAMERS. CSR3A LDA EQT12,I NO. NOBODY WAS CONFIGURED IOR BIT13 WITH SRQ PROGRAM. XOR BIT13 DISABLE FUTURE SRQ STA EQT12,I INTERRUPTS FOR NOW. JMP C.SR8 * C.SR4 LDB BEQTA,I POSSIBLE SRQ SOURCE LDA 1,I LOAD DEVICE CONFIGURATION WORD AND B37 MASK DEVICE ADDRESS IOR #TLK LDB EQT11,I CCE,SSB SRQ SERVICE ACTIVATED YET? JMP C.SR5 RBL,ERB NO, ACTIVATE NOW STB EQT11,I IOR #SPE. FORM CMNDS: STA CMDBA+1,I UNT,UNL,SPE,TLK LDA B4 LDB CMDBA JMP C.SR6 * C.SR5 ALF,ALF YES, ADDR NXT TLKER STA STSWD,I CL dA,INA LDB STSWD C.SR6 JSB DOIO DO SERIAL POLL OCT 60 SSA ERRORS ?? JMP DOWN YES, NO MERCY... ISZ EQT11,I INDICATE INPUT CLA,INA & LDB STSWD TAKE STATUS JSB DOIO OCT 120 (DATA MODE, CPU LSN) SSA TIME OUT? JMP LOSE7 YES, GO LOSE! LDA EQT11,I INDICATE OUTPUT ERA,CLE,ELA STA EQT11,I LDB BEQTA,I LOAD ADDRESS OF 1ST WORD IN CURRENT BEQT INB INCREMENT TO ADDR OF 2ND WORD LDA STSWD,I AND BIT14 SZA,RSS SRQ CLAIMED? JMP C.SR3 NO, TRY AGAIN * LDA 1,I YES IOR BIT15 SET SRQ PROGRAM SCHED ACTIVE BIT IN BEQT2 STA 1,I AND STORE ADB B3 INCREMENT TO BEQT WORD 5,SRQ STATUS BYTE LDA STSWD,I LOAD SRQ STATUS BYTE ALF,ALF SHIFT TO LOWER BYTE STA 1,I SAVE STATUS BYTE IN BEQT WORD 5 LDA EQT12,I LOAD EQT WORD 12 AND SET ALARM IOR BIT14 PROGRAM SCHEDULING ACTIVE BIT 14 STA EQT12,I AND STORE LDB BEQTA,I INB JMP C.SR3 TRY FOR MORE * C.SR7 LDA B2 LDB A#SPD ISSUE SERIAL POLL JSB DOIO DISABLE CMND OCT 60 SSA TIME-OUT? JMP DOWN YES, LOSE JSB C.SCH SKP * C.SR8 LDB EQT11,I RBL SSB,RSS I/O ABORTED? JMP CSR10 LDB BEQT1,I YES, ATTEMPT RESTART? RBL SSB JMP RSTRT YES, DO IT JMP LOSE3 NO, ABORT IT * CSR10 LDB EQT1,I SZB NO, BUSY NOW? JMP RSTRT YES, RESUME STB EQT11,I NO, CLEAR DVR CNTRL WORD JMP C37A * SKP * * ALARM PROGRAM SCHEDULING (IF "ASMB,...,N") * C.SCH NOP LDA EQT12,I LOAD EQT WORD 12,EQT ENTRY COUNT XOR BIT14 SET ALARM SCHEDULING ACTIVE BIT STA EQT12,I AND STORE JSB SBEQT GET -#BEQT ENTRIES(A),ADDRESS OF 1ST BEQT(B) CMA,INA SET COUNTER TO -#BEQT ENTRIES STA BQCNT,I AND STORE * C.SC1 INB GO TO ADDR OF 2ND WORD IN CURRENT BEQT STB BEQTA,I AND STORE IN BEQTA LDA 1,I LOAD SECOND WORD OF CURRENT BEQT SSA SCHEDULING ACTIVE BIT 15 SET? JMP C.SC3 YES,TRY TO SCHEDULE PROGRAM IF IT EXISTS C.SC2 ADB B6 NO,GO TO 1ST WORD IN NEXT BEQT ISZ BQCNT,I INCREMENT BEQT COUNTER JMP C.SC1 JMP C.SCH,I DONE, SO LEAVE * C.SC3 ELA,CLE,ERA FOUND, CLEAR SCHEDULING ACTIVE BIT 15 STA 1,I AND STORE BACK INTO 2ND WORD IN BEQT STB C.SC4 STORE ADDR FOR SCHEDULING SRQ PROG ADB B3 INCR ADDR TO 5TH WORD IN BEQT,SRQ STATUS BYTE STB PARM1 AND STORE * INB INCREMENT TO PASSED VALUE (BEQT6) STB PARM4 * ADB M5 GO TO ADDR OF 1ST WORD IN CURRENT BEQT LDA 1,I LOAD DEVICE CONFIGURATION WORD AND B37 MASK DEVICE ADDRESS STA PARM2 AND STORE LDA EQT1 LOAD DEVICE EQT ADDRESS STA PARM3 AND STORE * JSB $LIST SCHEDULE ALARM PROGRAM OCT 701 BY NAME AND PASS IT DEF *+6 FOUR PARAMETERS C.SC4 NOP ALARM PROGRAM NAME BUFFER ADDRESS PARM1 NOP SRQ STATUS BYTE DEF PARM2 DEVICE ADDRESS DEF PARM3 EQT ADDRESS PARM4 NOP PASSED VALUE * SZA SUCCESSFUL SCHEDULE? JMP C.SC5 NO,CHECK ERROR CODE JMP C.SC6 YES,LOAD ADDR OF 2ND WRD IN CURRENT BEQT * C.SC5 CPB B5 IS PROGRAM THERE? JMP LOSE5 NO,GO LOSE! LDA EQT12,I YES, MAINTAIN ALARM PROGRAM IOR BIT14 SCHEDULING ATTEMPT BY SETTING STA EQT12,I SCHEDULING ACTIVE BIT IN EQT WORD 12 LDB BEQTA,I LOAD ADDR OF 2ND WORD IN CURRENT BEQT LDA 1,I LOAD 2ND WORD IN BEQT IOR BIT15 RESET SRQ PROG#  SCHED ACTIVE BIT STA 1,I AND STORE INTO 2ND WORD IN BEQT * C.SC6 LDB BEQTA,I LOAD ADDR OF 2ND WORD IN CURRENT BEQT JMP C.SC2 CONTINUE... XIF SKP * * DMA COMPLETION SERVICE * C.DMA BLF,ELB GET EOR CHARACTERISTICS RAL,RAL ELA A(15)=EOR FLAG, A(0)=W/BYTE STA T1 JSB DMA? GET DMA CHAN STA T2 & JSB CFGIO CNFG I/O INSTRUCTIONS DEF DMAT2 LDA DIO12 XOR B4 FORM LIB 2/3 STA DIO12 STA DIO13 DIO13 LIB 2 STB T3 LDA T2 LDB EQT11,I CPA I.37 DMA COMPLETION? JMP C.DMD YES. LDA T1 SSA EOR INDICATED? JMP C.DM1 YES. LDA EQT4,I ALF SSA,RSS TIME OUT? JMP L.RTN NO, DISMISS * C.DM1 SLB,RSS DMA HUNG! INPUT? JMP DIO10 NO, SKIP WIERD CRAP IO6 STC BUS DISABLE DMA'S CLF LDA B6 TO NOT CLEAR EOR FF JSB CNTLR FORCE DMA CYCLE TO GET LAST BYTE IO7 CLC BUS ENABLE LATER CLF INSTRUCTIONS DIO10 CLC 6 & DIO11 STF 6 STOP DMA SLB,RSS INPUT? JMP LOSE1 NO, DEVICE DOWN * C.DM2 LDB T1 SSB EOR SEEN? SLB EXPECTED AFTER LAST BYTE? C.DM3 CLA,RSS CCA YES, ADJUST CNT DIO12 LIB 2 TAKE DMA REMAINS CPB T3 SAME AS PREVIOUS CNT?? RSS YES, MUST HAVE BEEN EVEN CNT ADA M1 NO, ADJUST FOR ODD CNT BLS ADB 0 ADB IOCNT,I ADB IOLNG,I =XMITTED CHAR CNT LDA 1 ARS ADA IOADR,I STA IOADR,I =BUFR END ADDR LDA EQT11,I SLA CHECK I/O DIRECTION JMP C.DM4 * XOR B2 OUTPUT, CLEAR DMA STA EQT11,I ACTIVE STATUS AND BIT8 MAINTAIN ASCII LOGIC IOR REACT ARM SRQ,ORA,PACKING JSB CNTLR J & JMP C.OR8 DUMP REMAINDER * C.DM4 STB IOCNT,I INPUT, POST APPROX.CNT AND B10 CRLF POST PROC? SZA,RSS JMP C.IR3 NO, ALLOW ODD CHAR.FILL LDB IOCNT,I YES, END ON CRLF ADB M2 CLE,SSB,RSS SZB,RSS CLB,CCE CCA,SEZ CLA ADA IOADR,I STA IOADR,I C.DM5 LDA IOADR,I GET CUR.WORD LDA 0,I SLB,RSS EVEN CNT? ALF,ALF YES, POSITION AND B377 EXTRACT CHAR CPA B15 CR? JMP C.DM6 OR CPA B12 LF? JMP C.DM6 OR CPB IOCNT,I EOB? JMP C.IR3 YES, DONE SLB,INB ODD CNT? ISZ IOADR,I YES, ADVANCE JMP C.DM5 & CONTINUE * C.DM6 STB IOCNT,I POST VALID CHAR CNT JMP C.IR3 * C.DMD SLB DMA COMPLETION FOR: JMP C.DM2 INPUT. JMP C.DM3 OUTPUT. SKP * * OUTPUT CONTINUATOR SERVICE * C.ORA LDA EQT11,I GET EOR CHARACTERISTICS ALF,CLE A(0)=EOR REQ., A(15)=W/BYTE. ALSO CLR E. LDB IOCNT,I SZB,RSS BUFR FLUSHED? JMP C.OR5 YES. (E)=0 CPB B1 WEIRD CRAP? LAST BYTE? JMP C.OR3 YES, (E)=0 INB,SZB,RSS ODD BYTE? JMP C.OR3 YES. (E)=1 INB,SZB,RSS LAST WORD? JMP C.OR2 YES. (E)=1 STB IOCNT,I NO. (E)=0 * C.OR1 LDA IOADR,I LDA 0,I GET DATA WORD SEZ NEXT OUTPUT UPPER BYTE ONLY? ALF,ALF YES, POSITION LDB IOCNT,I GET COUNT OF CHAR.S LEFT TO BE SENT. CCE,SSB WEIRD STUFF? ALSO SET E BIT. ISZ IOADR,I NO, ADVANCE BUFR IO1 OTA BUS ISSUE DATA C.OR8 JSB STATS GET STATUS RAL,RAL CHECK FOR QUICK RESPONSE SSA ?? JMP C.ORA YES, CONTINUE JMP L.RTN NO, AWAIT INTERRUPT * C.OR2 CLB,INB n@INDICATE ONE MORE BYTE STB IOCNT,I TO COME AFTER THIS ONE. CLB INDICATE NO EOR AND ALSO JMP C.OR4 DISABLE PACKING. (NO PACKING BIT 11=0) * C.OR3 CLB LAST BYTE! (E=0 LOWER) (E=1 UPPER) STB IOCNT,I SET COUNT TO ZERO TO FLAG SPECIAL CASE. SLA EOR REQUIRED? SSA,RSS W/LAST BYTE? JMP C.OR4 NO. LDB B50 YES, GIVE EOR (BITS 5-3=5) ALSO NO PACKING. XOR B1 CLEAR FUTURE REQ. C.OR4 ALF,ALF SEND COMMAND WORD TO I/O BOARD. ALF POSITION BIT 15 TO SIGN BIT. STA EQT11,I AND BIT8 MAINTAIN ASCII LOGIC IOR 1 IOR REARM ARM SQR,ORA INTRPT JSB CNTLR NOTIFY CNTRLER JMP C.OR1 * C.OR5 SLA,RSS ALL BYTES HAVE BEEN SENT. EOR REQUIRED? JMP C.OR6 NO, POSSIBLE CRLF IOR BIT15 YES, DO IT NOW LDB .0A STB IOADR,I JMP C.OR3 * C.OR6 ALF,ALF POSITION BIT 3 TO SIGN POSITION SSA,RSS CRLF REQUIRED? BIT 3 SET? JMP DOIOX NO. MAKE EXIT. * XOR BIT15 YES. CLEAR FUTURE REQUIREMENT. ALF,ALF POSITION BIT 11 TO SIGN POSITION. IOR BIT12 ENABLE ASCII LOGIC (BIT 8 OF EQT11). STA 1 SAVE EQT11 IN B REGISTER. * LDA CRLFA GET ADDRESS OF CRLF STA IOADR,I AND PUT IN POINTER TO I/O BUFFER. ISZ IOLNG,I INCR. COUNT FOR CR BUT NOT FOR LF YET. CCE SET FLAG TO SEND UPPER BYTE. * LDA EQT6,I CHECK IF OUTPUT MODE. AND B3 MASK TO GET FUNCTION CODE. CPA B2 WRITE? CODE=2? * JMP C.OR7 YES. * JMP C.OR9 NO. SEND LF. * C.OR7 LDA BEQT1,I CHECK IF LF IS TO BE SUPRESSED. AND BIT7 SUPPRESS IF BIT 7 IS SET. SZA SUPPRESS? * JMP C.ORB YES. * C.OR9 ISZ IOLNG,I NO. NOW INCREMENT COUNT FOR LF. LDA 1 RESTORE EQT11 TO A REGISTER. JMP C.OR2 3 GO SEND CRLF AS LAST TWO BYTES. * C.ORB LDA 1 RESTORE EQT11 TO A REGISTER. JMP C.OR3 GO SEND CR AS LAST BYTE. * * SKP * * INPUT CONTINUATOR SERVICE * C.IRL BLF,ELB GET EOR CHARACTERISTICS ELA & MERGE CUR EOR STATUS STA T1 A(15)=EOR, A(0)=W/BYTE REQ. SSA,RSS EOR? JMP C.IR1 NO, TAKE DATA SLA,RSS EXPECT W/BYTE? JMP C.IR3 NO, EOR ONLY * C.IR1 LDA IOADR,I STA T2 IO2 LIA BUS TAKE DATA BYTE BLF,BLF BIT 3, CRLF CHECK SLB,RSS JMP C.IR2 CPA B15 YES, IGNORE CR'S JMP CIR2A CPA B12 LF? JMP C.IR3 YES, END IT NOW * C.IR2 LDB IOCNT,I RETREIVE CNT SLB,RSS EVEN BYTE? ALF,ALF YES, POSITION SLB IOR T2,I NO, MERGE STA T2,I POST IN BUFR SLB,INB ODD BYTE? ISZ IOADR,I YES, ADVANCE BUFR STB IOCNT,I & CNT CHAR CPB IOLNG,I ALL DATA TAKEN? JMP C.IR3 YES, DONE CIR2A LDB T1 CCE,SSB EOR? JMP C.IR3 YES, END IT ALL * C.IR4 JSB STATS GET STATUS, CLEAR MAIN FLAG RAL,RAL SLA,RSS CHECK QUICK RESPONSE? JMP L.RTN NOT YET, AWAIT INTERRUPT LDB EQT11,I HAVE IT, CONTINUE... JMP C.IRL * C.IR3 CCE CLEAR PENDING IRL JSB STATS INTERRUPT CLA ADJUST FOR VALID STA IOLNG,I XMIS. LOG LDB IOCNT,I ODD CNT? SLB,RSS NO, DONE JMP DOIOX LDB EQT11,I RBR,RBR SLB,RSS DATA TYPE? CLB,RSS BINARY, 0 FILL LDB B40 ASCII, BLANK FILL STB T2 LDB IOADR,I LDA 1,I AND HI8 IOR T2 STA 1,I JMP DOIOX * SKP * * ERRORS * LOSE1 CLA,INA,RSS *I/O ERROR LOSE2 LDA B2 *I/O ABORTED BY IFC JMP LOSE * IFN ****p********IF SRQ SERVICE********** LOSE3 LDA B3 * I/O ABORTED BY SRQ * JMP LOSE * * LOSE4 LDA B4 * NO ALARM PROGRAM FOUND WITH NAME * JMP LOSE *SPECIFIED WHEN CTL REQ 20 WAS MADE* LOSE5 LDA B5 *ON SRQ INTERRUPT, DRIVER COULD NOT* JSB EQSTS *SCHEDULE ALARM PROGRAM SPECIFIED * JMP DOWN *IN DEVICE BEQT * LOSE7 LDA B7 *NO STATUS RETURNED BY DEVICE IN * JSB EQSTS *RESPONSE TO A SERIAL POLL PRIOR TO* JMP DOWN *TIMEOUT OCCURRING * XIF ************************************ * LOSE6 LDA EQT13,I *EQTX FULL IOR BIT15 STA EQT13,I INDICATE INITIATOR * CLA CLEAR BEQT1 ADDRESS SO BEQT7 STA BEQT1 WILL NOT BE POSTED * LDA B6 LOSE STA STSWD,I POST ERR STATUS LDA BIT15 STA XLOG,I GIVE ERR JMP L.XIT & QUIT * DOWN CCA *CRITICAL ERROR! STA CHAN LDB EQT13,I & DOWN BUS NOW SSB,RSS VIA CLA,INA,RSS CONTINUATOR LDA B3 INITIATOR JMP LXIT2 * * LOGICAL I/O CONTINUATOR EXITS * C.OFF LDA IDLE JSB CNTLR ARM SQR, SET DATA MODE IO8 CLC BUS,C & OFF 59310B CLA,CLE,RSS INDICATE CLOCK OFF L.RTN CLA,CCE INDICATE CLOCK ON STA T1 CLO INDICATE CONTINUATION ISZ C.37 JMP LXIT3 SKP * * LOGICAL I/O COMPLETION EXITS * L.XIT LDA STSWD,I POST EQT STATUS IN EQT5 & BEQT7 JSB EQSTS & LDA XLOG,I GIVE XMIS.LOG RAL,CLE,ERA PUT ERROR FLAG IN E REGISTER. LDB EQT8,I SSB WORDS REQUESTED? JMP LXIT1 NO, GIVE +CHARS INA YES, GIVE +WORDS ARS LXIT1 SEZ PUT THE ERROR BIT BACK IN IOR BIT15 IF IT WAS SET. STA XLOG,I SSA,RSS ANY ERRORS? JMP LXT1A NO LDA EQT6,I YES,LOAD EQT WORD 6 RAL,RAL ROTATE REQ TYPE TO LOWER BIT AND B3 AND MASK SZA REQ TYPE=0? JMP DOWN NO,BUFRD REQ,AL ERRORS FATAL! LDA BEQT1,I YES,UNBUFRD REQ,LOAD CNFG WORD ALF,ALF ROTATE E-BIT TO LSB SLA,RSS E-BIT=0? JMP DOWN YES,ALL ERRORS FATAL! * LXT1A LDB EQT13,I SSB INITIATOR? LDA B4 YES, IMMED.COMPLETE. (DON'T ABORT PROG) SSB,RSS LDA BIT15 NO, FREE DMA CHAN. LXIT2 STA T1 =RETURN CODE LDA IDLE JSB CNTLR ALLOW SQR, SET DATA MODE IO9 CLC BUS,C & KILL 59310B NOW CLA,CLE INDICATE CLOCK OFF STA EQT11,I CLEAR DVR CNTRL WORD STO INDICATE COMPLETION LXIT3 LDA EQT13,I SSA DETERMINE EXIT ROUTE LDB I.37 INITIATOR. SSA,RSS LDB C.37 CONTINUATOR STB T2 =RETURN ADDR LDA EQT13,I ELA,CLE,ERA CLEAR I/C INDICATOR STA EQT13,I LDA EQT4,I IOR BIT11 XOR BIT11 CLEAR TIME OUT FLAG STA EQT4,I SEZ,RSS CLOCK OFF? CLA,RSS YES, CLEAR IT LDA EQT14,I NO, RECOVER TIME VALUE * SKP * IFN **IF SRQ SERVICE***** SOC I/O COMPLETION? * JMP LXIT4 YES. * LDB EQT1,I * SZB I/O BUSY? * JMP LXIT5 YES. * LDB EQT11,I * SSB SRQ SERVICE BUSY? * JMP LXIT5 YES. * LXIT4 LDB EQT12,I * RBL,SLB SRQ PENDING? * CCA YES, HANDLE ON NXT INTRPT SSB PROG SCHEDULING DELAYED? LDA TIME YES, ACTIVATE TIME OUT XIF ********************* * LXIT5 STA EQT15,I IFN  *******IF SRQ SERVICE********** LDA DTOUT *LOAD ADDRESS OF DUMMY TIMEOUT* SOC *IF COMPLETION EXIT * STA EQT15 *AVOID RTIOC CLOCK CLEAR * XIF ******************************* * LDB BEQT1 POST BEQT7 * SZB,RSS TEST IF BEQT IS SETUP (IE. NO ERR 6) JMP LXIT6 ERR 6. NO ROOM IN EQTX. * ADB B6 LDA XLOG,I FIRST STORE TRANSMISSION LOG. STA 1,I * SSA,RSS IF ERROR (BIT15 SET), THEN CHANGE THE JMP LXIT6 STORED VALUE TO THE STATUS VALUE FROM LDA EQT5,I EQT5. AND B377 IOR BIT15 STA 1,I * LXIT6 LDA T1 BEGIN FINAL EXIT FROM DRIVER. LDB XLOG,I ISZ CHAN CRITICAL ERR? IO4 STC BUS NO, ENABLE INTERRUPT JMP T2,I & LEAVE GRACEFULLY SKP * DO I/O OPERATION * * (A)=+CHAR CNT, (B)=BUFR ADDR * JSB DOIO * DEF * (A)=+CHAR CNT XMITTED * DOIO NOP STA IOLNG,I POST CHAR LNG STB IOADR,I POST BUFR ADDR LDB EQT11,I SLB CHECK I/O DIRECTION? CLA,RSS INPUT, INIT UP CNT CMA,INA OUTPUT, INIT DOWN CNT STA IOCNT,I * DOIO0 LDA EQT11,I CONSTRUCT HP-IB CNTRL WORD: AND BIT8 ALLOW ASCII MODE LOGIC IOR DOIO,I MERGE CMND/DATA MODE LDB EQT11,I SLB,RBR I/O DIRECTION? JMP DOIO1 * IOR BIT11 OUTPUT, PACKING ON SLB,RSS DMA? IOR BIT13 NO, ARM ORA INTRPT JMP DOIO2 * DOIO1 SLB,RSS INPUT, DMA? IOR B50K NO, ARM IRL,EOR INTRPT SLB IOR B16K YES, ARM EOR,PACKING,DMA STA T1 SAVE CONTROL WORD LDA ENABL LOAD CONTROL WORD TO SET NRFD FALSE JSB CNTLR GO ISSUE IT LDA T1 LOAD HP-IB CONTROL WORD * DOIO2 IOR ENABL ENABLE FUNNY FUNCTIONS JSB CNTLR ISSU%E CONTROL WORD FOR ATN FALSE,ETC... LDA DOIO INA POST RESUME ADDR STA ZOOM,I RBL,SLB INPUT REQUEST? IIO1 LIA BUS,C YES, SET RFD FLOP RBR,SLB,RBL DMA REQUEST? JMP DOIO3 CCE,SLB NO, DIRECTION? JMP C.IR4 INPUT, AWAIT INTERRUPT JMP C.ORA OUTPUT, START CONTINUATOR * DOIO3 LDA IOLNG,I INIT DMA I/O OP INA ARS DETERMINE I/O LNG CMA,INA,SZA,RSS 0 LNG? JMP DOIO5 YES, CRLF ONLY! STA T1 SLB,BLF OUTPUT? JMP DOIO6 NO, IGNORE WHAT FOLLOWS! LDA IOLNG,I ERA ALLOW FOR EOR ACTIVITY CCA,SEZ ODD BYTE? JMP DOIO4 YES, ALLOW FOR IT CLA SLB,RSS EOR REQUIRED? JMP DOIO4 NO, NO ADJUSTMENT SSB EOR W/BYTE? LDA M2 YES, ALLOW FOR IT DOIO4 STA IOCNT,I POST ADJUSTMENT, IF ANY SZA ISZ T1 REDUCE DMA I/O LNG JMP DOIO6 DOIO5 LDA EQT11,I NOTHING LEFT, CLEAR XOR B2 DMA ACTIVE STATUS STA EQT11,I JMP DOIO0 & TRY AGAIN * DOIO6 JSB DMA? GET DMA CHAN JSB CFGIO CONFIGURE DMA I/O DEF DMAT1 INSTRUCTIONS LDA DIO1 AND B3 JSB CFGIO ALL OF THEM! DEF DMCT1 LDA CHAN GET HP-IB CHANNEL DIO1 OTA 6 & TELL DMA CIO1 CLC 2 LDB EQT11,I SLB INPUT REQ?? IIO2 STC BUS YES, $%&'&%$#$#&%$ ERB ESTABLISH I/O LDA IOADR,I DIRECTION RAL,ERA & CIO2 OTA 2 BUFR ADDR CIO3 STC 2 LDB T1 & CIO4 OTB 2 -WORD CNT CLF 0 INTERRUPTS OFF DIO2 STC 6,C START DMA CLA CPA DUMMY PRIVILEDGED INTRPTS? JMP L.RTN NO, AWAIT RESPONSE DIO3 CLC 6 YES, KILL DMA INTPRPT LDB INTBA LDA DIO1 & SLA >` INB LDA 1,I IOR BIT15 ALLOW RTE TO HANDLE STA 1,I STF 0 INTERRUPTS ON JMP L.RTN AWAIT DMA RESPONSE * DOIOX LDA IOLNG,I I/O OP COMPLETION HERE... ADA IOCNT,I (A)=XMIS LOG CONT. LDB ZOOM,I & JMP 1,I RESUME SKP * FIND DMA CHANNEL ASSIGNMENT * DMA? NOP DLD INTBA,I ELA,CLE,ERA FIND AVAILABLE CPA EQT1 DMA CHANNEL JMP DMA1 ELB,CLE,ERB CPB EQT1 JMP DMA2 CLA NONE! JMP DMA?,I DMA1 CLA,RSS DMA2 CLA,INA ADA B6 (A)=DMA CHAN JMP DMA?,I * * ISSUE HP-IB CONTROLLER CMND * CNTLR NOP IFN ** IF SRQ SERVICE ** STA DMA? * LDA EQT11,I IF DMA RUNNING SSA,RSS OR BUSY WITH SRQ RAR,SLA THEN KILL SRQ * TEST DMA BIT HERE. CLA,RSS INTERRUPT LDA EQT12,I GET SRQ INTERRUPT * RAL,RAL ARMING FLAG & * AND BIT15 ISSUE WITH CONTROL * IOR DMA? WORD * XIF ******************** CNTL1 STF BUS CNTL2 OTA BUS JMP CNTLR,I * * TAKE HP-IB CONTROLLER STATUS * (E)=1 TO ALSO CLEAR MAIN FLAG * STATS NOP STAT1 STF BUS ENABLE CARD CONTROL MODE SEZ (E)=1 TO CLEAR MAIN FLAG ONLY STAT2 CLC BUS,C WITH NO CHANGE TO EOR FF, ETC STAT3 LIA BUS DISABLE CONTROL MODE JMP STATS,I * * REGAIN HP-IB CONTROL * MINE NOP LDA B5 JSB CNTLR SET ACTIVE CNTRLR IO3 CLC BUS,C CLEAR IFC STATUS JMP MINE,I * SKP * * POST EQT STATUS BYTE * EQSTS NOP AND B377 STA MINE (A)=STATUS BYTE LDA EQT5,I AND HI8 IOR MINE STA EQT5,I JMP EQSTS,I * * CONFIGURE I/O INSTRUCTIONS * * (A)=I/O CHAN * JSB CFGIO * DEF * P+2: RET@URN * CFGIO NOP STA MINE (A)=CHAN LDB CFGIO,I GET TAB ADDR LDA 1,I STA EQSTS GET # ENTRIES CFG1 CCE,INB SET INDIRECT BIT RBL,ERB ON TAB ENT ADDR LDA 1,I AND HI10 CNFG INSTRUCTION IOR MINE STA 1,I ISZ EQSTS JMP CFG1 ISZ CFGIO JMP CFGIO,I * * GET #BEQT ENTRIES, 1ST BEQT ENTRY ADDR * SBEQT NOP LDA EQT12,I ALF,ALF AND B37 LDB EQT13,I ELB,CLE,ERB ADB FIXSZ JMP SBEQT,I * * INITIALIZE BEQT WORDS. * VALUE OF CONFIGURATION WORD IN A REGISTER. * ADDRESS OF BEQT1 FOR UNIT IN B REGISTER. * CLRBE NOP STA 1,I SET CONFIG WORD IN BEQT1. STB T1 SAVE BEQT1 ADDRESS. * LDB M7 FETCH NEGATIVE LENGTH OF BEQT. CLA SET REMAINING BEQT WORDS TO 0'S. * CLRBF ISZ T1 INCREMENT ADDRESS. INB,SZB,RSS INCREMENT DOWN COUNT. TEST FOR END. JMP CLRBE,I END OF BEQT. * STA T1,I CLEAR BEQT WORD. JMP CLRBF GO BACK AND CLEAR NEXT WORD. * SKP * * CNFG I/O & SETUP BEQT * * (A)=I/O CHANNEL * (B)=0/1: DISABLE/ENABLE CLC,C * JSB SETUP * P+1: HP-IB CONTROL LOST * P+2: NORMAL RETURN * SETUP NOP STB T3 LDA EQT4,I INSURE WE HAVE AND B77 BUS CHANNEL STA CHAN JSB CFGIO CNFG I/O INSTRUCTIONS DEF IOTAB LDB FIXSZ CMB,INB STB T1 LDA EQT12,I INSURE AND B377 MINIMUM ADA 1 SIZE EQTX SSA JMP LOSE6 LOSE!! * LDA EQT13,I FETCH FIRST EQTX ADDRESS. LDB XEQTA FETCH 1ST ADDR. FOR STORING EQTX ADDR.S. SET1 STA 1,I POST FIXED INA EQTX ADDRS INB ISZ T1 JMP SET1 * LDA EQT12,I LOAD EQT WORD 12 AND MASK MASK # OF DEVICE ENTRIES SZA # OF DE}DVICE ENTRIES ZERO? JMP SET8 NO, SKIP AUTO ADDR BUFR INITIALIZATION DLD CMDBF YES,INITIALIZE AUTO ADDR CMND BUFR DST CMDBA,I FOR THIS HP-IB TO UNT,UNL,0,0 * SET8 LDA EQT4,I ASR 6 EXTRACT AND B37 SUB-CHANNEL STA UNIT * LDA EQT12,I LOAD EQT WORD 12. AND MASK MASK TO GET DEVICE COUNT. SZA HAS BUS BEEN CONFIGURED? JMP SET YES. BEEN THRU BEFORE. * LDA EQT12,I NO. GET EQT WORD 12 AGAIN. IOR BIT8 SET DEVICE COUNT TO ONE STA EQT12,I AND STORE * LDB EQT4,I LOAD EQT WORD 4 LDA DFCFG LOAD DEFAULT BUS CNFG WORD SSB DMA BIT 15=0? IOR BIT13 NO,SET DMA BIT IN DEFAULT WORD LDB BCNFG INITIALIZE BUS BEQT. JSB CLRBE * * SET LDA UNIT GET SUBCHANNEL (UNIT) NUMBER AGAIN. SZA SUBCHANNEL 0? JMP SET2 NO. * LDB BCNFG LOAD BUS CNFG WORD ADDRESS JMP SET6 * SET2 JSB SBEQT GET #BEQT ENTS & ADDR STA T2 SAVE # OF CNFG SUB CHANNELS * CMA,INA FORM NEG. NO. OF CNGF. SUBCHANNELS. STA T1 SAVE COUNT. * CLA STA BEQT1 * * SET3 ISZ T1 INCREMENT DOWN COUNT. JMP *+2 JMP SET4 EXIT LOOP WHEN COUNT GETS TO ZERO. * LDA 1,I FETCH BEQT1 SZA,RSS BEQT ENTRY EMPTY? STB BEQT1 YES, REMEMBER IT * AND B37 GET DEVICE ADDR CPA UNIT OF INTEREST? JMP SET6 YES, GOT IT * ADB B7 JMP SET3 NO, TRY NEXT BEQT. * SET4 LDA BEQT1 UNIT NOT FOUND SZA EMPTY ENTRY? JMP SET5 YES. * STB BEQT1 NO, NEED TO MAKE ONE ADB B6 CALCULATE LAST NEEDED ADDRESS. LDA EQT12,I INSURE ROOM EXISTS AND B377 GET EQTX LENGTH. ADA EQT13,I CALCULATE LAST AVAILABLE ADDRESS. ELA,CLE,ERA CLEAR THE I/C BIT. (IS THIS NECESSARY?) CMA,INA ADA 1 SUBTRACT AVAILABLE FROM NEEDED. SSA,RSS NEEDED GREATER THAN AVAILABLE? JMP LOSE6 YES, FULL! * LDA T2 RETRIEVE # OF CNFG SUB CHANNELS CPA B37 31 ENTRIES YET? JMP LOSE6 YES, FULL! * LDA EQT12,I ADA BIT8 OK, CNT ENTRY STA EQT12,I * SET5 LDB BEQT1 LOAD ADDRESS OF IST BEQT WORD LDA UNIT LOAD DEVICE ADDRESS IOR DFCFG MERGE DEFAULT DEVICE CONFIG WORD JSB CLRBE INITIALIZE NEW BEQT. LDB BEQT1 LOAD ADDRESS OF BEQT WORD 1 * SET6 STB BEQT1 SAVE ADDRESS OF 1ST WORD IN BEQT INB INCREMENT TO ADDRESS OF 2ND WORD IN BEQT STB BEQT2 STORE ADDRESS OF 2ND WORD IN BEQT * LDB T3 RETRIEVE CLC,C FLAG. ERB (E)=1 FOR CLC,C JSB STATS TAKE STATUS, CLEAR FLAG STA T1 AND B17 CPA B11 IFC DETECTED? JMP SETUP,I YES, LEAVE P+1 LDA T1 AND B20 CPA B20 ACTIVE CONTROLLER? ISZ SETUP YES, EXIT P+2 JMP SETUP,I SKP * * EQT EXTENSION FIXED AREA ASSIGNMENTS * FIXSZ DEF FIXND-*-2 EQTX MIN.SIZE REQ. XEQTA DEF *+1 *BEGIN FIXED EQTX AREA IOLNG BSS 1 1 CUR I/O CHAR LNG IOADR BSS 1 2 CUR I/O BUFR ADDR IOCNT BSS 1 3 CUR I/O CHAR CNT XLOG BSS 1 4 PENDING XMISSION LOG STSWD BSS 1 5 PENDING EQT STATUS BYTE BEQTA BSS 1 6 SRQ, PENDING BEQT ADDR BQCNT BSS 1 7 SRQ, PENDING BEQT CNT ZOOM BSS 1 10 I/O RESUME ADDR DTOUT BSS 1 11 DUMMY TIMEOUT CMDBA BSS 2 12 AUTO ADDRESSING COMMAND BUFFER BCNFG BSS 7 15 BUS CONFG WORD. (BEQT FOR UNIT 0) FIXND EQU * *END FIXED EQTX AREA * * EQT EXTENSION VARIABLE AREA ENTRY * ONE ASSIGNMENT PER UNIQUE SUBCHANNEL * BEQT1 BSS 1 DEVICE CNFG WORD ADDRESS. BEQT2 BSS 1 SRQ ALARM PROG ADDRESS. *  * STORAGE, ETC * BUS EQU 20B NOMINAL HP-IB CHANN TIME DEC -100 SCHEDULE RETRY @ 10MSEC UNIT BSS 1 CHAN BSS 1 T1 BSS 1 T3 BSS 1 T2A DEF *+1 T2 BSS 5 CFGWA DEF *+1 BSS 1 ZBIT BSS 1 Z-BIT IN LSB PARM2 BSS 1 ALARM DEVICE ADDRESS PARM3 BSS 1 ALARM DEVICE EQT ADDRESS * .0A DEF .0 A#SPD DEF #SPD. A#DCL DEF #DCL. CRLFA DEF CRLF * .0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B10 OCT 10 B11 OCT 11 B12 OCT 12 B14 OCT 14 B15 OCT 15 B16 OCT 16 B17 OCT 17 B20 OCT 20 B21 OCT 21 B25 OCT 25 B27 OCT 27 B30 OCT 30 B37 OCT 37 B40 OCT 40 B50 OCT 50 B70 OCT 70 B77 OCT 77 B100 OCT 100 B137 OCT 137 B177 OCT 177 B377 OCT 377 B2103 OCT 2103 B6K OCT 6000 B14K OCT 14000 B16K OCT 16000 DFCFG OCT 17000 B50K OCT 50000 MASK OCT 17400 ENABL OCT 207 IDLE OCT 247 REACT OCT 24200 REARM OCT 20200 * BIT7 OCT 200 BIT8 OCT 400 BIT11 OCT 4000 BIT12 OCT 10000 BIT13 OCT 20000 BIT14 OCT 40000 BIT15 OCT 100000 HI8 OCT 177400 HI10 OCT 177700 HI11 OCT 177740 CRLF OCT 6412 FORMA DEF B6K M1 DEC -1 M2 DEC -2 M4 DEC -4 M5 DEC -5 M7 DEC -7 * * SKP CMDBF OCT 57477,40040 UNTALK,UNLISTEN,TLK,LSN #LSN EQU B40 LISTEN ADDR #TLK EQU B100 TALK ADDR #SPE. EQU B14K SERIAL POLL ENABLE #SPD. OCT 14537 SERIAL POLL DISABLE,UNTALK #LSDC OCT 20004 LSN ADDR 0, SDC #DCL. OCT 12000 UNIVERSAL DEVICE CLEAR #ULBT OCT 37500 UNL, BUS TALK #ULBL OCT 37440 UNL, BUS LISTEN #DLSC OCT 20140 DEVICE LISTEN, SECONDARY #DTSC OCT 40140 DEVICE TALK, SECONDARY * SKP IOTAB ABS *+1-IOTAE DEF IO1 DEF IO2 DEF IO3 DEF IO4 DEF IO5 DEF IO6 DEF IO7 DEF IO8 DEF IO9 DEF IIO1 DEF IIO2 DEF CNTL1 DEF CNTL2 DEF STAT1 DEF STAT2 DEF STAT3 IOTAE EQU * * DMAT1 ABS *+1-DMT1E DEF DIO1 DEF DIO2 DEF DIO3 DMT1E EQU * * DMCT1 ABS *+1-DMC1E DEF CIO1 DEF CIO2 DEF CIO3 DEF CIO4 DMC1E EQU * * DMAT2 ABS *+1-DMT2E DEF DIO10 DEF DIO11 DEF DIO12 DMT2E EQU * * * SIZE EQU * DRIVER SIZE CHECK END    59310-18006 1926 S C0122 &HPIB HPIB LIB             H0101 ASMB,R,Q,C HED HPIB, RTE BUS UTILITY NAM HPIB,7 59310-16004 REV 1926 790516 * ENT HPIB,SRQ,CMDR,CMDW ENT SRQSN,IBERR,IBSTS EXT .ENTR,EXEC,SRQ.T,IPUT,LUTRU * *************************************************** * (C) COPYRIGHT HEWLETT-PACKARD CO., 1975 * * ALL RIGHTS RESERVED * *************************************************** * * HPIB - RTE BUS UTILITY * * RELOC: 59310-16004 * SOURCE: 59310-18006 * *************************************************** * 1926 PCO * * PROBLEM: LU IS USED TO INDEX IN DRT. IN SESSION THE LU * PASSED TO ONE OF THESE SUBROUTINES IS NOT * NECESSARILY THE TRUE LU AND HENCE IS INVALID TO * USE FOR INDEXING THROUGH THE DRT. ALSO LU'S GREATER * THAN 77B ARE NOT HANDLED CORRECTLY. * SOLUTION: USE LIBRARY ROUTINE LUTRU TO GET TRUE LU * FOR PURPOSES OF INDEXING THROUGH THE DRT. * CHANGE THE LU MASK FROM B77 TO B377. ******************************************************************* * R.FAJARDO, 751017 * EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B * * HPIB CONTROL REQUESTS * * CALL HPIB(LU,IFUN,IPARM) * HPIB NOP JSB SET RECOVER VALID PARMS LDA CPAR2,I HPIB1 ASL 6 IOR LU FORM CNTRL WORD STA T1 JSB EXEC DO CONTROL REQ. DEF *+4 DEF .3 REQ.CODE DEF T1 CNTRL WORD DEF CPAR3,I OPTIONAL PARM JMP RTN * SKP * * GENERAL HPIB I/O REQUESTS * * CALL CMDW/CMDR(LU,ICMND,IDATA) * CMDR NOP HERE FOR READ REQ. JSB SET GET PARMS, ETC. JMP CMDS * CMDW NOP HERE FOR WRITE REQ. JSB SET CCB,CCE,RSS * CMDS CLB,CLE STB T5 LDA T2 ALF,RAL INSURE WE HAVE UNIT=0 AND B37 SZA JMP LOSE NO, LOSE! SEZ,IN*$A INA FORM I/O REQ.CODE STA T1 LDA LU IOR BIT12 ADD Z-BIT FOR STA T2 2 BUFR REQUEST LDA CPAR3,I GET DATA BUFR LNG AND B377 CMA,INA MAKE IT -CHARS STA T3 & LDA CPAR3 STA T6 ISZ CPAR3 ADJUST BUFR ADDR LDA CPAR2,I AND B377 GET CMND BUFR LNG CMA,INA MAKE -CHARS STA T4 & ISZ CPAR2 ADJUST BUFR ADDR JSB EXEC DEF *+7 DO I/O DEF T1 I/O REQ.CODE DEF T2 CNTRL WORD DEF CPAR3,I DATA BUFR DEF T3 DATA LNG DEF CPAR2,I CMND BUFR DEF T4 CMND LNG ISZ T5 INPUT REQUEST? STB T6,I YES, POST CNT JMP RTN * SKP * * BASIC'S SRQ/TRAP SERVICE * * CALL SRQSN(LU,TRAP#) -SET TRAP @LU * SRQSN NOP JSB SET GET PARMS & VALIDATE ADB .3 INDEX TO EQT WORD4 STB T3 LDA 1,I & AND B77 EXTRACT CHANNEL STA 1 * LDA T2 =DRT ENTRY ALF,RAL AND B37 EXTRACT SUB-CHANNEL SZA,RSS SUB-CHAN=0? JMP LOSE YES, NOT AVAIL TO DIRECT I/O ALF,ALF POSITION TO HI BITS IOR 1 & MERGE WITH CHANNEL STA T1 * LDA CPAR2,I VALIDATE PARM2: CMA,SSA,INA TRAP #'S 1-16 SZA,RSS ARE LEGAL JMP LOSE ADA .16 SSA JMP LOSE OTHERS LOSE * CCB ADB SRQ.T INDEX TO ADB CPAR2,I INDICATED STB T2 TRAP # JSB IPUT POST SUB-CHAN/CHAN DEF *+3 DEF T2 DEF T1 LDA SRQ.P STA CPAR3 =SRQ PROG NAME ADDR LDB T3 JMP SRQ1 * SKP * * SRQ SERVICE-SCHEDULE PROG * * CALL SRQ(LU,16,"PROG") * SRQ NOP JSB SET RECOVER PARMS LDA CPAR2,I CP]A B20 RSS JMP HPIB1 ADB .3 SRQ1 LDA 1,I CHECK EQT4 FOR AND BIT14 BUFFERING BIT=1 SZA,RSS ?? JMP SRQ2 XOR 1,I YES, FORCE NON-BUFFERED STB T3 REQUEST FOR THIS CALL STA T4 JSB IPUT POST @ EQT4 DEF *+3 DEF T3 DEF T4 CCA FLAG IT FOR RESET LATER SRQ2 STA T2 LDA B2000 BUILD CNTRL WORD IOR LU =2000B+LU STA T1 ISZ CPAR3 &MOVE BUFR BEYOND JSB EXEC CALL DRIVER NOW DEF *+4 DEF RQ3 REQ.CODE-NO ABORT DEF T1 CNTRL WORD DEF CPAR3 PROG NAME ADDR CCB IN CASE OF ERR ISZ T2 EQT MODIFIED? JMP RTN NO, LEAVE STA T1 YES, SAVE REGS STB T2 FOR USER LDA T3,I IOR BIT14 RESTORE BUFFERING STA T4 INDICATOR JSB IPUT DEF *+3 DEF T3 DEF T4 LDB T2 SSB,RSS ERRS? JMP RTN1 NO, EXIT JMP LOSE YES, ABORT * SKP * * ERROR STATUS FUNCTION * * I=IBERR(LU) * IBERR NOP JSB SET GET PARMS & VALIDATE ADB .12 LDA 1,I FIND EQTX AREA ELA,CLE,ERA ADA .3 RETRIEVE XLOG WORD LDB 0,I SSB ERRS INDICATED? JMP IBER1 CLA NO,(A)=0 JMP RTN * IBER1 LDA T1 RECOVER ERR CODE AND B377 SZA,RSS DMA TROUBLES? INA YES, I/O ERR JMP RTN (A)=ERR CODE * * STATUS RECOVERY: I=IBSTS(LU) * IBSTS NOP JSB SET GET LU & VALIDATE LDA T1 AND B377 (A)=STATUS BYTE * RTN STA T1 RTN1 LDA .0A CLEAR OPT. PARMS STA CPAR2 STA CPAR3 LDA T1 JMP XIT,I & LEAVE * SKP * GET PARMS & VALIDATE * SET NOP LDA SET RECOVER !RETURN ADDR ADA M2 & LDA 0,I GET PARM LIST ADDR STA XIT JMP SET1 * CPAR1 DEF * CPAR2 DEF * CPAR3 DEF .0 (OPTIONAL) * XIT NOP SET1 JSB .ENTR GET PARMS DEF CPAR1 LDA CPAR1,I AND B377 EXTRACT SESSION LU STA LU SAVE SESSION LU * JSB LUTRU SET TRUE (SYSTEM) LU. DEF *+3 SYSTEM LU IS RETURNED IN A REGISTER AND DEF LU ALSO STORED. DEF LUT * CPA M1 DOES SESSION LU MAP TO SYSTEM LU? JMP LOSE NO. ERROR. * CMA,INA YES. INSURE VALID SYSTEM LU. ADA LUMAX SSA JMP LOSE WRONG! LDA DRT ADA LUT INDEX TO ADA M1 APPROPRIATE LDA 0,I DRT ENTRY USING SYSTEM LU. SZA,RSS JMP RTN (IGNORE BIT BUCKET) STA T2 & AND B77 EXTRACT EQT # ADA M1 MPY .15 FIND EQT ADDR ADA EQTA LDB 0 ADA .4 GET EQT WORD 5 LDA 0,I & STA T1 CHECK DEVICE TYPE ALF,ALF AND B77 CPA B37 HPIB? JMP SET,I OK, LEAVE, (B)=EQT ADDR * LOSE LDA .0A STA CPAR2 CLEAR OPT.PARMS STA CPAR3 JSB EXEC DEF *+5 DEF .2 DEF .1 "ILL RQ-HPIB" DEF MSGA DEF .12 JSB EXEC & QUIT! DEF *+2 DEF .6 * * * STORAGE, ETC... * SUP .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .12 DEC 12 .15 DEC 15 .16 DEC 16 M1 DEC -1 M2 DEC -2 M16 DEC -16 B20 OCT 20 B37 OCT 37 B77 OCT 77 B377 OCT 377 B2000 OCT 2000 BIT12 OCT 10000 BIT14 OCT 40000 RQ3 OCT 100003 * .0A DEF .0 * LU BSS 1 LUT BSS 1 T1 EQU HPIB T2 EQU CMDR T3 EQU CMDW T4 EQU IBERR T5 EQU IBSTS T6 EQU SET * SRQ.P DEF * ASC 3,SRQ.P * MS:GA ASC 12,ILL RQ-HPIB PROG ABORTED * SIZE EQU * END V   59310-18007 1805 S 0122 HP-IB SRQ/TRAP PROGRAM FOR BASIC             H0101 RAASMB,R,L,C HED SRQ.P-SPECIAL SRQ/TRAP SERVICE PROGRAM FOR BASIC NAM SRQ.P,17,30 59310-16005 REV 1805 780110 * EXT EXEC,RMPAR,SRQ.T,TRPNT * **************************************************** * * SRQ.P-SPECIAL SRQ/TRAP SERVICE PROGRAM * * THIS PROGRAM WHEN ACTIVATED BY DVR37 WILL * SEARCH THE SRQ/TRAP TABLE MAINTAINED WITHIN * THE DRIVER & INVOKE ANY TRAPS ARMED BY THE * BASIC USER. NOTE THIS ROUTINE IS USED IN * CONJUNCTION WITH THE SRQSN CALL IN BASIC. * * RELOC: 59310-16005 * SOURCE: 59310-18007 * **************************************************** * S JSB RMPAR RECOVER SCHEDULE PARMS DEF *+2 DEF T1 LDA T3 GET EQT ADDR ADA .3 & INDEX TO WORD4 LDA 0,I EXTRACT CHANNEL AND B77 LDB T2 GET SUB-CHANNEL BLF,BLF POSITION TO HI BITS IOR 1 STA T1 * LDA SRQ.T SET TO STA T2 SCAN LDA M16 SRQ/TRAP STA T3 TABLE S1 LDA T2,I & DO IT CPA T1 MATCH? JMP S3 YES, INVOKE TRAP S2 ISZ T2 ISZ T3 END TABLE? JMP S1 NO, CONTINUE JSB EXEC YES, QUIT DEF *+2 *NO RETURN* DEF .6 * S3 LDA T3 ENTRY FOUND, ADA .17 (A)=TRAP # JSB TRPNT GO TRAP NOP JMP S2 * * STORAGE * T1 BSS 1 T2 BSS 1 T3 BSS 1 BSS 2 .3 DEC 3 .6 DEC 6 .17 DEC 17 M16 DEC -16 B77 OCT 77 * END S H  59310-18011 1926 S 0222 &MESS HP IB MESSAGE LIBRARY             H0102 ASMB,R,Q,C HED MESS, RTE HP-IB MESSAGE SUBROUTINE LIBRARY NAM MESS,7 59310-16011 REV 1926 790424 * * ENT TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL ENT STATS,PPOLL,PSTAT,CNFG,ABRT * EXT .ENTR,EXEC,IPUT,LUTRU * *************************************************** * (C) COPYRIGHT HEWLETT-PACKARD CO., 1978 * * ALL RIGHTS RESERVED * *************************************************** * * * MESS - RTE HP-IB MESSAGE UTILITY LIBRARY * * * * RELOC: 59310-16011 * * SOURCE: 59310-18011 * * * *************************************************** * EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B * ************************************************** * * * HP-IB MESSAGE SUBROUTINES * * * * TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL,STATS, * * PPOLL,PSTAT,CNFG,ABRT * * * ************************************************** SKP ************************************************** * PCO 1926 * PROBLEM DEVELOPED WITH THE USE OF THIS * WITH DSD SESSION MONITOR. THE SUBROUTINE "SET" * USES THE LU NUMBER TO INDEX THROUGH THE DRT TABLE. * WHEN THIS MODULE IS USED WITH SESSION, THE SESSION * LU IS OF COURSE THE LU NUMBER THAT IS USED. * * SOLUTION WAS TO MAKE A CALL TO SESSION LUTRU TO GET THE * TRUE LU VALUE FOR INDEXING THROUGHT THE DRT. * * ALSO AT THIS TIME THE COMMENTS WERE CHANGED TO * REFERENCE SYSTEM AND SESSION LU RATHER THAN JUST LU. * * ALSO THE MASK VALUE FOR SESSION LU WAS CHANGED FROM B77 * TO B377 IS SUBROUTINE "SET" AND THE RANGE FROM 1-63 TO 1-255 l* IN COMMENTS AS APPROPRIATE. * ********************************************************* SKP * * ****************************************************************** * * * * TRIGGER * CALL TRIGR(LU) * * * * * * WHERE: LU = SESSION LU AUTO ADRESSING OR * * * DIRECT I/O SESSION LU IN * * * RANGE OF 1-255 * * * * ****************************************************************** TRIGR NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP TRIG1 YES(DIRECT I/O MODE) * * * TRIGR - AUTO ADDRESSING MODE * * JSB CNTL NO, FORM AUTO ADDR CTL WORD * LDA UNLSN LOAD UNL,LSN COMMANDS IOR T3 MERGE SUBCHANNEL STA CBUFR SAVE IN FIRST WORD OF CMND BUFR LDA GET LOAD GET COMMAND STA CBUFR+1 SAVE IN SECOND WORD OF CMND BUFR * LDA M3 LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR TRIGR CMNDS JMP RTN1 EXIT * * * TRIGR - DIRECT I/O MODE * * TRIG1 JSB CNTL FORM DIRECT I/O CTL WORD * LDA GET LOAD GET COMMAND STA CBUFR SAVE IN COMMAND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O TRIGR CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * E * * CLEAR * CALL CLEAR(LU,I) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-255 * * * * * I=FUNCTION CODE * * * I=1 FOR SELECTED DEVICE CLEAR * * * I=2 FOR UNIVERSAL DEVICE CLEAR * * * (DIRECT I/O ONLY) * * * * ****************************************************************** CLEAR NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * LDB CPAR2,I LOAD I PARAMETER CPB .1 I=1? JMP CLR1 YES CPB .2 NO,I=2? JMP CLR2 YES JMP LOSE INVALID I PARAMETER,EXIT WITH ERROR * CLR1 SZA,RSS I=1,SUBCHANNEL=0? JMP CLR3 YES(DIRECT I/O MODE) JMP CLR4 NO(AUTO ADDR MODE) * CLR2 SZA I=2,SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * * * CLEAR - DIRECT I/O MODE * * CLR3 JSB CNTL FORM DIRECT I/O CTL WORD * CPB .1 I=1? JMP *+3 YES LDA DCL NO,I=2,LOAD UNIV DEV CLEAR CMND JMP *+2 LDA SDC LOAD SELECTED DEVICE CLEAR CMND STA CBUFR SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O CLEAR CMND JMP RTN1 * * * CLEAR - AUTO ADDRESSING MODE * * CLR4 JSB A0CNTL FORM ATO ADDR CTL WORD * LDA T3 LOAD SUBCHANNEL IOR UNLSN MERGE UNL,LSN CMNDS WITH SUBCHANNEL STA CBUFR SAVE IN FIRST WORD OF AUTO ADDR CMND BUFR * LDA SDC LOAD SELECTED DEVICE CLEAR CMND AND STA CBUFR+1 SAVE IN SECOND WORD OF AUTO ADDR CMND BUFR * LDA M3 LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR CLEAR CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * REMOTE * CALL RMOTE(LU) * * * * * * WHERE: LU =SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-255 * * * * ****************************************************************** RMOTE NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * LDA CTL16 LOAD REN CONTROL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD * JSB CTLR1 MAKE REN ENABLE CONTROL REQUEST * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP RTN1 YES,EXIT(DIRECT I/O MODE) * * * RMOTE - AUTO ADDRESSING MODE * * JSB CNTL NO,FORM AUTO ADDR CTL WORD * LDA UNLSN LOAD UNL,LSN COMMANDS IOR T3 MERGE SUBCHANNEL AND STA CBUFR SAVE IN AUTO ADDR COMMAND BUFR * LDA M2 LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT Е GO OUTPUT AUTO ADDR REMOT CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * GO TO LOCAL * CALL GTL(LU) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-255 * * * * ****************************************************************** GTL NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP GTL1 YES(DIRECT I/O MODE) * * * GTL - AUTO ADDRESSING MODE * * JSB CNTL NO,FORM AUTO ADDR CTL WORD * LDA UNLSN LOAD UNL,LSN COMMANDS IOR T3 MERGE SUBCHANNEL STA CBUFR SAVE IN FIRST OF AUTO ADDR CMND BUFR LDA GOLOC LOAD GTL COMMAND AND STA CBUFR+1 STORE IN SECOND WORD OF AUTO ADDR CMND BUFR * LDA M3 LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR GTL CMNDS JMP RTN1 EXIT * * * GTL - DIRECT I/O MODE * * GTL1 JSB CNTL FORM DIRECT I/O CTL WORD * LDA GOLOC LOAD GTL COMMAND STA CBUFR AND SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O GTL COMMANDS JMP RTN1 EXIT * SKP ****************************************************************** * n* * * LOCAL LOCK OUT * CALL LLO(BLU) * * * * * * WHERE: BLU=DIRECT I/O SESSION LU * * * IN RANGE 1-255 * ****************************************************************** LLO NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * JSB CNTL YES,FORM DIRECT I/O CTL WORD * LDA LLOCK LOAD LLO COMMAND AND STA CBUFR AND SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD COMMAND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O LLO CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * LOCAL * CALL LOCL(BLU) * * * WHERE: BLU=DIRECT I/O SESSION LU IN RANGE* * * OF 1-255 * * * * ****************************************************************** LOCL NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * LDA CTL17 YES(DIRECT I/O),LOAD CONTROL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN DIRECT I/O CONTROL WORD * JSB CTLR1 MAKE LOCAL ENABLE CONTROL REQUEST JMP RTN1 EXIT * SKP ****************************************************************** * * * * DYNAMIC STATUS * CALL STATS(LU,I) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-255 * * I=DEVICE/BUS STATUS RETURNED * * * IN LOWER BYTE * * * * ****************************************************************** STATS NOP JSB SET RETRIEVE VALID PARAMETERS * LDA CTL6 LOAD CONTROL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD * STAT ADB .3 INCREMENT EQT ADDRESS TO WORD 4 LDA 1,I LOAD EQT WORD 4 AND BIT14 ISOLATE BUFFERING BIT 14 SZA,RSS BIT 14=0? JMP STAT1 YES(UNBUFFERED),GO MAKE STATUS REQUEST * XOR 1,I NO(BUFFERED),FORCE UNBUFFERED,SET BIT14=0 STB T3 SAVE EQT WORD 4 ADDRESS STA T4 SAVE NEW UNBUFFERED EQT WORD 4 * JSB BUFCG STORE UNBUFFERED EQT WORD 4 * CCA SET FLAG TO RESET BIT 14 LATER STA T2 AND SAVE * STAT1 JSB CTLR1 MAKE STATUS CONROL REQUEST * * (A)=STATUS WORD * AND B377 MASK LOWER STATUS BYTE STA CPAR2,I STORE STATUS BYTE IN USER BUFFER * ISZ T2 EQT MODIFIED? JMP RTN1 NO,EXIT LDA T3,I YES,LOAD EQT WORD 4 IOR BIT14 RESET BUFFER BIT 14 STA T4 AND SAVE * JSB BUFCG RESTORE BUFFERING IN EQT WORD 4 JMP RTN1 EXIT * SKP ******************m**************************************************** * * * * PPOLL * CALL PPOLL(LU,I,ASGN) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN RANGE * * * OF 1-255 * * * * * * I=FUNCTION CODE * * * I=1,PARALLEL POLL ENABLE(PPE) * * * I=2,PARALLEL POLL DISABLE(PPD) * * * I=3,PARALLEL POLL UNCONFIGURE(PPU) * * * (DIRECT I/O ONLY) * * * * * * ASGN=POSITIVE OR NEGATIVE INTEGER * * * IN THE RANGE OF 1-8 REPRESENTING * * * HPIB DIO LINE ON WHICH TO RESPOND * * * TO A PARALLEL POLL. * * * * * * POSITIVE INTEGER INDICATES A * * * ZERO RESPONSE AND A NEGATIVE * * * INTEGER INDICATES A ONE RESPONSE * * * TO A PARALLEL POLL. * * * * ********************************************************************** PPOLL NOP JSB SET RETRIEVE VALID PARAMETERS * LDA CPAR2,I LOAD FUNCTION CPA .1 I=1? JMP PPOL1 YES(PPE) CPA .2 NO,I=2? JMP PPOL2 YES(PPD) CPA .3 K NO,I=3? JMP PPOL4 YES(PPU) JMP LOSE NO,INVALID FUNCTION,EXIT WITH ERROR * PPOL1 LDA CPAR3,I I=1,LOAD ASSIGNMENT PARAMETER SZA,RSS ASSIGNMENT=0? JMP LOSE YES,INVALID ASSIGNMENT,EXIT WITH ERROR * SSA,RSS NO,IS ASSIGNMENT NEGATIVE? JMP *+2 NO,ASSIGNMENT IS POSITIVE * CMA,INA YES,CONVERT TO POSITIVE NUMBER * ADA M9 SUBTRACT NINE FROM ASSIGNMENT SSA,RSS 1<=ASGN<=8 ?? JMP LOSE NO,INVALID ASSIGNMENT,EXIT WITH ERROR * ADA .8 ADD EIGHT TO ASSIGNMENT IOR PPCE MERGE DATA LINE AND PPC,PPE CMNDS * LDB CPAR3,I LOAD ASSIGNMENT AGAIN SSB IS ASSIGNMENT POSITIVE? IOR .8 NO,SET BIT 3 IN COMMAND WORD STA CBUFR YES,SAVE FIRST COMMAND WORD JMP *+3 * PPOL2 LDA PPCD LOAD PPC,PPD COMMANDS STA CBUFR AND SAVE IN COMMAND WORD * JSB IOSTA GET I/O STATUS REQUEST * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP PPOL3 YES(DIRECT I/O MODE) * * * PPOLL - AUTO ADDRESSING MODE (PPE,PPD) * * JSB CNTL NO,FORM AUTO ADDR CTL WORD * LDA CBUFR LOAD SECOND COMMAND WORD STA CBUFR+1 AND STORE IN SECOND WORD OF CMND BUFR * LDA UNLSN LOAD UNL,LSN COMMANDS IOR T3 MERGE SUBCHANNEL STA CBUFR AND SAVE IN FIRST WORD OF CMND BUFR * LDA M4 LOAD COMMAND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR PPOLL CMNDS JMP RTN1 EXIT * * * PPOLL - DIRECT I/O MODE (PPE,PPD) * * PPOL3 JSB CNTL FORM DIRECT I/O CTL WORD * LDA M2 LOAD DIRECT I/O CMND BUFR LENGTH M STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O PPOLL CMNDS JMP RTN1 * * * PPOLL - UNCONFIGURE (DIRECT I/O ONLY) * * PPOL4 JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * JSB CNTL YES,FORM DIRECT I/O CTL WORD * LDA PPU LOAD PPU COMMAND STA CBUFR AND SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT OUTPUT DIRECT I/O PPOLL COMMANDS JMP RTN1 EXIT * SKP ********************************************************************** * * * * PARALLEL POLL STATUS * CALL PSTAT(BLU,I) * * * * * * WHERE: BLU=DIRECT I/O SESSION LU * * * IN RANGE OF 1-255 * * * * * * I=INTEGER VARIABLE IN WHICH * * * STATUS OF BUS DATA LINES * * * DIO1-DIO8 WILL BE RETURNED * * * IN THE LOWER BYTE. * * * BIT0=DIO1,BIT1=DIO2,ETC. * * * * ********************************************************************** PSTAT NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * LDA B3000 YES,LOAD PARALLEL POLL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN DIRECT I/O CONTROL WORD * JMP STAT INITIATE PARALLEL POLL STATUS REQUEST * SKP ******************************************************************* * * * * CONFIGURE * CALL CNFG(LU,I,IW) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE OF 1-255 * * * * * I=FUNCTION CODE * * * I=1,CONFIGURATION REQUEST * * * I=2,UNCONFIGURE REQUEST * * * * * * IW=DEVICE/BUS CONFIGURATION WORD * * * * ******************************************************************* CNFG NOP JSB SET RETRIEVE VALID PARAMETERS * LDA CPAR2,I LOAD FUNCTION CPA .1 I=1? JMP CNFG1 YES(CONFIGURE REQUEST) CPA .2 NO,I=2? JMP CNFG2 YES(UNCONFIGURE REQUEST) JMP LOSE NO,INVALID FUNCTION,EXIT WITH ERROR * CNFG1 LDA CTL25 LOAD CONFIGURE REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD * JSB CTLR2 MAKE CONFIGURE CONTROL REQUEST JMP RTN1 EXIT * CNFG2 LDA CTL27 LOAD UNCONFIGURE REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD * JSB CTLR1 2 MAKE UNCONFIGURE CONTROL REQUEST JMP RTN1 EXIT * SKP ******************************************************************** * * * * ABORT * CALL ABRT(BLU,I) * * * * * * WHERE: BLU=DIRECT I/O SESSION LU IN RANGE * * * OF 1-255 * * * * * * I=FUNCTION CODE * * * I=1,ISSUE IFC COMMAND ONLY * * * I=2,ISSUE IFC AND DCL COMMANDS * * * I=3,ISSUE UNT,UNL COMMANDS * * * * ******************************************************************** ABRT NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * LDA LU YES(DIRECT I/O),LOAD SESSION LU STA CTLWD AND SAVE IN DIRECT I/O CONTROL WORD * LDA CPAR2,I LOAD FUNCTION CPA .1 I=1? JMP ABRT1 YES CPA .2 NO,I=2? JMP ABRT2 YES CPA .3 NO,I=3? JMP ABRT3 YES JMP LOSE NO,INVALID FUNCTION,EXIT WITH ERROR * ABRT1 LDA .1 LOAD CTL REQ PARAMETER JMP *+2 * ABRT2 CLA STA PARM3 AND SAVE IN CTL WORD PARM BUFR * JSB EXEC MAKE ABORT CONTROL REQUEST DEF *+4 DEF .3 DEF CTLWD DEF PARM3 JMP RTN1 EXIT * ABRT3 JSB CNTL FORM DIRECT I/O CTL WORD BUFR * LDA UNTLK NLH LOAD UNT,UNL CMNDS STA CBUFR AND SAVE IN CMND BUFR * LDA M2 LOAD CMND BUFR LNGTH STA CLGTH AND SAVE * JSB OUTPT OUTPUT UNT,UNL CMNDS JMP RTN1 EXIT * 6N SKP ************************** ************************ * * * * * * * SUBROUTINES * * * * * * ************************ * ************************** * ********************************************** * * * SUBROUTINE TO EXIT UTILITY LIBRARY * * * ********************************************** RTN1 LDA .0A STA CPAR2 STA CPAR3 JMP XIT,I * ********************************************************** * * * SUBROUTINE TO RETREIVE PARAMETERS AND VALIDATE * * * ********************************************************** SET NOP LDA SET LOAD RETURN ADDRESS ADA M2 SUBTRACT TWO LDA 0,I LOAD PARAMETER LIST ADDRESS STA XIT AND SAVE JMP SET1 * * CPAR1 DEF * FIRST PARAMETER CPAR2 DEF * SECOND PARAMETER CPAR3 DEF .0 THIRD PARAMETER * * XIT NOP SET1 JSB .ENTR RETRIEVE PARAMETERS DEF CPAR1 LDA CPAR1,I LOAD FIRST PARAMETER AND B377 MASK SESSION LU STA LU AND SAVE * JSB LUTRU GET SESSION LU. DEF *+3 SYSTEM LU IS RETURNED IN A REGISTER AND DEF LU ALSO STORED FOR USE LATER. DEF LUT * CPA M1 DOES SESSION LU MAP TO SYSTEM LU? JMP LOSE NO. EXIT WITH ERROR MESSAGE. * CMA,INA YES. CONVERT TO NEGATIVE SYSTEM LU. ADA LUMAX ADD TO LAST CONFIGURED SYSTEM LU SSA VALID SYSTEM LU? JMP LOSE NO,EXIT WITH ERROR MESSAGE LDA DRT YES,LOAD DRT TABLE ENTRY ADDRESS ADA LUT INDEX TO APPROPRIATE ADA M1 DRT ENTRY LDA 0,I LOAD DRT ENTRY SZA,RSS ENTRY=0? JMP RTN1 YES,EXIT(IGNORE BIT BUCKET) ST$A T2 NO,SAVE DRT ENTRY AND B77 MASK EQT# ADA M1 INDEX TO MPY .15 APPROPRIATE ADA EQTA EQT TABLE LDB 0 LOAD EQT ADDRESS INTO B-REG ADA .4 INDEX TO EQT WORD 5 LDA 0,I LOAD EQT WORD 5 STA T1 AND SAVE ALF,ALF SHIFT AND AND B77 MASK DEVICE TYPE CPA B37 DEVICE TYPE=37? JMP SET,I YES,RETURN(B-REG=EQT ADDRESS) * ****************************************************** * * * ERROR SUBROUTINE - INDICATES BAD PARAMETER * * * ****************************************************** LOSE LDA .0A LOAD ZERO STA CPAR2 SET PARAMETERS STA CPAR3 TO ZERO * JSB EXEC DEF *+5 DEF .2 WRITE "ILL RQ-HPIB" MESSAGE DEF .1 DEF MSGA DEF .12 * JSB EXEC DEF *+2 AND QUIT DEF .6 * ************************************************ * * * SUBROUTINE FOR RETRIEVING SUBCHANNEL * * * ************************************************ SUBCH NOP LDA T3 LOAD STATUS WORD THREE AND B37 MASK SUBCHANNEL STA T3 AND SAVE JMP SUBCH,I * ************************************************ * * * SUBROUTINE FOR FORMING CONTROL WORD * * FOR DOUBLE BUFFER I/O REQUEST * * * ************************************************ CNTL NOP LDA LU LOAD SESSION LU IOR BIT12 MERGE DIRECT I/O BIT 12 STA CTLWD AND SAVE JMP CNTL,I * ************************************************ * * * SUBROUTINE FOR I/O STATUS EXEC CALL x * * * ************************************************ IOSTA NOP JSB EXEC DEF *+6 DEF .13 DEF LU DEF T1 DEF T2 DEF T3 JMP IOSTA,I * ******************************************************* * * * SUBROUTINE FOR EXEC WRITE REQUEST TO DVR37 * * * ******************************************************* OUTPT NOP JSB EXEC DEF *+7 DEF .2 DEF CTLWD DEF .0 DEF .0 DEF CBUFR DEF CLGTH JMP OUTPT,I * ************************************************************** * * * SUBROUTINE FOR CNTL REQ WITHOUT OPTIONAL PARAMETER * * * ************************************************************** CTLR1 NOP JSB EXEC DEF *+3 DEF .3 DEF CTLWD JMP CTLR1,I * *********************************************************** * * * SUBROUTINE FOR CNTL REQ WITH OPTIONAL PARAMETER * * * *********************************************************** CTLR2 NOP JSB EXEC DEF *+4 DEF .3 DEF CTLWD DEF CPAR3,I JMP CTLR2,I * ************************************************************* * * * SUBROUTINE TO CLEAR OR RESET BUFFERING BIT 14 IN * * EQT WORD FOUR * * * ************************************************************* BUFCG NOP JSB IPUT DEF *+3 DEF T3 DEF T4 JMP BUFC G,I * * SKP * ******************************** * **************************** * * * * * * * CONSTANT STORAGE,ETC. * * * * * * * **************************** * ******************************** SUP .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .8 DEC 8 .12 DEC 12 .13 DEC 13 .15 DEC 15 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M9 DEC -9 B37 OCT 37 B77 OCT 77 B377 OCT 377 B3000 OCT 3000 BIT12 OCT 10000 BIT14 OCT 40000 CTL6 OCT 600 CTL16 OCT 1600 CTL17 OCT 1700 CTL25 OCT 2500 CTL27 OCT 2700 DCL OCT 12000 GET OCT 4000 GOLOC OCT 400 LLOCK OCT 10400 PPCD OCT 2560 PPCE OCT 2540 PPU OCT 12400 SDC OCT 2000 UNLSN OCT 37440 UNTLK OCT 57477 * .0A DEF .0 * LUT BSS 1 SYSTEM LU LU BSS 1 SESSION LU CBUFR BSS 2 CLGTH BSS 1 CTLWD BSS 1 PARM3 BSS 1 * T1 NOP T2 NOP T3 BSS 1 T4 BSS 1 * MSGA ASC 12,ILL RQ-HPIB PROG ABORTED * SIZE EQU * END m  59310-18012 2026 S C0122 &IB4A1 HP-IB LIBRARY HEADER             H0101 ASMB,R,Q,C NAM IB4A,7 59310-12001 REV.2026 800407 EQTX=19+7*D * * HEADER MODULE FOR RTE4 HPIB LIBRARY * THIS MODULE'S NAME IS &IB4A1 * RELOC 59310-1X012 PHANTOM MODULE * SOURCE 59310-18012 * END   59310-18013 2026 S C0122 &IB4A2 HP-IB LIBRARY STANDARD FILE             H0101 AOASMB,Q,C HED IB4A2, RTE4 HPIB LIBRARY NAM IB4A2,7 59310-1X013 REV 2026 800407 EQTX=18+7*D * * ENT TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL ENT STATS,PPOLL,PSTAT,CNFG,ABRT ENT SECR,SECRR,SECW,SECWR ENT CMDR,CMDW ENT SRQ,IBERR,IOCNT * EXT .ENTR,EXEC,IPUT,LUTRU * *************************************************** * (C) COPYRIGHT HEWLETT-PACKARD CO., 1978 * * ALL RIGHTS RESERVED * *************************************************** * * * MESS - RTE HP-IB MESSAGE UTILITY LIBRARY * * * * RELOC: 59310-1X013 PHANTOM MODULE * * SOURCE: 59310-18013 * * * *************************************************** * EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B * ************************************************** * * * HP-IB MESSAGE SUBROUTINES * * * * TRIGR,CLEAR,RMOTE,GTL,LLO,LOCL,STATS, * * PPOLL,PSTAT,CNFG,ABRT * * * ************************************************** SKP * * * * GENERAL HPIB I/O REQUESTS * * CALL CMDW/CMDR(LU,ICMND,IDATA) * CMDR NOP HERE FOR READ REQ. JSB SET GET PARMS, ETC. JMP CMDS * CMDW NOP HERE FOR WRITE REQ. JSB SET CCB,CCE,RSS * CMDS CLB,CLE STB T5 LDA T2 ALF,RAL INSURE WE HAVE UNIT=0 AND B37 SZA JMP LOSE NO, LOSE! SEZ,INA INA FORM I/O REQ.CODE STA T1 LDA LU IOR BIT12 ADD Z-BIT FOR STA T2 2 BUFR REQUEST LDA CPAR3,I GET DATA BUFR LNG AND B377  CMA,INA MAKE IT -CHARS STA T3 & LDA CPAR3 STA T6 ISZ CPAR3 ADJUST BUFR ADDR LDA CPAR2,I AND B377 GET CMND BUFR LNG CMA,INA MAKE -CHARS STA T4 & ISZ CPAR2 ADJUST BUFR ADDR JSB EXEC DEF *+7 DO I/O DEF T1 I/O REQ.CODE DEF T2 CNTRL WORD DEF CPAR3,I DATA BUFR DEF T3 DATA LNG DEF CPAR2,I CMND BUFR DEF T4 CMND LNG ISZ T5 INPUT REQUEST? STB T6,I YES, POST CNT JMP RTN * SKP * * * SRQ SERVICE-SCHEDULE PROG * * CALL SRQ(LU,IV,"PROG") SRQ CAUSES "PROG" TO BE SCHEDULED AND * PASSED VALUE IV. * CALL SRQ(LU,IV,0) DISABLES SRQ PROGRAM SCHEDULING. * SRQ NOP JSB SET RECOVER PARMS CLA CPA CPAR3,I IS "PROG" CHARACTER COUNT IS 0? LDA B100 YES. DISABLE ALARM PROGRAM. ADA B2000 COMPLETE FORMING REQUEST CODE. ADA LU INCLUDE THE LU. STA T1 * CLA STA T2 IF DISABLE, THEN SKIP CHANGING TO CPA CPAR3,I UNBUFFERED I/O REQUEST FOR THIS JMP SRQ3 EXEC CALL. * ADB .3 SRQ1 LDA 1,I CHECK EQT4 FOR AND BIT14 BUFFERING BIT=1 SZA,RSS ?? JMP SRQ2 * XOR 1,I YES, FORCE NON-BUFFERED STB T3 REQUEST FOR THIS CALL STA T4 JSB IPUT POST @ EQT4 DEF *+3 DEF T3 DEF T4 CCA FLAG IT FOR RESET LATER * SRQ2 STA T2 SAVE FLAG FOR RESETTING BUFFERED I/O. * ISZ CPAR3 MOVE "PROG" AND IV TO BUFFER. LDA CPAR3,I STA CBUFR MOVE 1 & 2 * ISZ CPAR3 LDA CPAR3,I STA CBUFR+1 MOVE 3 & 4 * ISZ CPAR3 LDA CPAR3,I STA CBUFR+2 MOVE 5 * LDA CPAR2,I STA CBUFR+3 MOVE IV *  SRQ3 JSB EXEC CALL DRIVER NOW DEF *+4 DEF RQ3 REQ.CODE-NO ABORT DEF T1 CNTRL WORD DEF CBUFA PROG NAME BUFFER ADDRESS. CCB IN CASE OF ERR ISZ T2 EQT MODIFIED? JMP RTN NO, LEAVE DST ANB YES, SAVE REGS LDA T3,I IOR BIT14 RESTORE BUFFERING STA T4 INDICATOR JSB IPUT DEF *+3 DEF T3 DEF T4 LDB T2 SSB,RSS ERRS? JMP RTN1 NO, EXIT JMP LOSE YES, ABORT * SKP * * ******************************************************************** * * I = IOCNT (LU) * ******************************************************************** IOCNT NOP JSB SET JSB GBQT SSA ERROR? CLA YES. RETURN ZERO FOR COUNT. JMP RTN * ******************************************************************* * * ERROR STATUS FUNCTION * I = IBERR (LU) * ******************************************************************* IBERR NOP JSB SET GET PARMS & VALIDATE JSB GBQT SSA,RSS ERROR? CLA NO. RETURN ZERO FOR NO ERRORS. AND B377 YES. EXTRACT ERROR BITS. JMP RTN * SKP * * ****************************************************************** * * * * TRIGGER * CALL TRIGR(LU) * * * * * * WHERE: LU = SESSION LU AUTO ADRESSING OR * * * DIRECT I/O SESSION LU IN * * * RANGE OF 1-63. * * * * * * TRIGR (BUSLU) GET * * * TRIGR (DEVLU) UNT,UNL,DEVLSN,GET * ********e********************************************************** TRIGR NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP TRIG1 YES(DIRECT I/O MODE) * * * TRIGR - AUTO ADDRESSING MODE * * JSB CNTL NO, FORM AUTO ADDR CTL WORD * LDA UNTLK LOAD UNT,UNL COMMANDS STA CBUFR SAVE IN FIRST WORD OF CMND BUFR * LDA T3 LOAD SUBCHANNEL ALF,ALF POSITION TO UPPER BYTE. IOR LSGET COMBINE WITH LSN,GET STA CBUFR+1 SAVE IN SECOND WORD OF CMND BUFR * LDA M4 LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR TRIGR CMNDS JMP RTN1 EXIT * * * TRIGR - DIRECT I/O MODE * * TRIG1 JSB CNTL FORM DIRECT I/O CTL WORD * LDA GET LOAD GET COMMAND STA CBUFR SAVE IN COMMAND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O TRIGR CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * CLEAR * CALL CLEAR(LU,I) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-63. * * * * * I=FUNCTION CODE * * * I=1 FOR SELECTED DEVICE CLEAR * * * I=2 FOR UNIVERSAL DEVICE CLEAR * * C * (DIRECT I/O ONLY) * * * * * * CLEAR (DEVLU,1) UNT,UNL,DEVLSN,SDC * * * CLEAR (BUSLU,1) SDC * * * CLEAR (BUSLU,2) DCL * ****************************************************************** CLEAR NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * LDB CPAR2,I LOAD I PARAMETER CPB .1 I=1? JMP CLR1 YES CPB .2 NO,I=2? JMP CLR2 YES JMP LOSE INVALID I PARAMETER,EXIT WITH ERROR * CLR1 SZA,RSS I=1,SUBCHANNEL=0? JMP CLR3 YES(DIRECT I/O MODE) JMP CLR4 NO(AUTO ADDR MODE) * CLR2 SZA I=2,SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * * * CLEAR - DIRECT I/O MODE * * CLR3 JSB CNTL FORM DIRECT I/O CTL WORD * CPB .1 I=1? JMP *+3 YES LDA DCL NO,I=2,LOAD UNIV DEV CLEAR CMND JMP *+2 LDA SDC LOAD SELECTED DEVICE CLEAR CMND STA CBUFR SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O CLEAR CMND JMP RTN1 * * * CLEAR - AUTO ADDRESSING MODE * * CLR4 JSB CNTL FORM ATO ADDR CTL WORD * LDA UNTLK LOAD UNT,UNL STA CBUFR SAVE IN FIRST WORD OF AUTO ADDR CMND BUFR * LDA T3 FETCH SUBCHANNEL ALF,ALF POSITION SUBCHANNEL TO UPPER BYTE. IOR LSSDC COMBINE SUBCHANNEL WITH LSN,SDC STA CBUFR+1 SAVE IN SECOND WORD OF AUTO ADDR CMND BUFR * LDA M4 l LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR CLEAR CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * REMOTE * CALL RMOTE(LU) * * * * * * WHERE: LU =SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-63. * * * * * * RMOTE (BUSLU) REN * * * RMOTE (DEVLU) REN;UNT,UNL,DEVLSN * ****************************************************************** RMOTE NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * LDA CTL16 LOAD REN CONTROL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD. * JSB CTLR1 MAKE REN ENABLE CONTROL REQUEST * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP RTN1 YES,EXIT(DIRECT I/O MODE) * * * RMOTE - AUTO ADDRESSING MODE * * JSB CNTL NO,FORM AUTO ADDR CTL WORD * LDA UNTLK LOAD UNT,UNL COMMANDS STA CBUFR SAVE IN AUTO ADDR COMMAND BUFR * LDA T3 FETCH SUBCHANNEL IOR NULSN FORM DEVLSN COMMAND. ALF,ALF POSITION TO UPPER BYTE. STA CBUFR+1 SAVE AS LAST BYTE IN COMMAND BUFFER. * LDA M3 LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR REMOT CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * GO TO LOCAL * CALL GTL(LU) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-63. * * * * * * GTL (DEVLU) UNT,UNL,DEVLSN,GTL * * * GTL (BUSLU) GTL * ****************************************************************** GTL NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP GTL1 YES(DIRECT I/O MODE) * * * GTL - AUTO ADDRESSING MODE * * JSB CNTL NO,FORM AUTO ADDR CTL WORD * LDA UNTLK LOAD UNT,UNL COMMANDS STA CBUFR SAVE IN FIRST OF AUTO ADDR CMND BUFR * LDA T3 FETCH SUBCHANNEL ALF,ALF POSITION TO UPPER BYTE. IOR LSGTL COMBINE WITH LSN,GTL STA CBUFR+1 STORE IN SECOND WORD OF AUTO ADDR CMND BUFR * LDA M4 LOAD AUTO ADDR CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR GTL CMNDS JMP RTN1 EXIT * * * GTL - DIRECT I/O MODE * * GTL1 JSB CNTL FORM DIRECT I/O CTL WORD * LDA GOLOC LOAD GTL COMMAND STA CBUFR AND SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O GTL COMMANDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * LOCAL LOCK OUT * CALL LLO(BLU) * * * * * * WHERE: BLU=DIRECT I/O SESSION LU * * * IN RANGE 1-63. * ****************************************************************** LLO NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * JSB CNTL YES,FORM DIRECT I/O CTL WORD * LDA LLOCK LOAD LLO COMMAND AND STA CBUFR AND SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD COMMAND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O LLO CMNDS JMP RTN1 EXIT * SKP ****************************************************************** * * * * LOCAL * CALL LOCL(BLU) * * * WHERE: BLU=DIRECT I/O SESSION LU IN RANGE* * * OF 1-63. * * * * ****************************************************************** LOCL NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * LDA CTL17 YES(DIRECT I/O),LOAD CONTROL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN DIRECT I/O CONTROL WORD *  JSB CTLR1 MAKE LOCAL ENABLE CONTROL REQUEST JMP RTN1 EXIT * SKP ****************************************************************** * * * * DYNAMIC STATUS * CALL STATS(LU,I) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE 1-63. * * I=DEVICE/BUS STATUS RETURNED * * * IN LOWER BYTE * * * * ****************************************************************** STATS NOP JSB SET RETRIEVE VALID PARAMETERS * LDA CTL6 LOAD CONTROL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD * STAT ADB .3 INCREMENT EQT ADDRESS TO WORD 4 LDA 1,I LOAD EQT WORD 4 AND BIT14 ISOLATE BUFFERING BIT 14 SZA,RSS BIT 14=0? JMP STAT1 YES(UNBUFFERED),GO MAKE STATUS REQUEST * XOR 1,I NO(BUFFERED),FORCE UNBUFFERED,SET BIT14=0 STB T3 SAVE EQT WORD 4 ADDRESS STA T4 SAVE NEW UNBUFFERED EQT WORD 4 * JSB BUFCG STORE UNBUFFERED EQT WORD 4 * CCA SET FLAG TO RESET BIT 14 LATER STA T2 AND SAVE * STAT1 JSB CTLR1 MAKE STATUS CONROL REQUEST * * (A)=STATUS WORD * AND B377 MASK LOWER STATUS BYTE STA CPAR2,I STORE STATUS BYTE IN USER BUFFER * ISZ T2 EQT MODIFIED? JMP RTN1 NO,EXIT LDA T3,I YES,LOAD EQT WORD 4 IOR BIT14 RESET BUFFER BIT 14 STA T4 AND SAVE *  JSB BUFCG RESTORE BUFFERING IN EQT WORD 4 JMP RTN1 EXIT * SKP ********************************************************************** * * * * PPOLL * CALL PPOLL(LU,I,ASGN) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN RANGE * * * OF 1-63. * * * * * * I=FUNCTION CODE * * * I=1,PARALLEL POLL ENABLE(PPE) * * * I=2,PARALLEL POLL DISABLE(PPD) * * * I=3,PARALLEL POLL UNCONFIGURE(PPU) * * * (DIRECT I/O ONLY) * * * * * * ASGN=POSITIVE OR NEGATIVE INTEGER * * * IN THE RANGE OF 1-8 REPRESENTING * * * HPIB DIO LINE ON WHICH TO RESPOND * * * TO A PARALLEL POLL. * * * * * * POSITIVE INTEGER INDICATES A * * * ZERO RESPONSE AND A NEGATIVE * * * INTEGER INDICATES A ONE RESPONSE * * * TO A PARALLEL POLL. * * * * * * PPOLL(DEVLU,1,A) UNT,UNL,LSN,PPC,PPE * * * PPOLL(BUSLU,1,A) PPC,PPE * * * PPOLL(DEVLU,2,A) UNT,UNL,LSN,PPC,PPD  * * * PPOLL(BUSLU,2,A) PPC,PPD * ********************************************************************** PPOLL NOP JSB SET RETRIEVE VALID PARAMETERS * LDA CPAR2,I LOAD FUNCTION CPA .1 I=1? JMP PPOL1 YES(PPE) CPA .2 NO,I=2? JMP PPOL2 YES(PPD) CPA .3 NO,I=3? JMP PPOL4 YES(PPU) JMP LOSE NO,INVALID FUNCTION,EXIT WITH ERROR * PPOL1 LDA CPAR3,I I=1,LOAD ASSIGNMENT PARAMETER SZA,RSS ASSIGNMENT=0? JMP LOSE YES,INVALID ASSIGNMENT,EXIT WITH ERROR * SSA,RSS NO,IS ASSIGNMENT NEGATIVE? JMP *+2 NO,ASSIGNMENT IS POSITIVE * CMA,INA YES,CONVERT TO POSITIVE NUMBER * ADA M9 SUBTRACT NINE FROM ASSIGNMENT SSA,RSS 1<=ASGN<=8 ?? JMP LOSE NO,INVALID ASSIGNMENT,EXIT WITH ERROR * ADA .8 ADD EIGHT TO ASSIGNMENT IOR PPCE MERGE DATA LINE AND PPC,PPE CMNDS * LDB CPAR3,I LOAD ASSIGNMENT AGAIN SSB IS ASSIGNMENT POSITIVE? IOR .8 NO,SET BIT 3 IN COMMAND WORD STA CBUFR YES,SAVE FIRST COMMAND WORD JMP *+3 * PPOL2 LDA PPCD LOAD PPC,PPD COMMANDS STA CBUFR AND SAVE IN COMMAND WORD * JSB IOSTA GET I/O STATUS REQUEST * JSB SUBCH GET SUBCHANNEL * SZA,RSS SUBCHANNEL=0? JMP PPOL3 YES(DIRECT I/O MODE) * * * PPOLL - AUTO ADDRESSING MODE (PPE,PPD) * * JSB CNTL NO,FORM AUTO ADDR CTL WORD * LDA CBUFR LOAD SECOND COMMAND WORD AND B377 MASK TO GET PPE OR PPD ALF,ALF POSITION TO UPPER BYTE. STA CBUFR+2 SAVE AS LAST BYTE. * LDA CBUFR AND H8  MASK TO GET CONFIGURED PPE. IOR T3 COMBINE WITH SUBCHANNEL. IOR NULSN COMBINE WITH NUL,LSN ALF,ALF POSITION BYTES (LSN FIRST) STA CBUFR+1 AND STORE IN SECOND WORD OF CMND BUFR * LDA UNTLK LOAD UNT,UNL COMMANDS STA CBUFR AND SAVE IN FIRST WORD OF CMND BUFR * LDA M5 LOAD COMMAND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT AUTO ADDR PPOLL CMNDS JMP RTN1 EXIT * * * PPOLL - DIRECT I/O MODE (PPE,PPD) * * PPOL3 JSB CNTL FORM DIRECT I/O CTL WORD * LDA M2 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT GO OUTPUT DIRECT I/O PPOLL CMNDS JMP RTN1 * * * PPOLL - UNCONFIGURE (DIRECT I/O ONLY) * * PPOL4 JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * JSB CNTL YES,FORM DIRECT I/O CTL WORD * LDA PPU LOAD PPU COMMAND STA CBUFR AND SAVE IN DIRECT I/O CMND BUFR * LDA M1 LOAD DIRECT I/O CMND BUFR LENGTH STA CLGTH AND SAVE * JSB OUTPT OUTPUT DIRECT I/O PPOLL COMMANDS JMP RTN1 EXIT * SKP ********************************************************************** * * * * PARALLEL POLL STATUS * CALL PSTAT(BLU,I) * * * * * * WHERE: BLU=DIRECT I/O SESSION LU * * * IN RANGE OF 1-63. * * * * * - * I=INTEGER VARIABLE IN WHICH * * * STATUS OF BUS DATA LINES * * * DIO1-DIO8 WILL BE RETURNED * * * IN THE LOWER BYTE. * * * BIT0=DIO1,BIT1=DIO2,ETC. * * * * ********************************************************************** PSTAT NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * LDA B3000 YES,LOAD PARALLEL POLL REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN DIRECT I/O CONTROL WORD * JMP STAT INITIATE PARALLEL POLL STATUS REQUEST * SKP ******************************************************************* * * * * CONFIGURE * CALL CNFG(LU,I,IW) * * * * * * WHERE: LU = SESSION LU AUTO ADDRESSING * * * OR DIRECT I/O SESSION LU IN * * * RANGE OF 1-63. * * * * * I=FUNCTION CODE * * * I=1,CONFIGURATION REQUEST * * * I=2,UNCONFIGURE REQUEST * * * * * * IW=DEVICE/BUS CONFIGURATION WORD * * * * ******************************************************************* CNeFG NOP JSB SET RETRIEVE VALID PARAMETERS * LDA CPAR2,I LOAD FUNCTION CPA .1 I=1? JMP CNFG1 YES(CONFIGURE REQUEST) CPA .2 NO,I=2? JMP CNFG2 YES(UNCONFIGURE REQUEST) JMP LOSE NO,INVALID FUNCTION,EXIT WITH ERROR * CNFG1 LDA CTL25 LOAD CONFIGURE REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD * LDA CPAR3,I PUT CONFIGURATION WORD IN CONTROL STA CBUFR BUFFER. * JSB CTLR2 MAKE CONFIGURE CONTROL REQUEST JMP RTN1 EXIT * CNFG2 LDA CTL27 LOAD UNCONFIGURE REQUEST CODE IOR LU MERGE SESSION LU STA CTLWD AND SAVE IN CONTROL WORD * JSB CTLR1 MAKE UNCONFIGURE CONTROL REQUEST JMP RTN1 EXIT * SKP ******************************************************************** * * * * ABORT * CALL ABRT(BLU,I) * * * * * * WHERE: BLU=DIRECT I/O SESSION LU IN RANGE * * * OF 1-63. * * * * * * I=FUNCTION CODE * * * I=1,ISSUE IFC COMMAND ONLY * * * I=2,ISSUE IFC AND DCL COMMANDS * * * I=3,ISSUE UNT,UNL COMMANDS * * * * ******************************************************************** ABRT NOP JSB SET RETRIEVE VALID PARAMETERS * JSB IOSTA GET I/O STATUS * JSB SUBCH GET SUBCHANNEL * SZA SUBCHANNEL=0? JMP LOSE NO,INVALID SESSION LU,EXIT WITH ERROR * LDA LU YES(DIRECT I/O),LOAD SESSION LU STA CTLWD AND SAVE IN DIRECT I/O CONTROL WORD * LDA CPAR2,I LOAD FUNCTION CPA .1 I=1? JMP ABRT1 YES CPA .2 NO,I=2? JMP ABRT2 YES CPA .3 NO,I=3? JMP ABRT3 YES JMP LOSE NO,INVALID FUNCTION,EXIT WITH ERROR * ABRT1 LDA .1 LOAD CTL REQ PARAMETER JMP *+2 * ABRT2 CLA STA CBUFR AND SAVE IN CONTROL BUFFER. * JSB CTLR2 MAKE ABORT CONTROL REQUEST * JMP RTN1 EXIT * ABRT3 JSB CNTL FORM DIRECT I/O CTL WORD BUFR * LDA UNTLK LOAD UNT,UNL CMNDS STA CBUFR AND SAVE IN CMND BUFR * LDA M2 LOAD CMND BUFR LNGTH STA CLGTH AND SAVE * JSB OUTPT OUTPUT UNT,UNL CMNDS JMP RTN1 EXIT * SKP ******************************************************************** * * * * READ AND WRITE WITH * CALL SECR (LU,ISEC,IBUF,ILNG) * * SECONDARY ADRRESSING* CALL SECW (LU,ISEC,IBUF,ILNG) * * * WHERE: * * * LU = BLU OR DLU * * * ISEC = SECONDARY ADDRESS 0-31 * * * IBUF = DATA BUFFER * * * ILNG = LENGTH OF BUFFER IN * * * WORDS IF >0 OR BYTES IF <0. * ******************************************************************** * SECWR EQU * ENTRY POINT FOR BASIC REAL READ. SECW NOP ENTRY POINT FOR BASIC INTEGER WRITE. JSB SET ALSO ENTRY POINT FOR FORTRAN. LDB .2 SET FOR WRITE. JMP SCS * * VSECRR EQU * ENTRY POINT FOR BASIC REAL READ. SECR NOP ENTRY POINT FOR BASIC INTEGER READ. JSB SET ALSO ENTRY POINT FOR FORTRAN. LDB .1 SET FOR READ. * SCS STB ICODE SET CODE FOR READ OR WRITE. * LDA CPAR3 FETCH DATA BUFFER ADDRESS. STA DBUFR SET ADDRESS FOR I/O CALL. * LDA CPAR4,I FETCH DATA BUFFER LENGTH. STA DLGTH SET VALUE FOR I/O CALL. * * * LDA CPAR2,I FETCH SECONDARY ADDRESS. AND B37 LIMIT TO 0 TO 31 CPA CPAR2,I JMP *+2 JMP LOSE ERROR EXIT WHEN OUTSIDE OF LIMITS. * IOR SEC SET UPPER BITS FOR SEC. ADDRS. * STA CBUFR STORE SEC AS 1ST OPT PARA. SCIO JSB CNDIO DO SECONDARY I/O REQUEST. * JMP RTN1 EXIT SKP SKP ************************** ************************ * * * * * * * SUBROUTINES * * * * * * ************************ * ************************** * ********************************************** * * * SUBROUTINE TO EXIT UTILITY LIBRARY * * * ********************************************** RTN DST ANB SAVE REGS RTN1 LDA .0A STA CPAR2 STA CPAR3 STA CPAR4 DLD ANB RESTORE REG.S JMP XIT,I * ********************************************************** * * * SUBROUTINE TO RETREIVE PARAMETERS AND VALIDATE * * * ********************************************************** SET NOP LDA SET LOAD RETURN ADDRESS ADA M2 SUBTRACT TWO LDA 0,I LOAD PARAMETER LIST ADDRESS STA XIT AND SAVE JMP SET1 * * CPAR1 DEF * FIRST PARAMETER CPAR2 DEF * SECOND PARAMETER CPAR3 DEF .0 THIRD PARAMETER CPAR4 DEF .0 FOURTH PARAMETER * * XIT NOP SET1 JSB .ENTR RETRIEVE PARAMETERS DEF CPAR1 LDA CPAR1,I LOAD FIRST PARAMETER AND B77 MASK SESSION LU STA LU AND SAVE * JSB LUTRU GET SESSION LU. DEF *+3 SYSTEM LU IS RETURNED IN A REGISTER AND DEF LU ALSO STORED FOR USE LATER. DEF LUT * CPA M1 DOES SESSION LU MAP TO SYSTEM LU? JMP LOSE NO. EXIT WITH ERROR MESSAGE. * CMA,INA YES. CONVERT TO NEGATIVE SYSTEM LU. ADA LUMAX ADD TO LAST CONFIGURED SYSTEM LU SSA VALID SYSTEM LU? JMP LOSE NO,EXIT WITH ERROR MESSAGE LDA DRT YES,LOAD DRT TABLE ENTRY ADDRESS ADA LUT INDEX TO APPROPRIATE ADA M1 DRT ENTRY LDA 0,I LOAD DRT ENTRY SZA,RSS ENTRY=0? JMP RTN1 YES,EXIT(IGNORE BIT BUCKET) STA T2 NO,SAVE DRT ENTRY AND B77 MASK EQT# ADA M1 INDEX TO MPY .15 APPROPRIATE ADA EQTA EQT TABLE LDB 0 LOAD EQT ADDRESS INTO B-REG ADA .4 INDEX TO EQT WORD 5 LDA 0,I LOAD EQT WORD 5 STA T1 AND SAVE ALF,ALF SHIFT AND AND B77 MASK DEVICE TYPE CPA B37 DEVICE TYPE=37? JMP SET,I YES,RETURN(B-REG=EQT ADDRESS) * ****************************************************** * * * ERROR SUBROUTINE - INDICATES BAD PARAMETER * * * ****************************************************** LOSE LDA .0A LOAD ZERO STA CPAR2 SET PARAMETERS STA CPAR3 TO ZERO * JSB EXEC DEF *+5 DEF .2 WRITE "ILL RQ-HPIB" MESSAGE DEF .1 DEF MSGA DEF .12 * JSB EXEC DEF *+2 AND QUIT DEF .6 * ************************************************ * * * SUBROUTINE FOR RETRIEVING SUBCHANNEL * * * ************************************************ SUBCH NOP LDA T3 LOAD STATUS WORD THREE AND B37 MASK SUBCHANNEL STA T3 AND SAVE JMP SUBCH,I * ************************************************ * * * SUBROUTINE FOR FORMING CONTROL WORD * * FOR DOUBLE BUFFER I/O REQUEST * * * ************************************************ CNTL NOP LDA LU LOAD SESSION LU IOR BIT12 MERGE DIRECT I/O BIT 12 STA CTLWD AND SAVE JMP CNTL,I * ************************************************ * * * SUBROUTINE FOR I/O STATUS EXEC CALL * * * ************************************************ IOSTA NOP JSB EXEC DEF *+6 DEF .13 DEF LU DEF T1 DEF T2 DEF T3 JMP IOSTA,I * ******************************************************* * * * SUBROUTINE FOR EXEC WRITE REQUEST TO DVR37 * * WITH COMMAND BUFFER ONLY. * * * ******************************************************* OUTPT NOP JSB EXEC DEF *+7 DEF .2 DEF CTLWD DEF .0 DEF .0 DEF CBUFR DEF CLGTH DST ANB JMP OUTPT,I * ******************************************************************** * * * SUBROUTINE FOR EXEC READ OR WRITE * * WITH DATA BUFFER ONLY. Ĺ * * * ******************************************************************** CNDIO NOP LDA LU SET LU IN CONTROL WORD. IOR B100 SET BIT FOR BINARY WITH EOR. STA CTLWD JSB EXEC SEND COMMAND AND DATA. DEF *+7 DEF ICODE 1=READ, 2=WRITE. DEF CTLWD CONTROL WORD. BIT 12 AND LU. DEF DBUFR,I DATA BUFFER. DEF DLGTH LENGTH OF DATA BUFFER. DEF CBUFR FIRST OPTIONAL PARAMETER. DEF CLGTH SECOND OPTIONAL PARAMETER. * DST ANB SAVE THE A AND B REGISTERS. * JMP CNDIO,I ************************************************************** * * * SUBROUTINE FOR CNTL REQ WITHOUT OPTIONAL PARAMETER * * * ************************************************************** CTLR1 NOP JSB EXEC DEF *+3 DEF .3 DEF CTLWD DST ANB JMP CTLR1,I * *********************************************************** * * * SUBROUTINE FOR CNTL REQ WITH OPTIONAL PARAMETER * * * *********************************************************** CTLR2 NOP JSB EXEC DEF *+4 DEF .3 DEF CTLWD DEF CBUFR CONTROL BUFFER WITH OPTIONAL PARAMETER. DST ANB JMP CTLR2,I * ************************************************************* * * * SUBROUTINE TO CLEAR OR RESET BUFFERING BIT 14 IN * * EQT WORD FOUR * * * ************************************************************* BUFCG NOP JSB IPUT Dx9EF *+3 DEF T3 DEF T4 JMP BUFCG,I * ******************************************************************* * * UTILITY SUBROUTINE TO GET XLOG FROM BEQT * * JSB GBQT WITH B REGISTER = ADDRESS OF FIRST EQT WORD. * * BEQT7 IS RETURNED IN A REGISTER. * ******************************************************************* * GBQT NOP GET THE XLOG ADB .12 LDA 1,I FIND EQTX AREA ELA,CLE,ERA ADA LFEQX FORM ADDR OF 1ST WORD PAST FXD EQTX. STA T4 SAVE ADDRESS. * ADB M1 LDA 1,I ALF,ALF AND B37 GET NUMBER OF ACTIVE DEVICES. * SZA,RSS TEST FOR NO CONFIGURED DEVICES. JMP GBQTE ERROR EXIT IF NO CONF. DEVICES. * CMA,INA FORM NEGATIVE FOR DOWN COUNTER. STA T5 SAVE THE COUNT. * LDA T2 RETRIEVE THE DRT ENTRY. ALF,RAL AND B37 EXTRACT THE SUBCHANNEL NUMBER. STA T3 SAVE THE SUBCHANNEL NUMBER. * SZA SUBCHANNEL = 0? JMP GBQTA NO. * LDB T4 YES. GET 1ST ADDR PAST FXD EQTX. ADB M1 BACK INTO ADDR OF BUS XLOG. * LDA 1,I GET THE BUSS XLOG. * JMP GBQT,I RETURN TO CALLONG ROUTINE. * GBQTA LDB T4 * GBQTB ISZ T5 END OF CONFIGURED DEVICES? JMP GBQTC NO. * JMP GBQTE YES. ERROR EXIT. * GBQTC LDA 1,I GET BEQT1 AND B37 EXTRACT SUBCNANNEL. CPA T3 DESIRED SUBCHANNEL? JMP GBQTD YES. GO GET STATUS AND EXIT. * ADB .7 NO. GOTO NEXT DEVICE. JMP GBQTB * GBQTD ADB .6 LDA 1,I FETCH BEQT7 * JMP GBQT,I RETURN TO CALLING ROUTINE. * GBQTE LDA B1X6 FETCH CONFIGURATION ERROR CODE. JMP GBQT,I * * * SKP * ******************************** * **************************** * * * * * * * CONSTANT STORAGE,ETC. *J~|x * * * * * * **************************** * ******************************** SUP .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .7 DEC 7 .8 DEC 8 .12 DEC 12 .13 DEC 13 .15 DEC 15 LFEQX DEC 18 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M5 DEC -5 M6 DEC -6 M9 DEC -9 B37 OCT 37 B77 OCT 77 B100 OCT 100 B2000 OCT 2000 B377 OCT 377 B3000 OCT 3000 BIT12 OCT 10000 BIT14 OCT 40000 B1X6 OCT 100006 CONFIGURATION ERROR CODE. H8 OCT 177400 MASK FOR HIGH 8 BITS. RQ3 OCT 100003 CTL6 OCT 600 CTL16 OCT 1600 CTL17 OCT 1700 CTL25 OCT 2500 CTL27 OCT 2700 NULSN OCT 40 DCL OCT 12000 GET OCT 4000 GOLOC OCT 400 LLOCK OCT 10400 PPCD OCT 2560 PPCE OCT 2540 PPU OCT 12400 SDC OCT 2000 LSGTL OCT 20001 LSN,GTL LSSDC OCT 20004 LSN,SDC LSGET OCT 20010 LSN,GET UNLSN OCT 37440 UNL,LSN TKLSN OCT 40040 TLK,LSN UNTLK OCT 57477 UNT,UNL SEUNL OCT 60077 SEC,UNL SEUNT OCT 60137 SEC,UNT SEC OCT 140 SEC * .0A DEF .0 * LUT BSS 1 SYSTEM LU LU BSS 1 SESSION LU ANB BSS 2 SAVE OF A AND B REGISTER. ICODE BSS 1 REQUEST CODE. 1=READ, 2=WRITE, 3=CNTRL CTLWD BSS 1 CONTROL WORD. CONTROL BITS & LU. DBUFR BSS 1 DATA BUFFER ADDRESS. DLGTH BSS 1 DATA BUFFER LENGTH. CBUFA DEF *+1 ADDRESS OF CONTROL BUFFER. CBUFR BSS 4 CONTROL BUFFER. CLGTH BSS 1 CONTROL BUFFER LENGTH. * T1 NOP T2 NOP T3 BSS 1 T4 BSS 1 T5 BSS 1 T6 BSS 1 * MSGA ASC 12,ILL RQ-HPIB PROG ABORTED * SIZE EQU * END q~  59310-18014 2026 S C0122 &IB4A3 HP-IB LIBRARY SSGA FUNCTION             H0101 SbASMB,R,Q,C HED IB4A3, RTE4 HPIB UTILITIES ACCESSING SSGA ENT'S. NAM IB4A3,7 59310-1X014 REV 2026 800407 * * RELOC 59310-1X014 PHANTOM MODULE. * SOURCE 59310-18014 * ENT SRQSN EXT .ENTR,EXEC,SRQ.T,IPUT,LUTRU * EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B * ********************************************************************* * BASIC'S SRQ/TRAP SERVICE * * CALL SRQSN(LU,TRAP#) -SET TRAP @LU * ********************************************************************** SRQSN NOP JSB SET GET PARMS & VALIDATE ADB .3 INDEX TO EQT WORD4 STB T3 LDA 1,I & AND B77 EXTRACT CHANNEL STA 1 * LDA T2 =DRT ENTRY ALF,RAL AND B37 EXTRACT SUB-CHANNEL SZA,RSS SUB-CHAN=0? JMP LOSE YES, NOT AVAIL TO DIRECT I/O ALF,ALF POSITION TO HI BITS IOR 1 & MERGE WITH CHANNEL STA T1 * LDA CPAR2,I VALIDATE PARM2: CMA,SSA,INA TRAP #'S 1-16 SZA,RSS ARE LEGAL JMP LOSE ADA .16 SSA JMP LOSE OTHERS LOSE * CCB ADB SRQ.T INDEX TO ADB CPAR2,I INDICATED STB T2 TRAP # JSB IPUT POST SUB-CHAN/CHAN DEF *+3 DEF T2 DEF T1 LDA SRQ.P STA CPAR3 =SRQ PROG NAME ADDR * LDA CPAR2,I STA TRP# USE TRAP NUMBER AS PASSED VALUE. LDB T3 JMP SRQ1 * SRQ1 LDA 1,I CHECK EQT4 FOR AND BIT14 BUFFERING BIT=1 SZA,RSS ?? JMP SRQ2 * XOR 1,I YES, FORCE NON-BUFFERED STB T3 REQUEST FOR THIS CALL STA T4 JSB IPUT POST @ EQT4 DEF *+3 DEF T3 DEF T4 CCA FLAG IT FOR RESET LATER * SRQ2 STA T2 SAVE FLAG FOR RESETTING BUFFERED I/O. * ISZ CPAR3 MOVE "PROG" AND IV TO BUFFER.  LDA CPAR3,I STA CBUFR MOVE 1 & 2 * ISZ CPAR3 LDA CPAR3,I STA CBUFR+1 MOVE 3 & 4 * ISZ CPAR3 LDA CPAR3,I STA CBUFR+2 MOVE 5 * LDA CPAR2,I STA CBUFR+3 MOVE IV * SRQ3 JSB EXEC CALL DRIVER NOW DEF *+4 DEF RQ3 REQ.CODE-NO ABORT DEF LU CNTRL WORD DEF CBUFA PROG NAME BUFFER ADDRESS. CCB IN CASE OF ERR ISZ T2 EQT MODIFIED? JMP RTN NO, LEAVE DST ANB YES, SAVE REGS LDA T3,I IOR BIT14 RESTORE BUFFERING STA T4 INDICATOR JSB IPUT DEF *+3 DEF T3 DEF T4 LDB T2 SSB,RSS ERRS? JMP RTN1 NO, EXIT JMP LOSE YES, ABORT * SKP **************************************************************** **************************************************************** * * SUBROUTINES * **************************************************************** **************************************************************** * ********************************************* * * SUBROUNTINE TO EXIT UTILITY LIBRARY * ********************************************* RTN DST ANB RTN1 LDA .0A STA CPAR2 STA CPAR3 DLD ANB JMP XIT,I * ************************************************************** * * SUBROUTNINE TO RETRIEVE PARAMETERS AND VALIDATE * ************************************************************** SET NOP LDA SET RECOVER RETURN ADDR ADA M2 & LDA 0,I GET PARM LIST ADDR STA XIT JMP SET1 * CPAR1 DEF * CPAR2 DEF * CPAR3 DEF .0 (OPTIONAL) * XIT NOP SET1 JSB .ENTR GET PARMS DEF CPAR1 LDA CPAR1,I IOR B2000 SET SRQ SETUP BIT IN CONTROL WORD. STA LU CONTROL WORD. * JSB LUTRU SET TRUE (SYSTEM) LU.  DEF *+3 SYSTEM LU IS RETURNED IN A REGISTER AND DEF CPAR1,I ALSO STORED. DEF LUT * CPA M1 DOES SESSION LU MAP TO SYSTEM LU? JMP LOSE NO. ERROR. * CMA,INA YES. INSURE VALID SYSTEM LU. ADA LUMAX SSA JMP LOSE WRONG! LDA DRT ADA LUT INDEX TO ADA M1 APPROPRIATE LDA 0,I DRT ENTRY USING SYSTEM LU. SZA,RSS JMP RTN (IGNORE BIT BUCKET) STA T2 & AND B77 EXTRACT EQT # ADA M1 MPY .15 FIND EQT ADDR ADA EQTA LDB 0 ADA .4 GET EQT WORD 5 LDA 0,I & STA T1 CHECK DEVICE TYPE ALF,ALF AND B77 CPA B37 HPIB? JMP SET,I OK, LEAVE, (B)=EQT ADDR * LOSE LDA .0A STA CPAR2 CLEAR OPT.PARMS STA CPAR3 JSB EXEC DEF *+5 DEF .2 DEF .1 "ILL RQ-HPIB" DEF MSGA DEF .12 JSB EXEC & QUIT! DEF *+2 DEF .6 * * * STORAGE, ETC... * SUP .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .12 DEC 12 .15 DEC 15 .16 DEC 16 M1 DEC -1 M2 DEC -2 M16 DEC -16 B20 OCT 20 B37 OCT 37 B77 OCT 77 B377 OCT 377 B2000 OCT 2000 BIT12 OCT 10000 BIT14 OCT 40000 RQ3 OCT 100003 * .0A DEF .0 * LU BSS 1 LUT BSS 1 T1 BSS 1 T2 BSS 1 T3 BSS 1 T4 BSS 1 T5 BSS 1 T6 BSS 1 * CBUFA DEF *+1 CBUFR BSS 4 ANB BSS 2 SRQ.P DEF * ASC 3,SRQ.P TRP# BSS 1 TRAP NUMBER. MUST FOLLOW SRQ.P * MSGA ASC 12,ILL RQ-HPIB PROG ABORTED * SIZE EQU * END   59310-18015 1940 S C0122 &IB4A4 HPIB RTE4 OBS FUNCTIONS             H0101 JASMB,R,Q,C HED IB4A4, RTE4 HPIB MATURE UTILITIES NAM IB4A4,7 59310-1X015 REV 1940 790717 ENT HPIB,IBSTS EXT .ENTR,EXEC,LUTRU * EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B * * HPIB - RTE BUS UTILITY * * RELOC: 59310-1X015 PHANTOM MODULE * SOURCE: 59310-18015 * *************************************************** * * CALL HPIB (LU,IFUN,IPARM) * HPIB NOP JSB SET RECOVER VALID PARMS LDA CPAR2,I HPIB1 ASL 6 IOR LU FORM CNTRL WORD STA T1 JSB EXEC DO CONTROL REQ. DEF *+4 DEF .3 REQ.CODE DEF T1 CNTRL WORD DEF CPAR3,I OPTIONAL PARM JMP RTN * SKP * * * STATUS RECOVERY: I=IBSTS(LU) * IBSTS NOP JSB SET GET LU & VALIDATE LDA T1 AND B377 (A)=STATUS BYTE * RTN STA T1 RTN1 LDA .0A CLEAR OPT. PARMS STA CPAR2 STA CPAR3 LDA T1 JMP XIT,I & LEAVE * SKP * GET PARMS & VALIDATE * SET NOP LDA SET RECOVER RETURN ADDR ADA M2 & LDA 0,I GET PARM LIST ADDR STA XIT JMP SET1 * CPAR1 DEF * CPAR2 DEF * CPAR3 DEF .0 (OPTIONAL) * XIT NOP SET1 JSB .ENTR GET PARMS DEF CPAR1 LDA CPAR1,I AND B377 EXTRACT SESSION LU STA LU SAVE SESSION LU * JSB LUTRU SET TRUE (SYSTEM) LU. DEF *+3 SYSTEM LU IS RETURNED IN A REGISTER AND DEF LU ALSO STORED. DEF LUT * CPA M1 DOES SESSION LU MAP TO SYSTEM LU? JMP LOSE NO. ERROR. * CMA,INA YES. INSURE VALID SYSTEM LU. ADA LUMAX SSA JMP LOSE WRONG! LDA DRT ADA LUT INDEX TO ADA M1 APPROPRIATE LDA 0,I DRT ENTRY USING SYSTEM LU. SZA,RSS JMP RTN (IGNORE BIT BUCKET) STA T2 l   & AND B77 EXTRACT EQT # ADA M1 MPY .15 FIND EQT ADDR ADA EQTA LDB 0 ADA .4 GET EQT WORD 5 LDA 0,I & STA T1 CHECK DEVICE TYPE ALF,ALF AND B77 CPA B37 HPIB? JMP SET,I OK, LEAVE, (B)=EQT ADDR * LOSE LDA .0A STA CPAR2 CLEAR OPT.PARMS STA CPAR3 JSB EXEC DEF *+5 DEF .2 DEF .1 "ILL RQ-HPIB" DEF MSGA DEF .12 JSB EXEC & QUIT! DEF *+2 DEF .6 * * * STORAGE, ETC... * SUP .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .6 DEC 6 .12 DEC 12 .15 DEC 15 .16 DEC 16 M1 DEC -1 M2 DEC -2 B37 OCT 37 B77 OCT 77 B377 OCT 377 * .0A DEF .0 * LU BSS 1 LUT BSS 1 T1 BSS 1 T2 BSS 1 * MSGA ASC 12,ILL RQ-HPIB PROG ABORTED * SIZE EQU * END   59310-80020 1609 S 0222 BCS D.37 A & B              H0102  IFN HED ** D.37A: BCS BUS I/O DRIVER ** NAM D.37A 59310-60020 REV.C, 760227 XIF IFZ HED ** D.37B: BCS BUS I/O DRIVER ** NAM D.37B 59310-60021 REV.C, 760227 XIF ENT D.37,I.37 EXT .BUFR IFZ EXT DMAC1,DMAC2,IOERR XIF SKP ******************************************* * * *** I N I T I A T O R S E C T I O N *** * * ******************************************* * ENTER WITH * * A = ADDR OF WD1 OF EQT ENTRY * B = ADDR OF WD2 OF I/O REQUEST * * EXIT VIA D.37,I WITH * A = 0 REQUEST INITIATED * A = 1 REQUEST REJECTED REASON IN B * B15 = 1 THE DRIVER IS BUSY OR * THE DEVICE IS BUSY * B0 = 1 DMA CHANEL(S) BUSY * B15-B0=0 ILLEGAL * * EXIT TO IOERR IF DMA REQUEST AND NOT AVAIALBLE IN SYSTEM * A=3 DMA REQUESTED NOT IN SYSTEM * B15-B0 ADDRESS OF WD1 OF USER CALL * D.37 NOP ENTRY FROM IOC STA EQTAD SAVE ADDR OF EQT WD1 STB REQAD SAVE ADDR OF REQUEST WD2 * * GET FROM USER CALL * LDA REQAD,I GET WD2 OF USER REQUEST AND =B177700 ISOLATE * * TEST FOR CLEAR REQUEST * SZA,RSS TEST FOR CLEAR REQUEST JMP CLEAR YES: GO PROCESS CLEAR REQUEST * * TEST IF DRIVER CONTINUATOR SECTION IS BUSY * LDB DVRBF GET DRIVER BUSY FLAG SSB TEST IF BUSY JMP REJRQ YES: GO TO REJECT EXIT,B=100000 * NO:CONTINUE * * ISOLATE * GFC ALF PUT FUNCTION BITS INTO BITS 0-3 AND =B17 ISOLATE STA FCODE SAVE IT * * TEST FOR LEGAL * * NOTE:ALL 1,2 &3 ARE LEGAL * FOR THIS DRIVER * * * GET FROM EQT AND TEST IF NEW CH # * LDA EQTAD,I GET WD 1 FROM EQT AND =B77 ISOLATE SC BITS CPA OLDSC IS CURRENT SC = TO OLD SC JMP X.1 YES: BYPASS CONFIGURATION SECTION * NO: RECONFIGURE ALL I/O INSTUCTIONS * * CONFIGURE I/O INSTRUCTIONS * STA OLDSC UPDATE OLD SC TO NEW VALUE IOR STFI STA STF1 STA STF2 STA STF3 ADA =B000100 CONVERT STF TO SFC STA SFC1 XOR =B000700 CONVERT SFC TO LIA STA LIA1 STA LIA3 UNL IFZ LST STA LIA4 STA LIA5 XIF LST ADA =B000100 CONVERT LIA TO OTA STA OTA1 ADA =B000100 CONVERT OTA TO STC STA STC1 STA STC2 UNL IFZ LST STA STC3 XIF LST XOR =B001200 CONVERT STC TO LIA ,C STA LIAC1 STA LIA2 ADA =B000100 CONVERT LIA ,C TO OTA ,C STA OTAC1 STA OTAC2 XOR =B005300 CONVERT OTA ,C TO LIB STA LIB1 IOR =B000700 CONVERT LIB TO CLC STA CLC1 IOR =B001200 CONVERT CLC TO CLC ,C STA CLCC2 STA CLCC4 UNL IFZ LST STA CLCC5 XIF LST SKP * *** GET PARAMETERS USED IN COMMON BY READ,WRITE & CONTROL SECTIONS *** * * * GET CODE * X.1 LDA EQTAD,I GET EQT WD 1 ALF,ALF PUT BITS RAL,RAL INTO BIST 0-4 AND =B37 ISOLATE CODE STA SUBUN SAVE IT * * GET * LDA REQAD,I GET WD2 OF USER REQUEST ALF,ALF PUT BITS RAL,RAL INTO BITS 0-5 AND =B67 ISOLATE STA SUBFU SAVE IT * * SET UP POINTERS TO EQT WD2 AND WD3 * LDA EQTAD GET ADDR OF EQT WD1 INA SET TO WD2 STA EQTW2 a SAVE IT INA SET TO WD3 STA EQTW3 SAVE IT * * BRANCH TO CONTROL OR READ/WRITE SECTION * * LDA FCODE CPA =B3 IS IT A CONTROL REQUEST JMP CTLRQ YES: * NO: CONTINUE TO R/W REQUEST SKP * *** GET REMAINING PARAMETERS FOR A READ/WRITE REQUEST *** * * * GET AND RESOLVE * ISZ REQAD SET REQAD TO WD3 ISZ REQAD SET REQAD TO WD4 LDA REQAD PUT ADDR OF WF4 INTO A LDA A,I GET FROM USER REQUEST RAL,CLE,SLA,ERA TEST AND CLEAR INDIRECT JMP *-2 INDIRECT: REPEAT,GET NEXT LEVEL STA UBUFA DIRECT: SAVE * * GET FROM USER REQUEST AND CONVERT TO + BYTES * ISZ REQAD SET REQ. ADDR TO WD5 LDA REQAD,I GET STA UBUFL SAVE IT SSA TEST IF WORDS OR BYTES JMP *+3 -:BYTES,CONVERT TO +BYTES * +:WDS,CONVERT TO BYTES ALS CONVERT WDS TO BYTES RSS CMA,INA CONV -BYTES TO +BYTES STA ULFLG SAVE +BYTES FOR XMISSION LOG COMP * * SET-UP READ/WRITE FLAG * LDA FCODE GET ERA PUT BIT0 INTO E CLA SET A=0 ERA PUT E INTO A15 STA RWFLG SAVE RESULT UNL IFZ LST * *** CLAIM A DMA CHANNEL IF DMA REQUESTED *** * LDA EQTAD,I GET WD1 OF EQUIP.TBL. SSA,RSS TEST IF DMA IS TO BE USED JMP SETBY 0:DMA NOT REQUIRED,GOTO BUSY EXIT * 1:USE DMA,CONTINUE * * CHECK CH1 FOR AVAILABILITY AND BUSY * LDB DMAC1 GET DMA CH1 FLAG CCE,SZB,RSS SET E=1,TEST IF SYSTEM HAS DMA? JMP NODMA NO:GO TO ABORT EXIT * YES:CHECK IF CH1 IS BUSY SSB TEST IF CH1 BUSY 1TJMP CKCH2 1:YES,TRY CH 2 * 0:NO,CONTINUE * * CLAIM DMA CH1 * STB DMAC# SAVE DMA CH# RBL,ERB SET BIT15=1 FOR BUSY FLAG,E=0 STB DMAC1 RESTORE DMAC1 WITH BUSY FLAG JMP SETBY GO TO SET BUSY SEC * * CHECK CH 2 FOR AVAILABILITY AND BUSY * CKCH2 LDB DMAC2 GET DMA CH2 FLAG SZB,RSS TEST IF SYSTEM HAS DMA JMP NODMA NO: GO TO ABORT EXIT * YES: CONTINUE SSB,RSS TEST IF CH2 BUSY JMP CDMA2 0:NO,GO CLAIMIT * YES: REJECT CALL * 1:YES,REJECT CALL,DMA BUSY * * REJECT REQUEST,BOTH DMA CHANNELS BUSY * CLB,INB SET B=1 JMP REJRQ EXIT VIA REJECT RETURN * * ABORT REQUEST, NO DMA * NODMA CCB SET B= -1 ADB REQAD ADD IN ADDR OF WD2 OF USER REQ. LDA =B3 SET A= 3 JMP IOERR EXIT TO IOC ERROR HALT * * CLAIM DMA CH2 * CDMA2 STB DMAC# SAVE DMAC# RBL,ERB SET BIT 15 = 1,E=1 STB DMAC2 RESTORE DMAC2 WITH BUSY FLAG XIF LST * * SET DRIVER BUSY FLAG * SETBY LDB =B100000 SET B15=1 STB DVRBF SET DVR BUSY FLAG TO BUSY * * SET DEVICE BUSY FLAG IN EQT WD2 * JSB UEQT2 GO UPDATE EQT WD2 * * CLEAR TRANSMISSION LOG * CLA SET A = 0 STA EQTW3,I CLEAR TRANSMISSION LOG * *** DETERMINE IF AUTO-ADDRESSING REQUESTED *** * AADCK LDA SUBUN GET SZA,RSS TEST IF FOR BUS(0) OR DEVICE(>0) JMP NOADR 0:GOTO NO ADDRESSING SECTION * >0: ENTER ADDRESSING SECTION SKP * *** AUTO ADDRESSING SECTION *** * * THIS SECTION ADDRESSES THE DEVICE TO TALK (READ REQUEST) * OR LISTEN (WRITE REQUEST) USING FOR THE * BUS ADDR. * * * PUT I/O CARD INTO CONTROLLER MODE WITH PACKING * LDA =B024267 GET CTL WD FOR CTLR MODE WITH PACING JSB CTLWD OUPUT CTL WD * * CONSTRUCT DEVICE ADDRESS FROM AND PUT INTO ADDR BUFFER * LDB RWFLG GET RED/WRT FLAG LDA =B000100 GET TALK ADDR BITS SSB,RSS TEST IF READ OR WRITE LDA =B000040 0:WRT,REPLACE WITH LISTEN ADDR * GROUP BITS * 1:RED,LEAVE AS IS IOR SUBUN ADD IN FOR ADDR ALF,ALF PUT INTO UPPER HALF WD STA ADDRB+1 PUT IT INTO ADDR BUFFER * * SET-UP OUTPUT SECTION PARAMETERS FOR OUTPUT OF ADDRESS * LDA ADRBA GET ADDR OF ADDR BUFEER STA BPNTR PUT INTO BUFFER POINTER LDA =B-2 GET # OF WDS STA WCNTR PUT INTO WORD COUNTER CLA,INA SET A0 = 1 STA OBFLG SET ODD BYTE FLAG LDA OBUFA GET ADDR OF OUPUT BUF CONT SEC STA IENTP PUT INTO INT.ENT PNTR * * SET-UP CONTINUATOR SECTION TO EXIT TO AUTO-ADDRESSING * COMPLETION SECTION * LDA ADRCA GET ADDR OF AUTO-ADDR'G COMPLT. SEC. STA OBEP PUT INTO OUT. BUF EXIT PNTR JMP AADIN GO TO AUTO-ADDR'G INIT. EXIT * * ADDRESS BUFFER * ADRBA DEF ADDRB ADDRB OCT 057477 UNTALK & UNLISTEN COMMANDS OCT 0 STORAGE FOR DEVICE ADDRESS SKP * *** AUTO-ADDRESSING COMPLETION SECTION *** * * PUT THE I/O CARD INTO THE TALK MODE(WRITE REQUEST) * OD LISTEN MODE(READ REQUEST) AND TAKE IT OUT * OF THE CONTROLLER MODE * ADDRC LDB RWFLG GET R/W FLAG LDA =B000110 GET CTL WD TO ENABLE TALK SSB TEST IF RED OR WRT LDA =B000120 1:RED,REPLACE WITH LISTEN CTLWD * 0:WRT,LEAVE AS IS JSB CTLWD OUTPUT IT JMP INIRW GO TO INITIATE RED/WRT SEC. SKP * *** NO ADDRESSING SECTION *** * * * DETERMINE IF I/O CARD IS * ADDRESSED TO TALYK (WRITE REQUEST) * ADDRESSED TO LISTEN (READ REQUEST) * * * GET CURRENT I/O CARD & BUS STATUS * NOADR JSB STAWD * * DETERMINE IF READ OR WRITE REQUEST * LDB RWFLG GET R/W FLAG SSB,RSS TEST IF READ OR WRITE REQ. JMP ATCHK 0:WRT, GO TO ADDR'D TO TALK CHK * 1:RED,CONTINUE TO ADDR'D TO LIST,CHK * * IF READ,TEST IF ADDRESSED TO LISTEN, * MRE=HIGH,RFD=HIGH, & DAC=LOW * AND =B000300 ISOLATE MRE & LISTEN BITS CPA =B000100 TEST IF MRE=H & LISTEN=1 JMP INIRW YES:GO TO RW INIT SEC JMP REJNA NO: GO TO NOT AVAIL REJ * * IF WRITE,TEST IF * 1.ADDRESED TO TALK AND MRE=HIGH * OR 2.ACTIVE AND MRE=LOW * ATCHK LDB A SAVE STATUS AND =B000240 ISOLATE TALK & MRE BITS CPA =B000040 IS TALK=1 & MRE=0? JMP INIRW YES: GO TO RW INIT. SEC. * NO:TRY CTLR MODE LDA B GET STATUS AND =B000220 ISOLATE MRE & ACTIVE BITS CPA =B000220 IS ACTIVE=1 & MRE=1? JMP INIRW YES: GO TO RW INIT. SEC. * NO:CONT. TO REJECT EXIT * * REJECT TEQUEST,CARD AND/OR BUS NOT READY * REJNA CLB,INB GET DEV NOT AVAILABLE STATUS JSB UEQT2 GO UPDATE EQT WD2 STB DVRBF CLR DVR BUSY FLG JMP REJRW SKP * *** READ/WRITE INITIATOR SECTION *** * * * SET-UP RECORD FORMAT FLAGS * INIRW LDB SUBFU GET SUBFUNCTION CODE RBR PUT A/B BIT INTO A15 * F/V BIT INTO A0 * R/A BIT INTO A3 STB RFMTF PUT RESULT INTO REC FMT FLGS UNL IFZ LST * * TEST IF DMA IS TO BE USED * LDA DMAC# GET DMA CH # CLAIMED SZA,RSS TEST IF ONE CLAIMED OR NOT JMP SUIRW 0:NO,GO SET-UP FOR INT. R/W * 6,7:YES,SE9T-UP FOR DMA R/W ERA SET E TO INDICATE DMA CH# TO USE * 0=6,1=7 * *** SET-UP READ OR WRITE USING DMA TRANSFER *** * * * SET DMA COMPLETION INTERUPT LINKAGE * SUDMA LDA OLDSC,I GET JSB,I FROM I/O INT.TRAP CELL STA DMAC#,I PUT IT IN DMA COMPLETION INT.LOC LDA DTCAD GET ADDR OF DMA XFER COMPLET SEC STA IENTP PUT INTO INT.ENT.PNTR * * ENABLE I/O CARD FOR DMA TRANSFER * LDB RWFLG GET R/W FLAG LDA =B004207 WRT:GET CTL WD FOR DMA WRT SSB TEST IF RED REQ. IOR =B012000 1:RED,ADD IN DMA REQ.FLAG SEL.BIT * AND EOR FLG ENABLE LDB RFMTF GET REC FMT FLGS SSB,RSS TEST A/B BIT IOR =B000400 0:ASCII,ADD IN ASCII MODE BIT JSB CTLWD OUTPUT IT * * FORM CTL WD 3 IN B (-WORD COUNT) * LDB ULFLG GET LENGTH OF USER BUF IN +BYTES INB ADD 1 TO ROUND UP TO WORDS BRS DIVIDE BY 2 TO MAKE WORDS STB WCNTR SAVE FOR XMISSIOM LOG COMP. CMB,INB MAKE IT NEGATIVE * * FORM CTL WD 1 IN A (RED/WRT MODE AND SELECT CODE) * LDA =B020000 GET DMA CTL WD 1:STC=0,WORD,CLC=0 IOR OLDSC ADD IN SC OF BUS I/O CARD * * DETERMINE DMA CHANNEL TO BE USED * SEZ TEST E FOR DMA CH# TO INITILIZE JMP ICH2 1:CH2,GO TO CH2 INIT. SEC. * 0:CH1,CONT. TO CH1 INIT. SEC. * * INITILIZE CH1 * ICH1 OTA 6 PUTPUT CW1 TO DMA CH1 LDA UBUFA GET BUFFER ADDR IOR RWFLG ADD IN R/W CTL BIT CLC 2 SET-UP DMA CH1 TO RCV CW2 OTA 2 SEND SW2 STC 2 SET-UP DMA CH1 TO RCV CW3 OTB 2 SEMD CW3 JMP DMAEX GOTO DMA EXIT ROTUTNE * * INITILIZE CH2 * ICH2 OTA 7 OUTPUT CW1 TO DMA CH2 LDA UBUFA GET BUFFER ADDR IOR RWFLG ADD IN R/W CTL BIT CLC 3 SET-UP DMA CH2 TO RCV CW2 OTA 3 SEND CW2 STC 3 SET-UP DMA CH2 TO RCV CW3 OTB 3 SEND CW3 * * CONFIGURE DMA STC INSRUCTION * DMAEX LDA STCCI GET CTC ,C INST IOR DMAC# ADD IN DMA CH # IN USE STA STCD1 STA STCD2 * * TURN ON INTERRUPT ON I/O CARD * CLCC5 CLC SC,C CLR FLG LDA =B000007 JSB CTLWD INITILIZE I/O CARD STC3 STC SC TURN ON INTERRUPT ON I/O CARD * * DETERMINE IF AUTO ADDRESSING USED * LDA SUBUN GET SUB UNIT REQUESTED SZA TEST IF AUTO ADDR'G UXSED JMP DMACX >0:YES,GOTO DMA CONT EXIT * 0:NO,CONT TO INITATOR EXIT * * IF AUTO ADD'G NOT USED,EXIT VIA INITIATORR SECTION * LIA4 LIA SC SET RFD FF TO START READ STCD1 STC 6,C TURN ON DMA CHANNEL JMP REQIN GOYTO REQ INIT EXIT * * IF AUTO ADDR'G USED, EXIT VIA CONTINUATOR SEC * DMACX LDA I.37 GET ADDR OF LOC FROM WHICH INT OCCURED STA DMAIR SAVE TI LIA5 LIA SC SET RFD FF TO START READ JSB RESTR RESTORE THE REGISTER CONTENTS STCD2 STC 6,C TURN ON DMA JMP DMAIR,I RETURN * DMAIR OCT 0 STCCI STC 0,C XIF LST SKP * *** SET-UP READ OR WRITE USING INTERRUPT TRANSFER *** * * * INITILIZE BUFFER POINTER * SUIRW LDA UBUFA GET VALUE OF USER STA BPNTR PUT INTO BUFFER POINTER * * INITILIZE BYTE COUNTER FOR READ * WORD COUNTER & ODD BYTE FLG FOR WRITE * LDA ULFLG GET LENGTH OF USER BUF IN +BYTES SZA,RSS TEST IF BUF LENGTH=0 JMP BUFL0 0:YES,GOTO BUF LEN 0 EXIT CMA,INA CONVERT TO -BYTES STA BCNTR SAVE -BYTES FOR READ STA OBFLG SAVE ODD BYT CNT FOR WRT INA ROUND DOWN ARS CONVERT TO WDS LESS ODD BYTE ADA =B-1 SET WD CNT TO 1 LESS STA WCNTR SAVE WD CNT FOR WRT * * SET-UP FOR ASCII R/W * CLA SSB,RSS TEST IF ASCII FMT LDA =B000400 0:ASCII,GET CTLWD BIT FOR ASCII MODE * 1:BINARY,LEAVE=0 * * DETERMINE IF READ OR WRITE REQUEST * LDB RWFLG GET READ/WTIRE FLAG SSB TEST IF RED OR WRT JMP SURED 1:RED,GO TO SET-UP RED SEC. * 0:WRT,CONTINUE TO SET-UP WRT SEC. * * SET-UP FOR WRITE * SUWRT LDB OBUFA GET ADDR OF WRT CONTINUATOR ROUT STB IENTP PUT INTO INT ENTRY PNTR LDB CMPLA GET ADDR OF CMPLTION SEC SZA TEST IF ASCII OR BINARY LDB SUCLA 1:ASCII,GET ADDR OF CRLF OUT SEC * 0:BIN,LEAVE AS IS STB OBEP PUT INTO OUT BUF ROUT EXIT PNTR IOR =B024207 ADD CTL WD FOR WRITE JSB CTLWD OUTPUT THE CONTROL WORD JMP RWRIN GO TO RED/WRT REQ INITIALTED EXIT * * SET-UP READ * SURED LDB REDAD GET ADDR OF READ ONTINUATOR ROUT. STB IENTP PUT IT INTO POINTER IOR =B050200 ADD IN CTL WD BITS FOR READ JSB CTLWD OUTPUT THE CONTROL WORD * * INITILIZE UPPER/LOWER BYTE FLAG * CLB STB ULFLG UNL IFZ LST * * INITIALIZE EOF COUNTER * LDB =D-30 STB EOFCT XIF LST * * SET-UP INPUT SEC TO BRANCH TO LEADER PROCESSOR * IFN LDA PACKA GET ADDR OF INPUT PACKING SEC XIF IFZ LDA INLDA GET ADDR OF LEADER PROC'G SEC XIF STA INPTP PUT INTO INPUT SEC BRANCH PNTR * * TEST IF RFD FF NEEDS TO BE SET * LIA2 LIA SC,C SET RFD FF TO START READ JMP RWRIN GO TO RED/WRT REQ INITIATED EXIT * * BUFFER LENGTH=0 EXIT PROCESING * BUFL0 LDB SUBUN GET SUB UNIT REQUESTED SZB TEST IF AUTO ADDR'G USED JMP CMPLT >0r:YES,GOTO COMPLT'N SEC * 0:NO,SET-UP INITIATOR EXIT LDA REQIA GET ADDR OF REQ INIT EXIT STA I.37 PUT INTO CONT SEC FOR .BUFR RET JMP CMPLT GOTO COMPLT'N SEC SKP * *** PROCESS A CLEAR REQUEST *** * * * CONFIGURE I/O INSTRUCTONS USED BY CLEAR PROCESSOR * CLEAR LDA EQTAD,I GET WD1 FROM EQT AND =B000077 ISOLATE BITS IOR STFI MAKE INTO STF INSTRUCTION STA STF9 STA STF8 IOR =B000400 CONVERT STF TO LIA STA LIA9 ADA =B000100 CONVERT LIA TO OTA STA OTA9 STA OTA8 IOR =B005300 CONVERT OTA TO CLC ,C * * TURN OFF INTERRUPT AND CLEAR FLAG * CLCC9 CLC SC,C * * IF = 0, EOP BUS * LDA EQTAD,I GET WD1 OF EQT AND =B003700 ISOLATE BITS SZA TEST FOR = 0 JMP CLR1 N/:BYPASS EOP * YES:CONTINUE TO EOP SECTIOM LDA =B000001 GET CTRL WD FOR EOP STF9 STF SC OTA9 OTA SC * * CLEAR IRL FF * CLR1 LIA SC LIA9 EQU CLR1 * * CLEAR OWRLFF,OBRLFF,RFD FF * LDA =B000007 STF8 STF SC OTA8 OTA SC * * CLEAR DRIVER BUSY FLAG * CLB STB DVRBF CLEAR DVR BUSY FLAG * * CLEAR EQT TABLE ENTRIES * LDA EQTAD GET ADDR OF EQT WD1 INA SET TO WD2 STA EQTW2 PUT INTO EQT WD2 ADDR INA SET ADDR TO EQT W&3 STB A,I CLEAR TRAMSMISSION LOG JSB UEQT2 CLEAR BITS 0-7: * BITS 14: R/W ERROR FLG * BIT 15: DEVICE BUSY FLG UNL IFZ LST * * RELEASE DMA CHANNEL IF CLAIMED * LDA DMAC# GET DMA CH # CURRENTLY IN USE SZA TEST IF DMA IN USE JSB RCDMA >0:GORELEASE & CLEAR DMA * 0:NO,GO TO EXIT XIF ,B@< SZA TEST IF AUTO-ADDR'NG SEC USED JMP CONTI >0:YES,EXIT VIA CONT. SEC * =0:NO,EXIT VIA INIT. SEC. * * TURN ON INTERRUPT AND EXIT * AADIN CLC SC,C CLR FLAG CLCC2 EQU AADIN STC1 STC SC TURN ON INTERRUPT ON I/O CARD * * INITATOR SECTION "REQUEST INITIATED" RETURN ROUTINE * REQIN CLA SET A=0 TO INDICATE REQUEST INITIATED JMP D.37,I RETURN TO IOC REQIA DEF REQIN SKP * * SUBROUTINE TO OUTPUT A CONTROL WORD * CTLWD NOP STF1 STF SC OTA1 OTA SC JMP CTLWD,I * * SUBROUTINE TO INPUT A STATUS WORD * STAWD NOP STF2 STF SC LIA1 LIA SC JMP STAWD,I * *** SUBROUTINE TO UPDATE EQT WD2 STATUS BITS 0-7,14,15 *** * * ENTER WITH 1.NEW VALUE FOR BITS 0-7,14,15 IN B * 2.EQTW2 SET TO ADDR OF EQT WD 2 * UEQT2 NOP ENTRY LDA EQTW2,I GET CURRENT VALUE OF WD2 FROM EQT AND =B037400 MASK OFF BITS 0-7,14,15 IOR B ADD IN NEW STATUS STA EQTW2,I RESTORE WD2 TO EQT JMP UEQT2,I RETURN * * INITIATOR SECTION PARAMETERS * * * USER REQUEST AND DEVICE PARAMETERS * REQAD OCT 0 ADDR OF USER REQUEST EQTW2 OCT 0 ADDR OF EQT WD 2 EQTW3 OCT 0 ADDR OF EQT WD 3 OLDSC OCT 100 CURRENT SC OF I/O INST. FCODE OCT 0 * 0 = CLEAR REQ. * 1 = READ REQ. * 2 = WRITE REQ. * 3 = CONTROL REQ. SUBFU OCT 0 SUBUN OCT 0 UBUFA OCT 0 USER BUFFER ADDR UBUFL OCT 0 USER BUFFER LENGHT DVRBF OCT 0 DRIVER BUSY FLAG UNL IFZ LST DMAC# OCT 0 DMA CH# CURRENTLY IN USE * 0 = NONE IN USE * 6 = CH 6 IN USE * 7 = CH 7 IN USE XIF LST SKP *********************************************** * * *** C O N T I N U A T O R S E C T I O N *** * * *********************************************** * * * THIS SECTION IS ENTERED FROM A JSB LINK,I LOCATED IN * THE INTERRUPT TRAP CELL.LINK CONTAINS A DEF I.37 * I.37 NOP ENTRY * * SAVE THE CONTENTS OF THE A,B,E &O REGISTERS * STA SAVA SAVE A STB SAVB SAVE B ERA,ALS PUT E INTO A15,O INTO A0 SOC TEST 0 REG INA SET A0=1 IF 0=1 STA SAVEO SAVE E & 0 CLC1 CLC SC TURN OFF INT.ENABLE CLF JMP IENTP,I BRANCH TO APPROPIATED CONT. ROUTINE IENTP DEF IENTP INTERRUPT ENTRY POINTER * NOTE:THIS POINTER IS NODIFIED * BY THE INITIATOR SECTION TO * POINT TO THE APROPIATE CONTINUATOR * ROUTINE * * POINTERS TO VAROUS CONTINUATOR ROUTINES * REDAD DEF RED PNTR TO READ CONT. SEC. OBUFA DEF OBUF PNTR TO OUTPUT BUFFER ROUT UNL IFZ LST DTCAD DEF DMATC PNTR TO DMA COMPLETION SEC. XIF LST SKP *** *** *** WRITE ROUTINES *** *** *** * *** OUTPUT CONTENTS OF BUFFER *** * OBUF ISZ WCNTR TEST IF LAST BYTE WAS OUTPUT RSS NO:CONTINUE JMP OOB YES:GO TO ODD BYTE OUT CHK LDA BPNTR,I GET WORD FROM BUFFER OTAC1 OTA SC,C OUTPUT IT ISZ BPNTR INCREMENT BUFFER POINTER JMP CONTI MCONTINUE INTERRUPT PROCESSING * * DETERMINE IF AN ODD # OF BYTES IS TO BE OUTPUT * OOB LDA OBFLG GET ODD BYTE FLG SLA,RSS TEST IF ODD BYT JMP OBEP,I 0:NO,DONE,EXIT * 1:YES,CONTINUE * * OUTPUT ODD BYTE * LDA =B020200 TAKE CARD OUT OF PACKING MODE JSB CTLWD OUTPUT CTL WD LDA BPNTR,I GET WD FROM BUFFER ALF,ALF POSITION BYTE TO LOW WD OTAC2 OTA SC,C OUTPUT IT * * SET-UP OUTPUT SECTION TO OUTPUT LAST BYTE AND EXIT * LDA =B-1 GET WD CNT FOR LAST OUTPUT STA WCNTR PUT INTO WD CNTR CLA SET A=0 STA OBFLG CLR ODD BYTE FLG JMP CONTI CONT INT PROC'G * *** OUTPUT OF BUFFER COMPLETE BFANCH TABLE *** * OBEP DEF OBEP OUTPUT COMPLET EXIT PNTR CMPLA DEF CMPLT PNTR TO COMPLETION SECTION ADRCA DEF ADDRC PNTR TO AUTO-ADDR'G COMPLETION SECTION SUCLA DEF SCRLF PNTR TO SET-UP OF CR LF OUTPUT SKP * *** SET-UP OUTPUT OF CR,LF FOR ASCII WRITE *** * SCRLF LDA =B024607 RESTORE PACKING MODE JSB CTLWD OUTPUT IT * * SET-UP OUTBUF SEC PARAMS FOR OUTPUT OF CRLF * LDA CRLFA GET ADDR OF CR,LF BUFFER STA BPNTR PUTINTO BUF PNTR LDA =B-2 GET WD COUNT STA WCNTR PUT INTO WD COUNTER * * SET-UP OUTPUT BUFF SEC TO EXIT TO COMPLETION SEC. * LDA CMPLA GET ADDR OF CMPLT EXIT STA OBEP PUT INTO OUT BUF EXIT PNTR JMP CONTI CONTINUE INT. PROC. * * CARRAGE RETURN,LINE FEED BUFFER * CRLFA DEF CRLF CRLF OCT 006412 SKP *** *** *** READ ROUTINS *** *** *** * *** INPUT BYTE,TEST FOR EOR & BRANCH TO PROC'G SEC *** * RED STF SC SET-UP I/O CARD TO INPUT STATUS STF3 EQU RED LIB1 LIB SC INPUT STATUS BLF,SLB POS BIT 12 INTO BIT0 & TEST EORFLG JMP EORP 1:EOR,GO TO EOR PROC SEC. * vR 0:NOT EOR,CONT LIAC1 LIA SC,C INPUT DATA BYTE,CLR FLAG JMP INPTP,I INPTP DEF INPTP,I * * INPUT PROCESSING BRANCH TABLE * PACKA DEF PACK UNL IFZ LST INLDA DEF INLED * *** PROCESS LEADER *** * * ENTER WITH BYTE IN LOW A * INLED SZA TEST IF BYTE = 000 JMP FBYTE NO: GOTO FIRST BYTE PROC'G * YES: CONT TO EOF TEST * * TEST IF EOF * ISZ EOFCT TEST IF JMP CONTI NO:CONT INT. PROC'G * YES:CONT TO EOF EXIT * * SET-UP EOF & EOT STATUS & GOTO COMPT * LDB =B240 GET EOT & EOF STATUS JMP CMPLS GOTO COMPLETION SEC * *** PROCESS FIRST NON-ZERO BYTE *** * * * SET-UP INPUT SEC. TO BRANCH TO PACK'G SEC * FBYTE LDB PACKA GET ADDR OF PACK'G SEC. STB INPTP PUT INTO INPUT BRANCH PNTR * * DETERMINE READ FORMAT * LDB RFMTF GET READ FORMAT FLAGS SLB,RSS TEST BIT0 JMP PACK 0:ASCII OR FIXED BINARY, * GOTO PACK'G SEC. * 1:VARIABLE BIN FMTS,SDT-UP RL * * DETERMINE IF ABS OR REL BIN FMT * STA TEMP SAVE BYTE1 FOR PACK SECTION RBR,RBR POSITION R/A BIT(BIT3) RBR,SLB INTO BIT0 AND TEST ADA =D3 1:ABS FMT, ADD 3 TO * 0:REL,LEAVE AS IS * * CONVERT TO BYTES * ALS CONVERT TO BYTES STA RECL SAVE FOR * * DETERMINE IF BUFFER IS LARGE ENOUGH TO TAKE RECORD * ADA BCNTR ADD -BUF BYTES TO REC LEN BYTES SSA,RSS TEST RESULT JMP FBEX +:RL >= BL,USE BL * -:RL < BL,USE RL * * CONVERT TO BYTE FOR BYTE CNTR * LDA RECL GET CMA,INA MAKE NEG STA BCNTR PUT INTO BYTE CNTR * * P RESTORE BYTE 1 TO A REG & GOTO PACK SECTION * FBEX LDA TEMP GET BYTE1 XIF LST * *** PACK BYTE INTO BUFFER UNTIL FULL *** * * * TOGGLE UPPER/LOWER FLAG * PACK LDB ULFLG GET UPPER/LOWER FLAG INB TOGGLE IT STB ULFLG SAVE RESULT * * DETERMINE IF UPPER OR LOWER BYTE INPUT * SLB,RSS TEST JMP LBYTE 0:LOWER,GOTO LOW BYTE PROC'G * 1:UPPER,CONT. TO UP BYTE PROC'G * * PROCESSING FOR UPPER BYTE * UBYTE ALF,ALF PUT BYTE INTO UPPER HALF WD STA TEMP SAVE IT FOR LOW BYTE PROC'G JMP BUFFT GOTO BUF FULL TEST * * PROCESSING FOR LOWER BYTE * LBYTE IOR TEMP STA BPNTR,I ISZ BPNTR INCREMENT BUFFER PNTR * * DETERMINE IF BUFFER IS FULL * BUFFT ISZ BCNTR INCREMENT BYTE CNTR & TEST IF FULL JMP CONTI NO:CONT INT. PROC'G * YES:CONT.TO BUF.FULL PROC'G * *** BUFFER FULL PROCESSING *** * * * PAD LAST WD IF ODD # BYTE REMAINING * BUFFP SLB,RSS TEST IF ODD BYTE REMAINING JMP CMPLT 0:NO,EXIT * 1:YES,CONT & PAD LDB RFMTF GET REC FMT FLGS SSB,RSS TEST IF ASCII OR BIN FMT PADA IOR =B040 0:ASCII,ADD IN SPACE CHAR * 1:BIN,LEAVE 0'S BUFFE STA BPNTR,I PUT RESULT INTO BUFFER JMP CMPLT EXIT TO CMPLT'N SEC * *** END OF RECORD PROCESSING *** * * * DETERMINE RECORD FORMAT * EORP LIA SC INPUT BYTE,DON'T CLR EOR FLG LIA3 EQU EORP LDB RFMTF GET REC FMT FLGS SSB,RSS TEST A/B BIT JMP AEOR 0:ASCII,GOTO ASCII EOR PROC'G * 1:BIN,CONT TO BIN EOR PROC'G * * BINARY EOR PROCESSING * BEOR CCB SET B=-1 STB BCNTR SET BYTE CNTR=-1 TO FAKE BUF FULL JMP PACK GOTO BUF PACK'G SEC * * ASCII EOR PR~HOCESSING * * * BACK-UP BYTE COUNTER SO AS NOT TO COUNT CR * AEOR CCB SET B=-1 ADB ULFLG DECREMENT UPPER/LOWER FLG STB ULFLG RESTORE IT * * DETERMONE IF CR PUT INTO BUFFER * SLB,RSS TEST IF LAST INPUT ODD OR EVEN JMP CMPLT 0:EVEN,GO TO COMPLT'N SEC * 1: ODD,REMOVE CR FROM BUFFER * * GET CR FROM BUFFER & MASK OFF * CCB SET B=-1 ADB BPNTR DECREMENT BUF BNTR STB BPNTR RESTOR BUF PNTR VALUE LDA B,I GET VALUE FROM BUFFER AND =B177400 MASK OFF CR JMP PADA GOTO ASCII PAD SEC SKP * * CONTINUE INTERRUPT PROCESSING * CONTI SFC SC TEST IF FLAG HAS BEEN SET SFC1 EQU CONTI JMP IENTP,I YES:BYPASS INPTERRUPT PROCESSING JSB RESTR NO:RESTORE REGISTERS STC2 STC SC TURN I/O CARD INTERRUPT BACK ON JMP I.37,I RETURN TO INTERRUPTED LOCATION * * SUBROUTINE TO RESTORE REGISTERS * RESTR NOP LDA SAVEO CLO SLA,ELA STO LDA SAVA LDB SAVB JMP RESTR,I EXIT * * CONTINUATOR SECTION PARMETERS * SAVA OCT 0 TEMP FOR A DURING INTERRUPT SAVB OCT 0 TEMP FOR B DURING INTERRUPT SAVEO OCT 0 TEMP FOR E & O DURING INTERR0PT BPNTR OCT 0 POINTER TO CURRENT LOC. IN BUFFER BCNTR OCT 0 BYTE COUNTER TEMP OCT 0 TEMP FOR UPPER HALF IN READ RFMTF OCT 0 RECORD FORMAT FLAGS * BIT0=0/1=F/V=FIXED/VARI LENGHT * BIT3=0/1=R/A=REL/ABS FMT * BIT15=0/1=A/B=ASCII/BINARY ULFLG OCT 0 UPPER/LOWER BYTE FLAG RWFLG OCT 0 READ/WRITE FLAG * BIT15=0: WRITE * BIT15=1: READ WCNTR OCT 0 WORD COUNTER OBFLG OCT 0 ODD BYTE FLAG IFZ EOFCT OCT 0 EOF MHCOUNTER RECL OCT 0 XIF SKP ********************************************** * * *** C O M P L E T I O N S E C T I O N *** * * ********************************************** UNL IFZ LST * *** DMA TRANSFER COMPLETE *** * * THIS SECTION ENTERED VIA INTERRUPT FROM THE DMA COMPLETION * INTERRUPT LOCATION OR FROM THE INTERRUPT TRAP CELL IF * AN EOR OCCURS ON INPUT BEFORE DMA WD CNT IS =0 * * DETERMINE IF READ OR WRITE REQ * DMATC LDB RWFLG GET RED/WRT FLAG SSB TEST IF RED OR WRT REQ JMP DMARC 1:RED,GO TO RED CMPLT SEC * 0:WRT,CONT TO WRT CMPLT SEC * *** DMA WRITE COMPLETE PROCESSING *** * DMAWC LDA DMAC# GET DMA CH# IN SSE JSB RCDMA GO CLR & RELEASE IT * * SET-UP TO WAIT FOR LAST BYTE TO BE ACCEPTED * LDA =B024200 GET CTL WD TO EN ORAFLG & PACK'G JSB CTLWD GO OUTPUT IT LDA CMPLA GET ADDR OF CMPLT'N SEC STA IENTP PUT INTO INT ENT PNTR JMP CONTI GO WAIT FOR INT TO OCCUR * *** DMA READ COMLETE PROCESSING *** * DMARC LDA =B000006 GET CTL WD FOR FORCED INPUT CYCLE JSB CTLWD GO OUTPUT IT * * GET BALANCE OF DMA WD CNT AND COMPUTE # OF BYTES INPUT * LDA DMAC# GET DMA CH IN USE ADA =D-4 OFFSET IT TO SC FOR WDCNT INPUT IOR LIAI CONFIG LIA INSRTUCTION STA LIAD1 STORE IT SO IT CAN BE EXECUTED LIAD1 LIA 2 GET BAL OF DMA WD CNT RAL,RAL JUSTIFY NEG WD CNT ARS,ARS TO NORMAL INTEGER FMT ADA WCNTR ADD LENGTH OF USER BUF * RESULT= # WDS INPUT ALS CONVER TO + BYTES STA ULFLG SAVE TRANS LOG COMP * * RELEALSE AND CLEAR DMA CHANNEL * LDA DMAC# GET DMA CH. # IN USE JSB RCDMA G0 RELEASE & CLR DξMA CH. JMP CMPLT GOTO CMPLT'N SEC * *** RCDMA: SUBROUTINE TO RELEASE DMA CH# TO IOC AND CLEZR DMA *** * * * ENTER WITH DMA CHANNEL NUMBER IN USE IN A * RCDMA NOP ENTRY * * NEUTRALIZE DMA COMPLETION INTERRUPT LOCATION * LDB STFI GET STF INSTRUCTION ADB A ADD DMA CH# STB STFD1 CONFIGURE STF DMA INSTRUCTION ADB CLCM ADD IN BITS FOR CLC INST. STB A,I PUT INTO DMA INTERRUPT LOCATION STB CLCD1 CONFIGURE CLC DMA INSTUCTION * * TURN OFF DMA * CLCD1 CLC 6 TURN OFF DMA CHAMNEL CMPLT INTERRUPT STFD1 STF 6 TURN OFF DMA * * RELEASE DMA CHANNEL TO IOC * CPA =B6 TEST IF CH6 STA DMAC1 YES:CLR BUSY STATUS IN DMAC1 CPA =B7 NO:TEST IF CH7 STA DMAC2 YES:CLR BUSY STATUS IN DMAC2 CLA SET A=0 STA DMAC# CLR DMA CH. IN USE FLAG JMP RCDMA,I RETURN XIF SKP LST * *** INTERUPT TRANSFER COMPLET *** * * * THIS SECTION ENTERED FROM THE CONTINUATOR SECTION * WHRN A READ/WRITE TRANSFER IS COMPLETE * * ENTER WITH STATUS IN B * * UPDATE EQT STATUS * CMPLT CLB SETB=0 FOR NORMAL COMPLT STATUS CMPLS JSB UEQT2 GO UPDATE EQT WD2 * * CLEAR RFD FF BEFORE COMPLETION EXIT * RCMPL LDA =B000007 JSB CTLWD CLR RFD FF CLCC4 CLC SC,C TURN OFF INT & CLR FLAG * * CONVERT # OF BYTES TRANSFERED TO +WDS OR +BYTES PER USER REQ. * LDA ULFLG GET # OF BYTES TRANSFERED LDB UBUFL GET MODE OF REQUEST SSB TEST IF BYTES OR WDS REQUESTED JMP *+3 -:BYTES,GO ON,LEAVE AS IS INA +:WDS,ROUND UP IF ODD # XFERED ARS CONVERT IT TO WORDS * * SET BIT 15 TO INDICATE FORMAT * LDB RFMTF GET RECORD FMT FLGS ELB PUT A/B BIT INTO E RAL,ERA PUT E INTO BIT15 * * UPDATE TRANSMISSION LOG * <:6 STA EQTW3,I PUT IT INTO EQT * * CLEAR DRIVER BUSY FLAG * CLB STB DVRBF CLR DVR BUSY FLG * * SUT-UP RETURN TO .BUFER * LDA I.37 STA RETAD JSB RESTR JSB .BUFR RETAD OCT 0 EQTAD OCT 0 SKP * * STORAGE * A EQU 0 B EQU 1 * * CONSTANTS * CLCCI CLC 0,C STFI STF 0 CLCM OCT 004600 LIAI LIA 0 SC EQU 0 END (<  59310-80051 1609 S 0122 HEADER (BLIB#)              H0101 ASMB,R,L,B ** BLIB : BUS LIBRARY HEADER REV 2 ** HED ** BLIB : BUS LIBRARY HEADER ** REV A NAM BLIBA * NOTE: THE PURPOSE OF THIS ROUTINE IS TO PROVIDE A * MEANS TO IDENTIFY THE VERSION OF THE LIBRARY TAPE BY * LISTING THE FIRST NAM RECORD END #  59310-80052 1609 S 0122 REMOTE ROUT (REMOTE)              H0101 pASMB,R,L,T,C,B ** REMOTE: SWITCH BUS TO REMOTE ROUTINE ** HED ** REMOT: SWITCH BUS TO REMOTE ** REV A NAM REMOT ENT REMOT EXT .ENTR,.IOC.,CMD SKP UREF# OCT 0 MODE DEF ZERO * REMOT NOP ENTRY JSB .ENTR GET PARAM DEF UREF# ADDR'S FROM USER CALL * * CONFIGURE IOC REQUEST * LDA UREF#,I GET UNIT REFERENCE # AND =B000077 LIMIT TO 2 OCTAL DIGITS IOR RMTRC ADD IN REQUEST CODE FOR REMOTE STA RCODE PUT IT INTO CALLING SEQ. TO IOC * * EXECUTE CONTROL REQUEST TO IOC * JSB .IOC. CALL IOC RCODE OCT 030300 RCODE = 0303 CONFIGURED JMP *-2 REPEAT IF REJECTED * * CHECK MODE * LDA MODE,I GET FROM USER CALL SZA,RSS TEST IT JMP END O:"SOFT REMOTE",EXIT * >0:"LOCAL LOCK OUT,CONTINUE * * OUTPUT COMMAND FOR LOCAL LOCK OUT * JSB CMD CALL COMMAND ROTINE DEF *+3 PNTR TO RETURN DEF UREF#,I ODDR OF BUS UREF# DEF LLO ADDR OF BUFFER CONTAINING * LOCAL LOCK OUT COMMAND * * SET MODE PARAMER TO ZERO FOR DEFALT CASE * END LDA ZEROA GET ADDR OF VALUE OF 0 STA MODE PUT IT INTO PARAM ADDR LIST JMP REMOT,I EXIT * * CONSTANTS * LLO OCT 1 BUFFER LENGTH OCT 010400 LLO CMD IN UPPER HALF WD * LLO CMD = 021 OCTAL * 0 001 000 100 000 000 ZEROA DEF ZERO ADDR OF ZERO ZERO OCT 0 VALUE ZERO RMTRC OCT 030300 REQ. CODE FOR SW TO REMOTE END X  59310-80053 1609 S 0122 LOCAL ROUT (LOCL)              H0101 4#ASMB,R,L,T,C,B ** LOCL: SWITCH BUS TO LOCAL ** HED ** LOCL: SWITCH BUS TO LOCAL ** REV A NAM LOCL ENT LOCL EXT .ENTR,.IOC. SKP UREF# OCT 0 * LOCL NOP ENTRY JSB .ENTR GET ADDR'S OF PARAMS DEF UREF# FROM USER CALL * * CONFIGURE IOC REQUEST * LDA UREF#,I AND =B000077 IOR RCLOC STA RCODE * * EXECUTE CONTROL REQUEST TO IOC * JSB .IOC. RCODE OCT 030200 JMP *-2 * * EXIT * JMP LOCL,I * * CONSTANTS * RCLOC OCT 030200 END R  59310-80054 1609 S 0122 DEVICE CLEAR ROUT (DEVL)              H0101 ASMB,R,L,T,C,B ** DEVCL: CLEAR ALL DEVICES ON BUS ** HED ** DEVCL: CLEAR ALL DEVICES ON BUS ** REV A NAM DEVCL ENT DEVCL EXT .ENTR,CMD SKP UREF# OCT 0 * DEVCL NOP ENTRY JSB .ENTR GET ADDR OF BUS UREF# DEF UREF# FROM USER CALL * * OUTPUT COMMAND FOR DEVICE CLEAR * JSB CMD CALL COMMAND ROUTINE DEF *+3 PNTR TO RETURN DEF UREF#,I ADDR OF BUS UREF # DEF DCR ADDR OF BUFFER CONTAINING * DEVICE CLEAR COMMAND * EXIT * JMP DEVCL,I EXIT * * CONSTANTS * DCR OCT 1 BUFFER LENGTH OCT 012000 DCR COMMAND IN UPPER HALF * DCR CMD = 024 OCTAL * 0 001 010 000 000 000 END R  59310-80055 1609 S 0122 CMMD ROUT (CMD)              H0101 ASMB,R,L,T,C,B **CMD: BUS COMMAND ROUTINE ** REV A HED ** CMD: BUS COMMAND ROUTINE ** REV A NAM CMD,6 ENT CMD EXT .ENTR,.IOC. SKP * * * UREF# OCT 0 WHO1 OCT 0 WHAT1 OCT 0 WHO2 OCT 0 WHAT2 OCT 0 WHO3 OCT 0 DUMY OCT 0 * CMD NOP JSB .ENTR GET ADDR'S OF PARAMETERS DEF UREF# * * CONFIGURE REQUEST CODES WITH UINIT REF # * LDA RC1 IOR UREF#,I STA RC1C STA RCCLC LDA RC2 IOR UREF#,I STA RCWRT LDA RC3 IOR UREF#,I STA RCSTA * * INITIALIZE PARAMETERS * LDA PARMA GET ADDR OF FIRST PARAM IN LIST RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 STA PARMA STA PARMP PUT IT INTO POINTER CLB STB WWFLG INITILIZE WHO/WHAT FLAG STB DUMY NOP LAST PARAM ADDR TO INSURE * EXIT SKP * *** MAIN LOOP *** * LOOP LDB PARMP,I GET ADDR OF PARMETER SZB,RSS TEST FOR MORE PARAMS JMP END 0:NO MORE PARAM'S LDA B,I GET CHAR COUNT AND =B377 MASK OFF MYSTERIOUS BIT 9 CMA,INA MAKE IT NEGATIVE STA LENTH PUT IT INTO THE CALLING SEQUENCE INB SET BUFFER ADDR TO WD2 OF BUFFER STB BUFAD PUT IT INTO THE CALLING SEQUENCE * * CHECK IF DIVER IS READY FOR NEXT OPERATION * JSB .IOC. INITIATE A STATUS REQUEST RCSTA OCT 040000 RCODE = STAUTS REQUEST SSA TEST FOR COMPLETION JMP *-3 NO:REPEAT STATUS CHECK * * SET-UP AND EXECUTE CONTROL REQUEST * IF ODD # PARAM,SET INTO CONTRILLER MODE * IF EVEN # PARAM,CLEAR CONTROLLER MODE * LDB WWFLG GET WHO/WHAT MODE FLAG LDA RC1C GET CTL RCODE TO CLR CTRL MODE SLB,RSS TEST MODE IOR =B000200 WHO: SET CONTOLLER MODE STA RCCTL PUT INTO THE CALLING JS5  B .IOC. INITATE A CONTROL REQUEST RCCTL OCT 030000 CONTROL REQUEST JMP *-2 * * OUTPUT THE WHO OR WHAT FIELD * JSB .IOC. INITIATE A WRITE REQUEST RCWRT OCT 020100 RCODE=WRITE BINARY JMP *-2 REPEAT REQUEST IF REJECTED BUFAD DEF BUFAD POINTER TO BUFFER LENTH OCT 0 # OF CHAR. * * SET UP OR NEXT PARAMETER * LDB WWFLG GET WHO/WHAT INB TOGGLE IT STB WWFLG REPLACE IT ISZ PARMP INCREMENT PARAMETER POINTER JMP LOOP SKP * * ZERO OUT PARAM ADDR S FOR NEXT EXECUTION * END LDA PARMA STA PARMP LDB =D-5 CLA STA PARMP,I ISZ PARMP INB,SZB JMP *-3 LDA WWFLG GET WHO/WHAT FLAG SLA,RSS TEST IF WHO OR WHAT WAS LAST JMP CMD,I WHAT: EXIT * WHO: CLEAR CONTROLLER MODE * * CLEAR CONTROLLER MODE BEFORE EXIT * JSB .IOC. RCCLC OCT 034400 JMP *-2 JMP CMD,I SKP * * STORAGE * RC1C BSS 1 PARMP BSS 1 WWFLG BSS 1 A EQU 0 B EQU 1 * * CONSTANTS * RC1 OCT 034400 RC2 OCT 020100 RC3 OCT 040000 PARMA DEF WHO1 END   59310-80056 1609 S 0122 BUFFRD READ ROUT (READB)              H0101 ASMB,R,L,T,C,B ** READB: BUFFERED READ ** HED ** READB: BUFFERED READ ** REV A NAM READB ENT READB EXT .ENTR,.IOC.,.DIO.,.IOR.,.IOI.,.DST SKP UREF# OCT 0 FMT BSS 1 ARRAY BSS 1 #REDS BSS 1 #ELMT BSS 1 BUFR BSS 1 BUFL BSS 1 * READB NOP ENTRY JSB .ENTR DEF UREF# * * CONFIGURE I/O REQUESTS * LDA UREF#,I GET VALUE OF AND =B77 ISOLATE TO 2 OCTAL DIGITS LDB A SAVE RESULT IN B IOR RARC ADD IN REQ.CODE FOR ASCII READ STA RC1 PUT INTO CALLING STA RC2 SEQUENCES LDA SRC GET REQ. CODE FOR STATUS CHECK IOR B ADD IN STA RC3 PUT INTO CALLING STA RC4 SEQUENCES. * * INITILIZE # OF READS COUNTER * LDA #REDS,I GET VALUE OF <# OF READS> CMA,INA MAKE IT NEGATIVE STA RCNTR PUT RESULT INTO COUNTR * * INITILIZE # OF ELEMENTS PER RECORD COUNTER * LDA #ELMT,I GET VALUE OF <# OF ELEMENTS> CMA,INA MAKE IT NEGATIVE STA ELCNT PUT RESULT INTO TEMP STORAGE * * INITILIZE INPUT BUFFER POINTERS * LDA BUFR GET ADDR OF BUFFER STA BUF1A PUT INTO CALLING SEQ. OF CALLS STA BUF1B TO IOC AND FMTR LDA BUFL,I GET VALUE OF INA ARS DIVIDE IT IN HALF ADA BUFR ADD ADDR OF TO LENGTH STA BUF2A PUT RESULT IN CALLING SEQ. OF I/O CALL STA BUF2B PUT EESULT IN CALLING SEQ. OF CONV.CALL * * INITILIZE INPUT BUFFER LENGHTS * LDA BUFL,I GET VALUE OF CMA,INA MAKE IT NEGATIVE STA BUF1L PUT RESULT INTO CALLING STA BUF2L SEQENCES FOR LENGTH * * INITILIZE POINTERS TO FORMAT SPECIFICATION * LDB FMT GET ADDR OF FORMAT SPECIFICATION INB BYPASS CHAR. COUNT LDA B,I GET FIRST TWO CHAR OF FMT SPEC AND =B077400 ISOLATE UPPER CHARACTER CPA ASTR IS IT A ASTERIC CLB YES:SET B=0 FOR FREE FEILD READ * NO:LEAVE B WITH ADDR OF FMT SPEC STB FMT1 PUT IT INTO CALLS TO FMTR STB FMT2 * * INITIATE FIRST READ INTO BUFFER 1 * JSB READ1 * ** MAIN LOOP ** * LOOP ISZ RCNTR RSS JMP END1 * * INITIATE READ INTO BUFFER 2, THEN CONVERT BUFFER 1 * JSB READ2 JSB CONV1 * * TEST FOR MORE READS * ISZ RCNTR RSS JMP END2 * * INITIATE READ INTO BUFFER 1,THEN CONVERT BUFFER 2 * JSB READ1 JSB CONV2 JMP LOOP * ** END 1 ** * END1 JSB .IOC. RC3 OCT 040000 SSA JMP *-3 JSB CONV1 JMP READB,I EXIT * ** END 2 ** * END2 JSB .IOC. RC4 OCT 040000 SSA JMP *-3 JSB CONV2 JMP READB,I EXIT SKP * * SUBROUTINE TO READ INTO BUFFER 1 * READ1 NOP JSB .IOC. RC1 OCT 010000 JMP *-2 BUF1A DEF BUFR,I BUF1L OCT 0 JMP READ1,I * * SUBROUTINE TO READ INTO BUFFER 2 * READ2 NOP JSB .IOC. RC2 OCT 010000 JMP *-2 BUF2A DEF BUFR,I BUF2L OCT 0 JMP READ2,I * *** SUBROUTINE TO CONVERT BUFFER1 *** * CONV1 NOP CLA CLB,INB JSB .DIO. BUF1B DEF BUFR,I FMT1 DEF FMT,I DEF ECON1 * * INITILIZE # OF ELEMENTS COUNTER * LDA ELCNT STA ECNTR * * CONVERT EACH ELEMENT AND STORE INTO ARRAY * NEXT1 JSB .IOR. JSB .DST DEF ARRAY,I ISZ ARRAY ISZ ARRAY ISZ ECNTR JMP NEXT1 ECON1 JMP CONV1,I * *** SUBROUTINE TO CONVERT BUFFER 2 *** * CONV2 NOP CLA CLB,INB JSB .DIO. BUF2B DEF BUFR,I FMT2 DEF FMT,I DEF ECON2 * * INITILIZE # OF ELEMENTS COUNTER * LDA ELCNT o STA ECNTR * * CONVERT EACH ELEMENT AND STORE INTO ARRAY * NEXT2 JSB .IOR. JSB .DST DEF ARRAY,I ISZ ARRAY ISZ ARRAY ISZ ECNTR JMP NEXT2 ECON2 JMP CONV2,I SKP * * STORAGE * A EQU 0 B EQU 1 ELCNT OCT 1 ECNTR BSS 1 RCNTR BSS 1 * * CONSTANTS * RARC OCT 010400 SRC OCT 040000 ASTR OCT 025000 ASCII ASTERIC IN UPPER HALF END   59310-80057 1609 S 0122 FTN IOC INTFC (CIOC)              H0101 rASMB,R,L,T,C,B ** CIOC: CALL IOC ** HED ** CIOC: FORTRAN CALLABLE IOC INTERFACE ** NAM CIOC,6 ENT CIOC EXT .ENTR,.IOC. SKP * *** CIOC: CALL IOC *** * UREF# OCT 0 RCODE OCT 0 STAT OCT 0 BUFAD OCT 0 BUFL OCT 0 * CIOC NOP JSB .ENTR GET PARAM DEF UREF# ADDRESSES * * FORM WD2 (+) OF CALL TO IOC * LDA UREF#,I GET AND =B77 IOSOLATE BITS 0-5 LDB RCODE,I GET BLF POSTION IN RBL,RBL UPPER WORD IOR B MERGE AND STA WD2 PUT INO WD2 OF CALL * * FORM WD3 OF CALL TO IOC * AND =B030000 ISOLATE BITS 12-13 LDB JMPC GET JMP CMPLT INST SZA TEST IF = 1,2 OR 3 LDB JMPR YES: GET JMP REJ INST * NO: USE JMP CMPLT INST STB WD3 PUT INTO WD3 OF CALL * * DETERMINE IF CONTROL REQUEST * CPA =B030000 TEST IF CTL REQ.(RCODE =03XX) JMP SUCTL YES: GO TO CTL SET-UP SEC. * NO: CONTINUE TO R/W SET-UP SEC. * * SET-UP CALL FOR READ OR WRITE * SURW LDA BUFAD STA WD4 LDA BUFL,I STA WD5 JMP CALL JMPR JMP REJ * * SET-UP CALL FOR CTL REQUEST * SUCTL LDA JMPC GET JMP RET INSTRUCT STA WD4 PUT IT INTO WD4 OF CALL TO IOC SKP * * CALL TO IOC * CALL JSB .IOC. WD2 OCT 0 + WD3 NOP :CLEAR & STATUS REQ. * :READ,WRITE,CONTROL REQ. WD4 DEF BUFAD,I FOR READ,WRITE REQ. * FOR CONTROL REQUEST WD5 DEF BUFL,I WD6 JMP REQC FOR READ,WRITE REQ JMPC EQU WD6 * * SET-UP FLAG FOR REJ OR CMPLT RETURN * REJ ,  CCE SET E FOR REJ FLAG RSS REQC CLE * * PUT CONTENTS OF A AND B INTO STATUS BUFFER * RET STA STAT,I PUT CONTENTS OF A INTO WD1 OF STATUS BUFFER ISZ STAT SET POINTER TO WD2 STB STAT,I PUT CONTENTS OF B INTO WD2 OF STATUS BUFFER ISZ STAT SET PNTR TO WD3 CLA ERA PUT E INTO A15 STA STAT,I PUT REJ FLG INTO WD3 * * EXIT * JMP CIOC,I EXIT SKP * * VARIABLES * A EQU 0 B EQU 1 * * CONSTANTS * END   91000-80002 A S 0106 HP 91000A VERIFICATION GEN. INFORMATION AND START            H0101 TASMB,R,B,L HED 91000A VERIF -- GENERAL INFORMATION -- 10/31/73 NAM START * * THE 91000A SUBSYSTEM VERIFICATION ALLOWS THE * USER TO EXERCISE THE 91000A IN ALL MODES. * * THE PROGRAM HAS A NUMBER OF TESTS WHICH ARE CALLED BY * TYPING THE COMMAND (SEE LIST BELOW). * * THE PROGRAM ISSUES A PROMPTER (>) WHEN IT IS READY TO * ACCEPT A COMMAND. * * * * T E S T S: * * * * 1. SINGLE CHANNEL * * 1 TO 200 READINGS ARE TAKEN ON A SINGLE SPECI- * FIED CHANNEL. THE RESULTS ARE PRESENTED * AS AN AVERAGE OF ALL READINGS, THE HIGHEST * AND LOWEST READINGS AND THEIR DIFFERENCE * (PEAK-TO-PEAK), AND THE RMS ERROR BETWEEN THE * READINGS AND THE AVERAGE. * * * 2. TWO CHANNEL * * 2 TO 200 READINGS ARE TAKEN ALTERNATING * BETWEEN TWO SPECIFIED CHANNELS. THE AVERAGE, * ETC., ARE PRESENTED FOR EACH CHANNEL. * * * 3. SEQUENTIAL * * 1 TO 200 READINGS ARE TAKEN SEQUENTIALLY FROM * A SPECIFIED STARTING CHANNEL. IF THE TOTAL * NUMBER OF READINGS EXCEEDS THE NUMBER OF * CONTIGUOUS CHANNELS AVAILABLE, THE SUBSYSTEM * WILL AUTOMATICALLY RESET TO THE STARTING CHANNEL * AND RESUME THE SCAN. NO INFORMATION IS PRESENTED * DIRECTLY. A LIST OF READINGS MAY BE MADE (SEE * LIST). SKP * 4. HISTOGRAM * * 1 TO 32767 READINGS ARE TAKEN ON ONE SPECI- * FIED CHANNEL AND CATEGORIZED. EACH DIFFERENT * VALUE READ IS A CATEGORY AND THE NUMBER OF * READINGS FOUND IN A CATEGORY ARE COUNTED. * UP TO 20 CATEGORIES CAN BE USED. AN ATTEMPT * TO CREATE A 21ST CATEGORY CAUSES EARLY TERM- * INATION OF THE TEST (THE NUMBER OF READINGS * TAKEN IS PRESENTED). THE AVERAGE, P-P, HIGH, * LOW, AND RMS ERR(yOR ARE PRESENTED. * * * 5. DISPLAY * * READINGS ARE CONTINOUSLY TAKEN ON ONE SPECI- * FIED CHANNEL. THE RESULTS ARE DISPLAYED IN * THE B REGISTER (2115/2116) OR IN THE SWITCH * REGISTER (2100/2114). IF THE ANSWER TO * AVERAGE IS YES, A 16 WORD AVERAGE IS DISPLAYED. * IF THE ANSWER TO AVERAGE IS NO, EACH READING * IS DISPLAYED. * * * 6. NORMALIZE * * ISSUE THE SYSTEM NORMALIZE COMMAND. * * * 7. REPEAT * * REPEAT THE LAST TEST AS SPECIFIED. REPEAT IS * NOT AVAILABLE AFTER ENTERING A NEGATIVE * NUMBER TO ABORT INPUT REQUESTS. IT IS * ALSO NOT AVAILABLE INITIALLY. * * * 8. LIST * * LIST ANY PART OR ALL OF THE DATA BUFFER * (READINGS 1 TO 200). IF THE LAST TEST WAS * HISTOGRAM, LIST THE HISTOGRAM OVER. LIST IS * NOT AVAILABLE AFTER DISPLAY, WITH REPEAT * CONDITION SET, OR WHENEVER A TEST IS ABORTED. * * * 9. TAPE * * TAKE ALL FURTHER COMMANDS FROM TAPE READER. * THIS MAY BE A PHOTO-READER (IF AVAILABLE) OR * THE TTY. IF THE TTY IS USED (ANSWER 0 TO * TAPE-READER SELECT CODE WHEN CONFIGURING) * THIS MODE DISABLES THE KEYBOARD ABORT FEATURE. SKP * 10. KEYBOARD * * TAKE ALL FURTHER COMMANDS FROM KEYBOARD (TTY). * THIS SHOULD ALWAYS BE THE LAST COMMAND ON A * TAPE OF COMMANDS. THIS IS THE NORMAL MODE * ENTERED AFTER LOADING THE PROGRAM. * * * 11. * * * THE ASTERISK IS USED FOR COMMENTS. THIS * ALLOWS THE USER TO DOCUMENT HIS TESTS. WHEN * ENCOUNTERED THE REST OF THAT LINE IS IGNORED. * * * 12. CONDITIONS * * ALL ACTIVE CONDITIONS ARE IDENTIFIED BY THEIR * FIRST LETTER. * * * 13. INSTRUCTIONS * * PROGRAM PRINTS A BRIEF SUMMARY OF * THE OPERATING COMMANDS. * * * C O N D I T I O N S: * * * TO PLACE CONDITIONS ON A TEST, TYPE THE WORD "SET" * FOLLOWED BY THE DESIRED CONDITION. * * * A. SET DELAY * * ALL TESTS FOLLOWING WILL USE A SOFTWARE DELAY * BETWEEN READINGS OF A MULTIPLE OF 10 MICRO- * SECONDS SPECIFIED AT THIS TIME. * * * B. SET PACER * * ALL TESTS FOLLOWING WILL BE TIMED BY AN * EXTERNAL PACER. DELAY IS OVERRIDDEN * IF PREVIOUSLY SET. * * * C. SET REPEAT * * REPEAT THE SPECIFIED TEST WITHOUT PRINTOUTS * UNTIL A KEYBOARD KEY IS PRESSED. HISTOGRAM * DOES CONTINUE PRINTING ALL INFORMATION * UNLESS SWITCH 15 IS UP. WITH SWITCH 15 * UP ONLY THE AVG WILL BE PRINTED. SKP * * * * CONDITIONS ARE CLEARED AS FOLLOWS: * * A. CLEAR DELAY * B. CLEAR PACER * C. CLEAR REPEAT * D. CLEAR ALL (CLEARS ALL CONDITIONS) * * WHENEVER THE USER LOSES TRACK OF HIS CONDITIONS, REFER * TO THE COMMAND "CONDITIONS" (12). * * * A D D I T I O N A L N O T E S: * * * SWITCH 15 ON THE SWITCH REGISTER MAY BE USED TO TERM- * INATE A LISTING EARLY (LINE-BY-LINE). WITH REPEAT * CONDITION SET AND HISTOGRAM CALLED, SWITCH 15=1 * WILL CAUSE ONLY THE AVERAGE TO BE PRINTED. ANY TIME * LIST IS CALLED WHILE SWITCH 15 IS UP WILL RESULT * IN LISTING ONE READING ONLY. * * ANY TEST MAY BE ABORTED DURING ITS SETUP BY ENTERING * A NEGATIVE NUMBER TO ANY NUMERICAL INPUT REQUEST * (I.E., NO=; CHANNEL=; ETC.). REPEAT WILL NOT BE * AVAILABLE AFTER THIS TYPE OF ABORT. * * ANY TEST MAY BE ABORTED WHILE RUNNING BY PRESSING ANY * KEYBOARD KEY (UNLESS IN TAPE MODE WITHOUT A PHOTO- * READER). LIST WILL NOT BE AVAILABLE BUT REPEAT WILL. * * PRESYSING A KEYBOARD KEY IS THE PROPER WAY TO TERMINATE * THE DISPLAY MODE OR ANY TEST WITH REPEAT SET. * HED START -- 91000A VERIF -- CONFIGURING LINK -- 10/31/73 * CONFIGURING ROUTINE LINK * * * THIS ROUTINE IS A ONE WORD * LINK TO CNFGR WHICH IS IN * THE CODE PROCEDURES SECTION. * * IT ALLOWS THE USER TO GET * TO THE CONFIGURING ROUTINE BY * USING 2000 (OCTAL) AS A START ADDRESS. * * STARTING AT OCTAL 2 WILL * BYPASS THIS ROUTINE AND GO * DIRECTLY TO THE ALGOL PORTION. SPC 2 ENT START EXT CNFGR SPC 1 START JMP CNFGR SPC 1 END Fb  91000-80003 A S 0106 HP 91000A VERIFICATION VERIF - ALGOL             H0101 HPAL,L,B,"VERIF" BEGIN COMMENT OCTOBER 31,1973 THIS ALGOL PROGRAM IS PRIMARILY A CONTROL ROUTINE. MOST OF THE WORK IS DONE IN ASSEMBLY LANGUAGE CODE PROCEDURES. THE ALGOL WRITES MESSAGES, READS QUANTITIES AND CHANNEL NUMBERS, CHECKS FOR ERROR ENTRIES, SETS UP THE REQUESTED TEST AND CALLS THE 2313B DRIVER (THROUGH THE FTN-ALGOL INTER- FACE, V2313), AND LISTS TEST RESULTS. ; PROCEDURE STATPAC(DATA,NUMBERTAKEN,MODE,HOWMANY); COMMENT THIS PROCEDURE CALCULATES THE AVERAGE OF ALL READINGS TAKEN ON ONE CHANNEL IN THE SI, TW, OR HI TESTS. IT ALSO CALCULATES THE HIGHEST AND LOWEST VALUES AND THEIR DIFFERENCE (PEAK-TO-PEAK). FINALLY, IT CALCULATES THE RMS ERROR BETWEEN THE READINGS AND THE AVERAGE. IT THEN PRINTS THESE VALUES ; VALUE MODE,HOWMANY; INTEGER NUMBERTAKEN,MODE,HOWMANY; REAL DATA; CODE; PROCEDURE I2313(UNIT,TYPE,PACE,MODE,CHANNELBUFFER,NUMBER, DATABUFFER,DIFFERENTIAL); COMMENT THIS IS THE ALGOL/FTN-DRIVER INTERFACE WHICH CALLS THE 2313B DRIVER (D.62V) ; VALUE UNIT,TYPE,PACE,MODE,NUMBER,DIFFERENTIAL; INTEGER UNIT,TYPE,PACE,MODE,NUMBER,CHANNELBUFFER, DIFFERENTIAL; REAL DATABUFFER; CODE; PROCEDURE INTRP(WHERE,SC,TC,RS,BS,SS,HI,DI,ADDRESS,CO, LAD,REPEATOK,USEGAIN,LOOP,PACED,RATE,RANGE,EXTSS,LISTOK,IN); COMMENT THIS PROCEDURE IS THE COMMAND INTERPRETER. IT DOES THE COMMUNICATING WITH THE OPERATOR WHEN FIRST CALLING A TEST OR SETTING A CONDITION ; INTEGER WHERE,SC,TC,RS,BS,SS,HI,DI,ADDRESS,LOOP, LISTOK,USEGAIN,PACED,RANGE,EXTSS,REPEATOK,CO,IN,RATE,LAD; CODE; PROCEDURE CNVRT(OUTBUFFER,INBUFFER,RGAIN,RGAIN2,START,NUMBER); COMMENT  THIS PROCEDURE CONVERTS THE RAW INTEGER DATA IN THE BUFFER INTO REAL VOLTAGES (INCLUDING ADJUSTMENT FOR GAIN); VALUE RGAIN,RGAIN2,START,NUMBER; INTEGER START,NUMBER; REAL OUTBUFFER,INBUFFER,RGAIN,RGAIN2; CODE; & & & & & & PROCEDURE DSPLY(CHANNEL,PACED,S); COMMENT THIS PROCEDURE OPERATES THE 91000A SUBSYSTEM DIRECTLY, DISPLAYING THE RESULTS IN THE B AND SWITCH REGISTERS ; VALUE CHANNEL,PACED; INTEGER CHANNEL,PACED,S; CODE; PROCEDURE HISTO(CHANNEL,PACED,RGAIN,HOWMANY,BUCKETS, NUMBERBUFFER,READINGBUFFER); COMMENT THIS PROCEDURE OPERATES THE 91000A SYSTEM DIRECTLY TO TAKE UP TO 32767 READINGS AND CATEGORIZE THEM INTO A HISTOGRAM ; VALUE CHANNEL,PACED; INTEGER CHANNEL,PACED,BUCKETS,HOWMANY,NUMBERBUFFER; REAL READINGBUFFER,RGAIN; CODE; PROCEDURE EXIT(TEST,WHERETO); COMMENT THIS PROCEDURE IS USED TO ABORT THE TEST OR TO GET OUT OF LOOP OR DISPLAY. IT SETS UP A SPECIAL TTY INTERRUPT AND JUMPS OPERATION DIRECTLY TO THE SPECIFIED LABEL UPON TTY INTERRUPT ; VALUE TEST; INTEGER TEST; LABEL WHERETO; CODE; PROCEDURE READ1(IN,NO,P1); COMMENT READ1 AND READ2 ARE REALLY THE SAME PRO- CEDURE BUT WITH DIFFERENT LENGTH CALLS. THE READX PROCEDURE, WHICH THESE CALL, READS THE TTY OR PHOTO-READER DEPENDING UPON WHAT IS SPECIFIED (TAPE OR KEYBOARD). ; VALUE IN,NO; INTEGER IN,NO,P1; CODE; PROCEDURE READ2(IN,NO,P1,P2); COMMENT SEE READ1; VALUE IN,NO; INTEGER IN,NO,P1,P2; CODE; PROCEDURE DELAY; COMMENT DELAY BETWEEN SCANS; CODE; INTEGER IN_1,OUT_2,CHANNEL,CHANNEL2,GAIN2,RATE, RANGE,EXTSS,DONE,LOOP_0,DUMMY_0,I,J,K,MODE, 0 LISTOK,WHERE,HOWMANY,START,FINISH,PACED_0,FIRST,LAD_0, ADDRESS,FIRSTCHANNEL,SC,CO,GAIN,ANSR, TC,RS,BS,SS,HI,DI,USEGAIN_0,NUMBER,REPEATOK,SAVEHOWMANY, DIFFERENTIAL,STATUS,BUCKETS,QUANT,SAVE,ABRT1; INTEGER ARRAY CHANNELBUFFER[1:200],N[1:25]; COMMENT CHANNELBUFFER IS USED TO STORE THE CHANNEL CODES ; & & & & & & & REAL ARRAY DATA[1:200]; COMMENT DATA IS USED IN TWO WAYS. THE DRIVER FILLS THE SECOND HALF OF DATA WITH INTEGERS (CONVERSION DATA). CNVRT TAKES THESE INTEGERS AND PUTS REAL VOLTAGES INTO DATA IN A NORMAL WAY. THAT IS, READING ONE IS IN DATA [1] AND IS THE FIRST TWO COMPUTER WORDS IN THE ARRAY; REAL RDUMMY_0.0,RGAIN,RGAIN2; BOOLEAN FIRSTTIME_TRUE; LABEL INITIALIZE,BACK,NUMBERIN,GETOUT, HISTLIST,SINGLECHANNEL,TWOCHANNEL,DISPLAY, TAKEREADINGS,WAIT,HISTOGRAM, ABORT,TERM,RITEABORT,READIN, ENDLIST,LISTER,DIRECTIONS,INFO, REPEAT,READDIFF,NORMALIZE,DODISPLAY, GETREADINGS,DISABLELIST,INABORT,STATREAD; SWITCH OPERATE_INITIALIZE,INITIALIZE,DIRECTIONS, BACK,INITIALIZE,INITIALIZE, DISPLAY,REPEAT,LISTER,NORMALIZE; COMMENT THIS SWITCH USES 'WHERE' TO DETERMINE WHAT INFORMATION (IF ANY) MUST BE ENTERED BY THE USER. ; SWITCH DOIT_SINGLECHANNEL,TWOCHANNEL,BACK, BACK,SINGLECHANNEL,HISTOGRAM; COMMENT AGAIN, 'WHERE' IS THE ARGUMENT. ONLY THE FIRST 6 VALUES OF 'WHERE' CAN GET TO THIS SWITCH. THE 2ND REFERENCE FOR SINGLE- CHANNEL IS USED BY SEQUENTIAL SCAN ; FORMAT F1(/" 91000A VERIF 10/31/73"), F3(A2),F4(" NO= _"), F6(" CHANNEL_"), F9(" "),F11(" = _"), F12(" ??"),F13(" WANT DIRECTIONS? _"), F14(" DIFF? _"), F16(" AVERAGE? _"), F18(" 1ST CH"),F19(" 2ND CH"), Fy20(" ABORT"), F24(I10),F25(" START,FINISH= _"),F26(7X,F10.6," _"), F28(" RDGS TAKEN"),F29(F11.6," _"), F30(" NO FINISH:",I7," RDGS"), F31(I6),F32(14X,"_"), F33(//"1-200 RDGS TOTAL UNLESS NOTED"// "A PROMPTER IS ISSUED:"// ">"//"RESPOND WITH:"// " SINGLE CH = ONE CH"/, " TWO CH = ALTERNATING CHS"/, " SEQUENTIAL = FROM START CH"/, " HISTOGRAM = 1-32767 RDGS ON 1 CH ARE CATEGORIZED"/, " DISPLAY = LOOP ON 1 CH, DISPLAY RDGS IN B OR SW REG"/ " AVERAGE=YES: 16 WD AVG; BIT 0", " (LSB)=0.3125MV"/, " AVERAGE=NO: DISPLAY EACH RDG;", " BIT 4 (LSB)=5.0MV"/, " REPEAT = REPEAT LAST TEST AS SPECIFIED"/ " LIST = LIST ANY PART OF DATA BUFFER"/ " NORMALIZE = ISSUE SYSTEM NORMALIZE"/ " CONDITIONS = LIST COND THAT ARE SET"/ "INSTRUCTIONS = GIVE BRIEF INSTRUCTIONS"/ " TAPE = INPUT COMMANDS FROM TAPE-RDR"/ " KEYBOARD = INPUT COMMANDS FROM KEYBD"/ " * = COMMENT - IGNORE LINE"// "CONDITIONS:"// "SET DELAY (LIMITS SCAN RATE)"/ "SET PACER (OVERRIDES DELAY)"/ "SET REPEAT"// "CLEAR DELAY"/,"CLEAR PACER"/,"CLEAR REPEAT"/, "CLEAR ALL (CLEARS ALL COND)",//"NOTES:",// "SW15 = 1 CAUSES EXIT FROM LIST",// "ABORT REQUEST WITH NEG # (REPEAT DISABLED)",// "ABORT A TEST; EXIT REPEAT OR DISPLAY WITH ANY KEYBD KEY ", "(LIST DISABLED)",///); PROCEDURE READNUM; BEGIN READIN: WRITE(OUT,F6);WRITE(OUT,F11);CHANNEL_201; READ1(IN,1,CHANNEL); IF CHANNEL THEN GO INABORT; IF CHANNEL>15 THEN BEGIN WRITE(OUT,F12);GO READIN;END;CHANNEL_CHANNEL+16; END; COMMENT CLEAR OUT ANY ABORT MODES (FOR RESTART);r EXIT(0,GETOUT);WRITE(OUT,F1); CO_-1; IF FIRSTTIME THEN BEGIN INFO: WRITE(OUT,F13); READ1(IN,-1,ANSR); IF ANSR= "YE" THEN WRITE(OUT,F33) ELSE IF ANSR# "NO" THEN GO TO INFO; COMMENT IF THE PROGRAM WAS JUST LOADED, ALLOW THE INSTRUCTIONS TO BE PRINTED. C DON'T PRINT THE INSTRUCTIONS ON RESTART; CO_FIRSTTIME_FALSE; WRITE(OUT,F9); END; COMMENT INITIALLY NO DATA IS AVAILABLE TO LIST AND NO VALID TEST IS DEFINED (NO REPEAT ALLOWED); REPEATOK_0; & COMMENT LIST MUST, ALSO, BE DISABLED WHEN LOOPING; DISABLELIST: LISTOK_0; NORMALIZE: COMMENT ISSUE SYSTEM NORMALIZE; I2313(8,0,0,0,DUMMY,0,RDUMMY,0); BACK: COMMENT THE DESIRED TEST AND CONDITIONS ARE TO BE ENTERED; INTRP(WHERE,SC,TC,RS,BS,SS,HI,DI,ADDRESS,CO,LAD, REPEATOK,USEGAIN,LOOP,PACED,RATE,RANGE,EXTSS,LISTOK,IN); REPEATOK_LISTOK_FIRSTCHANNEL_-1; & & & & GO OPERATE[WHERE]; COMMENT THIS SWITCH DETERMINES WHETHER OR NOT A TEST REQUIRING INPUT HAS BEEN ENTERED < <<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> VALUE OF WHERE TEST ENTERED DESTINATION WHY ----- ------------ ----------- --- 1 SINGLE CHANNEL INITIALIZE GET NO OF READINGS 2 TWO CHANNEL INITIALIZE GET NO OF READINGS 3 INSTRUCTIONS DIRECTIONS GIVE INSTRUCTIONS 4 NONE BACK SPARE 5 SEQUENTIAL SCAN INITIALIZE GET NO OF READINGS 6 HISTOGRAM INITIALIZE GET NO OF READINGS 7 DISPLAY DISPLAY SKIP TO CHANNEL NO 8 REPEAT REPEAT DO TEST OVER 9 LIST LISTER LIST DATA 10 NORMALIZE NORMALIZE ISSUE SYS NORM <<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ; INITIALIZE: I_GAIN2_RGAIN2_1; J_NUMBER_STATUS_0;Q COMMENT GET NO. OF READINGS; NUMBERIN: HOWMANY_0; WRITE(OUT,F4); READ1(IN,1,HOWMANY); COMMENT NEGATIVE NO. ABORTS; IF HOWMANY THEN GO INABORT ELSE COMMENT IS IT A VALID NUMBER?; IF HOWMANY=0 OR NOT HI AND HOWMANY>200 OR TC AND HOWMANY=1 THEN BEGIN WRITE(OUT,F12); GO TO NUMBERIN; END; SAVEHOWMANY_HOWMANY; IF SS THEN WRITE(OUT,F18);READNUM; GO DOIT[WHERE]; COMMENT THIS SWITCH DETERMINES WHICH TEST TO BE CON- STRUCTED (SEE DEFINITION OF WHERE ABOVE); SINGLECHANNEL: COMMENT ALSO SEQUENTIALSCAN; CHANNELBUFFER[1]_CHANNEL; MODE_0; COMMENT FOR SEQUENTIAL SCAN ASK IF CHANNELS ARE DIFFERENTIAL OR SINGLE-ENDED AND SET THE INDICATOR; IF SS THEN BEGIN MODE_2; DIFFERENTIAL_0; READDIFF: WRITE(OUT,F14); DONE_0; READ1(IN,-1,DONE); IF DONE="AB" THEN GO INABORT; IF DONE="YE" THEN DIFFERENTIAL_-1 ELSE IF DONE#"NO" THEN GO READDIFF; END; GO TAKEREADINGS; TWOCHANNEL: COMMENT ON FIRST TIME THROUGH (ON EACH CALL TO 2C) SAVE FIRST CHANNEL INFORMATION AND GO BACK TO INPUT SECTION; IF FIRSTCHANNEL THEN BEGIN CHANNEL2_CHANNEL; FIRSTCHANNEL_0; READNUM;GO DOIT[WHERE]; END; & & & COMMENT FORM OUTPUT BUFFER CONTAINING ALTERNATING CHANNEL NUMBERS; FOR I_1 STEP 2 UNTIL 199 DO BEGIN CHANNELBUFFER[I]_CHANNEL2; CHANNELBUFFER[I+1]_CHANNEL; END; MODE_1; TAKEREADINGS: EXIT(-1,GETOUT); GETREADINGS: COMMENT INITIATE READINGS; I2313(8,2,PACED,MODE,CHANNELBUFFER[1],HOWMANY, DATA[101],DIFFERENTIAL); WAIT: COMMENT MAKE STATUS CALL TO SEE IF READINGS HAVE ALL BEEN TAKEN; I2313(8,1,STATUS,0,DUMMY,0,RDUMMY,0); IF STATUS THEN GO WAIT; COMMENT NOT DONE; COMMENT DONE; IF LOOP THEN BEGIN DELAY; GO GETREADINGS;END; & COMMENT CONVERT THE DATA FROM SINGLECHANNEL, TWOCHANNEL, OR SEQUENTIALSCAN. HERE ALL GAIN INFORMATION IS PASSED IN ONE CALL AND ALL DATA CONVERTED ; CNVRT(DATA[1],DATA[101],1.0,1.0,0,HOWMANY); DONE_2; EXIT(0,GETOUT); COMMENT CLEAR ABORT FEATURE; IF TC THEN BEGIN DONE_4; COMMENT CALL STATPAC TO OPERATE ON FIRST CHANNEL DATA ON TWOCHANNEL (STATPAC MODE = 3); WRITE(OUT,F18); STATPAC(DATA[1],N[1],3,HOWMANY); WRITE(OUT,F19); END ELSE IF NOT SC THEN BEGIN WRITE(OUT,F28); GO BACK; END; COMMENT CALL STATPAC FOR SECOND CHANNEL DATA ON TWOCHANNEL (MODE = 4) OR FOR ALL DATA ON SINGLECHANNEL (MODE = 2); STATPAC(DATA[1],N[1],DONE,HOWMANY); GO BACK; COMMENT ALL DONE, GO LOOK FOR A NEW COMMAND; & DISPLAY: READNUM; COMMENT ASK IF AVERAGE IS DESIRED; STATREAD: WRITE(OUT,F16); DONE_0; READ1(IN,-1,DONE); STATUS_0; IF DONE="AB" THEN GO INABORT; IF DONE="YE" THEN STATUS_-1 ELSE IF DONE#"NO" THEN GO STATREAD; DODISPLAY: DSPLY(CHANNEL,PACED,STATUS); GO DISABLELIST; COMMENT NOTHING TO LIST AFTER DISPLAY; REPEAT: IF DI THEN GO DODISPLAY; IF NOT HI THEN GO TAKEREADINGS; & HISTOGRAM: NUMBER_HOWMANY; RGAIN_1.0; HISTO(CHANNEL,PACED,RGAIN, NUMBER,BUCKETS,N[1],DATA[1]); COMMENT N[21] IS TRUE IF AN ABORT WAS MADE; IF N[21] THEN GO GETOUT; COMMENT THE NUMBER IS NEGATIVE IF THE HISTOGRAM TERM- INATES EARLY AND GIVES THE NUMBER OF READINGS YET TO TAKE; IF NUMBER THEN WRITE(OUT,F30,HOWMANY+NUMBER); COMMENT CALL STATPAC FOR THE HISTOGRAM CATEGORIES (STATPAC MODE = 1); STATPAC(DATA[1],N[1],1,BUCKETS); HISTLIST: COMMENT LIST ALL CATEGORIES FOUND IN HISTOGRAM; FOR I_1 TO BUCKETS DO BEGIN COMMENT CHECK SWITCH 15 TO ESCAPE FROM LIST; IF KEYS THEN GO TERM; WRITE(OUT,F29,DATA[I]); WRITE(OUT,F24,N[I]); END; TERM: IF LOOP THEN BEGIN WRITE(OUT,F9); GO TO HISTOGRAM; END; GO ENDLIST; COMMENT THIS IS THE LISTER CALLED BY THE LIST COMMAND; LISTER: IF HI THEN GO HISTLIST; START_FINISH_0; HOWMANY_SAVEHOWMANY; COMMENT READ THE FIRST AND LAST READING NUMBERS TO BE LISTED; WRITE(OUT,F25); READ2(IN,2,START,FINISH); COMMENT GET OUT IF EITHER IS NEGATIVE; IF START OR FINISH THEN GO BACK; COMMENT VALID FIRST AND LAST?; IF START>FINISH OR START=0 OR START>HOWMANY THEN GO TO LISTER; IF FINISH>HOWMANY THEN FINISH_HOWMANY; WRITE(OUT,F9); IF NOT TC THEN BEGIN COMMENT START LISTING GROUPS; FOR J_START TO FINISH DO BEGIN WRITE(OUT,F29,DATA[J]);WRITE(OUT,F9); IF KEYS THEN GO ENDLIST;END;END; COMMENT PRINT TWO COLUMNS FOR TWOCHANNEL; IF TC THEN BEGIN DONE_1; IF START MOD 2=0 THEN BEGIN DONE_-1; WRITE(OUT,F32); END; FOR I_START TO FINISH DO BEGIN WRITE(OUT,F29,DATA[I]); IF DONE THEN WRITE(OUT,F9); DONE_-DONE; & COMMENT ESCAPE?; IF KEYS THEN GO ENDLIST; END; IF NOT DONE THEN WRITE(OUT,F9); END; ENDLIST: WRITE(OUT,F9); GO BACK; COMMENT PRINT 'ABORT' AND DISABLE LIST. ALSO WILL DO A SYSTEM NORMALIZE; ABORT: LISTOK_0; RITEABORT: WRITE(OUT,F20); GO NORMALIZE; INABORT: COMMENT THIS IS WHERE A NEGATIVE INPUT SENDS YOU FOR ABORT; REPEATOK_0; GO RITEABORT; GETOUT: COMMENT THIS IS WHERE ABORT FEATURE SENDS YOU WHEN A TTY KEY IS PRESSED. WHEN LOOPING THIS IS A NORMAL EXIT AND IT IS NOT DESIRED THAT ABORT BE PRINTED; IF LOOP THEN GO DISABLELIST; GO ABORT; DIRECTIONS: REPEATOK_LISTOK_0; WRITE(OUT,F33); WRITE(OUT,F9); GO hG640BACK; END$ db6   91000-80004 A S 0306 HP 91000A VERFICATION CODE PROCEDURES - CODES             H0103 "ASMB,R,B,L,C HED 91000A VERIF -- CODE PROCEDURES 10/31/73 * * * THIS ASSEMBLY LANGUAGE PROGRAM * CONTAINS 8 CODE PROCEDURES USED * BY THE 91000A VERIFICATION PROGRAM. * * IT ALSO CONTAINS A PROGRAM FOR CONFIGURING * AND A NUMBER OF SERVICE SUB-ROUTINES USED * BY THE PROCEDURES * * THE DIFFERENT PROCEDURES ARE IDENTIFIED * BY THEIR ENTRY POINTS. * * 1. INTRP - COMMAND INTERPRETER * 2. CNVRT - CONVERTS DATA TO VOLTAGE * 3. EXIT - SET-UP AND CHECK FOR ESCAPE * 4. DELAY - DELAYS FOR SPECIFIED TIME (10 USEC MULTIPLES) * 5. HISTO - HISTOGRAM ROUTINE * 6. DSPLY - REGISTER DISPLAY ROUTINE * 7. STATP - COMPUTES AVG, P-P, HIGH, LOW, & RMS * 8. CNFGR - RECONFIGURE BCS AND CONFIGURE DSPLY/HISTO * 9. READX - READS FROM TTY OR PHOTOREADER WITH ENTRY * POINTS: READ1, READ2 * * NAM CODES ENT INTRP,CNVRT,STATP,DSPLY ENT HISTO,EXIT,CNFGR,DELAY ENT READ1,READ2,GONLY EXT .IOC.,.DIO.,.IOI.,.SQT.,SQRT,.IOR. EXT FLOAT,.FDV,.DTA.,.ENTR,.RTOI,.IAR. SUP HED 91000A VERIF -- CODE PROCEDURES -- INTRP 10/31/73 ********************************** * * * INTRP -- COMMAND INTERPRETER * * * ********************************** SPC 1 * THE PROMPTER IS ISSUED BY THIS PROCEDURE. * * THE COMMAND IS SCANNED AND THE PROPER * INDICATORS SET FOR THE ALGOL. * * ERRORS IN COMMANDS ARE TRAPPED AND THE * PROMPTER IS RE-ISSUED. * * WHEN SETTING THE PACER, ITS PARAMETERS ARE * REQUESTED AND READ. SPC 2 WHERE NOP SC. NOP TC. NOP RS. NOP BS. NOP SS. NOP HI. NOP DI. NOP NOP CO. NOP NOP RPTOK NOP GONLY NOP LOOP NOP PACED NOP NOP NOP NOP LSTOK NOP BATCH NOP SPC 1 INTRP NOP JSB .ENTR DEF WHERE SKP LDA CO.,I PRINT SSA COND|ITIONS? JMP .COND YES SPC 1 START JSB .IOC. WRITE OUT OCT 20002 THE JMP *-2 PROMPTER (>) DEF CMND AND HOLD ONE DEC 1 THE LINE SPC 1 JSB READ4 \\\\\\\\\\\ DEF *+4 READ IN \ DEF DEVYC THE > DEF MIN1 COMMAND/ DEF PIN /////////// SPC 1 CLB CLEAR LDA DI.,I DATA DISPLAY SSA IN SWITCH OTB 1 REGISTER SPC 1 LDA DESC IS THE AND UPPER INPUT A CPA ASTER COMMENT? JMP START YES SPC 1 LDA DESC CHECK COMMAND: CPA LI LIST? JMP LISTR YES CPA RE REPEAT? JMP REPET YES CPA SE SET A CONDITION? JMP SET MAYBE CPA CL CLEAR A CONDITION? JMP CLEAR YES SPC 1 CPA CO PRINT CONDITIONS? JMP COND YES SPC 1 CPA BA GO TAPE? JMP BAT YES CPA TY GO KEYBOARD? JMP TYPE1 YES SKP GO.ON LDA NB12 INITIALIZE STA CNTR1 COUNTERS LDA IASC AND STA PNTR1 POINTERS LDA NB10 FOR STA CNTR FINDING LDA PARAM TEST TO STA PNTR BE CALLED AGAIN LDA PNTR1,I HAS A TEST CPA DESC BEEN FOUND JMP EKUAL YES ISZ PNTR1 NO - POINT TO NEXT TEST ISZ CNTR1 CHECKED ALL TESTS & FOUND NONE? JMP AGAIN NO - LOOK AGAIN ERRR JSB ERROR YES - WRITE "??" JMP START GO GIVE PROMPTER AGAIN EKUAL INB TEST HAS BEEN FOUND - INC TEST # ISZ PNTR ADVANCE TEST BOOLEAN POINTER ISZ CNTR INC CNTR FOR VALID TEST BOOLEAN ZERO NOP ISZ CNTR1 DONE?  JMP EKUAL NO STB WHERE,I YES - SET TEST INDICATOR CCB FORM "TRUE" LDA PNTR,I GET BOOLEAN STA PNTR LOCATION LDA CNTR CHECK FOR VALID SSA,RSS TEST BOOLEAN? JMP INTRP,I NO SPC 1 CLA STA SC.,I \\\\\\\\\\\ STA TC.,I \ STA RS.,I CLEAR \ STA BS.,I PREVIOUS > STA SS.,I COMMAND / STA HI.,I / STA DI.,I /////////// SPC 1 STB PNTR,I SET TRUE INTO TEST JMP INTRP,I GO BACK TO ALGOL SKP LISTR LDA LSTOK,I IS THERE SSA A DATA BUFFER TO LIST? JMP GO.ON YES JMP ERRR NO SPC 1 REPET LDA RPTOK,I IS THERE A TEST SSA THAT CAN BE REPEATED? JMP GO.ON YES JMP ERRR NO SPC 1 SET LDA DES WHAT IS THE THIRD CHAR? AND UPPER WAS IT A T? CPA T RSS YES - SO IT IS SET JMP GO.ON NO - SO MUST BE SEQUENTIAL CCB GET CONDITION LDA ST TO BE SET RSS SPC 1 CLEAR LDA FROM GET COND TO BE CLEARED ALF,ALF POSITION AND AND B377 ISOLATE FIRST CHARACTER CPA P PACER COND? JMP PCR YES CPA R REPEAT COND? JMP LOP YES CPA D SET DELAY? JMP SETD YES CPA ALL CLEAR ALL CONDITIONS? JMP CLRAL YES JMP ERRR INVALID COND - WRITE "??" SPC 2 LOP STA LSTOK,I CLEAR LIST CAPABILITY STB LOOP,I SET OR CLEAR LOOP CONDITION JMP START RE-ISSUE PROMPTER CLRAL SSB CLEAR REQUEST? JMP ERRR NO STB LOOP,I YES - CLEAR LOOP STB PACED,I CLEAR PACER JMP SETD2 CLEAR DELAY SPC 1 BAT LDA FIVE \\\\ \\\\\\\ LBL1 JMP LBL2 OR NOP (NO P.R.)\ CLB,RSS \ TYPE1 LDB ABRT SET TAPE OR \ STB LBL4 KEYBOARD MODE > LDA ONE / LBL2 STA DEVYC / STA BATCH,I / JMP START /////////// SPC 1 SPC 1 PCR STB PACED,I SET OR CLEAR PACE MODE JMP START AND RE-ISSUE PROMPTER SPC 1 SKP .COND JSB .IOC. PRINT OUT OCT 20002 " COND:" JMP *-2 DEF MSG4 DEC 3 SPC 1 COND CLB STB CO.,I CLEAR COND REQUEST STB OUTBF INDICATOR LDA PACED,I PACED SSA,RSS CONDITION? JMP LABL1 NO - GO ON LDA P YES - SET UP IOR SPACE P TO PRINT ADB .CO.. STA B,I ISZ OUTBF SPC 1 LABL1 LDA LOOP,I REPEAT SSA,RSS CONDITION? JMP LABL2 NO - GO ON LDA R YES - SET UP IOR SPACE R TO PRINT LDB OUTBF ADB .CO.. STA B,I ISZ OUTBF SPC 1 LABL2 LDA DELC DELAY SSA,RSS CONDITION? JMP LABL5 NO - GO ON LDA D YES - SET UP IOR SPACE D TO PRINT LDB OUTBF ADB .CO.. STA B,I ISZ OUTBF SPC 1 LABL5 LDB OUTBF SET OUTPUT PRINT STB LABL7 LENGTH FOR CONDITIONS SZB WERE THERE ANY COND? JMP LABL6 YES - GO PRINT THEM LDA NO NO - SET UP STA .CO..,I NONE TO PRINT CLB,INB LDA NE ADB .CO.. STA B,I LDA TWO SET PRINT LENGTH STA LABL7 FOR NONE SPC 1 LABL6 JSB .IOC. PRINT OCT 20002 CONDITIONS JMP *-2 OR .CO.. DEF TOP NONE LABL7 NOP JMP START SETD SSB,RSS SET DELAY? JMP SETD2 NO SPC 1 *c JSB .IOC. YES- REQUEST OCT 20002 DELAY JMP *-2 VALUE DEF MSG7 DEC -8 SPC 1 JSB READ1 READ IN DEF SETD1 DELAY DEF DEVYC VALUE DEF ONE (# OF DEF PIN MILLISECONDS) SPC 1 SETD1 LDB PIN RBL,CLE,SLB,ERB ABORT? JMP START YES CMB,INB SET COUNTER FOR SETD2 STB DELC # OF MILLISECONDS JMP START SPC 2 ****************** * * * END OF INTRP * * * ****************** HED 91000A VERIF -- CODE PROCEDURES -- CNVRT 10/31/73 ******************************************* * * * CNVRT -- CONVERT DATA TO REAL VOLTAGE * * * ******************************************* SPC 1 * THIS ROUTINE TAKES INTEGER DATA STORED * IN THE UPPER 12 BITS OF EACH WORD OF * AN INTEGER ARRAY (IN THIS CASE, THE * UPPER HALF OF THE REAL ARRAY - DATA) * AND CONVERTS IT TO REAL VOLTAGE * STORING IT IN A REAL ARRAY (DATA). * * TWO GAINS ARE USED ALTERNATING BUT * BOTH WILL OFTEN BE THE SAME. SPC 2 VOLTS NOP DATA NOP GAIN1 NOP GAIN2 NOP FIRST NOP NUMBR NOP SPC 1 CNVRT NOP JSB .ENTR DEF VOLTS SPC 1 * ** INITIALIZE ** SPC 1 DLD GAIN1,I OBTAIN DST FGAIN GAIN1 DLD GAIN2,I OBTAIN DST SGAIN GAIN2 LDA NUMBR,I SET COUNTER CMA,INA FOR NUMBER OF READINGS STA NUMBR TO BE CONVERTED LDA DATA SET INPUT BUFFER ADA FIRST,I POINTER TO STARTING STA DATA POINT LDA FIRST,I SET OUTPUT BUFFER ALS POINTER ADA VOLTS TO STARTING STA VOLTS POINT SKP LDA TEST SET UP ALTERNATING TEST MORE STA DESC SAVE AŗLTERNATING TEST LDB XL3 GET SECOND GAIN SLA FIRST OR SECOND? LDB XL2 FIRST - GET FIRST GAIN STB XL4 SET PROPER GAIN LDA DATA,I GET RAW DATA WORD ARS,ARS DIVIDE BY 16 ARS,ARS (RIGHT JUSTIFY) JSB FLOAT MAKE INTO REAL NUMBER FMP .005 MAKE IT VOLTAGE JSB .FDV ADJUST VOLTAGE XL4 DEF FGAIN BY AMOUNT OF GAIN STA VOLTS,I STORE ISZ VOLTS VOLTAGE STB VOLTS,I IN OUTPUT ISZ VOLTS ARRAY (INTO ALGOL) ISZ DATA NEXT DATA ISZ NUMBR DONE? RSS NO JMP CNVRT,I YES - RETURN TO ALGOL LDA DESC GET ALTERNATING TEST RAR SWITCH ALTERNATING TEST JMP MORE NEXT DATA SPC 2 ****************** * * * END OF CNVRT * * * ****************** HED 91000A VERIF -- CODE PROCEDURES -- EXIT 10/31/73 ********************************************* * * * EXIT -- SET UP AND CHECK TTY FOR ESCAPE * * * ********************************************* SPC 1 * THE TTY TRAP CELL LINK IS MADE * TO POINT AT I.EX BELOW SO THAT * AN INTERRUPT FROM THE TTY COMES HERE. * * THE LINK IS RESTORED ON INTERRUPT AND * CONTROL SENT TO A LABEL PASSED IN THE CALL. * * A CLEAR REQUEST HERE RESTORES THE LINK. * * THE 91000A TRAP CELL IS RESTORED WHENEVER * THE TTY LINK IS RESTORED. SPC 2 TEST1 NOP LABEL NOP SPC 1 EXIT NOP JSB .ENTR DEF TEST1 SPC 1 LDA TEST1,I LBL4 INA,SZA SET UP? JMP RSET NO - GO CLEAR IT JSB CHECK YES - IS TTY BUSY? LDA TTYIN GET NEW TRAP CELL LINK STA TTYL,I SET UP LINK LDA INTTY GET TTY INPUT MODE WORD AND OTA1 OTA TTY OUTPUT STCC1 STC TTY,C ENCODE| *($ THE TTY FOR INPUT JMP EXIT,I SPC 1 RSET JSB CLRIT GO CLEAR JMP EXIT,I SPC 1 I.EX NOP INTERRUPT ENTRY POINT JSB CLRIT GO CLEAR JMP LABEL,I GO TO ALGOL INTERRUPT POINT SPC 1 CLRIT NOP LDA TTYLC GET BCS TTY LINK CLC1 CLC TTY TURN OFF TTY STF1 STF TTY RESTORE FLAG STA TTYL,I RESTORE TRAP LINK CLC2 CLC .2313 TURN OFF 91000A LDA TCC RESTORE STA SC,I TRAP CELL STF2 STF .2313 JMP CLRIT,I SPC 1 * ** END OF EXIT ** * HED 91000A VERIF -- CODE PROCEDURES -- DELAY 10/31/73 ************************************************* * * * DELAY -- WAIT A SPECIFIED TIME INTERVAL * * * ************************************************* SPC 2 DELAY NOP ISZ DELAY SET RETURN POINT STA ASAVE SAVE A REGISTER LDA DELC GET 10 USEC MULTIPLE SZA,RSS IS IT 0? JMP DEL2 YES - JUST RETURN (NO DELAY) STA COU1 NO - SET COUNTER SPC 1 DEL1 LDA MIN2 GET 10 USEC COUNTER ISZ A \ JMP *-1 \ COUNT ISZ COU1 / DOWN JMP DEL1 / SPC 1 DEL2 LDA ASAVE RESTORE A REGISTER JMP DELAY,I SPC 1 * ** END OF DELAY ** HED 91000A VERIF -- CODE PROCEDURES -- DSPLY/HISTO 10/31/73 ****************************************** * * * DSPLY/HISTO -- COMBINED PROCEDURES * * * * DSPLY -- ADC DISPLAY FOR CALIBRATION * * HISTO -- HISTOGRAM ROUTINE * * * ****************************************** SPC 1 * DSPLY OR HISTO IS ENTERED AND * INITIAL SET-UP WHICH IS COMMON * IS ACCOMPLISHED. SPC 1 *************************************************** * * * COMBINED ENTRY POINT FOR BOTH DSPLY AND HISTO * * * *************************************************** SPC 2 * ** CALLING PARAMETER LIST ** SPC 1 CHANN NOP PACER NOP GAIN NOP QUANT NOP BUKTS NOP NBUFF NOP RBUFF NOP SPC 1 * ** START OF ROUTINE ** SPC 1 HISTO NOP DSPLY EQU HISTO JSB .ENTR DEF CHANN SPC 1 JSB EXIT SET UP DEF *+3 TTY ESCAPE DEF MIN1 CAPABILITY DEF ABORT SPC 1 LDA DI.,I DISPLAY SSA MODE? JMP K6 YES LDB NBUFF SET ADB D20 UP STB ATEST ABORT STA ATEST,I INDICATOR SKP K6 CLA STA SC,I CLEAR THE TRAP CELL SPC 1 LDA N.16 SET MPX STA MASK HISTO MASK SPC 1 LDA CHANN,I GET MPX ADDRESS IOR B1513 AND FORM COMMAND WORD LDB PACER,I TO BE SSB PACED? IOR BIT12 YES OTA5 OTA .2313 SET UP CHANNEL STCC5 STC .2313,C NUMBER LDA DI.,I IS THIS SSA,RSS DISPLAY MODE? JMP HIST NO - THEN HISTOGRAM * * THIS IS THE REGISTER DISPLAY ROUTINE * LDA JMPX LDB GAIN,I 16 WORD AVERAGE? SSB CLA NO - DISPLAY EACH READING STA JMPY YES LDA LDAX SET SSB,RSS PROPER LDA LDAY WORD STA LDAW COUNTER DISP CLA CLEAR SUM TO MAKE STA SUM ROOM FOR NEXT DISPLAY LDAW LDA N.16 OR MIN1 -- SET WORD COUNTER STA CNTR REED SFS .2313 JMP *-1 LIA1 LIA .2313 GET A DATA WORD STA KTVU AND SAVE IT LDA PACER,I SSA,RSS PACED? JSB DELAY NO - SO DELAY NOP YES - CONTINUE LDA KTVU AND BEXL4 STCC6 STC .2313,C START NEXT READING JMPY JMP AHEAD OR NOP FOR AVG. ARS,ARS DIVIDE ARS,ARS BY 16 ADA SUM ADD DATA AHEAD STA SUM TO THE SUM ISZ CNTR DONE WITH AVG? JMP REED NO - GET NEXT DATA WORD LDB SUM YES - DISPLAY RESULT IN THE OTB 1 B & SWITCH REGISTERS JMP DISP START NEW AVERAGE JMPX JMP AHEAD SPC 2 * ** END OF DISPLAY LOOP PORTION OF DSPLY/HISTO ** SKP * HERE BEGINS THE HISTOGRAM PORTION SPC 1 HIST CCA INITIALIZE # ADA NBUFF BUFFER STA NBUFF POINTER LDA FSTIM SET STA K8 FIRST TIME LDA QUANT,I SET STA EQTAD CMA,INA NUMBER STA QUANT,I COUNTER SPC 1 SFS5 SFS .2313 IGNORE FIRST JMP *-1 READING (GARBAGE) SSB,RSS PACED? JSB DELAY NO - SO DELAY NOP STCC7 STC .2313,C START FIRST GOOD READING CLA,INA \ STA J J_1 STA K K_1 LDA RBUFF SET ADA B62 POINTER STA PNTR / ADA MIN1 / STA INARY / SPC 1 READ SFS .2313 JMP *-1 LIA2 LIA .2313 GET READING (R) LDB PACER,I \ DELAY BETWEEN SSB,RSS > READINGS IF JSB DELAY / NOT PACED NOP ANRDG STC .2313,C START NEXT READING AND MASK K8 JMP STORE 1ST TIME (NOP THE REST) EQUAL JSB HCHK IS R=,>, OR < D[J]? ISZ PNTR R>D[J] ISZ J J_J+1 LDB J \ CMB,INB \ IS ADB K / J>K? SSB,RSS / JMP EQUAL NO LDB K \ YES CPB D20 K=20? JMP DONE YES - TOO MANY BUCKETS ISZ K NO - K_K+1 (NEW BUCKET) FSTIM JMP STORE SPC 1 INCR LDB NBUFF \ ADB J > N[J]_N[J]+U ISZ B,I / JMP CHEK SKP LOWER LDB J \ CPB ONE2 J=1? JMP K11 YES ADB MIN1 \ NO STB J \ LDB PNTR > J_J-1 ADB MIN1 / STB PNTR / JSB HCHK IS R=,>, OR < D[J]? ISZ J ISZ PNTR K11 LDB K R>D[J] CPB D20 K=20? JMP DONE YES - TOO MANY BUCKETS STB I NO - I_K 6 ISZ K K_K+1 (NEW BUCKET) STA TEMP SAVE R SPC 1 SORT LDB INARY \\\\\\\\\\\\ ADB I \ \ LDA B,I > D[I+1]_ \ INB / D[I] \ STA B,I / \ LDB NBUFF \ \ ADB I \ \ LDA B,I > N[I+1]_N[I] \ SORT INB / / UP STA B,I / / LDB I \ / CPB J \ I=J? / JMP *+4 YES - DONE / ADB MIN1 NO - I_I-1 / STB I / / JMP SORT //////////// SPC 1 LDA TEMP RESTORE R SPC 1 STORE STA PNTR,I D[J]_R LDB NBUFF \ ADB J \ N[J]_1 CLA,INA / STA B,I / CLA SET FIRST TIME INSTRUCTION STA K8 FOR REMAINING READINGS SPC 1 CHEK ISZ QUANT,I DONE? JMP READ NO - ANOTHER READING CLA SFS7 SFS .2313 YES JMP *-1 LDB CLEAN ISSUE OTA6 OTB .2313 CLEAN STCC8 STC .2313,C UP SKP * FINISHED FILLING THE BUCKETS SPC 1 STA BOTOM LDA RBUFF \ STA OUTRY \ ISZ INARY \ SET UP CALL LDA GAIN / TO CNVRT STA G1 / STA G2 / JSB CNVRT CALL DEF NDLST CNVRT OUTRY NOP \ INARY NOP \ G1 NOP \ PARAMETER G2 NOP / LIST DEF ZERO / DEF K / NDLST LDA K SET NUMBER OF BUCKETS STA BUKTS,I FOR RETURN SPC 1 LDA EQTAD \ ADA TEST2 \ IOR BOTOM \ IF (HOWMANY<10000 OR AND LOOP,I / BUCKETS>20) AND LOOP SSA,RSS / THEN WAIT JMP SFS8 / LDA N.4 \ STA BOTOM \ CLA \ STA TOP \ WAIT ISZ TOP / LOOP: JMP *-1 / (1-2.5 SEC) ISZ BOTOM / JMP *-5 / SPC 1 SFS8 SFS .2313 JMP *-1 SPC 1 ENND JSB CLRIT CLEAR ESCAPE CAPABILITY JMP HISTO,I GO BACK TO ALGOL SPC 1 ABORT LDA HI.,I DISPLAY SSA,RSS MODE? JMP ENND YES STA ATEST,I SET ABORT INDICATOR JMP ENND SPC 2 DONE CCA TOO MANY BUCKETS JMP SFS7 SPC 2 **************************** * * * END OF DSPLY/HISTO * * * **************************** HED 91000A VERIF -- CODE PROCEDURES -- STATPAC 10/31/73 ************************************************** * * * STATPAC -- CALCULATE AVG, P-P, HI, LO, & RMS * * * ************************************************** SPC 1 * THIS PROCEDURE CALCULATES THE AVERAGE OF ALL READINGS TAKEN ON * ONE CHANNEL IN THE SINGLE CHANNEL, TWO CHANNEL, OR HISTOGRAM * TESTS. IT ALSO CALCULATES THE HIGHEST AND LOWEST VALUES AND * THEIR DIFFERENCE (PEAK-TO-PEAK). FINALLY, IT CALCULATES THE * RMS ERROR BETWEEN THE READINGS AND THE AVERAGE. IT THEN PRINTS * THESE RESULTS. * * * MODE = 1 FOR HISTOGRAM * MODE = 2 FOR SINGLE CHANNEL * MODE = 3 FOR TWO CHANNEL (1ST CHANNEL) * MODE = 4 FOR TWO CHANNEL (2ND CHANNEL) SPC 2 RDGS NOP #TAKN NOP MODE NOP #RDGS NOP SPC 1 STATP NOP JSB .ENTR DEF RDGS SPC 2 LDB #RDGS,I \\\\\\\\\\\\\\\\\\\\\\\ LDA MODE,I \ CPA ONE2 TOTAL_ IF MODE=1 THEN 0 \ JMP LBL5 ELSE IF MODE=2 THEN \ CPA TWO HOWMANY ELSE \ RSS HOWMANY/2; \ BRS  / SZB,RSS TOTAL NEVER <1 / INB IF MODE#0 / RSS / LBL5 CLB / STB TOTAL /////////////////////// SPC 1 CLB DIV TWO STA QUOT MODE\2 STB REMDR AND MODE MOD 2 CLA CLB DST RMS RMS_AVG_0.0; DST AVG INA STA NUM NUMBER_1; CMA ADA RDGS STA RDGS SKP LDA QUOT \\\\\\\\\\\\\\\\\\\\\\ IOR REMDR \ ALS MEAN_BOTTOM_ \ ADA RDGS DATA[MODE\2 OR \ STA TEMP MODE MOD 2]; / DLD TEMP,I / DST BOTOM / DST MEAN /////////////////////// SPC 1 LDA MODE,I --------------------------\ CPA ONE2 \ JMP XYZ1 \ DLD BOTOM \ JMP XYZ2 TOP_IF MODE=1 THEN \ XYZ1 LDA #RDGS,I DATA[HOWMANY] ELSE BOTTOM; > ALS / ADA RDGS / STA TEMP / DLD TEMP,I / XYZ2 DST TOP --------------------------/ SPC 1 ******************************************************************** CCA * * ADA #TAKN * * STA #TAKN * FOR I_MODE * LDA QUOT * STEP MODE\2+MODE MOD 2 * ADA REMDR * UNTIL HOWMANY DO * STA STEP * * LDA MODE,I * BEGIN * XYZ3 STA I ******************************** *  * LDB A ******************************** CMB,INB * * ADB #RDGS,I * ** TEST FOR END OF LOOP ** * SSB * * JMP XYZ10 * DONE! * * ******************************** * * ALS \ * ADA RDGS \ * STA TEMP > VOLTAGE_DATA[I]; * DLD TEMP,I / * DST VOLTS / * * * LDA MODE,I \\\\\\\\\\\\\\\\\ * CPA ONE2 \ * RSS \ * JMP XYZ4 \ * LDA I \ \ * ADA #TAKN \ NUMBER_ > MODE=1 * LDA A,I / NUMBERTAKEN[I]; / * STA NUM / / * ADA TOTAL \ TOTAL_ / * STA TOTAL / TOTAL+NUMBER; / * JMP XYZ6 ///////////////// * SKP XYZ4 DLD TOP \\\\\\\\\\\\\\\\\\\\ * FSB VOLTS \ \ * SSA,RSS \ IF VOLTAGE>TOP \ * JMP XYZ5 / THEN TOP_ \ * DLD VOLTS / VOLTAGE; \ * DST TOP / \MODE * XYZ5 DLD VOLTS \ / #1 * FSB BOTOM \ IF VOLTAGE AVG_MEAN+AVG/TOTAL; FDV TOTAL / FAD MEAN / DST AVG / SKP ******************************************************************** LDA QUOT * FOR I_MODE\2 OR MODE MOD 2 * IOR REMDR * STEP MODE\2+MODE MOD 2 * XYZ7 STA I * UNTIL HOWMANY DO BEGIN * * ******************************** * * LDB A ******************************** CMB,INB * * ADB #RDGS,I * ** TEST FOR END OF LOOP ** * SSB * * JMP XYZ11 * DONE! * * ******************************** * * CLB,INB \\\\\\\\\\\\\\\\\\\\\\ * CPB MODE,I \ * RSS \ * JMP XYZ8 \ MODE * ADA #TAKN \  / =1 * LDA A,I > NUMBER_ / * STA NUM / NUMBERTAKEN[I]; / * * ////////////////////// * * * XYZ8 LDA I \----------------------\ * ALS \ ) \ * ADA RDGS \ (DATA[I] ) \ * STA TEMP > -AVG) ) \ * DLD TEMP,I / ) \ * FSB AVG / ) RMS_ \ * DST TEMP / ) RMS+ \ * JSB .RTOI \ ) (DATA[I] \* DEF TEMP \ ( )^2 ) -AVG)^2 * DEF TWO / ) *NUMBER/* DST TEMP / ) / * LDA NUM \ ) / * JSB FLOAT > ( )^2*NUMBER ) / * FMP TEMP / ) / * FAD RMS \ RMS_RMS+ ) / * DST RMS / ( )^2*NUMBER; ) / * * -----------------------/ * * * LDA I ******************************** ADA STEP * NEXT I * JMP XYZ7 * * ******************************************************************** SKP XYZ11 DLD RMS \ FDV TOTAL \ RMS_ JSB SQRT / SQRT(RMS/TOTAL); DST RMS / SPC 1 *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ LDA TWO + + CLB + WRITE(OUT,FOR1,AVG,TOP- + JSB .DIO. + BOTTOM,TOP,BOTTOM,RMS); + DEF FOR1 + + DEF ND ++++++++++++++++++++++++++++++++ * 7 + DLD AVG \ PRINT + JSB .IOR. / AVG + * + JSB .DTA. + * + ND LIA 1 \ + AND LOOP,I \ SKIP REST OF PRINT + SSA / IF LOOP AND SW15 + JMP .END / + * + LDA TWO \ + CLB \ + JSB .DIO. > SET UP REST OF PRINT + DEF FOR2 / + DEF .END / + * + DLD TOP \ + FSB BOTOM > PRINT + JSB .IOR. / P-P + * + DLD TOP \ PRINT + JSB .IOR. / HI + * + DLD BOTOM \ PRINT + JSB .IOR. / LO + * + DLD RMS \ PRINT + JSB .IOR. / RMS + * + * ++++++++++++++++++++++++++++++++ * + + JSB .DTA. + END OF PRINT + * + + *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++,.B@<++++++++ SPC 2 .END JMP STATP,I SPC 2 ******************** * * * END OF STATPAC * * * ******************** SB HED 91000A VERIF -- CODE PROCEDURES -- CNFGR 10/31/73 ***************************************** * * * CNFGR -- CONFIGURE I/O INSTRUCTIONS * * * ***************************************** SPC 1 * WHEN STARTING ADDRESS IS OCTAL 2000 * A JUMP TO HERE OCCURS SO THAT ALL * DEVICES CAN BE IDENTIFIED. SPC 2 CNFGR CLC 0,C CLA JSB FRST SAVE SOME LOCATIONS (1ST TIME) LDB TTYLC \\\\\\\\\\\\\\\\\\\ STB TTYL,I RESTORE TTY LINK \ LDB TCC RESTORE 91000A \ STB SC,I TRAP CELL \ NOP CLEAR ALL \ NOP POSSIBLE \ NOT STA LOOP,I TEST \ FIRST STA PACED,I CONDITIONS / TIME STA DELC / INA SET / STA DEVYC KEYBOARD / STA BATCH,I MODE / LDA ABRT SET ABORT FEATURE / STA LBL4 /////////////////// SPC 1 JSB ADDRS GET EQT ADDRS LDA TWO SET EQT LENGTH STA B,I TO TWO INB MAKE ADDRS OF 1ST WORD STB EQTAD OF TTY ENTRY AND SAVE ADB THREE MAKE ADDRS OF 4TH WORD LDA B,I OF TTY ENTRY AND GET DRVR ADRS STA TAD SAVE DRIVER D.00 ENTRY POINT LDB EQTAD,I GET OLD SELECT CODE LDB B,I GET TRAP CELL CONTENTS SPC 1 IN1 LIA 1 READ NEW SELECT CODE AND B77 AND ISOLATE IT JSB SCHK IS IT VALID? HLT 1B NO JMP IN1 TRY AGAIN STA EQTAD,I YES - PUT IN EQT STA TTYSC SAVE SC FOR TTY LDA TTYSC,I SAVE CONTENTS OF CELL FOR STA TTY11 ANOTHER DEVICE STB TTYSC,I SET TTY TRAP CELL SPC 1 JSB .IOC. CLEAR I/O ONE2 OCT 1 ON! TTY SKP IN2 LDA DMES1 GO GET 91000A LDB ML2 SELECT JSB GETIT CODE CPA TTYSC SAME AS TTY? RSS YES - OOPS! JSB SCHK IS IT VALID? JSB ERROR NO JMP IN2 TTY AGAIN STA SC SAVE SELECT CODE SPC 1 JSB ADDRS GET EQT ADDRS ADB FIVE SET FOR 91000A STB EQTAD ENTRY AND SAVE LDB B,I GET OLD 91000A SC STA EQTAD,I SET NEW 91000A SC LDA B,I GET TRAP CELL CONTENTS CPB TTYSC MAKE SURE THIS IS THE LDA TTY11 PROPER TRAP CELL CONT. STA TCC SAVE CONTENTS STA SC,I SET NEW TRAP CELL SPC 2 IN3 LDA DMES2 GO GET PHOTO- LDB ML2 READER SELECT JSB GETIT CODE SZA,RSS IS IT ZERO? JMP TONLY YES - NO PHOTOREADER CPA TTYSC SAME AS TTY? JMP *+4 YES - OOPS! CPA SC SAME AS 91000A? RSS YES - OOPS TOO! JSB SCHK IS IT VALID? JSB ERROR NO JMP IN3 TRY AGAIN STA TSC SAVE SELECT CODE SPC 1 JSB ADDRS GET EQT ADDRS LDA THREE CHANGE EQT LENGTH STA B,I TO THREE LDA TSC GET PR SELECT CODE ADB B11 SET EQT ADDRS FOR PR ENTRY STA B,I PUT NEW SC IN EQT LDA TTYSC,I GET TTY TRAP CELL CONTENTS STA TSC,I AND SET FOR PR ADB THREE SET EQT ADDRS FOR DRVR ENTRY LDA TAD GET TTY DRIVER ENTRY STA B,I AND SET INTO PR EQT ENTRY SPC 1 LDA LBL3 SET UP TAPE MODE RSS FOR PHOTO-READER TONLY CLA SET UP TAPE MODE STA LBL1 FOR TTY SKP LDA SC GET 91000A SELECT CODE IOR SFSX FORM SFS XX INSTRUCTION (91000A) STA SFS5 \ STA READ \ AND STA SFS7 > W STORE IT STA SFS8 / STA REED / SPC 1 XOR B500 FORM OTA XX INSTRUCTION (91000A) STA OTA5 \ AND STA OTA6 / STORE IT SPC 1 IOR B1100 FORM STC XX,C INSTRUCTION (91000A) STA STCC5 \ STA STCC6 \ AND STA STCC7 > STORE IT STA ANRDG / STA STCC8 / SPC 1 XOR B9B11 FORM CLC XX INSTRUCTION (91000A) STA CLC2 AND STORE IT SPC 1 XOR B4600 FORM STF XX INSTRUCTION (91000A) STA STF2 AND STORE IT SPC 1 IOR B400 FORM LIA XX INSTRUCTION (91000A) STA LIA1 \ AND STA LIA2 / STORE IT SPC 1 LDA OTA6 IOR B4600 STA OTA6 SPC 1 LDA TTYSC SET IOR OTAX MODE STA OTA1 COMMAND IOR B1100 FORM STC XX,C INSTRUCTION (TTY) STA STCC1 AND STORE IT XOR B9B11 FORM CLC XX INSTRUCTION (TTY) STA CLC1 AND STORE IT XOR B4600 FORM STF XX INSTRUCTION (TTY) STA STF1 AND STORE IT LDA TTYSC,I SAVE TRAP AND B77 CELL LINK STA TTYL AND LINK LDA A,I CONTENTS STA TTYLC (TTY) JMP 2B GO ON TO ALGOL SKP ************************************************* * * * GETIT -- GET TTY OR PHOTOREADER SELECT CODE * * * ************************************************* SPC 2 GETIT NOP STA MESS PUT MESSAGE PARAMETERS STB ML INTO CALL TO IOC JSB .IOC. OUTPUT OCT 20002 REQUEST JMP *-2 FOR A MESS NOP SELECT ML NOP CODE CLA,INA \ CLB,INB \ JSB .DIO. \ DEF FMT3 ׋ > INPUT NEW DEF *+2 / SELECT CODE JSB .IOI. / JMP GETIT,I / SPC 3 ************************************************* * * * FRST - SAVE SOME LOCATIONS, FIRST TIME ONLY * * * ************************************************* SPC 2 ORG WHERE FRST NOP LDB LBL4 SAVE ABORT STB ABRT CAPABILITY LDB LBL1 SAVE NORMAL STB LBL3 TAPE MODE LDB DEFIO GET ELB,CLE,ERB AND LDB B,I SAVE ADB B301 *FMT ERROR STB DEFIO ADDRESS LDB DEFER SET UP *FMT STB DEFIO,I ERROR ESCAPE ISZ DEFIO AND RETURN LDB FRST CLEAR THE ADB MIN1 CALL TO STA B,I THIS ROUTINE ADB EQTAD RETURN TO CNFGR ROUTINE JMP B,I AFTER "NOT FIRST TIME" AREA SPC 1 B301 OCT 301 USED ONLY BY DEFER JMP FMTER THIS ROUTINE ORR SKP ***************************************** * * * SCHK -- CHECK FOR VALID SELECT CODE * * * ***************************************** SPC 2 SCHK NOP STA GETIT SAVE SC ADA NB10 IS IT SSA MORE THAN 7? JMP SCHK,I NO - ERROR RETURN SPC 1 LDA GETIT IS IT CMA,INA LESS THAN ADA B67 70? SSA JMP SCHK,I NO - ERROR RETURN LDA GETIT RESTORE SC ISZ SCHK SET OK ISZ SCHK RETURN JMP SCHK,I SPC 4 ******************************* * * * ADDRS -- FIND EQT ADDRESS * * * ******************************* SPC 2 ORB ADDRS NOP LDB SQTAD GET SQT ADDRESS 3 SSB,RSS IS IT INDIRECT? JMP *+4 NO ELB,CLE,ERB YES - ELIM I BIT LDB B,I GET NEXT LEVEL JMP *-4 GO CHECK AGAIN ADB SIX OK, MAKE EQT ADDRESS JMP ADDRS,I HED 91000A VERIF -- CODE PROCEDURES -- SERVICE ROUTINES ******************************************* * * * CHECK -- WAIT FOR TTY TO BE AVAILABLE * * * ******************************************* SPC 2 CHECK NOP JSB .IOC. STATUS CALL OCT 40001 TO IOC SSA BUSY JMP *-3 YES JMP CHECK,I NO SPC 4 ********************************* * * * ERROR -- PRINT " ??" ON TTY * * * ********************************* SPC 2 ERROR NOP JSB .IOC. OUTPUT OCT 20002 MESSAGE JMP *-2 TO DEF WRONG TTY DEC -3 ( ??) JMP ERROR,I SKP *********************************************** * * * HCHK -- CHECK FOR R=,>, OR < D[J] (HISTO) * * * *********************************************** SPC 2 HCHK NOP LDB PNTR,I \ CPA B R=D[J]? JMP INCR YES SSA NO - R<0? JMP *+4 YES SSB NO - D[J]<0? JMP HCHK,I YES - (R>D[J]) JMP *+3 NO SSB,RSS - D[J]<0? JMP LOWER NO - (RD[J]? SSB / JMP LOWER NO - (RD[J]) SPC 3 *************************************** * * y * FORMATTER OVERLAY FOR *FMT ERRORS * * * *************************************** SPC 2 FMTER LDB BIGST GET LARGE NUMBER LDA NMBR,I \ AND HI.,I > HISTO & READ1? SSA / CLB YES - GET A 0 STB P1,I PUT 0 OR LG # IN PARAMETER JMP DEFIO,I RETURN TO FORMATTER ORR HED 91000A VERIF -- CODE PROCEDURES -- READX 10/31/73 ******************************************** * * * READX -- READ FROM TTY OR PHOTO-READER * * * ******************************************** SPC 1 * THIS ROUTINE READS A 72 CHARACTER * STRING FROM EITHER THE TTY OR * THE PHOTOREADER. * * FOR THE PHOTOREADER, THE ENTIRE * STRING IS PRINTED ON THE TTY. * * FOR NUMBERS THE FORMATTER IS * THEN USED FOR INTERNAL CONVERSION. SPC 2 * ** CALLING PARAMETER LIST ** SPC 1 DVICE NOP NMBR NOP P1 NOP NOP NOP NOP SPC 2 * ** START OF ROUTINE ** SPC 1 READ4 NOP ALL ENTRY READ1 EQU READ4 NAMES ARE READ2 EQU READ4 THE SAME JSB .ENTR DEF DVICE SPC 1 LDA DVICE,I IOR REDIT SET READ REQUEST STA *+2 AND STORE IT JSB .IOC. READ THE OCT 10401 OR OCT 10005 JMP *-2 PHOTOREADER DEF DESC OR TTY LONG DEC -72 (72-CHAR STRING) LDA DVICE,I GET DEVICE TYPE IOR BIT14 MAKE STATUS REQUEST CODE STA *+2 AND STORE IN CALL STAT JSB .IOC. CHECK INPUT OCT 40005 UNIT STATUS SSA DONE? JMP STAT NO - TRY AGAIN ELB,CLE,ERB YES - USE TRANS LOG LDA B SET NEGATIVE CMA,INA FOR CHARACTERS STA L41 SET OUTPUT STRING LENGTH ] SKP LDA B SET POINTER INA TO FIRST B1100 ARS UNUSED ADA DEFST BUFFER STA PNTR WORD INB STORE ADB LONG COMMA BRS PAIRS SZB,RSS IN JMP LW1 THE LDA COMMA REST STA PNTR,I OF ISZ PNTR THE INB,SZB STRING JMP *-3 BUFFER SPC 1 LW1 CLB,INB PHOTO- CPB DVICE,I READER? JMP L42 NO - TTY JSB .IOC. OUTPUT OCT 20002 THE JMP *-2 STRING DEF DESC ON TTY L41 DEC -72 SPC 1 L42 LDA NMBR,I FREE-FIELD NUMBERS SSA OR ASCII CHAR? JMP ALPHA ASCII JSB CHECK WAIT FOR TTY TO FINISH CLA \\\\\\\\\\\\\ CLB,INB \ JSB .DIO. \ DEFST DEF DESC \ OCT 0 CALL FOR \ DEF L43 INTEGER / LDA NMBR,I CONVERSION / LDB P1 / JSB .IAR. / L43 JMP READ4,I ///////////// ALPHA LDA DESC MOVE ASCII CHARACTERS STA P1,I INTO PROPER STORAGE JMP READ4,I SPC 2 ****************** * * * END OF READX * * * ****************** HED 91000A VERIF -- CODE PROCEDURES -- CONSTANTS, ETC *************************************** * * * CONSTANTS, STORAGE, MESSAGES, ETC * * * *************************************** SPC 1 * ** CONSTANTS ** SPC 1 ORB A EQU 0 ALL OCT 101 INTRP ASTER OCT 25000 INTRP SPC 1 B EQU 1 BA ASC 1,TA INTRP B11 OCT 11 INTRP,CNFGR B62 OCT 62 DSPLY/HISTO B67 OCT 67 SCHK B77 OCT 77 CNFGR B377 OCT 377 INTRP B400 OCT 400 INTRP,CNFGR B500 OCT 500 CNFGR B1513 OCT 120000 DSPLY/HISTO B9B11 OCT 5000 CNFGR B4600 OCT 4600 CNFGR BIT12 OCT 10000 DSPLY/HISTO BIT14 OCT 40000 READX BIGST OCT 77777 FMTER BEXL4 OCT 177760 DSPLY/HISTO SPC 1 CL ASC 1,CL INTRP CLEAN OCT 120000 DSPLY/HISTO CMND ASC 1,>_ INTRP CO ASC 1,CO INTRP COMMA ASC 1,,, READX SPC 1 D OCT 104 INTRP ASC(NULL D) D20 DEC 20 DSPLY/HISTO DEFIO DEF .DTA. CNFGR DEVYC OCT 1 INTRP,CNFGR DMES1 DEF MES1 CNFGR DMES2 DEF MES2 CNFGR SPC 1 FIVE OCT 5 INTRP,CNFGR FMT3 ASC 4,(K6) GETIT FOR1 ASC 9,(" AVG="F10.6"_") STATPAC FOR2 ASC 24,(" PP="F10.6" HI="F10.6" LO="F10.6" RMS="F10.8) SKP * ** CONSTANTS, CONT. ** SPC 1 SPC 1 IASC DEF NO INTRP INTTY OCT 140000 EXIT SPC 1 LDAX LDA N.16 DSPLY LDAY LDA MIN1 DSPLY SPC 1 MES1 OCT 6412 CNFGR ASC 11, 91000A SELECT CODE= _ CNFGR MES2 ASC 12, TAPE-RDR SELECT CODE= _ CNFGR MIN1 OCT -1 INTRP,DSPLY/HISTO,FRST MIN2 OCT -2 DELAY ML2 DEC 12 CNFGR MSG4 ASC 3, COND: INTRP MSG7 ASC 4, MULT= _ INTRP SPC 1 NB10 OCT -10 INTRP,SCHK NB12 OCT -12 INTRP NE ASC 1,NE INTRP N.4 DEC -4 DSPLY/HISTO N.16 DEC -16 DSPLY/HISTO SPC 1 OTAX OTA 0 CNFGR SPC 1 P OCT 120 INTRP (ASC NULL-P) PARAM DEF WHERE INTRP SPC 1 R OCT 122 INTRP (ASC, NULL-R) REDIT OCT 10401 READX SPC 1 SFSX SFS 0 CNFGR SIX OCT 6 ADDRS SPACE OCT 20000 INTRP SQTAD DEF .SQT. ADDRS SPC 1 T OCT 52000 INTRP (ASC T-NULL) TEST OCT 52525 CNVRT TEST2 DEC -10000 DSPLY/HISTO THREE OCT 3 CNFGR TTYIN DEF I.EX EXIT TTY EQU 12B EXIT TWO OCT 2 INTRP,STATPAC,CNFGR TY ASC 1,KE INTRP SPC 1 UPPER OCT 177400 INTRP,READX SPC 1 WRONG ASC 2, ?? ERROR SPC 1 XL2 DEF FGAIN CNVRT XL3 DEF SGAIN CNVRT SPC 1 .005 DEC .005 CNVRT .2313 EQU 11B SKP * ** INTRP SPECIAL CONSTANTS ** SPC 1 NO ASC 1,NO \ LI ASC 1,LI \ RE ASC 1,RE \ ASC 1,DI \ ASC 1,HI \ DO NOT SE ASC 1,SE / RE-ARRANGE NOP / ASC 1,IN / ASC 1,TW / ASC 1,SI / SPC 2 * ** STORAGE ** SPC 2 DESC NOP DES NOP ST NOP FROM NOP SUM NOP KTVU NOP ATEST NOP FGAIN NOP NOP I NOP J NOP K NOP MASK NOP COU1 NOP SGAIN NOP NOP ASAVE NOP TEMP NOP NOP AVG NOP NOP MEAN NOP NOP TOP BSS 2 BOTOM BSS 2 EQTAD OCT 17 BSS 44 SKP SPC 3 ABRT NOP INTRP,CNFGR,FRST SPC 1 CNTR EQU ADDRS INTRP, DESCR CNTR1 NOP INTRP SPC 1 DELC NOP INTRP,DELAY SPC 1 LBL3 NOP CNFGR,INTRP SPC 1 SPC 1 NUM EQU K STATPAC SPC 1 PIN NOP INTRP,DESCR OUTBF NOP \ INTRP, DESCR PNTR OCT 57400 INTRP, DSPLY/HISTO, HCHK, READX PNTR1 NOP INTRP SPC 1 QUOT EQU ATEST STATPAC SPC 1 REMDR EQU FROM STATPAC RMS EQU SGAIN STATPAC SPC 1 SC NOP EXIT, DSPLY/HISTO, CNFGR STEP EQU J STATPAC SPC 1 TAD NOP CNFGR TCC NOP CNFGR,EXIT TOTAL EQU FGAIN STATPAC TSC NOP CNFGR TTY11 NOP CNFGR <:6TTYL NOP EXIT,CNFGR TTYLC NOP EXIT,CNFGR TTYSC NOP CNFGR **************************** * * * END OF CODE PROCEDURES * * * **************************** SPC 1 END /< ") 91062-18001 A S 0122 BCS RELO TAPE START             H0101 uASMBҬB NAMSA NԠSA ԠVMSN SAԠNP SBVMSN DƠ+ HԠB NDSA   91062-18002 A S 0122 BCS RELO TAPE .CURE             H0101 VASMBҬB NAM.U ԠD..B NԠD.6.6 D.6NP SBD. MPD.6 .6NP SB.B MP.6 ND   91062-18003 A S 0122 BCS HP3480/85 SUBSYSTEM VERIFICATION TEST (VMSCN)             H0101 NB SUBUNŠVMSN àHSUNŠSDSGNDϠVYPPҠPANƠH à305SUBSYSM.HŠUPMNԠNSSSƠA30 àDVMA35ASANNҠPUG-NNADϠANHPMPUҠVA àAN03-6000DSɠADANDA03-60003NҠM- àUԠAD. àHSPGAMUSSASAN-YPŠ"NA"BSDVҠAD àD..HŠSUBUNŠNVSASϠUSDϠNVԠHŠDAA àMBDϠANGPN. àHŠVANPGAMSDVDDNϠHŠSԠSGMNS: à.AUMAàSANHSDSANNҠPGAMS-HANNS àHU0AŠSANNDHHŠ35APGAMMDASSԠUPBY àHŠNAZANƠHŠ"PGM"AAY. à.ANDMMDŠSԠ-PAҠND àHSSԠASASNGŠADNGNAHANN̠ҠANUMB àƠADNGSSPDBYHŠPGAMD. à3.SP(SUNA̩MDŠSԠ-PAҠND àBKSANSSDNHSMD. àSHGSҠPNS: àϠPAԠPVUSSԠS0 àϠMNAŠUNԠSԠSױ àϠPNUNԠSԠSײ àϠSUPPSSDAAPNUԠSױ5 DMNSNDAA(00UN(50HAN(50PGM(50 UVANŠ(ҬND àɯϠNAZAN A̠SAD(6BAND(SS(5B Š(00 Š(0 AD(0 A̠SAD(Bì A̠SAD(6B+ A̠SAD(0000 A̠ àAUMAàSANAAYNAZAN PGM( PGM( PGM(30 PGM(B PGM(50B PGM(6 HAN( HAN( HAN(33 HAN( HAN(55 HAN(66 àAUMAàS 5Š(03 0A̠SN PAUS Ơ(SS(90 0Š(5 kA̠ND A̠SNҠ(DAA(HAN(PGM(ҬUN( 5Ơ(-530 30A̠SNҠ(DAA(5HAN(5PGM(56ҬUN(5 35Ơ(-6350 0A̠SNB(DAA(HAN(6PGM(65ҬUN( Ơ(-55 5Ơ(SS(59550 50Š(0 SԽ0 A̠NV(DAA(5Sԩ ʽ DϠ90ɽ5 Š(0ʬDAA(ɩ Ơ(UN(ɩ-95560 55Š(05 GϠϠ0 60Š(06 0ʽ+ Ơ(-5905 5Ơ(-0090 0ʽ- 90NNU 95Ơ(SS(9 9Š(6 Š(03 PAUS A̠SN Ơ(SS(0000 àANDMMDŠS 00Ơ(SS(00 0Š(0 AD(HAN( Š(09 AD(0PGM( Ơ(PGM(-B5 Š(3 AD(NUMB GϠϠ 5NUMB A̠SNҠ(DAA(HAN(PGM(NUMBҬUN( Ơ(-NUMB9 9Ơ(SS(5600 0Š(0 SԽ0 A̠NV(DAA(NDSԩ DϠ50ɽ Š(0HAN(DAA(ɩ Ơ(UN(ɩ-9300 30Š(05 GϠϠ50 0Š(06 50NNU 60Ơ(SS(0 0Š( Š(03 PAUS A̠SN Ơ(SS(0000 àSPMDŠS 00Ơ(SS(3000 0Š( AD(HAN( Š(09 AD(0PGM( Š( AD(NUMB A̠SNB(DAA(HAN(PGM(NUMBҬUN( 5Ơ(-NUMB5 Ơ(SS(5600 0Š(0 SԽ0 NHAN( A̠NV(DAA(NDSԩ DϠ50ɽ Š(0NDAA(ɩ NN+ Ơ(UN(ɩ-9300 3 0Š(05 GϠϠ50 0Š(06 50NNU 60Ơ(SS(0 0Š( Š(03 PAUS A̠SN Ơ(SS(00300 300Š( PAUS GϠϠ àMAԠSN 00MAԠ("305SUBSYSMVAN" 0MAԠ("DAAADɯϠSԠDŠ?_" 0MAԠ(K3 03MAԠ("SԠSHG.PNS-PSSUN" 0MAԠ(جɲج9.53ج"_" 05MAԠ("DàVS" 06MAԠ("VAD" 0MAԠ("HANN""DAA"5"UNN" 0MAԠ("ANDMMDŠS-"3"HANN̠?_" 09MAԠ(3"PGAMD?_" MAԠ("SPMDŠS-"3"SANGHANN̠?_" MAԠ(3"ƠHANNS?_" 3MAԠ(3"ƠADNGS?_" MAԠ("NDƠSԠ-PSSUNϠSA" 5MAԠ(3"AUMAàS" 6MAԠ("NDAUϠS" MAԠ("NDANDMS" MAԠ("NDSPS" ND ND$    91065-80001 B S 0122 TIMER-COUNTER SUBSYSTEM BCS LINK (LNK27)             H0101 ];ASMBҬB̬ HDHP9065ABSNKSUBUNŠ NAMNK NԠNK Ԡ.NҬ...AD.DV BNAY:9065-6000 S:A-9065-6000- SNG:A-9065-6000- SU:9065-000 HSUNŠSDSGNDϠSMPYMŠPGAMMNGH MҠUNҠSUBSYSMSNHŠBSPANGSYSM. ϠPGAMUNҠ(AN: A̠NK(UUNìMŬSPGAGBANAANBDVM H:UUNԠ.N.Ơ0BԠGSҠAD UNàUNND MŠMŠBASŠD SPAANDBNPUԠSPŠDŬSPM GANPUԠAGGҠV GBNPUԠBGGҠV ANANPUԠAANUAҠANDAïDàD ANBNPUԠBANUAҠANDAïDàD DVMDGA̠VMҠ(536B53BNY SKP UBSS UNàDà- MŠBSS SPBSS GADà- GBDà- ANADà- ANBDà- DVMDà- NKNPNYPN SB.NҠGԠPAAMҠADDS DƠU A SADAAA SADAADAA SADAA3D SADAASAG SADAA5BUS DAUN MASZASSAҠA̠NS? MPDNŠYS! DASԱ SAPNұPS DASԲPNS SAPNҲ DAS3 SAPN3 DASԴ SAPNҴ DAS5 SAPN5 DAUNìɠBNGNUNN ADAD-0SUBAԠ0 SSAHK? MP+3 DBS5YS SBDAASԠUPHK SSA DAUNì DBDVM LMBSZBSSDVMUSԠ? MP+ DBDVM SZBDVMDŠ0? MPMŠNϬGϠGԠMŠBAS SZASSYSSUNN0? MPK BNB PABMPAŠD MP+6 NBNMNԠDŠKY SZPNұNMNԠPN PBSԴ+ MPKGA̠DŽ MP-6 DAPNұɠSԠUP ҠDAAD SADAA MŠDAMŬɠBNGNMŠBASŠD B PABMPAŠD MP+6 NBNMNԠDŠKY SZPNҲNMNԠPN PBSԴ+0 MPKGA̠D- MP-6 DAPNҲɠSԠUP SADAAD DASPɠBNGNSPŬSPM ADAD- SSAMMN? MP+5 BNB SBDAAYSSԠMB ADAS5+NV SSϠA DASP ANDBSAŠSPŠD B PABMPAŠD MP+6 NBNMNԠDŠKY SZPN3NMNԠPN PBS5 MPKGA̠D- MP-6 DAPN3ɠSԠUP SADAA3D3 ANANA̠PGAM SADAA5 DAGASԠV̠AAG MASZAPAAMҠUSD? MP+3YSGϠNV DAB000NϬSԠV̠Ϡ-.05V MP+ DDGAɠBNGNV̠ADAA SBGҠNV ҠDAA SADAASŠNBU DAGBSԠV̠BAG MASZAPAAMҠUSD? MP+3YSGϠNV DAB000NϬSԠV̠Ϡ-.05V MP+ DDGBɠBNGNV̠BDAA SBGҠNV ҠDAA5 SADAA5SŠNBU DAANASԠNPUԠAAN.AG MASZASS MPDNŠرر DAANAɠGԠAN.AD SBMPҠGϠGԠDAAD ҠDAA3 SADAA3 DAANBSԠNPUԠBAN.AG MASZASS MPDN DASԴADUS ADAD6ANUA SAPNҴPN DAANBɠGԠAN.BD SBMPҠGϠGԠDAAD ҠDAA3 SADAA3SŠNBU DADVMSԠDVM MASZASS MPDNŠNԠUSD DADVM SZASS MPDN DAB3000 ҠDAA SADAADVMUNN DADVMɠBNGNDVMD BNB PABMPAŠD MP+6 NBNMNԠDŠKY SZPN5NMNԠPN PBS5ADAҠB? MP+6YS MP-6 DAPN5ɠGԠDAAD ҠDAA SADAASŠDAAD MPDN PAS5ADA? MP+6YS NBNMNԠDŠKY SZPN5NMNԠPN PAB5ADB? SSYS MPKGA̠D- DAPN5ɠADAҠBDAA SADAASŠNBU DASԱ+ SADAA0MSGA DNŠDAUɠA̠D.5 ҠB0000 SANS SB.. NSԠԠ0000 MP- DƠDAA0 Ԡ6 A SԠBS SBUN SBGABU SBGBAGS SBANA SBANB SBDVM MPNKɠNMA̠UN KASԠAG- MPSԠUN DAA0NP DAANPDAA DAANPD DAA3NPSAG DAANPBUS DAA5NP PNұDƠSԱUNNS SԱԠ5000 Ԡ500 Ԡ00 Ԡ0 Ԡ00 Ԡ000 Ԡ6000 Ԡ600 Ԡ0 PNҲDƠSԲMŠBASŠS SԲԠ00 Ԡ000 Ԡ600 Ԡ6000 Ԡ500 Ԡ5000 Ԡ00 Ԡ000 Ԡ300 PN3DƠS3SPŠS S3Ԡ0 Ԡ Ԡ000 Ԡ00 PNҴDƠSԴANUASS SԴԠ0 Ԡ00 Ԡ000 Ԡ000 Ԡ00 Ԡ5000 Ԡ0 Ԡ Ԡ Ԡ0 Ԡ Ԡ PN5DƠS5DVMS S5Ԡ Ԡ Ԡ Ԡ000 Ԡ300 GҠNPNVԠGGҠV̠DAA SB.ADADD3.5ANDV̠DAA DƠANG SB.DVDVDŠSUԠBY50MV DƠSV SBؠNVԠ.P.ϠNG MANVԠBS SAHD ANDBADUS A SABBS DAHD ANDB0UPU AƬA ҠB MPGҬ ANGŠDà3.5 SVDà.05 HDNP MPҠNPANUAҠMPA B PABMPAŠD MP+6 NBNMNԠDŠKY SZPNҴNMNԠPN PBB6 MPKGA̠D- MP-6 DAPNҴɠGԠDAAD MPMPҬ SԱDƠSԱ SԲDƠSԲ S3DƠS3 SԴDƠSԴ S5DƠS5 D6Dà6 BU ND ND--AP ND--AP ND--AP    91065-80002 B S 0122 VERCT              H0101 NB à PGAMV à àHSPGAMSDSGNDϠVYPPҠPANƠH àHPMүUNҠANDHPMүUNүDVMSUBSYSMS. à àUNŠVԠPASNHŠBSPANGSYSMANDUS àBSDVSD.0D.5ɯϠNGUNGUNŠSADAND àNKSUBUNŠNK. à àVANSDVDDNϠϠSGMNS: à à.AUMAàS:SUBSYSMAUSAŠSDH àMNMUMPAҠAD. à à.MANUA̠S:ASHŠPAҠϠSPYPGAM àPAAMSNHŠSYSMNSŠKYBAD. à àSHGSҠPNS: à àAUMAàSԠS00 àMANUA̠SԠS0 àPAԠN̠Sױ à à à àɯϠNAZAN à A̠SAD(6BAND(SS(5B Š(000 AD(00 A̠SAD(0Bì ý+B A̠SAD(5Bì A̠SAD(0000 à àMDŠS à Š(00 AD(003KND à 0Š(00 PAUS A̠NK(0B Ơ(SS(050000 à àAUMAàS à 00Š(005 A̠NK(0B60 A̠DSɠ(6 Š(006 PAUS à Š(00 A̠NK(0B30 A̠DSɠ(3 MDAND(KND00B Ơ(MD-00 0Š(00 A̠NK(0B90 A̠DSɠ(9 à 0Š(009 MŽ DϠ30ɽ A̠NK(0BMŬ0 A̠DSɠ(Mũ MŽM- 30NNU à Š(00 0Ơ(SS(9050 50Ơ(SS(5600 60A̠NK(0B Š( A̠NK(0B0 0Ơ(SS(500 0A̠NK(0B500 AD(0DAA Š(0DAA GϠϠ0 à 90Š(03 PAUS 'Š(0 MŽ3 DϠ00ɽ A̠NK(0BMŬ0 A̠DSɠ(Mũ MŽM- 00NNU à Š(05 A̠NK(0B600 A̠DSɠ(60 Š(06 A̠NK(0B00.0.33 A̠DSɠ(0 Š(0 A̠NK(0B00.0.33 A̠DSɠ(0 à YPŽAND(KNDB Ơ(YP-300 0Š(0 PAUS Š(09 DϠ0ɽ3 A̠NK(0B000.0.00ɩ A̠DSɠ(0ɩ 0NNU à Š(00 A̠NK(0B0503.0.00 A̠DSɠ(00 Š(0 A̠NK(0B0500.-3.005 A̠DSɠ(005 30Ơ(SS(000 à àMANUA̠SԠ-PAҠND à 500DVM0 Š(0 AD(UN Š(03 AD(M Ơ(UNé50550505 505Š(0 AD(SP Š(05 AD(GA Š(06 AD(GB Š(0 AD(ANA Š(0 AD(ANB GϠϠ50 50Ơ(AND(KNDB5553055 55SP0 GA0 GB0 ANA0 ANB0 Š(09 AD(DVM à 50Ơ(UN-55555 5Š(00 53Ơ(SS(5905 5Ơ(SS(55553 55Š( ANK(0BUNìMŬSPGAGBANAANBDVM Ơ(A53050 530Š(030 GϠϠ500 50Ơ(UN-560550560 550Ơ(SS(5550555 555A̠NK(0B500 AD(0DAA Š(0DAA GϠϠ53 à 560Ơ(DVM-5050 50A̠DSɠ(0MŬDVM GϠϠ590 50A̠DSɠ(UNìMũ 590Ơ(SS(500 à àMAԠSN à c000MAԠ("HPMүUNҠSUBSYSMVAN" "DAAADɯϠSԠDŠ?" 00MAԠ(K6 00MAԠ("UNҠMD̠N.(53A.?" 003MAԠ(A5 00MAԠ("SԠS.G.PN-PSSUN" 005MAԠ("AUMAàS""HKDSPAY0000.00KHZ" 006MAԠ("SԠNPUԠAANDà.Ϡ00KHZ-PSSUN" 00MAԠ("Ѡà(0S" 00MAԠ("ѠàPSAŠ(S" 009MAԠ("ѠA(S.S0MSMS" 00MAԠ("SAԯSPS"5"ϠSAԠUNԠSױ5"5 "ϠSPUNԠSױ50"5ج"ϠԠSԠSױ" 0MAԠ(جű0.05ة 0MAԠ(جɷ 03MAԠ("SԠNPUԠA.Ϡ0HZ-PSSUN" 0MAԠ("PDA(.MS0USUS.US" 05MAԠ("PDAVGA" 06MAԠ("..AϠB" 0MAԠ("..AVGAϠB" 0MAԠ("DVMSԠ-APPYDàϠDVMNPUԠ-PSSUN" 09MAԠ("0V00V000VANG" 00MAԠ("ADA" 0MAԠ("ADB" 0MAԠ("MANUA̠S""NҠPGAMPAAMS" 3"UNN?" 03MAԠ("MŠBASŠ?" 0MAԠ("SPŠ?" 05MAԠ("GGҠV̠A?" 06MAԠ("GGҠV̠B?" 0MAԠ("ANUAҠA?" 0MAԠ("ANUAҠB?" 09MAԠ("DVM?" 030MAԠ("NVADPGAMPAAM" à ND SUBUNŠDSɠ(NNN3 à àDAANVSNANDPNԠSUBUN à DMNSNDAA(Nұ(6NҲ(5N3(NҴ(3N5( DMNSNDò(D3(3Dô(D5(5D6(6( à UVANŠ(DñDAA((DòDAA(6(D3DAA(5 UVANŠ(DôDAA((D5DAA(3(D6DAA( UVANŠ(NұNҲN3NҴN5N6DAA( à Š( AD(000UNDAA à Ơ(UN000 0Š(00 UN à 0UNýN MŽ(N+ DVMN3 ^Ơ(UN-50030 30Ơ(UN-0500 0UNýUN-0 50GϠϠ(00000060603000030000UN 60UN à 00(05B (3B GϠϠ(3055355009050M 5Š(00DAA UN 5Š(003NұDñ UN 30(00B 35Š(00NҲDò UN 5Š(005N3D3 UN 50(03B 55Š(006NҴDô UN 0(03B GϠϠ5 0(03B GϠϠ35 90(03B GϠϠ5 à 00(000B (500B GϠϠ(0030050355560M 0(05B GϠϠ5 0(05B GϠϠ5 30(05B GϠϠ35 0(05B GϠϠ5 50(05B GϠϠ5 60(005B (000B GϠϠ5 à 300(06B (50B GϠϠ(303033053555530350M 30(05B GϠϠ5 30(05B GϠϠ35 330(05B GϠϠ5 30Š(00N5D5 UN 350Š(00N6D6 UN à 00(03B (3B GϠϠ(003005055355M 0(00B GϠϠ5 0(00B GϠϠ35 30(05B GϠϠ5 0(05B GϠϠ5 50(05B GϠϠ35 à 500Ơ(UN-35050 50P̽50B GϠϠ530 50P̽60B 530Ơ(DVM-506060 50Ơ(DVM-55056050 550GϠϠ(6006006006006006063060600M 560GϠϠ(6006006006006006060630600M 50GϠϠ(60060060069g006006006060600M à 600Š(009P̬DAA UN 60Š(00P̬NұDñ UN 60Š(0P̬NҲDò UN 630Š(0P̬N3D3 UN 60Š(03P̬NҴDô à à 000MAԠ(ɱAة 00MAԠ("V" 00MAԠ(A"."A 003MAԠ(6A"."AA 00MAԠ(5A"."AA 005MAԠ(A"."3AA 006MAԠ(3A"."AA 00MAԠ(A"."5AA 00MAԠ(A"."6AA 009MAԠ(AA".VS" 00MAԠ(A6A"."A"VS" 0MAԠ(A5A"."A"VS" 0MAԠ(AA"."3A"VS" 03MAԠ(A3A"."A"VS" à ND ND$ R   91200-18001 1648 S 0122 DVR13 DRVR SRC              H0101 ASMB,L,C HED RTE DRIVER FOR <91200> VIDEO GENERATOR A-91200-16001-2 * * NAME: RTE-II DRIVER FOR 91200 VIDEO GENERATOR * SOURCE: 91200-18001 * BINARY: 91200-16001 * PGMR: R.M.C. REV.C(1648) MADE BY DENTON ANDERSON * * NAM DVA13,0 91200-16001 REV 1648 -- 761124 SPC 1 ENT IA13,CA13 SUP PRESS EXTRANEOUS LISTING SPC 1 * THIS DRIVER IS RESPONSIBLE FOR PROCESSING EXEC I/O CALLS FOR * THE <91200> VIDEO DISPLAY GENERATOR. IT RECOGNIZES WRITE AND * CONTROL REQUESTS. * * WRITE REQUESTS WILL INITIATE A DMA TRANSFER OF YX * COORDINATES OF POINTS TO BE WRITTEN ON OR ERASED FROM * THE VIDEO MONITOR SCREEN BY THE <91200>. * Y=BITS 15-8, X=BITS 7-0. * * CONTROL REQUESTS ARE USED TO:- * SET COLOR (BLACK FOR SELECTIVE ERASE) * SET SENSE (VIDEO POLARITY) * PERFORM A BULK ERASE. * INDICATE A POWER FAIL. * * THE FUNCTION BITS FOR CONTROL REQUESTS ARE DEFINED AS FOLLOWS:- * * BITS 10, 9, & 6 SELECT COLOR AS FOLLOWS: * * 00 XX0 WHITE * 00 XX1 BLACK (SELECTIVE ERASE) * 01 XX0 RED -----\ * 01 XX1 GREEN \ * 10 XX0 BLUE \ NOT FOR 1 CARD * 10 XX1 YELLOW (RED & GREEN / SYSTEMS * 11 XX0 MAGENTA (RED & BLUE) / * 11 XX1 CYAN (BLUE & GREEN) -----/ * * BIT 7 IS THE SENSE BIT, IF SET TO 1 IT CAUSES THE VIDEO * OUTPUT OF THE CARD TO INVERT. * * BIT 8 SET TO 1 CAUSES BULK ERASE (TO SENSE PREVIOUSLY SET). * IF BIT 7 IS ALSO SET THEN BIT 0 OF EQT5 IS SET TO SHOW THE * USER THAT A POWER FAIL HAS OCCURRED. * * WHEN BIT 8 OF THE CONTROL WORD IS SET (TO ERASE), BITS * 6, 9, & 10 OF THE CONTROL WORD ARE IGNORED. * * THE DRIVER PROCESSES TIMEOUT SO THAT THE SYSTEM WILL NOT * ISSUE A CLC FOLLOWI[ NG A TIMEOUT INTERRUPT. SKP * INITIATION SECTION SPC 1 I.XY NOP STA TVSC SAVE THE SELECT CODE LDA EQT5,I IS THE EQT SSA BUSY? JMP PFAIL YES - MUST BE AUTO RESTART LDA EQT4,I SHOW RTE THAT TIMEOUT AND IOR PS PWR FAIL WILL BE HANDLED HERE. STA EQT4,I LDA EQT6,I REQUEST CODE WITH EXEC CALL AND B3 TYPE IN LOW BITS. CPA B3 JMP CNTRL B10 SLA IF A=1,RETURN CODE IS RIGHT JMP I.XY,I TO SHOW ILLEGAL READ. SPC 1 LDA CHAN CONFIGURE DMA IOR OTA0 102606/7 STA DMAO XOR B4 102602/3 STA DMAO1 STA DMAO2 IOR B300 102702/3 STA DMAS IOR B1200 103702/3 ADA B4 103706/7 STA DMASC XOR B5000 106706/7 STA DMAC1 XOR B4 106702/3 STA DMAC END DMA CONFIGURATION SPC 1 LDA TVSC ASSIGN TV CARD TO DMA AND IOR BIT15 ASK STC AFTER EACH TRANSFER, DMAO OTA DMA BUT NO FINAL CLC. IOR STF0 CONFGR STF FOR TV STA STF1 LDA EQT7,I SEND BUFFER ADDRESS DIRECTLY DMAC CLC DMA-4 DMAO1 OTA DMA-4 TO ADDRESS REGISTER. LDA EQT8,I SEND TWO'S COMPLEMENT OF CMA,INA BUFFER LENGTH TO DMAS STC DMA-4 WORD COUNT REGISTER. DMAO2 OTA DMA-4 STF1 STF TVGEN READY TV CARD DMASC STC DMA,C TURN ON DMA, BUT DMAC1 CLC DMA PREVENT INTERRUPT FROM IT. CLA JMP I.XY,I SKP CNTRL DLD INTBA,I FIND DMA CHANNEL CPA EQT1 AND RELEASE IT. CLA CPB EQT1 CLB DST INTBA,I SPC 1 LDA TVSC CONFIGURE I/O INSTRUCTIONS IOR STF0 1021SC STA STFTV ADA B300 1024SC STA MIATV IOR B1200 1036SC STA OTATV IOR B100 1037SC STA STCTV XOR B5000 1067SC ( STA CLCTV XOR B5600 1031SC STA ERASE END I/O CONFIGURATION SPC 1 LDB EQT6,I GET CONTROL WORD BLF,BLF CHECK BIT 8 SLB JMP ERASE DO BULK 'ERASE' SPC 1 LDA EQT4,I AND MASK CHECK FOR SZA,RSS NON-ZERO SUB-CHANNEL JMP GO.ON IS ZERO - SO COLOR LDA B NOT ZERO - KILL COLOR RAR,ERA IS COLOR NOT SEZ,SLA,RSS WHITE OR BLACK? JMP GO.ON YES - SO OK! LDA B NO - SO KILL COLOR TO AND MASK2 WHITE ONLY STA B SPC 1 GO.ON CLE,ELB CALL IS TO SET OR CHANGE BRS,BRS COLOR AND/OR SENSE. CLA POSITION ELA,RAL CONTROL BITS RBR,ERB 6, 9, & 10 RBL,RBL FOR TESTING SSB,SLB,RSS CYAN OR GREEN? JMP *+3 NEITHER IOR B1 IT IS CYAN OR GREEN JMP *+4 WHICH? SLB,RSS MAGENTA OR RED? JMP *+5 NEITHER IOR B4 IT IS CYAN/MAGENTA OR GREEN/RED SEZ,RSS CYAN/MAGENTA OR GREEN/RED? IOR B10 IT IS GREEN OR RED JMP STFTV DONE SKP SSB,RSS YELLOW OR BLACK? JMP *+5 NEITHER (IT IS BLUE OR WHITE) IOR B10 IT IS YELLOW OR BLACK SEZ,RSS YELLOW OR BLACK? IOR B5 IT IS BLACK JMP STFTV DONE SEZ BLUE OR WHITE? IOR B5 IT IS BLUE SPC 1 STFTV STF TVGEN BECAUSE RTE DID CLF. CLCTV CLC TVGEN SWITCH MODE FF OTATV OTA TVGEN,C TO STEER OUTPUT TO MODE PFAIL LDA B4 REGISTER AND DO IMMEDIATE JMP I.XY,I COMPLETION SPC 4 ERASE CLF TVGEN CLEAR ANY PRESET STATE OF CARD CLA,INA SET STATUS BIT (PWR FAIL BIT) IOR EQT5,I ON EQT5 WORD SSB,RSS IS BIT 7 OF CNTRL WORD SET? AND EQ5 NO - SO CLEAR PWR FAIL. BIT STA EQT5,I MIATV MIA TVGEN ANY INPUT WILL BULK ERASE STCTV STC TVGEN,C INTERRUPT NEEDED TO COMPLETE. CLA JMP I.XY,I SPC 3 TVSC NOP STORE CURRENT IO SELECT CODE. BIT15 OCT 100000 PS OCT 30000 EQ5 OCT 177400 OTA0 OTA 0 STF0 STF 0 B1 OCT 1 B3 OCT 3 B4 OCT 4 B5 OCT 5 B100 OCT 100 B300 OCT 300 B1200 OCT 1200 B5000 OCT 5000 B5600 OCT 5600 BIT11 OCT 4000 MASK OCT 2700 MASK2 OCT 137771 SKP * CONTINUATOR SECTION. SPC 1 C.XY NOP LDB EQT1,I SZB,RSS JMP EXTRA SPURIOUS INTERRUPT. LDA EQT4,I EXAMINE BIT 11 FOR A AND BIT11 TIME-OUT ENTRY. SZA JMP TMOUT LDB EQT8,I GET TRANSMISSION LOG JMP C.XY,I A ALREADY CLEAR. SPC 1 TMOUT XOR EQT4,I BIT 11 IS SET, SO CLEAR STA EQT4,I IT AND STORE BACK. CLA HANDLE TIME-OUT HERE TO JMP C.XY,I PREVENT A CLC BY SYSTEM, SPC 1 AND DOWNED DEVICE. EXTRA STB EQT15,I IGNORE INTERRUPT AND ISZ C.XY PREVENT TIMEOUT FROM IT. JMP C.XY,I SPC 3 B EQU 1 CA13 EQU C.XY IA13 EQU I.XY TVGEN EQU 0 DMA EQU 6 NOMINAL DMA CHANNEL TBL EQU 1650B CHAN EQU TBL+23B INTBA EQU TBL+4 EQTBL EQU TBL+7 EQT1 EQU EQTBL+1 EQT4 EQU EQTBL+4 EQT5 EQU EQTBL+5 EQT6 EQU EQTBL+6 EQT7 EQU EQTBL+7 EQT8 EQU EQTBL+8 EQT15 EQU 1774B SPC 2 END 8   91200-18002 1648 S 0222 VIDEO LIBRARY              H0102 *ASMB,L,C HED RTE BASIC 'CHAR' INTERFACE A-91200-16002-2 * * NAME: RTE BASIC 'CHAR' INTERFACE * SOURCE: 91200-18002 (FILE 1) * BINARY: 91200-16002 (MODULE 1) * PGMR: L.W.S. ADDED TO LIBRARY BY DENTON ANDERSON. * REV.B(1603) IS FOR COLOR OPERATION. * REV.C(1648) IS FOR POWER FAIL - AUTO RESTART. * * NAM CHARS,7 91200-16002 REV 1648 -- 761124 ENT CHARS EXT .ENTR,CH#R SPC 2 * THIS ROUTINE SERVES AS AN INTERFACE BETWEEN THE TV LIBRARY * ROUTINE 'CHAR' AND A BASIC CALLING PROGRAM. IT ACCEPTS THE * ADDRESS OF A STRING VARIABLE (AS WELL AS A STRING IN QUOTES), * PUTS THE STRING LENGTH TEMPORAIRLY IN WORD 1 OF THE STRING * ARRAY, AND THEN CALLS THE CHAR LIBRARY ROUTINE TO DISPLAY * THE CHARACTER STRING. ALL OTHER PARAMETERS ARE PASSED DIRECTLY * TO CHAR AS RECEIVED. THE BASIC USER MUST CALL IT AS FOLLOWS: * * 10 CALL CHARS(X,Y,A$,S,D,N,M,P) * * X,Y --> X,Y COORDINATES OF LOWER-LEFT HAND POINT WHERE * CHARACTER STRING IS TO BE DISPLAYED. * * A$ --> STRING VARIABLE CONTAINING STRING TO BE DISPLAYED. * * S --> CHARACTER SIZE. * * D --> DIRECTION. * * N --> ARRAY STRUCTURE (FORCED TO 0). * * M --> DISPLAY MODE. * * P --> POWER FAIL INDICATOR. SKP * TYPICAL BASIC PROGRAM * --------------------- * * 10 DIM A$(72) * 20 PRINT "ENTER TV LU #, DISPLAY SENSE: "; * 30 INPUT L,S * 40 CALL VIDLU(L,S) * 50 CALL ERASE * 60 PRINT "ENTER ANY CHARACTER STRING OR /E" * 70 INPUT A$ * 80 IF A$(1,2)="/E" THEN 160 * 90 PRINT "ENTER X,Y,SIZE,DIREC,MODE: "; * 100 INPUT X,Y,S,D,M * 110 CALL CHARS(X,Y,A$,S,D,0,M,P) * 120 IF P#0 THEN 140 * 130 GO TO 50 * 140 PRINT"POWER FAIL, START OVER" * 150 GO TO 20 * 160 PRINT"DONE" * 170 END * * * BRANCH & MNEMONIC TABLE CONSIDERATIONS *  -------------------------------------- * * THE FOLLOWING TYPE OF ENTRY MUST BE MADE: * * FOR RTE-B: * CHARS(I,I,R,I,I,I,I,V) * * FOR REAL TIME BASIC: * CHARS(I,I,RA,I,I,I,I,IV) * * THE ENTRY POINT MUST BE 'CHARS' WITH EIGHT PARAMETERS EXACTLY * AS SHOWN. PARAMETER NUMBER 3 MUST BE SPECIFIED AS REAL SO THAT * THE STRING ARRAY (A$) CAN BE RETRIEVED DURING RUN TIME. PARAMETER * NUMBER 6 CAN BE SPECIFIED AS ANYTHING SINCE IT IS ALWAYS PASSED * AS ZERO TO THE TV LIBRARY ROUTINE. SKP X NOP STARTING X & Y COORDINATES OF THE Y NOP THE LOWER-LEFT CORNER. BUFR NOP ADRS OF CHAR. STRING OR LITERAL. SIZE DEF .0 CHARACTER SIZE. DIREC DEF .0 STRING DIRECTION. NUMBR NOP ARRAY STRUCTURE. MODE DEF .0 DISPLAY MODE. PFL NOP POWER FAIL INDICATOR. SPC 1 CHARS NOP << ENTRY POINT >> JSB .ENTR GET PARAMETER ADDRESSES. DEF X SPC 1 LDA BUFR,I SAVE STATEMENT COMPILE CODE. STA TEMP SAVE FOR LATER RESTORE. AND .377 ISOLATE STRING LENGTH. STA BUFR,I TEMPORARILY PUT BACK IN STRING. LDA PFL TRANSFER POWER FAIL INDICATOR STA PFAIL ADDRESS FOR NEXT CALL. SPC 1 *... CALL CHAR LIBRARY ROUTINE ... SPC 1 JSB CH#R CALL DEF *+9 THE DEF X,I ACTUAL DEF Y,I TV DEF BUFR,I LIBRARY DEF SIZE,I ROUTINE. DEF DIREC,I DEF .0 DEF MODE,I PFAIL NOP SPC 1 LDA TEMP RESTORE ACTUAL FIRST WORD IN STA BUFR,I BASIC SYMBOL TABLE. LDA DEF0 RE-ESTABLISH DEFAULTS STA SIZE / STA DIREC / STA MODE / CLA / STA PFL / JMP CHARS,I RETURN TO BASIC. SPC 1 TEMP NOP HOLDS ORIGINAL FIRST WORD OF S.T. .0 OCT 0 BUFFER STRUCTURE PARAMETER. .3I77 OCT 377 STRING COUNT MASK VALUE. DEF0 DEF .0 SPC 1 END ASMB,L,C HED RTE BASIC 'POINT' INTERFACE A-91200-16002-2 * * NAME: RTE BASIC 'POINT' INTERFACE * SOURCE: 91200-18002 (FILE 2) * BINARY: 91200-16002 (MODULE 2) * PGMR: L.W.S. ADDED TO LIBRARY BY DENTON ANDERSON * REV.B(1603) IS FOR COLOR OPERATION. * REV.C(1648) IS FOR POWER FAIL - AUTO RESTART. * P NAM PNTS,7 91200-16002 REV 1648 -- 761124 ENT PNTS EXT .ENTR,POINT,IFIX SUP PRESS EXTRANEOUS LISTING SPC 1 * THIS ROUTINE SERVES AS AN INTERFACE BETWEEN THE TV LIBRARY * ROUTINE 'POINT' AND A BASIC CALLING PROGRAM. IT ACCEPTS A * CONTIGUOUS ARRAY OF FLOATING-POINT X & Y SCREEN COORDINATES, * CONVERTS EACH TO INTEGER, AND SENDS UP TO 64 PAIRS OF COORD- * INATES TO THE ROUTINE 'POINT' AT A TIME. THE BASIC USER MUST * SET UP THE ARRAY OF X & Y COORDINATES AS FOLLOWS: * * A(1) = FIRST X COORDINATE * A(2) = FIRST Y COORDINATE * A(3) = SECOND X COORDINATE * A(4) = SECOND Y COORDINATE * . . * . . * . . * A(N-1) = LAST X COORDINATE * A(N) = LAST Y COORDINATE * * THE BASIC USER THEN CALLS IT AS FOLLOWS: * * 10 CALL PNTS(A(1),N,M,P) * * * A(1) --> FIRST WORD OF ARRAY OF POINTS * * N --> NUMBER OF POINTS (X,Y PAIRS) * * M --> DISPLAY MODE * * P --> POWER FAIL INDICATOR SKP * TYPICAL BASIC PROGRAM * --------------------- * * 10 DIM A(400) * 15 VIDLU(12,0) * 20 FOR I=1 TO 400 STEP 2 * 30 A(I)=((I+1)/2)-1 * 40 A(I+1)=((I+1)/2)-1 * 50 NEXT I * 60 CALL PNTS(A(1),200,3,P) * 70 IF P#0 THEN 15 * 80 END * * THE ABOVE EXAMPLE CALLS THE POINT LIBRARY ROUTINE WITH 200 PAIRS * OF X & Y COORDINATES. IMPORTANT: WHEN SUPPLYING THE AR)RAY * NAME, IT MUST BE SPECIFIED AS AN ARRAY. * * BRANCH & MNEMONIC TABLE CONSIDERATIONS * -------------------------------------- * * THE FOLLOWING TYPE OF ENTRY MUST BE MADE: * * FOR RTE-B: PNTS(R,I,I,V) * * FOR REAL TIME BASIC: PNTS(RA,I,I,IV) * * THE ENTRY POINT MUST BE 'PNTS' WITH FOUR PARAMETERS EXACTLY * AS SHOWN. SKP BUFER NOP REAL ARRAY ADRS FOR POINTS. NUMBR DEF B1 NUMBER OF (X,Y) POINTS. MODE DEF ZERO SCREEN DISPLAY MODE. PFL NOP POWER FAIL INDICATOR. SPC 1 PNTS NOP << ENTRY >> JSB .ENTR GET PARAMETER ADDRESSES. DEF BUFER SPC 1 LDA NUMBR,I SET USERS POINT COUNT. SZA,RSS IF =0, RETURN. JMP PNTS,I CMA,INA SET NEGATIVE. STA NUMBR LDA PFL TRANSFER POWER FAIL INDICATOR STA PFAIL ADDRESS FOR NEXT CALL. SPC 1 NEXTB LDA BUFAD INITIALIZE INTERNAL POINT BUFFER ADDRESS. STA BUF LDA M64 SET-UP LOOP STA COUNT CONTROL FOR 64 POINTS. CLA INITIALIZE ACTUAL BUFFER COUNT. STA NPT SPC 1 NEXTP JSB GETP GET A REAL X-COORDINATE & FIX. STA XY SAVE FOR LATER MERGE WITH Y-COORDINATE. JSB GETP GET A REAL Y-COORDINATE & FIX. ALF,ALF POSITION Y IN HIGH 8 BITS. IOR XY MERGE TO FORM (Y,X) STA BUF,I PUT AWAY IN INTERNAL BUFFER. ISZ NUMBR LAST USER POINT ? RSS NO. JMP DUMP YES, DUMP TO TV.? ISZ COUNT 64 PAIRS ? RSS JMP DUMP DUMP TO TV. ISZ BUF BUMP INTERNAL BUFFER ADDRESS. ISZ NPT UPDATE NUMBER OF POINTS. JMP NEXTP GET NEXT POINT. SPC 1 DUMP ISZ NPT UPDATE ACTUAL NUMBER OF POINTS. JSB POINT SEND DEF *+5 64 (OR LESS) DEF BUFFR PAIRS DEF NPT OF DEF MODE,I POINTS. PFAIL NOP SPC 1 LDA NUMBR  TIME TO SZA,RSS GET OUT? JMP DONE YES! JMP NEXTB NO, START NEXT BUFFER. SKP DONE LDA DEFB1 RE-ESTABLISH DEFAULTS STA NUMBR / LDA DEF0 / STA MODE / CLA / STA PFL / JMP PNTS,I ALL FINISHED!! SPC 2 GETP NOP < GET NEXT REAL POINT & FIX > DLD BUFER,I GET THE FLOATING-POINT VALUE. JSB IFIX CONVERT TO INTEGER LDB BUFER UPDATE USER'S BUFFER ADDRESS. ADB .2 STB BUFER JMP GETP,I RETURN. SPC 2 DEFB1 DEF B1 B1 OCT 1 .2 DEC 2 XY NOP HOLDS FORMED (Y,X) POINT M64 DEC -64 MAXIMUM POINT CONTROL VALUE NPT NOP ACTUAL NUMBER OF POINTS IN BUFFER COUNT NOP BUFFER LOOP CONTROL VALUE DEF0 DEF ZERO ZERO OCT 0 BUF NOP USERS BUFFER ADDRESSR ADDRESS BUFAD DEF *+1 INTERNAL POINT BUFFER BUFFR BSS 64 POINT BUFFER AREA. SPC 1 END ASMB,L,C HED VIDEO CHARACTER GENERATOR SUBROUTINE A-91200-16002-2 * * NAME: CHARACTER GENERATOR OF VIDEO DISPLAY LIBRARY * SOURCE: 91200-18002 (FILE 3) * BINARY: 91200-16002 (MODULE 3) * PGMR: R.M.C. REV.C(1648) MADE BY DENTON ANDERSON * REV.B(1603) IS FOR COLOR OPERATION. * REV.C(1648) IS FOR POWER FAIL - AUTO RESTART. * NAM CHAR,7 91200-16002 REV 1648 -- 761124 ENT CHAR,CH#R EXT .ENTR,DI[T,[TAB,VECTR SUP PRESS EXTRANEOUS LISTING SPC 1 XCHAR NOP "X" COORDINATE, LOWER LEFT POINT. YCHAR NOP "Y" COORDINATE, LOWER LEFT POINT. BUFAD NOP BEGINNING OF CHARACTER STRING. SIZE DEF ZERO CHARACTER SIZE (>0). ROT DEF ZERO 90 DEGREE ROTATION (0:3). LEN DEF ZERO STRING LENGTH PARAMETER. MODE DEF ZERO 0 TO WRITE, NON-0 TO ERASE. PFL NOP POWER FAIL INDICATOR. SPC 1 CHAR NOP ENTRY POINT.  JSB .ENTR TRANSFER THE PARAMETER ADDRESSES. DEF XCHAR LDA ROT,I AND B3 MOD 4 STA ROT LDA PFL TRANSFER POWER FAIL INDICATOR STA PFAIL ADDRESS FOR NEXT CALL. LDA YCHAR,I RETRIEVE INITIAL Y AND STA YV X CO-ORDINATES FOR TRANSFER LDA XCHAR,I TO 'VECTR' SUBROUTINE. STA XV LDA SIZE,I LOAD THE CHARACTER SIZE. SSA IS THE CHARACTER SIZE NEGATIVE? JMP EXIT ERROR, RETURN; "CALL" REJECTED. SZA,RSS IF SIZE 0 OR DEFAULTED, CLA,INA SET TO SIZE 1 AND B77 LIMIT TO A REASONABLE VALUE. STA SIZE CCA STA PCT PRESET THE PARENS COUNT, STA CHCTR AND CHARACTER COUNT. LDA LEN,I SSA STRING DELIMITED BY PARENS JMP BYTAD WHEN LEN IS NEGATIVE.. SZA,RSS STRING LENGTH IN FIRST WORD LDA BUFAD,I WHEN LEN=0. AND B77 REMOVE POSS HIGH CHAR. STA PCT PROTECT AGAINST ALL ('S. CMA USUAL INA SUPPRESSED TO ALLOW STA CHCTR LATER TEST WITH ISZ. SKP LDA LEN,I SZA,RSS TEST AGAIN FOR 0 PARAMETER ISZ BUFAD & BUMP TO PASS OVER. SPC 1 BYTAD LDA BUFAD CLE,ELA FORM BYTE ADDRESS. STA BUFAD ISZ CHCTR SKIPS IF PARENS MODE RSS CHCTR IS SAFE, & INITIALLY, NCH ISZ BUFAD INCREMENT FOR THE NEXT CHARACTER. LDA BUFAD LOAD THE ADDRESS WORD. CLE,ERA SAVE BIT 0 IN "E"; SHIFT ADDRESS. LDA A,I GET THE CHARACTER WORD. SEZ,RSS IS THE CHARACTER IN BITS 15-8? ALF,ALF YES, SO SHIFT IT INTO BITS 7-0. LDB DI[T DICTIONARY PARAMETERS ADDRESS AND B,I MASK TO LOWER BYTE (7 OR 8 INB BITS AS DEFINED IN DICTIONARY). ADA B,I SUBTRACT BASE CODE OF TABLE. SSA IF THE CHAR CODE IS < THE BASE, JMP FNCH IGNORE THIS CHARACTER. INB POINT TO TABLE LENGTH. ADA B,I IF THE CHARACTER IS STILL NOT SSA,RSS IN THE TABLE,THEN TRY TO ADA M40 FORCE LOWER CASE TO UPPER CASE. SSA,RSS IF STILL NOT IN THE TABLE, JMP NCH IGNORE THE CHARACTER. CMA,INA RESTORE DICTIONARY OFFSET IN ADA B,I A ROUND-ABOUT WAY CMA,INA CPA LPARC IS THIS CHARACTER A "("? JMP LPARN YES. CPA RPARC IS THIS CHARACTER A ")"? ISZ PCT YES. IS IT THE FINAL ONE? JMP D NO, CONTINUE. JMP EXIT YES, FINAL ")" SO RETURN. SPC 1 B3 OCT 3 B7 OCT 7 B17 OCT 17 B77 OCT 77 B777 OCT 777 M1 OCT -1 M40 OCT -40 LPARC ABS 50B-40B ( P NOP PCT NOP PARENTHESIS COUNTER. RPARC ABS 51B-40B ) SKP LPARN LDA PCT LOAD THE PARENTHESIS COUNTER. ADA M1 DECREMENT BY ONE(1). STA PCT STORE IT IN "PCT". LDA LPARC GET LPAREN CODE AGAIN D INB START OF DICTIONARY ADA B LDB A TEMP SAVE OF DICTIONARY ADDRESS. LDA B,I DICTIONARY CHARACTER CODE WORD. ALF NUMBER OF CONTROL WORDS TO 4 LSB. AND B17 MASK OFF BITS 3-0. CMA,INA NEGATE FOR COUNTING. CLE,ELA FORM THE BYTE COUNT. STA CCT PRESET TO -(# OF VECTORS). LDA B,I GET THE DICTIONARY WORD AGAIN. AND B777 MASK OFF THE RELATIVE ADDRESS. LDB [TAB ADD BEGINNING OF TABLE ADDRESS. ADA B CLE,ELA FORM THE BYTE ADDRESS STA P SAVE "A" AT "P". NCW LDB P CHARACTER ADDRESS OF COMMAND. ISZ P INCREMENT "P" FOR THE NEXT CODE. CLE,ERB FORM MEMORY ADDRESS OF COMMAND. LDB B,I LOAD THE WORD CONTAINING COMMAND. SEZ TEST THE COMMAND LOCATION. BLF,BLF SHIFT COMMAND TO BITS |0.*15-8. RBL,RBL STB A AND B3 ORIGINAL CODE BITS 6,7 STA TYPE BLF,RBR STB A AND B7 ORIGINAL CODE BITS 3,4,5 ADA ROT CORRECT FOR STRING'S ROTATION ADA ROT AND B7 MAKE MOD 8 STA THETA BLF,RBR STB A AND B7 ORIGINAL CODE BITS 0,1,2 MPY SIZE STA VLEN JSB VOUT CCA SET XV NEGATIVE SO THAT NEXT STA XV VECTOR WILL BE APPENDED. ISZ CCT MORE COMMAND WORDS? JMP NCW GET EM. ISZ CHCTR MORE CHARACTERS? JMP NCH GET EM. SKP EXIT LDA B100K DO A COMPLETION CALL TO STA VLEN VECTOR. JSB VOUT LDA DZERO RESTORE DEFAULT PARAMETERS STA SIZE FOR NEXT ENTRY STA ROT STA VLEN STA MODE CLA STA PFL JMP CHAR,I SPC 1 VOUT NOP JSB VECTR DEF CHK DEF XV DEF YV DEF THETA DEF VLEN DEF TYPE DEF MODE,I DEF ZERO PFAIL NOP CHK JMP VOUT,I SPC 3 CCT NOP CODE COUNTER. ZERO OCT 0 B100K OCT 100000 DZERO DEF ZERO SPC 1 CHCTR NOP CHARACTER COUNT THETA NOP VECTOR ROTATION 0:7 TYPE NOP VECTOR CONTROL 'WORD' * 0 NON-WRITING * 1 SUPPRESS FIRST POINT * 2 WRITE ALL POINTS * 3 SUPPRESS FIRST & LAST POINTS. SPC 1 A EQU 0 B EQU 1 CH#R EQU CHAR XV EQU XCHAR YV EQU YCHAR VLEN EQU LEN SPC 2 END yD0ASMB,L,C HED VIDEO SUBROUTINE [TABL (ASCII CODE TABLE)A-91200-16002-2 * * NAME: DICTIONARY/CODE TABLE OF VIDEO DISPLAY LIBRARY. * SOURCE: 91200-18002 (FILE 4) * BINARY: 91200-16002 (MODULE 4) * PGMR: R.M.C. REV.B(1603) MADE BY DENTON ANDERSON * REV.B(1603) IS FOR COLOR OPERATION. IT * DID NOT CHANGE THIS MODULE. * THERE IS NO CHANGE TO THIS MODULE FOR REV.C(1648). * * NAM [TABL,7 91200-16002 REV 1603 -- 751222 SPC 1 ENT DI[T,[TAB SPC 2 * DIRECTORY FORMAT: .XXX-.+NN0000B SPC 1 * WHERE, ".XXX" IS THE NAME OF THE FIRST * VECTOR CODE WORD; SPC 1 * "NN" IS THE NUMBER OF VECTOR CODE * WORDS FOR ".XXX". (4 BITS). SPC 3 ************* DO NOT REARRANGE THE ORDERING OF THIS TABLE! ******* DI[T DEF MASK ADDRESS DEFINITION FOR CHAR. * MASK OCT 177 ALLOW DEFINITION OF CODE LEVEL * BASE OCT -40 NEG OF FIRST ALLOWED CODE * LENTH ABS STBL-ETBL -(# OF ENTRIES IN DICTIONARY) * * * DICT ABS .SPC-.+010000B SPACE * STBL EQU DICT * ABS .EXP-.+030000B ! * ABS .QTE-.+040000B " * ABS .NUM-.+050000B # * ABS .S-.+110000B $ * ABS .PCT-.+100000B % * ABS .AND-.+060000B & * ABS .PRM-.+030000B ' APPOSTROPHE * ABS .LP-.+030000B ( * ABS .RP-.+030000B ) * ABS .STR-.+040000B * * ABS .PLS-.+030000B + * ABS .CMA-.+040000B , COMMA * ABS .MIN-.+020000B - * ABS .PER-.+030000B . ӫ * ABS .SLH-.+020000B / * ABS .0-.+100000B 0 * ABS .1-.+030000B 1 * ABS .2-.+060000B 2 * ABS .3-.+070000B 3 * ABS .4-.+030000B 4 * ABS .5-.+060000B 5 * ABS .6-.+060000B 6 * ABS .7-.+030000B 7 * ABS .8-.+110000B 8 * ABS .9-.+060000B 9 * ABS .CLN-.+060000B : * ABS .SCN-.+100000B ; * ABS .LTN-.+030000B < * ABS .EQU-.+030000B = * ABS .GTN-.+020000B > * ABS .QM-.+050000B ? * ABS .ATS-.+070000B @ * ABS .A-.+040000B A * ABS .B-.+070000B B * ABS .C-.+060000B C * ABS .D-.+040000B D * ABS .E-.+040000B E * ABS .F-.+030000B F * ABS .G-.+110000B G * ABS .H-.+030000B H * ABS .I-.+040000B I * ABS .J-.+050000B J * ABS .K-.+030000B K * ABS .L-.+020000B L * ABS .M-.+030000B M * ABS .N-.+030000B N * ABS .O-.+050000B O * ABS .P-.+040000B P * ABS .Q-.+060000B Q * ABS .R-.+060000B R * ABS .S-.+070000B S * ABS .T-.+030000B T  * ABS .U-.+040000B U * ABS .V-.+040000B V * ABS .W-.+060000B W * ABS .X-.+040000B X * ABS .Y-.+050000B Y * ABS .Z-.+040000B Z * ABS .LBK-.+030000B [ * ABS .RSL-.+020000B \ * ABS .RBK-.+030000B ] * ABS .UAW-.+030000B ^ * ABS .LAW-.+040000B _ * ETBL EQU * * ************* DO NOT REARRANGE THE CONTENTS OF THIS TABLE! ******* * END OF "ASCII CODE DIRECTORY". SKP * VECTOR BYTE CODES ARE PACKED TWO(2) PER * VECTOR CODE WORD. SPC 1 * FORM: CCDDDLLL,CCDDDLLL SPC 1 * WHERE, C/CODE: 0 = NON-WRITING, * 1 = FIRST AND LAST POINTS * ARE SUPPRESSED (IT IS * USED TO DRAW A VECTOR * BETWEEN TWO(2) OTHER * VECTORS), * 2 = FULL VECTOR (ALL POINTS * ARE DISPLAYED), * 3 = FIRST POINT IS * SUPPRESSED (IT IS USED * TO CONTINUE FROM THE * END OF AN EXISTING * VECTOR); SPC 1 * D/DIRECTION CODES: STARTING WITH * ZERO(0) DEGREES ON THE UNIT * CIRCLE, THERE ARE EIGHT (8) * POSSIBLE DIRECTIONS AT : 0,45,90,135,180, * 225,270,AND 315 DEGREES RESPECTIVELY. * RANGE = 0:7 SPC 1 * L/LENGTH: MAY BE 0 TO 7 UNITS LONG. SPC 3 * WATCH OUT FOR COMBINED CODES FOR THE FYOLLOWING GROUPS:- SPC 1 * [B P R] [C G] [E F] [% / 0 O] [, ;] [. :] [$ S] SPC 2 [TAB DEF . DEFINES THE CODE TABLE BASE ADDR&. .SPC OCT 3000 (SPACE). . EQU .SPC .EXP OCT 1200,11224,36062 ! .QTE OCT 4423,111002,131073,30400 " .NUM OCT 11204,11244,4664,1224,35462 # .AND OCT 2234,150711,174761,165361,174701,145072 & .PRM OCT 5022,111074,31000 ' .LP OCT 5423,124764,174403 ( .RP OCT 12411,134764,164405 ) .STR OCT 10614,21264,1234,36401 * .PLS OCT 11604,15264,34403 + .SCN OCT 5022,110741,170501,31052 ; (USES COMMA) .CMA OCT 34611,151341,170501,34403 , .MIN OCT 11011,101073 - .PER OCT 601,150741,70405 . OCT 16241,170701,50474 2ND DOT FOR : .PCT OCT 12221,140761,60473,110701,170541,21461 % .SLH OCT 10614,31472 / .0 EQU .SLH OCT 46 0 (USES / & O) OX OCT 631,152311,141371,172351,61005 O .1 OCT 602,20726,164475 1 .2 OCT 12611,141371,170751,161351,171304,1000 2 .3 OCT 12611,141371,170751,160452,134702,144721 3 OCT 54473 3 .4 OCT 1626,165761,142072 4 .5 OCT 10671,141311,151331,161722,142072,64 5 .6 OCT 631,151712,140453,141771,170751,61005 6 .7 OCT 13204,170753,171005 7 .8 OCT 5611,150731,161351,170771,141371,170751 8 OCT 161331,150711,1073 8 .9 OCT 101312,151731,161351,170771,41472,61 9 .CLN EQU .PER : .LTN OCT 5422,125372,34402 < .EQU OCT 5642,30602,35001 = .GTN OCT 4612,155075 > .QM OCT 12611,140771,170751,170462,100004 ? SKP .ATS OCT 12611,141371,172351,161331,150711,140563 @ OCT 1002 @ .A OCT 112312,175364,15042,42072 A * .B LOCATED BEFORE .P .C OCT 10624,144702,174454,174702,144471,400 C GX OCT 20433,101162,34401 G .D OCT 113303,174764,164543,3000 D .E OCT 142044 E .F OCT 113304,25441,141473 F .G EQU .C .H OCT 113063,42023,133002 H .I OCT 602,20526,20602,35463 I .J OCT 10671,140711,52441,101072,64 J .K OCT 113064,146053,175402 K .L OCT 13266,142002 L .M OCT 113372,145366,1000 M .N OCT 113061,76025,133002 N .O EQU OX SKP .B OCT 141711,150531,25400 B (USES P) .P OCT 113303,174761,164543,35403 P RX OCT 15442,175402 R .Q OCT 1241,154724,144702,174763,65022,135002 Q .R EQU .P .S OCT 10671,141311,150731,161331,150711,141371 OCT 35063 S OCT 22126,36062 $ .T OCT 13204,21366,2000 T .U OCT 13265,174702,144725,35064 U .V OCT 13264,175312,152072,32000 V .W OCT 13265,174711,151062,174711,152472,32000 W .X OCT 110714,150444,130774,170402 X .Y OCT 13261,175312,150452,30763,2000 Y .Z OCT 13204,170754,170704,1000 Z9 SKP .LBK OCT 11413,121366,141002 [ .RSL OCT 12674,34401 \ .RBK OCT 12411,101366,161004 ] .UAW OCT 12212,175032,173004 ^ .LAW OCT 11612,25372,15304,35061 _ * SPC 1 END ASMB,L,C HED VIDEO SUBROUTINES VECTR, AREA, VEND A-91200-16002-2 * * NAME: VECTOR GENERATOR, ETC. OF VIDEO DISPLAY LIBRARY. * SOURCE: 91200-18002 (FILE 5) * BINARY: 91200-16002 (MODULE 5) * PGMR: R.M.C. REV.C(1648) MADE BY DENTON ANDERSON * REV.B(1603) IS FOR COLOR OPERATION. * REV.C(1648) IS FOR POWER FAIL - AUTO RESTART. * * NAM VECTR,7 91200-16002 REV 1648 -- 761124 SPC 1 ENT VECTR,VEND,VAREA EXT .ENTR,POINT SPC 1 XV NOP X ORIGIN OF VECTOR. YV NOP Y ORIGIN OF VECTOR. ROT NOP ROTATION 0:7. LEN NOP VECTOR LENGTH (POINTS-1). TYPE DEF B2 VECTOR CONTROL WORD: * 0 NON-WRITING. * 1 SUPPRESS FIRST POINT. * 2 WRITE ALL POINTS. * 3 SUPPRESS FIRST & LAST POINTS. VMODE DEF ZERO DEFAULTS TO WHITE (0). DU\LO DEF ZERO 0/NON 0 =LOAD/LOAD & DUMP PBUFR. PF NOP POWER FAIL INDICAT%OR. SPC 1 VECTR NOP ENTRY POINT. JSB .ENTR TRANSFER THE PARAMETER ADDRESSES. DEF XV LDA VMODE,I TRANSFER MODE ADDRESS AND STA NMODE POWER FAIL LDA PF INDICATOR STA PFAIL FOR POINT CALL LDB LEN,I CHECK FIRST FOR LEN=100000B, CLE,ELB AND IF SO, DUMP WITHOUT SEZ,RSS VECTOR GENERATION. JMP *+3 SZB,RSS JMP EXIT1 SKP LDA XV,I IF X IS -VE, IGNORE X AND Y SSA AND APPEND VECTOR. JMP ADDTO ALF,ALF "X" COORDINATE TO BITS 15-8. XOR YV,I "Y" COORDINATE INTO BITS 7-0. ALF,ALF STA LOC SAVE THE NEXT DISPLAY LOCATION. ADDTO LDB TYPE,I RBR MOVE TYPE INTO BITS 15 STB TYPE AND 0 FOR EASY TESTING LDA ROT,I LDB LEN,I SZB,RSS IF LENGTH IS ZERO, JMP NOL GO CHECK SINGLE POINT CASE. CCE,SSB,RSS CMB,CLE,INB NEGATE FOR COUNTING. STB LEN SEZ IF LEN WAS -VE, REVERSE VECTOR ADA B4 DIRECTION. AND B7 MOD 8 ADA DBASE ADDRESS OF DISPLACEMENT CONSTANT. LDA A,I LOAD THE DISPLACEMENT CONSTANT. STA DISP SAVE FOR MODIFICATION WITH "LOC". LDA LOC LOAD THE CURRENT "GUN" LOCATION. LDB TYPE SSB,RSS NON-WRITE OR WRITE 1ST POINT? JMP TRAW YES ADA DISP SKIP THE FIRST POINT. STA LOC STORE "GUN" LOCATION IN "LOC". NPT ISZ LEN IS THIS THE LAST POINT? JMP EMIT NO, EMIT THE POINT AND CONTINUE. LDB TYPE SLB SUPPRESS LAST POINT? JSB .PPNT NO, SO DISPLAY THE POINT. JMP EXIT SPC 2 DISP NOP LOC NOP LOCATION OF NEXT DISPLAY POINT. B4 OCT 4 B7 OCT 7 SKP EMIT JSB .PPNT DISPLAY POINT AT "LOC". LDA LOC LOAD THE CURRENT "GUN" LOCATION. p ADA DISP ADD IN THE DISPLACEMENT. STA LOC STORE "LOC" TO SAVE IT FOR LATER. JMP NPT GO SEE IF THIS IS THE LAST POINT. SPC 1 TRAW SLB IS THIS A WRITE? JMP EMIT YES, GO DISPLAY THE FIRST POINT. LOOP2 ADA DISP NON-WRITE, "LOC" IS IN "A". ISZ LEN ARE THERE MORE DISPLACEMENTS? JMP LOOP2 YES, REPEAT THE ADD. STA LOC JMP EXIT SPC 1 NOL LDA LOC LOAD THE CURRENT "GUN" LOCATION. LDB TYPE CHECK FOR TYPE 2. SLB JSB .PPNT DISPLAY THE FIRST POINT. SPC 1 EXIT LDA DU\LO,I IF OUTPUT IS NOT FORCED SZA,RSS BY THE CALLER, JMP EXIT2 DON'T DUMP THE BUFFER. EXIT1 LDA PLEN WHEN OUTPUT IS FORCED, SZA DUMP ONLY IF BUFFER JSB DUMP HAS SOME POINTS. EXIT2 LDA DZERO RESTORE DEFAULT PARAMETERS STA DU\LO FOR NEXT ENTRY BY STA VMODE CALLER. LDA DEFB2 STA TYPE CLA STA PF JMP VECTR,I SPC 2 PBLEN ABS -BLEN .POUT DEF PBUFR CURRENT POINTER .PBUF DEF PBUFR FIXED POINTER TO START PLEN OCT 0 ACCUMULATOR PCTR ABS -BLEN OVERFILL PREVENTER SKP .PPNT NOP STA ALOC SAVE POINT LDB NMODE IS THE NEW MODE CPB MODE THE SAME AS OLD MODE? JMP .VPNT YES - GO ON LDB PLEN SZB IS THE BUFFER EMPTY? JSB DUMP NO - SO DUMP WITH OLD MODE LDB NMODE ESTABLISH STB MODE NEW MODE .VPNT STA .POUT,I ISZ .POUT ISZ PLEN ISZ PCTR JMP .PPNT,I JSB DUMP PBUFR IS FULL JMP .PPNT,I SPC 1 DUMP NOP JSB POINT DEF RSTR DEF PBUFR DEF PLEN DEF MODE PFAIL NOP RSTR LDB .PBUF STB .POUT LDB PBLEN STB PCTR CLB STB PLEN LDA ALOC RESTORE POINT JMP DUMP,I !e SPC 2 MODE NOP NMODE NOP SKP * CURRENT LOCATION ROUTINE. SPC 1 IX NOP ADDRESS FOR THE "X" COORDINATE. IY NOP ADDRESS FOR THE "Y" COORDINATE. VEND NOP ENTRY POINT. JSB .ENTR CALL WITH TWO(2) PARAMETERS. DEF IX LDA LOC LOAD THE LAST POINT ADDRESS. AND B377 EXTRACT THE X COORDINATE STA IX,I & STORE IT IN THE PARAMETER. LDA LOC LOAD THE LAST POINT ADDRESS. ALF,ALF SHIFT THE "Y" COORDINATE. AND B377 EXTRACT THE Y COORDINATE STA IY,I & STORE IT IN THE PARAMETER. JMP VEND,I SPC 2 A EQU 0 BLEN EQU 350 LENGTH OF PBUFR SPC 1 VLEN NOP STORE AREA VECTOR LENGTH ZERO OCT 0 B2 OCT 2 B3 OCT 3 SPC 1 DZERO DEF ZERO DEFB1 DEF B1 DEFB2 DEF B2 SPC 2 * ROTATION OFF-SET VALUES (45 DEGREE). SPC 1 DBASE DEF *+1 B1 OCT 1,401,400 B377 OCT 377,-1,177377 ROTATIONS 3,4,5 M400 OCT 177400,177401 ROTATIONS 6,7 SKP * AREA ERASE OR WRITE SUBROUTINE. * * THE AREA DEFINED IN THE CALL IS 'WRITTEN' FROM THE TOP LEFT * CORNER, COLUMN BY COLUMN. * * * CALCULATION OF INTERNAL PARAMETERS FOR AREA: SPC 1 ************************************************************** * VALUE OF AROT (0:3) * * * 00 * 01 * 10 * 11 * ************************************************************** * X ORIGIN * XA * XA-DELTY * XA-DELTX * XA * * Y ORIGIN * YA+DELTY * YA+DELTX * YA * YA * * LENGTH * DELTY * DELTX * DELTY * DELTX * * # OF VECTORS * DELTX+1 * DELTY+1 * DELTX+1 * DELTY+1 * ************************************************************** SPC 1 XA NOP YA NOP DELTX NOP INTERNAL USE AS VECTOR COUNTER. DELTY NOP INTERNAL USE AS LENGTH COUNTER. B AROT DEF ZERO DEFAULT L-TO-R FROM LOWER LHC. AMODE DEF B1 DEFAULT BLACK (1). PFL NOP POWER FAIL INDICATOR. SPC 1 VAREA NOP ENTRY POINT JSB .ENTR DEF XA LDA AMODE,I TRANSFER MODE ADDRESS AND STA NMODE POWER FAIL LDA PFL INDICATOR STA PFAIL FOR POINT CALL. LDA AROT,I AND B3 MOD 4 STA AROT LDB DELTY,I SLA,RAR LDB DELTX,I SSB NEG. LENGTH? JMP EAREA YES -- DON'T DO IT! CMB SAVE AS PRESET FOR STB VLEN LENGTH COUNTER. CMB RESTORE FOR YA CALCULATION. SLA CLB ADB YA,I STB YA SKP LDA AROT LDB DELTX,I SLA LDB DELTY,I SSB NEG. LENGTH? JMP EAREA YES -- DON'T DO IT! CMB STB DELTX -(# OF VECTORS) INB ADJUST FOR X-ORIGIN USE. INA ADD 1 SO THAT ROTS 0,3 CAN BE RAR SEPARATED FROM ROTS 1,2 SLA,RSS CLB ADB XA,I STB XA COLUM LDB VLEN STB DELTY LDA YA ALF,ALF XOR XA DOTS JSB .PPNT ADA M400 ISZ DELTY JMP DOTS ISZ XA ISZ DELTX JMP COLUM JSB DUMP OUTPUT PARTIAL BUFFER. EAREA LDA DZERO RESTORE DEFAULT PARAMETERS STA AROT STA DU\LO LDA DEFB1 FOR NEXT CALL. STA AMODE CLA STA PFL JMP VAREA,I SPC 2 ALOC NOP CURRENT COORDINATES FOR AREA. PBUFR BSS BLEN THEND EQU * SPC 2 END ASMB,L,C HED VIDEO SUBROUTINES POINT,VIDLU,ERASE A-91200-16002-2 * * NAME: EXEC INTERFACE OF VIDEO DISPLAY LIBRARY * SOURCE: 91200-18002 (FILE 6) * BINARY: 91200-16002 (MODULE 6) * PGMR: R.M.C. REV.C(1648) MADE BY DENTON ANDERSON * REV.B(1603) IS FOR COLOR OPERATION. *  REV.C(1648) IS FOR POWER FAIL - AUTO RESTART. * * NAM POINT,7 91200-16002 REV 1648 -- 761124 SPC 1 ENT POINT,VIDLU,ERASE EXT .ENTR,EXEC,RSFLG SPC 1 BUFFR NOP NUM DEF B1 MODE DEF ZERO PFAIL NOP POWER FIAL INDICATOR. SPC 1 POINT NOP ENTRY POINT JSB .ENTR DEF BUFFR LDA NUM,I SZA,RSS IF 0,RETURN WITH NO JMP PRTN ACTION. STA NUM LDA CPRAM AND B200 KEEP BIT 7 OF CPRAM FOR CONTROL STA B REQUEST TO DRIVER LDA MODE,I GET COLOR CODE AND B7 CLE,ERA POSITION RAL,RAL COLOR BITS ELA,ALF FOR CONTROL RAL,RAL CALL IOR B FORM MODE BITS FOR CONTROL WORD IOR LU COMPLETE CONTROL WORD STA CPRAM AND SAVE SPC 1 LDA PFAIL IS POWER FAIL SZA,RSS TO BE CHECKED? JMP SMODE NO - GO ON SPC 1 JSB EXEC STATUS CALL FOR POWER FAIL DEF SRTN DEF D13 DEF LU DEF PSTAT SPC 1 SRTN LDA PSTAT AND B1 STA PFAIL,I SKP SMODE JSB EXEC SEND LAST SENSE AND CURRENT DEF P1 MODE TO DRIVER IN DEF B3 CONTROL REQUEST. DEF CPRAM SENSE & MODE PARAMETERS & LU. SPC 1 P1 JSB EXEC SEND COORDINATES OF EACH DEF PRTN POINT IN USER'S BUFFER DEF B2 DEF LU DEF BUFFR,I DEF NUM SPC 1 PRTN LDA DEFB1 RESTORE DEFAULT STA NUM PARAMETERS FOR NEXT CALL. LDA DZERO STA MODE CLA STA PFAIL JMP POINT,I SPC 2 B EQU 1 B1 OCT 1 B2 OCT 2 B3 OCT 3 B7 OCT 7 B77 OCT 77 B200 OCT 200 B400 OCT 400 D13 DEC 13 ZERO OCT 0 DEFB1 DEF B1 DZERO DEF ZERO CPRAM NOP PSTAT NOP SKP LU NOP SENSE DEF ZERO SPC 1 VIDLB@ SET TEST RAR / BIT STORAGE STA BIT7 / RAR / STA BIT8 / RAR / STA BIT9 / JMP SAVE,I SKP **************************************************************** * * * -- GAIN CHECK ROUTINE FOR TV -- * * Qh * **************************************************************** SPC 1 * THE GAIN SUBROUTINE GENERATES A RECTANGLE * AND ARROWS TO TEST THE HEIGHT AND WIDTH ON THE TV SPC 1 GAIN NOP SZB WAIT? JSB TIME5 YES JSB ERASE ERASE ENTIRE SCREEN JSB MODE SET WRITE MODE SPC 1 LDB TESTM GET AMERICAN SCAN INDICATOR LDA X GET Y = 256 SZB AMERICAN SCAN? LDA YAMER YES - GET Y = 240 STA Y SET VERTICAL DIMENSION LDA SA0 GET RECT 1 Y FOR NON-AMER. SZB AMERICAN SCAN? ADA STADR YES - Y = Y - 8 STA S0 SET VERTICAL POSITION 1 LDA SA1 GET RECT 2 Y FOR NON-AMER SZB AMERICAN SCAN? ADA STADR YES - Y = Y - 8 STA S1 SET VERTICAL POSITION 2 CLA GET NOP FOR ARROW POS. REDUCER SZB AMERICAN SCAN? LDA ADDX YES - GET INST. FOR POS. RED. STA ADD SET ARROW POSITION REDUCER SPC 1 JSB SQUAR GO TO SQUAR SBR TO DRAW A RECT. OCT 0 Y DEC 256 VERT. DIM. OF RECT. X DEC 256 HORIZ. DIM. OF RECT. SPC 1 LDA SYMBL GET NUMBER OF DOTS IN SYMBOL STA DOTC PUT IN DOT COUNTER LDA POSIT GET NUMBER OF POSITIONS STA POSC PUT IN POSITION COUNTER LDA LOOPS GET NUMBER OF LOOPS (ARROWS) STA LOOPC PUT IN LOOP COUNTER LDA ARW1S GET START OF SYMBOL STA ARW1 AND SAVE LDA ARW1T GET START OF COMMON POSITION STA ARW1P AND SAVE SKP **************************************************************** * * * -- GAIN ROUTINE CONTINUED -- * * * **************************************************************** SPC 1 HEAD1 LDA ARW1,I GET DOT LDB ARW1P,I GET POSITION ADA B ADD DOT TO POSITION ADD ADA STADR REDUCE Y BY 8 FOR AMER SCAN ONLY JSB OUTR SEND DOT TO SCOPE ISZ DOTC INCREMENT DOT COUNTER JMP *+2 SKIP JMP HEAD2 GET NEXT POSITION ISZ ARW1 INCREMENT DOT POINTER JMP HEAD1 SET UP NEXT DOT SPC 1 HEAD2 LDA SYMBL GET -12 STA DOTC PUT IN DOT COUNTER ISZ POSC INCREMENT POSITION JMP *+2 ALL 5 NOT DRAWN JMP HEAD3 RESTORE POSC AND TEST LOOPC LDA ARW1 ADA D11 STA ARW1 ISZ ARW1P JMP HEAD1 SPC 1 HEAD3 LDA POSIT GET -5 STA POSC PUT IN POSITION COUNTER ISZ LOOPC ARE ALL SYMBOLS DRAWN JMP *+2 ALL SYMBOLS NOT DRAWN JMP HEAD4 ALL SYMBOLS DRAWN ISZ ARW1 5 SYMBOLS OF ONE TYPE DRAWN ISZ ARW1P JMP HEAD1 SPC 1 HEAD4 JSB SQUAR WRITE A S0 OCT 77575 CROSS DEC 2 IN THE DEC 6 MIDDLE JSB SQUAR OF THE S1 OCT 76577 SCREEN DEC 6 BY WRITING DEC 2 TWO RECTANGLES CCB DONE! JMP GAIN,I SPC 2 ADDX ADA STADR Y POSITION REDUCING INSTRUCTION SKP **************************************************************** * * * -- PIN CUSHION TEST, CROSS HATCH PATTERN -- * * * **************************************************************** SPC 1 PIN NOP PIN CUSHION TEST SZB WAIT? JSB TIME5 YES JSB ERASE ERASE ENTIRE SCREEN JSB MODE SET WRITE MODE CLA SET eWRITE STA TOGG INDICATOR SPC 1 LDB TESTM GET AMERICAN SCAN INDICATOR LDA MASK0 GET VERT MIDDLE DONE, NON-AMER SZB AMERICAN SCAN? LDA MASK6 YES - GET VERT MID DONE FOR AMER STA MSK0 SET VERTICLE MIDDLE DONE TESTER LDA MASK6 GET VERT MIDDLE, NON-AMER SZB AMERICAN SCAN? LDA MASK1 YES - GET VERT MID FOR AMER STA MSK6 SET VERTICLE MIDDLE TESTER LDA MASK9 GET VERT NXT TO MID, NON-AMER SZB AMERICAN SCAN? LDA MASK5 YES - GET NXT TO MID FOR AMER STA MSK9 SET VERT NEXT TO MIDDLE TESTER SPC 1 UNPIN CLB CLEAR X COUNTER PIN1 CLA CLEAR Y COUNTER FAX1 IOR B MERGE X INTO Y JSB OUTR DRAW DOT AND MASK2 MASK OUT X PORTION CPA MASK2 TEST FOR Y LINE FINSIHED JMP FAX2 Y LINE FINISHED ADA CON7 ADD 1 TO Y JMP FAX1 SPC 1 FAX2 CPB MASK3 IS LAST LINE FINISHED? JMP FAX4 LAST FINISHED CPB MASK4 IS NEXT TO MIDDLE FINISHED? JMP FAX3 YES CPB MASK7 IS THIS THE MIDDLE? JMP FAX3A YES CPB MASK8 IS MIDDLE FINISHED? JMP FAX3 YES ADB CON3 ADD 10B TO X JMP PIN1 DRAW NEXT VERTICLE SPC 1 FAX3 ADB B7 ADD 7B TO X JMP PIN1 SPC 1 FAX3A ADB B1 ADD 1 TO X JMP PIN1 SKP **************************************************************** * * * -- PIN CUSHION TEST CONTINUED -- * * * **************************************************************** SPC 1 FAX4 CLB CLEAR Y COUNTER FAX5 CLA CLEAR X COUNTER FAX6 IOR B MERGE Y INTO X JSB OUTR DRAW DOT AND MASK3 }HFBMASK OUT Y PORTION CPA MASK3 TEST FOR HORIZONTAL FINISHED JMP FAX7 FINISHED INA ADD 1 TO X JMP FAX6 SPC 1 FAX7 CPB MASK2 IS LAST LINE FINISHED? JMP PIN2 LAST FINISHED RETURN TO MAIN CPB MSK6 IS NEXT TO MIDDLE FINISHED? JMP FAX8 YES CPB MSK9 IS THIS THE MIDDLE? JMP FAX8A YES CPB MSK0 IS MIDDLE FINISHED? JMP FAX8 YES ADB B4000 ADD 10B TO Y JMP FAX5 DRAW NEXT HORIZONTAL SPC 1 FAX8 ADB CON2 ADD 7B TO Y JMP FAX5 SPC 1 FAX8A ADB CON7 ADD 1 TO Y JMP FAX5 SPC 2 PIN2 LDA TOGG CHANGE STATE INA OF WRITE STA TOGG INDICATOR SLA,RSS TIME TO ERASE? JMP RESP NO - DONE LDB TEST YES SZB,RSS IS THIS FROM GO-NOGO? JMP RESP NO - DONE SPC 1 JSB TIME5 WAIT JSB MODE1 SET ERASE MODE JMP UNPIN GO ERASE SPC 1 RESP CCB DONE! JMP PIN,I SKP H**************************************************************** * * * -- SETTLING TIME, SQUARES IN 4 CORNERS -- * * * **************************************************************** SPC 1 SETTM NOP SETTLING TIME ROUTINE SZB WAIT? JSB TIME5 YES JSB ERASE ERASE ENTIRE SCREEN JSB MODE SET WRITE MODE SPC 1 LDB TESTM GET AMERICAN SCAN INDICATOR LDA SA2 GET RIGHT SQUARE POS, NON-AMER SZB AMERICAN SCAN? LDA SXA2 YES - GET RT SQR FOR AMER STA S2 SET RIGHT SQUARE STARTING POINT LDA STADR GET LEFT SQUARE POS, NON-AMER SZB AMERICAN SCAN? LDA SXA3 YES - GET LEFT SQR FOR AMER STA S3 SET LEFT SQUARE STARTING POINT SPC 1 JSB SQUAR PUTS 8X8 SQUARE ZERO OCT 0 IN THE CON3 DEC 8 LOWER LEFT DEC 8 CORNER JSB SQUAR PUTS 8X8 SQUARE S2 OCT 174370 IN THE DEC 8 UPPER RIGHT DEC 8 CORNER JSB SQUAR PUTS 8X8 SQUARE S3 OCT 174000 IN THE DEC 8 UPPER LEFT DEC 8 CORNER JSB SQUAR PUTS 8X8 SQUARE OCT 370 IN THE DEC 8 LOWER RIGHT DEC 8 CORNER CCB DONE! JMP SETTM,I SKP **************************************************************** * * * -- QUICKLY WRITE & ERASE ALL POINTS -- * * * **************************************************************** SPC 1 QUICK NOP CPB B1 FLASH BACKGROUND? RSS MAYBE JMP LA X@ NO LIA 1 IOR TESTC AND HLT0 CPA HLT0 ? JMP QUICK,I NO - IGNORE JMP ON YES LA LIA 1 SSA REPEAT MODE IN SUPER TEST? JMP LB YES - SO DO IT ALF,RAL SSA FLASH MODE IN SUP TEST? JMP QUICK,I YES - IGNORE LB SZB WAIT JSB TIME5 YES JSB ERASE ERASE ENTIRE SCREEN JSB MAP GET COLOR & POLARITY INFO ON CLA SET WRITE/ERASE STA W.E INDICATOR TO WRITE OLOOP LDB W.E PREPARE CARD FOR MODE LDA MD SLB LDA B15 IOR POL JSB SETMD OUTPUT MODE LDA W.E CLB ESTABLISH ADDRESS 0,0 JMP *+3 START SKP **************************************************************** * * * -- QUICK CONTINUED -- * * * **************************************************************** SPC 1 LOOP INB,SZB,RSS INCREMENT ADDRESS - DONE? JMP DONE YES SLA WRITE? CMB NO - COMP. FOR UPPER SCREEN OTB1 OTB TV OUTPUT STCC4 STC TV,C POINT SLA WRITE? CMB NO - COMP. BACK FOR INCREMENT JMP LOOP CONTINUE DONE LDA TESTA SZA WRITE ONLY? JMP OUT YES - ALL DONE LDA W.E CHANGE STATE OF XOR B1 WRITE/ERASE STA W.E INDICATOR SLA WRITE? JMP OLOOP NO - GO ERASE OUT CCB YES - DONE! JMP QUICK,I SKP **************************************************************** * * * -- DISPLAY HP LOGO -- * * i * **************************************************************** SPC 1 LOGO NOP CLA,INA SET INDICATOR FOR STA TESTB FLASHING MODE SZB WAIT? JSB TIME5 YES JSB ERASE ERASE ENTIRE SCREEN JSB MODE SET WRITE MODE LDA CW1 SET OTA 6B UP CLC 2B DMA LDA BUFAD TRANSFER OTA 2B / STC 2B / LDA BUFLN / OTA 2B / LIB 2B READ BACK WORD COUNT SZB,RSS ZERO (NO DMA CARDS)? JMP NODMA DON'T USE DMA INB,SZB,RSS NEG ONE (NO DCPC CARD)? JMP NODMA DON'T USE DMA STC 6B,C TURN ON DMA SFS 6B WAIT FOR JMP *-1 DMA TO COMPLETE CLC 6B TURN OF DMA JMP EXIT DONE SPC 1 NODMA STA CNT4 SET WORD COUNT FOR NON-DMA LDB BUFAD GET BUFFER ADDRESS MORE LDA B,I GET A POINT FROM BUFFER JSB OUTR OUTPUT THE POINT INB ADVANCE BUFFER ADDRESS ISZ CNT4 COUNT DOWN - DONE? JMP MORE NO - GET NEXT POINT EXIT CCB DONE! CLA CLEAR FLASHING STA TESTB INDICATOR JMP LOGO,I SKP **************************************************************** * * * -- ERASE SCREEN -- * * * **************************************************************** SPC 1 BLANK NOP SZB WAIT? JSB TIME5 YES JSB ERASE DO THE BULK ERASE JSB MODE SET SCREEN POLARITY CCB JMP BLANK,I SPC 3 ***************************************************************** * D * * -- BIT 14 HALT PROCESSOR -- * * * ***************************************************************** SPC 1 ..HLT JSB .HALT FROM FLASH OR BARS LDA TEST SZA SUPER TEST? JMP BRS NO - BARS JMP RESTT YES - RESTART SPC 1 .HALT NOP JSB DEL SWITCH DE-BOUNCE LIA 1 CLEAR AND CLHLT HALT BIT (14) OTA 1 IN SWITCH REGISTER HLT 77B HALT LDA HLT77 RESTART STA *-2 JMP .HALT,I SKP **************************************************************** * * * -- FLASHING ROUTINE -- * * * **************************************************************** SPC 1 FLSH LDA B3 JSB SET STA SWCH CLEAR SWITCH TO DO 1 TEST FSH CLB JSB LOGO WRITE LOGO WITH BACKGROUND SPC 1 FLASH LDA TEST CPA B4 BARS? JMP CLR? YES SZA,RSS GO-NOGO TEST? JMP CLR? NO - SUPER TEST JSB TIME5 WAIT A SECOND LDA FTIME ESTABLISH LDB MD NUMBER SZB OF ARS TIMES STA FCNTR TO FLASH JMP FLSH0 START FLASHING SPC 1 CLR? LIA 1 FOR SUPER TEST & BARS ALF,RAL DO WE SSA,RSS WANT TO FLASH? JMP CLEAR NO SPC 1 FLSH0 LDA B2 GET BLACK-ON-WHITE BIT STA TESTC FLSH1 JSB SETMD SET VIDEO POLARITY STA TEMP SAVE POLARITY MODE LDA TEST CPA B4 BARS? JMP TIME YES SZA,RSS GO-NOGO TEST? JMP TIME NO JSB TIMEF YES - WAIT A BIT ISZ FCNTR COUNT DOWN # OF FLASHES - DONE? RSS NO JMP CLEER YES - GO CLEAR THINGS JMP FLSH2 CONTINUE FLASHING - NEXT PAGE SPC 1 TIME JSB TIME5 SUPER TEST OR BARS - WAIT LIA 1 WANT RAL TO SSA HALT? JMP ..HLT YES ALF WANT TO SSA,RSS CONTINUE FLASHING? JMP CLEAR NO - GO CLEAR THINGS SKP **************************************************************** * * * -- FLASHING ROUTINE CONTINUED * * * **************************************************************** SPC 1 LDA TEST CPA B4 BARS? JMP FLSH2 YES LIA 1 WANT TO STOP AND TEMP1 FLASHING THIS SZA,RSS PATTERN? JMP CLEAR YES - GO CLEAR THINGS SPC 1 FLSH2 LDA TEMP CHANGE VIDEO XOR B2 POLARITY MODE JMP FLSH1 AND GO FLASH SPC 1 CLEER CLA SET WHITE-ON-BLACK JSB SETMD FOR GO-NOGO TEST LIA 1 WANT TO SSA,RSS REPEAT? JMP FHLT NO - HALT RAL SSA INCREMENT COLORS? JSB INC YES JMP SWCH FHLT HLT 77B LDA HLT77 GO REPEAT STA *-2 THE TEST(S) SPC 1 SWCH NOP SWITCH - RSS IF ALL 3 TESTS RUN JMP FTEST GO FLASH AGAIN JSB ERASE ERASE SCREEN JMP BEGIN GO REDO I/O CHECK,ETC. SPC 1 CLEAR LDA TEST CPA B4 BARS? JMP DUNN YES LIA 1 SSA GO BACK TO REPEAT MODE? JMP LC YES AND CLR CLEAR SWITCH REGISTER OTA 1 FOR SUPER TEST LC JSB DEL  WAIT FOR SWITCH DEBOUNCE JMP AGAIN GET NEXT TEST SPC 1 FTEST LDB MD JSB MAP CPA B SAME COLOR? JMP FLASH YES - REPEAT IT JMP FSH NO - GET NEW ONE SKP **************************************************************** * * * -- COLOR OR GRAY BARS ROUTINE -- * * * **************************************************************** SPC 1 BRS LDA B4 JSB SET LIA 1 SET VIDEO POLARITY RAR,RAR FROM SWITCH REGISTER BIT 3 AND B2 =0 NORMAL STA TEMP =1 INVERTED JSB SETMD CLA INITIALIZE INSTRUCTION STA L0 FOR FIRST PASS JSB ERASE DO BULK ERASE SPC 1 CLB SET FIRST POINT (0,0) SPC 1 LOOPB LDA B OUTPUT JSB OUTR POINT SPC 1 INB,SZB,RSS INCREMENT POINT AND TEST JMP DUNN ALL DONE CPB ALL LOWER WHITE AREA COMPLETE? JMP T0 YES - MODIFY LOOP L0 NOP UNTIL LOWER AREA DONE, THEN RSS JMP LOOPB GO OUTPUT POINT SPC 1 LDA B CHECK X COORDINATE AND MASK3 FOR START OF CPA ZERO BLACK AREA? JMP T0 SET BLACK CPA FIRST BLUE AREA (1/8)? JMP T1 SET BLUE CPA SECND GREEN AREA (1/4)? JMP T2 SET GREEN CPA FS CYAN AREA (3/8)? JMP T1 SET CYAN CPA MASK8 RED AREA (1/2)? JMP T3 SET RED CPA FT MAGENTA AREA (5/8)? JMP T1 SET MAGENTA CPA B300 YELLOW AREA (3/4)? JMP T2 SET YELLOW CPA FST WHITE AREA (7/8)? JMP T1 SET WHITw0E JMP LOOPB GO OUTPUT THE POINT SKP **************************************************************** * * * -- BAR GENERATOR, CONTINUED -- * * * **************************************************************** SPC 1 DUNN LIA 1 STA TEMP1 SSA,RSS REPEAT? JMP *+3 NO JSB TIME5 YES - DELAY LOOP JMP BRS GO DO AGAIN LDA TEMP1 CHECK FOR ALF,RAL FLASHING CONDITION SSA (SWITCH 10)? JMP FLASH YES - GO FLASH BHLT HLT 77B NO - SO STOP! LDA HLT77 INSURE HALT COMMAND STA *-2 FOR 2100 JMP BRS DO IT AGAIN SPC 2 * COLOR SETTING ROUTINES SPC 1 T0 LDA XRSS \ STA L0 \ SET LDA B15 / BLACK JMP T4 / SPC 1 T1 LDA MD \ AND B7 > TURN BLUE ON JMP T4 / SPC 1 T2 LDA MD \ AND B13 \ TURN BLUE OFF IOR B10 / AND GREEN ON JMP T4 / SPC 1 T3 LDA MD \ AND B16 > TURN BLUE & GREEN OFF IOR B14 / AND RED ON SPC 1 T4 STA MD \ IOR TEMP \ SET REQUESTED MODE & POLARITY, JSB SETMD / THEN RETURN TO LOOP JMP LOOPB / SKP **************************************************************** * * * -- DRAW SPECIFIED SQUARE -- * * * **************************************************************** SPC 1 * ** USED BY GAIN AND SETTM ** SPC 1 SQUAR NOP LDA SQUAR,I THIS GETS LLHC STA BUFF _LDB SQUAR INB LDA 1,I ADDRESS OF VERT IN B CMA,INA TAKE TWO'S COMP INA ADD ONE STA VERT1 STA VERT2 STORE IN TWO COUNTERS INB ADD TO ADDRESS LDA 1,I GET HORIZONTAL CMA,INA TAKE TWO'S COMP INA ADD ONE STA HORZ1 STA HORZ2 STORE IN TWO COUNTERS INB PREPARE RETURN ADDRESS STB SQUAR STORE IN RETURN POINT LDA BUFF SPC 1 UP ADA CON7 A+1 TO A JSB OUTR DRAW DOT ISZ VERT1 ADD ONE TO VERT JMP UP SPC 1 RIGHT ADA B1 JSB OUTR ISZ HORZ1 JMP RIGHT SPC 1 DOWN ADA CON1 WHERE CON1=-400B JSB OUTR ISZ VERT2 JMP DOWN SPC 1 LEFT ADA XCONN WHERE XCONN=-1 JSB OUTR ISZ HORZ2 JMP LEFT SPC 1 JMP SQUAR,I SKP **************************************************************** * * * -- BULK ERASE ROUTINE -- * * * **************************************************************** SPC 1 ERASE NOP CLF3 CLF TV CLEAR PRESET LIA1 LIA TV ISSUE BULK ERASE CMND STCC1 STC TV,C STF 0 TURN ON THE INTERRUPT SYSTEM JSB TIMER TIME ERASE FOR 44 MILLISECONDS HLT 2B THE ERASE TOOK TOO LONG! LDA HLT2 RESTORE HALT STA *-2 FOR 2100A ENDE CLF 0 TURN OFF THE INTERRUPT SYSTEM JMP ERASE,I RETURN SPC 4 **************************************************************** * * * -- ERASE DURATION TIMER -- * * * ************************************************************ .**** SPC 1 * THIS IS A 44 MILLISECOND TIMER COMPENSATED * FOR COMPUTER MODEL. SPC 1 TIMER NOP LDB COMP SZB,RSS 2100? LDA MILC6 YES CPB B1 2114/2115? LDA MILC5 YES CPB B2 2116? LDA MILCT YES CPB B3 21MX? LDA MILCX YES CPB B4 21MX-E SERIES? JMP DXE YES SPC 1 ISZ A TIMING JMP *-1 LOOP JMP TIMER,I SPC 1 DXE LDA LOOPS 21MX-E SEREIS DXE1 LDB MILCE TIMING OCT 100060 LOOP INA,SZA JMP DXE1 JMP TIMER,I SKP **************************************************************** * * * -- GENERAL PURPOSE TIME DELAY -- * * * **************************************************************** SPC 1 * THE FOLLOWING IS NOT COMPENSATED FOR CYCLE TIME; * THE TIME IS SET BY BITS 11-13 (APPROXIMATELY) SPC 1 TIME5 NOP <1, 1 OR 5 SECOND TIMER LIA 1 CHECK LDB TEST SZB CPB B4 RSS CLA,INA,RSS ALF,RAR BITS 13 & 12 LDB TCON5 GET 5 SECOND COUNT SLA 1 SECOND? LDB POSIT MAYBE SSA QUICK? CCB YES RAL EXTREMELY SSA,RSS QUICK? JMP *+3 NO LDA TCONF YES RSS LDA TCON1 STA TCON SAVE PROPER COUNTER SPC 1 LDA TCON GET INNER TIMER ISZ A INNER TIMER JMP *-1 COUNT-DOWN LOOP ISZ B OUTER TIMER JMP *-4 COUNT-DOWN LOOP JMP TIME5,I SPC 4 **************************************************************** * D * * -- FLASH RATE DELAY FOR GO-NOGO TEST -- * * * **************************************************************** SPC 1 TIMEF NOP LDA TCONF ESTABLISH COUNTER LDB MD SZB WHITE? LDA TCON1 NO - SO FLASH SLOWER ISZ A COUNT JMP *-1 LOOP JMP TIMEF,I SKP **************************************************************** * * * -- OUTPUT A POINT -- * * * **************************************************************** SPC 1 OUTR NOP OTA1 OTA TV \ STCC2 STC TV,C \ OUTPUT POINT SFS1 SFS TV / TO CARD JMP *-1 / JMP OUTR,I SPC 4 **************************************************************** * * * -- SW REG CONTACT CHATTER DELAY ROUTINE -- * * * **************************************************************** SPC 1 DEL NOP STA ATMP1 SAVE A LDA CNT1 STA CNT4 SET COUNTER LDA ATMP1 RESTORE A ISZ CNT4 DELAY JMP *-1 LOOP JMP DEL,I SPC 4 **************************************************************** * * * -- SET ERASE MODE -- * * * **************************************************************** SPC 1 MODE1 NOP SET ERASE MODE LDA B15 STA MODE2 JSB MODE GO SET ERASE MODE CLA RESTORE STA MODE2 WRITE MODE BIT  JMP MODE1,I SKP **************************************************************** * * * -- SET WRITE MODE -- * * * **************************************************************** SPC 1 MODE NOP SET WRITE MODE JSB SETUP GET COLOR INFORMATION IOR MODE2 SET ERASE BIT IF DESIRED JSB SETMD OUTPUT MODE JMP MODE,I SPC 4 **************************************************************** * * * -- SET REQUESTED MODE -- * * * **************************************************************** SPC 1 SETMD NOP CLC1 CLC TV GET CARD READY FOR MODE WORD OTA2 OTA TV OUTPUT STCC3 STC TV,C MODE WORD SFS2 SFS TV JMP *-1 JMP SETMD,I SPC 4 **************************************************************** * * * -- INITIALIZE TEST PARAMETERS -- * * * **************************************************************** SPC 1 SET NOP STA TEST SAVE TEST INDICATOR LDA TRAPC RESTORE ERASE INTERRUPT STA SC,I IN TV TRAP CELL CLA ESTABLISH HALT CONDITION STA HALT? FOR AUTO RESTART JMP SET,I SKP **************************************************************** * * * -- POWER FAIL - AUTO RESTART -- * * * **************************************************************** SPC 1 + PFAIL NOP POWER FAIL - AUTO RESTART SFC 4B POWER UP? JMP ASTRT YES CCA SET RUNNING STA HALT? CONDITION LIA 1 SAVE SWITCH STA TEMP REGISTER LDA PFAIL SAVE RESTART STA TEMP1 ADDRESS FOR CNFGR CLC 4B SET RESTART INDICATOR HLT 4B SHUTDOWN SPC 1 ASTRT STC 4B ISSUE POPIO AND CRS JSB DEL SHORT DELAY JSB ERASE BULK ERASE LDB HALT? GET RUN/HALT CONDITION LDA TEMP GET SAVED SWITCH REG SZB HALT? OTA 1 NO - SO RESTORE SWITCH REG LDA TEST GET TEST INDICATOR CPA B1 GO-NOGO? JMP BEGIN YES - DO IT SZB,RSS HALT? JMP STUCK YES - STUCK HALT SSA RAM TEST? JMP RAMS YES - DO IT SZA,RSS "SUPER TEST"? JMP RESTT YES - DO IT CPA B2 PATTERN TEST (GO-NOGO)? JMP PATRN YES - DO IT CPA B3 LOGO FLASHER (GO-NOGO)? JMP FLSH YES - DO IT CPA B7 I/O CHECK (GO-NOGO)? JMP IOCHK YES - DO IT CPA B17 CONFIGURING? JMP TEMP1,I YES - FINISH IT CPA B4 COLOR BARS? JMP BRS YES - DO IT JMP STUCK INVALID TEST INDICATOR SKP **************************************************************** * * * -- COLOR INFORMATION COLLECTOR -- * * * **************************************************************** SPC 1 MAP NOP STB TEMP2 SAVE B REGISTER LIA 1 GET COLOR INFORMATION BITS AND B17 AND ISOLATE THEM STA MD THEN SAVE TEMPORARILY AND B7 ISOLATE COLOR BITS SZA,RSS WHITE? CLBB YES CPA B1 BLACK? LDB B15 YES CPA B2 RED? LDB B14 YES CPA B3 GREEN? LDB B11 YES CPA B4 BLUE? LDB B5 YES CPA B5 YELLOW? LDB B10 YES CPA B6 MAGENTA? LDB B4 YES CPA B7 CYAN? LDB B1 YES LDA MD RECOVER BITS RAR,RAR AND ISOLATE AND AND B2 POSITION POLARITY STA POL SAVE VIDEO POLARITY IOR B CONSTRUCT TOTAL MODE STB MD SAVE COLOR INFORMATION LDB TEMP2 RECOVER B REGISTER JMP MAP,I SKP **************************************************************** * * * -- SET COMP. BKGRND. FOR FLASHING -- * * * **************************************************************** SPC 1 SETUP NOP LDA TEST CPA B3 FLASHING ONLY (103B)? JMP L2 YES CPA B1 PATTERNS ONLY (102B)? JMP L1 YES SZA SUPER TEST? JMP ONN NO LIA 1 YES ALF,RAL SSA FLASHING IN SUPER TEST? JMP L2 YES JMP ONN NO SPC 1 L1 LDA TESTB IN LOGO SZA,RSS PATTERN? JMP ONN NO L2 JSB MAP GET LDA MD COLOR BITS SZA,RSS WHITE? JMP ONN YES - SKIP XOR B15 NO - COMPLEMENT STA MD CLB,INB STB TESTA SET INDICATOR FOR WRITE ONLY JSB QUICK GENERATE BACKGROUND ONN JSB MAP GET REQUESTED COLOR JMP SETUP,I SPC 2 **************************************************************** * qcTRN * * -- INCREMENT COLORS -- * * * **************************************************************** SPC 1 INC NOP LIA 1 GET AND AND MASKB SAVE THE STA B NON COLOR BITS LIA 1 GET THE CURRENT INA COLOR BITS AND INCREMENT AND B7 ISOLATE THE COLOR BITS CPA B1 BLACK? JMP *-3 YES - INCREMENT AGAIN IOR B MERGE WITH NON COLOR BITS OTA 1 SET IN SW REG JMP INC,I SKP 2T**************************************************************** * * * -- LOGO BUFFER -- * * * **************************************************************** SPC 1 BUFLN DEC -2013 BUFFER LENGTH (# OF POINTS) SPC 1 BUFAD DEF *+1 BUFFER STARTING ADDRESS SPC 2 ******** CHARACTERS ******** SPC 1 OCT 107115,107116,107117,107120,107121 OCT 106517,106117,105517,105117,104517 OCT 104117 OCT 107123,106523,106123,105523,105123 OCT 104524,104125,104526,105127,105527 OCT 106127,106527,107127 OCT 104140,104141,104142,104541,105141 OCT 105541,106141,106541,107140,107141 OCT 107142 OCT 104145,104545,105145,105545,106145 OCT 106545,107145,106146,105547,105150 OCT 107151,106551,106151,105551,105151 OCT 104551,104151 OCT 107153,107154,107155,107156,107157 OCT 106555,106155,105555,105155,104555 OCT 104155 OCT 104162,104163,104164,104165,104161 OCT 104561,105161,105561,106161,106561 OCT 107161,105564,105563,105562,105561 OCT 107162,107163,107164,107165 OCT 104167,104567,105167,105567,106167 OCT 106567,107167,107170,107171,107172 OCT 106573,106173,105572,105571,105570 OCT 105171,104572,104173 OCT 104175,104575,105175,105575,106175 OCT 106575,107175,105600,105577,105576 OCT 105575,107176,107177,107200,107201 OCT 104203,104603,105203,105603,106203 OCT 106604,107205,106606,106207,105607 OCT 105207,104607,104207,105204,105205 OCT 105206 OCT 104611,105211,105611,106211,106611 OCT 107212,107213,107214,106615,104615 OCT 104214,104213,104212 OCT 104220,104221,104222,104223,104217 OCT 104617,105217,105617,106217,106617 OCT 107217,105622,105621,105620,105617 A OCT 107220,107221,107222,107223 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 ******** CHARACTERS ******** SPC 1 OCT 104633,105233,105633,106233,106633 OCT 107234,107235,107236,106637,104637 OCT 104236,104235,104234 OCT 104241,104641,105241,105641,106241 OCT 106642,107243,106644,106245,105645 OCT 105245,104645,104245,105242,105243 OCT 105244 OCT 104247,104647,105247,105647,106247 OCT 106647,107247,107250,107251,107252 OCT 106653,106253,105652,105651,105650 OCT 105251,104652,104253 OCT 104255,104655,105255,105655,106255 OCT 106655,107255,107256,107257,107260 OCT 106661,106261,105661,105261,104661 OCT 104260,104257,104256 SPC 2 *********** LOGO *********** SPC 1 OCT 36544,36144,41145,40545,40145 OCT 37545,37145,36545,36145,44146 OCT 43546,43146,42546,42146,41546 OCT 41146,40546,40146,37546,37146 OCT 36546,36146,46147,45547,45147 OCT 44547,44147,43547,43147,42547 OCT 42147,41547,41147,40547,40147 OCT 37547,37147,36547,36147,50550 OCT 50150,47550,47150,46550,46150 OCT 45550,45150,44550,44150,43550 OCT 43150,42550,42150,41550,41150 OCT 40550,40150,37550,37150,36550 OCT 36150,53151,52551,52151,51551 OCT 51151,50551,50151,47551,47151 OCT 46551,46151,45551,45151,44551 OCT 44151,43551,43151,42551,42151 OCT 41551,41151,40551,40151,37551 OCT 37151,36551,36151,55552,55152 OCT 54552,54152,53552,53152,52552 OCT 52152,51552,51152,50552,50152 OCT 47552,47152,46552,46152,45552 OCT 45152,44552,44152,43552,4315)s2 OCT 42552,42152,41552,41152,40552 OCT 40152,37552,37152,36552,36152 OCT 60153,57153,56153,55553,55153 OCT 54553,54153,53553,53153,52553 OCT 52153,51553,51153,50553,50153 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 47553,47153,46553,46153,45553 OCT 45153,44553,44153,43553,43153 OCT 42553,42153,41553,41153,40553 OCT 40153,37553,37153,36553,36153 OCT 63154,62154,61154,60154,57154 OCT 56154,55554,55154,54554,54154 OCT 53554,53154,52554,52154,51554 OCT 51154,50554,50154,47554,47154 OCT 46554,46154,45554,45154,44554 OCT 44154,43554,43154,42554,42154 OCT 41554,41154,40554,40154,37554 OCT 37154,36554,36154,65155,64155 OCT 63155,62155,61155,60155,57155 OCT 56155,55555,55155,54555,54155 OCT 53555,53155,52555,52155,51555 OCT 51155,50555,50155,47555,47155 OCT 46555,46155,45555,45155,44555 OCT 44155,43555,43155,42555,42155 OCT 41555,41155,40555,40155,37555 OCT 37155,36555,36155,67156,66156 OCT 65156,64156,63156,62156,61156 OCT 60156,57156,56156,55556,55156 OCT 54556,54156,53556,53156,52556 OCT 52156,51556,51156,50556,50156 OCT 47556,47156,46556,46156,45556 OCT 45156,44556,44156,43556,43156 OCT 42556,42156,41556,41156,40556 OCT 40156,37556,37156,36556,36156 OCT 72157,71157,70157,67157,66157 OCT 65157,64157,63157,62157,61157 OCT 60157,54557,54157,53557,53157 OCT 52557,52157,51557,51157,50557 OCT 50157,47557,47157,46557,46157 OCT 45557,45157,44557,44157,43557 OCT 43157,42557,42157,41557,41157 OCT 40557,40157,37557,37157,36557 OCT 36157,74160,73160,72160,71160 OCT 70160,67160,66160,65160,64160 OCT 63160,62160,53160,52560,52160 OCT 51560,51160,50560,50160,47560 OCT 47160,46560,46160,45560,45160 OCT 44560,44160,43560,43160,42560 OCT 42160,41560,41160,40560,40160 OCT 37560,37160,36560,36160,76161 OCT 75161,74161,73161,72161,71161 OCT 70161,67161,66161,65161,64161 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 63161,52161,51561,51161,50561 OCT 50161,47561,47161,46561,46161 OCT 45561,45161,44561,44161,43561 OCT 43161,42561,42161,41561,41161 OCT 40561,40161,37561,37161,36561 OCT 36161,76162,75162,74162,73162 OCT 72162,71162,70162,67162,66162 OCT 65162,64162,54162,53562,53162 OCT 52562,51162,50562,50162,47562 OCT 47162,46562,46162,45562,45162 OCT 44562,44162,43562,43162,42562 OCT 42162,41562,41162,40562,40162 OCT 37562,37162,36562,36162,76163 OCT 75163,74163,73163,72163,71163 OCT 70163,67163,66163,65163,64163 OCT 57163,56563,56163,55563,55163 OCT 54563,54163,53563,53163,52563 OCT 50563,50163,47563,47163,46563 OCT 46163,45563,45163,44563,44163 OCT 43563,43163,42563,42163,41563 OCT 41163,40563,40163,37563,37163 OCT 36563,36163,76164,75164,74167 OCT 73164,72164,71164,70164,67164 OCT 66164,65164,61164,60564,60164 OCT 57564,57164,56564,56164,55564 OCT 55164,54564,54164,53564,53164 OCT 52564,50164,47564,47164,4656a4 OCT 46164,45564,45164,44564,44164 OCT 43564,43164,42564,42164,41564 OCT 41164,40564,40164,37564,37164 OCT 36564,36164,76165,75165,74165 OCT 73165,72165,71165,70165,67165 OCT 66165,65165,63565,63165,62565 OCT 62165,61565,61165,60565,60165 OCT 57565,57165,56565,56165,55565 OCT 55165,54565,54165,53565,53165 OCT 52565,50165,47565,47165,46565 OCT 46165,45565,45165,44565,44165 OCT 43565,43165,42565,42165,41565 OCT 41165,40565,40165,37565,37165 OCT 36565,36165,76166,75166,74166 OCT 73166,72166,71166,70166,67166 OCT 66166,65166,64566,64166,63566 OCT 63166,62566,62166,61566,61166 OCT 60566,60166,57566,57166,56566 OCT 56166,55566,55166,54566,54166 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 53566,47566,47166,46566,46166 OCT 45566,45166,44566,44166,43566 OCT 43166,42566,42166,41566,41166 OCT 40566,40166,37566,37166,36566 OCT 36166,76167,75167,74167,73167 OCT 72167,71167,70167,67167,66167 OCT 65567,65167,64567,64167,63567 OCT 63167,62567,62167,61567,61167 OCT 60567,60167,57567,57167,56567 OCT 56167,47167,46567,46167,45567 OCT 45167,44567,44167,43567,43167 OCT 42567,42167,41567,41167,40567 OCT 40167,37567,37167,36567,36167 OCT 76170,75170,74170,73170,72170 OCT 71170,70170,67170,66170,65570 OCT 65170,64570,64170,63570,63170 OCT 62570,62170,61570,61170,60570 OCT 60170,47170,46570,46170,45570 OCT 45170,44570,44170,43570,43170 OCT 42570,42170,41570,41170,4057/0 OCT 40170,37570,37170,36570,36170 OCT 76171,75171,74171,73171,72171 OCT 71171,70171,67171,66171,65571 OCT 65171,64571,64171,63571,63171 OCT 61571,61171,60571,60171,53571 OCT 53171,52571,46571,46171,45571 OCT 45171,44571,44171,43571,43171 OCT 42571,42171,41571,41171,40571 OCT 40171,37571,37171,36571,36171 OCT 76172,75172,74172,73172,72172 OCT 71172,70172,67172,66172,65572 OCT 65172,61572,61172,60572,60172 OCT 56572,56172,55572,55172,54572 OCT 54172,53572,53172,52572,46572 OCT 46172,45572,45172,44572,44172 OCT 43572,43172,42572,42172,41572 OCT 41172,40572,40172,37572,37172 OCT 36572,36172,76173,75173,74173 OCT 73173,72173,71173,70173,67173 OCT 66173,61573,61173,60573,60173 OCT 57573,57173,56573,56173,55573 OCT 55173,54573,54173,53573,53173 OCT 52573,46573,46173,45573,45173 OCT 44573,44173,43573,43173,42573 OCT 42173,41573,41173,40573,40173 OCT 37573,37173,36573,36173,76174 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 75174,74174,73174,72174,71174 OCT 70174,67174,66174,61574,61174 OCT 60574,60174,57574,57174,56574 OCT 56174,55574,55174,54574,54174 OCT 53574,53174,52574,46574,46174 OCT 45574,45174,44574,44174,43574 OCT 43174,42574,42174,41574,41174 OCT 40574,40174,37574,37174,36574 OCT 36174,76175,75175,74175,73175 OCT 72175,71175,70175,67175,66175 OCT 61575,61175,60575,60175,57575 OCT 57175,56575,56175,55575,55175 OCT 54575,54175,53575,46575,461755 OCT 45575,45175,44575,44175,43575 OCT 43175,42575,42175,41575,41175 OCT 40575,40175,37575,37175,36575 OCT 36175,76176,75176,74176,73176 OCT 72176,71176,70176,67176,66176 OCT 61176,60576,60176,57576,57176 OCT 56576,56176,51176,50576,50176 OCT 47576,47176,46576,46176,45576 OCT 45176,44576,44176,43576,43176 OCT 42576,42176,41576,41176,40576 OCT 40176,37576,37176,36576,36176 OCT 76177,75177,74177,73177,72177 OCT 71177,70177,67177,66177,60203 OCT 53577,53177,52577,52177,51577 OCT 51177,50577,50177,47577,47177 OCT 46577,46177,45577,45177,44577 OCT 44177,43577,43177,42577,42177 OCT 41577,41177,40577,40177,37577 OCT 37177,36577,36177,76200,75200 OCT 74200,73200,72200,71200,70200 OCT 67200,66200,56200,55600,55200 OCT 54600,54200,53600,53200,52600 OCT 52200,51600,51200,50600,50200 OCT 47600,47200,46600,46200,45600 OCT 45200,44600,44200,43600,43200 OCT 42600,42200,41600,41200,40600 OCT 40200,37600,37200,36600,36200 OCT 76201,75201,74201,73201,72201 OCT 71201,70201,67201,66201,60601 OCT 60201,57601,57201,56601,56201 OCT 55601,55201,54601,54201,53601 OCT 53201,52601,52201,51601,51201 OCT 50601,50201,47601,47201,46601 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 46201,45601,45201,44601,44201 OCT 43601,43201,42601,42201,41601 OCT 41201,40601,40201,37601,37201 OCT 36601,36201,76202,75202,74202 OCT 73202,72202,71202,70202,67202 OCT 66202,61602,61202,60602,6020TC2 OCT 57602,57202,56602,56202,55602 OCT 55202,54602,54202,53602,53202 OCT 52602,52202,51602,51202,50602 OCT 46602,46202,45602,45202,44602 OCT 44202,43602,43202,42602,42202 OCT 41602,41202,40602,40202,37602 OCT 37202,36602,36202,76203,75203 OCT 74203,73203,72203,71203,70203 OCT 67203,66203,61603,61203,60603 OCT 61203,57603,57203,56603,56203 OCT 55603,55203,54603,54203,53603 OCT 53203,52603,46603,46203,45603 OCT 45203,44603,44203,43603,43203 OCT 42603,42203,41603,41203,40603 OCT 40203,37603,37203,36603,36203 OCT 76204,75204,74204,73204,72204 OCT 71204,70204,67204,66204,61604 OCT 61204,60604,60204,57604,57204 OCT 56604,56204,55604,54204,53604 OCT 53204,52604,47204,46604,46204 OCT 45604,45204,44604,44204,43604 OCT 43204,42604,42204,41604,41204 OCT 40604,40204,37604,37204,36604 OCT 36204,76205,75205,74205,73205 OCT 72205,71205,70205,67205,66205 OCT 61605,61205,60605,60205,54205 OCT 53605,53205,52605,47205,46605 OCT 46205,45605,45205,44605,44205 OCT 43605,43205,42605,42205,41605 OCT 41205,40605,40205,37605,37205 OCT 36605,36205,76206,75206,74206 OCT 73206,72206,71206,70206,67206 OCT 66206,61606,61206,60606,60206 OCT 54606,54206,53606,53206,52606 OCT 47606,47206,46606,46206,45606 OCT 45206,44606,44206,43606,43206 OCT 42606,42206,41606,41206,40606 OCT 40206,37606,37206,36606,36206 OCT 76207,75207,74207,73207,72207 OCT 71207,70207,67207,66207,65207 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 61607,61207,60607,60207,57207 OCT 56607,56207,55607,55207,54607 OCT 54207,53607,53207,52607,47607 OCT 47207,46607,46207,45607,45207 OCT 44607,44207,43607,43207,42607 OCT 42207,41607,41207,40607,40207 OCT 37607,37207,36607,36207,76210 OCT 75210,74210,73210,72210,71210 OCT 70210,67210,66210,65210,61610 OCT 61210,60610,60210,57610,57210 OCT 56610,56210,55610,55210,54610 OCT 54210,53610,53210,50210,47610 OCT 47210,46610,46210,45610,45210 OCT 44610,44210,43610,43210,42610 OCT 42210,41610,41210,40610,40210 OCT 37610,37210,36610,36210,76211 OCT 75211,74211,73211,72211,71211 OCT 70211,67211,66211,65211,64211 OCT 61611,61211,60611,60211,57611 OCT 57211,56611,56211,55611,55211 OCT 54611,54211,53611,53211,50611 OCT 50211,47611,47211,46611,46211 OCT 45611,45211,44611,44211,43611 OCT 43211,42611,42211,41611,41211 OCT 40611,40211,37611,37211,36611 OCT 36211,76212,75212,74212,73212 OCT 72212,71212,70212,67212,66212 OCT 65212,64212,61212,60612,60212 OCT 57612,57212,56612,56212,55612 OCT 55212,54612,54212,51212,50612 OCT 50212,47612,47212,46612,46212 OCT 45612,45212,44612,44212,43612 OCT 43212,42612,42212,41612,41212 OCT 40612,40212,37612,37212,36612 OCT 36212,76213,75213,74213,73213 OCT 72213,71213,70213,67213,66213 OCT 65213,64213,63213,60613,60213 OCT 57613,57213,56613,51613,51213 OCT 50613,50213,47613,47213,46613 OCT 46213,45613,45213,44613,44213 OCT 43613,43213,42613,42213,41613 OCT 41213,40613,40213,37613,37213 OCT 36613,36213,76214,75214,74214 OCT 73214,72214,71214,70214,67214 OCT 66214,65214,64214,63214,62214 OCT 52614,52214,51614,51214,50614 SKP ****************************************************I************ * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 50214,47614,47214,46614,46214 OCT 45614,45214,44614,44214,43614 OCT 43214,42614,42214,41614,41214 OCT 40614,40214,37614,37214,36614 OCT 36214,76215,75215,74215,73215 OCT 72215,71215,70215,67215,66215 OCT 65215,64215,63215,62215,61215 OCT 53615,53215,52615,52215,51615 OCT 51215,50615,50215,47615,47215 OCT 46615,46215,45615,45215,44615 OCT 44215,43615,43215,42615,42215 OCT 41615,41215,40615,40215,76216 OCT 75216,74216,73216,72216,71216 OCT 70216,67216,66216,65216,64216 OCT 63216,62216,61216,60216,57216 OCT 56216,55616,55216,54616,54216 OCT 53616,53216,52616,52216,51616 OCT 51216,50616,50216,47616,47216 OCT 46616,46216,45616,45216,44616 OCT 44216,43616,43216,42616,76217 OCT 75217,74217,73217,72217,71217 OCT 70217,67217,66217,65217,64217 OCT 63217,62217,61217,60217,57217 OCT 56217,55617,55217,54617,54217 OCT 53617,53217,52617,52217,51617 OCT 51217,50617,50217,47617,47217 OCT 46617,46217,45617,45217,76220 OCT 75220,74220,73220,72220,71220 OCT 70220,67220,66220,65220,64220 OCT 63220,62220,61220,60220,57220 OCT 56220,55620,55220,54620,54220 OCT 53620,53220,52620,52220,51620 OCT 51220,50620,50220,47620,76221 OCT 75221,74221,73221,72221,71221 OCT 70221,67221,66221,65221,64221 OCT 63221,62221,61221,60221,57221 OCT 56221,55621,55221,54621,54221 OCT 53621,53221,52621,52221,76222 OCT 75222,74222,73222,72222,71222 OCT 70222,67222,66222,65222,64222 OCT 63222,62222,B B@<61222,60222,57222 OCT 56222,55622,55222,54622,76223 OCT 75223,74223,73223,72223,71223 OCT 70223,67223,66223,65223,64223 OCT 63223,62223,61223,60223,57223 OCT 76224,75224,74224,73224,72224 SKP **************************************************************** * * * -- LOGO BUFFER CONTINUED -- * * * **************************************************************** SPC 1 *********** LOGO *********** SPC 1 OCT 70224,70224,67224,66224,65224 OCT 64224,63224,62224,76225,75225 OCT 74225,73225,72225,71225,70225 OCT 67225,66225,65225,64225,76226 OCT 75226,74226,73226,72226,71226 OCT 70226,67226,66226,76227,75227 OCT 74227,73227,72227,71227,76230 OCT 75230,74230,76231,74164,71224 SPC 5 *************** *************** ** ** ** ** ** THE END ** ** ** ** ** *************** *************** SPC 4 END B 8K 91200-18004 1648 S 0422 TV INTFC VERIF SRC              H0104 ASMB,R,L,C TV INTFC. CARD VERIF. HED TV INTFC CARD VERIF. A-91200-16004-2 12/03/76 REV.C(1648) NAM TVERF,3 91200-16004 REV 1648 -- 761203 ENT TVERF EXT EXEC,VIDLU,ERASE,POINT,VECTR,VAREA,CHAR,VEND SUP A EQU 0 B EQU 1 SPC 2 * LOAD THIS PROGRAM USING THE RTE LOADER. IT MAY BE USED IN * FOREGROUND OR BACKGROUND. IT IS SUGGESTED THAT IT BE TEMPORARILY * LOADED INTO BACKGROUND AND SAVED WITH THE FMGR COMMAND "SP". IT * CAN THEN BE USED WHENEVER NEEDED AND DOES NO WASTE AN ID SEGMENT. * IT WILL NOT SWAP WHILE IN I/O SUSPENSION AS IT DOES NOT * USE COMMON. * * THE PROGRAM IS ACTIVATED BY: * * ON,TVERF[,LU] OR * RU,TVERF[,LU] (RTE II OR RTE III) * * THE LU IS THE LOGICAL UNIT # OF THE TERMINAL THAT IS TO BE USED * FOR CONTROLING THE PROGRAM. IF NO LU IS SPECIFIED IT WILL DEFAULT * TO 1 (THE SYSTEM CONSOLE). IN MULTIPLE TERMINAL OPERATION OF * RTE II OR RTE III THE SYSTEM WILL PASS THE LU OF THE ACTIVATING * TERMINAL IF NONE IS SUPPLIED BY THE OPERATOR. * * THE PROGRAM WILL PRINT: * * TV INTERFACE LU = * * THE USER REPLIES WITH THE APPROPRIATE LU. THEN THE PROGRAM PRINTS: * * IS CARD IN AMERICAN SCAN MODE? * * THE USER ANSWERS YES OR NO. THEN THE PROGRAM PRINTS: * * IS THIS A 1 CARD SYSTEM? * * THE USER ANSWERS YES OR NO. THEN THE PROGRAM PRINTS: * * COMMAND? * * THE USER ANSWERS YES OR NO. IF THE ANSWER IS YES THE * LIST OF COMMANDS SHOWN ON THE FOLLOWING PAGE IS PRINTED: SKP * COMMANDS ARE ENTERED AS FOLLOWS: * GA GAIN PATTERN FOR ADJUSTING MONITOR HEIGHT, WIDTH, * POSITION, AND FOCUS. * CR CROSSHATCH PATTERN FOR ADJUSTING MONITOR * LINEARITY AND PINCUSHION. * SE RECTANGLES IN THE FOUR CORNERS OF THE SCREEN * FOR CHECKING DISPLAY SETTLING TIME EFFECTS. * PO WRITES ALL POINTS ON THE SCREEN TO CHECK * FOR ANY MISSING POINTS. * LO WRITES HP LOGO ON THE SCREEN. * DE DEMONSRATES YMALL FEATURES OF DISPLAY LIBRARY. * ER ERASES THE SCREEN. * IN INVERT THE VIDEO POLARITY ON THE SCREEN. * FL FLASH ANY SPECIFIED PATTERN. * BA COLOR OR GRAY LEVEL BARS. * LU TO ENTER A NEW TV LU. * MO TO ENTER A DIFFERENT SCAN MODE. * EX EXITS THIS PROGRAM. * * * IF IT IS NOT A 1 CARD SYSTEM THE FOLLOWING IS ALSO PRINTED: * * THE COLOR CODES ARE AS FOLLOWS: * * CODE COLOR GRAY LEVEL * ---- ----- ---------- * B BLUE 1/8 * G GREEN 1/4 * C CYAN 3/8 * R RED 1/2 * M MAGENTA 5/8 * Y YELLOW 3/4 * W WHITE 7/8 * * * WHEN FLASHING, A BACKGROUND IS DISPLAYED FIRST AND IS THE * COMPLIMENT OF THE REQUESTED COLOR. * THE COMPLIMENTS ARE AS FOLLOWS: * WHITE - BLACK * RED - CYAN * GREEN - MAGENTA (YOU MAY GET SICK!) * BLUE - YELLOW SKP ***************************************************************** * * * -- START OF MAIN CONTROL -- * * * ***************************************************************** SPC 1 TVERF NOP LDA B,I GET FIRST PARAMETER PASSED SZA,RSS IF PARAM IS 0 INA SET LU TO 1, OTHERWISE STA LU SET FIRST PARAM INTO LU IOR X SET READ WITH STA RCON ECHO BIT CLA SET INDICATOR FOR STA ICOM FIRST TIME THRU STA POL SET NORMAL VIDEO POLARITY SPC 1 L0 JSB EXEC REQUEST DEF L1 TV INTERFACE LU = DEF B2 DEF LU DEF MES1 DEF ML1 SPC 1 L1 JSB EXEC INPUT TV LU DEF L2 DEF B1 DEF RCON DEF BUFF DEF B1 SPC 1 L2 LDA BUFF CHECK LOWER AND MASK4 CHARACTER FOR CPA D48  ASCII RANGE JMP L3 FROM 0 TO 9 CPA D56 INCLUSIVE JMP *+4 LDA BUFF IF NOT, IS IT AND MASK3 A SPACE CPA D32 CHARACTER RSS JMP L0 IF NOT, ASK FOR LU AGAIN LDA BUFF AND MES16 CPA B1 JMP L3 SZA JMP L0 SKP ***************************************************************** * * * -- MAIN CONTROL CONTINUED -- * * * ***************************************************************** SPC 1 L3 LDA BUFF CHECK UPPER ALF,ALF CHARACTER FOR AND MASK4 ASCII RANGE CPA D48 FROM 0 TO 9 JMP L4 INCLUSIVE CPA D56 RSS IF NOT, ASK FOR JMP L0 LU AGAIN LDA BUFF ALF,ALF AND MES16 CPA B1 JMP L4 SZA JMP L0 SPC 1 L4 LDA BUFF CONVERT 2 ASCII AND MASK3 CHARACTERS INTO STA B INTEGER VALUE AND MES17 OF TV LU # STA LUTV AND SAVE LDA BUFF ALF,ALF AND MES17 CPB D32 JMP *+3 MPY D10 ADA LUTV STA LUTV SPC 1 JSB VIDLU ESTABLISH TV LU IN DEF *+3 VIDEO DISPLAY LIBRARY DEF LUTV DEF POL SPC 1 JSB ERASE ERASE SCREEN DEF *+1 SKP ***************************************************************** * * * -- MAIN CONTROL CONTINUED -- * * * ***************************************************************** SPC 1 L5 JSB EXEC ASK IF CARD JIS IN DEF L6 AMERICAN SCAN MODE DEF B2 DEF LU DEF MES2 DEF D16 SPC 1 L6 JSB EXEC INPUT ANSWER DEF L7 DEF B1 DEF RCON DEF BUFF DEF B1 SPC 1 L7 CLB LDA BUFF CPA NO IS ANSWER NO? JMP *+5 IT IS - MTEST = 0 CPA YES IS ANSWER YES? RSS IT IS - MTEST = 1 JMP L5 NEITHER, ASK AGAIN INB STB MTEST SPC 1 L7A JSB EXEC ASK IF 1 CARD DEF L7B SYSTEM DEF B2 DEF LU DEF MES31 DEF D13 SPC 1 L7B JSB EXEC INPUT ANSWER DEF L7C DEF B1 DEF RCON DEF BUFF DEF B1 SPC 1 L7C CLB,INB LDA BUFF CPA NO JMP *+5 CPA YES RSS JMP L7A CLB STB CTEST SKP ***************************************************************** * * * -- MAIN CONTROL CONTINUED -- * * * ***************************************************************** SPC 1 LDA ICOM IS THIS THE SZA FIRST TIME THRU JMP L11 NO - SKIP NEXT QUESTION INA SET INDICATOR FOR STA ICOM NOT 1ST TIME THRU SPC 1 L8 JSB EXEC ASK IF USER KNOWS DEF L9 THE COMMANDS DEF B2 DEF LU DEF MES3 DEF ML3 SPC 1 L9 JSB EXEC INPUT ANSWER DEF L10 DEF B1 DEF RCON DEF BUFF DEF B1 SPC 1 L10 LDA BUFF CPA YES IS ANSWER YES? JMP L11 IT IS - SKIP COMMAND LIST CPA NO IS ANSWER NO? RSS IT IS - LIST COMMANDS JMP L8 NEITHER, ASK AGAIN SPC 1 JSB EXEC PRINT THjDE DEF L10A LIST OF DEF B2 COMMANDS DEF LU DEF MES4 DEF ML4 SPC 1 L10A LDA CTEST SZA,RSS COLOR SYSTEM? JMP L10B NO - GO ON JSB EXEC YES - BA COMMAND LISTED DEF L10B DEF B2 DEF LU DEF MES36 DEF ML36 SKP ***************************************************************** * * * -- MAIN CONTROL CONTINUED -- * * * ***************************************************************** SPC 1 L10B JSB EXEC PRINT THE DEF L10C REST OF THE DEF B2 LIST OF DEF LU COMMANDS DEF MES37 DEF ML37 SPC 1 L10C LDA CTEST SZA,RSS COLOR SYSTEM? JMP L11 NO - GO ON JSB EXEC YES - LIST COLOR CODES DEF L11 DEF B2 DEF LU DEF MES35 DEF ML35 SPC 1 L11 CLA CLEAR FLASH STA FLSH? COMMAND JSB EXEC PRINT: DEF L12 COMMAND? DEF B2 DEF LU DEF MES5 DEF MES13 SPC 1 L12 JSB EXEC INPUT A COMMAND DEF L13 DEF B1 DEF RCON DEF BUFF DEF B1 SPC 1 L13 LDA BUFF CHECK THE COMMAND CPA GA GA? JMP GAIN DO GA PATTERN CPA CR CR? JMP PIN DO CR PATTERN CPA SE SE? JMP SETTM DO SE PATTERN CPA PO PO? JMP BURN WRITE ALL POINTS SKP ***************************************************************** * * * -- MAIN CONTROL CONTINUED -- * * k * ***************************************************************** SPC 1 CPA LO LO? JMP LOGO WRITE LOGO CPA ER ER? JMP ERSE ERASE SCREEN CPA FL FL? JMP FLASH GO FLASH CPA IN IN? JMP INVRT GO INVERT CPA BA BA? JMP BARS COLOR BARS CPA XLU LU? JMP L0 GET NEW TV LU CPA MO MO? JMP L5 GET NEW SCAN MODE CPA TE TE? JMP TERM TERMINATE PROGRAM CPA EX EX? JMP TERM TERMINATE PROGRAM CPA EN EN? JMP TERM TERMINATE PROGRAM SPC 1 CPA DE IS COMMAND DE? RSS WRITE DEMO PATTERN JMP L8 NO VALID COMMAND, ASK AGAIN SPC 1 JSB GET GET COLOR FOR MULTI-CARD SYSTEMS JSB ERASE ERASE SCREEN DEF *+1 JSB VIDLU SET WRITE MODE DEF *+3 DEF LUTV DEF POL SPC 1 LDA MTEST SZA AMERICAN SCAN? JMP L18 YES - DIFFERENT PATTERN SKP ***************************************************************** * * * -- DEMONSTRATE DISPLAY LIBRARY -- * * * ***************************************************************** SPC 1 * WRITE THE FOLLOWING FOUR WAYS (FOR EUROPEAN OR * NON-STANDARD SCAN MODES): * * "HEWLETT-PACKARD 91200 TV INTERFACE CARD" SPC 1 JSB CHAR WRITE MESSAGE ACROSS TOP DEF L14 DEF D12 DEF D248 DEF MES6 DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L14 JSB CHAR WRITE MESSAGE DOWN DEF L15 RIGHT SIDE DEF D248 DEF D244 DEF MES6 DEF B1 DEF B3 DEF ZERO DEF COLOR SPC 1 L15 JSB CHAR WRITE MESSAGE UPSIDE DOWN DEF L16 ACROSS BOTTOM DEF D244 DEF MES16 DEF MES6 DEF B1 DEF B2 DEF ZERO DEF COLOR SPC 1 L16 JSB CHAR WRITE MESSAGE UP DEF L17 LEFT SIDE DEF MES16 DEF D12 DEF MES6 DEF B1 DEF B1 DEF ZERO DEF COLOR SPC 1 L17 JMP L22 SKIP TO MAIN PART OF PATTERN SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 2 * WRITE THE FOLLOWING FOUR WAYS (FOR AMERICAN SCAN MODE): * * "HEWLETT-PACKARD 91200 TV INTRFC CARD" SPC 1 L18 JSB CHAR WRITE MESSAGE ACROSS TOP DEF L19 DEF D21 DEF D232 DEF MES7 DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L19 JSB CHAR WRITE MESSAGE DOWN DEF L20 RIGHT SIDE DEF D248 DEF D226 DEF MES7 DEF B1 DEF B3 DEF ZERO DEF COLOR SPC 1 L20 JSB CHAR WRITE MESSAGE UPSIDE DOWN DEF L21 ACROSS BOTTOM DEF D234 DEF MES16 DEF MES7 DEF B1 DEF B2 DEF ZERO DEF COLOR SPC 1 L21 JSB CHAR WRITE MESSAGE UP DEF L22 LEFT SIDE DEF MES16 DEF D13 DEF MES7 DEF B1 DEF B1 DEF ZERO DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * *  * ***************************************************************** SPC 1 L22 LDA D232 SET STARTING Y VALUE FOR LDB MTEST MESSAGES, Y=232 FOR EUROPEAN SZB AND NON-STANDARD SCAN MODES. LDA D216 Y=216 FOR AMERICAN SCAN MODE. STA VERT1 SPC 1 JSB CHAR WRITE MESSAGE DEF L23 "ALPHANUMERIC CHARACTER DEF D20 GENERATOR" DEF VERT1 DEF MES8 DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L23 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR WRITE MESSAGE DEF L24 "ABCDEFGHIJKLMNOPQR DEF D20 STUVWXYZ1234567890" DEF VERT1 DEF MES9 DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L24 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR WRITE MESSAGE DEF L25 "!#$%&'*+,-./:; DEF D20 <=>?@[\]^" DEF VERT1 DEF MES10 DEF B1 DEF ZERO DEF ZERO DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L25 JSB VEND FIND END DEF L26 OF LAST DEF HORZ2 MESSAGE DEF VERT2 SPC 1 L26 JSB CHAR WRITE FOUR CHARACTERS DEF L27 ON END OF PREVIOUS DEF HORZ2 LINE: DEF VERT2 "()_ DEF JBUFR DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L27 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR WRITE MESSAGE DEF L28 "WRITES IN m DEF D20 FOUR DIRECTIONS" DEF VERT1 DEF MES11 DEF B1 DEF ZERO DEF ZERO DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L28 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR WRITE MESSAGE DEF L29 "MULTIPLE CHARACTER DEF D20 SIZE" DEF VERT1 DEF MES12 DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L29 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR WRITE MESSAGE DEF L30 "SIZE 1" DEF D20 DEF VERT1 DEF MES13 DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L30 LDA VERT1 REDUCE Y POSITION ADA ND16 BY 16 STA VERT1 SPC 1 JSB CHAR WRITE SIZE 2 MESSAGE DEF L31 "SIZE 2" DEF D20 DEF VERT1 DEF MES14 DEF B2 DEF ZERO DEF ZERO DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L31 LDA VERT1 REDUCE Y POSITION ADA ND26 BY 26 STA VERT1 SPC 1 JSB CHAR WRITE SIZE 3 MESSAGE DEF L32 "ETC." DEF D20 DEF VERT1 DEF MES15 DEF B3 DEF ZERO DEF ZERO DEF COLOR SPC 1 L32 LDA D123 SET Y VALUE FOG R VECTORS, LDB MTEST Y=123 FOR EUROPEAN OR SZB NON-STANDARD SCAN MODES. LDA D107 Y=107 FOR AMERICAN STA VERT1 SCAN MODE. SPC 1 JSB VECTR DRAW VERTICAL DEF L33 VECTOR OUTLINE DEF D110 (LEFT OF WORD DEF VERT1 "VECTORS") DEF B2 DEF D60 DEF B2 DEF COLOR SPC 1 L33 LDA VERT1 INCREASE Y POSITION ADA D60 BY 60 STA VERT1 SPC 1 JSB VECTR DRAW HORIZONTAL DEF L34 VECTOR OUTLINE DEF D110 (ABOVE WORDS DEF VERT1 "IN 8 DIRECTIONS") DEF ZERO DEF D132 DEF B2 DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L34 LDA D60 REDUCE Y POSITION CMA,INA BY 60 ADA VERT1 STA VERT1 SPC 1 JSB VECTR DRAW VETICAL DEF L35 VECTOR OUTLINE DEF D130 (RIGHT OF WORD DEF VERT1 "VECTORS") DEF B2 DEF MES23 DEF B2 DEF COLOR SPC 1 L35 LDA VERT1 INCREASE Y POSITION ADA D45 BY 45 STA VERT1 SPC 1 JSB VECTR DRAW HORIZONTAL DEF L36 VECTOR OUTLINE DEF D137 (BELOW WORDS DEF VERT1 "IN 8 DIRECTIONS") DEF ZERO DEF D105 DEF B2 DEF COLOR SPC 1 L36 JSB VECTR DRAW VERTICAL DEF L37 VECTOR OUTLINE DEF D242 (CLOSE AREA RIGHT DEF VERT1 OF WORDS DEF B2 "IN 8 DIRECTIONS") DEF MES17 DEF B2B@< DEF COLOR SKP B***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L37 LDA ND35 REDUCED Y POSITION ADA VERT1 BY 35 STA VERT1 SPC 1 JSB VECTR DRAW VECTOR AT DEF L38 45 DEG. ANGLE DEF D165 FROM LOWER LEFT DEF VERT1 TO UPPER RIGHT DEF B1 DEF MES20 DEF B2 DEF COLOR SPC 1 L38 JSB VECTR DRAW VERTICAL DEF L39 VECTOR DEF D180 DEF VERT1 DEF B2 DEF MES20 DEF B2 DEF COLOR SPC 1 L39 JSB VECTR DRAW VECTOR AT DEF L40 45 DEG. ANGLE DEF D195 FROM LOWER RIGHT DEF VERT1 TO UPPER LEFT DEF B3 DEF MES20 DEF B2 DEF COLOR SPC 1 L40 LDA VERT1 INCREASE Y POSITION ADA MES17 BY 15 STA VERT1 SPC 1 JSB VECTR DRAW HORIZONTAL DEF L41 VECTOR DEF D165 DEF VERT1 DEF ZERO DEF MES20 DEF B2 DEF COLOR SKP **************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * **************************************************************** SPC 1 L41 LDA VERT1 INCREASE Y POSITION ADA MES17 BY 15 STA VERT1 SPC 1 JSB VECTR DRAW VERTICAL PORTION DEF L42 OF ARROWHEAD ON DEF D165 VECTOR POINTING TO DEF VERT1 THE UPPER LEFT DEF MES13 DEF B2 Y DEF B2 DEF COLOR SPC 1 L42 JSB VECTR DRAW HORIZONTAL PORTION DEF L43 OF ARROWHEAD ON DEF D165 VECTOR POINTING TO DEF VERT1 THE UPPER LEFT DEF ZERO DEF B2 DEF B2 DEF COLOR SPC 1 L43 LDA MES17 REDUCE Y POSITION CMA,INA BY 15 ADA VERT1 STA VERT1 SPC 1 JSB VECTR DRAW UPPER PORTION DEF L44 OF ARROWHEAD ON DEF D165 VECTOR POINTING TO DEF VERT1 THE LEFT DEF B1 DEF B2 DEF B2 DEF COLOR SPC 1 L44 JSB VECTR DRAW LOWER PORTION DEF L45 OF ARROWHEAD ON DEF D165 VECTOR POINTING TO DEF VERT1 THE LEFT DEF MES16 DEF B2 DEF B2 DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L45 LDA MES17 REDUCE Y POSITION CMA,INA BY 15 ADA VERT1 STA VERT1 SPC 1 JSB VECTR DRAW VERTICAL PORTION DEF L46 OF ARROWHEAD ON DEF D165 VECTOR POINTING TO DEF VERT1 THE LOWER LEFT DEF B2 DEF B2 DEF B2 DEF COLOR SPC 1 L46 JSB VECTR DRAW HORIZONTAL PORTION DEF L47 OF ARROWHEAD ON DEF D165 VECTOR POINTING TO DEF VERT1 THE LOWER LEFT DEF ZERO DEF B2 DEF B2 DEF COLOR SPC 1 L47 LDA VERT1 INCREASE Y POSITION ADA MES20 BY 30 STA VERT1 SPC 1 JSB VECTR DRAW LEFT PORTION DEF L48 OF ARROWHEAD ON DEF 8D180 VECTOR POINTING UP DEF VERT1 DEF B5 DEF B2 DEF B2 DEF COLOR SPC 1 L48 JSB VECTR DRAW RIGHT PORTION DEF L49 OF ARROWHEAD ON DEF D180 VECTOR POINTING UP DEF VERT1 DEF MES16 DEF B2 DEF B2 DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L49 LDA MES20 REDUCE Y POSITION CMA,INA BY 30 ADA VERT1 STA VERT1 SPC 1 JSB VECTR DRAW LEFT PORTION DEF L50 OF ARROWHEAD ON DEF D180 VECTOR POINTING DOWN DEF VERT1 DEF B3 DEF B2 DEF B2 DEF COLOR SPC 1 L50 JSB VECTR DRAW RIGHT PORTION DEF L51 OF ARROWHEAD ON DEF D180 VECTOR POINTING DOWN DEF VERT1 DEF B1 DEF B2 DEF B2 DEF COLOR SPC 1 L51 LDA VERT1 INCREASE Y POSITION ADA MES20 BY 30 STA VERT1 SPC 1 JSB VECTR DRAW HORIZONTAL PORTION DEF L52 OF ARROWHEAD ON DEF D195 VECTOR POINTING TO DEF VERT1 THE UPPER RIGHT DEF JBUFR DEF B2 DEF B2 DEF COLOR SPC 1 L52 JSB VECTR DRAW VERTICAL PORTION DEF L53 OF ARROWHEAD ON DEF D195 VECTOR POINING TO DEF VERT1 THE UPPER RIGHT DEF MES13 DEF B2 DEF B2 DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- ; * * * ***************************************************************** SPC 1 L53 LDA MES17 REDUCE Y POSITION CMA,INA BY 15 ADA VERT1 STA VERT1 SPC 1 JSB VECTR DRAW UPPER PORTION DEF L54 OF ARROWHEAD ON DEF D195 VECTOR POINTING TO DEF VERT1 THE RIGHT DEF B3 DEF B2 DEF B2 DEF COLOR SPC 1 L54 JSB VECTR DRAW LOWER PORTION DEF L55 OF ARROWHEAD ON DEF D195 VECTOR POINTING TO DEF VERT1 THE RIGHT DEF B5 DEF B2 DEF B2 DEF COLOR SPC 1 L55 LDA MES17 REDUCE Y POSITION CMA,INA BY 15 ADA VERT1 STA VERT1 SPC 1 JSB VECTR DRAW VERTICAL PORTION DEF L56 OF ARROWHEAD ON DEF D195 VECTOR POINTING TO DEF VERT1 THE LOWER RIGHT DEF B2 DEF B2 DEF B2 DEF COLOR SPC 1 L56 JSB VECTR DRAW HORIZONTAL PORTION DEF L57 OF ARROWHEAD ON DEF D195 VECTOR POINTING TO DEF VERT1 THE LOWER RIGHT DEF JBUFR DEF B2 DEF B2 DEF COLOR DEF B1 FORCE DUMP OF VECTORS SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L57 CLA ESTABLISH -4096 AS A LDB MTEST CORRECTION FOR AMERICAN SZB SCAN (0 FOR OTHERS) FOR LDA M4096 POINT BUFFER TO DRAW STA VERT2 CURVED PORTION ON BORDER LDA BPNT1 SET UP BUFFER  STA PNTR POINTERS AND LDA BFAD COUNTERS FOR STA ADDX ADJUSTING POINTS LDB LOOPS ON CURVE SPC 1 L58 LDA PNTR,I ADJUST THE ADA VERT2 POINTS ON STA ADDX,I THE CURVE ISZ PNTR ISZ ADDX INB,SZB JMP L58 SPC 1 JSB POINT OUTPUT THE POINTS DEF L59 FOR CURVED PORTION DEF BUFFR OF BORDER AROUND DEF D8 "VECTORS IN 8 DIRECTIONS" DEF COLOR SPC 1 L59 LDA B3 REDUCE Y POSITION CMA,INA BY 3 ADA VERT1 STA VERT1 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L60 VERTICALLY DEF D126 "VECTORS" DEF VERT1 DEF MES16 DEF B1 DEF B1 DEF ZERO DEF COLOR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L60 LDA VERT1 INCREASE Y POSITION ADA D42 BY 42 STA VERT1 JSB CHAR OUTPUT MESSAGE DEF L61 HORIZONTALLY DEF D135 "IN 8 DIRECTIONS" DEF VERT1 DEF MES17 DEF B1 DEF ZERO DEF ZERO DEF COLOR SPC 1 L61 LDA VERT1 REDUCE Y POSITION ADA ND66 BY 66 AND USE STA VERT1 FOR VERTICAL SIZE JSB VAREA DRAW RECTANGULAR DEF L62 AREA ACROSS LOWER DEF D13 PART OF SCREEN DEF D17 DEF D229 DEF VERT1 DEF ZERO DEF COLOR SPC 1 L62 LDA VERT1 INCREASE Y POSITION ADA MES13 BY 6 TO GET START STA VERT1 OF FIRST MESSAGE IN AREA JSB CHAR  OUTPUT MESSAGE DEF L63 (ERASE FROM AREA) DEF D18 " THE PRESENT SCREEN DEF VERT1 SHOWS SOFTWARE" DEF MES18 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L63 JSB IYM10 REDUCE Y POSITION BY 10 JSB CHAR OUTPUT MESSAGE DEF L64 (ERASE FROM AREA) DEF D18 "CHARACTER AND DEF VERT1 VECTOR CAPABILITY." DEF MES19 DEF B1 DEF ZERO DEF ZERO DEF INCLR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L64 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L65 (ERASE FROM AREA) DEF D18 " ALL OF THE DEF VERT1 CHARACTERS IN THE" DEF MES20 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L65 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L66 (ERASE FROM AREA) DEF D18 "SUPPLIED LIBRARY DEF VERT1 ARE SHOWN" DEF MES21 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L66 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L67 (ERASE FROM AREA) DEF D18 " CALLS ARE, ALSO, MADE DEF VERT1 DIRECTLY TO" DEF MES22 DEF B1 DEF ZERO DEF ZERO DEF INCLR SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUEDP -- * * * ***************************************************************** SPC 1 L67 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L68 (ERASE FROM AREA) DEF D18 "VECTR, VAREA, POINT, DEF VERT1 ERASE, AND VIDLU." DEF MES23 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L68 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L69 (ERASE FROM AREA) DEF D18 " ALL PATTERNS ALLOW DEF VERT1 FOR SCAN MODES." DEF MES24 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L69 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 LDA MTEST AMERICAN SCAN SZA MODE? JMP L73 YES - SKIP TO OTHER MSGS. SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 JSB CHAR OUTPUT MESSAGE DEF L70 (ERASE FROM AREA) DEF D18 " THE SCAN MODE YOU DEF VERT1 ARE NOW USING IS" DEF MES25 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L70 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L71 (ERASE FROM AREA) DEF D18 "EITHER THE EUROPEAN DEF VERT1 STANDARD SCAN OR" DEF MES26 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L71 JSB IYM10 REDUCE Y POSITION BY 10 SPC 1 JSB CHAR OUTPUT MESSAGE DEF L72 (ERASE FROM AREA) DEF D18 "THE NON-STANDARD DEF VERT1 SCAN." DEF MES27 DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L72 JMP L76 DONE! SKP ***************************************************************** * * * -- DEMO PATTERN CONTINUED -- * * * ***************************************************************** SPC 1 L73 JSB CHAR OUTPUT MESSAGE DEF L74 (ERASE FROM AREA) DEF D18 "YOU ARE USING DEF VERT1 AMERICAN DEF MES28 STANDARD SCAN." DEF B1 DEF ZERO DEF ZERO DEF INCLR SPC 1 L74 JSB VAREA DRAW AREA ABOVE DEF L75 AMERICAN SCAN'S DEF ZERO VISIBLE RASTER DEF YAMER (FROM Y=240 TO DEF MASK3 Y=255 AND DEF MES17 X=0 TO X=255) DEF ZERO DEF COLOR SPC 1 L75 JSB CHAR OUTPUT MESSAGE DEF L76 (ERASE FROM THE DEF D9 NEW AREA) DEF D245 "YOU HAVE SELECTED DEF MES29 THE WRONG SCAN DEF B1 MODE!!!" DEF ZERO DEF ZERO DEF INCLR SPC 1 L76 LDA FLSH? SZA,RSS FLASH? JMP L11 NO - NEXT JMP F2 YES SKP ***************************************************************** * * * -- FLASHING ROUTINE -- * * * ***************************************************************** SPC 1 FLASH LDA FLSH? SZA ALREADY IN FLASH? i JMP L8 YES - KNOW COMMANDS? CLA,INA STA FLSH? SET FLASH INDICATOR JSB EXEC ASK FOR PATTERN DEF F1 DEF B2 DEF LU DEF MES34 DEF D10 SPC 1 F1 JMP L12 GET PATTERN SPC 2 F2 LDA ND72 GET # OF FLASHES (B/W) LDB COLOR SZB WHITE? ARS NO - HALF THE FLASHES STA PNTR SPC 1 F3 LDA TCONF GET DELAY FOR B/W LDB COLOR SZB WHITE? LDA TCONS NO - SLOWER FLASHING STA ADDX LDA POL TOGGLE POLARITY XOR B1 INDICATOR STA POL JSB VIDLU SET POLARITY DEF F4 (CHANGE IT) DEF LUTV DEF POL SPC 1 F4 ISZ ADDX DELAY JMP *-1 COUNT ISZ PNTR ALL FLASHES DONE? JMP F3 NO - GO AGAIN JMP L11 DONE, GET NEXT COMMAND SKP ***************************************************************** * * * -- COLOR ROUTINE -- * * * ***************************************************************** SPC 1 GET NOP GET COLOR LDA CTEST SZA JMP LXXX STA COLOR INA STA INCLR JMP GET,I SPC 1 LXXX JSB EXEC ASK FOR COLOR DEF LYYY DEF B2 DEF LU DEF MES32 DEF B7 SPC 1 LYYY JSB EXEC INPUT ANSWER DEF LZZZ DEF B1 DEF RCON DEF BUFF DEF B1 SPC 1 LZZZ LDA BUFF AND MASK9 CLB CPA RED LDB B2 CPA GREEN LDB B3 CPA BLUE LDB B4 CPA YELOW LDB B5 CPA MGNTA LDB B6 CPA CYAN LDB B7 STB COLOR LDA D9 CMB,INB ADA B ӿ STA INCLR CMB,INB INB CPB B1 STB INCLR SKP ***************************************************************** * * * -- COLOR ROUTINE CONTINUED -- * * * ***************************************************************** SPC 1 LDA FLSH? SZA,RSS FLASHING? JMP BK3 NO LDA COLOR YES SZA,RSS WHITE? JMP BK2 YES JSB ERASE NO - ERASE DEF *+1 JSB VAREA WRITE COMPLIMENTARY DEF BK1 BACKGROUND DEF ZERO DEF ZERO DEF MASK3 DEF MASK3 DEF ZERO DEF INCLR BK1 ISZ GET ELIMINATE ERASE ISZ GET ON RETURN BK2 JMP GET,I SPC 1 BK3 CLB,INB SET COMPLIMENTARY COLOR TO STB INCLR BLACK WHEN NOT FLASHING JMP GET,I SKP ***************************************************************** * * * -- MISCELLANEOUS ROUTINES -- * * * ***************************************************************** SPC 1 IYM10 NOP SUBROUTINE TO LDA VERT1 REDUCE Y POSITION ADA ND10 BY 10 STA VERT1 JMP IYM10,I SPC 3 ERSE JSB ERASE PROCESS ER DEF *+1 COMMAND JMP L11 GET NEXT COMMAND SPC 3 INVRT LDA POL CHANGE THE XOR B1 STATE OF THE STA POL VIDEO POLARITY INDICATOR JSB VIDLU REVERSE THE VIDEO DEF *+3 POLARITY DEF LUTV DEF POL JMP L11 GET NEXT COMMAND SPC 3 TERM JSB EXEC PRINT MESSAGE DEF L80 ON TERMINAL 5B@< DEF B2 "TVERF: STOP 0077" DEF LU DEF MES30 DEF D8 SPC 1 L80 JSB EXEC TERMINATION DEF L81 CALL DEF MES13 L81 HLT 77B DUMMY!!! SKP B***************************************************************** * * * -- CONSTANTS AND STORAGE -- * * * ***************************************************************** SPC 1 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 D9 DEC 9 D10 DEC 10 D13 DEC 13 D16 DEC 16 D17 DEC 17 D18 DEC 18 D20 DEC 20 D21 DEC 21 D32 DEC 32 D42 DEC 42 D45 DEC 45 D48 DEC 48 D56 DEC 56 D60 DEC 60 D105 DEC 105 D107 DEC 107 D110 DEC 110 D123 DEC 123 D126 DEC 126 D130 DEC 130 D132 DEC 132 D135 DEC 135 D137 DEC 137 D165 DEC 165 D180 DEC 180 D195 DEC 195 D216 DEC 216 D226 DEC 226 D229 DEC 229 D232 DEC 232 D234 DEC 234 D242 DEC 242 D244 DEC 244 D245 DEC 245 D248 DEC 248 ML4 DEC 307 ND10 DEC -10 ND16 DEC -16 ML1 DEC -19 ND26 DEC -26 ML3 DEC -27 ND35 DEC -35 ND66 DEC -66 ND72 DEC -72 SKP ***************************************************************** * * * -- CONSTANTS AND STORAGE CONTINUED -- * * * ***************************************************************** SPC 1 M4096 DEC -4096 ML35 DEC 131 ML36 DEC -33 ML37 DEC -99 TCONF DEC -10000 TCONS DEC -20000 LU NOP ICOM NOP LUTV NOP CTEST NOP COLOR NOP INCLR NOP MTEST NOP RCON NOP FLSH? NOP POL NOP NO ASC 1,NO YES ASC 1,YE GA ASC 1,GA CR ASC 1,CR SE ASC 1,SE PO ASC 1,PO LO ASC 1,LO ER ASC 1,ER FL ASC 1,FL IN ASC 1,IN BA ASC 1,BA XLU ASC 1,LU MO ASC 1,MO TE ASC 1,TE EX ASC 1,EX EN ASC 1,EN DE ASC 1,DE RED OCT 51000 GREEN OCT 43400 BLUE OCT 41000 YELOW OCT 54400 MGNTA OCT 46400 CYAN OCT 41400 BPNT1 DEF BUF BUF OCT 120603,121203,121603,122204 OCT 122605,123206,123607,123610 SA0 OCT 77575 SA1 OCT 76577 YAMER DEC 240 SKP ***************************************************************** * * * -- TERMINAL MESSAGES -- * * * ***************************************************************** SPC 1 MES1 ASC 10,TV INTERFACE LU = _ MES2 ASC 16,IS CARD IN AMERICAN SCAN MODE? _ MES3 ASC 14,DO YOU KNOW THE COMMANDS? _ MES4 OCT 6412,6412 ASC 16,COMMANDS ARE ENTERED AS FOLLOWS: OCT 6412 ASC 18, GA GAIN PATTERN FOR ADJUSTING M ASC 10,ONITOR HEIGHT, WIDTH OCT 26015,5040 ASC 14, POSITION, AND FOCUS OCT 27015,5040 ASC 18, CR CROSSHATCH PATTERN FOR ADJUST ASC 5,ING MONITO OCT 51015,5040 ASC 17, LINEARITY AND PINCUSHION. OCT 6412 ASC 18, SE RECTANGLES IN THE FOUR CORNE ASC 8,RS OF THE SCREEN OCT 6412 ASC 18, FOR CHECKING DISPLAY SETTL ASC 8,ING TIME EFFECTS OCT 27015,5040 ASC 18, PO WRITES ALL POINTS ON THE SCRE ASC 5,EN TO CHEC OCT 45415,5040 ASC 14, FOR MISSING POINTS. OCT 6412 ASC 18, LO WRITES HP LOGO ON THE SCREEN OCT 27015,5040 ASC 17, DE DEMONSTRATES ALL FEATURES O ASC 9,F DISPLAY LIBRARY. OCT 6412 ASC 13, ER ERASES THE SCREEN. OCT 6412 ASC 18, IN INVERT THE VIDEO POLARITY ON ASC 6, THE SCREEN. OCT 6412 ASC 18, FL FLASH ANY SPECIFIED PATTERN. MES36 ASC 17, BA COLOR OR GRAY SCALE BARS. MES37 ASC 14, LU TO ENTER A NEW TV LU OCT 27015,5040 ASC 19, MO TO ENTER A DIFFERENT SCAN MODE. OCT 6412 ASC 14, EX EXITS THIS PROGRAM. l SKP **************************************************************** * * * -- TERMINAL MESSAGES CONTINUED -- * * * **************************************************************** SPC 1 MES5 OCT 6412 ASC 5,COMMAND? _ MES30 ASC 8,TVERF: STOP 0077 MES31 ASC 13,IS THIS A 1 CARD SYSTEM? _ MES32 ASC 7, WHAT COLOR? _ MES34 ASC 10, PATTERN TO FLASH? _ MES35 OCT 6412,6412 ASC 16, THE COLOR CODES ARE AS FOLLOWS: OCT 6412,6412 ASC 13, CODE COLOR GRAY LEVEL OCT 6412 ASC 13, ---- ----- ---------- OCT 6412 ASC 11, B BLUE 1/8 OCT 6412 ASC 11, G GREEN 1/4 OCT 6412 ASC 11, C CYAN 3/8 OCT 6412 ASC 11, R RED 1/2 OCT 6412 ASC 11, M MAGENTA 5/8 OCT 6412 ASC 11, Y YELLOW 3/4 OCT 6412 ASC 11, W WHITE 7/8 SKP ***************************************************************** * * * -- TV MESSAGE STRINGS -- * * * ***************************************************************** SPC 1 MES6 DEC 39 ASC 20,HEWLETT-PACKARD 91200 TV INTERFACE CARD MES7 DEC 36 ASC 18,HEWLETT-PACKARD 91200 TV INTRFC CARD MES8 DEC 32 ASC 16,ALPHANUMERIC CHARACTER GENERATOR MES9 DEC 36 ASC 18,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 MES10 DEC 23 ASC 12,!#$%&'*+,-./:;<=>?@[\]^ MES11 DEC 25 ASC 13,WRITES IN FOUR DIRECTIONS MES12 DEC 23 ASC 12,MULTIPLE CHARACTER SIZE MES13 DEC 6 ASC 3,SIZE 1 MES14 DEC 6 ASC 3,SIZE 2 MES15 DEC 4 ASC 2,ETC. MES16 DEC 7 ASC 4,VECTORS MES17 DEC 15 ASeC 8,IN 8 DIRECTIONS MES18 DEC 35 ASC 18, THE PRESENT SCREEN SHOWS SOFTWARE MES19 DEC 32 ASC 16,CHARACTER AND VECTOR CAPABILITY. MES20 DEC 30 ASC 15, ALL OF THE CHARACTERS IN THE MES21 DEC 27 ASC 14,SUPPLIED LIBRARY ARE SHOWN. MES22 DEC 35 ASC 18, CALLS ARE, ALSO, MADE DIRECTLY TO MES23 DEC 36 ASC 18,VECTR, VAREA, POINT, ERASE, & VIDLU. MES24 DEC 36 ASC 18, ALL PATTERNS ALLOW FOR SCAN MODES. MES25 DEC 36 ASC 18, THE SCAN MODE YOU ARE NOW USING IS MES26 DEC 36 ASC 18,EITHER THE EUROPEAN STANDARD SCAN OR MES27 DEC 22 ASC 11,THE NON-STANDARD SCAN. MES28 DEC 37 ASC 19,YOU ARE USING AMERICAN STANDARD SCAN. MES29 DEC 40 ASC 20,YOU HAVE SELECTED THE WRONG SCAN MODE!!! SKP **************************************************************** * * * -- CONSTANTS & TABLES FOR ARROW ROUTINE -- * * * **************************************************************** SPC 1 SYM1 OCT 2000,2001,2002,2003,2004,2005,2006,2007 OCT 1005,1406,2406,3005 SYM2 OCT 2000,2001,2002,2003,2004,2005,2006,2007 OCT 1002,1401,2401,3002 SYM3 OCT 0003,0403,1003,1403,2003,2403,3003,3403 OCT 2401,3002,3004,2405 SYM4 OCT 0003,0403,1003,1403,2003,2403,3003,3403 OCT 0402,0404,1001,1005 SYM5 OCT 0000,0401,1002,1403,2004,2405,3006,3407 OCT 3406,3405,3007,2407 SYM6 OCT 0000,0401,1002,1403,2004,2405,3006,3407 OCT 0001,0002,0400,1000 SYM7 OCT 0007,0406,1005,1404,2003,2402,3001,3400 OCT 3401,3402,3000,2400 SYM8 OCT 0007,0406,1005,1404,2003,2402,3001,3400 OCT 0006,0005,0407,1007 SPC 2 * ARROW POSITION TABLE SPC 1 SYM1P OCT 076010,076040,076070,076120,076150 SYM2P OCT 076220,076250,076300,076330,076360 SYM3P OCT 004175,020175,034175,050175,064175 SYM4P OCT 110175,124175,140175,154 175,170175 SYM5P OCT 004010,020040,034070,050120,064150 SYM6P OCT 110220,124250,140300,154330,170360 SYM7P OCT 004360,020330,034300,050250,064220 SYM8P OCT 110150,124120,140070,154040,170010 SPC 1 * DUMMY ADDRESS TO ENABLE PROGRAM TO SEARCH THRU * FOR A PARTICULAR SYMBOL (DOT POINTER) SPC 1 ARW1 DEF SYM1 ARW1S DEF SYM1 SPC 1 * DUMMY ADDRESS TO ENABLE PROGRAM TO SEARCH THRU THE * POSITIONS OCCUPIED BY A PARTICULAR SYMBOL SPC 1 ARW1P DEF SYM1P ARW1T DEF SYM1P SKP **************************************************************** * * * -- GAIN CHECK ROUTINE FOR TV -- * * * **************************************************************** SPC 1 * THE GAIN SUBROUTINE GENERATES A RECTANGLE * AND ARROWS TO TEST THE HEIGHT AND WIDTH ON THE TV SPC 1 GAIN JSB GET GET COLOR FOR MULTI-CARD SYSTEMS JSB ERASE ERASE ENTIRE SCREEN DEF *+1 JSB VIDLU SET WRITE MODE DEF *+3 DEF LUTV DEF POL SPC 1 LDA ADD SAVE POSITION REDUCER INST. STA ADDX LDB MTEST GET AMERICAN SCAN INDICATOR LDA X GET Y = 256 SZB AMERICAN SCAN? LDA YAMER YES - GET Y = 240 STA Y SET VERTICAL DIMENSION LDA SA0 GET RECT 1 Y FOR NON-AMER. SZB AMERICAN SCAN? ADA STADR YES - Y = Y - 8 STA S0 SET VERTICAL POSITION 1 LDA SA1 GET RECT 2 Y FOR NON-AMER SZB AMERICAN SCAN? ADA STADR YES - Y = Y - 8 STA S1 SET VERTICAL POSITION 2 CLA GET NOP FOR ARROW POS. REDUCER SZB AMERICAN SCAN? LDA ADDX YES - GET INST. FOR POS. RED. STA ADD SET ARROW POSITION REDUCER SPC 1 JSB SQUAR GO TO SQUAR SBtUR TO DRAW A RECT. OCT 0 Y DEC 256 VERT. DIM. OF RECT. X DEC 256 HORIZ. DIM. OF RECT. SPC 1 LDA SYMBL GET NUMBER OF DOTS IN SYMBOL STA DOTC PUT IN DOT COUNTER LDA POSIT GET NUMBER OF POSITIONS STA POSC PUT IN POSITION COUNTER LDA LOOPS GET NUMBER OF LOOPS (ARROWS) STA LOOPC PUT IN LOOP COUNTER LDA ARW1S GET START OF SYMBOL STA ARW1 AND SAVE LDA ARW1T GET START OF COMMON POSITION STA ARW1P AND SAVE SKP **************************************************************** * * * -- GAIN ROUTINE CONTINUED -- * * * **************************************************************** SPC 1 HEAD1 LDA BFAD SET BUFFER STA PNTR POINTER STA A1 HEAD0 LDA ARW1,I GET DOT LDB ARW1P,I GET POSITION ADA B ADD DOT TO POSITION ADD ADA STADR REDUCE Y BY 8 FOR AMER SCAN ONLY STA PNTR,I STORE POINT ISZ PNTR IN OUTPUT BUFFER ISZ DOTC INCREMENT DOT COUNTER JMP HEADA SKIP JSB POINT OUTPUT THE DEF *+4 POINT BUFFER A1 NOP DEF D12 DEF COLOR JMP HEAD2 GET NEXT POSITION HEADA ISZ ARW1 INCREMENT DOT POINTER JMP HEAD0 SET UP NEXT DOT SPC 1 HEAD2 LDA SYMBL GET -12 STA DOTC PUT IN DOT COUNTER ISZ POSC INCREMENT POSITION JMP *+2 ALL 5 NOT DRAWN JMP HEAD3 RESTORE POSC AND TEST LOOPC LDA ARW1 ADA ND11 STA ARW1 ISZ ARW1P JMP HEAD1 SKP *************************************************************** * * * -- GAIN ROUTINE CONTINUED -- *  * * *************************************************************** SPC 1 HEAD3 LDA POSIT GET -5 STA POSC PUT IN POSITION COUNTER ISZ LOOPC ARE ALL SYMBOLS DRAWN JMP *+2 ALL SYMBOLS NOT DRAWN JMP HEAD4 ALL SYMBOLS DRAWN ISZ ARW1 5 SYMBOLS OF ONE TYPE DRAWN ISZ ARW1P JMP HEAD1 SPC 1 HEAD4 JSB SQUAR WRITE A S0 OCT 77575 CROSS DEC 2 IN THE DEC 6 MIDDLE JSB SQUAR OF THE S1 OCT 76577 SCREEN DEC 6 BY WRITING DEC 2 TWO RECTANGLES LDA ADDX RESTORE INSTRUCTION STA ADD LDA FLSH? SZA,RSS FLASH? JMP L11 NO - NEXT JMP F2 YES SPC 1 ADDX NOP DOTC NOP BFAD DEF BUFFR PNTR NOP LOOPC NOP BUFFR BSS 256 SYMBL DEC -12 POSC NOP D12 DEC 12 ND11 DEC -11 LOOPS DEC -8 SKP **************************************************************** * * * -- PIN CUSHION TEST, CROSS HATCH PATTERN -- * * * **************************************************************** SPC 1 PIN JSB GET GET COLOR FOR MULTI-CARD SYSTEMS JSB ERASE ERASE ENTIRE SCREEN DEF *+1 JSB VIDLU SET WRITE MODE DEF *+3 DEF LUTV DEF POL SPC 1 LDB MTEST GET AMERICAN SCAN INDICATOR LDA MASK0 GET VERT MIDDLE DONE, NON-AMER SZB AMERICAN SCAN? LDA MASK6 YES - GET VERT MID DONE FOR AMER STA MSK0 SET VERTICLE MIDDLE DONE TESTER LDA MASK6 GET VERT MIDDLE, NON-AMER SZB AMERICAN SCAN? LDA MASK1 YES - GET VERT MID FOR AMER STA MSK6p SET VERTICLE MIDDLE TESTER LDA MASK9 GET VERT NXT TO MID, NON-AMER SZB AMERICAN SCAN? LDA MASK5 YES - GET NXT TO MID FOR AMER STA MSK9 SET VERT NEXT TO MIDDLE TESTER SPC 1 CLB CLEAR X COUNTER PIN1 LDA BFAD SET UP BUFFER STA PNTR POINTER STA A2 CLA CLEAR Y COUNTER FAX1 IOR B MERGE X INTO Y STA PNTR,I PUT POINT INTO ISZ PNTR OUTPUT BUFFER AND MASK2 MASK OUT X PORTION CPA MASK2 TEST FOR Y LINE FINSIHED JMP FAX2 Y LINE FINISHED ADA X ADD 1 TO Y JMP FAX1 SKP *************************************************************** * * * -- PIN CUSHION TEST CONTINUED -- * * * *************************************************************** SPC 1 FAX2 STB POSC SAVE X COUNTER JSB POINT OUTPUT COMPLETE DEF *+4 LINE FROM BUFFER A2 NOP DEF X DEF COLOR LDB POSC RESTORE X COUNTER CPB MASK3 IS LAST LINE FINISHED? JMP FAX4 LAST FINISHED CPB MASK4 IS NEXT TO MIDDLE FINISHED? JMP FAX3 YES CPB MASK7 IS THIS THE MIDDLE? JMP FAX3A YES CPB MASK8 IS MIDDLE FINISHED? JMP FAX3 YES ADB D8 ADD 10B TO X JMP PIN1 DRAW NEXT VERTICLE SPC 1 FAX3 ADB MES16 ADD 7B TO X JMP PIN1 SPC 1 FAX3A ADB B1 ADD 1 TO X JMP PIN1 SPC 1 B1 OCT 1 MASK0 OCT 100000 MASK1 OCT 70000 MASK4 OCT 170 MASK5 OCT 73400 MASK6 OCT 74000 MASK7 OCT 177 MASK8 OCT 200 MASK9 OCT 77400 SPC 2 FAX4 CLB CLEAR Y COUNTER FAX5 LDA BFAD SET BUFFER STA PNTR POINTER STA A3 CLA  CLEAR X COUNTER FAX6 IOR B MERGE Y INTO X STA PNTR,I PUT POINT INTO ISZ PNTR OUTPUT BUFFER AND MASK3 MASK OUT Y PORTION CPA MASK3 TEST FOR HORIZONTAL FINISHED JMP FAX7 FINISHED INA ADD 1 TO X JMP FAX6 SKP **************************************************************** * * * -- PIN CUSHION TEST CONTINUED -- * * * **************************************************************** SPC 1 FAX7 STB POSC SAVE Y COUNTER JSB POINT OUTPUT A COMPLETE DEF *+4 LINE FROM BUFFER A3 NOP DEF X DEF COLOR LDB POSC RESTORE Y COUNTER CPB MASK2 IS LAST LINE FINISHED? JMP RESP LAST FINISHED RETURN TO MAIN CPB MSK6 IS NEXT TO MIDDLE FINISHED? JMP FAX8 YES CPB MSK9 IS THIS THE MIDDLE? JMP FAX8A YES CPB MSK0 IS MIDDLE FINISHED? JMP FAX8 YES ADB B4000 ADD 10B TO Y JMP FAX5 DRAW NEXT HORIZONTAL SPC 1 FAX8 ADB CON2 ADD 7B TO Y JMP FAX5 SPC 1 FAX8A ADB X ADD 1 TO Y JMP FAX5 SPC 1 RESP LDA FLSH? SZA,RSS FLASH? JMP L11 NO - NEXT JMP F2 YES SPC 1 MSK0 NOP MSK6 NOP MSK9 NOP B4000 OCT 4000 CON2 OCT 3400 STADR OCT 174000 SKP **************************************************************** * * * -- WRITE ALL POINTS -- * * * **************************************************************** SPC 1 BURN JSB GET GET COLOR FOR MULTI-CARD SYSTEMS JSB ERASE ERASE ENTIRE SCREEN DEF *+1 JSB VIDLU SET WRITE MODE DEF *+3 DEF LUTV DEF POL SPC 1 JSB VAREA WRITE AREA DEF OUT 256 POINTS BY DEF ZERO 256 POINTS DEF ZERO DEF MASK3 DEF MASK3 DEF ZERO DEF COLOR SPC 1 OUT LDA FLSH? SZA,RSS FLASH? JMP L11 NO - NEXT JMP F2 YES SPC 2 MASK2 OCT 177400 MASK3 DEC 255 POSIT OCT -5 SA2 OCT 174370 SXA2 OCT 164370 SXA3 OCT 164000 SKP **************************************************************** * * * -- SETTLING TIME, SQUARES IN 4 CORNERS -- * * * **************************************************************** SPC 1 SETTM JSB GET GET COLOR FOR MULTI-CARD SYSTEMS JSB ERASE ERASE ENTIRE SCREEN DEF *+1 JSB VIDLU SET WRITE MODE DEF *+3 DEF LUTV DEF POL SPC 1 LDB MTEST GET AMERICAN SCAN INDICATOR LDA SA2 GET RIGHT SQUARE POS, NON-AMER SZB AMERICAN SCAN? LDA SXA2 YES - GET RT SQR FOR AMER STA S2 SET RIGHT SQUARE STARTING POINT LDA STADR GET LEFT SQUARE POS, NON-AMER SZB AMERICAN SCAN? LDA SXA3 YES - GET LEFT SQR FOR AMER STA S3 SET LEFT SQUARE STARTING POINT SPC 1 JSB SQUAR PUTS 8X8 SQUARE ZERO OCT 0 IN THE D8 DEC 8 LOWER LEFT DEC 8 CORNER JSB SQUAR PUTS 8X8 SQUARE S2 OCT 174370 IN THE DEC 8 UPPER RIGHT DEC 8 CORNER JSB SQUAR PUTS 8X8 SQUARE S3 OCT 174000 IN THE DEC 8 UPPER LEFT DEC 8 CORNER JSB SQUAR PUTS 8X8 SQUARE OCT 370 B@ VIDEO GENERATOR * * NAME: BCS DRIVER FOR 91200 VIDEO GENERATORTOR * SOURCE: 91200-18005 * BINARY: 91200-16005 * PGMR: JOHN FLORES * * NAM D.13 91200-16005 REV 1645 SPC 1 ENT D.13,I.13 EXT DMAC1,DMAC2,IOERR SUP PRESS EXTRANEOUS LISTING SPC 1 * THIS DRIVER IS RESPONSIBLE FOR PROCESSING EXEC I/O CALLS FOR * THE <91200> VIDEO DISPLAY GENERATOR. IT RECOGNIZES WRITE AND * CONTROL REQUESTS. SPC 1 * WRITE REQUESTS WILL INITIATE A DMA TRANSFER OF YX * COORDINATES OF POINTS TO BE WRITTEN ON OR ERASED FROM * THE VIDEO MONITOR SCREEN BY THE <91200>. * Y=BITS 15-8, X=BITS 7-0. SPC 1 * CONTROL REQUESTS ARE USED TO:- * SET COLOR (BLACK FOR SELECTIVE ERASE) * SET SENSE (VIDEO POLARITY) * PERFORM A BULK ERASE. SPC 1 * THE FUNCTION BITS FOR CONTROL REQUESTS ARE DEFINED AS FOLLOWS:- SPC 1 * BITS 10, 9, & 6 SELECT COLOR AS FOLLOWS: SPC 1 * 00 XX0 WHITE * 00 XX1 BLACK (SELECTIVE ERASE) * 01 XX0 RED -----\ * 01 XX1 GREEN \ * 10 XX0 BLUE \ NOT FOR 1 CARD * 10 XX1 YELLOW (RED & GREEN / SYSTEMS * 11 XX0 MAGENTA (RED & BLUE) / * 11 XX1 CYAN (BLUE & GREEN) -----/ SPC 1 * BIT 7 IS THE SENSE BIT, IF SET TO 1 IT CAUSES THE VIDEO * OUTPUT OF THE CARD TO INVERT. SPC 1 * BIT 8 SET TO 1 CAUSES BULK ERASE (TO SENSE PREVIOUSLY SET). SPC 1 * WHEN BIT 8 OF THE CONTROL WORD IS SET (TO ERASE), BITS * 6, 7, 9, & 10 OF THE CONTROL WORD ARE IGNORED. SPC 1 SKP * INITIATION SECTION SPC 1 D.13 NOP STA SAVA SAVE EQT ENTRY ADDRESS STB SAVB SAVE REQUEST (WORD 2) ADDRESS. LDA SAVB,I GET WORD 2 OF USER REQUEST. ALF ROTATE REQUEST CODE TO LOW A. AND M17 AND ISOLATE CODE. SZA,RSS IS IT A CLEAR REQUEST? JMP CLREQ YES JMP TO CLEAR REQ ROUTINE. LDB A NO, PUT REQUEST CODE IN B-REG. * * DRIVER BUSY TEST * LDA DFLG IF DRIVER BUSY, SZA (DFLG NOT=0, THEN JMP REJB REJECT REQUEST. LDA SAVA,I GET FIRST WORD OF EQT. AND M77 ISOLATE DEVICE SELECT CODE. STA TVSC SAVE IT IN TVSC. * * CHECK PHYSICAL DEVICE BUSY * IOR SFS1 COMBINE TV S.C. WITH SFS INST. STA I.2 CONFIGURE SFS INST FOR FLG CK. I.2 SFS TVGEN IS TV FLAG SET? JMP REJB NO, REJECT REQ. * * CHECK FOR CONTROL REQUEST * CPB B3 CONTROL REQUEST ??? JMP CNTRL YES, PROCESS CONTROL REQUEST. * * ILLEGAL REQUEST CODE CHECK * CPB B2 WRITE REQUEST ?? RSS YES, PROCESS WRITE. JMP RCER NO, ILLEGAL REQ CODE. SPC 1 * * CHECK FOR AVAILABLE DMA CHANNEL * LDB DMAC1 GET DMA INDICATOR WORD. CCE,SZB,RSS IS DMA DEFINED ? JMP NODMA NO SET ERROR EXIT. SSB YES,IS DMAC1 BUSY ? JMP CH2 YES, TRY DMAC2. STB A SAVE DMA CH NO. RBL,ERB SET THIS DMA CH. STB DMAC1 BUSY. JMP SDMA CH2 LDB DMAC2 GET DMA INDICATOR WORD. SZB,RSS IS DMAC2 DEFINED ? JMP *+3 NO,REJECT SSB,RSS IS DMAC2 BUSY ? JMP *+7 NO. CLB,INB YES,SET DMA BUSY INDICATOR. JMP REJB+1 AND REJECT. NODMA CCB SET B TO FWA ADB SAVB OF USER CALL. LDB B3 SET A=3 TO SAY NO DMA JMP IOERR AND HALT. STB A SAVE DMA CH NO. RBL,ERB SET THIS DMA CH. STB DMAC2 BUSY. SKP * * SET DMA COMPLETION INTERRUPT LINK * SDMA LDB TVSC,I GET THE CONTENTS OF THE DEVICE INTERRUPT STB A,I LOCATION AND PLUG INTO DMA INTERRUPT LOC. STA CHAN SAVE DMA NO. * * CONFIGURE DMA INSTRUCTIONS. * * IOR OTA0 102606/7 STA DMAO XOR B4 102602/3 STA DMAO1 STA DMAO2 IOR B300 102702/3 STA DMAS IOR B1200 103702/3 ADA B4 103706/7 STA DMASC XOR B5000 106706/7 STA DMACX XOR B4 106702/3 STA DMAC END DMA CONFIGURATION * * SET THE DEVICE BUSY FLAG * LDA SAVA GET ADDRESS OF FIRST EQT WORD. STA EQT1 AND SAVE IT. ISZ SAVA SET ADDRESS TO WORD 2 OF EQT. LDB M15 ENTRY, SET BIT 15 ON ( A FIELD = 2) LDA SAVA,I TO SAY BUSY IOR B AND STA SAVA,I RESTORE. * * INITIALIZE TRANSMSSION LOG. * LDA SAVA SET ADDRESS OF INA EQT WORD 3 STA EQTA IN EQTA STB EQTA,I INITIALIZE XMISSION LOG. SPC 1 * * OUTPUT DMA CONTROL WORD. * LDA TVSC ASSIGN TV CARD TO DMA AND IOR BIT15 ASK STC AFTER EACH TRANSFER, DMAO OTA DMA BUT NO FINAL CLC. IOR STF0 CONFGR STF FOR TV STA STF1 SKP * * OUTPUT USER BUFFER ADDRESS * ISZ SAVB INDEX ADDRESS TO WORD 4. ISZ SAVB OF USER REQUEST. LDA SAVB GET WORD 4 OF LDA A,I REQUEST. RAL,CLE,SLA,ERA (IF INDIRECT, JMP *-2 GET EFFECTIVE ADDRESS DMAC CLC DMA-4 SEND BUFFER ADDRESS DIRECTLY. DMAO1 OTA DMA-4 TO ADDRESS REGISTER. * * OUTPUT USER WORD COUNT * ISZ SAVB INDEX TO WORD 5 OF REQUEST LDA SAVB,I GET WORD 5-BUFFER LENGTH STA CHC SAVE WORD COUNT CMA,INA SET WORD COUNT TO NEG. DMAS STC DMA-4 SEND TWO'S COMPLEMENT OF DMAO2 OTA DMA-4 BUFFER LENGTH TO WORD COUNT REG. * * FOLLOWING INSTRUCTIONS STRART DATA TRANSMISSION. * STA DFLG SET DFLG BUSY (NOT=0) CLA A=0, INDICATES OPERATION INITIATE. STF1 STF TVGEN READY TV CARD DMASC STC DMA,C TURN ON DMA, BUT DMACX CLC DMA PREVENT INTERRUPT FROM IT. CLA JMP D.13,I EXIT TO IOC. * * CONFIGURE I-0 INSTRUCTIONS FOR TV CARD CONTROL WORD. * CNTRL LDA TVSC CONFIGURE I/O INSTRUCTIONS IOR MIA0 1024 STA ERASE IOR B1200 1036 STA OTATV IOR B100 1037 STA STCTV XOR B5000 1067 STA CLCTV END I/O CONFIGURATION * * SET EQT BUSY FLAG * LDA SAVA GET ADDRESS OF EQT1 STA EQT1 AND SAVE. ISZ SAVA SET ADDRESS LDA SAVA,I WORD 2 OF EQT ENTRY. IOR M15 SET BIT 15 STA SAVA,I OF WORD 2 = 1 LDA SAVA (A-FIELD=2) TO DAY BUSY AND RESTORE. SKP * * STORE ADDRESS OF EQT 3 IN DRIVER * INA SET ADDRESS OF EQT WORD 3 STA EQTA IN EQTA * * CHECK THE USER CONTROL WORD AND RE-CONFIGURE * IT FOR THE TV CARD. * SPC 1 LDA SAVB,I GET CONTROL WORD (ICNWD). AND =B3700 ISOLATE CONTROL BITS. STA B SAVE IT IN B REG. BLF,BLF CHECK BIT 8 SLB JMP ERASE DO BULK 'ERASE' SPC 1 LDA EQT1,I AND MASK CHECK FOR SZA,RSS NON-ZERO SUB-CHANNEL JMP GO.ON IS ZERO - SO COLOR LDA B NOT ZERO - KILL COLOR RAR,ERA IS COLOR NOT SEZ,SLA,RSS WHITE OR BLACK? JMP GO.ON YES - SO OK! LDA B NO - SO KILL COLOR TO AND MASK2 WHITE ONLY STA B SPC 1 GO.ON CLE,ELB CALL IS TO SET OR CHANGE BRS,BRS COLOR AND/OR SENSE. CLA POSITION ELA,RAL CONTROL BITS RBR,ERB 6, 9, & 10 RBL,RBL FOR TESTING SSB,SLB,RSS CYAN OR GREEN? { JMP *+3 NEITHER IOR B1 IT IS CYAN OR GREEN JMP *+4 WHICH? SLB,RSS MAGENTA OR RED? JMP *+5 NEITHER IOR B4 IT IS CYAN/MAGENTA OR GREEN/RED SEZ,RSS CYAN/MAGENTA OR GREEN/RED? IOR B10 IT IS GREEN OR RED JMP CLCTV DONE SSB,RSS YELLOW OR BLACK? JMP *+5 NEITHER (IT IS BLUE OR WHITE) IOR B10 IT IS YELLOW OR BLACK SKP SEZ,RSS YELLOW OR BLACK? IOR B5 IT IS BLACK JMP CLCTV DONE SEZ BLUE OR WHITE? IOR B5 IT IS BLUE CLCTV CLC TVGEN SWITCH MODE FF OTATV OTA TVGEN,C TO STEER OUTPUT TO MODE REG. LDB EQT1 GET ADDRESS OF FIRST EQT WORD. INB SET TO ADDRESS OF SECOND WORD. LDA B,I GET SECOND WORD. AND =B77777 CLEAR DEVICE BUSY FLAG AND STA B,I RESTORE IT. LDA M15 DO IMMEDIATE JMP D.13,I COMPLETION * * REJECT SECTION * RCER CLB,RSS REQUEST CODE ERROR (B)=0. REJB LDB M15 DRIVER-DEVICE BUSY,(B) SIGN=1, CLA,INA SET(A) NON-ZERO. JMP D.13,I EXIT TO IOC AND REJECT. * * CLEAR REQUEST ROUTINE * CLREQ LDA SAVA,I GET FIRST WORD OF EQT. AND M77 ISOLATE DEVICE SELECT CODE. IOR CLC0 NO,CONFIGURE CLC ON TV CARD. STA CLCSC CLCSC CLC TVGEN,C TURN OF TV CARD. ISZ SAVA SET ADDRESS TO WORD 2 OF EQT. LDA SAVA,I GET CONTENTS OF WORD 2. ELA,CLE,ERA CLEAR DEVICE BUSY FLAG. STA SAVA,I AND RESTORE. ISZ SAVA SET ADDRESS TO WORD 3 OF EQT. LDA SAVA,I GET CONTENTS OF WORD 3. CLA CLEAR XMISSION LOG STA SAVA,I AND RESTORE. JMP D.13,I EXIT TO IOC. * * ERASE SECTION * ERASE MIA TVGEN ANY INPUT WILL BULK ERASE STCTV STC TVGEN,C INTERRUPT NEEDED TO COMPLETE. CLA STB ERFLG 0 SET ERASE FLAG SO THAT I.13 KNOWS STB DFLG INTERRUPT WAS CAUSED BY ERASE. JMP D.13,I ALSO SET DRIVER BUSY FLAG (DFLG) SKP * * CONSTANTS AND STORAGE SECTION * TVSC NOP STORE CURRENT IO SELECT CODE. BIT15 OCT 100000 OTA0 OTA 0 STF0 STF 0 SFS1 SFS 0 CLC0 CLC 0,C MIA0 MIA 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B10 OCT 10 B100 OCT 100 B300 OCT 300 B1200 OCT 1200 B5000 OCT 5000 MASK OCT 700 MASK2 OCT 137771 SAVA OCT 0 SAVB OCT 0 M15 OCT 100000 M17 OCT 17 M77 OCT 77 CHAN OCT 0 USED TO SAVE DMA CHANNEL. DFLG OCT 0 SET CONDITION INDICATES DRIVER BUSY. EQTA OCT 0 EQT1 OCT 0 ERFLG OCT 0 SET CONDITION INDICATES BULK ERASE. SKP * CONTINUATOR SECTION. SPC 1 * * ENTERED BY THE TV CARD INTERRUPT AFTER * COMPLETION OF DMA OR A BULK ERASE. * I.13 NOP STA SAVAX SAVE A-REG STB SAVBX SAVE B-REG ERA,ALS SAVE E, SOC AND STA SAVEX OVERFLOW LDA TVSC CONFIGURE CLC ON TV CARD IOR CLC0 BEFORE STA TVCLC EXIT. * * CHECK FOR COMPLETION OF A BULK ERASE OPERATION * LDA ERFLG DOES ERASE FLAG INDICATE BULK ERASE? SZA JMP RSTOR YES, SO RESTORE REGS,CLEAR FLAGS & RETURN. * * DISMANTLE DMA-DRIVER INTERRUPT LINKAGE * LDA DMACX NO,STORE A CLC INST. IN STA CHAN,I THE DMA INTERRUPT LOCATION. * * CLEAR DMA CHANNEL BUSY FLAG. * LDA CHAN GET DMA CHANNEL NO. CPA B6 WAS CH NO.1 USED ? STA DMAC1 YES,CLEAR CH NO.1 BUSY FLAG. CPA B7 WAS CH NO. 2 USED.? STA DMAC2 YES,CLEAR CH NO.2 BUSY FLAG. * * RESTORE WORD 3 OF EQT ENTRY AND CLEAR DRIVER BUSY FLAG. * RSTOR LDA EQTA,I SET A=WORD 3 OF EQT ENTRY LDB CHC SET B=WORD COUNT ADA B PUT WORD COUNT IN A AND STA EQTAWz*($,I RESTORE WORD 3 IN EQT. CLA CLEAR THE DRIVER STA DFLG BUSY FLAG STA ERFLG AND THE ERASE FLAG. * * CLEAR DEVICE BUSY FLAG * LDB EQT1 GET ADDRESS OF FIRST EQT WORD. INB SET TO ADDRESS OF WORD 2. LDA B,I GET SECOND EQT WORD. AND =B77777 CLEAR DEVICE BUSY BIT. STA B,I AND RESTORE WORD. SKP * * RESTORE REGISTER SECTION * LDA SAVEX RESTORE CLO E SLA,ELA OVERFLOW, STF 1 A, LDA SAVAX AND B AT TIME OF LDB SAVBX INTERRUPT. TVCLC CLC TVGEN,C CLEAR CONROL & CLEAR FLAG ON TY CARD JMP I.13,I RETURN TO IOC. SPC 3 * * CONSTANTS AND STORAGE SECTION * A EQU 0 A-REG. B EQU 1 B-REG. TVGEN EQU 0 DUMMY SELECT CODE. DMA EQU 6 NOMINAL DMA CHANNEL SAVAX OCT 0 SAVEX OCT 0 SAVBX OCT 0 CHC OCT 0 SPC 2 END _{*  # 91200-18006 1634 S 0122 HP91200 EXEC CALL ADAPTER ROUTINE             H0101 TASMB,R,B,L,T,C HED BCS DRIVER FOR <91200> VIDEO GENERATOR * * NAME: BCS DRIVER FOR 91200 VIDEO GENERATORTOR * SOURCE: 91200-18005 * BINARY: 91200-16005 * PGMR: JOHN FLORES * * NAM D.13 91200-16005 REV 1633 SPC 1 ENT D.13,I.13 EXT DMAC1,DMAC2,IOERR SUP PRESS EXTRANEOUS LISTING SPC 1 * THIS DRIVER IS RESPONSIBLE FOR PROCESSING EXEC I/O CALLS FOR * THE <91200> VIDEO DISPLAY GENERATOR. IT RECOGNIZES WRITE AND * CONTROL REQUESTS. SPC 1 * WRITE REQUESTS WILL INITIATE A DMA TRANSFER OF YX * COORDINATES OF POINTS TO BE WRITTEN ON OR ERASED FROM * THE VIDEO MONITOR SCREEN BY THE <91200>. * Y=BITS 15-8, X=BITS 7-0. SPC 1 * CONTROL REQUESTS ARE USED TO:- * SET COLOR (BLACK FOR SELECTIVE ERASE) * SET SENSE (VIDEO POLARITY) * PERFORM A BULK ERASE. SPC 1 * THE FUNCTION BITS FOR CONTROL REQUESTS ARE DEFINED AS FOLLOWS:- SPC 1 * BITS 10, 9, & 6 SELECT COLOR AS FOLLOWS: SPC 1 * 00 XX0 WHITE * 00 XX1 BLACK (SELECTIVE ERASE) * 01 XX0 RED -----\ * 01 XX1 GREEN \ * 10 XX0 BLUE \ NOT FOR 1 CARD * 10 XX1 YELLOW (RED & GREEN / SYSTEMS * 11 XX0 MAGENTA (RED & BLUE) / * 11 XX1 CYAN (BLUE & GREEN) -----/ SPC 1 * BIT 7 IS THE SENSE BIT, IF SET TO 1 IT CAUSES THE VIDEO * OUTPUT OF THE CARD TO INVERT. SPC 1 * BIT 8 SET TO 1 CAUSES BULK ERASE (TO SENSE PREVIOUSLY SET). SPC 1 * WHEN BIT 8 OF THE CONTROL WORD IS SET (TO ERASE), BITS * 6, 7, 9, & 10 OF THE CONTROL WORD ARE IGNORED. SPC 1 SKP * INITIATION SECTION SPC 1 D.13 NOP STA SAVA SAVE EQT ENTRY ADDRESS STB SAVB SAVE REQUEST (WORD 2) ADDRESS. LDA SAVA,I GET FIRST WORD OF EQT. AND M77 ISOLATE DEVICE SELECT CODE. STA TVSC SAVE IT IN TVSC. * * DRIVER BUSY TEST * DXX.1 LDB DFLG IF DRIVER BUSY, SZB (DFLG NOT=0, THEN JMP REJB REJECT REQUEST. * * CHECK FOR CONTROL REQUEST * LDA SAVB,I GET WORD 2 OF USER REQUEST. ALF ROTATE REQUEST CODE TO LOW A REG. AND M17 AND ISOLATE CODE. CPA B3 CONTROL REQUEST ??? JMP CNTRL YES, PROCESS CONTROL REQUEST. * * ILLEGAL READ CHECK * B10 SLA IF A=1 ,RETURN CODE IS RIGHT JMP D.13,I TO SHOW ILLEGAL READ. SPC 1 * * CHECK FOR AVAILABLE DMA CHANNEL * LDB DMAC1 GET DMA INDICATOR WORD. CCE,SZB,RSS IS DMA DEFINED ? JMP NODMA NO SET ERROR EXIT. SSB YES,IS DMAC1 BUSY ? JMP CH2 YES, TRY DMAC2. STB A SAVE DMA CH NO. RBL,ERB SET THIS DMA CH. STB DMAC1 BUSY. JMP SDMA CH2 LDB DMAC2 GET DMA INDICATOR WORD. SZB,RSS IS DMAC2 DEFINED ? JMP *+3 NO,REJECT SSB,RSS IS DMAC2 BUSY ? JMP *+7 NO. CLB,INB YES,SET DMA BUSY INDICATOR. JMP REJB+1 AND REJECT. NODMA CCB SET B TO FWA ADB SAVB OF USER CALL. LDB B3 SET A=3 TO SAY NO DMA JMP IOERR AND HALT. STB A SAVE DMA CH NO. RBL,ERB SET THIS DMA CH. STB DMAC2 BUSY. SKP * * SET DMA COMPLETION INTERRUPT LINK * SDMA LDB TVSC,I GET THE CONTENTS OF THE DEVICE INTERRUPT STB A,I LOCATION AND PLUG INTO DMA INTERRUPT LOC. STA CHAN SAVE DMA NO. * * CONFIGURE DMA INSTRUCTIONS. * * IOR OTA0 102606/7 STA DMAO XOR B4 102602/3 STA DMAO1 STA DMAO2 IOR B300 102702/3 STA DMAS IOR B1200 103702/3 ADA B4 10r3706/7 STA DMASC XOR B5000 106706/7 STA DMACX XOR B4 106702/3 STA DMAC END DMA CONFIGURATION * * SET THE DEVICE BUSY FLAG * LDA SAVA GET ADDRESS OF FIRST EQT WORD. STA EQT1 AND SAVE IT. ISZ SAVA SET ADDRESS TO WORD 2 OF EQT. LDB M15 ENTRY, SET BIT 15 ON ( A FIELD = 2) LDA SAVA,I TO SAY BUSY IOR B AND STA SAVA,I RESTORE. * * INITIALIZE TRANSMSSION LOG. * LDA SAVA SET ADDRESS OF INA EQT WORD 3 STA EQTA IN EQTA STB EQTA,I INITIALIZE XMISSION LOG. SPC 1 * * OUTPUT DMA CONTROL WORD. * LDA TVSC ASSIGN TV CARD TO DMA AND IOR BIT15 ASK STC AFTER EACH TRANSFER, DMAO OTA DMA BUT NO FINAL CLC. IOR STF0 CONFGR STF FOR TV STA STF1 SKP * * OUTPUT USER BUFFER ADDRESS * ISZ SAVB INDEX ADDRESS TO WORD 4. ISZ SAVB OF USER REQUEST. LDA SAVB GET WORD 4 OF LDA A,I REQUEST. RAL,CLE,SLA,ERA (IF INDIRECT, JMP *-2 GET EFFECTIVE ADDRESS DMAC CLC DMA-4 SEND BUFFER ADDRESS DIRECTLY. DMAO1 OTA DMA-4 TO ADDRESS REGISTER. * * OUTPUT USER WORD COUNT * ISZ SAVB INDEX TO WORD 5 OF REQUEST LDA SAVB,I GET WORD 5-BUFFER LENGTH STA CHC SAVE WORD COUNT CMA,INA SET WORD COUNT TO NEG. DMAS STC DMA-4 SEND TWO'S COMPLEMENT OF DMAO2 OTA DMA-4 BUFFER LENGTH TO WORD COUNT REG. * * FOLLOWING INSTRUCTIONS START DATA TRANSMISSION. * STA DFLG SET DFLG BUSY (NOT=0) CLA A=0, INDICATES OPERATION INITIATE. STF1 STF TVGEN READY TV CARD DMASC STC DMA,C TURN ON DMA, BUT DMACX CLC DMA PREVENT INTERRUPT FROM IT. CLA JMP D.13,I EXIT TO IOC. * * CONFIGURE I-0 INSTRUCTIONS FOR TV CARD CONTROL WORD. * CNTRL LDA TVSC CONFIGURE I/O INSTRUCTIONS 8J IOR MIA0 1024 STA ERASE IOR B1200 1036 STA OTATV IOR B100 1037 STA STCTV XOR B5000 1067 STA CLCTV END I/O CONFIGURATION * * SET EQT BUSY FLAG * LDA SAVA GET ADDRESS OF EQT1 STA EQT1 AND SAVE. ISZ SAVA SET ADDRESS LDA SAVA,I WORD 2 OF EQT ENTRY. IOR M15 SET BIT 15 STA SAVA,I OF WORD 2 = 1 LDA SAVA (A-FIELD=2) TO DAY BUSY AND RESTORE. SKP * * STORE ADDRESS OF EQT 3 IN DRIVER * INA SET ADDRESS OF EQT WORD 3 STA EQTA IN EQTA * * CHECK THE USER CONTROL WORD AND RE-CONFIGURE * IT FOR THE TV CARD. * SPC 1 LDA SAVB,I GET CONTROL WORD (ICNWD). AND =B3700 ISOLATE CONTROL BITS. STA B SAVE IT IN B REG. BLF,BLF CHECK BIT 8 SLB JMP ERASE DO BULK 'ERASE' SPC 1 LDA EQT1,I AND MASK CHECK FOR SZA,RSS NON-ZERO SUB-CHANNEL JMP GO.ON IS ZERO - SO COLOR LDA B NOT ZERO - KILL COLOR RAR,ERA IS COLOR NOT SEZ,SLA,RSS WHITE OR BLACK? JMP GO.ON YES - SO OK! LDA B NO - SO KILL COLOR TO AND MASK2 WHITE ONLY STA B SPC 1 GO.ON CLE,ELB CALL IS TO SET OR CHANGE BRS,BRS COLOR AND/OR SENSE. CLA POSITION ELA,RAL CONTROL BITS RBR,ERB 6, 9, & 10 RBL,RBL FOR TESTING SSB,SLB,RSS CYAN OR GREEN? JMP *+3 NEITHER IOR B1 IT IS CYAN OR GREEN JMP *+4 WHICH? SLB,RSS MAGENTA OR RED? JMP *+5 NEITHER IOR B4 IT IS CYAN/MAGENTA OR GREEN/RED SEZ,RSS CYAN/MAGENTA OR GREEN/RED? IOR B10 IT IS GREEN OR RED JMP CLCTV DONE SSB,RSS YELLOW OR BLACK? JMP *+5 NEITHER (I4!T IS BLUE OR WHITE) IOR B10 IT IS YELLOW OR BLACK SKP SEZ,RSS YELLOW OR BLACK? IOR B5 IT IS BLACK JMP CLCTV DONE SEZ BLUE OR WHITE? IOR B5 IT IS BLUE CLCTV CLC TVGEN SWITCH MODE FF OTATV OTA TVGEN,C TO STEER OUTPUT TO MODE REG. LDB EQT1 GET ADDRESS OF FIRST EQT WORD. INB SET TO ADDRESS OF SECOND WORD. LDA B,I GET SECOND WORD. AND =B77777 CLEAR DEVICE BUSY FLAG AND STA B,I RESTORE IT. LDA M15 DO IMMEDIATE JMP D.13,I COMPLETION * * REJECT SECTION * RCER CLB,RSS REQUEST CODE ERROR,(B)=0 RCER2 CLB,INB CHARACTER REQUEST ILLEGAL FOR BLS,SLB DRIVER, SETB=2. REJB LDB M15 DRIVER-DEVICE BUSY,(B) SIGN=1, CLA,INA SET(A) NON-ZERO. JMP D.13,I EXIT TO IOC AND REJECT. * * ERASE SECTION * ERASE MIA TVGEN ANY INPUT WILL BULK ERASE STCTV STC TVGEN,C INTERRUPT NEEDED TO COMPLETE. CLA STB ERFLG SET ERASE FLAG SO THAT I.13 KNOWS STB DFLG INTERRUPT WAS CAUSED BY ERASE. JMP D.13,I ALSO SET DRIVER BUSY FLAG (DFLG) SKP * * CONSTANTS AND STORAGE SECTION * TVSC NOP STORE CURRENT IO SELECT CODE. BIT12 OCT 10000 BIT15 OCT 100000 OTA0 OTA 0 STF0 STF 0 CLC0 CLC 0,C MIA0 MIA 0 B1 OCT 1 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B100 OCT 100 B300 OCT 300 B1200 OCT 1200 B5000 OCT 5000 BIT11 OCT 4000 MASK OCT 700 MASK2 OCT 137771 SAVA OCT 0 SAVB OCT 0 M15 OCT 100000 M17 OCT 17 M77 OCT 77 CHAN OCT 0 USED TO SAVE DMA CHANNEL. DFLG OCT 0 SET CONDITION INDICATES DRIVER BUSY. EQTA OCT 0 EQT1 OCT 0 ERFLG OCT 0 SET CONDITION INDICATES BULK ERASE. SKP * CONTINUATOR SECTION. SPC 1 * * ENTERED BY THE TV CARD INTERRUPT AFTER * COMPLETION OF DMA OR A BULK ERAESE. * I.13 NOP STA SAVAX SAVE A-REG STB SAVBX SAVE B-REG ERA,ALS SAVE E, SOC AND STA SAVEX OVERFLOW LDA TVSC CONFIGURE CLC ON TV CARD IOR CLC0 BEFORE STA TVCLC EXIT. * * CHECK FOR COMPLETION OF A BULK ERASE OPERATION * LDA ERFLG DOES ERASE FLAG INDICATE BULK ERASE? SZA JMP RSTOR YES, SO RESTORE REGS,CLEAR FLAGS & RETURN. * * DISMANTLE DMA-DRIVER INTERRUPT LINKAGE * LDA DMACX NO,STORE A CLC INST. IN STA CHAN,I THE DMA INTERRUPT LOCATION. * * CLEAR DMA CHANNEL BUSY FLAG. * LDA CHAN GET DMA CHANNEL NO. CPA B6 WAS CH NO.1 USED ? STA DMAC1 YES,CLEAR CH NO.1 BUSY FLAG. CPA B7 WAS CH NO. 2 USED.? STA DMAC2 YES,CLEAR CH NO.2 BUSY FLAG. * * RESTORE WORD 3 OF EQT ENTRY AND CLEAR DRIVER BUSY FLAG. * RSTOR LDA EQTA,I SET A=WORD 3 OF EQT ENTRY LDB CHC SET B=WORD COUNT ADA B PUT WORD COUNT IN A AND STA EQTA,I RESTORE WORD 3 IN EQT. CLA CLEAR THE DRIVER STA DFLG BUSY FLAG STA ERFLG AND THE ERASE FLAG. * * CLEAR DEVICE BUSY FLAG * LDB EQT1 GET ADDRESS OF FIRST EQT WORD. INB SET TO ADDRESS OF WORD 2. LDA B,I GET SECOND EQT WORD. AND =B77777 CLEAR DEVICE BUSY BIT. STA B,I AND RESTORE WORD. SKP * * RESTORE REGISTER SECTION * LDA SAVEX RESTORE CLO E SLA,ELA OVERFLOW, STF 1 A, LDA SAVAX AND B AT TIME OF LDB SAVBX INTERRUPT. TVCLC CLC TVGEN,C CLEAR CONROL & CLEAR FLAG ON TY CARD JMP I.13,I RETURN TO IOC. SPC 3 * * CONSTANTS AND STORAGE SECTION * A EQU 0 A-REG. B EQU 1 B-REG. TVGEN EQU 0 DUMMY SELECT CODE. DMA EQU 6 NOMINAL DMA CHANNEL SAVAX OCT 0 SAVEX OCT 0 SAVBN*($X OCT 0 CHC OCT 0 TEMP OCT 0 SPC 2 END *  $ 91700-18100 1728 S 0222 DS1/B COMM. DRIVER: DVR65             H0102 ASMB,R,L,C HED DVR65 91700-16100 REV.1728 * (C) HEWLETT-PACKARD CO. 1977 * NAM DVR65 91700-16100 REV.1728 770630 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT I.65,C.65 EXT $LIST IFZ EXT $DDT XIF * * * DVR65 * SOURCE: 91700-18100 * BINARY: 91700-16100 * PRGMR: BOB SHATZER * DATE: 12 JAN 76 * * * * THIS IS THE COMMUNICATIONS DRIVER DESIGNED TO SUPPORT THE * DS1B DISTRIBUTED SYSTEMS NETWORK. THIS DRIVER IS NOT COM- * PATABLE WITH EARLIER VERSIONS OF DVR65, SCE/1, OR DS-1. * BOTH THE CALLING SEQUENCES AND THE LINE PROTOCOL HAVE BEEN * MODIFIED TO FACILITATE BETTER RESOURCE MANAGEMENT WITHIN * THE SYSTEM. THE DRIVER IS DESIGNED TO BE USED IN AN RTE-II * OR RTE-III SYSTEM. * * THIS DRIVER IS DESIGNED TO FUNCTION WITH EITHER THE HP 12665 * SERIAL DATA INTERFACE (SDI) CARD OR THE HP 12773 SERIAL * MODEM DATA INTERFACE (SMDI) CARD. THE DRIVER MAKES NO DIS- * TINCTION BETWEEN THE TWO BOARDS OR BETWEEN VARIOUS DATA * RATES. * * * ***** CAUTION ***** CAUTION ***** CAUTION ***** CAUTION ***** * * DO NOT ATTEMPT TO USE THIS DRIVER OUTSIDE OF THE DS-1 ENVIRON- * MENT WITHOUT THE PROPER SUPPORTING COMMUNICATIONS MANAGEMENT * STRUCTURE! THE DRIVER IS SPECIFICALLY DESIGNED TO INTERACT * WITH THE VARIOUS DS-1 MODULES SO AS TO PROVIDE PROPER RESOURCE * MANAGEMENT. * * ***** CAUTION ***** CAUTION ***** CAUTION ***** CAUTION ***** * SKP * * CALLING SEQUENCES * * *** NOTE: THESE CALLING SEQUENCES ARE SHOWN AS CLASS CALLS. * HOWEVER, THE DRIVER IS ABLE TO HANDLE NON-CLASS I/O AS WELL. * TO DO NON-CLASS I/O, SIMPLY CONVERT THE CALLS TO THEIR PROPER * FORMAT. *** SPC 2 * TRANSMIT REQUEST AND RECEIVE OR TRANSMIT DATA SPC 1 * JSB EXEC * DEF *+8 * DEF IRW REQUEST CODE = 20 (CLASS WRITE/READ) * DEF CONWD CONTROL WORD (SEE BELOW) * DEF RBUFR REQUEST BUFFER ADDRESS * DEF RBUFL REQUEST BUFFER LENGTH * DEF DBUFR DATA BUFFER ADDRESS * DEF DBUFL DATA BUFFER LENGTH * DEF CLASS * * * RECEIVE OR TRANSMIT REQUEST OR DATA ONLY SPC 1 * JSB EXEC * DEF *+8 * DEF IRW REQUEST CODE (17 = READ AND 18 = WRITE) * DEF CONWD CONTROL WORD (SEE BELOW) * DEF BUFFR REQUEST OR DATA BUFFER ADDRESS * DEF BUFFL REQUEST OR DATA BUFFER LENGTH * DEF TIME1 TIME TAG WORD 1 (DATA CALLS ONLY) * DEF TIME2 TIME TAG WORD 2 (DATA CALLS ONLY) * DEF CLASS * * * CONTROL REQUEST SPC 1 * JSB EXEC * DEF *+5 * DEF IRW REQUEST CODE = 19 (CLASS CONTROL) * DEF CONWD CONTROL WORD (SEE BELOW) * DEF BUFFR LRN/PRN BUFFER * DEF CLASS * SKP * * THE LRN/PRN BUFFER IS A SIX WORD BUFFER WHICH IS SUPPLIED BY * THE CALLER FOR AN ENABLE LISTEN MODE (MODE=3) CALL. THE DRIVER * PLACES THE FIRST THREE VALUES INTO THE EQT EXTENSION (WORDS 1, 2 * AND 3). THE REMAINING THREE WORDS ARE STORED IN THE DRIVER. * FOR A CLEAR REQUEST (MODES 2 AND 4), THE DRIVER WILL CLEAR * THE LRN/PRN VALUES BEING MAINTAINED IN EQT EXTENSION WORDS * 1 AND 2, AND WILL RETURN THEIR VALUES TO THE USER IN THE * BUFFER ADDRESS SUPPLIED. * * THE FORMAT FOR THE USER-SUPPLIED BUFFER IS AS FOLLOWS: * WORD 1 - LINE RESOURCE NUMBER * WORD 2 - PROGL RESOURCE NUMBER * WORD 3 - INTRA-REQUEST TIMEOUT (-10'S OF MILLISECONDS) * WORD 4 - ADDRESS OF #SBIT SUBROUTINE IN RES * y WORD 5 - ADDRESS OF $CGRN ENTRY POINT IN THE SYSTEM * WORD 6 - #0 IF THIS IS A PRIMARY NETWORK NODE * =0 IF THIS IS A SECONDARY NODE * * NOTE: THE DISTINCTION BETWEEN PRIMARY AND SECONDARY IS NECESSARY * TO RESOLVE THE CONTENTION PROBLEM WHICH PERIODICALLY OCCURS * WHEN TWO REQUESTS ARE MADE SIMULTANEOUSLY, ONE FROM EITHER * END OF THE COMMUNICATIONS LINE. IN THIS CASE, THE SECONDARY * DRIVER YIELDS TO THE OTHER END AND RETURNS TO THE USER WITH * THE 'BR' AND THE 'RB' BITS SET TO INDICATE A SIMULTANEOUS * REQUEST CONDITION OCCURED. IN NORMAL USAGE, ALL SATELLITES * ARE PRIMARY AND CCE IS SECONDARY. A CCE MAY BE MADE PRIMARY IF * IT COMMUNICATES WITH ANOTHER CCE (VIA PTOP OR OPERATOR COMMANDS), * AND IT DOES NOT SUPPORT ANY SATELLITES. * * THE INTRA-REQUEST TIMEOUT IS USED TO PROVIDE A TIMEOUT COUNTER * WHICH RUNS IN THE INTERVAL BETWEEN REQUEST AND DATA PORTIONS OF * A I/O CALL. IN A CCE NODE, THE VALUE SHOULD BE ZERO, SINCE CCE * HAS A MECHANISM FOR PROVIDING AN ALL-ENCOMPASSING TRANSACTION * TIMEOUT. IN SCE/4 AND 5 NODES, A VALUE SHOULD BE SUPPLIED TO * PROVIDE SOME FORM OF TRANSACTION TIMEOUT, SINCE THAT IS NOT * SUPPLIED BY THE SUPPORTING SOFTWARE. * * IF #SBIT AND $CGRN DO NOT EXIST IN A PARTICULAR NODE, A ZERO * IS PASSED FOR EACH OF THESE ADDRESSES. THE DRIVER CHECKS FOR * A ZERO PRIOR TO EXECUTING A 'JSB' TO THAT LOCATION. * SKP * CONTROL WORD FORMAT SPC 1 * 15!14 13 12!11 10 9! 8 7 6! 5 4 3! 2 1 0 * ************************************************* * * * Z*NW*BR*MR* MODE * LOGICAL UNIT * * ************************************************* * * * WHERE: * * NW IS THE NO WAIT BIT WHICH IS USED BY A CALLER TO SPECIFY * THAT HE BE GIVEN CONTROL BACK IMMEDIATELY IF THE REMOTE * CANNOT SERVICE HIS REQUEST PROMPTLY. NOT USED BY THE DRIVER, * BUT IS SPECI&qFIED IN A DRIVER-LIKE CALLING SEQUENCE TO D65MS. * * BR IS THE BLIND REQUEST BIT WHICH IS USED BY A CALLER TO * SPECIFY THAT HE DOES NOT WANT TO WAIT FOR THE REPLY TO COME * BACK FROM THE REMOTE. NOT USED BY THE DRIVER, BUT IS SPECIFIED * IN A DRIVER-LIKE CALL TO D65MS. * * MR IS USED TO INDICATE A MASTER REQUEST TO THE DRIVER SO THAT * IT CAN SET THE I/O COMPLETION FLAG IN THE LIST ENTRY ASSOCIATED * WITH THE CURRENT REQUEST UPON I/O COMPLETION. * * MODE: READ-WRITE REQUESTS * 0 FOR SEND OR RECEIVE REQUEST ONLY * 1 FOR SEND REQUEST AND READ DATA * 2 FOR SEND REQUEST AND SEND DATA * 3 FOR SEND OR RECEIVE DATA ONLY * 4 FOR SEND DATA ONLY WITHOUT A PRE- * EXISTING DATA PENDING CONDITION * CONTROL REQUESTS * 0 FOR SEND STOP * 1 FOR ENABLE LISTEN MODE * 2 FOR CLEAR REQUEST * 3 FOR ENABLE LISTEN MODE AND SETUP LRN AND PRN * 4 FOR CLEAR AND SET EQT DOWN * * Z: REQUIRED BY RTE FOR REQUEST AND DATA CALLS TO FORCE * FORCE THE SYSTEM TO TRANSPORT BOTH REQUEST AND * DATA BUFFERS BEFORE AND AFTER THE I/O CALL. * * NOTE: MODE 4 IS A PRIVILEGED MODE DESIGNED FOR USE BY PROGL AND * OTHER USERS WHO HAVE NEED TO SEND BLOCKS OF PURE DATA AND, IN * DOING SO, MUST BYPASS THE NORMAL COMMUNICATIONS RESOURCE * MANAGEMENT AND TRANSACTION MANAGEMENT FUNCTIONS. THIS MODE * IS LEGAL FOR WRITING ONLY. * SKP * EQUIPMENT TABLE USAGE * ********************* * * EQT # USE * *************************** * 1 DEFINED * 2 DEFINED * 3 DEFINED * 4 DEFINED * 5 DEFINED * 6 DEFINED * 7 FIRST BUFFER ADDRESS * 8 FIRST BUFFER LENGTH * 9  DATA BUFFER ADDRESS (REQ AND DATA) * 10 DATA BUFFER LENGTH (REQ AND DATA) * 11 COROUTINE POINTER * 12 EXTENDED STATUS WORD * 13 EQT EXTENSION ADDRESS * 14 DEFINED TIMEOUT VALUE * 15 TIMEOUT COUNTER * EXT1 VALUE OF LINE RESOURCE NUMBER * EXT2 VALUE OF PROGL RESOURCE NUMBER * EXT3 INTRA-REQUEST TIMEOUT VALUE (- 10'S OF MSECS.) * EXT4 STREAM TYPE FROM CURRENT PARMB * EXT5 MASTER REQUESTOR CLASS NUMBER FROM CURRENT PARMB * EXT6 ID SEG. ADDR. OF PGM. TO BE INTERRUPT SCHEDULED * EXT7 1ST TIME TAG OF LAST RECEIVED REQUEST * EXT8 2ND TIME TAG OF LAST RECEIVED REQUEST * SKP * STATUS WORD FORMAT * * * 15!14 13 12!11 10 9! 8 7 6! 5 4 3! 2 1 0 * ************************************************* * * *BL*IR*IL*SR*TO*CL*BR*GC* EQT 5 * ************************************************* * *RW*OC*RD*DD*MM*LM*RP*DP*TP*SF*RB*RM*PE*PAR CNTR* EQT 12 * ************************************************* * * WHERE: * * BL - BROKEN LINE * IR - ILLEGAL REQUEST TYPE * IL - ILLEGAL LENGTH RECEIVED * SR - STOP RECEIVED (GC ALSO SET IF VALID DATA REJECT) * TO - TIME OUT * CL - ILLEGAL LENGTH SPECIFIED IN CALLING SEQUENCE * BR - BUSY REJECT (RP OR DP CONDITION EXISTS) * GC - GOOD COMPLETION * RW - READ/WRITE DIRECTION FOR CURRENT REQUEST SEGMENT * OC - OPEN/CLOSED LOOP TRANSMISSION MODE * RD - REQUEST AND DATA MODE * DD - DATA DIRECTION FOR REQ AND DATA (1 = WRITE) * MM - MASTER REQUEST MODE * LM - LISTEN MODE ENABLED * RP - REQUEST PENDING * DP - DATA PENDING * TP - TRANSACTION PENDING * SF - SYSTEM FAILURE * RB - REMOTE BUSY * RM - RECEIVED MODE (OPEN/CLOSED LOOP) * PE - PARITY ERROR * q PAR CNTR - PARITY COUNTER * SKP I.65 NOP IFZ JMP *+3 NORMAL DRIVER ENTRY JSB $DDT SPECIAL ENTRY - CALL $DDT DEF *+1 XIF JSB SETIO CONFIGURE I/O INSTRUCTIONS LDA EQT13,I EXT. AREA ADDRESS SZA,RSS SKIP IF ONE SPECIFIED JMP GENER ELSE SYSTEM GENERATED INCORRECTLY LDA EQTX6,I FIRST ENTRY SZA FOR DEVICE? JMP NFIR NO. LDA EQT6,I GET EQT6 AND B377 ISOLATE REQUEST CODE AND MODE CPA B303 IS THIS AN INITIALIZE REQUEST? RSS YES - GO PROCESS IT JMP RQERR NO - REJECT REQUEST LDA EQT4,I FETCH SELECT CODE AND B77 ISOLATE ADA MN6 SUBTRACT 6 TO FIND ADA INTBA ENTRY IN INTERRUPT TABLE LDB A,I FETCH USER INTERRUPT LINK SSB,RSS IS IT POSITIVE? (EQT ADDRESS) JMP GENER YES - SYSTEM INCORRECTLY GENERATED CMB,INB GET INTERRUPT LINK STB EQTX6,I AND SAVE LDB EQT1 SET DRIVER STB A,I INTERRUPT LINK JSB RDD.C CLEAR RECEIVER AND STATUS WORDS LDA EQT4,I TELL RTE THAT I WANT CONTROL ON TIME OUTT IOR BIT12 IOR BIT13 AND ON POWER FAIL STA EQT4,I * NFIR LDA EQT5,I GET EQT WORD 5 SSA,RSS IS THE EQT ENTRY BUSY? JMP NFIR1 NO - NORMAL ENTRY LDA B103 WAS BUSY - SIMULATE LISTEN REQUEST STA EQT6,I (POWER FAIL CONDITION) NFIR1 LDA EQT12,I GET EQT 12 ALF,ALF ROTATE RP AND DP BITS TO LOWER BYTE AND B3 ISOLATE THEM STA STATE AND SAVE AS CURRENT DRIVER STATE LDA EQT6,I GET EQT6 AGAIN ALF,ALF ROTATE MODE TO LOWER BYTE RAL,RAL AND B7 MASK IT OFF STA MODE AND SAVE IT ADA M5 SSA,RSS MODE>4 IS AN ERROR JMP RQERR YES - MODE > 4 - ERROR LDA EQT6,I GEoT EQT6 AGAIN AND B3 ISOLATE REQUEST CODE SZA,RSS IS IT ZERO? JMP RQERR YES - ERROR CPA B3 IS IT A CONTROL REQUEST? JMP CNREQ YES - GO PROCESS ADA M1 MAKE REQUEST CODE 0 OR 1 MPY D15 MULTIPLY BY 15 FOR RQTBL INDEXING LDB MODE GET MODE BLS ADB MODE MODE * 3 ADB 0 ADD REQUEST TYPE ADB STATE AND STATE ADB RQTBL SET UP REQUEST TABLE INDEX LDA 1,I GET CONTENTS OF RQTBL AT INDEX AND MN400 CLEAR LOW HALF SZA,RSS IS IT ZERO? JMP ER.IR YES - ILLEGAL REQUEST SSA IS THE VALUE NEGATIVE? JMP ER.BR YES - DO A 'SOFT' REJECT LDA EQT6,I PICK UP EQT 6 AND BIT9 ISOLATE MASTER REQUEST BIT RAL,RAL ROTATE IT TO BIT 11 STA MSTR AND SAVE IT FOR LATER USAGE LDB 1,I GET ADDRESS FROM TABLE JMP 1,I JUMP TO PROCESSOR * B103 OCT 103 B377 OCT 377 MODE NOP STATE NOP MSTR NOP * SKP * * REQUEST PROCESSOR TABLE * * THIS TABLE IS ACTUALLY A THREE DIMENSIONAL ARRAY WHICH IS INDEXED * BY REQUEST CODE, MODE, AND DRIVER STATE. IF THE ENTRY WHICH IS * INDEXED BY A PARTICULAR REQUEST AT A SPECIFIC TIME IS ZERO, THE * REQUEST IS ILLEGAL AND WILL BE REJECTED BY THE DRIVER (THE SYSTEM * WILL RETURN AN 'IO07' TO THE REQUESTOR.) IF THE ENTRY IS NEGATIVE, * THE DRIVER WILL RETURN WITH AN IMMEDIATE COMPLETION RETURN AND * BIT 1 OF THE EQT5 STATUS AREA WILL BE SET TO INDICATE A DRIVER * BUSY REJECT. IF THE ENTRY IS POSITIVE, THE REQUEST IS VALID AND * THE ENTRY CONTAINS THE ADDRESS OF THE REQUEST PROCESSOR. * * RQTBL DEF *+1 RCODE MODE STATE REQ TYPE ****************************************************************************** B1 DEC 1 1 0 0 READ REQ MN6 OCT 177772 1 0 1 (DP) READ RE Q DEF R.REQ 1 0 2 (RP) READ REQ DEF RQ.RD 1 1 0 REQ & RDATA BIT15 OCT 100000 1 1 1 (DP) REQ & RDATA MN3 OCT 177775 1 1 2 (RP) REQ & RDATA DEF RQ.SD 1 2 0 REQ & SDATA MN4 OCT -4 1 2 1 (DP) REQ & SDATA DCLCC CLC 7,C 1 2 2 (RP) REQ & SDATA B2 DEC 2 1 3 0 READ DATA DEF R.DTA 1 3 1 (DP) READ DATA B3 DEC 3 1 3 2 (RP) READ DATA B4 DEC 4 1 4 0 READ DATA BIT3 OCT 10 1 4 1 (DP) READ DATA BIT5 OCT 40 1 4 2 (RP) READ DATA DEF S.REQ 2 0 0 SEND REQ MN400 OCT 177400 2 0 1 (DP) SEND REQ M1 OCT -1 2 0 2 (RP) SEND REQ DEF RQ.RD 2 1 0 REQ & RDATA RC OCT 170017 2 1 1 (DP) REQ & RDATA TNW OCT 170360 2 1 2 (RP) REQ & RDATA DEF RQ.SD 2 2 0 REQ & SDATA M5 DEC -5 2 2 1 (DP) REQ & SDATA CLCC CLC 0,C 2 2 2 (RP) REQ & SDATA D15 DEC 15 2 3 0 SEND DATA DEF S.DTA 2 3 1 (DP) SEND DATA B77 OCT 77 2 3 2 (RP) SEND DATA DEF SP.DT 2 4 0 SEND DATA DEF SP.DT 2 4 1 (DP) SEND DATA DEF SP.DT 2 4 2 (RP) SEND DATA * SKP * * CONTROL REQUEST PROCESSOR * CNREQ LDA STATE TEST DATA PENDING CONDITION CPA B1 IS IT SET? JMP STPRQ YES - SEND STOP JSB CNPRC CALL CONTROL REQUEST PROCESSOR SUBROUTINE STA EQT12,I SAVE EQT12 STATUS JSB ICHAS SET UP COROUTINE POINTER CLB,INB SET B FOR GOOD COMPLETION JMP ER.BrR+1 AND EXIT * SKP * CONTROL REQUEST PROCESSOR SUBROUTINE * CNPRC NOP LDB MODE GET MODE ADB CNTBL SET UP TO INDEX CONTROL TABLE JMP B,I AND JUMP TO PROCESSOR * CNTBL DEF *+1,I DEF STPRQ MODE 0 DEF LSN.1 MODE 1 DEF CLR.2 MODE 2 DEF LSN.3 MODE 3 DEF CLR.4 MODE 4 * CLR.2 CLB,RSS NORMAL CLEAR REQUEST CLR.4 LDB BIT14 CLEAR AND DOWN REQUEST JSB STAT SET EQT DOWN IF C AND D REQUEST LDB EQT7,I GET ADDRESS PROVIDED BY USER JSB ICHAS CHASE DOWN INDIRECTS LDA EQTX1,I GET LRN STA B,I AND RETURN TO USER INB BUMP USER BUFFER POINTER LDA EQTX2,I GET PRN STA B,I AND RETURN TO USER JSB RDD.C CLEAR THE CARD JSB CGRN CLA STA EQTX1,I CLEAR LRN VALUE IN EQT EXTENTION STA EQTX2,I CLEAR PRN VALUE IN EXTENSION LDB UNKNI GET UNKNOWN INTERRUPT POINTER JMP CNPRC,I AND EXIT * LSN.3 LDB EQT7,I LISTEN AND SETUP MODE JSB ICHAS GET USER BUFFER ADDRESS LDA B,I GET LRN STA EQTX1,I AND SAVE IT INB BUMP BUFFER POINTER LDA B,I GET PRN STA EQTX2,I AND SAVE THAT, TOO INB BUMP BUFFER POINTER LDA B,I GET INTRA-REQUEST TIMEOUT STA EQTX3,I AND SAVE IT INB BUMP BUFFER POINTER LDA B,I GET #SBIT ADDR. AND $CGRN ADDRESS STA #SBIT AND SAVE THEM INB LDA B,I IN BODY OF DRIVER STA $CGRN INB BUMP POINTER AGAIN LDA B,I GET PRIMARY FLAG STA PRIMY AND SAVE IT LSN.1 STC 0,C SET I/O CARD TO LISTEN MODE JSB CGRN LDB LSTNI GET LISTEN INTERRUPT POINT LDA BIT10 GET LISTEN STATUS BIT JMP CNPRC,I AND RETURN SKP * * HERE FOR IMMEDIATE COMPLETION RETURN * A REG SHOULD CONTAIN THEJ STATUS OF LAST REQUEST * * ER.BR LABEL IS USED FOR 'SOFT' REJECTS OF REQUESTS. * THAT IS, A REQUEST WHICH IS RECEIVED WHEN THERE IS * EITHER A REQUEST PENDING OR A DATA PENDING CONDITION IS * CURRENTLY EXISTING. * ER.BR LDB B2 GET BUSY BIT FOR IMMED COMPL REJECT JSB STAT PUT NEW STATUS IN EQT 5 LDA B4 SET FOR IMMEDIATE COMPLETION * * HERE FOR COMPLETION RETURN * EQT 11 WILL BE SET DEPENDING UPON LISTEN MODE STATUS * IDON STA TEMP2 SAVE COMPLETION STATUS LDA EQT12,I GET EQT12 AND BIT10 ISOLATE LISTEN MODE BIT LDB UNKNI SET FOR ILLEGAL INTERRUPT SZA IS THE DRIVER IN LISTEN MODE? LDB LSTNI YES - SET FOR LISTEN INTERRUPT LDA TEMP2 GET STATUS AGAIN IDON1 JSB ICHAS SAVE ROUTINE ADDRESS LDB EQT12,I GET EQT12 FOR RETURN TO CALLER JMP I.65,I RETURN TO RTE SYSTEM * ER.IR LDB BIT6 ILLEGAL REQUEST JSB STAT UPDATE EQT5'S STATUS CLA,INA,RSS SET FOR READ-WRITE ERROR RQERR LDA B2 REQUEST ERROR CODE JMP IDON AND EXIT * GENER LDA B3 SET A=3 FOR DEVICE NOT READY REJECT JMP IDON * SKP * * STOP REQUEST PROCESSOR * STPRQ JSB SSTOP SEND STOP LDB STPRA GET STOP REQUEST CONTINUATOR ADDRESS STRQ1 STC 0 PUT CARD IN TRANSMIT MODE JMP IEXIT+1 AND RETURN WITH OPERATION IN PROGRESS * * SUBROUTINE TO SEND A STOP * SSTOP NOP SAVE RETURN ADDRESS LDA STOP GET STOP WORD JSB OUTPA SEND STOP JMP SSTOP,I RETURN * * SUBROUTINE TO SEND TNW * STNW NOP LDA TNW GET TRANSMIT NEXT WORD JSB OUTPA OUTPUT WORD JMP STNW,I RETURN * * SUBROUTINE TO RETRANSMIT LAST WORD * SRLW NOP LDA RLW RETRANSMIT LAST WORD JSB OUTPA OUTPUT CHARACTER JMP SRLW,I RETURN * SKP * * HERE FOR RECEIVE OR TRANSMIT DAT(lA ONLY * S.DTA CCE,RSS SET E=1 FOR SEND DATA REQUEST R.DTA CLE AND TO ZERO FOR RECEIVE DATA REQUEST JSB DLCHK CHECK DATA LENGTH * LDA EQTX4,I GET FRIENDLY BIT (11) ALF SSA,RSS IS IT FRIENDLY? JMP DTAGO NO, DON'T CHECK TIME-TAGS * LDB EQT10,I EQT10 HAS TAGS ADDR IF XSIO CALL LDA EQT6,I RAL,SLA TEST "T" FIELD SSA SKIP IF "SYSTEM" REQUEST LDB EQT9 NORMAL CALL, EQT 9 & 10 HAVE TAGS LDA 1,I GET 1ST TAG CPA EQTX7,I MATCH REQUEST'S TIME-TAG 1? INB,RSS YES JMP ER.IR NO, TREAT AS ILLEGAL REQUEST LDA 1,I GET 2ND TIME-TAG ISZ EQTX7 CPA EQTX7,I MATCH REQUEST'S TIME-TAG 2? RSS YES, DO THE TRANSFER JMP ER.IR REJECT REQUEST * DTAGO LDA EQT12,I GET EQT12 AND BIT4 ISOLATE REMOTE'S MODE ALF,ALF ROTATE TO BIT 14 TO SET OUR MODE RAL,RAL RAL,ERA SET BIT 15 TO REFLECT DATA DIRECTION IOR EQT12,I INCLUSIVE OR IN EQT12 AND NBIT8 CLEAR DATA PENDING CONDITION STA EQT12,I JSB CLPAR CLEAR PARITY COUNTER LDB WDINT SET FOR POSSIBLE WRITE INTERRUPT SSA READ OR WRITE? JMP TRDT3 WRITE...DO NOT SET FOR DMA TRANSFER UNTIL READY JSB GTDMA SET UP DMA LDB RDINT GET READ INTERRUPT TRDT3 JSB STNW TELL OTHER SIDE TO "LET HER GO" * * ALL NORMAL EXITS FROM INITIATOR COME THRU HERE * IEXIT STC 0,C SET FOR RECEIVE MODE CLA GET A ZERO JMP IDON1 RETURN * * B303 OCT 303 BIT8 OCT 400 NBIT8 OCT 177377 UNKNI DEF IUNKN LSTNI DEF ILSTN RDINT DEF INTRD WDINT DEF INTWD WR1IT DEF ITWR1 BIT10 OCT 2000 BIT9 OCT 1000 * SKP * * * REQUEST AND DATA TRANSMISSION MODE * RQ.RD CLA,RSS SEND REQUEST AND READ DATA RQ.SD LDA BIT12 REQ AND SEND DATA - SET DATA WRITE FLAG l JSB DLCHK DO LENGTH CHECK IOR BIT13 SET REQUEST AND DATA MODE INTO STATUS * * HERE FOR STARTING OF A SEND REQUEST * SREQ1 IOR BIT15 SET FOR WRITING...BIT 15 IOR BIT10 MASK IN LISTEN ENABLED FLAG IOR MSTR STUFF IN MASTER REQUEST BIT STA EQT12,I SAVE IT AWAY LDA EQT7,I GET FIRST 2 WORDS OF REQUEST DLD A,I DST EQTX4,I AND PUT INTO EQT EXTENSION JSB CLPAR CLEAR PARITY COUNTER JSB SRC SEND REQUEST COMING LDB WR1IT JMP IEXIT DO A NORMAL CONTINUATION EXIT * BIT12 OCT 10000 BIT14 OCT 40000 * SKP * * HERE FOR RECEIVE OR TRANSMIT REQUEST ONLY * S.REQ CLA SEND REQUEST ONLY CALL JMP SREQ1 * R.REQ LDA BIT10 SET LISTEN FLAG..CURRENT STATUS OF DRIVER IOR MSTR STUFF IN MASTER REQUEST FLAG STA EQT12,I SAVE NEW STATUS JSB CLPAR CLEAR PARITY COUNTER LDB LNRCI GET READ REQ INTERRUPT JMP TRDT3 TELL OTHER SIDE TO CONTINUE * LNRCI DEF ILNRC * * ROUTINE TO CLEAR PARITY COUNTER * CLPAR NOP LDA PMSK GET MASK FOR PARITY COUNTER AND EQT12,I MASK OFF PARITY COUNT STA EQT12,I AND RESTORE EQT12 JMP CLPAR,I * * ROUTINE TO CHECK DATA LENGTH LEGALITY * DLCHK NOP LDB EQT8,I GET DATA BUFFER LENGTH SZB IS IT ZERO? JMP DLCHK,I NO - RETURN ON LEGAL LENGTH LDB B4 YES JMP ER.IR+1 TAKE ERROR EXIT * SKP * * SPECIAL DATA TRANSMISSION MODE * SP.DT JSB DLCHK CHECK DATA LENGTH LDA EQT12,I GET EQT 12 IOR BIT15 SET TRANSMIT MODE STA EQT12,I AND SAVE IT JSB CLPAR CLEAR PARITY COUNTER LDB DWDEF GET RETURN-POINTER ADDRESS. JSB SPECL GO TO START SPECIAL DMA TRANSMISSION. JMP IEXIT TAKE INITIATOR EXIT. * SP.EN CLE JSB PRIV DEALLOCATE DMA JSB CEXT2 AWAIT RESPJNLHONSE JSB TIMCK REENTERED, IS IT TIMEOUT? JMP LNRC2 YES JSB RDD.D GET SCE-1'S REPLY CPA RLW RETRY? RSS YES JMP REQDN NO, DONE WITH THIS RECORD LDB DWDEF JMP SPDMA RETRY * DWDEF DEF SP.EN * SPECL NOP ENTRY/EXIT: SPECIAL DMA START-UP LDA EQT7,I GET THE FIRST ELEMENT LDA A,I FROM THE CALLER'S DATA BUFFER. DST SPTMP SAVE FIRST WORD AND RETURN POINTER. ISZ EQT7,I ADVANCE BUFFER POINTER FOR DMA. LDB EQT8,I GET THE TRANSMISSION LENGTH. ADB M1 SUBTRACT ONE FOR FIRST WORD. STB EQT8,I SAVE DECREMENTED LENGTH FOR DMA. SZB ONE WORD TRANSMISSION? JSB GTDMA NO. PREPARE FOR DMA TRANSFER. DLD SPTMP GET FIRST DATA WORD & RETURN POINTER. JSB OUTPA OUTPUT IN RCV MODE--RESPONSE STARTS DMA. JMP SPECL,I RETURN: =RETURN-POINTER. * SPTMP OCT 0,0 TEMPORARY STORAGE. N SKP * * CONTINUATION SECTION * C.65 NOP JSB SETIO CONFIGURE I/O INSTRUCTIONS LDA EQT1,I GET EQT WORD 1 SZA IS DRIVER BUSY? JMP C.651 YES - GO ON LDB EQT11,I DRIVER WAS NOT BUSY CPB LSTNI WAS IT IN LISTEN MODE? JMP C.651 YES - THAT'S OK STA EQT15,I SPURIOUS INTERRUPT - KILL TIMEOUT JSB RDD.C CLEAR CARD JMP CEXT4 AND EXIT C.651 LDB EQT11,I GET BRANCH ADDRESS FOR ROUTINE SZB MAKE SURE IT IS NOT ZERO JMP B,I GO TO INTERRUPT PROCESSOR * SKP * * UNKNOWN INTERRUPTS COME HERE * WE'RE IN TROUBLE IF WE EVER GET HERE!!!!! * IUNKN JSB RDD.C CLEAR CARD BY READING IT LDA BIT6 SET SYSTEM FAILURE BIT STA EQT12,I INTO STATUS LDA B4 STA MODE SET UP MODE TO FAKE A CLEAR AND DOWN REQUEST JSB CNPRC CALL CONTROL REQUEST PROCESSOR CLB SET UP TO CLEAR EQT5 JMP CEND AND EXIT * SKP * * HERE FOR FIRST INTERRUPT WHEN CARD IN LISTEN MODE * ILSTN JSB CHECK FIND OUT WHAT THEY SENT US JMP ILSN4 TIME OUT...IGNORE JMP ILSN3 PARITY ERROR...TELL THEM TO RETRY JMP ILSN4 STOP...IGNORE * * IF WE GET THIS FAR...CHECK RETURN A REG WITH DATA WORD * SZA,RSS MAKE SURE A BROKEN LINE DIDN'T SNEAK IN JMP CHCK2 BROKEN LINE...TURN OFF CARD CPA RC REQUEST COMING? JMP ILSN1 YES...PROCESS AS A REQUEST COMING LDB EQT1,I GET EQT 1 WORD SZB,RSS WAS DRIVER BUSY? JMP ILSN4 NO - JUST IGNORE INTERRUPT ILSN6 JSB SSTOP SEND STOP...UNKNOWN WORD JMP ILSN7 & EXIT IN LISTEN MODE * ILSN1 LDA EQT12,I GET EQT 12 AND B1400 IS THERE EITHER REQUEST OR DATA PENDING? SZA,RSS JMP ILSN2 NO - CONTINUE ALF,ALF SLA,RSS IS IT REQUEST PENDING? JMP ILSN4 YES, IGNORE INTERRUPT LDA EQT12,I RP OR DP CONDITION IOR BIT7 SET TRANSACTION PENDING FLAG STA EQT12,I AND STORE IT BACK LDB SCODE PICK UP SELECT CODE BLF,BLF ROTATE TO UPPER BYTE ADB BIT14 SET IN DATA PENDING FLAG LDA EQTX4,I GET STREAM TYPE FROM PENDING REQUEST AND B377 ISOLATE STREAM TYPE ALF,ALF ROTATE TO UPPER BYTE ADA B2 SET 2 INTO LOWER BYTE JSB SBIT SET BREAK FLAG IN STREAM LIST JSB CGRN ILSN2 JSB SCHED GO AND SCHEDULE QUEUE OR WHOM EVER... JMP ILSN6 SEND A STOP IF QUEUE IS BUSY LDA EQT14,I GET TIMEOUT VALUE JMP *+3 SET IT UP AND EXIT ILSN3 JSB SRLW SEND RLW ILSN4 CLA CLEAR TIMEOUT STA EQT15,I JSB RDD.C CLEAR CARD BY READING IT ILSN7 LDB LSTNI SET FOR LISTEN MODE INTERRUPT JMP CEXIT AND EXIT * B6200 OCT 6200 B1400 OCT 1400 * SKP * * SUBROUTINE TO SCHEDULE INTERRUPT-HANDLING PROGRAM * SCHED NOP LDB EQTX6,I GET ID SEGMENT ADDRESS OF PROGRAM STB PROG SAVE ADDRESS ADB B17 GET TO STATUS LDA B,I GET STATUS AND B17 MASK OFF ALL BUT STATUS SZA BUSY? JMP SCHED,I YES...TELL OTHER SIDE TO RETRY ADB M5 GET TO B REG LDA EQT4 GET ADDRESS OF LU STA B,I SAVE ADDRESS JSB $LIST SCHEDULE PROGRAM OCT 101 PROG NOP LDA EQT12,I GET OLD STATUS AND B6200 MASK OFF ALL BUT LE, TP, AND MM IOR BIT9 SET IN REQUEST PENDING STA EQT12,I AND SAVE IT ISZ SCHED BUMP RETURN POINT JMP SCHED,I AND RETURN * SKP * ILNRA JSB STNW ACKNOWLEDGE REDUNDANT RC JSB CEXT2 AWAIT LENGTH * * HERE FOR LENGTH COMING INTERRUPT * ILNRC JSB CCHCK CHECK FOR TIME OUT,PARITY ERROR,STOP CPA RC CHECK FOR RC (PREV. SIM. REQUEST) JMP ILNRA ACKNOWLEJDGE IT LDB BIT5 GET ERROR CODE SSA,INA,RSS BUMP COUNT AND CHECK FOR POSITIVE JMP LNRC4 ILLEGAL LENGTH - SEND STOP ADA EQT8,I IS IT WITHIN RANGE? SSA JMP LNRC4 SEND STOP AND TERMINATE LDA TEMP2 GET LENGTH AGAIN CMA GET COUNT POSITIVE STA EQT8,I SAVE FOR DMA TRANSFER JSB STNW TELL OTHER SIDE TO CONTINUE JSB CEXT2 DO CONTINUATION EXIT...GIVE NEXT INTERRUPT ADDRESS * SKP * * HERE WHEN MODE INTERRUPT OCCURS * JSB CCHCK CHECK TO,PAR.,STOP RAL,CLE,ERA E REG CONTAINS DATA FLAG SZA DMA OPEN? LDA BIT4 NO...SET DMA SPECIAL IOR EQT12,I STUFF INTO EQT12 SEZ IS IT A REQUEST AND DATA? IOR BIT8 YES STA EQT12,I SAVE STATUS IMOD9 LDA EQT12,I GET PARITY COUNT AND BIT3 MASK ALL BUT PARITY ERROR FLAG SZA DONE IT MAX # OF TIMES? JMP LNRC3 YES...PARITY ERROR CPA EQT8,I COMPARE LENGTH JMP ERQ1 ZERO LENGTH TERMINATE JSB GTDMA NO...SET FOR DMA TRANSFER LDA EQT12,I GET PARITY COUNT AND B17 ISOLATE PARITY COUNTER SZA FIRST TIME? JMP IMOD2 NO LDA GDMAW GET DMA AVAILABLE WORD LDB EQT12,I GET EQT 12 FOR MODE BLF,BLF BLF,SLB TEST EQT12 BIT 4 LDA TNW OTHER SIDE DOESN'T HAVE DMA, SEND TNW JSB OUTPA SEND WORD JMP *+3 IMOD2 JSB SRLW SECOND TIME...RLW ISZ EQT12,I BUMP PARITY COUNT JSB CEXT2 DO CONTINUATION EXIT...SUPPLY NEXT INTERRUPT RETURN * SKP * * HERE ON REQUEST COMPLETE INTERRUPT * CLE CLEAR E REG FOR PRIV ROUTINE JSB PRIV DEALLOCATE DMA JSB CHECK CHECK DATA JMP LNRC2 TIME-OUT JMP IMOD9 PARITY ERROR - RETRY JMP LNRC5 STOP RECEIVED ERQ1 LDA EQT12,I GET CURRENT DRIVER STATUS AND MSK12 SAVE LSTEN, DATA PENDING, & DMA MODE STA EQT12,I SAVE STATUS LDA EQT7,I GET WORDS 1 AND 2 OF REQUEST DLD A,I EQTX4 EQU *+1 DST * AND PUT INTO EQT EXTENSION LDA EQT7,I GET REQUEST ADDRESS ADA D33 POINT TO TIME-TAGS DLD 0,I PICK THEM UP EQTX7 EQU *+1 DST * STUFF THEM IN EQT EXTENSION JSB STNW SEND TNW JSB CEXT2 WAIT IN RCV MODE JMP REXIT NOW CLEAR CARD & EXIT GDMAW OCT 67 D33 DEC 33 SKP * * HERE FOR START OF DATA TRANSMIT * INTWD JSB CCHCK JSB TNWCK MAKE SURE IT'S A TNW * * OTHER SIDE NOW READY TO RECEIVE DATA * IWD1 LDB DWDNI GET DATA WRITE INTERRUPT LDA EQT12,I GET MODE OF TRANSFER RAL TEST BIT 14 SSA DMA OPEN? JMP SPDMA NO...SET SPECIAL JSB GTDMA GET DMA FOR TRANSMITTING. JSB CEXTT YES...SET TO TRANSMIT MODE * * HERE FOR FINISHED TRANSMITTING DATA * IDWDN CLE CLEAR E REG JSB PRIV DEALLOCATE DMA JSB CEXT2 TAKE CONTINUATION EXIT...SET FOR DATA DONE * SKP * * HERE ON COMPLETION OF WRITE DATA * JSB CCHCK CPA RLW ERROR? JMP IWD1 TRY AGAIN JMP REQDN OK STATUS & TERMINAYE * DWDNI DEF IDWDN SKP * * HERE FOR COMPLETION OF READ DATA * INTRD CLE JSB PRIV DEALLOCATE DMA JSB CHECK CHECK DATA JMP LNRC2 TIMEOUT JMP IDR1 PARITY ERROR JMP LNRC5 STOP RECEIVED LDA EQT12,I MASK OFF ALL BUT LISTEN AND BIT10 STA EQT12,I SAVE NEW STATUS JSB STNW SEND TNW FOR SUCCESS JSB CEXTT WAIT IN TRANSMIT MODE REXIT JSB RDD.C CLEAR CARD JMP REQDN DO NORMAL COMPLETION * * HERE ON PARITY ERROR ...RETRANSMIT * IDR1 LDA EQT12,I GET PARITY COUNT AND BIT3 MASK OFF ALL BUT PARITY ERRO~R FLAG SZA IS THE FLAG SET? JMP LNRC3 YES...PARITY ERROR JSB GTDMA GET DMA LDB EQT12,I GET MODE WORD ISZ EQT12,I BUMP PARITY COUNT NOP IN CASE IT ROLLS OVER LDA TNW BLF,BLF BLF,SLB TEST MODE BIT LDA RLW NOT FIRST TIME, RLW JSB OUTPA SEND WORD JSB CEXT2 DO CONTINUATION EXIT JMP INTRD * SKP * * PROCESSOR TO HANDLE A STOP RECEIVED IN RESPONSE TO A RC * STPRC LDA BIT10 GET LISTEN ENABLED BIT LDB BIT4 PICK UP STOP RECEIVED BIT FOR EQT 5 JMP ITWR7 * ITWR3 LDA PRIMY GET PRIMARY FLAG SZA IS IT ZERO? JMP SNDRC+1 NO, PRIMARY NODE, AWAIT RESPONSE * ITWR4 JSB SCHED SECONDARY NODE - SCHEDULE QUEUE RSS JMP ITWR6 JSB SSTOP QUEUE BUSY, SEND STOP JSB CEXTT EXIT IN TRANSMIT MODE LDA BIT10 PICK UP LISTEN MODE BIT ITWR6 LDB B2 BIT 1 FOR EQT 5 ITWR7 IOR BIT5 SET IN SIMULTANEOUS REQUEST BIT STA EQT12,I AND PUT BACK INTO EQT12 JMP CEND AND RETURN TO USER * SKP * * HERE TO RETRY RC * SNDRC JSB SRC SEND REQUEST COMING (AGAIN) JSB CEXT2 AWAIT REPLY * * HERE FOR LENGTH WORD NEEDED INTERRUPT * ITWR1 JSB CHECK CHECK RECEIVED CHARACTER JMP SNDRC TIME-OUT, POSSIBLE RETRY JMP LNRC3 PARITY JMP STPRC STOP RECEIVED CPA RC WAS IT A REQUEST COMING? JMP ITWR3 YES, SIMULTANEOUS REQUEST CONDITION CPA RLW RETRANSMIT? JMP SNDRC YES, SEND RC AGAIN JSB TNWCK MAKE SURE IT WAS TNW * * OTHER SIDE IS NOW SCHEDULED AND HAS AN OUTSTANDING REQUEST * JSB CLPAR CLEAR RETRY COUNT LDA EQT8,I GET REQUEST BUFFER LENGTH CMA NEGATE COUNT JSB OUTPA SEND WORD JSB CEXT2 WAIT FOR REPLY * * HERE FOR READY TO SEND MODE IN REGISTER LDA #SBIT GET #SBIT ADDRESS SZA,RSS IS IT ZERO? JMP SBIT,I YES - JUST EXIT LDA STAT IT'S OK - RETRIEVE THE REGISTER JSB #SBIT,I CALL #SBIT ROUTINE IN #RSAX CPA MN4 WAS A MINUS 4 RETURNED? JMP SBIT,I YES - ENTRY IS GONE - RETURN SZA,RSS WAS A ZERO RETURNED? JMP SBIT,I YES - NORMAL RETURN LDA EQT12,I PICK UP EQT12 IOR BIT6 STUFF IN SYSTEM FAILURE BIT STA EQT12,I AND SAVE IT AWAY IFZ HLT 65B XIF JMP SBIT,I * SPC 2 CGRN NOP LDA EQTX1,I LDB $CGRN SZB JSB $CGRN,I JMP CGRN,I SKP * * SEND REQUEST COMING WITH 500 MSEC WAIT * SRC NOP LDA MD50 STA EQT15,I 500 MSEC TIMEOUT ISZ EQT12,I BUMP RETRY COUNT LDA EQT12,I NOW TEST IT RAR,RAR GIVE IT 3 TRIES SLA JMP LNRC2 FAILED 3 TIMES, GIVE TIMEOUT LDA RC JSB OUTPA SEND ANOTHER RC JMP SRC,I RETURN * MD50 DEC -50 * HERE FOR TIME OUT * LNRC2 LDB BIT3 JMP LNRC4 * * CHECK FOR TNW, TREAT AS PARITY IF NOT * TNWCK NOP CPA TNW JMP TNWCK,I RETURN ONLY IF A TNW * * HERE FOR PARITY ERROR * LNRC3 LDA BIT3 PARITY ERROR IOR EQT12,I SET BIT 3 IN EQT WORD 12 STA EQT12,I AND PUT IT BACK CLB SET EQT5 STATUS TO ALL ZEROS * * HERE TO SET ERROR,SEND STOP, AND TERMINATE * LNRC4 JSB SSTOP SEND STOP JSB STAT PUT STATUS INTO EQT 5 JSB CEXTT AND EXIT IN XMIT MODE JSB RDD.C CLEAR CARD BY READING IT JMP CEND+1 TERMINATE * * HERE IF STOP WAS RECEIVED * LNRC5 LDB BIT4 GET STATUS...STOP JMP CEND SKP * ROUTINE TO DO CHECKING OF INPUT DATA * WILL RETURN *+1 TIME OUT * *+2 PARITY ERROR * *+3 STOP RECEIVED * *+4 NORMAL RETURN...A REG CONTAINS DATA WORD * CHECK NOP JSB TIMCK GO CHECK FOR TIMEOUT JMP CHECK,I YES...DO TIME OUT RETURN ISZ CHECK GET PARITY ERROR RETURN * * CHECK FOR PARITY OR MISSED TRANSMISSION JSB RDD.D READ DATA AND STATUS FROM CARD STA TEMP2 SAVE DATA RBR,SLB SEE IF MISSED TRANSMISSION RSS YES...TELL OTHER SIDE TO DO IT AGAIN JMP RDD1 NO...ALL OK JSB SRLW RE-TRANSMIT LAST WORD LIA1 LIA 0 CLEAR CARD FOR NEXT ENTRY LDA TEMP2 GET DATA WORD AGAIN RDD1 RBL,CLE GET TO CORRECT POSITION CPB B7 IF ALL LOWER 3 BITS SET...PARITY ERROR CCE SET FOR PARITY ERROR RBL,ERB SET IN ERROR BIT SSB,RSS PARITY ERROR? JMP CHCK1 NO SZA BROKEN LINE? JMP CHECK,I NO...PARITY ERROR RETURN CHCK2 STA EQT12,I CLEAR LISTEN MODE...TURN OFF CARD LDB BIT7 SET FOR BROKEN LINE JMP CEND YES...TERMINATE CHCK1 ISZ CHECK SET FOR STOP INTERRUPT CPA STOP STOP? JMP CHECK,I YES...DO STOP RETURN ISZ CHECK JMP CHECK,I DO NONE OF THE ABOVE RETURN * * TIME OUT CHECK ROUTINE * RETURN *+1 TIME OUT OCCURED * *+2 NO TIME OUT * TIMCK NOP LDA EQT4,I GET TIME OUT WORD AND NBT11 CLEAR OFF BIT 11 CPA EQT4,I WAS IT ALREADY CLEAR? ISZ TIMCK YES STA EQT4,I SAVE WORD JMP TIMCK,I AND RETURN * BIT7 OCT 20.0 BIT4 OCT 20 MSK12 OCT 2420 B17 OCT 17 PMSK OCT 177760 BIT11 OCT 4000 NBT11 OCT 173777 TEMP2 NOP * * ROUTINE TO READ CARD DATA AND STATUS * RDD.D NOP LIA2 LIA 0 READ DATA WORD LIBC1 LIB 0,C READ STATUS WORD JMP RDD.D,I RETURN * * ROUTINE TO CLEAR CARD * RDD.C NOP CLCC2 CLC 0,C JSB RDD.D JMP RDD.C,I * * ROUTINE TO OUTPUT A WORD TO THE I/O CARD * OUTPA NOP OTA1 OTA 0 OUTPUT A JMP OUTPA,I RETURN * * ROUTINE TO PUT DIRECT CO-ROUTINE ADDRESS IN EQT 11 * ICHAS NOP RSS LDB B,I RBL,CLE,SLB,ERB JMP *-2 STB EQT11,I JMP ICHAS,I * * ROUTINE TO SET UP DMA * ASSUMES LENGTH IN EQT 8, ADDRESS IN EQT 7, * DIRECTION SIGN BIT EQT 12 * GTDMA NOP LDA BIT11 XOR CHAN CONVERT TO A STC 6,C COMMAND STA STCD2 SET FOR ACTIVATE DMA XOR B5004 CHANGE TO CLC 2 OR 3 STA CLCD1 XOR BIT11 CONVERT TO STC 0 COMMAND STA STCD1 XOR BIT6 CHANGE TO OTA 2 OR 3 STA OTAD2 STA OTAD3 XOR B4 CHANGE TO OTA 6 OR 7 STA OTAD1 * LDB EQT12,I GET STATUS CCE,SSB WRITE REQUEST? CLE YES. LDA EQT4,I FETCH SELECT CODE AND B77 SEZ,RSS OUTPUT? IOR BIT13 YES. ADD CLC ENABLE BIT OTAD1 OTA 0 OUTPUT CONTROL WORD 1 CLCD1 CLC 0 LDA EQT7,I FETCH DATA BUFFER ADDRESS ELA,RAR ADD INPUT/OUTPUT BIT OTAD2 OTA 0 OUTPUT CONTROL WORD 2 STCD1 STC 0 LDA EQT8,I FETCH DATA BUFFER LENGTH CMA,INA COMPLEMENT OTAD3 OTA 0 OUTPUT CONTROL WORD 3 CLF 0 DISABLE INTERRUPT SYSTEM STCD2 STC 0,C ACTIVATE DMA LDA DUMMY PRIVILEGED INTERRUPT SZA,RSS PRESENT? JMP GTDMA,I NO. RETURN CCE SET DMA CHANNEL ACTIVE FOR PRIV. DRIVERS JSB PRIV YES. |STF 0 ENABLE INTERRUPT SYSTEM JMP GTDMA,I RETURN * * SUBROUTINE TO TELL PRIVILEGED DRIVERS THAT I NEED DMA * PRIV NOP CHAN CLC 0,C THIS INSTRUCTION SET BY SETIO LDB CHAN LOAD B REG FOR CHANNEL NUMBER CHECK LDA INTBA DEPENDING UPON STATUS OR SLB E REG INA SET OR CLEAR LDB A,I DMA ACTIVE FLA ELB,RBR STB A,I JMP PRIV,I RETURN * BIT13 OCT 20000 B5004 OCT 5004 * * SUBROUTINE TO CONFIGURE I/O INSTRUCTIONS * SETIO NOP LDA EQT13,I GET ADDRESS OF EQT EXTENSION STA EQTX1 & SET-UP EXTENSION POINTERS INA STA EQTX2 INA STA EQTX3 INA STA EQTX4 INA STA EQTX5 INA STA EQTX6 INA STA EQTX7 LDA EQT4,I AND B77 ISOLATE SELECT CODE STA SCODE AND SAVE IT IOR CLCC CLC0,C COMMAND STA CLCC2 STA CLCC3 XOR BIT11 CONVERT TO STC 0,C COMMAND STA LSN.1 STA IEXIT STA CEXIT STA STCC1 XOR BIT9 CONVERT TO STC 0 COMMAND STA CEXT1 STA STRQ1 XOR BIT7 CONVERT TO LIA COMMAND STA LIA1 STA LIA2 XOR B5000 CONVERT TO LIB 0,C COMMAND STA LIBC1 XOR B5300 CONVERT TO OTA 0 COMMAND STA OTA1 LDB DCLCC GET CLC 6,C COMMAND LDA INTBA,I GET EQT1 ADDRESS RAL,CLE,ERA CLEAR SIGN BIT CPA EQT1 CHANNEL 6 OR 7 DMA ADB M1 CHANNEL 6 STB CHAN SAVE CONFIGURED ADDRESS JMP SETIO,I RETURN * * B5000 OCT 5000 B5300 OCT 5300 B4100 OCT 4100 B7 OCT 7 STOP OCT 7760 SEND STOP RLW OCT 7417 RETRANSMIT LAST WORD BIT6 OCT 100 SCODE NOP * EQTX1 NOP EQTX2 NOP EQTX3 NOP EQTX5 NOP EQTX6 NOP * #SBIT NOP SPECIAL STORAGE AREA - DO NOT REORDER! $CGRN NOP PRIMY NOP IFZ BSS 200 qNLHPATCH AREA FOR DEBUG *********** XIF * A EQU 0 B EQU 1 * BSS 0 SEE HOW BIG IT IS SKP * * DEFINE BASE PAGE LOCATIONS NEEDED * * * . EQU 1650B EQT1 EQU .+8 EQT4 EQU .+11 EQT5 EQU .+12 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 INTBA EQU 1654B DUMMY EQU 1737B END 'N : 91700-18101 1614 S 0122 DS1/B CCE MODULE: PLOS              H0101 OASMB,R,L,C HED PLOS 91700-16101 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM PLOS,2,30 91700-16101 REV A 760329 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************** * *PLOS PROGRAM LOAD SAVE FOR BASIC * *SOURCE PART # 91700-18101 REV A * *REL PART # 91700-16101 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 12-17-74 * *MODIFIED BY JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: DECEMBER 1975 * *************************************************** SPC 1 SUP SPC 2 * * PROGRAM TO DO LOADS AND SAVE ON UP TO * MAXN TERMINALS. WHERE MAXN IS THE NUMBER OF TERMINALS * WHICH CAN OPERATE AT ANY ONE TIME * REMEMBER EACH TERMINAL TAKE 145 WORDS!!! * CENTRAL PROGRAM WHEN SCHEDULED MUST BE * PASSED THE CLASS NUMBER * SPC 2 * DEFINE ENTRY POINTS SPC 2 * DEFINE EXTERNALS SPC 1 EXT EXEC,READF,POSNT,CLOSE,WRITF EXT OPEN,CREAT,D65SV EXT D65CL SPC 2 * DEFINE A AND B REG SPC 1 A EQU 0 B EQU 1 SKP * * PROGRAM STARTS HERE * PLOS LDA B,I GET CLASS NUMBER STA CLSNM SAVE CLASS NUMBER JMP PLOSS AND WAIT FOR FIRST USER * * WE SHOULD ONLY GO THROUGH THE ABOVE ONCE * SPC 1 PLOS0 BSS 0 HERE ON ALL OTHER CALLS PLOSS JSB EXEC DO A GET CALL...WAIT FOR SOMETHING DEF *+5 DEF D21 CODE FOR A GET CALL DEF CLSNM CLASS # DEF RBUF REQUEST BUFFER DEF D35  REQUEST BUFFER LENGTH * LDA RLU GET COMM. LU AND MSK1 KEEP ONLY LOW 6 BITS STA RLU * * * WHEN WE GET HERE SOMEONE WANTS SOMETHING * LDA DCBN GET DCB NUMBER..IF ZERO SZA IT IS A NEW REQUEST JMP PLOS1 NOT A NEW REQUEST LDA CALOC NEW REQUEST...SEE IF WE CAN HANDLE IT ADA MMAXS LDB M3 SET ERROR TO -3 ...CAN'T HANDLE IT SSA,RSS HANDLE REQUEST? JMP TERM NO...TELL THEM TRY LATER LDB M4 GET ERROR CODE IF LENGTH ERROR LDA BLEN GET LENGTH WORD ADA MBUFS SEE IF LARGER THAN BUFFER SSA,RSS JMP TERM YES...ERROR LDA LSFG GET LOAD-SAVE FLAG SSA LOAD OR SAVE LOAD=0,SAVE=1 JMP PSAV1 SAVE PSAV3 JSB OPN GO OPEN FILE JMP PLOS1 OK ON OPEN...TREAT AS STANDARD PSAV2 LDB M2 SET FOR NOT THERE JMP TERM AND TERMINATE * * HERE FOR SAVE * PSAV1 JSB OPN CHECK FOR TYPE 0 FILE RSS POSSIBLE JMP PSAV4 TRY TO CREATE IT LDA DCBN SEE IF TYPE 0 ADA D2 LDA A,I SZA TYPE ZERO? PSAV4 JSB CRET NO...TRY TO CREATE IT JMP PLOS1 OK..GO TO IT JSB DALOC CLOSE FILE IF OPEN JMP PSAV2 TERMINATE * * AT THIS POINT THE DCB IS DEFINED * THE FILE IS OPENED AND WE ARE READ TO DO * OUR THING. * PLOS1 LDA LSFG LOAD OR SAVE? SSA JMP PLOS2 SAVE JSB LBUF LOAD THE BUFFER FROM THE DISC STB STAT SAVE THE FILE STATUS JSB WREC SEND THE DATA ACROSS THE LINE JSB WRPLY SEND STATUS REPLY JMP PLOS0 AND TERMINATE AND WAIT SPC 1 PLOS2 JSB RREC READ THE DATA FOR SAVE CLB TELL THEM ALL WENT WELL STB STAT SAVE IT IN THE STATUS WORD JSB SBUF SAVE BUFFER IN FILE JSB WRPLY SEND REPLY JMP PL\OS0 GO WAIT FOR MORE SKP * * SUBROUTINE TO READ RECORDS FROM A FILE UNTIL * BUFFER IS FULL. * CALLING SEQUENCE * JSB LBUF * UPON RETURN...B REG= STATUS * STATUS= -1=EOF,O=BUFFER FULL * LBUF NOP LDA DBUFA GET DATA BUFFER ADDRESS STA TEMP1 SAVE AS CURRENT DATA ADDRESS INA GET TO FIRST DATA WORD STA LBUF1 SAVE FOR FILE WRITE COMMAND LDA BLEN GET MAX BUFFER SIZE ADA M1 MAKE SURE DON'T OVERWRITE BUFFER STA TEMP2 SAVE CURRENT BUFFER SIZE LBUFA JSB READF GO READ A RECORD DEF *+6 DEF DCBN,I DCB ADDRESS GOES HERE DEF FERR FILE STATUS AFTER READ LBUF1 NOP BUFFER ADDRESS GOES HERE DEF TEMP2 CURRENT MAX BUFFER LENGTH DEF TEMP3 ACTUAL SIZE OF RECORD LDA FERR GET FILE STATUS LDB TEMP3 GET LENGTH SSA,RSS EOF? JMP LBUFF NO CCB YES...SET TO -1 JMP LBUFG AND TERMINATE LBUFF CPB TEMP2 ACTUAL=REQUESTED LENGTH? CLB,RSS YES...SET THAT WE LOST SOMETHING SZB IF LENGTH NOT MATCH, IS IT A ZERO LN REC.? RSS NO...CONTINUE PROCESSING JMP LBUFA YES, ZERO LENGTH RECORD...IGNORE IT LBUFG STB TEMP1,I SET STATUS IN BUFFER SZB EOF OR BUFFER FULL? CPB M1 ? JMP LBUFB YES...EITHER BACKSPACE OR TERMINATE JSB LIMCK CHECK IF IN LIMITS JMP LBUFA NOT IN LIMITS...IGNORE LDB TEMP3 GET RECORD LENGTH AGAIN ADB LBUF1 GET ADDRESS OF NEXT RECORD TO READ STB TEMP1 SAVE ADDRESS INB GET TO FIRST DATA WORD STB LBUF1 SAVE AS CURRENT BUFFER ADDESS LDB TEMP3 GET LENGTH OF LAST READ CMB NEGATE AND SUBTRACT 1 (INCLUDE COUNT WORD) ADB TEMP2 SAVE AS NEW LENGTH STB TEMP2 SAVE NEW LENGTH SSB,RSS SHOULD NEVER GO NEGATIVE يJMP LBUFA BUT MAKE SURE ANYWAY * * AT THIS POINT THE BUFFER IS FULL OR AN * EOF HAS BEEN HIT...IN ANY CASE DON'T READ * ANY MORE NOW * LBUFB SZB EOF? JMP LBUFC YES...CLOSE FILE JSB POSNT NO...BACKSPACE ONE RECORD DEF *+4 DEF DCBN,I DEF FERR DEF M1 CLB SET THE B REG...BUFFER FULL JMP LBUF,I RETURN * * EOF HIT...CLOSE FILE * LBUFC JSB DALOC DEALOCATE THE DCB CCB SET B=-1...EOF JMP LBUF,I RETURN SKP * * SUBROUTINE TO MOVE BUFFER TO FILE * CALLING SEQUENCE * JSB SBUF * SBUF NOP LDA DBUFA GET DATA BUFFER ADDRESS STA TEMP1 SAVE BUFFER ADDRESS SBUFA LDA TEMP1,I GET LENGTH OF RECORD SZA,RSS DONE? JMP SBUF,I YES...RETURN INA,SZA,RSS EOF? JMP SBUFB YES...CLOSE FILE STA TEMP2 SAVE LENGTH FOR WRITE LDB C4040 GET TWO SPACES STB TEMP1,I MOVE SPACES INTO LENGTH WORD JSB WRITF WRITE THE RECORD DEF *+5 DEF DCBN,I DEF FERR ERROR STATUS DEF TEMP1,I BUFFER ADDRESS DEF TEMP2 LENGTH OF WRITE GOES HERE LDA TEMP2 GET LENGTH OF LAST WRITE ADA TEMP1 GET ADDRESS OF NEXT WRITE STA TEMP1 SAVE FOR NEXT WRITE JMP SBUFA CONTINUE WRITING ON FILE * * HERE WHEN EOF REACHED * SBUFB JSB DALOC DEALOCATE THE DCB JMP SBUF,I RETURN SKP * * SUBROUTINE TO ALOCATE DCB AND OPEN A FILE * CALLING SEQUENCE * JSB OPN * NORMAL RETURN * ERROR RETURN * OPN NOP JSB ALOC GO GET A DCB ADDRESS LDA DCBN GET DCB ADDRESS STA OPEN1 SAVE DCB ADDRESS JSB OPEN GO TRY TO OPEN FILE DEF *+7 OPEN1 NOP DCB ADDRESS HERE DEF FERR DEF PNAM NAME OF FILE DEF D0 DEF SC DEF LU LDA FERR ANY ERRORS? mSSA,RSS JMP OPN,I NO...RETURN JSB DALOC YES...DEALOCATE THE DCB ISZ OPN SET FOR ERROR RETURN JMP OPN,I ERROR RETURN SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB CRET * NORMAL RETURN * ERROR RETURN * CRET NOP JSB ALOC GO GET A DCB LDA DCBN GET THE DCB ADDRESS STA CRET1 SAVE DCB ADDRESS LDA TYPE GET TYPE WORD SZA,RSS IS IT ZERO? LDA D9 YES...DEFAULT TO TYPE 9 STA TYPE SAVE TYPE WORD LDA SIZE GET SIZE WORD SZA,RSS IS IT ZERO? LDA D40 YES...DEFAULT TO 40 RECORDS STA SIZE SAVE SIZE WORD JSB CREAT CREATE THE FILE DEF *+8 CRET1 NOP DEF FERR DEF PNAM NAME TO BE USED DEF SIZE DEF TYPE TYPE IS DEFINED AS TYPE 9 DEF SC SECURITY CODE DEF LU LDA FERR GET FILE STATUS SSA,RSS ANY ERRORS? JMP CRET,I NO...RETURN JSB DALOC DEALOCTE DCB ISZ CRET SET FOR ERROR RETURN JMP CRET,I RETURN...ERROR SKP * * SUBROUTINE TO ALOCATE A DCB * CALLING SEQUENCE * JSB ALOC * ALOC NOP * * BEFORE WE ALOCATE A DCB, CHECK IF ONE IS * ALREADY ALOCATED * LDA SATA GET ADDRESS OF ACTIVE SATELITE TABLE STA TEMP1 SAVE IN UP COUNTER LDA MMAXS GET MAX # OF ENTRIES INA STA TEMP2 SAVE IN DOWN COUNTER CLA SET UP FOR TABLE DISPLACEMENT STA TEMP3 LDA RLU GET REMOTE LU # ALOC4 CPA TEMP1,I IS THERE A MATCH JMP ALOC5 YES...DCB ALOCATED FOR TERMINAL ALREADY ISZ TEMP1 NO...GET NEXT ENTRY ISZ TEMP3 ISZ TEMP2 DONE? JMP ALOC4 NO...CONTINUE * * TERMINAL DOESN'T ALREADY HAVE A DCB...TRY TO FIND ONE * LDA DCBBA GET ADDRESS OF DCB AVAILABLE TABLE STA TEIMP1 SAVE IN TEMP LOCATION LDA MMAXS GET MAX # OF ENTRIES STA TEMP2 SAVE IN DOWN COUNTER CLA GET A ZERO STA TEMP3 SAVE AS MULT. FACTOR ALOC1 ISZ TEMP2 DONE? JMP ALOC3 NO...CONTINUE LDB M3 YES...NO ROOM JMP TERM TELL OTHER SIDE TO TRY LATER ALOC3 LDA TEMP1,I GET CONTENTS OF TABLE SZA,RSS IS THERE SOMETHING THERE? JMP ALOC2 NO...GOOD FOUND A HOME!!! ISZ TEMP1 GET NEXT ADDRESS ISZ TEMP3 INCREMENT MULT COUNT JMP ALOC1 CONTINUE * * HERE IF WE HAVE ROOM * ALOC2 LDA TEMP3 GET MULT FACTOR MPY D144 GET DISPLACEMENT FROM FIRST ADA DCBA ADDRESS OF AVAILABLE DCB STA TEMP1,I SAVE IN TABLE TO HOLD A PLACE STA DCBN SAVE IN PARMB ISZ CALOC INCREMENT # OF ACTIVE TERMINALS LDA TEMP3 GET DISPLACEMENT ADA SATA ADD FOR SATELLITE TABLE ENTRY LDB RLU GET REMOTE LU STB A,I SAVE PLACE IN TABLE JMP ALOC,I RETURN SPC 3 * * TERMINAL ALREADY HAS A DCB...CLOSE IT AND REUSE IT * ALOC5 LDA TEMP3 GET DISPLACEMENT ADA DCBBA GET TO DCB ADDRESS LDA A,I GET DCB ADDRESS STA DCBN SAVE DCB ADDRESS IN PARMB STA CLSAL SAVE FOR CLOSE JSB CLOSE CLOSE CURRENTLY OPEN DCB DEF *+3 CLSAL NOP DEF FERR JMP ALOC,I DCB IS NOW ALOCATED SKP * * SUBROUTINE TO DALOCATE A DCB * CALLING SEQUENCE * JSB DALOC * DALOC NOP LDA DCBBA GET ADDRES OF DCB ACTIVE TABLE STA TEMP1 SAVE IN TEMP LOCATION LDA MMAXS GET MAX # OF ENTRIES STA TEMP2 SAVE IN TEMP LOCATION LDA SATA GET ADDRESS OF SATELLITE OPEN TABLE STA TEMP3 DALC1 ISZ TEMP2 GONE THRU TABLE? JMP DALC2 NO....GOOD LDB M4 WE IN BIG TROUBLE...SHOULD NEVER GET HERE JMP TERM UNKNOWN DCRB DALC2 LDA TEMP1,I GET ADDRESS IN TABLE CPA DCBN THE SAME? JMP DALC3 YES...DEALOCATE IT ISZ TEMP3 GET TO NEXT SATELLITE ENTRY ISZ TEMP1 GET NEXT BUFFER ADDRESS JMP DALC1 GO TRY AGAIN * * HERE FOR MATCH CONDITION * DALC3 JSB CLOSE CLOSE FILE...IF OPEN DEF *+3 DEF DCBN,I DCB ADDRESS DEF DCBN IGNORE ERROR CLA GET A ZERO STA TEMP1,I CLEAR OUT TABLE LOCATION STA TEMP3,I CLEAR OUT SATELLITE ENTRY STA DCBN CLEAR OUT DCB POINTER LDA CALOC GET CURRENT # OF ACTIVE TERMINALS ADA M1 DECREASE IT BY 1 STA CALOC SAVE AS CURRENT # OF ACTIVE JMP DALOC,I RETURN SKP * * SUBROUTINE TO SEND DATA TO TERMINAL * CALLING SEQUENCE * JSB WREC * WREC NOP * LDA RLU IOR MSK2 DATA ONLY STA IMODE * JSB D65CL SEND DATA CALL DEF *+7 DEF IRWW WRITE DEF IMODE DEF DBUF DEF BLEN DEF RBUF+33 PASS TIME-TAGS DEF RBUF+34 * JMP BAD ERROR RETURN JMP WREC,I RETURN SPC 4 * * ROUTINE TO READ DATA FROM A TERMINAL * CALLING SEQUENCE * JSB RREC * RREC NOP * LDA RLU IOR MSK2 STA IMODE * JSB D65CL READ DATA DEF *+7 DEF IRWR DEF IMODE DEF DBUF DEF BLEN LENGTH DEF RBUF+33 PASS TIME-TAGS DEF RBUF+34 * JMP BAD ERROR RETURN JMP RREC,I RETURN SPC 3 BAD JSB CMER JMP PLOS0 SKP * * SUBROUTINE TO DO LIMIT CHECKING * CALLING SEQUENCE * JSB LIMCK * OUT OF RANGE RETURN * IN RANGE RETURN * B REG=BUFFER LENGTH ON ENTRY * LIMCK NOP LDA LBUF1 GET STARTING BUFFER ADDRESS CLE,ELA CONVERT TO BYTE ADDRESS STA LMCKA SAVE AS STARTING BYTE ADDRESS CLE,ELB COg.NVERT LENGTH TO BYTE LENGTH CMB,INB NEGATE LENGTH STB LMCKC SAVE IN DOWN COUNTER LDA ULIM GET UPPER LIMIT SZA,RSS ANY LIMITS? JMP INRNG NO...ALL LINES IN RANGE CLA GET A ZERO STA LMCKB CLEAR BINARY SUM...LINE # LMCK1 LDB LMCKA GET BYTE ADDRESS ISZ LMCKA GET NEXT BYTE ADDRESS ISZ LMCKC OUT OF BUFFER? RSS NO JMP LIMCK,I YES...TREAT AS OUT OF RANGE JSB ABYTE GET A CHARACTER CPA C40 IS IT A SPACE? JMP LMCK1 YES...IGNORE SPACES STA B MOVE CHAR TO B REG ADB MC60 ADD TO -60B ADA MC72 ADD TO -72B SSA OUT OF RANGE? SSB TO LOW? JMP CKRNG LAST NUMERIC...CHECK RANGE LDA LMCKB GET PARTICAL SUM STB LMCKB SAVE CURRENT VALUE MPY D10 MOVE OVER A PLACE FOR NEXT CHAR ADA LMCKB ADD IN CURRENT NUMBER STA LMCKB SAVE AS PARTICAL JMP LMCK1 GET NEXT CHAR SPC 2 * AT THIS POINT WE HAVE BINARY LINE NUMBER SPC 1 SPC 1 CKRNG LDA LMCKB GET LINE NUMBER CMA,INA CONVERT TO NEGATIVE VALUE STA B GET IT IN B REG ADA M1 ADD 1 FOR CHECKING LOWER LIMIT ADA LLIM ADD IN LOWER LIMIT...+..OUT OF RANGE ADB ULIM ADD IN UPLIM...-..OUT OF RANGE SSA SSB JMP LIMCK,I OUT OF RANGE INRNG ISZ LIMCK IN RANGE...IN RANGE RETURN JMP LIMCK,I SPC 2 LMCKA NOP LMCKB NOP LMCKC NOP * * SUBROUTINE TO SEND A REPLY TO THE TERMINAL * CALLING SEQUENCE * JSB WRPLY * B REG= STATUS * WRPLY NOP LDA RBUF SET IN REPLY BIT IOR BIT14 STA RBUF LDB D35 GET FRIENDLY REPLY SIZE(35WDS) ALF POSITION FRIENDLY BIT(#11) TO SIGN. SSA,RSS IF REPLY GOING TO AN ALIEN SATELLITE, LDB D21 MAX. RBEPLY LENGTH IS 21 WORDS. STB RBUFL CONFIGURE THE REPLY LENGTH. JSB D65SV SEND REPLY DEF *+7 DEF IRWW DEF RLU REQ ONLY DEF RBUF DEF RBUFL LENGTH DEF DUMMY DEF DUMMY JSB CMER ERROR RETURN * JMP WRPLY,I RETURN SPC 4 * * HERE TO TERMINATE ON AN ERROR CONDITION * B REG=STATUS * TERM STB STAT SAVE STATUS JSB D65CL TELL OTHER SIDE, NO DATA DEF *+7 DEF ICR SEND STOP DEF RLU DEF DUMMY DEF DUMMY DEF DUMMY DEF DUMMY * JSB CMER ERROR RETURN JSB WRPLY SEND REPLY...REASON FOR STOP JMP PLOS0 WAIT FOR SOMEONE ELSE SPC 3 * * SUBROUTINE TO GET A CHARACTER * CALLING SEQUENCE * JSB ABYTE * B REG= BYTE ADDRESS....UPON RETURN A REG=CHAR * ABYTE NOP CLE,ERB CONVERT TO WORD ADDRESS LDA B,I GET CHARACTER SEZ,RSS UPPER HALF? ALF,ALF YES AND B377 MASK OFF UPPER HALF ELB,CLE GET BYTE ADDRESS AGAIN JMP ABYTE,I RETURN SPC 3 CMER NOP DST ERVAL JSB EXEC DEF *+5 DEF D2 DEF D1 DEF ERMS DEF ERML * JMP CMER,I SPC 3 ERMS ASC 9,PLOS : COMM. ERROR ERVAL BSS 2 ERML DEC 11 SKP * * TEMP VALUES,CONSTANTS,BUFFERS, WHAT EVER * MAXN EQU 2 MAX # OF OPEN TERMINALS BUFS EQU 512 SIZE OF DATA BUFFER SPC 1 CLSNM NOP CLASS NUMBER B377 OCT 377 BIT14 OCT 40000 D21 DEC 21 D1 DEC 1 D2 DEC 2 D9 DEC 9 D10 DEC 10 D35 DEC 35 D40 DEC 40 D144 DEC 144 MC60 OCT -60 MC72 OCT -72 C40 OCT 40 C4040 ASC 1, M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 MMAXS ABS 0-MAXN-1 MAX # OF TERMINALS + 1 MBUFS ABS 0-BUFS-1 DATA BUFFER SIZE CALOC OCT 0 CURRENT # OF ACTIVE DCB'S TEMP1 NOP TEMP2 NOP TEMP3 NOP <:6 D0 OCT 0 DBUFA DEF DBUF RBUFL NOP REPLY LENGTH: 35WD-FRIEND/21WD-ALIEN. DCBBA DEF DCCB DCBA DEF DCBF SATA DEF SAT IRWW OCT 100002 IRWR OCT 100001 DUMMY OCT 0 MSK1 OCT 77 MSK2 OCT 300 ICR OCT 100003 IMODE NOP SPC 2 * * HERE WE DEFINE THE PRMB * RBUF NOP STREAM ID DCBN NOP DCB ADDRESS LSFG NOP LOAD-SAVE FLAG,OVERIDE FLAG FERR NOP FILE MANAGER STATUS STAT NOP STATUS PNAM NOP PROGRAM NAME BSS 2 SC NOP SECURITY CODE LU NOP LOGICAL UNIT TYPE NOP FILE TYPE SIZE NOP FILE SIZE BLEN NOP BUFFER LENGTH LLIM NOP LOWER LIMIT ULIM NOP UPPER LIMIT BSS 9 NOT USED RLU NOP REMOTE LU BSS 10 SPC 2 * * DEFINE SATELLITE OPEN TABLE * SAT REP MAXN NOP SPC 2 * DEFINE DCB TABLE DCCB BSS 0 REP MAXN NOP SPC 2 * DEFINE DCB AREA DCBF BSS 0 REP MAXN BSS 144 SPC 2 * DEFINE DATA BUFFER DBUF BSS 512 END EQU * END PLOS R< * 91700-18102 1633 S 0222 DS1/B CCE MODULE REMAT             H0102 6ASMB,R,L,C HED REMAT 91700-16102 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM REMAT,3,80 91700-16102 REV.A 760812 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************ * *REMAT OPERATOR INTERFACE PROGRAM FOR DS-1 * *SOURCE PART # 91700-18102 REV A * *REL PART # 91700-16102 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 12-27-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: OCT.11, 1975 * ************************************************** * * RTE PROGRAM TO PROVIDE OPERATOR ACCESS * TO THE CENTRAL STATION FOR VARIOUS CONTROL FUNCTIONS. * TO THE SATELLITE STATION FOR VARIOUS CONTROL FUNCTIONS. * * SUP ENT REMAT * EXT EXEC EXT OPEN,READF,CLOSE,POSNT EXT CREAT,WRITF EXT RNRQ,PURGE EXT DEXEC,$LIBR,$LIBX EXT $PARS,DMESS,$CVT3 EXT DMESG,REIO,RMPAR EXT #ST04,D65MS,CNUMD,.DFER IFN EXT DBUG XIF * A EQU 0 B EQU 1 * * INITIALIZE TRANSFER STACK. * REMAT JSB RMPAR GET PRAMS DEF *+2 DEF P1 SAVE IN TEMP AREA LDB *-1 GET ADDRESS OF TEMP AREA STB TEMP SAVE ADDR OF SCHEDULE PARAMS. SPC 1 IFN DEBUG OPTION LDA B,I GET PRAM CPA D55 DO THEY WANT DEBUG? RSS YES JMP REMC1 NO JSB DBUG DEF *+1 JSB EXEC DEF *+4 DEF B6 DEF B0 DEF B1 JMP REMAT AND TRY AGAIN XIF SPC 1 REMC1 JSB EXEC SET SWAP ONLY WHAT IS NEEDED DEF *+3 DEF D22 DEF B2 LDA STKHD RESET STACK POINTER. STA P.STK CLA,INA SET FIRST STACK ENTRY STA P.STK,I FOR LOGICAL UNIT 1 (DEFAULT). * LDA TEMP,I CHECK IF P1 = ASCII PARAM. AND HB377 SZA,RSS JMP STR NO. MUST BE INPUT LU. * * FETCH SCHEDULE PARAMETERS (FL,NA,ME,SEVERITY,LIST). * DLD P1+1 FILL BLANKS AFTER THE FILE NAME SZA,RSS IF THE NAME IS SHORTER THAN 3 WORDS LDA DBBLK SZB,RSS LDB DBBLK DST P1+1 REPLACE LDA A.$TR GENERATE "$TR,FLNAME" IN BUFFER. STA INBUF LDA A.TR1 STA INBUF+1 LDA TEMP,I STA INBUF+2 ISZ TEMP LDA TEMP,I STA INBUF+3 ISZ TEMP LDA TEMP,I STA INBUF+4 ISZ TEMP * LDA B5 SET COUNT. STA INCNT * LDA TEMP,I SET UP DUMMY SCHEDULE PARAMS. STA ALTBK+3 SEVERITY CODE. ISZ TEMP LDA TEMP,I STA ALTBK+2 LIST LU. * LDA DFALT POINT TO DUMMY PARAMS. STA TEMP * STR STA TRFLG SET/CLEAR FLAG FOR QUERY SECTION. * * FETCH SCHEDULE PARAMETERS (LU,LOG,LIST,SEVERITY CODE). * LDA TEMP,I GET LU OF INPUT DEVICE. SZA,RSS JMP STAT IF NONE, USE DEFAULT. CPA B1 IGNORE IF = 1. JMP STAT * LDB P.STK PUT SPECIFIED LU INTO ADB B4 TRANSFER STACK. STB P.STK STA P.STK,I * STAT LDA P.STK,I JSB EQTYP CHECK EQ. TYPE OF INPUT LU. STA LUTYP * ISZ TEMP LDA TEMP,I GET LU OF LOG DEVICE. SZA JMP SVLOG * DEFLT LDB LUTYP CLA,INA EITHER LU 1 OR SZB,RSS LDA P.STK,I INPUT LU IF TTY DEVICE. SVLOG STA LOGLU * ISZ TEMP LDA TEMP,I GET LU OF LIST DEVICE, SZA,RSS LDA B6 OR USE DEFAULT =`C 6. STA LSTLU * ISZ TEMP LDA TEMP,I SAVE SEVERITY CODE. STA SEVER * LDA TRFLG IF SCHEDULED WITH FILE NAME, SZA ALREADY HAVE TR SIMULATED. JMP CHK$ * * DISPLAY PROMPT CHARACTER (IF TTY DEVICE). * CONTROL RETURNS HERE WHEN REQUEST PROCESSING COMPLETES. * QUERY LDA P.STK,I CHECK WHETHER CURRENT INPUT STA TEMP STA LUTYP IS FROM A TTY TYPE DEVICE. AND HB377 NON ZERO IF FILE NAME, ELSE LU. SZA JMP REMRD REMOTE FILE. * JSB LCALS SET FOR LOCAL ONLY LDA TEMP JSB EQTYP LOCAL LU: CHECK TYPE. STA LUTYP SZA JMP LOCRD LOCAL LU NOT TTY DEVICE. * JSB REIO DISPLAY PROMPT ON TTY DEVICE. DEF *+5 DEF IRWW DEF LOGLU DEF PROMP DEF B1 JMP ERPRN * LDA LOGLU SET ECHO BIT. IOR B400 STA TEMP * * INPUT OPERATOR REQUEST FROM CURRENT DEVICE OR FILE. * LOCRD JSB REIO LOCAL SATELLITE LU. DEF *+5 DEF IRWR DEF TEMP DEF INBUF DEF D40 JMP ERPRN * STA TEMP SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. JSB LCALS SET FOR LOCAL JSB EOFCK CHECK FOR END OF FILE. JMP TRANS GOT IT. JMP ECHO GO ECHO IF NECCESSARY. * REMRD JSB READF CENTRAL STATION FILE. DEF *+6 (OPENED WHEN FIRST TRANSFER DEF IDCB WAS PERFORMED) DEF IERR DEF INBUF DEF D40 DEF INCNT ACTUAL WORD COUNT. * JSB ERCHK CHECK FOR ERRORS. * LDA INCNT IF EOF, GENERATE TR REQUEST. INA,SZA JMP BUMP TRANS LDA A.$TR STA INBUF LDA A.$TR+1 STA INBUF+1 LDA B2 STA INCNT JMP ECHO * BUMP LDA P.STK ADA B3 ISZ A,I BUMP RECORD COUNT. * * ECHO THE REQUEST IF NOT INPUT FROM TTY DEVICE. * ECHO LDA LUTYP SZA,RSܬS JMP CKCNT IT IS A TTY DEVICE. * LDA SEVER INHIBIT ECHO IF CPA B1 SEVERITY CODE = 1. JMP CHK$ * JSB REIO NOT TTY: ECHO. DEF *+5 DEF IRWW DEF LOGLU DEF INBUF DEF INCNT JMP ERPRN * CHK$ LDA INBUF FIRST CHARACTER MUST AND HB377 BE A "$". CPA AS.$ RSS JMP OPER * LDA INBUF BLANK OUT THE "$" SIGN. AND B377 IOR BLANK STA INBUF * CKCNT LDB INCNT IGNORE REQUEST IF NULL. RBL MAKE CHARACTER COUNT. SZB,RSS JMP QUERY * * PARSE THE OPERATOR REQUEST. * LDA BUFAD (A) = BUFAD, (B) = INCNT. JSB $LIBR TURN OFF INTERUPTS NOP JSB $PARS DEF PRAMS PARAMETER BUFFER ADDRESS. JSB $LIBX TURN THEM BACK ON DEF *+1 DEF *+1 * JMP M0000 CHECK IF PROCESSING NEEDED * * SEND CENTRAL RTE COMMANDS. * OTHER LDA INCNT CONVERT LENGTH TO BYTES RAL STA INCNT * * HERE FOR SENDING MESSAGES WILL EITHER SEND TO * CENTRAL OR SATILATE, DEPENDING UPON CONTENTS * OF A REG. 0, CENTRAL, NON ZERO TERMINAL * JSB DMESS SEND COMMAND. DEF *+4 DEF MODE DESINATION CODE DEF INBUF ASCII COMMAND. DEF INCNT COUNT (+POSITIVE BYTES) * SZA,RSS ANY RESPONSE MESSAGE? JMP QUERY NO CPB MD1 IF = -1, JMP DMERR THEN GO TO REPORT A ERROR. STA TEMP SAVE COUNT * JSB REIO DISPLAY REPLY MESSAGE. DEF *+5 DEF IRWW DEF LOGLU DEF INBUF DEF TEMP JMP ERPRN * JMP QUERY * * CHECK THE OPERATOR REQUEST CODE AGAINST THE LEGAL * REQUEST CODES AND JUMP TO THE PROPER PROCESSOR. * * TO ADD NEW REQUEST ONE MERELY: * A. ADDS ASCII OPERATION CODE TO TABLE "LDOPC". * B. ADDS PROCESSOR START ADDRESS TO TABLE %"LDJMP". * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. * M0000 LDB OP FETCH OPERATION CODE. STB OPP SET STOP FLAG. LDA LDOPC SET OPERATION TABLE POINTER. STA TEMP1 LDA LDJMP SET PROCESSOR JUMP ADDRESS. STA TEMP2 * M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE. JMP TEMP2,I COMPARES. GO DO IT. * ISZ TEMP1 KEEP LOOKING. ISZ TEMP2 JMP M0030 * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS. * ASC 1,DU ASC 1,EX ASC 1,ST ASC 1,SW ASC 1,TE ASC 1,TR ASC 1,LO ASC 1,PL ASC 1,RP ASC 1,BT ASC 1,SL ASC 1,SO OPP NOP OP CODE FOR CURRENT REQ. * LDJMP DEF *+1,I JMP ADDRESS FOR EACH OP CODE. DEF M0400 DU REQUEST. DEF M0500 EX REQUEST. DEF M0900 ST REQUEST. DEF M0990 SW REQUEST. DEF M1000 TE REQUEST. DEF M1200 TR REQUEST. DEF M1400 LO REQUEST DEF M1500 PL REQUEST DEF OPER RP TCE/5 REQUEST ILLEGAL DEF M1600 BT...BASIC TRAP REQUEST DEF M1700 SL...SLAVE LIST ROUTINE DEF M1800 SO...SLAVE OFF ROUTINE DEF OTHER NOT SPECIAL JUST SEND IT * OPER LDA D10 INPUT ERROR: 010 OPERS STA IERR JSB ERCHK WON'T RETURN. * DMERR DLD INBUF GET THE ASCII ERROR CODES, JMP ERPRN AND GO TO PRINT THE ERROR. * HED REMAT: DU PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * DU,FLNAME,LU,SECURITY,LABEL * * DUMP CENTRAL FILE ON SATELLITE LOGICAL INIT. * M0400 LDB CP1 ERROR IF NO FILE NAME. JSB ASCHK LDB CP2 ERROR IF NO LU. JSB INTCK * LDA P2 TEST FOR PT PUNCH. JSB EQTYP CPA B2 RSS JMP M0405 * LDA B1000 GENERATE LEADER. IOR P2 STA TEMP * JSB DEXEC DEF *+4 DEF SDILU DEF B3I oDEF TEMP * JMP ERPRN LINE ERROR * * OPEN THE CENTRAL FILE. * M0405 JSB OPEN OPEN THE FILE. DEF *+7 DEF UDCB DEF IERR DEF P1 FILE NAME. DEF B0 OPEN OPTIONS. DEF P3 SECURITY CODE. DEF P4 LABEL. * LDA IERR CHECK FOR ERRORS IF IERR NEG. SSA JSB ERCHK LDA OPNFL SET UDCB OPEN FLAG. ELA,CLE,ERA IOR HIBIT STA OPNFL * * READ A RECORD FROM CENTRAL FILE. * M0410 JSB READF READ. DEF *+6 DEF UDCB DEF IERR DEF INBUF DEF D128 DEF INCNT XMSN LOG. * JSB ERCHK CHECK FOR ERRORS. * LDA INCNT CHECK FOR EOF. INA SZA,RSS JMP M0420 GOT IT. GO PROCESS. * * * OUTPUT THE RECORD ON SATELLITE LOGICAL INIT. * JSB DEXEC DEF *+6 DEF SDILU DEF B2I DEF P2 LU. DEF INBUF DEF INCNT * JMP ERPRN LINE ERROR * JMP M0410 GO GET NEXT RECORD. * * PROCESS END OF FILE CONDITION. * M0420 LDA P2 GET LOGICAL UNIT. JSB EQTYP STA B EQUIPMENT TYPE. * LDA B100 SET DEFAULT TO M.T. DEVICE. CPB B2 XOR B1100 PUNCHED TAPE - TRAILER. CPB D10 IOR B1100 LINE PRINTER - PAGE EJECT. IOR P2 INSERT LOGICAL UNIT. STA TEMP * JSB DEXEC PERFORM I/O CONTROL. DEF *+5 DEF SDILU DEF B3I DEF TEMP FORMATTED CONTROL WORD. DEF MD1 USED ONLY FOR LP. * JMP ERPRN LINE ERROR * JMP M0950 GO CLOSE FILE. HED REMAT: EX PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * EX PROCESSOR * * TERMINATE THE OPERATOR INTERFACE PROGRAM. * M0500 JSB REIO DISPLAY TERMINATION MESSAGE DEF *+5 ON LOG DEVICE. DEF B2 DEF LOGLU DEF TRMSG DEF B6 * JSB CLSFL CLOSE ROPEN FILES. * JSB EXEC EXIT. DEF *+2 DEF B6 * TRMSG ASC 6, $END REMAT HED REMAT: ST PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * ST,LU,FLNAME,SECURITY,LABEL,TYPE,#BLOCKS,RECSIZE * * STORE FROM SATELLITE LU ONTO CENTRAL DISC FILE. * M0900 LDB CP2 ERROR IF NO FILE NAME. JSB ASCHK * LDA B3 DEFAULT FILE TYPE TO 3. LDB P5 SZB,RSS STA P5 * LDA D10 DEFAULT # BLOCKS TO 10. LDB P6 SZB,RSS STA P6 * LDB CP1 ERROR IF NO LU. JSB INTCK * * CREATE THE CENTRAL DISC FILE. * JSB CREAT CREATE FILE. DEF *+8 DEF UDCB DEF IERR DEF P2 FILE NAME. DEF P6 # BLOCKS. DEF P5 FILE TYPE. DEF P3 SECURITY CODE. DEF P4 LABEL. * LDA IERR CHECK FOR ERRORS IF IERR NEG. SSA JSB ERCHK LDA OPNFL SET UDCB OPEN FLAG. ELA,CLE,ERA IOR HIBIT STA OPNFL * * READ INPUT FROM SATELLITE LOGICAL UNIT. * LDA P1 DETERMINE DEVICE TYPE. JSB EQTYP STA LUTYP SAVE DEVICE TYPE. SZA IF TTY, JMP M0910 LDA P1 SET ECHO BIT. IOR B400 STA P1 * M0910 LDA LUTYP IF DEVICE IS A TTY, SZA DISPLAY INPUT PROMPT CHAR. JMP M0920 * JSB DEXEC IT IS. DISPLAY PROMPT, BECAUSE DEF *+6 OF PERCEPTIBLE DELAY BETWEEN DEF SDILU DEF B2I RECORDS. DEF B1 DEF IPRMP ASCII SLASH, SPACE. DEF MD3 * JMP ERPRN LINE ERROR * M0920 JSB DEXEC READ THE INPUT RECORD. DEF *+6 DEF SDILU DEF B1I DEF P1 LOGICAL UNIT. DEF INBUF DEF D128 * JMP ERPRN LINE ERROR * STA TEMP SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. * * CHECK FOR INPUT END OF FILE. * JSB EOFCK JMP M0950 GOT IT. LDA INCNT IGNORE NULL NON-CARD INPUT. SZA,RSS JMP M0910 * * WRITE THE RECORD ON CENTRAL DISC FILE. * JSB WRITF DEF *+5 DEF UDCB DEF IERR DEF INBUF DEF INCNT * LDA IERR CHECK FOR ERRORS. SSA,RSS JMP M0910 NONE. GO READ NEXT RECORD. * JSB PURGE ERROR. PURGE FILE. DEF *+6 DEF UDCB DEF TEMP DEF P2 FILE NAME. DEF P3 SECURITY. DEF P4 LABEL. * LDA OPNFL OUTPUT ERROR MESSAGE. ELA,CLE,ERA STA OPNFL JSB ERCHK * * END OF FILE ON INPUT. * M0950 JSB CLOSE CLOSE THE CENTRAL FILE. DEF *+3 DEF UDCB DEF IERR * LDA OPNFL CLEAR UDCB OPEN FLAG. ELA,CLE,ERA STA OPNFL * JMP QUERY HED REMAT: SW PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * SW,N * * CHANGE DESTINATION OF REMAT OPERATOR REQUESTS. * DESTINATION IS SATELLITE (N=LU), OR THE CENTRAL STATION RTE (N=0). * M0990 LDA CP1 SEE IF VALUE SUPPLIED SZA IF NOT SUPPLIED, PRINT CURRENT VALUE JMP M0991 SUPPLIED, SAVE IT JSB CNUMD CONVERT LU TO DEC DEF *+3 DEF MODE DEF P3 SAVE IN TEMP LOCATION LDA P3+2 GET LAST TWO CHAR STA SWMG1 SAVE FOR PRINT OUT JSB REIO GO PRINT OUT MESSAGE DEF *+5 DEF IRWW DEF LOGLU DEF SWBUF DEF B3 6 CHARS JMP ERPRN JMP QUERY AND RETURN TO USER M0991 LDA P1 SZA,RSS IF THIS IS A LOCAL REFERENCE, JMP M0992 GO TO SET IT UP. JSB LCALS PREPARE NEXT CALL FOR LOCAL REFERENCE. LDA P1 GET THE USER-SPECIFIED LU NUMBER. JSB EQTYP GO TO GET THE EQUIPMENT TYPE-CODE. STA B SAVE THE TYPE-CODE, TEMPORARILY. LDA D56 PREPARE FOR POSSIBLE BAD PARAM. ERROR. CPR$640B B65 IF THE USER'S LU IS LINKED TO DVR65, RSS SKIP TO SET NEW DESTINATION; ELSE, JMP OPERS REPORT BAD PARAMETER ERROR! LDA P1 GET THE DESTINATION LU NUMBER. * M0992 STA MODE 0=LOCAL RTE, N=SATELLITE-LINK LU NO. JMP QUERY * MODE NOP SPC 1 SWBUF ASC 2,SW= SWMG1 ASC 1, HED REMAT: TE PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * TE,-ASCII MESSAGE- PROCESSOR. * * SEND A MESSAGE TO THE CENTRAL STATION OPERATOR. * M1000 LDB CP1 SZB,RSS JMP OPER ERROR 10 IF NO MESSAGE. * CLB FIND THE COMMA IN INBUF. LDA BUFAD STA TEMP * M1010 LDA TEMP,I GET NEXT WORD. AND HB377 ALF,ALF CPA COM JMP M1020 COMMA IN LEFT BYTE. * LDA TEMP,I AND B377 CPA COM JMP M1030 COMMA IN RIGHT BYTE. * ISZ TEMP BUMP TO NEXT WORD. INB COUNT WORDS SKIPPED. JMP M1010 LOOP. * M1020 LDA TEMP,I LEFT. CLEAR COMMA. AND B377 STA TEMP,I JMP M1040 * M1030 ISZ TEMP RIGHT. BUMP TO NEXT WORD. INB * M1040 CMB,INB ADJUST WORD COUNT. ADB INCNT STB INCNT * LDA MODE GET THE COMMUNICATION LU IOR BIT15 SET THE NO-ABORT BIT STA IMODE SAVE FOR CALL TO DMESG * JSB DMESG SEND THE MESSAGE. DEF *+4 DEF IMODE DEF TEMP,I ADDRESS. DEF INCNT LENGTH. * JMP OPER ERROR RETURN * JMP QUERY SPC 3 IMODE NOP BIT15 OCT 100000 S6 HED REMAT: TR PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * TR,XXXXXX PROCESSOR. * * TRANSFER CONTROL TO LOCAL LU OR REMOTE FILE. * M1200 LDA P.STK,I IF CURRENT INPUT IS FROM A AND HB377 CENTRAL FILE, CLOSE IT. SZA,RSS JMP M1210 * JSB CLOSE DEF *+3 DEF IDCB DEF IERR * LDA OPNFL ERA,CLE,ELA CLEAR IDCB OPEN FLAG. STA OPNFL * M1210 LDA P1 GET PARAM 1. SZA,RSS IF NOT SPECIFIED, CCA SIMULATE "TR,-1". * SSA,RSS NEGATIVE INTEGER? JMP M1220 NO. * * BACK UP THROUGH TRANSFER STACK. * LDB P.STK TOP OF STACK? BKUP CPB STKHD JMP M0500 YES. SIMULATE "EX" REQUEST. ADB MD4 NO. BACK UP 1 ENTRY. INA,SZA JMP BKUP LOOP TILL DONE. STB P.STK SET NEW STACK ADDRESS. JMP M1250 GO CHECK FOR CENTRAL FILE. * * ADD NEW CONTROL TO THE TRANSFER STACK. * M1220 LDA P.STK BUMP TO NEXT ENTRY. ADA B4 STA P.STK CPA STKEN RSS JMP M1230 * LDA D13 STACK OVERFLOW. ERROR 013. JMP OPERS * M1230 LDB P1 STORE LU OR FILE NAME. STB A,I INA LDB P1+1 STB A,I INA LDB P1+2 STB A,I INA CLB,INB SET RECORD NUMBER TO 1. STB A,I * * IF CENTRAL FILE, OPEN AND OPTIONALLY POSITION. * M1250 LDA P.STK,I AND HB377 SZA,RSS JMP QUERY LOCAL LU. GO GET NEXT REQUEST. * JSB OPEN OPEN THE FILE. DEF *+4 DEF IDCB DEF IERR DEF P.STK,I * LDA IERR PROCESS ERRORS ONLY IF SSA IERR IS NEGATIVE. JSB ERCHK ISZ OPNFL SET OPEN FLAG. * LDA P.STK POSITIONING REQUIRED? ADA B3 LDB A,I CPB B1 (REC. CNT MORE THAN 1?) JMP QUERY NO. STB TEMP YES. * JSB POSNT POSIWTION TO NEXT RECORD. DEF *+5 DEF IDCB DEF IERR DEF TEMP NUR GREATER THAN ZERO. DEF TEMP ABSOLUTE RECORD NUMBER. * JSB ERCHK CHECK FOR ERRORS. JMP QUERY * * TRANSFER STACK. * * FOR EACH ENTRY, WORD 1 = INTEGER LU OR * FIRST 2 FNAME CHAR. * WORD 2,3 = REST OF FNAME. * WORD 4 = NEXT RECORD NUMBER. * P.STK NOP STACK POINTER. STKHD DEF *+1 * BSS 32 8 ENTRIES. * STKEN DEF * STACK LWA+1. HED REMAT: LO PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * LO PROCESSOR * * LO,FILENAME [,TERMINAL LU] * M1400 LDA CP1 GET TYPE FLAG PRAM #1 CPA B2 IS IT ASC ? RSS YES JMP OPER NO...ERROR..FILENAME MISSING LDA CP2 GET TERMINAL LU LDB MODE GET CURRENT TERMINAL LU SZB,RSS IS THERE A REMOTE LU DEFINED SZA OR DID THEY SUPPLY ONE? RSS YES JMP OPER NO...ERROR CCE,SZA OVERRIDE CURRENT TERMINAL? LDB P2 YES STB P2 SAVE TERMINAL LU LDA LOGLU GET LOG DEVICE ALF,ALF SET TO HIGH ORDER RAL,ERA SET SIGN BIT...FORCE LOAD IOR B1 SET IN LOAD FLAG STA LPWD1 SET IN LOG DEVICE DLD P1 GET FIRST 4 CHAR OF NAME DST NAM LDA P1+2 STA NAM+2 CLA STA LPWD2 LIST LU CLEARED JMP LOPL1 GO SEND PARMB HED REMAT: PL PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * PL REQUEST * * PL[,LIST LU][,TERMINAL LU] * M1500 LDA CP1 GET TYPE FLAG PRAM #1 LDB LSTLU GET DEFAULT LIST LU CPA B1 IS FIRST PRAM SUPPLIED? LDB P1 YES...GET LIST LU STB LPWD2 SAVE LIST LU LDA LOGLU GET LOGLU ALF,ALF SET FOR HIGH HALF OF WORD CCE RAL,ERA SET IN SIGN BIT  STA LPWD1 SAVE FOR LOG DEVICE LDA CP2 SEE IF TERMINAL LU SUPPLIED LDB MODE SZB,RSS CHECK IF ONE OR THE OTHER SUPPLIED CPA B1 RSS YES...AT LEAST ONE SUPPLIED JMP OPER NO...ERROR CPA B1 OVERRIDE? LDB P2 YES...GET SPECIFIED LU STB P2 SET IN REMOTE LU SPC 2 * * HERE WE SEND PARMB TO DO A FORCE DOWN LOAD * CONTROL WILL BE RETURN WHEN APLDR IS COMPLETE * LOPL1 LDA D8 SET IN STREAM TYPE STA LOPMB JSB D65MS SEND REQUEST DEF *+7 DEF IRWW DEF P2 DEF LOPMB DEF LOLNG DEF B0 DEF B0 JMP ERPRN FOR ERROR CONDITION JSB .DFER MOVE SPACE IN PROG NAME DEF APNAM DEF SFILL LDA APLER GET ERROR CODE SZA,RSS IF ZERO, NO ERROR JMP *+3 ADA D59 ERROR CODES START AT -60 CMA,INA MAKE ERROR CODES POSITIVE MPY B3 GET TO ADDRESS ADA ERMGA LDB A,I GET FLAG WORD INA GET TO ERROR MESSAGE STB LOCLN SAVE IN TEMP LOCATION DLD A,I GET ERROR CODE DST ERAPL SAVE ERROR CODE LDA LOCLN GET ERROR FLAG SZA,RSS MOVE NAME? JMP LOPL3 NO JSB .DFER YES DEF APNAM DEF APERM LOPL3 JSB LCALS CHECK IF ECHO SSAGE LDA LOGLU JSB EQTYP SZA ECHO DEVICE? JMP QUERY NO JSB REIO YES DEF *+5 DEF IRWW DEF LOGLU DEF APLMG DEF D10 JMP ERPRN JMP QUERY AND RETURN * IRWR OCT 100001 IRWW OCT 100002 * SPC 2 * * THIS IS THE PARMB FOR FORCED * DOWN LOAD. DO NOT CHANGE ORDER * !!! * D8 DEC 8 D59 DEC 59 LOPMB NOP LOCLN NOP BSS 3 LPWD1 NOP LPWD2 NOP APLER BSS 0 NAM NOP APERM BSS 0 BSS 27 LOLNG DEC 35 SPC 1 ER]MGA DEF *+1 OCT 0 DON'T PRINT NAME ASC 2,DONE OCT 1 ASC 2,REM OCT 1 ASC 2,DUP OCT 1 ASC 2,NO OCT 1 ASC 2,OF OCT 1 ASC 2,FMP OCT 0 ASC 2,0BIS 00 BLANK ID SEGMENTS OCT 0 ASC 2,CKSM OCT 0 ASC 2,COM OCT 0 ASC 2,MEM OCT 0 ASC 2,ID? OCT 0 ASC 2,BUSY SPC 1 APLMG ASC 3,APLDR: ASC 1, ERAPL ASC 2, ASC 1, APNAM ASC 3, SFILL ASC 3, HED REMAT: BT PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 SPC 1 * * BASIC TRAP REQUEST * BT[RAP],XX WHERE XX=TRAP # * M1600 LDA CP1 SEE IF NUMERIC CPA B1 IS IT RSS YES JMP OPER NO...ERROR LDA P1 GET VALUE TO BE CONVERTED ADA D100 ADD VALUE TO FORCE LEADING ZEROS STA P1 JSB CNUMD CONVERT TO DEC. DEF *+3 DEF P1 DEF P3 OUTPUT ASC IN TEMP LOCATION LDA P3+2 GET LOWER 2 CHAR STA TRP# SAVE AS TRAP # LDA SDILU GET LU OF REMOTE TERMINAL LDB CP2 SEE IF THEY SUPPLIED ONE? SZB ONE SUPPLIED? LDA P2 YES...GET VALUE STA P2 JSB DEXEC SEND SCHEDULE TRAP CALL DEF *+4 DEF P2 SDILU DEF D10I DEF TRAP JMP ERPRN LINE ERROR JMP QUERY AND RETURN SPC 1 TRAP ASC 2,TRAP TRP# ASC 1, D100 DEC 100 HED REMAT: SL PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * SLAVE PROGRAM LIST REQUEST * SLIST (,LIST LU) * M1700 LDA CP1 SEE IF LIST LU SUPPLIED LDB LSTLU GET DEFAULT CPA B1 IF TYPE=1 USE SUPPLIED RSS YES...DON'T USE DEFAULT STB P1 SAVE FOR PRINTING LDA C4040 GET SPACE WORD STA CP3 SAVE FOR NAME MOVE JSB EXEC GET SOME DISK SPACE DEF *+6 DEF GETRK  DEF B1 DEF SLPMB DEF DSKLU DEF P7 JMP ERPRN JSB RNRQ GET A RN # DEF *+4 DEF RNALC DEF RNNUM RN # GOES HERE DEF P7 TEMP LOCATION JMP ERPRN JSB RNRQ SET RN # ... TO BE CLEARED BY PTPM DEF *+4 DEF RNGLK DEF RNNUM DEF P7 JMP ERPRN LDA #ST04+1 STA P7 SAVE FOR WRITE JSB EXEC SEND PROGRAM LIST REQ TO PTPM DEF *+8 DEF CLSWR DEF B0 DEF SLPMB DEF B5 DEF P7 DEF P7 DEF P7 JMP ERPRN JSB RNRQ WAIT FOR PTPM TO CLEAR RN# DEF *+4 DEF RNGCL DEF RNNUM DEF P7 JMP ERPRN JSB RNRQ CLEAR OUT RN # DEF *+4 DEF RNRLS DE-ALOCATE RN # DEF RNNUM DEF P7 JMP ERPRN JSB EXEC READ THE DISK DEF *+7 DEF IRWR DEF DSKLU DEF INBUF READ BUFFER...120 WORDS LONG DEF D128 DEF SLPMB DEF B0 JMP ERPRN JSB EXEC RELEASE THE DISK DEF *+5 DEF RLTRK DEF B1 DEF SLPMB DEF DSKLU JMP ERPRN JSB REIO PRINT HEADER MESSAGE DEF *+5 DEF IRWW DEF P1 DEF HDMSG DEF D10 JMP ERPRN LDA BUFAD GET READ BUFFER ADDRESS STA RTEMP SAVE FOR COUNT RDLOP LDB A,I GET VALUE SZB,RSS IS THERE ONE THERE? JMP RNEXT NO CPB MD1 DONE? JMP RDONE YES JSB .DFER MOVE NAME TO PRINT AREA DEF P3 RTEMP NOP JSB REIO WRITE OUT LINE DEF *+5 DEF IRWW DEF P1 WRITE LU DEF CP3 DEF B4 4 WORDS JMP ERPRN RNEXT LDA RTEMP ADA B4 GET TO NEXT ENTRY STA RTEMP JMP RDLOP GET NEXT ENTRY RDONE JSB LCALS SEE IF IT IS THE LINE-PRINTER LDA P1 GET LU  JSB EQTYP GET EQT TYPE CPA D10 LP? RSS YES JMP QUERY NO LDA P1 IOR B1100 OR IN CONTROL WORD STA P1 JSB EXEC DO A PAGE EJECT DEF *+4 DEF CNTRL DEF P1 DEF MD1 JMP ERPRN JMP QUERY AND RETURN FOR NEXT ENTRY * SPC 1 SLPMB NOP TRACK ADDRESS DSKLU NOP DISK LU OCT 5 FLAG...TELL PTPM SPECIAL REQ OCT 0 SECTOR 0 RNNUM NOP RESOURCE NUMBER SPC 1 C4040 ASC 1, RNALC OCT 040020 ALLOCATE GLOBAL RN--NO ABORT RNGLK OCT 040002 LOCK GLOBAL RN--NO ABORT RNGCL OCT 040006 CLEAR GLOBAL RN--NO ABORT RNRLS OCT 040040 RELEASE GLOBAL RN--NO ABORT CNTRL OCT 100003 GETRK OCT 100017 RLTRK OCT 100020 * HED REMAT: SO REQUEST PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * SO REQUEST * SO,PNAME OR SO...TURN OFF ALL SLAVE PTOP PROGRAMS * M1800 LDA #ST04+1 GET CLASS BUFFER ADDRESS STA P7 JSB .DFER MOVE NAME TO PRAMB DEF POPMB+5 DEF P1 ADDRESS OF THE 1ST PARAMETER (PGM NAME) JSB EXEC WRITE TO PTPM CLASS DEF *+8 DEF CLSWR DEF B0 DEF POPMB DEF D8 DEF P7 DEF P7 DEF P7 JMP ERPRN JMP QUERY AND RETURN SPC 1 POPMB NOP NOP OCT 100012 SPECIAL PTPM REQUEST NOP NOP BSS 3 NAME GOES HERE HED REMAT: TC PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 HED REMAT: SUBROUTINE SECTION * (C) HEWLETT-PACKARD CO. 1976 * * SUBROUTINE TO TEST FOR END OF FILE ON LOCAL DEVICES. * * TEMP = EQT STATUS WORD. * INCNT = EQT WORD COUNT. * LUTYP = EQUIPMENT TYPE. * JSB EOFCK * EOF RETURN * NORMAL RETURN * EOFCK NOP CLE LDA LUTYP EOF DEPENDS ON DEVICE. SZA,RSS JMP EOF1 TTY. CPA B1 JMP EOF1 PHOTOREADER. CPA D9 JMP EO F4 CARD READER. CPA D13 JMP EOF4 MARK SENSE. CCE DEFAULT TO MAG TAPE. * EOF1 LDA TEMP GET STATUS WORD. ALF,ALF SEZ,RSS IF E=1, CHECK BIT 7. JMP EOF2 SSA JMP EOF3 EOF2 RAL,RAL CHECK BIT 5. SSA,RSS JMP EOF5 NO EOF. * EOF3 LDA LUTYP GET LU TYPE SZA IS IT A TTY ? JMP EOFND NO, CONTINUE JSB DEXEC YES, GENERATE A CR. DEF *+6 DEF SDILU DEF B2I WRITE DEF P1 LU OF TTY DEF CR DEF B1 * JMP ERPRN LINE ERROR JMP EOFND * EOF4 LDA INCNT CHECK FOR BLANK CARD. SZA EOF5 ISZ EOFCK EOFND JSB LCALC CLEAR IF LOCAL JMP EOFCK,I * * SUBROUTINE TO CHECK FOR ASCII PARAMETER. * ASCHK NOP (B) = CODE WORD. SZB,RSS JMP OTHER IF NOT THERE OR ADB MD2 SZB JMP OTHER NOT ASC LET RTE GIVE US ERROR JMP ASCHK,I * * SUBROUTINE TO CHECK INTEGER PARAMETERS. * INTCK NOP (B) = CODE WORD. LDA D55 SZB,RSS JMP OPERS ERROR 55 IF MISSING. LDA D56 ADB MD1 SZB JMP OPERS ERROR 56 IF NOT NUMERIC. JMP INTCK,I * * SUBROUTINE TO FIND EQUIPMENT TYPE OF AN LU. (IF EQUIPMENT- * TYPE CODE = <05> AND UNIT# = 0, CHANGE TO <00> FOR OUR PURPOSES.) * RETURN WITH (A) = EQUIPMENT-TYPE CODE. * EQTYP NOP (A) = LU. STA TEMP1 JSB DEXEC DEF *+5 DEF SDILU DEF D13I DEF TEMP1 DEF TEMP2 EQT5 RETURNED HERE * JMP ERPRN LINE ERROR * JSB LCALC CLEAR IF LOCAL CHECK * LDA TEMP2 ALF,ALF AND B77 CPA B5 DVR05? RSS YES JMP EQTYP,I NO, RETURN. A=EQUIP-TYPE LDA DRT GET PTR TO DEV REF TABLE ADA TEMP1 ADD LU # ADA MD1 MINUS ONE. LDA A,I GE;oT DRT ENTRY FOR THIS LU AND HB174 ISOLATE UNIT # SZA IF UNIT # = 0, RETURN LDA B5 WITH A = 0, JMP EQTYP,I ELSE A = 5. SPC 1 * * SUBROUTINE TO FORCE TO LOCAL * CALLING SEQUENCE * JSB LCALS * NORMAL RETURN * LCALS NOP LDA SDILU GET DESTINATION LU STA LCAL1 SAVE IN TEMP LOCATION CLA SET FOR LOCAL STA SDILU JMP LCALS,I AND RETURN SPC 1 LCAL1 NOP SPC 1 * * SUBROUTINE TO RESET DESTINATION LU * IF IT WAS FORCED TO ZERO * CALLING SEQUENCE * JSB LCALC * NORMAL RETURN * LCALC NOP LDB LCAL1 GET FLAG SZB,RSS IF ZERO...DON'T RESET JMP LCALC,I AND RETURN STB SDILU SAVE FOR LATTER USE CLB STB LCAL1 CLEAR FLAG JMP LCALC,I AND RETURN SPC 1 * * SUBROUTINE TO PROCESS ERRORS IN RFA CALLS. * ERCHK NOP LDA IERR CAN BE POS. OR NEG. SZA,RSS JMP ERCHK,I NO ERROR. * LDB BLANK MAKE POSITIVE, SET SIGN WORD. SSA,RSS JMP ERCK1 LDB MINUS CMA,INA ERCK1 STB EMSG+3 * CCE DECIMAL CONVERSION. JSB $LIBR TURN OFF INTERUPTS NOP JSB $CVT3 CONVERT TO ASCII. STA B * ADB B2 STORE LAST 2 DIGITS LDA B,I IN MESSAGE BUFFER. IOR LB20 LEADING BLANK TO ASCII 0. STA EMSG+4 ADB MD1 LDA B,I SET UP SIGN AND AND B377 FIRST DIGIT. IOR EMSG+3 IOR B20 LEADING BLANK TO ASCII 0. STA EMSG+3 STORE IN MESSAGE BUFFER. JSB $LIBX TURN INTERUPTS BACK ON DEF *+1 DEF STKRS * ERPRN DST EMSG+3 * STKRS LDA STKHD RESET STACK POINTER. STA P.STK * JSB EXEC DISPLAY ERROR MESSAGE. DEF *+5 DEF B2 DEF LOGLU DEF EMSG DEF B5 * JSB CLSFL CLOSE aFILES CURRENTLY OPEN. * JSB LCALS SET FOR LOCAL EQT CHECK LDA LOGLU GET LU JSB EQTYP GET EQT TYPE SZA,RSS TTY DEVICE? JMP QUERY * LDA A.$TR GENERATE $TR,1 STA INBUF LDA A.TR1 STA INBUF+1 LDA A.TR1+1 STA INBUF+2 LDA B3 STA INCNT JMP ECHO * EMSG ASC 5,REMAT * * SUBROUTINE TO CLOSE THE COMMAND FILE OPEN TO IDCB, * OR USER FILE OPEN TO UDCB IF EITHER OR BOTH ARE OPEN. * CLSFL NOP LDA OPNFL SZA,RSS JMP CLSFL,I BOTH DCB'S ARE CLOSED. * SLA,RSS JMP CLOS2 IDCB NOT OPEN. * JSB CLOSE CLOSE THE COMMAND FILE. DEF *+3 DEF IDCB DEF IERR * LDA OPNFL CLOS2 SSA,RSS JMP CLOS3 UDCB NOT OPEN. * JSB CLOSE CLOSE THE USER FILE. DEF *+3 DEF UDCB DEF IERR * CLOS3 CLA STA OPNFL CLEAR OPEN FLAGS. JMP CLSFL,I RETURN. HED REMAT: CONSTANTS AND STORAGE * (C) HEWLETT-PACKARD CO. 1976 * PARAMETER STORAGE AREA. * SDILU EQU MODE DRT EQU 1652B DEV. REF. TABLE POINTER PRAMS NOP FLAG WORD. OP BSS 3 OPERATION CODE. CP1 NOP FLAG WORD. P1 BSS 3 PARAM 1 (UP TO 6 CHARACTERS). CP2 NOP P2 BSS 3 CP3 NOP P3 BSS 3 CP4 NOP P4 BSS 3 CP5 NOP P5 BSS 3 CP6 NOP P6 BSS 3 CP7 NOP P7 BSS 3 BSS 1 NEED FOR PARSE..# OF PRAMS * B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B20 OCT 20 B65 OCT 65 B77 OCT 77 B100 OCT 100 B377 OCT 377 B400 OCT 400 B1000 OCT 1000 B1100 OCT 1100 CLASN NOP CLSWR OCT 100024 LB20 OCT 10000 HB377 OCT 177400 HB174 OCT 174000 HIBIT OCT 100000 MD1 DEC -1 MD2 DEC -2 MD3 DEC -3 MD4 DEC -4 D9 DEC 9 D10 DEC 10 D13 DEC 13 D22 DEC 22 D40 DEC 40 D55 DEC 55 D56 DEC 56 D128 DEC 128 B1I OC[<:6T 100001 B2I OCT 100002 B3I OCT 100003 D10I OCT 100012 D13I OCT 100015 OPNFL NOP BIT 1 = IDCB; BIT 15 = UDCB. TEMP NOP TEMP1 NOP TEMP2 NOP INCNT NOP # WORDS IN INPUT REQUEST. LUTYP NOP EQ. TYPE OF INPUT DEVICE. LOGLU OCT 1 LU OF LOG DEVICE. LSTLU NOP LU OF LIST DEVICE. SEVER NOP SEVERITY CODE. A.$TR ASC 2,$TR A.TR1 ASC 2,R,1 COM OCT 54 CR OCT 6400 AS.$ OCT 022000 IERR NOP PROMP ASC 1,$_ PROMPT CHARACTER. IPRMP ASC 2,/ _ BLANK OCT 020000 DBBLK OCT 20040 MINUS OCT 026400 DFALT DEF ALTBK ALTBK OCT 0,0,0,0 TRFLG NOP HDMSG ASC 10, ACTIVE SLAVE PROGS BUFAD DEF INBUF INBUF BSS 128 BUFFER. IDCB BSS 144 UDCB BSS 144 * SIZE EQU * * END REMAT mS< 6 91700-18103 1613 S 0122 DS1/B CCE MODULE: NPRGL              H0101 FASMB,R,L,C HED NPRGL 91700-16103 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM NPRGL,2,30 91700-16103 REV A 760323 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * *********************************************** * *NPRGL PROGRAM TO DO ABSOLUTE DOWN LOADING * *SOURCE PART # 91700-18003 REV B * *REL PART # 91700-16003 REV B * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 8-28-74 * *MODIFIED BY: CHUCK WHELAN * *DATE MODIFIED: MARCH 1976 * ************************************************ SPC 1 SUP SPC 2 * * PROGRAM TO DO DOWN LINK LOADING ON UP TO * MAXN TERMINALS. WHERE MAXN IS THE NUMBER OF TERMINALS * WHICH CAN OPERATE AT ANY ONE TIME * REMEMBER EACH TERMINAL TAKES 173 WORDS!!! * SPC 2 * DEFINE ENTRY POINTS SPC 2 * DEFINE EXTERNALS SPC 1 EXT EXEC,READF,POSNT,CLOSE EXT OPEN EXT D65SV IFN EXT DBUG XIF SPC 2 * DEFINE A AND B REG SPC 1 A EQU 0 B EQU 1 SPC 3 * * STATUS AND ERROR WORD COMMENTS * *STATUS WORD ERROR WORD *0 =NEW REQ DON'T CARE *1 =DATA COMMING STARTING ADDRESS OF RECORD *2 =ID SEG COMMING CONTENTS OF LOCATION 2 *3 =NO ID SEQ 0=NO STARTING ADDRESS OR LOCATION 2 *-2 FMG ERROR FMG ERROR CODE *-3 BUSY 0...TRY LATTER *-4 LOST DCB -103...IN BIG TROUBLE * SKP * * PROGRAM STARTS HERE * PROGL LDA B,I GET CLASS NUMBER STA CLSNM SAVE CLASS NUMBER IFN SPC 1 SZA DO THEY WANT DEBUG JMP PRGL1 JSB DBUG DEF *+1 JSB EXEC DEF *+4 DEF D6 DEF D0 DEF D1 JMP PROGL XIF SPC 2 PLOS0 BSS 0 PRGL1 JSB EXEC DO A GET CALL...WAIT FOR SOMETHING DEF *+5 DEF D21 CODE FOR A GET CALL DEF CLSNM CLASS # DEF RBUF REQUEST BUFFER DEF D35 REQUEST BUFFER LENGTH * LDA RLU GET COMM. LU AND MSK1 KEEP ONLY LOW 6 BITS STA RLU * * WHEN WE GET HERE SOMEONE WANTS SOMETHING * LDA DCBN GET DCB NUMBER..IF ZERO SZA IT IS A NEW REQUEST JMP PLOS2 NOT A NEW REQUEST * JSB ALOC ALLOCATE A DCB * JSB OPEN OPEN IT DEF *+7 DEF DCBN,I DEF FERR DEF PNAM FILE NAME DEF D0 DEF SC DEF LU * LDA FERR ANY ERRORS? CPA D7 MUST BE FILE TYPE 7 CLB,RSS OK JMP ERRM2 DO ERROR RETURN STB DNFLG CLEAR OUT DONE FLAG * * AT THIS POINT THE DCB IS DEFINED * THE FILE IS OPENED AND WE ARE READY TO DO * OUR THING. * PLOS2 LDA DNFLG SEE IF WE ARE DONE SZA DONE? JMP DONE YES JSB LBUF NO...LOAD UP BUFFER STB STAT SAVE THE FILE STATUS JSB STLN SET LENGTH OF REPLY PARMB LDA D1 SET STATUS MORE COMMING STA STAT SZB DONE? ISZ DNFLG YES...SET DONE FLAG FOR NEXT TIME LDA SADD GET STARTING ADDRESS STA STRTA SET IN STARTING ADDRESS LDA DLEN GET LENGTH OF DATA BUFFER STA LNGH SZA,RSS IF LENGTH IS ZERO...DONE JMP DONE ZERO...DONE LDA RBUF GET STREAM TYPE IOR BIT14 STA RBUF SAVE REPLY STREAM TYPE LDA RLU GET COMM. LU IOR B120 SET SEND REQ. AND DATA & Z BIT STA CNWD *  * JSB D65SV SEND DATA TO TERMINAL DEF *+7 DEF IRWW WRITE DEF CNWD DEF RBUF DEF RBUFL DEF DBUF DATA BUFFER DEF DLEN DATA LENGTH * JSB CLOS ERROR, CLOSE & DEALLOCATE DCB JMP PLOS0 TERMINATE AND WAIT * * SUBROUTINE TO CLOSE FILE & DEALLOCATE DCB * CLOS NOP JSB CLOSE CLOSE FILE DEF *+3 DEF DCBN,I DEF FERR JSB DALOC DE-ALLOCATE THE DCB JMP CLOS,I RETURN SKP * * ROUTINE TO LOAD THE BUFFER FROM A FILE * CALLING SEQUENCE * JSB LBUF READ THE BUFFER * UPON RETURN B REG WILL CONTAIN THE STATUS * LBUF NOP CLA STA CADD CLEAR CURRENT ENDING ADDRESS STA SADD CLEAR STARTING ADDRESS STA DLEN CLEAR OUT LENGTH STA FILER SET FOR NO FILE ERRORS * LBUF0 JSB READF READ A RECORD DEF *+6 DEF DCBN,I DEF FERR DEF RDBUF DEF D60 DEF TEMP1 LDA TEMP1 GET LENGTH CPA M1 DONE? JMP LBUFB YES * * DO CHECKSUM CHECKING * LDA RLEN GET LENGTH ALF,ALF CMA NEGATE...INCLUDE STARTING ADDRESS AS LENGTH STA CKLEN LDA STADA GET STARTING ADDRESS CLB CLEAR OUT FOR LOOP LBUF5 ADB A,I DO CHECKSUM INA ISZ CKLEN DONE? JMP LBUF5 NO CPB A,I DO THEY MATCH JMP LBUF6 YES ISZ FILER NO...SET FOR ERROR JMP LBUFB AND TERMINATE * LBUF6 LDA STADD GET BUFFER ADDRESS CPA D2 IS IT PART OF THE ID SEGMENT? JMP IDFIX YES LDA CADD FIRST TIME THRU? SZA CPA STADD IS ADDRESS NEXT RECORD? JMP LBUFC YES LDB SADD GET STARTING ADDRESS CMB,INB NEGATE IT CMA,INA NEGATE ENDING ADDRESS ADA STADD SEE IF WITHIN EXSITING BUFFER ӷADB STADD SSA SSB RSS NOT WITHIN PREVOUS CODE JMP LBUFC IS, SAVE IT SPC 1 LBUFP JSB POSNT HERE IF BUFFER FULL, OR BREAK IN CODE DEF *+4 DEF DCBN,I DEF FERR DEF M1 LDB FILER SET FOR MORE TO COME JMP LBUF,I AND RETURN SPC 2 LBUFB JSB CLOSE HERE IF EOF REACHED DEF *+3 DEF DCBN,I DEF FERR LDB FILER CHECK IF ANY ERRORS CMB NEGATE...IF WAS ZERO..NO ERROR, OTHERWISE FILE ERROR JMP LBUF,I AND RETURN SPC 3 LBUFC LDA CADD GET CURRENT ADDRESS LDB STADD FIRST RECORD? SZA,RSS STB SADD YES...SET IN STARTING ADDRESS LDA RLEN GET RECORD LENGTH ALF,ALF AND B377 GET LENGTH STA RLEN SAVE LENGTH ADA DLEN GET LENGTH AFTER THE MOVE STA B SAVE FOR THE MOMENT ADA MBUFS SEE IF WE HAVE OVERFLOWED THE SSA,RSS DATA BUFFER JMP LBUFP YES WE HAVE STB DLEN SAVE LENGTH LDA RLEN GET LENGTH AGAIN ADA STADD GET ENDING ADDRESS+1 STA B SAVE FOR AWHILE CMA,INA NEGATE IT ADA CADD SEE IF GREATER THAN CURRENT ENDING SSA STB CADD YES...SAVE NEW ENDING ADDRESS LDA SADD GET BEGINING CMA,INA GET DISPLACEMENT INTO BUFFER ADA STADD ADA DBUFA GET STARTING ADDRESS FOR MOVE STA STADD SAVE ADDRESS LDA RLEN GET LENGTH AGAIN CMA,INA NEGATE FOR LOOP COUNT STA RLEN LDB SDBA GET STARTING ADDDRESS OF INPUT BUFFER LBUFD LDA B,I STA STADD,I SAVE DATA WORD INB GET NEXT ADDRESS ISZ STADD ISZ RLEN DONE? JMP LBUFD NO JMP LBUF0 DONE...GET ANOTHER RECORD SPC 2 IDFIX DLD FWRD GET TWO WORDS DST CAIDS,I SAVE WORDS ISZ CAIDS GET NEXTu ADDRESS ISZ CAIDS ISZ CLIDS INCREMENT RECORD COUNT JMP LBUF0 GET ANOTHER REOCRD SKP * * SUBROUTINE TO ALOCATE A DCB * CALLING SEQUENCE * JSB ALOC * ALOC NOP * * BEFORE WE ALOCATE A DCB, CHECK IF ONE IS * ALREADY ALOCATED * LDA SATA GET ADDRESS OF ACTIVE SATELITE TABLE STA TEMP1 SAVE IN UP COUNTER LDA MMAXS GET MAX # OF ENTRIES INA STA TEMP2 SAVE IN DOWN COUNTER CLA SET UP FOR TABLE DISPLACEMENT STA TEMP3 LDA RLU GET REMOTE LU # ALOC4 CPA TEMP1,I IS THERE A MATCH JMP ALOC5 YES...DCB ALOCATED FOR TERMINAL ALREADY ISZ TEMP1 NO...GET NEXT ENTRY ISZ TEMP3 ISZ TEMP2 DONE? JMP ALOC4 NO...CONTINUE * * TERMINAL DOESN'T ALREADY HAVE A DCB...TRY TO FIND ONE * LDA DCBBA GET ADDRESS OF DCB AVAILABLE TABLE STA TEMP1 SAVE IN TEMP LOCATION LDA MMAXS GET MAX # OF ENTRIES STA TEMP2 SAVE IN DOWN COUNTER CLA GET A ZERO STA TEMP3 SAVE AS MULT. FACTOR ALOC1 ISZ TEMP2 DONE? JMP ALOC3 NO...CONTINUE LDB M3 YES...NO ROOM JMP TERM TELL OTHER SIDE TO TRY LATER ALOC3 LDA TEMP1,I GET CONTENTS OF TABLE SZA,RSS IS THERE SOMETHING THERE? JMP ALOC2 NO...GOOD FOUND A HOME!!! ISZ TEMP1 GET NEXT ADDRESS ISZ TEMP3 INCREMENT MULT COUNT JMP ALOC1 CONTINUE * * HERE IF WE HAVE ROOM * ALOC2 LDA TEMP3 GET MULT FACTOR MPY DCBSZ GET DISPLACEMENT FROM FIRST ADA DCBA ADDRESS OF AVAILABLE DCB STA TEMP1,I SAVE IN TABLE TO HOLD A PLACE STA DCBN SAVE IN PARMB ISZ CALOC INCREMENT # OF ACTIVE TERMINALS LDA TEMP3 GET DISPLACEMENT ADA SATA ADD FOR SATELLITE TABLE ENTRY LDB RLU GET REMOTE LU STB A,I SAVE PLACE IN TABLE JMP ALOC6 SET UP THE ID SEGEMENT SPC 3 * * TERMINAL ALREADY HAS A DCB...CLOSE IT AND REUSE IT * ALOC5 LDA TEMP3 GET DISPLACEMENT ADA DCBBA GET TO DCB ADDRESS LDA A,I GET DCB ADDRESS STA DCBN SAVE DCB ADDRESS IN PARMB JSB CLOSE CLOSE CURRENTLY OPEN DCB DEF *+3 DEF DCBN,I DEF FERR ALOC6 LDA DCBN GET DCB ADDRESS ADA D144 GET TO ID SEG ADDRESS STA CAIDS LDB MIDLN GET LOOP OCUNT STB CLIDS CLB STB A,I CLEAR OUT ID SEG INA ISZ CLIDS JMP *-3 JMP ALOC,I AND RETURN SKP * * SUBROUTINE TO DALOCATE A DCB * CALLING SEQUENCE * JSB DALOC * DALOC NOP LDA DCBBA GET ADDRES OF DCB ACTIVE TABLE STA TEMP1 SAVE IN TEMP LOCATION LDA MMAXS GET MAX # OF ENTRIES STA TEMP2 SAVE IN TEMP LOCATION LDA SATA GET ADDRESS OF SATELLITE OPEN TABLE STA TEMP3 DALC1 ISZ TEMP2 GONE THRU TABLE? JMP DALC2 NO....GOOD LDB M4 WE IN BIG TROUBLE...SHOULD NEVER GET HERE JMP TERM UNKNOWN DCB DALC2 LDA TEMP1,I GET ADDRESS IN TABLE CPA DCBN THE SAME? JMP DALC3 YES...DEALOCATE IT ISZ TEMP3 GET TO NEXT SATELLITE ENTRY ISZ TEMP1 GET NEXT BUFFER ADDRESS JMP DALC1 GO TRY AGAIN * * HERE FOR MATCH CONDITION * DALC3 CLA GET A ZERO STA TEMP1,I CLEAR OUT TABLE LOCATION STA TEMP3,I CLEAR OUT SATELLITE ENTRY STA DCBN CLEAR OUT DCB POINTER JMP DALOC,I RETURN SKP * * SUBROUTINE TO SEND A REPLY TO THE TERMINAL * CALLING SEQUENCE * JSB WRPLY * WRPLY NOP JSB STLN SET LENGTH OF REPLY PARMB LDA RBUF GET STREAM TYPE IOR BIT14 SET FOR REPLY STA RBUF JSB D65SV SEND REPLY DEF *+7 DEF IRWW WRITE DEF RLU DATA ONL Y DEF RBUF REQ. BUFFER DEF RBUFL LENGTH DEF DUMMY DEF DUMMY * JSB CMER ERROR RETURN JMP WRPLY,I RETURN SPC 4 * ERRM2 JSB CLOS CLOSE & DEALLOCATE DCB LDB M2 * * HERE TO TERMINATE ON AN ERROR CONDITION * B REG=STATUS * TERM STB STAT SAVE STATUS LDA FERR CPB M3 BUSY? CLA YES CPB M4 DCB LOST? LDA M103 YES...BIG TROUBLE STA FERR JSB WRPLY SEND ERROR REPLY JMP PLOS0 AND WAIT SPC 4 * * ROUTINE TO SEND ID SEGMENT WHEN DONE * DONE LDA DCBN ADA D144 STA IDSEG ADDR OF ID SEG DATA JSB DALOC DEALLOCATE THE DCB LDA CAIDS ADA M2 DLD A,I GET WORDS 2 AND 3 DST PNAM LDB D3 INCASE NO ID SEGMENT LDA CLIDS GET # OF 2/3 ENTRIES SZA,RSS STARTING ADDRESS? STA PNAM+1 NO...SET TO ZERO CMA,INA ADA D1 IF ONLY ONE RECIEVED... NO ID SEQMENT SSA,RSS JMP TERM NO ID SEQ LDA D2 SET FOR ID SEG COMMING STA STAT LDA IDLNH GET LENGTH OF ID INFO STA LNGH SAVE IN LENGTH WORRD LDA RBUF IOR BIT14 SET FOR REPLY STA RBUF LDA RLU IOR B120 SEND REQUEST AND DATA + Z BIT STA CNWD JSB STLN SET LENGTH OF REPLY PARMB JSB D65SV SEND ID SEQMENT DEF *+7 DEF IRWW WRITE DEF CNWD DEF RBUF DEF RBUFL REQ. LENGTH IDSEG NOP ID SEGMENT ADDRESS (DATA) DEF IDLNH DATA LENGTH * JSB CMER ERROR RETURN * JMP PLOS0 AND TERMINATE SPC 3 CMER NOP DST ERVAL JSB EXEC DEF *+5 DEF D2 DEF D1 DEF ERMS DEF ERML * JMP CMER,I SPC 3 STLN NOP THIS ROUTINE SETS THE LENGTH OF THE REPLY DST SAVAB 3- SAVE THE REGISTERS LDA RBUF GET WORD 0 OF PARMB AND MSK2 ISOLATE THE F BIT LDB D35 SZA,RSS IS THE BIT SET ? LDB D25 NO, SET FOR 25 WORDS (OLD PARMB) STB RBUFL SAVE DLD SAVAB RESTORE THE REGISTERS JMP STLN,I RETURN SPC 3 ERMS ASC 9,NPRGL: COMM ERROR ERVAL BSS 2 ERML DEC 11 SKP * * TEMP VALUES,CONSTANTS,BUFFERS, WHAT EVER * MAXN EQU 2 MAX # OF OPEN TERMINALS BUFS EQU 512 SIZE OF DATA BUFFER LNHID EQU 18 LENGTH OF ID SEQMENT INFO SPC 1 CLSNM NOP CLASS NUMBER B377 OCT 377 BIT14 OCT 40000 D21 DEC 21 B120 OCT 10200 D1 DEC 1 D2 DEC 2 D3 DEC 3 D6 DEC 6 D7 DEC 7 D25 DEC 25 D35 DEC 35 D60 DEC 60 D144 DEC 144 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M103 DEC -103 MIDLN ABS 0-LNHID NEGATIVE LENGTH OF ID SEG INFO MMAXS ABS 0-MAXN-1 MAX # OF TERMINALS + 1 MBUFS ABS 0-BUFS-1 DATA BUFFER SIZE CALOC OCT 0 CURRENT # OF ACTIVE DCB'S TEMP1 NOP TEMP2 NOP TEMP3 NOP CADD NOP SADD NOP SDBA DEF FWRD D0 OCT 0 DBUFA DEF DBUF DCBBA DEF DCCB STADA DEF STADD CKLEN NOP FILER NOP DCBA DEF DCBF SATA DEF SAT SZDCB EQU 144+LNHID DCBSZ ABS SZDCB MSK1 OCT 77 MSK2 OCT 4000 CNWD NOP DUMMY OCT 0 IRWW OCT 100002 RBUFL NOP DLEN NOP IDLNH ABS LNHID SAVAB BSS 2 SPC 2 * * HERE WE DEFINE THE PRMB * . EQU * RBUF NOP STREAM ID BSS 1 STAT NOP STATUS STRTA BSS 0 FERR NOP LNGH NOP PNAM NOP PROGRAM NAME BSS 2 SC NOP SECURITY CODE DNFLG BSS 0 LU NOP LOGICAL UNIT DCBN NOP CLIDS NOP CURRENT # OF 2 WORD TRANSFERS CAIDS NOP CURRENT ADDRESS WITHIN ID SEGMENT SPC 1 ORG . RE POSITION EVERYBODY BSS 24 RLU NOP LU WHO CALLED UP BSS 10 SPC 2 * * INPUT BUFFER640 FOR READING ABSOLUTE RECORDS * ... EQU * DEFINE FOR REORG RLEN NOP LENGTH WORD STADD NOP STARTING ADDRESS WORD FWRD NOP FIRST DATA WORD SPC 1 * * REORG AND MAKE BUFFER 60 WORDS LONG * ORG ... RDBUF BSS 60 SPC 2 * * DEFINE SATELLITE OPEN TABLE * SAT REP MAXN NOP SPC 2 * DEFINE DCB TABLE DCCB BSS 0 REP MAXN NOP SPC 2 * DEFINE DCB AREA DCBF BSS 0 REP MAXN BSS SZDCB SPC 2 * DEFINE DATA BUFFER DBUF BSS 512 END EQU * END PROGL y6  , 91700-18104 1614 S 0122 DS1/B CCE MODULE: PROGL              H0101 IASMB,R,L,C HED PROGL 91700-16104 REV A * (C) HEWLETT-PACKARD CO 1976 NAM PROGL,2,30 91700-16104 REV A 760330 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * * PROGL MODULE FOR CONCURRENT MULTI-TERMINAL DOWNLOADS * ENT PROGL * * WRITTEN BY: CHUCK WHELAN NOV 1975 * * * PROGL * * EXT EXEC,OPEN,READF,CLOSE EXT RNRQ,DRTEQ EXT #RSAX * * * #ACTV EQU 10 NUMBER OF ACTIVE DOWNLOADS AT ONE TIME * #TERM EQU 32 NUMBER OF POSSIBLE COMM. LINES * SKP * * * "PROGL" IS A DISTRIBUTED SYSTEM COMMUNICATIONS MONITOR. IT * SERVICES ALL SYSTEM DOWNLOAD REQUESTS FROM "SCE-1" SOFTWARE AT * REMOTE SATELLITES. WHEN A NEW REQUEST IS RECEIVED, THE REQUESTED * ABSOLUTE FILE CONTAINING THE CORELOAD IS TRANSMITTED RECORD-BY- * RECORD USING CLASS I/O WRITE OPERATIONS TO THE COMMUNICATIONS * DRIVER ("DVR65"). * * WHEN "PROGL" IS NOT EXECUTING IT IS IN A CLASS I/O GET * SUSPENSION WAITING FOR AN ENTRY TO BE PLACED ON THE CLASS QUEUE * FOR ITS CLASS NUMBER. ENTRIES ARE PLACED ON THIS QUEUE WHEN A * NEW DOWNLOAD REQUEST IS RECEIVED OR A PREVIOUS CLASS I/O WRITE * COMPLETES. SINCE NEW REQUESTS ARE WRITTEN TO "PROGL"S CLASS BY * "GRPM" WITH A CLASS I/O MAILBOX WRITE/READ, "PROGL" IS ABLE * TO DIFFERENTIATE BETWEEN THE TWO BY EXAMINING "IPRM3". * * THE PARMB PASSED TO "PROGL" BY "GRPM" CONTAINS THE LU IN THE * 25TH WORD, AND THE DOWNLOAD FILE NUMBER (BINARY) IN THE 2ND WORD. * THESE ARE THE ONLY WORDS IN THE PARMB USED BY "PROGL". THE DOWN- * LOAD FILE NUMBER IS CONVERTED TO AN ASCII FILE NADME CONSISTING * OF "P" FOLLOWED BY THE FIVE ASCII DIGIT OCTAL EQUIVALENT OF THE * NUMBER. NON-SCE1 REQUESTS TO PROGL PLACE A ZERO IN THE 2ND WORD, * AND THE ASCII FILE NAME IN THE 3RD, 4TH, & 5TH WORD OF THE PARMB. * * THE NUMBER OF DOWNLOADS THAT CAN BE ACTIVE AT ANY ONE TIME * IS LIMITED ONLY BY SYSTEM AVAILABLE MEMORY AND THE SIZE OF THE * ACTIVE DOWNLOAD TABLE. IN-PROCESS DOWNLOADS HAVE AN ENTRY IN * THIS TABLE CONSISTING OF LU, TIME-TAGS, SEQ #, AND THE 144 WORD * DCB FOR THE DOWNLOAD FILE. IF A NEW REQUEST IS RECEIVED WHILE * THIS TABLE IS FULL, IT IS PLACED IN A FOUR WORD (LU, TIME-TAGS, & * FILE #) ENTRY IN A WAIT QUEUE. WHEN AN ENTRY BECOMES AVAILABLE * IN THE ACTIVE TABLE, AN ENTRY IN THE WAIT QUEUE CAN BE ACTIVATED. * THE NUMBER OF ENTRIES IN THE ACTIVE TABLE IS SET AT ASSEMBLY TIME * BY THE ITEM "NACTV". * * THE LU AND SEQ # OF A DOWNLOAD REQUEST ARE PASSED IN THE * OPTIONAL PARAMETERS OF EACH CLASS I/O WRITE. THE PROGRAM ENSURES * THAT ONLY ONE DOWNLOAD TO A LU IS IN PROCESS BY RE-USING THE SAME * TABLE ENTRY WITH A NEW SEQ # IF A DOWNLOAD IS RESTARTED, AND * IGNORING I/O COMPLETIONS (ERRORS OR NOT) WITH WRONG SEQ. NUMBERS. * * EACH TIME THAT "PROGL" IS ENTERED ON A CLASS WRITE * COMPLETION, IT CHECKS THE RETURNED ERROR STATUS FOR DRIVER * ERRORS AND IF NONE, READS THE NEXT RECORD FROM THE DOWNLOAD * FILE, WRITES IT TO THE DRIVER AND AGAIN SUSPENDS ON ITS CLASS. * * WHEN ALL RECORDS IN THE DOWNLOAD FILE HAVE BEEN SUCCESSFULLY * TRANSMITTED, "PROGL" SENDS A ONE-WORD REQUEST TO THE SATELLITE * TO INDICATE THE DOWNLOAD IS COMPLETE. AT THIS TIME, THE FILE IS * CLOSED, THE TABLE ENTRY IS CLEARED, AND UNLESS A WAIT QUEUE * ENTRY CAN BE ACTIVATED, "PROGL" AGAIN SUSPENDS ON ITS CLASS. * * SKP * * PROGL IS ENTERED HERE INITIALLY PROGL BSS 0 ENTRY. LDA 1,I AND MSK14 RELEASE CLASS BUFFER SZA SKIP IF NOT 1ST TIME STA ICLAS SAVE CLASS # FORƭ PROGL * * * SUSPEND UNTIL A NEW REQUEST IS WRITTEN TO MONITOR OR COMPLETION * ON A PREVIOUS DRIVER WRITE OCCURS * PGET JSB EXEC WAIT FOR NEXT REQST OR I/O COMPLETION DEF *+8 DEF D21 DEF ICLAS DEF BUFR DEF LEN DEF LU DEF SEQ# DEF TYPE * LDB TYPE CHECK TYPE OF CLASS I/O CPB D2 JMP IOCOM IT WAS WRITE, PROCESS I/O COMPLETION * * PROCESS NEW DOWNLOAD REQUEST * LDA BUFR+24 STA LU SET LU FROM PARMB JSB SRCH SEARCH FOR ENTRY IN DOWNLOAD TABLE CLB,RSS THIS LU WASN'T IN TABLE JMP RSTRT FOUND, CLEAR & RESTART * * NO PREVIOUS ACTIVE ENTRY FOR LU CPB CURAD WAS DOWNLOAD TABLE FULL? JMP FULL YES, QUEUE THIS ENTRY LDA LU LU STA CURAD,I STORE IN 1ST WORD OF DOWNLOAD ENTRY RSS * * SAME LU, USE SAME TABLE ENTRY WITH NEW SEQ # & TIME-TAGS RSTRT JSB CLSE CLOSE PREVIOUS DOWNLOAD FILE DLD BUFR+33 GET TIME-TAGS DST TAGAD,I SAVE IN ACTIVE DOWNLOAD ENTRY LDB BUFR+1 PGM # FROM PARMB SZB SKIP IF A NON-SCE1 REQUEST JMP NEWLD OTHERWISE CONVERT A BINARY PGM # LDA BUFR+2 CHARS 1 & 2 OF FILE NAME STA NAME LDA BUFR+3 CHARS 4 & 5 STA NAME+1 LDA BUFR+4 5TH CHAR JMP SETNM * * CONVERT PGM # TO BE DOWNLOADED NEWLD RRL 4 DUAL ROTATE LEFT 4 AND D7 IOR ASCP0 FORM ASCII OF 1ST 2 CHARS STA NAME CLA RRL 3 POSITION 3RD OCTAL DIGIT ALF,RAL MOVE TO LHW RRL 3 GET 4TH DIGIT IOR ASC00 ASCII FOR 3RD & 4TH DIGITS STA NAME+1 CLA RRL 3 5TH DIGIT ALF,RAL TO LHW RRL 3 GET 6TH & FINAL DIGIT IOR ASC00 CONVERT TO ASCII SETNM STA NAME+2 * LDA POOLS GET SEQ # OF THIS DOWNLOAD FROM POOL STA SEQAD,I 2ND WORD OF DOWNLOAD E oNTRY ISZ POOLS UPDATE POOL SEQUENCE NUMBER ZERO NOP * * OPEN FILE TO BE DOWNLOADED JSB OPEN DO FMGR OPEN DEF *+5 DEF DCBAD,I DCB ADDRESS DEF IERR DEF NAME DEF ZERO * LDA IERR SSA SKIP IF NO ERROR FROM FMP JMP ERR1 SEND REJECT IF ERROR * * LOCK PRN SO PROGL HAS EXCLUSIVE USE OF LINE JSB DORN DO LOCAL LOCK ON PROGL RN OCT 100001 JMP NEXT NOW XFER NEXT RECORD HED SEND NEXT DOWNLOAD RECORD * (C) HEWLETT-PACKARD CO 1976 * * * ENTER HERE WHEN COMPLETION OF PREVIOUS WRITE HAS OCCURRED * IOCOM STA IERR SAVE STATUS JSB SRCH FIND DOWNLOAD TABLE ENTRY FOR LU JMP PGET LU NOT IN TABLE, IGNORE LDA SEQAD,I GET SEQ # OF TABLE ENTRY CPA SEQ# DOES IT MATCH? RSS YES JMP PGET NO, IGNORE THIS COMPLETION * CHECK DRIVER ERROR STATUS LDA IERR GET ERROR STATUS FROM DRIVER SLA,RSS LSB OF EQT5 JMP ERR3 DRIVER ERROR OCCURRED * * THIS SECTION IS ENTERED TO GET NEXT RECORD FROM DOWNLOAD FILE. * NEXT JSB READF READ NEXT RECORD DEF *+6 DCBAD NOP DEF IERR DEF DBUF DEF MAXL MAX ALLOWED LENGTH DEF LENX ACTUAL LENGTH * LDA IERR CHECK FOR ERRORS SSA JMP ERR2 ERROR IN FILE READ * LDA LENX SSA CHECK FOR END-OF-FILE JMP EOFND FOUND, WRAP IT UP * * VERIFY CHECKSUM OF NEXT RECORD TO BE DOWNLOADED * LDA DBUF ALF,ALF AND B377 STA 1 SAVE BUFFER LENGTH IN B CMB,INB NEGATE LENGTH STB DBUF SET IN LENGTH FIELD FOR SCE-1 INA CMA,INA STA CNTR WORD COUNTER. LDB DBFAD BUFFER ADDRESS. CLA CKSML ADA 1,I ADD UP THE WORDS. INB ISZ CNTR JMP CKSML CPA 1,I COMPARE CHECKSUMS. RSS < JMP ERR2 NOT EQUAL. * * CHECKSUM OK, SETUP TO WRITE THIS RECORD LDA LU GET LU IOR B400 WRITE DATA ONLY (PROGL SPECIAL) STA CONWD * * NOW DO CLASS I/O WRITE TO DRIVER * JSB EXEC DEF *+8 DEF D18N NO ABORT BIT IS SET DEF CONWD WRITE DATA DEF DBUF DATA BUFFER ADDRESS DEF LENX LENGTH CURAD NOP OPT.PARAM 1 = LU SEQAD NOP OPT.PARAM 2 = SEQ # OF DOWNLOAD DEF ICLAS WRITE IT ON PROGL'S CLASS * JMP ERR3 ERROR * NOW GO INTO SUSPEND ON PROGL'S CLASS UNTIL A DRIVER WRITE COMPLETES * OR A NEW REQUEST IS RECEIVED. JMP PGET * * * ENTER HERE WHEN END OF DOWNLOAD FILE IS DETECTED * RETURN GOOD STATUS FOR A SUCCESSFUL DOWNLOAD * EOFND JSB CLSE CLOSE DOWNLOAD FILE CLA 0= GOOD DOWNLOAD * TERM STA ISTAT SET STATUS FOR TRANSMISSION * JSB EXEC WRITE FINAL REQUEST DEF *+8 DEF D18N CLASS WRITE TO COMM DRIVER DEF LU REQ ONLY DEF ISTAT 1 WORD REQUEST HAS STATUS DEF D1 DEF LU OPT.PARAM 1 = LU DEF SEQAD,I OPT.PARAM 2 = DOWNLOAD SEQ # DEF ICLAS PROGL CLASS NUMBER NOP * * CLEAR PRN SO ANYONE ELSE CAN USE THIS LU JSB DORN CLEAR PROGL RESOURCE NUMBER OCT 100004 * JSB #RSAX CLEAR TRANSACTION DEF *+5 DEF D3 DEF ST/LS STREAM 9 DEF SCODE SELECT CODE TAGAD NOP ADDR OF TIMETAGS * LDA ISTAT CPA M4 IS THIS A NON-SCE1 BUSY REJECT? JMP PGET YES, DONE * * THIS DOWNLOAD IS OVER * CLEAN OUT DOWNLOAD TABLE ENTRY AND GIVE SPACE TO * ANY ENTRY FOUND IN WAITING QUEUE * CLNUP CLA STA CURAD,I SET DOWNLOAD ENTRY AS AVAILABLE LDB WAITA LDA NQUE STA CNTR COUNTER= -# OF WAITQ ENTRIES CKQUE LDA 1,I SZA SKIP IF SLOT EMPTY JMP ACTIV I:OTHERWISE, ACTIVATE IT ADB D2 ISZ CNTR JMP CKQUE JMP PGET NOTHING QUEUED, GO TO GET SUSPEND * * NOW ACTIVATE A WAITING DOWNLOAD REQUEST FROM THE WAIT QUEUE USING * THE ACTIVE DOWNLOAD TABLE SPACE WHICH WAS JUST MADE AVAILABLE * ACTIV STA CURAD,I MOVE LU TO TABLE ENTRY JUST CLEARED CLA STA 1,I CLEAR WAIT QUEUE ENTRY INB STB TPNT DLD 1,I GET TIME-TAGS FROM WAIT QUEUE ENTRY DST TAGAD,I & SAVE IN ACTIVE DOWNLOAD ENTRY ISZ TPNT ISZ TPNT ADDR OF PGM # IN WAIT QUEUE ENTRY LDB TPNT,I PICKUP PGM # AND START DOWNLOADING IT JMP NEWLD HED PROGL SUBROUTINES & DATA AREA * (C) HEWLETT-PACKARD CO 1976 * * THIS SUBROUTINE SEARCHES FOR A DOWNLOAD TABLE ENTRY FOR * THE PASSED LU. RETURNS TO P+1 IF NOT FOUND, OTHERWISE P+2 * SRCH NOP LDA NACTV STA CNTR - # OF ACTIVE ENTRIES ALLOWED CLA INITIALIZE ADDR OF EMPTY SLOT STA TPNT LDB TABAD ADDR OF DOWNLOAD TABLE SNXT LDA 1,I PICKUP LU OF THIS ENTRY CPA LU DOES THIS ONE MATCH LU? JMP SRCHX YES, FOUND DOWNLOAD ENTRY IOR TPNT NO, IS THIS THE 1ST EMPTY SLOT? SZA,RSS SKIP IF EMPTY SLOT ALREADY FOUND STB TPNT STORE ADDR OF 1ST EMPTY SLOT ADB TLENT BUMP TABLE POINTER ISZ CNTR JMP SNXT TRY NEXT * LU NOT IN ACTIVE TABLE LDB TPNT RETURN 1ST EMPTY SLOT INSTEAD RSS RETURN +1 * * FOUND AN ENTRY IN THE ACTIVE DOWNLOAD TABLE FOR THIS LU SRCHX ISZ SRCH RETURN+2 STB CURAD SET ADDRESS OF ENTRY INB STB SEQAD & ADDRESS FOR SEQ # INB STB TAGAD & ADDRESS FOR TIME-TAGS ADB D2 STB DCBAD & ADDRESS FOR DCB JMP SRCH,I RETURN * * CLOSE DOWNLOAD FILE * CLSE NOP JSB CLOSE DEF *+3 DEF DCBAD,I DEF IERR JMP CLSE,I * * GET P[ROGL RESOURCE NUMBER FOR THIS LU FROM EQT EXTENSION+1 * AND PERFORM REQUESTED LOCK/UNLOCK ON IT * DORN NOP JSB DRTEQ GET EQT FOR LU DEF *+2 DEF LU SSB JMP CLNUP LU NOT FOUND, CLEAN OUT THIS ENTRY ADB D3 LDA 1,I PICK UP EQT 4 AND B77 ISOLATE SELECT CODE ALF,ALF STA SCODE SAVE FOR #RSAX CALL ADB D9 COMPUTE EQT13 ADDR LDB 1,I RBL,CLE,SLB,ERB JMP *-2 RESOLVE INB POINT TO EXTENSION + 1 LDA 1,I GET RESOURCE NUMBER STA PRN * JSB RNRQ DO REQUESTED OPERATION ON RN DEF *+4 DEF DORN,I DEF PRN DEF IERR * ISZ DORN JMP DORN,I * * DOWNLOAD TABLE IS FULL, PUT THIS REQUEST IN WAITING QUEUE * FULL LDA M4 LDB BUFR+1 2ND WORD OF PARMB SZB,RSS IS THIS AN SCE-1 DOWNLOAD? JMP TERM NO, GIVE A BUSY REJECT * LDA NQUE STA CNTR -QUEUE TABLE SIZE CLA STA TPNT LDB WAITA ADDR OF WAIT QUEUE CKQ LDA 1,I GET LU OF THIS ENTRY CPA LU DOES IT MATCH THIS REQUEST JMP BLDQ YES, THEN SET NEW PGM # & TIME-TAGS IOR TPNT CHECK IF THIS IS 1ST EMPTY SLOT IN QUEUE SZA,RSS SKIP IF NOT STB TPNT SAVE ITS ADDRESS ADB D2 BUMP QUEUE POINTER ISZ CNTR JMP CKQ EXAMINE NEXT ENTRY * * WE NOW KNOW THAT THIS LU WASN'T ALREADY IN WAIT QUEUE LDB TPNT GET ADDRESS OF 1ST EMPTY SLOT SZB,RSS WERE THERE ANY EMPTIES? JMP PGET NO, WE'RE IN TROUBLE LDA LU LU STA 1,I INTO 1ST WORD OF WAIT QUEUE ENTRY * BLDQ INB LDA BUFR+33 1ST WORD OF PASSED TIME-TAGS STA 1,I STORE IN WAIT QUEUE ENTRY INB LDA BUFR+34 2ND WORD STA 1,I INB LDA BUFR+1 PGM # STA 1,I GOES INTO 4TH WORD JMP PGET 0.* GO BACK TO SUSPEND ON GET * ERR1 CCA ERROR IN FILE OPEN JMP TERM ERR2 JSB CLSE ERROR IN FILE READ, DO CLOSE LDA M2 JMP TERM ERR3 JSB CLSE DRIVER ERROR, DO CLOSE LDA M3 JMP TERM * * DATA AREA * NAME BSS 3 IERR NOP ISTAT NOP ICLAS NOP PRN NOP TPNT NOP CNTR NOP TYPE NOP LENX NOP CONWD NOP POOLS NOP LU NOP SEQ# NOP SCODE NOP * D1 DEC 1 D2 DEC 2 D3 DEC 3 D7 DEC 7 D9 DEC 9 D21 DEC 21 M2 DEC -2 M3 DEC -3 M4 DEC -4 B77 OCT 77 B400 OCT 400 B377 OCT 377 D18N OCT 100022 MSK14 OCT 137777 ST/LS OCT 4402 * TLENT DEC 146 SIZE OF DOWNLOAD TABLE ENTRY NACTV ABS -#ACTV NQUE ABS #ACTV-#TERM MAXL DEC 255 LEN DEC 35 PARMB LENGTH ASC00 ASC 1,00 ASCP0 ASC 1,P0 * DBFAD DEF DBUF+1 TABAD DEF DT ADDR OF DOWNLOAD TABLE WAITA DEF WAITQ ADDR OF WAITING QUEUE * BUFR BSS 35 PARMB DBUF BSS 255 FILE INPUT BUFFER * * THE FOLLOWING RESERVES SPACE FOR THE ACTIVE DOWNLOAD TABLE DT REP #ACTV DOWNLOAD TABLE: LU,SEQ#,TAGS,& DCB BSS 148 * * THE FOLLOWING RESERVES SPACE FOR THE WAIT QUEUE WAITQ REP #TERM-#ACTV WAITING QUEUE: LU, TIME-TAGS, & PGM # BSS 4 * END PROGL n0  , 91700-18105 1553 S 0122 DS1/B CCE MODULE: OPERM              H0101 PASMB,L,R,C HED OPERM 91700-16105 REV A 751229 * (C) HEWLETT-PACKARD CO. 1976 NAM OPERM,2,30 91700-16105 REV A 751229 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT OPERM EXT MESSS,EXEC,D65SV,#MBRK IFZ EXT DBUG XIF * * * OPERM * SOURCE: 91700-18105 * BINARY: 91700-16105 * PRGMR: BOB SHATZER * DATE: 29 DEC 75 * * * * OPERM IS THE CCE MONITOR WHICH RECEIVES OPERATOR REQUESTS INIT- * IATED BY A REMOTE CPU. THIS MONITOR OPERATES ON STREAM 7. * * OPERM LDA B,I GET INPUT PARAMETER IFZ SZA,RSS IS IT A ZERO? JMP *+3 YES - CALL DEBUG XIF STA CLSN NO - NORMAL SCHEDULE - SAVE CLASS NUMBER JMP OPER1 GO TO GET THE FIRST REQUEST * IFZ JSB DBUG CALL DEBUG IF P1 WAS 0 DEF *+1 JSB EXEC TERMINATE...SAVE RESOURCES DEF *+4 DEF B6 DEF B0 DEF B1 JMP OPERM TRY AGAIN XIF * OPER1 JSB EXEC DO A CLASS GET AND WAIT FOR REQUEST DEF *+5 DEF D21 DEF CLSN CLASS # DEF PARMB REQUEST BUFFER DEF D35 MAX LENGTH =35 * LDA LNGTH GET LENGTH SZA,RSS IF ZERO...SEND BACK ZERO TO THEM JMP DONE * JSB #MBRK GO CHECK THE BREAK FLAG DEF *+4 DEF D7 STREAM DEF RLU REQUESTING LU DEF TTAGS TIME TAGS JMP OPER1 JMP OPER1 * JSB MESSS CALL SYSTEM MSG PROCESSOR WITH MESSAGE DEF *+3 DEF SMESG ?v   DEF LNGTH CMA,INA MAKE SYSTEM REPLY LENGTH POSITIVE BYTES STA LNGTH SAVE LENGTH * DONE LDA PARMB GET STREAM TYPE IOR BIT14 SET IN FOR REPLY STA PARMB SAVE AS REPLY STREAM LDB D35 GET 35 WORD REPLY LENGTH ALF ROTATE FRIENDLY BIT (BIT 11) TO BIT 15 SSA,RSS IS IT SET? (REUEST FROM SCE/4 OR /5) LDB D25 NO - SET REPLY LENGTH TO 25 WORDS STB RPYLN AND SAVE IT JSB D65SV SEND REPLY DEF *+7 DEF B2 DEF RLU DEF PARMB DEF RPYLN DEF B0 DEF B0 NOP ERROR RETURN POINT JMP OPER1 WAIT FOR ANOTHER REQUEST * B EQU 1 B0 OCT 0 B1 OCT 1 B2 OCT 2 B6 OCT 6 D7 DEC 7 D21 DEC 21 D25 DEC 25 D35 DEC 35 RPYLN NOP BIT14 OCT 40000 CLSN NOP PARMB BSS 35 LNGTH EQU PARMB+5 SMESG EQU PARMB+6 RLU EQU PARMB+24 TTAGS EQU PARMB+33 * END OPERM l   ' 91700-18106 1607 S 0122 DS1/B CCE MODULE: DLIST              H0101 RASMB,R,L,C HED DLIST 91700-16106 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM DLIST,2,30 91700-16106 REV A 760212 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************* * *DLIST DIRECTORY LIST PROGRAM FOR DS1/B * *SOURCE PART # 91700-18106 REV A * *REL PART # 91700-16106 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 9-18-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: DECEMBER 1975 * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * SPC 3 * * DEFINE ENTRY POINTS * ENT DLIST SPC 3 * * DEFINE EXTERNALS * EXT EXEC,D65SV,D65CL IFZ EXT DBUG XIF SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SKP * * MAIN ROUTINE STARTS HERE * DLIST NOP LDA B,I SEE IF THEY WANT DEBUG STA CLSSN SAVE CLASS NUMBER IFZ SZA DO THEY WANT DEBUG JMP DLST0 NO JSB DBUG DEF *+1 JSB EXEC DEF *+4 DEF D6 DEF D0 DEF D1 JMP DLIST XIF SPC 1 DLST0 JSB EXEC DO A GET CALL DEF *+5 DEF D21 DEF CLSSN DEF STYP DEF D35 LDA RLU AND MSK1 KEEP ONLY THE LOWER BITS OF THE COMM. LU STA RLU LDA BROUT GET ADDRESS OF CURRENT COROUTINE SZA,RSS JMP SUB1 m8 JMP A,I GO TO SPECIFIED SUBROUTINE SPC 2 SUB2A DEF SUB2 SUB3A DEF SUB3 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB6A DEF SUB6 SUB7A DEF SUB7 DON1A DEF DONE1 SKP * * HERE ON NEW REQUEST * SUB1 LDA DBFA GET AD OF WHERE DIR DATA INFO STORED INFO STA LUDSP SAVE FOR LU LOOPING SUB2 LDA D2 GET ADDRESS OF SYSTEM DISK STA WCLU SAVE AS WANTED LU LDA TATSD GET # OF TRACK IN SYSTEM DISK ADA M1 GET TO LAST TRACK STA WTRCK SAVE IN WANT TRACK CLB SET FOR SECTOR ZERO STB WSEC SET WANT SECTOR TO ZERO LDA D128 READ 128 WORDS JSB GETSC GET THE SECTOR LDA LUDSP,I GET LU OF CARTRIDGE SZA,RSS DONE? JMP DONE YES LDA BROUT SEE IF FIRST TIME SZA JMP SUB22 NOT FIRST TIME LDB MCODF SEE IF THEY SUPPLIED A MASTER CLE,SZB,RSS JMP SUB21 CMB,INB CODE, AND IF THEY DID, DOES ADB MSCA,I IT MATCH CLE,SZB,RSS IF MATCH,SET E REG CCE MATCH ON SECURITY CODE...SET E REG LDA MCODF SEE IF SECURITY CODE PRESENT LDB MSCA,I GET ACTUAL VALUE SZB,RSS IF MASTER SECURITY CODE...DON'T CHECK SZA,RSS DID THEY SUPPLY ONE, WHEN THERE WASN'T ONE? RSS NO...ONE NOT SUPPLIED CCE ONE SUPPLIED...SET TO ALLOW CLA SET FLAG SUB21 ELA STA MCODF SAVE MASTER SECURITY CODE MATCH SUB22 LDA CRLU DO THEY WANT A SPECIFIED LU? SZA,RSS LU SUPPLIED? JMP MCR NO LDB LUDSP GET DISPLACEMENT CMA,INA ASSUME LU SSA,RSS IS IT LABEL? JMP SUB23 NO...LU CMA,INA YES...LABEL...MAKE POS AGAIN ADB D2 AND GET TO LABEL WORD SUB23 CPA B,I IS LABEL OR LU MATCH? JMP MCR MATCH...PROCESS LU LDA LUDSP NO MATCH GO TO NEXT ONE ADA D4g STA LUDSP JMP SUB2 SKP * * ROUTINE TO PROCESS A MOUNTED CARTRIDGE * SPC 1 MCR LDA SUB5A SET UP FOR RETURN AFTER SENDING THE LINE STA BROUT LDA SECT2 GET # OF SECTORS IN TRACK STA SCTRK SAVE IN SECTORS/TRACK LDA LUDSP,I GET LU OF DISK STA WCLU SAVE AS WANTED CURRENT LU ISZ LUDSP GET TO FIRST DIRECTORY TRACK LDB LUDSP,I GET DIRECTORY TRACK ADDRESS STB WTRCK SAVE TRACK ADDRESS ISZ LUDSP GET TO LOCK WORD ISZ LUDSP LDB LUDSP,I GET LOCK WORD ISZ LUDSP GET TO NEXT ENTRY SZB IS LU LOCKED JMP SUB2 YES CLB ASSUME NOT LU 2 CPA D2 IS IT SYSTEM DISC? LDB D14 YES STB WSEC SAVE STARTING SECTOR ADDRESS LDA DBFA SET FOR ZERO DISPLACEMENT WITHIN BUFFER JSB SCFX GO GET SECTOR JMP SUB2 NO DIRECTORY? LDA DISP GET NAME OF CART. JSB NMOVE MOVE CR NAME TO OUTPUT BUFFER DEF CRNA LDA CRNA GET FIRST WORD OF CR NAME AND B7777 GET RID OF SIGN BIT STA CRNA RESTORE LDA DISP GET TO LABEL WORD ADA D3 LDA A,I CONVERT LABEL WORD TO ASC JSB BNDEC DEF LWA LABEL WORD ADDRESS LDB DISP GET TO # SEC/TRACK ADB D6 LDA B,I GET # OF SECTORS/TRACK STA SCTRK SAVE AS # OF SECTORS/TRACK ADB D2 GET TO # OF DIRECTORY TRACKS LDA B,I ADA WTRCK GET ENDING DIRECTORY TRACK STA NTRKS LDA B,I GET # OF DIRECTORY TRACKS CMA,INA MAKE # POS. JSB BNDEC CONVERT TO ASC DEF DTRKA LDA DTRKA+2 MOVE UP THE LEAST SIGNIFICANT DIGITS STA DTRKA THEY ARE THE ONLY ONES TO BE PRINTED JSB WTLIN SEND LINE TO TERMINAL DEF HEAD1 FIRST HEADING LINE JMP TERM WAIT FOR HIM TO RETURN  SKP * * HERE AFTER FIRST HEADING LINE WRITTEN * SUB3 LDA SUB4A GET ADDRESS WHERE TO GO NEXT TIME STA BROUT JSB WTLIN SEND OUT SEND HEADING LINE DEF HEAD2 JMP TERM GO WAIT FOR HIM TO RETURN SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE * SUB5 LDA SUB3A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN SEND OUT BLANK LINE DEF BLNKL JMP TERM GO WAIT FOR HIM TO RETURN SPC 5 * * HERE TO START OUTPUTING DIRECTORY * SUB4 LDA DISP GET FILE ENTRY ADA D16 JSB SCFX SEE IF WE NEED NEW SECTOR JMP SUB2 DONE...NO MORE DIRECTORY LDA DISP,I IS THIS FILE PURGED SSA JMP SUB4 YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU JSB MDLIN MOVE THE LINE JMP SUB4 ERROR CONDITION JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE JMP TERM WAIT FOR HIM AGAIN SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB6 LDA SUB7A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL JMP TERM SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB7 LDA SUB2A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL JMP TERM SKP * * SUBROUTINE TO MOVE DETAIL LINE TO PRINT LINE * CALLING SEQUENCE * JSB MDLIN * NO MATCH RETURN...IE..FILTER MIS-MATCH,TYPE NO MATCH * NORMAL RETURN * SPC 1 MDLIN NOP LDA FLTR IS FILTER SPECIFIED SZA NO CPA SPACA OR IS IT ALL SPACE? JMP NDLN2 NOT SUPPLIED OR SPACE LDA FLTRA GET ADDRESS WHERE FILTER LOCATED CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP SAVE FILTER BYTE ADDRESS LDA DISP $\GET ADDRESS OF NAME CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP1 SAVE IN BYTE ADD COUNTER LDA M6 # OF CHAR IN FILTER STA TEMP2 SAVE IN DOWN COUNTER MDN11 LDB TEMP GET BYTE ADD OF FILTER JSB ABYTE GET BYTE SZA,RSS IF ZERO, CHANGE TO SPACE LDA C40 C40=SPACE CPA FLTRC IS IT A "*"? JMP MDN12 YES...DON'T CHECK STA TEMP3 SAVE IN TEMP LOCATION LDB TEMP1 GET BYTE ADDRESS OF NAME JSB ABYTE GET BYTE CPA TEMP3 IS THERE A MATCH? RSS YES JMP MDLIN,I NO...IGNORE ENTRY MDN12 ISZ TEMP GET TO NEXT ENTRY ISZ TEMP1 ISZ TEMP2 DONE? JMP MDN11 NO SPC 2 * * AFTER CHECKING NAME, CHECK TYPE * NDLN2 LDB DISP GET TO FILE TYPE ADB D3 LDB B,I LDA FTYP CHECK WITH FILE TYPE PASSED RAL,CLE,ERA IS THERE A FILE TYPE? SEZ FILE TYPE SPECIFIED CPA B YES...DOES IT MATCH RSS MATCH...OR NO FILE TYPE SPECIFIED JMP MDLIN,I FILE TYPE NOT MATCHED STB FTYPT SAVE TYPE IN TEMP FOR LATTER LDA B JSB BNDEC CONVERT FILE TYPE TO ASC DEF DTYPA LDA DISP MOVE NAME TO OUTPUT LINE JSB NMOVE DEF DNAMA LDA DISP GET # OF SECTORS OR LU ADA D4 ASSUME LU LDB FTYPT SEE IF TYPE=0 SZB YES? ADA D2 NO...GET # OF SECTORS LDA A,I GET VALUE SZB IF LU...DON'T DIVIDE BY 2 CLE,ERA CONVERT TO # OF BLOCKS JSB BNDEC CONVERT TO ASC DEF DBSLU LDB DISP GET TO SECURITY CODE ADB D8 LDA B,I GET SECURITY CODE JSB BNDEC CONVERT TO ASC DEF DSECA LDB FTYPT CHECK IF THIS REC AN EXTENT LDA DISP ADA D5 LDA A,I IF EXTENT...CAN'T BE TYPE=0 AND UB377 NO EXTENT A=0 SZB IF TYPE 0...DON'T CHECK FOR EXTENT SZA,RSS NOT TYPE 0...EXTENT? ISZ MDLIN NOT EXTENT..OR TYPE 0 NORM RETURN LDA DLLWS LENGTH OF DETAIL LINE WITH S.C. LDB MCODF SUPPLY SECURITY CODE? SZB,RSS LDA DLLS NO...LENGTH WITHOUT SECURITY CODE STA DLINA SAVE FOR TRANSFER JMP MDLIN,I RETURN SPC 1 FTYPT NOP DLLWS DEC 16 DLLS DEC 12 D5 DEC 5 SKP * * HERE WHEN WE ARE ALL DONE * DONE LDA BROUT SEE IF WE SENT THEM ANYTHING SZA JMP DONE1 YES...JUST TERMINATE LDA DON1A GET ADDRESS OF TERMINATION POINT STA BROUT JSB WTLIN SEND "DISK NOT MOUNTED" DEF NOCRM JMP TERM * DONE1 JSB D65CL SEND STOP DEF *+3 DEF D3 CONTROL REQUEST DEF RLU 0 IS THE MODE FOR STOP JSB CMER ERROR RETURN * LDA BIT14 TELL OTHER SIDE, ALL DONE RSS SPC 5 * * HERE WE TERMINATE BY SENDING REPLY * TERM CLA SET FOR MORE TO COME STA STAT SAVE STATUS LDA STYP GET STREAM TYPE IOR BIT14 SET FOR REPLY STA STYP AND B4000 ISOLATE THE F BIT LDB D35 GET F. LENGTH SZA,RSS BIT SET ? LDB D20 NO, OLD LENGTH STB RPLYL SAVE JSB D65SV SEND REPLY DEF *+7 DEF IRWW WRITE DEF RLU REQUEST ONLY DEF STYP DEF RPLYL REPLY LENGTH DEF DUMMY DEF DUMMY * JSB CMER ERROR REPLY JMP DLST0 GO DO A GET CALL SKP * * SUBROUTINE TO SEND DATA TO REMOTE * CALLING SEQUENCE * JSB WTLIN * DEF BUFFER * BUFFER FORMAT * LENGTH WORD, DATA BUFFER * WTLIN NOP LDA WTLIN,I GET ADDRESS OF OUPUT LINE INA GET TO FIRST DATA WORD STA WTLNB LDA RLU GET COMM. LU IOR MSK3 SEND DATA STA IMODE * JSB D65CL DEF *+7 DEF IRWW DEF IMODE WTLNB NOP DATA BUFFER DEF LNGH DEF TAGS DEF TAGS+1 JMP BAD ERROR RETURN * LDB WTLIN,I GET LENGTH OF MESSAGE LDB B,I LDA LNGH GET AVAILABLE LENGTH CMA,INA ADA B SEE IF THERE WAS TO MUCH ROOM SSA CHANGE LENGTH? STB LNGH YES...SET IN CORRECT LENGTH ISZ WTLIN GET RETURN ADDRESS JMP WTLIN,I RETURN SPC 3 BAD JSB CMER JMP DLST0 SKP * * SUBROUTINE TO MOVE NAME TO OUTPUT BUFFER * CALLING SEQUENCE * JSB NMOVE * DEF DESTINATION BUFFER * A REG=SOURCE ADDRESS * WILL MOVE 3 WORDS * NMOVE NOP LDB NMOVE,I GET DESTINATION ADDRESS STB NMOV1 SAVE IN TEMP LOCATION LDB M3 GET DOWN COUNT STB NMOV2 NMOVA LDB A,I GET DATA STB NMOV1,I SAVE DATA INA GET NEXT ADDRESS ISZ NMOV1 ISZ NMOV2 JMP NMOVA NOT DONE...CONTINUE ISZ NMOVE GET TO RETURN ADDRESS JMP NMOVE,I RETURN SPC 2 NMOV1 NOP NMOV2 NOP SKP * * SUBROUTINE TO KEEP DISPLACEMENT ON DISK OK * CALLING SEQUENCE * JSB SCFX * NO MORE DIRECTORY TRACK RETURN * NORMAL RETURN * A REG=DISPLACEMENT * UPON RETURN * WILL UPDATE WTRCK,WSEC,AND DISP AS REQUIRED * ASSUMES DISP STARTS WITH ADDRESS OF BUFFER * SCTRK MUST BE SET TO # OF SECTORS/TRACK * IF TRACK CHANGES, NTRCK=LAST DIRECTORY TRACK-1 * ALL SECTORS ARE ASSUMED TO BE 128 WORDS LONG * SPC 1 SCFX NOP CMA,INA NEGATE ADDRESS ADA DBFA GET DISPLACEMENT CMA,INA MAKE IT POSITIVE CLB CHECK IF OVERFLOW DIV D128 CROSS A SECTOR BOUNDRY ADB DBFA GET DISPLACEMENT AS AN ADDRESS STB DISP SAVE DISPLACEMENT ADDRESS SZA,RSS  SECTOR CHANGE JMP SCFXA NO LDA D14 YES...GET TO NEXT SECTOR ADA WSEC GET TO NEXT SECTOR ADDRESS CLB DIV SCTRK SEE IF WE HAVE A HAVE LOOPED AROUND STB WSEC SAVE NEW SECTOR ADDRESS SZA IF NO ROLLOVER OR SZB NO NEW TRACK NEEDED JMP SCFXA DON'T UPDATE TRACK ADDRESS CCB UPDATE TRACK ADDRESS ADB WTRCK GET TO NEXT TRACK CPB NTRKS DONE? JMP SCFX,I YES STB WTRCK NO...SET IN NEW TRACK ADDRESS SCFXA LDA D128 DO A 128 WORD READ JSB GETSC ISZ SCFX GET TO RETURN JMP SCFX,I RETURN SKP * * SUBROUTINE TO READ A SECTOR * CALLING SEQUENCE * JSB GETSC * THE FOLLOWING MUST BE SET UP * WTRCK,WSEC,WCLU * GETSC NOP STA BUFL SAVE BUFFER READ LENGTH LDA WTRCK GET CURRENT TRACK ADDRESS CPA CTRCK SAME AS ONE WE GOT NOW? RSS YES JMP GTSC1 NO...GO READ IT LDA WSEC IS IT THE SAME SECTOR CPA CSEC ? RSS YES JMP GTSC1 NO...GO READ IT LDA WCLU SAME LU? CPA CCLU JMP GETSC,I YES...DON'T READ SECTOR GTSC1 LDA WCLU SET UP AS CURRENT STA CCLU LDA WTRCK STA CTRCK LDA WSEC STA CSEC JSB EXEC GO READ A SECTOR DEF *+7 DEF D1 DEF WCLU DEF DBUF DEF BUFL DEF WTRCK DEF WSEC JMP GETSC,I GOT SECTOR, RETURN SPC 2 CTRCK OCT -1 CSEC OCT -1 CCLU OCT -1 BUFL NOP SKP * * SUBROUTINE CONVERT BINARY TO DECMAL * CALLING SEQUENCE * JSB BNDEC * DEF BUFFER WHERE TO ASC * A REG=BINARY # * BNDEC NOP STA DTEMP SAVE BINARY # LDB BNDEC,I GET ADDRESS WHERE TO ASC CLE,ELB CONVERT TO BYTE ADDRESS STB DTMP1 SAVE BYTE ADDRESS ISZ BNDEC GET TO RŗETURN ADDRESS LDA DNMA GET ADDRESS OF DIVISORS STA DTMP2 SAVE FOR DIVIDING LDA M5 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER LDA C40 GET A SPACE CHARACTERR LDB DTEMP GET BINARY VALUE SSB,RSS IF NEGATIVE...CONVERT JMP BNDCB NOT NEGATIVE CMB,INB NEGATIVE, MAKE POSITIVE STB DTEMP LDA C55 SET IN NEG SIGN BNDCB LDB DTMP1 GET BYTE ADDRESS JSB SBYTE SAVE SIGN ISZ DTMP1 GET NEXT BYTE ADDRESS BNDCA LDA DTEMP GET BINARY # CLB GET A ZERO DIV DTMP2,I STB DTEMP SAVE REMAINDER ADA C60 CONVERT TO ASC LDB DTMP1 GET CURRENT BYTE ADDRESS JSB SBYTE SAVE ASC BYTE ISZ DTMP2 GET NEXT DIVISOR ISZ DTMP1 GET NEXT BYTE ADDRESS ISZ DTMP3 DONE? JMP BNDCA NO JMP BNDEC,I RETURN SPC 1 C55 OCT 55 DTEMP NOP DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM DNM DEC 10000,1000,100,10,1 SKP * * SBROUTINE TO GET A BYTE * CALLING SEQUENCE * JSB ABYTE * B REG= BYTE ADDRESS * A REG= BYTE * UPON RETURN * B AND A REG UNCHANGED * ABYTE NOP CLE,ERB CONVERT TO WORD ADDRESS LDA B,I GET WORD SEZ,RSS CHECK WHICH HALF ALF,ALF AND B377 GET BYTE ELB,CLE GET BYTE ADDRESS AGAIN JMP ABYTE,I RETURN SPC 3 * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS THE BYTE * B REG CONTAINS THE BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA STEMP SAVE IN TEMP LOCATION CLE,ERB CONVERT TO WORD ADDRESS LDA B,I GET WORD SEZ,RSS RIGHT OR LEFT HALF? ALF,ALF LEFT AND UB377 MASK ALL BUT UPPER 8 BITS IOR STEMP OR IN NEW HALF SEZ,RSS LE$FT OR RIGHT? ALF,ALF LEFT STA B,I SAVE WORD ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN SPC 1 STEMP NOP SPC 3 CMER NOP DST ERVAL JSB EXEC DEF *+5 DEF D2 DEF D1 DEF ERMS DEF ERML * JMP CMER,I SPC 3 ERMS ASC 9,DLIST: COMM. ERROR ERVAL BSS 2 ERML DEC 11 SKP * * DCB LAYOUT * STYP NOP STREAM TYPE BSS 1 NOT USED STAT NOP STATUS ECOD NOP ERROR CODE LNGH NOP LENGTH WORD FLTR ASC 3, NAME FILTER...0..NO FILTER MCODF NOP MASTER SECURITY CODE CRLU NOP LU OF CART. TO DO FTYP NOP FILE TYPE FILTER BROUT NOP ADDRESS OF CURRENT ROUTINE TO PROCESS 0=START WCLU NOP CURRENT LU FOR DISK READ WTRCK NOP CURRETN TRACK TO READ WSEC NOP CURRENT SECTOR TO READ DISP NOP DISPLACEMENT IN BUFFER SCTRK NOP # OF SECTORS/TRACK LUDSP NOP DISPLACEMENT IN DIRECTORY LU NTRKS NOP # OF DIRECTORY TRACKS * * HERE WE FILL TO GET TO 35 WORD REQ * BSS 5 RLU NOP DEFINED IN QUEUE...LU OF WHO WE ARE TALKING TO BSS 8 TAGS BSS 2 SPC 2 RPLYL NOP LENGTH OF DIRECTORY PARMB B377 OCT 377 C40 OCT 40 C60 OCT 60 D3 DEC 3 D8 DEC 8 UB377 OCT 177400 D35 DEC 35 D21 DEC 21 D14 DEC 14 D20 DEC 20 B4000 OCT 4000 D16 DEC 16 D128 DEC 128 D4 DEC 4 D1 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 M3 DEC -3 M5 DEC -5 M6 DEC -6 MSK1 OCT 77 MSK3 OCT 300 IRWW OCT 100002 DUMMY NOP IMODE NOP B7777 OCT 77777 BIT14 OCT 40000 FLTRA DEF FLTR FLTRC OCT 52 TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP * TATSD EQU 1756B SECT2 EQU 1757B DBFA DEF DBUF MSCA DEF DBUF+126 CLSSN NOP SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 DEC 27 SPACA ASC 1, *B@< ASC 3,ILAB= CRNA ASC 3, ASC 1, ASC 7,REMOTE DLIST ASC 2,CR#= LWA ASC 3, ASC 1, ASC 5,DIR TRKS= DTRKA ASC 3, SPC 1 HEAD2 DEC 16 ASC 16, NAME TYPE #BLKS/LU SCODE SPC 1 NOCRM DEC 8 ASC 8,DISK NOT MOUNTED DLINA DEC 16 ASC 1, DNAMA ASC 3, ASC 1, DTYPA ASC 3, ASC 1 DBSLU ASC 3, ASC 1, DSECA ASC 3, SPC 2 BLNKL DEC 1 OCT 20040 DBUF BSS 128 SPC 3 END EQU * END DLIST *B !1 91700-18107 1609 S 0122 DS1/B CCE MODULE: UPLIN              H0101 NASMB,R,L,C HED UPLIN 91700-16107 REV A * (C) HEWLETT-PACKARD CO. 1976 * NAM UPLIN,3,3 91700-16107 REV A 760225 SUP SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * * NAME: UPLIN * SOURCE: 91700-18107 * RELOC: 91700-16107 * PGMR: CHUCK WHELAN [12/5/75] * * * SPC 2 * EXTERNAL REFERENCES EXT EXEC,$LIBR,$LIBX EXT MESSS EXT #RSAX EXT #LDEF,#RFSZ,#RXCL EXT RNRQ,#BUSY,#QRN SPC 3 * UPLIN FOR DS-1B' UPLIN IS SCHEDULED EVERY 5 SECONDS TO PERFORM * THE FOLLOWING FUNCTIONS: * 1. CHECKS/WAITS FOR SYSTEM QUIESCENCE. PRINTS OPERATOR MESSAGE * WHEN QUIESCENCE IS ACHIEVED. * 2. UPDATES SLAVE "TCB" TIMEOUT VALUES, AND IF A TRANSACTION HAS * TIMED OUT, DOES THE FOLLOWING: * A) IF MONITOR IS I/O SUSPENDED DOES NOTHING UNLESS THE EQT TIMER * IS ZERO AND THE "D" BIT IS SET IN WHICH CASE IT STORES A -1 IN * EQT 15 TO FORCE A QUICK TIMEOUT TO THE DRIVER. * B) IF MONITOR IS IN ANY OTHER STATUS, THE TCB IS PURGED, AND IF * THE BREAK FLAG WASN'T SET AND THE EQT "AND DATA" BIT WAS SET, * A STOP IS SENT VIA THE DRIVER. IF THE MONITOR ABORT FLAG IS * SET, THE MONITOR IS THEN ABORTED. * 3. AFTER PROCESSING EACH SLAVE TCB LIST, UPLIN CHECKS TO SEE IF * THE CORRESPONDING MONITOR IS DORMANT, AND IF SO, RESCHEDULES IT. * 4. UPDATES MASTER TCB TIMEOUT VALUES, AND IF A MASTER TCB TIMES-OUT, * IT CHECKS THE PROGRAM STATUS. IF DORMANT, THE MASTER CLASS NUMBER * AND THE TCB ARE CLEARED. IF I/O SUSPENDED AND EQT15 IS ZERO * IT STORES A -1 IN EQT15 TO FORCE A QUICK TIME-OUT TO THE DRIVER. * IF IN A "WAIT" STATE AND THE I/O COMPLETION FLAG IN THE TCB * IS SET, IT WRITES A NULL REQUEST TO THE MASTER REQUESTER'S * CLASS. * 5. RESCHEDULES "GRPM","SRPM", OR "QCLM" IF THEY ARE DORMANT. * 6. CHECKS FOR ANY DOWNED COMMUNICATIONS EQTS, AND DOES "ENABLE * LISTEN" REQUESTS TO ANY FOUND. * * * EQTA EQU 1650B FWA OF EQUIPMENT TABLE DRT EQU 1652B FWA OF DEVICE REFERENCE TABLE LUMAX EQU 1653B NO OF LOGICAL UNITS (IN DRT) INTBA EQU 1654B FWA OF INTERRUPT TABLE BPA1 EQU 1742B FWA RT DISC RES BP LINK AREA SKP UPLIN EQU * * * CHECK FOR SYSTEM QUIESCENCE * LDA GLCW GET GLOBAL RN LOCK/CLEAR COMMAND RAL,ARS SET THE NO-WAIT BIT QRNWT STA RNCW SAVE CONFIGURED CONTROL WORD * JSB RNRQ GO TO RTE TO REQUEST DEF *+4 RESOURCE NUMBER STATUS, DEF RNCW OR TO AWAIT CLEARING OF THE RN. DEF #QRN ADDR OF QUIESCENT RN DEF TEMP RETURN STATUS JMP SLVTS IGNORE ERRORS * LDA RNCW IF PROGRAM HAS BEEN AWAITING CPA GLCW THE CLEARING OF #QRN, THEN JMP SLVTS BYPASS THE MESSAGE CODE. * LDA TEMP QRN STATUS LDB #BUSY ACTIVE TCB COUNT CPA K7 IF QRN WAS LOCKED GLOBALLY, SZB AND NO ACTIVE TCB'S EXIST, SKIP JMP SLVTS ELSE BYPASS QUIESCENT CODE. * JSB EXEC INFORM DEF *+5 THE DEF K2 OPERATOR DEF K1 THAT THE DEF QMES SYSTEM DEF K10 IS QUIESCENT. * LDA GLCW RETURN TO IMMOBILIZE UPLIN JMP QRNWT SKP * * THIS SECTION PROCESSES SLAVE TRANSACTIONS & MONITORS * SLVTS LDA BPA1 CPA K2 IS THIS AN RTE-III OR RTE-IV? RSSI RSS YES JMP SLVT2 NO LDB RSSI GET "RSS"  STB MODI1 MODIFY TO DO CROSS-MAP STORE STB MODI2 MODIFY TO DO CROSS-MAP LOAD * SLVT2 LDA NAMES ADDR OF SLAVE MONITOR NAMES STA NPNT LDA K2 STA ST.LS SLAVE/STREAM ID FOR #RSAX ADA #LDEF STA LPNT PNTR TO SLAVE LIST HEADER ADDRS IN RES LDA N10 NUMBER OF MONITORS STA LCNT COUNTER= - # OF MONITORS * CKLST LDB LPNT,I GET ADDRESS OF HEADER INB STB MCLSA SAVE ADDR OF MONITOR CLASS # INB STB MSEGA ADDR OF MONITOR'S ID SEGMENT ADDR LDB LPNT,I NXTCB STB LSTAD SAVE ADDR OF ADDR OF NEXT TCB * * ENTER HERE TO CHECK EACH SLAVE TCB * CKTCB LDB LSTAD PICK UP ADDR OF ADDR OF TCB JSB LODWD (CROSS)LOAD ADDR OF TCB SZA,RSS IS IT THERE? JMP CKMON NO, END OF THIS LIST JSB TSTCB BUMP TIMER IN TCB JMP NXTCB DIDN'T TIMEOUT, CHECK NEXT TCB SKP * * SLAVE TRANSACTION HAS TIMED OUT * INB TCB ADDR+1 JSB LODWD PICK UP 2ND WORD STA TEMP AND SCMSK ISOLATE SELECT CODE (BITS 13-8) STA PRAM1 * LDA MSEGA,I GET MONITOR'S ID SEG ADDR RAL,CLE,ERA CLEAR SIGN ADA K15 POINT TO STATUS LDA 0,I AND K15 ISOLATE STATUS CPA K2 IS IT IN "I/O SUSPEND"? JMP SLVCK YES, JUMP INB COMPUTE ADDR OF TIME-TAGS JSB LODWD (CROSS)LOAD 1ST TIME TAG WORD STA TAGS INB JSB LODWD (CROSS)LOAD 2ND TIME TAG WORD STA TAGS+1 * JSB #RSAX DELETE SLAVE TCB DEF *+5 DEF K3 DEF ST.LS SLAVE/STREAM ID DEF PRAM1 SELECT CODE DEF TAGS TIME-TAGS * SZA SKIP IF ENTRY DELETED JMP NXLST WHOOPS! IGNORE THIS LIST LDA TEMP RAL,SLA TEST BREAK FLAG JMP CKABT SET, NO STOP REQUIRED SSA,RSS WAS IT A REQ. & DATA? JMP CKABT NO, NO STOP REQUIRED * * SEND A STOP TO CLEAR THE PENDING DATA REQUEST JSB GTEQT COMPUTE ADDR OF EQT LDA EQTA CMA,INA ADA 1 THIS ADDR - 1ST EQT ADDR CLB STB LU DIV K15 COMPUTE RELATIVE EQT NUMBER STA TEMP LDA LUMAX # OF LUS CMA,INA STA CNTR COUNT TO CORRECT LU NUMBER LDB DRT DEVICE REF TABLE ADDRESS * SEARCH FOR THIS EQT NUMBER IN DEVICE REFERENCE TABLE FNDEQ ISZ LU LU NUMBER FOR THIS DRT ENTRY LDA 1,I PICK UP DRT ENTRY AND B77 ISOLATE EQT # CPA TEMP IS THIS OUR EQT? JMP STPIT YES INB BUMP DRT POINTER ISZ CNTR JMP FNDEQ TRY NEXT JMP CKABT SC MUST BE INVALID, IGNORE IT * * IF MONITOR IS I/O SUSPENDED ON COMM. EQT & EQT15=0, SET EQT15=-1 SLVCK JSB GTEQT COMPUTE EQT ADDRESS LDA MSEGA,I GET ID SEG ADDR OF MONITOR RAL,CLE,ERA CLEAR SIGN CPA 1,I IS MONITOR ID BSEG ADDR IN EQT1? JSB EQTIM YES, CHECK/SET EQT15 LDB XACTA JMP NXTCB CHECK NEXT TCB * * CALL DVR TO SEND A STOP STPIT JSB EXEC DEF *+3 DEF K3N DEF LU MODE 0 = SEND STOP NOP * * CHECK MONITOR ABORT FLAG CKABT LDA MSEGA,I SSA,RSS SKIP IF SET JMP CKTCB NOT SET, DON'T ABORT IT, CHECK NEXT TCB * * ABORT THE MONITOR BY GENERATING AN "OF,(NAME),1" MESSAGE * LDA NPNT STA TEMP LDB COMMA COMMA IN 1ST LHW LDA TEMP,I 1ST 2 CHARACTERS OF NAME LSL 8 POSITION "," AND 1ST CHARACTER IN B REG STB MSNAM MOVE TO FIELD FOR "OF" LSL 8 ISZ TEMP LDA TEMP,I GET 3RD & 4TH CHARS OF NAME LSL 8 POSITION 2ND & 3RD CHARS IN B REG STB MSNAM+1 LSL 8 ISZ TEMP LDA TEMP,I GET 5TH CHAR OF NAME LSL 8 POSITION 4TH & 5TH CHARS IN 4B REG STB MSNAM+2 * JSB MESSS CALL RTE MESSAGE PROCESSOR DEF *+3 DEF OFMES "OF,XXXXX,1" DEF K10 NOP JMP UPMON NOW GO & RESCHEDULE IT * * THIS CODE CHECKS MONITOR STATUS TO SEE IF IT HAS ABORTED CKMON LDA MSEGA,I MONITORS ID SEGMENT ADDRESS RAL,CLE,ERA CLEAR OFF SIGN BIT SZA,RSS ADDR SPECIFIED? JMP NXLST NO ADA K15 COMPUTE ADDR OF STATUS LDA 0,I AND K15 ISOLATE STATUS BITS SZA SKIP IF DORMANT JMP NXLST ELSE MONITOR IS STILL GOING * * RESCHEDULE MONITOR UPMON LDA MCLSA,I GET CLASS NUMBER OF MONITOR RAL,CLE,ERA CLEAR SIGN BIT STA PRAM1 LDB NPNT,I 1ST 2 CHARS OF MONITOR NAME CPB RFASC IS IT "RF" JMP RFAGO DO "RFAM" SCHEDULE * JSB EXEC SCHEDULE MONITOR, PASS CLASS NUMBER DEF *+4 DEF K10N NPNT NOP ADDR OF MONITOR NAME DEF PRAM1 NOP JMP NXLST * RFAGO JSB EXEC SCHEDULE "RFAM" DEF *+7 DEF K10N SCHEDULE WITH "NO ABORT" DEF RFASC DEF K99 DEF #RFSZ NUMBER OF RFA ENTRIES FROM "RES" DEF PRAM1 CLASS NUMBER DEF #RXCL RFAEX CLASS NOP * * DONE WITH THIS SLAVE LIST, START ON NEXT NXLST ISZ NPNT ISZ NPNT ISZ NPNT UPDATE POINTER TO MONITOR NAME ISZ LPNT POINT TO NEXT LIST HEADER ADDRESS LDA ST.LS ADA B400 NEXT SLAVE/STREAM ID STA ST.LS ISZ LCNT COUNT # OF MONITORS JMP CKLST PROCESS NEXT LIST * * DONE WITH SLAVE MONITOR/TRANSACTION PROCESSING * SKP * * PROCESS MASTER TCBS * LDB #LDEF ADDR OF LIST HEADER ADDRS INB LDB 1,I GET ADDR OF MASTER HEADER CKMST STB LSTAD SAVE ADDR OF NEXT TCB'S ADDR CKMS2 LDB LSTAD PICK-UP ADDR OF ADDR OF NEXT TCB JSB LODWD (CROSS)LOAD ADDR OF NEXT TCB SZA,RSS JMP RSCHD NO MORE MASTER TCBS TO PROCESS * JSB TSTCB UPDATE THIS TCB'S TIME JMP CKMST DIDN'T TIME-OUT, DO NEXT TCB * * MASTER TCB HAS TIMED OUT * ADB K2 POINT TO 3RD WORD OF MASTER TCB JSB LODWD (CROSS)LOAD CLASS NUMBER IOR BIT15 CLASS # WITH "NO WAIT" BIT SET STA PRAM1 * INB POINT TO 4TH WORD OF MASTER TCB JSB LODWD (CROSS)LOAD ID SEGMENT ADDRESS RAL,CLE,ERA CLEAR OFF SIGN BIT ADA K15 POINT TO STATUS LDA 0,I AND K15 ISOLATE STATUS SZA,RSS DORMANT? JMP CREPT YES, CLEAR IT ALL CPA K3 IS IT "WAIT" STATE? JMP MWAIT YES CPA K2 IS IT IN I/O SUSPEND? JSB EQTIM YES, CHECK/SET EQT15 JMP NXMST * * MASTER REQUESTER IS IN STATE 3 AFTER TCB TIMEOUT MWAIT ADB N2 POINT TO 2ND TCB WORD JSB LODWD (CROSS)LOAD IT SSA,RSS TEST ITS I/O COMPLETION FLAG JMP NXMST NOT SET, DO NOTHING * * WRITE A NULL REQUEST INTO THE MASTER REQUESTERS CLASS JSB EXEC DEF *+8 DEF K20N CLASS WRITE/READ, NO ABORT DEF K0 DEF DUMMY DEF K0 ZERO LENGTH DEF DUMMY DEF DUMMY DEF PRAM1 CLASS NUMBER * K0 NOP * NXMST LDB XACTA GET ADDR OF NEXT TCB ADDR JMP CKMST GO CHECK FOR NEXT TCB * * MASTER REQUESTER IS DORMANT, CLEAR CLASS AND TCB * CREPT CCA SET THE RELEASE RE-TRY SWITCH STA TEMP TO -1 * CLRTN JSB EXEC GO TO RTE TO RELEASE CLASS NUMBER DEF *+5 DEF K21N CLASS GET/NO ABORT DEF PRAM1 MASTER CLASS/RELEASE/NO WAIT DEF K0 DEF K0 RSS IGNORE ERRORS ISZ TEMP RELEASE PROCESSING COMPLETED? JMP CLRES YES. GO TO CLEAR THE TCB INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP CREPT T` NO. CONTINUE TO CLEAR REQUESTS * LDA PRAM1 GET THE CLASS NUMBER AGAIN AND CLMSK EXCLUDE THE NO-DE-ALLOCATION BIT(#13) STA PRAM1 RESTORE THE MODIFIED CLASS WORD JMP CLRTN RETURN FOR FINAL DE-ALLOCATION * * NOW CLEAR OUT THE MASTER REQUESTERS TCB CLRES JSB #RSAX CALL #RSAX TO PURGE MASTER TCB DEF *+4 DEF K3 DEF K1 STREAM-LIST = MASTER DEF PRAM1 CLASS NUMBER * SZA,RSS SKIP IF TCB NOT DELETED, IGNORE REST JMP CKMS2 CONTINUE WITH NEXT TCB ON CHAIN * SKP * * RESCHEDULE "GRPM","SRPM", "QCLM", OR "RFAEX" IF THEY ARE DORMANT * RSCHD JSB EXEC TRY TO SCHEDULE GRPM (IF DORMANT) DEF *+3 DEF K10N DEF NGRPM NOP * JSB EXEC TRY TO SCHEDULE SRPM (IF DORMANT) DEF *+3 DEF K10N DEF NSRPM NOP * JSB EXEC TRY TO SCHEDULE QCLM (IF DORMANT) DEF *+3 DEF K10N DEF NQCLM NOP * SKP * * CHECK FOR DOWNED COMMUNICATION LINES * LDA LUMAX NUMBER OF LOGICAL UNITS CMA,INA STA LCNT SET COUNTER LDA B101 STA LU MODE= 1 FOR "ENABLE LISTEN" LDA DRT ADDR OF DEVICE REFERENCE TABLE UPEQ2 STA LPNT LDA 0,I PICK-UP DRT ENTRY AND B77 ISOLATE EQT NUMBER ADA N1 MPY K15 REL.POS. IN EQT ADA EQTA POINT TO 1ST WORD OF EQT ADA K4 ADDR OF EQT5 LDB 0 LDA 0,I CONTENTS OF EQT 5 ALF,ALF AND B77 ISOLATE EQUIPMENT TYPE CODE CPA B65 DVR65? JMP UPEQ4 YES, SEE IF IT'S UP * UPEQ3 ISZ LU BUMP LU IN CONTROL WORD LDA LPNT INA INCREMENT DRT POINTER ISZ LCNT JMP UPEQ2 PROCESS NEXT DRT ENTRY * * ALL LU'S HAVE BEEN CHECKED, EXIT UPLIN * JSB EXEC DEF *+2 DEF K6N * * PROCESS COMMUNICATIOrNS EQT * UPEQ4 ADB K7 POINT TO EQT12 DLD 1,I GET CONTENTS OF EQT12 & EQT13 RAL,RAL ALF,SLA IS IT IN LISTEN MODE(BIT 10)? JMP UPEQ3 YES, OK ADB K5 COMPUTE ADDR OF EQTX6 LDA 1,I SZA,RSS HAS THIS EQT BEEN INITIALIZED? JMP UPEQ3 NO * * ISSUE AN "ENABLE LISTEN" REQUEST JSB EXEC DEF *+3 DEF K3N DEF LU CONTROL MODE = 1 NOP JMP UPEQ3 SKP * * SUBROUTINES * SPC 2 * * THIS ROUTINE BUMPS THE TIMEOUT IN A TCB * TSTCB NOP LDB 0 STB XACTA SAVE ADDRESS OF THIS TRANSACTION IFZ LIA 1 ALF,SLA IS SW REG BIT 12 SET? JSB LOGER YES, LOG TCB ON LU #6 XIF INB POINT TO 2ND WORD OF TCB JSB LODWD (CROSS)LOAD TIMER AND B377 ISOLATE IT CPA B377 IS IT ABOUT TO ROLL OVER? JMP TSTC5 YES, DON'T BUMP IT, RETURN + 2 * JSB LODWD (CROSS)LOAD TIMER AGAIN INA BUMP TIMER JSB $LIBR LOWER FENCE NOP MODI1 NOP RSS HERE IF RTE-III OR RTE-IV JMP TSTC3 XSA 1,I STORE INTO SYSTEM MAPPED LOCATION RSS * * BELOW INSTRUCTION IS EXECUTED FOR RTE-II SYSTEMS ONLY TSTC3 STA 1,I STORE UPDATED TIMER IN TCB JSB $LIBX RAISE FENCE DEF *+1 DEF *+2 * TSTC5 ISZ TSTCB RETURN +2 FOR TCB TIMED-OUT LDB XACTA TCB ADDR INTO B REG JMP TSTCB,I RETURN SPC 3 * * IF EQT15 IS ZERO, SET IT TO -1 TO FORCE A QUICK DRIVER TIMEOUT * EQTIM NOP JSB GTEQT COMPUTE EQT ADDRESS ADB K14 POINT TO EQT15 LDA 1,I PICK-UP CURRENT TIMER SZA IS IT RUNNING? JMP EQTIM,I YES, LEAVE IT ALONE CCA JSB $LIBR LOWER FENCE NOP STA 1,I SET QUICK TIMEOUT (-1) IN EQT15 JSB $LIBX RAISE FENCE DEF EQTIM SPC 3 * * THIS ROUTINE COMPUTES EQT ADDRESS FROM SELECT CODE * GTEQT NOP LDB XACTA ADDR OF TRANSACTION INB JSB LODWD (CROSS)LOAD 2ND WORD ALF,ALF RIGHT JUSTIFY SELECT CODE AND B77 ISOLATE IT ADA INTBA USE IT TO INDEX INTERRUPT TABLE ADA N6 TABLE STARTS AT 6 LDB 0,I LOAD EQT ADDRESS JMP GTEQT,I RETURN IT IN B REG SPC 3 * * SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV) * LODWD NOP MODI2 LDA 1,I GET WORD FROM TCB (RSS IF DMS SYSTEM) JMP LODWD,I RETURN IF RTE-II XLA 1,I LOAD WORD FROM ALTERNATE MAP JMP LODWD,I SKP * * DATA AREA * PRAM1 NOP LU NOP RNCW NOP LPNT NOP LCNT NOP CNTR NOP ST.LS NOP XACTA NOP LSTAD NOP MCLSA NOP MSEGA NOP TEMP NOP TAGS DEC 0,0 DUMMY NOP * K1 DEC 1 K2 DEC 2 K3 DEC 3 K4 DEC 4 K5 DEC 5 K7 DEC 7 K10 DEC 10 K14 DEC 14 K15 DEC 15 K99 DEC 99 B65 OCT 65 B77 OCT 77 COMMA OCT 54 B101 OCT 101 B377 OCT 377 B400 OCT 400 BIT15 OCT 100000 K3N OCT 100003 K6N OCT 100006 K10N OCT 100012 K20N OCT 100024 K21N OCT 100025 GLCW OCT 40006 GLOBAL RN LOCK/CLEAR - NO ABORT SCMSK OCT 037400 CLMSK OCT 157777 N1 DEC -1 N2 DEC -2 N6 DEC -6 N10 DEC -10 * OFMES ASC 1,OF MSNAM BSS 3 ASC 1,,1 * QMES ASC 10, SYSTEM IS QUIESCENT * NGRPM ASC 3,GRPM NSRPM ASC 3,SRPM NQCLM ASC 3,QCLM * NAMES DEF *+1 LIST OF SLAVE MONITOR NAMES ASC 3,SMON 0 ASC 3,DLIST 1 ASC 3,PLOS 2 ASC 3,NPRGL 3 ASC 3,PTOPM 4 ASC 3,EXECM 5 RFASC ASC 3,RFAM 6 ASC 3,OPERM 7 ASC 3,PLOSB 8 ASC 3,PROGL 9 * IFZ * NEND DEF * SKP * * THIS ROUTINE IS CALLED TO LOG AN ACTIVE TCB ON LU 6 * LOGER NOP INB 2ND WORD OF TCB  JSB LODWD ALF,ALF RIGHT JUSTIFY SELECT CODE JSB CVOCT CONVERT IT TO ASCII STA SC STORE IN PRINT LINE * JSB LODWD CONVERT LOW 2 DIGITS OF TIMER JSB CVOCT TO OCTAL ASCII STA TIMER+1 JSB LODWD ALF,ALF RAL,RAL RIGHT JUSTIFY HIGH DIGIT AND K3 IOR ASC.0 CONVERT IT TO ASCII STA TIMER * LDA NPNT ADDR OF CURRENT MONITOR NAME CPA NEND IS IT A MASTER TCB? JMP LOG5 YES, USE NAME OF MASTER REQUESTER * JSB LODWD SLAVE TCB, NOW GET BREAK FLAG RAL INTO BIT 0 AND K1 IOR ASC.0 ASCII 0 OR 1 STA BREAK STORE IN PRINT LINE * JSB LODWD GET "D" BIT RAL,RAL AND K1 IOR ASC.0 ASCII 0 OR 1 STA DBIT STORE IN PRINT LINE * INB POINT TO TIME TAGS IN TCB LDA T1AD STA PNT1 POINT TO PRINT LINE FIELD JSB OCT3 CONVERT TO OCTAL ASCII INB NOW 2ND WORD OF TIME TAGS ISZ PNT1 ISZ PNT1 JSB OCT3 TO OCTAL ASCII * LDB NPNT ADDR OF MONITOR NAME LDA K35 LENGTH OF PRINT LINE JMP LOG8 * * ENTER HERE FOR MASTER TCB LOG5 ADB K2 POINT TO ID SEG ADDR IN TCB JSB LODWD PICK-UP ID SEG ADDR LDB 0 RBL,CLE,ERB CLEAR OFF BIT 15 ADB K12 POINT TO NAME FIELD LDA K14 PRINT SHORT RECORD FOR MASTER TCB * LOG8 STA RECL SAVE PRINT LINE LENGTH (WORDS) LDA 1,I STA NAMER 1ST 2 CHARS OF NAME TO PRINT LINE INB LDA 1,I STA NAMER+1 3RD & 4TH CHARS OF NAME INB LDA 1,I AND HIBYT IOR LBLNK FORCE BLANK IN RHW STA NAMER+2 5TH WORD OF NAME + BLANK * JSB EXEC LOG PRINT LINE TO LU #6 DEF *+5 DEF K2 DEF K6 DEF LOGL DEF RECL * LDB XACTA RESTORE TCB EB@ - DS1 INITIALIZATION * (C) HEWLETT-PACKARD CO. 1976 * * NAM LSTEN,3,25 91700-16109 REV.A 760308 SPC 1 ENT LSTEN SPC 1 EXT READF,CLOSE,OPEN,RNRQ,PRTN,MESSS,REIO,PGMAD,CNUMD EXT EXEC,$LIBR,$LIBX,$CGRN,RMPAR,PARSE,#PRMY,#RSAX EXT #FWAM,#GPRN,#MSTO,#NULL, #QRN,#RTRY,#SRPM EXT #ST00,#ST01,#ST02,#ST03,#ST04,#ST05,#ST06,#ST07 EXT #ST08,#ST09,#SVTO,#TBRN,#WAIT,#SWRD,#BUSY EXT #GRPM,#QCLM,#NCLR,#SCLR,#RFSZ,#RXCL,#SBIT,#PLOG EXT #QLOG SUP * * NAME: LSTEN * SOURCE: 91700-18109 * RELOC.: 91700-16109 * PGMR: C.C.H. [ 03/08/76 ] * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 5 * LSTEN SERVES A DUAL PURPOSE. IT IS USED, PRIMARILY, TO INITIALIZE * THE DISTRIBUTED SYSTEMS NETWORK THROUGH ESTABLISHMENT OF THE * REQUIRED RESOURCES (CLASS NUMBERS, RESOURCE NUMBERS, TRANSACTION * LISTS, POINTERS, TIMERS, AND CONSTANTS), THROUGH THE ACTIVATION * OF 'LISTEN' MODE FOR EACH SPECIFIED COMMUNICATION LINE INTERFACE, * AND BY SCHEDULING THOSE MONITOR-PROGRAMS WHICH SERVICE INCOMING * REQUESTS FROM REMOTE NETWORK NODES. SPC 3 * LSTEN'S SECONDARY PURPOSE IS TO ALLOW THE USER TO RE-ENABLE A * COMMUNICATION LINE INTERFACE, WHICH HAS BEEN INACTIVATED BY * UNFORESEEN MALFUNCTIONS. IT MAY ALSO BE USED TO BRING THE * NETWORK TO A QUIESCENT STATE, IN ORDER TO ADJUST SYSTEM TIMING, * OR FOR ANY OTHER PURPOSE WHICH REQUIRES SUSPENSION OF NETWORK * OPERATIONS, AT THIS PARTICULAR NODE. * SKP * SCHEDULING FOR INITIALIZATION: * ----------------------------- ASPC 1 * *ON,LSTEN,(INPUT LU),(ERROR LU) * * SCHEDULE TO ACCEPT RESPONSES FROM A PERIPHERAL DEVICE. * * NOTE: IF SCHEDULING PARAMETERS ARE NOT SUPPLIED, LU #1 IS THE DEFAULT. * IF THE (INPUT LU) IS LINKED TO AN INTERACTIVE DEVICE, * INTERROGATORY REMARKS WILL BE DISPLAYED ON THE DEVICE. * THE (ERROR LU), IF SPECIFIED, MUST BE LINKED TO AN * INTERACTIVE DEVICE. * * *ON,LSTEN,FI,LE,NM [,SECURITY CODE [,CARTRIDGE NUMBER] ] * * SCHEDULE TO ACCEPT RESPONSES FROM A FILE . * * NOTE: ANY ERRORS WILL BE REPORTED ON LU #1; WILL THEN ABORT. * * * INITIALIZATION QUERIES AND VALID RESPONSES (IN NORMAL ORDER): * ------------------------------------------------------------ SPC 1 * NOTE: CONTROL FILE RESPONSES CONSIST OF ONE RECORD PER RESPONSE. * * /A : ABORT IS A VALID RESPONSE TO ALL QUERIES. * * /LSTEN: PRIMARY SYSTEM? * NOTE: NON-PRIMARY SYSTEMS YIELD, FOR SIMULTANEOUS REQUESTS FROM BOTH. * * /LSTEN: NUMBER OF CURRENT TRANSACTIONS? <1-100 (/D =DEFAULT OF 32)> * NOTE: EACH TRANSACTION USES 4 WORDS OF SYSTEM-AVAILABLE-MEMORY. * * /LSTEN: LINE LU? * /LSTEN: LINE LU? * * /LSTEN: MONITOR NAME? * /LSTEN: MONITOR NAME? * * /LSTEN: INPUT # OF FILES: <1 TO 255 (TOTAL FILES OPEN TO ALL NODES)> * NOTE: ASKED ONLY FOR /D OPTION, OR WHEN SPECIFIED. * * /LSTEN: SECURITY CODE? * * END LSTEN (TERMINATION MESSAGE) * SPC 2 * ONCE THE SYSTEM HAS BEEEN INITIALIZED, SUBSEQUENT SCHEDULING OF * WILL CAUSE ENTRY INTO THE SECONDARY MODE OF OPERATION. * IN THIS MODE, THE USER MAY RE-ENABLE COMMUNICATION LINE INTERFACES, *  SCHEDULE ADDITIONAL MONITORS, ENABLE THE TRANSACTION MONITOR, * OR PLACE THE SYSTEM INTO QUIESCENT MODE. ONCE THE SYSTEM HAS BEEN * MADE QUIESCENT, THE USER MAY, ONLY, ADJUST THE TIMING VALUES, * OR RE-START THE QUIESCENT SYSTEM. * SKP * SCHEDULING FOR SECONDARY MODE OF OPERATION: * ------------------------------------------ SPC 1 * *ON,LSTEN,(LINE LU#),(ERROR LU#) * * THIS PROCEDURE IS USED TO RE-ENABLE THE LINE INTERFACE FOR A * SINGLE LOGICAL UNIT NUMBER. THERE IS NO INTERACTION WITH THE * USER, UNLESS AN ERROR IS DETECTED. IN THE EVENT OF ERROR * DETECTION, THE USER WILL BE QUERIED ON THE (ERROR LU#) DEVICE. * * (INPUT LU#),(ERROR LU#) < DEFAULT = LU#1 FOR BOTH > * / * *ON,LSTEN, * \ * FI,LE,NM [,SECURITY CODE [,CARTRIDGE NUMBER] ] * * IN SECONDARY MODE, SCHEDULING WITH AN INTERACTIVE TERMINAL * AS THE (INPUT LU#) DEVICE, OR UNDER THE CONTROL OF A COMMAND FILE, * WILL ALLOW THE USER TO SELECT SEVERAL POSSIBLE OPERATIONS. * * SECONDARY MODE QUERIES AND VALID RESPONSES: * ------------------------------------------ SPC 1 * NOTE: /A (ABORT ) IS A VALID RESPONSE TO ALL QUERIES. * * **** ACCEPTABLE RESPONSES--NON-QUIESCENT SYSTEM **** * * /LSTEN: OPERATION? * /LSTEN: LU TO BE RE-ENABLED? < LU# (LINKED TO DVR65)> * /LSTEN: LU TO BE RE-ENABLED? * * /LSTEN: OPERATION? * * /LSTEN: OPERATION? * ( P1-P4: OPTIONAL SCHEDULING PARAMETERS FOR PLOG ) * * /LSTEN: OPERATION? * * NOTE: OPTIONAL PARAMETERS FOR ARE PASSED TO , ON * FIRST USE OF EITHER COMMAND. SUBSEQUENT USE OF THE OTHER * COMMAND WILL MERELY ENABLE THE OPTION, WITHOUT CHANGING THE * CURRENT OPERATING MODE OF . * * /LSTEN: OPERATION? * /LSTEN: SYSTEM QUIESCENCE * /LSTEN: SECURITY CODE? < AA (MUST MATCH ORIGINAL SECURITY CODE)> * END LSTEN (TERMINATION MESSAGE) * * /LSTEN: OPERATION? * /LSTEN: MONITOR NAME? * /LSTEN: MONITOR NAME? * /LSTEN: OPERATION? * END LSTEN (TERMINATION MESSAGE) * * /LSTEN: OPERATION? * * ??: LIST COMMANDS * /A: ABORT! * /E: TERMINATE * /L: RE-ENABLE LINE * /Q: QUIESCE NETWORK * /S: SCHEDULE MONITOR(S) * * QUIESCENT SYSTEM ONLY: * /R: RE-START NETWORK * /T: ADJUST TIMING * * * **** ACCEPTABLE RESPONSES--QUIESCENT SYSTEM, ONLY **** * * /LSTEN: OPERATION? * /LSTEN: QUIESCENT RE-START * /LSTEN: SECURITY CODE? < AA (MUST MATCH ORIGINAL SECURITY CODE)> * * /LSTEN: OPERATION? * TIMING MODIFICATION--CURRENT VALUES: * * MASTER T/O = NNNNNN * SLAVE T/O = NNNNNN * REMOTE-BUSY = NNNNNN * REMOTE-QUIET = NNNNNN * * * /LSTEN* MASTER T/O [1 TO 255 (*5 SEC.)]? <1 TO 255 (NUMERIC RESPONSE)> * (INITIAL VALUE = 5) * * /LSTEN: SLAVE T/O [1 TO 255 (*5 SEC.)]? <1 TO 255 (NUMERIC RESPONSE)> * (INITIAL VALUE = 3) * * /LSTEN: REMOTE-BUSY WAIT [1 TO 10 SEC.]? <1 TO 10(NUMERIC)> * (INITIAL VALUE =3) * * /LSTEN: REMOTE-QUIET WAIT [1 TO 10 SEC.]? <1 TO 10 (NUMERIC)> * (INITIAL VALUE =1) * SKP * * ERROR MESSAљGES--INTERPRETATION AND APPROPRIATE ACTION: * ----------------------------------------------------- * * [ ALL MESSAGES ARE PRECEDED BY "/LSTEN:" ] SPC 1 * CLASS I/O ERROR - A REQUIRED CLASS NUMBER CANNOT BE ALLOCATED. * IS ABORTED. THIS ERROR MAY REQUIRE * RE-GENERATION WITH A LARGER ALLOTMENT OF CLASS NO'S. * * END LSTEN - NORMAL COMPLETION MESSAGE. THE TEN CHARACTERS COMPRISING * THE MESSAGE ARE ALSO RETURNED IN THE 5-WORD TEMPORARY * STORAGE AREA OF A SCHEDULER'S I.D. SEGMENT. THEY MAY BE * RECOVERED THROUGH THE USE OF . * IF HAS BEEN ABORTED, THE FIVE WORDS OF RETURNED- * DATA CONSIST OF: 100000B,ER, L,ST,EN * * EOF..INPUT MORE - AN END-OF-FILE CONDITION HAS BEEN DETECTED ON * THE (INPUT LU#) DEVICE. THE QUESTION IS DISPLAYED * ON THE (ERROR LU#) DEVICE, AND THE USER MAY SUPPLY * THE REQUIRED RESPONSE FROM THIS DEVICE. * * ERROR: MON?: AAAAA - THE SPECIFIED MONITOR IS NOT IN THE SYSTEM. * ABORT , USING /A COMMAND, AND THEN LOAD * THE MONITOR INTO THE SYSTEM. RE-START . * * ERROR: STAT: AAAAA - THE MONITOR'S STATUS IS NOT 'DORMANT', AND * THEREFORE IT CANNOT BE SCHEDULED. * ABORT , USING /A COMMAND, AND THEN USE * RTE OPERATOR COMMANDS TO CHANGE THE STATUS. * * FILE ERROR - IMPROPER RESPONSE TO "INPUT # OF FILES". RETRY. * * INVALID NAME! - MONITOR NAME IS NOT RECOGNIZED BY . RETRY. * * INVALID RESPONSE! - OPERATOR ENTRY ERROR. RETRY. * (NO RETRY ALLOWED FOR QUIESCENT OR RE-START MODE) * * LSTEN ABORTED - IF INITIALIZATION WAS IN PROGRESS, THEN ALL ALLOCATED * RESOURCES HAVE BEEN RETURNED TO RTE. * * LU ERROR - IMPROPER LU# SPECIFIEMD, OR LU# NOT LINKED TO DVR65. RETRY. * * NO SYSTEM MEMORY! - INSUFFICIENT SYSTEM AVAILABLE MEMORY FOR USE BY * THE NETWORK. SYSTEM CANNOT BE INITIALIZED. * IS ABORTED. RE-GENERATION OF RTE MAY * BE REQUIRED. * * RN ERROR - A REQUIRED RESOURCE NUMBER CANNOT BE ALLOCATED; * IS ABORTED. RE-GENERATION, WITH A LARGER * ALLOTMENT OF RESOURCE NUMBERS, MAY BE REQUIRED. * * SYSTEM IS NOT QUIESCENT! - TIMING MODIFICATION IS NOT ALLOWED, UNTIL * ALL PENDING TRANSACTIONS HAVE BEEN CLEARED * FROM THE SYSTEM. AWAIT QUIESCENT CONDITION, * AND RE-SCHEDULE . * * TOO MANY LU'S - MORE THAN 32 LOGICAL UNIT NUMBERS HAVE * BEEN SPECIFIED FOR CONFIGURATION. * IS ABORTED. REDUCE THE NUMBER OF * LU'S AND RE-SCHEDULE . * * TR FILE ERROR - THE FILE MANAGER CANNOT PROCESS THE FILE * WHICH WAS SPECIFIED IN THE SCHEDULING * PARAMETERS. CORRECT THE FILE PROBLEM, * AND RE-SCHEDULE . * * ** UPLIN NOT SCHEDULED - THE SYSTEM TRANSACTION-MONITOR AND CLEANUP * PROGRAM COULD NOT BE SCHEDULED. * IS ABORTED! DETERMINE NATURE OF * PROBLEM AND CORRECT. RE-SCHEDULE . * SKP PRAM NOP INPUT LU OR FIRST 2 CHARS. OF FILE NAME. NOP ERROR LU OR SECOND 2 CHARS. OF FILE NAME. NOP THIRD TWO CHARS. OF FILE NAME. NOP FILE SECURITY CODE--OPTIONAL. NOP FILE CARTRIDGE NUMBER--OPTIONAL. LSTEN JSB RMPAR GET THE DEF *+2 PARAMETERS DEF PRAM FOR LOCAL USE. IFZ EXT DBUG LDA PRAM CPA D6 DO THEY WANT DEBUG? RSS  YES JMP LSTN1 NO...LET HER RIP JSB DBUG INVOKE DEBUG DEF *+1 JMP TERM4 TERMINATE AND SAVE RESOURCES. XIF LSTN1 LDA #FWAM GET "ALREADY-INITIALIZED" INDICATOR. STA ONTWO SAVE IN OPTION 1/2 FLAG WORD CCA STA TTYF CLEAR OUT TTY FLAG * LDA PRAM SEE IF PRAM IS SUPPLIED LDB B1 IF NOT, DEFAULT TO LU 1 SZA SUPPLIED? LDB A YES ADA BM100 LU OR FILE? SSA CLA LU...CLEAR FILE FLAG STA FILFG STB RLU SAVE AS READ LU SZA LU OR FILE? JMP LSTN2 FILE * JSB EXEC LU...SEE WHICH ONE DEF *+4 DEF D13 DEF RLU DEF TEMP1 * LDA TEMP1 GET STATUS...SEE IF DVR00 ALF,ALF AND B77 CPA B5 IF EQUIPMENT TYPE-CODE = <05>, CLA CHANGE TO <00> FOR OUR USE. LDB A LDA RLU GET READ LU SZB,RSS TTY? IOR B400 YES...SET IN ECHO BIT STA RLU SAVE AS INPUT LU STB TTYF SAVE TTY FLAG LDA PRAM+1 SZA IS ERROR LU SUPPLIED? JMP LSTN2+1 YES...SAVE IT. SZB,RSS IS INPUT LU A TTY? LDA RLU YES...SET IF FOR ERROR LU SZA,RSS STILL ZERO? * LSTN2 LDA B1 YES...DEFAUT TO SYSTEM STA ERLU SAVE ERROR LU * JSB EXEC FIND OUT STATUS DEF *+4 DEF D13 DEF ERLU DEF TEMP1 * LDA TEMP1 GET STATUS ALF,ALF AND B77 CPA B5 IF EQUIPMENT TYPE-CODE = <05>, CLA CHANGE TO <00> FOR OUR USE. LDB ERLU SZA TTY? LDB B1 NO...SET TO SYSTEM TTY LDA B IOR B400 STA ERLU * JSB CHCKN SEE IF FILE RSS FILE...OPEN IT JMP LSTN3 NOT FILE * JSB OPEN OPEN THE FILE DEF *+7 DEF INDCB DIRECTORY CONTROL BLOCK DEF TEMP1 ERROR-RETURN STORAGE DEF PRAM FILE NAME DEF ZERO OPEN OPTION: EXCLUSIVE/NON-UPDATE DEF PRAM+3 FILE SECURITY CODE DEF PRAM+4 FILE CARTRIDGE NUMBER * LDA TEMP1 ANY ERRORS? SSA,RSS JMP LSTN3 NO * JSB SYSER SYSTEM ERROR DEF TRFM "TR FILE ERROR" * LSTN3 LDA ONTWO OPTION 1/2 FLAG LDB TTYF TTY FLAG (EQUIPMENT TYPE CODE). SZA OPTION 1? JMP OPTN2 NO...OPTION 2 * CPB B65 ATTEMPT TO INITIALIZE WITH SDI LU#? RSS YES. SKIP TO REPORT THE ERROR. JMP INITL NO. GO TO START THE INITIALIZATION. * JSB SYSER INFORM THE USER OF THE DEF LUERM " LU ERROR"--NO RETURN. * * INITIALIZATION CONTROL SECTION. * INITL JSB PRMRY GO TO SEE IF THIS IS PRIMARY SYSTEM. JSB SAM GO SET UP SYS. AVAIL. MEM. FOR LISTS. JSB LUIN READ IN & INITIALIZE THE SPECIFIED LU'S LDA LUBUF SEE IF THEY ENTERED ANY LU'S CLE,SZA,RSS ? JMP ABORT NO...DIDN'T ENTER ANY LU'S JSB MSET SCHEDULE MONITORS & SET UP STREAM LISTS. JSB SECOD SET NETWORK SECURITY CODE FOR THIS NODE. JSB SUPLN SCHEDULE UPLINE PROGRAM JSB SCHDQ SCHEDULE QUEUEING PROCESSORS, JMP TERM AND TERMINATE. * SKP * CHECK FOR PRIMARY SYSTEM--DOES NOT YIELD FOR SIMULTANEOUS REQUESTS. SPC 1 PRMRY NOP ENTRY/EXIT: PRIMARY SYSTEM CHECK. JSB PRINT ASK THE USER IF THIS IS THE DEF PRMSG "PRIMARY SYSTEM?". JSB READ GET THE RESPONSE. CPA B2 IF THE RESPONSE IS ASCII, CCA,RSS PREPARE TO SET THE PRIMARY FLAG; ELSE, JMP PRMER REPORT THE RESPONSE ERROR. CPB /A IF THE USER WISHES TO EXIT, JMP ABRT4 GO TO ABORT THE PROGRAM. CPB "NO" IF THIS IS NOT TܜHE PRIMARY SYSTEM, JMP PRMRY,I THEN RETURN FOR THE NEXT PROCESS. CPB "YE" IF THIS IS TO BE THE PRIMARY, RSS THEN SKIP TO SET THE FLAG. JMP PRMER * ERROR: INFORM THE USER. STA PRMY# SET THE PRIMARY FLAG IN =-1. JMP PRMRY,I RETURN FOR THE NEXT PROCESSING STEP. * PRMER JSB ERROR IMPROPER REPLY: DEF IVRES INFORM THE USER, AND JMP PRMRY+1 ALLOW ANOTHER CHANCE. * PRMSG DEF *+2 DEF D9 ASC 9, PRIMARY SYSTEM? _ * "NO" ASC 1,NO "YE" ASC 1,YE * SKP * SUBROUTINE TO OBTAIN SYSTEM AVAILABLE MEMORY & INITIALIZE NULL LIST. SPC 1 SAM NOP ENTRY/EXIT: SYS. AV. MEM. SET-UP. LDA D32 INITIALIZE DEFAULT NO. STA SVNUM OF TRANSACTIONS =32. LDA DM3 INITIALIZE THE DELAY RE-TRY STA RETRY COUNTER FOR 3 TRIES. SOVER JSB PRINT ASK THE USER TO SPECIFY THE: DEF MSG0 " NO. OF CURRENT TRANSACTIONS?" JSB READ READ THE RESPONSE. CPA B1 IF THE RESPONSE WAS NUMERIC, JMP SVALU GO TO PROCESS IT; ELSE, DETERMINE CPB /D IF DEFAULT VALUE IS TO BE USED. JMP SDFLT USE THE DEFAULT VALUE (32). CPB /A IF THE USER WISHES TO EXIT, JMP ABRT4 GO TO ABORT THE PROGRAM. * SERR JSB ERROR IMPROPER REPLY: DEF IVRES GO TO INFORM THE USER OF THE ERROR; JMP SOVER THEN ALLOW ANOTHER CHANCE. * SVALU STB SVNUM SAVE NO. OF TRANSACTIONS, TEMPORARILY. SSB,RSS IF VALUE NEGATIVE--INFORM USER OF ERROR. CMB,INB,SZB,RSS NEGATE THE NUMBER & CHECK FOR ZERO. JMP SERR * ERROR: NUMBER IS INVALID--TRY AGAIN * ADB D100 ADD THE MAXIMUM ALLOWABLE NO. (100). SSB IS THE SPECIFIED NO. ALLOWABLE? JMP SERR NO. GO INFORM HIM OF THE ERROR! * SDFLT LDB SVNUM GET THE NUMBER OF TRANSACTIONS. CMB,INB FORM A LOOP COUNT u INB,SZB,RSS EQUAL TO (THE NUMBER SPECIFIED-1). CCB PROTECT AGAINST A NULL COUNTER! STB SCNT SAVE THE LOOP COUNT. LDA SVNUM GET THE NUMBER OF TRANSACTIONS. MPY B4 CALCULATE: MEMORY SIZE(WORDS) = STA SZMEM (TRANSACTIONS)*(4 WDS./TRANSACTION) * CLE GET A JSB RNSUB RESOURCE NUMBER DEF TBRN# FOR THE TABLE-ACCESS RN. CLE GET A JSB RNSUB RESOURCE NUMBER DEF GPRN# FOR THE GENERAL PRE-PROCESSOR RN. CLE GET A JSB RNSUB RESOURCE NUMBER DEF QRN# FOR THE SYSTEM-QUIESCENT RN. CLE GET A JSB CLSUB CLASS NUMBER DEF GRPM# FOR THE GENERAL PRE-PROCESSOR MODULE. CLE GET A JSB CLSUB CLASS NUMBER DEF SRPM# FOR THE SLAVE PRE-PROCESSOR MODULE. CLE GET A JSB CLSUB CLASS NUMBER DEF QCLM# FOR THE QUEUE CLEAN-UP MONITOR. CLE GET A JSB CLSUB CLASS NUMBER DEF RXCL# FOR 'RFAM'/'RFAEX' COMMUNICATIONS. * LDA BPA1 IF THE FIRST WORD OF BASE PAGE CPA B2 IS =2, THEN THIS IS A DMS SYSTEM, RSS AND THE CODE MUST BE MODIFIED; JMP SREPT ELSE, BYPASS THE CODE CHANGES. DLD XSBAI GET THE CROSS-STORE INSTRUCTION, DST STLNK AND CONFIGURE THE TWO NULL-LINK DST STERM INSTRUCTIONS FOR DMS OPERATION. * SREPT JSB #RSAX GO TO THE DEF *+3 SYSTEM RESOURCE-CONTROL ROUTINE, DEF ZERO TO REQUEST SYSTEM AVAILABLE MEMORY, DEF SZMEM IN THE AMOUNT SPECIFIED BY THE USER. * CPA M1 IF THE AMOUNT WILL NEVER BE AVAILABLE, JMP NOMER INFORM THE USER OF THE PROBLEM. SZA HAS THE MEMORY BEEN ALLOCATED? JMP NULNK YES. GO TO LINK THE NULL LIST. JSB DELAY NO. IT'S NSOT AVAILABLE NOW--WAIT. JMP NOMER * RETRIES EXHAUSTED: INFORM USER! JMP SREPT TRY AGAIN FOR MEMORY ALLOCATION. * NULNK JSB CLEAR GO TO CLEAR SYSTEM DATA AREA IN . JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. LDA #FWAM GET THE ADDRESS OF THE S.A.M. BLOCK, STA #NULL AND INITIALIZE HEAD OF NULL LIST. STA B LINK SLOOP ADB B4 THE STLNK STB A,I NULL [CONTAINS XSB A,I: DMS] NOP LIST [NOP: RTE-II, DEF A,I: DMS] STB A WITH ISZ SCNT FOUR- JMP SLOOP WORD CLB NULL STERM STB A,I ENTRIES. [CONTAINS XSB A,I: DMS] NOP [NOP: RTE-II, DEF A,I: DMS] * SKP * INITIALIZE ALL GLOBAL RN'S, CLASS NUMBERS, AND COUNTERS IN 'RES'. SPC 1 LDA TBRN# STA #TBRN LDA GRPM# STA #GRPM LDA GPRN# STA #GPRN LDA SRPM# STA #SRPM LDA QCLM# STA #QCLM LDA RXCL# STA #RXCL LDA QRN# STA #QRN LDA MSTO# STA #MSTO LDA SVTO# STA #SVTO LDA RTRY# STA #RTRY LDA WAIT# STA #WAIT LDA PRMY# STA #PRMY CLA STA #BUSY * JSB $LIBX RESTORE THE DEF SAM SYSTEM'S DEFENSES. * NOMER JSB SYSER GO TO INFORM THE USER THAT DEF NOMEM MEMORY IS UN-AVAILABLE--NO RETURN. * BPA1 EQU 1742B SZMEM NOP NUMBER OF WORDS OF S.A.M. REQUESTED. XSBAI XSB A,I DMS: CROSS-STORE VIA ALTERNATE MAP. * MSG0 DEF *+2 DEF D16 ASC 16, NO. OF CURRENT TRANSACTIONS? _ IVRES DEF *+2 DEF D9 ASC 9, INVALID RESPONSE! NOMEM DEF *+2 DEF D9 ASC 9, NO SYSTEM MEMORY! * SKP * * DELAY SUBROUTINE: DELAY EXECUTION FOR 1-SECOND. * SET (BEFORE ENTRY) TO NEGATIVE NUMBER OF PASSES ,B* ALLOWED THROUGH , BEFORE RETURN TO P+1 ERROR-RETURN. * NORMAL RETURN IS TO P+2, FOLLOWING DELAY OF 1-SECOND. * DELAY NOP ENTRY/EXIT: DELAY SUBROUTINE. JSB EXEC WAIT DEF *+6 1 SECOND DEF D12 TO ALLOW DEF ZERO SYSTEM DEF B1 CONDITIONS TO DEF ZERO CHANGE DEF DM100 AS REQUIRED. ISZ RETRY IF RETRY COUNT IS NOT EXHAUSTED, ISZ DELAY THEN SET RETURN TO P+2; ELSE, IF JMP DELAY,I EXHAUSTED, RETURN TO P+1--ERROR! * RETRY NOP RE-TRY COUNTER SPC 2 GRPM# NOP GENERAL PRE-PROCESSOR CLASS NUMBER. SRPM# NOP SLAVE PRE-PROCESSOR CLASS NUMBER. QCLM# NOP QUEUE CLEAN-UP MONITOR'S CLASS NUMBER. RXCL# NOP 'RFAM'/'RFAEX' COMMUNICATION CLASS NO. TBRN# NOP TABLE-ACCESS RN. GPRN# NOP GENERAL PRE-PROCESSOR RN. QRN# NOP SYSTEM-QUIESCENT RN. MSTO# ABS 256-5 MASTER-REQUEST TIMEOUT(LOWER BYTE -5) SVTO# ABS 256-3 SLAVE-REQUEST TIMEOUT(LOWER BYTE -3) RTRY# DEC -3 D65MS BUSY-REJECT RETRY COUNT WAIT# DEC -1 D65MS QUIESCENT WAIT INTERVAL * SKP * OPTION 2 IS ENTERED WHEN SYSTEM IS ALREADY INITIALIZED. * OPTN2 LDA LUAD INITIALIZE THE POINTER STA LUPNT TO THE LOGICAL UNIT NO. BUFFER JSB CHCKN SEE IF THEY WANT TO READ FROM A FILE JMP OPT20 YES LDB RLU GET LU...INCASE DVR SUPPLIED IN RMPAR LDA TTYF SEE WHAT TYPE OF DEVICE WE TALK TO CPA B65 IS IT DVR65? JMP OPT22 YES OPT20 JSB PRINT DEF OPMES " OPERATION?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES. CONTINUE PROCESSING. JMP EXPLN NO...EXPLAIN THE POSSIBILITIES! * CPB /A REQUEST TO ABORT? JMP ABRT4 YES. DO IT! CPB /E REQUEST TO TERMINATE2NLH? JMP TERM YES. GO TO OBLIGE. CPB PM REQUEST TO MONITOR PARMB'S? RSS YES--SKIP; ELSE, CHECK FOR A CPB QM REQUEST TO MONITOR QUEUEING ERRORS? JMP PLOG YES. SET UP MONITORING FOR EITHER. CPB /S REQUEST TO SCHEDULE MONITOR(S)? JMP SKEDM YES. GO TO SET UP TO SCHEDULE. CPB PC REQUEST TO CANCEL PARMB MONITORING? RSS YES--SKIP; ELSE, CHECK FOR A CPB QC REQUEST TO CANCEL Q-ERROR MONITORING? JMP PCLR YES. GO TO STOP EITHER PROCESS. CPB ?? IS THE USER PUZZLED? JMP EXPLN YES...GIVE HIM SOME ASSISTANCE. JSB RNRQ GO TO RTE DEF *+4 TO OBTAIN THE DEF GLCNW STATUS OF THE DEF #QRN SYSTEM QUIESCENT DEF TEMP1 RESOURCE NUMBER. LDB PARSB+1 GET THE USER COMMAND, AGAIN. LDA TEMP1 GET THE STATUS OF #QRN. CPA B7 IF THE SYSTEM IS ALREADY QUIESCENT, JMP QCHNG THEN ONLY /R AND /T ARE ALLOWED; ELSE, CPB /L REQUEST TO RE-ENABLE A LINE? JMP OPT21 YES. GO TO DETERMINE THE LU NUMBER. CPB /Q REQUEST TO MAKE THIS NODE QUIESCENT? JMP QUIES YES.GO TO PROCESS THE REQUEST. JMP EXPLN USER IS CONFUSED...HELP HIM! * QCHNG CPB /R REQUEST TO RE-START FROM QUIESCENCE? JMP REQUE YES. GO TO START IT UP AGAIN. CPB /T REQUEST TO CHANGE TIMEOUT VALUES, ETC.? JMP TIME YES. GO PROCESS THE REQUESTED CHANGES. * EXPLN JSB PRNTX EXPLAIN THE COMMANDS DEF EXPMS TO THE CONFUSED USER. JMP OPT20 REPEAT THE QUESTION. N* SKEDM CCE =1 TO DISALLOW DEFAULT SCHEDULING. JSB MSET GO TO SCHEDULE MONITOR(S). JMP OPT20 RETURN TO CHECK FOR OTHER OPTIONS. SKP OPT21 JSB PRINT SEE WHICH LU THEY WANT DEF UPLUM " LU TO BE RE-ENABLED?_" JSB READ READ IN # CPA B1 NUMERIC ANSWER? JMP OPT22 YES CPB /E END OF LIST? JMP OPT20 YES. CHECK FOR OTHER OPTIONS. CPB /A REQUEST TO ABORT? JMP ABORT YES. GO DO IT! OPT2E JSB ERROR NO...ERROR DEF LUERM "LU ERROR" JMP OPT21 TRY AGAIN * OPT22 SZB,RSS ZERO..ILLEGAL LU JMP OPT2E ERROR STB LTEMP SAVE THE SPECIFIED LOGICAL UNIT NO. JSB LUTST GO TO TEST FOR LINKAGE TO DVR65. JMP OPT2E * ERROR--TRY AGAIN! * LDA LTEMP GET THE LOGICAL UNIT NUMBER. IOR B200 INCLUDE SUB-FUNCTION =2: CLEAR REQUEST. STA CLU SAVE THE CONFIGURED CONTROL WORD. * CLA INITIALIZE 'LRN' & 'PRN' TO ZERO, STA LRN IN ORDER TO LATER DETERMINE STA PRN IF RELEASE OF THE RN'S IS REQUIRED. * JSB EXEC GO TO RTE DEF *+4 TO REQUEST THAT DEF SD3 DVR65 CLEAR OUT DEF CLU ANY PREVIOUS DEF PBUF CONFIGURATION DATA. JMP OPT2E * RTE-DETECTED ERROR--TRY AGAIN! * * LDA LRN GET THE RETURNED 'LRN'--IF ANY. SZA,RSS IF NOTHING WAS RETURNED, JMP *+4 THEN BYPASS THE RN RELEASE. CCE CLEAR THE FORMER JSB RNSUB RESOURCE NUMBER DEF LRN FOR THE COMM. LINE RN. LDA PRN GET THE RETURNED 'PRN'--IF ANY. SZA,RSS IF NOTHING WAS RETURNED, JMP *+4 THEN BYPASS THE RN RELEASE. CCE CLEAR THE FORMER JSB RNSUB RESOURCE NUMBER DEF PRN FOR THE 'PROGL' RN. JSB LUSET GO TO SET UPBm THE LOGICAL UNIT NO. JMP OPT2E * RTE-DETECTED ERROR--TRY AGAIN! * LDA TTYF IF THE INITIAL REQUEST CPA B65 WAS TO RE-ENABLE A SINGLE LU, JMP TERM THEN DON'T ASK FOR MORE INPUT; ELSE, JMP OPT21 GO BACK FOR MORE. * GLCNW OCT 100006 GLOBAL LOCK/CLEAR--NO WAIT. SD13 OCT 100015 SD3 OCT 100003 SKP ******* DO NOT CHANGE THE ORDER OF THE NEXT SEVEN STATEMENTS! ******* SPC 1 PBUF DEF LRN ADDRESS OF INITIALIZING PARAMETERS. LRN NOP COMM. LINE RESOURCE NUMBER. PRN NOP 'PROGL' RESOURCE NUMBER. NOP (REQUEST & DATA TIMEOUT--SATELLITE ONLY) SDF DEF #SBIT ENTRY ADDRESS: DVR65 LIST PROCESSOR. CDF DEF $CGRN ENTRY ADDRESS: GLOBAL RN CLEAR ROUTINE. PRMY# NOP PRIMARY FLAG: PRIMARY=-1, SECONDARY=0 * SKP * NETWORK TIMING-VALUE MODIFICATION SECTION (QUIESCENT MODE ONLY!). * TIME LDA #BUSY CHECK FOR QUIESCENT SYSTEM. SZA IF IT IS NOT-YET QUIESCENT, THEN JMP NOTQ LET THE USER KNOW; ELSE, JSB GETV GO TO GET CURRENT VALUES. JSB PRNTX PRINT SECTION HEADER. DEF TMES " TIMING MODIFICATION" MQUES JSB PRINT DEF MSTMG " MASTER T/O [1 TO 255 (*5 SEC.)]?_" JSB READ GET THE RESPONSE. SZA,RSS ANY CHANGE DESIRED? JMP SQUES NO. PROCEED TO NEXT QUESTION. CPA B1 NUMERIC RESPONSE? JMP CHEKM YES. SKIP TO CHECK LIMITS. CPB /A ABORT REQUEST? JMP ABRT4 YES. GO TO OBLIGE. MSER JSB ERROR INVALID DEF IVRES RESPONSE! JMP MQUES ASK AGAIN. * CHEKM JSB VCHEK CHECK FOR ACCEPTABLE VALUE DEF D255 (MAXIMUM =255) JMP MSER IMPROPER VALUE. AND D255 ACCEPTABLE--ISOLATE LOWER BYTE, JSB VSTOR AND STORE IT AWAY. DEF #MSTO LOCATION OF CONSTANT IN 'RES'. * SQUES JSB PRINT DEF SLVMG " SLAVE T/O [1 TO 255 (*5 SEC.)?]_" JSB READ GET RESPONSE. SZA,RSS ANY CHANGE DESIRED? JMP BZTRY NO. PROCEED TO NEXT QUESTION. CPA B1 NUMERIC RESPONSE? JMP CHEKS YES. SKIP TO CHECK LIMITS. CPB /A ABORT REQUEST? JMP ABRT4 YES. GO TO OBLIGE. SVER JSB ERROR INVALID DEF IVRES RESPONSE! JMP SQUES ASK AGAIN. * CHEKS JSB VCHEK CHECK VALIDITY OF RESPONSE. DEF D255 (MAXIMUM =255) JMP SVER IMPROPER VALUE. AND D255 ACCEPTABLE--ISOLATE LOWER BYTE, JSB VSTOR AND GO TO STORE IT. DEF #SVTO LOCATION OF CONSTANT IN 'RES'. * BZTRY JSB PRINT DEF BZMG "REMOTE-BUSY WAIT [1 TO 10 SEC.]?_" JSB READ GET RESPONSE SZA,RSS ANY CHANGE DESIRED? JMP WAITQ NO. PROCEED TO NEXT QUESTION. CPA B1 NUMERIC? JMP CHEKB YES. GO TO PROCESS. CPB /A ABORT REQUEST? JMP ABRT4 YES. GO TO OBLIGE. BZER JSB ERROR IMPROPER DEF IVRES RESPONSE! JMP BZTRY ASK AGAIN. * CHEKB JSB VCHEK GO TO CHECK VALIDITY. DEF D10 (MAXIMUM =10) JMP BZER INVALID VALUE. JSB VSTOR GO TO STORE VALUE. DEF #RTRY LOCATION OF CONSTANT IN 'RES'. * WAITQ JSB PRINT DEF WAITM " REMOTE-QUIET WAIT [1 TO 10 SEC]?_" JSB READ GET RESPONSE. SZA,RSS ANY CHANGE DESIRED? JMP OPT20 NO. GO SEE IF OTHER OPTIONS DESIRED. CPA B1 NUMERIC? JMP CHEKW YES. GO CHECK VALIDITY. CPB /A REQUEST TO ABORT? JMP ABRT4 YES. GO DO IT! WERR JSB ERROR INVALID DEF IVRES RESPONSE! JMP WAITQ ASK AGAIN. * CHEKW JSB VCHEK CHECK FOR ACCEPTABLE VALUE. DEF D10 (MAXIMUM =10) JMP WERR IMPROPER VALUE. JSB VSTOR ACCEPTABLE--GO SAVE IT. DEF #WAI{T LOCATION OF CONSTANT IN 'RES'. * JMP OPT20 CHECK FOR OTHER OPTIONS. * VCHEK NOP ENTRY/EXIT: VALID RESPONSE CHECK LDA VCHEK,I GET THE MAXIMUM VALUE TO BE LDA A,I USED FOR LIMIT CHECKING. ISZ VCHEK POINT TO THE ERROR-RETURN ADDRESS. SSB,RSS IF THE VALUE IS NEGATIVE CMB,INB,SZB,RSS OR ZERO, THEN IT JMP VCHEK,I IS UN-ACCEPTABLE! ELSE, STB NVALU THE NEGATIVE VALUE IS SAVED. ADB A IF THE VALUE SSB EXCEEDS THE MAXIMUM, THEN JMP VCHEK,I IT IS IN ERROR! ELSE, LDA NVALU THE NEG. VALUE IS ISZ VCHEK RETURNED TO THE CALLER JMP VCHEK,I AT . * VSTOR NOP ENTRY/EXIT: CONSTANT STORAGE. LDB VSTOR,I GET THE STORAGE ADDRESS. ISZ VSTOR ESTABLISH THE CORRECT RETURN POINT. * JSB $LIBR GAIN ACCESS TO NOP THE SYSTEM'S RESOURCES. STA B,I SAVE THE NEW CONSTANT IN 'RES'. JSB $LIBX RESTORE THE DEF VSTOR SYSTEM'S DEFENSES. * NVALU NOP TEMP. STORAGE: NEGATED VALUE. * NOTQ JSB PRINT INFORM THE USER THAT DEF NOTQM " SYSTEM IS NOT QUIESCENT!" JMP ABRT4 GO TO ABORT THE PROGRAM. * * ROUTINE TO GET CURRENT SYSTEM TIMING VALUES FOR REPORT TO USER. * GETV NOP ENTRY/EXIT LDA #MSTO GET MASTER TIMEOUT VALUE. ADA DM256 FORM FULL DATA WORD. CMA,INA MAKE IT POSITIVE. JSB CNVTD GO TO CONVERT IT TO ASCII. DEF MSVAL SPECIFY DESTINATION OF RESULT. * LDA #SVTO GET SLAVE TIMEOUT VALUE. ADA DM256 FORM FULL DATA WORD. CMA,INA MAKE IT POSITIVE. JSB CNVTD GO TO CONVERT IT TO ASCII. DEF SLVAL SPECIFY DESTINATION OF RESULT. * LDA #RTRY GET REMOTE-BUSY RETRY COUNT. CMA,INA MAKE IT POSITIVE. JSB CNVTD GO TO CCONVERT IT TO ASCII. DEF RTVAL SPECIFY DESTINATION OF RESULT. * LDA #WAIT GET QUIESCENT-WAIT INTERVAL VALUE. CMA,INA MAKE IT POSITIVE. JSB CNVTD GO TO CONVERT IT TO ASCII. DEF WTVAL SPECIFY DESTINATION OF RESULT. JMP GETV,I RETURN. * CNVTD NOP ENTRY/EXIT: ASCII CONVERSION ROUTINE. STA TEMP1 SAVE THE RAW DATA, TEMPORARILY. LDA CNVTD,I GET THE DESTINATION ADDRESS. STA STUFM CONFIGURE THE CALL TO 'CNUMD'. JSB CNUMD GO TO DEF *+3 CONVERT DEF TEMP1 THE VALUE STUFM NOP TO ASCII. ISZ CNVTD ADJUST THE RETURN POINTER, JMP CNVTD,I AND RETURN TO THE CALLER. * SKP * TMES DEF *+2 DEF D70 ASC 19, TIMING MODIFICATION--CURRENT VALUES: OCT 6412 OCT 6412 ASC 8, MASTER T/O = MSVAL ASC 3, OCT 6412 ASC 8, SLAVE T/O = SLVAL ASC 3, OCT 6412 ASC 8, REMOTE-BUSY = RTVAL ASC 3, OCT 6412 ASC 8, REMOTE-QUIET = WTVAL ASC 3, OCT 6412 OCT 6412 * MSTMG DEF *+2 DEF D17 ASC 17, MASTER T/O [1 TO 255 (*5 SEC.)]?_ SLVMG DEF *+2 DEF D17 ASC 17, SLAVE T/O [ 1 TO 255 (*5 SEC.)]?_ BZMG DEF *+2 DEF D17 ASC 17, REMOTE-BUSY WAIT [1 TO 10 SEC.]?_ WAITM DEF *+2 DEF D17 ASC 17, REMOTE-QUIET WAIT [1 TO 10 SEC]?_ NOTQM DEF *+2 DEF D13 ASC 13, SYSTEM IS NOT QUIESCENT! * D70 DEC 70 SKP * 'PLOG' & 'PCLR' ARE USED TO INITIALIZE AND TERMINATE THE PROCESS * WHICH ALLOWS LOGGING OF ALL NETWORK TRANSACTIONS (PARMB'S) WHICH * FLOW THROUGH THIS PARTICULAR NODE OF THE NETWORK. ADDITIONALLY, * QUEUEING ERRORS MAY BE SEPARATELY MONITORED THRU USE OF PLOG. * * WILL SCHEDULE A PROGRAM CALLED , AND PASS IT THE CLASS * NUMBER [P1], FROM WHICH IT MAY EXPECT TO "GET" THE LOGGED PARMB'S. * ADDITIONALLY, PLOG WILL RECEIVE UP TO 4 OPTIONAL SCHEDULING PARAMETERS, * WHICH WERE SPECIFIED BY THE USER: [,P2[,P3[,P4[,P5]]]] * PLOG LDA #PLOG IF EITHER OPTION SZA,RSS HAS BEEN LDA #QLOG PREVIOUSLY SZA INVOKED, THEN JMP STPR1 BYPASS SCHEDULING OF . * CLE GET A JSB CLSUB CLASS NUMBER DEF PRAM1 FOR THE TRANSACTION-LOGGER: . * LDA DM4 INITIALIZE A COUNTER FOR USE IN STA LUTST GATHERING SCHEDULING PARAMETERS. LDA PR2AD INITIALIZE A POINTER FOR STA LUSET PARAMETER STORAGE. LDB PBDEF GET THE ADDRESS OF THE PARSING BUFFER. ADB B4 POINT TO FIRST SCHEDULING PARAMETER. PGET LDA B,I GET THE PARAMETER TYPE-SPECIFICATION. INB POINT TO THE ACTUAL PARAMETER. SZA NULL PARAMETER? LDA B,I NO. GET THE PARAMETER. STA LUSET,I SAVE FOR SCHEDULING. ADB B3 POINT TO NEXT TYPE-SPECIFICATION. ISZ LUSET SET POINTER FOR NEXT STORAGE LOC'N. ISZ LUTST ALL PARAMETERS BEEN OBTAINED? JMP PGET NO. GO BACK FOR MORE. * LDA DPLOG GET THE NAME-ARRAY ADDRESS. STA NAMPT INITIALIZE THE NAME POINTER. CCE GO TO JSB MSKED SCHEDULE . SZA,RSS WAS IT PROPERLY SCHEDULED? JMP PSTOR YES. GO TO SET THE LOGGING SWITCH. CCE NO--RETURN JSB CLSUB THE CLASS NUMBER DEF PRAM1 TO THE SYSTEM. JMP ABRT4 * ABORT THE PROCESS! * * DPLOG DEF *+1 ADDRESS OF NAME-ARRAY. ASC 3,PLOG * SKP STPR1 STA PRAM1 INITIALIZE SWITCH WITH OLD CLASS NO. * PSTOR LDB PARSB+1 GET THE USER'S COMMAND. CPB QM IF Q-ERRORS ARE TO BE MONITORED, CLB THEN PREPARE TO ENABLE #QLOG. JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. LDA WPRAM1 GET THE LOGGER'S CLASS NUMBER. SZB IF PARMB'S ARE TO BE LOGGED, STA #PLOG ENABLE LOGGING: SAVE CLASS IN . SZB,RSS OTHERWISE, STA #QLOG ENABLE LOGGING OF QUEUEING ERRORS. JSB $LIBX RESTORE THE DEF *+1 SYSTEM'S DEFENSES, AND DEF OPT20 GO TO CHECK FOR OTHER OPTIONS. SPC 1 * ROUTINE TO CANCEL TRANSACTION MONITORING. SPC 1 PCLR CLE PREPARE TO CLEAR #PLOG. LDB PARSB+1 GET THE USER'S COMMAND. LDA #PLOG GET THE PARMB LOGGING CLASS NO. CPB PC IF USER WISHES TO STOP PARMB LOGGING, CCE,RSS SET =1 (TO SPECIFY #PLOG) & SKIP; LDA #QLOG ELSE, GET Q-ERROR CLASS NO. [=0]. CLB PREPARE TO DISABLE LOGGING. JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. SEZ IF =1, STB #PLOG TURN OFF THE TRANSACTION-LOGGING SWITCH; SEZ,RSS ELSE, IF =0, STB #QLOG TURN OFF Q-ERROR LOGGING SWITCH. JSB $LIBX RESTORE DEF *+1 THE SYSTEM'S DEF *+1 DEFENSES. SZA,RSS IF THE OPTION WAS NOT ENABLED, JMP OPT20 GO TO CHECK FOR OTHER REQUESTS. STA MCLAS SAVE CLASS NUMBER FOR POSSIBLE RELEASE. SEZ IF PARMB LOGGING WAS TURNED OFF, LDA #QLOG SEE IF Q-ERROR LOGGING IS ENABLED. SEZ,RSS IF Q-ERROR LOGGING WAS TURNED OFF, LDA #PLOG SEE IF PARMB LOGGING IS ENABLED. SZA IF THE OPPOSITE OPTION IS ENABLED, JMP OPT20 THEN DO NOT ABORT THE LOGGER . * JSB EXEC GO TO RTE DEF *+8 TO WRITE A DEF CLS18 ZERO LENGTH DEF ZERO RECORD INTO DEF ZERO THE LOGGER'S DEF ZERO CLASS. THIS DEF ZERO WILL INFORM DEF ZERO THAT DEF MCLAS LOGGING HAS NOP TERMINATED. * JMP OPT20 GO TO CHECK FOR OTHER OPTIONS. SKP * SUBROUTINE TO VERIFY THAT LU IS LINKED TO 'DVR65'. * LUTST NOP JSB EXEC GO TO RTE DEF *+4 TO GET THE DEF SD13 EQUIPMENT TYPE-CODE DEF LTEMP LINKED TO THE LU NO. DEF TEMP1 SUPPLIED BY THE USER. JMP LUTST,I * INVALID LU--TAKE ERROR-RETURN (P+1) * * LDA TEMP1 ISOLATE THE ALF,ALF EQUIPMENT AND B77 TYPE-CODE. CPA B65 IS THE LU LINKED TO 'DVR65'? ISZ LUTST YES. SET FOR VALID RETURN (P+2). JMP LUTST,I NO. ERROR: RETURN TO P+1. SPC 2 * SUBROUTINE TO SET-UP & ENABLE A LOGICAL UNIT NO. (VIA DVR65). * LUSET NOP CLE GET A JSB RNSUB RESOURCE NUMBER DEF LRN FOR THE COMMUNICATION LINE. CLE GET A JSB RNSUB RESOURCE NUMBER DEF PRN FOR USE BY 'PROGL' (ON THIS LU). * LDB SDF GET LINK TO #SBIT (RES). RSS SKIP TO CHECK FOR INDIRECT LDB B,I GET A RBL,CLE,SLB,ERB DIRECT ADDRESS FOR JMP *-2 DVR65'S ACCESS TO . STB SDF SAVE ADDRESS FOR DRIVER INITIALIZATION. * LDB CDF GET LINK TO $CGRN (RTE). RSS SKIP TO CHECK FOR INDIRECT. LDB B,I GET A RBL,CLE,SLB,ERB DIRECT ADDRESS FOR JMP *-2 DVR65'S ACCESS TO $CGRN. STB CDF SAVE ADDRESS FOR DRIVER INITIALIZATION. * LDA LTEMP GET THE LOGICAL UNIT NUMBER. IOR B300 FORM: SUB-FUN. =3 (SET UP & ENABLE LU). STA CLU SAVE THE CONFIGURED CONTROL WORD. * JSB EXEC GO TO RTE DEF *+4 TO REQUEST THAT DEF SD3 'DVR65' SET UP & ENABLE DEF CLU LISTEN MODE FOR DEF PBUF THE SPECIFIED LU. JMP XXLUSET,I * RTE-DETECTED ERROR--TRY AGAIN! * ISZ LUSET SET FOR NORMAL RETURN (P+2). JMP LUSET,I RETURN TO THE CALLER. * SKP * PROGRAM TERMINATION PROCESSOR. * TERM JSB CHCKN WAS THERE A FILE RSS YES...FILE JMP TERM1 NO...DON'T CLOSE IT * JSB CLOSE CLOSE DEF *+3 THE DEF INDCB CONTROL DEF TEMP1 FILE. * TERM1 LDA ENMSG IF PROGRAM IS BEING ABORTED CPA ABPRM THEN IGNORE JMP TERM3 THE END MESSAGE. * JSB PRNTX GO TO PRINT THE DEF ENDMG TERMINATION MESSAGE--SANS HEADER. * TERM3 JSB PRTN RETURN ERROR INFORMATION DEF *+2 TO THE DEF ENMSG BATCH PROCESSOR. * TERM4 CLB PREPARE FOR NORMAL TERMINATION. LDA PRAM GET FIRST SCHEDULING PARAMETER. CPA D6 IF IT IS =6, THEN CONVERT THE INB TERMINATION CODE TO SAVE RESOURCES. STB TCOD CONFIGURE THE TERMINATION CODE. JSB EXEC GO TO THE DEF *+4 RTE EXECUTIVE DEF D6 TO TERMINATE DEF ZERO THIS PROGRAM, DEF TCOD AND-PERHAPS-TO SAVE RESOURCES. * JMP LSTEN GO BACK TO THE BEGINNING. * TCOD NOP (TERM. CODE: 0-NORMAL/1-SAVE RESOURCES) * SKP * COMMUNICATION LINE ENABLING ROUTINE. * LUIN NOP LDA LUMAX INITIALIZE A COUNTER FOR DETECTION STA LUCNT OF EXCESSIVE NUMBER OF LU'S. LDA LUAD INITIALIZE POINTER FOR STORAGE OF STA LUPNT SPECIFIED LU'S--FOR ABORT PROCESSOR. LSTN4 CLB CLEAR THE CURRENT ENTRY, IN PREPARATION STB LUPNT,I FOR LATER ERROR CHECKING. JSB PRINT DEF MSG1 " LINE LU?_" JSB READ READ A RECORD CPA B1 WAS INPUT BINARY? JMP LSTN6 YES. GO TO PROCESS THE LU. CPB /E END OF LIST? JMP LUIN,I YES. RETURN CPB /A REQUEST TO TERMINATE? JMP ABORT YES. GO TO CLEAN UP & EXIT. LUERR JSB ERROR DEF LUERM "LU ERROR" JMP LSTN4 TRY AGAIN SPC 1 LSTN6 ISZ LUCNT MAXIMUM NO. BEEN PROCESSED? RSS NO. CONTINUE PROCESSING. JMP LUXS * ERROR: TOO MANY LU'S! * STB LTEMP SAVE TEMPORARILY. * JSB LUTST GO VERIFY THAT LU IS LINKED TO 'DVR65'. JMP LURST NOT A DVR 65...ERROR * LDB LUAD GET LU BUFFER ADDRESS FOR INDEX. LLOOP LDA B,I GET AN ENTRY FROM THE LU BUFFER. SZA,RSS END OF BUFFER? JMP LSET YES. GO TO ADD THE NEW LU. CPA LTEMP HAS THE NEW LU ALREADY BEEN INITIALIZED? JMP LURST YES. REPORT THE ERROR! INB NO. ADVANCE THE BUFFER POINTER. JMP LLOOP GO TO EXAMINE THE NEXT BUFFER ENTRY. * LSET LDA LTEMP ADD THE NEW LOGICAL UNIT NUMBER STA LUPNT,I TO THE LU STORAGE BUFFER. JSB LUSET GO TO SET UP & ENABLE THE LU. JMP LURST * RTE-DETECTED ERROR--TRY AGAIN! * * ISZ LUPNT ADVANCE 'LUBUF' POINTER. JMP LSTN4 NO. GO TO REQUEST ANOTHER LU NUMBER. * LUXS JSB SYSER INFORM USER THAT TOO MANY LU'S DEF LUSZR HAVE BEEN SPECIFIED! [NO RETURN]. * LURST LDB LUCNT * ERROR: DECREMENT THE ADB M1 BUFFER COUNTER, AND STB LUCNT RESTORE THE PREVIOUS COUNT. JMP LUERR GO TO INFORM THE USER OF THE ERROR. * LTEMP NOP TEMPORARY LOGICAL UNIT NO. STORAGE. SKP D6 DEC 6 D8 DEC 8 D9 DEC 9 D10 DEC 10 D12 DEC 12 D13 DEC 13 D16 DEC 16 D17 DEC 17 D32 DEC 32 D95 DEC 95 D100 DEC 100 D255 DEC 255 DM2 DEC -2 DM3 DEC -3 DM4 DEC -4 DM100 DEC -100 DM256 DEC -256 B0 OCT 0 ZERO EQU B0 B1 OCT 1 B3 OCT 3 B4 OCT 4 B17 OCT 17 B77 OCT 77 B200 OCT 200 B300 OCT 300 B400 OCT 400 B65 OCT 65 BM100 OCT -100 M1 DEC -1 RLU NOP TEMP1 NOP /A ASC 1,/A /D ASC 1,/D /E ASC 1,/E /L ASC 1,/L /Q ASC 1,/Q /R ASC 1,/R /S ASC 1,/S /T ASC 1,/T PC ASC 1,PC PM ASC 1,PM QC ASC 1,QC QM ASC 1,QM ?? ASC 1,?? CLU NOP TTYF NOP ONTWO NOP SVNUM NOP SCNT NOP LUMAX DEC -33 -(MAX. NUMBER OF LU'S +1) LUCNT NOP LUPNT NOP LUAD DEF LUBUF LUBUF BSS 32 SKP * * ROUTINE TO GET SIZE OF OVERFLOW FILE FOR USE BY 'RFAM'. * FILIN NOP JSB PRINT DEF FILMG " INPUT # OF FILES: _" JSB READ CPA B1 INPUT NUMERIC? JMP GFIL2 YES CPB /A REQUEST TO TERMINATE? JMP ABORT YES. GO TO CLEAN UP & EXIT. * FILER JSB ERROR DEF FERMG "FILE ERROR" JMP FILIN+1 RETRY * GFIL2 STB A SZB,RSS SIZE=0 JMP FILER YES ADB DM256 OR TO LARGE SSA,RSS SSB,RSS OR NEGATIVE JMP FILER ERROR STA RFSIZ SAVE LENGTH FOR RFA SCHEDULE * JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. STA #RFSZ SAVE NUMBER OF 'OPEN' RFA FILES. JSB $LIBX RESTORE THE SYSTEM'S DEFENSES, DEF FILIN AND RETURN TO THE CALLER. * RFSIZ NOP SKP * CLASS NUMBER ALLOCATION/DE-ALLOCATION SUBROUTINE. * * ENTER: & - DON'T CARE (DESTROYED ON RETURN). * = 0 - REQUEST A CLASS ALLOCATION FROM RTE. * = 1 - RETURN A CLASS NUMBER TO THE SYSTEM. * - CLASS NUMBER ADDRESS. * NOTE: DE-ALLOCATION ERRORS ARE IGNORED! * CLSUB NOP ENTRY/EXIT: CLASS SUBROUTINE. LDA DM3 INITIALIZE RE-TRY COUNTER FOR 3 PASSES, STA RETRY IN CASE SYS. MEM. UN-AVAILABLE. CLA,SEZ,RSS IF RETURN OPTION: SET TO IGNORE ERRORS; LDA RSSIN ELSE, SET TO RECOGNIZE ERRORS. STA ERRIN CONFIGURE ERROR-HANDLING INSTRUCTION. * LDB CLSUB,I GET THE CLASS NUMBER ADDRESS. ISZ CLSUB SET RETURN TO . LDA B,I GET THE CLASS NUMBER--IF ANY. ALR,RAR REMOVE BUFFER-SAVE BIT(#14)--IF ANY. SEZ,RSS IF REQUEST TO GET A CLASS, CLA USE ZERO CLASS NUMBER. IOR CLREQ SET NO-WAIT/CLASS-SAVE BITS(15,13). STA B,I SAVE MODIFIED CLASS NO. SPECIFICATION. STB CLSAD CONFIGURE THE CALL WITH CLASS NO. ADDR. SEZ DE-ALLOCATION REQUEST? JMP DEALC YES. GO TO RETURN THE CLASS NUMBER. * CLALC JSB EXEC GO TO RTE DEF *+5 TO REQUEST DEF CLCTL THE ALLOCATION DEF ZERO OF A CLASS NUMBER, DEF ZERO WHICH WILL BE RETURNED TO CLSAD NOP THE SPECIFIED STORAGE ADDRESS. JMP CLERR REPORT THE SYSTEM-LEVEL ERROR. * SSA,RSS ALLOCATION ERROR? JMP CLRTN NO. GO CLEAR PENDING REQUEST. CPA DM2 YES. NO MEMORY AT PRESENT TIME? JSB DELAY YES--WAIT A WHILE & RE-TRY. JMP CLERR *ERROR: NO CLASS# OR RE-TRIES EXHAUSTED. JMP CLALC GO TO RE-TRY THE ALLOCATION REQUEST. * DEALC JSB EXEC GO TO RTE DEF *+8 TO WRITE A DEF CLS18 ZERO LENGTH DEF ZERO RECORD INTO DEF ZERO THE CLASS, WHICH DEF ZERO IS TO BE DEF ZERO DE-ALLOCATED. DEF ZERO THIS WILL ALLOW DEF CLSAD,I SUSPENDED PROGRAMS NOP TO BE ABORTED. * SETSW CCA SET THE RELEASE RE-TRY SWITCH STA CEXIT TO =-1. * CLRTN JSB EXEC GO TO RTE DEF *+5 TO CLEAR DEF CLS21 THE PENDING DEF CLSAD,I REQUEST DEF ZERO ON THE DEF ZERO CLASS. ERRIN NOP IGNORE ERRORS(YES-NOP; NO-RSS)? RSSIN RSS YES. SKIP TO CHECK FOR DE-ALLOCATION. vNLH JMP CLERR NO--REPORT THE CLASS ERROR. ISZ CEXIT RELEASE PROCESSING COMPLETE? JMP REM15 YES. GO CLEAR THE NO-WAIT BIT(#15). * CPA M1 NO. ARE ALL PENDING REQUESTS CLEARED? RSS YES. SKIP TO CHECK FOR DE-ALLOCATION. JMP SETSW NO. CONTINUE TO CLEAR REQUESTS. * LDA ERRIN GET ALLOCATION/DE-ALLOCATION INDICATOR. SZA IF ALLOCATION IN PROCESS, JMP REM15 GO TO REMOVE BIT#15 & RETURN. * LDA CLSAD,I FOR DE-ALLOCATION: GET CLASS WORD, AND CLMSK REMOVE NON-RELEASE BIT(#13), STA CLSAD,I AND RESTORE CLASS WORD. JMP CLRTN GO TO RETURN THE CLASS NUMBER TO RTE. * REM15 LDA CLSAD,I GET THE CLASS WORD ALR,RAR RETAIN BUFFER-SAVE BIT(#13) & CLASS NO. STA CLSAD,I RESTORE THE CLASS WORD. * JMP CLSUB,I RETURN TO THE CALLER. * CLCTL OCT 100023 CLREQ OCT 120000 CLS18 OCT 100022 CLS21 OCT 100025 CLMSK OCT 117777 CEXIT NOP * CLERR JSB SYSER GO TO INFORM THE USER OF A DEF CLSER CATASTROPHIC CLASS-PROCESSING ERROR. * fRN SKP * NETWORK SECURITY CODE PROCESSOR. * * [ CAUTION: DO NOT MAKE CHANGES TO ,,OR RTNS. ] * SECOD NOP ENTRY/EXIT: SECURITY CODE ROUTINE. JSB PRINT DEF SECMS " SECURITY CODE?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES.CONTINUE PROCESSING. JMP SECOD+1 NO. ASK AGAIN. CPB /A USER WISH TO ABORT? JMP ABORT YES--GO DO IT. SPC 1 UNL JSB *+19 LST JSB $LIBR GAIN ACCESS NOP TO SYSTEM RESOURCES. STB #SWRD SAVE MODIFIED SECURITY CODE IN 'RES'. JSB $LIBX RESTORE THE DEF *+1 SYSTEM'S DEF *+1 DEFENSES. SPC 1 JMP SECOD,I RETURN. SPC 1 SECMS DEF *+2 DEF D9 ASC 9, SECURITY CODE? _ * UNL OCT 0,60001,2011,23,2011 JMP *-2 AND *+7 IOR *+7 STA *+1 OCT 0,7000,60001 JMP *-12,I OCT 17,100020,2003,5477 LST SKP * SYSTEM QUIESCEING ROUTINE (SUSPEND NETWORK COMMUNICATIONS). * * [ CAUTION: DO NOT MAKE CHANGES TO ,, OR RTNS.] * QUIES JSB PRINT DEF QHED " SYSTEM QUIESCENCE" QASK JSB PRINT DEF SECMS " SECURITY CODE?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES. CONTINUE PROCESSING. JMP QASK NO. ASK AGAIN. CPB /A REQUEST TO ABORT? JMP ABRT4 YES. OBLIGE THE REQUESTOR! SPC 1 UNL JSB *-27 LST CPB #SWRD DOES THE CALLER KNOW THE SECRET? JMP QUIET <> LET HIM PASS! JSB ERROR <> INFORM HIM OF DEF IVRES THE ERROR OF JMP ABRT4 HIS WAYS!!! SPC 1 QUIET JSB RNRQ GO TO RTE DEF *+4 TO REQUEST DEF B2 A GLOBAL LOCK ]a DEF #QRN UPON THE QUIESCENT DEF TEMP1 RESOURCE NUMBER. * JMP TERM GO TO TERMINATION. * SKP * RE-START A FORMERLY QUIESCED SYSTEM. * * [ CAUTION: DO NOT MAKE CHANGES TO ,, OR RTNS.] * REQUE JSB PRINT DEF RQHED " QUIESCENT RE-START" RQASK JSB PRINT DEF SECMS " SECURITY CODE?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES. CONTINUE PROCESSING. JMP RQASK NO. ASK AGAIN. CPB /A ABORT REQUEST? JMP ABRT4 YES. GO TO COMPLY. UNL JSB *-49 LST SPC 1 CPB #SWRD DOES THE USER KNOW THE SECRET? JMP QOVER <> ALLOW RE-START. JSB ERROR INFORM HIM OF DEF IVRES THE ERROR OF JMP ABRT4 HIS WAYS!!!! SPC 1 QOVER JSB RNRQ GO TO RTE DEF *+4 TO REQUEST DEF B4 AN UNLOCKING OF DEF #QRN THE QUIESCENT DEF TEMP1 RESOURCE NUMBER. JMP OPT20 CHECK FOR OTHER OPTIONS. * SPC 1 QHED DEF *+2 DEF D9 ASC 9, SYSTEM QUIESCENCE RQHED DEF *+2 DEF D10 ASC 10, QUIESCENT RE-START * SKP * RESOURCE NUMBER ALLOCATION/DE-ALLOCATION ROUTINE. SPC 1 * ENTER: & - DON'T CARE (DESTROYED ON RETURN) * = 0 - ALLOCATE GLOBALLY & LOCK LOCALLY * - 1 - DE-ALLOCATE * - ADDRESS FOR RETURN OF RESOURCE NUMBER * NOTE: DE-ALLOCATION ERRORS ARE IGNORED! * NOTE: RN'S ARE LOCKED LOCALLY, TO PREVENT USE UNTIL COMPLETES. * RNSUB NOP ENTRY/EXIT: RN ALLOCATION/RELEASE RTN. CCB,SEZ IF THIS IS A DE-ALLOCATION REQUEST, CLB THEN RESET THE FLAG TO IGNORE ERRORS. STB ERRN SAVE THE ERROR-PROCESSING FLAG. LDA GALCA INITIALIZE FOR GLOBAL ALLOCATION. SEZ { IF THE REQUEST IS FOR DE-ALLOCATION, LDA DALCA THEN GET DE-ALLOCATE REQUEST CODE. STA RNCOD CONFIGURE CALL WITH PROPER REQUEST CODE. LDA RNSUB,I GET THE STORAGE ADDRESS FOR THE RN. STA RNAD CONFIGURE THE CALL WITH RN ADDRESS. ISZ RNSUB SET RETURN ADDRESS TO BYPASS RN ADDRESS. * JSB RNRQ GO TO RTE TO REQUEST OR RETURN A DEF *+4 GLOBALLY ALLOCATED/LOCALLY LOCKED RNCOD NOP RESOURCE NUMBER. RNAD NOP DEF RNST DUMMY STATUS INFO STORAGE. ISZ ERRN IF DE-ALLOCATION REQUEST ERROR-- JMP RNSUB,I OR NORMAL COMPLETION: RETURN. * JSB SYSER ALLOCATION ERROR: INFORM THE CALLER. DEF RNERM CATASTROPHIC ERROR--NO RETURN! * GALCA DEF GALC ADDRESS OF ALLOCATION CODE. DALCA DEF DALC ADDRESS OF DE-ALLOCATION CODE. GALC OCT 140021 GLOBAL ALLOCATE/LOCAL LOCK/NO ABORT DALC OCT 140040 RELEASE GLOBAL/NO ABORT ERRN NOP ERROR-HANDLING SWITCH(0-IGNORE/1-REPORT) RNST NOP RN STATUS STORAGE (NOT USED). * SKP * DEFINE TOTAL # OF MONITORS * * [ ADD 1 TO THE VALUE FOR EACH NEW MONITOR TO BE ADDED ] * #MON EQU 10 * * DEFINE - # OF MONITORS * MNMON ABS -#MON SPC 1 NAMA DEF NAMES SPC 1 NAMES ASC 3,SMON DEF #ST00+1 STREAM-TYPE 0 OCT 100000 ABORT O.K. * ASC 3,DLIST DEF #ST01+1 STREAM-TYPE 1 OCT 0 NO ABORT! * ASC 3,PLOS DEF #ST02+1 STREAM-TYPE 2 OCT 0 NO ABORT! * ASC 3,NPRGL DEF #ST03+1 STREAM-TYPE 3 OCT 0 NO ABORT! * ASC 3,PTOPM DEF #ST04+1 STREAM-TYPE 4 OCT 0 NO ABORT! * ASC 3,EXECM DEF #ST05+1 STREAM-TYPE 5 OCT 100000 ABORT O.K. * RFAM ASC 3,RFAM DEF #ST06+1 STREAM-TYPE 6 OCT 0 NO ABORT! * ASC 3,OPERM DEXF #ST07+1 STREAM-TYPE 7 OCT 100000 ABORT O.K. * ASC 3,PLOSB DEF #ST08+1 STREAM-TYPE 8 OCT 0 NO ABORT! * ASC 3,PROGL DEF #ST09+1 STREAM-TYPE 9 OCT 0 NO ABORT! * * NEW ENTRY: .........ASC 3,NAME? << ADD NEW MONITOR NAME HERE >> * .........DEF #ST10+1 << DEFINE STRM.-HEADER CLASS-WORD HERE >> * .........OCT X00000 << UPLIN ABORT O.K.: X=1; NO ABORT: X=0>> * .....................<< ADD EXT FOR STRM.-HEADER ENT IN 'RES'>> SKP * ROUTINE TO SCHEDULE USER-SPECIFIED SLAVE MONITORS. * MSET NOP ENTRY/EXIT: MONITOR SCHEDULING RTN. CLA,SEZ,RSS IF =1, DISALLOW DEFAULT SCHEDULING. CCA INITIALIZE A FLAG TO ALLOW STA MFLAG DEFAULT SCHEDULING ON FIRST PASS. MLOOP LDA MNMON INITIALIZE A COUNTER STA MCNT FOR THE NO. OF MONITORS TO SCHEDULE. LDB NAMA INITIALIZE THE STB NAMPT PROGRAM NAME-ARRAY POINTER. * JSB PRINT ASK FOR THE DEF MONMS " MONITOR NAME? _" * JSB READ GET THE USER'S RESPONSE. CPB /E ALL DONE? JMP MSET,I YES. RETURN FOR NEXT OPERATION. CPB /A REQUEST TO ABORT? JMP ABORT YES. GO TO CLEAN UP & EXIT. CPB /D CHECK FOR DEFAULT SCHEDULING. RSS IF IT IS A "/D", THEN SKIP FOR DEFAULT; JMP MNAM ELSE, CONTINUE CHECKING. ISZ MFLAG IF THIS IS NOT A 1RST-PASS DEFAULT JMP NAMER REQUEST--ERROR!--ELSE, JMP MDFLT DEFAULT: GO TO SCHEDULE ALL MONITORS. * MNAM CPA B2 IF RESPONSE WAS ASCII-ALPHA. CHARACTERS, RSS THEN SKIP TO CHECK FOR A VALID NAME; JMP NAMER ELSE, INFORM THE USER OF HIS ERROR! * LDA NAMPT GET THE POINTER TO THE NAME-ARRAY. MCOMP CPB A,I IF THE FIRST TWO CHARACTERS COMPARE, INA,RSS THEN ADVANCE NAME POINTER & SKIP. N JMP NXNAM NO COMPARISON--GO TO CHECK NEXT ENTRY. * LDB PARSB+2 GET CHARACTERS 3 & 4 FROM USER. CPB A,I IF THESE COMPARE TO THE NAME-ARRAY, INA,RSS THEN ADVANCE NAME POINTER & SKIP. JMP NXNAM NO COMPARISON--GO TO CHECK NEXT ENTRY. * LDB PARSB+3 GET CHARACTERS 5 & 6 FROM USER. CPB A,I IF THESE COMPARE, JMP MFOUN THEN GO TO SCHEDULE THE MONITOR. * NXNAM LDA NAMPT ADVANCE THE ADA B5 NAME-ARRAY POINTER TO POINT STA NAMPT TO THE NEXT MONITOR'S NAME. LDB PARSB+1 GET USER'S FIRST TWO CHARACTERS AGAIN. ISZ MCNT HAVE ALL OF THE NAMES BEEN CHECKED? JMP MCOMP NO. GO TO CHECK THE NEXT ONE. * NAMER JSB ERROR INFORM THE USER OF HAVING SUPPLIED AN DEF INVNM " INVALID NAME!" JMP MLOOP GO BACK TO TRY AGAIN. * SKP MFOUN CLA CLEAR 'MFLAG' IN ORDER TO STA MFLAG DIS-ALLOW DEFAULT SCHEDULING. * CLE SPECIFY MONITOR SCHEDULING. JSB MSKED GO TO SCHEDULE THE MONITOR. JMP MLOOP GO TO ASK FOR THE NEXT NAME. * MDFLT CLE SPECIFY MONITOR SCHEDULING. JSB MSKED GO TO SCHEDULE A MONITOR. LDA NAMPT ADVANCE THE ADA B5 NAME-ARRAY POINTER TO POINT STA NAMPT TO THE NEXT MONITOR'S NAME. ISZ MCNT HAVE ALL MONITORS BEEN SCHEDULED? JMP MDFLT NO. GO TO SCHEDULE THE NEXT ONE. JMP MSET,I YES. RETURN FOR THE NEXT OPERATION. * PRAM1 NOP PROGRAM PRAM2 NOP SCHEDULING PRAM3 NOP PARAMETER PRAM4 NOP STORAGE PRAM5 NOP LOCATIONS. RFMDF DEF RFAM SCHNW OCT 100012 STMPT NOP NAMPT NOP MCNT NOP MFLAG NOP SPC 1 * DO NOT CHANGE ORDER OF 'MCLAS' & 'IDAD' * SPC 1 MCLAS NOP IDAD NOP * QUES ASC 2,MON? ASTAT ASC 2,STAT SMES DEF *+2 DEF D10 ASC 4, ERROR: ERCO[D ASC 3, : SNAM ASC 3,XXXXX MONMS DEF *+2 DEF D8 ASC 8, MONITOR NAME? _ INVNM DEF *+2 DEF B7 ASC 7, INVALID NAME! * D99 DEC 99 B5 OCT 5 * SKP * SUBROUTINE TO SCHEDULE A MONITOR & INITIALIZE IT'S LIST-HEADER ENTRY. * MSKED NOP ENTRY/EXIT: MONITOR SCHEDULER. SEZ MONITOR OR OTHER SCHEDULE REQUEST? JMP SCHED GO TO SCHEDULE ANOTHER PROCESSOR. JSB PGMAD GO TO GET MONITOR'S ID SEGMENT ADDRESS. DEF *+2 DEF NAMPT,I ADDRESS OF MONITOR'S NAME. SZA,RSS IS THE MONITOR PRESENT? JMP MON? NO. INFORM THE USER. STA IDAD YES. SAVE I.D. SEGMENT ADDRESS. LDA B GET MONITOR'S STATUS INTO . AND B17 ISOLATE THE MONITOR'S STATUS. SZA IS IT DORMANT? JMP STERR NO. INFORM USER OF ERROR. * CLE GET A JSB CLSUB CLASS NUMBER DEF MCLAS FOR THE MONITOR. LDB NAMPT GET THE NAME-ARRAY POINTER. ADB B3 ADVANCE TO THE STREAM-LIST ENTRY. LDA B,I GET ADDRESS OF STREAM-LIST CLASS-WORD. STA STMPT SAVE FOR 'RES' INITIALIZATION. INB ADVANCE TO THE ABORT-FLAG ENTRY. LDA IDAD GET THE I.D. SEGMENT ADDRESS. IOR B,I INCLUDE THE ABORT-FLAG BIT(#15)--IF ANY. STA IDAD RESTORE THE FLAGGED I.D. SEGMENT ADDRESS * JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. DLD MCLAS GET CLASS NO. & ID SEG. ADDRESS. DST STMPT,I STORE INTO STREAM LIST-HEADER IN 'RES'. JSB $LIBX RESTORE DEF *+1 THE SYSTEM'S DEF *+1 DEFENSES. * CLB CLEAR THE FIFTH STB PRAM5 SCHEDULING PARAMETER. LDA NAMPT GET THE NAME-ARRAY POINTER. CPA RFMDF IF 'RFAM' IS BEING SCHEDULED, THEN JMP RFSCH GO TO SET UP THE REQUIRED PARAMETERS. LDA MCLAS GE#T THE MONITOR'S CLASS NUMBER, AND STA PRAM1 SAVE FOR FIRST SCHEDULING PARAMETER. STB PRAM2 CLEAR ALL STB PRAM3 OF THE OTHER STB PRAM4 SCHEDULING PARAMETERS. JMP SCHED GO TO SCHEDULE THE MONITOR. * RFSCH JSB FILIN GO TO GET THE FILE COUNT FOR , AND STA PRAM2 SAVE FOR SECOND SCHEDULING PARAMETER. LDA D99 DECIMAL 99 (RFAM INITIALIZATION FLAG) IS STA PRAM1 THE FIRST SCHEDULING PARAMETER. LDA MCLAS THE THIRD SCHEDULING PARAMETER STA PRAM3 IS CLASS NUMBER. LDA RXCL# CLASS NUMBER IS THE FOURTH AND STA PRAM4 FINAL SCHEDULING PARAMETER FOR . SKP * SCHED JSB EXEC GO TO RTE DEF *+8 TO SCHEDULE DEF SCHNW THE MONITOR DEF NAMPT,I WITHOUT WAIT. DEF PRAM1 SCHEDULING PARAMETER #1. PR2AD DEF PRAM2 SCHEDULING PARAMETER #2. DEF PRAM3 SCHEDULING PARAMETER #3. DEF PRAM4 SCHEDULING PARAMETER #4. DEF PRAM5 SCHEDULING PARAMETER #5. JMP STCOD * ERROR--REPORT TO USER * SZA WAS IT CORRECTLY SCHEDULED? JMP STERR NO--INCORRECT STATUS ERROR. * * LDB NAMPT GET NAME-ARRAY ADDR OF CURRENT SCHEDULEE CPB RFMDF IF IT IS 'RFAM' THEN RSS SKIP TO AWAIT COMPLETION; ELSE, JMP MSKED,I RETURN TO THE CALLER (=STATUS). * JSB EXEC TERMINATE DEF *+4 AND SAVE RESOURCES, DEF D6 TO AWAIT DEF ZERO RE-AWAKENING BY DEF B1 THE RFA MONITOR. * LDA B,I GET THE RETURNED PARAMETER. CPA RXCL# IF IT IS THE 'RFAEX' CLASS NUMBER, JMP MSKED,I THEN RFA IS SET UP CORRECTLY; ELSE, JMP STERR INFORM USER OF THE ERROR! * MON? DLD QUES GET THE MONITOR-MISSIN NG INDICATOR. JMP STCOD SAVE FOR THE ERROR MESSAGE. STERR DLD ASTAT GET THE STATUS-PROBLEM INDICATOR. STCOD DST ERCOD SAVE THE ERROR CODE. * DLD NAMPT,I GET THE NAME DST SNAM OF THE MONITOR, LDB NAMPT AND SAVE IT ADB B2 FOR USE IN LDA B,I THE ERROR-REPORT STA SNAM+2 MESSAGE. * JSB ERROR GO TO PRINT THE DEF SMES ERROR MESSAGE. JMP MSKED,I RETURN TO THE CALLER. * SKP * SCHEDULE , THE TRANSACTION MONITOR & CLEANUP PROGRAM, * TO RUN EVERY FIVE SECONDS. * SUPLN NOP JSB EXEC GO TO THE DEF *+6 RTE EXECUTIVE DEF SCHTM TO TIME-SCHEDULE DEF UPLIN DEF B2 TO BE RUN DEF B5 EVERY FIVE SECONDS; DEF DM2 TO BEGIN IN TWO SECONDS. RSS IF A SYSTEM ERROR IS DETECTED, SKIP; JMP SUPLN,I ELSE, RETURN TO THE CALLER. * JSB SYSER INFORM THE USER OF A CATASTROPHIC ERROR: DEF UPMES 'UPLIN' WAS NOT SCHEDULED. [NO RETURN] * SCHTM OCT 100014 UPMES DEF *+2 DEF D12 ASC 2, ** UPLIN ASC 3,UPLIN ASC 7,NOT SCHEDULED! * * SCHEDULE QUEUEING PROCESSORS: ,,& . * SCHDQ NOP ENTRY/EXIT LDA NAMAD GET THE ADDRESS OF THE FIRST PROCESSOR. STA NAMPT INITIALIZE POINTER TO PROGRAM NAME ARRAY. LDA NMCNT INITIALIZE A NEGATIVE COUNTER STA NCNTR FOR NUMBER OF PROGRAMS TO BE SCHEDULED. CLA SET THE CLASS PARAMETER =0 (DUMMY), STA PRAM1 SINCE IT'S ALREADY STORED IN . STA PRAM2 CLEAR STA PRAM3 REMAINING STA PRAM4 SCHEDULING STA PRAM5 PARAMETERS. * SCHDL CCE SPECIFY OTHER-PROCESSOR SCHEDULING. JSB MSKED GO TO SCHEDULE THE PROCESSOR. SZA CAhkTASTROPHIC ERROR? JMP ABORT YES ** ABORT ** LDA NAMPT GET THE NAME-ARRAY POINTER. ADA B3 ADD AN OFFSET FOR NEXT NAME ENTRY. STA NAMPT UPDATE THE ARRAY POINTER. ISZ NCNTR ALL QUEUEING PROCESSORS BEEN SCHEDULED? JMP SCHDL NO. GO TO SCHEDULE THE NEXT ONE. JMP SCHDQ,I YES. RETURN TO THE CALLER. * NCNTR EQU SUPLN NMCNT EQU DM3 NAMAD DEF *+1 POINTER TO FIRST PROGRAM'S NAME. ASC 3,SRPM SLAVE PRE-PROCESSING MONITOR. ASC 3,GRPM GENERAL PRE-PROCESSING MONITOR. ASC 3,QCLM QUEUEING CLEAN-UP MONITOR. * SKP * SUBROUTINE TO PRINT MESSAGES ON INTERACTIVE TERMINALS--ONLY. * * CALLING SEQUENCES: * * JSB PRINT....PRINT:" /LSTEN:" JSB PRNTX....PRINT:"" * DEF MESSAGE DEF MESSAGE * PRNTX NOP ENTRY/EXIT: PRINT W/O HEADER LDA PRNTX GET THE RETURN ADDRESS. STA PRINT SAVE FOR THE RETURN. LDA A,I GET THE MESSAGE ADDRESS, STA OLDAD AND SAVE FOR ERROR-TRANSFER ROUTINE. DLD A,I GET THE MESSAGE SPECIFICATIONS, DST PRNT1 AND CONFIGURE THE CALLING SEQUENCE. JMP PRNT0 GO TO PRINT THE MESSAGE W/O HEADER. * PRINT NOP NORMAL ENTRY/EXIT DLD NORMA RE-ESTABLISH THE DST PRNT1 NORMAL MESSAGE SPECIFICATIONS. LDA MSGAD INITIALIZE THE STA BUFPT MESSAGE BUFFER POINTER. LDB PRINT,I GET ADDRESS OF MESSAGE INFORMATION. LDA ERXTM IF THE ERROR-TRANSFER ROUTINE IS SZA,RSS IN CONTROL, BYPASS 'OLDAD' UPDATING. STB OLDAD SAVE IT FOR THE ERROR-TRANSFER ROUTINE. DLD B,I GET BUFFER ADDRESS AND LENGTH. STA MSPNT SAVE FOR SOURCE POINTER. LDB B,I GET THE MESSAGE LENGTH. ADB B5 CONFIGURE THE LENGTH FOR STB PRNTL INCLUSION OF THE HEADER. CMB,INB FORM A NEGATIVE COUNTER e ADB B5 FOR USE IN MOVING THE MESSAGE. LDA D20 IF THE MESSAGE LENGTH ADA B EXCEEDS THE MAXIMUM SSA BUFFER SIZE, THEN JMP PRNTA IGNORE THE REQUEST; ELSE, MSGET LDA MSPNT,I TRANSFER STA BUFPT,I THE ISZ MSPNT MESSAGE ISZ BUFPT TO THE INB,SZB PRINT JMP MSGET BUFFER. LDA TTYF GET TTY FLAG LDB ERFLG GET ERROR FLAG SZB,RSS ERROR OR SZA,RSS OR INTERACTIVE RSS YES...PRINT MESSAGE JMP PRNTA NO ERROR AND NOT INTERACTIVE LDA RLU GET INTERACTIVE LU SZB ERROR? LDA ERLU YES...ERROR LU STA PRTLU SAVE AS PRINT LU PRNT0 JSB REIO PRINT MESSAGE DEF *+5 DEF B2 DEF PRTLU PRINT LU PRNT1 DEF HEDMS MESSAGE ADDRESS. DEF PRNTL MESSAGE LENGTH. PRNTA ISZ PRINT POINT TO RETURN ADDRESS JMP PRINT,I RETURN SPC 1 B2 OCT 2 D20 DEC 20 ERLU NOP ERROR LOGICAL UNIT NO. PRTLU NOP PRNTL NOP OLDAD NOP PREVIOUS MESSAGE ADDRESS. MSPNT NOP BUFPT NOP NORMA DEF HEDMS DEF PRNTL MSGAD DEF MSGBF HEDMS OCT 6412 CARRIAGE-RETURN/LINEFEED. ASC 4, /LSTEN: MSGBF BSS 20 * SPC 2 * ROUTINE TO DECIDE WHICH TYPE OF INPUT DEVICE * EITHER FILE OR LU * IF LU, A REG WILL CONTAIN LU TYPE * CALLING SEQUENCE * JSB CHCKN * FILE RETURN * LU RETURN * CHCKN NOP LDB FILFG GET FILE FLAG LDA TTYF GET TTY FLAG SZB,RSS LU OR FILE ISZ CHCKN LU JMP CHCKN,I AND RETURN * FILFG NOP FILE FLAG. SPC 2 * SUBROUTINE TO PRINT SYSTEM ERROR MESSAGES AND * ABORT * CALLING SEQUENCE * JSB SYSER * DEF ERR MESSAGE * SYSER NOP LDA SYSER,I STA SYSAD JSB PRINT SYSAD NOP JMP ABORT AFTE$R MESSAGE...ABORT * SKP * SUBROUTINE TO READ FROM A SELECTED INPUT DEVICE * WILL PARSE THE INPUT AND PLACE RESULT IN A BUFFER * CALLED PARSB. * CALLING SEQUENCE * JSB READ * UPON RETURN A REG=PARSB, B REG=PARSB+1 * READ NOP JSB CHCKN FILE OR LU JMP READB FILE READA LDA RLU GET READ LU LDB RDER IS THIS AN ERROR READ? SZB LDA ERLU YES...READ FOR ERROR DEVICE STA REDLU SAVE READ LU JSB REIO ISSUE THE READ DEF *+5 DEF B1 DEF REDLU DEF INBUF DEF INBFS SZB EOF HIT? JMP READC NO REDER ISZ RDER SET READ-ERROR FLAG. JSB ERXFR INDICATE ERROR, AND ALLOW RE-TRY. DEF EOFM "EOF...INPUT NEEDED" JMP READA TRY AGAIN SPC 1 READB JSB READF READ FROM A FILE DEF *+6 DEF INDCB DEF RSTAT DEF INBUF DEF INBFS DEF ILEN LDB ILEN GET LENGTH SSB,RSS SZB,RSS ZERO OR - ERROR JMP REDER READC CLE,ELB CONVERT TO BYTE LENGTH STB ILEN SAVE LENGTH JSB PARSE GO PARSE INPUT DEF *+4 DEF INBUF DEF ILEN PBDEF DEF PARSB CLA CLEAR OUT READ-ERROR FLAG STA RDER DLD PARSB LOAD A AND B REG JMP READ,I AND RETURN * RDER NOP REDLU NOP ILEN NOP RSTAT NOP SKP * ROUTINE TO PRINT ERROR MESSAGE. * * CALLING SEQUENCE: * * JSB ERROR * DEF * * WILL SET ERROR FLAG FOR RETRY * ERROR NOP LDA ERROR,I STA ERRAD ISZ ERFLG JSB PRINT ERRAD NOP CLA STA ERFLG ISZ ERROR JSB CHCKN IF A FILE IS IN CONTROL, JMP ABORT THEN NO 2ND CHANCES ARE POSSIBLE! JMP ERROR,I AND RETURN SPC 1 ERFLG NOP SPC 3 * PRINT THE ERROR MESSAGE AND REPEAT THE QUESTION ON THE (ERROR LU) DEVICE. * * CALLING SEQUENCE: * * JSB ERXFR * DEF * ERXFR NOP ENTRY/EXIT: ERROR TRANSFER ROUTINE LDA ERXFR,I GET ADDRESS OF MESSAGE INFORMATION. STA ERXAD SAVE FOR 'PRINT' CALL. LDA OLDAD GET ADDRESS OF QUESTION INFORMATION. STA ERXTM SAVE LOCALLY FOR QUERY. ISZ ERFLG FORCE THE USE OF THE (ERROR LU). JSB PRINT GO TO PRINT ERXAD NOP THE ERROR MESSAGE. * JSB PRINT GO TO REPEAT THE QUESTION DEF ERXTM,I ON THE (ERROR LU) DEVICE. CLA CLEAR OUT STA ERFLG THE ERROR FLAG, STA ERXTM AND THE ERROR-TRANSFER FLAG. ISZ ERXFR BYPASS THE MESSAGE DEFINITION JMP ERXFR,I UPON RETURNING TO THE CALLER. * ERXTM NOP STORAGE: QUESTION DEFINITION ADDRESS. * SKP * HERE ON ANY ABORT CONDITIONS * WILL CLEAR ALL LU'S, FLAGS, * DE-ALLOCATE ALL RN'S AND CLASS NUMBERS, * AND TERMINATE ALL MONITORS. * CALLING SEQUENCE * JMP ABORT * ABORT LDA ONTWO OPTION 1 OR 2 SZA JMP ABRT4 OPTION 2 * LDA LUBUF GET THE CONTENTS OF THE LU BUFFER SZA,RSS HAVE ANY ENTRIES BEEN MADE? JMP MKILL NO. BYPASS LU-CLEAR SECTION. * LDA LUMAX INITIALIZE A COUNTER FOR THE MAXIMUM STA LUCNT NUMBER OF LU'S TO BE PROCESSED. LDA LUAD INITIALIZE POINTER TO STA LUPNT LU STORAGE BUFFER. * LOOP ISZ LUCNT HAS THE LAST LU BEEN CHECKED? RSS NO. CONTINUE TO CLEAR LU'S. JMP MKILL YES. GO ON TO TERMINATE THE MONITORS. * LDA LUPNT,I GET THE CURRENT LU NUMBER. SZA,RSS IS AN LU PRESENT? JMP MKILL NO. GO TO ABORT THE MONITORS. * IOR B200 INCLUDE SUB-FUNCTION =2: CLEAR REQUEST. STA CLU SAVE THE CONFIGURED CONTROL WORD. * JSB EXEC GO TO RTE DEF *+4 TO REQUEST THAT 7NLH DEF SD3 DVR65 CLEAR OUT DEF CLU ANY PREVIOUS DEF LRN CONFIGURATION DATA. NOP * IGNORE ERRORS * * CCE CLEAR THE JSB RNSUB RESOURCE NUMBER DEF LRN FOR THE COMM. LINE RN. CCE CLEAR THE JSB RNSUB RESOURCE NUMBER DEF PRN FOR THE 'PROGL' RN. * ISZ LUPNT ADVANCE POINTER TO THE NEXT LU NO. JMP LOOP GO BACK TO PROCESS THE NEXT LU. * jN SKP MKILL LDA #FWAM IF SYSTEM AVAILABLE MEMORY SZA,RSS HAS NOT BEEN ALLOCATED, JMP ABRT4 THEN GO TO COMPLETION. LDA MNMON GET NEGATIVE NUMBER OF MONITORS. STA MCNT SAVE AS A LOOP COUNTER. LDB NAMA GET THE ADDRESS OF THE NAME-ARRAY. ABMON STB NAMPT SAVE AS A POINTER. ADB B3 POINT TO 'DEF' TO THE STREAM-LIST ENTRY. LDA B,I GET ADDRESS OF THE STREAM-LIST ENTRY. LDA A,I GET THE MONITOR CLASS NO.--IF ANY. SZA,RSS IS THIS MONITOR ACTIVE? JMP ABNEX NO. GO TO TRY THE NEXT MONITOR. STA MCLAS YES. SAVE THE CLASS NO. FOR RELEASE. JSB KILLM GO TO TERMINATE THE MONITOR. * ABNEX LDB NAMPT GET THE NAME-ARRAY POINTER. ADB B5 ADVANCE THE POINTER TO THE NEXT ENTRY. * ISZ MCNT HAVE ALL MONITORS BEEN ABORTED? JMP ABMON NO. GO BACK TO KILL THE NEXT ONE. * * GATHER ALL RN'S AND CLASS NUMBERS FROM 'RES' FOR LOCAL PROCESSING. * LDA #TBRN STA TBRN# LDA #GRPM STA GRPM# LDA #GPRN STA GPRN# LDA #SRPM STA SRPM# LDA #QCLM STA QCLM# LDA #RXCL STA RXCL# LDA #QRN STA QRN# * CCE GO TO RELEASE THE JSB CLSUB CLASS NUMBER DEF RXCL# FOR 'RFAM'/'RFAEX' COMMUNICATIONS. * JSB MESSS ABORT 'RFAEX' DEF *+3 VIA THE DEF RFKIL RTE SYSTEM'S DEF D10 MESSAGE PROCESSOR. * LDA NAMAD GET POINTER TO 'SRPM' NAME ARRAY. STA NAMPT SET POINTER FOR 'KILLM' ROUTINE. LDA SRPM# GET 'SRPM' CLASS NUMBER. STA MCLAS SET FOR RELEASE BY 'KILLM'. JSB KILLM GO TO TERMINATE 'SRPM'. * LDA NAMPT GET NAME ARRAY POINTER. ADA B3 POINT TO 'GRPM' NAME ARRAY. STA NAMPT SET POINTER FOR TERMINATION. LDA GRPM# GET 'GRPM' CLASS NUMHBER. STA MCLAS SET FOR RELEASE BY 'KILLM'. JSB KILLM GO TO TERMINATE 'GRPM'. * LDA NAMPT GET NAME ARRAY POINTER. ADA B3 POINT TO 'QCLM' NAME ARRAY. STA NAMPT SET POINTER. LDA QCLM# GET 'QCLM' CLASS NUMBER. STA MCLAS SET FOR RELEASE. JSB KILLM GO TO TERMINATE 'QCLM'. * CCE GO TO RELEASE THE JSB RNSUB RESOURCE NUMBER DEF TBRN# FOR TABLE-ACCESS CONTROL. CCE GO TO RELEASE THE JSB RNSUB RESOURCE NUMBER DEF GPRN# FOR THE GENERAL PRE-PROCESSOR MODULE. CCE GO TO RELEASE THE JSB RNSUB RESOURCE NUMBER DEF QRN# FOR SYSTEM-QUIESCENCE CONTROL. * JSB #RSAX GO TO THE SYSTEM-RESOURCE DEF *+3 CONTROL-ROUTINE, IN ORDER TO DEF ZERO RETURN SYSTEM AVAILABLE MEMORY, DEF #FWAM WHICH WAS PREVIOUSLY ALLOCATED. * JSB CLEAR GO TO CLEAR SYSTEM DATA AREA IN . * ABRT4 JSB PRINT PRINT ABORT MESSAGE DEF ABRTM "LSTEN ABORTED" DLD ABPRM DST ENMSG JMP TERM * SKP KILLM NOP ENTRY/EXIT: TERMINATION ROUTINE JSB EXEC GO TO RTE DEF *+4 TO REQUEST DEF KILCD TERMINATION DEF NAMPT,I OF THE SPECIFIED DEF B3 PROGRAM. NOP * IGNORE ERRORS * * CCE RELEASE JSB CLSUB THE PROGRAM'S DEF MCLAS CLASS NUMBER. * JMP KILLM,I RETURN TO THE CALLER. SPC 1 B7 OCT 7 KILCD OCT 100006 ABPRM OCT 100000 ASC 1,ER RFKIL ASC 5,OF,RFAEX,1 SPC 3 * ROUTINE TO CLEAR 'LSTEN'-INITIALIZED ENTRIES IN . SPC 1 CLEAR NOP ENTRY/EXIT LDA #NCLR INITIALIZE A COUNTER FOR THE STA TEMP1 SIZE OF THE AREA TO BE CLEARED. LDA #SCLR GET A POINTER TO THE START OF TH#E AREA. RSS SKIP TO CHECK FOR INDIRECT ADDRESS. LDA A,I GET A RAL,CLE,SLA,ERA DIRECT ADDRESS FOR JMP *-2 THE POINTER. STA NAMPT SAVE THE ADDRESS POINTER. JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. CLA CLEAR CLOOP STA NAMPT,I THE ISZ NAMPT 'LSTEN'-INITIALIZED ISZ TEMP1 STORAGE LOCATIONS JMP CLOOP IN 'RES'. * JSB $LIBX RESTORE THE DEF CLEAR SYSTEM'S DEFENSES. * SKP * FERMG DEF *+2 DEF D6 ASC 6, FILE ERROR * RNERM DEF *+2 DEF B5 ASC 5, RN ERROR * MSG1 DEF *+2 DEF D6 ASC 6, LINE LU? _ * LUERM DEF *+2 DEF B5 ASC 5, LU ERROR * TRFM DEF *+2 DEF D8 ASC 8, TR FILE ERROR * FILMG DEF *+2 DEF D10 ASC 10, INPUT # OF FILES: _ * LUSZR DEF *+2 DEF B7 ASC 7, TO MANY LU'S * EOFM DEF *+2 DEF D10 ASC 10, EOF..INPUT MORE * ABRTM DEF *+2 DEF D8 ASC 8, LSTEN ABORTED! * CLSER DEF *+2 DEF D9 ASC 9, CLASS I/O ERROR * ENDMG DEF *+2 DEF B5 ENMSG ASC 5, END LSTEN * UPLUM DEF *+2 DEF D12 ASC 12, LU TO BE RE-ENABLED? _ * OPMES DEF *+2 DEF B7 ASC 7, OPERATION? _ * SKP * EXPMS DEF *+2 DEF D95 OCT 6412 CARRIAGE-RETURN/LINE-FEED ASC 9, ??: LIST COMMANDS OCT 6412 ASC 5, /A: ABORT! OCT 6412 ASC 7, /E: TERMINATE OCT 6412 ASC 10, /L: RE-ENABLE LINE OCT 6412 ASC 10, /Q: QUIESCE NETWORK OCT 6412 ASC 12, /S: SCHEDULE MONITOR(S) OCT 6412 OCT 6412 ASC 12, QUIESCENT SYSTEM ONLY: OCT 6412 ASC 11, /R: RE-START NETWORK OCT 6412 ASC 9, /T: ADJUST TIMING * SPC 3 A EQU 0 B EQU 1 BUFS EQU 20 PBUFS EQU 34 INbGBFS ABS BUFS INBUF BSS BUFS PARSB BSS PBUFS INDCB BSS 144 SPC 1 BSS 0 << SIZE OF 'LSTEN' >> SPC 1 END LSTEN c &2Y 91700-18110 1552 S 0122 DS1/B CCE MODULE: DAPOS              H0101 >ASMB,R,L,C HED DAPOS 91700-16110 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DAPOS,7 91700-16110 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DAPOS EXT APOSN EXT .ENTR SPC 5 * * DAPOS * SOURCE:91700-18110 * BINARY:91700-16110 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 5 NOP DAPOS NOP JSB .ENTR DEF PRAMS * LDA D3 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * * SZB,RSS WAS THE 4TH ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT LDA PRAMS+4 MOVE POSSIBLE 5TH * SZA,RSS THERE? JMP DONE NO FINISHED ISZ #PRMS YES BUMP COUNT & STORE AWAY STA PRAM1+4 DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY LDA PRAM1+1,I GET IERR JMP DAPOS,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB APOSN DRTN NOP PRAM1 REP 5 NOP JMP RFASR,I SPC 5 CLEAR NOP CLA CLEAR OPTIONAL PARAMETER DEFS CLB DST PRAMS+3 DST PRAM1+3 JMP CLEAR,I SPC 5 * CONSTANTS D3 DEC 3 ADDS DEF DRTN+1 #PRMS NOP END * AN ERROR EXISTS (G   '. 91700-18111 1552 S 0122 DS1/B CCE MODULE: DCLOS              H0101 @ASMB,R,L,C HED DCLOS 91700-16111 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DCLOS,7 91700-16111 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DCLOS EXT CLOSE EXT .ENTR SPC 5 * * DCLOS * SOURCE:91700-18111 * BINARY:91700-16111 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 3 NOP DCLOS NOP JSB .ENTR DEF PRAMS * * * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * LDA PRAMS+2 MOVE 3RD STA PRAM1+2 * LDA D3 CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR CLB STB PRAMS+2 CLEAR OPTIONAL PARAMETERS STB PRAM1+2 JMP DCLOS,I FINISHED RETURN TO USER RFASR NOP JSB CLOSE DRTN NOP PRAM1 REP 3 NOP JMP RFASR,I SPC 5 * CONSTANTS D3 DEC 3 ADDS DEF DRTN+1 END * AN ERROR EXISTS k (. 91700-18112 1552 S 0122 DS1/B CCE MODULE: DCONT              H0101 ?ASMB,R,L,C HED DCONT 91700-16112 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DCONT,7 91700-16112 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DCONT EXT FCONT EXT .ENTR SPC 5 * * DCONT * SOURCE:91700-18112 * BINARY:91700-16112 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 4 NOP DCONT NOP JSB .ENTR DEF PRAMS * LDA D3 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * * SZB,RSS WAS THE 6TH ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY JMP DCONT,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB FCONT DRTN NOP PRAM1 REP 4 NOP JMP RFASR,I SPC 5 CLEAR NOP CLB CLEAR OPTIONAL PARAMETER DEF STB PRAMS+3 STB PRAM1+3 * JMP CLEAR,I SPC 5 * CONSTANTS D3 DEC 3 ADDS DEF DRTN+1 #PRMS NOP END * AN ERROR EXISTS  )/ 91700-18113 1552 S 0122 DS1/B CCE MODULE: DCRET              H0101 6ASMB,R,L,C HED DCRET 91700-16113 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DCRET,7 91700-16113 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DCRET EXT CREAT EXT .ENTR SPC 5 * * DCRET * SOURCE:91700-18113 * BINARY:91700-16113 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 7 NOP DCRET NOP JSB .ENTR DEF PRAMS * LDA PRAMS+6 IS THE DESTINATION SPECIFIED SZA,RSS JMP MORE NO DEFAULT TO CENTRAL INA STEP TP DESTINATION WORD LDA A,I PICK IT UP SZA IS IT LOCAL JMP ERROR NO EXIT WITH ERROR * * MORE LDA D5 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * DLD PRAMS+4 MOVE 5TH & POSSIBLE 6TH DST PRAM1+4 * SZB,RSS WAS THE 6TH ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT LDA PRAMS+6 MOVE POSSIBLE 7TH * SZA,RSS THERE? JMP DONE NO FINISHED ISZ #PRMS YES BUMP COUNT & STORE AWAY STA PRAM1+6 DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY LDA PRAMS+1,I JMP DCRET,I FINISHED RETURN TO USER SPC 5 * CLEAR ARRAY & CALL CONSOLE OUTPUT ERROR JSB CLEAR LDA MD18 RETURN DESTINATION ERROR PARAMETER STA PRAMS+1,I TO USER JMP   DCRET,I & RETURN SPC 5 RFASR NOP JSB CREAT DRTN NOP PRAM1 REP 7 NOP JMP RFASR,I SPC 5 CLEAR NOP CLA CLEAR DEF TO OPTIONAL PARAM CLB DST PRAMS+5 DST PRAM1+5 JMP CLEAR,I SPC 5 * CONSTANTS A EQU 0 D5 DEC 5 ADDS DEF DRTN+1 MD18 DEC -18 #PRMS NOP END * AN ERROR EXISTS "  *1 91700-18114 1552 S 0122 DS1/B CCE MODULE: DLOCF              H0101 =ASMB,R,L,C HED DLOCF 91700-16114 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DLOCF,7 91700-16114 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DLOCF EXT LOCF EXT .ENTR SPC 5 * * DLOCF * SOURCE:91700-18114 * BINARY:91700-16114 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 9 NOP DLOCF NOP JSB .ENTR DEF PRAMS * LDA APRMS SET UP SOURCE ADDRESS STA PRMSA * LDA APRM1 SET UP DESTINATION ADDRESS STA APRM2 * LDA MD9 SET UP LOOP COUNTER STA CONTR * CLB CLEAR PARAMETER COUNTER * LOOP LDA PRMSA,I MOVE PARAMETERS TO 2NDARY SZA,RSS JMP OUT STA APRM2,I ARRAY COUNTING AS YOU GO INB ISZ PRMSA INCREMENT POINTERS ISZ APRM2 ISZ CONTR DONE YET? JMP LOOP NO-CONTINUE * * OUT ADB ADDS STB DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY JMP DLOCF,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB LOCF DRTN NOP PRAM1 REP 9 NOP JMP RFASR,I SPC 5 CLEAR NOP LDB APRMS SET UP CLEAR ADDRESS STB PRMSA * LDB PRM1 STB PR1 * LDB MD9 BUILD LOOP COUNTER STB CONTR * CLB LOOP1 STB PRMSA,I CLEAR A WORD STB PR1,I ISZ PRMSA INCREMENT POINTERS ISZ PR1 ISZ CONTR JMP LOOP1 * JMP CLEAR,I SPC 5 * CONSTANTS CONTR NOP APRMS DEF PRAMS PRMSA NOP ADDSo   DEF DRTN+1 MD9 DEC -9 APRM1 DEF PRAM1 APRM2 NOP PRM1 DEF PRAM1 PR1 NOP END * AN ERROR EXISTS )  +2 91700-18115 1552 S 0122 DS1/B CCE MODULE: DNAME              H0101 IASMB,R,L,C HED DNAME 91700-16115 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DNAME,7 91700-16115 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DNAME EXT NAMF EXT .ENTR SPC 5 * * DNAME * SOURCE:91700-18115 * BINARY:91700-16115 * SHANE DICKEY * AUGUST 29,1974 * PRAMS REP 6 NOP DNAME NOP JSB .ENTR DEF PRAMS * LDA PRAMS+5 IS THE DEST CODE SPECIFIED? SZA,RSS JMP MORE CONTINUE * INA STEP PAST CART. LABEL LDA A,I TO DESTINATION CODE SZA CENTRAL CALL? JMP ERROR NO ABORT USER MORE LDA D4 SET UP DEFAULT # OF PRAMS. STA #PRMS * * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 DST PRAM1+2 MOVE 2ND TWO * DLD PRAMS+4 MOVE POSSIBLE 5TH & 6TH DST PRAM1+4 * SZA,RSS WAS THE 5TH ONE THERE? JMP DONE NO-DONE * ISZ #PRMS YES INCREMENT COUNT * SZB,RSS THERE? JMP DONE NO FINISHED ISZ #PRMS YES BUMP COUNT & STORE AWAY DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY LDA PRAMS+1,I GET IERR JMP DNAME,I FINISHED RETURN TO USER SPC 5 * CLEAR ARRAY & CALL CONSOLE OUTPUT ERROR JSB CLEAR LDA MD18 PICK UP & RETURN STA PRAMS+1,I ERROR CODE JMP DNAME,I & RETURN TO USER SPC 5 RFASR NOP JSB NAMF DRTN NOP 0   PRAM1 REP 6 NOP JMP RFASR,I SPC 5 CLEAR NOP CLA CLEAR DEFS TO OPTIONAL PARAMS. CLB DST PRAMS+4 DST PRAM1+4 * JMP CLEAR,I SPC 5 * CONSTANTS A EQU 0 D4 DEC 4 ADDS DEF DRTN+1 #PRMS NOP MD18 DEC -18 END ]  ,3 91700-18116 1552 S 0122 DS1/B CCE MODULE: DOPEN              H0101 BASMB,R,L,C HED DOPEN 91700-16116 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DOPEN,7 91700-16116 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DOPEN EXT .ENTR EXT OPEN SPC 5 * * DOPEN * SOURCE:91700-18116 * BINARY:91700-16116 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 6 NOP DOPEN NOP JSB .ENTR DEF PRAMS * LDA PRAMS+5 IS THE DESTINATION SPECIFIED? SZA,RSS JMP MORE DEFAULT TO CENTRAL CALL * INA STEP PAST CART.LABEL LDA A,I PICK UP DESTINATION CODE SZA CENTRAL CALL? JMP ERROR NO-ABORT USER MORE LDA D3 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * * SZB,RSS WAS THE 4TH ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT DLD PRAMS+4 PICK UP POSSIBLE 5TH & 6TH DST PRAM1+4 * SZA,RSS THERE? JMP DONE NO FINISHED ISZ #PRMS YES BUMP COUNT & STORE AWAY * SZB,RSS 6TH PARAMETER THERE? JMP DONE NO ISZ #PRMS YES DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY LDA PRAMS+1,I GET IERR JMP DOPEN,I FINISHED RETURN TO USER SPC 5 * CLEAR ARRAY & CALL CONSOLE OUTPUT ERROR JSB CLEAR LDA MD18 PICK UP & RETURN ERR  OR CODE STA PRAMS+1,I TO USER JMP DOPEN,I THEN RETURN SPC 5 RFASR NOP JSB OPEN DRTN NOP PRAM1 REP 6 NOP JMP RFASR,I SPC 5 CLEAR NOP CLA CLEAR DEFS TO OPTIONAL CLB PARAMETERS DST PRAMS+3 DST PRAM1+3 STA PRAMS+5 STA PRAM1+5 * JMP CLEAR,I SPC 5 * CONSTANTS A EQU 0 D3 DEC 3 ADDS DEF DRTN+1 #PRMS NOP MD18 DEC -18 END * AN ERROR EXISTS <  -4 91700-18117 1552 S 0122 DS1/B CCE MODULE: DPOSN              H0101 QASMB,R,L,C HED DPOSN 91700-16117 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DPOSN,7 91700-16117 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DPOSN EXT POSNT EXT .ENTR SPC 5 * * DPOSN * SOURCE:91700-18117 * BINARY:91700-16117 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 4 NOP DPOSN NOP JSB .ENTR DEF PRAMS * LDA D3 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * SZB,RSS OPTIONAL PARAMETER PRESENT JMP DONE * ISZ #PRMS * DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY JMP DPOSN,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB POSNT DRTN NOP PRAM1 REP 4 NOP JMP RFASR,I SPC 5 CLEAR NOP CLB CLEAR DEF TO OPTIONAL PARAM STB PRAMS+3 STB PRAM1+3 * JMP CLEAR,I SPC 5 * CONSTANTS D3 DEC 3 ADDS DEF DRTN+1 #PRMS NOP END * AN ERROR EXISTS  .4 91700-18118 1552 S 0122 DS1/B CCE MODULE: DPURG              H0101 PASMB,R,L,C HED DPURG 91700-16118 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DPURG,7 91700-16118 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DPURG EXT PURGE EXT .ENTR SPC 5 * * DPURG * SOURCE:91700-18118 * BINARY:91700-16118 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 5 NOP DPURG NOP JSB .ENTR DEF PRAMS * LDA PRAMS+4 IS THE DESTINATION SPECIFIED? SZA,RSS JMP MORE NO DEFAULT TO CENTRAL CALL * INA STEP PAST CART.LABEL LDA A,I TO DESTINATION CODE SZA CENTRAL CALL JMP ERROR NO ABORT THE USER MORE LDA D3 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * * SZB,RSS WAS THE 4TH ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT LDA PRAMS+4 MOVE POSSIBLE 5TH * SZA,RSS THERE? JMP DONE NO FINISHED ISZ #PRMS YES BUMP COUNT & STORE AWAY STA PRAM1+4 DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JSB CLEAR CLEAR PARAMETER ARRAY LDA PRAMS+1,I GET IERR JMP DPURG,I FINISHED RETURN TO USER SPC 5 * CLEAR ARRAY & CALL CONSOLE OUTPUT ERROR JSB CLEAR LDA MD18 RETURN ERROR CODE STA PRAMS+1,I TO USER & JMP DPURG,I EXIT SPC 5 RFASR NOP JSB PURGE DRTN   NOP PRAM1 REP 5 NOP JMP RFASR,I SPC 5 CLEAR NOP CLA CLEAR OPTIONAL PARAMETER DEFS CLB DST PRAMS+3 DST PRAM1+3 * JMP CLEAR,I SPC 5 * CONSTANTS A EQU 0 D3 DEC 3 ADDS DEF DRTN+1 #PRMS NOP MD18 DEC -18 END * AN ERROR EXISTS g  /6 91700-18119 1552 S 0122 DS1/B CCE MODULE: DREAD              H0101 AASMB,R,L,C HED DREAD 91700-16119 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DREAD,7 91700-16119 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DREAD EXT READF EXT .ENTR SPC 5 * * DREAD * SOURCE:91700-18119 * BINARY:91700-16119 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 6 NOP DREAD NOP JSB .ENTR DEF PRAMS * * LDA D3 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * * SZB,RSS WAS THE 6TH ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT DLD PRAMS+4 MOVE POSSIBLE 3RD & 4TH DST PRAM1+4 * SZA,RSS 3RD PRESENT? JMP DONE NO * ISZ #PRMS YES-INCREMENT COUNT * SZB,RSS 4TH PRESENT? JMP DONE NO * ISZ #PRMS DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN REBUILT CALL * JSB RFASR JSB CLEAR CLEAR OPTIONAL PARAMETERS LDA PRAMS+1,I GET IERR JMP DREAD,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB READF DRTN NOP PRAM1 REP 6 NOP JMP RFASR,I SPC 5 CLEAR NOP CLA CLEAR DEFS TO OPTIONAL PARAMETERS CLB DST PRAMS+3 DST PRAM1+3 STA PRAMS+5 STA PRAM1+5 * JMP CLEAR,I SPC 5 * CONSTANTS D3 DEC 3 ADDS DEF DRTN+1 #PRMS NOP END * AN ERROR EXISTS a   07 91700-18120 1552 S 0122 DS1/B CCE MODULE: DSTAT              H0101 CASMB,R,L,C HED DSTAT 91700-16120 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DSTAT,7 91700-16120 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DSTAT EXT FSTAT EXT .ENTR SPC 5 * * DSTAT * SOURCE:91700-18120 * BINARY:91700-16120 * SHANE DICKEY * JULY 31,1974 * PRAMS NOP DSTAT NOP JSB .ENTR DEF PRAMS * LDA PRAMS MOVE DEFS FOR 1ST TWO STA PRAM1 * LDA D1 CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR JMP DSTAT,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB FSTAT DRTN NOP PRAM1 NOP JMP RFASR,I SPC 5 * CONSTANTS ADDS DEF DRTN+1 D1 DEC 1 END * AN ERROR EXISTS  17 91700-18121 1552 S 0122 DS1/B CCE MODULE: DWIND              H0101 TASMB,R,L,C HED DWIND 91700-16121 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DWIND,7 91700-16121 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DWIND EXT RWNDF EXT .ENTR SPC 5 * * DWIND * SOURCE:91700-18121 * BINARY:91700-16121 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 2 NOP DWIND NOP JSB .ENTR DEF PRAMS * LDA D1 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * * SZB,RSS WAS THE 2ND ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB CLEAR CLEAR PARAMETER ARRAY JSB RFASR JMP DWIND,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB RWNDF DRTN NOP PRAM1 REP 2 NOP JMP RFASR,I SPC 5 CLEAR NOP CLB CLEAR DEF TO OPTIONAL PARAM STB PRAMS+1 STB PRAM1+1 * JMP CLEAR,I SPC 5 * CONSTANTS D1 DEC 1 ADDS DEF DRTN+1 #PRMS NOP END * AN ERROR EXISTS 9 28 91700-18122 1552 S 0122 DS1/B CCE MODULE: DWRIT              H0101 OASMB,R,L,C HED DWRIT 91700-16122 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DWRIT,7 91700-16122 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DWRIT EXT WRITF EXT .ENTR SPC 5 * * DWRIT * SOURCE:91700-18122 * BINARY:91700-16122 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 5 NOP DWRIT NOP JSB .ENTR DEF PRAMS * * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * LDA PRAMS+4 MOVE 4TH & POSSIBLE 5TH STA PRAM1+4 * LDA D5 CALCULATE RETURN ADA ADDS STA DRTN & PUT IN CONSTRUCTED CALL * JSB RFASR CLB STB PRAMS+4 STB PRAM1+4 JMP DWRIT,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB WRITF DRTN NOP PRAM1 REP 5 NOP JMP RFASR,I SPC 5 * CONSTANTS D5 DEC 5 ADDS DEF DRTN+1 END [ 39 91700-18123 1607 S 0122 DS1/B CCE MODULE: POPEN              H0101 IASMB,R,L,C HED POPEN 91700-16123 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM POPEN,7 91700-16123 REV A 760212 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT POPEN,PREAD,PWRIT,PCONT EXT D65MS,D65CL EXT .ENTR * SPC 5 * * POPEN * SOURCE: 91700-18023 * BINARY: 91700-16023 * SHANE DICKEY * JULY 30,1974 * * MODIFIED BY CHUCK WHELAN NOV 1975 * SPC 5 IPCB NOP IERR NOP INAM NOP ILU NOP ITAG NOP SPC 5 POPEN NOP * * MASTER REQUESTS FOR POPEN COME HERE * JSB .ENTR PICK UP THE USER PARAMETERS DEF IPCB LDA POPEN SET UP ERROR RETURN STA RTRN * LDA IERR STA ERRAD LDA DITAG SET PARAM CLEAR LOC STA CLEAR * PARAMETER CHECK LDA ITAG CLB,INB JSB BPARM SET UP BASIC PARMB * DLD INAM,I IRBF5 EQU *+1 DST IRBUF+5 MOVE 1ST TWO WORDS OF NAME LDA INAM ADA D2 LDA 0,I STA IRBUF+7 STORE 3RD WORD OF NAME LDA ITAG SET UP RETURN TAG FIELD ADDRESS STA TAGAD LDB IPCB LDA ILU,I GET LU # ADB D3 SAVE LU IN 4TH WORD OF PCB STA B,I * LDA IPCB NODAT CCB FLAG FOR NO DATA * * THIS CODE IS USED IN COMMON BY ALL P TO P CALLS * MAIN STB RCXMT SAVE OP TYPE STA PCBAD SAVE PCB ADDRESS ADA D3 LDA 0,I GET LU IOR BIT15 SET "NO ABORT" BIT STA DREQ REQ. ONLY IOR B300 STA DDATA DATA ONLY * THE CALL TO D65MS WILL: * 1) GET AN I/O CLASS * 2) COMPLETE WORD i2 OF PARMB * 3) SEND REQUEST * 4) AWAIT REPLY * 5) RETURN REPLY * 6) RETURN CONTROL JSB D65MS ISSUE REQUEST CALL DEF *+8 DEF D2 DEF DREQ WITH SIGN BIT SET DEF IRBUF DEF IRBFL DEF DUMMY DEF DUMMY DEF DUMMY * JMP ERR+1 ERROR DETECTED LDB IRBUF+3 RETURN ERROR WORD STB ERRAD,I LDA IRBF5 STA TAGPR * LDA M3 LDB PCBAD SET UP COUNT & SOURCE JSB MOVE * RETURN THE TAG FIELD LDA IRBF8 STA TAGPR LDA M10 GET COUNT LDB TAGAD JSB MOVE * CLB STB CLEAR,I CLR PARAMETER SIZE CHECK LOC LDB IRBUF+3 SZB WAS ERROR DETECTED? JMP RTRN,I YES, IERR SET LDB IRBUF+2 SSB,RSS WAS REQUEST REJECTED? CLB,RSS NO, OK CLB,INB YES, SET REJECT IERR STB ERRAD,I RETURN IT TO CALLER LDA RCXMT OP CODE SSA,RSS SKIP IF NO DATA SZB SKIP IF NO ERROR JMP RTRN,I OTHERWISE RETURN NOW * * NOW CALL "D65CL" TO DO DATA TRANSFER TO COMPLETE TRANSACTION * JSB D65CL DEF *+7 DEF RCXMT DEF DDATA BUFF NOP DEF LEN DEF IRBUF+33 PASS TIME-TAGS TO DRIVER DEF IRBUF+34 JMP ERR+1 ERROR CLB SET GOOD RETURN JMP RTRN,I * SPC 5 BPARM NOP * SUBSTREAM,STREAM,FUNCTION CODE AND TAG FIELD INSERTED IN * PARMB HERE * THE CLASS IS NOW ALLOCATED AND KNOWN BUILD THE * PARMB FOR THE SATELLITE * ROUTINE ALSO CHECKS FOR SUFFICIENT PARAMETERS IN P TO P CALL STB IRBUF+2 SET FUNCTION CODE SZA,RSS JMP ERR2 TOO FEW PARAMETERS IN CALL STA TAGPR LDA D4 TO BE BUILT-& STORE THE STA IRBUF STREAM TYPE LDA M10 LDB IRBF8 JSB MOVE JMP BPARM,I RETURN SPC 5 ERR NOP DECODE ASCII B REGISTER LDA D4C7 SET INITIAL ERROR CODE CPB ASC01 SUSPEND ERROR? JMP ERR1 YES CPB ASC05 TIME OUT? JMP ERR1 YES INA INCREMENT CODE CPB ASC02 ABORT ERROR? JMP ERR1 YES INA INCREMENT CODE ERR1 CMA,INA,RSS NEGATE THE CODE ERR2 LDA M40 STA ERRAD,I RETURN IERR CLB CLEAR MAX SIZE CHECK STB CLEAR,I JMP RTRN,I & RETURN SKP * * READ REQUESTS * RIPCB NOP RIERR NOP RIBUF NOP RIL NOP RITAG NOP * RTRN EQU * PREAD NOP JSB .ENTR GET USER PARAMETERS DEF RIPCB * LDA RIERR STA ERRAD LDA DRITA GET CLEAR ADDRESS STA CLEAR LDA RITAG LAST REQ PARAM THERE? * LDB D2 SET FUNCTION CODE JSB BPARM * LDA RIPCB JSB MVPCB MOVE PCB TO PARMB * LDA RITAG STA TAGAD * LDA RIBUF SAVE BUFFER ADDRESS STA BUFF LDA RIL,I SAVE DATA LENGTH STA LEN STA IRBUF+18 IN PARMB TOO * LDA RIPCB PCB ADDRESS CLB,INB SET FOR DATA READ JMP MAIN NOW DO LINE COMM & RETURN SKP * * WRITE REQUESTS * PIPCB NOP PIERR NOP PIBUF NOP PIL NOP PITAG NOP * * PWRIT NOP PWRITE REQUESTS HERE JSB .ENTR PICK UP PARAMETERS DEF PIPCB * LDA PWRIT SET UP ERROR RETURN STA RTRN LDA PIERR STA ERRAD LDA DPITA SET CLEAR ADDRESS STA CLEAR LDA PITAG LDB D3 JSB BPARM BUILD BASIC PARMB * LDA PIPCB JSB MVPCB MOVE PCB TO PARMB * LDA PITAG STA TAGAD LDA PIBUF GET DATA ADDRESS STA BUFF LDA PIL,I GET DATA LENGTH STA LEN STA IRBUF+18 * LDA PIPCB LDB D2 SET FOR DATA WRITE JMP MAIN NOW DO LINE COMM & RETURN SKP * * CONTROL REQUEYSTS * CIPCB NOP CIERR NOP CITAG NOP * * PCONT NOP JSB .ENTR GET PARAMETERS DEF CIPCB * LDA PCONT SET UP ERROR RETURN STA RTRN LDA CIERR STA ERRAD LDA DCITA SET UP SIZE CHECK WORD STA CLEAR LDA CITAG LAST REQUIRED LDB D4 SET UP FUNCTION CODE JSB BPARM BUILD BASIC PARMB * LDA CIPCB JSB MVPCB MOVE PCB TO PARMB * LDA CITAG STA TAGAD * LDA CIPCB PCB ADDRESS JMP NODAT DO LINE COMM & RETURN SKP * * MOVE SUBROUTINES * MOVE NOP * A CONTAINS -# OF WORDS TO MOVE * B CONTAINS DESTINATION ADDRESS * TAGPR CONTAINS SOURCE ADDRESS STA CONTR MOVE1 LDA TAGPR,I PICK UP NEXT WORD STA B,I AND PUT IT AWAY INB ISZ TAGPR INCREMENT POINTERS ISZ CONTR JMP MOVE1 TILL DONE JMP MOVE,I * * MOVE PCB INTO PARMB * MVPCB NOP STA TAGPR POINTER TO PCB LDA M3 MOVE 3 WORDS LDB IRBF5 INTO PARMB +5,6,7 JSB MOVE DO IT JMP MVPCB,I SKP * * DATA AREA * IRBUF BSS 35 IRBF8 DEF IRBUF+8 B EQU 1 IRBFL DEC 35 D2 DEC 2 D3 DEC 3 D4 DEC 4 B300 OCT 300 TAGPR NOP M10 DEC -10 M3 DEC -3 CONTR NOP DREQ NOP DDATA NOP PCBAD NOP ERRAD NOP TAGAD NOP RCXMT NOP LEN NOP ASC01 ASC 1,01 SUSPEND ERROR CODE ASC02 ASC 1,02 ABORT ERROR CODE ASC05 ASC 1,05 TIME OUT BIT15 OCT 100000 DCITA DEF CITAG CLEAR NOP M40 DEC -40 DPITA DEF PITAG DRITA DEF RITAG D47 DEC 47 DITAG DEF ITAG DUMMY NOP END  4= 91700-18124 1607 S 0122 DS1/B CCE MODULE: PTOPM              H0101 YASMB,R,L,C HED PTOPM 91700-16124 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM PTOPM,2,30 91700-16124 REV A 760209 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT PTOPM EXT EXEC EXT RNRQ EXT D65CL IFZ EXT DBUG XIF SPC 5 * * PTOPM * SOURCE:91700-18124 * BINARY:91700-16124 * SHANE DICKEY * JULY 30,1974 * * MODIFIED NOV 1975 BY CHUCK WHELAN * * * Z OPTION INCLUDES DEBUG PACKAGE PTOPM NOP * * START LDA B,I IS P1=I/O CLASS IFZ SZA,RSS IF ZERO-INITIALIZE CALL-SET UP JMP *+3 AND TERMINATE- IF REAL LSTEN XIF STA ICLAS SCHEDULE--SET UP GET AND DO IT IFZ JMP GET * JSB DBUG SET UP DBUG DEF *+1 * JSB EXEC SAVE RESOURCES AND TERMINATE DEF *+4 DEF D6 DEF ZERO DEF D1 * JMP START LSTEN CALL STARTS HERE XIF * * ISSUE GET ON I/O CLASS * GET JSB DOGET SUSPEND IN CLASS GET UNTIL REQ. RCVD ICLAS DEC 4 NOP LDA IRBUF+2 SET PARMB REPLY FLAG FOR LATER RETURN IOR MSK5 STA IRBUF+2 * * IS THIS A NEW REQUEST OR AN ACCEPT/REJECT * ON A PREVIOUS ONE? AND B1400 SAVE ONLY THE FLAG FIELD SZA NEW REQUEST? JMP ACREJ NO, POFF/FINISH LDA IRBUF+2 YES AND D7 ADA CODEA ADD ADDRESS OF PROCESS TABLES JMP A,I AND GO DO IT * ALL INCOMING NEW PROG/PROG OPEN REQUESTS * REQUESTS ARE PROCESSED HERE * OPEN REQUESTS CONSIST OF THREE BASIC STEPS TO PROCESS * THESE ARE : *  1) FIND CURRENT LIST SLOT FOR ENTRY(NEW SLOT OR EXISTING ONE) * THEN SET UP C.L. SLOT * 2)UPDATE THE PARMB TO REFLECT THE C.L. SLOT USED * 3) SCHEDULE PROGRAM TO RECEIVE REQUEST * OPEN REQUESTS ARE OF TWO TYPES:PREVIOUSLY EXISTING * AND NEW REQUESTS. THE FIRST OF THESE IS PROCESSED * BEGINNING AT THE LABEL "FOUND" AND THE OTHERS ARE * PROCESSED STARTING WITH THE CODE LOCATED AT * NOTFD (NOT FOUND) * FIRST THE CURRENT LIST MUST BE SEARCHED TO SEE IF * THE REQUESTING PROGRAM NETWORD HAS BEEN EXTABLISHED * (OR FOUND) OPENP JSB SERCL IS THIS AN EXISTING HOOKUP JMP NOTFD NO-NOT FOUND-SET UP NEW ONE * * SET UP THE"FORM B"OF THE PARMB AND PASS IT ON TO THE USER JSB BPARM REPLACE NAME WITH I.D. WORDS * NOTE THAT THE SYSTEM WILL ONLY SCHEDULE A CENTRAL USER * ONCE I.E. WHEN THE 1ST SATELLITE OPEN IS RECEIVED * IF THE CENTRAL USER TERMINATES WITHOUT * ISSUING A FINIS CALL * SYSTEM BUFFER SPACE WILL EVENTUALLY BE FILLED * BY INCOMING SATELLITE MASTER REQUESTS * JMP GET * * * NEW PTOP USERS SET UP HERE * * * * GET SLOT IN CURRENT LIST NOTFD CLA,INA STA PRID# INITIALIZE PROGRAM ID# TO 1 * SEARCH FOR EMPTY ENTRY IN CURRENT LIST LDA CRLSA STARTING TABLE ADDR GET1 LDB 0,I CPB M1 JMP ERMT ERROR IF TABLE FULL SZB,RSS JMP *+4 IF 1ST IS ZERO, THIS ENTRY IS FREE ADA D4 POINT TO NEXT ISZ PRID# INCREMENT PROGRAM ID # JMP GET1 TRY NEXT STA ADDR3 SAVE ADDRESS OF THIS ENTRY ADA D2 LDB NNAME+2 STB A,I INA STA CLSAD ADDR OF CLASS # IN TABLE DLD NNAME ADDR3 EQU *+1 DST * MOVE 1ST 2 WORDS OF NAME LDA B13 GET "NEW CLASS" CLASS WORD STA CLSAD,I TO SET UP CALL * JSB EXEC GET THE I O CLASS NUMBER DEF *+8 BY GETTING AN I-O CLASS DEF D20 DEF ZERO DEF IRBUF DEF D1 DEF D1 DEF =D1 CLSAD NOP SZA HOW WAS THE ALLOCATION ? JMP ERMS BAD, ERROR EXIT * CLEAR REQUEST LDA CLSAD,I STA *+2 JSB DOGET THE PREVIOUS WRITE READ LEFT NOP A DUMMY REQUEST IN THE CLASS, CLR IT. NOP IGNORE ABORT CONDITION JSB BPARM * * SCHEDULE THE PROGRAM JSB EXEC DEF *+4 SCHEDULE REQUESTED PROGRAM DEF D10SB WITHOUT WAIT & PASS IT DEF ADDR3,I IT'S I/O CLASS AS PARAMETER DEF CLSAD,I P1 * * THE PROGRAM MUST BE IN THE DORMANT LIST OR * AN ERROR EXISTS JMP REMER ERROR RETURN-RTE TRIED TO ABORT US SZA,RSS IN DORMANT LIST? JMP GET YES CLA,RSS REMER CLA,INA FLG ERROR STA TEMP INITIALIZE ERROR FLAG * REMOVE CLASS REQUEST WITH A GET CLA CLEAR THE ENTRY IN STA ADDR3,I THE CURRENT LIST LDA CLSAD,I TAKE OFF "DONT DEALLOCATE" BIT AND MSK8 STA UCLA2 * JSB DOGET CLEAR THE UNUSED REQUEST FROM THE UCLA2 NOP I/O CLASS ESTABLISHED * ISZ TEMP WOULD HAVE ABORTED LDB M43 LDA TEMP ABORT ERROR? SZA ADB D2 YES, ERROR -41 JMP ERR PROCESS THE ERROR * * PLIST JSB EXEC WRITE DIRECTORY TO DISC IN LOCN PASSED DEF *+7 DEF D2 DEF IRBUF+1 DISC LU DEF CRLST DIRECTORY ADDRESS DEF D81 DIRECTORY LENGTH DEF IRBUF TRACK ADDRESS DEF IRBUF+3 SECTOR ADDRESS * JSB RNRQ NOW START UP REMAT BY CLEARING RN # DEF *+4 DEF D4 DEF IRBUF+4 DEF IRBUF+5 JMP GET HED ACEPT/REJCT PROC. * (C) HEWLETT-PACKARD CO. 1976 * * HANDLE SLAVE OFF AND FINISH REQUESTS HERE * ACREJ LDA IRBUF+2 AND MSK4 MASK OUT THE REST OF THE PARMB CPA D10 JMP POFF HANDLE SLAVE OFF CPA D9 RSS JMP ER103 UNRECOGNIZED * FI!NIT JSB SERCL IS PROGRAM IN CURRENT LIST? JMP GET NO, NOT DEFINED JSB FINIS CLEAN OUT ENTRY IN CURRENT LIST JMP GET * * CLEAR ENTRY OUT OF CURRENT LIST, AND ABORT PROGRAM IF IT'S HANGING * ON THE CLASS SO THE CLASS NUMBER CAN BE DEALLOCATED. * FINIS NOP STB ADDR3 SAVE ADDR OF NAME * * NOW CLEAR ALL REQUESTS FROM THE I/O CLASS * (ONE AT A TIME) AND CAUSE IT TO BE RELEASED * LDA CLSAD,I GET CLASS NUMBER IOR B1315 SET BIT 13 & 15 IN CLASS WORD STA TEMP THEN SAVE FOR CALL STA CLFLG SET CLASS CLEAR FLAG NON-ZERO * NXGET JSB DOGET GET REQUEST TEMP NOP JMP ABTIT FIRST, PGM MUST BE TERMINATED * CLB CPB CLFLG RELEASE PROCESSING COMPLETE? JMP FIEND YES INA,SZA ALL PENDING REQUESTS CLEARED? JMP NXGET NO, CLEAR MORE STA CLFLG SET FOR ONE MORE LDA TEMP AND MSK8 CLEAR NO DE-ALLOCATE FLAG STA TEMP JMP NXGET * * ABORT USER PROGRAM ABTIT JSB EXEC TERMINATE PROGRAM DEF *+3 DEF D6N DEF ADDR3,I CLB,RSS GET OUT IF WOULD HAVE ABORTED JMP NXGET NOW RELEASE CLASS # * FIEND STB ADDR3,I CLEAR ENTRY IN PTOPM'S LIST JMP FINIS,I & EXIT SPC 5 POFF LDA NNAME PICK UP ENTRY TO BE CLEARED SZA CLEAR ENTIRE TABLE? JMP FINIT NO, CLEAR INDICATED ENTRY LDB CRLS3 POINTER TO CLASS #S LOOP STB CLSAD ADB M3 POINT TO NAME LDA 1,I GET 1ST WORD OF ENTRY CPA M1 END OF TABLE? JMP GET YES SZA SKIP IF THIS SLOT IS EMPTY JSB FINIS OTHERWISE CLEAR & TERMINATE IT LDB CLSAD ADB D4 POINT TO NEXT CLASS # JMP LOOP AND RETURN FOR MORE * * PROCESS ERRORS AND ABNORMAL CONDITIONS HERE * THE B REGISTER CONTAINS THE DETECTED ERROR CODE * RECOGNIZED ERROR CONDITIONS * -42 CURRENT LIST FULL-NO ROOM-RETRY * -43 PROGRAM NOT IN DORMANT LIST * -103 ID#'S IN PARMB OFF OR F.CDE PR PROG ID#,OR SAT#,OR CLASS# * FROM VALCK IN ERROR * FORMAT RETURN PARMB * PUT ERROR CODE IN THE PARMB * * * ERMS CLA STA ADDR3,I CLEAR ENTRY IN CURRENT LIST * ERMT LDB M42 RSS * ER103 LDB M103 ILLEGAL PCB ERR STB IRBUF+3 STORE ERROR WORD * HERE WE CLEAR THE DRIVER TO GET RID OF DATA LDA IRBUF+24 AND MSK9 STA TEMP * JSB D65CL SEND STOP DEF *+7 DEF IRC CONTROL REQUEST DEF TEMP CONWORD (=LU) DEF DUMMY DEF DUMMY DEF DUMMY DEF DUMMY * JSB ERR1 ERROR RETURN * LDA IRBUF+24 AND MSK9 STA IRBUF+24 CLEAR ALL BUT LU * LDA IRBUF IOR BTRPY SET REPLY & FRIENDLY BITS STA IRBUF INTO STREAM WORD * JSB D65CL SEND THE REPLY DEF *+7 DEF IRWW DEF IRBUF+24 REQ ONLY DEF IRBUF DEF IRBFL DEF DUMMY DEF DUMMY * JSB ERR1 ERROR RETURN JMP GET * NOTE: IF PARMB WORD #4 IS RETURNED NON-ZERO * (ERROR CONDITION) THE FLAG FIELD (WORD 2), TAG FIELD, * AND PROGRAM NAME FIELD WILL NOT BE RELIABLE SPC 5 ERR1 NOP DST SAVAB SAVE ERROR CODE FROM A AND B REG. JSB EXEC OUTPUT ERROR MESSAGE DEF *+5 DEF D2 DEF D1 DEF MESS DEF MESSL * JMP ERR1,I RETURN SPC 5 * THIS SUBROUTINE SET'S UP THE PARMB IN A MODIFIED * B FORMAT SO THAT IT'S ENTRY CAN BE FOUND WHEN IT * COMES BACK ACCEPTED OR REJECTED FROM THE USER SUBROUTINE * MODIFY PARMB TO REFLECT C.L. INFORMATION BPARM NOP LDB PRID# PICK UP ID# PREVIOUSLY BUILT STB IRBUF+5 AND SAVE IT IN PARMB LDB CLSAD,I PICK UP USER I/O CLASS STB IRBUF+6 & PUT IN PARMB JSB BLATZ SEND PARMB JMP BPARM,I SPC 5 * VERIFY THAT A READ, WRITE, OR CLOSE REQUEST * IS BEING ISSUED ON A VALID TERMINAL PREVIOUSLY * OPENED AND KNOWN TO THE MONITOR AND IF OK PASS IT TO THE PGM READP LDA IRBUF+5 PICK UP PROG IO # AND MSK3 MASK ALL BUT LOW ORDER 3 BYTE SZA IS I.D. ZERO? ADA M21 GREATER THAN 20? SSA,RSS JMP ER103 ERROR IF YES * THE PROGRAM ID IS IN THE RIGHT RANGE-NO FURTHER CHECKING CAN BE * DONE ON IT * NOW CHECK THE REQUESTED I/O CLASS-IT MUST MATCH ADA D20 THE CURRENT LIST INDEX ALS,ALS CONVERT TO CURRENT LIST ADDRESS ADA CRLSA AND SAVE IN STA ADDR3 * ADA D3 NOW STEP TO THE CLASS WORD STA CLSAD SAVE ADDR OF CLASS # LDA 0,I GET CLASS # LDB M44 PICK UP ERROR CODE CPA NNAME+1 DO THEY MATCH ? CLA,RSS JMP ERR NO- AN ERROR EXISTS * THE PROG ID # AND I/O CLASS APPEAR ALL RIGHT CPA ADDR3,I HAS ENTRY BEEN DELETED? JMP ERR YES REJECT REQUEST JSB BLATZ SEND PARMB JMP GET SPC 5 BLATZ NOP JSB EXEC DO A WRITE READ TO DEF *+8 PASS REQUEST ON DEF D20 TO THE USER FOR HIS DEF ZERO NEXT GET DEF IRBUF DEF IRBFL DEF DUMMY DEF DUMMY DEF CLSAD,I JMP BLATZ,I SPC 5 * * DO A CLASS I/O GET * DOGET NOP JSB EXEC DEF *+5 DEF D21N DEF DOGET,I CLASS # DEF IRBUF DEF IRBFL RSS SKIP IF WE COULD HAVE ABORTED ISZ DOGET ELSE RETURN TO P+2 ISZ DOGET JMP DOGET,I RETURN * * THIS SUBROUTINE SEARCHES THE CURRENT LIST * ON RETURN * B REGISTER POINTS TO THE START OF THE MATCHING * CURRENT LIST ENTRY * (NORMAL RETURN ONLY) * NORMAL RETURN (P+2) * ERROR RETURN (P+1) * * * THE CURRENT LIST WILL NOW BE SEARCHED FOR * A MATCH UNTIL A -1 IS ENCOUNTERED (END OF TABLE) * * SERCL NOP CLB STB PRID# INITIALIZE PROGRAM ID# LDB CRLSA LOOP1 ISZ PRID# LDA B,I CPA M1 JMP SERCL,I NOT FOUND * THIS IS A VALID ENTRY SO CHECK NAME & THEN LU CPA NNAME INB,RSS JMP LOOP7+1 LDA 1,I CPA NNAME+1 INB,RSS JMP LOOP7 LDA 1,I CPA NNAME+2 JMP DUN FOUND ONE ADB M1 LOOP7 ADB M1 ADB D4 JMP LOOP1 * DUN INB STB CLSAD SAVE ADDR OF CLASS # ADB M3 B POINTS TO ENTRY IN CURRENT LIST ISZ SERCL JMP SERCL,I HED CONSTANTS AND VARIABLES * (C) HEWLETT-PACKARD CO. 1976 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D6 DEC 6 D7 DEC 7 D9 DEC 9 D10 DEC 10 D20 DEC 20 B1400 OCT 140000 CRLSA DEF CRLST ADDR OF CURRENT LIST TABLE CRLS3 DEF CRLST+3 ADDR OF CLASS # IN 1ST ENTRY CODEA DEF CODES,I CODES DEF ER103 DEF OPENP DEF READP DEF READP DEF READP DEF PLIST DEF FINIT DEF ER103 IRBFL DEC 35 REQUEST BUFFER LENGTH B13 OCT 020000 BTRPY OCT 044000 B1315 OCT 120000 MSK4 OCT 17 D81 DEC 81 M1 DEC -1 M3 DEC -3 M21 DEC -21 MESSL DEC -30 M42 DEC -42 M43 DEC -43 M44 DEC -44 M103 DEC -103 MSK3 OCT 377 MSK5 OCT 200 MSK8 OCT 157777 MSK9 OCT 77 CLFLG NOP DUMMY OCT 0 D6N OCT 100006 D21N OCT 100025 OP CODE FOR CLASS I/O GET (NO ABORT) IRC OCT 100003 STOP CODE IRWW OCT 100002 WRITE CODE D10SB OCT 100012 PRID# NOP * IRBUF REP 5 OCT 0 NNAME REP 3 OCT 0 REP 27 OCT 0 A EQU 0 B EQU 1 ZERO OCT 0 MESS ASC 12,COMM ERROR OUTPUT-PTOPM ASC 1, SAVAB OCT 0,0 * * 20 ENTRIES OF 4 WORDS EACH IN THE CURRENT LIST * * EACH ENTRY CONTAINS: * WORDS 1-3 = PROGRAM NAME * WORD 4 = ASSIGNED I/O CLASS * CRLST BSS 80 INITIALLY ALL ZEROES UNL CRLST REP 80 NOP LST DEC -1R0.* DELIMITER, DON'T REMOVE END PTOPM 0 5 B 91700-18125 1607 S 0222 DS1/B CCE MODULE: RFAEX              H0102 AASMB,R,L,C HED RFAEX 91700-16125 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM RFAEX,18,30 91700-16125 REV A 760212 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT EXEC IFZ EXT DBUG XIF A EQU 0 B EQU 1 * EXTERNALS FOR REMOTE FILE ACCESS-LEVEL 1 EXT NAMF,FCONT,LOCF,APOSN EXT CREAT,PURGE,OPEN,WRITF EXT READF,POSNT,RWNDF,CLOSE EXT FSTAT EXT D65SV EXT D65CL,#RXCL * SPC 5 * * RFAEX * SOURCE:91700-18125 * BINARY:91700-16125 * SHANE DICKEY * JULY 30,1974 * * DATE MODIFIED : JANUARY 1976 * * MODIFIED BY JEAN-PIERRE BAUDOUIN * * * Z OPTION INCLUDES DBUG PACKAGE SPC 5 RFAEX NOP * * GET THE I/O CLASS FOR THIS MONITOR SAET UP BY LSTEN * START LDA B,I IS P1 = I/O CLASS? IFZ CPA D99 IF 99 GO INTO DBUG JMP *+3 AND TERMINATE-IF REAL CALL- JMP GET * JSB DBUG SET UP DBUG DEF *+1 * JSB EXEC SAVE RESOURCES AND TERMINATE DEF *+4 DEF D6 DEF ZERO DEF D1 * JMP START LSTEN CALL STARTS HERE XIF * * ISSUE GET ON I/O CLASS * GET JSB EXEC THIS GET WILL SUSPEND DEF *+5 RFAEX UNTIL RFAM WRITES DEF D21 IN ITS CLASS DEF #RXCL THE REQUEST PARMB WILL BE DEF IRBUF IN THE IRBUF BUFFER AREA DEF IRBFL * * * PARMB+24=LU * * MOVE FILE NAME TO FSNAM FROM PARMB * * LDB PARMB ADB D6 * JSB PIKUP GET 1ST TWO CHARS STA FSNAM * JSB PIKUP THEN NEXT TWO  STA FSNAM+1 * JSB PIKUP STA FSNAM+2 * LDA PARMB ADA D22 * LDB A,I GET CURRENT DCB ADDRESS RSS RESOLVE THE INDIRECT LDB B,I RBL,CLE,SLB,ERB JMP *-2 STB CDCBA * INA INA THEN GET LU # LDB A,I STB FSTLU * * THE ORIGINAL CALL IS RECONSTRUCTED * THE PREPROCESS FLAG IS CHECKED TO DETERMINE * IF THERE IS ANY PREPROCESSING TO BE DONE * AN EXAMPLE OF THIS WOULD BE THE GATHERING OF * A DATA BUFFER BEFORE EXECUTION OF A FILE WRITE * ALSO ERROR CHECKING CAN BE DONE IN PREPROCESS S/R * FOLLOWING THE PREPROCESS THE RECONSTITUTED CALL * IS EXECUTED AND STATUS IS RETURNED TO RFAEX BY FMP * IT IS THE RETURN OF THIS STATUS INFORMA- * TION THAT COMPRISES THE MAJOR PART OF POST- * PROCESSING, OF COURSE OTHER TYPES OF POSTPROCESSES * CAN BE ACCOMPLISHED. AN EXAMPLE IS THE WRITING OF * AN ACQUIRED DATA BUFFER TO THE TERMINAL FOLLOWING * A DATA READ * * * ISOLATE THE FUNCTION CODE LDA PARMB ADA D2 LDA A,I AND MSK0 MASK OUT UPPER BYTE ADA BASE STA FCODE * * * * CLEAR THE JSB BUFFER TO ZEROS AT THE START * LDB DM20 SET UP A COUNTER TO STB CONTR CLEAR 20 WORDS OF THE JSB BUFFER LDA JSBFA TO 0-THEN SET UP START ADDRESS STA AJSBF TO CLEAR CLA LOOP7 STA AJSBF,I CLEAR A WORD * * INCREMENT COUNTERS * * ISZ AJSBF ISZ CONTR JMP LOOP7 IF NOT DONE DO NEXT ONE * * PICK UP THE LU# FROM THE FST AND PUT IT IN FSTLU * * * RECONSTRUCT THE CALL * LDA PARMB BUILD A POINTER TO THE ADA D6 1ST USER PARAMETER IN STA BLOKA PARMB & STORE IT IN BLOKA LDA PRMSA BUILD A POINTER TO THE ASSEMBLY STA APRMS AREA & SAVE IT-ACTUAL PARAMETERS' LDA JSBFA BUILD A POINTER TO THE JSB STA AJSBF ASSEMBLY AREA LDA FCODE GET FCODE TO CHECK IF -IT IS IN THE ADA M1 THE GOOD RANGE. SSA JMP CODER FCODE < 150, ERROR ADA M13 SSA,RSS JMP CODER FCODE > 162, ERROR * LDA FCODE USE CODE AS INDEX IN THE FMGR ADA JSBTA ROUTINES TABLE ADA M1 LDA A,I PICK UP THE ADDRESS OF THE STA AJSBF,I S/R THAT WILL SERVICE ISZ AJSBF THIS REQUEST AND PUT IT ISZ AJSBF IN THE JSB TABLE SPC 2 * AFTER PUTTING IN THE JSB STEP PAST DEF RETURN *(THIS WILL BE COMPUTED AND FILLED IN LATER) * INITIALIZE PARAMETER COUNTER TO DO SAME * * CLA THIS WILL BE INCREMENTED STA PRCNT SPC 2 * BEFORE THE BUFFER IS BUILT FROM PARMB IT MAY * NEED A "MASSAGE" THIS WILL PICK UP ODD-BALL * PARAMETERS LIKE DCB WORK AREA POINTERS THAT * ARE NOT IN THE PARMB REQUEST-THE FOLLOWING * CODE ISOLATES THE ADDRESS OF THIS "MASSAGE" S/R * AND TRANSFERS TO IT. * * LDA PREPA ADA FCODE * * EXECUTE PREPROCESSING S/R * LDB D6 SET UP ERROR REGISTER LDA A,I JSB A,I * * * * PICK UP THE LOCATION OF THE NEXT CONTROL BYTE * JSB PRE7 COMPUTE "DEF RTRN" AS LAST STEP * * THE CALLING SEQUENCE IS COMPLETE-EXECUTE IT!!! * SET THE NO DATA TO BE RETURNED FLAG-NOMINAL CASE * * CLA STA DATA2 SPC 3 * EXECUTE THE CALL * * JSB JSBUF-1 STA SAVEA SAVE A AND B REGISTERS TO PASS THEM BACK TO STB SAVEB THE USER IN WORDS +2 AND +3 OF THE REPLY PARMB. SPC 2 * AFTER THE REQUEST IS EXECUTED THE POST PROCESSING * S/R WILL BE EXECUTED IN A MANNER ANALOGOUS TO THAT * SHOWN ABOVE FOR PREPROCESSING * * SET UP & CALL S/R THAT CONTROLS POSTPROCESSING * * LDA PSTPA ADA FCODE INDEX IN THE POST PROCESSING TABLE LDA A,I GET THE PROPER ADDRESS JSB A,I GO EXECUTE THE ROUTINE * * RETURN IERR TO RFAM THROUGH CDCB FOR POSTPROCESSING * OF ALL REQUESTS EXCEPT FSTAT (NO DCB IN CDCB) * LDA FCODE GET REQUEST TYPE CPA D13 IS IT A FSTAT CALL? JMP PAST YES SKIP IT LDA FERR GET IERR AS RETURNED LDB CDCBA GET CDCB ADDRESS ADB D145 STEP TO IERR WORD STA B,I AND STORE SPC 2 * IF THE DATA FLAG IS SET THE DATA MUST BE * RETURNED BEFORE THE STATUS REPLY CAN BE SENT BACK * IS THIS A REQUEST FROM A MOD BBL TERMINAL? * IF SO NO REPLY CAN BE RETURNED * * PAST LDA DATA2 SZA * * DETERMINE WHICH TYPE OF REPLY IS TO BE RETURNED * JMP *+3 JSB SDREQ JMP QUITS JSB SDATA SEND THE DATA BACK JSB SDREQ SEND THE PREV FORMATTED REQUEST * * * TERMINATE. THIS WILL REACTIVATE RFAM WHICH IS WAITING * ON A SCHEDULE (RFAEX) WITH WAIT. * * QUITS JSB EXEC DEF *+2 DEF D6 HED RFAEX: PREPROC. * (C) HEWLETT-PACKARD CO. 1976 SPC 5 PRE1 NOP * THIS S/R INSERTS DCB & IERR INTO CALL * LDA CDCBA PICK UP THE DCB ADDRESS INA STEP PAST FLAG WORD STA AJSBF,I ISZ AJSBF STORE IT & INCREMENT POINTER LDA FERRA PICK UP THE ERROR POINTER STA AJSBF,I & STORE IT * ISZ AJSBF * ISZ PRCNT INCREMENT THE PRAMETER COUNT ISZ PRCNT * LDA BLOKA PICK UP THE CONTROL BYTE ADDRESS IOR MSK5 ADD JUSTIFICATION FLAG STA PRAM1 JMP PRE1,I SPC 5 PRE2 NOP * INSERT DATA BUFFER RECORD ADDRESS LDA DABFA PICK UP DATA BUFFER ADDRESS STA AJSBF,I AND INSERT IT IN THE NEXT JSB ISZ AJSBF BUFFER SLOT-INCREMENT JSB BUFR ISZ PRCNT POINTER & PARAMETER COUNT * NOTE PRAM1 HASN'T BEEN SET UP JMP PRE2,I SPC 5 PRE3 NOP * USED FOR CREATE,PURGE,OPEN,RENAME JSB PRE1 INSERT DCB & IERR JSB STAND ADD STANDARD PARAMETERS JMP PRE3,I SPC 5 PRE4 NOP * MOVE PARMB POINTER PAST FIp LE NAME LDA BLOKA ADA D3 STA BLOKA * GETCB SETUP STA PRAM1 JMP PRE4,I SPC 5 * PRE5 NOP * USED FOR POSITION RECORD,CLOSE FILE,FILE CONTROL * LOCATE RECORD,ABS. PON RECORD JSB PRE1 INSERT DCB,IERR JSB PRE4 MOVE POINTER PAST FILE NAME * IS THIS CALL FOR RLOCF? IF NOT NEED ONLY * SET UP STANDARD PARAMETERS AND EXIT LDA FCODE PICK UP THE REQUEST FUNCTION CPA D11 CODE AND COMPARE TO 11 (RLOCF) RSS JMP PRE5A * SET UP THE STORAGE FOR THE 7 RETURNED RLOCF * PARAMETERS AND EXIT * LDA DM7 STA CONTR * LDA LOBSA LOOPL STA AJSBF,I INA ISZ AJSBF ISZ PRCNT ISZ CONTR JMP LOOPL JMP PRE5,I & RETURN * SET UP TO STRIP THE STANDARD PARAMETERS PRE5A JSB STAND JMP PRE5,I SPC 5 * PRE6 NOP * WRITE PREPROCESS S/R JSB PRE1 INSERT DCB & ERROR ADDRESS JSB PRE2 INSERT DATA RECORD ADDRESS JSB PRE4 MOVE PAST NAME JSB STAND GET STANDARD PARAMS JSB PRE8 READ DATA RECORD JMP PRE6,I & RETURN SPC 5 * PRE7 NOP * THIS IS THE LAST PREPROCESSING S/R CALLED * BY EACH REQUEST * IT COMPUTES "DEF RTRN" LDA JSBFA PICK UP THE ADDRESS OF THE ADA PRCNT JSB BUFFER & ADD THE # OF PARMS ADA D2 ALREADY INSERTED THEN ADD 1 FOR LDB JSBFA THE DEF RTRN & 1 FOR1ST FREE INB WORD THE FIND SLOT FOR DEF RTRN STA B,I AND INSERT IT FINALLY JMP PRE7,I RETURN SPC 5 PRE8 NOP * CHECK THE RECORD SIZE JSB SIZE * IT IS OK SO SET UP TO READ THE DATA * SET UP EXACT WORD LENGTH LDA PARMB ADA D5 LDA A,I STA IDBFL * * BUILD MODE LDA FSTLU GET THE COMM. LU AND MSK2 KEEP ONLY THE LU IOR MSK3 INSERT DATA ONLY CODE STA IMODE SAVE FOR D65CL CALL * PICK UP THE DATA * * JSkfB D65CL DEF *+7 DEF IRWR READ REQUEST DEF IMODE DEF DABUF DATA BUFFER DEF IDBFL BUFFER LENGTH DEF IRBUF+33 PASS TIME-TAGS TO DRIVER DEF IRBUF+34 * JMP ABERR ERROR RETURN * JMP PRE8,I NO,RETURN SPC 5 SPC 5 PRE10 NOP JSB PRE1 GET DCB & ERROR LOC JSB PRE2 GET DATA RECORD ADDRESS JSB PRE4 MOVE POINTER PAST NAME JSB STAND GET STANDARD PARAMETERS JSB SIZE * IF IT PASSES MUSTER THEN THE REQUEST IS COMPLETE * AND LOOKS OK SO EXIT BACK TO TO EXECUTE THE REQUEST JMP PRE10,I SPC 5 PRE11 NOP * USED FOR STATUS JSB PRE2 LDA D124 STA IDBFL JMP PRE11,I HED RFAEX: POST PROC. * (C) HEWLETT-PACKARD CO. 1976 PST1 NOP * NOTE THAT THE RETURN IS BUILT IN THE ORIGINAL * REQUEST BUFFER BEHIND DATA TYPE & SUBSTREAM * USED BY ALL REMOTE FMP & EXEC CALLS * NOTE THAT THERE ARE NO CONTROL BYTES * IN THE RETURNED BUFFER LDA PARMB PICK UP THE ADDRESS TO RETURN ADA D2 THE VALUES TO STA BLOKA * LDA SAVEA PICK UP SAVED A REG CONTENTS STA BLOKA,I ISZ BLOKA LDA SAVEB PICK UP SAVED B REG CONTENTS STA BLOKA,I ISZ BLOKA * ADJUST THE RETURNED PARAMETER COUNT LDA D4 STA RPCNT JMP PST1,I SPC 5 PST2 NOP * SET THE DATA COUNT * GET THE TRANSMISSION LOG LDA JSBFA ADA D6 LDA A,I LDA A,I STA BLOKA,I ISZ BLOKA ISZ RPCNT * * SET THE DATA TOO FLAG * CLA,INA STA DATA2 JMP PST2,I SPC 5 PST4 NOP JSB PST1 * RETURN THE 124 WORD DISC DIRECTORY FROM LOGICAL * UNIT # 2 FOR THE FILE STATUS FMP COMMAND * SET THE DATA TOO FLAG CLA,INA STA DATA2 JMP PST4,I SPC 5 PST6 NOP * RETURN IERR LDA FERRA,I STA BLOKA,I ISZ BLOKA ISZ RPCNT JMP PST6,I SPC 5 * PST7 NOP * RETURN A & B & IERR JSB PST1 JSB PST6 JMP PST7,I SPC 5 PST10 NOP * READ POST-PROCESSER JSB PST7 JSB PST2 JMP PST10,I SPC 5 PST12 NOP * THIS S/R RETURNED FIVE OPTIONAL LOCATION PARAMS * THE CALL IS SEARCHED AND A PARAMETER IS ASSEMBLED * FOR EACH DEF IN THE CALL THE PROCESS ENDS WHEN A * ZERO IS ENCOUNTERED IN THE JSB BUFFER JSB PST7 FIRST PUT IN A,B,IERR * LDA DM7 STA CONTR * LDB LOBSA LOOP9 LDA B,I * STA BLOKA,I * INB ISZ BLOKA ISZ RPCNT ISZ CONTR JMP LOOP9 JMP PST12,I SPC 5 SPC 5 HED RFAEX: EXEC PREPROC. * (C) HEWLETT-PACKARD CO. 1976 SPC 5 SPC 5 HED RFAEX: UTILITY S'R'S * (C) HEWLETT-PACKARD CO. 1976 STUFF NOP * NOTE THAT THE E REG NEED BESET UP AT THE START ONLY * THEREAFTER (SINCE THE CHARACTERS ARE PICKED UP IN * PAIRS) THE START OF EACH WORD IS IN THE * RELATIVE LOCATION-& THUS E IS OK FOREVERMORE * INCREMENT NUMBER OF ASSEMBLED PARAMETERS * CHECK THE CHAR COUNT FOR "EVENESS" LDB D10 SET UP THE ERROR REGISTER LDA PRMLP SLA JMP ERR ISZ PRCNT * THE LOOP COUNTER IS ALREADY TO GO-PRMLP LDA APRMS PICK UP THE ADDRESS OF THE STA AJSBF,I PARAMETER TO BE BUILT & PUT * IT IN THE JSB BUFFER * INCREMENT "DEF PARAM" POINTER (JSB BUFFER) ISZ AJSBF * * NOW THE INITIAL CHARACTER MUST BE LOCATED LDA BLOKA PICK UP 1ST CHAR LOCATION SSA RIGHT JUSTIFIED? CCE,RSS NO-SET E REG TO 1 CLE YES-SET E REG TO 0 * NOW CLEAR BYTE POINTER AND MSK1 CLEAR SIGN & STORE STA BLOKA POINTER TO NEXT PARAMETER * PICK UP 1ST CHARACTER AGAN4 LDA BLOKA,I PICK UP 1ST CHAR OF PAIR SEZ,RSS AND LEFT JUSTIFY IT ALF,ALF IF REQUIRED AND MSK6 STA PRM4 * PICK UP 2ND CHAR SEZ,RSS HAVE WE CROSSED A WORD BOUNDARY? * NOTE 2ND CHAR IS OPPOSITE JUSTIFICATION OF 1ST 1 ISZ BLOKA YES-INCREMENT SOURCE ADDRESS * LDA BLOKA,I PICK UP CHAR & RIGHT JUSTIFY IT SEZ,RSS IF REQUIRED BEFORE THE MERGING ALF,ALF OF THE TWO CHARS. AND MSK0 * NOW MERGE THE TWO CHARS & STORE THEM IOR PRM4 STA APRMS,I ISZ APRMS * NOW A "DEF PRAM" & AT LEAST ONE PARAM WORD * HAVE BEEN ASSEMBLED-DETERMINE IF THERE ARE * MORE CHARACTERS IN THIS STRING SEZ HAVE WE CROSSED A WORD BOUNDARY ? ISZ BLOKA YET-IF SO INCREMENT STORAGE ISZ PRMLP INCREMENT THE ISZ PRMLP CHARACTER COUNT-ARE THERE MORE? JMP AGAN4 YES-SET UP TO GET TWO MORE * WE ARE DONE WITH THIS CHAR SET UP ADDRESS OF * NEXT CONTROL CHAR TO BE EXTRACTED BY GETCB * LDA BLOKA PICK UP CONTROL CHAR ADDRESS-NOW SEZ IS IT IN THE HIGH ORDER BYTE? IF IOR MSK5 LEFT JUSTIFIED BIT 15=1 & SET IT STA PRAM1 UP FOR THE GETCB CALL TO FOLLOW JMP STUFF,I AND EXIT SPC 5 SDREQ NOP SEND THE REPLY WITH STATUS * AS A REQUEST * * SET THE PARMB RETURN FLAG LDA IRBUF PICK UP THE STREAM TYPE IOR MSK7 OR IN THE REPLY FLAG STA IRBUF & RETURN TO THE PARMB AND B4000 ISOLATE THE F BIT LDB IRBFL GET F LENGTH (35) SZA,RSS F BIT SET ? LDB RPCNT NO, GET SHORT, COMPUTED LENGTH STB LENGT SAVE * * THIS S/R ASSUMES THAT PREVIOUS POST PROCESSING * S/R HAVE SET UP THE REQUEST BUFFER TO BE SENT * IN REPLY TO THE ORIGIONAL REQUEST LDA FSTLU GET COMM. LU AND MSK2 STA IMODE * REPLIES ARE TRANSMITTED SPECIAL OPEN LOOP * & NO DMA AT THE TERMINAL IS ASSUMED JSB D65SV SEND REQUEST REPLY TO TERMINAL DEF *+7 DEF IRWW DEF IMODE DEF IRBUF DEF LENGT BUFFER LENGTH | DEF DUMMY DEF DUMMY * JMP ABERR ERROR RETURN * JMP SDREQ,I NO, RETURN SPC 5 SIZE NOP * FIRST PICK UP THE # OF DATA WORDS LDA PARMB ADA D5 LDA A,I * IS IT ZERO-ERROR IF IT IS SZA,RSS JMP ERR1 * IS IT NEGATIVE-ERROR IF IT IS SSA JMP ERR1 * IT'S POSITIVE BUT IS IT GREATER THAN 128 WORDS * LONG?-ERROR IF IT IS STA IDBFL SAVE DATA BUFFER LENGTH CMA,INA ADA DABFL SSA JMP ERR1 JMP SIZE,I SPC 5 SDATA NOP * * SET UP THE TRANSMIT DATA ONLY CALL MODE * AND INSERT IT IN THE CALL * LDA FSTLU GET COMM. LU AND MSK2 IOR MSK3 SEND DATA ONLY STA IMODE * * EXECUTE THE CALL JSB D65CL DEF *+7 DEF IRWW WRITE DEF IMODE DATA ONLY DEF DABUF DATA BUFFER DEF IDBFL BUFFER LENGTH DEF IRBUF+33 PASS TIME-TAGS TO DRIVER DEF IRBUF+34 * JMP ABERR ERROR RETURN * JMP SDATA,I NO, RETURN SPC 5 SPC 3 CODER LDB MD25 JMP ERR SPC 3 * * D6 PREPROCESSING ERROR * D7 POSTPROCESSING ERROR * D11 SIZE ERROR ERR STB SAVEB * * NOTE THAT THE RETURN IS BUILT IN THE ORIGINAL * REQUEST BUFFER BEHIND DATA TYPE & SUBSTREAM * USED BY ALL REMOTE RFA CALLS * NOTE THAT THERE ARE NO CONTROL BYTES * IN THE RETURNED BUFFER * DETERMINE IF THIS ERROR OCCURED DURING AN RFA READ * OR WRITE IF SO A STOP COMMAND MUST BE SENT TO CLEAR OUT * THE DATA RECORD ON THE LINE LDA PARMB ISOLATE THE FUNCTION CODE ADA D2 LDA A,I AND MSK0 ADA BASE NORMALIZE IT CPA D4 IS IT A 4 (REMOTE WRITE) JMP STOP YES SEND STOP CPA D5 NO-IS IT A 5 (REMOTE READ) JMP STOP YES SEND STOP-ALL OTHERS CONTINUE JMP GO OTHERWISE BUILD ERROR REPLY STOP LDA FSTLU GET COMM. LU AND MSK2 STA FSTLU * JSXB D65CL SEND STOP DEF *+7 DEF ICR CONTROL REQUEST DEF FSTLU STOP DEF DUMMY DEF DUMMY DEF DUMMY DEF DUMMY * JMP ABERR ERROR RETURN * GO LDA PARMB ADA D2 THE VALUES TO STA BLOKA * * SET UP A -1 FOR THE A REG. RETURN * THIS WILL ALERT THE TERM. THAT AN ERROR REPLY * IS BEING SENT LDA SAVEA STA BLOKA,I ISZ BLOKA * PICK UP THE B REG. (ERROR TYPE) LDA SAVEB STB IRBUF+4 SAVE THE ERROR CODE IN THE ERROR RETURN OF THE PARMB * * SET THE REPLY FLAG LDA IRBUF PICK UP THE STREAM WORD IOR MSK7 OR IN THE REPLY FLAG STA IRBUF & RESTORE TO THE BUFFER AND B4000 ISOLATE THE F BIT LDB IRBFL GET F LENGTH (D35) SZA,RSS F BIT SET ? LDB D25 NO, GET SHORT LENGTH STB LENGT SAVE FOR CALL * LDA FSTLU SET UP DRIVER MODE AND MSK2 STA IMODE * REPLIES ARE TRANSMITTED SPECIAL OPEN LOOP * & NO DMA AT THE TERMINAL IS ASSUMED * JSB D65SV SEND REQUEST REPLY TO TERMINAL DEF *+7 DEF IRWW WRITE DEF IMODE DEF IRBUF DEF LENGT DEF DUMMY DEF DUMMY * JMP ABERR ERROR RETURN * * LDA SAVEB GET ERROR CODE AGAIN ABEND LDB CDCBA GET ADDRSS OF CURRENT DCB ADB D145 STEP TO ERROR WORD STA B,I SAVE ERROR CODE JSB EXEC TERMINATE TO REACTIVATE RFAM DEF *+2 DEF D6 SPC 5 ERR1 LDA D11 JMP ERR SPC 5 ABERR DST SSA SAVE DRIVER ERROR RETURN * OUTPUT ERROR MESSAGE * LDA B CONVERT ERROR # IOR B#60 TO ASCII STA COMER+6 FOR OUTPUT * JSB EXEC OUTPUT ERROR MESSAGE DEF *+5 DEF D2 DEF D1 DEF COMER DEF COMEL * wB@< REMOTE EXEC-CALL MONITOR *(C) HEWLETT-PACKARD CO. 1976* * NAM EXECM,2,30 91700-16127 REV.A 760212 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT D65SV EXT D65CL EXT CNUMO EXT REIO EXT #MBRK IFZ EXT DBUG XIF A EQU 0 B EQU 1 SUP EXT EXEC SPC 5 * * EXECM * SOURCE:91700-18127 * BINARY:91700-16127 * SHANE DICKEY * JULY 30.1974 * * MODIFIED BY: C.C.H. [01/11/76] * * Z OPTION INCLUDES DEBUG SPC 5 HED EXEC REQUEST PROCESSOR * (C) HEWLETT-PACKARD CO. 1976 * * * GET THE I/O CLASS FOR THIS MONITOR SET UP BY LSTEN * EXECM LDA B,I IS P1 = I/O CLASS? IFZ SZA,RSS IF ZERO INITIALIZE CALL-SET UP JMP *+3 AND TERMINATE-IF REAL LSTEN CALL- XIF STA ICLAS SET UP GET AND DO IT IFZ JMP GET * JSB DBUG SET UP DBUG DEF *+1 * JSB EXEC SAVE RESOURCES AND TERMINATE DEF *+4 DEF D6 DEF ZERO DEF D1 * JMP EXECM LSTEN CALL STARTS HERE XIF * * ISSUE GET ON I/O CLASS * GET JSB EXEC THIS GET WILL SUSPEND DEF *+5 EXECM UNTIL QUEUE SENDS DEF D21 A REMOTE EXEC CALL TO THE MONITOR DEF ICLAS UPON ACTIVATION, REQUEST PARMB WILL BE DEF IRBUF IN THE IRBUF BUFFER AREA DEF IRBFL * * PARMB+24=LU * LDA IRBUF+24 AND MSK2 STA FSTLU * * * THE ORIGINAL CALL IS RECONSTRUCTED * THE PREPROCESS FLAG IS CHECKED TO DETERMINE * IF THERE IS ANY /PREPROCESSING TO BE DONE * AN EXAMPLE OF THIS WOULD BE THE GATHERING OF * A DATA BUFFER BEFORE EXECUTION OF A WRITE REQUEST * ALSO ERROR CHECKING CAN BE DONE IN PREPROCESS S/R * FOLLOWING THE PREPROCESS THE RECONSTITUTED CALL * IS EXECUTED AND STATUS IS RETURNED TO EXECM * BY EXEC-IT IS THE RETURN OF THIS STATUS INFORMA- * TION THAT COMPRISES THE MAJOR PART OF POST- * PROCESSING, OF COURSE OTHER TYPES OF POSTPROCESSES * CAN BE ACCOMPLISHED. AN EXAMPLE IS THE WRITING OF * AN ACQUIRED DATA BUFFER TO THE TERMINAL FOLLOWING * A DATA READ * * * * CLEAR THE JSB BUFFER TO ZEROS AT THE START * LDB DM12 SET UP A COUNTER TO STB CONTR CLEAR 12 WORDS OF THE JSB BUFFER LDA JSBFA TO 0-THEN SET UP START ADDRESS STA AJSBF TO CLEAR CLA LOOP7 STA AJSBF,I CLEAR A WORD * * INCREMENT COUNTERS * ISZ AJSBF ISZ CONTR JMP LOOP7 IF NOT DONE DO NEXT ONE * * RECONSTRUCT THE CALL * LDA PARMB BUILD A POINTER TO THE ADA D6 1ST USER PARAMETER IN STA BLOKA PARMB & STORE IT IN BLOKA LDA PRMSA BUILD A POINTER TO THE ASSEMBLY STA APRMS AREA & SAVE IT-ACTUAL PARAMETERS' LDA JSBFA BUILD A POINTER TO THE JSB STA AJSBF ASSEMBLY AREA LDA JSBTB GET JSB TO EXEC & INSERT IT STA AJSBF,I IN THE BUILDING BUFFER ISZ AJSBF ISZ AJSBF * * AFTER PUTTING IN THE JSB STEP PAST DEF RETURN *(THIS WILL BE COMPUTED AND FILLED IN LATER) * INITIALIZE PARAMETER COUNTER TO DO SAME * CLA THIS WILL BE INCREMENTED STA PRCNT STA RECHK INITIALIZE CHECK-COUNT. * * BEFORE THE BUFFER IS BUILT FROM PARMB IT MAY NEED A "MASSAGE". * THE FOLLOWING CODE ISOLATES THE ADDRESS OF THIS "MASSAGE" S/R * AND TRANSFERS TO IT. * * SET UP THE EXEC PREPROCESS S/R ADDRESS * LDA BLOKA GET ADDR OF ICODE WORD INA * * THE ICODE PARAMETER MUST NOW BE SET UP * LDA A,ԿI ALF,ALF AND MSK0 STA ICODE * SKP * SET UP THE ERROR REGISTER * LDB D9 ADA EXPRA PICK UP ICODE, PROCESSOR,ERROR CHECK ICODE LDA A,I AND XFER TO PROCESS IF DEFINED * * BY WAY OF REVIEW: * BLOKA NOW POINTS TO PARMB+6(START OF PARAMETERS) * APRMS NOW POINTS TO PARMS (PARAMETER STORAGE BUFFER) * AJSBF NOW POINTS TO JSBUF+3 (BUILDING BUFFER 3RD WORD) * THE PARAMETER COUNT (PRCNT) IS ZERO * ICODE CONTAINS THE REQUESTED EXEC ICODE SETTING * THE PARMB IS CONTAINED IN THE IRBUF BUFFER * JSB A,I * * SET THE SIGN BIT & SET UP BOTH RETURNS * LDB JSBUF+2 LDA B,I IOR MSK5 STA B,I * JSB PRE7 COMPUTE "DEF RTRN" & ERROR RETURN * * SET THE NO DATA TO BE RETURNED FLAG-NOMINAL CASE * CLA STA DATA2 * * EXECUTE THE CALL * JSB JSBUF-1 STA SAVEA STB SAVEB * * AFTER THE REQUEST IS EXECUTED THE POST PROCESSING * S/R WILL BE EXECUTED IN A MANNER ANALOGOUS TO THAT * SHOWN ABOVE FOR PREPROCESSING * * SET UP & CALL S/R THAT CONTROLS POSTPROCESSING * JSB PST1 RETURN THE A AND B REGISTERS FIRST * * NOW WE ARE DONE UNLESS THE TIME WORDS ARE TO * BE RETURNED ( EXEC CALL 11) * LDB D9 LDA ICODE AND MSK1 ADA EXPSA PICK UP POSTPROCESSOR,ERROR CHECK ICODE LDA A,I AND EXECUTE POST PROCESSOR JSB A,I * SKP * IF THE DATA FLAG IS SET THE DATA MUST BE * RETURNED BEFORE THE STATUS REPLY CAN BE SENT BACK * * SET BIT14 FOR REPLY TO THE SATELLITE. * LDA IRBUF GET STREAM WORD IOR MSK8 ADD REPLY BIT STA IRBUF & REPLACE IT LDA DATA2 SZA * * DETERMINE WHICH TYPE OF REPLY IS TO BE RETURNED * JSB SDATA SEND THE DATA BACK JSB SDREQ SEND THE PREV FORMATTED REQUEST * * SO RETURN * JMP GET LOOP BACK TO AWAIT NEXT REQUEST * SPC 2 * REPORT ERRORS TO THE SYSTEM OPERATOR. * ERRPT NOP ENTRY/EXIT: ERROR-REPORT RTN. DST ERCOD SAVE THE ASCII ERROR CODE. CPB "02" = ASCII "02" ? CCB,RSS YES. SET =-1 & SKIP FOR MORE CHECKS JMP ERRP0 NO. CONTINUE ERROR-REPORT PROCESSING. CPA "DS" IF ERROR IS "DS02": PREEMPTION, JSB ERR GO TO ENSURE CLEANUP, VIA . * ERRP0 LDA D10 CALCULATE THE ADDRESS CMA,CLE,INA OF THE OFFENDING ADA ERRPT CALLING SEQUENCE. STA ERRPT SAVE THE ADDRESS FOR ASCII CONVERSION. JSB CNUMO GO TO CONVERT DEF *+3 THE ADDRESS TO DEF ERRPT AN OCTAL VALUE IN ASCII CODE. DEF ERADR SAVE THE CODE FOR ERROR-PRINTOUT. * JSB EXEC GO DEF *+5 TO DEF IRWW PRINT DEF D1 THE DEF ERMSG ERROR DEF D15 MESSAGE. NOP IGNORE ERRORS--IF ANY. * JMP GET GO TO AWAIT THE NEXT REQUEST. * ERMSG ASC 8, /EXECM ERROR: ERCOD ASC 4,???? AT ERADR ASC 3,000000 * HED PREPROCESSING S/R'S * (C) HEWLETT-PACKARD CO. 1976 * SKP SPC 10 PRE7 NOP * * THIS IS THE LAST PREPROCESSING S/R CALLED * BY EACH REQUEST * IT COMPUTES "DEF RTRN" & SETS 'CCE,RSS' INTO ERROR-RTN. LOC'N. * AND 'CLE' INTO NORMAL RETURN LOC'N. * IF THE 'EXEC' CALL IS A NON-DISC READ/WRITE CALL FOR <130 WORDS, * THEN A CONVERSION IS MADE, TO CALL , VICE , IN ORDER * TO ALLOW ANOTHER PROGRAM TO GAIN ACCESS TO THE DISC-RESIDENT AREA. * LDA JSBFA PICK UP THE ADDRESS OF THE ADA PRCNT JSB BUFFER & ADD THE # OF PARMS ADA D2 ALREADY INSERTED THEN ADD 1 FOR LDB JSBFA THE DEF RTRN & 1 FOR 1ST FREE INB WORD. THEN FIND SLOT FOR DEF RTRN STA B,I AND INSERT IT. LDB ERRIN GET EXEC-ERROR INSTRUCTION (CCE,RSS). STB A,I  STORE IN ERROR-RETURN LOCATION. INA POINT TO NORMAL-RETURN LOCATION. LDB ERRIN+1 GET NORMAL-RETURN INSTRUCTION (CLE). STB A,I STORE IN NORMAL-RETURN LOCATION. LDA RECHK GET THE CHECK-COUNT. CPA D2 READ/WRITE CALL & BUFFER <130 WORDS? RSS YES, CONTINUE CHECKS. JMP PRE7,I NO--CANNOT USE ! LDB JSBRE GET THE "JSB REIO" INSTRUCTION. ADA PRCNT IF THE PARAMETER COUNT =4 (NON-DISC), & CPA D6 IT'S A READ/WRITE CALL FOR <130 WORDS, STB JSBUF THEN CONVERT TO CALL VIA . JMP PRE7,I RETURN SPC 2 PRE8 NOP ENTRY EXIT: DATA-READ SUBROUTINE. JSB BCHEK CHECK FOR "BREAK", BEFORE USE OF LINE. * LDA FSTLU GET THE LOGICAL UNIT NUMBER. IOR MSK3 INCLUDE MODE FOR DATA-ONLY. STA CONWD SAVE THE CONFIGURED CONTROL WORD. * * PICK UP THE DATA * JSB D65CL CALL DEF *+8 THE DEF IRWR COMMUNICATION LINE DEF CONWD CONTROL ROUTINE DEF DABUF TO DEF IDBFL READ DEF IRBUF+33 THE DEF IRBUF+34 CALLER'S DEF EXTAD DATA. JSB ERRPT * A SYSTEM ERROR HAS BEEN DETECTED! * * JMP PRE8,I * CONWD NOP * SPC 10 HED POST PROCESSING S/R'S * (C) HEWLETT-PACKARD CO. 1976 * PST1 NOP * * NOTE THAT THE RETURN IS BUILT IN THE ORIGINAL * REQUEST BUFFER BEHIND DATA TYPE & SUBSTREAM * USED BY ALL REMOTE FMP & EXEC CALLS * NOTE THAT THERE ARE NO CONTROL BYTES * IN THE RETURNED BUFFER * LDA PARMB PICK UP THE ADDRESS TO RETURN ADA D2 THE VALUES TO STA BLOKA * LDA SAVEA PICK UP SAVED A REG CONTENTS STA BLOKA,I ISZ BLOKA LDA SAVEB PICK UP SAVED B REG CONTENTS STA BLOKA,I ISZ BLOKA * * ADJUST THE R |ETURNED PARAMETER COUNT * LDA D4 STA RPCNT JMP PST1,I SPC 3 * BREAK-CHECK SUBROUTINE. SPC 1 BCHEK NOP ENTRY/EXIT * JSB #MBRK GO TO THE BREAK-CHECK ROUTINE DEF *+4 DEF STRM SPECIFY THIS MONITOR'S STREAM-TYPE (5). DEF FSTLU SPECIFY THE CURRENT LOGICAL UNIT NO. DEF IRBUF+33 SPECIFY LOCATION OF THE TIME-TAGS. * JSB ERRPT ERROR: REPORT THE PROBLEM. * JMP GET BREAK DETECTED--GO AWAIT NEXT REQUEST. * STB EXTAD NO BREAK. SAVE EQT EXT. ADDR. FOR D65CL. JMP BCHEK,I RETURN TO THE CALLER. * HED EXEC PRE PROCESSING S/R'S * (C) HEWLETT-PACKARD CO. 1976 * SPC 5 OK1 NOP PROCESS AN EXEC WRITE CALL * * FIRST FIX UP LOGICAL UNIT # * JSB OK1A THEN READ PARAMS INTO JSB BUFFER * * NOW THE DATA RECORD MUST BE PICKED UP. * LDA IDBFL GET THE DATA LENGTH. SZA ZERO LENGTH WRITE REQUEST? JSB PRE8 NO. GO TO READ DATA FROM THE LINE. JMP OK1,I RETURN FROM PREPROCESSOR SPC 5 OK1A NOP JSB SIZE * * NOW DO STANDARD STUFF I.E. SET UP TO EMPTY PARMB * ISZ BLOKA INCREMENT TO PARMB +07 LDA BLOKA,I MOVE ICODE TO PARMS ALF,ALF AND MSK2 STA APRMS,I LDA APRMS MOVE DEF ICODE TO JSBUF+2 STA AJSBF,I ISZ AJSBF INCREMENT TO JSBUF+3 ISZ PRCNT INCREMENT PARAMETER COUNT TO 1 ISZ BLOKA INCREMENT TO PARMB+8 ISZ APRMS INCREMENT PARAMETER STORAGE ADDRESS * LDB BLOKA,I GET CONTROL WORD STB APRMS,I PUT IN PARAMETER STORAGE LDB APRMS STB AJSBF,I PUT IT IN THE JSB BUFFER THEN ISZ AJSBF INCREMENT THE BUFFER POINTER & ISZ PRCNT THE PARAMETER COUNT ISZ APRMS * * SET UP & CALL STAND & CALL IT TO FILL PARMS * LDB DABFA PICK UP THE DATA BUFFER STB AJSBF,I ADDRESS & PUT IT IN THE JSB THEN ISZ AJSBF INCREMENT THE BUFFER POINTER & ISZ PRCNT THE PARAMETER COUNT ISZ BLOKA LDA BLOKA IOR MSK5 FOR THE 1ST "STANDARD" STA PRAM1 PARAMETER THEN GO AND * JSB STAND PICK THEM UP BEFORE ISZ RECHK SHOW PASSAGE OF USE-CHECK (R/W). JMP OK1A,I RETURNING SPC 5 OK3 NOP THE I/O CONTROL S/R FIRST, LDA BLOKA SETS UP FOR THE IOR MSK5 CALL & THE LOADS THE STA PRAM1 STANDARD PARAMETERS * JSB STAND & THEN JMP OK3,I RETURNS SPC 5 OK11 NOP * * TIME IN TMBSS BUFFER AFTER CALL * LDA ICODA STA AJSBF,I ISZ AJSBF ISZ PRCNT LDA TMBSA STA AJSBF,I ISZ AJSBF ISZ PRCNT JMP OK11,I SPC 5 OK31 NOP JSB OK3 * * PUT IN THE DEF'S TO THE STATUS WORDS * LDA IST1A STA AJSBF,I ISZ AJSBF ISZ PRCNT LDA IST2A STA AJSBF,I ISZ AJSBF ISZ PRCNT JMP OK31,I HED EXEC POST PROCESSING S/R'S * (C) HEWLETT-PACKARD CO. 1976 * SPC 5 OKP2 NOP THE READ EXEC CALL SUB-POST-PROC * * SET THE DATA TOO FLAG & RETURN * LDB IDBFL GET THE DATA BUFFER LENGTH. STB DATA2 RETURN-DATA FLAG: #0=SEND DATA,0=NO DATA JMP OKP2,I RETURN. SPC 2 OKP10 NOP * * THIS SUB-POST-PROCESS IS USED BY EXEC CALLS THAT * RETURN ONLY A&B REGS (I.E. IT IS A DUMMY S/R) * JMP OKP10,I SPC 2 OKP11 NOP THE TIME REQ. SUB-POST-PROCESSOR * * SET UP A LOOP TO PICK UP THE FIVE WORDS IN THE * TIME BSS "TMBSS" * LDA MD5 STA CONTR * LDB TMBSA LOOP5 LDA B,I STA BLOKA,I STORE TIME WORD ISZ BLOKA * * INCREMENT THE RETURNED PARAMETER COUNTER * ISZ RPCNT INB ISZ CONTR JMP LOOP5 JMP OKP11,I SPC 2 OKP13 NOP LDA ISTA1 RETURN, THE TWO STATUS WORDS LDB PARMB SET B TO RETURN BUFFER+4 ADDRESS ADB D4 * STA B,I RETURN 1ST STATUS WORD LDA ISTA2 GET THE NEXT ONE INB STA B,I LDA RPCNT FINALLY ADJUST RETURNED PARAM ADA D2 COUNT & RESTORE STA RPCNT IT & THEN JMP OKP13,I RETURN * SKP STUFF NOP * * NOTE THAT THE E REG NEED BE SET UP AT THE START ONLY * THEREAFTER (SINCE THE CHARACTERS ARE PICKED UP IN * PAIRS) THE START OF EACH WORD IS IN THE * RELATIVE LOCATION-& THUS E IS OK FOREVERMORE * INCREMENT NUMBER OF ASSEMBLED PARAMETERS * CHECK THE CHAR COUNT FOR "EVENESS" * LDB D10 SET UP THE ERROR REGISTER LDA PRMLP SLA JMP ERR+1 ISZ PRCNT * * THE LOOP COUNTER IS ALREADY TO GO-PRMLP * LDA APRMS PICK UP THE ADDRESS OF THE STA AJSBF,I PARAMETER TO BE BUILT & PUT * IT IN THE JSB BUFFER * INCREMENT "DEF PARAM" POINTER (JSB BUFFER) * ISZ AJSBF * * NOW THE INITIAL CHARACTER MUST BE LOCATED * LDA BLOKA PICK UP 1ST CHAR LOCATION SSA RIGHT JUSTIFIED? CCE,RSS NO-SET E REG TO 1 CLE YES-SET E REG TO 0 * * NOW CLEAR BYTE POINTER * AND MSK1 CLEAR SIGN & STORE STA BLOKA POINTER TO NEXT PARAMETER * * PICK UP 1ST CHARACTER * AGAN4 LDA BLOKA,I PICK UP 1ST CHAR OF PAIR SEZ,RSS AND LEFT JUSTIFY IT ALF,ALF IF REQUIRED AND MSK6 STA PRM4 * * PICK UP 2ND CHAR * SEZ,RSS HAVE WE CROSSED A WORD BOUNDARY? * * NOTE 2ND CHAR IS OPPOSITE JUSTIFICATION OF 1ST 1 * ISZ BLOKA YES-INCREMENT SOURCE ADDRESS * LDA BLOKA,I PICK UP CHAR & RIGHT JUSTIFY IT SEZ,RSS IF REQUIRED BEFORE THE MERGING ALF,ALF OF THE TWO CHARS. AND MSK0 * * NOW MERGE THE TWO CHARS & STORE THEM * IOR PRM4 STA APRMS,I  ISZ APRMS * * NOW A "DEF PRAM" & AT LEAST ONE PARAM WORD * HAVE BEEN ASSEMBLED-DETERMINE IF THERE ARE * MORE CHARACTERS IN THIS STRING * SEZ HAVE WE CROSSED A WORD BOUNDARY ? ISZ BLOKA YET-IF SO INCREMENT STORAGE ISZ PRMLP INCREMENT THE ISZ PRMLP CHARACTER COUNT-ARE THERE MORE? JMP AGAN4 YES-SET UP TO GET TWO MORE * * WE ARE DONE WITH THIS CHAR SET UP ADDRESS OF * NEXT CONTROL CHAR TO BE EXTRACTED BY GETCB * LDA BLOKA PICK UP CONTROL CHAR ADDRESS-NOW SEZ IS IT IN THE HIGH ORDER BYTE? IF IOR MSK5 LEFT JUSTIFIED BIT 15=1 & SET IT STA PRAM1 UP FOR THE GETCB CALL TO FOLLOW JMP STUFF,I AND EXIT SPC 1 SDREQ NOP SEND THE REPLY WITH STATUS AS A REQUEST. LDB IRBFL GET FRIENDLY PARMB LENGTH(35 WORDS). LDA IRBUF GET THE FIRST WORD OF THE PARMB. ALF POSITION FRIENDLY BIT(#11) TO THE SIGN. SSA,RSS IS REPLY GOING TO A FRIENDLY SATELLITE? LDB RPCNT NO. GET MINIMUM REPLY LENGTH. STB RPLEN CONFIGURE REPLY LENGTH SPECIFICATION. * * THIS S/R ASSUMES THAT PREVIOUS POST PROCESSING * S/R HAVE SET UP THE REQUEST BUFFER TO BE SENT * IN REPLY TO THE ORIGINAL REQUEST * THE REQUEST IS CONTAINED IN THE TERMQ BUFFER AREA * LDA FSTLU GET THE LOGICAL UNIT NUMBER. STA CONWD SAVE AS CONFIGURED CONTROL WORD. * JSB D65SV SEND REQUEST REPLY TO TERMINAL DEF *+7 DEF IRWW DEF CONWD DEF IRBUF DEF RPLEN DEF DUMMY DEF DUMMY JSB ERRPT * JMP SDREQ,I RETURN SPC 10 SIZE NOP ENTRY EXIT: BUFFER SIZE ANALYZER. LDB ICODE GET THE REQUEST CODE. LDA IRBUF+5 GET THE NUMBER OF DATA WORDS. SZA ZERO WORDS SPECIFIED? JMP NEG? NO--CHECK FOR NEGATIVE. CPB D1 ZERO-LENGTH READ REQUEST? JMP SETLN YES--GO TO SET DNdATA LENGTH. CPB D2 ZERO-LENGTH WRITE REQUEST? JMP SETLN YES--GO TO SET DATA LENGTH. JMP ERR1 NO. ERROR! NEG? SSA NEGATIVE SPECIFICATION? JMP ERR1 YES--ERROR! * * IT'S POSITIVE BUT IS IT GREATER THAN 512 WORDS * LONG?-ERROR IF IT IS * SETLN STA IDBFL SAVE DATA BUFFER LENGTH STA B SAVE LENGTH FOR CHECK. CMA,INA ADA DABFL SSA JMP ERR1 ADB DM130 IF THE DATA BUFFER LENGTH SSB IS <130 WORDS, THEN INDICATE ISZ RECHK THE PASSAGE OF AN USE-CHECK. JMP SIZE,I SPC 1 * IF A DATA FLAG ERROR HAS BEEN DETECTED * SEND A STOP REPLY AND THEN SEND AN ERROR REPLY * * TRANSMIT STOP REPLY * NOW SEND THE STANDARD ERROR REPLY * ERR1 LDB D11 SET UP ERROR REGISTER JMP ERR+1 * * ERROR PROCESSING OF CONFIGURED 'EXEC-CALL' ERRORS. * EXERR DST IRBUF+4 SAVE ASCII ERROR CODE FOR THE USER. CPA "IO" IF THE ERROR WAS AN "IOXX", RSS SKIP TO FURTHER ISOLATE THE TYPE. JMP CKSC GO TO PROCESS NON-"IOXX" ERRORS. CPB "05" IF THE ERROR CODE CLA,RSS WAS "IO05" (ILLEGAL TRK/SECTOR), CPB "08" OR "IO08" (DISC WRITE >1 TRK), CLA,RSS PREPARE FOR ERROR CODE #11; LDB D12 ELSE, USE CODE #12 FOR DEFAULT. SZA,RSS WAS IT "IO05" OR "IO08" ? LDB D11 YES. SET ERROR CODE =11. JMP ERR+1 GO TO RETURN THE ERROR INFORMATION. * CKSC LDB D12 LOAD THE DEFAULT ERROR CODE. CPA "SC" IF THIS WAS A SCHEDULING ERROR, LDB D8 SET THE ERROR CODE =8. JMP ERR+1 GO TO RETURN THE ERROR INFORMATION. * SKP SDATA NOP JSB BCHEK CHECK FOR "BREAK", BEFORE LINE USE. * * SET UP THE TRANSMIT DATA ONLY CALL MODE * AND INSERT IT IN THE CALL * LDA FSTLU GET THE LOGICAL UNIT NUMBER. IOR MSK3w3B@< INCLUDE THE BITS FOR MODE =DATA ONLY. STA CONWD SAVE THE CONFIGURED CONTROL WORD. * * EXECUTE THE CALL * JSB D65CL DEF *+8 DEF IRWW DEF CONWD DEF DABUF DEF IDBFL SET UP IN SIZE S-R DEF IRBUF+33 PASS TIME-TAGS TO DRIVER DEF IRBUF+34 DEF EXTAD JSB ERRPT * JMP SDATA,I JB SKP ERR NOP STB SAVEB * * ERROR 8 = SCHEDULING ERROR. * ERROR 9 = ILLEGAL EXEC ICODE * ERROR10 = ODD PARMB STRING COUNT * ERROR11 = PARMB DATA FLAG (# WORDS OF DATA) ERROR * ERROR12 = "IOXX" ERROR WAS DETECTED. * * NOTE THAT THE RETURN IS BUILT IN THE ORIGINAL * REQUEST BUFFER BEHIND DATA TYPE & SUBSTREAM * USED BY ALL REMOTE EXEC CALLS * NOTE THAT THERE ARE NO CONTROL BYTES * IN THE RETURNED BUFFER * DETERMINE IF THIS ERROR OCCURED DURING AN EXEC READ * OR WRITE IF SO A STOP COMMAND MUST BE SENT TO CLEAR OUT * THE DATA RECORD ON THE LINE * LDA IRBUF+7 PICK UP THE ICODE FROM PARMB ALF,ALF AND MSK0 ADA DM3 IF ICODE =1 OR 2 IT IS A READ SSA,RSS OR WRITE REQUEST SO SEND STOP JMP GO OTHERWISE BUILD ERROR REPLY * JSB D65CL SEND STOP! DEF *+8 DEF IRC DEF FSTLU DEF DUMMY DEF DUMMY DEF DUMMY DEF DUMMY DEF EXTAD NOP * IGNORE ERRORS TO ENSURE CLEANUP * * * SET A =-1 FOR THE A REG. RETURN, TO INDICATE THAT THIS IS AN ERROR REPLY. * GO CCA STA IRBUF+2 LDA SAVEB GET THE ERROR TYPE, AND INSERT STA IRBUF+3 INTO PARMB WORD #4 FOR RETURN. * LDA IRBUF GET THE FIRST WORD OF THE PARMB. IOR MSK8 ADD REPLY BIT STA IRBUF & RETURN IT LDB IRBFL GET FRIENDLY PARMB LENGTH (35 WORDS). ALF POSITION FRIENDLY BIT(#11) TO THE SIGN. SSA,RSS IS THE REPLY GOING TO A FRIENDLY USER? LDB D12 NO. GET MAX. REPLY LENGTH FOR ALIENS. STB RPLEN CONFIGURE REPLY LENGTH SPECIFICATION. * LDA FSTLU GET THE LOGICAL UNIT NUMBER. STA CONWD SAVE THE CONTROL WORD. * SKP JSB D65SV SEND REQUEST REPLY TO TERMINAL DEF *+7 DEF IRWW DEF CONWD DEF IRBUF DEF RPLEN LENGTH OF THE REQUEST/REPLY BUFFER DEF DUMMY DEF DUMM/Y NOP * IGNORE ERRORS TO ENSURE CLEANUP * * JMP GET GO TO AWAIT THE NEXT REQUEST. SPC 3 STAND NOP LDA PRAM1 AGAN3 JSB GETCB * * NOW GO GET CONTROL BYTE AND PARAMETER COUNT * UP AND EXECUTE THE CALL CONTAINED IN IT. * ADJUST PARAMETER LOOP COUNTER * LDA PRMLP PICK UP THE PARAMETER LOOP LDB TEMP COUNTER & THE PARAMETER TYPE SZB,RSS IS THE CONTROL CHAR AN "END" CHAR JMP STAND,I IF SO WE ARE READY TO WRAP UP CMA,INA TRUE LOOP COUNTER & STA PRMLP RESTORE IT * * NOW PROCESS THE PARAMETER * THE CHAR IS EITHER A STRING OR AN INTEGER * SO TWO OR MORE CHARS MUST BE MOVED INTO THE JSB * BUFFER & THE PARAMETER COUNT MUST BE INCREMENTED * BY 1 * LDA BLOKA JSB STUFF * * SET UP THE CONTROL CHARACTER LOCATION * JMP AGAN3 GO GET NEXT PARAMETER JMP STAND,I * SKP GETCB NOP * * THIS S/R PICKS UP THE CONTROL BYTE FOR THE NEXT * PARAMETER * IT ASSUMES THAT THE A REGISTER CONTAINS THE * ADDRESS OF THE WORD CONTAINING THE C.B. AND THE * SIGN TELLS WHICH BYTE IT IS IN * IF BIT 15 IS 0 THE C.B. IS RIGHT JUSTIFIED * IF BIT 15 IS 1 THE C.B. IS LEFT JUSTIFIED * IF E=0 (RT. JUS),SIGN=0 FOR CONTROL BYTE * SSA RIGHT JUSTIFIED ? ERRIN CCE,RSS NO-SET E REG TO 1 CLE YES-SET E REG TO 0 * AND MSK1 CLEAR SIGN BIT & PICK LDA A,I UP WORD SEZ RIGHT JUSTIFY THE C.B. ALF,ALF IF REQUIRED AND MSK0 MASK OUT THE LEFT BYTE * * THE CONTROL BYTE IS NOW ISOLATED IN THE RIGHT BYTE * STA TEMP SAVE FOR LATER * * ISOLATE THE CHAR COUNT * AND MSK2 ISOLATE THE CHAR STA PRMLP COUNT & RETURN TO THE USER * * SET DATA BYTE LOCATION OF STUFF OP. TO FOLLOW * IF CONTROL BYTE IS LEFT JUST. THEN THE DATA BYTE * IS RIGHT JUSTIFIED & VICE VERSA * SEZ,RSS ISZ BLOKA LDA BLéOKA AND MSK1 SEZ,RSS IOR MSK5 STA BLOKA * * BLOKA SIGN AND CONTENTS TELL WHERE THE DATA BYTE * IS-SAME CONVENTIONS AS ABOVE * JMP GETCB,I * SPC 10 MSK0 OCT 000377 MSK1 OCT 077777 MSK2 OCT 000077 MSK3 OCT 000300 MSK5 OCT 100000 MSK6 OCT 177400 MSK8 OCT 40000 * * ADDRESSES OF TABLES * DABFA DEF DABUF EXPRA DEF EXPRT-1 EXEC CALL PROCESS TABLE ADDRESS EXPSA DEF EXPST-1 EXEC CALL POST PROCESS TABLE ADD ICODA DEF ICODE IST1A DEF ISTA1 IST2A DEF ISTA2 JSBFA DEF JSBUF PRMSA DEF PARMS TMBSA DEF TMBSS * * CONSTANTS & STORAGE * ********* CONSTANTS ********* * DABFL DEC 512 DM12 DEC -12 DM130 DEC -130 D1 DEC 1 D2 DEC 2 D5 DEC 5 STRM EQU D5 STREAM-TYPE. D6 DEC 6 D8 DEC 8 D15 DEC 15 D11 DEC 11 D12 DEC 12 IRC OCT 100003 IRWR OCT 100001 IRWW OCT 100002 CODE FOR WRITE REQUEST MD5 DEC -5 D10 DEC 10 D4 DEC 4 DM3 DEC -3 D9 DEC 9 "DS" ASC 1,DS "IO" ASC 1,IO "02" ASC 1,02 "05" ASC 1,05 "08" ASC 1,08 "SC" ASC 1,SC * SKP * ********** STORAGE ********** * IRBUF BSS 35 AJSBF NOP APRMS NOP BLOKA NOP PARMB PARAMETER POINTER CONTR NOP DATA2 NOP EXTAD NOP EQT EXTENSION ADDRESS. ICODE NOP EXEC CALL CODE TYPE STORAGE IRBFL DEC 35 LENGTH OF REQUEST BUFFER ISTA1 NOP ISTA2 NOP PARMB DEF IRBUF REQUEST ADDRESS DEC 6 FIRST WORD OF REQUEST PRAM1 NOP THESE PARAMS MAY BE SET UP BY PRCNT NOP PRMLP NOP PRM4 NOP RECHK NOP USE-CHECK COUNTER. RPCNT NOP RETURNED PARAMETER COUNTER RPLEN NOP REPLY LENGTH STORAGE. SAVEA NOP RETURNED A REG CONTENTS SAVEB NOP TEMP NOP FSTLU NOP * TMBSS BSS 5 * * THE INFORMATION BUFFER FOLLOWS * IDBFL OCT 0 DATA BUFFER LENGTH PARMS BSS 12 BUFFER FOR REQUEST DATA WORDS * JSBTB JSB EXEC JSBRE JSB REIO * * JSBUF IS A S/R CON!]FIGURED BUFFER * NOP ENTRY POINT JSBUF BSS 12 BUFFER FOR ASSEMBLING EXEC REQS. SEZ,RSS DID 'EXEC' DETECT AN ERROR? JMP JSBUF-1,I NO. TAKE NORMAL RETURN. JMP EXERR YES. GO TO PROCESS THE ERROR. * SKP * TABLES * EXPRT DEF OK1A ICODE 1 = READ REQ DEF OK1 ICODE 2 =WRITE REQ DEF OK3 ICODE 3 = CONTROL DEF ERR ICODE 4 = UNDEFINED(DISC ALLOC) DEF ERR ICODE 5 = UNDEFINED (PKG.TRK.REL) DEF ERR ICODE 6 = UNDEFINED(PRG.COMPLET) DEF ERR ICODE 7 = UNDEFINED(PRG.SUSPEND) DEF ERR ICODE 8 = UNDEFINED(SEG.LOAD) DEF ERR ICODE 9 = UNDEFINED(SCHED W.WAIT) DEF OK3 ICODE 10= PROGRAM SCHED(WONTWAIT) DEF OK11 ICODE 11= TIME REQUEST DEF OK3 ICODE 12= EXECUTION TIME DEF OK31 ICODE 13= I/O STATUS DEF ERR ICODE 14 UNDEFINED DEF ERR ICODE 15 UNDEFINED(GLOBTRK.ALL) DEF ERR ICODE 16 UNDEFINED(GLOBTRK.REL) * * EXPST DEF OKP2 ICODE 1 READ REQUEST DEF OKP10 ICODE 2 WRITE DEF OKP10 ICODE 3 CONTROL REQUEST DEF ERR ICODE 4 UNDEFINED (SEE DEF ERR ICODE 5 UNDEFINED ALSO DEF ERR ICODE 6 UNDEFINED THE DEF ERR ICODE 7 UNDEFINED EXPRT DEF ERR ICODE 8 UNDEFINED TABLE) DEF ERR ICODE 9 UNDEFINED DEF OKP10 ICODE 10 PROGRAM SCHED (WOUTWAIT DEF OKP11 ICODE 11 TIME REQUEST DEF OKP10 ICODE 12 EXECUTION TIME DEF OKP13 ICODE 13 I/O STATUS DEF ERR ICODE 14 UNDEFINED (SEE ALSO DEF ERR ICODE 15 UNDEFINED EXPRT DEF ERR ICODE 16 UNDEFINED TABLE) DABUF BSS 512 ICLAS NOP ZERO NOP DUMMY EQU ZERO D21 DEC 21 END EXECM R ;Q 91700-18128 1603 S 0122 DS1/B CCE MODULE: DEXEC              H0101 ;ASMB,R,L,C HED REMOTE EXEC-CALL INTERFACE*(C) HEWLETT-PACKARD CO. 1976* * NAM DEXEC,7 91700-16128 REV.A 760116 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 EXT D65AB EXT EXEC EXT D65MS EXT .ENTR * ENT DEXEC SUP * DEXEC * SOURCE:91700-18128 * BINARY:91700-16128 * SHANE DICKEY * AUGUST 1,1974 * * MODIFIED BY J. P. BAUDOUIN * MODIFIED 18 JUN 75 * * MODIFIED BY: CHW [ 01-16-76 ] * SPC 2 * DEXEC NOP LDA DEXEC GET THE RETURN POINTER. STA EXIT SAVE FOR '.ENTR' PROCESSING. LDA MD10 CLEAR THE PARAMETER AREA LDB APRMS TO FACILITATE CHECKING JSB CLERR FOR MISSING PARAMETERS. * JMP GETPR GO TO OBTAIN PARAMETER ADDRESSES. * PRAMS REP 10 NOP SPC 5 EXIT NOP GETPR JSB .ENTR DEF PRAMS * CLA STA ERRFG STA RCXMT LDA MD35 LDB IRBFA JSB CLERR * LDA PRAMS,I * * IS LU = 0? IF SO LOCAL CENTRAL CALL * SZA,RSS LOCAL EXEC CALL? JMP LEXEC YES AND B77 STA IRBUF+24 LDA IRBFA LDB STREM SET UP 1ST PARMB WORD-STREAM TYPE STB A,I * ADA D5 STEP TO WORD 6 OF PARMB STA AIRBF UNDER CONSTRUCTION & CONTINUE * * COMPUTE # OF PARAMETERS * CLA LDB APRMS STB PRMSA GET ADDRESS OF FIRST PASSED PARM * LOOP2 LDB PRMSA,I IS IT THERE (NONZERO) SZB,RSS JMP OUT NO-DONE GET OUT INA YES-INCREMENT PARM COUNT ISZ PRMSA STEP TO NEXT PRAM JMP LOOP2 * OUT ADA M1 DECREMENT TO ACCOUNT FOR IDEST NOT SHIPPED STA PRMS# STA AIRBF,I ISZ AIRBF * * INSERT ICODE INTO PARMB * LDA PRAMS+1,I STA AIRBF,I AND MSK0 STRIP SIGN BIT & SAVE STA ICODE ISZ AIRBF * * SET UP POINTER TO NEXT PARMB ADDRESS TO FILL * LDA AIRBF STA PONTR * * SET UP PARMB BUFFER FILL SUBROUTINE * LDA ICODE LDB D1 ADA M14 SSA,RSS JSB ERR LDA ICODE ZERO? SZA,RSS JSB ERR YES SSA NEGATIVE? JSB ERR YES * * PICK UP THE PROCESSOR * ADA SUBAD LDA A,I * JSB A,I * * DVR65 DRIVER CALL * JSB STUP GO TO SET UP THE MASTER REQUEST. * * THE CALL TO 'D65MS' WILL : * 1) GET AN I/O CLASS * 2) COMPLETE WORD 2 OF PARMB (CLASS) * 3) SEND THE REQUEST * 4) AWAIT THE REPLY * 5) RETURN REPLY TO CALLER FOR EXAMINATION * 6) RETURN CONTROL TO CALLER * * JSB D65MS GO TO THE MASTER-REQUEST INTERFACE. DEF *+8 DEF RCXMT REQUEST CODE DEF CONWD CONTROL WORD (ERROR/Z/MODE/LU #) DEF IRBUF REQUEST BUFFER DEF IRBFL REQUEST LENGTH DEF BUFF,I DATA BUFFER--IF ANY DEF BUFL DATA LENGTH--IF ANY DEF TEMP ERROR-REPORT ADDRESS JMP MSERR * ERROR DETECTED BY 'D65MS'--REPORT IT. * LDB D1 GET ERROR CODE LDA ICODE AND ICODE FOR INDEX ADA PUBAD THEN ADD TABLE START LDA A,I GET PROCESSOR ADDRESS JSB A,I & GO DO IT * SKP * ERRORS SIGNIFIED BY AN ASCII DS,SC,IO (OR) RQ IN THE * PARMB + 5 WORD ON RETURN * IF SIGN BIT SET ON ICODE-RETURN TO USER * OTHERWISE KICK HIM OFF * RETURN THE STATUS * CHECK FOR SATELLITE DETECTED ERROR * LDB D2 SET UP ERROR CODE LDA IRBUF+6 SET UP TERMINALS ERROR RESPONSE STA MSG4+1 IN CASE AN ERROR EXISTS LDA IRBUF+5 STA MSG4 CPA DS IS IT AN ASCII "DS"? JSB ERR YES CPA SC A "SC"? JSB ERR YES CPA IO AN "IO" JSB ERR YES CPA RQ AN"RQ"? JSB ERR YES CPA IL AN "IL" JSB ERR YES * * WELL WE MADE IT * CLEAR THE ENTRY ARRAY, AFTER SETTING CORRECT EXIT POINT. * LDA PRAMS+1,I GET THE USER'S REQUEST CODE. SSA IF THE SIGN-BIT WAS SET, PREPARE ISZ EXIT FOR RETURN TO USER AT P+2. LDA MD10 LDB APRMS JSB CLERR * * RETURN * LDA IRBUF+5 LDB IRBUF+6 JMP EXIT,I HED PARMB CONSTRUCTION ARRAY * (C) HEWLETT-PACKARD CO. 1976 * ICOD1 NOP * * READ S/R * CLA,INA STA RCXMT JSB FILL JMP ICOD1,I SPC 1 ICOD2 NOP * * WRITE S/R * LDA D2 STA RCXMT JSB FILL JMP ICOD2,I SPC 1 ICOD3 NOP * * CONTROL CALL * PICK UP THE CONTROL WORD * LDA PRAMS+2,I STA PONTR,I * ISZ PONTR INCREMENT STORAGE ADDRESS LDA PRAMS+3,I OPTIONAL PARAMETER PRESENT? SZA,RSS JMP ICOD3,I NO EXIT STA PONTR,I AND PUT IN PARMB JMP ICOD3,I SPC 1 ICD10 NOP * * SCHEDULE CALL * JSB NAME * * NOW SET UP TO MOVE OPTIONAL PARAMETERS IN * LDA D5 BUILD LOOP COUNTER CMA,INA STA CONTR LDA APRMS ADA D3 STEP TO DEF TO 1ST ONE LOOP3 LDB A,I GET IT'S ADDRESS SZB,RSS IS IT THERE? JMP ICD10,I NO-EXIT LDB B,I STB PONTR,I ISZ PONTR INA ISZ CONTR JMP LOOP3 JMP ICD10,I ICD11 NOP * * TIME-NO PARAMETERS * LDA D2 STA IRBUF+5 JMP ICD11,I SPC 5 ICD12 NOP * JSB NAME GET PROGRAM NAME LDA APRMS LOOK AT "IOFST" PRAM.IF - THIS I S ADA D5 INITIAL OFFSET VERSION OF CALL LDA A,I LDA A,I * SSA,RSS WHICH ONE IS IT? JMP ABSRT ABSOLUTE START TIME! LDA D3 INITIAL OFFSET! CMA,INA STA CONTR SET UP COUNTER JMP STRT4 AND GO PROCESS ABSRT LDA D6 SET UP COUNTER CMA,INA STA CONTR * STRT4 LDA APRMS ADA D3 LOOP4 LDB A,I GET ADDRESS OF DEF THEN DEF LDB B,I THE PARAMETER IT'SELF STB PONTR,I & PUT IN PARMB ISZ PONTR INA INCREMENT POINTERS ISZ CONTR & IF NOT DONE DO IT AGAIN JMP LOOP4 JMP ICD12,I SPC 1 ICD13 NOP * * STATUS-PICK UP CONTROL WORD * LDA PRAMS+2,I STA PONTR,I JMP ICD13,I SKP * LOCAL EXEC-CALL EXECUTION ARRAY * EXSR NOP JSB EXEC DEF NOP DEFS REP 8 NOP SEZ ANY EXEC-DETECTED ERRORS? JMP MSERR YES. GO TO PROCESS. DST SAVEA SAVE FOR RETURN TO USER. LDA PRAMS+1,I GET THE USER'S REQUEST CODE. SSA IF THE SIGN-BIT WAS SET, ISZ EXIT SET FOR RETURN TO USER AT P+2. JMP EXSR,I RETURN TO THE CALLER. * MSERR DST MSG4 SAVE THE ASCII ERROR CODES. LDB D2 SET FLAG TO RETURN THE ERROR CODE. RSS BYPASS THE 'ERR' ENTRY POINT. * ERR NOP STB SAVEB SAVE ERROR CODE LDA PRAMS+1,I RETURN CONTROL TO USER IF SSA ICODE SIGN BIT SET JMP ERR1 * * OUTPUT MESSAGE TO CONSOLE AND TERMINATE USER * 1 IMPLIES ICODE ERROR-RQ ERROR * 2 IMPLIES SATELLITE RETURNED ERROR * 3 IMPLIES DATA LENGTH ERROR * GET PROGRAM NAME * LDB MESGA LDA SAVEB ADA M1 ADA A ADB A * * CALCULATE ABORTION ADDRESS * LDA PRMS# GET ADDRESS OF USERS JSB ADA D3 CMA,INA ADA EXIT * SKP * OUTPUT ERROR MESSAGE & TERMINATE * JSB D65AB  * * A REGISTER = JSB ADDRESS * B REGISTER = ADDRESS OF MESSAGE BUFFER * ERR1 LDA MESGA LDB SAVEB ADB M1 ADB B ADA B DLD A,I JMP EXIT,I * SPC 2 * * BUILD PARAMETERS FOR 'D65MS' * STUP NOP MASTER CALL SETUP S/R LDA D2 PREPARE FOR REQUEST-ONLY. LDB RCXMT IF THIS IS A REQUEST & DATA CALL, SZB,RSS THEN SKIP; ELSE, STA RCXMT SET REQUEST CODE FOR WRITE. BLF POSITION DRIVER MODE RBL,RBL TO . LDA IRBUF+24 GET THE LOGICAL UNIT NUMBER. IOR MSK2 INCLUDE THE ERROR-RETURN FLAG, IOR B AND THE DRIVER MODE. SZB IF THIS IS A REQUEST & DATA CALL, IOR ZBIT THEN SET THE DOUBLE BUFFER BIT(#12). STA CONWD SAVE THE CONFIGURED CONTROL WORD. LDA PRMS# GET ADDRESS OF USER'S JSB ADA D3 CMA,INA ADA EXIT STA TEMP AND SAVE AS ERROR-REPORT ADDRESS. JMP STUP,I RETURN TO MAKE THE CALL TO D65MS. * SKP CLERR NOP STA CONTR SAVE LOOP COUNTER STB PRMSA SAVE DESTINATION POINTER CLB LOOP6 STB PRMSA,I CLEAR A WORD ISZ PRMSA ISZ CONTR JMP LOOP6 CONTINUE TIL DONE JMP CLERR,I AND RETURN SPC 1 LEXEC LDA MD8 LDB DEFA STB ADEF JSB CLERR * * DON'T LET LOCAL SMESG THROUGH * LDB D1 LDA PRAMS+1,I AND MSK0 CPA D14 JSB ERR IOR MSK2 STA RCODE * LDA APRMS ADA D1 STA PRMSA * LDA MD8 STA CONTR LDA DEFRC CLB,RSS * LOOP7 LDA PRMSA,I SZA,RSS DONE IF PARAMETER IS ZERO JMP DONE7 STA ADEF,I INB ISZ PRMSA ISZ ADEF ISZ CONTR JMP LOOP7 * DONE7 INB ADB DEFB STB DEF LDA ERRIN GET ERROR-DETECTED INSTRUCTION(CCE,RSS). STA B,JI STORE IN ERROR RETURN LOCATION. INB POINT TO NORMAL RETURN LOCATION. LDA ERRIN+1 GET NORMAL-RETURN INSTRUCTION (CLE). STA B,I STORE IN NORMAL-RETURN LOCATION. * JSB EXSR * DLD SAVEA GET FOR RETURN TO USER. JMP EXIT,I ERRIN CCE,RSS CLE DEFRC DEF RCODE RCODE NOP * FILL NOP LDA APRMS GET DATA BUFFER ADDRESS ADA D3 LDB A,I STB BUFF INA LDB A,I GET DATA BUFFER LENGTH LDB B,I STB IRBUF+8 SSB CHARACTERS? JMP CHAR2 YES STB IRBUF+11 NO WORDS SAVE # TO USE AT OTHER STB BUFF+1 END JMP FILL3 THEN CONTINUE * CHAR2 CMB,INB CONVERT TO + CHARS SLB & ROUND UP INB THEN CONVERT TO WORDS BRS STB IRBUF+11 STB BUFF+1 FILL3 LDA B LDB D3 SZA,RSS JSB ERR ADA MD513 SSA,RSS JSB ERR * * INSERT CONWD & OPTIONAL WORDS * (IF PRESENT) IN PARMB * LDA PRAMS+2,I STA PONTR,I ISZ PONTR ISZ PONTR * LDA PRAMS+5 SZA,RSS JMP FILL,I LDA A,I STA PONTR,I ISZ PONTR * LDA PRAMS+6 SZA,RSS JMP FILL,I LDA A,I STA PONTR,I ISZ PONTR JMP FILL,I SPC 5 NAME NOP LDA PRAMS+2 LDB A,I GET 1ST 2 CHARS OF PROG STB PONTR,I NAME & PUT IN PARMB ISZ PONTR INA STEP TO NEXT TWO * LDB A,I STB PONTR,I AND DO IT AGAIN ISZ PONTR INA * LDB A,I THEN AGAIN STB PONTR,I ISZ PONTR JMP NAME,I SPC 5 IPODX NOP * * DUMMY S/R USED FOR NULL POSTPROCESSES * JMP IPODX,I SPC 5 IPD11 NOP * * TIME RETURN TIME VALUES * LDA IRBFA ADA D7 STA AIRBF GET ADDRESS OF RETURNED TIME * LDA D5 CMA,,INA BUILD COUNTER STA CONTR * LDA APRMS GET DEF TO BSS ADA D2 LDA A,I * LOOP5 LDB AIRBF,I STB A,I INA ISZ AIRBF GET A WORD & RETURN IT ISZ CONTR INCREMENT POINTERS JMP LOOP5 & DO IT AGAIN IF NEEDED JMP IPD11,I SPC 5 IPD13 NOP * * STATUS RETURN TWO STATUS WORDS * LDA APRMS ADA D3 LDA A,I GET 1ST STATUS WORD LDB IRBUF+7 STB A,I AND RETURN IT TO USER * LDA APRMS ADA D4 GET 2ND WORD LDB A,I SZB,RSS JMP IPD13,I LDB IRBUF+8 LDA A,I STB A,I * JMP IPD13,I SPC 5 HED CONSTANTS AND STORAGE * (C) HEWLETT-PACKARD CO. 1976 * SUBAD DEF SUBS-1 SUBS DEF ICOD1 DEF ICOD2 DEF ICOD3 DEF ERR DEF ERR DEF ERR DEF ERR DEF ERR DEF ERR DEF ICD10 DEF ICD11 DEF ICD12 DEF ICD13 * * PUBAD DEF PSUBS-1 PSUBS DEF IPODX DEF IPODX DEF IPODX DEF ERR DEF ERR DEF ERR DEF ERR DEF ERR DEF ERR DEF IPODX DEF IPD11 TIME DEF IPODX DEF IPD13 STATUS * * B77 OCT 77 D1 DEC 1 D2 DEC 2 D3 DEC 3 M1 DEC -1 A EQU 0 B EQU 1 PRMSA NOP APRMS DEF PRAMS MD35 DEC -35 IRBFA DEF IRBUF IRBUF BSS 35 CONTR NOP AIRBF NOP STREM DEC 5 D6 DEC 6 D7 DEC 7 PONTR NOP ICODE NOP D4 DEC 4 D5 DEC 5 IRBFL DEC 35 * SKP * THE FOLLOWING TWO STATEMENTS ARE TOGETHER!! * BUFF DEF TEMP NOP BUFL EQU BUFF+1 DEFA DEF DEFS DEFB DEF DEF MD8 DEC -8 M14 DEC -14 MD513 DEC -513 MD10 DEC -10 D14 DEC 14 RCXMT NOP CONWD NOP ZBIT OCT 10000 DS ASC 1,DS SC ASC 1,SC IO ASC 1,IO RQ ASC 1,RQ IL ASC 1,IL SAVEA NOP SAVEB NOP ERRFG NOP MESGA DEF MSG1 * * DO NOT REARRANGE THE FOLLOWING0.* MESSAGE BUFFERS * MSG1 ASC 2,RQ MSG4 ASC 2, ADEF NOP MSK0 OCT 77777 TEMP NOP PRMS# NOP MSK2 OCT 100000 END 90 < I 91700-18129 1605 S 0222 DS1/B CCE MODULE: RES              H0102 ASMB,R,L,C HED * - DS1 RESIDENT STORAGE * (C) HEWLETT-PACKARD CO. 1976 * NAM RES,14 91700-16129 REV.A 760130 SPC 1 ENT #BUSY,#FWAM,#GPRN,#GRPM,#LDEF,#MNUM,#MRTH,#MSTO ENT #NULL, #QRN,#RSAX,#RTRY,#SAVM,#SBIT,#SRPM,#ST00 ENT #ST01,#ST02,#ST03,#ST04,#ST05,#ST06,#ST07,#ST08 ENT #ST09,#ST10,#SVTO,#TBRN,#WAIT,#RXCL,#QCLM,#QLOG ENT #NCLR,#SCLR,#SWRD,#PLOG,#PRMY,#RFSZ,OVFLA EXT $ALC,$CGRN,$LIBR,$LIBX,$RTN,.ENTP * NAME: RES * SOURCE: 91700-18129 * RELOC: 91700-16129 * PGMR: C.C.H. [ 01/30/76 ] * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * RES IS A CORE-RESIDENT SYSTEM LIBRARY MODULE, USED BY THE * DS1 (DISTRIBUTED SYSTEMS) SOFTWARE PACKAGE, TO PROVIDE * CONTROLLED-ACCESS COMMON STORAGE. ITEMS STORED IN ARE NETWORK * GLOBAL CONSTANTS & VARIOUS LISTS WHICH CONTAIN THE TRANSACTION-BLOCK * RECORDS OF CURRENT TRANSACTIONS-IN-PROCESS ON THE NETWORK. * * #RSAX IS A PRIVILEGED LIBRARY ROUTINE, EMBEDDED IN RES, * WHICH CONTROLS ACCESS TO, AND ALLOWS MAINTENANCE OF, THE * NETWORK'S TRANSACTION-CONTROL-BLOCKS FOR CURRENT REQUESTS. * * #RSAX OPERATION: * 1. ON FIRST ENTRY, VERIFY THAT CALLER IS ELSE, ERROR #1! * A. SAVE I.D. SEGMENT ADDRESS FOR S.A.M. VALIDITY CHECKS. * B. IF LOC'N 1742B(BPA1) =2, THEN OP-SYSTEM USES DMS HARDWARE, * REQUIRING CONFIGURATION OF DMS FIRMWARE MACRO INSTRUCTIONS. * C. IF NON-DMS: OP-SYSTEM IS RTE-II--CLEAR DMS REFERENCES. * D. CLEAR THE 'JSB' TO THE INITIALIZATION ROUTINE. * 2. GET PARAMETERS & CHECK VALIDITY OF SPECIFIED STREAM & LIST. * A. IgF IMPROPER LIST - ERROR #1 --- REJECT! * 3. CHECK MODE OF OPERATION: * A. IF =0, GO TO 7. TO ALLOCATE/DE-ALLOCATE SYSTEM MEMORY. * B. IF =1, GO TO 3. TO ADD NEW ENTRY TO MASTER-REQUEST LIST. * C. IF =2, GO TO 4. TO ADD NEW ENTRY TO A SLAVE-STREAM LIST. * D. IF =3, GO TO 5. TO REMOVE AN ENTRY & RETURN IT TO THE POOL. * E. IF =4, SEARCH FOR BRK. FLAG--IF FOUND, CLEAR&RETURN ENTRY(GO TO 5.) * F. IF =5, SEARCH FOR ENTRY--=0:FOUND;=-4: NOT FOUND (GO TO 5.) * G. IF NONE OF THE ABOVE - ERROR #2 --- REJECT! * 4. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE MASTER LIST. * A. IF NONE AVAILABLE, CALLER HAS NOT CHECKED AVAILABILITY OF * TABLE-ACCESS RN (#TBRN) BEFORE ENTRY - ERROR #3 --- REJECT! * B. IF ENTRY AVAILABLE, SEARCH BY CLASS NO. FOR OBSOLETE ENTRIES * IN THE MASTER REQUEST LIST. * C. FLAG ALL OBSOLETE MASTER-REQUEST ENTRIES AS BAD, IF THEY * ORIGINATED WITH SAME REQUESTOR (BIT#15 =1 OF WORD#4). * D. LINK THE NEW ENTRY INTO THE MASTER REQUEST LIST. * 4.E. TRANSFER THE CALLER'S DATA INTO THE NEW ENTRY. * F. IF ENTRY POOL NOT DEPLETED, CLEAR TABLE-ACCESS RN & RETURN. * 5. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE SLAVE-STREAM LIST. * A. IF NONE, #TBRN NOT CHECKED BEFORE ENTRY - ERROR #3 --- REJECT! * B. LINK THE NEW ENTRY INTO THE SPECIFIED SLAVE-STREAM LIST. * C. TRANSFER CALLER'S DATA INTO THE NEW ENTRY. * D. RETURN VIA 3.F.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. * 6. CHECK LIST SPECIFICATION, BEFORE SEARCHING FOR/CLEARING AN ENTRY. * A. IF IMPROPER LIST SPECIFIED - ERROR #1 --- REJECT! * B. SEARCH FOR ENTRY. IF MODE=4,CHECK BREAK FLAG & CLEAR ENTRY, IF SET. * C. IF MODE=5, RETURN; ELSE, CLEAR ENTRY & RESTORE IT TO ENTRY POOL. * D. RETURN VIA 3.F.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. * 7. VERIFY CALLER TO BE BEFORE ALLOCATION/DE-ALLOCATION OF S.A.M. * A. IF ST/LS = #FWAM GO TO DE-ALLOCATE SYSTEM AVAILABLE MEMORzY. * B. IF ST/LS # #FWAM REQUEST ALLOCATION OF SYSTEM AVAIL. MEMORY. * C. IF REQUEST GRANTED, STORE BLOCK ADDRESS IN #FWAM, SIZE IN #SAVM. * D. IF REQUEST DENIED, RETURN REASON IN , FOR FURTHER ANALYSIS. * SKP * #RSAX CALLING SEQUENCE: * * JSB #RSAX * DEF *+5 * DEF MODE MODE OF OPERATION (0,1,2,3,4,OR 5). * DEF ST/LS STREAM/LIST, OR ALLOCATE: #WORDS, DE-ALLOCATE: #FWAM * DEF KEY KEYWORD FOR LIST SEARCHES. * DEF BUFAD ADDRESS OF DATA BUFFER FOR NEW ENTRY OR SEARCH. * NORMAL: =0, =ENTRY ADDRESS; ERROR: =-N,=0; * BREAK-FLAG FOUND:=0,= ENTRY ADDR.; NOT FOUND:=0 * * WHERE: * MODE =0 - REQUEST ALLOCATION/DE-ALLOCATION OF SYSTEM MEMORY. * MODE =1 - TO ADD A NEW ENTRY TO THE MASTER REQUEST LIST. * MODE =2 - TO ADD A NEW ENTRY TO A SLAVE-STREAM LIST. * MODE =3 - TO REMOVE AN ENTRY FROM A LIST & RETURN IT TO THE POOL. * MODE =4 - SEARCH FOR SLAVE-STRM. BREAK FLAG & CLEAR ENTRY IF SET. * MODE =5 - SEARCH FOR A MASTER OR SLAVE ENTRY. * * ST/LS - MODE =0: ALLOCATE NUMBER OF WORDS SPEC'D. IN ST/LS. * ST/LS - MODE =0: IF ST/LS =(#FWAM), RETURN SYSTEM MEMORY. * ST/LS - MODE=1-5: DUAL-BYTE CODE WORD WHICH IDENTIFIES THE LIST * WHICH IS TO BE MODIFIED. THE UPPER BYTE CONTAINS * THE SLAVE-STREAM IDENTITY (0-12B); THE LOWER BYTE * CONTAINS THE LIST-TYPE IDENTITY (1=MASTER,2=SLAVE): * * LIST IDENTIFICATION STREAM/LIST CODE WORD * ----------------------- --/-- ------- * MASTER REQUEST 00/01 000001B * SLAVE-STREAM 0 REQUEST 00/02 000002B * SLAVE-STREAM 1 REQUEST 01/02 000402B * SLAVE-STREAM 2 REQUEST 02/02 001002B * SLAVE-STREAM 3 REQUEҡST 03/02 001402B * SLAVE-STREAM 4 REQUEST 04/02 002002B * SLAVE-STREAM 5 REQUEST 05/02 002402B * SLAVE-STREAM 6 REQUEST 06/02 003002B * SLAVE-STREAM 7 REQUEST 07/02 003402B * SLAVE-STREAM 8 REQUEST 10/02 004002B * SLAVE-STREAM 9 REQUEST 11/02 004402B * SLAVE-STREAM 10 REQUEST 12/02 005002B * * KEY - UNIQUE KEYWORD FOR LIST SEARCHES. IT MUST BE SPECIFIED * TO BE THE MASTER-REQUESTOR'S CLASS NO., WHEN ADDING TO, * DELETING FROM, OR SEARCHING MASTER LIST (MODE=1,3,5). * 'KEY' MUST BE SUPPLIED AS A DUMMY PARAMETER FOR MODE=2. * IT MUST CONTAIN THE SELECT CODE OF THE COMMUNICATION * LINE I/O CARD (IN THE UPPER BYTE), TO SEARCH FOR OR * DELETE SLAVE-STREAM ENTRIES (MODE=3,4,5; ST/LS=XX/02). * [OPTIONAL (NOT USED) WHEN MODE =0] * * BUFAD - ADDRESS OF 3-WORD DATA BUFFER(MODE=1,2), WITH ELEMENTS * TO BE ADDED TO A LIST ENTRY; OR ADDRESS OF 2-WORD * TIME-TAG TO SEARCH/CLEAR SLAVE ENTRIES (MODE=3,4,5). * [OPTIONAL: CLEAR/SEARCH-FOR MASTER ENTRY (MODE=3,5)]. * [OPTIONAL (NOT USED) WHEN MODE =0] * SKP * DATA BUFFER FORMAT FOR MASTER-LIST ENTRIES: * * WORD #1 - SELECT CODE OF COMM. LINE DEVICE (BITS#13-8) * REQUEST TIMEOUT COUNT (BITS#7-0). * * WORD #2 - MASTER CLASS NUMBER (BITS#12-0). * * WORD #3 - REQUESTOR'S ID SEG. ADDRESS (BITS#14-0). * * DATA BUFFER FORMAT FOR SLAVE-STREAM LIST ENTRIES: * * WORD #1 - SELECT CODE OF COMM. LINE DEVICE (BITS#13-8) * REQUEST TIMEOUT COUNT (BITS#7-0). * * b WORD #2 - TRANSACTION TIME-TAG #1 (LEAST). * * WORD #3 - TRANSACTION TIME-TAG #2 (MOST). * * DATA BUFFER FORMAT FOR SLAVE-LIST CLEARING/BREAK-FLAG CHECK: * * WORD #1 - TRANSACTION TIME-TAG #1 (LEAST). * * WORD #2 - TRANSACTION TIME-TAG #2 (MOST). * * LIST FORMATS: * * 'RES' SYSTEM AVAILABLE MEMORY * ------------------------------- ------------------------- * * #MRTH < ADDR.=1RST MASTER-LIST ENTRY>--- * * * * * #ST00 --- * . * . < TRANSACTION TIME-TAG#1 > * . < TRANSACTION TIME-TAG#2 > * . * . * #STXX < ******* FORMAT SAME ******* >---< **** FORMAT SAME ***** > * < ********* FOR ALL ********* > < ******** FOR ********* > * < ****** SLAVE STREAMS ****** > < ******** ALL ********* > * < *** SLAVE STREAMS **** > * * WHERE: A(#15) = ABORT O.K. FOR MONITOR; B(#15) = BAD CONTENTS; * * SCODE(#13-#8) = COMM. LINE DEVICE'S SELECT CODE; * * I(#15) = I/O COMPLETION FLAG X = NOT USED [RESERVED!] * * !(#15) = MONITOR BREAK FLAG (TRANSACTION WAS INTERRUPTED). * * D(#14) = REQUEST AND DATA TRANSACTION * * *NOTE: 0 IN LIST HEAD OR FIRST WORD OF ENTRY SIGNALS END OF LIST. SKP **************************************************************************** * - * * #SBIT IS A SPECIAL SUBROUTINE TO ALLOW THE COMMUNICATION DRIVER * * TO SET THE I/O COMPLETION FLAG (BIT#15) IN WORD #2 OF MASTER * * REQUEST ENTRIES, AND TO SET THE BREAK FLAG (BIT#15) IN WORD #2 * * OF SLAVE-STREAM ENTRIES. * * * * NOTE: #SBIT SHOULD ONLY BE ENTERED FROM TYPE-0 PROGRAMS, SINCE * * ACCESS TO THE RTE PRIVILEGED PROCESSORS ($LIBR, $LIBX) IS * * NOT PROVIDED AT THIS ENTRY POINT. * * * * TYPE-0 PROGRAMS MUST NOT MAKE EXTERNAL REFERENCES TO * * #SBIT, LEST A COPY OF BE INCORRECTLY APPENDED * * TO THE PROGRAM. THE ADDRESS OF THE ENTRY POINT WILL BE * * PROVIDED TO THE DRIVER WHEN ENABLES THE LU. * * * * * * #SBIT CALLING SEQUENCE: * * * * LDA ST/LS = LIST IDENTIFIER (SEE ABOVE). * * LDB KEY = SEARCH KEY * * JSB #SBIT * * =0: NORMAL; ALWAYS =0. * * * * SEARCH KEY IS: * * * * = D-BIT(#14) & SELECT CODE(BITS#13-8)-SLAVE ENTRY * * = CLASS NUMBER (BITS#12-0) - MASTER LIST ENTRY. * * * * #SBIT ERRORS AT RETURN: =-1 - INVALID LIST * * =-4 - ENTRY COULD NOT BE FOUND * * * **************************************************************************** SPC 4 * #RSAX ERROR INDICATIONS: * * ERROR DETECTION WILL RESULT IN A RETURN TO THE CALLER WITH THE * REQUESTED ACTION NOT PERFORMED. WILL BE =0; IS AS FOLLOWS: * * = -1: AN INVALID LIST IDENTIFIER HAS BEEN SPECIFIED OR * FIRST CALLER IS NOT . * * = -2: THE SPECIFIED MODE OF OPERATION IS UN-DEFINED. * * = -3: NO SPACE FOR A NEW ENTRY. THE CALLER DID NOT WAIT FOR * THE TABLE-ACCESS RESOURCE NUMBER (#TBRN) TO BE CLEARED, * PRIOR TO CALLING #RSAX. (THIS SHOULD NOT OCCUR IF ALL * CALLERS ADHERE TO THE RN CONVENTION, PRIOR TO CALLING.) * * = -4: THE ENTRY TO BE CLEARED CANNOT BE LOCATED. * SKP MODE NOP MODE OF OPERATION. ST/LS NOP STREAM/LIST, #WORDS OR FWA: S.A.M. KEY NOP KEYWORD FOR LIST SEARCHES. BUFAD NOP ADDRESS OF NEW ENTRY BUFFER. SUP [SUPPRESS EXTENDED LISTING] #RSAX NOP ENTRY/EXIT JSB $LIBR DECLARE THIS TO BE NOP A PRIVILEGED ROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES DEF MODE FOR PARAMETERS & RETURN POINT. * INIT JSB CONFG 1RST ENTRY: CONFIGURE; 'NOP' THEREAFTER. * LDA KEY,I GET THE SEARCH KEY, STA KEY AND SAVE IT LOCALLY. LDA ST/LS,I GET STREAM/LIST OR S.A.M. PARAMETER. STA ST/LS AND SAVE LOCALLY. LDB MODE,I GET THE MODE OF OPERATION, STB MODE AND SAVE IT LOCALLY, ALSO. * DMS1 JSB MAPSV SAVE MAP STATUS: DMS; 'NOP': RTE-II. * dLDB MODE GET THE MODE OF OPERATION (AGAIN?). SZB,RSS IF MODE =0, THEN THIS IS A S.A.M. JMP SAM ALLOCATION/DE-ALLOCATION REQUEST. * JSB LSTCK GO CHECK VALIDITY & SET LIST CODE. SZA LIST IDENTIFIER ACCEPTABLE? [=LSTCD] JMP ERR01 * NO. ERROR #1: INVALID LIST! * LDA MODE GET THE MODE OF OPERATION. CPA P1 IF MODE =1, GO TO ADD A NEW ENTRY JMP ADENT TO THE MASTER-REQUESTOR LIST. CPA P2 IF MODE =2, GO TO ADD A NEW ENTRY JMP ADENT TO THE SLAVE MONITOR'S LIST. CPA P3 IF MODE =3, GO CLEAR AN ENTRY AND JMP MD345 RETURN IT TO THE NULL ENTRY POOL. CPA P4 IF MODE =4, GO EXAMINE THE LIST FOR JMP MD345 AN ENTRY WITH THE BREAK-FLAG SET. CPA P5 IF MODE =5, REQUEST IS ENTRY SEARCH. JMP MD345 GO TO SEARCH FOR THE ENTRY. JMP ERR02 * ERROR #2: INVALID MODE! * SKP * ADD A NEW ENTRY TO THE MASTER OR SLAVE-STREAM LIST. SPC 1 ADENT LDA #NULL GET THE NULL LIST LINK-WORD. CLE,SZA,RSS IS AN ENTRY AVAILABLE FROM THE POOL? JMP ERR03 * NO. ERROR #3: NO ENTRY AVAILABLE! STA ENTAD YES. SAVE ADDRESS OF NEW ENTRY. LDA MODE GET THE OPERATION MODE. CPA P2 IF A SLAVE ENTRY IS TO BE ADDED, JMP SLVAD GO TO PROCESS LIST CHANGES.[=LSTCD] * LDA CLMSK SET UP CLASS NO. MASK FOR STA KYMSK SEARCH OF EXISTING MASTER ENTRIES. LDB P2 SET UP OFFSET TO ALLOW SEARCH FOR STB OFSET SECOND WORD OF MASTER ENTRIES. ADB BUFAD FORM ADDRESS OF THE THIRD DATA ELEMENT GETID LDA B,I GET NEW ID SEG. ADDR. [XLA B,I: DMS] NOP [DUMMY: RTE-II; DEF B,I: DMS] STA IDSEG SAVE FOR BAD-ENTRY PROCESSING. * MLOOK JSB SERCH SEARCH FOR AN OBSOLETE ENTRY. JMP MSTAD END-OF-LIST: GO TO ADD NEW ENTRY. ADB P3 GET ܋THE 3RD WORD (ID SEGMENT ADDRESS) LDA B,I FROM ENTRY WITH SAME CLASS NUMBER. CPA IDSEG PREVIOUS ENTRY FROM SAME REQUESTOR? IOR SIGN YES. ADD BAD-ENTRY FLAG (BIT#15). STA B,I REPLACE THE MODIFIED WORD. JMP MLOOK SEARCH FOR ADDITIONAL BAD ENTRIES. * MSTAD CLB,INB ADD AN ENTRY TO THE MASTER LIST. * SLVAD CLA REMOVE AN ENTRY FROM THE NULL LIST. JSB LNK GO TO PROCESS LIST CHANGES. SZA LIST-PROCESSING ERROR? JMP ERR04 YES--INFORM THE CALLER! * LDA ENTAD = DESTINATION ADDRESS, WHICH INA IS THE SECOND WORD OF THE NEW ENTRY. STA TEMP SAVE FOR DESTINATION-BUFFER POINTER. LDB M3 GET NEGATIVE COUNT = NUMBER OF MOVES. STB TEMP+1 SAVE FOR WORD-MOVE COUNTER. LDB BUFAD GET THE SOURCE ADDRESS. MVW LDA B,I GET THE SOURCE WORD [XLA B,I: DMS] NOP [DUMMY: RTE-II; DEF B,I: DMS] STA TEMP,I STORE IT INTO THE DESTINATION LOCATION. INB ADVANCE THE SOURCE-BUFFER POINTER. ISZ TEMP ADVANCE THE DESTINATION BUFFER POINTER. ISZ TEMP+1 ALL WORDS BEEN MOVED? JMP MVW NO. GO BACK FOR MORE. * GETAD LDB ENTAD =ENTRY ADDRESS FOR NORMAL RETURN. CLA JMP EXIT GO TO PREPARE FOR RETURN TO CALLER. * SKP * ERROR PROCESSING AND EXIT SECTION. SPC 1 ERR04 LDA P4 =4: ENTRY CANNOT BE LOCATED. JMP ERR01+1 ERR03 LDA M3 =3: NEW ENTRY NOT AVAILABLE. CLB =0: ERROR-RETURN. JMP DMS2 RETURN-DIRECTLY-WITH ERROR INDICATION! ERR02 LDA P2 =2: INVALID MODE PARAMETER. JMP ERR01+1 ERR01 CLA,INA =1: INVALID LIST PARAMETER. CMA,INA NEGATE THE ERROR CODE. CLB =0: FOR ERROR RETURN. * EXIT DST TEMP SAVE TEMPORARILY. LDA #NULL IF NO ENTRIES REMAIN AVAILABLE y SZA,RSS IN THE ENTRY POOL, THEN DO NOT JMP RETRN CLEAR THE TABLE-ACCESS RN; ELSE, LDA #TBRN GET THE TABLE-ACCESS RN AND GO TO RTE JSB $CGRN TO MAKE IT AVAILABLE FOR NEXT ACCESS. RETRN DLD TEMP RESTORE THE REGISTER RETURN-DATA. * DMS2 JSB MPRST RESTORE MAPS: DMS; 'NOP': RTE-II. * JSB $LIBX RETURN TO THE CALLER, VIA THE RTE DEF #RSAX PRIVILEGED ROUTINE PROCESSOR. * SPC 3 * * DYNAMIC MAPPING SYSTEM MAP PROCESSING ROUTINES. SPC 1 MAPSV NOP ENTRY/EXIT: STATUS SAVE RSB GET CURRENT MAP STATUS. RBL,RBL POSITION CURRENT STATUS FOR RESTORATION. STB DMSTS SAVE FOR RESTORATION BEFORE EXIT. SJP MAPSV,I ENABLE SYSTEM MAP AND RETURN. * DMSTS NOP DMS MAP-STATUS STORAGE. * SPC 1 MPRST NOP ENTRY/EXIT: MAP RESTORATION. JRS DMSTS MPRST,I RESTORE MAP AND RETURN. * SKP * PROCESS: CLEAR(3), BREAK-FLAG CHECK(4), AND SEARCH(5) MODES. SPC 1 MD345 LDB BUFAD GET ADDRESS OF USER'S TIME-TAGS. * GTAG1 LDA B,I GET TAG #1 [XLA B,I: DMS] NOP [DUMMY: RTE-II; DEF B,I: DMS] INB POINT TO SECOND TIME-TAG. GTAG2 LDB B,I GET TAG #2 [XLB B,I: DMS] NOP [DUMMY: RTE-II; DEF B,I: DMS] DST TTAG SAVE FOR ENTRY COMPARISON. LDB LSTCD GET THE REMOVAL-LIST IDENTIFIER. ADB #LDEF FIND THE TABLE ADDRESS. LDB B,I GET LIST-HEADER ADDRESS FROM TABLE. LDA B,I GET THE LINK-WORD. SZA,RSS EMPTY LIST? JMP ERR01 * YES. ERROR #1: INVALID LIST! * LDA SCMSK GET MASK FOR SEARCH BY SELECT CODE. CPB MDEF IF A MASTER ENTRY IS TO BE CLEARED, LDA CLMSK THEN CLASS NO. MASK MUST BE USED. STA KYMSK SAVE THE MASK FOR USE BY 'SERCH'. CLA,CLE,INA SET: KEY= 2ND WORD OF SLAVE ENTRY. CPB MDEF IF A MASTER ENTRY IS TO BE CLEARED, INA THEN SEARCH KEY IS IN 3RD WORD. STA OFSET SAVE THE ENTRY-OFFSET FOR 'SERCH'. STB TEMP SAVE THE LIST ADDRESS--TEMPORARILY. * CLOOP JSB SERCH SEARCH FOR THE ENTRY TO BE CLEARED. JMP ERR04 * ERROR #4: ENTRY NOT FOUND! STB ENTAD SAVE THE ENTRY ADDRESS. * LDA TEMP GET THE LIST ADDRESS AGAIN. CPA MDEF IF A MASTER ENTRY IS BEING PROCESSED, JMP MODCK GO CHECK FOR SEARCH OR CLEAR OPTION. ADB P2 POINT TO THE SLAVE TIME-TAG WORDS. DLD B,I GET THE ENTRY'S TIME-TAGS. CPA TTAG IF THE FIRST COMPARES, RSS GO TO CHECK THE SECOND; ELSE, JMP CLOOP CONTINUE SEARCHING. CPB TTAG+1 IF THE SECOND COMPARES, RSS GO CLEAR THE ENTRY; ELSE, JMP CLOOP CONTINUE SEARCH FOR VALID ENTRY. * MODCK LDA MODE GET THE MODE OF OPERATION. CPA P3 IF A CLEAR REQUEST IS IN PROCESS, JMP CLREN GO-DIRECTLY-TO CLEAR THE ENTRY. CPA P4 IF A BREAK-FLAG SEARCH IS IN PROCESS, CLB,INB,RSS PREPARE TO EXAMINE ENTRY'S SECOND WORD. JMP GETAD MODE =5: RETURN WITHOUT ALTERING ENTRY. * ADB ENTAD FORM ADDRESS OF SECOND ENTRY-WORD. LDA B,I GET THE CONTENTS OF THE SECOND WORD. CLB PREPARE TO RETURN NO-BREAK INDICATOR. SSA,RSS IS THE BREAK-FLAG (BIT#15) SET? JMP GETAD+1 NO. EXIT WITHOUT FURTHER ACTION. * CLREN LDA LSTCD REMOVE ENTRY FROM SPECIFIED LIST. CLB ADD ENTRY TO NULL LIST. JSB LNK GO TO PROCESS LIST CHANGES. SZA LIST-PROCESSING ERROR? JMP ERR04 YES. GO TO INFORM THE CALLER! JMP GETAD NO. GO TO MAKE NORMAL RETURN. * SPC 10 * * SYSTEM AVAILABLE MEMORY ALLOCATION/DE-ALLOCATION PROCESSOR. SPC 1 SAM LDA XEQT GET CALLER'S I.D. SEGMENT ADDRESS. CPA VALID ^ IF THIS IS CALLING, RSS THEN ALLOW ACCESS; ELSE, JMP ERR01 REPORT IMPROPER ACCESS! * LDA ST/LS GET THE MEMORY-REQUEST SPECIFICATION. CPA #FWAM IF CURRENT FWA S.A.M. SPECIFIED, JMP RTSAM THEN THIS IS A DE-ALLOCATION REQUEST. * STA SZMEM ALLOCATE: SAVE NO. OF WORDS REQUESTED. JSB $ALC REQUEST SYSTEM AVAILABLE MEMORY (S.A.M.) SZMEM DEC 128 IN THE AMOUNT SPECIFIED BY THE CALLER. JMP DMS2 * NEVER AVAILABLE: =-1,=MAX EVER JMP DMS2 * NOT AVAILABLE NOW: =0,=MAX NOW STA #FWAM O.K. SAVE THE ADDRESS OF MEMORY BLOCK. STB #SAVM SAVE THE SIZE OF THE MEMORY BLOCK. JMP DMS2 RETURN WITH S.A.M. SPECIFICATIONS. * RTSAM LDB #SAVM GET THE NUMBER OF WORDS TO RETURN. DST RTN CONFIGURE THE DE-ALLOCATION REQUEST. JSB $RTN RETURN A SYSTEM-AVAILABLE-MEMORY BLOCK; RTN NOP BEGINNING AT SPECIFIED ADDRESS, AND NOP CONTAINING SPECIFIED NO. OF WORDS. CLA CLEAR THE STORAGE LOCATIONS FOR: STA #FWAM MEMORY BLOCK ADDRESS. STA #SAVM MEMORY BLOCK SIZE. JMP DMS2 RETURN TO THE CALLER. * VALID NOP I.D. SEGMENT ADDRESS: LEGAL CALLER. * SKP * SUBROUTINE FOR DRIVER MANIPULATION OF LIST ENTRIES. SPC 1 * ENTER: = ST/LS; = D-BIT(#14) & SELECT CODE (UPPER BYTE)--SLAVE * = CLASS NO (BITS#12-0)--MASTER * RETURN: & =0: NORMAL; =-1, =0: LIST-CODE ERROR. * =-4, =0: NO SUCH ENTRY. * #SBIT NOP ENTRY/EXIT: DRIVER ACCESS TO LISTS. STB KEY SAVE KEYWORD FOR LIST SEARCH. * DMS3 JSB MAPSV SAVE MAP STATUS: DMS; 'NOP': RTE-II. * JSB LSTCK GO CHECK VALIDITY & SET LIST CODE. SZA VALID LIST IDENTIFIER? JMP SERR1 * NO. INFORM CALLER OF ERROR. [=-1] gNLHCLB,CLE,INB SEARCH COMPARISONS ARE TO BE CPB LSTCD PERFORMED ON 2ND WD. OF SLAVE ENTRIES, INB OR ON 3RD WD. OF MASTER ENTRIES. STB OFSET SAVE THE KEYWORD OFFSET. LDA DSMSK GET MASK: D-BIT AND SELECT CODE. CPB LSTCD IF MASTER LIST IS TO BE SEARCHED, LDA CLMSK THEN CLASS NO. MASK MUST BE USED. STA KYMSK SAVE THE MASK FOR USE BY 'SERCH'. JSB SERCH SEARCH FOR THE ENTRY TO BE MODIFIED. JMP SERR4 * ENTRY NOT FOUND--ERROR! INB POINT TO THE FLAG WORD. LDA B,I GET THE WORD TO BE MODIFIED. IOR SIGN INCLUDE THE FLAG (BIT#15). STA B,I REPLACE THE MODIFIED WORD. * CLA,RSS =0 FOR NORMAL RETURN. SERR4 LDA M4 =-4 FOR UNLOCATED ENTRY. SERR1 CLB =0, FOR ALL RETURNS. * DMS4 JSB MPRST RESTORE MAPS: DMS; 'NOP': RTE-II. * JMP #SBIT,I RETURN TO THE USER. * DSMSK OCT 77400 SEARCH MASK: D-BIT & SELECT CODE. M4 DEC -4 * }N SKP * SUBROUTINE TO CHECK LIST PARAMETER & SET LIST CODE. SPC 1 * ENTER: = ST/LS; = DON'T CARE. * RETURN: =0, =LIST CODE: NORMAL; =-1, =?: ERROR. * LSTCK NOP ENTRY/EXIT: LIST ID ROUTINE. CLB LSL 8 ISOLATE STREAM IN & LIST IN . ALF,ALF POSITION LIST TO LOWER BYTE. ADA B FORM THE LIST CODE FOR TABLE INDEXING. STA LSTCD SAVE FOR USE ELSEWHERE. ADA NMAX CHECK FOR SPECIFICATION SSA OF AN UN-DEFINED LIST. CPA NMAX NULL LIST SPECIFIED? CCA,RSS * ERROR: INVALID LIST! =-1. CLA DEFINED LIST: =0 - NORMAL RETURN. LDB LSTCD =LIST CODE, WHEN JMP LSTCK,I RETURNING TO THE CALLER. * LSTCD NOP LIST IDENTIFICATION CODE. * SKP * SUBROUTINE TO SEARCH FOR A SPECIFIC LIST ENTRY. SPC 1 * ENTER: & = DON'T CARE. * =0: SEARCH FROM TOP; =1: CONTINUE SEARCH. * 'KYMSK' SET TO ISOLATE PERTINENT BITS. * 'OFSET' SET = OFFSET INTO ENTRY FOR KEYWORD. * 'LSTCD' SET TO CODE OF LIST TO BE SEARCHED. * * RETURN: P+1 -- ENTRY NOT LOCATED; MEANINGLESS, =0. * P+2 -- ENTRY WAS LOCATED; MEANINGLESS, = ENTRY ADDRESS. * SERCH NOP ENTRY/EXIT:LIST SEARCH ROUTINE. LDB TEMP+1 GET NEXT-ENTRY ADDRESS TO CONTINUE. SEZ IS THIS A REQUEST TO CONTINUE? JMP SLOOP YES. GO TO CONTINUE THE SEARCH. LDA KEY GET THE CALLER'S SEARCH-KEY. AND KYMSK ISOLATE THE FIELD OF INTEREST, STA KEY AND SAVE THE SEARCH KEY. LDB LSTCD GET THE LIST IDENTIFIER. ADB #LDEF FIND THE TABLE ADDRESS. LDB B,I GET TOP-OF-LIST ADDRESS FROM TABLE. * SLOOP LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB,RSS IS THIS THE END OF THE LIST? JMP SERCH,I YES. TAKE "NOT FOUND" EXIT (P+1). * STB TEMP+1 SAVE POINTER TO NEXT ENTRY. ADB OFSET POINT TO KEYWORD LOCATION. LDA B,I GET THE KEYWORD. AND KYMSK ISOLATE THE PERTINENT BITS. LDB TEMP+1 PREPARE TO RETURN WITH ENTRY ADDRESS. CPA KEY DOES IT MATCH THE CALLER'S KEYWORD? CCE,RSS YES. SET FOR CONTINUATION--SKIP. JMP SLOOP NO. CONTINUE SEARCHING. * ISZ SERCH ENTRY FOUND: SET RETURN TO P+2. JMP SERCH,I RETURN TO THE CALLER. * SKP * SUBROUTINE TO PROCESS LIST LINKAGE. SPC 1 * ENTER: = CODE OF REMOVAL LIST; = CODE OF ADDITION LIST. * 'ENTAD' SET TO ADDRESS OF ENTRY TO BE REMOVED. * * RETURN: & =0: NORMAL; =-1, =UNCHANGED: ERROR. * LNK NOP ENTRY/EXIT: LIST LINK ROUTINE. STA TEMP SAVE REMOVAL-LIST CODE, TEMPORARILY. ADA #LDEF FIND THE TABLE ADDRESS. LDA A,I GET ADDRESS: TOP-OF-REMOVAL-LIST. LNK1 STA PNTR SAVE LIST POINTER. LDA A,I GET THE LINK TO THE NEXT ENTRY. SZA,RSS IF THIS IS THE END OF THE LIST, JMP LNKER THEN INFORM THE CALLER OF THE ERROR. CPA ENTAD IS THIS THE ENTRY TO BE REMOVED? RSS YES. SKIP TO REMOVE IT. JMP LNK1 NO. TRY THE NEXT ONE. LDA ENTAD,I GET THE LINK TO THE FOLLOWING ENTRY, STA PNTR,I AND MOVE IT TO THE PREVIOUS ENTRY. * ADB #LDEF FIND THE TABLE ADDRESS. LDB B,I GET ADDRESS: TOP-OF-ADDITION-LIST. LNK2 STB PNTR SAVE LIST POINTER. LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB IS THIS THE END OF THE LIST? JMP LNK2 NO. CONTINUE SEARCHING FOR THE END. STB ENTAD,I YES. MAKE NEW ENTRY = END-OF-LIST. LDA ENTAD GET THE ADDRESS OF THE NEW ENTRY. STA PNTR,I SAVE IN LINK-WORD OF PREVIOUS ENTRY. * CPB TEMP REMOVING ENTRY FROM NULL LIST? [=0] CLA,INA,RSS YES. PREPARE TO ADD TO ACTIVE COUNT. CCA NO. PREPARE TO DECREMENT ACTIVE COUNT. ADA #BUSY COMPUTE THE NEW 'ACTIVE-ENTRY' COUNT, STA #BUSY AND UPDATE THE INDICATOR. CLA,RSS INDICATE NORMAL RETURN, AND SKIP. LNKER CCA =-1: NO ENTRIES IN REMOVAL LIST. JMP LNK,I RETURN IS MADE TO THE CALLER. * SKP * TABLE OF LIST-HEADER ADDRESSES. LIST CODES: STREAM/LIST SPC 1 #LDEF DEF *+1 START-OF-TABLE DEFINITION. DEF #NULL ENTRY-POOL HEADER 00/00 MDEF DEF #MRTH MASTER-REQUEST HEADER 00/01 SDEF DEF #ST00 SLAVE-STREAM 00 HEADER 00/02 DEF #ST01 SLAVE-STREAM 01 HEADER 01/02 DEF #ST02 SLAVE-STREAM 02 HEADER 02/02 DEF #ST03 SLAVE-STREAM 03 HEADER 03/02 DEF #ST04 SLAVE-STREAM 04 HEADER 04/02 DEF #ST05 SLAVE-STREAM 05 HEADER 05/02 DEF #ST06 SLAVE-STREAM 06 HEADER 06/02 DEF #ST07 SLAVE-STREAM 07 HEADER 07/02 DEF #ST08 SLAVE-STREAM 08 HEADER 10/02 DEF #ST09 SLAVE-STREAM 09 HEADER 11/02 DEF #ST10 SLAVE-STREAM 10 HEADER 12/02 * NEW ENTRY: .........DEF #STXX.....SLAVE-STREAM XX HEADER.....XX/02 NMAX ABS #LDEF+1-* LIST CODE VALIDITY-CHECKING CONSTANT. #MNUM ABS NMAX-SDEF NUMBER OF SLAVE-STREAM TYPES. SPC 1 * CONSTANTS AND STORAGE. SPC 1 CLMSK OCT 17777 MASK FOR ISOLATION OF CLASS NUMBER. ENTAD NOP STORAGE FOR ADDRESS OF LIST ENTRY. IDSEG NOP STORAGE FOR MASTER ID SEGMENT ADDRESS. KYMSK NOP KEYWORD ISOLATION MASK. M3 OCT -3 OFSET NOP KEYWORD OFFSET INTO THE ENTRY. P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 PNTR NOP STORAGE FOR LIST POINTER. SCMSK OCT 37400 MASK FOR ISOLATION OF SELECT CODE. SIGN OCT 100000 TEMP OCT 0,0 TEMPORARY STORAGE LOCATIONS. TTAG OCT 0,0 TIME-TAG STORAGE, FOR SLAVE _pSEARCH. SPC 1 * GENERAL SYSTEM DATA [ INITIALIZED BY 'LSTEN' ]. SPC 1 #SCLR DEF #TBRN START OF AREA CLEARED BY 'LSTEN'. #FWAM NOP ADDRESS OF SYSTEM AVAIL. MEMORY BLOCK. #SAVM NOP SIZE OF SYSTEM AVAIL. MEMORY BLOCK. #TBRN NOP TABLE-ACCESS RESOURCE NUMBER. #GRPM NOP GENERAL PRE-PROCESS MODULE CLASS NO. #GPRN NOP GENERAL PRE-PROCESS MODULE RN. #SRPM NOP SLAVE PRE-PROCESSOR CLASS NUMBER. #QCLM NOP QUEUE CLEAN-UP MONITOR CLASS NUMBER. #QRN NOP QUIESCENT(RN) OR SHUT-DOWN(0). #BUSY NOP FLAG:0-NORMAL;#0-HOLD-OFF SLAVE REQUESTS #MSTO NOP MASTER REQUEST TIMEOUT VALUE. #SVTO NOP SLAVE REQUEST TIMEOUT VALUE. #RTRY NOP D65MS BUSY-REJECT RETRY COUNT. #WAIT NOP D65MS QUIESCENT WAIT INTERVAL. #SWRD NOP NETWORK-NODE SECURITY CODE. SKP * LIST HEADERS (REMAINDER OF LISTS LOCATED IN SYSTEM AVAILABLE MEMORY). SPC 1 #NULL NOP LIST HEADER: ENTRY POOL. SPC 1 #MRTH NOP MASTER REQUEST LIST. SPC 1 #ST00 OCT 0,0,0 SLAVE-STREAM 00 LIST. SPC 1 #ST01 OCT 0,0,0 SLAVE-STREAM 01 LIST. SPC 1 #ST02 OCT 0,0,0 SLAVE-STREAM 02 LIST. SPC 1 #ST03 OCT 0,0,0 SLAVE-STREAM 03 LIST. SPC 1 #ST04 OCT 0,0,0 SLAVE-STREAM 04 LIST. SPC 1 #ST05 OCT 0,0,0 SLAVE-STREAM 05 LIST. SPC 1 #ST06 OCT 0,0,0 SLAVE-STREAM 06 LIST. SPC 1 #ST07 OCT 0,0,0 SLAVE-STREAM 07 LIST. SPC 1 #ST08 OCT 0,0,0 SLAVE-STREAM 08 LIST. SPC 1 #ST09 OCT 0,0,0 SLAVE-STREAM 09 LIST. SPC 1 #ST10 OCT 0,0,0 SLAVE-STREAM 10 LIST. SPC 1 * NEW ENTRY: ...#STXX OCT 0,0,0..................SLAVE-STREAM XX LIST. SPC 1 * RFA OVERFLOW FILE SPECIFICATIONS: SP!C 1 NOVSC NOP NUMBER OF SECTORS IN FILE. NOP TRACK ADDRESS OF START OF FILE. NOP SECTOR ADDRESS OF START OF FILE. NOP NUMBER OF SECTORS PER TRACK. NOP LOGICAL UNIT OF OVERFLOW FILE CARTRIDGE. #RFSZ NOP MAXIMUM NUMBER OF 'OPEN' RFA FILES. #RXCL NOP 'RFAEX' CLASS NUMBER. * #PLOG NOP PARMB LOGGING PROGRAM'S CLASS NO. #QLOG NOP CLASS NO. FOR SPECIAL Q ERROR LOGGING #PRMY NOP DVR65 FLAG: #0-PRIMARY, =0-SECONDARY. * #NCLR ABS #TBRN-* NEGATIVE NO: LOCATIONS 'LSTEN' CLEARS. * OVFLA DEF NOVSC ADDRESS OF OVERFLOW-FILE SPECIFICATIONS. SKP * INITIALIZATION SECTION: RTE-II/III SETUP & VALIDITY CHECKING. * * NOTE: THIS CODE IS USED ONLY UPON INITIAL ENTRY. * IT IS OVERLAYED BY THE SYSTEM SPECIFICATIONS. * ORG #TBRN CODE RESIDES IN SYSTEM DATA AREA. * CONFG NOP ENTRY/EXIT: INITIALIZATION ROUTINE. LDB XEQT GET THE CALLER'S I.D. SEGMENT ADDRESS. ADB P12 POINT TO THE FIRST NAME SPECIFICATION. LDA B,I GET CHARACTERS 1 & 2. CPA "LS" IF THE CHARACTERS ARE "LS", INB,RSS ADVANCE THE POINTER & CONTINUE; JMP ERR01 ELSE, DENY THE ACCESS! LDA B,I GET CHARACTERS 3 & 4. CPA "TE" IF THE CHARACTERS ARE "TE", INB,RSS ADVANCE THE POINTER & CONTINUE; JMP ERR01 ELSE, DENY THE ACCESS! LDA B,I GET CHARACTER #5. AND DSMSK ISOLATE THE CHARACTER IN UPPER BYTE. CPA "N0" IF THE CHARACTER IS "N0", THEN THIS RSS IS : ACCESS IS LEGAL! JMP ERR01 DENY ILLEGAL ACCESS! LDA XEQT GET I.D. SEGMENT ADDRESS OF . STA VALID SAVE FOR S.A.M. VALIDITY CHECKING. * LDA BPA1 IF THE FIRST WORD OF BASE PAGE CPA P2 IS =2, THEN THIS IS A DMS SYSTEM, RSS AND THE CODE MUST BE MOD"$"IFIED; ELSE, JMP RTE2X CLEAR PATHS TO DMS CODE AND EXIT. * DLD XLABI GET BOTH PARTS OF 'XLA B,I' INSTRUCTION. DST GETID CONFIGURE I.D. SEGMENT INSTRUCTION. DST MVW CONFIGURE MOVE-WORDS INSTRUCTION. DST GTAG1 CONFIGURE FIRST TIME-TAG INSTRUCTION. LDA XLBIN GET MACRO ONLY: 'XLB B,I' INSTRUCTION. DST GTAG2 CONFIGURE SECOND TIME-TAG INSTRUCTION. JMP DMSEX BYPASS PATH-CLEARING INSTRUCTIONS. * RTE2X CLA CLEAR ALL STA DMS1 PATHS TO STA DMS2 THE DMS STA DMS3 MAP-PROCESSING STA DMS4 INSTRUCTIONS. * DMSEX CLA PREVENT FURTHER CALLS TO STA INIT THE INITIALIZATION ROUTINE. JMP CONFG,I RETURN TO NORMAL PROCESSING. * SKP P12 DEC 12 "LS" ASC 1,LS "TE" ASC 1,TE "N0" OCT 47000 XLABI XLA B,I XLBIN XLB B,I * A EQU 0 B EQU 1 BPA1 EQU 1742B XEQT EQU 1717B SPC 1 ORR [ INDICATES SIZE OF ] SPC 1 END $ >W 91700-18130 1605 S 0122 DS1/B CCE MODULE: QUEUE              H0101 ^ASMB,R,L,C HED QUEUE 91700-16130 REV A 760127 * (C) HEWLETT-PACKARD CO. 1976 NAM QUEUE,1,2 91700-16130 REV.A 760127 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT QUEUE EXT EXEC,RNRQ,#GRPM,#QRN,#BUSY,#QCLM,#CLWT IFZ EXT DBUG XIF * * * QUEUE * SOURCE: 91700-18130 * BINARY: 91700-16130 * PRGMR: BOB SHATZER * DATE: 27 JAN 76 * * * * QUEUE IS THE DS-1 PROGRAM WHICH IS SCHEDULED BY A 'REQUEST * COMING' BEING RECEIVED BY DVR65. QUEUE FIRST CHECKS FOR THE * VALIDITY OF THE INTERRUPT. IF IT IS NOT FROM AN INITIALIZED * DVR65 CHANNEL OR IF IT IS A SPURIOUS INTERRUPT FROM ANOTHER * I/O SLOT, THE INTERRUPT WILL BE IGNORED. QUEUE THEN * DETERMINES THE LU AND SELECT CODE OF THE INTERRUPTING * CHANNEL AND DOES A RESOURCE NUMBER LOCK ON THE LINE RN * TO PREVENT CONTENTION PROBLEMS. THE INCOMING REQUEST IS * THEN READ TO GRPM'S I/O CLASS. * * * ERRORS: THE FOLLOWING ERROR CONDITIONS CAN OCCUR: * * 1. INTERRUPT NOT FROM DVR65 - IGNORE IT * 2. INTERRUPT NOT FROM INITIALIZED COMM LINE - CLEAR THE * DRIVER * 3. INTERRUPT FROM NON-EXISTANT LU - IGNORE IT * 4. BAD LRN - CLEAR THE DRIVER AND DOWN THE EQT * 5. GRPM'S CLASS IS BAD - REPORT CATASTROPHIC ERROR * 6. NOT ENOUGH SYS. AVAIL. MEM. - SEND STOP * * ALL ERROR PROCESSING IS DONE BY THE DISC-RESIDENT MODULE * 'QCLM'. QUEUE WRITES THE NECESSARY ERROR INFORMATION TO * QCLM'S I/O CLASS AND GOES ABOUT IT'S BUSINESS. THIS IS DONE * TO INCREASE THRUPUT THROUGH THE QUEUEING MODULES ACND TO * DECREASE THE REQUIREMENTS FOR A LARGE FOREGROUND CORE- * RESIDENT AREA. * SKP QUEUE STB EQT4 SAVE EQT 4 ADDRESS FROM DRIVER LDA B,I GET SCHEDULE PARAMETER IFZ CPA D99 IS IT 99? RSS JMP Q.1 NO - NORMAL SCHEDULE CALL JSB DBUG CALL DBUG DEF *+1 JMP EXIT EXIT WHEN DONE WITH DBUG XIF Q.1 AND B77 IF NORMAL SCHEDULE, PICK UP SELECT CODE STA SCODE AND SAVE IT LOCALLY ALF,ALF ROTATE SELECT CODE TO UPPER BYTE STA CHANL AND SAVE IT IN QCB INB BUMP POINTER TO EQT 5 LDA B,I GET EQT 5 ALF,ALF ROTATE AND B77 AND ISOLATE EQUIP TYPE CPA B65 IS INTERRUPT FROM DVR65? RSS YES JSB ERR0 NO - IGNORE IT ADB D8 INDEX TO EQT 13 ADDRESS LDA B,I GET EQT EXTENSION ADDRESS LDA A,I GET LRN FROM EXTENSION SZA,RSS IS DRIVER INITIALIZED? JSB ERR1 NO - ILLEGAL INTERRUPT STA LRN GOOD RN - SAVE IT * CLB LDA EQTA GET FWA EQT AREA CMA,INA MAKE IT NEGATIVE ADA EQT4 ADD THE ADDRESS OF EQT4 DIV D15 DIVIDE BY 15 TO GET EQT # INA BUMP BY ONE STA EQT# AND SAVE EQT NUMBER * CLB,INB SET UP B AS LU COUNTER LDA DRT GET FWA DRT STA TEMP AND SAVE IN TEMPORARY LOCATION NEXT LDA TEMP,I GET DRT ENTRY AND B77 MASK OFF EQT # CPA EQT# IS THE THE RIGHT ONE? JMP FOUND YES - PROCEED ISZ TEMP NO - GO TRY AGAIN CPB LUMAX ALL LU'S CHECKED? JSB ERR0 YES - IGNORE INTERRUPT INB NO - BUMP LU COUNTER JMP NEXT AND TRY AGAIN * FOUND STB LU FOUND A VALID LU - SAVE IT LDA CHANL GET CHANNEL FROM QCB IOR LU STUFF IN THE LU STA CHANL AND SA$VE IT AWAY LDA #GRPM GET GRPM'S CLASS NUMBER FROM RES STA GRPM AND SAVE IT LOCALLY * JSB RNRQ DO AN RN LOCK ON THE LRN DEF *+4 DEF LGNW LOCK GLOBAL,NO WAIT,NO ABORT DEF LRN DEF EQT4 JSB ERR2 ERROR RETURN * JSB EXEC READ THE REQUEST TO GRPM'S CLASS DEF *+8 DEF D17I DEF LU DEF ZERO DEF D35 DEF LU DEF SCODE DEF GRPM JSB ERR3 HERE IF CLASS READ FAILS * LDA #BUSY GET # OF TCB'S COUNTER SZA ANY ACTIVE TCB'S? JMP EXIT YES - DO NORMAL EXIT JSB RNRQ IF NONE, HANG ON #QRN - THIS IS DEF *+4 A QUIESCENT CONDITION DEF GLCW DEF #QRN DEF EQT4 JSB ERR0 ERROR RETURN EXIT JSB EXEC TERMINATE QUEUE DEF *+2 DEF D6 * SKP * * ERROR PROCESSING SECTION * ERR0 NOP HERE TO GIVE UP AND TERMINATE DST REGS SAVE REGISTERS IN QCB CLA SET QCB CONTROL WORD TO ZERO LDB ERR0 PICK UP ORIGINATION ADDRESS JMP ERRN AND GO TO GENERAL ERROR PROCESSOR * ERR1 NOP HERE TO CLEAR DRIVER DST REGS LDA B10 LDB ERR1 JMP ERRN * ERR2 NOP HERE TO CLEAR AND DOWN EQT DST REGS LDA B30 LDB ERR2 JMP ERRN * ERR3 NOP HERE TO REPORT CATASTROPHIC ERROR DST REGS LDA BIT15 LDB ERR3 * ERRN STA QCB SAVE CONTROL WORD ADB M1 SUBTRACT 1 FROM ERROR ADDRESS STB ERRAD AND SAVE IT IN THE QCB JSB #CLWT WRITE QCB TO QCLM DEF *+6 DEF #QCLM DEF QCB DEF D7 DEF XEQT DEF ZERO NOP ERROR RETURN JMP EXIT AND GO TERMINATE * SKP * * CONSTANTS AND STORAGE * A EQU 0B B EQU 1B LUMAX EQU 1653B DRT EQU 1652B EQTA EQU 1650B XEQT EQU 1717B } * IFZ D99 DEC 99 BSS 30 ** TEMPORARY PATCH AREA FOR DEBUG ** XIF EQT4 NOP TEMP NOP EQT# NOP GRPM NOP B77 OCT 77 B65 OCT 65 D8 DEC 8 LRN NOP D15 DEC 15 M1 DEC -1 LGNW OCT 140002 GLCW OCT 040006 D17I ABS 100000B+17 D35 DEC 35 D6 DEC 6 D7 DEC 7 B10 OCT 10 B30 OCT 30 LU NOP SCODE NOP BIT15 OCT 100000 QCB NOP QCB - DO NOT REORDER THESE SEVEN WORDS ZERO NOP DUMMY PARAMETER NOP DUMMY PARAMETER CHANL NOP REQUESTING LU AND SELECT CODE ERRAD NOP ERROR ADDRESS POINTER REGS NOP REGISTER STORAGE AREA NOP * END QUEUE  ?H 91700-18131 1551 S 0122 DS1/B CCE MODULE: FLOAD              H0101 <ASMB,L,R,C HED FLOAD 91700-16131 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM FLOAD,7 91700-16131 REV A 751219 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ********************************************** * *FLOAD SUBROUTINE TO DO FORCED DOWN LOADS * *SOURCE PART #: 91700-18131 REV A * *REL PART # 91700-16131 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 8-23-74 * *MODIFIED BY: JEAN-PIERRE D. BAUDOUIN * *DATE MODIFIED: DEC 1975 * *********************************************** SPC 1 SUP * EXT D65MS,.ENTR,.DFER,D65AB SPC 1 ENT FLOAD SPC 1 A EQU 0 B EQU 1 SPC 1 * * CALLING SEQUENCE * JSB FLOAD * DEF *+4 OR *+5 * DEF PROGRAM FILE NAME * DEF DESTINATION LOGICAL UNIT * DEF ERROR CODE * DEF OPTIONAL 3 WORD MESSAGE BUFFER SPC 2 FNAM NOP FLU NOP FERCD NOP FERMG NOP FLOAD NOP JSB .ENTR DEF FNAM * LDA FLU,I GET THE COMM. LU AND B77 SET FOR REQ ONLY STA FLU * LDA FERMG STA ERMOV SAVE FOR LATTER MOVE LDB FLOAD GET CALLING ADDRESS ADB M5 GET BACK TO ADD WHO CALLED SZA OPTIONAL PRAM SUPPLIED? ADB M1 YES...TAKE IT INTO ACCOUNT STB ERADD SAVE FOR MSTR CALL LDA D8 GET STREAM TYPE STA STRM SAVE STREAM TYPE LDA BT150 SET BITS 0 AND 15 (FOR LO COMMAND) CLB DST FLGWD SET FLAG WORDS JSB .DFER MOVE NAME INTO PARMB DEF FNAME DEF FNAM,I * JSB D65MS CALL MSTER TO SEND REQ DEF *+7 DEF B2 WRITE DEF FLU CONTROL FOR REQ ONLY DEF STRM PARMB DEF D35 LENGTH OF PARMB DEF DUMMY DEF DUMMY JMP LNERR LINE ERROR LDA FNAME GET ERROR RETURN STA FERCD,I AND SAVE FOR USER LDA FERMG SEE IF WE MOVE OPTIONAL NAME SZA,RSS JMP FLOAD,I NO JSB .DFER MOVE NAME ERMOV NOP DEF ERNM JMP FLOAD,I RETURN SPC 3 LNERR DST ERMS SAVE ERROR MESSAGE FROM A & B REG. CPA ASDS IS IT A "DSXX"ERROR ? JMP DSER YES LDB MSER NO, SYSTEM ERROR, ABORT THE USER LDA ERADD GET MESSAGE @ AND ERROR @ JSB D65AB WE DO NOT RETURN FROM THIS JSB * * WE WILL DECODE THE XX PART OF THE ERROR MESSAGE * AND MAP IT AS A NEGATIVE ERROR CODE FOR THE USER * DSER LDA ERMS+1 GET THE XX PART AND B17 GET VALUE OF THE LS DIGIT STA LCHAR SAVE LDA ERMS+1 GET VALUE AGAIN ALF,ALF SWAP CHARACTERS AND B17 GET UPPER CHARATERS VALUE MPY D10 WEIGHT IT ADA LCHAR WE NOW HAVE THE ERROR # CMA,INA MAKE IT <0 ADA DM46 MAP IT STA FERCD,I PASS IT TO THE USER * LDA FERMG IF THE USER WANTS IT WE WILL PASS HIM SZA,RSS THE ERROR MESSAGE JMP FLOAD,I HE DOES NOT WANT IT, RETURN DLD ERMS GET THE MESSAGE DST FERMG,I PASS IT ISZ FERMG ISZ FERMG STEP TO LAST WORD LDA BLNK GET AN ASCII DOUBLE BLANK STA FERMG,I PASS IT JMP FLOAD,I RETURN SPC 3 D8 DEC 8 D10 DEC 10 BT150 OCT 100001 B2 DEC 2 D35 DEC 35 M5 DEC 5 M1 DEC -1 DM46 DEC -46 B77 OCT 77 B17 OCT 17 DUMMY NOP LCHAR NOP MSER DEF ERMS ERMS NOP BLNK ASC 1, ASDS ASC 1,DS ERADD NOP  SPC 1 STRM NOP NOP CLASS # HERE BSS 3 FLGWD NOP NOP FNAME BSS 1 ERNM BSS 2 ASC 1, BSS 24 MAKE THE PARMB 35 WORDS LONG END ܙ @H 91700-18132 1608 S 0122 DS1/B CCE MODULE: DMESS              H0101 WASMB,L,R,C HED DMESS 91700-16132 REV.A 760216 * (C) HEWLETT-PACKARD CO. 1976 NAM DMESS,7 91700-16132 REV.A 760216 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DMESS EXT D65MS,MESSS,.ENTR * * * DMESS * SOURCE: 91700-18132 * BINARY: 91700-16132 * PRGMR: BOB SHATZER * DATE: 09 DEC 75 * * MODIFIED BY: C.C.H. 02-16-76 * * DMESS IS A UTILITY SUBROUTINE WHICH IS USED TO SEND OPERATOR * COMMANDS TO A REMOTE CPU. * * CALLING SEQUENCE: * * JSB DMESS * DEF *+4 * DEF * DEF * DEF (IN + BYTES) * * * ON RETURN, THE REGISTERS HAVE THE FOLLOWING MEANING: * * = 0 NO RESPONSE FROM REMOTE * < 0 NEGATIVE OF NUMBER OF BYTES IN RESPONSE * = -1 INDICATES AN ILLEGAL REQUEST LENGTH (>19 BYTES) * * DLU NOP DESTINATION LU BUFAA NOP MESSAGE BUFFER BUFLA NOP MESSAGE LENGTH DMESS NOP START OF ROUTINE JSB .ENTR DEF DLU GET PRAMS LDA DLU,I GET REQUESTED LU CCE,SZA,RSS IS IT LOCAL? JMP LOCAL YES - SEND IT LOCALLY RAL,ERA SET SIGN-BIT FOR ERROR RETURN. STA DLU SAVE LU# AND ERROR-FLAG, LOCALLY. LDA D7 REMOTE - GET STREAM TYPE STA PARMB AND PUT IT INTO PARMB LDA BUFLA,I GET REQUEST LENGTH STA LNGH STORE IT INTO PARMB STA BUFL1 AND SAVE IT FOR COUNTER LDA BUFAA GET BUFFER ADDRESS LDB MESSA GET DESTINATION ADDRESS eQ JSB MOVE MOVE BUFFER BUFL1 NOP LENGTH GOES HERE SPC 1 JSB D65MS WRITE REQUEST TO REMOTE DEF *+7 DEF D2 DEF DLU DEF PARMB DEF D35 DEF DUMMY DEF DUMMY JMP MSERR ERROR RETURN POINT LDA LNGH ANY RETURN MESSAGE? SZA,RSS JMP DMESS,I NO RETURN MESSAGE STA BUFL2 SAVE LENGTH AS POSITIVE BYTES. LDA MESSA GET ADDRESS OF MESSAGE TO BE RETURNED LDB BUFAA GET ADDRESS OF USER'S BUFFER. JSB MOVE GO TRANSFER RESPONSE TO USER'S BUFFER. BUFL2 NOP LDA LNGH GET LENGTH OF MESSAGE CMA,INA JMP DMESS,I AND RETURN SPC 2 LOCAL JSB MESSS HERE IF LOCAL MESSAGE DEF *+3 DEF BUFAA,I DEF BUFLA,I JMP DMESS,I AND RETURN * MSERR DST BUFAA,I SAVE ERROR CODES FOR USER'S ANALYSIS. LDA D4 RETURN WITH = -4, AND = -1, CMA,INA,RSS TO INDICATE 4-BYTE ERROR-CODE MESSAGE. * SZERR CLA BUFFER SIZE ERROR - CLEAR A CCB AND SET B TO -1 JMP DMESS,I AND RETURN SPC 2 * * SUBROUTINE TO MOVE BUFFERS * CALLING SEQUENCE * JSB MOVE * DEC +# OF BYTES * A REG=SOURCE ADDRESS * B REG=DESTINATION ADDRESS * MOVE NOP STA MOVEA SAVE SOURCE ADDRESS LDA MOVE,I GET LENGTH SZA,RSS IS LENGTH ZERO? JMP SZERR YES - BUFFER SIZE ERROR ADA MXSIZ ADD MAXIMUM BUFFER SIZE SSA,RSS DID IT OVERFLOW? JMP SZERR YES - BUFFER SIZE ERROR LDA MOVE,I NO - GO MOVE DATA CLE,ERA CONVERT TO WORD LENGTH SEZ ODD? INA YES CMA,INA NEGATE FOR DOWN COUNT STA MOVE,I SAVE FOR DOWN COUNTER MOVE1 LDA MOVEA,I STA B,I INB ISZ MOVEA ISZ MOVE,I DONE? JMP MOVE1 NO...CONTINUE ISZ MOVE JMP MOVE,I AND j RETURN * B EQU 1 DUMMY NOP MOVEA NOP MXSIZ DEC -36 MESSA DEF PARMB+6 D7 DEC 7 D2 DEC 2 D4 DEC 4 D35 DEC 35 PARMB BSS 35 LNGH EQU PARMB+5 * END  AI 91700-18133 1612 S 0122 DS1/B CCE MODULE: DMESG              H0101 QASMB,R,L,C HED DMESG 91700-16133 REV A * (C) HEWLETT PACKARD CO. 1976 NAM DMESG,7 91700-16133 REV A 760318 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************** * *DMESG TELLOP MESSAGE SUBROUTINE * *SOURCE PART # 91700-18133 * *REL PART # 91700-16133 * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 7-30-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: DEC 1975 * ********************************************************* SPC 1 * * LIBRARY SUBROUTINE APPENDED TO RTE USER * PROGRAM FOR SENDING MESSAGES TO SATELLITE STATION * OPERATOR CONSOLE (LU 1). * * CALLING SEQUENCE: * JSB DMESG * DEF *+4 * DEF COMMUNICATION LU * DEF BUFFER * DEF BUFFER LENGTH * * * SPC 3 ENT DMESG * EXT DEXEC,.ENTR * A EQU 0 * * GET MESSAGE ADDRESS AND LENGTH. * LU NOP BUFAD NOP BUFL NOP DMESG NOP JSB .ENTR GET PRAM ADDRESS DEF LU LDA BUFL,I GET LENGTH CMA,INA SET FOR DOWN COUNTER STA CNT SZA,RSS MAKE SURE NOT ZERO JMP DMESG,I RETURN IF ZERO ADA D37 TEST FOR LENGTH GREATER THAN 37 WORDS SSA JMP DMESG,I RETURN TO ERROR RETURN IF SO * * MOVE MESSAGE TO INTERNAL BUFFER.g   * LDA DFOUT STA TEMP * LOOP LDA BUFAD,I STA TEMP,I ISZ BUFAD ISZ TEMP ISZ CNT JMP LOOP * LDA BUFL,I ADJUST BUFFER LENGTH. ADA B3 STA BUFL * LDA LU,I GET THE COM. LU LDB D2 GET DEXEC CODE RAL,CLE,SLA,ERA IS SIGN BIT SET (STRIP IT) LDB D2I YES, SET FOR NO ABORT CALL TO DEXEC STB CNWD SAVE FOR CALL STA LU SAVE * * SEND THE MESSAGE WITH ID PREFIX. * JSB DEXEC DEF *+6 DEF LU DEF CNWD DEF B1 DEF OUTBF DEF BUFL * JMP DMESG,I RETURN TO CALLER (ERR RTRN IF LU HAD BIT15) ISZ DMESG SET FOR OK RETURN JMP DMESG,I RETURN SPC 2 * * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 D2 DEC 2 D2I OCT 100002 B3 OCT 3 D37 DEC 37 CNT NOP TEMP NOP DFOUT DEF OUTBF+3 OUTBF ASC 3,=S00: BSS 37 CNWD NOP * SIZE EQU * * END   BI 91700-18134 1603 S 0122 DS1/B CCE MODULE: DLK65              H0101 4ASMB,R,L,C HED DLK65 - DVR65 FTN4 LINK SUBR * (C) HEWLETT-PACKARD CO. 1976 * NAM DLK65,7 91700-16134 REV A 760113 ENT DLK65 EXT D65CL,.ENTR,D65AB * * NAME: DLK65 * SOURCE: 91700-18134 * RELOC: 91700-16134 * PGMR: D.J.G. (01-13-76) * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * .IRW NOP .ILU NOP .DBUF NOP .DLNT NOP .RQBF NOP .RQLN NOP .MODE NOP DLK65 NOP JSB .ENTR DEF .IRW * LDA .ILU,I GET LU STA NABRT SAVE AS NO-ABORT FLAG RAL,CLE,ERA STRIP SIGN BIT STA .ILU SAVE STRIPPED LU LDB DLK65 SET UP ERROR REPORT ADDRESS ADB DM6 LDA .MODE IF FEWER THAN 7 PRAMS, IT'S GOTTA SZA,RSS BE A MODE 2 CALL. ELSE MODE 0 JMP MODE2 * ADB DM2 (ERROR REPORT ADDRESS) STB ERRAD * LDA .MODE,I SZA MODE MUST BE 0!!! JMP ERR * CLA,INA SET UP CONWD FOR D65CL CALL LDB .IRW,I SLB,RSS SEND DATA? INA YES, SET MODE IN CONWD = 2 ALF,RAL POSITION MODE BITS TO 6-8 RAL IOR .ILU INCLUDE LU # IOR ZBIT SET Z-BIT STA CONWD * JSB D65CL CALL D65CL DEF *+7 DEF .IRW,I DEF CONWD DEF .RQBF,I DEF .RQLN,I DEF .DBUF,I DEF .DLNT,I JMP ERRTN ERROR RETURN * EXIT CLA RE-SET ADDRESSES FOR NEXT CALL STA .MODE JMP DLK65,I RETURN * * SKP * * * MODE-2 REQUESTS * MODE2 STB ERRAD (ERROR REPORT ADDRESS) LDA .RQBF,I GET MODE VALUE  . MUST = 2!!! CPA TWO RSS JMP ERR LDA .ILU SET UP CONWD FOR D65CL CALL STA CONWD * JSB D65CL CALL D65CL DEF *+7 DEF .IRW,I DEF CONWD DEF .DBUF,I DEF .DLNT,I DEF * DUMMY PARAM DEF * DUMMY PARAM JMP ERRTN ERROR RETURN POINT JMP EXIT * * TWO DEC 2 CONWD NOP NABRT NOP NO-ABORT FLAG ZBIT OCT 10000 ERRAD NOP DM6 DEC -6 DM2 DEC -2 * * ERRTN STA EMSG HERE FOR ERROR RETURN STB EMSG+1 LDA NABRT GET NO-ABORT FLAG SSA NO-ABORT FLAG SET? JMP EXIT YES, RETURN TO CALLER ERR LDA ERRAD SET UP ERROR CALL LDB EMSGA TO 'D65AB' JSB D65AB JMP DLK65,I (JUST IN CASE) * EMSGA DEF EMSG EMSG ASC 2, * A EQU 0 B EQU 1 END U  CJ 91700-18135 1614 S 0122 DS1/B CCE MODULE: D65MS              H0101 6ASMB,R,L,C HED MASTER REQUEST INTERFACE * (C) HEWLETT-PACKARD CO. 1976* * NAM D65MS,7 91700-16135 REV.A 760331 SPC 1 ENT D65MS SPC 1 EXT .ENTR,#RSAX,$TIME,#MSTO,#QRN,#WAIT EXT EXEC,D65CL,D65AB,DRTEQ,RNRQ,#TBRN,#PLOG * * NAME: D65MS * SOURCE: 91700-18135 * RELOC: 91700-16135 * PGMR: C.C.H. [ 03/31/76 ] * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * D65MS PROVIDES THE MASTER REQUESTOR WITH AN INTERFACE TO THE * COMMUNICATIONS NETWORK, WHICH GUARDS AGAINST CONFLICTING * REQUESTS FROM OTHER USERS WHO MAY ATTEMPT TO GAIN ACCESS TO * THE SAME COMMUNICATION PATH. * * D65MS OPERATION: * 1. GET USER-SUPPLIED PARAMETERS. * A. FORM ERROR-REPORT ADDRESS =JSB D65MS, IF [ERRAD] NOT SUPPLIED. * B. SET ERROR-RETURN FLAG IF CONWD PARAMETER BIT#15 =1. * C. ISOLATE & REMOVE NO-WAIT BIT(#10) & BLIND REQUEST BIT(#9) IN CONWD. * D. ADD MASTER-REQUEST BIT(#9) TO CONTROL WORD. * E. SAVE FLAG WORD WITH ERROR-RETURN BIT(#15), NO-WAIT BIT(#1), * AND BLIND REQUEST BIT(#0). * 2. CHECK <#QRN> IN 'RES': * A. IF IT IS ZERO, THEN DS1 SYSTEM IS SHUT DOWN; ERROR: "DS00". * B. IF IT IS NON-ZERO, THEN VALUE IS A RESOURCE NUMBER, WHICH MUST BE * CHECKED FOR AVAILABILITY. LOCK & CLEAR THE RN, BEFORE PROCEEDING. * C. IF IT IS ALREADY LOCKED, THEN THE SYSTEM HAS BEEN MADE * QUIESCENT--WAIT FOR UN-LOCK BEFORE PROCEEDING. * D. IF IT IS UN-LOCKED, THEN PROCEED WITH THE RN CLEARED. * E. IF #QRN IS NOW =0, THEN SYSTEM HAS BEEN CHANGED FROM QUIESCENT * TO SHUT-DOWN STATE. RETURN WITH ERROR: "DS00". * 3. GET EQT EXTENSION ADDRESS FOR EQT ASSOCIATED WITH SPECIFIED LU. * A. SAVE EQT EXTENSION ADDRESS FOR USE BY 'D65CL'. * 4. IF BLIND REQUEST, THEN NO NEED TO CHECK REPLY LENGTH-GO TO 5.; ELSE, * CHECK FOR MINIMUM LENGTH =35 WORDS; <35: ERROR: "DS06". * 5. GET CLASS NUMBER FROM RTE FOR USE IN RECEIVING REPLY * VIA QUEUE--WAIT IF UNAVAILABLE. * 6. ADD FRIENDLY SATELLITE BIT(#11) TO FIRST WORD OF PARMB. * 7. PUT MASTER CLASS NO. IN WORD #2 OF PARMB, FOR LATER USE * BY QUEUE, IN FORWARDING THE REPLY. * 8. PUT CURRENT SYSTEM TIME IN WORDS #34 & #35 OF PARMB, AND * IN LOCAL STORAGE. TIME-TAG IS USED TO UNIQUELY IDENTIFY * THE REPLY AS THE EXPECTED REPLY. SKP * 9. WAIT FOR AVAILABILITY OF TABLE-ACCESS RN (#TBRN) BEFORE * BUILDING A MASTER REQUESTOR CONTROL TABLE ENTRY; START MASTER TIMER, * UNLESS CONWD BIT#9 =1 (BLIND REQUEST). * 10. GO TO 'D65CL' TO FORWARD THE REQUEST, VIA THE COMM. LINE. * A. IF #PLOG #0, WRITE PARMB TO PARMB LOGGER'S CLASS NO. * 11. IF BLIND REQUEST, RETURN NOW; ELSE, DO A CLASS GET TO AWAIT REPLY. * 12. CHECK THE REPLY: * A. ZERO LENGTH =TIMEOUT (COURTESY OF 'UPLIN'). * B. AT LEAST 35 WORDS (PARMB SIZE) ARE EXPECTED; ELSE, "DS03" ERROR! * C. SAME TIME-TAG MUST BE RETURNED; ELSE, THIS IS A LATE * OR IMPROPER REPLY, AND IS IGNORED: GO TO 11. * D. IF BUSY-REPLY(WORD#1,BIT#13=1) RECEIVED FROM A QUIESCENT * REMOTE, THEN CHECK 'FLAGS' FOR THE NO-WAIT BIT(#1). * E. IF NO-WAIT & ERROR-RETURN BITS SET, THEN RETURN VIA * WITH &="DS08"; ELSE, GO TO 'D65AB' WITH REGISTERS ="DS08". * F. IF NO-WAIT BIT CLEAR, THEN PLACE PROGRAM IN TIME LIST FOR A * PERIOD OF SECONDS, AS SPECIFIED BY <#WAIT> IN 'RES'. * G. AFTER THE DELAY, RE-SUBMIT THE REQUEST (GO TO 2.). * 13. CHECK FOR A REPLY FROM AN ILLEGAL REQUEST; IF ILLEGAL: "DS03" ERROR! * 14. RETURN THE CLASS NUMBER TO THE SYSTEM. * 15. CLEAR THE MASTER REQUESTOR CONTROL TABLE ENTRY. * 16. RETURN TO THE CALLER AT , WITH DVR65 INFO IN &. * * D65MS CALLING SEQUENCE: * * JSB D65MS * DEF *+7 [OR *+8] * DEF RCODE DRIVER REQUEST CODE * DEF CONWD CONTROL WORD/ERROR-RETURN FLAG (BIT#15). * DEF RQBUF REQUEST BUFFER ADDRESS. * DEF RQLEN REQUEST LENGTH. (MINIMUM SIZE =35 WORDS) * DEF DABUF DATA BUFFER ADDRESS OR DUMMY PARAMETER. * DEF DALEN DATA BUFFER LENGTH OR DUMMY PARAMETER. * [DEF ERRAD] [OPTIONAL ADDRESS FOR ERROR-REPORT PRINTOUT.] * RETURN HERE UPON ERROR DETECTION. * NORMAL RETURN HERE, UPON COMPLETION. * * * CONWD DESCRIPTION: * * BIT#15 - ERROR-RETURN FLAG (SEE D65MS ERROR PROCESSING: ITEM #1). * BITS#14,13 - RESERVED FOR USE BY 'RTE'. * BIT#12 - 'Z' BIT (DOUBLE BUFFER, AS DESCRIBED IN RTE MANUAL). * BIT#11 - RESERVED FOR USE BY 'RTE'. * BIT#10 - NO-WAIT (SEE D65MS OPERATION: ITEMS #12.D THRU #12.G). * BIT#9 - BLIND REQUEST: NO REPLY EXPECTED, AT THIS TIME. * BITS#8,7,6 - REQUEST TYPE (MODE): 0 - REQUEST ONLY * 1 - SEND REQUEST & READ DATA * 2 - SEND REQUEST & SEND DATA * 3 - READ OR SEND DATA ONLY * BITS#5-#0 - LOGICAL UNIT NO. OF COMMUNICATION LINE INTERFACE. * * NOTE: BITS #9,10 -AS SPECIFIED BY THE USER- ARE REMOVED BY 'D65MS', * AND BIT #9 (MASTER REQUEST) IS SET, BEFORE CALLING 'D65CL'. SKP * * D65MS ERROR PROCESSING: * * 1. IF SIGN BIT(#15) OF LU PARAMETER IS SET, ASCII ERROR CODES * ARE SUPPLIED TO THE CALLER IN THE & REGISTERS, UPON * RETURN TO THE POINT IN THE CALLING SEQUENCE. * 2. IF THE SIGN BIT IS NOT SET, THEN THE ROUTINE 'D65AB' IS * CALLED TO ABORT THE CALLER'S PROGRAM, AFTER PRINTING AN * ERROR MESSAGE ON THxGE SYSTEM CONSOLE. THE MESSAGE PRINTED * WILL CONTAIN EITHER THE USER-SUPPLIED ERROR ADDRESS (ERRAD), * OR THE ADDRESS OF THE USER'S CALL TO 'D65MS'. * * D65MS ERROR MESSAGES: * * "DS00" - DS1 IS SHUT-DOWN! * * "DS01" - DVR65 DETECTED ERROR (PARITY, ETC.) - FROM 'D65CL'. * * "DS03" - ILLEGAL REPLY - SHORT PARMB. * * "DS04" - LOGICAL UNIT INVALID OR NO CLCT ENTRY. * * "DS05" - MASTER REQUEST TIMEOUT (COURTESY OF 'UPLIN'). * * "DS06" - ILLEGAL REQUEST. * * "DS07" - 'RES' TABLE-ACCESS ERROR. * * "DS08" - BUSY-REJECT FROM REMOTE [NO-WAIT SET OR RETRIES EXHAUSTED]. * * "IOXX" - \ * - RTE SYSTEM DETECTED ERRORS. * "RNXX" - / * * * SKP SUP [SUPPRESS EXTENDED LISTING] RCODA NOP REQUEST CODE ADDRESS. CONWD NOP CONTROL WORD ADDRESS. RQBUF NOP REQUEST BUFFER ADDRESS. RQLEN NOP REQUEST BUFFER LENGTH. DABUF NOP DATA BUFFER ADDRESS OR DUMMY PARAMETER. DALEN NOP DATA BUFFER LENGTH OR DUMMY PARAMETER. ERRAD NOP OPTIONAL ADDRESS OF ERROR-CAUSING CALL. SPC 1 D65MS NOP ENTRY/EXIT JSB .ENTR OBTAIN DIRECT ADDRESSES DEF RCODA FOR PARAMETERS & RETURN POINT. CLB CLEAR CLASS NUMBER STB CLASN FOR ERROR PROCESSOR. LDA ERRAD,I GET OPTIONAL ERROR-REPORT ADDRESS. STB ERRAD CLEAR PARAMETER FOR NEXT CALL. SZA DID USER SUPPLY AN ADDRESS? JMP STORA YES, GO TO SAVE IT. LDA D65MS NO. SET ERROR ADDRESS TO POINT ADA DM9 TO CALL TO 'D65MS'. STORA STA ERRA SAVE FOR POSSIBLE ERROR PROCESSING. * LDA CONWD,I GET THE CONTROL WORD. RAL,CLE,ERA MOVE THE ERROR-RETURN FLAG TO . STA B SAVE IN , TEMPORARILY. AND B3000 ISOLATE NO-WAIT & BLIND REQUEST BITS. SWP EXCHANGE & FOR BOOLEAN OPERATIONS. XOR B h REMOVE NO-WAIT & BLIND REQUEST BITS. IOR B1000 ADD THE MASTER-REQUEST FLAG (BIT#9). STA CONWD SAVE THE COMPLETE CONTROL WORD, LOCALLY. BLF,BLF POSITION NO-WAIT & BLIND REQUEST BITS ERB TO BITS #1,#0; ADD ERROR-RTN: BIT#15. STB FLAGS SAVE THE COMPLETE FLAG WORD. SPC 1 * CHECK FOR LOCAL SYSTEM SHUT-DOWN OR QUIESCENT STATUS. SPC 1 RETRY LDA #QRN GET THE QUIESCENT/SHUT-DOWN RN. SZA,RSS IS THE DS1 SYSTEM SHUT-DOWN? JMP DOWN YES. GO TELL CALLER THE SAD NEWS. SPC 1 * REQUESTS WILL BE FORCED TO WAIT HERE, IF LOCAL SYSTEM HAS BEEN QUIESCED. SPC 1 JSB RNRQ GO TO RTE TO CHECK FOR SYSTEM QUIESCENCE. DEF *+4 DEF LCGW LOCK/CLEAR/WAIT/NO-ABORT DEF #QRN CHECK SYSTEM-QUIESCENCE RESOURCE NUMBER. DEF TEMP DUMMY PARAMETER. JMP PASER * RTE ERROR - PASS CODE TO CALLER * * LDA #QRN IF QUIESCENT STATE HAS BEEN CHANGED SZA,RSS TO SYSTEM SHUT-DOWN STATE, JMP DOWN THEN TELL THE CALLER THE SAD NEWS. * SKP * LOCATE EQT ADDRESS TO GET DEVICE SELECT CODE & EXTENSION ADDRESS. SPC 1 JSB DRTEQ GO TO FIND EQT ADDRESS. DEF *+2 DEF CONWD RETURN INFO FOR THIS LOGICAL UNIT. * CPA M1 IF INVALID LU DETECTED, JMP LUERR * ERROR: "DS04" IS REPORTED. ADB P3 FORM EQT4 ADDRESS FROM EQT FWA IN . LDA B,I GET CONTENTS OF EQT4. AND B77 ISOLATE THE DEVICE SELECT CODE. STA SCODE SAVE FOR INSERTION INTO MRCT. INB POSITION TO EQT5 ADDRESS. LDA B,I GET CONTENTS OF EQT5. AND EQMSK ISOLATE THE EQUIPMENT TYPE-CODE. CPA TYP65 IS THIS LU LINKED TO DVR65? RSS YES. SKIP TO FIND THE EQT EXTENSION. JMP LUERR NO. * ERROR: "DS04" - INVALID LU! ADB P8 COMPUTE ADDRESS OF EQT13. LDB B,I GET A DIRECT RBL,CLE,SLB,ERB ADDRESS FOR THE JMP *-2 EQT EXTENSION. STB EXTAD SAVE FOR USE BY 'D65CL'. SPC 2 * CHECK FOR MINIMUM REPLY LENGTH OF 35 WORDS. SPC 1 LDA FLAGS GET 'FLAGS' FOR BLIND-REQUEST CHECK. SLA IF THIS IS A BLIND-REQUEST, THEN JMP GCLAS NO NEED TO CHECK REPLY LENGTH. LDA RQLEN,I GET REQUEST BUFFER LENGTH. ADA M35 IF NEGATIVE, OR <35 WORDS SSA WERE SPECIFIED, THEN JMP ILRQ THIS IS AN ILLEGAL REQUEST! SPC 2 * REQUEST A CLASS NUMBER ALLOCATION FROM RTE. SPC 1 GCLAS LDA BIT13 INITIALIZE CLASS NUMBER STA CLASN FOR NON-RELEASE USAGE. JSB EXEC GO TO RTE FOR A CLASS NO.--WAIT FOR IT. DEF *+5 DEF CLS19 CLASS CONTROL(QUICK ALLOCATE)-NO ABORT. DEF ZERO LU ='BIT BUCKET' FOR ALLOCATION. DEF ZERO DUMMY PARAMETER FOR ALLOCATION. DEF CLASN CLASS NUMBER STORAGE ADDRESS. JMP PASER * RTE ERROR: MESSAGE IN & * * JSB EXEC GO TO RTE TO COMPLETE DEF *+5 PREVIOUS ALLOCATION REQUEST. DEF CLS21 CLASS GET--NO ABORT. DEF CLASN CLASS NUMBER STORAGE ADDRESS. DEF ZERO DUMMY PARAMETER. DEF ZERO DUMMY PARAMETER. JMP PASER * RTE ERROR: MESSAGE IN & * * SKP * ADD FRIENDLY SATELLITE BIT(#11) TO FIRST WORD OF PARAMETER BUFFER. SPC 1 LDA BIT11 ADD THE LDB RQBUF FRIENDLY SATELLITE BIT(#11) IOR B,I TO THE FIRST WORD (STREAM,ETC.) STA B,I OF THE PARAMETER BUFFER (PARMB). SPC 1 * ADD CLASS NUMBER & LATE-REPLY TIME TAG TO PARMB. SPC 1 LDA CLASN GET MASTER CLASS NUMBER. STA MBUF+1 SAVE FOR MASTER REQUEST TABLE ENTRY. INB POINT TO 2ND WORD (MASTER CLASS NO.) STA B,I SAVE FOR REPLY (USED BY QUEUE). # ADB P32 POINT TO WORD #34 OF PARMB. STB TEMP SAVE TEMPORARILY. DLD $TIME GET CURRENT SYSTEM TIME. DST TEMP,I SAVE IN PARMB AND LOCAL STORAGE DST TAG FOR VALID REPLY RECOGNITION. SPC 1 * BUILD MASTER REQUESTOR LIST-ENTRY IN 'RES'. SPC 1 LDB FLAGS GET BLIND-REQUEST FLAG. LDA SCODE GET COMM. LINE SELECT CODE. ALF,ALF POSITION TO UPPER BYTE. SLB,RSS IF BLIND REQUEST, NO TIMER NEEDED--SKIP. IOR #MSTO INCLUDE TIMEOUT COUNT IN LOWER BYTE. STA MBUF SAVE IN FIRST WORD OF ENTRY BUFFER. LDA XEQT GET I.D. SEG. ADDRESS OF USER'S PROGRAM. STA MBUF+2 SAVE IN THIRD WORD OF ENTRY BUFFER. SPC 1 * WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE IN 'RES'; ADD NEW ENTRY. SPC 1 JSB RNRQ GO TO RTE TO CHECK THE TABLE-ACCESS RN. DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT FOR IT/NO ABORT. DEF #TBRN TABLE-ACCESS SPACE-AVAILABLE RN. DEF TEMP DUMMY PARAMETER. JMP PASER * RTE ERROR - PASS ERROR CODE TO USER * * JSB #RSAX GO TO 'RES' ACCESS ROUTINE. DEF *+5 DEF P1 ADD A MASTER ENTRY. DEF P1 SPECIFY MASTER LIST. DEF CLASN SEARCH FOR OLD ENTRIES, USING CLASS NO. DEF MBUF ADDRESS OF TABLE ENTRY DATA. SZA ANY ERRORS? JMP RESER * ERROR: "DS07" (NOT LIKELY). * SKP * CALL 'D65CL' TO COMMUNICATE VIA THE COMM. LINE. SPC 1 JSB D65CL GO TO COMM. LINE ACCESS ROUTINE. DEF *+8 DEF RCODA,I REQUEST CODE ADDRESS. DEF CONWD CONTROL WORD. DEF RQBUF,I REQUEST BUFFER ADDRESS. DEF RQLEN,I REQUEST BUFFER LENGTH ADDRESS. DEF DABUF,I DATA BUFFER ADDRESS OR DUMMY PARAMETER. DEF DALEN,I DATA BUFFER LENGTH OR DUMMY PARAMETER. DEF EXTAD ADDRESS OF EQT EXTENSION. JMP PASER * COMM. LINE ERROR: GO PROCESS * DST REG SAVE RETURN INFO FROM DVR65. * JSB PLOG GO TO CHECK FOR PARMB LOGGING REQUEST. * LDA FLAGS IF THIS WAS A SLA BLIND REQUEST (FLAGS BIT#0 =1), JMP BLIND GO TO CLEAN UP; ELSE, SPC 1 * DO A CLASS GET TO WAIT FOR A REPLY FOR THIS TRANSACTION. SPC 1 GETRP JSB EXEC GO TO RTE TO GET THE REPLY. DEF *+5 DEF CLS21 SPECIFY CLASS GET--NO ABORT. DEF CLASN SPECIFY MASTER CLASS NO.--NO RELEASE. DEF RQBUF,I SPECIFY REPLY ADDRESS. DEF RQLEN,I SPECIFY REPLY LENGTH. JMP PASER * RTE ERROR: GO TO PROCESS * SPC 1 * CHECK FOR PROPER REPLY. SPC 1 SZB,RSS CHECK FOR ZERO REPLY LENGTH. JMP MTOER * ZERO LENGTH: GO PROCESS TIMEOUT ERROR * ADB M35 WERE AT LEAST SSB 35 WORDS RETURNED? JMP RPLER * NO. REPLY ERROR "DS03" * LDB RQBUF GET REPLY BUFFER ADDRESS. ADB P33 POINT TO WORD #34. STB TEMP SAVE POINTER TEMPORARILY. DLD TEMP,I GET REPLY WORDS #34 & #35 (TIME TAG). CPA TAG IF FIRST TAG COMPARES, RSS SKIP TO CHECK SECOND; ELSE, JMP GETRP NOT EXPECTED REPLY; TRY AGAIN. CPB TAG+1 IF SECOND TAG COMPARES, RSS THEN THIS IS IT; ELSE, JMP GETRP NOT EXPECTED REPLY; TRY AGAIN. * SKP * CHECK FOR BUSY-REPLY FROM A REMOTE WHICH HAS BEEN MADE QUIESCENT. SPC 1 LDB RQBUF GET REPLY BUFFER ADDRESS. LDA B,I GET THE FIRST WORD OF THE REPLY. AND RPMSK ISOLATE REPLY-BIT(#14) & BUSY-BIT(#13). CPA RPMSK IS THIS A QUIESCENT-REJECT FROM REMOTE? RSS YES. SKIP TO PROCESS THE CONDITION. JMP RPLCK NO. CONTINUE WITH NORMAL PROCESSING. XOR B,I REMOVE THE REPLY & BUSY-REJECT BITS. STA B,I RESTORE THE FIRST WORD OF THE REQUEST. *  LDA FLAGS GET THE FLAG-WORD. AND P2 ISOLATE THE NO-WAIT BIT (#1). SZA CALLER WISH TO WAIT FOR THE REMOTE? JMP BZYER NO. TELL HIM IT'S UN-AVAILABLE. * JSB EXEC GO TO THE RTE 'EXEC' DEF *+6 IN ORDER TO PLACE DEF P12 INTO THE TIME-LIST, DEF ZERO THIS PROGRAM, FOR A PERIOD DEF P2 OF DELAY IN SECONDS, DEF ZERO (ONCE-ONLY) AS DETERMINED BY A DEF #WAIT NEGATIVE VALUE <#WAIT> IN 'RES'. * JSB CLNUP RETURN CLASS# AND CLEAR TABLE ENTRY; JMP RETRY THEN, RE-SUBMIT THE REQUEST. SPC 1 * CHECK FOR A REPLY FROM AN ILLEGAL REQUEST. SPC 1 RPLCK ADB P2 POSITION TO THIRD WORD. LDA B,I GET THE WORD. CPA "IL" IF IT IS ASCII "IL", THEN JMP ILRQ USER MADE AN ILLEGAL REQUEST ("DS06"). BLIND JSB CLNUP GO TO CLEAN UP BEFORE EXITING. SPC 1 * RETURN TO USER AT NORMAL RETURN POINT. SPC 1 DLD REG = DVR65 RETURN INFORMATION. ISZ D65MS SET EXIT POINTER FOR NORMAL RETURN. JMP D65MS,I RETURN TO THE CALLER. * SKP * SUBROUTINE TO RELEASE THE MASTER CLASS AND CLEAR THE MASTER-LIST ENTRY. SPC 1 CLNUP NOP ENTRY/EXIT LDA CLASN GET THE CLASS NUMBER. SZA,RSS IF CLASS NEVER ASSIGNED, JMP CLNUP,I RETURN NOW. * IOR SIGN INCLUDE THE NO-WAIT BIT(#15), STA CLASN AND SAVE FOR RELEASE. CREPT CCA SET THE RELEASE RE-TRY SWITCH STA CEXIT TO =-1. * CLRTN JSB EXEC GO TO RTE TO RELEASE CLASS NUMBER. DEF *+5 DEF CLS21 SPECIFY CLASS GET/NO ABORT DEF CLASN SPECIFY MASTER CLASS/RELEASE/NO WAIT. DEF ZERO DUMMY BUFFER ADDRESS. DEF ZERO DUMMY BUFFER LENGTH. RSS IGNORE ERRORS. * ISZ CEXIT RELEASE PROCESSING COMPLETED? JMP CLRES  YES. GO TO CLEAR THE 'RES' ENTRY. CPA M1 NO. ARE ALL PENDING REQUESTS CLEARED? RSS YES. SKIP TO DE-ALLOCATE THE CLASS. JMP CREPT NO. CONTINUE TO CLEAR REQUESTS. * LDA CLASN GET THE CLASS NUMBER AGAIN. AND CLMSK EXCLUDE THE NO-DE-ALLOCATION BIT(#13). STA CLASN RESTORE THE MODIFIED CLASS WORD. JMP CLRTN RETURN FOR FINAL DE-ALLOCATION. * CLRES LDA CLASN GET THE CLASS WORD. XOR SIGN REMOVE THE NO-WAIT BIT(#15). STA CLASN SAVE VIRGIN CLASS NO. FOR LIST SEARCH. * JSB #RSAX GO TO 'RES' ACCESS ROUTINE. DEF *+5 DEF P3 CLEAR A LIST ENTRY. DEF P1 SPECIFY MASTER LIST. DEF CLASN SEARCH, USING CLASS NUMBER. DEF ZERO DUMMY PARAMETER. JMP CLNUP,I RETURN. * SKP * ERROR PROCESSING SECTION. SPC 1 DOWN LDB "00" SYSTEM IS SHUT-DOWN: "DS00". JMP GETDS RPLER LDB "03" ILLEGAL REPLY/REC.SIZE: "DS03". JMP GETDS LUERR LDB "04" ILLEGAL LU OR NO CLCT ENTRY: "DS04". JMP GETDS MTOER LDB "05" MASTER REQUEST TIMEOUT: "DS05". JMP GETDS ILRQ LDB "06" ILLEGAL REQUEST: "DS06". JMP GETDS RESER LDB "07" 'RES' LIST-ACCESS ERROR: "DS07". JMP GETDS BZYER LDB "08" BUSY-REJECT FROM THE REMOTE: "DS08". * GETDS LDA "DS" GET FIRST HALF OF ERROR MESSAGE "DS". * PASER DST MSGBF SAVE TOTAL ERROR MESSAGE. * JSB CLNUP GO TO CLEAN UP BEFORE EXITING. * LDB MSGAD POINTS TO ERROR MESSAGE ADDRESS. LDA FLAGS GET ERROR-RETURN FLAG. ELA POSITION TO FOR TESTING. LDA ERRA GET THE ERROR-REPORT ADDRESS. SEZ,RSS ABORT OR RETURN TO CALLER? JSB D65AB ABORT! -- NO RETURN. DLD MSGBF GET ERROR CODES AND RETURN TO JMP D65MS,I THE CALLER AT ERROR-RETURN POINT. SPC 1 * IF REQUESTED, WRITE PARMB'S TO THE LOGGER'S CLASS NO. SPC 1 PLOG NOP ENTRY/EXIT: PARMB LOGGING ROUTINE. LDA #PLOG GET REQUEST FLAG FROM . SZA,RSS IS THERE A REQUEST TO LOG PARMB'S? JMP PEXIT NO. COMPLETE MASTER PROCESSING. * STA PCLAS YES. SAVE THE LOGGER'S CLASS LOCALLY. * JSB EXEC WRITE DEF *+8 THE DEF CLS20 PARMB (PARAMETER BUFFER) DEF ZERO TO THE DEF RQBUF,I PARMB LOGGER'S DEF RQLEN,I CLASS NUMBER. DEF XEQT SUPPLY THE I.D. SEGMENT ADDRESS DEF "MS" AND ASCII "MS" SOURCE IDENTIFIER DEF PCLAS AS OPTIONAL PARAMETERS. NOP ** IGNORE ERRORS FOR THIS OPERATION ** * PEXIT DLD REG RESTORE THE REGISTERS. JMP PLOG,I RETURN TO COMPLETE MASTER PROCESSING. * PCLAS NOP LOCAL STORAGE FOR LOGGER'S CLASS NO. * SKP * CONSTANTS AND STORAGE. SPC 1 B EQU 1 B77 OCT 77 B1000 OCT 1000 B3000 OCT 3000 BIT11 OCT 4000 BIT13 OCT 20000 CEXIT NOP CLASS-RELEASE SWITCH STORAGE. CLASN NOP CLASS NUMBER STORAGE. CLMSK OCT 117777 CLASS NUMBER MASK. CLS19 OCT 100023 CLASS CONTROL--NO ABORT. CLS20 OCT 100024 CLASS WRITE/READ--NO ABORT. CLS21 OCT 100025 CLASS GET--NO ABORT. DM9 DEC -9 EQMSK OCT 37400 EQT5 EQUIPMENT TYPE-CODE MASK. FLAGS NOP ER.RTN(#15=1),NWAIT(#1=1),BLIND(#0=1) ERRA NOP ERROR-REPORT ADDRESS. EXTAD NOP EQT-EXTENSION ADDRESS. LCGW OCT 40006 GLOBAL RN LOCK/CLEAR/WAIT/NO-ABORT. LGW OCT 40002 GLOBAL RN LOCK/WAIT/NO ABORT. M1 OCT -1 M35 DEC -35 MBUF OCT 0,0,0 MRCT ENTRY BUFFER. MSGAD DEF *+1 ADDRESS OF ERROR MESSAGE BUFFER. MSGBF ASC 2,DS00 ERROR MESSAGE BUFFER. P1 DEC 1 P2 DEC 2 P3 DEC 3 P8 DEC 8 P12 DEC 12 P32 DEC 32 P33 DEC 33 REG OCT 0,0 DVR65 RETURN REGISTER INFORMATION. RPMSK OCT 60000 BUSY REPLY MASK.{xHFB SCODE NOP DEVICE SELECT CODE STORAGE. SIGN OCT 100000 TAG OCT 0,0 TIME TAG STORAGE FOR REPLY VALIDATION. TEMP NOP TEMPORARY STORAGE. TYP65 OCT 32400 EQUIPMENT TYPE-CODE 65, FOR DVR65. XEQT EQU 1717B USER'S I.D. SEGMENT ADDRESS. ZERO OCT 0 "00" ASC 1,00 "03" ASC 1,03 "04" ASC 1,04 "05" ASC 1,05 "06" ASC 1,06 "07" ASC 1,07 "08" ASC 1,08 "DS" ASC 1,DS "IL" ASC 1,IL "MS" ASC 1,MS SPC 1 END jH DU 91700-18136 1614 S 0122 DS1/B CCE MODULE: GET              H0101 ASMB,R,L,C HED GET 91700-16136 REV A * (C) HEWLETT-PACKARD CO 1976 NAM GET,7 91700-16136 REV A 760330 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT GET,ACEPT,REJCT,FINIS EXT EXEC EXT .ENTR EXT D65SV EXT CNUMO EXT #ST04 SPC 5 * * GETS * SOURCE:91700-18136 * BINARY:91700-16136 * SHANE DICKEY * JULY 30,1974 * * MODIFIED FOR DS-1B' BY CHUCK WHELAN NOV 14,1975 * SPC 5 * THESE LIBRARY SUBROUTINES ARE USED IN CONJUNCTION * WITH THE PROGRAM TO PROGRAM COMMUNICATION MONITOR * PTOPM TO AFFECT COMMUNICATION WITH SATELLITE PROGRAMS * THEY CONTAIN THE FOUR SLAVE ENTRY POINTS (GET * ACCEPT,AND REJECT AND FINIS) THAT MAY BE ENTERED * BY A PROGRAM IN SLAVE MODE WHICH IS COMMUNICATING * WITH A PROGRAM IN MASTER MODE. * FOR A FURTHER DISCUSSION OF WHAT EACH OF THESE * ENTRY POINTS DOES SEE THE REMARKS UNDER THE SPECIFIC * ENTRY POINT BELOW. * * * THE SUBROUTINES REQUIRE THAT THE USER ENTER * THEM IN A CONTROLLED SEQUENCE. THAT IS TO SAY GET * MUST BE ENTERED FIRST AND * EITHER ACCEPT OR REJECT MUST BE ENTERED SECOND. THIS SEQUENCE IS * REPEATED FOR EACH INCOMING MASTER COMMAND * IT IS NOT DIFFICULT TO IMAGINE THE CONFUSION * THAT RESULTS IF AN ACCEPT REQUEST IS ISSUED ON A REQUEST * NOT YET RECIEVED AND OTHER ANALOGOUS SEQUENCE ERRORS * ALL OF THIS IS KEPT STRAIGHT BY MANIPULATION OF THE VARIABLE * "NEXT" WHICH IS INITIALIZED TO ONE AND MAINTAINED BY THE SUBROUTINE * THE STATES OF THE VARIABLE ARE AS FOLLOWS: * NEXT =1 IMPLIES "GET" CALL REQUIRED NEXT * NEXT=2 IMPLIES ACCEPT/REJ CALL REQUIRED) NEXT * * FINIS MAY BE ISSUED AT ANY TIME HED "GET" PROCESSING * (C) HEWLETT-PACKARD CO 1976 ICLAS NOP IERR NOP IFUN NOP ITAG NOP IL NOP SPC 5 GET NOP SPC 5 * ENTRY HERE SIGNIFIES THAT THE USER SUBROUTINE HAS COMPLETED THE * PROCESSING OF THE LAST CALL AND WISHES TO INTERROGATE HIS I/O * CLASS TO DETERMINE IF THERE ARE ANY MORE REQUESTS * TO BE PROCESSED. IF MORE REQUESTS HAVE BEEN QUED UP ON THE * CLASS THE ONE ON THE TOP OF THE STACK WILL BE PASSED TO THE * USER.IF THERE ARE NO OUTSTANDING REQUESTS THE USER * WILL BE I/O SUSPENDED UNTIL A REQUEST IS RECEIVED * BY THE MONITOR AND PLACED IN THE USER'S I/O CLASS. SPC 5 * SAVE INPUT PARAMETERS JSB .ENTR PICK UP THE PARAMETERS PASSED DEF ICLAS LDB DIL GET SIZE CHECK DEF STB CLEAR LDB GET RETURN ADDR STB EXIT LDB IERR SET UP ERROR PRAM ADDR STB ERRM1 LDA IL ADDRESS SZA,RSS LAST ONE REQ. THERE? JMP ERPAR NO-ERROR CLA,INA LDB ERCOM CPB M47 COMM ERROR OCCURRED LAST XACTION? STA NEXT YES, RESET SEQ INDICATOR CPA NEXT CHECK FOR LEGAL SEQUENCE RSS JMP ERSEQ TAKE ERROR EXIT IF SEQUENCE ERR STA ERCOM * LDA ICLAS,I SET UP THIS USER'S I/O CLASS STA MYCLS JSB EXEC ISSUE GET ON I/O CLASS DEF *+5 DEF D21 DEF MYCLS DEF IRBUF DEF IRBFL * * PASS THE TAG TO THE USER * LDA ITAG SET UP THE TAG FIELD LOCATION STA TAGPR FOR TRANSFER * * MOVE TAG FIELD FROM PARMB TO USER AREA * LDA M10 STA CONTR 10 WORD COUNTER LDA IRBF8 GET1 LDB 0,I STB TAGPR,I STORE WORD IN USER AREA INA ISZ TAGPR BUMP POINTERS ISZ CONTR JMP GET1 ITERATE * GET FUNCTION CODE FROM THE PARMB & USE AS A SWITCH LDA IRBUF+2 GET FUNCTION CODE ^H AND O7 STA FCODE SAVE FUNCTION CODE * SET FUNCTION CODE SO USER WILL KNOW WHAT HE GOT * STA IFUN,I RETURN RECEIVED FUNCTION CODE LDB IRBUF+18 DATA BUFFER LENGTH RAR,SLA SKIP UNLESS READ OR WRITE STB IL,I RETURN LENGTH TO CALLER * RETURN TO THE USER ISZ NEXT SET SEQ INDICATOR * SET IERR FLAG CLB RETURN "NO ERROR" FLAG STB IERR,I TO THE USER STB IL JMP GET,I RETURN TO USER HED "ACCEPT" PROCESSING * (C) HEWLETT-PACKARD CO 1976 AITAG NOP AIERR NOP AIBUF NOP * * ENTRY HERE SIGNIFIES THAT THE LAST REQUEST EXAMINED * WAS AN ACCEPTABLE ONE AND THE REQUEST WAS TO BE HONORED * * THE ACTION TO BE ACCOMPLISHED FOR AN ACCEPT REQUEST * VARIES AS TO THE TYPE OF REQUEST WHICH WAS LAST RECEIVED * ACCEPT REQUESTS ARE PERFORMED FOR ALL FOUR MASTER REQUESTS * EXIT EQU * ACEPT NOP JSB .ENTR PICK UP CALLING PARAMETERS FROM DEF AITAG THE USER * LDB DAIER GET SIZE CHECK LOCATION STB CLEAR * * CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB * DLD AITAG JSB PUTAG * LDA AIBUF SZA STA DATAD SET DATA ADDRESS CLB STB AIERR CLEAR FOR PARAM CK NEXT TIME LDA FCODE RAR,SLA SKIP IF OPEN OR CONTROL(DO REQ ONLY) RSS JMP ACPFG LDB READZ CONWD FOR READ (REQ & WRITE DATA) SSA SKIP IF PREAD LDB WRITZ CONWD FOR WRITE (REQ & READ DATA) LDA AIBUF SZA,RSS WAS DATA BUFFER SPECIFIED JMP ERPAR NO, INSUFFICIENT PARAMS * ACPFG LDA IRBUF+2 SET ACCEPT FLAG IN PARMB IOR BIT14 * * REMAINDER OF THIS SECTION IS SHARED BY "ACEPT" AND "REJCT" * DVR STA IRBUF+2 LDA IRBUF ALF,ELA LDA IRBFL LENGTH=35 WORDS IF FRIENDLY SEZ,RSS TEST FRIENDLY BIT LDA D25 IT'S UNFRIENDLY STA RQLEN LDA IR>BUF IOR BIT14 SET REPLY BIT STA IRBUF LDA IRBUF+24 AND B77 IOR 1 INCLUDE DRIVER REQUEST TYPE STA CONWD CONFIGURE CALL FOR LU & OP TYPE LDA D2 CPB WRITZ IS IT SEND REQ & RCV DATA? CLA,INA YES, OP IS READ STA D2T * JSB D65SV DO CALL TO DRIVER THRU D65SV DEF *+7 DEF D2T DEF CONWD DEF IRBUF DEF RQLEN DATAD DEF DUMMY DEF IRBUF+18 JMP ERRAC COMMUNICATION ERROR ALF,ALF ALF,SLA CHECK FOR STOP RECEIVED JMP ERRAC IT WAS, DATA WAS REJECTED * CLA,INA STA NEXT LDA ERRM1,I RETRN STA ERCOM SAVE RETURN STATUS CLB JMP EXIT,I RETURN FROM ACEPT/REJCT TO CALLER * ERRAC LDA M47 ERROR STATUS= -47 STA ERRM1,I JMP RETRN HED "REJECT" PROCESSING * (C) HEWLETT-PACKARD CO 1976P JITAG NOP JIERR NOP * * ENTRY HERE IS SIMILAR TO THAT FOR THE ACCEPT OPTION * EXCEPT THE REQUEST HAS BEEN DETERMINED NOT TO BE FROM A VALID * SATELLITE AND MUST BE REJECTED. AGAIN THE LOGIC * IS BROKEN UP INTO FOUR SUBCLASSES ACCORDING TO THE TYPE * OF REQUEST BEING REJECTED * REJCT NOP JSB .ENTR PICK UP USER PARAMETERS DEF JITAG LDB DJIER STB CLEAR SET UP SIZE CHECK LOCATION LDB REJCT PICK UP RETURN ADDR STB EXIT * * CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB * DLD JITAG JSB PUTAG * LDA FCODE PICK UP TYPE OF REQUEST RAR,SLA RSS SKIP IF READ OR WRITE FUNCTION JMP REJ4 * LDA IRBUF+24 GET LU IOR BIT6 STA D2T SET UP CONTROL BIT * SEND ENABLE LISTEN REQUEST TO DRIVER JSB EXEC DEF *+3 DEF D3 DEF D2T * REJ4 LDA IRBUF+2 ADA D4 MODIFY CODE * SET THE PARMB REJECT FLAG FOR PTOPM IOR MSK5 CLB DO WRITE REQUEST ONLY w STB JIERR CLEAR FOR PARAM CK NEXT TIME JMP DVR NOW SEND REPLY & EXIT HED "FINISH" PROCESSING * (C) HEWLETT-PACKARD CO 1976 FINIS NOP * GET NAME OF PROGRAM TO BE FINISHED * (THE ONE THAT THIS S-R IS APPENDED TO ) LDA B1717,I GET ID SEGMENT OF CURRENTLY ADA D12 EXECUTING PROGRAM & STEP TO NAME LDB A,I GET FIRST 2 CHARS OF NAME STB IRBUF+5 & MOVE TO PARMB * INA LDB A,I GET 2ND TWO STB IRBUF+6 & SAVE AWAY * INA GET 3RD TWO LDA 0,I AND MSK1 MASK OUT ID SEG STATUS BITS IOR B40 STA IRBUF+7 AND SAVE * CLA,INA STA NEXT RESET SEQUENCE INDICATOR * * SET FUNCTION CODE REPLY FLAG & ACCEPT/REJECT FLAG * LDA HCODE STA IRBUF+2 * * SEND IT TO THE MONITOR * SO THIS PROGRAM CAN BE REMOVED FROM THE ACTIVE LIST * LDA #ST04+1 GET CLASS # FOR PTOPM RAL,CLE,ERA CLEAR OFF SIGN BIT STA PTOP * JSB EXEC SEND THE REQUEST BACK TO PTOPM DEF *+8 DEF D20 DEF ZERO DEF IRBUF DEF IRBFL DEF DUMMY DEF DUMMY DEF PTOP ISZ FINIS JMP FINIS,I RETURN HED UTILITY SUBROUTINES/DATA AREA * (C) HEWLETT-PACKARD CO 1976 * * THIS SUBROUTINE CHECKS FOR CALL ERRORS & RETURNS A MODIFIED * PARMB TO THE SATELLITE MASTER PROGRAM * PUTAG NOP DST TAGPR STORE ADDRS OF TAG FIELD & ERROR FLAG SZB,RSS SKIP IF ERROR DEF WAS PASSED JMP ERPAR OTHERWISE ERROR IN CALL LDA NEXT CHECK SEQUENCE CPA D2 CLA,RSS OK JMP ERSEQ ERROR, NOT TIME FOR ACEPT/REJCT STA ERRM1,I CLEAR ERROR FLAG LDA M10 BUILD A TEN WORD COUNTER STA CONTR LDA IRBF8 BUILD AN ADDRESS IN THE PARMB * PUT1 LDB TAGPR,I PUT A WORD IN PARMB STB A,I INA INCREMENT ISZ TAGPR POINTERS IS/Z CONTR DONE WITH MOVE? JMP PUT1 AND BRANCH BACK IF NOT DONE JMP PUTAG,I ON COMPLETION RETURN SPC 5 ERSEQ LDA M46 -46 = SEQUENCE ERROR RSS ERPAR LDA M40 -40 = INSUFFICIENT PARAMETERS STA ERRM1,I RETURN ERROR TO USER CLB CLEAR PARAM SIZE CHECK WORD STB CLEAR,I JMP EXIT,I AND RETURN SPC 5 ERR1 NOP STA SSA SAVE DRIVER STATUS LDA B1717,I GET THE NAME OF THE PROGRAM ADA D12 THIS S/R IS APPENDED TO LDB A,I FROM THE ID SEGMENT STB COMER+6 & SAVE IN THE OUTPUT * INA BUFFER LDB A,I STB COMER+7 * INA LDB A,I LDA B AND MSK1 STRIP OFF STATUS BITS STA COMER+8 * JSB CNUMO CONVERT STATUS WORD TO ASCII DEF *+3 DEF SSA DEF CNBUF RESULTING ASCII * JSB EXEC OUTPUT DRIVER ERROR DEF *+5 MESSAGE DEF D2 DEF D1 DEF COMER * DEF COMEL JMP ERR1,I & RETURN * * DATA AREA * CONTR NOP FCODE NOP CONWD NOP MYCLS NOP NEXT DEC 1 ERCOM NOP TAGPR DEC 0,0 ERRM1 EQU TAGPR+1 A EQU 0 B EQU 1 M10 DEC -10 D2T NOP BIT6 OCT 100 BIT14 OCT 40000 B40 OCT 40 B77 OCT 77 READZ OCT 10200 REQ & WRITE DATA + Z BIT WRITZ OCT 10100 REQ & READ DATA + Z BIT ZERO OCT 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D20 DEC 20 D21 DEC 21 D25 DEC 25 IRBFL DEC 35 RQLEN NOP MSK1 OCT 177400 B1717 OCT 1717 D12 DEC 12 HCODE OCT 40211 MSK5 OCT 100000 O7 OCT 7 PTOP OCT 100004 M46 DEC -46 M47 DEC -47 CLEAR NOP M40 DEC -40 IRBF8 DEF IRBUF+8 DJIER DEF JIERR DAIER DEF AIERR DIL DEF IL * IRBUF EQU * * BSS 35 THIS BUFFER IS ZEROED UNL REP 35 NOP LST CNBUF BSS 3 COMER ASC 7,COMM ERROR - SSA NOP COMEL DEC -16 DUMMY NOP 5*($ END * E Q 91700-18138 1612 S 0222 DS1/B CCE MODULE: SCGN0              H0102 CASMB,L,R,C HED SCGN0 91700-16138 REV.A 760314 * (C) HEWLETT-PACKARD CO. 1976 * NAM SCEGN,3,90 91700-16138 REV.A 760314 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************* * *SCGN0 MAIN FOR THE SCE GENERATOR-LOADER * *SOURCE PART # 91700-18138 REV A * *REL PART # 91700-16138 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-29-74 * *MODIFIED BY: K.HAHN [ C.C.H. ] * *DATE MODIFIED: 09-23-75 [ 03-14-76 ] * *MODIFICATION: ADD CURRENT PAGE LINKING, MAP ALL, AND * COMMENTS. * [ ADD ECHO ON/OFF OPTION TO SUPPRESS COMMAND ECHO, * ADD EXTENDED-NAM PRINTOUT, ADD DVR05 PROCESSING. ] ************************************************** SPC 1 * * * THIS PROGRAM CONTROLS THE SEGMENTS * OF THE RTS GENERATOR * SPC 3 * * DEFINE ENTRY POINTS * ENT .MEM.,.MEM1,.MEM2,.MEM3,.MEM4,.MEM5,.MEM6 ENT ?XFER,ABDCB,ABL1,ABL2,ABRC1,ABREC ENT BPLOC,CKS,COMOR,FWAM,GTOUT,LISTO,LOCC ENT LOUT,LST,LST1,LST2,LST3,LST4,LST5 ENT LSTI,LSTP,LWAM,NAMR.,PACK$,PLK,PLKS ENT PNAMA,PNAME,PRAMS,PRCMD,PRINT,PUNCH,RBTA ENT RBTO,RBIN,SSTBL,UEXFL ENT IBUFR,PLK1,CMDLU,LSDCB ENT RLDCB,SWAPR,FERR,FILCK,PRMT ENT FOPEN,FCRET ENT FTRKA,NSEC,NTRK,SECTK ENT SECA,TRKA,ENDM,DSKLU,SMTLN ENT PARSB,PARSA,FCLOS,ENDLU,COML ENT PARS1,PARS2,PARS3,PARS4,PARS5 ENT PRS21,PRS31,PRS41,PRS51,INDCB ENT STKAD,P:TR,PUSH,NOPRT,LDRCD V ENT SC3CD,S45CD,SWPLC,INDB3 ENT CLSFI,#ECHO ENT PRS22,PRS23,SIZE ENT EFLAG,CPLMG,CPLML SPC 2 * * DEFINE EXTERNALS * EXT LOAD,WRITF,EXEC,CLOSE EXT CREAT,OPEN,READF,CNUMD EXT .ENTR,.DFER EXT PARSE,IFBRK EXT LOCF,APOSN,NBUF9 EXT CPLEN IFN EXT DBUG XIF SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SKP * * HERE IS WHERE WE START * SPC 1 START NOP CLA INITIALIZE FOR STA #ECHO ECHO OF COMMANDS. STB CMDLU IFN LDA B,I SEE IF THEY WANT THE DEBUGER CPA B6 RSS YES JMP STRT0 NO JSB DBUG DEF *+1 JSB EXEC TERMINATE...SAVE RESURCES DEF *+4 DEF B6 DEF ZERO DEF B1 JMP START XIF STRT0 JSB SWAP GO GET THE INITIAL SEGMENT DEC 3 JSB A,I GO TO SEGMENT LDA SWPLC GET INDEX TO SEGMENT TABLE STA *+2 JSB SWAP NOP SEGMENT # PLACED HERE JMP A,I UPON RETURN FROM SWAP A REG=START SPC 2 D13 DEC 13 B77 OCT 77 B400 OCT 400 NOPRT NOP ENDLU NOP UP377 OCT 177400 SKP ***** * ** PACK$ ** INSERT A WORD INTO THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * LDA WORD TO BE PLACED IN RECORD * JSB PACK$ * RETURN * * NOTE: .B. IS NOT ALTERED BY THIS SUBROUTINE ***** PACK$ NOP STA ABL1,I STORE WORD AT NEXT LOCATION ISZ ABL1 IN BUFFER, INCREASE ADDRESS. ADA CKS ADD WORD TO CHECKSUM STA CKS AND RESTORE WORD ISZ ABREC COUNT WORD JMP PACK$,I AND EXIT. SPC 1 * * ABSOLUTE RECORD BUFFER AND POINTERS * ABREC OCT 0 ABRC1 BSS 49 BUFFER FOR ABSOLUTE OUTPUT ABL1 DEF ABREC+2 HOLDS CURRENT BUFFERR ADDRESS ABL2 DEF ABREC+2 .ABR DEF ABREC CKS NOP HOLDS COMP WUTED CHECKSUM SKP ***** * ** PUNCH ** OUTPUT THE RECORD IN THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * JSB PUNCH * RETURN * * NOTE: THIS SUBROUTINE INSERTS CHECKSUM AND WORDCOUNT BEFORE OUTPUT ***** PUNCH NOP ENTRY/EXIT LDA CKS ADD LOAD ADDRESS TO CHECK-SUM ADA ABREC+1 AND SET RECORD SUM STA ABL1,I IN LAST WORD OF RECORD. LDA ABREC ADD 2 TO RECORD WORDCOUNT ALF,ALF POSITION AS FIRST CHAR. AND STA ABREC SET. ALF,ALF REPOSITION, ADD 3 FOR TOTAL ADA B3 LENGTH AND SET FOR STA PTEMP SAVE LENGTH JSB WRITF GO WRITE THE RECORD DEF *+5 DEF ABDCB DEF FERR DEF ABREC DEF PTEMP JSB IBUFR SET UP OUTPUT JMP PUNCH,I EXIT- SPC 1 B3 OCT 3 PTEMP NOP ***** SKP ***** * ** IBUFR ** INITIALIZE THE ABSOLUTE RECORD BUFFER (ABREC) SO IT MAY * BE FILLED UP FOR LATER OUTPUT * CALLING SEQUENCE: * JSB IBUFR * RETURN * ***** IBUFR NOP CLA ZERO OUT STA ABREC WORD COUNT STA CKS AND CHECKSUM LDA ABL2 INITIALIZE STA ABL1 NEXT WORD POINTER JMP IBUFR,I * SKP **** * * PLK ** * * PLK PUNCHES CORE FROM A TO B IN ABS FORMAT. * IF ALSO LISTS THE PUNCH BOUNDS. A, B SPECIFY THE * FINAL LOAD ADDRESS OF THE DATA. OFFSET IS * ADDED TO GET THE CURRENT CORE LOCATION. * ***** PLK NOP ENTRY: LDA,LDB,JSB. STA PLK1 INB STB PLK3 PL2 LDA MD45 INITIALIZE COUNTER STA PLK2 FOR MAX. BLOCK SIZE OF 45 WORDS. LDA PLK1 STORE LOAD ADDR. OF BLOCK STA ABRC1 IN WORD 2 OF PUNCH BUFFER PL3 LDA PLK1 ADA PLKS ADD OFFSET TO GET ACTUAL ADDRESS IN CORE LDA A,I GET WORD TO PUNCH JSB PACK$ PUT INTO BUFFER ISZ PLK1 ADD 1 TO CURRENT BLOCK ADDR.  LDA PLK1 IF CURRENT BLOCK CPA PLK3 TERMINATED, GO TO JMP PL4 PUNCH LAST BLOCK. ISZ PLK2 INDEX COUNTER. JMP PL3 BUFFER NOT FILLED. JSB PUNCH BUFFER FILLED - PUNCH JMP PL2 FILL NEXT BUFFER. * PL4 JSB PUNCH PUNCH LAST BUFFER - JMP PLK,I EXIT. * PLK1 NOP HOLDS FWA PUNCH AREA PLK2 NOP HOLDS BUFFER INDEX PLK3 NOP HOLDS LWA+1 PUNCH AREA MD45 DEC -45 * SPC 2 SKP * * SEARCH SYSMBOL TABLE FORR MATCH ROUTINE * ***** * ** SSTBL ** SEARCH SYMBOL TABLE * CALLING SEQUENCE * * LDA ADDRESS OF 5 CHAR NAME TO MATCH * JSB SSTBL * RETURN1 SYMBOL NOT FOUND * RETURN2 FOUND, LST1-LST5 POINT TO MATCHED ENTRY * * NOTE: THE NAME INPUT FOR MATCH MUST START ON A WORD BOUNDARY ***** SPC 1 SSTBL NOP STB STEMP SAVE TEMPORARILY JSB LSTI INITIALIZE SYMBOL TABLE SSTB1 JSB LSTP SET LST ENTRY ADDRESSES JMP SSTBL,I END OF TABLE--ERROR RETURN LDB STEMP RETRIEVE ADDRESS OF TARGET MATCH LDA B,I CPA LST1,I CHARS. 1&2 MATCH? INB,RSS JMP SSTB1 NO--GET NEXT ENTRY LDA B,I CPA LST2,I INB,RSS JMP SSTB1 LDA B,I XOR LST3,I AND UP377 CHECK CHAR. 5 SZA JMP SSTB1 * MATCH FOUND -- MAKE SUCCESS RETURN ISZ SSTBL JMP SSTBL,I * * STEMP NOP SKP ***** * ** LSTI / LSTP ** SYMBOL TABLE ACCESSING SUBROUTINES * * PURPOSE: TO SET IN WORDS LST1 - LST5 THE * ADDRESSES OF THE FIVE WORDS IN AN * ENTRY IN THE LST (LOADER SYMBOL TABLE) * * INITIAL SETUP IS MADE BY THE ROUTINE * -LSTI- THIS SECTION INITIALIZES * THE NEGATIVE COUNT OF THE NUMBER * OF ENTRIES IN THE LST AND SETS LST5 POINTING TO * THE "-1"TH ENTRY. SPC 1 * THE SECTION -LSTP- SETS THE FIVE *  ADDRESSES OF THE NEXT LST ENTRY * IN LST1-LST5. IT ALSO INDEXES THE * ENTRY COUNTER. WHEN THE COUNTER = ZERO * EXIT FROM LSTP IS TO P+1 OF THE CALL * AND LST1-LST5 CONTAIN THE ADDRESSES * FOR A NEW ENTRY. IF THE COUNT AFTER * INDEXING IS NOT ZERO, EXIT IS TO * P+2 OF THE CALL. SPC 1 * CALLING SEQUENCE: (P-1) JSB LSTI * (P) JSB LSTP * (P+1) (END OF LST RETURN) * (P+2) (NEXT ENTRY ADDRESSES * SET RETURN) SPC 2 * - INITIALIZER- SPC 1 LSTI NOP JSB BRKCK CHECK IF THEY WANT TO BREAK LDA LST GET NUMBER OF LST ENTRIES - SET CMA NEGATIVE THE VALUE + 1. STA LSTPX STORE CCA SET A =-1 ADA FWAM SET ADDRESS+1 OF WORD 1 OF FIRST STA LST5 LDA FTRKA RESET TRACK ADDRESS STA CTRKA CLA STA CSECA JSB RDSMB GO READ/WRITE SYMBOL TABLE TO DISK JMP LSTI,I EXIT SPC 2 * - PROCESSOR - SPC 1 LSTP NOP LDA LST5 GET ADDRESS FOR NEXT ENTRY ADA ENDM OVERFLOW? SSA JMP LSTP1 NO LDA CSECA YES...GET NEXT BLOCK ADA NSEC CLB SEE IF TRACK SPILL OVER DIV SECTK STB CSECA REMAINDER=SECTOR ADDRESS ADA NTRK GET TO NEXT TRACK ADA CTRKA STA CTRKA SET IN NEW TRACK ADDRESS * ADB NSEC GET LAST+1 SECTOR OF BLOCK CMB,INB ADB SECTK IF END NOT ON SSB,RSS SAME TRACK, JMP *+4 START BLOCK ON CLB NEXT TRACK STB CSECA ISZ CTRKA * JSB RDSMB GO GET SYMBOL TABLE BLOCK CCA RESET TO BEGINING OF BUFFER ADA FWAM STA LST5 LSTP1 LDA LST5 INA STA LST1 INA STA LSl/T2 INA STA LST3 INA STA LST4 INA STA LST5 ISZ LSTPX INDEX ENTRY COUNTER. ISZ LSTP NOT END OF LST - SET P+2 EXIT JMP LSTP,I -EXIT- TO P+1 IF END OF LST. SPC 1 CSECA NOP CTRKA NOP FTRKA NOP NSEC NOP NTRK NOP SECTK NOP ENDM NOP DSKLU NOP SKP * * SUBROUTINE TO READ/WRITE SYMBOL TABLE FROM DISC * CALLING SEQUENCE * JSB RDSMB * RDSMB NOP LDA SECA GET LAST SECTOR ADDRESS LDB TRKA GET LAST TRACK ADDRESS CPA CSECA IS IT EQUAL TO CURRENT? RSS YES JMP WTSMT NO...WRITE AND READ CPB CTRKA HOW ABOUT THE TRACK ADDRESS? JMP RDSMB,I SAME THING...DON'T DO ANYTHING WTSMT JSB EXEC GO WRITE OUT CURRENT DEF *+7 DEF B2 DEF DSKLU DEF FWAM,I DEF SMTLN DEF TRKA DEF SECA JSB EXEC READ IN NEW BLOCK DEF *+7 DEF B1 DEF DSKLU DEF FWAM,I DEF SMTLN DEF CTRKA DEF CSECA LDA CTRKA STA TRKA LDA CSECA STA SECA RESET TRACK SECTOR ADDRESS JMP RDSMB,I AND RETURN SPC 1 TRKA NOP SECA NOP SMTLN NOP SKP * * ROUTINE TO HANDLE THE "PRCMD" JSB FROM THE GENERATOR * PRCMD NOP JSB SWAP DEC 1 LOAD IN LOADER JSB LOAD GO TO IT ("PRCMD" IN SEGMENT) RSS ERROR RETURN ISZ PRCMD NORMAL RETURN JSB SWAP ROLL BACK THE GENERATOR SWPLC NOP JMP PRCMD,I AND GIVE CONTROL BACK SPC 4 * * ROUTINE TO SWAP SEGMENTS * CALLING SEQUENCE * JSB SWAP * DEC SEG # 0=GENERATOR 1=LOADR * A AND B REG SAVED * SWAP NOP LDA SWAP,I GET SEG NAME MPY B3 ADA SGNMA STA SWAPA JSB EXEC ROLL IN SEGMENT DEF *+3 DEF D8 SWAPA NOP SWAPR ISZ SWAP GET RETURN ADDRESS JMP SWAP,I AND RETURN SPC 1 ABREG BSS 2 * * THE FOLLOWING ORDER MUST NOT BE CHANGED * SGNMA DEF *+1 ASC 3,SCGN1 RTC-B GENERATOR SEGMENT ASC 3,SCGN2 LOADER SEGMENT ASC 3,SCGN3 OPERATOR INTERFACE LOADER SEGMENT ASC 3,SCGN4 START UP SEGEMENT ASC 3,SCGN5 SCE3 GENERATOR SEGMENT D8 DEC 8 S45CD OCT 0 LDRCD OCT 2 SC3CD OCT 4 SKP * * SUBROUTINE TO CLOSE AND PURGE ALL FILES * CURRENTLY OPEN TO PROGRAM INCASE OF ERROR * JSB JSB GTOUT * * NOTE: * I AM CHEATING...GEORGE HAS INDICATED THAT IT * IS POSSIBLE TO PURGE A FILE IF ALL I HAVE IS * A DCB. THE WAY THIS IS DONE IS AS FOLLOWS * SET EXTENT POINTER TO 0...MAIN...GET RID OF SEMENTS * GET THE # OF SECTORS IN FILE AND DIVIDE BY 2 * TO GIVE YOU THE # OF BLOCKS. * DO A CLOSE AND TRUNCATE ALL BLOCKS, WHICH MAKES * THE FILE MANAGER ROUTINES DO EFFECTLY A PURGE. * THUS WE HAVE DONE A PURGE WITHOUT THE NAME * THIS IS DEPENDENT ON DCB MEANING...IF IT CHANGES * BYE.... * * GTOUT NOP LDA 1717B GET TO ID NAME ADA D12 ADD TO NAME STA .DFR1 SAVE FOR MOVE JSB .DFER MOVE NAME DEF ABMSG .DFR1 NOP LDA ABM1 GET TO LAST TO CHAR AND UP377 MASK OFF 6TH CHAR IOR B40 STA ABM1 SAVE ONLY 5 CHAR NAME LDA D14 GO PRINT ABORT LDB DFABM MESSAGE TO THE JSB LOUT OUTPUT LIST FILE LDA ABDCB+9 SEE IF FILE OPEN CPA 1717B THATS OUR ID SEGMENT ADDRESS RSS YES JMP GTOT1 NO CLA CLEAR OUT EXTENTS LDB ABDCB+2 SEE IF TYPE 0 SZB,RSS JMP CLSAB IT IS, DON'T PURGE FILE STA ABDCB+15 LDA ABDCB+5 GET # OF SECTORS CLE,ERA CONVERT TO BLOCKS CLSAB STA BLKS AND SAVE IT JSB FCLOS PURGE THE FILE!!! DEF *+3 DEF ABDCB DEF BLKS GTOT1 JSB FCLOS CLOSE LIST FILE DEF *+2 DEF LSDCB JSB FCLOS FCLOS RELOCATABLE INPUT FILE IF OPEN DEF *+2 DEF RLDCB JSB FCLOS CLOSE INPUT FILE DEF *+2 DEF INDCB * * AT THIS POINT ALL FILES ARE CLOSED OR PURGED * TELL WORLD WE ARE DONE * JSB EXEC PRINT OUT ABORT MESSAGE DEF *+5 DEF B2 DEF ENDLU DFABM DEF ABMSG "RTSGN ABORTED" DEF B7 JSB EXEC RELEASE TRACKS DEF *+3 DEF B5 DEF M1 JSB EXEC AND TURN OFF DEF *+2 DEF B6 SPC 1 ABMSG ASC 2, ABM1 ASC 1, ASC 4,ABORTED B1 OCT 1 B2 OCT 2 B5 OCT 5 B6 OCT 6 B7 OCT 7 M1 DEC -1 BLKS NOP D12 DEC 12 SKP * SUBROUTINE TO WRITE ON INTERACTIVE DEVICE * AND LIST FILE * CALLING SEQUENCE * JSB PRINT * A REG= SIO LENGTH WORD * B REG= ADDRESS OF MESSAGE * PRINT NOP DST ABREG SAVE A AND B REG FOR LOUT JSB BYTCN CONVERT SIO TO USUAL INB SKIP OVER LEADING SPACE ADA M1 CUT COUNT NOT INCLUDE SPACE STA PRNTA SAVE LENGTH STB PRNTB SAVE ADDRESS LDA NOPRT DO WE PRINT THIS MESSAGE? SZA JMP PRNT1 NO JSB WRITF OUTPUT MESSAGE DEF *+5 DEF INDCB TO THE INPUT DEVICE DEF FERR PRNTB NOP DEF PRNTA LENGTH PRNT1 LDA #ECHO IF BOTH THE ECHO-OFF FLAG, ADA PRMFL AND THE PROMPT FLAG CPA B2 ARE SET, JMP PRINT,I BYPASS WRITING TO LIST FILE. DLD ABREG GET LENGTH AGAIN JSB LOUT WRITE TO FILE JMP PRINT,I AND RETURN SPC 1 PRNTA NOP SPC 1 * SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS * CALLING SEQUENCE * JSB BYTCN * B REG UNCHANGED * BYTCN NOP STA BYTCA SAVE LENGTH FOR CHECKING LATTER SSA WORDS OR CHARACTERS? JMP *+3 WORDS - CMA,INA CONVERT CHAR TO WORDS ARS DIVIDE BY 2+1 STA BYTCC SAVE IN DOWN COUNTER LDA LSBFA GET ADDRESS WHERE TO PUT OUTPUT STA BYTCD SAVE FOR MOVE BYTC1 LDA B,I MOVE MESSAGE STA BYTCD,I ISZ BYTCD INB ISZ BYTCC DONE? JMP BYTC1 NO LDB BYTCA WORDS OR CHARACTERS? SSB JMP BYTC2 WORDS CLE,ERB CONVERT CHARACTERS TO WORDS SEZ,RSS ODD # OF CHAR? JMP BYTC3 NO STB BYTCC YES...SAVE COUNT FOR LATTER ISZ BYTCC INCLUDE ODD CHAR ADB LSBFA GET TO END LDA B,I AND UP377 MASK OFF LOWER HALF IOR B40 OR IN A SPACE STA B,I SAVE IT LDB BYTCC GET LENGTH AGAIN BYTC3 RSS SKIP OVER COMPLEMENTING BYTC2 CMB,INB CHANGE NEG WORDS TO + WORDS LDA B GET LENGTH IN A REG LDB OTBFA GET ADDRESS OF BUFFER...INCLUDING SPACE INA INCLUDE SPACE IN COUNT JMP BYTCN,I AND RETURN SPC 1 BYTCA NOP BYTCC NOP BYTCD NOP OTBFA DEF OTBUF LSBFA DEF OTBUF+1 B40 OCT 40 SPC 1 * SUBROUTINE TO WRITE ONTO A LIST FILE * CALLING SEQUENCE * JSB LOUT * AREG = SIO LENGTH * B REG= BUFFER ADDRESS * LOUT NOP JSB BYTCN CONVERT LENGTH STA LOUTA STB LSBF SAVE BUFFER ADDRESS FOR OUTPUTING LDA LSBFA,I GET FIRST TWO USER-CHARACTERS. CPA PRMCR IF THEY ARE THE PROMPT CHARACTERS, RSS SKIP TO REPLACE THE BACK ARROW. JMP LWRT NOT THE PROMPT--NO NEED TO CHANGE. AND UP377 SAVE THE UPPER BYTE, IOR B40 AND REPLACE THE LOWER WITH A SPACE. STA LSBFA,I RESTORE THE MODIFIED PROMPT CHARACTERS. LWRT JSB WRITF WRITE THE RECORD DEF *+5 LDCBA DEF LSDCB DEF FERR LSBF NOP LIST BUFFER ADDRESS HERE DEF LOUTA JMP LOUT,I AND RETURN[Z SPC 1 LOUTA NOP EFLAG NOP #ECHO NOP COMMAND-ECHO FLAG: 0=ON, 1=OFF. PRMCR ASC 1,-_ PROMPT CHARACTERS. SKP * * SUBROUTINE TO GET NAME * OPEN,READ AND CLOSE A RELOCATABLE * FILE. * CALLING SEQUENCE * JSB RBIN * ERROR RETURN * NORMAL RETURN * * A REG= BUFFER ADDRESS * UPON RETURN * A REG=-1 EOF OR A REG<> DATA IS THERE * LENGTH IN POSITIVE WORDS FIRST WORD * DATA RECORD * RBIN NOP STA RBINA SAVE BUFFER ADDRESS LDA RLDCB+9 SEE IF DCB OPEN CPA 1717B IS IT OPEN JMP RBOPN YES...DON'T RE OPEN JSB BRKCK SEE IF WE WANT OUT LDA PARS2 GET FILE NAME TYPE SZA IF NOT NULL JMP RBIN1 GO OPEN THE FILE LDA B5 DEFAULT IS LU 5 STA PARS2+1 SET LDA B1 SET FILE NAME TYPE STA PARS2 TO NUMERIC RBIN1 JSB FOPEN TRY TO OPEN FILE DEF *+3 DEF RLDCB DEF B300 JSB FILCK JMP RBIN,I RBOPN JSB READF READ THE FILE DEF *+6 DEF RLDCB DEF FERR DEF RBINA,I DEF D60 MAX OF 60 WORDS DEF RLEN LENGTH OF RECORD JSB FILCK SEE IF ANY ERROR JMP RBIN,I ERROR...DO ERROR RETURN ISZ RBIN GET NORMAL RETURN LDA RLEN GET LENGTH STA RBINA,I AND SAVE IN FIRST WORD CPA M1 EOF? RSS JMP RBIN,I NO JSB FCLOS YES...CLOSE FILE DEF *+3 DEF RLDCB DEF ZERO CCA TELL THEM END OF FILE JMP RBIN,I AND RETURN SPC 2 RBINA NOP RLEN NOP * * SUBROUTINE TO OPEN A FILE * CALLING SEQUENCE * JSB FOPEN FILE OPEN * DEF *+3 * DEF DCB ADDRESS * DEF SUBFUNCTION FOR READ OR WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * ODCBA HNOP SUBF NOP FOPEN NOP JSB .ENTR DEF ODCBA LDB C4040 LDA PRS22 SZA,RSS STB PRS22 LDA PRS23 SZA,RSS STB PRS23 FOPN1 LDA ODCBA GGET DCB ADDRESSPE LDB SUBF,I GET SUBFUNCTION JSB TYP0 CHECK IF TYPE IS 0 JMP FOPEN,I YES EXIT JSB OPEN TRY TO OPEN FILE DEF *+7 DEF ODCBA,I DEF FERR DEF PARS2+1 NAME DEF ZERO OPEN OPTION DEF PARS3+1 SECURTIY CODE DEF PARS4+1 LOGICAL UNIT LDB ODCBA GET DCB ADDRESS CPB INDEF IS IT INPUT FILE ISZ NOPRT SET NON-ZERO(NO PRINT) JMP FOPEN,I RETURN SKP * SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE * CALLING SEQUENCE * LDA DCB ADDRESS * LDB SUBFUNCTION * JSB TYP0 * RETURN HERE(P+1) IF IT IS TYPE 0 * RETURN HERE(P+2) IF IT IS NOT TYPE 0 * TYP0 NOP STA T0DCB LDA PARS2 CMA,INA,SZA IF NULL OR NUMERIC INA,SZA,RSS THEN OPEN A DUMMY TYPE 0 JMP TYP1 ISZ TYP0 OTHERWISE TAKE NOT JMP TYP0,I TYPE 0 EXIT TYP1 LDA PARS2+1 GET LU SZA,RSS IF NOT DEFINED INA DEFINE AS LU = 1 STA PARS2+1 CLA JSB SET SET DIRECTORY JSB SET ADDRESS TO ZERO JSB SET ALSO SET TYPE TO 0 LDA PARS2+1 GET LOGICAL UNIT IOR B MERGE IN SUBFUNCTION JSB SET AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+4 DEF D13 DEF PARS2+1 DEF EQT5 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND B77 AND MASK CPA B5 IF THE TYPE-CODE IS <05>, JSB TYPE5 THEN GO TO EXAMINE THE SUBCHANNEL. STA EQT5 SAVE THE EQUIPMENT TYPE-CODE. LDB B100 GET EOF CONTROL SUBFUNCTION ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE LDB B1000 8 LDA EQT5 CPA B2 IS DRIVER A PUNCH JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE=0 DON'T DO PAGE EJECT JMP SEOF LDB B1100 LINE SPACE OPTION SEOF LDA PARS2+1 GET LU IOR B MERGE EOF CONTROL SUBFUNCTION JSB SET SET IN DCB CLA JSB SET SET NO SPACEING LEGAL LDA B1001 SET READ&WRITE LEGAL JSB SET AND SECURITY CODES AGREE JSB SET AND UPDATE MODEES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SET SET OPEN FLAG LDA T0DCB ADA B3 STA T0DCB SET TO WORD 13 CLA SET IN CORE BUFFER FLAG JSB SET TO ZERO INA JSB SET SET RECORD COUNT LDA EQT5 GET TYPE CODE LDB T0DCB GET DCB ADDRESS ADB MD15 RESET TO WORD 1 CPB INDEF IS IT THE INPUT DEVICE STA NOPRT SAVE TO INDICATE PRINT / NO PRINT ADB B4 GET TO CONTROL FUNCTION LOCATION LDB B,I GET CONTROL WORD STB SET SAVE IN TEMP LOCATION ADA MD17 IF THE EQUIPMENT TYPE-CODE SSA,RSS IS > 16 (MAG.TAPE,ETC.), JMP T0END THEN AVOID WRITING AN END-OF-FILE. JSB EXEC DO A PAGE EJECT, OR GENERATE LEADER. DEF *+4 DEF B3 DEF SET TEMP WHERE FUNCTION CODE LOCATED DEF M1 FORCE A PAGE EJECT T0END CLA SPECIFY TYPE 0 OPEN STA FERR CLEAR ERROR CODE JMP TYP0,I * SET NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SET,I * INDEF DEF INDCB T0DCB NOP EQT5 NOP MD17 DEC -17 MD15 DEC -15 B4 OCT 4 B12 OCT 12 B23 OCT 23 B37 OCT 37 B100 OCT 100 B300 OCT 300 B1000 OCT 1000 B1001 OCT 100001 B1100 OCT 1100 D60 DEC 60 * FILNM ASC 5,FILE NAME? * SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB FC>WNLHRET * DEF *+5 * DEF DCB ADDRESS * DEF SIZE * DEF TYPE * DEF SUBFUNCTION FOR READ/WRITE IN CASE A TYPE 0 FILE * * ASSUMES THAT PARS2+1=FILE NAME * PARS3+1=SECURITY CODE * PARS4+1=LU * SPC 1 CDCBA NOP CSIZ NOP CTYP NOP CSBUF NOP FCRET NOP JSB .ENTR DEF CDCBA JSB FOPEN GO TRY TO OPEN THE FILE DEF *+3 DEF CDCBA,I DEF CSBUF,I SZA,RSS TYPE 0? JMP FCRET,I YES...RETURN JSB CLOSE IF NOT CLOSE FILE IF OPEN DEF *+3 DEF CDCBA,I DEF FERR JSB CREAT TRY CREATING THE FILE DEF *+8 DEF CDCBA,I DEF FERR DEF PARS2+1 DEF CSIZ,I DEF CTYP,I DEF PARS3+1 DEF PARS4+1 JMP FCRET,I N SKP * * SUBROUTINE TO CLOSE A FILE * USED TO DETERMINE IF CLOSING A DUMMY TYPE 0 * CALLING SEQUENCE * JSB FCLOS * DEF *+3 * DEF DCB ADDRESS * DEF TRUNCATE OPTION (DEFAULT IS ZERO) * * CLDCB NOP COPTN DEF ZERO FCLOS NOP JSB .ENTR DEF CLDCB LDA CLDCB,I GET DIRECTORY DISC ADDRESS SZA,RSS IF ZERO JMP FCLS1 THEN DUMMY DCB JSB CLOSE ELSE DO STANDARD CLOSE DEF *+4 DEF CLDCB,I DEF FERR DEF COPTN,I JMP FCLOS,I FCLS1 LDA DFZER RESET THE OPTION WORD STA COPTN IN CASE NOT SUPPLIED NEXT TIME LDA CLDCB ADA D9 CLB STB A,I LDA CLDCB SEE IF LIST DCB CPA LDCBA RSS YES IT IS CPA ADCBA ABSOLUTE OUTPUT DCB? RSS YES. SKIP TO PROCESS END-OF-FILE. JMP FCLOS,I NO ADA B4 STA FCLS2 SAVE FOR EXEC CALL JSB EXEC PROCESS END-OF-FILE FOR THE DEVICE. DEF *+4 DEF B3 CONTROL REQUEST FCLS2 NOP LU & EOF SUBFUNCTION. DEF M1 PAGE EJECT CODE JMP FCLOS,I AND RETURN * * ZERO OCT 0 D9 DEC 9 * SKP * SUBROUTINE TO CLOSE THE ABSOLUTE OUTPUT FILE * * CALLING SEQUENCE * JSB CLSFI * NORMAL RETURN * * THIS ROUTINE WILL DELETE UNUSED FILE AREA * CLSFI NOP LDA ABDCB+5 GET #SEC MPY ABDCB+15 MULT. BY THE CURRENT EXTENT NO. STA TMP LDA ABDCB+3 TRK CMA,INA ADA ABDCB+10 CTRK - TRK MPY ABDCB+8 (CTRK - TRK) * #SEC/TR LDB ABDCB+4 CMB,INB ADA B (CTRK - TRK) * #S/TR - SEC ADA ABDCB+11 (CTRK - TRK) * #S/TR - SEC + CSEC ADA TMP ADD IN NUMBER OF EXTENTS ARS CONVERT TO NUMBER OF BLOCKS LDB ABDCB+5 GET NUMBER OF SECS CLE,ERB CONVERT TO BLOCKS CMA,INA SET CURRENT BLOCK NEG AD`B A # OF BLKS - CURRENT BLK CCA ADB A ONE MORE FOR GOOD MEASURE STB TMP JSB FCLOS DEF *+3 ADCBA DEF ABDCB ADDRESS OF ABSOLUTE-OUTPUT DCB DEF TMP JMP CLSFI,I * TMP NOP * * TYPE-CODE CONVERSION FOR DVR05(2640/44) SUBCHANNEL SPECIFICATIONS. * TYPE5 NOP ENTRY/EXIT: EQUIP. TYPE <05> PROCESSING. LDA PARS2+1 GET THE CONWORD. AND B77 ISOLATE THE LOGICAL UNIT NUMBER. ADA M1 SUBTRACT ONE FOR DRT INDEXING. ADA DRT CALCULATE THE POSITION IN THE DRT. LDA A,I GET THE DRT ENTRY. ALF,RAL POSITION SUBCHANNEL TO BITS #4-0. AND B37 ISOLATE THE SUBCHANNEL. STA B SAVE IT TEMPORARILY. SZA,RSS IF THE SUBCHANNEL IS ZERO, THEN RETURN JMP TYPE5,I TO SIMULATE A TYPE <00> DEVICE. LDA B23 PREPARE TO SIMULATE A TYPE <23> DEVICE. CPB B4 IF THE SUBCHANNEL IS FOUR, THEN LDA B12 SIMULATE A TYPE <12> DEVICE. JMP TYPE5,I RETURN--DEVICE TYPE: <12>,LP OR <23>,MT * SKP * SUBROUTINE TO PRINT COMMAND AND ACCEPT * INPUT. * CALLING SEQUENCE * JSB PRMT * DEF *+6 * DEF PRINT MESSAGE BUFFER * DEF LENGTH (IN SIO FORMAT) * DEF REPLY ADDRESS * DEF LENGTH (IN + # OF CHARACTERS) * DEF PARSE BUFFER * * A REG= + NUMBER OF CHARACTERS * PMEMB NOP PMEML NOP PRADD NOP PRLEN NOP PPARS NOP PRMT NOP JSB .ENTR DEF PMEMB CLA,INA SET THE STA PRMFL PROMPT-IN-PROCESS FLAG. PRMT1 LDB PMEMB GET BUFFER ADDRESS LDA PMEML,I GET LENGTH JSB PRINT PRINT QUESTION LDA PRLEN,I GET LENGTH INA CONVERT TO WORDS CLE,ERA STA PRMTA SAVE LENGTH CMA,INA CONVERT TO NEGATIVE WORD COUNT STA PRMTB SAVE IN TEMP LDB PRADD GET ADDRESS WHERE TO SPACE FILL LDA C4040 SPACE WORD STA B,I INB ISZ PRMTB DONE? JMP *-3 NO JSB READF GO GET INPUT DEF *+6 DEF INDCB FROM INPUT DEVICE DEF FERR DEF PRADD,I DEF PRMTA DEF PRMTB JSB FILCK SEE IF WE HAD A FILE ERROR JSB GTOUT WE...GET OUT JSB BRKCK SEE IF WE WANT OUT LDA PRMTB GET LENGTH FOR PRINT ON FILE SSA,RSS IS IT A END OF FILE JMP PRMT2 NO LDA TR YES GO SIMIULATE A TR STA PRADD,I COMMAND TO POP LDA PRADD THE STACK LDB B2 JMP PRMT3 * PRMT2 CLE,ELA CONVERT TO CHARACTERS STA PRMTB SAVE THE LENGTH. LDB #ECHO IF THE ECHO FLAG SZB IS OFF, JMP PRMTX THEN BYPASS COMMAND LOGGING. LDB PRADD GET INPUT JSB LOUT WRITE IT ONTO OUTPUT FILE PRMTX LDA PRADD,I SEE IF THEY WANT OUT? CPA !! JSB GTOUT YES...GET OUT AND MASK CHECK FIRST CHAR FOR AN * CPA ASTER MEANING A COMMENT JMP PRMT1 GOTO NEXT COMMAND LDA PRADD,I GET AGAIN JSB PARSE DEF *+4 DEF PRADD,I DEF PRMTB DEF PPARS,I LDB PPARS GET FIRST 2 CHARS. INB LDA B,I CPA TR TRANSFER COMMAND? RSS JMP PRMT4 NO - GO EXIT INB YES, BUT CHECK FURTHER FOR A LDA B,I FOR A BLANK OR COMMA AND MASK IN CHAR 3 CPA BLANK JMP PRMT5 CPA COMMA RSS JMP PRMT4 PRMT5 LDA PRADD GET BUFFER ADDRESS LDB PRMTB GET LENGTH PRMT3 JSB TRCHK GO DO TR THING JMP PRMT1 GO RETRY COMMAND PRMT4 CLB CLEAR THE STB PRMFL PROMPT-IN-PROCESS FLAG. LDA PRMTB GET ACTUAL REPLY LENTH JMP PRMT,I AND RETURN SPC 1 C4040 ASC 1, !! ASC 1,!! TR ASC 1,TR PRMTA NOP PRMTB NOP ASTER OCT 25000 ASTERIwASK IN HIGH MASK OCT 177400 BLANK OCT 020000 COMMA OCT 026000 PRMFL NOP PROMPT FLAG: 0 =NONE, 1= IN PROCESS. SKP * SUBROUTINE TO DETERMINE IF STACK IS TO * BE PUSHED OR POPPED * * IF PUSHED, IT CLOSES THE CURRENT FILE, * SAVES RC,AND OPENS NEW FILE * * IF POPPED, IT CLOSES THE CURRENT FILE, * OPENS THE PREVIOUS FILE, AND POSITIONS * IT TO THE PROPER RECORD. * TRCHK NOP STB PRMTB SAVE LENGTH STA TRCH1 SET BUFF ADDR. JSB PARSE GO REPARSE DEF *+4 TRCH1 NOP DEF PRMTB DEF PARSB LDA PARS2 GET FILE TYPE SZA IF NOT NULL JMP TR3 GO TO PUSH * TR1 JSB FCLOS CLOSE THE CURRENT FILE DEF *+3 DEF INDCB DFZER DEF ZERO JSB POP GO POP STACK JSB GTOUT ERROR, NO MORE ENTRIES STA RC SAVE RECORD COUNT JSB FOPEN OPEN PREVIOUS FILE DEF *+3 DEF INDCB DEF B400 JSB FILCK JMP TRCHK,I LDA INDCB+2 GET TYPE SZA,RSS IF TYPE 0 JMP TRCHK,I EXIT LDA RC GET RECORD COUNT CMA,INA SET NEGATIVE AND STA COUNT SAVE TR2 ISZ COUNT ARE WE THERE YET? RSS JMP TRCHK,I YES...GET OUT JSB READF READ A RECORD DEF *+6 DEF INDCB DEF FERR DEF PRADD,I DEF ZERO DEF RL LDA RL SSA IF EOF...POP STACK JMP TR1 JMP TR2 GET NEXT RECORD SKP * * PLACE NEW INPUT FILE ON STACK AND PUSH * TR3 LDA INDCB+14 GET REC NUMBER OF NEXT RECORD STA RC SAVE AS CURRENT RECORD # JSB FCLOS GO CLOSE THE FILE DEF *+3 DEF INDCB DEF ZERO LDA RC GET RECORD COUNT JSB PUSH GO PUSH STACK JSB GTOUT ERROR STACK OVERFLOW JSB FOPEN GO OPEN NEW FILE DEF *+3 DEF INDCB DEF B400 JSB pFILCK NOP JMP TRCHK,I AND RETURN * * COUNT NOP RC NOP RL NOP SKP * * SUBROUTINE TO PUSH AND POP A STACK * STACK DEFINITION * WORD 4= RECORD COUNT FOR NEXT RECORD TO READ * WORD 3= 0 ELSE CH5&CH6 * WORD 2= 0 ELSE CH3&CH4 * WORD 1= LU ELSE CH1&CH2 * WORD 0= TYPE...1=TYPE 0, 2=REGULAR * * PUSH-PLACES FILE NAME AND TYPE ON STACK * LEAVES POINTER AT RECORD COUNT (WORD 4) * ASSUMES PARS2 CONTAINS INFO NEEDED * CALLING SEQUNCE * LDA RC OF CURRENT FILE * JSB PUSH * ERROR RETURN STACK OVERFLOW * NORMAL RETURN * SPC 1 PUSH NOP STA P:TR,I SAVE CURRENT RECORD COUNT ISZ P:TR INCREMENT TO BEGINNING OF NEXT ENTRY LDA ENDST GET END OF STACK ADDRESS CPA P:TR IF = JMP PUSH,I THEN OVERFLOW DLD PARS2 SAVE TYPE DST P:TR,I ISZ P:TR ISZ P:TR DLD PARS2+2 STORE CHARS 3-6 DST P:TR,I ISZ P:TR ISZ P:TR ISZ PUSH SET FOR NORMAL RETURN JMP PUSH,I AND RETURN SKP * * SUBROUTINE THAT MOVES THE POINTER TO PREVIOUS * STACK ENTRY * PLACES RECORD COUNT IN A REG * LEAVES POINTER AT REC. COUNT * * CALLING SEQUENCE * JSB POP * ERROR RETURN * NORMAL RETURN * A REG=REC. COUNT * SPC 1 POP NOP LDA P:TR GET CURRENT POINTER ADA MD9 DECREMENT TO PREVIOUS ENTRY LDB STKAD GET STACK ADDRESS CMB,INB ADB A IF CURRENT LESS THAN SSB START OF STACK JMP POP,I NO MORE ENTRIES STA P:TR SET AS NEW POINTER DLD P:TR,I GET OLD ENTRY DST PARS2 ISZ P:TR INCREMENT TO WORDS 3 AND 4 ISZ P:TR DLD P:TR,I DST PARS2+2 ISZ P:TR ISZ P:TR LDA P:TR,I GET RECORD COUNT ISZ POP GET NORMAL RETURN JM'P POP,I AND RETURN SPC 2 STKAD DEF STACK BSS 1 STACK BSS 25 ENDST DEF * P:TR DEF STACK-1 MD9 DEC -9 SKP * * FILE CHECK ROUTINE * CALLING SEQUENCE * JSB FILCK * ERROR RETURN * NORMAL RETURN * MUST SEND ERROR PRAM TO FERR * FILCK NOP LDA FERR SSA,RSS ANY ERRORS? JMP FNOER CMA,INA SET POS FOR CONVERT STA FERR JSB CNUMD GET DEC ERROR CODE DEF *+3 DEF FERR DEF FERMA ERROR MESSAGE ADDRESS LDA FERMA+2 GET LAST TWO CHARACTERS STA FERMA SAVE FOR MESSAGE LDA D14 LDB FILEA JSB PRINT SEND ERROR TO USER RSS FNOER ISZ FILCK GET NORMAL RETURN IF NO ERROR JMP FILCK,I AND RETURN SPC 2 FILEA DEF *+1 ASC 5,FILE ERROR ASC 1, - FERMA ASC 4, FERR NOP D14 DEC 14 SKP * * SUBROUTINE TO CHECK IF WE SHOULD ABORT * CALLING SEQUENCE * JSB BRKCK * NORMAL RETURN * NOTE: * ROUTINE WILL NOT RETURN IF WE WANT OUT * BRKCK NOP JSB IFBRK DEF *+1 SZA,RSS WANT OUT? JMP BRKCK,I NO JSB GTOUT YES SKP * SUBROUTINE USED TO OBTAIN MODULE'S LENGTH. * CALLED FROM NAM RECORD PROCESSOR IN SLAG2. * CALL: JSB SIZE * RETURN: (A) = LENGTH, OR A NEG # IF ANY ERROR. * SIZE NOP ENTRY TO GET SIZE OF CURRENT MOD LDA NBUF9 GET WORD 7 FROM NAM RECORD. SSA,RSS IS THIS MOD ASMB, FTN OR ALGOL ? JMP SIZE,I ASMB, NBUF+9 HAS GOOD SIZE. LDA RLDCB+2 GET FILE TYPE FROM DCB. SZA SKIP IF TYPE 0. JMP SIZE0 GO CALCULATE SIZE. LDA NBUF9 GET SIZE WORD AGAIN. CPA M1 IS IT ALGOL ? JMP *+3 YES. ELA,CLE,ERA NO, CLEAR SIGN BIT. JMP SIZE,I RETURN WITH FTN'S (BAD) GUESS. CLA ALGOL MODULE SO TURN OFF LOCAL MODE. STA CPLML JMP SIZE ,I RETURN. SIZE0 JSB LOCF GET CURRENT FILE POSITION. DEF *+4 DEF RLDCB DEF SERR DEF SREC LDA SERR ERROR ? SSA,RSS JMP SIZE,I YES, RETURN NEG #. SIZE1 JSB READF READ DEF *+5 NEXT DEF RLDCB RECORD'S DEF SERR FIRST DEF SBUFR FOUR DEF SLNTH WORDS. LDA SERR ERROR ? SSA,RSS JMP SIZE,I YES, RETURN NEG #. LDA WORD2 ISOLATE CLB IDENT OF RRR 13 RECORD. CPA THREE DBL TYPE ? JMP SIZE2 YES. CPA FIVE END TYPE ? JMP SIZE3 YES. JMP SIZE1 NEITHER, GO GET NXT RECORD. SIZE2 LDB WORD2 IS DATA LSR 7 TO BE ON SSA,RSS BASE OR CURRENT PAGE. JMP SIZE1 BASE, DON'T INCLUDE IN SIZE. LSL 1 DUMP Z/C BIT. CLB ZERO OUT FOR SHIFT. LSR 10 GETS # INSTR WORDS INTO A. ADA WORD4 ADD RELOCATION BASE. STA SIZE5 TUCK IT AWAY. JMP SIZE1 BACK TO GET NEXT RECORD. SIZE3 JSB APOSN REPOSITION DEF SIZE4 THE DEF RLDCB FILE. DEF SERR DEF SREC SIZE4 LDA SERR ERROR ? SSA,RSS JMP SIZE,I YES, RETURN NEG #. LDA SIZE5 NO, RETURN JMP SIZE,I THE SIZE. SIZE5 BSS 1 TEMPORARY STORAGE. SERR BSS 1 SREC BSS 1 SBUFR BSS 4 SLNTH DEC 4 WORD1 EQU SBUFR WORD2 EQU SBUFR+1 WORD3 EQU SBUFR+2 WORD4 EQU SBUFR+3 THREE DEC 3 FIVE DEC 5 * * CONSTANTS TABLES WHAT NOT * SPC 3 . EQU * PARS1 BSS 4 .. EQU * PARS2 BSS 1 PRS21 BSS 1 PRS22 BSS 1 PRS23 BSS 1 PARS3 BSS 1 PRS31 BSS 3 PARS4 BSS 1 PRS41 BSS 3 PARS5 BSS 1 PRS51 BSS 3 SPC 1 ORG . PARSB BSS 34 ORG .. PARSA BSS 34 SPC 3 PNAMA DEF PNAME * PNAME NOP NOP NOP BSS 3 PRAMS DEC 3 DEC 99L0.* REP 6 NOP * SPC 2 * FWAM NOP TO BE CALCULATED AT RUN TIME LST NOP # OF ENTRY PT ENTRYS LSTPX OCT 0 HOLDS ENTRY COUNTER(NEG. #+1). LST1 OCT 0 LST2 OCT 0 LST3 OCT 0 LST4 OCT 0 LST5 NOP CPLMG NOP CURRENT PAGE LINK MODE GLOBAL FLAG. * 0 => BASE PAGE (DEFAULT), 1 => CURRENT PAGE MODE. CPLML NOP CURRENT PAGE LINK MODE LOCAL FLAG. * 0 => LOCAL MODE OFF, 1 => LOCAL MODE ON, -1 => BUFFER FULL. * * * RELOCATION BASE TABLE ( RBT ) * * THE ORDER OF THESE ENTRIES MUST BE MAINTAINED RBTO DEF LOCC RBTA DEF B0 B0 NOP ABSOLUTE RELOCATION BASE LOCC NOP PROGRAM RELOCATION BASE BPLOC NOP BASE PAGE RELOCATION BASE COMOR OCT 0 COMMON RELOCATION OCT 0 ABSOLUTE * * THE FOLLOWING CORE IS THE USER'S MEMORY TABLE. * .MEM. DEF *+1 USER'S MEMORY TABLE .MEM1 OCT 100 SET DEFAULT FWABP .MEM2 OCT 1647 " " LWABP .MEM3 OCT 2000 " " FWAM .MEM4 OCT 17677 " " LWAM .MEM5 NOP " " FWAC .MEM6 NOP " NOP LWAC SPC 2 * ?XFER NOP DRT EQU 1652B ADDRESS OF DEVICE REFERENCE TABLE. LWAM EQU 1777B RTE TELLS US END OF CORE LISTO NOP NAMR. NOP PLKS NOP UEXFL NOP COML NOP SPC 2 * * I-O LU # * CMDLU EQU PARS2+1 SPC 1 * * PRINT BUFFER * OTBUF ASC 1, BSS 39 SPC 4 * * DEFINE DCB'S * ABDCB BSS 144 LSDCB BSS 144 RLDCB BSS 144 INDCB BSS 3 INDB3 BSS 141 SPC 2 END EQU * END START }0 Gb 91700-18139 1612 S 0422 DS1/B CCE MODULE: SCGN1              H0104 EASMB,R,L,C HED SCGN1 91700-16139 REV.A 760317 * (C) HEWLETT-PACKARD CO. 1976 * NAM SCGN1,5 91700-16139 REV.A 760317 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ************************************************** * *SCGN1 RTC GENERATOR SEGMENT * *SOURCE PART # 91700-18139 REV.A * *REL PART # 91700-16139 REV.A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-29-74 * *MODIFIED BY: K.HAHN, [ C.C.H. CLEAR EQTX BUFFER ] * [ J-P B. END OF IDSEG LIST ] * *DATE MODIFIED: 6-27-75 [02-16-76] * [03-17-76] * *************************************************** ************************************************** A EQU 0 B EQU 1 SUP * * THE TERM RTS/2100 IS SYNONYMOUS WITH RTE-C, AND * THE TERMS ARE USED INTERCHANGEABLY THROUGHOUT * THIS DOCUMENT. * * SKP * * * * * * RTSGN PROGRAM TABLE FORMAT (IDENTS) * * WORD 1: IP1 - NAME 1,2 * WORD 2: IP2 - NAME 3,4 * WORD 3: IP3 - NAME 5,SC * * SC = 0 PROGRAM HAS BEEN LOADED * = XX (OCTAL) INT PRG * * * LST FORMAT * * WORD 1: LST1 - NAME 1,2 * WORD 2: LST2 - NAME 3,4 * WORD 3: LST3 - NAME 5, ORDINAL * WORD 4: LST4 - IDENT ADDRESS * WORD 5: LST5 - BP LINK ADDRESS * * * * ENTERNS AND EXTERNS * * * EXT LST,PLK,PLKS,?XFER,LSTI,LSTP EXT .MEM.,PRCMD EXT UEXFL,SSTBL,.MEM3 EXT LST1,LST2,LST3,LST4,LST5 EXT .MEM1,.MEM4 EXT .MEM2,.MEM5,.MEM6,NAMR.,LISTO EXT PARSA EXT dPNAME,PNAMA EXT EXEC,LOCC,BPLOC,PRINT EXT PRMT,GTOUT,ABDCB EXT FCRET,WRITF,FCLOS,CLSFI EXT FILCK,FERR,SWAPR,LSDCB,CMDLU EXT ENDLU,LOUT,INDCB * * * .XFER EQU ?XFER * * * .MEM. TABLE DEFINITIONS * * .MEM1 = FWABP * .MEM2 = LWABP * .MEM3 = FWAM * .MEM4 = LWAM * .MEM5 = FWAC * .MEM6 = LWAC * * * * ERROR CODES * * TB: SYMBOL TABLE/ID SEG OVERFLOW * NA: PARAMETER NAME ERROR * PA: PARAMETER ERROR * PR: PARAMETER PRIORITY ERROR * IN: PARAMETER EXECUTION INTERVAL ERROR * CH: INVALID CHANNEL NUMBER * DR: INVALID DRIVER NAME * LU: INVALID DEVICE REFERENCE NUMBER * EQ: INVALID EQT. NO. IN INT RECORD * AD: INVALID ENTRY POINT * DU: DUPLICATE PROGRAM NAME SKP * * WDCNT BSS 1 TEMPORARY WORD COUNTER BIDNT BSS 1 ADDR OF FIRST IDENT * MAXC BSS 1 MAX CHAR COUNT TCHAR BSS 1 TEMPORARY CHAR SAVE AREA OCTNO BSS 1 OCTAL DIGIT PIOC BSS 1 ADDR. OF PRIVILEGED I/O CARD $$ TBCHN BSS 1 TIME BASE GENERATOR CHNL * ID5 BSS 1 PRIORITY ID6 BSS 1 RESOLUTION CODE ID7 BSS 1 EXECUTION MULTIPLE ID8 BSS 1 HOURS ID9 BSS 1 MINUTES ID10 BSS 1 SECONDS ID11 BSS 1 TENS OF SECONDS * * CURAL BSS 1 SETAD BSS 1 ABSOLUTE OUTPUT BUFFER ADDRESS * SPC 1 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 IPXSV BSS 1 SRISV BSS 1 IP1 BSS 1 IP2 BSS 1 IP3 BSS 1 SYMAD BSS 1 FWASM CURAT BSS 1 CURRENT TBUF ADDRESS TCNT BSS 1 CURRENT TBUF COUNT TBUF BSS 4 TEMPORARY BUFFER PPREL BSS 1 TBREL BSS 1 * KEYAD BSS 1 ADDRESS OF KEY WORD TABLE KEYCN BSS 1 TOTAL KEYWORD COUNT * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * ASQT BSS 1 ADDR OF DEVICE REFERENCE TABLE CSQT BSS 1 NO. ENTRIES IN DEV. REF. TABLE *  A$CIA BSS 1 ADDRESS OF $CIC ROUTINE PROCT BSS 1 NO. OF INT. ENTRIES STRAD BSS 1 $STRT START ADDRESS * * IDSAD BSS 1 SYSAD BSS 1 IDNOS BSS 1 ACTUAL ID'S FILLED STRPN BSS 3 START UP PROG NAME AINT BSS 1 ADDRESS OF INTERRUPT TABLE CINT BSS 1 NO. ENTRIES IN INTERRUPT TABLE * * * TEMPL BSS 1 TEMPH BSS 1 TEMPS BSS 1 * PARNO BSS 1 PARAMETER RECORD LENGTH * IOADD BSS 1 I/O ADDR (CHANNEL NO.) IN EQT IODMA BSS 1 I/O DMA FLAG IN EQT IOBUF BSS 1 I/O BUFFERING FLAG IN EQT IOTYP BSS 1 I/O DRIVER TYPE IN EQT (OCTAL) DFLAG BSS 1 DMA-IN FLAG FOR EQT BFLAG BSS 1 BUFFERING-IN FLAG FOR EQT TFLAG BSS 1 TIME-OUT ENTRY FLAG FOR EQT INTCH BSS 1 INT RECORD CHANNEL NO. LSTSV BSS 1 LST COUNT SAVE FOR REL UPDATE I.XX BSS 1 DRIVER ENTRY POINT C.XX BSS 1 DRIVER EXIT POINT TIMWD BSS 1 RANAD BSS 1 * DRANG BSS 1 DIGIT RANGE LWABP BSS 1 DIFLG BSS 1 DATA-IN FLAG = -1/0 = NOT IN/IN CMFLG BSS 1 COMMA FLAG = -1/0 = NOT IN/IN BUFUL BSS 1 BUFFER U/L FLAG LBLAD BSS 1 MEMAD BSS 1 EPRGT BSS 122 BUFFER FOR UP TO 25 PROGS SPRGT BSS 3 END OF BUFFER SPC 2 * * HERE IS THE END OF AREA THAT NEEDS TO BE SAVED * MAKE SURE BSS FOR OTHER SEGMENTS AT LEAST THIS * BIG...BSSIZ=THAT SIZE * BSSIZ EQU * SKP * PRINT: ERR XX * * THE ERROR SUBROUTINE IS USED TO PRINT THE DIAGNOSTICS * FOR ALL ERROR MESSAGES. * * CALLING SEQUENCE: * A = 2-CHAR ASCII ERROR CODE * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP PRINT ERROR MESSAGES STA AMERR+3 SET ERROR CODE INTO MESSAGE LDA P6 LDB AMERR AMERR = MESSAGE ADDRESS JSB PRINT PRINT ERROR MESSAGE JMP ERROR,I RETURN * AMERR DEF *+1 ASC 3,ERR qERROR MESSAGE = ERR + CODE SKP * * SET DATA TO ABS TAPE * * ROUTINE TO RESERVE AND SET CORE ON THE * LOADER PRODUCED ABSOLUTE OUTPUT. * * CALLING SEQUENCE: * A = FINAL STARTING ADDRES * B = FINAL ENDING ADDRESS * * SETAD = ADDRESS OF THE OUTPUT DATA BUFFER * * JSB SETCR * * RETURN: A AND B ARE DESTROYED * SETCR NOP STA TEMP1 CMA,INA ADA SETAD BUFFER ADDRESS STA PLKS OFFSET ADDRESS LDA TEMP1 STARTING ADDRESS JSB PLK OUTPUT ROUTINE IN THE LOADER JMP SETCR,I * SKP * * THE IPX ROUTINE ADDRESSES THE CURRENT 3 WORD ENTRY * IN THE INTERRUPT PROGRAM TABLE FROM THE ADDRESS OF * THE CURRENT ENTRY (BIDNT) . THE TABLE START ADDRESS * IS LWAM * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IPX * * RETURN, CONTENTS OF A AND B ARE DESTROYED * IPX NOP LDA BIDNT BUILD POINTERS STA IP1 INA STA IP2 INA STA IP3 ADA N5 STA BIDNT JMP IPX,I * * CLEAR BUFFER TO CALLING SEQ+1 * * THE BUFCL SUBROUTINE STUFFS A 64 WORD BUFFER WITH CALL+1 * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF BUFFER * JSB BUFCL * CALL+1 = DATA TO BE STUFFED * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * BUFCL NOP LDA N64 STA WDCNT SET BUFFER LENGTH = 64 LDA BUFCL,I GET STUFF DATA STA B,I CLEAR BUFFER WORD INB ISZ WDCNT ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING ISZ BUFCL JMP BUFCL,I RETURN * * ROUTINT TO COMPARE TWO NAME BUFFERS * * * CALLING SEQUENCE: * A = ADDRESS OF SOURCE NAME- 3 ENTRIES * B = ADDRESS OF TABLE 3 ENTRIES * JSB NACMP * * RETURN: A AND B ARE DESTROYED * (N+1) NAMES DO NOT COMPARE * (N+2) NAMES COMPARE * NACMP NOP STA TEMP1 SAVE SOURCE ADDRESS V STB TEMP2 SAVE TABLE ADDRESS LDA N2 LOOP COUNT STA TEMP3 NACM1 LDA TEMP1,I SOURCE ENTRY CPA TEMP2,I TABLE COMPARE RSS YES,COMPARE, LOOK NEXT JMP NACMP,I NO IT DOESN'T RETURN ISZ TEMP1 BUMP SOURCE ISZ TEMP2 BUMP TABLE ISZ TEMP3 JMP NACM1 TRY AGAIN LDA TEMP2,I FIRST TWO COMPARE, LOOK LAST AND M7400 LOOK UPPER ONLY STA B LDA TEMP1,I AND M7400 CPA B ISZ NACMP BUMP RETURN FOR COMPARE! JMP NACMP,I * * * SET INITIAL IPX ADDRESS * * INIPX SETS THE ADDRESS OF THE FRIST ENTRY IN THE * PROGRAM IDENT TABLE AS THE CURRENT ADDRESS. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INIPX * * RETURN: A AND B ARE DESTROYED * INIPX NOP LDA SPRGA GET START OF PROGRAM TABLE STA BIDNT JMP INIPX,I SKP * ALBUF DEF LBUF ATBUF DEF TBUF APNAM DEF PNAMA SPRGA DEF SPRGT EPGTA DEF EPRGT-1 * * * ERR09 ASC 1,NA PARAMETER NAME ERROR ERR10 ASC 1,PA PARAMETER ERROR ERR12 ASC 1,IN PARAMETER INTERVAL ERROR ERR24 ASC 1,CH INVALID CHANNEL NO. IN EQT REC ERR25 ASC 1,DR INVALID DRIVER NAME ERR27 ASC 1,LU INVALID DEVICE REF. NO. ERR31 ASC 1,EQ INVALID EQT NO. IN INT RECORD ERR33 ASC 1,AD INVALID ENTRY POINT IN INT RECORD PTERM ASC 1,EN ERRDU ASC 1,DU COMMA OCT 54 COMMA IJSB JSB 0,I I-JSB CODE FOR INTERRUPT LOCS UASCZ OCT 30000 UPPER ASCII ZERO CHAR CHARD OCT 104 ASCII CHAR D CHARB OCT 102 ASCII CHAR B CHART OCT 124 ASCII CHAR T BIT14 OCT 40000 BIT 14=1 CHAVR ASC 1,VR CHRPR ASC 1,PR REQT ASC 1,RE RDRT ASC 1,RD RINT ASC 1,RI CHREN ASC 1,EN CHRAB ASC 1,AB UTCHR ASC 1,T USCHR ASC 1,S ERR11 EQU CHRPR PARAMETER PRIORITY ERROR CHREQ EQU ERR31 MES28 DEF MS28 * MES25 DEF *+1 ASC 4,EQT TBL * MES26 DEF *+1 p ASC 4,DRT TBL ASC 3, LU# * MES42 DEF *+1 ASC 4,#ID SEG? MES41 DEF *+1 ASC 5,PRIV. INT? MES2 DEF *+1 ASC 6,REL SYS MODS MES3 DEF *+1 ASC 6,REL RES LIB MES12 DEF *+1 ASC 4,INT PRGS MES13 DEF *+1 ASC 4,IGNORE? * SKP *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * * SYSTEM TABLE DEFINITION * * . EQU 1650B EQTA DEF .+0 FWA OF EQUIPMENT TABLE EQT# DEF .+1 # OF EQT ENTRIES DRT DEF .+2 FWA OF DEVICE REFERENCE TABLE LUMAX DEF .+3 # OF LOGICAL UNITS (IN DRT) INTBA DEF .+4 FWA OF INTERRUPT TABLE INTLG DEF .+5 # OF INTERRUPT TABLE ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD DEF .+7 FWA OF KEYWORD BLOCK * * I/O MODULE/DRIVER COMMUNICATION * EQT1 EQU .+8 ADDRESSES EQT2 EQU .+9 EQT3 EQU .+10 OF EQT4 EQU .+11 EQT5 EQU .+12 CURRENT EQT6 EQU .+13 EQT7 EQU .+14 15-WORD EQT8 EQU .+15 EQT9 EQU .+16 EQT EQT10 EQU .+17 EQT11 EQU .+18 ENTRY EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * CHAN EQU .+19 CURRENT DMA CHANNEL # TBG DEF .+20 I/O ADDRESS OF TIME-BASE CARD SYSTY DEF .+21 EQT ENTRY ADDRESS OF SYSTEM TTY * * SYSTEM REQUEST PROCESSOR /'EXEC' COMMUNICATION * * RQCNT EQU .+22 # OF REQUEST PARAMETERS -1 RQRTN EQU .+23 RETURN POINT ADDRESS RQP1 EQU .+24 ADDRESSES RQP2 EQU .+25 RQP3 EQU .+26 OF REQUEST RQP4 EQU .+27 RQP5 EQU .+28 PARAMETERS RQP6 EQU .+29 RQP7 EQU .+30 (SET FOR MAXIMUM OF RQP8 EQU .+31 8 PARAMETERS) * * DEFINITION OF SYSTEM LISTS (QUEUES) * * DORMT DEF .+32 ADDRESS OF 'DORMANT' LIST, SKEDD DEF .+33 'SCHEDULE' LIST, SUSP3 EQU .+36 'AVAILABLE MEMORY' LIST, SUSP4 EQU .+37 'DISC ALLOCATION' LIST, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SEGMENT' * * XEQT EQU .+39 ID SEGMENT ADDR. OF CURRENT PROG. XLINK EQU .+40 'LINKAGE' XTEMP EQU .+41 'TEMPORARY (5-WORDS) XPRIO EQU .+46 'PRIORITY' WORD XPENT EQU .+47 'PRIMARY ENTRY POINT' XSUSP EQU .+48 'POINT OF SUSPENSION' XA EQU .+49 'A REGISTER' AT SUSPENSION XB EQU .+50 'B REGISTER' XEO EQU .+51 'E AND OVERFLOW * * SYSTEM MODULE COMMUNICATION FLAGS * * OPATN EQU .+52 OPERATOR/KEYBOARD ATTENTION FLAG OPFLG EQU .+53 OPERATOR COMMUNICATION FLAG SWAP EQU .+54 RT DISC RESIDENT SWAPPING FLAG DUMMY DEF .+55 I/O ADDRESS OF DUMMY INT. CARD IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 DEF .+58 FWA R/T DISC RES. BP LINK AREA BPA2 EQU .+59 LWA R/T DISC RES. BP LINK AREA BPA3 EQU .+60 FWA BKG DISC RES. BP LINK AREA LBORG DEF .+61 FWA OF RESIDENT LIBRARY AREA RTORG DEF .+62 FWA OF REAL-TIME AREA RTCOM DEF .+63 LENGTH OF REAL TIME COMMON AREA RTDRA EQU .+64 FWA OF R/T DISC RESIDENT AREA AVMEM DEF .+65 FWA OF SYSTEM AVAILABLE MEMORY BKORG DEF .+66 FWA OF BACKGROUND AREA BKCOM EQU .+67 LENGTH OF BACKGROUND COMMON AREA BKDRA EQU .+68 FWA OF BKG DISC RESIDENT AREA * * UTILITY PARAMETERS * TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDRESS SFCUN EQU .+79 SOURCE FILE LU AND DISC ADDRESS MPTFL EQU .+80 MEMORY PROTECT ON/OFF FLAG (0/1) FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA DEF .+87 LWA OF MEMORY IN BACKGROUND BP<CLR DEF .+44 SKP * * THIS IS WHERE WE START. *** INITIALIZATION *** * SWPIN NOP THIS IS WHERE CONTROL IS PASSED LDA RSTA WHEN SEGMENT ROLLED IN JMP SWAPR CONTROL IS RETURN TO MAIN WITH A REG=START SPC 1 RSTA DEF RSTRT SPC 1 * * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * TBG CHNL? ENTER 2 OCTAL DIGITS * * PRIV. INT. ENTER 2 OCTAL DIGITS $$ * * FWA BP? ENTER 4 OCTAL DIGITS * * LWA MEM? ENTER 5 OCTAL DIGITS * * FWA SYS MEM? ENTER 5 OCTAL DIGITS * * * RSTRT NOP LDA M2000 SET UP FWAM STA .MEM3 LDA P1647 STA .MEM2 SET LWABP CLA STA LST CLEAR THE SYMBOL TABLE COUNT STA NAMR. LDA LISTO AND N9 CLEAR BIT 3, FOR NEW HEADING STA LISTO * * SET PARAMETER INPUT UNIT * * SET TIME BASE GENERATOR CHANNEL NOP SPACE NEW LINE CHNLT LDA P9 LDB MES30 MES30 = ADDR: TBG CHNL? JSB READ PRINT MESSAGE, GET REPLY LDA P2 SET FOR 2 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP CHNLT REPEAT INPUT STA TBCHN SET TBG CHANNEL NO. * * GET PRIV. INT. CARD ADDR. NOP SPACE NEW LINE $$ DUMY LDA P10 $$ LDB MES41 MES41 = ADDR: PRIV. INT. CARD?$$ JSB READ PRINT MESSAGE, GET REPLY $$ LDA P2 SET FOR 2 OCTAL DIGITS INPUT $$ JSB DOCON GET DIGITS $$ JMP DUMY -ERROR, REPEAT INPUT. $$ STA PIOC SET ADDR. OF DUMMY CARD. $$ * * * * SET FWA BP LINKAGE FWENT NOP SPACE  $ LDA P7 $ LDB MES27 MES27 = ADDR: FWA BP LINKAGE? JSB READ PRINT AND GET REPLY LDA P4 JSB GETOC GET 4 OCTAL DIGITS, CONVERT JMP LNKER INVALID DIGIT ENTERED JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP SETFB YES - SET FWA BP LINKAGE LNKER JSB INERR JMP FWENT REPEAT MESSAGE SETFB LDB OCTNO GET FWA BP SZB,RSS SKIP - VALID (NON-ZERO) FWA BP JMP LNKER REPEAT FWA BP LINKAGE INPUT STB .MEM1 ADB N1 STB LWABP SAVE FOR INT PROCESSOR NOP SPACE NEW LINE * LDA ALBUF SET OFFSET ADDRESS STA SETAD TO THE CLEARED BUFFER LDB ALBUF ADDRESS OF IN BUFFER JSB BUFCL CLEAR BUFFER TO OCTAL ZEROS OCT 0 LDA EQTA START ADDR OF AREA TO BE CLEARED LDB BPCLR END ADDRESS JSB SETCR CLEAR LOWER HALF LDA BPCLR LDB BKLWA JSB SETCR CLEAR UPPER HALF SMLWA LDA P8 LDB MESS3 MESS3 = ADDR: LWA MEM? JSB READ PRINT MESSAGE, GET REPLY LDA P5 SET FOR 5 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP SMLWA REPEAT INPUT LDA OCTNO GET LWAM STA TEMP3 SAVE FOR FWA SYS MEMORY PROCESSING STA SETAD,I PUT IN BUFFER LDA BKORG ADDRESS OF BK LWAM LDB A ADDRESS INTO B JSB SETCR OUTPUT ABSOLUTE LDA BKLWA THE OTHER BP REFERENCE LDB A JSB SETCR OUTPUT TO ABS * NOP SPACE GETAV LDA P12 PRINT: LDB MES34 "FWA SYS MEM? JSB READ GET THE ANSWER LDA P5 SET FOR 5 OCTAL DIGITS. JSB DOCON CONVERT TO OCTAL. JMP SYMER -ERROR. JMP SETAV OK , SET BOUNDARY. * SYMER JSB INERR JMP GETAV -REPEAT REQUEST * SETAV LDA OCTNO IF NUMBER STA WSYMAD SZA,RSS EQ 0, LEAVE FWA JMP SETA1 LDB TEMP3 SUBTRACT ORIG. CMA,INA ADB A NEW VALUE SSB ERROR IF JMP SYMER NEW > LWAM * CLEAR RTS BP AREA LDA SYMAD GET START OF SYS MEMORY ADA N1 ADJUST FOR LWAM RSS SETA1 LDA TEMP3 DEFAULT TO LWAM STA .MEM4 UPPER LOAD BOUNDS * SET PRIV CHAN IN BP LDA PIOC PRIV. INT CHANNEL STA SETAD,I PUT IN BUFFER LDA DUMMY ADDRESS WHERE TO GO IN BP LDB A JSB SETCR GO SET IT IN BP * GO REL SYS MODULES NOP SPACE NEW LINE LDA P12 PRINT: LDB MES2 "REL SYS MODS" JSB PRINT PRINT * RELOCATE FROM RTS/2100 LOADER LDA P2 STA .XFER NON ZERO TO LOAD SYS MODULES CLA GET A ZERO STA PNAME CLEAR NAME FLAG STA LOCC CLEAR LOCC IN LOADER STA BPLOC SAME FOR BPLOC JSB PRCMD GO RELOCATE SYS MODULES JSB GTOUT ERROR FROM LOADER...GET OUT LDA LOCC UPDATE FWAM STA .MEM3 FWAM LDA BPLOC UPDATE FWABP STA .MEM1 LDA LST STA LSTSV SAVE FOR RELOCATION ERROR LDA UEXFL WERE THERE ANY UNDEFINED? SZA,RSS JMP *+4 NO CONTINUE RELSE LDA ERR33 YES,PRINT: JSB ERROR "ERR AD" JMP RSTRT START RTSGN OVER LDB A$STR JSB SSTBL WAS $STRT LOADED? JMP RELSE NO, ERROR, LDA LST4 YES, GET STARTING ADDRESS LDA A,I STA STRAD SAVE IT FOR CLEAN-UP AT END OF RTSGN LDB A$CIC $CIC NAME JSB SSTBL WAS $CIC LOADED? JMP RELSE NO, ERROR, START OVER LDA LST4 BUILD A BP LINK FOR $CIC LDA A,I STA SETAD,I OUTPUT BP LINK LDA .MEM1 FOR $CIC LDB A JSB SETCR LDB LST5 LDA .MEM1 STA A$CIA SAVE FOR JSB INSTRUCTION STA B,I ISZ .MEM1 BUMP TO NEXT LINK JMP GENIO YES, GO BUILD I/O TABLES * * * * NUMERICAL INPUT CONTROL * * THE DOCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., TBG CHANNEL NO., AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB DOCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * DOCON NOP JSB GETOC GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB INERR INVALID DIGIT ENTRY JMP DOCON,I RETURN ISZ DOCON INCR RETURN ADDRESS LDA OCTNO GET CONVERTED NUMBER JMP DOCON,I RETURN SKP * * INVALID TTY RESPONSE * * THE INERR SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INERR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INERR NOP LDA ERR10 SET INVALID DEVICE ERROR CODE JSB ERROR PRINT ERROR MESSAGE JMP INERR,I RETURN * SKP MES27 DEF MS27 MES34 DEF SYMES SYMES ASC 6,FWA SYS MEM? MS27 ASC 4,FWA BP? MESS3 DEF *+1 ASC 5,LWA MEM? MES30 DEF *+1 ASC 5,TBG CHNL? A$STR DEF *+1 ASC 3,$STRT A$CIC DEF *+1 ASC 3,$CIC * CHARX OCT 130 EQXCT NOP XEXTM NOP TEQCT BSS 1 TEQTX BSS 1 AEQTX DEF EQXTB * SKP * * GENERATE I/O TABLES * * THIS SECTION OF CODE GENERATES THE I/O TABLES * FOR THE SYSTEM. THESE INCLUDE THE EQUIPMENT TABLE (EQT), * STANDARD DEVICE REFERENCE TABLE (DRT), AND INTERRUPT TABLE. * * THE EQT RECORDS HAVE THE FOLLOWING FORMAT: * * N1,DVRN2<,D><,B><,T=><,X=> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * X = EQT EXTENSION AREA SIZE * * IF T= IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST NEXT BE ENTERED. * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN OPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * ]NLH FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) 1N* * GENIO CLA STA IDNOS ID'S MADE STA STRPN START UP PROGRAM FLAG STA CEQT NOS OF EQT'S STA PROCT NOS OF INT PROG ENTRIES STA TEQCT #EQTX AREAS OF CONCERN NOP SPACE NEW LINE LDA AEQTX STA TEQTX LDA .MEM3 FWAM STA AEQT EQT STARTING ADDRESS STA PPREL LDA P7 PRINT: LDB MES25 "EQT TBL" JSB PRINT NOP SPACE NEW LINE * SEQT NOP SPACE LDA CEQT EQT COUNT INA LDB MES6A STUFF INTO PRINT BUFFER JSB STFNM LDA P9 PRINT: LDB MES6 "EQT XX =?" JSB READ AND INPUT DRIVER REQUEST LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA PTERM CHARS= END ? JMP SSQTI YES, TRY TO END CPA REQT REPEAT? JMP GENIO YES * JSB GINIT INITIALIZE BUFFER SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,U IOERR LDA ERR24 SET CODE = INVALID CHNL IN EQT JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * CLDBU LDB OCTNO GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS ADB N8 IS CHAN EQ. LESS THAN 10? SSB JMP IOERR YES, CHANNEL ERROR CLA STA TIMWD CLEAR TIME WORD STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF AND A REG. CPA CHRDV CHAR = DV? CCA,RSS YES - CONTINUE JMP DVERR INVALID DRIVER NAME JSB GETNA GET NEXT CHAR IN TBUF AND A REG. CPA ASCR DVRXX ? LDA ASC. ALF,ALF AND M177 CONSERVE ONLY LOWER HALF STA TBUF LDA ASIDR,I AND M7400 IO;R TBUF STA ASIDR,I LDA ASCDR,I AND M7400 IOR TBUF STA ASCDR,I JMP STYPE YES - GET DRIVER TYPE DVERR LDA ERR25 SET CODE = INVALID DRIVER NAME JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD STYPE LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF LDA TBUF STA ASTYP SAVE 2 ASCII CHARS FOR I.XX,C.XX STA ASCYP SAVE FOR C.XX COMPARE CCA ADA CURAL ADJUST CURRENT LBUF ADDR STA CURAL RESET CURAL TO CONVERT TYPE LDA P2 JSB GETOC GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME LDB OCTNO GET DRIVER TYPE BLF,BLF ROTATE TO UPPER B STB IOTYP SET DRIVER TYPE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = BLANK? CCA,RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * STA DFLAG SET DMA-IN FLAG STA TFLAG SET TIME-OUT FLAG STA EQXCT SET EQTX FLAG STA BFLAG SET BUFFERING-IN FLAG * INDBU CCA STA CMFLG SET COMMA FLAG = NO COMMA IN JSB GETAL GET NEXT CHAR FROM LBUF CPA CHARD CHAR = D? JMP SEDMA YES - SET DMA CODE CPA CHARB CHAR = B? JMP SETBU YES - SET BUFFERING CODE CPA CHART CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG CPA CHARX "X" ? JMP STEQX YES, ALLOW EQT EXTENSION UNERR LDA ERR10 SET CODE = INVALID D,B,T JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED JSB GETAL GET NEXT CHAR CPA AEQUL IS IT "=" ? RSS YES ACCEPT TIME VALUE JMP UNERR NO, ITS AN ERROR LDA N5 5 CHAR VALUE JSB GETOC FETCH TIME OUT TIME Vg JMP UNERR NUMBER IS NO GOOD SZA WAS ZERO INPUT? CMA ONE'S COMPLEMENT FOR THAT RTS STA TIMWD SAVE FOR OUTPUT EQTST JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED LDA BIT14 SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * STEQX JSB GETAL GET CHAR CPA AEQUL "="? ISZ EQXCT YES, 1ST TIME THROUGH? JMP UNERR NO, LOSE!! LDA P30 CPA TEQCT ARBITRARY LIMIT <30 EQTX JMP UNERR ENTRIES PER SYASTEM!! LDA N5 GET EQTX AREA SIZE JSB GETOC JMP UNERR NOT # STA EQXCT JMP EQTST * LISCN LDB ASIDR ADDRESS OF I.XX BUFFER JSB SSTBL IS IT IN THE SYMBOL TABLE? JMP DVERR NO LDA LST4 YES, GET THE ADDRESS LDA A,I STA I.XX SAVE FOR OUTPUT LDB ASCDR ADDRESS OF C.XX BUFFER JSB SSTBL IS IT IN SYMBOL TABLE? JMP NOCXX NO, USE ADDRESS OF I.XX LDA LST4 YES, GET ADDRESS LDA A,I STCXX STA C.XX SAVE DRIVER EXIT POINT * LDB ALBUF CLEAR OUTPUT BUFFER JSB BUFCL OCT 0 LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. STA LBUF+3 OUTPUT BUFFER LDA I.XX STA LBUF+1 INT. ADDRESS LDA C.XX STA LBUF+2 COMPLETE ADDRESS * LDA IOTYP GET EQUIPMENT TYPE CODE AND M7000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,I CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE STA LBUF+4 LDA EQXCT SSA,RSS EQTX SPECIFIED? SZA,RSS JMP LISC1 NO. STA LBUF+11 POST @EQT12 STA TEQTX,I ISZ TEQTX LDA PPREL & ADA P12 STA TEQTX,I SAVE EQT13 ADDR ISZ TEQTX FOR LATER USE ISZ TEQCT LISC1 LDA TIMWD WAS A TIME INPUT? SZA STA LBUF+13 YES, SAVE IT IN EQT LDA PPREL GET CURRENT EQT ADDRESS LDB A ADB P14 ADDRESS OF END OF EQT STB PPREL JSB SETCR OUTPUT IN ABS ISZ PPREL BUMP TO NEXT EQT ENTRY ISZ CEQT INCR EQT ENTRY COUNT JMP SEQT PROCESS NEXT EQT RECORD * SPC 1 NOCXX LDA I.XX C.XX NOT FOUND SO USE JMP STCXX I.XX ADDRESS * SSQTI LDA CEQT ANY EQT'S BEEN LOADED? SZA JMP XEQTX YES, CAN END LDA ERR10 NO,AT LEAST ONE REQUIRED JSB ERROR PRINT: "ERR PA" JMP SEQT START OVER * XEQTX LDA TEQCT CMA,INA,SZA,RSS ANY EQTX AREA? JMP SSQT NO, ON TO SQT SETUP STA TEQCT LDB ALBUF GET ADDRESS OF 'LBUF'. JSB BUFCL GO TO CLEAR THE BUFFER, IN NOP PREPARATION FOR PUNCHING EQTX AREA. LDA AEQTX STA TEQTX XEQX1 LDA PPREL POST EQTX ADDR STA LBUF & ADA TEQTX,I RESERVE SPACE STA PPREL LDA TEQTX,I GET THE CURRENT EQTX SIZE, STA EQXCT AND SAVE IT TEMPORARILY. ISZ TEQTX LDA TEQTX,I EQT13=EQTX ADDR ISZ TEQTX LDB 0 JSB SETCR ISSUE NOW * CLA LDB LBUF STB XEXTM STA LBUF * XLOOP LDA EQXCT GET THE EXTENSION SIZE. SZA,RSS PUNCHING COMPLETED? JMP XDONE YES. GO TO PROCESS NEXT EXTENSION. ADA N64 NO.ADD MAX. SIZE OF DUMMY BUFFER. SSA EXTENSION AREA LARGER THAN 'LBUF'? JMP XNEG NO. GO TO PUNCH THE NULL WORDS. STA EQXCT YES. SAVE THE REMAINDER. LDA B GET THE EQT EXTENSION ADDRESS. ADB P63 FORM LAST ADDRESS: THIS RECORD. JSB SETCR GO TO PUNCH THE NULL WORDS. LDB XEXTM GET CURRENT EXTENSION ADDRESS. ADB P64 ADD OFFSET FOR AREA ALREADY PUNCHED. STB XEXTM SAVE ADDRESS OF NEXT AREA TO BE PUNCHED. JMP XLOOP GO BACK TO PUNCH THE REMAINDER. * XNEG LDA B GET THE EQT EXTENSION ADDRESS. ADB N1 COMPUTE THE LAST ADB EQXCT ADDRESS TO BE PUNCHED. JSB SETCR GO TO PUNCH THE NULL WORDS. * XDONE ISZ TEQCT JMP XEQX1 * * * SET DEVICE REFERENCE TABLE (SQT) * SSQT LDA PPREL UPDATE REL ADDRESS STA ASQT SAVE SQT ADDRESS CLA,INA STA CSQT SET SQT COUNT = 1 LDA P13 LDB MES26 MES26 = ADDR: *DEV REF TABLE JSB PRINT PRINT: * DEVICE REFERENCE TABLE * DEVRE LDA CSQT GET CURRENT DEV REF NO. LDB MES28 JSB STFNM STUFF NUM IN BUFFER NOP SPACE NEW LINE LDA P11 LDB MES28 MES28 = ADDR: XX = EQT #? JSB READ GET SQT RECORD FROM TTY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA PTERM CHARS = /E? JMP SINTI YES - SET INTERRUPT TABLE CPA RDRT REPEAT DRT? JMP SSQT YES, START OVER CPA REQT REPEAT EQT? JMP GENIO YES, GO BACK JSB GINIT RE-INITIALIZE LBUF SCAN LDA N3 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP NOSUB IGNOR SUBCHANNEL LDA CMFLG COMMA ENCOUNTERED? SZA YES - GO GET SUBCHANNEL JMP NOSUB NO - DEFAULT IT TO ZERO LDA N2 JSB GETOC GET 2 DEC DIGITS JMP DRERR JSB GETAL GET NEXT CHAR CPA ZERO END OF BUFFER? RSS YES JMP DRERR NO, SHOULD BE BUT ISN'T LDA OCTNO GET SUB CHANNEL CMA,INA ADA P31 SSA <=31 (10) ?? JMP DRERR NO, LOSE!! LDA OCTNO OK, RECOVER SUB-CHANNEL RSS SKIP OVER DEFAULT NOSUB CLA DEFAULT TO ZERO STA TEMPS SAVE SUB CHANNEL ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 15 - 11 STA TEMPH SAVE SUBCHANNEL NO. LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? RSS YES - CONTINUE JMP SETQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. CMA,INA COMPLEMENT CURRENT DEV. REF. NO. LDB AEQT GET ADDRESS OF EQT INA,SZA,RSS SKIP - DEV. REF. NOT 1 JMP *+4 SET TTY CHANNEL NO. = FIRST EQT ADB P15 ADJUST CURRENT EQT ADDRESS INA,SZA SKIP - EQT FOUND JMP *-2 CONTINUE CURRENT EQT SEARCH STB LBUF+1 SET EQT ADDR IN TTY CHANNEL LDA TBCHN TBG CHANNEL STA LBUF PUT IN OUT PUT BUFFER LDA TBG ADDRESS WHERE TO GO LDB SYSTY JSB SETCR OUTPUT IN ABSOLUTE * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. STA LBUF FOR OUTPUT LDA PPREL ABS ADDRESS LDB A JSB SETCR GO BUILD ABS DATA ISZ PPREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT JMP DEVRE GET NEXT SQT ENTRY DRERR LDA ERR27 SET CODE = INVALID DEV. REF. NO. JSB ERROR PRINT DIAGNOSTIC JMP DEVRE REPEAT INPUT * SINTI LDA CSQT HAVE ANY DRT'S BEEN ENTERED? ADA N1 STA CSQT SSA,RSS JMP SINTT YES, GO TO INT PROCESSING JMP DRERR NO, ERROR , START OVER * SKP * ROUTINE TO INPUT TO BUFFER FROM TTY * A REG=LENGTH...POSITVE BYTES, NEGATIVE WORDS * B REG=ADDRESS OF MESSAGE * WILL PUT RESPONSE IN LBUF * * MAKE A CALL TO PRMT * CALLING SEQUENCE IS AS FOLLOWS * JSB PRMT * DEF *+6 * DEF MESSAGE BUFFER ADDRESS * DEF LENGTH OF MESSAGE BUFFER (POSITIVE CHAR) * DEF INPUT BUFFER ADDRESS * DEF MAX LENGTH * DEF ERROR PARSE ADDRESS * READ NOP STA RTMP1 STB RTMP2 SAVE LENGTH AND ADD OF MESSAGE JSB PRMT GO TO MAIN FOR INPUT DEF *+6 RTMP2 NOP DEF RTMP1 DEF LBUF DEF P64 DEF PARSA STA PARNO SAVE LENGTH OF INPUT BUFFER INA CONVERT TO WORD ADDRESS CLE,ERA ADA ALBUF GET TO END OF BUFFER CLB PUT ZERO AT END OF BUFFER STB A,I JSB GINIT INITIALIZE LBUF SCAN JMP READ,I AND RETURN RTMP1 NOP * SKP * * GET CHAR FROM LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * GETNA AND GETOC. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GETAL * * RETURN: * A = CURRENT CHARACTER * B = DESTROYED * GETAL NOP LDA CMFLG CMFLG = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB BUFUL GET U/L FLAG IGNOR LDA CURAL,I GET CHAR FROM LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND M377 ISOLATE LOWER CHAR CPA ZERO END OF BUFFER? JMP GETAL,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ CURAL INCR LBUF ADDRESS CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS STB BUFUL SAVE U/L FLAG CPA COMMA CHAR = COMMA? ISZ CMFLG RESET FLAG TO SHOW COMMA IN JMP GETAL,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP GETAL,I RETURN WITH BLANK SKP * * MOVE ALPHA FROM LBUF TO TBUF * * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM LBUF * TO TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR IS TO * BE MOVED TO THE LOW CHAR IN TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN TBUF. * B = IGNORED * JSB GETNA * * RETURN: * A = FIRST CHAR (IF ONLY 1 CHAR) OR FIRST 2 CHARS MOVED. * B = DESTROYED * GETNA NOP CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. CHARS LDA ATBUF ATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB TBUF CLEAR WORD 1 OF TBUF CCA STA CMFLG SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB GETAL GET CHAR FROM LBUF CPA ZERO END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP OCHAR GET ODD CHAR FROM LBUF LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I YES - RETURN OCHAR JSB GETAL GET CHAR FROM LBUF CPA ZERO  END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I RETURN SKP * OUTPUT ID SEGMENT IN ABS * * GENERATE ID SEGMENT * * THIS ROUTINE WILL BUILD AN ID SEGMENT IN THE OUTPUT * BUFFER (LBUF) AREA. THE BUFFER IS CLEARED AND STUFFED * WITH DATA (FROM THE PNAME TABLE). * * CALLING SEQUENCE: * A = ABSOLUTE ADDRESS OF SEGMENT * B = LIST LINK ADDRESS TO NEXT SEGMENT * JSB GENID * * * RETURN: A CONTAINS THE ADDRESS OF THE ID SEGMENT * (FOR THE OUTPUT) * B IS DESTROYED. * GENID NOP STA IDSAV STB LNKSV LDB ALBUF BUFFER ADDRESS JSB BUFCL CLEAR BUFFER OCT 0 LDA LNKSV GET LINK ADDRESS STA LBUF PUT IN BUFFER LDB PNAMA GET DISPLACEMENT INTO ID SEGMENT ADB P7 GET TO WORD 7 LDA B,I GET PRIORITY SZA,RSS LDA P99 DEFAULT TO 99 STA LBUF+6 LDA .XFER ENTRY POINT STA LBUF+7 LDA PNAME NAME 1,2 STA LBUF+12 LDB PNAMA INB LDA B,I NAME 3,4 STA LBUF+13 INB LDA B,I NAME 5, BLNK AND M7400 MASK OUT BLANK INA MAKE TYPE 1 STA LBUF+14 LDB PNAMA ADB P8 GET TO WORD 8 OF NAM RECORD LDA B,I RESOLUTION ALF,ALF ALF,RAL SHIFT INTO PLACE INB IOR B,I MURGE EXEC MULT STA LBUF+17 PUT IN BUFFER INB LDA B,I HOURS SZA,RSS LDA N24 DEFAULT TO 24 STA LBUF+21 INB LDA B,I MINUTES SZA,RSS J LDA N60 DEFAULT TO 60 STA LBUF+20 INB LDA B,I SECONDS SZA,RSS LDA N60 DEFAULT TO 60 STA LBUF+19 INB LDA B,I TENS OF SEC SZA,RSS LDA N100 DEFAULT TO 100 STA LBUF+18 LDA .MEM3 LOW MAIN STA LBUF+22 LDA LOCC HIGH MAIN STA LBUF+23 LDA .MEM1 LOW BASE STA LBUF+24 LDA BPLOC HIGH BASE STA LBUF+25 LDA LOCC UPDATE FWAM STA .MEM3 FWAM LDA BPLOC UPDATE FWABP STA .MEM1 FWABP CLA STA LOCC CLEAR LOCC STA BPLOC " BPLOC LDA IDSAV ABS ADDRESS JMP GENID,I RETURN * IDSAV BSS 1 LNKSV BSS 1 * * * CONVERT OCT/DEC ASCII TO BINARY * * THE GETOC SUBROUTINE CONVERTS THE NEXT CHARACTERS IN LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB GETOC * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * GETOC NOP LDB L10 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB L12 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA CMFLG SET COMMA-IN FLAG CLA STA OCTNO OCTNO = OCTAL NUMBER GETNX JSB GETAL GET CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA L60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA OCTNO GET PREVIOUS OCTAL NO. ADA A SET A = OCTNO X 2 ADA A SET A = OCTNO X 4 LDB DRANG GET DIGIT RANGE CPB L12 RANGE = DECIMAL? ADA OCTNO SET A = OCTNO X 5 ADA A SET A = OCTNO X 10/8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP GETOC,I RETURN - ERROR SKP * * * ROUTINE TO CONVERT THE OCTAL NUMBER IN A TO * ASCII AND STUFF THE 2 LOW ORDER DIGITS INTO A BUFFER * ADDRESSED BY B. LEADING ZEROS ARE SUPPRESED * * CALLING SEQUENCE: * * A = OCTAL NUMBER * B = BUFFER ADDRESS * * RETURN: A AND B ARE DESTROYED * STFNM NOP STB STFAD SAVE FINAL ADDRESS LDB ATBUF TEMP BUFFER ADDRESS CMA,INA NEG FOR DECIMAL CONVERT JSB CONVD LDA TBUF+2 LEAST 2 DIGITS AND M7400 ISOLATE UPPER CHAR CPA UASCZ CHAR = ASCII ZERO? LDA UBLNK YES, REPLACE WITH BLANK STA B SAVE UPPER CHAR LDA TBUF+2 GET ORIG DIGITS AND M177 ISOLATE LOWER CHAR IOR B MURGE STA STFAD,I STORE IN BUFFER JMP STFNM,I * STFAD BSS 1 * * LOAD PROG NAME INTO TABLE * * THE 3 WORD PROGRAM NAME IS PUT INTO THE RTSGN PROG * TABLE. THE NAMES ARE LOADED FROM THE TOP DOWN. * * CALLING SEQUENCE: * A = ADDRESS OF PROGRAM NAME * B = IGNORED * JSB LDIPX * * RETURN: A AND B ARE DESTROYED * LDIPX NOP STA IPXSV SAVE PROG NAME ADDRESS JSB INIPX INITIALIZE TO START OF TABLE LDA PROCT NUMBER OF ENTRIES ALS MULT X2 ADA PROCT PLUS ONE TO MAKE IT X3 CMA,INA ADA BIDNT BUILD NEXT NAME ADDRESS STA BIDNT FOR SAVE LDA EPGTA FIND END OF SYMBOL TABLE LDB A LDA BIDNT CHECH FOR OVERFLOW INTO LST CMA,INA ADA B SSA,RSS HAS IT OVERFLOWED? JMP LSERR YES JSB IPX INITIALIZE IP POINTERS LDA IPXSV,I GET N1-N2 STA IP1,I PUT IN TABLE ISZ IPXSV BUMP POINTER LDA IPXSV,I GET N3-N4 STA IP2,I SAVE ISZ IPXSV LDA IPXSV,I GET N5-XX STA IP3,I SAVE ISZ PROCT BUMP NUMBER OF NAMES JMP LDIPX,I RETURN * SPC 2 * * HERE ON OVERFLOW ERRORS * LSERR LDA ERRTB JSB ERROR TELL OPERATOR NO USE JSB GTOUT TERMINATE...GET OUT SPC 1 ERRTB ASC 1,TB IDENT/LST OVERFLOW SKP * * SEARCH RTSGN PROG TABLE * * THIS IS A MULTIPLE ENTRY ROUTINE WHICH WILL EITHER * SEARCH FOR A NAME OR CONTINUE FROM THE LAST FIND. * * CALLING SEQUENCE: * A = ADDRESS OF NAME (3WORD) * B = IGNORED * JSB SRIPX * * RETURN: * (N+1) PROGRAM NAME WAS FOUND IN TABLE, IN IP1-3 * (N+2) REACHED THE END OF THE PROGRAM TABLE * SRIPX NOP LDB WDCNT SEARCH OR CONTINUE? SZB JMP SRIP1 CONTINUE STA SRISV INIT SEARCH JSB INIPX SET UP IP POINTERS LDA PROCT NUMBER OF ENTRIES CMA STA WDCNT SAVE FOR LOOPING SRIP1 ISZ WDCNT ALL DONE? JMP *+3 NO, GO COMPARE NAMES ISZ SRIPX NLH YES, BUMP RETURN JMP SRIPX,I JSB IPX SET POINTERS LDB IP1 NAME IN TABLE LDA SRISV,I LOOK FOR NAME JSB NACMP GO COMPARE JMP SRIP1 DOSN'T COMPARE, LOOK NEXT JMP SRIPX,I DOES COMPARE, RETURN * N SKP * * INITIALIZE CHAR TRANSFER * * THE GINIT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GINIT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * GINIT NOP LDA ALBUF ALBUF = ADDR OF LBUF STA CURAL SET CURRENT LBUF ADDRESS CCB STB BUFUL BUFUL = BUFFER U/L FLAG JMP GINIT,I RETURN * * CONVERT A TO ASCII AT B * * THE CONVD SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CONVD NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET POWER RANGE ADDRESS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA B PUT NUMBER IN B (REMAINDER) LDA N2 STA TCNT SET CONVERSION COUNTER JSB GETD GET FIRST DIGIT IOR UBLNK ADD BLANK TO FIRST CHAR STA CURAT,I SAVE FIRST BLANK, CHARACTER ISZ CURAT INCR MESSAGE ADDRESS NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP kNEXTD NO - CONTINUE WITH NEXT DIGIT JMP CONVD,I YES - RETURN * * SET PARAMETERS * * THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) * OF THE NAME, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM. * EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS: * * NAME * NAME,PRIORITY * NAME,PRIORITY,EXECUTION INTERVAL * * PRIORITY = 2 DECIMAL DIGITS (0-99) * EXECUTION INTERVAL = 6 OPERANDS * 1 - RESOLUTION CODE (2 DECIMAL DIGITS) * 2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS) * 3 - HOURS (2 DECIMAL DIGITS) * 4 - MINUTES (2 DECIMAL DIGITS) * 5 - SECONDS (2 DECIMAL DIGITS) * 6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) * * * RETURN: A AND B ARE DESTROYED * (N+1): SOME PARAMETERS WERE ENTERED * (N+2): NO PARAMETERS WERE ENTERED * * TBUF CONTAINS THE ENTERED NAME * * PARAM NOP DST PRSAV TEMPORARILY SAVE PROMPT DATA. JSB READ GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHARS INPUT JMP PARAM+1 REPEAT PARAMETER INPUT STA PARNO SAVE PARAMETER RECORD LENGTH CLA STA ID5 STA ID6 STA ID7 STA ID8 STA ID9 STA ID10 STA ID11 JSB GETAL CPA M60 RSS JMP *+3 ISZ PARAM JMP PARAM,I JSB GINIT INITIALIZE BUFFER SCAN LDA N5 JSB GETNA MOVE CHARS FROM LBUF TO TBUF JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = BLANK?(DELIMITER = COMMA) JMP SETYP YES - CONTINUE CPA ZERO JMP PARAM,I * PANER LDA ERR09 PARAMETER NAME ERROR JMP PARER * * SET NEW PROGRAM PRIORITY SETYP LDA N2 SET COUNT FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAPER PRIORITY ERROR JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) RSS >. YES - CONTINUE CPA BLANK CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY PAPER LDA ERR11 PARAMETER PRIORITY ERROR JMP PARER * SETNR LDB OCTNO GET PRIORITY STB ID5 SET NEW PRIORITY JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARAM,I YES,RETURN * * GET RESOLUTION CODE LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA ID6 SET IN IDENT 6 * * GET EXECUTION MULTIPLE LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB EXINT GET DIGITS FROM LBUF AND M1600 ISOLATE UPPER 3 BITS IN A SZA SKIP IF VALID MULTIPLE JMP PAIER INVALID EXECUTION INTERV FORMAT LDA OCTNO GET CONVERTED NUMBER STA ID7 * * GET HOURS LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N24 STA ID8 * * GET MINUTES LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N60 STA ID9 * * GET SECONDS LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N60 STA ID10 * * GET TENS OF MILLISECONDS LDA N2 SET FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = 0? (END OF BUFFER) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA OCTNO ADA N100 STA ID11 JMP PARAM,I * * EXECUTION INTERVAL INPUT CONTROL EXINT NOP JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT q  JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = BLANK? (DELIMITER=COMMA) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA OCTNO GET CONVERTED NUMBER JMP EXINT,I RETURN WITH NUMBER IN A PAIER LDA ERR12 PARAMETER INTERVAL ERROR * PARER JSB ERROR PRINT ERROR MESSAGE DLD PRSAV GET DATA FOR REPEAT OF PROMPT. JMP PARAM+1 RE-READ PARAMETER RECORD * PRSAV OCT 0,0 TEMPORARY PROMPT-DATA STORAGE. * GET DIGIT FOR CONVD * * GETD PROVIDES THE ASCII CHARACTERS FOR CONVD. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP *+4 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR M60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * * PNAME UPDATE * * THIS ROUTINE WILL UPDATE THE PARAMETERS IN THE * PNAME TABEL. THE SOURCE WILL BE FROM THE * "ENTR PRAMS" TABLE * * CALLING SEQUENCE: * A = SOURCE ADDRESS * B = IGNORED * JSB UPNAM * * RETURN: A AND B ARE DESTROYED * UPNAM NOP STA TEMP1 SAVE SOURCE ADDRESS LDA TEMP1,I GET PRIORITY LDB PNAMA GET ADDRESS OF PRAMS ADB P7 STA B,I YES ISZ TEMP1 LDA TEMP1,I GET RESOLUTION INB SZA STA B,I UPDATE ISZ TEMP1 LDA TEMP1,I EXEC MULT. INB SZA STA B,I ISZ TEMP1 LDA TEMP1,I HOURS INB SZA STA B,I ISZ TEMP1 LDA TEMP1,I MINUTES  INB SZA STA B,I ISZ TEMP1 LDA TEMP1,I SECONDS INB SZA STA B,I ISZ TEMP1 LDA TEMP1,I TENS OF MILLISECONDS INB SZA STA B,I JMP UPNAM,I RETURN * SKP MS28 ASC 6, = EQT #? MES6A DEF MES6I MES6 DEF *+1 ASC 2,EQT MES6I BSS 1 ASC 2, =? MES29 DEF *+1 ASC 4,INT TBL AYES OCT 131 ANO OCT 116 MES5 DEF *+1 ASC 7,STRT-UP PROG? MES7 DEF *+1 ASC 7,# WDS IN COMM? MES8 DEF *+1 ASC 7,REL USER PROGS MES9 DEF *+1 ASC 5,SNAPSHOT? MES10 DEF *+1 ASC 6,ENTER PRAMS MES11 DEF *+1 ASC 7,SCEGN FINISHED BNDS DEF *+1 ASC 4,-BOUNDS MEMOT DEF *+1 ASC 3,FWABP= ASC 3,LWABP= ASC 3,FWAM= ASC 3,LWAM= ASC 3,FWAC= ASC 3,LWAC= ASET DEF *+1 ASC 6,- SET BPLOCC ASTO ASC 2, TO ASTOA DEF ASTO ASLOC DEF *+1 ASC 2,LOCC ASSTL DEF *+1 ASC 8,-LINKS START AT ASPCE OCT 40 ACOMA OCT 26000 MES55 DEF *+1 ASC 10,INPUT SNAPFILE NAME? * * * PROGRAM CONSTANT FACTORS ZERO OCT 0 N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 N6 DEC -6 N8 DEC -8 N9 DEC -9 N10 DEC -10 N24 DEC -24 N28 DEC -28 N60 DEC -60 N64 DEC -64 N100 DEC -100 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P9 DEC 9 P11 DEC 11 P12 DEC 12 P13 DEC 13 P14 DEC 14 P15 DEC 15 P20 DEC 20 P27 DEC 27 P30 DEC 30 P31 DEC 31 P28 DEC 28 P58 DEC 58 P63 DEC 63 P64 DEC 64 P99 DEC 99 P1647 OCT 1647 L10 EQU N8 L12 EQU N10 L60 OCT -60 M60 OCT 60 M77 OCT 77 M177 OCT 177 M377 OCT 377 M1600 OCT 160000 M2000 OCT 2000 M7400 OCT 177400 M7000 OCT 177000 SPC 3 IDAA DEF ID5 STRPA DEF STRPN ASIDR DEF *+1 ASC 1,I. ASTYP BSS 1 UBLNK OCT 20000 JMP3I JMP 3,#I ASCDR DEF *+1 ASC 1,C. ASCYP BSS 1 OCT 20000 AEQUL OCT 75 SKP DPWRS DEF *+1 P0100 DEC 10000 P1000 DEC 1000 P100 DEC 100 P10 DEC 10 P1 DEC 1 OPWRS DEF *+1 M0100 OCT 10000 M1000 OCT 1000 M100 OCT 100 M10 OCT 10 OCT 1 CHRDV ASC 1,DV * SUP BLANK OCT 040 BLANK MSIGN OCT 100000 NEGATIVE SIGN * ?ADD DEF *+1 ASC 1,? UGCHR ASC 1,G ASCR OCT 51000 ASCII R IN UPPER HALF ASC. ASC 1,. SKP * INTERRPUT TABLE PROCESSOR * * SINTT NOP SPACE NEW LINE LDA PPREL GET CURRENT RELOCATION ADDR STA AINT SAVE INTERRUPT TABLE ADDRESS LDA P7 LDB MES29 MES29 = ADDR. * INT TABLE JSB PRINT PRINT: INT TBL LDA A$CIA $CIC ADDRESS IOR IJSB ADD JSB 0,I CODE STA JSCIC SET JSB CIC,I CODE LDB ALBUF GO STUFF BUFFER WITH JSB $CIC JSB BUFCL JSCIC OCT 0 STUFF DATA CLA STA PROCT LDA P5 PG ZERO INT START ADDRESS LDB LWABP CMB,INB ADB P58 SSB JMP *+3 LDB LWABP RSS LDB P58 ADDRESS FIRST HALF JSB SETCR OUTPUT JSB $CIC,I * LDA HLTB4 SET HLT 4 INTO LOC 4 STA LBUF TO OUTPUT BUFFER LDA P4 ADDRESS LDB A JSB SETCR OUTPUT HLT 4 LDB P6 GET ADDR OF FIRST INT LOCATION STB TBREL SET CURRENT BP ADDRESS * SETIN LDA P1 NEW LINE LDB ?ADD JSB READ GET INT RECORD FROM TTY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA PTERM CHARS = -E? JMP ENDIO YES - I/O TABLES COMPLETE CPA RINT REPEAT INTERRUPT? JMP SINTT YES CPA REQT GO BACK TO EQT? JMP GENIO YES CPA RDRT REPEAT DRT? JMP SSQT YES JSB GINIT RE-INITIALIZE LBUF SCAN LDA P2 JSB GETOC GET 2 OCWTAL DIGITS, CONVERT JMP CHERR INVALID INT CHANNEL NO. DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP SETCH SAVE INT CHANNEL NO. CHERR LDA ERR10 SET CODE = INVALID INT CHNL NO. JSB ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * SETCH LDA OCTNO GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. ADA N4 CHAN L.T. 4? SSA JMP CHERR YES, CHANNEL ERROR * LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA CHREQ CHARS = EQ? JMP INTEQ YES - PROCESS INT EQT RECORD CPA CHRPR CHARS = PR? JMP INTPR YES - PROCESS INT PRG RECORD CPA CHREN CHARS = EN? JMP INTEN YES - PROCESS INT ENT RECORD CPA CHRAB CHARS = AB? JMP INTAB YES - PROCESS INT ABS RECORD IMNEM LDA ERR09 SET CODE = INVALID INT MNEMONIC JSB ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * INTEQ LDA N2 JSB GETNA MOVE NEXT 2 CHARS TO TBUF CPA UTCHR CHARS = T,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N2 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP EQUER INVALID EQT NO. IN INT REC LDB OCTNO GET EQT TABLE ENTRY NO. CMB,INB,SZB,RSS SKIP - VALID LOWER LIMIT JMP EQUER INVALID EQT REFERENCE STB TCHAR SAVE EQT NO. ADB CEQT ADD UPPER EQT REF. NO. SSB,RSS SKIP - INVALID UPPER LIMIT JMP TSTIQ TEST FOR FIRST EQT REFERENCE EQUER LDA ERR31 SET CODE = INVALID EQT NO. JSB ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * TSTIQ LDB TCHAR GET EQT REF. NO. LDA AEQT GET ADDR OF EQT INB,SZB,RSS SKIP - NOT FIRST EQT REFERENCE JMP SEQTI SET EQT ADDR IN INT TABLE ADA P15 ADJUST FOR NEXT EQT ENTRY ADDR INB,SZB SKIP - EQT A5DDRESS FOUND JMP *-2 CONTINUE EQT SEARCH SEQTI LDB JSCIC GET JSB CIC CODE JMP COMIN SET INTERRUPT TABLE, LOCATION * INTPR LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA UGCHR CHARS = G,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA TBREL FETCH CHANNEL CMA,INA ADA INTCH ASSENDING ORDER? SSA,SZA JMP IMNEM NO, ERROR LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF LDA TBUF+2 NAME: 5 AND M7400 MASK OUT LOWER HALF IOR INTCH PUT IN CHN(SELECT CODE) STA TBUF+2 SAVE IN TABLE LDA ATBUF ADDRESS OF NAME JSB LDIPX PUT IN TABLE CLA LDB JSCIC JMP COMIN * INTEN LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA UTCHR CHARS = T, BLANK RSS YES - CONTINUE JMP IMNEM INVALID INT MNEMONIC LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF LDB ATBUF ADDR OF NAME JSB SSTBL SEARCH SYMBOL TABLE RSS NOT FOUND, ERROR JMP SETE1 SET ENTRY POINT ADDRESS ENERR LDA ERR33 SET CODE = INVALID ENTRY POINT JSB ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INT RECORD INPUT * SETE1 LDA LST5 HAS LINK BEEN MADE? LDA A,I SZA,RSS JMP SETEN NO, GO MAKE ONE IOR IJSB YES, FORM THE JSB FOR BP STA B CLA JMP COMIN SETEN LDA LST4 GET BP LINK ADDRESS LDA A,I STA SETAD,I LDA .MEM1 MAKE A BP LINK LDB A JSB SETCR LDB LST5 LDA .MEM1 STA B,I IOR IJSB ADD JSB 0,I CODE STA B CLA SET INT ENTRY = ZERO ISZ .MEM1 JMP COMIN SET INTERRUPT TABLE, LOCATION * INTAB LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDZA P6 JSB GETOC GET 6 OCTAL DIGITS, CONVERT JMP IMNEM INVALID ABS DIGIT CLA LDB OCTNO GET ABSOLUTE VALUE * COMIN STA TBUF SAVE INT TABLE CODE STB TBUF+1 SAVE INT LOCATION CODE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? RSS YES, CONTINUE JMP ENERR NO, BUT SHOULD BE LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR CMA,INA ADA TBREL ADD CURRENT ADDRESS SZA,RSS SKIP - NOT NEXT LOCATION JMP STINT SET INTERRUPT TABLES, LOCATION SSA SKIP - INVALID CHANNEL NO. ORDER JMP FILLI FILL IN SKIPPED VALUES EQERR LDA ERR24 SET CODE = INVALID INT CHNL ORDR JSB ERROR PRINT DIAGNOSTIC JMP SETIN GET NEXT INTERRUPT RECORD * PFINT LDA TBUF IF TRAP CELL FOUR, SZA ENTRY MUST BE AN JMP CHERR 'ABS' OR AN 'ENT' LDA P4 LDB TBUF+1 STORE INTO STB SETAD,I TRAP CELL FOUR LDB A JSB SETCR JMP SETIN GET NEXT INTERRUPT RECORD * HLTB4 OCT 103004 TRAP CELL DEFAULT VALUE * FILLI STA TCNT SET NO. OF FILL-INS REQUIRED CLA SET INTERRUPT TABLE ENTRY = ZERO STA SETAD,I LDA PPREL ADDRESS LDB A JSB SETCR ISZ PPREL INCR CURRENT INT TABLE ADDRESS ISZ TBREL INCR CURRENT INT LOCATION ADDR ISZ TCNT SKIP - ALL FILL-INS COMPLETE JMP FILLI+1 CONTINUE INT FILL-IN * STINT LDB TBUF+1 GET INT LOCATION CODE STB SETAD,I PUT INT LOCATION CODE IN INT LOC ISZ TBREL INCR CURRENT BP LOCATION ADDR LDB TBREL GET INT LOCATION ADDR CMB,INB ADB P64 ADD ADDR OF FIRST SYS LINK SSB SKIP - INT LOCATION OVERFLOW JMP EQERR * NOBPO LDA TBREL INT. ADDRESS PLUS ONE ADA N1 ADJUST  LDB A ADDRESS JSB SETCR SET CORE LDA TBUF GET INT TABLE CODE STA SETAD,I TO OUT BUFFER LDA PPREL ADDRESS LDB A JSB SETCR OUTPUT IT ISZ PPREL INCR CURRENT RELOCATION ADDR JMP SETIN GET NEXT INT TABLE RECORD ENDIO LDA AINT GET ADDRESS OF INT CMA,INA ADA PPREL ADD CURRENT RELOCATION ADDR STA CINT SAVE NO. INT ENTRIES NOP SPACE NEW LINE NOP SPACE NEW LINE * * OUTPUT EQTA THRU INTLG * LDA AEQT EQT START ADDRESS STA LBUF LDA CEQT NUMBER OF EQTS STA LBUF+1 LDA ASQT DRT START ADDRESS STA LBUF+2 LDA CSQT NUMBER OF DRT'S STA LBUF+3 LDA AINT INTERRUPT TABLE ADDRESS STA LBUF+4 LDA CINT NUMBER OF INTERRUPT ENTRIES STA LBUF+5 LDA EQTA START ADDRESS-ABS LDB INTLG END ADDRESS JSB SETCR GO BUILD ABS SKP * * GET ID'S AND BUILD KEY WORD TABLE * LDA PPREL KEY WORD TABLE ADDRESS STA LBUF LDA KEYWD ABS ADDRESS LDB A JSB SETCR LDA PPREL STA KEYAD KEY WORD ADDRESS KEYID LDA P8 PRINT: LDB MES42 "# ID SEGS?" JSB READ LDA N2 GET -2 (SET FOR DECIMAL JSB GETOC CONVERSION OF 2 DIGITS) JMP IDWER BAD NUMBER STA KEYCN # OF ID SEGS TO KEY COUNT SZA,RSS JMP IDWER DO NOT ACCEPT ID COUNT OF ZERO! CMA,INA ADA P99 OR GREATER THEN 99 SSA JMP IDWER LDA KEYCN RESTORE A ADA PPREL ADD TO PRESENT LOCATION INA FOR ZERO END STA PPREL UPDATE PPREL STA SYSAD INITIAL ID SEG ADDRESS STA IDSAD FIRST ID SEG ADDRESS JMP *+4 IDWER LDA ERR10 PRINT: JSB ERROR "ERR-PA"  JMP KEYID TRY AGAIN JSB GETAL SZA JMP IDWER NO, ERROR LDA KEYCN NOS OF KEY WORDS CMA,INA STA WDCNT LDA SYSAD STA TEMP2 LDA KEYAD STA TEMP3 KYBLD LDA TEMP2 ADDRESS OF CURRENT ID STA LBUF ID ADDRESS LDA TEMP3 KEY WORD ADDRESS LDB A INTO B ISZ TEMP3 BUMP TO NEXT KEY WORD ADDR JSB SETCR OUT PUT TO ABS LDA TEMP2 UPDATE ID ADDRESS ADA P28 SEG SIZE STA TEMP2 ISZ WDCNT ALL DONE? JMP KYBLD NOT DONE YET STA PPREL NEW RELOCATE ADDRESS CLA STA LBUF GET A ZERO IN THE OUTPUT BUFFER LDA KEYAD ADA KEYCN NOS OF KEY WORDS LDB A JSB SETCR ZERO NEXT TO LAST KEY ENTRY LDB ALBUF CLEAR BUFFER AREA JSB BUFCL OCT 0 LDA KEYCN GET ID SEG COUNT CMA,INA STA WDCNT SAVE NEG LDA SYSAD ADDRESS OF FIRST ID SEG STA TEMP3 CLOOP LDA TEMP3 STARTING ADDRESS LDB A ADB P27 BUMP TO LAST ADDR STB TEMP3 UPDATE STB LBUF ISZ LBUF POINT TO NEXT ID SEG ISZ TEMP3 TO NEXT ADDR JSB SETCR CLEAR ID SEGMENT ISZ WDCNT ALL DONE? JMP CLOOP NO, DO MORE LDA TEMP3 ADA N28 CLEAR CLB LAST STB LBUF LINK LDB A POINTER JSB SETCR SKP * * GET START-UP PROGRAM * NOP SPACE LDA P13 PRINT: LDB MES5 "STRT-UP PROG?" JSB PARAM GO GET PARAMETERS RSS JMP RESLB NO PARAMS WERE INPUT LDA TBUF MOVE NAME 1,2 STA STRPN LDA TBUF+1 NAME 3,4 STA STRPN+1 LDA TBUF+2 NAME 5 STA STRPN+2 LDA SYSAD SEG ONE ADDRESS STA LBUF PUT SEG INTO THE SCHEDULED_ LIST LDA SKEDD ADDRESS IN BASE PAGE LDB A JSB SETCR TO ABSOLUTE LDA SYSAD SEG ONE ADDRESS ADA P28 UPDATE TO NEXT STA SYSAD ISZ IDNOS BUMP NOS OF ID'S SKP * * RELOCATE RESIDENT LIBRARY * RESLB NOP SPACE START ON NEW LINE LDA SYSAD STA SETAD,I FIRST DORMENT SEGMENT LDA DORMT DORMENT LIST POINTER LDB A JSB SETCR SET IT IN BP LDA PPREL UP LOCC FOR RELOCATE STA .MEM3 STA SETAD,I LIBRARY ORG TO BP LDA LBORG LDB A JSB SETCR CLA STA PNAME LDA P11 PRINT: LDB MES3 "REL RES LIB" JSB PRINT LDA P2 STA .XFER MAKE NON-ZERO FOR LIBRARY CLA STA LOCC STA BPLOC LDA LSTSV RESTORE SYMBOL TABLE COUNT STA LST IN THE LOADER JSB PRCMD GO TO LOADER JSB GTOUT LOADER ERROR...GET OUT LDA LOCC SZA,RSS LDA .MEM3 RESTORE WITH SELF IF LOCC IS ZERO STA .MEM3 STA SETAD,I PUT IN BUFFER LDA RTORG BASE PAGE LOCATION LDB A JSB SETCR OUTPUT TO ABS LDA BPLOC SZA STA .MEM1 UPDATE IF NON-ZERO LDA .MEM1 SET BASE PAGE LOWER LIMIT STA LBUF TO BUFFER LDA P1647 SET BASE PAGE UPPER LIMIT STA LBUF+1 TO BUFFER LDA BPA1 FIRST BP ADDRESS LDB A INB LAST BP ADDRESS JSB SETCR SET TO BP COMM AREA LDA LST COUNT OF SYMBOLS STA LSTSV SAVE FOR UPDATE AFTER EACH RELOCATE-CORE RES PROGS * * SET UP COMMON AREA * WDSCM NOP SPACE NEW LINE LDA P14 PRINT: LDB MES7 "# WDS IN COMM?" JSB READ LDA N5 JSB GETOC GET 5 DIGITS JMP WDERR BAD NUMBER JSB GETAL LOOK FOR END OF BUFFNLHER SZA JMP WDERR NOT END ERROR, TRY AGAIN LDA OCTNO GET VALUE SZA,RSS JMP RELRS STA SETAD,I LDA RTCOM COMMON SIZE TO BP LDB A JSB SETCR LDA .MEM3 UPDATE FWAC STA .MEM5 ADA OCTNO UPDATE LWAC STA .MEM3 ADA N1 STA .MEM6 LWAC JMP RELRS GO REL CORE RES PROGS WDERR LDA ERR10 PRINT: JSB ERROR "ERR-PA" JMP WDSCM TRY AGAIN N SKP * * RELOCATE CORE RESIDENT PROGRAMS * RELRS NOP SPACE NEW LINE CLA GET A ZERO STA PNAME STA LOCC STA BPLOC STA .XFER CLEAR FOR CORE RES LOAD LDA LSTSV RESTORE BEFORE EACH RELOCATE STA LST LDA P14 PRINT: LDB MES8 "REL USER PROGS" JSB PRINT JSB PRCMD GO RELOCATE!!!!! JSB GTOUT LOADER ERROR...GET OUT LDA .XFER WAS ZERO INPUT? SZA,RSS JMP SNAPO YES, GO DO SNAPSHOT * CHANGE PARAMETERS SRFIN NOP SPACE LDA P11 PRINT: LDB MES10 "ENTER PRAMS" JSB PARAM GO GET PARAMS RSS PARAMS WERE INPUT JMP SRFI5 NO PARAMS INPUT, NO CHANGE LDA TBUF NAME 1,2 STA PNAME LDA TBUF+1 NAME 3,4 LDB PNAMA INB STA B,I LDA TBUF+2 NAME 5 INB STA B,I LDA IDAA ADDRESS OF PARAMETERS JSB UPNAM UPDATE PARAMETERS SRFI5 CLA STA WDCNT CLEAR FOR FIRST TIME LDA APNAM JSB SRIPX SEARCH FOR DUPS JMP SR5I FOUND ONE LDB PNAMA ADB P2 LDA B,I MASK OUT LOWER BLANK AND M7400 STA B,I AND RESTORE LDA PNAMA THIS NAME NOT IN TABLE JSB LDIPX SO, PUT IT THERE JMP SRFI6 CONTINUE PROCESSING SR5I LDA IP3,I IS THIS AN INT PRG? AND M77 SZA JMP SRFI6 YES, ITS OK LDA ERRDU NO, LOOKS LIKE A DUP ENTRY JSB ERROR JMP SRFIN TRY AGAIN * SRFI6 LDA STRPA ADDRESS OF START UP NAME LDB PNAMA JUST LOADED NAME JSB NACMP COMPARE NAMES JMP SRFI2 NO COMPARE CLA DOES COMPARE STA STRPN CLR STRT FLAG LDA IDSAD SEGMENT ADDRESS CLB POINTS TO ADDRESS JSB GENID GO BUILD ID SEGMENT  LDB A ADB P27 COMPUTE THE END OF ID ADDRESS JSB SETCR OUTPUT IT LDA IDSAD GET ID SEG ADDRESS INA POINT TO TEMPORARY STORAGE STA SETAD,I ADA P9 WORD 11 IN SEG LDB A JSB SETCR ADD WORD TO SEG CLA,INA STA SETAD,I LDA IDSAD ADA P15 PUT A 1 INTO WORD 16 OF THE SEG LDB A JSB SETCR LDA IDSAD GET CORRECT ID SEG ADDRESS JSB SRFI3 "PROGS" WERE ENTERED, GO LOOK FOR IT JMP RELRS GO RELOCATE NEXT * SRFI2 LDA IDNOS ENTERED PROGS EXCEEDED ID SEGS? CMA,INA ADA KEYCN SSA JMP LSERR IRRECOVERABLE ERROR YES!! LDA SYSAD GET CORRECT ID SEG ADDRESS JSB SRFI3 GO CHECK FOR INT-PRGS LDA SYSAD BUILD SEG IN THIS ADDRESS LDB A ADB P28 LOOK TO NEXT SEGMENT STB SYSAD DYNAMIC SEG POINTER JSB GENID BUILD ID SEG LDB A ADB P27 GET ADDRESS OF END OF ID SEG INA SKIP THE 1ST WORD (LINK) ISZ SETAD JSB SETCR OUTPUT IT CCA ADA SETAD STA SETAD ISZ IDNOS UP NOS OF ID' INPUT JMP RELRS GO GET NEXT * SRFI3 NOP STA PPREL SAVE ID SEG ADDRESS CLA STA WDCNT CLEAR FOR INITIAL ENTRY LDA APNAM ADDRESS OF INPUTTED PROG NAME SRFI4 JSB SRIPX GO SEARCH RSS FOUND NAME JMP SRFI3,I END OF TABLE LDA IP3,I COMPARES,GET SC AND M77 SZA,RSS JMP SRFI4 ADA AINT ADDRESS OF INTERRUPT TABLE ADA N6 LDB PPREL SET NEG OF ID ADDRESS CMB,INB INTO THE INTERRUPT TABLE STB SETAD,I LDB A JSB SETCR LDA IP3,I AND M7400 STA IP3,I SHOW ENTRY AS USED JMP SRFI4 LOOK AGAIN SKP * * SNAPSHOT OUTPUT * SNAPO LDA STRPN  WAS START-UP PRG REQUESTED? SZA,RSS BUT NOT LOADED JMP SNAP5 NO,GO CHECK FOR INT PRGS NOP SPACE LDA P12 YES, PRINT: LDB MES5 "STAR-UP PROG" JSB PRINT NOP SPACE LDA P5 PRINT: LDB STRPA START-UP PROG NAME JSB PRINT NOP SPACE JMP RELRS RELOCATE START-UP PROGRAM * SNAP5 CLA STA PPREL HEADER FLAG STA WDCNT LDA P1 NAME ADDRESS SNAP6 JSB SRIPX GO SEARCH RSS FOUND SOMETHING JMP SNAP7 END OF TABLE LDA IP3,I IS IT AN INT PRG NAME? AND M77 SZA,RSS JMP SNAP6 NO, LOOK NEXT LDA PPREL HEADER BEEN PRINTED? SZA JMP *+7 YES NOP SPACE NO, PRINT IT LDA P8 PRINT: LDB MES12 "INT PRG" STA PPREL SET HEADER FLAG JSB PRINT NOP SPACE NEW LINE LDA P5 PRINT: LDB IP1 PRG NAME JSB PRINT JMP SNAP6 LOOK NEXT * SNAP7 LDA PPREL ANY INT PRGS PRINTED? SZA,RSS JMP SNAP8 NO, CONTINUE NOP SPACE YES, ASK IGNORE QUESTION LDA P7 PRINT: LDB MES13 "IGNORE?" JSB READ AND GET THE REPLY CCA STA CMFLG JSB GETAL FRIST LETTER OF REPLY CPA ANO AN "N" ? JMP RELRS YES, TRY TO RELOCATE PRGS CPA AYES NO, IS IT A "Y" ? JMP SNAP8 YES, PROCESS SNAPSHOT LDA ERR10 WAS NEITHER JSB ERROR PRINT: "ERR-PA" JMP SNAP7 TRY AGAIN * SNAP8 LDA JMP3I SET STARTING JMP STA LBUF LDA STRAD SET STARTING ADDRESS STA LBUF+1 LDA P2 LDB P3 JSB SETCR * SET FWA SYS MEM IN BP LDA SYMAD FWA SYS MEM SZA,RSS LDA .MEM3 DEFAULT TO FWAM, IF FWASM EQ 0. STA LBUF+1 TO BUFFER LDA .MEMd3 STA LBUF LDB AVMEM BP ADDRESS LDA B ADA N1 JSB SETCR SET FWA SYS MEM INTO RTS BP JSB CLSFI FCLOS ABSOLUTE OUTPUT FILE NOP SPACE SNAP2 LDA P9 PRINT: LDB MES9 "SNAPSHOT" JSB READ CCA STA CMFLG JSB GETAL GET RESPONSE CPA ANO NO????? JMP ENDGN YEP, END OF RTS GEN CPA AYES YES??????? JMP *+4 YES LDA ERR10 JSB ERROR JMP SNAP2 TRY AGAIN * * GET SNAP FILE NAME * SNP11 LDA P20 LDB MES55 JSB READ READ IN NAME JSB FCRET GO CREATE SNAP FILE DEF *+5 DEF ABDCB DEF P30 DEF P3 DEF ZERO JSB FILCK JMP SNP11 TRY AGAIN LDA .MEM. FRIST ADDRESS STA MEMAD .MEM. ADDRESS LDA MEMOT ADDRESS OF LABELS STA LBLAD LDA N6 NUMBER OF LABELS STA WDCNT JSB GINIT INITIALIZE BUFFER CLA STA MAXC CLEAR WORD COUNT STA PROCT CLEAR TOTAL COUNT SNAP1 LDA N4 NO OF CHARS LDB BNDS ADDRESS OF "-BOUNDS" JSB BUFUP PUNCH ON TAPE JSB LBOUT PUNCH LABELS LDA MEMAD,I NEXT VALUE LDB ATBUF BUFFER TEMP STORAGE JSB CONVD CONVERT TO OCTAL LDA N3 LDB ATBUF JSB BUFUP PUNCH VALUE LDB MES25 FINISH LINE WITH "CRLF" JSB BUFUP ISZ MEMAD BUMP TO NEXT VALUE ISZ WDCNT MORE? JMP SNAP1 YES * LDA LST NUMBER OF SYMBOLS CMA,INA STA WDCNT JSB LSTI SET UP START OF SYMBOL TABLE SNAP4 JSB LSTP READ IN A SYMBOL JMP SNAP3 NO MORE...DONE LDA N3 LDB ASET JSB BUFUP PUNCH "-SET" LDA N2 LDB LST1 JSB BUFUP PUNCH SYMBOL NAME LDB LST3 MOVE TO END OF NAME LDA B,I GET LAST CHAR AND M7400 MASK OUT LOWER IOR ASPCE INSERT SPACE AS LAST CHAR STA B,I RESTORE LDA N1 LDB LST3 JSB BUFUP PUNCH LAST CHAR LDA N2 LDB ASTOA PUNCH " TO " JSB BUFUP LDB LST4 BUMP TO LST4 LDA B,I LDB ATBUF JSB CONVD CONVERT LST4 TO OCTAL LDA N3 LDB ATBUF JSB BUFUP PUNCH LST4 LDB MES25 JSB BUFUP FINISH WITH CRLF LDB LST5 LDA B,I GET LST5 SZA,RSS IS LST5 EQ. 0? JMP SNAP4 YES, SKIP LINKS LDA N8 LDB ASSTL JSB BUFUP PUNCH "-LINKS START AT" LDB LST5 LDA B,I GET LINK LDB IDAA BUFFER ADDRESS JSB CONVD CONVERT LST5 LDA TBUF AND M377 MASK OUT SPACE AS FIRST CHAR IOR ACOMA INSERT A COMMA STA TBUF RESTORE, COMMA AS FIRST LDA N3 LDB IDAA JSB BUFUP PUNCH LST5 LDA N3 LDB ATBUF JSB BUFUP PUNCH LST4 LDB MES25 JSB BUFUP FINISH WITH "CRLF" JMP SNAP4 NO, DO NEXT * SNAP3 LDA N8 LDB ASET JSB BUFUP PUNCH "-SET BPLOCC TO" LDA .MEM1 LDB ATBUF JSB CONVD LDA N3 LDB ATBUF JSB BUFUP PUNCH BPLOC LDB MES25 DUMP BUFFER JSB BUFUP LDA N3 END LINE WITH CRLF LDB ASET ADDRESS OF "SET" JSB BUFUP PUNCH"-SET" LDA N2 LDB ASLOC ADDRESS OF "LOCC" JSB BUFUP PUNCH "LOCC" LDA N2 LDB ASTOA JSB BUFUP PUNCH " TO " LDA .MEM3 FETCH FWAM LDB ATBUF JSB CONVD CONVERT TO ASCII LDA N3 LDB ATBUF JSB BUFUP PUNCH VALUE OF FWAM LDB MES25 JSB BUFUP END LINE WITH CRLF JSB CLSFI GO FCLOS SNAP FILE JMP ENDGN GO TO END RTSGN ROUTINE SKP * * * OUTPUT LABEL ROUTINE * * * CALLING SEQUENCE: * A AND B ARE IGNORED * JSB LBOUT * * RETURN: A AND B ARE DESTROYED * LBOUT NOP LDA N3 LDB LBLAD ADDRESS OF LABEL JSB BUFUP PUNCH LABEL LDA LBLAD UPDATE LABEL POINTER ADA P3 STA LBLAD JMP LBOUT,I RETURN * * * LOAD AND DUMP THE PUNCH BUFFER * * * CALLING SEQUENCE: * A = NEG OF NO. OF WORDS TO LOAD * B = ADDRESS TO LOAD FROM * JSB BUFUP * * RETURN: A AND B ARE DESTROYED * BUFUP NOP CPB MES25 DUMP BUFFER REQUEST? JMP BUFDN YES STA MAXC NO, SAVE NO OF WORDS TO GO ADA PROCT ACCUMULATE THE TOTAL STA PROCT LDA B,I GET THE WORD STA CURAL,I PUT IN BUFFER INB BUMP SOURCE POINTER ISZ CURAL UP BUFFER POINTER ISZ MAXC ALL DONE? JMP *-5 JMP BUFUP,I ALL DONE, RETURN * BUFDN LDA PROCT GET NEG OF WORD COUNT CMA,INA MAKE POSITIVE STA MAXC SAVE LENGTH JSB WRITF WRITE TO SNAP FILE DEF *+5 DEF ABDCB DEF FERR DEF LBUF DEF MAXC SIZE JSB GINIT INITIALIZE BUFFER POINTERS CLA STA MAXC STA PROCT JMP BUFUP,I RETURN * * * * ENDGN NOP SPACE NEW LINE LDA P14 PRINT: LDB MES11 "SCEGN FINISHED" JSB LOUT JSB FCLOS FCLOS PRINT FILE DEF *+3 DEF LSDCB DEF FERR JSB FCLOS CLOSE INPUT FILE DEF *+3 DEF INDCB DEF FERR JSB EXEC PRINT OUT ENDING MESSAGE DEF *+5 DEF P2 DEF ENDLU DEF MES11+1 DEF P7 JSB EXEC RELEASE SYMBOL TABLE TRACKS DEF *+3 DEF P5 DEF N1 JSB EXEC AND TERMINATE DEF *+2 DEF P6 SPC 1 LBUF BSS 64 EQXTB BSS 58 ROOM FOR <30 EQTX SETUPS SIZZ EQU * END SWPIN * 1*($$* K5 91700-18140 1608 S 0322 DS1/B CCE MODULE: SCGN2              H0103 KASMB,R,L,C HED SCGN2 91700-16140 REV.A 760216 * (C) HEWLETT-PACKARD CO. 1976 * NAM SCGN2,5 91700-16140 REV.A 760216 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ****************************************************** * *SCGN2 SUBORDINATE LOADER CONTROL * *SOURCE PART # 91700-18140 REV.A * *REL PART # 91700-16140 REV.A * *WRITTEN BY: LARRY POMATTO-JACK COOLEY * *DATE WRITTEN: 9-24-74 * *MODIFIED BY: K. HAHN [ C.C.H.] * *DATE MODIFIED: 12-02-75 [02-16-76] * *MODIFICATION: ADD CURRENT PAGE LINKING, MAP ALL, & *COMMENTS * [ FIX INDIRECT EXTERNAL REF. & ADD BYTE ADDRESSING ] * [ FIX C.P. LINK PROCESSING, ADD ECHO ON/OFF COMMAND] * [ ADD EXTENDED-NAM PRINTOUT ] ****************************************************** * * THE TERM RTS/2100 IS SYNONYMOUS WITH RTE-C AND * THE TERMS ARE USED INTERCHANGEABLY THROUGHOUT * THIS DOCUMENT * * * ENTRY POINT NAMES * ENT LSWAP,LOAD ENT NBUF9,CPLEN * * EXTERNAL REFERENCE NAMES * EXT PNAME,PNAMA,PRAMS EXT SIZE,EFLAG,CPLMG,CPLML,#ECHO EXT .MEM.,.MEM1,.MEM2,.MEM3,.MEM4,.MEM5,.MEM6 EXT ?XFER,PLKS,ABRC1,LISTO,UEXFL EXT LST,LST1,LST2,LST3,LST4,LST5 EXT LOCC,BPLOC,RBTO,NAMR. EXT COMOR,RBTA EXT PRINT,PARSB EXT PACK$,LSTP,LSTI,SSTBL,PRMT,PUNCH EXT LOUT,SWAPR,PLK,RBIN,PLK1 EXT FERR,RLDCB,FCLOS,COML * A EQU 0 B EQU 1 SUP SPC 1 ********************************************************************6**** * * THESE ROUTINES ARE USED BOTH IN THE RTS LOADER ITSELF AND IN * THE RTS GENERATOR RTSGN. THESE ROUTINES,CALLED A SUBORDINATE * CONTROL MODULE, COMPRISE A COMMAND PROCESSOR FOR LOADER COMMANDS. * THIS MODULE IS CALLED AS IF IT WERE A SUBROUTINE WITH NO * PARAMETERS AND TWO RETURNS. THE (P+1) RETURN IS USED FOR ABNORMAL * TERMINATION CONDITIONS, WHILE THE (P+2) RETURN IS USED FOR NORMAL * RETURNS VIA THE END COMMAND.THE CALLING SEQUENCE IS AS FOLLOWS: * * JSB PRCMD * RETURN1 RELOCATION ABORTED RETURN * RETURN2 NORMAL RETURN * ******************************************************************** SPC 3 * NOTE!!!!!! * THIS BSS THAT FOLLOWS MUST BE THERE INORDER * TO INSURE THAT NO CODE IS OVERLAYED * FROM THE OTHER SEGMENT * BSS 310B SIZE DEFINED IN RTGEN SEGMENT SPC 4 * * HERE WHEN SEGEMENT IS FIRST LOADED * CONTROL IS PASSED BACK TO THE MAIN * VIA A SWAPR RETURN * LSWAP NOP * * NOTE THE FOLLOWING IS BECAUSE WE DO NOT HAVE * EXTERNALS WITH OFFSET * LDA MD5 GET LOOP COUNTER STA BLINE SAVE IN TEMP LOCATION LDB LSTAA GET ADDRESS OF WHERE LIST ROUTINE LOCATED LOOP LDA B HERE WE CHASE DOWN OUR OWN LDA A,I INDRECTS, AND ADD OUR OWN RAL,CLE,SLA,ERA JMP *-2 IOR BIT15 ADD IN OUR OWN INDIRECT STA B,I AND SAVE IT AGAIN INB ISZ BLINE DONE? JMP LOOP NO JMP SWAPR YES...RETURN SPC 1 BIT15 OCT 100000 LSTAA DEF *+1 LST1A DEF LST1 LST2A DEF LST2 LST3A DEF LST3 LST4A DEF LST4 LST5A DEF LST5 SKP * * RTS LOADER UTILITY SUBROUTINES * SPC 1 ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BSS 1 BLINE NOP LDA LBUFA STA BLINE-1 LDA MD60 LDB BLANK STB BLINE-1,I ISZ BLINZE-1 INA,SZA JMP *-3 JMP BLINE,I ***** STMP1 NOP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMETER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA IMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RETURN1 NOTHING BUT BLANKS TO END OF LINE * RETURN2 DELIMETER FOUND * * NOTE: IF NO VALID DELIMITER IS FOUND (OR COMMA WITH NOTHING BUT * BLANKS TO THE END OF LINE) A DIRECT JUMP TO THE COMMAND * ERROR ROUTINE WILL RESULT. THUS CONTROL MAY NOT BE RETURNED ***** DELIM NOP JSB QGETC GET THE NEXT CHAR JMP DELIM,I END OF LINE , RETURN (P+1) LDB M2 INITIALIZE STB STMP1 COMMA COUNTER CPA B40 IS THIS A BLANK? JMP DEL01 YES CPA B54 NO, IS IT A COMMA? RSS JMP CMER NO, ERROR ISZ STMP1 DEL01 JSB NXTC GET NEXT NON BLANK CHAR JMP DEL02 END OF LINE CPA B54 GOT ONE, IS IT A COMMMA? RSS JMP DEL03 NO ISZ STMP1 YES, IS IT THE SECOND ONE? JMP DEL01 NO, GET NEXT NON BLANK CHARACTER DEL03 JSB BAKUP YES, BACK UP BUFFER POINTERS ISZ DELIM AND EXIT (P+2) JMP DELIM,I DEL02 ISZ STMP1 WAS THERE A COMMA? JMP DELIM,I NO, EXIT (P+1) JMP CMER YES, ERROR ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP LDA QQCNT DECREMENT CHAR COUNT ADA M1 STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB M1 DECREMENT POINTER STB QQPTR JMP BAKUP,I ***** * ** PRCMD ** MAIN ENTRY POINT FOR THE SUBORDINATE CONTROL MODULE. * CONTROL IS PASSED TO TYMOD OR NXTCM TO GET THE NEXT * COMMAND. THAT COMMAND IS PARSED, AND CONTROL IS PASSED * TO ITS ASSOCIATED PROC^ESSING ROUTINE. IF A FATAL ERROR * IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING * PRCMD AT (P+1). THE ONLY OTHER EXIT IS VIA THE END * COMMAND (P+2). AFTER PROCESSING ANY OTHER COMMAND, * CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. * ***** LOAD BSS 0 PRCMD NOP PROCESS RTE LOADER/2100 COMMANDS NXTCM JSB CMDIN GET NEXT COMMAND LINE LDA CTACN LDB CTABL JSB SCAN SCAN 1ST ELEMENT FOR MATCH JMP CMER COMMAND ERROR. ADA PTABL JUMP TO PROCESSOR LDA A,I JMP A,I * CMER1 DEF *+1 OCT 5 ASC 3,CMND? ***** * CONTROL COMES HERE ON DETECTING A COMMAND ERROR. THE MESSAGE * 'CMND?' IS OUTPUT, INPUT IS SWITCHED TO TTY, AND GET NEXT CMD. ***** CMER LDB CMER1 OUTPUT CMND? MESSAGE JSB DIAG JMP PRCMD+1 GET NEXT COMMAND FROM TTY SKP * *RTS LOADER TABLES * ***** * * BRANCH TABLE FOR COMMAND PROCESSORS. * ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRIES IN * COMMAND MNEMONIC TABLE. * ***** PTABL DEF * DEF BNDST BOUNDS STATEMENT DEF MAPST MAP STATEMENT DEF RELST RELOCATE STATEMENT DEF RELST REL STATEMENT DEF SERST SEARCH STATEMENT DEF NXTCM OUTPUT STATEMENTS IGNORED DEF DSPST DISPLAY STATEMENT DEF EOL END STATEMENT DEF SETST SET STATEMENT DEF LNKST LINKS STATEMENT DEF EXTST EXTERNALS INDIRECT/DIRECT STATEMENT DEF ECOST ECHO ON/OFF STATEMENT ***** * * COMMAND MNEMONIC TABLE * * BITS 15-8 # CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE * OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS TABLE IS * OF PARAMOUNT IMPORTANCE. IF ANY KEYWORD IS EXACTLY THE SAME * AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST * APPEAR FIRST. (FOR EXAMPLE RELOCATE APPEARS BEFORE REL) * ***** CTACN ABS CTABS-CTABN NEG NBR ENTRIES IN TABLE CTABL DEF CTABS CTABS ABS 3000B+ABOUD-CMTBL BOUNDS ABS 1400B+AMAP-CMTBL MAP ABS 4000B+ARELC-CMTBL RELOCATE ABS 1400B+ARELC-CMTBL REL ABS 3000B+ASEAR-CMTBL SEARCH ABS 3000B+AOTPU-CMTBL OUTPUT ABS 3400B+ADISP-CMTBL DISPLAY ABS 1400B+AEND.-CMTBL END ABS 1400B+ASET.-CMTBL SET ABS 2400B+ALINK-CMTBL LINKS ABS 4400B+AEXT-CMTBL EXTERNALS ABS 2000B+AECHO-CMTBL ECHO CTABN EQU * KTABS ABS 2400B+AFWAB-CMTBL FWABP ABS 2400B+ALWAB-CMTBL LWABP ABS 2000B+AFWAM-CMTBL FWAM ABS 2000B+ALWAM-CMTBL LWAM ABS 2000B+AFWAC-CMTBL FWAC ABS 2000B+ALWAC-CMTBL LTABS ABS 2000B+ALOCC-CMTBL LOCC ABS 3000B+ABPLC-CMTBL BPLOCC ABS 2400B+AXFER-CMTBL ?XFER ABS 2400B+ATBLE-CMTBL TABLE ABS 3000B+AUNDE-CMTBL UNDEFS MTABS ABS 3400B+AMODS-CMTBL MODULES ABS 3400B+AGLOS-CMTBL GLOBALS ABS 2400B+ALINK-CMTBL LINKS SWICH ABS 1000B+AON-CMTBL ON ABS 1400B+AOFF.-CMTBL OFF ABS 1400B+AALL-CMTBL ALL BORC ABS 2000B+ABAS-CMTBL BASE ABS 3400B+ACUR-CMTBL CURRENT TSTRT ABS 2400B+ASTRT-CMTBL START ABS 1000B+AIN-CMTBL IN TAT ABS 1000B+AAT..-CMTBL AT TTO ABS 1000B+ATO..-CMTBL TO DIEXT ABS 4000B+AIEXT-CMTBL INDIRECT ABS 3000B+ADEXT-CMTBL DIRECT....THESE TWO MUST BE IN ORDER STABL DEF TSTRT ATTBL DEF TAT TOTBL DEF TTO LTABL DEF LTABS KTABL DEF KTABS MTABL DEF MTABS BCTBL DEF BORC SWTBL DEF SWICH ***** * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS OF NO IMPORTANCE ***** CMTBL DEF * ABOUD ASC 3,BOUNDS AMAP ASC 2,MAP ARELC ASC 4,RELOCATE ASEAR ASC 3,SEARCH AOTPU ASC 3,OUTPUT ADISP ASC 4,DISPLAY ATBLE ASC 3,TABLE AUNDE ASC 3,UNDEFS AMODS ASC 4,MODULES AGLOS ASC 4,GLOBALS ALINK ASC 3,LINKS AON ASC 1,ON AOFF. ASC 2,OFF AALL ASC 2,ALL AEND. ASC 2,END AFWAM ASC 2,FWAM ALWAM ASC 2,LWAM AFWAB ASC 3,FWABP ALWAB ASC 3,LWABP AFWAC ASC 2,FWAC ALWAC ASC 2,LWAC ALOCC ASC 2,LOCC ABPLC ASC 3,BPLOCC AXFER ASC 3,?XFER ABAS ASC 2,BASE ACUR ASC 4,CURRENT ASTRT ASC 3,START AIN ASC 1,IN AAT.. ASC 1,AT ASET. ASC 2,SET ATO.. ASC 1,TO AEXT ASC 5,EXTERNALS AIEXT ASC 4,INDIRECT ADEXT ASC 3,DIRECT AECHO ASC 2,ECHO * PRPTA ASC 1,-_ * PTR NOP CNTR NOP PTR2 NOP CCNT NOP QQCN1 NOP QQPT. NOP TEMP NOP NCHAR NOP CNT NOP SKP SKP * * SCANNER ROUTINE * ***** * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF MNEMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4  YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COMMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I SKP * * INPUT COMMAND LINE * ***** * ** CMDIN ** INPUT NEXT COMMAND LINE USING SIO DRIVERS * CALLING SEQUENCE: * * JSB CMDIN * RETURN * * NOTE: CMDIN CHECKS FOR '-' IF REQUIRED AND DOES A JMP CMER IF NOT * THERE. IT ALSO SKIPS COMMENTS AND ADVANCES INPUT BUFFER * POINTERS PAST THE '-' IF IT APPEARS IN THE INPUT BUFFER. * * THE IDENTIFIER CMDLU IS USED TO SET UP TTY VS PHOTORDR INPUT * * CMDLU=JSB 104B,I FOR KEYBOARD(TTY) INPUT * NO COMMAND ID CHAR. REQUIRED. NO ECHO. * * =JSB 101B,I FOR BATCH INPUT(E.G., PHOTOREADER, * OR CASSETTE). * COMMAND ID REQUIRED IN COLUMN. 1, AND ECHO TO LIST UN * IMPLIED. * * RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED * ***** CMDIN NOP CLA RESET INCOMING CHARACTER STA QQCNT POINTERS LDA QBUFA STA QQPTR JSB PRMT SEND PROMT,READ REPLY DEF *+6 DEF PRPTA DEF B2 DEF QIBUF DEF D72 DEF PARSB STA QQCHC JMP CMDIN,I AND RETURN * MOVE3 NOP * ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 ISZ MOVE3 BUMP OUTPUT POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBERED CHAR? RSS JMP MOVE.,I NO, BUFFER IS OK IOR B40 NO,APPEND A BLLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I SPC 1 SKP * * ****COMMAND PROCESSORS**** * ***** * ** RELOCATE ** SEARCH COMMAND PROCESSORS * ***** RELST CLA,RSS SET SEARCH FLAG OFF. SPC 1 SERST CLA,INA SET SEARCH FLAG ON. SPC 1 STA LIBFL STORE FLAG CLA STA NREC CLEAR #GOOD RECORDS COUNTER STA RIC STA XNAM JSB FCLOS CLOSE OPEN REL INPUT FILE...IF NOT CLOSED. DEF *+2 DEF RLDCB LDA LOCC HAS LOCC BEEN SET YET? SZA JMP *+3 YES LDA .MEM3 NO--SET TO FWAM STA LOCC LDA BPLOC HAS BPLOC BEEN SET YET? SZA JMP *+3 YES. GO GET NEXT NON-BLANK CHARACTER. LDA .MEM1 NO. SET BASE PAGE STA BPLOC TO FWABP+5. JSB NXTC GET NEXT NON-BLANK CHAR JMP LDRIN NO MORE CPA B54 IS IT A COMMA? JMP LDRIN YES...IGNORE REST OF LINE CPA B50 LEFT PAREND? RSS YES JMP CMER NO--COMMAND ERROR LDA BLANK BLANK OUT XNAM STA XNAM+1 STA XNAM+2 LDA XNAMA JSB MOVE. * JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NO MORE CPA B51 RIGHT PAREN? JMP LDRIN YES JMP CMER NO, ERROR JMP LDRIN XNAMA DEF XNAM LBUFA DEF LBUF ***** * ** DISPLAY COMMAND PROCESSOR * ***** DSPST JSB BLINE BLANK PRINT LINE LDA QQPTR SAVE STA STMP BUFFER LDA QQCNT POINTERS STA SVAL LDA LBUFA MOVE NAME OF ENTITY TO BE DISPLAYED JSB MOVE. INTO THE OUTPUT BUFFER LDA STMP STA QQPTR RESTORE BUFFER POINTERS LDA SVAL STA QQCNT LDA MD11 LDB KTABL JSB SCAN IS THIS A KEYWORD? JMP DSP10 NO, IT MUST BE AN IDENTIFIER CPA D11 UNDEFS? JMP OLSTU CPA D10 TABLE? JMP OLSTE CPA B3 LDB .MEM3 CPA B4 LDB .MEM4 CPA B1 LDB .MEM1 CPA B2 LDB .MEM2 CPA B5 LDB .MEM5 CPA B6 LDB .MEM6 CPA D8 LDB BPLOC CPA D9 LDB ?XFER CPA B7 LDB LOCC GET CURRENT LOCATION COUNTER JMP DSP20 YES SPC 2 DSP10 LDB LBUFA JSB SSTBL SEARCH SYMBOL TABLE JMP DSP30 SYMBOL IS UNDEFINED LDB LST4A,I GET VALUE DSP20 LDA LBUF+2 SET EQUAL SIGN(=) IN 6TH CHAR AND UPCM OF PRINT LINE IOR B75 STA LBUF+2 LDA LBUF4 JSB CONV CONVERT THE VALUE TO ASCII LDA D12 DSP25 LDB LBUFA JSB PRINT PRINT THE LINE JMP NXTCM FINISHED, GET NEXT COMMAND DSP30 LDA MD5 MOVE "UNDEFINED" TO LBUF LDB DSP40 JSB DMOVEX LBUF4 DEF LBUF+3 LDA D15 JMP DSP25 * DSP40 DEF *+1 ASC 5,UNDEFINED ***** * ** MAP COMMAND PROCESSOR * * LISTO--CORE MAP LISTING FLAG * BIT 0 GLOBAL VARIABLES * 1 MODULES * 2 LINKS * 3 HEADING HAS BEEN PRINTED ***** MAPST LDA LISTO AND D8 STA LISTO MAP1 LDA MD6 LDB MTABL JSB SCAN JMP CMER STA B LDA LISTO CPB B4 MAP ON? RSS YES. SAME AS MAP ALL. CPB B6 ALL ? IOR B7 YES, SET ALL THREE OPTIONS. CPB B1 MODULES? IOR B2 CPB B2 GLOBALS? IOR B1 CPB B3 LINKS? IOR B4 CPB B5 OFF? CLA RESET POINTER STA LISTO JSB DELIM ADVANCE PAST DELIMITERS RSS JMP MAP1 LDA LISTO SZA,RSS ANY OPTIONS ON? JMP NXTCM NO, GET NEXT COMMAND AND D8 HAS HEADING BEEN PRINTED? SZA JMP NXTCM YES, GET NEXT COMMAND LDA LISTO RESTORE IOR D8 STA LISTO LDA HEAD1 LDB HEAD1+1 JSB LOUT LDA HEAD1 LDB HEAD2 JSB LOUT LDA HEAD1 LDB HEAD3 JSB LOUT JMP NXTCM GET NEXT COMMAND SPC 1 HEAD1 DEC 47 # CHARS. IN EACH PRINT LINE. DEF *+1 ASC 24, PROGRAM ENTRY LOW HIGH LOW HIGH HEAD2 DEF *+1 ASC 24, MODULE POINT MAIN MAIN BASE BASE HEAD3 DEF *+1 ASC 24, ---------------------------------------------- ***** * ** BOUNDS COMMAND PROCESSOR * ***** BNDST LDA MD6 LDB KTABL JSB SCAN JMP CMER NO MORE KEYWORDS ADA M1 ADA .MEM. COMPUTE ADDRESS STA NCHAR SAVE ADDRESS TEMPORARILY JSB NXTC GET NEXT NON BLANK CHAR JMP CMER CPA B75 EQUAL SIGN? RSS JMP CMER NO,ERROR JSB NSCAN GET OCTAL NUMBER JMP CMER NO MORE CHARS. JMP CMER NOT NUMERIC SSA IS IT POSITIVE OR ZERO? JMP BER1 NO. ISSUE ERROR AND IGNORE. STA NCHAR,I LEGAL ADDRESS, POST VALUE AND JSB DELIM JMP NXTCM JMP BNDST LOOK FOR NEW PARAMETERS SPC 1 BER1 LDB BER2 ISSUE "IL BND" ERROR JSB DIAG JMP NXTCM AND GET NEXT COMMAND * BER2 DEF *+1 DEC 6 ASC 3,IL BND ***** * ** SET COMMAND PROCESSOR * ***** SETST CLA STA STMP LDA M2 LDB LTABL LOCC OR BPLOCC? JSB SCAN JMP SET01 NO, MUST BE SYM TAB ENTRY ADA RBTA YES, SAVE ADDRESS TO STA STMP PUT VALUE INTO JMP SET02 SET01 JSB BLINE BLANK OUT THE BUFFER LDA LBUFA THEN MOVE NAME TO BUF JSB MOVE. FOR LATER CHECKING SET02 CCA LDB TOTBL LOOK FOR "TO" JSB SCAN JMP CMER NOT FOUND, ERROR JSB NSCAN GET VALUE JMP CMER JMP CMER STA SVAL SAVE VALUE LDB STMP IF SYM TAB ENTRY, SZB,RSS JMP SET03 THEN JUMP TO SET03 STA STMP,I ELSE SET VALUE INTO LOCC JMP NXTCM OR BPLOCC AND GET NEXT COMMAND SET03 LDB LBUFA LOOK FOR SYMBOL IN JSB SSTBL SYMBOL TABLE JMP SET04 NOT FOUND LDA SVAL IF FOUND, STA LST4A,I STORE VALUE, JMP NXTCM AND GET NEXT COMMAND SET04 LDA SVAL STA LST4A,I STORE THE VALUE CLA STA LST5A,I INITIALIZE LINK POINTER ISZ LST BUMP ENTRIES COUNTER LDB LBUFA LDA B,I STA LST1A,I STORE FIRST 2 CHARS INB LDA B,I STA LST2A,I STORE SECOND TWO CHARS INB LDA B,I AND UPCM ZER OUT EXT ID NBR STA LST3A,I AND STORE FIFTH CHAR JMP NXTCM THEN GET NEXT COMMAND * STMP NOP SVAL NOP ***** * ** LINKS STATEMENT COMMAND PROCESSOR * ***** LNKST LDA M2 LOOK LDB STABL FOR JSB SCAN "START" OR "IN". JMP CMER NEITHER, ERROR. CPA ONE 1 MEANS "START", ELSE "IN". JMP LSTRT GO DO LINKS START..... LDA M2 LOOK LDB BCTBL FOR JSB SCAN BASE OR CURRENT. JMP CMER NEITHER, ERROR. CLE,ERA 1 MEANT BASE, 2 MEANT CURRENT. STA CPLMG 0 => BASE, 1 => CURRENT MODE. STA CPLML SET LOCAL: 0 => OFF, 1 => ON. JMP NXTCM GO GET NEXT COMMAND. LSTRT CCA LDB ATTBL JSB SCAN LOOK FOR "AT" JMP CMER JSB NSCAN GET LINK ADDRESS JMP CMER JMP CMER STA LINKA AND SAVE IT JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER CPA B54 IS IT A COMMA? RSS YES, GOOD JMP CMER NO, ERROR JSB NSCAN GET LINK VALUE JMP CMER JMP CMER STA LINKV AND SAVE IT JSB LSTI INITIALIZE SYMBOL TABLE POINTERS LNK01 JSB LSTP ADVANCE TO NEXT ENTRY JMP NXTCM NO MORE, GET NEXT COMMAND LDB LINKA LDA LST4A,I CPA LINKV STB LST5A,I JMP LNK01 * LINKA NOP LINKV NOP * ***** * ** EXTERNALS INDIRECT/DIRECT OPTION * ***** EXTST LDA M2 DIRECT/INDIRECT...ONLY TWO LEGAL LDB DTABL ADDRESS OF START OF DIRECT/INDIRECT JSB SCAN LOOK FOR "DIRECT" OR "INDIRECT" JMP CMER ERROR CLE,ERA 1=INDIRECT, 2=DIRECT...CONVERT TO 0,1 STA DIRFL SAVE FOR ENTRIES JMP NXTCM AND GET NEXT COMMAND * DTABL DEF DIEXT * SKP ***** * ** ECOST ** ECHO ON/OFF STATEMENT PROCESSOR * ***** * ECOST LDA M2 TWO LEGAL OPTIONS: ON, OFF LDB SWTBL ON/OFF MNEMONIC-TABLE ADDRESS. JSB SCAN GO TO SEARCH FOR "ON" OR "OFF". JMP CMER * NEITHER ONE--ERROR! * CLE,ERA 1=ON, 2=OFF--CONVERT TO 0 OR 1. STA #ECHO SET THE COMMAND-ECHO SWITCH. JMP NXTCM GO TO GET THE NEXT COMMAND. * ***** * ** NXT>NLHC ** GET NEXT NON-BLANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP NXTC+1 GET ANOTHER CHARACTER CPA B55 IS IT A "-"? JMP NXTC+1 YES...IGNORE IT ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I MD4 DEC -4 B55 OCT 55 ***** * ** LTG ** LEADER-TRAILER GENERATOR ***** * ** DIAG ** OUTPUT MESSAGES THAT ARE STORED WITH THE CHAR COUNT * IMMEDIATELY PRECEEDING THE BUFFER. * CALLING SEQUENCE: * * LDB ADDRESS OF BUFFER MINUS 1, WHICH CONTAIN BUFFER LENGTH * JSB DIAG * RETURN * ***** DIAG NOP ENTRY: LDB,JSB LDA B,I INB JSB PRINT OUTPUT DIAGNOSTIC JMP DIAG,I RETURN. * * cN* DIAGNOSTIC OUTPUT SECTION * LER3 LDB ERR03 MEMORY OVERFLOW JMP ERROR * LER4 LDB ERR04 LINKAGE AREA OVERFLOW JMP ERROR * LER5 LDB ERR08 ERROR CALCULATING MODULE SIZE JMP ERROR * ERROR JSB DIAG PRINT DIAGNOSTIC ABORT LDB RAMSG PRINT MESSAGE JSB DIAG FOR RELOCATION ABORTED CLA STA UEXFL CLEAR UNDEF EXTERNS FLAG STA NAMR. ALLOW A NAM RECORD STA DIRFL DEFAULT IS FOR FORCED INDIRECT JSB LSTI INITIALIZE SYM TAB POINTERS LOOP1 JSB LSTP GO TO NEXT SYM TAB ENTRY JMP ABRT1 FCLOS FILE, IF OPEN LDA LST3A,I CLEAR AND UPCM EXTERNAL STA LST3A,I ID NUMBER JMP LOOP1 DO FOR ALL SYM TAB ENTRIES * ABRT1 JSB FCLOS FCLOS INPUT FILE DEF *+2 DEF RLDCB JMP PRCMD,I AND DO ERROR RETURN * RAMSG DEF *+1 OCT 6 ASC 3,REL AB * ERR03 DEF *+1 OCT 6 ASC 3,MEM OV * ERR04 DEF *+1 OCT 6 ASC 3,BPG OV * * ERR06 DEF *+1 OCT 6 ASC 3,COM OV * ERR07 DEF *+1 OCT 6 ASC 3,DU ENT * ERR08 DEF *+1 OCT 6 ASC 3,SIZ ER * ILBP LDB ILBP. JMP ERROR ILBP. DEF *+1 OCT 6 ASC 3,IL BPL SPC 2 SKP * *ROUTINES FOR PROCESSING RECORDS * ***** * ** NAM RECORD PROCESSOR *** RIC = 1 * * THIS ROUTINE IS CALLED TO ASSIGN SPACE FOR A PROGRAM * TO BE LOADED. THE NAM RECORD IS MOVED FROM LBUF TO * NBUF BEFORE THIS ROUTINE IS CALLED. * SPECIAL CONVENTIONS APPLY TO FORTRAN AND ALGOL * PROGRAMS. IN A FORTRAN PROGRAM (IDENTIFIED BY 1 IN * SIGN POSITION OF WORD 7 OF NAM RECORD) THE PROGRAM * LENGTH IN WORD 7 MAY BE GREATER THAN THE ACTUAL LENGTH. * THEREFORE THE UPPER BOUND IS NOT SET UNTIL LOADING * OF DATA BLOCKS. ***** NAMR NOP LDA CPLMG GET GLOBAL MODE FLAG. SZA,RSS IS GLOBAL MODE ON ? JMP NAMR2 NO, GO TO BASEw PAGE PROCESSING. JSB SIZE YES, GO GET SIZE OF MODULE. SZA,RSS WAS CPLML TURNED OFF IN SIZE ? JMP NAMR2 YES, DO NOT C.P. LINK THIS MODULE. SSA ERROR DURING SIZE PROCESSING? JMP LER5 YES. STA MODSZ NO, SAVE SIZE. LDA CPLPR RESET CURRENT PAGE LINK STA CPLP BUFFER POINTER. LDB LOCC GET CLA THE RRL 6 FIRST INA WORD LSL 10 ADDRESS STA FWANP NEXT PAGE. LDB LOCC GET NEGATIVE OF CMB,INB CURRENT LOCATION. ADB A SUBTRACT FROM FWANP. STB SIZEA SAVE # WORDS LEFT ON CURRENT PG. CMB,INB GET NEG # WORDS LEFT. ADB MODSZ SUBTRACT FROM MODULE SIZE. SSB,RSS PAGE CROSSING ? JMP PAGEX YES. CLA NO. STA CPLML TURN OFF LOCAL MODE. JMP NAMR2 FINISH PROCESSING NORMALLY. PAGEX STB SIZEB SAVE # WORDS OFF CURRENT PAGE. LDA SIZEA GET # WORDS CURR PG AGAIN. ADA MAGIC # SUBTRACT THE MAGIC NUMBER. SSA,RSS CLOSE ENOUGH TO PAGE BOUNDARY ? JMP DOFRM NO, GO DO THE MIN FORMULA. LDA FWANP YES, STA LOCC MOVE LOCC UP TO NEXT PAGE. STA CPLS SET CURR PG LINK START ADDR. STA CPPTR SET CURR PG LINK POINTER. LDA MODSZ GET TOTAL SIZE OF MODULE. ADA MD1K SUBTRACT 1024. STA MSM1K SAVE FOR POSSIBLE USE LATER. SSA IS TOTAL SIZE LESS THAN 1024 ? JMP NOLNK YES, NO LINKS NEEDED ON CP. ADA MD256 NO, SUBTRACT ANOTHER 256. SSA IS TOTAL SIZE LESS THAN 1280. JMP SMLNK YES, ALLOCATE (MSM1K) LINK AREA. LDA ONE28 NO, STA #LNKS ALLOCATE 128 LINKS. SETUP ADA LOCC BUMP LOCC OVER STA LOCC CP LINK AREA. LDA CPLPR GET LINKS BUFFER ADDRESS. ADA #LNKS BUMP BY NUMBER OF LINKS ALLOCATED. STA CPLE SET CP AREA END. JMP NAMR2 CONTINUE NAM PROCESSING. NOLNK CLA STA CPLML TURN OFF LOCAL MODE. STA #LNKS ZERO LINK ALLOCATION. JMP NAMR2 CONTINUE NAM PROCESSING. SMLNK LDA MSM1K GET MODULE SIZE MINUS 1024. ARS,ARS DIVIDE BY 4. STA #LNKS ALLOCATE (MSM1K-1024)/4 LINKS. JMP SETUP GO SET UP ADDRESSES BEFORE CONTINUING. DOFRM LDA SIZEA GET A FOR FORMULA. ARS DIVIDE BY TWO. CMA,INA MAKE NEGATIVE. ADB A SUBTRACT A/2 FROM B. SSB WHICH IS SMALLER. JMP BLTA B LESS THAN A/2, OR EQUAL. LDA SIZEA A/2 LESS THAN B. ARS DIVIDE BY TWO. JMP BLTA+1 BLTA LDA SIZEB GET B AGAIN. ARS,ARS DIVIDE BY 4. STA #LNKS ALLOCATE LINKS. LDA LOCC SET UP STA CPLS START AND STA CPPTR POINTER. ADA #LNKS BUMP LOCC OVER CP ALLOCATION. JMP SETUP+1 GO TO SAVE LOCC & SET CP LIMIT. NAMR2 LDA NBUF+10 CHECK BASE PAGE LENGTH SSA JMP ILBP ILLEGAL BASE PAGE LENGTH(<0) LDB NBUF+11 GET COMMON LENGTH. SZB,RSS JMP NM1 NO COMMON LDA .MEM5 SZA,RSS JMP NM6 ALLOCATE 1ST COMMON CMA,INA ADA .MEM6 INA STA COML CMB,INB ADB A CHECK FOR COMMON LENGTH OVERFLOW SSB,RSS JMP NM1 LENGTH GOOD LDB ERR06 COMMON BLOCK ERROR JMP ERROR SPC 2 NM6 STB COML ALLOCATE 1ST COMMON LDA LOCC MOVE PROGRAM RELOCATION BASE UP. STA .MEM5 ADA COML STA .MEM6 INA STA LOCC RESET LOCATION COUNTER NM1 LDA BPLOC SET LOWER BOUND OF BASE PAGE AREA STA BPPTR INITIALIZE BASE PAGE POINTER LDA LOCC SET LOWER BOUND OF PROGRAM AREA STA PAPTR INITIALIZE PROGRAM AREA POINTER LDA .MEEM5 STA COMOR LDA NBUF+9 GET PROGRAM LENGTH STA FTNFL SET FORTRAN LOADING FLAG - BIT 15 CPA M1 ALGOL PROGRAM? JMP NAMR,I YES. LIMITS SET DURING LOADING. * * ALLOCATE BASE PAGE STORAGE * LDA NBUF+10 GET BASE PAGE AGAIN SZA,RSS IF NO BP ALLOCATION, JMP NM2 CHECK FOR PROGRAM ALLOCATION. ADA BPLOC COMPUTE LAST LOCATION & STA B CHECK FOR OVERFLOW ADA M1 CMA,INA ADA .MEM2 SSA NEGATIVE MEANS OVERFLOW JMP LER4 OF BASE PAGE AREA STB BPPTR SET UPPER LIMIT B. P. * * ALLOCATE PROGRAM AREA STORAGE * NM2 LDA NBUF+9 GET PROGRAM LENGTH SZA,RSS IF PROGRAM LENGTH = 0, JMP NAMR,I LDB FTNFL COMPILER-GENERATED? SSB JMP NAMR,I YES,LIMITS SET DURING DBL PROCESSING ADA LOCC COMPUTE HIGH ADDRESS & STA B CHECK FOR OVERFLOW CMA,INA ADA .MEM4 SSA NEGATIVE RESULT MEANS OVERFLOW JMP LER3 MEMORY OVERFLOW ERROR STB PAPTR SET UPPER BOUND JMP NAMR,I SPC 1 SPC 2 ***** * ** ENT ** EXT RECORD PROCESSORS * * ENT RECORD PROCESSOR (RIC = 2) * EXT RECORD PROCESSOR (RIC = 4) * * PURPOSE OF THIS SECTION IS TO PROCESS ENTRY POINTS * AND EXTERNAL SYMBOLS, ADD SYMBOLS TO THE * LOADER SYMBOL TABLE, AND * SET A FLAG IF AN ENTRY POINT FROM A LIBRARY * LOAD MATCHES AN UNDEFINED EXTERNAL SYMBOL. * CONTROL RETURNED FROM THIS SECTION TO -LDRIN-. * * WORDS USED FOR TEMPORARY STORAGE: * * LBUF - RECORD TYPE FLAG: 1 = ENT, 0 = EXT * LBUF+1 - NEGATIVE COUNT OF ENT/EXT ENTRIES IN RECORD. * LBUF+2 - FIRST WORD ADDRESS OF CURRENT ENTRY. ***** EXTR CLA,RSS EXT: FLAG=0 ENTR CLA,INA ENT: FLAG=1 STA LBUF SAVE RECORD TYPE LDA LBUF+1 GET AND ISOLATE AND B77 RECORD ITEM COUNT. CMA,INA SET NEGATIVE FOR = STA LBUF+1 COUNTER IN PROCESSING LDA LBUFA SET LBUF+2 = ADDRESS OF ADA B3 FIRST ENTRY STA LBUF+2 IN RECORD * * CHECK LST AND RECORD ENTRIES FOR MATCHING SYMBOLS * ENTX1 LDB LBUF+2 GET ADDRESS OF SYMBOL JSB SSTBL SEE IF IT IS THERE JMP ENTX6 NOT THERE...PUT IT IN LDB LBUF+2 GET ADDRESS OF WORD #3 OF ADB B2 ENTRY NAME. LDA LBUF IF RECORD TYPE SZA,RSS JMP EXT0 IS EXT, GO POST ORDINAL. * * SYMBOL MATCH IN ENT RECORD * LDA LST4A,I IS ENT DEFINED? SZA OR IS IT A SPECIAL ENTRY CPA UDFE IS SPECIAL..TREAT AS UNDEF ENTRY JMP ENT21 NO. SET VALUE FROM RECORD. LDB SERFG YES, LOADING FROM LIBRARY SZB JMP ENTX5 IGNORE DUPLICATE FROM LIBRARY. LDB ERR07 JSB DIAG COMPLAIN ABOUT DUPLICATE LDB LBUF+2 LDA B5 PRINT "OFFENDING" ENT SYMBOL JSB PRINT JMP ENTX5 * * ADD ENTRY POINT ADDRESS TO LST ENTRY. * ENT21 CLA CLEAR "LIBRARY LOAD" FLAG. STA SERFG ENT22 LDA B,I GET WORD 3 OF RECORD ENTRY STA LST3A,I AND STORE IN LST WORD 3. INB GET WORD 4 OF RECORD ENTRY LDB B,I (ENTRY VALUE). CMB COMPLEMENT TO INDICATE UNRELOCATED STB LST4A,I SAVE IN LST FOR LATER ACTION. * * ENTRY FROM INPUT LOADING * * * ADVANCE TO NEXT RECORD ITEM * ENTX5 LDB LBUF+2 GET OLD RECORD ENTRY ADDRESS ADB B3 ADD 3 FOR NEXT EXT ENTRY. ADB LBUF ADD ONE MORE FOR ENT RECORD. STB LBUF+2 SET ADDRESS OF NEXT ENTRY. ISZ LBUF+1 INDEX ENTRY COUNT - JMP ENTX1 MORE TO PROCESS. JMP LDRIN FINISHED- GET NEXT RECORD. * * NO MATCH IN LST FOR RECORD ENTRY SYMBOL - ADD * NEW ENTRY - CHECK FIRST FOR MEMORY CONFLICT. * * ENTX6 LDB LBUF+2 (B) = RECORD ENTRY ADDR. LDA B,I MOVE WORDS 1 AND 2 OF RECORD Z$STA LST1A,I ENTRY TO WORDS INB 1 AND 2 NEW LST ENTRY LDA B,I (WORD 3 WILL BE SET LATER) STA LST2A,I INB (B) = ADDR. OF WORD 3, REC. ENTRY LDA UDFE STA LST4A,I DENOTE UNDEFINED. CLA STA LST5A,I DENOTE NO LINK ASSIGNED ISZ LST ADD 1 TO LST ENTRY COUNT. LDA LBUF GET RECORD TYPE FLAG SZA JMP ENT22 ENT; GO POST VALUE. EXT0 LDA B,I GET WORD 3 OF RECORD ENTRY, STA LST3A,I STORE TO POST EXT ORDINAL. LDA DIRFL FORCED INDIRECT FLAG 0-FORCED INDIRECT SZA 1-MAKE DIRECT LINK IF YOU CAN JMP ENTX5 NON-ZERO, POSTPONE LINK ASSIGNMENT LDA LST5A,I HAS A LINK ALREADY BEEN ASSIGNED? SZA JMP ENTX5 YES, CONTINUE PROCESSING LDA LST4A,I NO, ALLOCATE ONE CPA UDFE LINK ROUTINE RECOGNIZES UNDEFINED AS CLA 0 IN .A.(VALUE OF SYMBOL PARAM) JSB LINK ALLOCATE THE LINK STB LST5A,I AND UPDATE SYMBOL TABLE JMP ENTX5 GO PROCESS NEXT ITEM. * * ER10 LDB LST1A,I MOVE SYMBOL INTO STB ER10B ERROR MESSAGE. LDB LST2A,I STB ER10B+1 LDB LST3A,I STB ER10B+2 LDB ERR10 JSB DIAG LDA NBUF+2 STORE OPCODE ONLY. JMP DBL3 * ERR10 DEF *+1 OCT 21 ASC 6, UNDEF EXT: ER10B BSS 3 DIRFL NOP DIRECT FLAG, 1=DIRECT OPTION, 0=ALWAYS INDIRECT ***** * ** RELEN ** RELOCATE ENTRY POINT ADDRESS * CALLING SEQUENCE: (B) = UNRELOCATED ENT VALUE * (A)=CONTENTS OF LST3(RELOCATION BASE) * JSB RELEN * RETURN: (A) = LINK ADDRESS, IF ANY * (B) = RELOCATED ENT ADDRESS * * PURPOSE: RELOCATES ENT ADDRESS AS DESIGNATED * BY THE RELOCATION FIELD (R) IN BITS * 00-01 OF (LST3). 0 = PROGRAM, 1 = BASE * PAGE, 2 = COMMON, 3 = ABSOLUTE. * ALSO POSTS VALUE IN LINK TABLE. * BITS 07-00 OF (LST3) ARE CLEARED. ***** RELEN NOP ENTRY/EXIT POINT AND B7 GET R-FIELD ADA RBTO ADB A,I RELOCATE SYMBOL VALUE STB LST4A,I POST ENTRY VALUE IN LST. LDA LST5A,I GET LINK ADDRESS, IF ANY SZA,RSS IS LINK ASSIGNED? JMP RELEN,I NO. EXIT. ADA BPAGA C174 STB A,I YES. POST VALUE IN LINK TABLE. LDA LST5A,I RECOVER LINK ADDRESS JMP RELEN,I EXIT SKP * * DBL RECORD PROCESSING * * DATA BLOCK RECORD PROCESSOR (RIC = 3) SPC 1 * THIS SECTION RELOCATES THE LOAD ADDRESS OF A DATA * BLOCK AND RELOCATES AND STORES THE WORDS IN IT. * * A RELOCATION BYTE IS ASSOCIATED WITH EACH * INSTRUCTION OR DATA WORD IN A DBL RECORD. * THIS 3-BIT BYTE CONTAINS ONE OF THE * FOLLOWING RELOCATION INDICATORS: SPC 1 * 000 - ABSOLUTE * 001 - PROGRAM RELOCATABLE * 010 - BASE PAGE RELOCATABLE * 011 - COMMON RELOCATABLE * 100 - EXTERNAL SYMBOL REFERENCE (NO OFFSET) * 101 - TWO-WORD GROUP. WORD 1 CONTAINS OPCODE, * RELOCATION BYTE FOR OFFSET, AND AN OPTIONAL * EXTERNAL SYMBOL ORDINAL. WORD 2 CONTAINS THE * OFFSET (ADDRESS). THE RELOCATION BYTE CAN BE: * 00 - PROGRAM * 01 - BASE PAGE * 10 - COMMON * 11 - ABSOLUTE * 110 - TWO-WORD BYTE ADDRESS RECORD * * THIS SECTION USES THE RELOCATION BASE * TABLE (RBT) TO RELOCATE THE LOAD * ADDRESS AND DATA WORDS. THE RELOCATION * BASES IN THE RBT ARE SET BY THE NAM * RECORD PROCESSOR. THE TABLE IS STRUCTURED * AS: * RBTA DEF *+1 * RBT OCT 0 (ABSOLUTE) * PREL (PROGRAM ORIGIN - FWA) * BPREL (BASE PAGE ORIGIN (FROM ORB) * COMOR (COMMON AREA ORIGIN) * OCT 0 (ABSOLUTE AGAIN) * * IF A FORTRAN GENERATED PROGRAM IS BEING LOADED, * A CHECK FOR MEMORY OVERFLOW IS MADE BEFORE * EACH DBL RECORD IS PROCESSED. IF OVERFLOW OCCURS, * AN IMMEDIATE TERMINATION OF LOADING IS MADE * BY TRANSFERRING TO THE ERROR ROUTINE. OTHERWISE, * THE NEW FWA OF THE MEMORY AREA IS SET AND * LOADING CONTINUES. THE DBL RECORDS FOR A FTN * OBJECT PROGRAM ARE GENERATED IN ASCENDING * ORDER - I.E. THE LOAD ADDRESS OF EACH DBL RECORD * IS LARGER THAN THE PREVIOUS - AND THE LAST DBL * RECORD LOADED IS THE LAST PROGRAM SEGMENT (I.E., * A BSS DOES NOT FOLLOW) SO THE NEW FWA OF AVAIL. * MEMORY IS KNOWN AFTER THE LAST DBL RECORD IS * PROCESSED. ******************************************************************** SPC 3 ***** * ** DBL RECORD PROCESSOR * ***** SPC 2 DBLR LDA LBUF+1 RELOCATE THE ASR 6 DBL AND B3 LOAD XOR B1 ADDRESS STA QGETC SAVE RELOCATION BASE CODE ADA RBTO LDA A,I NOW GET RELOCATED ADDRESS ADA LBUF+3 AND ADD RECORD RELOCATION STA LBUF STORE RELOCATED RECORD ADDRESS LDB CPLMG GET GLOBAL MODE FLAG SZB,RSS IS GLOBAL MODE ON? JMP DBL00 NO - NEEDN'T CHECK PAGE CROSSING LDB CPLML GET LOCAL MODE FLAG SZB,RSS IS LOCAL MODE ON? JMP DBL00 NO * YES - CHECK FOR PAGE CROSSING AND C076 GET PAGE OF LOCAL ADDRESS STA ABRC1 ** TEMPORARY STORAGE ** LDA CPLS GET PAGE OF BEGINNING AND C076 CURRENT PAGE LINKS CPA ABRC1 SAME PAGES JMP *+3 YES - PROCEED AS NORMAL CLA NO - TURN OFF CURRENT PAGE STA CPLML LINKS LOCAL MODE LDA LBUF GET LOAD ADDRESS AGAIN DBL00 STA ABRC1 STORE ABSOLUTE RECORD ADDRESS. LDA LBUF+1 GET # OF AND B77 INSTRUCTIONS CMA,INA AND MAKE NEGATIVE STA LBUF+1 STORE INSTRUCTION COUNT * * CHECK FOR MEMORY OVERFLOW OF FTN OR ALGOL PGM * CMA,INA RESET WORD COUN0T TO POSITIVE. ADA LBUF ADD LOAD ADDR. TO WORD COUNT. LDB FTNFL FORTRAN OR ALGOL PROGRAM? SSB,RSS JMP DBL0 NO. LIMIT CAME FROM NAM REC. LDB QGETC GET RELOCATION CODE SZB PROGRAM RELOCATION BASE? JMP DBL0 NO, CONTINUE PROCESSING STA PAPTR YES, SAVE HIGH MAIN ADDRESS CMA,INA ADA .MEM4 SSA A NEGATIVE RESULT MEANS OVERFLOW JMP LER3 AND TERMINATION OF LOADING. DBL0 LDA LBUF5 GET ADDRESS OF WORD 5 OF DBL * RECORD (FIRST RELOC. BYTE WORD) STA LBUF+2 IN LBUF+2. DBL1 LDB LBUF+2,I SET RELOCATION BYTE WORD STB LBUF+3 IN LBUF+3. LDA M5 SET BYTE COUNTER STA NBUF = -5 ISZ LBUF+2 SET ADDRESS FOR FIRST DATA WORD. DBL2 LDA LBUF+3 GET RELOC. BYTE WORD - ROTATE ALF,RAR 3-BIT BYTE FOR NEXT INSTR. TO STA LBUF+3 LOW A AND RESTORE WORD. AND B7 ISOLATE BYTE. CPA B4 IF BYTE = 4, THEN GO TO EXTERNAL JMP DBL4 REFERENCE SECTION. CPA B5 IF BYTE = 5, THEN GO TO 2-WORD JMP DBL5 MEMORY REFERENCE GROUP SECTION. CPA B6 IF BYTE = 6, THEN GO TO PROCESS JMP DBL6 BYTE ADDRESS INSTRUCTION. ADA RBTA BYTE = 0-3. ADD ADDR. OF RBT LDA A,I TO BYTE AND GET BASE VALUE. ADA LBUF+2,I ADD DATA WORD TO RELOCATION BASE DBL3 JSB PACK$ LDA LBUF GET LOAD ADDRESS ISZ LBUF INCREMENT IT XOR LBUF CHECK TO SEE IF A PAGE AND C076 BOUNDARY WAS CROSSED SZA,RSS JMP DBL31 CLA YES, SO CAN NO LONGER STA CPLML USE CURRENT PAGE LINKS DBL31 ISZ LBUF+1 INDEX DATA WORD COUNT JMP DBL9 MORE IN RECORD. JSB PUNCH OUTPUT THE ABSOLUTE RECORD. JMP LDRIN PROCESS NEXT INPUT RECORD. * DBL9 ISZ LBUF+2 ADD 1 TO RECORD ADDRESS ISZ NBUF INDEX REL-BYTE |(COUNTER JMP DBL2 MORE BYTES IN WORD JMP DBL1 GET NEXT BYTE WORD. * * CODE 4: ADDRESSABLE INSTRUCTION OR DEF REFERENCING * AN EXTERNAL SYMBOL (WITHOUT OFFSET). ADDRESSABLES * USE PRIOR LINK AS FIRST CHOICE SO AS TO RE-USE * LINKS OUT OF CURRENT AREA. DEFS USE DIRECT ADDRESS * AS FIRST CHOICE. * DBL4 LDA LBUF+2,I GET INSTR. WORD STA NBUF+2 SAVE IT JSB ORDSR SEARCH FOR EXT ORDINAL LDA NBUF+2 AND C074 GET OPCODE SZA,RSS DEF? JMP DBL45 YES. USE VALUE IF DEFINED. LDB LST5A,I GET LINK ADDRESS SZB IS LINK ASSIGNED? JMP DBL46 YES. USE IT. DBL45 LDB LST4A,I GET VALUE CPB UDFE DEFINED? CLA,RSS NO. JMP DBL10 YES, LINK MAY NOT BE NEEDED LDB LST5A,I GET LINK ADDRESS SZB,RSS IS LINK ASSIGNED? JSB LINK NO. GET ONE. STB LST5A,I SAVE LINK ADDRESS. DBL46 LDA NBUF+2 GET INSTRUCTION SSA FORWARD REFERENCES INDIRECTLY TO JMP DBL47 EXTERNAL, TREAT AS THOU NOT DEFINED AND C174 REMOVE EXT ORDINAL IOR C1000 SET FOR INDIRECT IOR B COMBINE ADDRESS JMP DBL3 GO STORE INSTRUCTION * DBL47 LDB LST4A,I GET ACTUAL ADDRESS...FOR RELOCATION * DBL10 CLA STA RTMP1 SET UP RTMP FOR NO LINK CASE LDA LST5A,I IF ENTRY IS SPECIAL IOR BIT15 DON'T USE DIRECT LINK SZB,RSS LDB A USE BASE PAGE INDIRECT JSB SPLIC BUILD INSTR,ALLOC LINK IF NEEDED. LDB NBUF+2 GET MODIFIED INSTRUCTION. SSB IF IT IS AN INDIRECT EXTERNAL REFERENCE, JMP DBL3 DO NOT CHANGE THE SYMBOL TABLE ENTRY. LDB RTMP1 ELSE, GET THE NEW LINK ADDRESS. SZB IF A NEW LINK WAS CREATED, STB LST5A,I SAVE IT IN SY.MBOL TABLE ENTRY. JMP DBL3 * RTMP1 NOP * ORDSR NOP AND B377 ISOLATE EXT ORDINAL STj$A NBUF+1 SAVE ORDINAL SZA,RSS EXT PRESENT? JMP ORDSR,I NO. EXIT. JSB LSTI INITIALIZE LST PROCESSOR ORDLP JSB LSTP SET LST ENTRY ADDRESSES. JMP ILEXT ORDINAL MUST EXIST LDA LST3A,I GET WORD 3 OF LST ENTRY, ISOLATE AND B377 BITS 07-00, AND COMPARE VALUE TO CPA NBUF+1 SAVED EXT ORDINAL RSS JMP ORDLP NOT FOUND, KEEP SEARCHING LST LDA LST4A,I FOUND SSA,RSS IS IT REALLY AN EXT ID #? JMP ORDSR,I YES, RETURN JMP ORDLP NO, KEEP LOOKING * SKP * CODE 5: 2-WORD GROUP FOR MEMORY REFERENCE OR * EXTERNAL REFERENCE WITH OFFSET. * DBL5 LDA LBUF+2,I GET WORD 1 (OP-CODE,REL. BYTE) STA NBUF+2 SAVE IT RAR,RAR JSB ORDSR ANY EXTERNAL? ISZ LBUF+2 POINT AT OFFSET LDB LBUF+2,I GET OFFSET LDA NBUF+2 GET WORD 1 AND B3 SAVE REL BYTE ADA RBTO ADB A,I RELOCATE OPERAND LDA NBUF+1 SZA,RSS ANY EXTERNAL? JMP DBL5A NO. LDA LST4A,I CPA UDFE IS EXTERNAL DEFINED? JMP ER10 NO. COMPLAIN. SZA,RSS IF ADDRESS IS SPECIAL...NOT DEFINED SZB,RSS NO OFFSET IS ALLOWED RSS OK JMP ER10 ERROR OFFEST ON SPECIAL NOT LEGAL ADB LST4A,I YES, ADD VALUE. DBL5A JSB SPLIC JMP DBL3 STORE IT. * * CODE 6: 2-WORD GROUP FOR BYTE ADDRESS DEFINITION (DBL/DBR) * DBL6 LDA LBUF+2,I GET THE INSTRUCTION WORD. ALF POSITION INSTRUCTION TO LOWER BYTE. AND D15 ISOLATE INSTRUCTION FIELD. SZA MUST BE =0; ELSE, JMP LER2 THIS IS AN ILLEGAL RECORD! LDA LBUF+2,I GET THE INSTRUCTION WORD AGAIN. AND B3 ISOLATE THE RELOCATION INDICATOR. LDB RBTO GET THE PROPER ADB A RELOCATION BASE LDB B,I FROM THE TABLE. RBL CONVERT IT TO BYmTE ADDRESS FORMAT [*2]. ISZ LBUF+2 POINT TO THE SECOND INSTRUCTION WORD. LDA LBUF+2,I GET THE BYTE ADDRESS. CLE,SSA IF THE SIGN IS SET, THEN JMP LER2 THIS IS AN ILLEGAL RECORD! ADA B FORM THE RELOCATED BYTE ADDRESS. SEZ,RSS IF THE RESULT IS A VALID BYTE ADDRESS, JMP DBL3 GO TO RECORD THE RESULT; ELSE, JMP LER2 REPORT THE ILLEGAL RECORD ERROR! * SKP ***** * ** SPLIC ** * * THIS ROUTINE COMBINES OPCODES WITH ADDRESSES IN * ADDRESSABLE INSTRUCTIONS. BASE PAGE LINKS ARE USED * AS REQUIRED TO HANDLE PAGE CROSSINGS. ***** SPLIC NOP LDA NBUF+2 RECOVER OPCODE AND C174 STA NBUF+2 SAVE INSTRUCTION RAL,CLE,SLA,ERA IF INSTR IS INDIRECT, SET SSB JMP SPL1 ADB C1000 INDIRECT BIT IN ADDRESS. SPL1 SZA,RSS ADDRESSABLE INSTRUCTION? JMP SPL2 NO. GO STORE VALUE. C074 STB A GET OPERAND ADDRESS AND C076 GET PAGE ADDRESS SZA,RSS IN BASE PAGE? JMP DBL8 YES. XOR LBUF COMPARE WITH LOAD ADDRESS AND C076 SAVE MODULE/PAGE ADDRESS. SZA,RSS JMP DBL7 OPERAND IS IN SAME PAGE. LDA B DIFFERENT: (A)_OPERAND ADDRESS JSB LINK GET BASEPAGE LINK SWP AND AMASK SAVE ONLY THE OFFSET FROM PAGE BOUND. SWP STB RTMP1 STORE OFFSET. LDA NBUF+2 (B) = OFFSET OF LINK, (A) = INSTRUCTION. IOR C1000 SET INDIRECT BIT IOR ZCBIT MERGE APPROPRIATE Z OR C BIT. SPL2 IOR B COMBINE ADDRESS JMP SPLIC,I * * OPERAND IN SAME PAGE AS INSTRUCTION. * DBL7 LDA B GET OPERAND ADDRESS AND AMASK ISOLATE PAGE AREA ADDRESS. IOR B2000 SET Z BIT = 1 (CURRENT PAGE) DBL7A IOR NBUF+2 COMBINE OPCODE, IND JMP SPLIC,I * * REFERENCE TO BASE PAGE OPERAND * DBL8 LDA B GET OPND JMP DBL7A * ILNLHEXT LDB ILEX1 OUTPUT "IL EXT" ERROR JMP ERROR * SKP * CONSTANT AND STORAGE SECTION FOR -DBLR-. * ILEX1 DEF *+1 OCT 6 ASC 3,IL EXT M5 OCT -5 B377 OCT 377 AMASK OCT 101777 SAVE INDIRECT C076 OCT 76000 B2000 OCT 2000 LBUF5 DEF LBUF+4 ZCBIT NOP EITHER ZERO OR 2000B. * vN SKP ***** * ** LINK ** ALLOCATE LINK WORD * * PURPOSE: TO SEARCH BASE PAGE LINK TABLE * FOR AN EXISTING OPERAND ADDRESS MATCHING * THE PARAMETER OPERAND AND TO ALLOCATE * A WORD TO CONTAIN THE OPERAND ADDRESS * IF A MATCH IS NOT FOUND. SPC 1 * THE OPERAND ADDRESS PARAMETER IS STORED * IN THE LINKAGE WORD IF A MATCH IS NOT * FOUND IN THE LINKAGE AREA. SPC 1 * THE OPERAND ADDRESS PARAMETER IS IN * THE A-REGISTER ON ENTRY TO LINK. THE * LOCATION OF THE WORD IN THE LINKAGE * AREA CONTAINING THE OPERAND IS RETURNED * TO THE CALLER IN THE B-REGISTER. * * ENTRY: (A) = OPERAND ADDRESS FOR SEARCH THRU LINKS * TABLE(BPAGE), OR 0 IF VALUE IS UNDEFINED * AND THE ALLOCATION OF A LINK IS TO BE * FORCED. * SPC 2 LINK NOP ENTRY/EXIT POINT STA LINK3 SAVE OPERAND CLB RESET TO BASE PAGE STB ZCBIT AS DEFAULT. LDB BPPTR GET HIGHEST BASE PAGE LOCATION SZA,RSS IS THE LINK AREA TO BE SEARCHED? JMP LINK2 NO, FORCED LINK. LDB .MEM1 YES,START AT BOTTOM LINK1 CPB BPPTR HAS ENTIRE LINK AREA BEEN SEARCHED? JMP LINK4 MATCH, GOTO ALLOCATE WORD. LDA B ADA BPAGA LDA A,I GET LINK WORD CPA LINK3 MATCH? JMP LINK,I YES INB JMP LINK1 SPC 2 LINK2 STB A CMB,INB ADB .MEM2 OVERFLOW? SSB JMP LER4 YES NO LINK ROOM. ADA BPAGA GET ADDRESS IN BASE PAGE LINK TABLE LDB LINK3 STORE VALUE STB A,I IN THERE LDB BPPTR RETURN WITH LINK ADDRESS IN (B) ISZ BPPTR INCREMENT BASE PAGE BOUND JMP LINK,I EXIT WITH LINK ADDRESS IN (B) LINK3 NOP TEMP FOR OPND ADDRESS LINK4 LDA CPLMG IS GLOBAL SZA,RSS MODE ON ? JMP LINK2 NO, GO TO BASE PAGE CODE. LDA RIC GET RELOCATION INDICATOR BACK. CPA B4 ARE WE PROCESSING AN EXT RECORD ? JMP LINK2 YES, GO DO BASE PAGE LINK FOR IT. LDA CPLML GET THE LOCAL MODE FLAG. CPA M1 IF IT'S =-1, BUFFER IS FULL, BUT PAGE JMP LINK5-1 STILL SAME, SO GO SEARCH OLD C.P.LINKS. SZA,RSS IF LOCAL MODE HAS BEEN TURNED OFF, JMP LINK2 GO TO CREATE A BASE PAGE LINK. LDA CPLPR NO, SEARCH FOR EXISTING LINK. LINK5 CPA CPLP DONE LOOKING ? JMP LINK6 YES, MAKE NEW LINK. LDB A,I NO, GET NEXT CP LINK VALUE. CPB LINK3 DO THE VALUES MATCH ? JMP LINK7 YES, WE HAVE AN EXISTING LINK. INA NO, BUMP TO ADDRESS NEXT VALUE. JMP LINK5 GO CHECK NEXT VALUE (MAYBE). LINK6 LDA CPLE IS THERE ROOM CPA CPLP FOR ANOTHER LINK. JMP LINK8 NO, CHANGE MODES. LDA LINK3 GET VALUE FOR NEW LINK. STA CPLP,I SET VALUE IN NEW LINK. LDB CPPTR GET ADDRESS OF NEW LINK. ISZ CPLP BUMP ADDRESS FOR NEXT LINK. ISZ CPPTR BUMP LINK ADDRESS POINTER. LDA B2000 SET BIT 10 FOR STA ZCBIT CURRENT PAGE LINK. JMP LINK,I RETURN TO CALLER. LINK7 LDB CPLPR GET ADDRESS OF EXISTING LINK. CMB,INB MAKE IT NEGATIVE. ADB A (A) = LINK ADDRESS IN HOST BUFFER. ADB CPLS (B) = LINK ADDRESS IN TARGET CORE. LDA B2000 SET BIT 10 FOR STA ZCBIT CURRENT PAGE LINK. JMP LINK,I RETURN TO CALLER. LINK8 CCA SET LOCAL C.P. MODE STA CPLML TO INDICATE C.P. BUFFER IS FULL. LDB BPPTR GET NEXT BP LINK ADDRESS. JMP LINK2 AND GO TO BASE BASE CODE. * * THIS IS THE IMAGE OF THE TARGET'S CURRENT PAGE * LINKING AREA. IT ALSO SERVES AS THE BUFFER TO * BE FILLED AND OUTPUT TO THE ABS OUTPUT FILE. * CPLEN NOP LENGTH WORD h3OF ABS RECORD. CPLS NOP ABS LOAD ADDRESS FOR LINKS. CPLKS BSS 128 SPACE FOR LINK VALUES. CPSUM NOP LEAVE ROOM FOR CHECKSUM. * CPLPR DEF CPLKS LINK AREA ADDRESS (NOT MODIFIED). CPLP DEF CPLKS POINTER FOR STORING VALUES IN BUFFER. CPLE NOP LAST WORD ALLOCATED TO LINKS IN BUFFER. #LNKS NOP NUMBER OF LINKS ALLOCATED. CPPTR NOP TARGET'S ADDRESS OF LINK. N#LNK NOP NEG # LINKS (FOR CKSUM LOOP CONTROL). M128 DEC -128 BECAUSE THIS MACHINE CANNOT SUBTRACT. SKP * RECORD PROCESSING CONTROL * ******************************************************************** * THIS SECTION CONTROLS THE INPUT OF OBJECT * PROGRAMS FROM THE STANDARD INPUT AND PROGRAM * LIBRARY DEVICES. THE TRANSFER OF CONTROL TO * THE APPROPRIATE RECORD PROCESSORS IS MADE * FROM THIS SECTION. EACH PROCESSOR (EXCEPT * NAM PROCESSOR) RETURNS TO THE LABEL -LDRIN-. * * INPUT RECORD, LEGALITY CHECK AND CHECKSUM SECTION ******************************************************************** LDRIN LDA RIC WAS LAST RECORD AN END RECORD? CPA B5 JMP NXTCM GET NEXT COMMAND INCHK LDA LBUFA GET BUFFER WHERE TO PUT REL. JSB RBIN GET NEXT RELOCATABLE RECORD JMP CMER FILE ERROR ON INPUT CPA M1 END OF FILE? JMP NXTCM YES. GO TO GET NEXT COMMAND. SZA,RSS NO. ZERO LENGTH RECORD? JMP INCHK YES. READ NEXT RECORD. * * CHECK FOR LEGAL RECORD TYPE * LDA LBUF+1 GET TYPE WORD ALF,RAR ROTATE RIC FIELD TO AND B7 LOW A AND ISOLATE CODE STA RIC SAVE FOR PROCESSING SZA IF RIC=0 ADA M6 OR GREATER THAN 5 SSA,RSS ERROR? JMP LER2 YES LDA LBUF GET NEGATIVE COUNT CMA,INA NEGATE COUTN STA LBUF STA CONV SET UP WORD COUNT JMP LDRC AND PROCESS RECORD * LER2 LDB ERR02 YES...TELL THEM ILLEGAL RECORD JSB DIAG JMP ABORT AND ABORT RELOCATION SPC 1 * PROCESS VALID RECORD * LDRC ISZ NREC BUMP COUNT # GOOD RECORDS. LDA RIC (A) = RECORD TYPE LDB SERFG (B) = LIBRARY LOAD FLAG CPA B1 IF RIC = 1, THEN GO TO PROCESS JMP LDRC3 NAM RECORD. SSB,RSS JMP SERJP IF LOADING, CONTINUE PROCESSING CPA B5 IF NOT LOADING, RSS AND IF THIS IS AN END RECORD, JMP INCHK JMP INCHK ELSE READ THE NEXT RECORD SERJP ISZ NAMR. CPA B2 IF RIC = 2, JMP ENTR GO PROCESS ENT RECORD. * * FIRST NON-ENT ON LIBRARY LOAD; * SEE IF THIS PROGRAM IS NEEDED. * SZB DIRECT LOAD? JMP LDRC5 NO, SET TO SKIP ISZ FNENT FIRST NON-ENT/NON-NAM? RSS JSB NAMR PROCESS SAVED NAM RECORD * * TRANSFER TO RECORD PROCESSOR SECTION. * LDA RIC CPA B3 IF RIC = 3, GO TO JMP DBLR DBL RECORD PROCESSOR. CPA B4 EXT? JMP EXTR EXT RECORD PROCESSOR. CPA B5 END RECORD? JMP ENDR YES. GO TO PROCESS. JMP LER2 NO. STRANGE RECORD! SKP * * PROCESSING FOR END RECORD * ***** * ** END RECORD PROCESSOR * ***** CLOOP NOP ENDR LDA #LNKS CHECK LINK ALLOCATION. SZA,RSS SKIP IF LINKS HAVE BEEN ALLOCATED. JMP ENDR6 SKIP OUTPUT OF CP LINK RECORD. LDA CPLS GET THE RECORD'S LOAD ADDRESS. STA B SAVE FOR LAST ADDRESS COMPUTATION. CMA,INA CALCULATE OFFSET TO C.P. BUFFER ADA CPLPR LOCATION IN . STA PLKS SAVE FOR USE BY ABSOLUTE PUNCH ROUTINE. ADB #LNKS COMPUTE THE LAST ADDRESS ADB M1 FOR THIS ABSOLUTE RECORD. LDA CPLS = FIRST LOAD-ADDRESS OF THE RECORD. JSB PLK GO TO PUNCH THE ABSOLUTE RECORD(S). LDA M128 SET UP STwA CLOOP CLEAR LOOP COUNTER. LDA CPLPR GET ADDRESS OF LINK AREA. CLB STB A,I INA ISZ CLOOP JMP *-3 * AREA SHOULD NOW BE RESET TO ZERO. ENDR6 LDA CPLMG TURN LOCAL MODE BACK ON STA CPLML IFF GLOBAL MODE IS ON. CLA SET FLAG FOR STA NAMR. NAM RECORD EXPECTED STA #LNKS CLEAR FOR NEW RELOCATION INDICATION. LDA ?XFER IS THERE ALREADY A TRANSFER ADDRESS? SZA TAKE ONLY THE FIRST ONE JMP ENDR0 LDA LBUF+1 GET ADDRESS RAR SSA,RSS IS TRANSFER ADDRESS GIVEN? JMP ENDR1 AND B3 ADA RBTO RELOCATE THE LDA A,I TRANSFER ADDRESS ADA LBUF+3 STA ?XFER STORE RELOCATED TRANSFER ADDRESS CLA,RSS AND MOVE PROGRAM NAME&PARAMETERS. ENDR1 LDA PNAME IS DEFAULT NAME ALREADY THERE? SZA JMP ENDR0 YES--DON'T MOVE NAME. LDA MD14 ZERO PNAME BUFFER LDB PNAMA STB CONV CLB STB CONV,I ISZ CONV INA,SZA JMP *-3 DLD B3 SET DEFAULT PROGRAM TYPE AND DST PRAMS PRIORITY LDA PNAMA GET 15-BIT ADDRESS OF PNAME STA PNDEF AND STORE INLINE LDA NSCAN GET NEG. # WORDS IN NAM BUFFER CPA MD9 IS THIS A 9-WORD NAM RECORD? RSS YES. CONTINUE. LDA MD17 NO. TREAT IT AS A 17-WORD NAM RECORD. ADA B3 MOVE ONLY NAME AND PARAMETERS LDB NBUF6 MOVE PROGRAM NAME AND PARAMS TO PNAME. JSB MOVEX PNDEF NOP DESTINATION BUFFER ADDRESS. * * PRINT MODULE NAME, BOUNDS(MAIN AND BASE PAGE) * ENDR0 LDA LISTO PRINT MODULE NAME? ARS SLA,RSS JMP ENDR2 NO, CONTINUE PROCESSING JSB BLINE BLANK INPUT LINE LDA M3 MOVE MODULE NAME TO LDB NBUF6 LBUF JSB MOVEX DEF LBUF+1 * LDA NSCAN GET THE NAM-RECORD SIZE. ADA D60 IF IT IS LARGER SSA THAN SIXTY WORDS, JMP NAMPR BYPASS NAM EXTENSION PROCESSING. LDA NSCAN GET THE NAM-RECORD SIZE AGAIN. CPA MD9 IF IT IS A 9-WORD NAM, JMP NAMPR THEN BYPASS NAM-EXTENSION PROCESSING. CPA MD17 IF IT IS A 17-WORD NAM-RECORD, JMP NAMPR THEN NO EXTENSION EXISTS--BYPASS. ADA D17 COMPUTE THE NAM-EXTENSION SIZE, STA CONV AND SAVE THE RESULT, TEMPORARILY. * LDB NBF20 GET ADDRESS OF FIRST EXTENSION WORD. JSB MOVEX MOVE THE NAM-EXTENSION INFORMATION DEF LBUF+4 TO THE PRINT BUFFER. * LDA CONV GET THE EXTENSION SIZE AGAIN. ADA MD4 ADD 4 WORDS FOR NAME & LEADING BLANKS. LDB LBUFA GET THE ADDRESS OF THE PRINT BUFFER. JSB LOUT GO TO PRINT PROGRAM NAME & EXTENSION. JMP LSTAD BYPASS PROCESSING FOR SIMPLE NAMS. * NAMPR LDA MD4 GET PARAMETERS LDB LBUFA TO PRINT ONLY JSB LOUT THE PROGRAM'S NAME. * LSTAD JSB BLINE GO TO CLEAR THE PRINT BUFFER. * LDA LBF10 NOW CONVERT LOW MAIN ADDRESS LDB LOCC JSB CONV INA NOW CONVERT CCB ADB PAPTR CONVERT HIGH MEMORY ADDRESS JSB CONV INA LDB BPLOC JSB CONV INA CCB ADB BPPTR CONVERT HIGH BASE PAGE JSB CONV LDA B60 LDB LBUFA THE JSB LOUT THE LINE * * LIST ENTRY POINTS, RELOCATE THEM, AND CLEAR * FLAGS IN SYMBOL TABLE * ENDR2 CLA SET # EXTERNALS YET UNDEFINED STA UEXFL CLEAR # UNDEFINEDS COUNTER. JSB LSTI SET LST POINTERS. ENDR3 JSB LSTP SET LST ENTRY ADDRESSES. JMP ENDR5 END OF LIST--GO SET LOCC,BPLOC JSB BLINE BLANK PRINT LINE LDA LST3A,I GET FLAG WORD OF ENTRY. STA TEMP SAVE FOR LATER RELOCATION AND UPCM CLEAR FLAG BITS 7-0 STA LST3A,I  IOR B40 SET BLANK IN LOW CHAR. STA LBUF+7 PUT IN PRINT BUFFER LDB LST4A,I GET VALUE. CPB UDFE DEFINED? JMP ENDR4 NO-BUMP UNDEFINEDS COUNTER CMB,SSB HAS SYMBOL BEEN RELOCATED? JMP ENDR3 YES--NOT PART OF THIS MODULE. LDA TEMP GET RELOCATION BASE JSB RELEN RELOCATE THE VALUE LDA LISTO PRINT ENTRY POINT NAMES? SLA,RSS JMP ENDR3 NO LDA LST1A,I GET CHARS 1,2 STA LBUF+5 LDA LST2A,I GET CHARS 3,4 STA LBUF+6 STORE; CHAR 5 ALREADY THERE. LDB LST4A,I GET RELOCATED VALUE LDA LBF10 GET ADDRESS TO STORE CONVERTED ASCII JSB CONV CONVERT TO OCTAL LDA D26 LDB LBUFA JSB LOUT JMP ENDR3 ENDR4 ISZ UEXFL JMP ENDR3 ENDR5 LDA PAPTR MOVE LOCC UP STA LOCC LDA BPPTR MOVE UP BPLOC STA BPLOC LDA XNAM IF XNAM IS ZERO, SZA CONTINUE PROCESSING RECORDS JMP NXTCM IF NOT GET NEXT COMMAND JMP INCHK * D17 DEC 17 D60 DEC 60 NBF20 DEF NBUF+20 * SKP * * PRELIMINARY NAM RECORD PROCESSING * ***** * * THIS PROCESSING OF NAM RECORDS OCCURS BEFORE DECIDING * WHETHER OR NOT TO RELOCATE A MODULE * ***** LDRC3 LDB NAMR. IS NAM 1ST RECORD? SZB IS NAM 1ST RECORD? JMP LDRC8 NO--SEQUENCE ERROR. LDB XNAMA LDA B,I SZA,RSS WAS A MODULE NAME SPECIFIED? JMP L.DC4 NO. CPA LBUF+3 YES--DOES THIS MODULE MATCH THE NAME? INB,RSS JMP LDRC6 NO--SKIP IT LDA B,I CPA LBUF+4 INB,RSS JMP LDRC6 LDA B,I XOR LBUF+5 AND UPCM SZA JMP LDRC6 L.DC4 LDA LST STA LSTS SAVE SYMBOL-TABLE SIZE FOR BACKUP. LDA CONV GET NEGATIVE WORD COUNT FOR NAM-RECORD. STA NSCAN SAVE FOR LOGGING PROCESSOR. ADA B3 MADD AN OFFSET FOR FIRST NAME-WORD. LDB LBUF4 MOVE RECORD TO NBUF, STARTING FROM NAME. JSB MOVEX NBUF6 DEF NBUF+6 CCA SET FLAG FOR 1ST NON-ENT STA FNENT LDA LIBFL STA SERFG JMP LDRIN GO PROCESS NEXT RECORD. * * RESET PROCESSING - PROGRAM FROM LIBRARY IS * TO BE DISCARDED. LDRC5 LDA LSTS STA LST PROGRAM) LST LENGTH. LDRC6 CCA SUPPRESS LOADING PROGRAM. STA SERFG CLA STA NAMR. JMP INCHK * LDRC8 LDB ERR09 MISSING END RECORD JSB DIAG ERROR *L09 JMP ABORT NO, ABORT RELOCATION BSS 2 STORAGE FOR MOVEX MOVEX NOP MOVE A BLOCK OF DATA STA MOVEX-1 STORE NEG. # WORDS. LDA MOVEX,I GET DESTINATION BUFFER ADDRESS. JSB INDIR ENSURE DIRECT ADDRESSES. ISZ MOVEX SET RETURN ADDRESS. STA MOVEX-2 STORE DESTINATION POINTER LDA B,I GET WORD STA MOVEX-2,I STORE IN DESTINATION BUFFER. INB POINT TO NEXT SOURCE ADDRESS. ISZ MOVEX-2 POINT TO NEXT DESTINATION ADDRESS. ISZ MOVEX-1 DONE? JMP *-5 NO. GO BACK FOR MORE. JMP MOVEX,I YES. RETURN TO CALLER. * * CONSTANTS AND STORAGE FOR MAIN CONTROL SECTION * MD14 DEC -14 LIBFL NOP NREC NOP #GOOD RECORDS COUNTER. RIC OCT 0 HOLDS RECORD IDENTIFICATION CODE UPCM OCT 77400 UPPER CHARACTER MASK. LSTS OCT 0 USED DURING LIBRARY LOADING TO FNENT NOP * FTNFL OCT 0 2^15=1 IF FORTRAN/ALGOL * M6 DEC -6 D72 DEC 72 * ERR02 DEF *+1 OCT 6 ASC 3,IL REC * ERR09 DEF *+1 OCT 6 ASC 3,REC SE * SERFG NOP "SEARCH" FLAG=1 IF SEARCHING, 0 IF DIRECT LOAD. XNAM BSS 3 SPC 2 OLSTE CLA,INA,RSS ENTRY POINT LIST OPTION OLSTU CLA LIST UNDEFINED SYMBOLS OPTION JSB EPL JMP NXTCM * INDIR NOP INDIRECT ADDRESS TRACK-DOWN ROUTINE. n RSS TRACK DOWN LDA A,I A DIRECT RAL,CLE,SLA,ERA ADDRESS IN THE JMP *-2 REGISTER. RSS TRACK DOWN LDB B,I A DIRECT RBL,CLE,SLB,ERB ADDRESS IN THE JMP *-2 REGISTER. JMP INDIR,I RETURN. SKP * * PROCESSOR FOR END COMMAND * ***** * ** END COMMAND PROCESSOR * ***** EOL ISZ PRCMD SET UP SUCCESS RETURN (P+2) LDA LOCC IF NO MODULES RELOCATED, SZA,RSS JMP PRCMD,I RETURN IMMEDIATELY LDA ?XFER ELSE CHECK FOR TRANSFER ADDRESS SZA JMP ENDC4 YES. EOL1 LDA MXFR PRINT "?XFER?" LDB MXFR+1 JSB PRINT JSB CMDIN GET TRANSFER ADDR FROM INPUT JSB NSCAN JMP EOL1 JMP EOL1 STA ?XFER JMP ENDC6 GO OUTPUT LINKS. * ENDC4 LDA .XBUF PRINT EXECUTION POINT LDB ?XFER JSB CONV LDA D22 LDB SAQA JSB PRINT ENDC6 JSB PLINK PUNCH LINKS * * PRINT LIST OF UNDEFINEDS, IF ANY, OR "NO UNDEFS" * CLA JSB EPL * * CHECK IF LINKS TABLE IS TO BE PRINTED, * AND IF SO, PRINT "LINKS TABLE" * LDA LISTO ARS,ARS SLA,RSS JMP NOHED DONT PRINT HEADER LDA ENC10 PRINT "LINKS TABLE" AS HEADER LDB ENC10+1 JSB LOUT NOHED JSB LSTI INITIALIZE SYMBOL TABLE SCAN ENDC7 JSB LSTP GET POINTERS TO NEXT ENTRY. JMP PRCMD,I FINISHED SCAN. RETURN TO MAIN CONTROL. JSB MLBUF MOVE SYMBOL TO LBUF LDB LST5A,I SZB,RSS IS LINK ASSIGNED? JMP ENDC7 NO LDA LBUF4 CONVERT LINK JSB CONV LDA LST4A,I CPA UDFE IS SYMBOL DEFINED? JMP ENDC8 NO ENDC9 LDA LISTO IS LINK TABLE TO BE PRINTED? ARS,ARS SLA,RSS JMP ENDC7 NO LDA D12 LDB LBUFA PRINT THE LINE JSB LOUT JMP ENDC7 ENDC8 LDA LS=T5A,I OUTPUT A ZERO IN ALL UNDEFINED SYMBOL'S STA ABRC1 LINK LOCATIONS. CLA JSB PACK$ JSB PUNCH JMP ENDC9 * * ***** CONSTANTS ***** * ENC10 DEC 12 DEF *+1 ASC 6, LINKS TABLE MXFR DEC 6 DEF *+1 ASC 3,?XFER? MD60 DEC -60 MD17 DEC -17 MD11 DEC -11 MD9 DEC -9 MD8 DEC -8 MD6 DEC -6 MD5 DEC -5 M1 OCT -1 B1 OCT 1 B2 OCT 2 B4 OCT 4 B5 OCT 5 D8 DEC 8 D22 DEC 22 B3 OCT 3 DEFAULT PROGRAM TYPE AND DEC 99 PRIORITY D11 DEC 11 B30 OCT 30 B40 OCT 40 B51 OCT 51 B54 OCT 54 UDFE OCT 77777 WHAT ENT IS IF IT ISN'T DEFINED. C1000 OCT 100000 * LBF10 DEF LBUF+9 SKP ***** * ** EPL * ENTRY POINT LIST ROUTINE * * CALLING SEQUENCE: * (A): =0, LIST UNDEFINED EXTERNAL SYMBOLS. * =1, LIST ENTRY POINT SYMBOLS AND * ABSOLUTE ADDRESSES FROM LST. * * (P) JSB EPL * (P+1) (RETURN) A AND B DESTROYED * ***** EPL NOP ENTRY/EXIT POINT STA NBUF SAVE ENTRY PARAMETER. SZA,RSS UNDEFS? JMP EPL5 YES--CHECK COUNTER EPL0 JSB LSTI INITIALIZE SYMBOL TABLE POINTERS. EPL1 JSB LSTP SET LST ENTRY ADDRESSES JMP EPL,I END OF SYMBOL TABLE JSB MLBUF MOVE SYMBOL TO LBUF LDB LST4A,I (B) = ENT. ADDRESS LDA NBUF (A) = ENTRY PARAMETER SZA IF ENT LIST REQUESTED JMP EPL2 GO TO CONVERT ADDRESS IN B. CPB UDFE DEFINED? RSS NO. JMP EPL1 YES, GO CHECK NEXT ENTRY. LDB LBUFA LDA B5 JSB PRINT OUTPUT SYMBOL AND LINK LOCN. JMP EPL1 CONTINUE SCAN * * LIST SYMBOL TABLE * EPL2 CPB UDFE ENTRY DEFINED? JMP EPL1 NO LDA LBUF4 DEFINED,PRINT VALUE JSB CONV LDA D12 LDB LBUFA JSB LOUT JMP EPL1 PROCESS9 NEXT ENTRY IN LST. * EPL5 LDA UEXFL GET # UNDEFINEDS COUNTER SZA ANY UNDEFINEDS? JMP EPL7 YES--LIST THEM. LDA EPL6 NO--PRINT "NO UNDEFS" LDB EPL6+1 JSB PRINT JMP EPL,I SPC 1 EPL6 DEC 9 DEF *+1 ASC 5,NO UNDEFS SPC 1 EPL7 LDA UNDFS PRINT "UNDEFS" LDB UNDFS+1 JSB PRINT JMP EPL0 * UNDFS DEC 7 DEF *+1 ASC 4, UNDEFS * * CONSTANT AND STORAGE SECTION FOR -EPL- . * .XBUF DEF SAQB SAQA DEF *+1 ASC 8,STARTING ADDRESS SAQB BSS 3 M2 OCT -2 M3 OCT -3 B6 OCT 6 B7 OCT 7 B60 OCT 60 * * * MOVE CURRENT SYMBOL VROM SYMBOL TABLE TO LBUF * MLBUF NOP LDA M3 LDB LST1 JSB MOVEX DEF LBUF LDA LBUF+2 MAKE 6TH CHAR. A BLANK IOR B40 STA LBUF+2 JMP MLBUF,I SKP ***** * * SUBROUTINE: CONV (CONVERT 15-BIT BINARY NUMBER * TO 6-CHARACTER (LEADING BLANK) * ASCII FORM OF THE OCTAL * REPRESENTATION.) * * CALLING SEQUENCE: * * (A)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (B)-BINARY VALUE FOR CONVERSION * * (P) JSB CONV * (P+1) (RETURN)-(A)=NEXT ADDRESS OF STORAGE * AREA,(B)-DESTROYED. ***** CONV NOP STA NBUF+3 SAVE STORAGE AREA ADDRESS RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA NBUF+4 = -3. LDA B40 MAKE FIRST CHARACTER A SPACE. CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA NBUF+5 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR NBUF+5 PACK IN UPPER CHARACTER STA NBUF+3,I AND STORE IN STORAGE AREA. ISZ NBUF+3 ADD 1 TO STORAGE AREA ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ NBUF+4 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDA NBUF+3 FINISHED, SET (A)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * BLANK ASC 1, (ORG LBUF-1 FOR EPL SUBROUTINE) LBUF OCT 0 OCT 0 BSS 58 NBUF BSS 63 HOLDS PROGRAM NAME,PARAMETERS,COMMENTS. NBUF9 EQU NBUF+9 * SKP ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. ISZ QGETC SKIP EXIT JMP QGETC,I * QBUFA DEF QIBUF QIBUF BSS 40 QQCHC NOP QQCNT NOP QQPTR NOP T1 NOP T3 NOP PCHAR NOP * SKP ***** * ** NSCAN ** GET NUMBER FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB NSCAN * RETURN1 NO MORE CHARACTERS * RETURN2 ILLEGAL NUMBER * RETURN3 GOT ONE, VALUE IN .A. * ***** NSCAN NOP CLA INITIALIZE VALUE STA T3 JSB NXTC JMP NSCAN,I NO MORE NON BLANK CHARS ISZ NSCAN JMP NSC2 * NSC1 STA T3 JSB QGETC GET A CHARACTER JMP NSCX+1 DONE RETURN NUMBER NSC2 STA PCHAR SAVE CHAR CPA B54 COMMA? JMP NSCX YES. END OF FIELD. CPA B40 BLANK? JMP NSCX YES-END OF FIELD ADA M60 CONVERT TO DIGIT SSA IS IT A DIGIT? JMP NSCAN,I NO, ERRSOR STA T1 SAVE DIGIT ADA MD8 LEGAL DIGIT? SSA,RSS JMP NSCAN,I LDA T3 MPY D8 MULTIPLY RADIX ADA T1 JMP NSC1 * NSCX JSB BAKUP BACK UP OVER LAST CHAR LDA T3 PICK UP VALUEE ISZ NSCAN RETURN (P+2) JMP NSCAN,I SKP ***** * ** PLINK ** PUNCH LINKS * CALLING SEQUENCE * * JSB PLINK * RETURN * ***** PLINK NOP PUNCH LINKS LDA BPAGA STORE OFFSET FOR PUNCHING STA PLKS LDA .MEM1 START SEARCH OF BASE PAGE LINKS AREA PLIN1 CPA .MEM2 FINISHED SEARCH? JMP PLINK,I YES--EXIT LDB A ADB BPAGA GET ADDRESS OF 1ST WORD IN LINK TABLE LDB B,I GET VALUE SZB SEARCH FOR 1ST NONZERO ENTRY JMP *+3 GOT ONE INA JMP *-8 STA PLK1 STORE LOW ADDRESS CPA B2000 END OF PAGE? JMP PLIN2 YES--PUNCH REST OF RECORD LDB A ADB BPAGA LDB B,I SZB,RSS JMP PLIN2 FOUND END OF BLOCK INA JMP *-8 SPC 2 PLIN2 ADA M1 CONVERT TO ACTUAL HIGH ADDRESS STA B OF PUNCH AREA, AND LDA PLK1 GET LOW ADDRESS OF PUNCH AREA JSB PLK PUNCH LDA PLK1 GET ADDRESS TO START NEXT SEARCH JMP PLIN1 * SKP SKP * * CONSTANTS,AND MESSAGES * * * * ***** CONSTANTS ***** * ONE DEC 1 B50 OCT 50 D9 DEC 9 D10 DEC 10 D12 DEC 12 D15 DEC 15 D26 DEC 26 B75 OCT 75 B77 OCT 77 B177 OCT 177 M60 OCT -60 MAGIC DEC -24 MD1K DEC -1024 MD256 DEC -256 ONE28 DEC 128 * * BPPTR BSS 1 BASE PAGE POINTER PAPTR NOP PROGRAM AREA POINTER MODSZ NOP FWANP NOP SIZEA NOP SIZEB NOP MSM1K NOP SPC 3 * * THE BASE PAGE LINKS TABLE (STORED IN BPAGE) * HAS ROOM FOR 1020 WORDS, CORRESPONDING * TO CORE ADDRESSES (OCTITRNAL) 4-1777. * LOCATIONS 0-1 ARE INACESSIBLE AYWAY. AND LOCATIONS * 2,3 ARE RESERVED FOR RTS PROGRAM DESCRIPTION RECORDS. * BPAGA DEF *+1 BPAGE NOP BASE PAGE LINKS TABLE (1024 NOP'S) UNL REP 1023 NOP LST SPC 1 END EQU * * END LSWAP T N.} 91700-18141 1602 S 0122 DS1/B CCE MODULE: SCGN3              H0101 CASMB,L,C HED SCGN3 91700-16141 REV.A 760108 * (C) HEWLETT-PACKARD CO. 1976 * NAM SCGN3,5 91700-16141 REV.A 760108 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************** * *SCGN3 ON-LINE LOADER SEGMENT...LOADER CONTROL * *SOURCE PART # 91700-18141 REV A * *REL PART # 91700-16141 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 9-18-74 * *MODIFIED BY: K.HAHN * *DATE MODIFIED: 6-27-75 * ***************************************************** SPC 1 * * DEFINE EXTERNALS * EXT LST,PLK,PLKS,?XFER,LSTI,LSTP EXT .MEM.,PRCMD EXT FTRKA,NSEC,NTRK,SECA,TRKA,ENDM EXT DSKLU,SMTLN,SECTK EXT UEXFL,SSTBL,.MEM3 EXT LST1,LST2,LST3,LST4,LST5 EXT .MEM1,.MEM4 EXT .MEM2,.MEM5,.MEM6,NAMR.,LISTO EXT FWAM,LWAM,PARSA EXT PNAME,PNAMA,PRAMS EXT EXEC,LOCC,BPLOC,PRINT EXT INDCB,PRMT,GTOUT,ABDCB EXT FCRET,WRITF,FCLOS,CLSFI EXT FILCK,FERR,SWAPR,LSDCB,CMDLU EXT LOUT,ENDLU,COML,PUNCH,ABRC1,PACK$ SUP SPC 1 * * DEFINE ENTRY POINTS * SPC 1 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SKP SKP SKP * * THIS IS WHERE WE START. * SPC 2 GSWAP NOP START HERE LDA RSTA GET STARTING ADDRESS JMP SWAPR AND RETURN TO MAIN SPC 1 RSTA DEF RSTRT SPC 1 RSTRT CLA CLEAR OUT POINTERS STA PNAME STA LOCC STA BPLOC STA COML STA ?XFER STA LST JSB PRCMD JMP RSTRT ERROR...RETRY LDA ?XFER LDB LOCC SZA IF NO STARTING ADDRESS OR SZB,RSS NOTHING RELOCATED JMP LDRDN TERMINATE JSB GENID SET IN ID SEGMENT LDRDN JSB CLSFI AND TERMINATE...CLOSE FILES LDA P16 LDB DNMSG "LOADER COMPLETED" JSB LOUT JSB EXEC SEND TERMINATION MESSAGE DEF *+5 DEF P2 DEF ENDLU DEF DNMSG+1 DEF P8 JSB FCLOS TERMINATE LIST FILE DEF *+3 DEF LSDCB DEF ZERO JSB FCLOS TERMINATE INPUT FILE DEF *+3 DEF INDCB DEF ZERO JSB EXEC RELEASE TRACKS DEF *+3 DEF P5 DEF N1 JSB EXEC AND TERMINATE DEF *+2 DEF P6 SPC 2 P23 DEC 23 P6 DEC 6 P8 DEC 8 P12 DEC 12 P128 DEC 128 P5 DEC 5 P4 DEC 4 P30 DEC 30 P10 DEC 10 P64 DEC 64 P3 DEC 3 ZERO NOP P14 DEC 14 P2 DEC 2 P7 DEC 7 N1 DEC -1 P200 DEC 200 P16 DEC 16 M20 DEC -20 P99 DEC 99 M7400 OCT 177400 N24 DEC -24 N60 DEC -60 N100 DEC -100 JMP3I JMP 3,I DNMSG DEF *+1 ASC 8,SCEGN COMPLETED SKP * JSB GENID * * * RETURN: A AND B ARE DESTROYED * GENID NOP LDA M20 STA TEMP1 CLA LDB ALBUF BUFFER ADDRESS STA B,I ISZ TEMP1 JMP *-2 LDB PNAMA GET DISPLACEMENT INTO ID SEGMENT ADB P7 GET TO WORD 7 LDA B,I 7 GET PRIORITY SZA,RSS LDA P99 DEFAULT TO 99 STA LBUF+3 LDA ?XFER ENTRY POINT STA LBUF+17 LDB PNAMA LDA B,I NAME 1,2 STA LBUF INB LDA B,I NAME 3,4 STA LBUF+1 INB LDA B,I NAME 5, BLNK AND M7400 MASK OUT BLANK INA MAKE TYPE 1 STA LBUF+2 LDB PNAMA  ADB P8 GET TO WORD 8 OF NAM RECORD LDA B,I RESOLUTION ALF,ALF ALF,RAL SHIFT INTO PLACE INB IOR B,I MURGE EXEC MULT STA LBUF+4 PUT IN BUFFER INB LDA B,I HOURS SZA,RSS LDA N24 DEFAULT TO 24 STA LBUF+6 INB LDA B,I MINUTES SZA,RSS LDA N60 DEFAULT TO 60 STA LBUF+7 INB LDA B,I SECONDS SZA,RSS LDA N60 DEFAULT TO 60 STA LBUF+8 INB LDA B,I TENS OF SEC SZA,RSS LDA N100 DEFAULT TO 100 STA LBUF+9 LDA .MEM3 LOW MAIN STA LBUF+10 LDA LOCC HIGH MAIN STA LBUF+11 LDA .MEM1 LOW BASE STA LBUF+12 LDA BPLOC HIGH BASE STA LBUF+13 LDA .MEM5 STA LBUF+14 LDA COML STA LBUF+15 LDA JMP3I STA LBUF+16 LDA M9 STA TEMP1 MOVE TO 2 WORD RECORDS LDA ALBUF STA TEMP2 LDA P2 STARTING ADDRESS STA ABRC1 GNID1 LDA TEMP2,I JSB PACK$ ISZ TEMP2 LDA TEMP2,I JSB PACK$ ISZ TEMP2 JSB PUNCH ISZ TEMP1 JMP GNID1 NOT DONE JMP GENID,I RETURN * ALBUF DEF LBUF M9 DEC -9 TEMP1 NOP TEMP2 NOP SPC 1 LBUF BSS 32 LNKSV BSS 1 SKP * * SUBROUTINE TO READ INPUT * READ NOP STA READ2 STB READ1 JSB PRMT DEF *+6 READ1 NOP DEF READ2 DEF LBUF DEF P64 DEF PARSA JMP READ,I SPC 1 READ2 NOP SPC 2 END GSWAP * { OW 91700-18142 1612 S 0122 DS1/B CCE MODULE: SCGN4              H0101 CASMB,L,C HED SCGN4 91700-16142 REV.A 760314 * (C) HEWLETT-PACKARD CO. 1976 * NAM SCGN4,5 91700-16142 REV.A 760314 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************* * *SCGN4 START UP SEGMENT FOR SCE GENERATOR * *SOURCE PART # 91700-18142 REV A * *REL PART # 91700-16142 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-29-74 * *MODIFIED BY: K. HAHN [ C.C.H. ] * *DATE MODIFIED: 6-27-75 [03-14-76] * ***************************************************** SPC 1 * * DEFINE EXTERNALS * EXT LST,PLK,PLKS,?XFER,LSTI,LSTP EXT .MEM.,PRCMD EXT FTRKA,NSEC,NTRK,SECA,TRKA,ENDM EXT DSKLU,SMTLN,SECTK EXT UEXFL,SSTBL,.MEM3 EXT LST1,LST2,LST3,LST4,LST5 EXT .MEM1,.MEM4 EXT .MEM2,.MEM5,.MEM6,NAMR.,LISTO EXT FWAM,LWAM,PARSA EXT PNAME,PNAMA,PRAMS EXT EXEC,LOCC,BPLOC,PRINT EXT PRMT,GTOUT,ABDCB EXT FCRET,WRITF,FCLOS EXT FILCK,FERR,SWAPR,LSDCB,CMDLU EXT LOUT,ENDLU,COML,PUNCH,ABRC1,PACK$ EXT FOPEN,INDCB,PARS5,STKAD,P:TR,PUSH EXT NOPRT,PARS3,PRS31,PARS2,PRS21,PRS41 EXT SC3CD,RMPAR,LDRCD,S45CD,SWPLC EXT INDB3 EXT COR.A SUP SPC 1 * * DEFINE ENTRY POINTS * SPC 1 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SKP SKP SKP * * THIS IS WHERE WE START. * FIRST WE FIGURE HOW MUCH CORE WE HAVE * THEN WE GET THE NAME OF THE LIST FILE * AND THEN AWAY WE GO DOING OUR GENERATION * SRTSG NOP CONTROL TRANSFERED HERE BY MAIN LDA STRTA RETURN TO MAIN WITH START ADDRESS JMP SWAPR BACK WE GO SPC 1 STRTA DEF START SPC 2 START NOP CONTROL RETURNED HERE BY MAIN LDA 1657B ADDRESS OF KEYWORD TABLE STA TEMP1 SAVE FOR LOOP TRY LDB TEMP1,I GET FIRST ID SEG ADDRESS SZB,RSS END OF KEYWORD TABLE? JMP SEG2? YES. REPORT LACK OF ! ADB P12 GET TO NAME LDA B,I GET FIRST TWO CHAR. CPA ASCSC "SCGN2"...LARGEST SEGMENT RSS YES JMP NEXT NO INB LDA B,I GET SECOND TWO CHARS CPA ASCGN RSS MATCH JMP NEXT INB LDA B,I AND M7400 CPA B310K "2" JMP MATCH NEXT ISZ TEMP1 JMP TRY TRY AGAIN MATCH LDA TEMP1,I GET ADDRESS JSB COR.A GET TO LWAM OF SEGMENT INA GET FWAM STA FWAM SAVE AS FIRST WORD AVAIL MEM CMA,INA GET SIZE OF UNDECLARED ADA LWAM CORE CLB DIV P128 SEE HOW MANY SECTOR FIT IN SZA IF ZERO...GET OUT...NO ROOM JMP OK1 OK CONTINUE LDA P8 MESSAGE LENGHT LDB NOROM PRNER JSB LOUT PRINT THE MESSAGE JSB GTOUT SEG2? LDA P12 MESSAGE LENGTH LDB SEGMS "NO !" JMP PRNER GO TO REPORT A CATASTROPHIC ERROR. OK1 STA NSEC SAVE AS # OF SECTOR FOR ONE BLOCK MPY P128 GET LENGTH OF DISK WRITES AND READS STA SMTLN SAVE AS LENGTH OF SYMBOL TABLE CLB NOW GET # OF 5 WORD ENTRIES ALLOWED DIV P5 MPY P5 GET AMOUNT OF CORE CCB ADA B ADDRESS OF LAST WORD OF SYM TAB ROOM ADA FWAM WE NOW HAVE THAT ADDRESS CMA,INA NEGATE IF FOR OVERFLOW CHECKING STA ENDM AND PASS BACK TO MAIN S2 JSB EXEC GET SOME DISK SPACE DEF *+6 DEF P4 DEF P5 ASK FOR 5 TRACKS...ROUGHLY 6000 SYMBOLS DEF FTRKA RTE WILL PUT IN FIRST TRACK DEF DSKLU AND DISK IT IS ON DEF SECTK SECTORS/TRACK CLB LDA NSEC GET # OF 128 WORD SECTORS PER WRITE/READ INA SET FOR NEXT CLE,ELA MPY BY 2...64 WORD SECTORS DIV SECTK CALCULATE MULT FACTOR FOR EACH WRITE STB NSEC REMAINDER=NEXT SECTOR ADDRESS STA NTRK NEXT TRACK ADDRESS CMB,INB DO A LITTLE OPTIMIZING ADB P30 IF OVER 30 SECTORS...START AT TRACK BOUNDRY SSB,RSS WELL? JMP MTCH1 NO CLB YES...CLEAR OUT SECTOR ADDRESS STB NSEC AND SAVE AS NEXT ISZ NTRK AND INCREMENT TRACK COUNT MTCH1 LDA FTRKA SET UP SO WE DON'T DO FIRST WRITE STA TRKA CLA STA SECA * * NOW WE SET UP OUR COMMAND LU OR FILE * STRT0 LDB CMDLU GET ADDRESS FOR RMPAR JSB RMPAR DEF *+2 DEF CMDLU STRT1 LDA CMDLU GET FIRST WORD SZA,RSS IF ZERO ISZ CMDLU SET TO 1 (DEFAULT TO SYS CONSOLE) DLD PARS3 GET POSSIBLE SEC. CODE & LU STA PRS31 AND SAVE STB PRS41 LDA PRS21 GET FILE NAME TYPE LDB P1 DEFAULT IS FOR LU 1 AND M7400 IS INPUT A ASCII SZA INB YES STB PARS2 SET AS FILE TYPE LDA B400 GET POTENTIAL R/W SUBFUNCTION STA PARS5 SAVE FOR OPEN CALL JSB FOPEN GO OPEN FILE DEF *+3 INDBA DEF INDCB DEF PARS5 LDA FERR FIND IF THE FILE EXISTS CPA MD6 RSS JMP OK3 AT LEAST THE FILE IS THERE! JSB EXEC DEF *+5 DEF P2 DEF P1 DEF NOFIL DEF NOFLL JSB GTOUT OK3 JSB FILCK ANY FILE ERRORS? RSS YES--TRY THE SYSTEM CONSOLE. JMP STRT2 NO--ALL'S WELL. CLA FORCE A DEFAULT STA CMDLU TO LU#1 FOR COMMAND INPUT. JMP STRT1 START OVER--BYPASS CALL TO . STRT2 LDA STKAD ADA M1 RESET STACK POINT STA P:TR CLA JSB PUSH GO PLACE ON STACK RSS ERROR RETURN - ABORT JMP OK2 OK CONTINUE LDA P14 LDB STCOV JSB LOUT JSB GTOUT ERROR RETURN - ABORT OK2 LDB P1 SET AS DEFAULT TO 1 LDA NOPRT GET INTERACTIVE FLAG SZA,RSS SET? LDB INDB3 STB ENDLU SET FOR EDLU * * NOW GET NAME OF LIST FILE * FNAME LDA P10 LDB LSTFI JSB READ GET LIST FILE JSB FCRET GO CREATE THE FILE DEF *+5 DEF LSDCB DEF P64 DEF P3 DEF ZERO JSB FILCK CHECK FILE STATUS JMP FNAME ERROR * FILNM LDA P16 LENGTH IN POS BYTES LDB OUTFI "OUTPUT FILE NAME" JSB READ GO READ FROM USER JSB FCRET GO CREATE THE OUTPUT FILE DEF *+5 DEF ABDCB DEF P200 DEF P7 DEF ZERO JSB FILCK CEHCK FILE ERROR JMP FILNM RETRY...ERROR SPC 1 * * FIND OUT WHAT THEY WANT TO DO * GENERATE OR LOAD * TRYG1 LDA P18 LDB GNLDM GENERATOR OR LOADER? JSB READ LDA PRS21 GET FIRST TWO CHAR ANSWER CPA GE GENERATOR? JMP GEN YES CPA LO LOAD? RSS YES JMP TRYG1 NO...ERROR LDA LDRCD LOADER SWAP CODE JMP DONE * * FIND OUT WHAT TYPE OF SATELLITE * GEN LDA P18 LDB TYPMG "TYPE OF SATELLITE" JSB READ DLD PRS21 B REG=EX CCA SET -1 FOR ERROR CHECK CPB E3 SCE3? LDA SC3CD YES...SET FOR SCE3 CODE CPB E4 SCE4? LDA S45CD YES...SET FOR SCE 4-5 GENERATION CPB E5 SCE5? LDA S45CD N YES CPB E6 SEE IF SCE 6 LDA SC3CD YES...TREAT LIKE SCE 3 SSA IF SIGN SET, ERROR JMP GEN ...TRY AGAIN * * SAVE SEGMENT NUMBER * DONE STA SWPLC SAVE IN SWAP WORD JMP START,I AND RETURN TO MAIN SKP P2 OCT 2 P18 DEC 18 P23 DEC 23 P12 DEC 12 P128 DEC 128 P1 DEC 1 P14 DEC 14 B400 OCT 400 M1 DEC -1 MD6 DEC -6 P5 DEC 5 P4 DEC 4 P8 DEC 8 P30 DEC 30 P10 DEC 10 P64 DEC 64 P3 DEC 3 ZERO NOP P7 DEC 7 P200 DEC 200 P16 DEC 16 M7400 OCT 177400 B310K OCT 31000 TEMP1 NOP TEMP2 NOP SPC 1 LBUF BSS 32 SPC 1 LSTFI DEF *+1 ASC 5,LIST FILE? OUTFI DEF *+1 ASC 8,OUTPUT FILE NAME? TYPMG DEF *+1 ASC 9,TYPE OF SATELLITE? GNLDM DEF *+1 ASC 9,GENERATE OR LOAD? NOROM DEF *+1 ASC 4,NO ROOM SEGMS DEF *+1 ASC 6,NO ! STCOV DEF *+1 ASC 7,STACK OVERFLOW NOFIL ASC 16,SCEGN ABORTED: NO TRANSFER FILE NOFLL DEC 16 E3 ASC 1,E3 E4 ASC 1,E4 E5 ASC 1,E5 E6 ASC 1,E6 LO ASC 1,LO GE ASC 1,GE ASCSC ASC 1,SC ASCGN ASC 1,GN SKP * * SUBROUTINE TO READ INPUT * READ NOP STA READ2 STB READ1 JSB PRMT DEF *+6 READ1 NOP DEF READ2 DEF LBUF DEF P64 DEF PARSA JMP READ,I SPC 1 READ2 NOP SPC 2 END SRTSG * s1 P Z 91700-18143 1602 S 0222 DS1/B CCE MODULE: SCGN5              H0102 DASMB,R,L,C HED SCGN5 91700-16143 REV.A 760108 * (C) HEWLETT-PACKARD CO. 1976 * NAM SCGN5,5 91700-16143 REV.A 760108 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ************************************************** * *SCGN5 BCS GENERATOR SEGMENT * *SOURCE PART # 91700-18143 REV A * *REL PART # 91700-16143 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 9-18-74 * *MODIFIED BY: K. HAHN * *DATE MODIFIED: 6-27-75 * *************************************************** ************************************************** A EQU 0 B EQU 1 SUP * * * * * LST FORMAT * * WORD 1: LST1 - NAME 1,2 * WORD 2: LST2 - NAME 3,4 * WORD 3: LST3 - NAME 5, ORDINAL * WORD 4: LST4 - IDENT ADDRESS * WORD 5: LST5 - BP LINK ADDRESS * * * * ENTERNS AND EXTERNS * * * EXT LST,PLK,PLKS,?XFER,LSTI,LSTP EXT .MEM.,PRCMD EXT UEXFL,SSTBL,.MEM3 EXT LST1,LST2,LST3,LST4,LST5 EXT .MEM1,.MEM4 EXT .MEM2,.MEM5,.MEM6,NAMR.,LISTO EXT PARSA EXT PNAME,PNAMA EXT EXEC,LOCC,BPLOC,PRINT EXT INDCB,PRMT,GTOUT,ABDCB EXT FCRET,WRITF,FCLOS,CLSFI EXT FILCK,FERR,SWAPR,LSDCB,CMDLU EXT ENDLU,LOUT,.DFER,CNUMO,CNUMD * * * .XFER EQU ?XFER * * * .MEM. TABLE DEFINITIONS * * .MEM1 = FWABP * .MEM2 = LWABP * .MEM3 = FWAM * .MEM4 = LWAM * .MEM5 = FWAC * .MEM6 = LWAC * * * * ERROR CODES * * TB: SYMBOL TABLE/ID SEG OVERFLOW * NA: PARAMETER NAME ERROR * PA: PARAMETER E^RROR * PR: PARAMETER PRIORITY ERROR * IN: PARAMETER EXECUTION INTERVAL ERROR * CH: INVALID CHANNEL NUMBER * DR: INVALID DRIVER NAME * LU: INVALID DEVICE REFERENCE NUMBER * EQ: INVALID EQT. NO. IN INT RECORD * AD: INVALID ENTRY POINT * DU: DUPLICATE PROGRAM NAME SKP * * LINTL BSS 1 STARTING BASE PAGE LINK ADDRESS WDCNT BSS 1 TEMPORARY WORD COUNTER * MAXC BSS 1 MAX CHAR COUNT TCHAR BSS 1 TEMPORARY CHAR SAVE AREA OCTNO BSS 1 OCTAL DIGIT * CURAL BSS 1 SETAD BSS 1 ABSOLUTE OUTPUT BUFFER ADDRESS * SPC 1 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 CURAT BSS 1 CURRENT TBUF ADDRESS TBUF BSS 4 TEMPORARY BUFFER PPREL BSS 1 TBREL BSS 1 * * AEQT BSS 1 ADDRESS OF EQUIPMENT TABLE CEQT BSS 1 NO. ENTRIES IN EQUIPMENT TABLE * * PROCT BSS 1 NO. OF INT. ENTRIES * * PARNO BSS 1 PARAMETER RECORD LENGTH * IODMA BSS 1 I/O DMA FLAG IN EQT IOBUF BSS 1 I/O BUFFERING FLAG IN EQT DFLAG BSS 1 DMA-IN FLAG FOR EQT BFLAG BSS 1 BUFFERING-IN FLAG FOR EQT INTCH BSS 1 INT RECORD CHANNEL NO. * DRANG BSS 1 DIGIT RANGE DIFLG BSS 1 DATA-IN FLAG = -1/0 = NOT IN/IN CMFLG BSS 1 COMMA FLAG = -1/0 = NOT IN/IN BUFUL BSS 1 BUFFER U/L FLAG LBLAD BSS 1 MEMAD BSS 1 SPC 2 * * HERE IS THE END OF AREA THAT NEEDS TO BE SAVED * MAKE SURE BSS FOR OTHER SEGMENTS AT LEAST THIS * BIG...BSSIZ=THAT SIZE * BSSIZ EQU * SKP * * UTILITY ROUTINES * * PRINT: ERR XX * * THE ERROR SUBROUTINE IS USED TO PRINT THE DIAGNOSTICS * FOR ALL ERROR MESSAGES. * * CALLING SEQUENCE: * A = 2-CHAR ASCII ERROR CODE * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP PRINT ERROR MESSAGES STA AMERR+3 SET ERROR CODE INTO MESSAGE LDA P6 LDB AMERR  AMERR = MESSAGE ADDRESS JSB PRINT PRINT ERROR MESSAGE JMP ERROR,I RETURN * AMERR DEF *+1 ASC 3,ERR ERROR MESSAGE = ERR + CODE SKP * * SET DATA TO ABS TAPE * * ROUTINE TO RESERVE AND SET CORE ON THE * LOADER PRODUCED ABSOLUTE OUTPUT. * * CALLING SEQUENCE: * A = FINAL STARTING ADDRES * B = FINAL ENDING ADDRESS * * SETAD = ADDRESS OF THE OUTPUT DATA BUFFER * * JSB SETCR * * RETURN: A AND B ARE DESTROYED * SETCR NOP STA TEMP1 CMA,INA ADA SETAD BUFFER ADDRESS STA PLKS OFFSET ADDRESS LDA TEMP1 STARTING ADDRESS JSB PLK OUTPUT ROUTINE IN THE LOADER JMP SETCR,I * SKP * ALBUF DEF LBUF ATBUF DEF TBUF * * * ERR10 ASC 1,PA PARAMETER ERROR ERR24 ASC 1,CH INVALID CHANNEL NO. IN EQT REC ERR25 ASC 1,DR INVALID DRIVER NAME ERR27 ASC 1,LU INVALID DEVICE REF. NO. ERR33 ASC 1,AD INVALID ENTRY POINT IN INT RECORD ERR34 ASC 1,UE UNDEFINED EXTERNAL PTERM ASC 1,EN COMMA OCT 54 COMMA IJSB JSB 0,I I-JSB CODE FOR INTERRUPT LOCS UASCZ OCT 30000 UPPER ASCII ZERO CHAR CHARD OCT 104 ASCII CHAR D REQT ASC 1,RE RDRT ASC 1,RS RINT ASC 1,RI * MES25 DEF *+1 ASC 4,EQT TBL * OCT 6412 ASC 2,LU#: * MES2 DEF *+1 ASC 6,REL SYS MODS * SKP * * INITIALIZATION SECTION * * * THIS IS WHERE WE START. * SWPIN NOP THIS IS WHERE CONTROL IS PASSED LDA RSTA WHEN SEGMENT ROLLED IN JMP SWAPR CONTROL IS RETURN TO MAIN WITH A REG=START SPC 1 RSTA DEF RSTRT SPC 1 * * * THE FOLLOWING MESSAGES ARE PRINTED DURING THE INITIALIZATION * PHASE, WITH THE SPECIFICATIONS FOR EACH VALID RESONSE. * * * MESSAGE RESPONSE * * FWA BP? ENTER 4 OCTAL DIGITS * * LWA MEM? ENTER 5 OCTAL DIGITS * * FWA MEM ENTER 5 OCTAL DIGITS  * * # WORDS COMMON 4 DEC DIGITS * * RSTRT NOP CLA STA NAMR. LDA LISTO AND N9 CLEAR BIT 3, FOR NEW HEADING STA LISTO * * * * SET FWA BP LINKAGE FWENT LDA P7 LDB MES27 MES27 = ADDR: FWA BP LINKAGE? JSB READ PRINT AND GET REPLY LDA P4 JSB DOCON GET 4 OCTAL DIGITS, CONVERT RSS INVALID DIGIT ENTERED JMP SETFB YES - SET FWA BP LINKAGE LNKER JSB INERR JMP FWENT REPEAT MESSAGE SETFB LDB OCTNO GET FWA BP SZB,RSS SKIP - VALID (NON-ZERO) FWA BP JMP LNKER REPEAT FWA BP LINKAGE INPUT STB .MEM1 STB LINTL SAVE STARTING LINK ADDRESS FOR INT LINK TABLE CMB,INB CHECK IF GREATER THAN 1777 ADB B1777 SSB JMP LNKER YES IT IS...ERROR SMLWA LDA P8 LDB MESS3 MESS3 = ADDR: LWA MEM? JSB READ PRINT MESSAGE, GET REPLY LDA P5 SET FOR 5 OCTAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP SMLWA REPEAT INPUT LDA OCTNO GET LWAM SZA,RSS ZERO IS ERROR JMP SMLWE STA .MEM6 SAVE LWAM IN LWAC CMA,INA CHECK IF LESS THAN FWABP ADA .MEM1 SSA ERROR? JMP GETAV NO SMLWE JSB INERR YES...ERROR JMP SMLWA TRY AGAIN * GETAV LDA P8 PRINT: LDB MES34 "FWA MEM" JSB READ GET THE ANSWER LDA P5 SET FOR 5 OCTAL DIGITS. JSB DOCON CONVERT TO OCTAL. JMP SYMER -ERROR. JMP SETAV OK , SET BOUNDARY. * SYMER JSB INERR JMP GETAV -REPEAT REQUEST * SETAV LDA OCTNO IF NUMBER SZA,RSS ZERO IS ERROR JMP SYMER STA .MEM3 SAVE FIRST WORD MEM ADA N1 SET UP LWABP STA .MEM2 CMA,INA CHECK IF LOWER THAN FWABP ADA .MEM1 SSA,RSS ERROR? JMP SYXOMER YES LDA .MEM2 CMA,INA CHECK IF GREATER THAN 1777 LDB B1777 ADA B1777 SSA,RSS IF NEGATIVE...DEFAULT TO 1777 LDB .MEM2 GET ACTUAL STB .MEM2 SAVE AS LWABP * * GET # WORDS OF COMMON * GETCM LDA P14 LDB MES7 "# WORDS OF COMMON" JSB READ LDA N5 CONVERT DEC NUMBER JSB DOCON JMP COMER ERROR IN CONVERSIO LDA .MEM6 GET LWAM CMA ADA OCTNO SEE IF WE HAVE ROOM ADA .MEM3 SSA ERROR? JMP GTCM1 NO COMER JSB INERR ERROR JMP GETCM TRY AGAIN SPC 1 GTCM1 LDA OCTNO GET # OF WORDS SZA IF ZERO...NO COMMON .MEM4=.MEM5=.MEM6 CMA IF NOT ZERO...ALLOW FOR COMMON ADA .MEM6 STA .MEM4 SET IN LWAM... CPA .MEM6 IF=TO .MEM6...NO COMMON RSS INA OTHERWISE SET FWAC TO LWAM+1 STA .MEM5 * * DEFINE SYMBOLS NEEDED BY BCS * WHICH PCS NORMALLY DEFINES * THESE SYMBOLS ARE: * .EQT.,.SQT.,HALT,.MEM. * .EQT. IS BETWEEN THE 6 WORD SQT ENTRY AND THE * START OF THE 4 WORD EQT ENTRIES. IT CONTAINS * THE # OF EQT ENTRIES DEFINED * .SQT. WHERE THE START OF THE SQT TABLE IS LOCATED * .HALT IF DEFINED IS THE RESTART LOCATION * IF NOT DEFINED IT BECOMES A LOCKED HALT * .MEM. IS A 6 WORD TABLE WITH THE FIRST WORD * CONTAINING THE ADDRESS OF THE MEM TABLE * THE TABLE CONSISTS OF FWABP,LWABP,FWAM,LWAM * AND LWAM (THERE ARE TWO LWAM ENTRIES) * CLA CLEAR OUT LST ENTRIES STA LST STA .XFER LDA DEFLC GET ADDRESS OF ASC TABLE STA TEMP1 SAVE TO USE LDA N4 NUMBER OF ENTRIES TO DEFINE STA TEMP2 SAVE IN DOWN COUNTER ASGNM LDB TEMP1,I GET ENTRY ADDRESS STB DFER1 JSB SSTBL IT ISN'T DEFINED, WILL SET UP LST FOR US yNOP LDA LST1 GET ADD WHERE TO PUT SYMBOL STA DFER2 SAVE FOR MOVE JSB .DFER MOVE IN NAME DFER2 NOP DFER1 NOP LDB LST3 LDA B,I AND M7400 STA B,I MASK OFF LOWER BYTE INB GET TO LST4 CLA SET AS SPECIAL DEFINED STA B,I INB GET TO LST5 LDA .MEM1 DEFINE A BASE PAGE LINK STA B,I ISZ .MEM1 INCREMENT FWABP ISZ TEMP1 GET TO NEXT ENTRY ISZ LST INCREMENT # OF LST ENTRIES ISZ TEMP2 DONE? JMP ASGNM NO * * * HERE GO RELOCATE THE SYSTEM * LDA P12 PRINT: LDB MES2 "REL SYS MODS" JSB PRINT PRINT * RELOCATE FROM RTS/2100 LOADER CLA GET A ZERO STA PNAME CLEAR NAME FLAG STA LOCC CLEAR LOCC IN LOADER STA BPLOC SAME FOR BPLOC JSB PRCMD GO RELOCATE SYS MODULES JSB GTOUT ERROR FROM LOADER...GET OUT LDA LOCC UPDATE FWAM STA .MEM3 FWAM LDA BPLOC UPDATE FWABP STA .MEM1 LDB .IOCA SEE IF THEY DEFINED IOC JSB SSTBL JMP RELSE NO...ERROR LDB .HLTA SEE IF HALT DEFINED JSB SSTBL JSB GTOUT NOT DEFINED??? WE DEFINED IT...GET OUT LDA LST4,I NEEDED, SEE IF DEFINED SZA DEFINED? JMP CHCK3 YES * CHCK2 LDA .MEM3 GET ADDRESS STA LST4,I AND SAVE IT ISZ LST INCREMENT # OF ENTRIES LDA HTINA GET ADDRESS WHERE HALT INSTRUCTION LOCATED STA SETAD SAVE FOR PUNCHING IT OUT LDA JMPIN GET JUMP BASE PAGE INSTURCTION IOR .MEM1 SET IN BASE PAGE LINK STA HTIN+1 SAVE AS NEXT INST AFTER HALT LDA .MEM3 GET ADDRESS WHERE HALT TO GO LDB A INB SET FOR 2 WORD TRANSFER JSB SETCR WRITE OUT 2 WORDS LDA .MEM. SET FOR WADDRESS WHERE LINK CONTENTS ARE ADA P2 GET TO .MEM3 STA SETAD SAVE ADDRESS LDA .MEM1 GET OUTPUT ADDRESS LDB .MEM1 JSB SETCR SET IN LINK WORD ISZ .MEM1 ISZ .MEM3 ISZ .MEM3 SET FOR FWAM CHCK3 LDA ATBUF SET UP FOR OUTPUTING HALT LINK WORD STA SETAD LDA LST4,I GET ADDRESS WHERE HALT INSTRUCTION STA SETAD,I SAVE FOR OUTPUTING LDA LST5,I GET BASE PAGE LINK LDB LST5,I ADDRESS FOR OUTPUTING JSB SETCR AND GO OUTPUT LINK WORD LDA UEXFL SEE IF WE HAVE ANY UNDEFINED EXT. SZA,RSS UNDEFINED? JMP GENIO NO...CONTINUE RELSE LDA ERR34 UNDEFINED EXT JSB ERROR RESTART JMP RSTRT SPC 1 B1777 OCT 1777 .IOCA DEF *+1 ASC 3,.IOC. SKP * * * * NUMERICAL INPUT CONTROL * * THE DOCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., TBG CHANNEL NO., AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB DOCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * DOCON NOP JSB GETOC GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB INERR INVALID DIGIT ENTRY JMP DOCON,I RETURN ISZ DOCON INCR RETURN ADDRESS LDA OCTNO GET CONVERTED NUMBER JMP DOCON,I RETURN SKP * *  INVALID TTY RESPONSE * * THE INERR SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID * RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INERR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INERR NOP LDA ERR10 SET INVALID DEVICE ERROR CODE JSB ERROR PRINT ERROR MESSAGE JMP INERR,I RETURN * SKP MES27 DEF MS27 MES34 DEF SYMES SYMES ASC 4,FWA MEM? MS27 ASC 4,FWA BP? MESS3 DEF *+1 ASC 5,LWA MEM? HTINA DEF *+1 HTIN HLT 77B DEFINED HALT INST NOP JMPIN OCT 124000 JMP BASE PAGE INDIRECT * * SKP * * BUILD I-O TABLES * * * GENERATE I/O TABLES * * THIS SECTION OF CODE GENERATES THE I/O TABLES * FOR THE SYSTEM. THESE INCLUDE THE EQUIPMENT TABLE (EQT), * STANDARD DEVICE REFERENCE TABLE (DRT), AND INTERRUPT TABLE. * SQT TABLE,DMA ASSIGNMENT, AND INTERUPT LINK TABLE * * THE EQT RECORDS HAVE THE FOLLOWING FORMAT: * * N1,D.N2<,D><,UX> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * UX= SUB CHANNEL * * * EACH SQT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,N2,ENTRY POINT * N1,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) * * GENIO CLA SET # OF EQT'S TO ZERO STA CEQT CLEAR EQT COUNTER LDA .MEM3 FWAM STA SQTAD ADDRESS WHERE SQT GOES ADA P6 GET TO EQT8 ENTRIES STA AEQT SAVE AS CURRENT EQT ADDRESS INA SAVE ROOM FOR # OF EQT ENTRIES STA PPREL LDA P7 PRINT: LDB MES25 "EQT TBL" JSB PRINT * SEQT LDA CEQT EQT COUNT INA ADA P6 SET EQT#=EQT+6...START PRINTING AT 7 LDB MES6A STUFF INTO PRINT BUFFER JSB STFNM LDA P9 PRINT: LDB MES6 "EQT XX =?" JSB READ AND INPUT DRIVER REQUEST LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA PTERM CHARS= END ? JMP SSQTI YES, TRY TO END CPA REQT REPEAT? JMP GENIO YES * JSB GINIT INITIALIZE BUFFER SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,U IOERR LDA ERR24 SET CODE = INVALID CHNL IN EQT JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD * CLDBU LDB OCTNO GET I/O CHANNEL NO. STB EQTW1 SET I/O ADDRESS ADB N8 IS CHAN EQ. LESS THAN 10? SSB JMP IOERR YES, CHANNEL ERROR CLA STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG LDA N2 TWO CHAR COMPARE JSB GETNA SEE IF IT IS D. CPA ASCD. CHARS=D.? JMP STYPE YES DVERR LDA ERR25 SET CODE = INVALID DRIVER NAME JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD STYPE LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF STA ASTYP SAVE 2 ASCII CHARS FOR I.XX,C.XX CCA ADA CURAL ADJUST CURRENT LBUF ADDR STA CURAL RESET CURAL TO CONVERT TYPE LDA P2 JSB GETOC GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME LDB OCTNO GET DRIVER TYPE BLF,BLF ROTATE TO UPPER B STB EQTW2 SET DRIVER TYPE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * CCA STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG * INDBU CCA STA CMFLG SET COMMA FLAG = NO COMMA IN JSB GETAL GET NEXT CHAR FROM LBUF CPA CHARD CHAR = D? JMP SEDMA YES - SET DMA CODE CPA CHARU CHAR = U? JMP SETBU YES - SET BUFFERING CODE UNERR LDA ERR10 SET CODE = INVALID D,B,T JSB ERROR PRINT DIAGNOSTIC JMP SEQT GET NEXT EQT RECORD EQTST JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG IOR EQTW1 SET IN DMA BIT STA EQTW1 AND SAVE IT JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG HERE FOR SUBCHANNEL PROCESSING JMP UNERR DUPLICATE U'S ENTERED LDA N2 2 CHAR CONVERSION JSB GETOC JMP UNERR ERROR IN CONVERSION LSL 6 GET IN CORRECT POSITION FOR SUBCHANNEL IOR EQTW1 MERGE IT IN STA EQTW1 JMP EQTST AND CHECK FOR MORE * LISCN LDB ASDDR ADDRESS OF D.XX BUFFER JSB SSTBL IS IT IN THE SYMBOL TABLE? JMP DVERR NO LDA LST4,I YES, GET THE ADDRESS STA EQTW4 SAVE DRIVER START ADDRESS LDA EQTWA GET ADDRESS OF EQT TABLE STA SETAD SAVE FOR PUNCHING LDA PPREL GET CURRENT OUTPUT ADDRESS LDB A ADB P3 4 WORD EQT ENTRY STB PPREL  SAVE FOR LATTER JSB SETCR OUTPUT IN ABS ISZ PPREL BUMP TO NEXT EQT ENTRY ISZ CEQT INCR EQT ENTRY COUNT JMP SEQT PROCESS NEXT EQT RECORD * SPC 1 * SSQTI LDA CEQT ANY EQT'S BEEN LOADED? SZA JMP SSQT YES, CAN END LDA ERR10 NO,AT LEAST ONE REQUIRED JSB ERROR PRINT: "ERR PA" JMP SEQT START OVER * SQTAD NOP EQTWA DEF *+1 EQTW1 NOP EQTW2 NOP NOP EQTW4 NOP SPC 1 ASCD. ASC 1,D. CHARU OCT 125 SKP * * SET DEVICE REFERENCE TABLE (SQT) * SSQT LDA P11 SEND OUT BEGINING MESSAGE LDB MESQ0 "SQT ENTRIES" JSB PRINT LDA MESQA GET ADDRESS OF MESSAGE BUFFERS STA CMSQA SAVE AS CURRENT LDA SQTEA GET ADDRESS OF START OF SQT ADDRESS STA CSQTE LDA N6 GET # OF SQT ENTRIES STA SQTCT SAVE IN DOWN COUNTER SPC 1 SQTIN LDB CMSQA GET ADDRESS OF MESSAGES LDA B,I INB LDB B,I JSB READ GET INPUT LDA N2 GET FIRST 2 CHARS JSB GETNA CPA RDRT RETRY SQT TABLE? JMP SSQT YES CPA REQT RETRY EQT TABLE? JMP GENIO YES JSB GINIT RESET FOR SCAN LDA P2 CONVERT SQT ENTRY JSB GETOC TO OCTAL JMP SQTER ERROR IN CONVERSION SZA,RSS 0 IS ILLEGAL JMP SQTER STA CSQTE,I SAVE VALUE ADA N7 CHECK IF IN RANGE SSA LESS THAN 6? JMP SQTER ERROR CMA CHECK IF OUT OF RANGE ADA CEQT SSA JMP SQTER OUT OF RANGE ISZ CMSQA GET NEXT MESSAGE ADDRESS ISZ CMSQA GET TO NEXT COUNT ISZ CSQTE GET NEXT STORAGE ADDRESS ISZ SQTCT DONE? JMP SQTIN NO...GET NEXT ENTRY * LDA SQTEA GET ADDRESS OF WHERE BUFFER TO BE OUTPUTED IS STA SETAD SA.+HFBVE ADDRESS LDA SQTAD GET ABS OUTPUT ADDRESS LDB SQTAD GET ENDING ADDRESS ADB P5 JSB SETCR OUTPUT IT JMP GTDMA GO GET DMA FLAGS SPC 1 SQTER LDA ERR27 SQT ERROR JSB ERROR JMP SQTIN AND TRY AGAIN SPC 1 CMSQA NOP CSQTE NOP SQTCT NOP N7 OCT -7 SPC 1 SQTEA DEF *+1 REP 6 NOP SPC 1 MESQA DEF QMESA QMESA OCT 5 DEF KYBD? OCT 4 DEF TTY? OCT 4 DEF LIB? OCT 6 DEF PNCH? OCT 6 DEF INPT? OCT 5 DEF LIST? MESQ0 DEF *+1 ASC 6,SQT ENTRIES AwH SKP * *HERE WE GET THE DMA CHANNEL * GTDMA LDA P4 LDB DMAMG "DMA?" JSB READ CLA STA TBUF ASSUME NO DMA STA TBUF+1 LDA P2 CONVERT ANSWER TO ASC JSB GETOC JMP DMAER ERROR IN CONVERSION SZA,RSS DMA SUPPLIED? JMP DMA0 NO CPA P6 IS IT A 6? RSS YES JMP DMAER NO...HE BLEW IT STA TBUF SAVE CHANNEL 6 JSB GETAL SEE IF END CPA BLANK COMMA? JMP DMA1 YES...CHECK FOR CHANNEL 7 CPA ZERO END? JMP DMA0 YES...OUTPUT IT DMAER JSB INERR ERROR JMP GTDMA SPC 1 DMA1 LDA P2 CONVERT SECOND PRAM JSB GETOC JMP DMAER ERROR IN CONVERSION CPA P7 IF SUPPLIED, MUST BE 7 RSS JMP DMAER NOT...ERROR STA TBUF+1 SAVE FOR LATTER DMA0 LDA ATBUF GET ADDRESS WHERE DMA INFO CONTAINED STA SETAD SET FOR OUTPUTING LDB DMC1A GET ADDRESS OF "DMAC1" ENTRY JSB SSTBL FIND IT JSB GTOUT .IOC. WITH OUT IT??? LDA LST4,I GET ADDRESS WHERE IT IS LOCATED LDB A SET IN 1 WORD WRITE JSB SETCR SET IN WORD ISZ SETAD GET TO NEXT ENTRY LDB DMC2A FIND "DMAC2" JSB SSTBL JSB GTOUT ERROR...NOT THERE LDA LST4,I GET ADDRESS WHERE LOCATED LDB A JSB SETCR SET IN DMA CHANNEL INFO SPC 2 * * DEFINE XSQT,XEQT,.EQT.,.SQT.,.MEM. * LDA ALBUF SET UP OUTPUT BUFFER ADDRESS STA SETAD LDB XSQTA GET "XSQT" JSB SSTBL FIND IT JSB GTOUT NOT THERE LDA SQTAD GET ADDRESS WHERE SQT TABLE STARTS STA LBUF SAVE FOR OUTPUT LDA LST4,I GET ADDRESS IN IOC WHERE XSQT IS LOCATED LDB A JSB SETCR AND GIVE IT TO THEM LDB XEQTA FIND XEQT ADDRESS JSB SSTBL JSB GTOUT GET mOUT...NOT DEFINED LDA AEQT GET ADDRESS WHERE EQT TABLE LOCATED STA LBUF SAVE FOR OUTPUTING LDA LST4,I GET ADDRESS WHERE TO PUT IT LDB A JSB SETCR AND OUTPUT IT LDB .EQTA FIND ".EQT." ENTRY POINT JSB SSTBL FIND IT JSB GTOUT NOT THERE...ERROIR LDA AEQT DEFINE FOR SNAP STA LST4,I LDB CEQT GET COUNT STB LBUF SAVE IT LDB A SET FOR ONE WORD WROITE JSB SETCR AND SAVE # OF EQT ENTRIES LDA LST5,I SET UP BASE PAGE LINK LDB AEQT STB LBUF SAVE FOR LINK OUTPUT LDB A JSB SETCR LDB .SQTA FIND ".SQT." ENTRY JSB SSTBL JSB GTOUT NOT THERE...ERROR LDA SQTAD STA LST4,I STA LBUF LDA LST5 DEFINE LINK ONLY LDA A,I LDB A JSB SETCR SAVE LINK ADDRESS LDB .MEMA FIND ".MEM." ENTRY...DEFINE .MEM. TABLE JSB SSTBL JSB GTOUT LDA PPREL DEFINE IT AS NEXT INSTRUCTION STA LST4,I SAVE IT FOR SNAP INFO STA LBUF SET IT IN FOR LATTER USE LDA LST5 LDA A,I GET BASE PAGE LINK ADD LDB A JSB SETCR SET IN BASE PAGE LINK FOR .MEM. LDA PPREL INA SET UP FOR DEF STA LBUF LDA .MEM1 GET FWABP STA LBUF+1 LDA .MEM2 GET LWABP STA LBUF+2 LDB PPREL ADB P6 GET FWAM STB LBUF+3 ISZ LBUF+3 LDA .MEM4 STA LBUF+4 STA LBUF+5 LWAM LDA PPREL STB PPREL SET TO BE AFTER .MEM. TABLE JSB SETCR SET IN .MEM. TALBE ISZ PPREL JMP SINTT GO PROCESS INTERUPTS SPC 1 DEFLC DEF *+1 .EQTA DEF EQTA. .SQTA DEF SQTA. .MEMA DEF MEMA. .HLTA DEF HLTA. DMC1A DEF DMC1 DMC2A DEF DMC2 DMAMG DEF MGDMA XSQTA DEF SQTAX XEQTA DEF EQTAX SKP * ROUTINE TO INPUT TO BUFFER FROM TTY * A REG=LENGTH...POSITVE BYTES, NEGATIVE WORDS * B REG=ADDRESS OF MESSAGE * WILL PUT RESPONSE IN LBUF * * MAKE A CALL TO PRMT * CALLING SEQUENCE IS AS FOLLOWS * JSB PRMT * DEF *+6 * DEF MESSAGE BUFFER ADDRESS * DEF LENGTH OF MESSAGE BUFFER (POSITIVE CHAR) * DEF INPUT BUFFER ADDRESS * DEF MAX LENGTH * DEF ERROR PARSE ADDRESS * READ NOP STA RTMP1 STB RTMP2 SAVE LENGTH AND ADD OF MESSAGE JSB PRMT GO TO MAIN FOR INPUT DEF *+6 RTMP2 NOP DEF RTMP1 DEF LBUF DEF P64 DEF PARSA STA PARNO SAVE LENGTH OF INPUT BUFFER INA CONVERT TO WORD ADDRESS CLE,ERA ADA ALBUF GET TO END OF BUFFER CLB PUT ZERO AT END OF BUFFER STB A,I JSB GINIT INITIALIZE LBUF SCAN JMP READ,I AND RETURN RTMP1 NOP * SKP * * I-O TABLE SUBROUTINES * * * GET CHAR FROM LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * GETNA AND GETOC. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GETAL * * RETURN: * A = CURRENT CHARACTER * B = DESTROYED * GETAL NOP LDA CMFLG CMFLG = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB BUFUL GET U/L FLAG IGNOR LDA CURAL,I GET CHAR FROM LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND M377 ISOLATE LOWER CHAR CPA ZERO END OF BUFFER? JMP GETAL,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ CURAL INCR LBUF ADDRESS CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS STB BUFUL SAVE U/L FLAG CPA COMMA CHAR = COMMA? ISZ CMFLG RESET FLAG TO SHOW COMMA IN JMP GETAL,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANKaW CHAR JMP GETAL,I RETURN WITH BLANK SKP * * MOVE ALPHA FROM LBUF TO TBUF * * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM LBUF * TO TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR IS TO * BE MOVED TO THE LOW CHAR IN TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN TBUF. * B = IGNORED * JSB GETNA * * RETURN: * A = FIRST CHAR (IF ONLY 1 CHAR) OR FIRST 2 CHARS MOVED. * B = DESTROYED * GETNA NOP CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. CHARS LDA ATBUF ATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB TBUF CLEAR WORD 1 OF TBUF CCA STA CMFLG SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB GETAL GET CHAR FROM LBUF CPA ZERO END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP OCHAR GET ODD CHAR FROM LBUF LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I YES - RETURN OCHAR JSB GETAL GET CHAR FROM LBUF CPA ZERO END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I RETURN SKP * * CONVERT OCT/DEC ASCII TO BINARY * * THE GETOCI SUBROUTINE CONVERTS THE NEXT CHARACTERS IN LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB GETOC * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * GETOC NOP LDB L10 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB L12 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA CMFLG SET COMMA-IN FLAG CLA STA OCTNO OCTNO = OCTAL NUMBER GETNX JSB GETAL GET CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA L60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA OCTNO GET PREVIOUS OCTAL NO. ADA A SET A = OCTNO X 2 ADA A SET A = OCTNO X 4 LDB DRANG GET DIGIT RANGE CPB L12 RANGE = DECIMAL? ADA OCTNO SET A = OCTNO X 5 ADA A SET A = OCTNO X 10/8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP GETOC,I RETURN - ERROR SKP * * * ROUTINE TO CONVERT THE OCTAL NUMBER IN A TO * ASCII AND STUFF THE 2 LOW ORDER DIGITS INTO A BUFFER * ADDRESSED BY B. LEADING ZEROS ARE SUPPRESED * * CALLING SEQUENCE: * * A = OCTAL NUMBER * B = BUFFER ADDRESS * * RETURN: A AND B ARE DESTROYED * STFNM NOP STB STFAD SAVE FINAL ADDRESS LDB ATBUF TEMP BUFFER ADDRESS JSB CONVD LDA TBUF+2 LEAST 2 DIGITS STA STFAD,I STORE IN BUFFER JMP STFNM,I * STFAD BSS 1 * * SKP * * INITIALIZE CHAR TRANSFER * * THE GINIT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GINIT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * GINIT NOP LDA ALBUF ALBUF = ADDR OF LBUF STA CURAL SET CURRENT LBUF ADDRESS CCB STB BUFUL BUFUL = BUFFER U/L FLAG JMP GINIT,I RETURN * * CONVERT A TO ASCII AT B * * THE CONVD SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CONVD NOP STB CONSV LDB A SSA COMPLEMENT? CMA,INA YES STA CONLN SAVE FOR CONVERSION SSB DEC OR OCT JMP CNVD1 DEC. JSB ȆCNUMO OCTAL CONVERT DEF *+3 DEF CONLN CONSV NOP JMP CONVD,I AND RETURN CNVD1 JSB CNUMD DEC CONVERT DEF *+3 DEF CONLN DEF CONSV,I JMP CONVD,I AND RETURN SPC 1 CONLN NOP SKP * * CONSTANTS * MES6A DEF MES6I MES6 DEF *+1 ASC 2,EQT MES6I BSS 1 ASC 2, =? MES29 DEF *+1 ASC 4,INT TBL AYES OCT 131 ANO OCT 116 MES7 DEF *+1 ASC 7,# WDS IN COMM? MES9 DEF *+1 ASC 5,SNAPSHOT? MES11 DEF *+1 ASC 2, MS112 ASC 1, ASC 4,FINISHED BNDS DEF *+1 ASC 4,-BOUNDS MEMOT DEF *+1 ASC 3,FWABP= ASC 3,LWABP= ASC 3,FWAM= ASC 3,LWAM= ASC 3,FWAC= ASC 3,LWAC= ASET DEF *+1 ASC 6,- SET BPLOCC ASTO ASC 2, TO ASTOA DEF ASTO ASLOC DEF *+1 ASC 2,LOCC ASSTL DEF *+1 ASC 8,-LINKS START AT ASPCE OCT 40 ACOMA OCT 26000 MES55 DEF *+1 ASC 10,INPUT SNAPFILE NAME? * * * PROGRAM CONSTANT FACTORS ZERO OCT 0 N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 N6 DEC -6 N8 DEC -8 N9 DEC -9 N10 DEC -10 N60 DEC -60 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P9 DEC 9 P11 DEC 11 P12 DEC 12 P14 DEC 14 P20 DEC 20 P30 DEC 30 P64 DEC 64 L10 EQU N8 L12 EQU N10 L60 OCT -60 M177 OCT 177 M377 OCT 377 M7400 OCT 177400 IDAA DEF *+1 BSS 5 ASDDR DEF *+1 ASC 1,D. ASTYP BSS 1 UBLNK OCT 20000 JMP3I JMP 3,I P10 DEC 10 P1 DEC 1 * BLANK OCT 040 BLANK MSIGN OCT 100000 NEGATIVE SIGN * ?ADD DEF *+1 ASC 1,? CLCIN CLC 10B LNKAD NOP P61 DEC 61 SKP * * INTERRUPTT TABLE PROCESSOR * * INTERRPUT TABLE PROCESSOR * * SINTT LDA P7 LDB MES29 MES29 = ADDR. * INT TABLE JSB PRINT PRINT: INT TBL * * INITAL LY SET ALL INTERUPT LOCATIONS TO CLC X * LDB ALBUF GET ADDRESS OF A BUFFER LDA HLTB4 LOCATION 4 HALT STA B,I SAVE HALT INB INA SET FOR HALT 5 STA B,I INB CLA CLEAR OUT LOC 6 AND 7 STA B,I INB STA B,I CLEAR LOC 7 INB LDA N60 SET UP FOR 60 CLC INSTR STA TEMP1 LDA CLCIN CLC 10...FIRST LOC TO BE CLEARED JSCLC STA B,I START PUTTING IN CLC INST. INA INCREMENT CLC INB GET NEXT ADDRESS ISZ TEMP1 DONE? JMP JSCLC NO...CONTINUE LDA ALBUF GET BUFFER ADDRESS AGAIN STA SETAD SET IN FOR DUMPING LDB P61 GET LENGTH LDA LINTL SEE IF LINKS LESS THAN 100 CMA,INA ADA B SSA,RSS IF SO USE LINTL AS LAST ADDRESS LDB LINTL LDA P4 START WITH LOCATION 4 JSB SETCR SET IT IN LDB P8 GET ADDR OF FIRST INT LOCATION STB TBREL SET CURRENT BP ADDRESS * SETIN LDA P1 NEW LINE LDB ?ADD JSB READ GET INT RECORD FROM TTY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA PTERM CHARS = -E? JMP SNAPO YES - I/O TABLES COMPLETE CPA RINT REPEAT INTERRUPT? JMP SINTT YES CPA REQT GO BACK TO EQT? JMP GENIO YES CPA RDRT REPEAT DRT? JMP SSQT YES JSB GINIT RE-INITIALIZE LBUF SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP CHERR INVALID INT CHANNEL NO. DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP SETCH SAVE INT CHANNEL NO. CHERR LDA ERR10 SET CODE = INVALID INT CHNL NO. JSB ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * SETCH LDA OCTNO GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. ADA N4  CHAN L.T. 4? SSA JMP CHERR YES, CHANNEL ERROR * LDA P7 DO 7 OCTAL CHAR CONVERSION JSB GETOC CONVERT TO BINARY JMP CHERR ERROR IN COONVERSION LDB CMFLG SEE IF THERE IS A COMMA SZB ? JMP COMIN NO...ABS VALUE * * HERE IF ENTRY POINT SPECIFIED * INTEN LDA OCTNO GET LINK ADDRESS STA LNKAD SAVE FOR LATTER CMA,INA CHECK IF IN BOUNDS ADA P64 SSA TO BIG? JMP CHERR YES LDA LNKAD CMA,INA ADA LINTL CHECK INCASE LINTL LESS THAN 100 SSA JMP CHERR ERROR TO BIG LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF LDB ATBUF ADDR OF NAME JSB SSTBL SEARCH SYMBOL TABLE RSS NOT FOUND, ERROR JMP SETEN SET ENTRY POINT ADDRESS ENERR LDA ERR33 SET CODE = INVALID ENTRY POINT JSB ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INT RECORD INPUT * SETEN LDA LST4,I GET BP LINK ADDRESS STA SETAD,I LDA LNKAD GET LINK ADDRESS LDB A JSB SETCR LDA LNKAD GET LINK ADDRESS AGAIN FOR JSB INST IOR IJSB ADD JSB 0,I CODE * COMIN STA TBUF SAVE INT TABLE CODE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? RSS YES, CONTINUE JMP ENERR NO, BUT SHOULD BE LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR CMA,INA ADA TBREL ADD CURRENT ADDRESS SZA IF EQUAL...OK SSA IF LESS THAN, ERROR JMP STINT SET INTERRUPT TABLES, LOCATION EQERR LDA ERR24 SET CODE = INVALID INT CHNL ORDR JSB ERROR PRINT DIAGNOSTIC JMP SETIN GET NEXT INTERRUPT RECORD * PFINT LDA TBUF IF TRAP CELL FOUR, STA SETAD,I SAVE VALUE FOR LOC 4 LDA P4 SAVE TO SET IN LOC 4 6 LDB P4 ONLY ONE WORD JSB SETCR JMP SETIN GET NEXT INTERRUPT RECORD * HLTB4 OCT 103004 TRAP CELL DEFAULT VALUE * * STINT LDB TBUF GET INT LOCATION CODE STB SETAD,I PUT INT LOCATION CODE IN INT LOC LDB TBREL GET INT LOCATION ADDR CMB,INB ADB P64 ADD ADDR OF FIRST SYS LINK SSB SKIP - INT LOCATION OVERFLOW JMP EQERR * LDA INTCH GET INTERUPT LOCATION STA TBREL UPDATE CURRENT COUNT LDB A SET FOR 1 WORD OUTPUT JSB SETCR SET CORE JMP SETIN AND TRY AGAIN SKP * * SNAPSHOT OUTPUT FOR LOADER RELOCATION SECTION * * * SNAPSHOT OUTPUT * SNAPO CLA STA WDCNT * SNAP8 LDA JMP3I SET STARTING JMP STA LBUF LDA ?XFER SET STARTING ADDRESS STA LBUF+1 LDA P2 LDB P3 JSB SETCR JSB CLSFI CLOSE OUTPUT FILE SNAP2 LDA P9 PRINT: LDB MES9 "SNAPSHOT" JSB READ CCA STA CMFLG JSB GETAL GET RESPONSE CPA ANO NO????? JMP ENDGN YEP, END OF RTS GEN CPA AYES YES??????? JMP SNP11 YES LDA ERR10 JSB ERROR JMP SNAP2 TRY AGAIN * * GET SNAP FILE NAME * SNP11 LDA P20 LDB MES55 JSB READ READ IN NAME JSB FCRET GO CREATE SNAP FILE DEF *+5 DEF ABDCB DEF P30 DEF P3 DEF ZERO JSB FILCK JMP SNP11 TRY AGAIN LDA PPREL SET UP FWAM PAST EQT AND .MEM. TABLE STA .MEM3 SAVE AS FWAM LDA .MEM. FRIST ADDRESS STA MEMAD .MEM. ADDRESS LDA MEMOT ADDRESS OF LABELS STA LBLAD LDA N6 NUMBER OF LABELS STA WDCNT JSB GINIT INITIALIZE BUFFER CLA STA MAXC CLEAR WORD COUNT STA PROCT CLEAR TOTAL COUNT SNAP1 LDA N4 ^ NO OF CHARS LDB BNDS ADDRESS OF "-BOUNDS" JSB BUFUP PUNCH ON TAPE JSB LBOUT PUNCH LABELS LDA MEMAD,I NEXT VALUE LDB ATBUF BUFFER TEMP STORAGE JSB CONVD CONVERT TO OCTAL LDA N3 LDB ATBUF JSB BUFUP PUNCH VALUE LDB MES25 FINISH LINE WITH "CRLF" JSB BUFUP ISZ MEMAD BUMP TO NEXT VALUE ISZ WDCNT MORE? JMP SNAP1 YES * LDA LST NUMBER OF SYMBOLS CMA,INA STA WDCNT JSB LSTI SET UP START OF SYMBOL TABLE SNAP4 JSB LSTP READ IN A SYMBOL JMP SNAP3 NO MORE...DONE LDA N3 LDB ASET JSB BUFUP PUNCH "-SET" LDA N2 LDB LST1 JSB BUFUP PUNCH SYMBOL NAME LDB LST3 MOVE TO END OF NAME LDA B,I GET LAST CHAR AND M7400 MASK OUT LOWER IOR ASPCE INSERT SPACE AS LAST CHAR STA B,I RESTORE LDA N1 LDB LST3 JSB BUFUP PUNCH LAST CHAR LDA N2 LDB ASTOA PUNCH " TO " JSB BUFUP LDB LST4 BUMP TO LST4 LDA B,I LDB ATBUF JSB CONVD CONVERT LST4 TO OCTAL LDA N3 LDB ATBUF JSB BUFUP PUNCH LST4 LDB MES25 JSB BUFUP FINISH WITH CRLF LDB LST5 LDA B,I GET LST5 SZA,RSS IS LST5 EQ. 0? JMP SNAP4 YES, SKIP LINKS LDA N8 LDB ASSTL JSB BUFUP PUNCH "-LINKS START AT" LDB LST5 LDA B,I GET LINK LDB IDAA BUFFER ADDRESS JSB CONVD CONVERT LST5 LDA TBUF AND M377 MASK OUT SPACE AS FIRST CHAR IOR ACOMA INSERT A COMMA STA TBUF RESTORE, COMMA AS FIRST LDA N3 LDB IDAA JSB BUFUP PUNCH LST5 LDA N3 LDB ATBUF JSB BUFUP PUNCH LST4 LDB MES25 JSB BUFUP FINISH WITH "CRLF" JMP SNAP4 NO, DO NEXT * SNAP3 LDA N8 LDB ASET JSB BUFUP PUNCH "-SET BPLOCC TO" LDA .MEM1 LDB ATBUF JSB CONVD LDA N3 LDB ATBUF JSB BUFUP PUNCH BPLOC LDB MES25 DUMP BUFFER JSB BUFUP LDA N3 END LINE WITH CRLF LDB ASET ADDRESS OF "SET" JSB BUFUP PUNCH"-SET" LDA N2 LDB ASLOC ADDRESS OF "LOCC" JSB BUFUP PUNCH "LOCC" LDA N2 LDB ASTOA JSB BUFUP PUNCH " TO " LDA .MEM3 FETCH FWAM LDB ATBUF JSB CONVD CONVERT TO ASCII LDA N3 LDB ATBUF JSB BUFUP PUNCH VALUE OF FWAM LDB MES25 JSB BUFUP END LINE WITH CRLF JSB CLSFI GO FCLOS SNAP FILE JMP ENDGN GO TO END RTSGN ROUTINE SKP * * SNAPSHOT GENERATION SUBROUTINES * * * * OUTPUT LABEL ROUTINE * * * CALLING SEQUENCE: * A AND B ARE IGNORED * JSB LBOUT * * RETURN: A AND B ARE DESTROYED * LBOUT NOP LDA N3 LDB LBLAD ADDRESS OF LABEL JSB BUFUP PUNCH LABEL LDA LBLAD UPDATE LABEL POINTER ADA P3 STA LBLAD JMP LBOUT,I RETURN * * * LOAD AND DUMP THE PUNCH BUFFER * * * CALLING SEQUENCE: * A = NEG OF NO. OF WORDS TO LOAD * B = ADDRESS TO LOAD FROM * JSB BUFUP * * RETURN: A AND B ARE DESTROYED * BUFUP NOP CPB MES25 DUMP BUFFER REQUEST? JMP BUFDN YES STA MAXC NO, SAVE NO OF WORDS TO GO ADA PROCT ACCUMULATE THE TOTAL STA PROCT LDA B,I GET THE WORD STA CURAL,I PUT IN BUFFER INB BUMP SOURCE POINTER ISZ CURAL UP BUFFER POINTER ISZ MAXC ALL DONE? JMP *-5 JMP BUFUP,I ALL DONE, RETURN * BUFDN LDA PROCT GET NEG OF WORD COUNT CMA,INA MAKE POSITIVE STA MAXC SAVE LENGTH JSB WRITF lNLHWRITE TO SNAP FILE DEF *+5 DEF ABDCB DEF FERR DEF LBUF DEF MAXC SIZE JSB GINIT INITIALIZE BUFFER POINTERS CLA STA MAXC STA PROCT JMP BUFUP,I RETURN * * * * ENDGN LDA 1717B GET NAME ADA P12 STA EDGN1 JSB .DFER MOVE IN NAME DEF MES11+1 EDGN1 NOP LDA MS112 MASK OFF 6TH CHAR AND M7400 IOR ASPCE STA MS112 LDA P14 PRINT: LDB MES11 "RTSGN FINISHED" JSB LOUT JSB FCLOS FCLOS PRINT FILE DEF *+3 DEF LSDCB DEF FERR JSB FCLOS CLOSE TRANSFER FILE DEF *+3 DEF INDCB DEF FERR JSB EXEC PRINT OUT ENDING MESSAGE DEF *+5 DEF P2 DEF ENDLU DEF MES11+1 DEF P7 JSB EXEC RELEASE SYMBOL TABLE TRACKS DEF *+3 DEF P5 DEF N1 JSB EXEC AND TERMINATE DEF *+2 DEF P6 SKP * KYBD? ASC 3,KYBD? TTY? ASC 2,TTY? LIB? ASC 2,LIB? PNCH? ASC 3,PUNCH? INPT? ASC 3,INPUT? LIST? ASC 3,LIST? DMC1 ASC 3,DMAC1 DMC2 ASC 3,DMAC2 SQTAX ASC 3,XSQT EQTAX ASC 3,XEQT EQTA. ASC 3,.EQT. SQTA. ASC 3,.SQT. MEMA. ASC 3,.MEM. HLTA. ASC 3,HALT MGDMA ASC 2,DMA? LBUF BSS 64 SIZZ EQU * END SWPIN * N Rq 91700-18146 1603 S 0122 DS1/B CCE MODULE: D65AB              H0101 *ASMB,R,L,C HED * ABORT MESSAGE ROUTINE * (C) HEWLETT-PACKARD CO. 1976 * NAM D65AB,7 91700-16146 REV.A 760111 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ******************************************************* * *D65AB SUBROUTINE TO HANDLE ABORT MESSAGES. * *SOURCE PART # 91700-18146 REV.A * *REL PART # 91700-16146 REV.A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 8-22-74 * *MODIFIED BY: C.C.H. * *DATE MODIFIED: 01-11-76 * ********************************************************* * * DEFINE A AND B REG * A EQU 0 B EQU 1 SPC 1 * * DEFINE EXTERNALS * EXT EXEC,CNUMO SPC 1 * * DEFINE ENTRY POINT * ENT D65AB SPC 1 SUP SUPPRESS EXTENDED LISTING. SPC 1 * * SUBROUTINE TO HANDLE ABORT MESSAGES. * * B REG= ADDRESS OF 4 CHARACTER (ASCII) ERROR MESSAGE * A REG= ADDRESS TO BE INCORPORATED INTO ERROR MESSAGE * * CALLING SEQUENCE * JSB D65AB ABORT MESSAGE...DVR ERROR * D65AB WILL NOT RETURN CONTROL TO USER * * D65AB NOP STA ERCD SAVE ABORT ADDRESS DLD B,I GET ERROR MESSAGE DST MSG SAVE ERROR MESSAGE * JSB CNUMO CONVERT ERROR ADDRESS TO OCTAL DEF *+3 DEF ERCD DEF ERCD * LDB XEQT GET ADDRESS OF ID SEGMENT ADB D12 POINT TO NAME ADDRESS (WORD #13). LDA B,I GET THE FIRST TWO NAME CHARACTERS. STA PNAM SAVE IN ERROR MESSAGE, STA AMSG AND IN Aa  BORT MESSAGE. INB POINT TO I.D. SEGMENT WORD #14. LDA B,I GET CHARACTERS THREE AND FOUR. STA PNAM+1 SAVE IN ERROR MESSAGE, STA AMSG+1 AND IN ABORT MESSAGE. INB POINT TO I.D. SEGMENT WORD #15. LDA B,I GET CHARACTER FIVE & PROGRAM TYPE. AND UBYTE RETAIN ONLY THE NAME-CHARACTER, IOR B40 AND INSERT A FOLLOWING BLANK. STA PNAM+2 SAVE IN ERROR MESSAGE, STA AMSG+2 AND IN ABORT MESSAGE. * JSB EXEC SEND 2-LINE ERROR/ABORT MESSAGE DEF *+5 DEF B2 DEF B1 TO SYSTEM CONSOLE (LU #1) DEF MSG DEF D19 * JSB EXEC TERMINATION REQUEST DEF *+2 NO RETURN DEF B6 FROM TERMINATION CALL. SPC 1 MSG ASC 3,XXXX: PNAM ASC 3, ERCD ASC 3, OCT 6412 CR/LF ASC 1,* AMSG ASC 8,XXXXX ABORTED! * B1 OCT 1 B2 OCT 2 B6 OCT 6 B40 OCT 40 D12 DEC 12 D19 DEC 19 UBYTE OCT 177400 XEQT EQU 1717B CURRENT I.D. SEGMENT ADDRESS. SPC 1 END fR  SZ 91700-18147 1601 S 0122 DS1/B CCE MODULE: D65SV              H0101 :ASMB,R,L,C HED * SLAVE REPLY INTERFACE * (C) HEWLETT-PACKARD CO. 1976 * NAM D65SV,7 91700-16147 REV.A 760101 SPC 1 ENT D65SV,#MBRK EXT .ENTR,EXEC,#RSAX,#PLOG,DRTEQ,D65CL * * * NAME: D65SV * SOURCE: 91780-18147 * RELOC: 91780-16147 * PGMR: C.C.H. [ 01/01/76 ] * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * D65SV HANDLES SLAVE MONITOR REPLIES, WHICH ARE DESTINED FOR * REMOTE SATELLITES. THE REPLIES ARE COMMUNICATED TO THE NETWORK * VIA 'D65CL', IN ORDER TO AVOID CONFLICT WITH OTHER USERS OF * THE SAME COMMUNICATION LINE. ADDITIONALLY, 'D65SV' CLEARS THE * SLAVE MONITOR LIST-ENTRY, TO PREVENT POST FACTO TIMEOUT ERRORS. * * D65SV OPERATION: * * 1. GET USER PARAMETERS. * A. CHECK FOR VALID LOGICAL UNIT NO. (VIA 'DRTEQ'). * B. EXTRACT THE COMM. LINE DEVICE SELECT CODE. * C. VERIFY THAT THE LOGICAL UNIT IS LINKED TO DVR65. * 2. GET AND SAVE THE SLAVE MONITOR'S CLASS NUMBER. * 3. CALL <#MBRK> TO CHECK THE CURRENT TRANSACTION FOR A BREAK CONDITION. * A. IF BREAK FLAG SET, DON'T REPLY (GO TO 6.). * 4. CALL TO SEND REPLY TO THE SATELLITE. * A. IF #PLOG #0, WRITE PARMB TO PARMB LOGGER'S CLASS NO. * 5. CLEAR ENTRY IN SLAVE MONITOR CONTROL LIST. * 6. IF ERROR, RETURN TO THE CALLER AT , WITH * ASCII ERROR CODES IN &; ELSE, RETURN TO * WITH DVR65 RETURN INFO IN &. * * D65SV CALLING SEQUENCE: * * JSB D65SV * DEF *+7 * DEF RCODE REQUEST CODE. * DEF CONWD CONTROL WORD. * DEF RQBUF REPLY BUFFER. * DEF RQLEN 1 REPLY BUFFER LENGTH (MINIMUM =35 WORDS). * DEF DABUF DATA BUFFER (OR DUMMY PARAMETER). * DEF DALEN DATA BUFFER LENGTH (OR DUMMY PARAMETER). * RETURN HERE UPON ERROR DETECTION. * NORMAL RETURN HERE, UPON COMPLETION. * ( =0: BREAK-FLAG DETECTED. ) * SKP * * D65SV ERROR MESSAGES: * * ( RETURNED TO CALLER IN & AT LOCATION ) * * "DS01" - DRIVER HAS DETECTED AN ERROR CONDITION (PARITY, ETC.) * * "DS02" - HAS PREEMPTED ACCESS TO THE COMMUNICATION LINE. * * "DS04" - LOGICAL UNIT INVALID, OR NOT ENTERED IN CLCT TABLE. * * "DS07" - 'RES' TABLE ENTRY CANNOT BE LOCATED. * * "DS08" - BUSY-REJECT FROM REMOTE [ RETRIES EXHAUSTED ]. * * "IOXX" \ * - SYSTEM LEVEL ERRORS DETECTED BY RTE. * "RNXX" / * * SPC 3 **************************************************************************** * * * #MBRK EXAMINES THE CURRENT SLAVE-STREAM LIST FOR THE MONITOR * * OPERATING ON THE STREAM-TYPE SPECIFIED BY THE CALLER. * * * * IF AN ENTRY'S BREAK-FLAG (WORD #2, BIT#15) IS SET, #MBRK RETURNS TO * * THE CALLER AT THE POINT. IF THE FLAG IS CLEAR, #MBRK * * RETURNS TO THE POINT. THE IS TAKEN, * * WHEN #MBRK DISCOVERS AN IMPROPER LOGICAL UNIT SPECIFICATION, OR * * WHEN #RSAX DETERMINES AN IMPROPER STREAM SPECIFICATION. * * * * #MBRK CALLING SEQUENCE: * * * * JSB #MBRK * * DEF *+4 = ASCII ERROR CODES ("DS04"/"DS07") * * =0, = ENTRY ADDRESS. * * = LINE SELECT CODE, = EQT EXTENSION ADDRESS. * * * **************************************************************************** SKP RCODA NOP REQUEST CODE ADDRESS. CONWD NOP CONTROL WORD ADDRESS. RQBUF NOP REPLY BUFFER ADDRESS. RQLEN NOP REPLY BUFFER LENGTH ADDRESS. DABUF NOP DATA BUFFER ADDR. (OR DUMMY PARAMETER). DALEN NOP DATA BUFFER LENG. (OR DUMMY PARAMETER). SUP [ SUPPRESS EXTENDED LISTING ] D65SV NOP ENTRY/EXIT. JSB .ENTR OBTAIN DIRECT ADDRESSES DEF RCODA FOR PARAMETERS & RETURN POINT. CLA INITIALIZE THE STA ERFLG ERROR FLAG STA REG AND REGISTER STA REG+1 STORAGE LOCATIONS. LDA RQBUF,I GET THE FIRST WORD OF THE PARMB. AND B377 ISOLATE THE STREAM TYPE, STA STYPE AND SAVE LOCALLY. LDB RQBUF GET THE REQUEST BUFFER ADDRESS. ADB P33 FORM ADDRESS OF TIME-TAG WORDS. STB TTADR SAVE FOR LIST ACCESS. SPC 1 * CHECK FOR BREAK FLAG, AND OBTAIN SELECT CODE & EXTENSION ADDRESS. SPC 1 JSB #MBRK GO TO CHECK DEF *+4 THE SLAVE-LIST ENTRY DEF STYPE FOR A BREAK CONDITION DEF CONWD,I IN THIS MONITOR'S DEF TTADR,I STREAM-LIST. JMP D65SV,I ERROR RETURN--CODES IN . JMP EXIT BREAK DETECTED: NORMAL RETURN [=0]. SPC 1 * CALL 'D65CLD' TO SEND THE REPLY TO THE SATELLITE. SPC 1 JSB D65CL GO TO COMM. LINE ACCESS ROUTINE. DEF *+8 DEF RCODA,I REQUEST CODE. DEF CONWD,I CONTROL WORD. DEF RQBUF,I REPLY BUFFER ADDRESS. DEF RQLEN,I REPLY BUFFER LENGTH. DEF DABUF,I DATA BUFFER ADDR. (OR DUMMY PARAMETER). DEF DALEN,I DATA BUFFER LENG. (OR DUMMY PARAMETER). DEF EXTAD EQT EXTENSION ADDRESS. ISZ ERFLG * ERROR--SET ERROR-RETURN FLAG. DST REG SAVE REGISTERS FOR RETURN TO CALLER. JSB PLOG GO TO CHECK FOR PARMB LOGGING REQUEST. SPC 1 * CLEAR CURRENT TRANSACTION IN SLAVE-STREAM LIST IN . SPC 1 JSB #RSAX GO TO ACCESS ROUTINE. DEF *+5 DEF P3 CLEAR AN ENTRY. DEF ST/LS SPECIFY THIS MONITOR'S LIST. DEF SCODE SEARCH, USING LINE SELECT CODE, DEF TTADR,I AND TRANSACTION TIME-TAGS. SSA ANY ERRORS? JMP ER07 YES. GO TO INFORM THE CALLER. SPC 1 * RETURN TO THE CALLER WITH & FROM DVR65, OR ASCII ERROR CODE. SPC 1 EXIT LDA ERFLG GET THE ERROR RETURN FLAG. SZA,RSS ANY ERRORS? ISZ D65SV NO. SET FOR NORMAL EXIT. DLD REG GET THE RETURN INFORMATION. JMP D65SV,I RETURN TO THE CALLER. SPC 1 * ERROR PROCESSING SECTION. SPC 1 ER07 LDB "07" #RSAX TABLE-ACCESS ERROR. LDA "DS" GET FIRST HALF OF ERROR MESSAGE "DS". JMP D65SV,I RETURN WITH ASCII ERROR MSG. IN &. SPC 4 * IF REQUESTED, WRITE PARMB'S TO THE LOGGER'S CLASS NO. SPC 1 PLOG NOP ENTRY/EXIT: PARMB LOGGING ROUTINE. LDA #PLOG GET REQUEST FLAG FROM . SZA,RSS IS THERE A REQUEST TO LOG PARMB'S? JMP PLOG,I NO. COMPLETE THE SLAVE PROCESSING. * STA PCLAS YES. SAVE THE LOGGER'S CLASS LOCALLY. * JSB EXEC WRITE DEF *+8  THE DEF CLS20 PARMB (PARAMETER BUFFER) DEF ZERO TO THE DEF RQBUF,I PARMB LOGGER'S DEF RQLEN,I CLASS NUMBER. DEF XEQT SUPPLY THE I.D. SEGMENT ADDRESS DEF "SV" AND ASCII "SV" SOURCE IDENTIFIER DEF PCLAS AS OPTIONAL PARAMETERS. NOP ** IGNORE ERRORS FOR THIS OPERATION ** JMP PLOG,I RETURN TO COMPLETE SLAVE PROCESSING. * SKP * CONSTANTS AND STORAGE. SPC 1 A EQU 0 B EQU 1 B77 OCT 77 B377 OCT 377 CLS20 OCT 100024 CLASS WRITE/READ--NO ABORT. EQMSK OCT 37400 EQT5 EQUIPMENT TYPE-CODE MASK. EXTAD NOP EQT EXTENSION ADDRESS. ERFLG NOP ERROR FLAG: #0 - TAKE . P2 DEC 2 P3 DEC 3 P4 DEC 4 P8 DEC 8 P33 DEC 33 PCLAS NOP LOCAL STORAGE: PARMB LOGGER'S CLASS NO. REG OCT 0,0 REGISTER STORAGE. SCODE NOP UPPER-BYTE SELECT CODE FOR LIST SEARCH. STYPE NOP STREAM-TYPE FROM PARMB. ST/LS NOP STREAM & LIST CODE-WORD FOR '#RSAX'. TTADR NOP TIME-TAG ADDRESS FROM PARMB. TTAG OCT 0,0 TIME-TAG STORAGE. TYP65 OCT 32400 EQUIPMENT TYPE-CODE 65, FOR DVR65. XEQT EQU 1717B USER'S I.D. SEGMENT ADDRESS. ZERO OCT 0 "04" ASC 1,04 "07" ASC 1,07 "DS" ASC 1,DS "SV" ASC 1,SV * SKP * < #MBRK > ROUTINE TO EXAMINE BREAK-FLAG IN MONITOR STREAM-LIST ENTRY. SPC 1 * CALLING SEQUENCE: * * JSB #MBRK * DEF *+4 * DEF STRM MONITOR'S STREAM TYPE-CODE. * DEF LU LU TO BE USED BY MONITOR--IF NO BREAK. * DEF TTAGA ADDRESS OF TIME-TAGS (2). * = ASCII ERROR CODES. * =0, = ENTRY ADDRESS. * =SELECT CODE, =EQT EXTENSION ADDRESS. * STRM NOP STREAM TYPE-CODE ADDRESS LU NOP LOGICAL UNIT NO. ADDRESS. TTAGA NOP ADDRESS OF 2-WORD TIME-TAG BUFFExR. #MBRK NOP ENTRY/EXIT: BREAK-FLAG ROUTINE. JSB .ENTR OBTAIN DIRECT ADDRESSES DEF STRM FOR PARAMETERS & RETURN POINT. SPC 1 * VERIFY LOGICAL UNIT & EXTRACT SELECT CODE & EQT EXTENSION ADDRESS. SPC 1 JSB DRTEQ GO TO FIND EQT INFORMATION. DEF *+2 DEF LU,I RETURN INFO FOR THIS LOGICAL UNIT. SSB ANY ERRORS? JMP MBER4 * ERROR: INVALID LU "DS04". * ADB P3 FORM EQT4 ADDRESS FROM EQT FWA IN . LDA B,I GET THE CONTENTS OF EQT4. AND B77 ISOLATE THE DEVICE SELECT CODE. ALF,ALF POSITION TO THE UPPER BYTE. STA SCODE SAVE FOR CLEARING THE TABLE ENTRY. * INB POINT TO EQT5 ADDRESS. LDA B,I GET THE CONTENTS OF EQT5. AND EQMSK ISOLATE THE EQUIPMENT TYPE-CODE. CPA TYP65 IS THIS LU LINKED TO DVR65? RSS YES. SKIP TO FIND THE EQT EXTENSION. JMP MBER4 NO. * ERROR: "DS04" INVALID LU! * ADB P8 COMPUTE ADDRESS OF EQT13. LDB B,I GET A DIRECT RBL,CLE,SLB,ERB ADDRESS FOR THE JMP *-2 EQT EXTENSION. STB EXTAD SAVE FOR USE BY 'D65CL'. SPC 1 * LOCATE THE SLAVE-STREAM LIST-ENTRY FOR THE CURRENT TRANSACTION. SPC 1 LDA STRM,I GET FIRST WORD OF REPLY BUFFER. AND B377 ISOLATE THE STREAM TYPE. ALF,ALF POSITION TO UPPER BYTE. ADA P2 ADD OFFSET FOR STREAM HEADERS. STA ST/LS SAVE CODE-WORD FOR CLEARING LIST ENTRY. DLD TTAGA,I GET THE TIME-TAGS, DST TTAG AND SAVE FOR LATER USE. SKP * SEARCH FOR A "BREAK" CONDITION, AMONG THE STREAM-LIST ENTRIES. SPC 1 JSB #RSAX GO TO CHECK DEF *+5 THE SLAVE-LIST ENTRY DEF P4 FOR A BREAK CONDITION; DEF ST/LS USING SPECIFIED LIST CODE, DEF SCODE DEVICE SELECT CODE, AND DEF TTJ*($AG TIME-TAGS, FOR ENTRY-SEARCH. SSA ANY ERRORS? JMP MBER7 * LIST ERROR--REPORT: "DS07". SZB BREAK-FLAG DETECTED? JMP BREAK YES. EXIT VIA . * LDA SCODE RETURN WITH: = SELECT CODE, LDB EXTAD = EXTENSION ADDRESS. ISZ #MBRK SET NO-BREAK RETURN: P+3 BREAK ISZ #MBRK IF BREAK DETECTED: P+2 JMP #MBRK,I RETURN TO THE CALLER. * MBER4 LDB "04" INVALID LOGICAL UNIT ERROR. RSS MBER7 LDB "07" #RSAX TABLE-ACCESS ERROR. LDA "DS" GET FIRST HALF OF ERROR MESSAGE. JMP #MBRK,I TAKE ERROR-RETURN EXIT: P+1 * SPC 3 END * T ` 91700-18149 1613 S 0122 DS1/B CCE MODULE: PLOSB              H0101 RASMB,R,L,C HED PLOSB 91700-16149 REV.A * (C) HEWLETT-PACKARD CO. 1976 NAM PLOSB,2,30 91700-16149 REV.A 760325 SUP SPC 2 *********************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL * RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE * PHOTOCOPIED, REPRODUCED, OR TRANSLATED TO ANOTHER * PROGRAM LANGUAGE WITHOUT THE PRIOR CONSENT OF * HEWLETT-PACKARD COMPANY. *********************************************************** SPC 3 * *********************************************************** * * PROGRAM LOAD AND SAVE FOR BASIC * * BUFFERED DATA TRANSFER FOR 8500 SATELLITES * * SOURCE PART # 91700-18149 REV A * * REL PART # 91700-16149 REV A * * LISTING PART # A-91700-16149-1 * * WRITTEN BY: BARBARA PACKARD, LARRY POMATTO * * DATE WRITTEN: 12-05-74 * * MODIFIED BY: JEAN-PIERRE BAUDOUIN * * DATE MODIFIED: DEC 1975 *********************************************************** SPC 2 * * PROGRAM TO DO READ/WRITE ON UP TO MAXN * OPEN FILES FOR 8500 SATELLITES. MAXN IS THE NO. * OF FILES WHICH MAY BE OPEN AN ANY ONE TIME. * REMEMBER EACH FILE TAKES 145 WORDS!!! * CENTRAL PROGRAM WHEN SCHEDULED MUST BE * PASSED THE CLASS NUMBER. * * DATA IS PACKED INTO 512 WORD BUFFERS BEFORE * TRANSFER. * SKP * DEFINE ENTRY POINTS SPC 2 * DEFINE EXTERNALS SPC 1 EXT EXEC,READF,POSNT,CLOSE,WRITF EXT OPEN,CREAT,D65SV,D65CL IFN EXT DBUG XIF SPC 2 * DEFINE A AND B REG SPC 1 A EQU 0 B EQU 1 SKP * * PROGRAM STARTS HERE * PLOSB LDA B,I GET CLASS NUMBER STA CLSNM SAVE CLASS NUMBER IFN SZA DO THEY WANT DBUG? JMP PLOSS YES WAIT FOR FIRST USER JSB DBUG NO...GIVE THEM DBUG DEF *+1 JSB EXEC TURN4+ OFF, SAVE RESOURCES FOR LATTER DEF *+4 DEF D6 DEF D0 DEF D1 JMP PLOSB GO TO BEGINING WHEN RE-STARTED XIF SPC 1 D6 DEC 6 * * WE SHOULD ONLY GO THROUGH THE ABOVE ONCE * SPC 1 PLOS0 BSS 0 HERE ON ALL OTHER CALLS PLOSS JSB EXEC DO A GET CALL...WAIT FOR SOMETHING DEF *+5 DEF D21 CODE FOR A GET CALL DEF CLSNM CLASS # DEF RBUF REQUEST BUFFER DEF D35 REQUEST BUFFER LENGTH * * WHEN WE GET HERE SOMEONE WANTS SOMETHING * LDA DCBN GET DCB NUMBER..IF ZERO SZA IT IS A NEW REQUEST JMP PLOS1 NOT A NEW REQUEST LDA STAT GET STATUS WORD CPA M1 JMP CLSIT CLOSE REQUEST LDA CALOC NEW REQUEST...SEE IF WE CAN HANDLE IT ADA MMAXS LDB M3 SET ERROR TO -3 ...CAN'T HANDLE IT SSA,RSS HANDLE REQUEST? JMP TERM NO...TELL THEM TRY LATER LDB M4 GET ERROR CODE IF LENGTH ERROR LDA BLEN GET LENGTH WORD ADA MBUFS SEE IF LARGER THAN BUFFER SSA,RSS JMP TERM YES...ERROR LDA LSFG GET LOAD-SAVE FLAG SSA LOAD OR SAVE LOAD=0,SAVE=1 JMP PSAV1 SAVE JSB OPN GO OPEN FILE JMP PLOS1 OK ON OPEN...TREAT AS STANDARD PSAV2 LDB M2 SET FOR NOT THERE JMP TERM AND TERMINATE * HERE FOR SAVE * PSAV1 JSB CRET GO CREATE THE FILE JMP PLOS1 CREATED OK...PROCESS LDA FERR GET ERROR CODE STA TEMP0 SAVE INCASE NOT TYPE 0 FILE JSB OPN CHECK IF TYPE 0 FILE RSS POSSIBLY JMP PSAV2 NO...OH WELL LDA LSFG GET LOAD-SAVE FLAG SLA OVERRIDE BIT SET? JMP PLOS1 YES,OK LDA DCBN GET ADDRESS WHERE DCB LOCATED ADA D2 GET TO TYPE WORD LDA A,I GET WORD SZA,RSS TYPE 0? JMP PLOS1 YES...GOOD JSB DALOC NO...DEALOCATE DCB LDA TEMP0 GET FILE ERROR STA FERR RESET ERROR TYPE JMP PSAV2 TERMINATE * * AT THIS POINT THE DCB IS DEFINED * THE FILE IS OPENED AND WE ARE READY TO DO * OUR THING. * PLOS1 LDA STAT GET STATUS WORD CPA M1 JMP PLOS3 REQUEST WAS TO CLOSE THE FILE LDA LSFG LOAD OR SAVE? SSA JMP PLOS2 SAVE JSB LBUF LOAD THE BUFFER FROM THE DISC STB STAT SAVE THE FILE STATUS CPB M2 FMGR ERROR? JMP TERM YES, TERMINATE JSB WREC SEND THE DATA ACROSS THE LINE JSB WRPLY SEND STATUS REPLY JMP PLOS0 AND TERMINATE AND WAIT SPC 1 PLOS2 JSB RREC READ THE DATA FOR SAVE CLB TELL THEM ALL WENT WELL STB STAT SAVE IT IN THE STATUS WORD JSB SBUF SAVE BUFFER IN FILE CPB M2 FMGR ERROR? JMP TERM YES, TERMINATE JSB WRPLY SEND REPLY JMP PLOS0 GO WAIT FOR MORE * * CLOSE FILE AND DEALLOCATE DCB * PLOS3 JSB DALOC DEALLOCATE DCB AND CLOSE FILE CLB STB STAT STATUS OK JSB WRPLY SEND REPLY JMP PLOS0 GO TO SLEEP * * SUBROUTINE TO READ RECORDS FROM A FILE UNTIL * BUFFER IS FULL. * CALLING SEQUENCE * JSB LBUF * UPON RETURN...B REG= STATUS * STATUS= -1=EOF,O=BUFFER FULL * LBUF NOP LDA DBUFA GET DATA BUFFER ADDRESS STA TEMP1 SAVE AS CURRENT DATA ADDRESS INA GET TO FIRST DATA WORD STA LBUF1 SAVE FOR FILE WRITE COMMAND LDA BLEN GET MAX BUFFER SIZE ADA M1 EOB WORD, JUST IN CASE STA TEMP2 SAVE CURRENT BUFFER SIZE LBUFA JSB READF GO READ A RECORD DEF *+6 DEF DCBN,I DCB ADDRESS DEF FERR FILE STATUS AFTER READ LBUF1 NOP BUFFER ADDRESS GOES HERE DEF TEMP2 CURRχENT MAX BUFFER LENGTH DEF TEMP3 ACTUAL SIZE OF RECORD LDA FERR GET FILE STATUS LDB TEMP3 GET LENGTH SSA,RSS ERROR? JMP LBUFF NO CCB YES...SET TO -1 JMP LBUFG AND TERMINATE LBUFF CPB TEMP2 ARE THE TWO EQUAL? CLB,RSS YES...LOST SOMETHING SZB NO, 0 LENGTH? RSS NO JMP LBUFA YES,GET NEXT ONE LBUFG STB TEMP1,I SET STATUS IN BUFFER SZB EOF OR BUFFER FULL? CPB M1 ? JMP LBUFB YES...EITHER BACKSPACE OR TERMINATE LDB TEMP3 GET RECORD LENGTH AGAIN ADB LBUF1 GET ADDRESS OF NEXT RECORD TO READ STB TEMP1 SAVE ADDRESS INB GET TO FIRST DATA WORD STB LBUF1 SAVE AS CURRENT BUFFER ADDESS LDB TEMP3 GET LENGTH OF LAST READ CMB NEGATE AND SUBTRACT 1 (INCLUDE COUNT WORD) ADB TEMP2 SAVE AS NEW LENGTH STB TEMP2 SAVE NEW LENGTH SSB,RSS SHOULD NEVER GO NEGATIVE JMP LBUFA BUT MAKE SURE ANYWAY * * AT THIS POINT THE BUFFER IS FULL OR AN * EOF HAS BEEN HIT...IN ANY CASE DON'T READ * ANY MORE NOW * LBUFB SZB EOF? JMP LBUFC YES...CLOSE FILE JSB POSNT NO...BACKSPACE ONE RECORD DEF *+4 DEF DCBN,I DCB ADDRESS DEF FERR DEF M1 CLB SET THE B REG...BUFFER FULL LDA FERR GET ERROR CODE SSA LDB M2 SET TO -2 IF ERROR JMP LBUF,I RETURN * * EOF HIT...CLOSE FILE * LBUFC JSB DALOC DEALOCATE DCB AND CLOSE FILE CCB SET B=-1...EOF LDA FERR GET ERROR CODE SSA LDB M2 SET TO -2 FOR STATUS IF ERROR JMP LBUF,I RETURN SKP * * SUBROUTINE TO MOVE BUFFER TO FILE * CALLING SEQUENCE * JSB SBUF * SBUF NOP LDA DBUFA GET DATA BUFFER ADDRESS STA TEMP1 SAVE BUFFER ADDRESS SBUFA LDA TEMP1,I GET LENGTH OF RECORD SZA,RSS DONE? JMP SBUF,I YES...RETURN ISZ TEMP1 GET ADDRESS OF 1ST DATA WORD STA TEMP2 SAVE LENGTH FOR WRITE INA,SZA,RSS EOF? JMP SBUFB YES...CLOSE FILE JSB WRITF WRITE THE RECORD DEF *+5 DEF DCBN,I DCB ADDRESS DEF FERR ERROR STATUS DEF TEMP1,I BUFFER ADDRESS DEF TEMP2 LENGTH OF WRITE GOES HERE LDA FERR GET ERROR CODE SSA ERROR? JMP SBUFB YES, TRY TO CLOSE FILE LDA TEMP2 GET LENGTH OF LAST WRITE ADA TEMP1 GET ADDRESS OF NEXT WRITE STA TEMP1 SAVE FOR NEXT WRITE JMP SBUFA CONTINUE WRITING ON FILE * * HERE WHEN EOF REACHED * SBUFB JSB DALOC DEALOCATE THE DCB CLB LDA FERR GET CLOSE ERROR CODE SSA SKIP IF OK LDB M2 SET FOR STATUS WORD STA FERR RESTORE ERROR CODE JMP SBUF,I RETURN SKP SPC 2 * * THIS SECTION CLOSES ALL FILES CURRENTLY * OPEN TO THE REMOTE LU # * CLSIT LDA SATA GET ADDRESS OF ACTIVE SATELLITES STA TEMP1 SAVE IN UP COUNTER LDA MMAXS GET MAX # OF ENTRIES INA STA TEMP2 SAVE IN DOWN COUNTER CLA SET UP FOR TABLE DISPLACEMENT STA TEMP3 CLOS1 LDA RLU GET REMOTE LU # CPA TEMP1,I IS THERE A MATCH RSS JMP CLOS2 NO, TRY NEXT ONE * LDA TEMP3 GET DISPLACEMENT ADA DCBBA GET TO DCB ADDRESS LDB A,I GET DCB ADDRESS STB CLSAL SAVE FOR CLOSE CLB DEALLOCATE DCB STB A,I CLEAR TABLE LOCATION STB TEMP1,I CLEAR SATELLITE ENTRY JSB CLOSE CLOSE DCB DEF *+3 CLSAL NOP DEF FERR LDA CALOC GET CURRENT # OF ACTIVE TERMINAL ADA M1 DECREASE IT BY 1 CPA M1 NONE ACTIVE? JMP CLOS3 f YES. GO TO COMPLETION. STA CALOC SAVE NEW CURRENT # * CLOS2 ISZ TEMP1 NO...GET NEXT ENTRY ISZ TEMP3 ISZ TEMP2 DONE? JMP CLOS1 NO...CONTINUE * CLOS3 LDB M2 LDA FERR GET FMGR ERROR CODE SSA NO ERROR CPA M11 OR FILE ALREADY CLOSED CLB CPB M2 JMP TERM EXIT IF ERROR STB STAT OK IN STATUS WORD JSB WRPLY SEND REPLY JMP PLOS0 GO TO SLEEP SKP * SUBROUTINE TO ALOCATE DCB AND OPEN A FILE * CALLING SEQUENCE * JSB OPN * NORMAL RETURN * ERROR RETURN * OPN NOP JSB ALOC GO GET A DCB ADDRESS LDA DCBN GET DCB ADDRESS STA OPEN1 SAVE DCB ADDRESS JSB OPEN GO TRY TO OPEN FILE DEF *+7 OPEN1 NOP DCB ADDRESS HERE DEF FERR DEF PNAM NAME OF FILE DEF D0 DEF SC DEF LU LDA FERR ANY ERRORS? SSA,RSS JMP OPN,I NO...RETURN JSB DALOC YES...DEALOCATE THE DCB ISZ OPN SET FOR ERROR RETURN JMP OPN,I ERROR RETURN SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB CRET * NORMAL RETURN * ERROR RETURN * CRET NOP JSB ALOC GO GET A DCB LDA DCBN GET THE DCB ADDRESS STA CRET1 SAVE DCB ADDRESS LDA TYPE GET TYPE WORD SZA,RSS IS IT ZERO? LDA D11 YES...DEFAULT TO TYPE 11 STA TYPE SAVE TYPE WORD LDA SIZE GET SIZE WORD SZA,RSS IS IT ZERO? LDA D40 YES...DEFAULT TO 40 RECORDS STA SIZE SAVE SIZE WORD JSB CREAT CREATE THE FILE DEF *+8 CRET1 NOP DEF FERR DEF PNAM NAME TO BE USED DEF SIZE DEF TYPE TYPE IS DEFINED AS TYPE 9 DEF SC SECURITY CODE DEF LU LDA FERR GET FILE STATUS SSA,RSS ANY ERRORS? JMP CRET,I NO...RETURN JSB DALOC DEALOCTE DCB ISZ CRET SET FOR ERROR RETURN JMP CRET,I RETURN...ERROR SKP * * SUBROUTINE TO ALOCATE A DCB * CALLING SEQUENCE * JSB ALOC * ALOC NOP LDA DCBBA GET ADDRESS OF DCB AVAILABLE TABLE STA TEMP1 SAVE IN TEMP LOCATION LDA MMAXS GET MAX # OF ENTRIES STA TEMP2 SAVE IN DOWN COUNTER CLA GET A ZERO STA TEMP3 SAVE AS MULT. FACTOR ALOC1 ISZ TEMP2 DONE? JMP ALOC3 NO...CONTINUE LDB M3 YES...NO ROOM JMP TERM TELL OTHER SIDE TO TRY LATER ALOC3 LDA TEMP1,I GET CONTENTS OF TABLE SZA,RSS IS THERE SOMETHING THERE? JMP ALOC2 NO...GOOD FOUND A HOME!!! ISZ TEMP1 GET NEXT ADDRESS ISZ TEMP3 INCREMENT MULT COUNT JMP ALOC1 CONTINUE * * HERE IF WE HAVE ROOM * ALOC2 LDA TEMP3 GET MULT FACTOR MPY D144 GET DISPLACEMENT FROM FIRST ADA DCBA ADDRESS OF AVAILABLE DCB STA TEMP1,I SAVE IN TABLE TO HOLD A PLACE STA DCBN SAVE IN PARMB ISZ CALOC INCREMENT # OF ACTIVE TERMINALS NOP LDA TEMP3 GET DISPLACEMENT ADA SATA ADD FOR SATELLITE TABLE ENTRY LDB RLU GET REMOTE LU STB A,I SAVE PLACE IN TABLE JMP ALOC,I RETURN SPC 3 SKP * * SUBROUTINE TO DALOCATE A DCB * CALLING SEQUENCE * JSB DALOC * DALOC NOP LDA DCBBA GET ADDRES OF DCB ACTIVE TABLE STA TEMP1 SAVE IN TEMP LOCATION LDA MMAXS GET MAX # OF ENTRIES STA TEMP2 SAVE IN TEMP LOCATION LDA SATA GET ADDRESS OF SATELLITE OPEN TABLE STA TEMP3 DALC1 ISZ TEMP2 GONE THRU TABLE? JMP DALC2 NO....GOOD LDB M4 WE IN BIG TROUBLE...SHOULD NEVER GET HERE JMP TERM UNKNOWN DCB DALC2 LDA TEMP1,I GET ADDRESS IN TABLE CPA DCBN THE SAME? JMP DALC3 YES...DEALOCATE IT ISZ TEMP3 GET TO NEXT SATELLITE ENTRY ISZ TEMP1 GET NEXT BUFFER ADDRESS JMP DALC1 GO TRY AGAIN * * HERE FOR MATCH CONDITION * DALC3 JSB CLOSE CLOSE THE FILE DEF *+3 RETURN DEF DCBN,I DCB ADDRESS DEF DCBN IGNORE ANY ERRORS CLA GET A ZERO STA TEMP1,I CLEAR OUT TABLE LOCATION STA TEMP3,I CLEAR OUT SATELLITE ENTRY STA DCBN CLEAR OUT DCB POINTER LDA CALOC GET CURRENT # OF ACTIVE TERMINALS SZA [ PROTECT AGAINST A NEGATIVE COUNT ] ADA M1 DECREASE IT BY 1 STA CALOC SAVE AS CURRENT # OF ACTIVE JMP DALOC,I RETURN SKP * * SUBROUTINE TO SEND DATA TO TERMINAL * CALLING SEQUENCE * JSB WREC * WREC NOP LDA RLU GET LU AND B77 CLEAN IT IOR B300 SET FOR DATA ONLY STA CNWD JSB D65CL SEND EXEC CALL DEF *+7 DEF IWRIT WRITE REQUEST DEF CNWD DEF DBUF ADDRESS OF DATA BUFFER DEF BLEN DATA LENGTH DEF RBUF+33 PASS TIME-TAGS TO DRIVER DEF RBUF+34 NOP ERROR RETURN JMP WREC,I RETURN SPC 4 * * ROUTINE TO READ DATA FROM A TERMINAL * CALLING SEQUENCE * JSB RREC * RREC NOP LDA RLU AND B77 IOR B300 SET FOR DATA ONLY STA CNWD JSB D65CL DEF *+7 DEF IREAD READ DATA DEF CNWD DEF DBUF DEF BLEN DEF RBUF+33 PASS TIME-TAGS TO DRIVER DEF RBUF+34 NOP ERROR RETURN JMP RREC,I RETURN SKP * * SUBROUTINE TO SEND A REPLY TO THE TERMINAL * CALLING SEQUENCE * JSB WRPLY * B REG= STATUS * WRPLY NOP LDA RBUF SET IN REPLY BIT IOR BIT14 STA RBUF LDA RLU GET REMOTE LU STA RRLU SAVE IN kREPLY BUFFER AND B77 STA CNWD SET CONTROL WORD (MODE 0) JSB D65SV SEND REPLY DEF *+7 DEF IWRIT WRITE DEF CNWD REQUEST ONLY DEF RBUF REQUST BUFFER DEF RBUFL REQUST BUFFER LENGTH DEF DUMMY DEF DUMMY NOP ERROR RETURN JMP WRPLY,I RETURN SPC 4 * * HERE TO TERMINATE ON AN ERROR CONDITION * B REG=STATUS * TERM STB STAT SAVE STATUS LDA RLU GET LU AND B77 CLEAN IT STA CNWD SAVE THE CONTROL WORD. JSB D65CL TELL OTHER SIDE, NO DATA DEF *+7 DEF ICONT CONTROL REQUEST DEF CNWD SEND STOP DEF DUMMY DEF DUMMY DEF DUMMY DEF DUMMY NOP ERROR RETURN JSB WRPLY SEND REPLY...REASON FOR STOP JMP PLOS0 WAIT FOR SOMEONE ELSE SPC 3 SKP * * TEMP VALUES,CONSTANTS,BUFFERS, WHAT EVER * MAXN EQU 2 MAX # OF OPEN TERMINALS BUFS EQU 512 SIZE OF DATA BUFFER SPC 1 CLSNM NOP CLASS NUMBER BIT14 OCT 40000 D21 DEC 21 D1 DEC 1 D2 DEC 2 D11 DEC 11 D40 DEC 40 D144 DEC 144 M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 M11 DEC -11 MMAXS ABS 0-MAXN-1 MAX # OF TERMINALS + 1 MBUFS ABS 0-BUFS-1 DATA BUFFER SIZE CALOC OCT 0 CURRENT # OF ACTIVE DCB'S TEMP0 NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP D0 OCT 0 DBUFA DEF DBUF D35 DEC 35 IREAD OCT 100001 READ / RETURN IF ERROR IWRIT OCT 100002 WRITE / RETURN IF ERROR ICONT OCT 100003 CONTROL / RETURN IF ERROR RBUFL ABS RBFL REQUEST BUFFER LENGTH DCBBA DEF DCCB DCBA DEF DCBF SATA DEF SAT CNWD NOP B77 OCT 77 B300 OCT 300 DUMMY NOP SKP * * HERE WE DEFINE THE PARMB * . EQU * RBUF NOP STREAM ID DCBN NOP DCB ADDRESS LSFG NOP LOAD-SAVE FLAG,OVERIDE FLAG FERR NOP FILE MANAGER%<:6 STATUS STAT NOP STATUS PNAM NOP PROGRAM NAME BSS 2 SC NOP SECURITY CODE LU NOP LOGICAL UNIT TYPE NOP FILE TYPE SIZE NOP FILE SIZE BLEN NOP BUFFER LENGTH BSS 3 NOT USED RRLU NOP REMOTE LU RBFL EQU *-. LENGTH OF REQUEST BUFFER BSS 7 NOT USED RLU NOP REMOTE LU (PARMB + 24) BSS 10 REMAINDER OF PARMB (TIME TAGS) SPC 2 * * DEFINE SATELLITE OPEN TABLE * SAT REP MAXN NOP SPC 2 * DEFINE DCB TABLE DCCB BSS 0 REP MAXN NOP SPC 2 * DEFINE DCB AREA DCBF BSS 0 REP MAXN BSS 144 SPC 2 * DEFINE DATA BUFFER DBUF BSS 512 END EQU * END PLOSB Bs< Ud 91700-18150 1603 S 0122 DS1/B CCE MODULE: D65CL              H0101 -ASMB,R,L,C HED COMM. LINE INTERFACE * (C) HEWLETT-PACKARD CO. 1976 * NAM D65CL,7 91700-16150 REV.A 760111 ENT D65CL EXT .ENTR,EXEC,DRTEQ,RNRQ,#RTRY * NAME: D65CL * SOURCE: 91700-18150 * RELOC: 91700-16150 * PGMR: C.C.H. [01/11/76 ] * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * D65CL CONTROLS ACCESS TO THE COMMUNICATIONS LINE VIA THE RESOURCE * NUMBERING (RN) SCHEME OF RTE-II & RTE-III. TWO RN'S ARE CHECKED FOR * AVAILABILITY, PRIOR TO ALLOWING ACCESS TO THE COMM. LINE. THE RN'S * ARE IDENTIFIED AS: PRN ( RN) AND LRN (LINE RN). * * D65CL OPERATION: * * 1. GET PARAMETERS AND CHECK FOR VALID LOGICAL UNIT NUMBER. * 2. ATTEMPT TO LOCK/CLEAR PRN WITH WAIT. * A. IF PRN IS LOCKED, SLAVE ACCESS IS REJECTED: "DS02" ERROR. * B. IF PRN IS LOCKED, MASTER ACCESS AWAITS COMPLETION. * C. IF AVAILABLE, PROCEED WITH PRN CLEARED. * 3. IF CONTROL REQ. OR MODE =DATA REQUEST, GO TO 4; ELSE, GO TO 6.C. * 4. ATTEMPT TO LOCK LRN; DON'T WAIT 'TIL AVAILABLE. * 5. CALL DVR65 FOR I/O TRANSFER VIA SUPPLIED LU. * A. IF GOOD TRANSFER, RETURN TO USER; ELSE, * 6. CHECK REJECT REASON: * A. IF REMOTE BUSY, WAIT 1-SECOND AND RETRY--GO TO 5. * B. IF RETRIES EXHAUSTED: "DS08" ERROR. * C. IF DRIVER BUSY, DO LRN LOCK W/WAIT. WHEN LRN IS AVAILABLE, * RE-CALL DRIVER (GO TO 4.). * D. IF ERROR REJECT, RETURN WITH ASCII ERROR CODE IN &. * * D65CL CALLING SEQUENCE: * * JSB D65CL * DEF *+7 [ OR *+8 ] * DEF RCODE READ/WRITE/CONTROL (1/2/3) REQUEST CODE * DEF CONWD CONTROL WORD: Z/MODE/LU OF COMM. LINE. * DEF RQBUF REQUEST OR DATA BUFFER ADDRESS. * DEF RQLEN REQUEST OR DATA BUFFER LENGTH. * DEF DABUF DATA BUFFER ADDRESS OR DUMMY PARAMETER. * DEF DALEN DATA BUFFER LENGTH OR DUMMY PARAMETER. * [ DEF EXTAD ] [ OPTIONAL ADDRESS OF EQT EXTENSION ] * RETURN HERE UPON DETECTION OF ERROR. * NORMAL COMPLETION RETURN HERE. * * NOTE: LRN & PRN ARE OBTAINED FROM THE FIRST TWO WORDS OF THE EXTENSION * TO THE EQT ENTRY LINKED TO THE USER-SPECIFIED LOGICAL UNIT NO. * SKP * * D65CL ERROR MESSAGES: * ( RETURNED TO CALLER IN & AT LOCATION ) * * "DS01" - DVR65 DETECTED AN ERROR CONDITION (PARITY ERROR, ETC.) * * "DS02" - HAS PREEMPTED COMPLETION OF THE CALLER'S REQUEST. * * "DS04" - LOGICAL UNIT INVALID, OR NOT ENTERED IN CLCT TABLE. * * "DS08" - BUSY-REJECT FROM REMOTE--RETRIES EXHAUSTED. * * "IOXX" \ * - SYSTEM LEVEL ERRORS, DETECTED BY RTE. * "RNXX" / * SKP RCODE NOP REQUEST CODE ADDRESS. CONWD NOP CONTROL WORD ADDRESS. RQBUF NOP ADDRESS OF REQUEST OR DATA BUFFER. RQLEN NOP ADDRESS OF REQUEST OR DATA BUFFER SIZE. DABUF NOP ADDRESS OF REQUEST OR DATA BUFFER. DALEN NOP ADDRESS OF REQUEST OR DATA BUFFER SIZE. EXTAD NOP OPTIONAL ADDRESS OF EQT EXTENSION. SUP [SUPPRESS EXTENDED LISTING] D65CL NOP ENTRY/EXIT JSB .ENTR OBTAIN DIRECT ADDRESSES DEF RCODE FOR PARAMETERS & RETURN POINT. SPC 1 LDA RCODE,I GET REQUEST CODE AND ABORT FLAG (BIT#15). CCE,SSA,RSS TEST SIGN & PREPARE TO SET IT. RAL,ERA SET SIGN FOR ERROR RETURN. STA RCODE SAVE REQUEST CODE, LOCALLY. * CLA LDB EXTAD GET EQT EXTENSION PARAMETER--IF ANY. STA EXTAD CLEAR PARAMETER FOR NEXT ACCESS. SZB  WAS THE EXTENSION PARAMETER SUPPLIED? JMP GETX YES. GO TO GET THE EXTENSION ADDRESS. SPC 1 * CHECK FOR VALID LU AND CALCULATE EQT EXTENSION ADDRESS. SPC 1 JSB DRTEQ GO TO FIND EQT ADDRESS. DEF *+2 DEF CONWD,I RETURN INFO FOR THIS LOGICAL UNIT. CPA M1 IF INVALID LU DETECTED, JMP ABOR4 * ERROR: "DS04" - INFORM THE CALLER. * ADB D4 FORM EQT5 ADDRESS FROM EQT FWA IN . LDA B,I GET THE CONTENTS OF EQT5. AND EQMSK ISOLATE THE EQUIPMENT TYPE CODE. CPA TYP65 IS THIS LU LINKED TO DVR65? RSS YES, CONTINUE PROCESSING. JMP ABOR4 NO. * ERROR: "DS04" - INVALID LU! * ADB D8 COMPUTE ADDRESS OF EQT13. GETX LDB B,I GET A DIRECT RBL,CLE,SLB,ERB ADDRESS FOR THE JMP *-2 EQT EXTENSION. SPC 1 * LOCATE RESOURCE NUMBERS FOR THE SPECIFIED LOGICAL UNIT. SPC 1 LDA B,I GET THE LINE-CONTROL RESOURCE NUMBER, STA LRN AND SAVE IT. INB INDEX TO THE PRN ENTRY. LDA B,I GET THE RESOURCE NUMBER, STA PRN AND SAVE IT. LDA LCGW INITIALIZE 'PRNCW' TO ACCOMMODATE STA PRNCW CORE-RESIDENT COPIES OF . * LDA #RTRY GET NEGATIVE NUMBER OF RETRIES. STA RTCNT SAVE FOR BUSY-RETRY PROCESSING. * SKP * DETERMINE WHETHER IS USING THE LINE BY DOING A LOCK CLEAR ON THE * RESOURCE NUMBER. IF HAS THE LINE, SLAVE ACCESS IS * REJECTED: "DS02"; MASTER ACCESS MUST WAIT FOR TO COMPLETE. SPC 1 PWAIT LDA PRNCW GET THE 'PRN' CONTROL WORD. XOR SIGN ADD OR DELETE THE NO-WAIT BIT(#15). STA PRNCW RESTORE THE CONTROL WORD. * JSB RNRQ GO TO CHECK PRN AVAILABILITY. DEF *+4 DEF PRNCW SPECIFY GLOBAL LOCK/CLEAR/NO-ABORT. DEF PRN ADDRESS OF RN.  DEF TEMP RETURN STATUS. JMP ABORX GO PROCESS RN ERROR, IF ANY. * LDA TEMP GET THE STATUS OF 'PRN'. CPA D1 IF IT IS CLEAR, JMP REQCK THEN CONTINUE THE PROCESSING. CPA D2 IF IT WAS LOCALLY LOCKED TO THE CALLER, JMP ABOR2 THIS IS --ACCESS DENIED! * LDA CONWD,I GET THE CONTROL WORD. AND B1000 ISOLATE THE MASTER-REQUEST BIT(#9). SZA IF THIS IS A MASTER-REQUEST, JMP PWAIT GO TO AWAIT COMPLETION; JMP ABOR2 ELSE, ABORT SLAVE REQUESTS: "DS02"! SPC 1 * EXAMINE SPECIFIED DRIVER MODE. ONLY DATA & CONTROL REQUESTS WILL BE * ALLOWED TO PROCEED TO THE DRIVER WITHOUT WAITING FOR LRN AVAILABILITY. SPC 1 REQCK LDA RCODE GET THE REQUEST CODE WORD AND B77 ISOLATE THE REQUEST CODE. CPA D3 IF IT IS A CONTROL REQUEST, JMP LRNLK DO NOT WAIT FOR LRN AVAILABILITY. LDA CONWD,I GET THE CONTROL WORD. AND B700 ISOLATE THE DRIVER MODE OF OPERATION. CPA B300 IF THIS IS A DATA-ONLY REQUEST, RSS PROCEED TO MAKE THE DRIVER CALL; ELSE, JMP LOCKW GO TO CHECK AVAILABILITY OF LRN. SPC 1 * ATTEMPT TO LOCK THE LINE RN, BUT DO NOT WAIT, IF ALREADY LOCKED. * THE DRIVER WILL DETERMINE VALIDITY OF ACCESS FOR THIS REQUEST. * WE'LL BE FORCED TO WAIT AT A LATER TIME, IF DVR65 IS BUSY. SPC 1 LRNLK JSB RNRQ ATEMPT TO LOCK LRN--DON'T WAIT. DEF *+4 DEF LGNW SPECIFY GLOBAL LOCK/NO WAIT/NO ABORT. DEF LRN ADDRESS OF LINE RN. DEF TEMP RETURN STATUS (NOT USED). JMP ABORX PROCESS RN ERROR, IF ANY. * SKP SPC 1 * CALL THE DRIVER TO PERFORM THE REQUEST. SPC 1 CALLD JSB EXEC CALL RTE TO DO THE I/O. DEF *+7 RETURN ADDRESS:ERROR; ELSE, *+8:NORMAL. DEF RCODE REQUEST CODE ADDRESS. DEF CONWD,I CONTROL WOVRD. DEF RQBUF,I REQUEST OR DATA BUFFER ADDRESS. DEF RQLEN,I REQUEST OR DATA BUFFER LENGTH. DEF DABUF,I DATA BUFFER ADDRESS OR DUMMY PARAMETER. DEF DALEN,I DATA BUFFER LENGTH OR DUMMY PARAMETER. JMP ABORX GO TO PROCESS OP-SYSTEM ERROR. STA TEMP SAVE : EQT5 STATUS FOR CALLER. STB TEMP+1 SAVE : EQT12 STATUS FOR CALLER. SPC 1 * EXAMINE THE RETURN-STATUS FROM THE DRIVER. SPC 1 SLA,RAR WAS THE TRANSFER SUCCESSFUL? JMP NEXIT YES, GO PREPARE FOR NORMAL EXIT. SWP EXCHANGE & FOR BOOLEAN OPERATIONS. AND B40 ISOLATE EQT12 BIT#5 (REMOTE BUSY). CLE,ERB MOVE BUSY-REJECT BIT(EQT5 #1) TO . SEZ,SZA,RSS BUSY-REJECT/REMOTE-BUSY OR BOTH? JMP ABOR1 NEITHER--DRIVER ERROR! SEZ,RSS WAS THE REMOTE SYSTEM BUSY? JMP DELAY YES. GO TO WAIT AWHILE & RETRY. SZA NO. SIMULTANEOUS REQUESTS DETECTED? JMP CALLD YES. LET DVR65 SOLVE THE PROBLEM. SPC 1 * BUSY-REJECT: THE DRIVER DETERMINED THAT A NEW REQUEST COULD NOT BE * PROCESSED AT THIS TIME. THE USER MUST WAIT FOR AVAILABILITY OF THE LRN. SPC 1 LOCKW JSB RNRQ LOCK THE LRN--WAIT FOR AVAILABILITY. DEF *+4 DEF LGW SPECIFY GLOBAL LOCK/WITH WAIT/NO ABORT. DEF LRN ADDRESS OF LRN. DEF TEMP RETURN STATUS (NOT USED). JMP ABORX PROCESS RN ERROR CONDITION. JMP CALLD RN LOCKED. GO CALL THE DRIVER. SPC 1 * PREPARE FOR NORMAL RETURN TO THE USER SPC 1 NEXIT ISZ D65CL SET EXIT-POINTER FOR . DLD TEMP RETURN WITH & FROM DVR65. JMP D65CL,I RETURN TO THE USER. SPC 1 * ERROR PROCESSING SECTION. SPC 1 ABOR8 LDB "08" REMOTE-BUSY/RETRIES EXHAUSTED: "DS08". JMP GETDS GO TO GET "DS" PORTION OF ERROR CODE. ABOR4 LDB "04" INVALID LOGICAL UNIT ERROR: "DS0E$"4". JMP GETDS GO TO GET FIRST HALF OF MESSAGE. ABOR2 LDB "02" SLAVE-TRANSACTION INTERRUPTED: "DS02". RSS GO TO GET FIRST HALF OF MESSAGE. ABOR1 LDB "01" ABORTIVE DRIVER ERROR: "DS01". GETDS LDA "DS" GET FIRST HALF OF ERROR MESSAGE. ABORX JMP D65CL,I RETURN TO THE USER. SKP * WAIT--IN ORDER TO ALLOW TIME FOR THE REMOTE TO CLEAR TABLE SPACE. SPC 1 DELAY JSB EXEC GO TO THE RTE 'EXEC' DEF *+6 IN ORDER TO DEF D12 PLACE THIS PROGRAM DEF ZERO IN THE TIME LIST DEF D1 FOR A 1-SECOND DELAY, DEF ZERO WHILE WAITING FOR DEF DM100 TABLE SPACE AT REMOTE SYSTEM. * ISZ RTCNT MAXIMUM NO. OF RETRIES BEEN EXECUTED? JMP CALLD NO. GO TO TRY AGAIN. JMP ABOR8 YES. INFORM CALLER OF THE PROBLEM. SPC 2 * POINTER AND CONSTANT STORAGE AREA. SPC 1 B EQU 1 B40 OCT 40 B77 OCT 77 B300 OCT 300 B700 OCT 700 B1000 OCT 1000 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D8 DEC 8 D12 DEC 12 DM100 DEC -100 EQMSK OCT 37400 EQT5 EQUIPMENT TYPE CODE MASK. LCGW OCT 40006 GLOBAL RN LOCK/CLEAR/WAIT/NO ABORT. LGNW OCT 140002 GLOBAL RN LOCK/NO WAIT/NO ABORT. LGW OCT 40002 GLOBAL RN LOCK/WAIT/NO ABORT. LRN NOP LINE CONTROL RESOURCE NUMBER. M1 OCT -1 PRN NOP RESOURCE NUMBER. PRNCW NOP RN-CHECK CONTROL WORD. RTCNT NOP BUSY-REJECT RETRY COUNTER. SIGN OCT 100000 TEMP OCT 0,0 TEMPORARY STORAGE. TYP65 OCT 32400 EQUIPMENT TYPE CODE 65 FOR DVR65. ZERO OCT 0 "01" ASC 1,01 "02" ASC 1,02 "04" ASC 1,04 "08" ASC 1,08 "DS" ASC 1,DS SPC 1 END bv$ V a 91700-18151 1603 S 0122 DS1/B CCE MODULE: DRTEQ              H0101 KASMB,R,L,Z,C HED DRT/EQT ADDRESS ROUTINE * (C) HEWLETT-PACKARD CO. 1976 * IFN NAM DRTEQ,7 91700-16151 REV.A 760117 XIF IFZ NAM DRTEQ,14 91700-16151 REV.A 760117 XIF ENT DRTEQ IFN EXT .ENTR XIF IFZ EXT .ENTP,$LIBR,$LIBX XIF * NAME: DRTEQ * SOURCE: 91700-18151 * RELOC: 91700-16151 * PGMR: C.C.H. [ 01/17/76 ] * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * DRTEQ ACCEPTS A USER-SUPPLIED LOGICAL UNIT NUMBER, AND RETURNS * TO THE CALLER, BOTH THE CONTENTS OF THE DEVICE REFERENCE TABLE * ENTRY FOR THAT LOGICAL UNIT, AND THE ADDRESS OF THE FIRST WORD * OF THE EQT ENTRY WHICH IS LINKED TO THE SPECIFIED LOGICAL UNIT. * * DRTEQ CALLING SEQUENCE: * * JSB DRTEQ * DEF *+2 [ OR *+2+N WHERE N= NUMBER OF OPTIONAL PARAMETERS <=2 ] * DEF LU ADDRESS OF LOGICAL UNIT NO. IN QUESTION. * [DEF DRTEN] [OPTIONAL ADDRESS FOR RETURN OF DRT ENTRY CONTENTS.] * [DEF EQTAD] [OPTIONAL ADDRESS FOR RETURN OF EQT ENTRY LOCATION.] * =DRT ENTRY CONTENTS; =EQT ADDRESS. * * FORTRAN CALLING SEQUENCE: CALL DRTEQ(LU,IDRT,IEQAD) OR REG=DRTEQ(LU) * * NOTE: IN THE SPECIAL CASE OF LOGICAL UNIT NUMBERS WHICH ARE * LINKED TO EQT #0 ("BIT BUCKET"), THE DRT ENTRY RETURNED * TO 'DRTEN' & WILL REFLECT THE ACTUAL CONTENTS; I.E., * ANY SUBCHANNEL OR LU-LOCK BITS WILL BE PASSED TO THE CALLER. * SINCE THERE IS NO EQT ENTRY ASSOCIATED WITH THE LU, * 'EQTAD' & WILL BOTH BE SET =0. * * DRTEQ ERROR PROCESSIN6G: * * INVALID LOGICAL UNIT NUMBERS WILL BE INDICATED BY SETTING -1 * INTO THE RETURNED PARAMETERS-IF ANY, AND INTO BOTH &, UPON * RETURN TO THE CALLER. * * SUP [SUPPRESS EXTENDED LISTING] * LU NOP LOGICAL UNIT ADDRESS. P1 DEF A OPTIONAL DRT ENTRY RETURN ADDRESS. P2 DEF B OPTIONAL EQT ADDRESS RETURN LOCATION. SPC 1 DRTEQ NOP ENTRY/EXIT. IFN JSB .ENTR OBTAIN DIRECT ADDRESSES XIF IFZ JSB $LIBR DEFINE THIS SUBROUTINE NOP TO BE PRIVILEGED. JSB .ENTP PRIVILEGED: GET DIRECT ADDRESSES. XIF DEF LU DEFINE PARAMETER STORAGE AREA. SPC 1 * RE-INITIALIZE CALLING-PARAMETER ADDRESSES TO POINT TO & , * IN ORDER TO ALLOW USER TO CALL WITHOUT RETURN-DATA PARAMETERS. SPC 1 DLD P1 GET PARAMETER ADDRESSES-IF ANY. DST DRT SAVE FOR DATA RETURN. DLD REGDF GET INITIAL PARAMETER DEFINITION. DST P1 RE-INITIALIZE FOR NO PARAMETERS. SPC 1 * VERIFY THAT CALLER HAS REQUESTED DATA FOR A VALID LOGICAL UNIT NO. SPC 1 LDA LU,I GET THE USER SUPPLIED LU NUMBER. AND B77 ISOLATE THE PERTINENT BITS. ADA M1 SUBTRACT ONE, FOR VALIDITY CHECKING. STA B SAVE FOR DRT INDEXING. CMA,CLE IF THE SPECIFIED LU NUMBER ADA LUMAX IS NOT IN THE RANGE: SEZ,RSS 1<=LU<=LUMAX, THEN JMP ERROR THE LU IS INVALID! SPC 1 * RETRIEVE THE CONTENTS OF THE DEVICE REFERENCE TABLE ENTRY. SPC 1 ADB DRTA FIND THE DEVICE REFERENCE TABLE ENTRY LDA B,I FOR A VALID LOGICAL UNIT NUMBER. STA AREG SAVE THE DRT ENTRY FOR THE CALLER. STA LU SAVE IT FOR RETURN IN . AND B77 ISOLATE THE EQT ORDINAL. CLB PREPARE TO RETURN EQT ADDRESS =0. SZA,RSS IF THEГ ORDINAL IS ZERO, JMP ZERO RETURN WITH EQT ADDRESS =0. SPC 1 * CALCULATE THE ADDRESS OF THE EQUIPMENT TABLE ENTRY LINKED TO THE LU. SPC 1 ADA M1 ORDINAL-1 =RELATIVE EQT ENTRY ORDINAL. MPY D15 RELATIVE ENTRY*WORDS/ENTRY =OFFSET. LDB A GET EQT-ENTRY OFFSET IN . ADB EQTA FORM ABSOLUTE EQT-ENTRY ADDRESS IN . ZERO STB BREG SAVE THE EQT ADDRESS FOR THE CALLER. JMP EXIT GO TO RETURN THE REQUESTED INFORMATION. * SKP * PROCESS INVALID LOGICAL UNIT NUMBER ERRORS. SPC 1 ERROR CCA INVALID LOGICAL UNIT NUMBER. STA AREG RETURN TO USER WITH BOTH PARAMETERS STA BREG AND & SET TO -1. SPC 1 * PASS DATA BACK TO THE CALLER AND THEN RETURN. SPC 1 EXIT LDA AREG = DRT ENTRY OR -1, IF ERROR. STA DRT,I PASS DRT ENTRY TO CALLER, IF REQUESTED. LDB BREG = EQT ADDRESS OR -1, IF ERROR. STB EQTAD,I PASS EQT ADDRESS TO CALLER, IF REQUESTED. IFN JMP DRTEQ,I RETURN:=DRT OR -1;=EQT ADD. OR -1. XIF IFZ JSB $LIBX RETURN TO CALLER DEF DRTEQ VIA PRIVILEGED PROCESSOR. XIF SPC 1 * CONSTANTS, POINTERS, AND STORAGE. SPC 1 A EQU 0 B EQU 1 B77 OCT 77 EQTA EQU 1650B ADDRESS OF 1RST WORD OF EQUIPMENT TABLE. DRTA EQU 1652B ADDRESS OF DEVICE REFERENCE TABLE. LUMAX EQU 1653B NUMBER OF VALID DRT ENTRIES. M1 DEC -1 D15 DEC 15 AREG NOP TEMPORARY STORAGE: DRT ENTRY OR ERROR. BREG NOP TEMPORARY STORAGE: EQT ADDR. OR ERROR. DRT NOP DRT RETURN-PARAMETER ADDRESS. EQTAD NOP EQT ADDR. RETURN-PARAMETER ADDRESS. REGDF OCT 0,1 REGISTER ADDRESSES FOR INITIALIZATION. SPC 1 END k W` 91700-18152 1603 S 0122 DS1/B CCE MODULE: PGMAD              H0101 <ASMB,R,L,C,N HED I.D. SEG. ADDRESS ROUTINE *(C) HEWLETT-PACKARD CO. 1976* IFN NAM PGMAD,7 91700-16152 REV.A 760117 EXT .ENTR XIF IFZ NAM PGMAD,14 91700-16152 REV.A 760117 EXT .ENTP,$LIBR,$LIBX XIF ENT PGMAD SPC 1 * NAME: PGMAD * SOURCE: 91700-18152 * RELOC: 91700-16152 * PGMR: C.C.H. [ 01/17/76 ] [LIBERALLY EXTRACTED FROM 'SCHED'] SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * PGMAD ACCEPTS A USER-SUPPLIED ADDRESS OF A 3-WORD ARRAY WHICH * CONTAINS THE ASCII CODE FOR THE NAME OF A PARTICULAR PROGRAM. * PGMAD RETURNS THE I.D. SEGMENT ADDRESS OF THE PROGRAM, IT'S STATUS, * AND AN INDICATION OF THE TYPE OF I.D. SEGMENT; I.E.,LONG/SHORT. * * PGMAD CALLING SEQUENCE: * * JSB PGMAD * DEF *+2 [ OR *+2+N WHERE N= NUMBER OF OPTIONAL PARAMETERS ] * DEF NAME ADDRESS OF 3-WORD ASCII PROGRAM NAME ARRAY. * [DEF IDAD] [OPTIONAL ADDRESS FOR RETURN OF I.D. SEG. ADDRESS] * [DEF ISTAT] [OPTIONAL ADDRESS FOR RETURN OF PROGRAM STATUS] * [DEF IDTYP] [OPTIONAL ADDRESS FOR RETURN OF I.D.SEGMENT TYPE] * = I.D. SEGMENT ADDRESS. * = PROGRAM STATUS. * = 0: STANDARD 28-WORD I.D. SEGMENT. * = 1: SHORT(PROGRAM SEGMENT) 9-WORD I.D. SEGMENT. * * FORTRAN CALLING SEQUENCE: CALL PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * OR * REG=PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * * PGMAD ERROR DETECTION: * * A. ADDRESaS OF NAME-ARRAY NOT SUPPLIED. * B. CHARACTER #5 OF USER-SUPPLIED PROGRAM NAME IS NULL. * C. I.D. SEGMENT WITH EQUIVALENT PROGRAM NAME CANNOT BE FOUND. * * -- RETURN TO WITH: * * 1. & AND 'IDAD' & 'ISTAT' ALL SET = 0. * 2. AND 'IDTYP' ARE SET =1. * NAME NOP ADDRESS OF ASCII NAME ARRAY. P1 DEF A ADDRESS FOR RETURN OF PARAMETER #1. P2 DEF B ADDRESS FOR RETURN OF PARAMETER #2. P3 DEF PTEM ADDRESS FOR RETURN OF PARAMETER #3. SUP [SUPPRESS EXTENDED LISTING] PGMAD NOP ENTRY/EXIT: I.D.SEG. ADDRESS ROUTINE. IFN JSB .ENTR OBTAIN DIRECT ADDRESSES. XIF IFZ JSB $LIBR DEFINE THIS SUBROUTINE NOP TO BE PRIVILEGED. JSB .ENTP GET DIRECT ADDRESSES--PRIVILEGED MODE. XIF DEF NAME DEFINE PARAMETER STORAGE AREA. SPC 1 LDA NAME GET THE ADDRESS OF THE ASCII ARRAY. SZA,RSS DID THE CALLER SUPPLY AN ADDRESS? JMP ERREX NO--ERROR! SPC 1 * RESET POINTERS TO ALLOW USER TO CALL WITHOUT RETURN-DATA PARAMETERS. SPC 1 DLD P1 GET PARAMETER ADDRESSES-IF ANY. DST IDAD SAVE FOR DATA RETURN. DLD REGDF GET INITIAL PARAMETER DEFINITION DST P1 AND RE-INITIALIZE FOR NO PARAMETERS. LDA P3 GET 'IDTYP' PARAMETER ADDRESS--IF ANY. LDB DPTEM GET DEF TO DUMMY PARAMETER STORAGE. STA IDTYP SAVE PARAMETER ADDRESS. STB P3 RE-INITIALIZE FOR NO 'IDTYP' PARAMETER. * LDB NAME GET ADDRESS OF NAME ARRAY. STB PTEM SAVE ADDRESS OF 1RST & 2ND CHARACTERS. INB POINT TO 2ND TWO CHARS. OF NAME ARRAY. STB PTEM+1 SAVE ADDRESS OF 3RD & 4TH CHARS. INB POINT TO LAST CHARACTER'S ADDRESS. LDA B,I GET THE WORD FROM THE NAME ARRAY. AND UBYTE ISOLATE CHAR.#5 FROM UPPER BYTE. STA PTEM+2 SAVE CHAR.#5 LOCALLY. SZA FORCE ERROR-RETURN FOR A NULL CHARACTER. LDA KEYWD GET ADDRESS OF KEYWORD TABLE. STA KEYPT SET POINTER TO TOP OF TABLE. PLOOP LDA KEYPT,I GET THE KEYWORD-TABLE ENTRY. CCE,SZA,RSS IF THIS IS THE END-OF-LIST (0), JMP ERREX THEN GO TO RETURN AN ERROR INDICATION. * ADA P12 POINT TO NAME-CHARS.1 & 2 IN I.D. SEG. LDB A,I GET CHARS. 1 & 2 FROM I.D. SEGMENT. CPB PTEM,I IF THEY ARE THE SAME AS USER'S CHARS., INA,RSS THEN PROCEED WITH COMPARISON; ELSE, JMP PNEXT GO TO GET NEXT KEYWORD ENTRY. * LDB A,I GET CHARS. 3 & 4 FROM THE I.D. SEGMENT. CPB PTEM+1,I IF THESE TWO COMPARE TO USER'S CHARS, INA,RSS THEN CONTINUE CHECKING; ELSE, JMP PNEXT GO TO GET NEXT KEYWORD ENTRY. * STA PSTAT SAVE ADDRESS TO GET STATUS--LATER. LDA A,I GET THE LAST CHAR. FROM I.D. SEGMENT. STA B SAVE THE WORD FOR SHORT I.D. TESTING. AND UBYTE ISOLATE CHARACTER #5 FROM I.D. SEG. CPA PTEM+2 IF THIS IS A FINAL MATCH, THEN JMP PFOUN GO TO GATHER DATA FOR THE RETURN. * PNEXT ISZ KEYPT POINT TO NEXT KEYWORD ENTRY. JMP PLOOP GO TO CHECK NEXT KEYWORD ENTRY. * ERREX CLA,CCE,INA SET 'IDTYP' & STA IDTYP,I TO 1--FOR ERROR-RETURN. CLA RETURN WITH & AND 'IDAD' & CLB 'ISTAT' ALL SET TO ZERO! JMP EROUT GO TO RETURN THE BAD NEWS. * PFOUN LSR 4 MOVE THE SHORT I.D. BIT TO . CLE,ERB SET TO: 0-LONG/1-SHORT ID.SEG. TYPE. CLA,SEZ IF STANDARD I.D. SEG.: =0; ELSE, INA SET =1 FOR SHORT I.D. SEGMENT. STA IDTYP,I RETURN THE I.D. SEGMENT TYPE. LDA KEYPT,I = I.D. SEGMENT ADDRESS. ISZ PSTAT POINT TO I.D. SEGMENT STATUS WORD. LDB PSTAT,I = PROGRAM'S CURRENT STATUS. EROUT STA IDAD,I RETURN DATA TO STB ISTAT,I USER'S PARAMETERS--IF ANY. IFN JMP PGMAD,I RETURN TO CALLER. XIF IFZ JSB $LIBX RETURN TO CALLER DEF PGMAD VIA PRIVILEGED PROCESSOR. XIF * A EQU 0 B EQU 1 DPTEM DEF PTEM DUMMY POINTER: PARAMETER #3. IDAD NOP ADDRESS FOR RETURN OF I.D. SEG. ADDRESS. ISTAT NOP ADDRESS FOR RETURN OF PROGRAM STATUS. IDTYP NOP ADDRESS FOR RETURN OF I.D. SEGMENT TYPE. KEYPT NOP POINTER TO CURRENT I.D. SEGMENT ADDRESS. KEYWD EQU 1657B BASE PAGE ADDRESS OF KEYWORD TABLE. P12 DEC 12 OFFSET TO I.D. SEGMENT NAME-ENTRY. PSTAT NOP TEMPORARY STORAGE. PTEM OCT 0,0,0 TEMPORARY STORAGE. REGDF DEF A DUMMY POINTER: PARAMETER #1. DEF B DUMMY POINTER: PARAMETER #2. UBYTE OCT 177400 UPPER-BYTE ISOLATION MASK. SPC 1 END ; Xa 91700-18153 1606 S 0122 DS1/B CCE MODULE: GRPM              H0101 VASMB,R,L,C HED GRPM 91700-16153 REV.A 760206 * (C) HEWLETT-PACKARD CO. 1976 NAM GRPM,1,4 91700-16153 REV.A 760206 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT GRPM EXT EXEC,#GRPM,#MNUM,#LDEF,#QRN,#SRPM,RNRQ EXT #QCLM,#CLWT,#PLOG,$TIME,#RSAX * * * GRPM * SOURCE: 91700-18153 * BINARY: 91700-16153 * PRGMR: BOB SHATZER * DATE: 06 FEB 76 * * * * GRPM IS THE GENERAL REQUEST PRE-PROCESS MODULE FOR DS-1. * IT RECEIVES INCOMING REQUESTS FROM QUEUE AND PERFORMS * VALIDITY CHECKS ON THE STREAM TYPE. IF THE INCOMING * PARMB IS A REPLY, IT IS FORWARDED TO THE STREAM TYPE * WHICH IS SPECIFIED IN PARMB WORD 2. ALL INCOMING SLAVE * REQUESTS ARE FORWARDED TO SRPM FOR DISPATCHING TO THE * PROPER MONITOR. IF THE REQUEST IS FROM SCE/1, THE * INCOMING REQUEST WORD IS PUT IN WORD 2 OF AN INTERN- * ALLY GENERATED STREAM 9 PARMB, AND THE REQUESTING LU * IS INDICATED IN WORD 25. IN THIS WAY, REQUESTS COMING INTO * THE SYSTEM FROM SCE/1 ARE REFORMATTED TO BE TREATED LIKE * ANY OTHER REQUEST. * * * ERRORS: THE FOLLOWING ERROR CONDITIONS CAN OCCUR: * * 1. BAD CLASS NUMBER FOR GRPM - REPORT CATASTROPIC ERROR * 2. ILLEGAL STREAM TYPE - SEND "ILRQ" * 3. SRPM'S CLASS IS BAD - REPORT CATASTROPHIC ERROR * * ALL ERROR PROCESSING IS DONE BY THE DISC-RESIDENT MODULE * 'QCLM'. THE NECESSARY ERROR PROCESSING INFORMATION AND THE * PARMB ARE WRITTEN INTO QCLM'S I/O CLASS. THUS, GRPM IS FREE TO * SERVICE THE NEXT INCOMING REQUEST. * SKP GRPM CLA STA QCB CLEAR QCB WHERE NEEDED STA SHEDR STA ERRAD * JSB EXEC CLASS GET TO WAIT FOR PARMB DEF *+7 DEF D21I DEF #GRPM DEF PARMB DEF D35 DEF LU DEF SCODE JSB ERR1 SLA,RSS CHECK FOR GOOD DRIVER COMPLETION JSB ERR0 NO GOOD - GIVE UP DST REGS SAVE REGISTERS ON RETURN FROM DRIVER LDA SCODE GET SELECT CODE ALF,ALF ROTATE TO UPPER BYTE FOR CHANNEL WORD IOR LU STUFF IN THE LU STA CHANL AND SAVE IT IN THE CHANNEL WORD LDA PARMB GET FIRST WORD OF REQUEST SSA,RSS IS IT AN SCE1 REQUEST? (BIT15 = 1) JMP GRP.1 NO - GO PROCESS AS NORMAL REQUEST * STA PARMB+1 STORE SCE1 REQUEST IN WORD 2 OF PARMB LDA D9 GET PROGL STREAM TYPE STA PARMB AND PUT IT INTO WORD 1 OF THE PARMB * GRP.1 ALF ROTATE 'FRIENDLY' (BIT11) TO BIT 15 SSA IS IT SET? JMP GRP.2 YES - REQUEST IS FROM FRIENDLY SATELLITE DLD $TIME REQUEST IS FROM 'OLD' BCS SATELLITE DST PARMB+33 SET UP BOGUS TIME TAG GRP.2 LDA PARMB GET FIRST WORD OF THE PARMB AND B377 ISOLATE STREAM TYPE STA STREM AND SAVE IT CMA,INA ADA #MNUM SUBTRACT FROM MAX STREAM NUMBER SSA DID IT OVERFLOW? JSB ERR2 YES - ILLEGAL STREAM TYPE LDA PARMB GET STREAM WORD OF PARMB RAL ROTATE BIT 14 TO HI BIT SSA IS IT SET? JMP REPLY YES - THIS IS A REPLY LDA STREM GET STREAM TYPE MPY D3 MULTIPLY BY 3 TO SETUP OFFSET LDB #LDEF,I GET POINTER TO STREAM HEADERS ADB A INDEX BY STREAM TYPE ADB B2 STB SHEDR AND SAVE POINTER ADB B2 BUMP POINTER TO MONITOR'S ID SEG ADDR LDA B,I GET ID SEG ADDRESS SZA,RSS IS IDSEG ADDR ZERO? JSB ERR2 YES - NO SUCH MONITOR * JSB RNRQ CHECK FOR #QRN BEING SET DEF *+4 DEF GLCN GLOBAL LOCK-CLEAR NO WAIT DEF #QRN DEF STREM JSB ERR0 GET NEXT REQUEST IF ERROR LDA STREM GET RETURNED STATUS CPA D1 IS RN CLEAR? RSS YES - GO ON JSB ERR3 NO - REJECT REQUEST JSB #CLWT WRITE PARMB TO SRPM'S CLASS DEF *+6 DEF #SRPM DEF QCB DEF D42 DEF LU DEF SCODE JSB ERR1 ERROR ON CLASS WRITE/READ JMP GRPM GO BACK TO GET * REPLY JSB #RSAX SEARCH FOR AN EXISTING CLASS IN RES DEF *+4 TO MAKE SURE REPLY ISN'T WRITTEN DEF D5 A GENERAL RTE USER WHO IS HUNG ON A DEF D1 NON-NETWORK ASSIGNED CLASS. DEF PARMB+1 SZA DOES CLASS EXIST? JSB ERR4 NO - GO BACK TO GET NEXT REQUEST JSB #CLWT WRITE TO MASTER REQUESTOR'S CLASS DEF *+6 DEF PARMB+1 DEF PARMB DEF D35 DEF ZERO DEF ZERO JSB ERR4 IGNORE THE ERROR - GO BACK TO GET * LDA #PLOG GET PARMB LOGGING FLAG SZA,RSS IS IT SET? JMP GRPM NO - GO AND GET NEXT REQUEST JSB #CLWT FLAG IS SET - WRITE QCB AND PARMB DEF *+6 TO THE PLOG MONITOR DEF #PLOG DEF QCB DEF D42 DEF XEQT DEF ZERO NOP IGNORE THE ERROR JMP GRPM GO BACK TO GET ANOTHER REQUEST * SKP * * ERROR PROCESSING SECTION * ERR0 NOP HERE TO GIVE UP AND TERMINATE DST REGS SAVE REGISTERS IN QCB CLA SET QCB CONTROL WORD TO ZERO LDB ERR0 PICK UP ORIGINATION ADDRESS JMP ERRN AND GO TO GENERAL ERROR PROCESSOR * ERR1 NOP HERE TO REPORT CATASTROPHIC ERROR DST REGS LDA BIT15 LDB ERR1 JMP ERRN * ERR2 NOP HERE TO SEND 'ILRQ' TO REMOTE DST REGS LDA B5 LDB ERR2 JMP ERRN * ERR3 NOP HERE TO SEND BUSY REPLY DST REGS LDA B2 LDB ERR3 JMP ERRN * ERR4 NOP SEND 'STOP' IF DATA PENDING. STA REGS SAVE FIRST HALF OF ERROR CODE. LDA REGS+1 GET DRIVER STATUS (EQT12). STB REGS+1 SAVE REMAINDER OF ERROR CODE FOR . ALF,ALF POSITION DATA PENDING BIT(#8) TO LSB. AND D1 ISOLATE. IF DP SET, SENDS 'STOP'. LDB ERR4 GET ORIGINATION ADDRESS. * ERRN STA QCB SAVE CONTROL WORD ADB M1 SUBTRACT 1 FROM ERROR ADDRESS STB ERRAD AND SAVE IT IN THE QCB JSB #CLWT WRITE QCB+PARMB TO QCLM DEF *+6 DEF #QCLM DEF QCB DEF D42 DEF XEQT DEF ZERO NOP ERROR RETURN JMP GRPM GO BACK TO GET * SKP * * CONSTANTS AND STORAGE * A EQU 0 B EQU 1 XEQT EQU 1717B D21I ABS 100000B+21 ZERO OCT 0 D9 DEC 9 D35 DEC 35 B377 OCT 377 STREM NOP LU NOP SCODE NOP B5 OCT 5 B2 OCT 2 BIT15 OCT 100000 M1 DEC -1 D1 DEC 1 D5 DEC 5 D3 DEC 3 GLCN OCT 140006 QCB NOP QCB - DO NOT REORDER THESE 8 LINES SHEDR NOP STREAM LIST HEADER ADDRESS NOP DUMMY PARAMETER CHANL NOP REQUESTING LU AND SELECT CODE ERRAD NOP ERROR ORIGINATION ADDRESS REGS NOP REGISTER SAVE AREA NOP PARMB BSS 35 PARMB AREA D42 DEC 42 * END GRPM _O Yb 91700-18154 1606 S 0122 DS1/B CCE MODULE: SRPM              H0101 VASMB,R,L,C HED SRPM 91700-16154 REV.A 760206 * (C) HEWLETT-PACKARD CO. 1976 NAM SRPM,17,4 91700-16154 REV.A 760206 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT SRPM EXT EXEC,#SRPM,RNRQ,#TBRN,#RSAX EXT #QCLM,#CLWT,#PLOG,#SVTO,#CDCB SUP * * * SRPM * SOURCE: 91700-18154 * BINARY: 91700-16154 * PRGMR: BOB SHATZER * DATE: 06 FEB 76 * * * * SRPM IS THE SLAVE REQUEST PRE-PROCESS MODULE FOR DS-1. * IT RECEIVES BOTH PARMB'S AND QCB HEADERS FROM GRPM AND * BUILDS A SLAVE STREAM LIST ENTRY IN RES FOR THE REQUEST. * IT THEN PRE-PROCESSES THE REQUEST AS REQUIRED BY THE * PARTICULAR DESTINATION MONITOR AND THEN SENDS THE REQUEST * TO THAT MONITOR VIA ITS I/O CLASS WITH A CLASS WRITE/ * READ. * * * ERRORS: THE FOLLOWING ERROR CONDITIONS CAN OCCUR: * * 1. SRPM'S CLASS IS BAD - REPORT CATASTROPHIC ERROR * 2. THE RES TABLE MGT RN (#TBRN) IS BAD - DITTO * 3. CANNOT BUILD A TABLE ENTRY IN RES - IGNORE REQUEST * 4. MONITOR'S CLASS IS BAD - THROW THE REQUEST AWAY * * ALL ERROR PROCESSING IS DONE BY THE DISC-RESIDENT MODULE * 'QCLM'. THE NECESSARY ERROR PROCESSING INFORMATION AND * THE PARMB IS WRITTEN INTO QCLM'S I/O CLASS. THUS, SRPM IS * FREE TO SERVICE THE NEXT INCOMING REQUEST. * SKP SRPM JSB EXEC CLASS GET TO WAIT FOR PARMB DEF *+7 DEF D21I DEF #SRPM DEF QCB DEF D42 DEF LU DEF SCODE JSB ERR1 * LDA PARMB GET FIRST WORD OF REQUEST AND B377 ISOLATE STREAM TYPE STA STRE]M AND SAVE IT ALF,ALF ROTATE TO UPPER BYTE USE WITH #RSAX ADA D2 SET IN LOWER BYTE TO INDICATE SLAVE LISTS STA ST.LS SAVE FOR #RSAX CONTROL WORD * LDA SCODE GET SELECT CODE ALF,ALF MOVE TO UPPER BYTE IOR #SVTO STUFF IN SLAVE REQUEST TIMEOUT LDB REGS+1 GET EQT12 FROM DRIVER RETURN BLF,BLF ROTATE DATA PENDING BIT TO BIT 0 SLB IS THERE A DATA PENDING CONDITION? IOR BIT14 YES - SET BIT 14 IN RSAX ENTRY WORD STA ENTRY AND STORE IN BUFFER FOR #RSAX DLD PARMB+33 GET TIME TAG FROM PARMB DST ENTRY+1 AND PUT INTO RSAX ENTRY * JSB RNRQ GLOBAL LOCK #RSAX TABLE RN DEF *+4 DEF GLW DEF #TBRN DEF MCLSN JSB ERR1 * JSB #RSAX CALL #RSAX TO BUILD LIST ENTRY DEF *+5 FOR THIS REQUEST DEF D2 DEF ST.LS DEF ZERO DEF ENTRY SSA ERROR? JSB ERR0 YES - DROP THE REQUEST AND GET THE NEXT * LDA LU GET THE SPECIFIED LU STA PARMB+24 STUFF IT INTO THE PARMB * LDA STREM GET STREAM TYPE CPA D6 IS THIS A STREAM 6 REQUEST? (RFA) RSS YES. SKIP TO GET CDCB ADDRESS. JMP GETCL NO. GO TO GET MONITOR'S CLASS. LDB CDCBA GET THE CDCB ADDRESS. RSS OBTAIN LDB B,I A RBL,CLE,SLB,ERB DIRECT JMP *-2 ADDRESS STB PARMB+22 STUFF CDCB ADDRESS INTO PARMB * GETCL LDB SHEDR GET STREAM HEADER ADDRESS INB BUMP POINTER TO MONITOR'S CLASS NUMBER LDA B,I GET CLASS NUMBER STA MCLSN SAVE MONITOR'S CLASS NUMBER * JSB #CLWT WRITE PARMB TO MONITOR'S CLASS DEF *+6 DEF MCLSN DEF PARMB DEF D35 DEF ZERO DEF ZERO JSB ERR2 ERROR RETURN * LDA #PLOG GET PARMB LOGGING FLAG SZA,RSS vZ IS IT SET? JMP SRPM NO - GO BACK TO GET ANOTHER REQUEST JSB #CLWT WRITE QCB AND PARMB TO LOGGER DEF *+6 DEF #PLOG DEF QCB DEF D42 DEF XEQT DEF ZERO JSB ERR0 IGNORE ERROR RETURN JMP SRPM ALL DONE - GET THE NEXT REQUEST * SKP * * ERROR PROCESSING SECTION * ERR0 NOP HERE TO GIVE UP AND TERMINATE DST REGS SAVE REGISTERS IN QCB CLA SET QCB CONTROL WORD TO ZERO LDB ERR0 PICK UP ORIGINATION ADDRESS JMP ERRN AND GO TO GENERAL ERROR PROCESSOR * ERR1 NOP HERE TO REPORT CATASTROPHIC ERROR DST REGS LDA BIT15 LDB ERR1 JMP ERRN * ERR2 NOP HERE TO DEALLOCATE LIST ENTRY DST REGS LDA B40 LDB ERR2 JMP ERRN * ERRN STA QCB SAVE CONTROL WORD ADB M1 SUBTRACT 1 FROM ERROR ADDRESS STB ERRAD AND SAVE IT IN THE QCB JSB #CLWT WRITE QCB+PARMB TO QCLM DEF *+6 DEF #QCLM DEF QCB DEF D42 DEF XEQT DEF ZERO NOP ERROR RETURN JMP SRPM GO GET ANOTHER REQUEST * SKP * * CONSTANTS AND STORAGE * B EQU 1 XEQT EQU 1717B BIT15 OCT 100000 D21I ABS 100000B+21 D35 DEC 35 D42 DEC 42 B377 OCT 377 STREM NOP ZERO OCT 0 D2 DEC 2 GLW OCT 40002 LU NOP SCODE NOP M1 DEC -1 CDCBA DEF #CDCB BIT14 OCT 40000 ENTRY OCT 0,0,0 MCLSN NOP D6 DEC 6 QCB NOP QCB - DO NOT REORDER THESE 8 LINES SHEDR NOP STREAM LIST HEADER ADDRESS ST.LS NOP #RSAX STREAM/LIST CONTROL WORD CHANL NOP REQUESTING LU AND SELECT CODE ERRAD NOP ERROR ORIGINATION ADDRESS REGS NOP REGISTER STORAGE AREA NOP PARMB BSS 35 PARMB AREA B40 OCT 40 * END SRPM  Zc 91700-18155 1550 S 0122 DS1/B CCE MODULE: #CDCB              H0101 6ASMB,L,R HED #CDCB 91700-16155 REV A 751209 * (C) HEWLETT-PACKARD CO. 1976 NAM #CDCB,30 91700-16155 REV A 751209 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT #CDCB * * * #CDCB * SOURCE: 91700-18155 * BINARY: 91700-16155 * PRGMR: BOB SHATZER * DATE: 09 DEC 75 * * * * #CDCB IS THE CURRENT DCB BUFFER WHICH IS USED TO PASS THE CURRENT * DCB BETWEEN RFAM AND RFAEX. * * #CDCB REP 153 NOP * END ; [a 91700-18156 1552 S 0122 DS1/B CCE MODULE: #CLWT              H0101 LASMB,R,L,C HED #CLWT 91700-16156 REV A 751226 * (C) HEWLETT-PACKARD CO. 1976 NAM #CLWT,6 91700-16156 REV.A 751226 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT #CLWT EXT $LIBR,$LIBX,.ENTP,EXEC * * * #CLWT * SOURCE: 91700-18156 * BINARY: 91700-16156 * PRGMR: BOB SHATZER * DATE: 26 SEP 75 * * * #CLWT IS A RE-ENTRANT SUBROUTINE WHICH IS USED BY QUEUE, * GRPM, AND SRPM TO HANDLE CLASS I/O WRITE-READS FROM ONE TO * ANOTHER AND TO WRITE CONTROL AND CLEAN-UP INFORMATION TO * QCUM, THE QUEUEING CLEAN-UP MODULE. * * * CALLING SEQUENCE: * * JSB #CLWT * DEF *+6 * DEF CLSNO USER-SUPPLIED CLASS NUMBER * DEF BUFAD USER-SUPPLIED BUFFER ADDR * DEF BUFLN USER-SUPPLIED BUFFER LEN * DEF PARM1 CLASS-CALL OR DUMMY PARAMETER * DEF PARM2 CLASS-CALL OR DUMMY PARAMETER * * * * TDB NOP TEMPORY DATA BLOCK HEADER DEC 8 TDB LENGTH NOP CLSNO NOP USER-SUPPLIED CLASS NUMBER BUFAD NOP USER-SUPPLIED BUFFER ADDRESS BUFLN NOP USER-SUPPLIED BUFFER LENGTH PARM1 NOP OPTIONAL CLASS-CALL PARAMETER PARM2 NOP OPTIONAL CLASS-CALL PARAMETER * #CLWT NOP PRIMARY ENTRY POINT JSB $LIBR DEF TDB JSB .ENTP CALL .ENTP TO RETREIVE PARAMETERS DEF CLSNO STA TDB+2 SAVE RETURN ADDRESS * JSB EXEC PERFORM p  CLASS WRITE/READ DEF *+8 DEF D20I DEF ZERO DEF BUFAD,I DEF BUFLN,I DEF PARM1,I DEF PARM2,I DEF CLSNO,I CLA,RSS SET =0 IF ERROR RETURN CLA,INA SET =1 FOR NO ERROR STA RTRN AND USE TO SET RETURN POINT * JSB $LIBX RETURN TO CALLER DEF TDB RTRN NOP * ZERO OCT 0 D20I ABS 100000B+20 * END J  \c 91700-18157 1601 S 0122 DS1/B CCE MODULE: QCLM              H0101 BASMB,L,R,C HED QCLM 91700-16157 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM QCLM,2,28 91700-16157 REV A 760101 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * QCLM COMMUNICATION MANAGMENT CLEANING MODULE * * SOURCE PART # 91700-18157 REV A * * REL PART # 91700-16157 REV A * * WRITTEN BY JEAN-PIERRE BAUDOUIN * * DATE WRITTEN DEC 1975 * * MODIFIED BY BOB SHATZER * * DATE MODIFIED 01 JAN 76 * *************************************************************** SPC 2 EXT EXEC,#QCLM EXT D65CL,D65SV,#RSAX EXT $LIBR,$LIBX,$CVT3,#PLOG,#QLOG IFZ EXT DBUG XIF SUP SPC 3 QCLM LDA B,I GET 1ST PARAMETER IFZ CPA D99 DO WE WANT DBUG ? RSS YES JMP START NO JSB DBUG YES, CALL IT DEF *+1 * JSB EXEC TERMINATE AND SAVE RESOURCES DEF *+4 DEF D6 DEF D0 DEF D1 XIF SPC 3 * * FIRST WE CLEAN THE BUFFER * START LDA BUFI SET THE POINTER TO 1ST WORD LDB DM42 SET THE COUNTER STB CNTR1 CLB STB A,I CLEAR A WORD INA STEP TO NEXT WORD ISZ CNTR1 DONE ? JMP *-3 NO, CONTINUE * JSB EXEC YES, HANG ON OUR CLASS DEF *+6 DEF D21I CLASS GET-NO ABORT DEF #QCLM OUR CLASS IS IN RES BUFI DEF IBUF BUFFER ADDRESS DEF D42 MAX BUFFER LENGTH (QCB+PARMB) / DEF XEQT ADDRESS OF ID SEG OF CALLER JMP QUIT ERROR RETURN * LDA #PLOG GET GENERAL PARMB LOGGING FLAG STA LOGCL SAVE IT AS PLOG CLASS JUST IN CASE SZA IS LOGGING TO BE DONE? JMP LOGIT YES - WRITE QCB AND PARMB TO PLOG LDA #QLOG GET QUEUEING LOG FLAG STA LOGCL SAVE THAT JUST IN CASE SZA,RSS IS SPECIAL LOGGING DESIRED? JMP NOLOG NO - DON'T LOG ANYTHING * LOGIT JSB EXEC FOR EITHER CASE, WRITE TO PLOG DEF *+8 DEF D20I DEF D0 DEF IBUF DEF D42 DEF XEQT DEF "QC" DEF LOGCL NOP IGNORE THE ERROR RETURN * NOLOG LDA IBUF GET QCB CONTROL WORD SZA,RSS ARE ANY BITS SET? JMP START NO - GET NEXT COMPLAINT SSA,RSS IS BIT 15 SET? (CATASTROPHIC ERROR) JMP TEST NO - GO TEST OTHER BITS * LDB XEQT WE WILL TRANSFER THE NAME OF ADB D12 THE PROGRAM WHICH CALLED US LDA B,I INTO AN INTERNAL BUFFER STA ORIGN FOR OUR MESSAGE. INB STEP TO SECOND WORD LDA B,I GET IT STA ORIGN+1 SAVE INB STEP TO LAST LDA B,I GET IT AND B174K SAVE THE UPPER BYTE IOR B72 MERGE A ":" FOR THE MESSAGE STA ORIGN+2 SAVE * * WE NOW CODE THE QCB IN ASCII (ALL OF IT IS OCTAL) * AND WE FORMAT IT IN A SECOND LINE OF MESSAGE * THIS IS TO HELP THE RECOVERY * LDA W1A GET THE ADDRESS OF THE 1ST WORD STA PNTR1 USE AS DESTINATION POINTER LDA BUFI GET ADDRESS OF QCB STA PNTR2 USE AS ORIGIN POINTER LDA DM7 SET A COUNTER STA CNTR1 * OUTLP CLE SET FOR OCTAL CONVERSION LDA PNTR2,I GET A WORD JSB $LIBR FENCE OFF NOP JSB $CVT3 CODE LDB A,I MOVE THE ASCII INTO ITS STB PNTR1,I <BUFFER. INA STEP TO SECOND WORD ISZ PNTR1 STEP THE DESTINATION POINTER DLD A,I GET LAST 2 WORDS DST PNTR1,I SAVE JSB $LIBX FENCE BACK ON DEF *+1 DEF *+1 LDA PNTR1 GET THE DESTINATION POINTER ADA D4 PUSH IT STA PNTR1 AND RESTORE IT ISZ PNTR2 STEP TO NEXT QCB WORD ISZ CNTR1 ALL DONE ? JMP OUTLP NO, CONTINUE * JSB EXEC OUTPUT THE CATASTROPHIC ERROR MESSAGE DEF *+5 DEF D2 WRITE DEF D1 CRT DEF MSG MESSAGE ADDRESS DEF MSGL MESSAGE LENGTH * JMP START GO, GET NEXT COMPLAINT SPC 3 * * IN THIS AREA WE TREAT THE NON CATASTROPHIC ERRORS * TEST LDA TBTOP GET ADDRESS OF TABLE TOP STA TPNTR SET TABLE POINTER LDA DM16 SET UP COUNTER TO CHECK LOW 14 BITS STA BTCNT OF CONTROL WORD * LOOP2 LDA IBUF GET THE CODE WORD LOOP1 ISZ TPNTR STEP TO NEXT ROUTINE ISZ BTCNT ALL BITS CHECKED? RSS NO JMP START YES - GO BACK TO GET SLA,RAR DO WE WANT IT ? RSS YES JMP LOOP1 NO * LDB TPNTR GET THE ADDRESS OF THE ROUTINE SZB,RSS IS THERE A ROUTINE ? JMP LOOP1 NO, FORGET IT INB,SZB,RSS END OF TABLE ? JMP START YES, GET NEXT COMPLAINT * STA IBUF SAVE THE CODE WORD LDB TPNTR,I GET THE ROUTINE POINTER JMP B,I GO EXECUTE THE ROUTINE SPC 3 HED QCLM: ROUTINES * (C) HEWLETT-PACKARD CO. 1976 * * HERE FOR "SEND STOP" * BIT0 CLB JSB CNTRL SEND CONTROL REQUEST JMP LOOP2 RETURN * * HERE FOR "SEND REMOTE BUSY" * BIT1 LDA PARMB GET 1ST WORD IOR BZYBT INSERT THE BUSY BIT STA PARMB REPLACE THE WORD JSB SEND SHIP THE PARMB JMP LOOP2 RETURN * * HERE FORWY "SEND ILRQ" * BIT2 LDA ILRQ SET STA PARMB+2 "ILRQ" LDA ILRQ+1 INTO THE STA PARMB+3 PARMB JSB SEND SHIP IT JMP LOOP2 RETURN * * HERE FOR "CLEAR DRIVER" * BIT3 LDB B200 SET FOR CLEAR JSB CNTRL SEND CONTROL REQUEST JMP LOOP2 RETURN * * HERE FOR "DOWN THE EQT" * BIT4 LDB B400 SET FOR DOWN EQT JSB CNTRL SEND CONTROL REQUEST JMP LOOP2 RETURN * * HERE FOR "DEALLOCATE ENTRY" * BIT5 JSB #RSAX CALL THE ENTRY MANIPULATOR DEF *+5 DEF D3 DEALLOCATE ONE ENTRY DEF IBUF+2 ST-LS POINTER DEF IBUF+4 SELECT CODE DEF PARMB+33 TIME TAGS NOP ERROR RETURN JMP LOOP2 RETURN SPC 3 * * * THIS ROUTINE WILL DO A CONTROL REQUEST ON THE LINE. * THE MODE FIELD OF THE CONTROL WORD IS PASSED IN B * REGISTER * CNTRL NOP LDA IBUF+3 GET LU WORD AND B77 MAKE SURE THE REST IS CLEAN IOR B INCLUDE THE MODE STA CNWD SAVE AS CONTROL WORD * JSB D65CL DEF *+7 DEF D3 CONTROL REQUEST DEF CNWD DEF DUMMY DEF DUMMY DEF DUMMY DEF DUMMY NOP ERROR RETURN (IGNORED) JMP CNTRL,I RETURN SPC 3 * * THIS ROUTINE WILL SEND A REPLY PARMB * SEND NOP LDA IBUF+3 GET LU AND B77 CLEAN IT STA IBUF+3 SAVE * JSB D65SV DEF *+7 DEF D2 WRITE DEF IBUF+3 REQUEST ONLY DEF PARMB BUFFER ADDRESS DEF D35 LENGTH DEF DUMMY DEF DUMMY * NOP ERROR RETURN ( IGNORED ) JMP SEND,I SPC 3 QUIT JSB EXEC GIVE UP AND TERMINATE DEF *+2 DEF D6 SPC 3 HED QCLM: DECLARATIONS * (C) HEWLETT-PACKARD CO. 1976 A EQU 0 B EQU 1 IBUF BSS 7 THESE 2 BUFFERS M UE S T STAY TOGETHER PARMB BSS 35 ** QCB + PARMB ** BZYBT OCT 20000 BUSY BIT DM42 DEC -42 DM16 DEC -16 BTCNT NOP DM7 DEC -7 D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D6 DEC 6 D12 DEC 12 D20I ABS 100000B+20 D35 DEC 35 D42 DEC 42 D99 DEC 99 D21I OCT 100025 B77 OCT 77 B200 OCT 200 B400 OCT 400 B174K OCT 177400 B72 OCT 72 CNWD NOP DUMMY NOP ILRQ ASC 2,ILRQ "QC" ASC 1,QC LOGCL NOP XEQT NOP TPNTR NOP PNTR1 NOP PNTR2 NOP CNTR1 NOP MSG OCT 6412 ASC 1, / ORIGN BSS 3 ASC 15, CATASTROPHIC NETWORK FAILURE OCT 6412 ASC 3, QCB: W1 BSS 3 ASC 2, / BSS 3 ASC 2, / BSS 3 ASC 2, / BSS 3 ASC 2, / BSS 3 ASC 2, / BSS 3 ASC 2, / BSS 3 OCT 6412 MSGL DEC 58 W1A DEF W1 SPC 3 * * TABLE FOR THE ROUTINES * TBTOP DEF * DEF BIT0 DEF BIT1 DEF BIT2 DEF BIT3 DEF BIT4 DEF BIT5 DEC -1 END OF TABLE MARK SPC 3 END QCLM + ] g 91700-18159 1603 S 0122 DS1/B CCE MODULE: SMON              H0101 OASMB,R,L,C HED SMON 91700-16159 REV.A 760111 * (C) HEWLETT PACKARD CO. 1976* NAM SMON,2,29 91700-16159 REV.A 760111 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * IS THE DISTRIBUTED SYSTEMS MONITOR WHICH PROCESSES ALL * INCOMING STREAM-0 REQUESTS. AT PRESENT, ONLY 'GETLU' SATELLITE * REQUESTS ARE CLASSIFIED UNDER THE STREAM-0 CATEGORY. WILL * TRANSFER THE RESPONDING CCE LOGICAL UNIT NO. (AS SUPPLIED BY THE * QUEUEING PROCESSOR) FROM TO , PRIOR TO * TRANSMITTING THE REPLY TO THE SATELLITE. THE REPLY LENGTH WILL * BE 35 WORDS FOR FRIENDLY SATELLITES, AND 3 WORDS FOR ALIENS. * ENT SMON EXT EXEC,D65SV * SMON LDA B,I GET THE -SUPPLIED CLASS NUMBER, STA CLASN AND SAVE IT FOR REQUEST PROCESSING. * GET JSB EXEC GO TO DEF *+5 THE RTE SYSTEM DEF CLS21 TO GET DEF CLASN THE USER'S DEF PBUF PARAMETER DEF PBLN BUFFER. JMP ERROR * REPORT THE SYSTEM-LEVEL ERROR! * * LDA PBUF GET THE STREAM WORD. IOR BIT14 INCLUDE THE REPLY BIT(#14). STA PBUF RESTORE THE STREAM WORD. LDB PBLN GET FRIENDLY REPLY LENGTH (35 WORDS). ALF POSITION FRIENDLY BIT(#11) TO SIGN. SSA,RSS IF THE REQUEST WAS FROM AN ALIEN, LDB THREE PREPARE FOR A SHORT REPLY (3 WORDS). STB RPLEN SAVE THE CONFIGURED REPLY LENGTH. * LDA PBUF+24 GET THE CCE LU NUMBER, STA PBUF+2 AND TRANSFER IT TO 2ND WORD OF REPLY. STA CONWD USE IT ALSO,   FOR CONTROL WORD. * JSB D65SV CALL THE DEF *+7 SLAVE-REPLY DEF IRWW PROCESSOR DEF CONWD TO DEF PBUF TRANSMIT DEF RPLEN THE USER'S DEF ZERO REQUESTED DEF ZERO INFORMATION. JMP ERROR * REPORT THE SYSTEM-LEVEL ERROR! * * JMP GET GO TO AWAIT THE NEXT REQUEST. * ERROR DST SMESG+4 CONFIGURE MESSAGE W/SYSTEM ERROR CODES. JSB EXEC INFORM DEF *+5 THE USER DEF WRITE OF A DEF ONE SYSTEM- DEF SMESG LEVEL DEF SMSIZ PROBLEM. * JSB EXEC TERMINATE, IN ORDER TO ALLOW DEF *+2 TO RESTORE THE DEF SIX NORMAL CONDITIONS FOR . SUP SMESG ASC 14, /SMON: XXXX ERROR-ABORTED! SMSIZ DEC 14 * B EQU 1 IRWW OCT 100002 BIT14 OCT 040000 CONWD NOP CLASN NOP RPLEN NOP CLS21 OCT 100025 ONE OCT 1 THREE OCT 3 SIX OCT 6 WRITE OCT 2 ZERO OCT 0 PBLN DEC 35 PBUF BSS 35 END SMON  ^e 91700-18160 1621 S 0122 DS1/B SAT. BOOT SCE/1             H0101 ASMB,A,B,L,C HED SCE/1 91700-16160 * (C) HEWLETT PACKARD CO. 1976 ORG 0 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ***************************************** * NAME: SCE/1 (PROTECTED BBL) * SOURCE TAPE: 91700-18160 REV 1621 * ABS TAPE: 91700-16160 REV 1621 ***************************************** * J.D. RHODES 31 MAY 1974 * MODIFIED BY CHUCK WHELAN 17 MAY 1976 * * THIS PROGRAM CONFIGURES AND INSTALLS THE SCE/1 IN THE * PROTECTED AREA OF CORE FOR 4,8,12,16,24, AND 32K CPU'S. * * OPERATING INSTRUCTIONS: * * 1. LOAD (OR DOWN-LOAD) THIS PROGRAM USING THE BBL, * SCE/1, OR SCE/2. * * 2. SET THE SWITCH REGISTER AS FOLLOWS: * * SWITCHES SET TO * """""""" """""" * * 5-0 SELECT CODE OF SERIAL INTERFACE CARD * * 14-12 0 FOR 4K CPU * 1 FOR 8K CPU * 2 FOR 12K CPU * 3 FOR 16K CPU * 5 FOR 24K CPU * 7 FOR 32K CPU * * 15 SET IF CORELOAD TO COME UP RUNNING * * ALL OTHER SWITCHES MUST BE SET TO 0. * * 3. SET P REGISTER TO 2B (STARTING ADDRESS). * * 4. PRESS 'INTERNAL PRESET', 'EXTERNAL PRESET', 'LOADER * ENABLE', AND 'RUN'. * * 5. HLT 77B (OR CORELOAD GO) INDICATES SUCCESSFUL INSTALLATION. * * HLT 22B INDICATES AN INVALID SWITCH REGISTER SETTING: * - SELECT CODE < 10B * - INVALID CPU SIZE * - EXTRANEOUS SWITCHES * * DURING DOWNLOAD THE FOLLOWING HALT0S MAY OCCUR: * 102011 - ERROR STATUS RETURNED FROM CENTRAL * 102012 - LINE PROTOCOL FAILED * 102013 - BAD LENGTH RECEIVED * A EQU 0 B EQU 1 SUP * SKP ORG 2B * JMP 3,I DEF START HLT 4B POWER FAIL HALT * ORG 100B * START CLC 0,C TURN OFF EVERYTHING LIA 1 AND B77 GET SELECT CODE STA CHN SAVE SELECT CODE AND B7 VALIDATE CPA CHN JMP HLT22 INVALID SELECT CODE LIA 1 AND C77 CHECK FOR EXTRANEOUS SWITCHES SZA JMP HLT22 BAD SWITCH SETTINGS LDB HLT77 LIA 1 SSA SKIP IF HLT 77 AT END LDB JMP2 SETUP TO RUN IMMEDIATELY STB .STRT,I CONFIGURE SCE-1 FINAL INST. AND G70 GET CPU SIZE CPA G40 JMP HLT22 20K NO GOOD CPA G60 JMP HLT22 28K NO GOOD IOR C77 FORM FWBBL STA FWBBL * LDB IOTAB DEF TO I/O TABLES STB T2 CNFG1 LDB T2,I CONFIGURE THE I/O INSTRUCTIONS SZB,RSS JMP MOVE FINISHED. LDA B,I SSA,RSS SIMPLE I/O INSTRUCTION TEST HLT 63B NOT I/O INSTRUCTION XOR CHN AND B77 XOR B,I STA B,I STORE CONFIGURED INSTRUCTION ISZ T2 JMP CNFG1 * MOVE LDB .GO MOVE1 LDA B,I STA FWBBL,I ISZ FWBBL INB CPB .ENDR FINISHED ? JMP HLT77 YES. JMP MOVE1 NO. LOOP. * HLT22 HLT 22B INVALID SWITCH SETTINGS RSS HLT77 HLT 77B INSTALLATION COMPLETED. JMP 3,I RESTART * .STRT DEF GOHLT .GO DEF GO .ENDR DEF ENDR CHN NOP T2 NOP B7 OCT 7 B77 OCT 77 G70 OCT 70000 G40 OCT 40000 G60 OCT 60000 C77 OCT 7700 FWBBL NOP JMP2 JMP 2 * IOTAB DEF *+1 DEF TO I/O TABLE DEF GO DEF GO+1 DEF GO+2 DEF X & DEF OUT+1 DEF GETWD+1 DEF GETWD+3 DEF IN+3 NOP TERMINATES TABLE * HED SCE/1 BBL CODE * (C) HEWLETT PACKARD CO. 1976 ORG 3700B SITUATE FOR TRANSPORTABILITY * SDI EQU 14B SATELLITE COMPUTER CHANNEL. * GO CLC SDI,C LIA SDI,C INITIALIZE CARD LIA SDI * LDA RC OUTPUT 1-WORD PARMB M2 JSB OUT PRECEEDED BY 3 OVERHEAD LDA MIN2 WORDS: RC, LENGTH, MODE. JSB OUT CMA,INA JSB OUT RAR,CLE,RAR SET BIT 15. MIA 1 MERGE CONTENTS OF SW REGISTER. JSB OUT * X OTA SDI RESPOND TO LAST TNW JSB IN READ FIRST WORD CPB RC REQUEST? JMP END YES (EOT). STB RL SAVE LENGTH SSB,RSS CHECK THAT LENGTH NEG. HLT 13B BAD LENGTH RECEIVED JSB IN READ START ADDRESS. STB ADDR SAVE. STB OUT INITIALIZE CHECKSUM OTB 1 FLASH ADDR IN SW REG Y JSB IN READ DATA WORD. MIN2 STB ADDR,I MOVE TO CORE ADDRESS. ISZ ADDR INCR. CORE POINTER. ADB OUT COMPUTE CHECKSUM STB OUT ISZ RL LAST DATA WORD? JMP Y NO. JSB GETWD READ CHECKSUM LDA RLW CPB OUT DOES CHECKSUM COMPARE LDA TNW YES, SEND TNW JMP X CONTINUE * OUT NOP OTA SDI OUTPUT WORD. JSB GETWD GET NEXT WORD CPB TNW TNW? JMP OUT,I YES. CPB RLW RLW? JMP *-5 YES. HLT 12B NEITHER * GETWD NOP SFS SDI NEW WORD RECEIVED? JMP *-1 NO. LIB SDI READ DATA WORD JMP GETWD,I * IN NOP JSB GETWD READ NEXT WORD LDA TNW OTA SDI ASK FOR NEXT WORD (SEND TNW) JMP IN,I RETURN. * END JSB IN THROW AWAY REQ LEN JSB IN THROW <AWAY MODE JSB IN READ PROGL STATUS WORD. SZB ERROR IF NON-ZERO HLT 11B ERROR STATUS FROM CENTRAL, HALT GOHLT NOP CONFIGURED TO "HLT 77" OR "JMP 2" * TNW OCT 170360 TRANSMIT NEXT WORD. RLW OCT 007417 RE-TRANSMIT LAST WORD. RC OCT 170017 REQUEST COMING. ADDR NOP RL NOP * ENDR BSS 0 END  _h 91700-18161 1553 S 0122 DS1/B BOOT XCHANGE: XBBDL              H0101 ASMB,A,B,L,C HED XBBDL 91700-16161 * (C) HEWLETT PACKARD CO. 1976 ORG 0 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ************************************************************** * NAME: XBBDL * SOURCE TAPE: 91700-16161 REV A * ABS TAPE: 91700-16161 REV. A * PROGRAMMER: BOB SHATZER * DATE WRITTEN: 03/12/75 * DATE MODIFIED: 29 DEC 1975 ************************************************************** * * THIS PROGRAM CONFIGURES AND INSTALLS THE BBDL IN THE * PROTECTED AREA OF CORE FOR 4,8,12,16,24, AND 32K CPU'S. * * OPERATING INSTRUCTIONS: * * 1. LOAD (OR DOWN-LOAD) THIS PROGRAM USING THE BBL, BBDL, * SCE/1, OR SCE/2. * * 2. SET THE SWITCH REGISTER AS FOLLOWS: * NOTE - A ZERO IN ANY FIELD WILL RESULT IN THE FOLLOWING * CONFIGURATION: * READER 16 * DISC 21 * SUBCHANNEL 0 * * SWITCHES SET TO * """""""" """""" * * 5-0 SELECT CODE OF PHOTOREADER * * 6-11 SELECT CODE OF DISC (LOWER) * * 14-12 1 FOR 8K CPU * 2 FOR 12K CPU * 3 FOR 16K CPU * 5 FOR 24K CPU * 7 FOR 32K CPU * * 15 SUBCHANNEL OF SYSTEM DISC * (0 FOR LOWER AND 1 FOR UPPER) * * ALL OTHER SWITCHES MUST BE SET TO 0. * * 3. SET P REGISTER TO 2B (STARTING ADDRESS). * * 4. PRESS 'INTERNAL PRESET', 'EXTERNAL PRESET', 'LOADER * ENABLE', AND 'RUN'. * * , 5. HLT 77B INDICATES SUCCESSFUL INSTALLATION. * * HLT 22B INDICATES AN INVALID SWITCH REGISTER SETTING: * - INVALID CPU SIZE * - EXTRANEOUS SWITCHES * SKP B EQU 1 * ORG 2B * JMP 3,I DEF START HLT 4B POWER FAIL HALT * ORG 100B * START CLC 0,C TURN OFF EVERYTHING LIA 1 GET SWITCH REGISTER AND B77 GET SELECT CODE OF READER SZA,RSS IS SELECT CODE ZERO? LDA B16 YES - SET IT TO 16 STA PCHAN AND SAVE IT LIA 1 GET SWITCH REGISTER AGAIN ELA,RAL ROTATE BIT 15 TO E ALF,ALF AND BITS 6-11 TO LOW WORD AND B77 ISOLATE SELECT CODE SZA IS DISC SELECT CODE ZERO? JMP *+3 NO LDA B21 YES - SET IT TO 21 CLE AND SET DISC SUBCHANNEL TO 0 STA DCHAN AND SAVE IT AS DISC SELECT CODE CLA,CME CHANGE DISC SUBCHANNEL BIT FOR HDWE ELA,RAL AND ROTATE IT INTO POSITION ALF,ALF IOR G30 INCL OR WITH SEEK WORD VALUE STA SEEKA,I AND SAVE IT LIA 1 AND G70 GET CPU SIZE CPA G40 JMP HLT22 20K NO GOOD CPA G60 JMP HLT22 28K NO GOOD SZA,RSS IS MEM SIZE 0? LDA G70 YES - SET IT TO 32K IOR C77 FORM FWBBL STA FWBBL CMA,INA NEGATE FOR MEM-PROTECT CONSTANT STA .MS,I * LDB IOTBP GET DEF TO READER I/O TABLE LDA PCHAN AND READER SELECT CODE JSB CONFG CONFIGURE READER I/O LDB IOTBD GET DISC DATA CHANNEL I/O TABLE LDA DCHAN AND ITS SELECT CODE JSB CONFG GO CONFIGURE THAT LDB IOTBC GET COMMAND CHANNEL I/O TABLE LDA DCHAN GET DATA CHANNEL S/C INA BUMP IT TO GET COMMAND CHANNEL JSB CONFG GO CONFIGURE THAT TOO * LDB .GO MOVE1 LDA B,I  STA FWBBL,I ISZ FWBBL INB CPB .ENDR FINISHED ? JMP HLT77 YES. JMP MOVE1 NO. LOOP. * HLT22 HLT 22B INVALID SWITCH SETTINGS RSS HLT77 HLT 77B INSTALLATION COMPLETED. JMP 3,I RESTART * CONFG NOP I/O CONFIGURATION ROUTINE STB T2 STA CHAN CNFG1 LDB T2,I CONFIGURE THE I/O INSTRUCTIONS SZB,RSS JMP CONFG,I FINISHED. LDA B,I SSA,RSS SIMPLE I/O INSTRUCTION TEST HLT 63B NOT I/O INSTRUCTION XOR CHAN AND B77 XOR B,I STA B,I STORE CONFIGURED INSTRUCTION ISZ T2 JMP CNFG1 * .GO DEF LOAD .ENDR DEF ENDR .MS DEF MAXAD PCHAN NOP DCHAN NOP CHAN NOP T2 NOP B16 OCT 16 B21 OCT 21 B77 OCT 77 G70 OCT 70000 G30 OCT 30000 G40 OCT 40000 G60 OCT 60000 C77 OCT 7700 FWBBL NOP SEEKA DEF SEEKC * IOTBP DEF *+1 PHOTOREADER I/O TABLE DEF RDCH+2 DEF RDCH+3 DEF RDCH+5 NOP TERMINATES TABLE * IOTBD DEF *+1 DISC DATA CHANNEL I/O TABLE DEF D.1 DEF D.2 DEF D.3 DEF D.4 DEF DMACW NOP * IOTBC DEF *+1 DISC COMMAND CHANNEL I/O TABLE DEF C.1 DEF C.2 DEF C.3 DEF C.4 DEF C.5 DEF C.6 DEF C.7 NOP * HED BBDL CODE * (C) HEWLETT PACKARD CO. 1976 ORG 3700B SITUATE FOR TRANSPORTABILITY * RDR EQU 16B * LOAD CLA,RSS EOBLK LDA EOTC TRAILER LENGTH LEADR CLC 0,C LEAVE CLEAN ON EXIT CCE,INA,SZA,RSS HLT 77B END OF TAPE JSB RDCH READ A CHAR CMB,CCE,INB,SZB,RSS IS IT WORD COUNT? JMP LEADR NO STB COUNT SAVE WDCOUNT JSB RDCH THROW AWAY ONE FRAME JSB RDCH READ START ADDRESS STB 0 INITIALIZE CKSUM LOOP STB ADDR SET POINTER ADB MAXAD VALIDATE LOAD ADDRESS SEZ,CLE "J LOADER CLOBBERED? ADDR2 HLT 55B YES TELL USER JSB RDCH FETCH DATA WORD EOTC STB ADDR,I PLANT WORD IN CORE ADA 1 TALLY CKSUM LDB ADDR CLE,INB ISZ COUNT END OF BLOCK JMP LOOP NOT YEST JSB RDCH READ CKSUM CPB 0 VALID? JMP EOBLK YES ADDR1 HLT 11B NO-CKSUM ERROR COUNT NOP MAXAD NOP RDCH NOP READ FRAME(2 IF E IS CLEAR) CLB STC RDR,C START READER SFS RDR MSK1 JMP *-1 USED BY DISC BOOT MIB RDR,C SEZ,CME READ ANOTHER CHAR? JMP RDCH,I NO,EXIT WITH E CLEAR BLF,BLF SET FOR SECOND CHAR JMP RDCH+2 * ADDR NOP DC EQU 21B CC EQU DC+1 * SEEKC OCT 30000 SUBCHAN=1 (OCT 31000=SUBCHAN 0) LDB MSK1 C.1 OTB CC ISSUE READ COMMAND C.2 STC CC,C START READ TO CLEAR 1ST STATUS LDA SEEKC D.1 OTA DC ISSUE CYLINDER ADDRESS (0) D.2 STC DC,C TELL CTRL CYL ADDRESS LOADED C.3 OTA CC ABORT READ,SEND SEEK COMMAND C.4 STC CC,C START SEEK LDA DMACW OTA SIX ISSUE DMA CONTROL WD LDA ADDR1 OTA TWO ISSUE START CORE ADDRESS(2011B) D.3 STC DC,C TELL CNTL HEAD/SECT LOADED STC TWO SET FOR WORD COUNT OTA TWO ISSUE WD COUNT (HUGE) C.5 OTB CC ISSUE READ COMMAND D.4 STC DC,C PREVENT SPURIOUS DMA XFER STC SIX,C START DMA C.6 STC CC,C START DISK READ C.7 SFS CC WAIT FOR DISC XFER (6144 WDS) JMP *-1 JSB ADDR2,I DONE-JMP INTO CODE (2055B,I) * DMACW ABS 120000B+DC ENDR BSS 0 * TWO EQU 2 SIX EQU 6 * END Zf `i 91700-18162 1621 S 0122 DS1/B SAT. BOOT SCE/2             H0101 ASMB,A,B,L,C HED SCE2 91700-16162 REV A 760315 * (C) HEWLETT-PACKARD CO. 1976 ORG 0 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************* * *SCE2 SCE2 * *SOURCE PART # 91700-18162 REV 1621 * *ABS PART # 91700-16162 REV 1621 * *WRITTEN BY: JIM HARTSEL * *DATE WRITTEN: * *MODIFIED BY: CHUCK WHELAN * *DATE MODIFIED: 05-17-76 * **************************************************** SUP * ************************************ * * * SCE/2 TERMINAL EXECUTIVE * * INDIRECT ENTRY POINT * * * ************************************ * * * ORG 2 JMP 3,I * B EQU 1 SDI EQU 14B REMOTE COMPUTER CHANNEL. TTY EQU 15B LOCAL TTY CHANNEL. * ************************************ * * * TEMPORARY BASE PAGE LINKAGES * * * ************************************ * ORG 100B THIS BASE PAGE AREA NOT USED JMP *+1,I BY TCE/2. DEF CNFIG RE-CONFIGURATION ENTRY POINT. * ******************************************** * * * OVERLAYABLE RECONFIGURATION SECTION * * S-REGISTER SETTING: * * BITS 0- 5 = REMOTE COMPUTER CHANNEL * * BITS 6-11 = TTY CHANNEL * * BITS 12-14= CORE SIZE (VALUE+1 * 4K) * * * ******************************************** * ORG 6440B * ERR HLT 13B INCASE OF ERROR CNFIG LIA 1 READ SWITCH REGISTER. AND O77 SZA,RSS JMP ERR STA RCH STORE REMOTE COMPUTER CHANNEL. LIA 1 ALF,ALF RAL,RAL AND O77 SZA,RSS JMP ERR STA TCH STORE TTY CHANNEL. * SET CONFIGURED INSTRUCTIONS FOR CORE SIZE LIA 1 AND P7000 ISOLATE BITS 12-14 STA TEMP LDA NCAD STA PNTR SAVE POINTER TO CONFIGURABLE "DEF"S LDB NCON NUMBER TO CONFIGURE LDA PNTR,I IOR TEMP INCLUDE HIGH ADDRESS BITS STA PNTR,I ISZ PNTR INB,SZB JMP *-5 ITERATE * LDA RCH LDB RTBL CONFIGURE REMOTE I/O INSTRUCTIONS. JSB CONFG LDA TCH LDB TTBL CONFIGURE TTY INSTRUCTIONS. JSB CONFG * LDB PSIZ - PGM SIZE LDA QUERA STA PNTR IOR TEMP STA LOC POINTER TO HIGH CORE FOR MOVE STA 3 STARTING ADDR INTO LOC.3 LDA PNTR,I STA LOC,I MOVE INTO HIGHER CORE ISZ PNTR ISZ LOC INB,SZB JMP *-5 MOVE NEXT JMP 3,I NOW GO TO SCE-2 * * CONFG NOP STA CHANL STB PNTR CNFL LDB PNTR,I FETCH NEXT I/O INSTR. ADDRESS. SZB,RSS DONE IF ZERO. JMP CONFG,I LDA B,I FETCH I/O INSTRUCTION. AND MASK CLEAR CHANNEL. IOR CHANL INSERT NEW CHANNEL. STA B,I REPLACE I/O INSTRUCTION. ISZ PNTR JMP CNFL LOOP TILL DONE. * RCH NOP TCH NOP CHANL NOP PNTR NOP MASK OCT 177700 O77 OCT 77 P7000 OCT 70000 NCAD DEF INIT NCON ABS INIT-SIZE # OF RECONFIGURED DEFS QUERA DEF QUERY PSIZ ABS QUERY-SIZE SIZE OF SCE-2 MAIN AREA * RTBL DEF *+1 TABLE OF ADDRESSES OF I/O DEF INIT1 INSTR. FOR REMOTE COMPUTER. DEF RCH1 DEF RCH2 DEF RCH3  DEF RCH4 DEF RCH5 DEF RCH6 DEF RCH7 DEF RCH8 DEF RCH9 DEF RCH10 NOP END OF TABLE. * TTBL DEF *+1 TABLE OF I/O INSTRUCTIONS DEF TCH1 FOR TTY. DEF TCH2 DEF TCH3 DEF TCH4 DEF TCH5 DEF TCH6 DEF TCH7 DEF TCH8 NOP END OF TABLE. * ORG 6600B ************************************ * * * MAIN ENTRY POINT * * * ************************************ * * QUERY CLA,INA DISPLAY ":" PROMPT. JSB TTYO OCT 35137 * LDA BFSIZ INPUT THE COMMAND. LDB BUFAD JSB TTYIN * JMP TMESS GO PROCESS THE COMMAND. * * M0950 LDA B6 DISPLAY "SYNTAX ERROR". JSB TTYO ASC 6,SYNTAX ERROR JMP QUERY SKP ******************************** * DECIPHER OPERATOR MESSAGES. ********************** ******************************** * * B CONTAINS # CHARACTERS. * DATA IN BUFFR. * TMESS CLA STA TEMP+2 CLEAR CHARACTER FLAG. CMB,INB,SZB,RSS CHECK IF COUNT ZERO. JMP QUERY YES STB TEMP+3 NEGATIVE CHAR. COUNT. * LDB MD33 CLEAR PARAMETER AREA. STB TEMP LDB PARPT STA B,I INB ISZ TEMP JMP *-3 * LDB BUFAD INPUT BUFFER CLE,ELB BYTE ADDRESS. STB TEMPP LDA INIT STA TEMP+5 INITIAL PARAM POINTER. LDA TEMP+5,I STA TEMP+4 INITIAL STORE POINTER. ADA MD1 STA TEMP+6 PARAM CHAR COUNT ADDR. * DEC10 LDB TEMPP FETCH NEXT BYTE. CLE,ERB LDA B,I SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER. ALF,ALF UPPER, SO ROTATE. AND M377 ISOLATE CHARACTER. * CPA COM CHECK FOR JMP DEC60 COMMA OR CPA BLNK BLANK JMP DEC65 ,DELIMITER. * LDB TEMP+6,I ADD -1 TO CHAR COUNT. ADB MD1 STB TEMP+6,I * LDB TEMP+2 CHECK IF TO BE UPPER/LOWER. SZB UPPER. JMP DEC40 LOWER. * ALF,ALF STA TEMP+4,I STORE CHARACTER. ISZ TEMP+2 SET FLAG TO LOWER CHARACTER. JMP DEC50 GO INCREMENT DATA CHAR. * DEC40 IOR TEMP+4,I COMBINE UPPER & LOWER. STA TEMP+4,I STORE. CLA STA TEMP+2 RESET FLAG TO UPPER CHAR. ISZ TEMP+4 BUMP STORE LOCATION. * DEC50 ISZ TEMPP BUMP BUFFER ADDR. ISZ TEMP+3 BUMP CHAR. COUNT. JMP DEC10 GO PROCESS NEXT CHAR. ISZ PARAM DONE- BUMP PARAM COUNT. JMP M0000 GO TO EXIT. * DEC65 LDA PARAM FIRST PARAM? SZA JMP DEC50 NO, IGNORE BLANKS DEC60 CLA STA TEMP+2 CLEAR CHAR. FLAG. * ISZ TEMP+5 BUMP PARAM POINTER. ISZ PARAM BUMP PARAM COUNT. LDA PARAM CPA B10 EIGHT PARAMS? JMP M0000 YES, GO PROCESS. * LDA TEMP+5,I STA TEMP+4 ADA MD1 STA TEMP+6 PARAM CHAR COUNT ADDR. JMP DEC50 GO INCREMENT DATA BUFFER. SKP * * IDENTIFY THE COMMAND (LOAD OR RUN). * M0000 LDA OP ADD UP THE THREE WORDS. ADA OP+1 ADA OP+2 * CPA SM.LO = SUM OF "LOAD"? JMP M0100 YES. CPA SM.RU = SUM OF "RUN"? JMP M0200 YES. CPA SM.RA = SUM OF "RUNAT"? JMP GETAD YES. JMP M0950 NO, SYNTAX ERROR. * A.LO EQU 046117B "LO" A.AD EQU 040504B "AD" A.RU EQU 051125B "RU" A.N EQU 047000B "N0" A.NA EQU 047101B "NA" A.T EQU 052000B "T0" * SM.LO ABS A.LO+A.AD SM.RU ABS A.RU+A.N SM.RA ABS A.RU+A.NA+A.T * * * LOAD XXXXX * LOAD INTO THE TERMINAL THE PROGRAM XXXXX WHICH * RESIDES ON THE CENTRAL STATION DISC. * M0100 LDA CP1 IS THERE A NAME? SZA,RSS JMP M0950 NO. * FILL TRAILLING BLANKS, SCHEDULE PROGL, & DOWNLOAD JSB LODIT JMP QUERY RETURN TO OPERATOR. SKP * * RUN(*,P1,P2,P3,P4,P5) * * RUNAT NNN (,P1,P2,P3,P4,P5) * * RUN XXXXX (,P1,P2,P3,P4,P5) * * P1...P5 = OPTIONAL PARAMETERS. * NNN = START ADDRESS. * XXXXX = PROGRAM NAME. * M0200 LDA CP1 IS 1ST PARAM NULL OR "*"? LDB P1 SZA CPB ASTER JMP MOVIT YES. * * FILL TRAILING BLANKS, SCHEDULE PROGL, & DOWNLOAD JSB LODIT JMP MOVIT RUN. * GETAD LDA CP1 IS THERE A START ADDR? SZA,RSS JMP M0950 NO, ERROR. LDB P1AD JSB CVT1 CONVERT START ADDRESS. STA IADR * * CONVERT OPTIONAL PARAMETERS TO BINARY AND STORE. * MOVIT LDA P2AD STA DCVTA ADDR OF DATA BUFFER. ADA MD1 STA DCVTB ADDR OF CHAR COUNT. * LDA DO.P1 STA TEMP+4 DESTINATION ADDR. LDA MD5 STA TEMP+5 COUNTER * TRANS LDA DCVTB,I CHAR. COUNT. SZA,RSS ZERO? JMP STORE YES, STORE ZERO. * LDB DCVTA JSB CVT1 CONVERT TO BINARY. * STORE STA TEMP+4,I STORE VALUE. ISZ TEMP+4 LDA DCVTA ADA B4 STA DCVTA LDA DCVTB ADA B4 STA DCVTB * ISZ TEMP+5 DONE? JMP TRANS NO. * LDB DO.P1 (B) = ADDR OF 1ST PARAM. CLC 0,C "PRESET" LDA IADR IS THERE A START ADDR? SZA JMP IADR,I YES, USE IT. LDA B6 JSB TTYO TYPE MESSAGE ASC 6,NO START ADR JMP QUERY * * DCVTA NOP DCVTB NOP O.P1 OCT 0 O.P2 OCT 0 O.P3 OCT 0 O.P4 OCT 0 O.P5 OCT 0 SKP * SCHEDULE PROGL AT REMOTE AND PASS LU, PROGRAM NAME. * THEN LOAD THE PROGRAM INTO TERMINAL CORE. * CALLING * SEQUENCE: (B) = ADDR OF ASCII PROGRAM NAME. * JSB LODIT * LODIT NOP LDA P1AD STA TEMP LDA MD3 STA TEMP+1 TLOOP LDB BLQNKW FILL TRAILING BLANKS LDA TEMP,I SZA LDB BLNK AND M377 SZA JMP *+3 ADB TEMP,I STB TEMP,I ISZ TEMP ISZ TEMP+1 JMP TLOOP * * NOW SEND THE DOWNLOAD REQUEST TO PROGL * JSB LSTN SET CARD IN LISTEN MODE LDB RC JSB OUT SEND "REQUEST COMING" JMP *-2 RETRY LDB MD6 -LENGTH-1 JSB OUT SEND IT JMP *-2 RETRY LDB B2 GET MODE WORD (2) JSB OUT SEND IT JMP *-2 RETRY RCH10 CLC SDI TURN CARD TO TRANMITTER LDB MD3 INB,SZB DELAY A WHILE JMP *-1 LDB K9 JSB OUT1 SEND STREAM CLB JSB OUT1 2ND WORD = 0 LDB P1 JSB OUT1 SEND 1ST 2 CHARS OF NAME LDB P1+1 JSB OUT1 SEND 3RD & 4TH CHARS OF NAME JSB LSTN SET CARD BACK TO LISTEN MODE LDB P1+2 JSB OUT SEND LAST WORD (FINAL NAME CHARS) JMP RCH10 ERROR IN TRANSMISSION, TRY AGAIN LDB TNW JSB OUT1 SEND REPLY TO COMPLETE REQUEST * CLA,CLE CLEAR LOCATION 3. STA ERFLG INITIALIZE ERROR INDICATOR STA 3 * READ-IN PROGL DOWNLOAD DATA RECORD LOAD1 JSB IN READ 1ST WORD OF DATA CPB RC IS IT EOT (RC) JMP END YES (EOT). STB RL SAVE NEGATIVE RECORD LENGTH ADB K100 SEZ,RSS DOES -99 < LEN < 0? ISZ ERFLG NO, FLAG ERROR JSB IN READ STARTING ADDRESS STB ADDR AND SAVE. STB CKSUM INITIALIZE CHECKSUM * DATA JSB IN READ DATA WORD. LDA ERFLG SZA,RSS SKIP IF ANY ERRORS OCCURRED STB ADDR,I STORE DATA WORD. ADB CKSUM STB CKSUM UPDATED RUNNING CHECKSUM LDB ADDR GET ADDRESS FOR SWR OTB 1 OUTPUT SOMETHING ISZ ADDR ISZ RL LAST DATA WORD? JMP DATA  NO. * JSB IN YES, READ CHECKSUM. LDA ERFLG ERROR FLAG CPB CKSUM CKSUM OK? CLE,SZA YES, ANY OTHER ERRORS? JMP ERRX FAILED, ERROR RETURN JMP LOAD1 ALL OK, DO NEXT RECORD * END JSB IN JSB IN JSB IN GET STATUS WORD. LDA ERFLG SZA SKIP IF NO ERRORS LDB B2 SET ERROR CODE. JMP CLNUP * IN NOP CLA RCH3 SFS SDI WORD RECEIVED? JMP *-1 NO. RCH4 LIB SDI READ DATA WORD. RCH5 LIA SDI,C READ STATUS WORD. SSA PARITY ERROR? ISZ ERFLG YES, SET ERROR FLAG. LDA TNW RCH6 OTA SDI OUTPUT "XMIT NEXT WORD". JMP IN,I * OUT NOP TRANSMIT A WORD. JSB OUT1 GO TRANSMIT FOR CARD...WAIT FOR READY RCH9 LIA SDI CPA RLW JMP OUT,I ERROR RETURN..TRY AGAIN ISZ OUT SET FOR NORMAL RETURN CPA TNW JMP OUT,I DO NORMAL RETURN ERRX LDB B2 UNKNOWN RETURN..ERROR * CLNUP SZB ANY ERRORS? JMP ERRFD YES, GO PROCESS. LDA 3 SET DEFAULT STA IADR START ADDRESS. JMP LODIT,I RETURN. * ERRFD LDA B6 CPB B2 JMP ERR2 COM LINE ERROR. CPB MD1 JMP ERR4 CAN'T LOCATE. JSB TTYO TYPE MESSAGE ASC 6,PROGL ERROR JMP QUERY * ERR2 JSB TTYO ASC 6,COM LINE ERR JMP QUERY * ERR4 JSB TTYO ASC 6,CAN'T LOCATE JMP QUERY * * SUBROUTINE TO SET THE CARD IN LISTEN MODE * LSTN NOP INIT1 CLC SDI,C LISTEN..INHIBIT INTERUPTS RCH1 LIA SDI,C READ STATUS RCH2 LIA SDI READ WORD...CLEARS CARD JMP LSTN,I RETURN * * *SUBROUTINE TO OUTPUT A WORD THE CARD AND WAIT *UNTIL CARD IS READY TO CONTINUE * OUT1 NOP RCH7 OTB SDI SEND WORD RCH8 SFS SDI WAIT JMP *-1 JMP OUT1,I RETURN...WHEN CARD READY SK&P * * KEYBOARD INPUT DRIVER. * (A) = RECORD SIZE, WORDS. * (B) = BUFFER ADDRESS. * JSB TTYIN * ON RETURN, (B) = # CHAR. INPUT. SPC 3 TTYIN NOP ENTRY. RAL,CLE STORE # CHAR. STA RSIZE CLA STA RL CLEAR CHAR. COUNTER. STB ADDR STORE BUFFER POINTER. * CLC 0,C TURN OFF INTERRUPTS. TYIN JSB TYI READ A CHARACTER. AND M177 CPA LF LINE FEED? JMP TYIN YES, IGNORE. CPA CR CARRIAGE RETURN? JMP EOI YES, ALL DONE. CPA RBOUT RUBOUT? JMP CANCL YES. CPA CONTH BACKSPACE CHAR? JMP BAKUP YES. CPA BKSPC BACKSPACE KEY? JMP BAK * LDB RL BUFFER FULL? CPB RSIZE JMP TTYIN,I YES, IGNORE CHAR. ISZ RL SEZ,CME INSERT CHAR IN BUFFER JMP RIGHT ALF,ALF STA ADDR,I JMP TYIN RIGHT IOR ADDR,I STA ADDR,I ISZ ADDR JMP TYIN * EOI LDA LF OUTPUT LINE FEED. JSB TYO LDB RL SET (B) = CHAR. COUNT. JMP TTYIN,I RETURN. * CANCL LDA BSLSH OUTPUT BACKSLASH. JSB TYO LDA CR OUTPUT CARRIAGE RETURN. JSB TYO LDA LF OUTPUT LF. JSB TYO JMP QUERY RE-PROMPT THE OPERATOR. * BAKUP LDA BKARW OUTPUT BACK ARROW. JSB TYO BAK LDA RL DECREMENT CHAR. COUNT. ADA MD1 STA RL LDB ADDR ADJUST BUFFER POINTER. CME,SLA FLIP E. ADB MD1 STB ADDR LDA B,I SEZ AND MASKU CLEAR RIGHT CHAR. STA B,I JMP TYIN GO INPUT NEXT CHAR. * TYI NOP LDA DA ECHO INPUT. TCH1 OTA TTY TCH2 STC TTY,C INPUT A CHARACTER. TCH3 SFS TTY JMP *-1 TCH4 LIA TTY JMP TYI,I RETURN SPC 3 * * DISPLAY DEVICE OUTPUT DRIVER. * (A) = # WORDS.Qe * JSB TTYO * (BUFFER) SPC 3 TTYO NOP ENTRY. RAL FORM NO. OF CHARS CMA,CLE,INA NEGATE COUNT STA RL * TO LDA TTYO,I PICK UP NEXT BUFFER WORD. SEZ,CME LEFT CHAR? ISZ TTYO NO, BUMP BUFFER POINTER. SEZ LEFT CHAR? ALF,ALF YES, RIGHT JUSTIFY. AND M377 MASK CHAR. CPA BKARW IS IT A BACKARROW? JMP TTYEX YES, RETURN. JSB TYO OUTPUT THE CHARACTER ISZ RL BUMP COUNT JMP TO ITERATE * LDA CR JSB TYO DO CARRAIGE RETURN LDA LF OUTPUT LINE FEED. JSB TYO TTYEX SEZ ON LHW? ISZ TTYO YES, BUMP POINTER TO RETURN ADDR JMP TTYO,I RETURN. * TYO NOP OUTPUT A CHARACTER. LDB LOUT PRINT OUTPUT. TCH5 OTB TTY TCH6 OTA TTY TCH7 STC TTY,C TCH8 SFS TTY JMP *-1 JMP TYO,I * * CR OCT 15 CARRIAGE RETURN. LF OCT 12 LINE FEED. BKSPC OCT 31 BACKSPACE KEY. BSLSH OCT 134 BACKSLASH. BKARW OCT 137 BACKARROW. DA OCT 160000 ECHO INPUT. LOUT OCT 120000 PRINT OUTPUT. RSIZE NOP SKP * * ASCII TO BINARY CONVERSION ROUTINE. * * CALLING SEQUENCE: * * A= CHARACTER COUNT * B= DATA BUFFER ADDRESS * JSB CVT1 * * IF THE DATA BUFFER BEGINS WITH AN "@" SIGN, * THE DATA IS TAKEN TO BE OCTAL, ELSE DECIMAL. * * ON RETURN, (A) = CONVERTED VALUE * CVT1 NOP ENTRY. STA TMP+1 SAVE CHAR COUNT CLA STA TMP CLEAR ACCUMULATING VALUE. CLE,ELB STB TEMP+2 STORE CHAR. ADDR. RBR IS FIRST CHAR = @? LDA B,I AND MSK14 STA TEMP+3 (ZERO IF OCTAL NUMBER). SZA JMP CV015 NO. LDA B,I YES, CHANGE TO ASCII ZERO. AND M377 IOR UPR60 STA B,I * CV015 LDA TMP ALBF,RAR LDB TEMP+3 OCTAL NUMBER; SZB,RSS JMP CV018 YES ADA TMP ADA TMP TMP=10*TMP CV018 STA TMP STORE MULTIPLIED VALUE. LDB TEMP+2 GET CHAR ADDR. CLE,ERB LDA B,I GET DATA VALUE. SEZ,RSS IF E SET, THEN LOWER CHAR. ALF,ALF UPPER, SO ROTATE. AND M377 * ADA MD48 CHECK IF LEGAL DATA CHAR. STA TMP+2 SSA JMP M0950 ERROR IN SYNTAX. ADA MD8 LDB TEMP+3 OCTAL NUMBER? SZB ADA MD2 NO. SSA,RSS JMP M0950 ERROR. * LDA TMP+2 LDB TEMP+3 SZB,RSS AND B7 ADA TMP ADD TO ACCUMULATED STA TMP VALUE AND STORE. ISZ TEMP+2 INCR CHAR ADDR. ISZ TMP+1 INCR CHAR COUNT. JMP CV015 GO PROCESS NEXT CHAR. * LDA TMP LOAD CONVERTED VALUE. JMP CVT1,I RETURN. SKP B2 OCT 2 B4 OCT 4 B6 OCT 6 B7 OCT 7 B10 OCT 10 CONTH EQU B10 K9 DEC 9 K100 DEC 100 MD1 DEC -1 MD2 DEC -2 MD3 DEC -3 MD5 DEC -5 MD6 DEC -6 MD8 DEC -8 MD33 DEC -33 MD48 DEC -48 M177 OCT 177 RBOUT EQU M177 M377 OCT 377 COM OCT 54 BLNK OCT 40 BLNKW ASC 1, ASTER OCT 25000 UPR60 OCT 30000 MSK14 OCT 137400 MASKU OCT 177400 IADR NOP RL OCT 0 ADDR OCT 0 TNW OCT 170360 RLW OCT 007417 RC OCT 170017 "REQUEST COMING" LOC NOP ERFLG NOP CKSUM NOP TMP BSS 3 * TEMPP OCT 0 TEMP BSS 7 TEMPORARY STORAGE. BFSIZ DEC 18 BUFFR BSS 18 OPER I/O MESSAGE BUFFER. * * PARAM NOP PARAMETER COUNTER. OP1 NOP CHAR. COUNT - COMMAND MNEMONIC. OP BSS 3 MNEMONIC. CP1 NOP CHAR. COUNT-PARAM 1. P1 BSS 3 PARAM 1 (UP TO 3 WORDS). CP2 NOP ETC. P2 BSS 3 CP3 NOP P3 BSS 3 CP4 NOP P4 BSS 3 CP5 NOP P5 BSS 3 CP6 NOP P6 BSS 3 CP7 NOP pB@ PRESET LIMIT (=8)? CPA YDSA? JMP LNRC3 YES,HAVE NO CHOICE BUT TO SET PARITY! LDB DBBIT JSB STAT SET DRIVER BUSY LDA RSS MODIFY DRIVER INITIATOR SECTION FOR RE-TRY. STA EXIT0 STA EXIT2 JSB SSTOP LDB SSTPI BUT 1ST,STOP ALL KNOWN TRANSMISSIONS! JMP CEXT1 EXIT0 NOP ENTERED HERE FROM D.65 INITIATOR. JMP D.65,I NORMALLY THIS CODE EXECUTED!!!! CLA STA EXIT0 HERE ONLY IF PARITY OCCURED. STA CMD JMP OTA1+1 YDSA? DEC 8 CKFLG NOP RSS RSS * SKP * * HERE FOR LENGTH WORD COMING INTERRUPT * ILNC JSB CCHCK CHECK FOR PARITY ERROR OR STOP INA SET FOR CORRECT NEGITIVE COUNT ADA RBUFL GREATER THAN MAX? SSA JMP LNRC4 YES...ERROR LDA TEMP2 GET LENGTH AGAIN CMA MAKE COUNT POSITIVE STA RBUFL STA EQTW3,I SAVE LENGTH JSB STNW TELL OTHER SIDE TO CONTINUE JSB CEXT2 DO CONTINUATION EXIT * SKP * * HERE ON A MODE WORD COMING INTERRUPT * JSB CCHCK CHECK FOR STOP AND PARITY RAL,CLE,ERA STA OMODE SAVE OTHER SIDES MODE CLA,SEZ REQUEST AND DATA? CCA YES STA WAITF SET OR CLEAR DATA FLAG IMOD9 JSB ITRAN SET UP INCASE OF INTERRUPT TRANSFER kv LDA OMODE GET OTHER SIDES MODE SZA,RSS DMA SPECIAL? JSB GTDMA NO...DMA OPEN...SEE IF WE GOT DMA LDA RBUFL GET REQUEST BUFFER LENGTH SZA,RSS ZERO LENGTH REQUEST JMP ERQ1 YES...GO DO COMPLETION LDA PARCT GET PARITY COUNT CPA YDSA? MAX NUMBER OF TIMES? JMP LNRC3 YES...PARITY ERROR JSB DMA YES...TURN IT ON LDA PARCT GET PARITY COUNT ISZ PARCT INCREMENT PARITY COUNT SZA FIRST TIME? JMP ILNC3 NO LDA OMODE GET OTHER MODE SZA IS OTHER MODE DMA? JMP ILNC2 NO LDA DMAF DO WE HAVE DMA? SZA JMP ILNC4 YES ISZ OMODE SET OTHER MODE NON ZERO JMP ILNC2 SET FOR NON DMA TRANSFER ILNC4 LDA GDMAW GET WE HAVE DMA WORD JSB OUTPA SEND IT RSS ILNC2 JSB STNW YES...TELL THEM TO CONTINUE RSS ILNC3 JSB SRLW NO LDB IRTNS INTERRUPT DATA TRANSFER? LDA OMODE GET OTHER SIDE MODE SZA DMA OPEN? JMP CEXIT NO JSB CEXT2 YES * * SKP * * HERE FOR REQUEST COMPLETE...DMA * JSB CLDMA CLEAR DMA ACTIVE...IF SET JSB CHECK CHECK FOR PARITY ERRORS AND STOP JMP IMOD9 PARITY ERROR...RETRY JMP LNRC5 STOP WAS RECEIVED ERQ1 LDA WAITF REQUEST AND DATA SZA,RSS REQUEST & DATA? JSB OFDMA TURN OFF DMA...REQUEST ONLY JSB STNW TELL OTHER SIDE ALL IS WELL JSB CEXT2 SET RECEIVE MODE TO GET REPLY * * HERE WHEN HANDSHAKING IS OVER * ICREQ JSB RDD.C CLEAR CARD JMP REQDN TERMINATE * A1 NOP A2 NOP RB1 NOP TEMPB NOP TEMPC NOP OMODE NOP GDMAW OCT 67 IRTNS DEF TRNSI C10 OCT 10 C40 OCT 40 C200 OCT 200 TEMPD NOP CREQI DEF ICREQ * SKP * * HERE ON RETURN FROM SENDING STOP * SSTPI DEF *+1 JSB RDD.C ] READ CARD TO CLEAR IT JSB OFDMA TURN OFF DMA CLA STA WAITF AND WAITING FOR DATA FLAGS * EXIT2 NOP "RSS" ONLY IF IN PARITY MODE. JMP REQDN STA EXIT2 LDB DBBIT JSB STAT JSB CLEAR JMP D.652 RE-INITIATE DRIVER CALL IF PARITY OCCURED. * * SKP * * HERE FOR REQUEST DATA COMING VIA INTERRUPTS * TRNSI JSB CHECK READ CARD JMP TRNS1 PARITY ERROR JMP LNRC5 STOP RECEIVED STA TEMPB,I SAVE VALUE ISZ TEMPB GET NEXT ADDRESS JMP *+3 TRNS1 STA TEMPB,I SAVE VALUE ISZ TEMPD INCREMENT PARITY COUNT ISZ TEMPC DONE? JMP ILNC2 NO LDB TEMPD GET PARITY ERRORS SZB ANY ERRORS? JMP IMOD9 YES...TRY AGAIN JMP ERQ1 NO...TERMINATE * SKP * * HERE FOR START OF DATA WRITE * INTWD JSB CCHCK CHECK FOR STOP OR PARITY ERROR CPA CB TRANSMIT NEXT WORD? RSS YES JMP LNRC3 NO...ERROR * * OTHER SIDE READ TO RECEIVE DATA * IWD1 JSB DMA GET DMA JSB ITRAN SET UP INCASE OF INTERRUPT TRANSFER LDB DDATI DMA DATA COMPLETE INTERRUPT LDA DMAF SZA DMA? JMP CEXT1 YES * * FALL THRU TO OUTDI IF NOT DMA TRANSFER * SKP * * HERE TO OUTPUT DATA ON INTERRUPT * OUTDI LDA TEMPB,I GET WORD JSB OUTPA OUTPUT WORD ISZ TEMPB GET NEXT ADDRESS LDB IOUTD GET CONTINUATION INTERRUPT ISZ TEMPC DONE? JMP CEXT1 NO...CONTINUE..LEAVE IN TRANSMIT MOD IWTRD JSB CEXT2 YES...SET FOR WAITING FOR STATUS * SKP * * HERE FOR STATUS ON DATA WRITE * JSB CHECK GO READ STATUS OF LAST TRANSFER JMP IWD1 PARITY ERROR...RETRY JMP LNRC5 STOP...ERROR CPA CB TNW? RSS ALL OK...TERMINATE JMP LNRC3 NO...TREATE AS A PvNLHARITY ERROR JSB OFDMA RESET DMA CLA GET A ZERO STA WAITF CLEAR WAITING FOR DATA INTERRUPT REQDN CLB,INB SET FOR ALL OK JMP CEND TERMINATE * DDATI DEF IDDAT IOUTD DEF OUTDI * SKP * * HERE FOR DMA COMPLETION...WRITE DATA * IDDAT JSB CLDMA TURN OFF DMA JSB CCHCK GO CHECK DATA QUALITY JMP IWTRD SET STATUS INTERRUPT * SKP * * HERE FOR LENGTH WORD TRANSMIT INTERRUPT * ISLW JSB CCHCK CHECK OF STOP OR PARITY ERROR CPA CB IS IT TNW? JMP ITWR2 YES CPA CD IS IT RLW? RSS YES JMP LNRC3 NO...ERROR CLA GET A ZERO INA,SZA HERE WE SIT AWHILE BEFORE TRYING AGAIN JMP *-1 JSB SRC TRY AGAIN LDB SLWI SET FOR SAME INTERRUPT JMP CEXIT DO CONTINUATION EXIT ITWR2 LDA RBUFL GET LENGTH CMA NEGATE COUNT JSB OUTPA OUTPUT LENGTH WORD JSB CEXT2 DO CONTINUATION EXIT * SPC 4 * * HERE TO SEND MODE WORD * JSB CCHCK STOP OR PARITY ERROR JSB GTDMA SEE IF WE CAN GET DMA CLA,SEZ,RSS YES INA NO LDB DATFG GET FLAG CLE,SZB REQUEST AND DATA? CCE YES ELA,RAR SET IN DATA FLAG JSB OUTPA OUTPUT WORD JSB CEXT2 DO CONTINUATION EXIT * VN SKP * * HERE TO SEND REQUEST CONTENTS * JSB CCHCK CHECK FOR STOP OR PARITY CPA CB TNW? RSS CPA GDMAW POSSIBLE OTHER SIDE DMA RSS JMP LNRC3 NO...TREATE AS PARITY ERROR ISRQ1 LDB RBUFL GET LENGTH WORD SZB,RSS ZERO? JMP ISTR1 YES LDA DMAF DO WE HAVE DMA? SZA,RSS JMP ISRQ2 NO JSB DMA START DMA LDB EREQI GET END DMA INTERRUPT JMP CEXT1 DO TRANSMIT CONTINUATION ISRQ2 JSB ITRAN SET UP FOR INTERRUPT TRANSFER * * FALL THRU TO ISRQ IF IT IS TO BE PROCESSED VIA INTERRUPTS * SKP * * HERE FOR SENDING REQUEST VIA INTERRUPTS * ISRQ LDA TEMPB,I GET WORD JSB OUTPA OUTPUT DATA WORD ISZ TEMPB GET NEXT ADDRESS LDB SRQI GET CONTINUATION ADDRESS ISZ TEMPC DONE? JMP CEXT1 NO...SET IN TRANSMIT MODE ISTR0 JSB CEXT2 YES...WAIT FOR STATUS * SKP * * HERE FOR END REQUEST STATUS INTERRUPT * JSB CCHCK CHECK FOR PARITY OR STOP CPA CB TNW? JMP ISTR1 YES CPA CD RLW? JMP ISRQ1 YES...RETRY JMP LNRC3 NO...ERROR ISTR1 JSB STNW SEND TNW AS RESPONSE LDB *+2 JMP CEXT1 DEF *+1 LDA DATFG SEND DATA TOO? SZA JMP *+3 JUMP UNLESS REQUEST ONLY JSB OFDMA TURN OFF DMA...REQUEST ONLY JMP REQDN JSB CEXT2 WAIT FOR TNW JSB CHECK PARITY OR STOP? JMP RETRY PARITY JMP IWDT1 STOP CPA CB WAS IT A TNW? RSS YES JMP LNRC3 NO, TREAT AS PARITY ISZ REQW4 GET TO DATA ADDRESS LDA DRWFG GET DATA READ WRITE FLAG STA RWFLG SAVE AS READ WRITE FLAG LDA REQW4,I GET ADDRESS JSB INDCK CHASE DOWN INDIRECTS STA RBUFA SAVE DATA ADDRESS ISZ REQW4 GET TO DATA LENGTH _ LDA REQW4,I GET LENGTH STA RBUFL SAVE LENGTH * * SET FOR STANDARD READ OR WRITE DATA * LDA RWFLG SZA READ OR WRITE? JMP IWD1 WRITE STA PARCT CLEAR PARITY ERROR COUNT JMP IDR1 READ * * THEY DID NOT WANT THE DATA * SEND THEM A -1 LENGTH * NORMAL TERMINATION * IWDT1 LDA DATFG REQUEST AND DATA? SZA ? CCA YES...SET FOR OK STOP STA EQTW3,I SAVE AS LENGTH JSB OFDMA TURN OFF DMA CLA STA WAITF CLEAR WAITING FOR DATA FLAG LDB C10 GET STOP RECEIVED BIT JMP CEND TERMINATE * SRQI DEF ISRQ SKP * * HERE FOR END DMA WRITE TRANSFER * IEREQ JSB CLDMA CLEAR DMA JMP ISTR0 SET STATUS INTERRUPT * EREQI DEF IEREQ * SKP * * HERE FOR DMA COMPLETION READ * INTRD JSB CLDMA TURN OFF DMA JSB PARCK CHECK FOR PARITY ERROR RSS NO ERRORS JMP IDR1 YES....RETRY JSB OFDMA TURN OFF DMA IDR2 JSB STNW TELL OTHER SIDE ALL IS WELL CLA GET A ZERO STA WAITF CLEAR DATA FLAG LDB CREQI JMP CEXT1 EXIT IN TRANSMIT MODE * * IDR1 CLA GET A ZERO STA TEMPD CLEAR PARITY FLAG..INTERRUPT PROCESS LDA PARCT GET PARITY COUNT CPA YDSA? DONE MAX NUMBER OF TIMES? JMP LNRC3 YES...PARITY ERROR JSB ITRAN SET UP FOR INTERRUPT TRANSFER JSB DMA START DMA (IF WE HAVE ONE) LDA PARCT GET PARITY COUNT ISZ PARCT INCREMENT PARITY COUNT SZA,RSS FIRST TIME? JMP *+3 YES JSB SRLW NO RSS IDR3 JSB STNW YES LDB NTRDI GET DMA TERMINATION LDA DMAF DOING DMA TRANSFER SZA JMP CEXIT YES JSB CEXT2 NO...INTERRUPT PROCESS * SKP * * HERE FOR RECEIVE DATA NON DMA * INDMA JSB RDD.S READ CARD STA TEMPB,I SAVE DATA WORD ISZ TEMPB GET NEXT WORD SSB PARITY ERROR? ISZ TEMPD YES ISZ TEMPC DONE? JMP IDR3 NO...TELL THEM TO CONTINUE LDB TEMPD GET PARITY ERROR FLAG SZB ANY ERRORS? JMP IDR1 YES JMP IDR2 NO * SKP * * HERE FOR PARITY ERRORS * LNRC3 LDB C40 GET PARITY ERROR CODE STB LN6ER AND SAVE IT JMP LNRCX GO SEND STOP SPC 3 * * HERE TO SET ERROR,SEND STOP,AND TERMINATE * LNRC4 LDB C2 GET LENGTH ERROR CODE STB LN6ER AND SAVE IT LNRCX JSB SSTOP SEND STOP LDB LNR6I GET POINTER TO LNRC6 JMP CEXT1 AND CONTINUE LNR6I DEF LNRC6 SPC 3 * * HERE ON STOP RECEIVED * LNRC5 LDB C10 JMP CEND TERMINATE SPC 3 * * HERE ON RETURN FROM SENDING STOP FROM LNRC3 OR LNRC4 * LNRC6 LDB LN6ER GET ERROR CODE SPC 3 * * HERE FOR COMPLETION EXIT * CEND JSB CLEAR CLEAR THE DRIVER AND CARD JSB STAT UPDATE STATUS CLA,INA CPA INT? LISTEN MODE? JMP I65 YES CLB NO CLA JMP CEXT3 COMPLETE * I65 CLA STA IJMP STA CMD LDA A2 STA I1 LDA A1 STA I2 LDA RB1 STA I3 LDA I.65 STA P65 JSB INT65 EXECUTE INT65 LDA I1 CLO SLA,ELA STF 1 LDA I2 LDB I3 JMP P65,I * INT? NOP I1 NOP I2 NOP I3 NOP P65 NOP * SPC 3 * * HERE FOR CONTINUATION EXIT * CEXT2 NOP LDB CEXT2 GET NEXT ADDRESS CEXIT LDA LSCMD GET LISTEN INSTRUCTION RSS CEXT1 LDA TRCMD SET CARD IN TRANSMIT MODE CEXT3 STB IJMP SAVE NEXT JUMP INSTRUCTION STA CMD SAVE CARD COMMAND LDA OTWRD GET WORD TO OUTPUT LDB OUTFG SEE IF WNE SHOULD OUTPUT SZB OTA1 OTA 0 YES LDA A2 CLO RESTORE REGS SLA,ELA STF 1 LDA A1 LDB RB1 CMD NOP COMMAND GOES HERE JMP I.65,I AND RETURN * LSCMD STC 0,C TRCMD STC 0 OUTFG NOP OTWRD NOP LN6ER NOP * * * STAT NOP EQT STATUS UPDATE ROUTINE CLF 0 TURN OFF INTERRUPT SYSTEM LDA EQTW2,I GET EQT WORD AND C374K MASK OFF EXTRA BITS IOR B STUFF IN B REGISTER STA EQTW2,I AND PUT IT AWAY JSB INTON TURN INTSYS ON JMP STAT,I * SKP * * SUBROUTINE TO CHECK FOR STOP AND PARITY * CCHCK NOP JSB CHECK JMP RETRY PARITY ERROR-RETRY. JMP LNRC5 STOP JMP CCHCK,I ALL OK * SPC 3 * * SUBROUTINE TO CHECK FOR PARITY AND STOP * CHECK NOP JSB PARCK CHECK FOR PARITY ERROR JMP CHCK1 NO PARITY ERROR LDB C200 GET BROKEN LINE CHECK SZA BROKEN LINE? JMP CHECK,I NO...JUST PARITY ERROR JMP CEND GO TO END CHCK1 ISZ CHECK CPA CC STOP? JMP CHECK,I YES ISZ CHECK NO JMP CHECK,I NORRMAL RETURN * SPC 3 * * PARITY CHECKING ROUTINE * PARCK NOP JSB RDD.S READ CARD SSB PARITY ERROR ISZ PARCK YES JMP PARCK,I RETURN * SPC 3 * * ROUTINE TO SET UP COUNTERS FOR INTERRUPT TRANSFER * ITRAN NOP LDA RBUFA GET ADDRESS STA TEMPB SAVE ADDRESS LDA RBUFL GET LENGTH CMA,INA CONVERT TO NEGITIVE COUNT STA TEMPC CLA GET A ZERO STA TEMPD SAVE PARITY ERROR COUNT JMP ITRAN,I RETURN * BSS 0 END s0 c{ 91703-18102 1606 S 0222 DS1/B SCE/3 MODULE: TEXEC              H0102 LASMB,R,L,C,N HED TEXEC 91703-16102 * (C) HEWLETT PACKARD CO. 1976 NAM TEXEC,3 91703-16102 REV A 760203 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 **************************************** * *TEXEC TERMINAL EXEC FOR BCS TO RUN UNDER DS1/B * *SOURCE PART # 91703-18102 * *REL PART # 91703-16102 * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-29-74 * *MODIFIED BY: BOB SHATZER (04-07-75) * DAN GIBBONS (01-07-76) * J-P BAUDOUIN (01-21-76) * DAN GIBBONS (01-27-76) * BOB SHATZER (02-03-76) * ***************************************** SPC 1 * * * THIS VERSION OF TEXEC SUPPORTS THE USE OF $DDT * THROUGH THE USE OF THE 'Z' ASSEMBLY OPTION. * * * * ENT RLOAD ENT ATTEN ENT CHAIN ENT RNPGM ENT RMESG ENT IDLE ENT PTPON,PTPOF,ESCON ENT HALT ENT .ENTR,GETLU ENT RMPAR,CLRIO * EXT STBSY,RESET EXT .IOC.,REXEC,RCRET EXT .MEM. EXT RPURG EXT RCLOS EXT RNAME EXT #TAM EXT $BUSY,$ESC EXT ATTN EXT PARMB IFZ EXT $DDT XIF SUP * A EQU 0 B EQU 1 * * * NOTE THAT TEXEC MAKES AN INITIALIZATION CALL TO #TAM PRIOR * TO MAKING ANY CALLS TO THE COMM LINK. THIS CALL SETS UP * THE PROPER LU FOR D.65 AND INITIALIZES THE CORRECT TIMEOUT * VALUE. HED OPERATOR PROMPT (BCS) * (C) HEWLETT PACKARD CO. 1976 *********************** * QUERY THE OPERATOR. ****************************** *********************** * JMP MSTRT MANUAL START ADDR = 2000B. IDLE NOP ENTRY. HALT EQU IDLE LDA WHERE ESTABLISH BAIL-OUT ADDR. JSB ATTN QUERY JSB WAIT * JSB INITL INITILIZE .MEM. TABLE * CLA CLEAR STANDBY FLAG. STA STBYF STA $BUSY CLEAR COMMUNICATIONS BUSY FLAG. STA $ESC CLEAR ESCAPE FLAG. * JSB WAIT WAIT FOR TTY TO COMPLETE JSB .IOC. DISPLAY ":" PROMPT. OCT 020002 JMP *-2 DEF COLON DEC 1 * JSB WAIT * LDA DM40 STA TEMP SET UP -40 LOOP COUNTER LDB .BUFR GET BUFFER ADDRESS LDA BLNKW AND DOUBLE BLANK STA B,I STORE BLANKS INTO BUFFER INB ISZ TEMP BUMP POINTERS AND COUNTERS JMP *-3 CONTINUE UNTIL BUFFER IS BLANKED * JSB .IOC. INPUT THE COMMAND. OCT 010401 JMP *-2 .BUFR DEF BUFFR DEC -80 * JSB .IOC. WAIT FOR INPUT COMPLETION OCT 40001 STATUS OF INPUT DEVICE SSA DEVICE STILL BUSY? JMP *-3 YES...WAIT UNTIL DONE * STB WAIT SAVE CHARACTER COUNT CLE,ERB CONVERT TO WORD COUNT SEZ IF ODD # OF WORDS INB INCREMNET WORD COUNT FOR ODD CHAR STB MSLEN SAVE WORD LENGTH LDB WAIT GET CHARACTER COUNT JSB TMESS GO PROCESS THE COMMAND. JMP QUERY * WAIT NOP JSB .IOC. I/O STATUS WAIT. OCT 40002 SSA JMP *-3 JMP WAIT,I * COLON ASC 1,:_ PROMPT CHARACTER. * * OPERATOR ATTENTION KEY WAS PRESSED. * WHERE DEF ATTEN ATTEN LDA DCRLF OUTPUT CR/LF. LDB B1 JSB OPDIS JSB WAIT JSB ABORT DO SOME HOUSEKEEPING. * * OPERATOR ERROR MESSAGES * M0950 LDA ETAM3 "SYNTAX ERROR". LDB B6 JSB OPDIS * = JMP QUERY SPC 1 ETAM3 DEF MTAM3 MTAM3 ASC 6,SYNTAX ERROR DM40 DEC -40 HED OPDIS (OPERATOR DISPLAY ROUTINE) * (C) HEWLETT PACKARD CO. 1976 * * DISPLAY OPERATOR MESSAGE ON TERMINAL DISPLAY DEVICE. * * CALLING SEQUENCE: * * (A) = ASCII MESSAGE ADDRESS. * (B) = + WORD COUNT OR - CHARACTER COUNT. * JSB OPDIS * OPDIS NOP * STA OPD1 STB OPD2 * JSB WAIT * JSB .IOC. OCT 020002 JMP *-2 OPD1 NOP BUFFER. OPD2 NOP COUNT. * JMP OPDIS,I SPC 5 STNBY NOP DISPLAY "STANDBY" MESSAGE. LDA STBYF SZA JMP STN INA STA STBYF LDA STNDF LDB B4 JSB OPDIS STN LDA $ESC ALLOW ESCAPE. SZA JSB ABORT LDB DELAY DELAY LOOP. INA,SZA JMP *-1 INB,SZB JMP *-3 JMP STNBY,I * STNDF DEF *+1 ASC 4,STANDBY HED OPERATOR INPUT DECIPHER ROUTINE * (C) HEWLETT PACKARD CO. 1976 ******************************** * DECIPHER OPERATOR MESSAGES. ********************** ******************************** * * CALLING * SEQUENCE: JSB TMESS * B CONTAINS # CHARACTERS. * DATA IN BUFFR. * TMESS NOP ENTRY. CLA STA TEMP+2 CLEAR CHARACTER FLAG. SZB,RSS CHECK IF COUNT ZERO. JMP TMESS,I YES, SO EXIT. STB MLEN SAVE CHARACTER LENGTH CMB,INB STB TEMP+3 NEGATIVE CHAR. COUNT. * LDB MD33 CLEAR PARAMETER AREA. STB TEMP LDB PARPT STA B,I INB ISZ TEMP JMP *-3 * LDB BUFAD INPUT BUFFER CLE,ELB BYTE ADDRESS. STB TEMPP LDA INIT STA TEMP+5 INITIAL PARAM POINTER. LDA TEMP+5,I STA TEMP+4 INITIAL STORE POINTER. ADA MD1 STA TEMP+6 PARAM CHAR COUNT ADDR. * DEC10 LDB TEMPP FETCH NEXT BYTE. CLE,ERB )LDA B,I SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER. ALF,ALF UPPER, SO ROTATE. AND M377 ISOLATE CHARACTER. * CPA COM CHECK FOR JMP DEC60 COMMA OR CPA BLNK BLANK JMP DEC65 DELIMITER. CPA COLN OR IS IT A ":" JMP DEC60 * LDB TEMP+6,I ADD -1 TO ADB MD1 CHARACTER STB TEMP+6,I COUNT. * LDB TEMP+2 CHECK IF TO BE UPPER/LOWER. SZB UPPER. JMP DEC40 LOWER. * ALF,ALF POSITION. STA TEMP+4,I STORE. ISZ TEMP+2 SET FLAG TO LOWER CHARACTER. JMP DEC50 GO INCREMENT DATA CHAR. * DEC40 IOR TEMP+4,I COMBINE UPPER/LOWER. STA TEMP+4,I STORE. CLA STA TEMP+2 RESET FLAG TO UPPER CHAR. ISZ TEMP+4 BUMP STORE LOCATION. LDA TEMP+4 DELIMIT "TELLOP". CPA PMEND JMP M0000 * DEC50 ISZ TEMPP BUMP BUFFER ADDR. ISZ TEMP+3 BUMP CHAR. COUNT. JMP DEC10 GO PROCESS NEXT CHAR. DEC55 ISZ PARAM DONE- BUMP PARAM COUNT. JMP M0000 GO TO EXIT. * DEC65 LDA PARAM FIRST PARAM? SZA,RSS JMP DEC60 YES, BLANK = DELIMITER. ISZ TEMPP NO, IGNORE BLANKS. ISZ TEMP+3 JMP DEC10 GO PROCESS NEXT CHARACTER. JMP DEC55 DEC60 CLA STA TEMP+2 RESET UPPER CHAR FLAG. * ISZ TEMP+5 BUMP PARAM POINTER. ISZ PARAM BUMP PARAM COUNT. LDA PARAM CPA B10 EIGHT PARAMS? JMP M0000 YES, GO PROCESS. * LDA TEMP+5,I STA TEMP+4 ADA MD1 STA TEMP+6 PARAM CHAR COUNT ADDR. JMP DEC50 GO INCREMENT DATA BUFFER. SPC 2 COLN OCT 72 HED MESSAGE PROCESSOR * (C) HEWLETT PACKARD CO. 1976 ********************************** * SEARCH COMMAND MNEMONIC TABLE. ******************* ********************************** * M0000 CLA CLEAR EQUIVALENCE STA EQCNT COUNTE*kR. LDA OPCNT INITIALIZE # MNEMONICS STA TEMP COUNTER. * LDA LDOPC SET UP MNEMONIC STA TEMP+1 TABLE STA T.PTR POINTER. * RSET LDA TAB FORM BYTE ADDR RAL OF INPUT COMMAND STA I.PTR MNEMONIC. * LDA OP1 # CHAR IN INPUT. SZA,RSS JMP M0950 ERROR IF NULL. ADA MD1 STA CHCNT NEG. CHAR COUNT -1. * GET LDA I.PTR GET NEXT INPUT BYTE. ISZ I.PTR ISZ CHCNT ANY MORE CHARACTERS? JMP *+2 YES. JMP MTCH? NO. CLE,ERA E=0 IF LEFT BYTE, ELSE =1. LDA A,I SEZ,RSS ALF,ALF POSITION. AND M377 ISOLATE. STA B SAVE. * LDA T.PTR,I GET TABLE MNEMONIC BYTE. SEZ,RSS ALF,ALF POSITION. AND M377 ISOLATE. SEZ ISZ T.PTR * CPA B COMPARE - EQUAL? JMP EQ YES * LOOP LDA TEMP+1 ADVANCE TO NEXT ENTRY ADA B5 IN MNEMONIC STA TEMP+1 TABLE. STA T.PTR CLA STA EQCNT ISZ TEMP BUMP MNEMONIC COUNTER. JMP RSET GO COMPARE. JMP M0500 END OF MNEMONICS, ERROR. * EQ ISZ EQCNT COUNT THIS MATCH. JMP GET GO TO NEXT CHAR. * MTCH? LDA TEMP+1 DID WE GET A MATCH ADA B3 LDA A,I CPA EQCNT ON THIS MNEMONIC? JMP *+2 YES. JMP LOOP NO. * * MATCH FOUND. GO TO PROCESSOR. * LDA TEMP+1 FETCH PROCESSOR ADDR. ADA B4 LDA A,I JMP A,I GO TO PROCESSOR. HED LOAD XXXXX COMMAND * (C) HEWLETT PACKARD CO. 1976 * * LOAD XXXXX * GENERATE AN RLOAD SUBROUTINE CALL TO * LOAD INTO THE TERMINAL THE PROGRAM XXXXX WHICH * RESIDES ON THE CENTRAL STATION DISC. * M0100 JSB NAMCK * M0110 JSB RLOAD DEF *+5 DEF STATS DEF IERR DEF P1 DEF IADR * JSB LDERR CHECK FOR NPRGL ERRORS. SSB,RSS SZB,RSS WAS PROGL DORMANT? * JMP QUERY YES. JSB STNBY NO, STANDBY. JMP M0110 TRY AGAIN. * NAMCK NOP LDA CP1 IS THERE A NAME? SZA,RSS JMP M0950 NO. LDA TAB+1 JSB TRAIL FILL TRAILING BLANKS. JMP NAMCK,I * LDERR NOP LDA STATS LDB IERR ANY PROGL ERRORS? SSB,RSS INA,SZA ANY LINE ERRORS RSS YES...PROGL OR LINE ERRORS JMP LDERR,I NO. B=IERR= 0 OR 1. LDA EPRGL CPB MD1 LDA EFIND YES, CAN'T FIND PROGRAM. CPB MD6 JMP LDERR,I LDB B6 JSB OPDIS JMP QUERY * EFIND DEF MTAM7 MTAM7 ASC 6,CAN'T LOCATE EPRGL DEF MPRGL MPRGL ASC 6,NPRGL ERROR HED RUN COMMAND * (C) HEWLETT PACKARD CO. 1976 * * RUN[*,P1,P2,P3,P4,P5] * * RUNAT NNN [,P1,P2,P3,P4,P5] * * RUN XXXXX [,P1,P2,P3,P4,P5] * * P1...P5 = OPTIONAL PARAMETERS. * NNN = START ADDRESS. * XXXXX = PROGRAM NAME. * M0200 LDA CP1 IS 1ST PARAM NULL OR "*"? LDB P1 SZA CPB ASTER JMP MOVIT YES. * LDA TAB+1 JSB TRAIL M0215 JSB RLOAD MUST BE A PROGRAM NAME. DEF *+5 LOAD THE PROGRAM. DEF STATS DEF IERR DEF P1 DEF IADR * JSB LDERR CHECK FOR PROGL ERRORS. SSB,RSS SZB,RSS WAS PROGL DORMANT? JMP MOVIT YES. JSB STNBY NO. JMP M0215 * * HERE WE COME FOR "RUNAT" COMMAND * GETAD LDA CP1 IS ADDRESS SUPPLIED? SZA,RSS JMP M0950 NO...ERROR JSB CVT1 CONVERT ADDRESS DEF P1 DEF CP1 STA IADR SAVE AS STARTING ADDRESS * MOVIT JSB MOVE JMP RUNIT YES. * * CONVERT OPTIONAL PARAMETERS TO BINARY AND STORE. * MOVE NOP LDA TAB+2 STA DCVTA ADDR OF DATA BUFFER. ADA MD1 STUA DCVTB ADDR OF CHAR COUNT. * LDA DO.P1 STA TEMP+4 DESTINATION ADDR. LDA MD5 STA TEMP+5 COUNTER * TRANS LDA DCVTB,I CHAR. COUNT. SZA,RSS ZERO? JMP STORE YES, STORE ZERO. * JSB CVT1 CONVERT TO BINARY. DCVTA DEF * DCVTB DEF * * STORE STA TEMP+4,I STORE VALUE. ISZ TEMP+4 LDA DCVTA ADA B4 STA DCVTA LDA DCVTB ADA B4 STA DCVTB * ISZ TEMP+5 DONE? JMP TRANS NO. JMP MOVE,I * RUNIT JSB RNPGM GO RUN THE PROGRAM. DEF *+7 DEF IADR DO.P1 DEF O.P1 DEF O.P2 DEF O.P3 DEF O.P4 DEF O.P5 * * WON'T COME BACK UNLESS NO START ADDRESS. * START LDA ENSA "NO START ADDRESS" LDB B6 JSB OPDIS JMP QUERY * O.P1 OCT 0 O.P2 OCT 0 O.P3 OCT 0 O.P4 OCT 0 O.P5 OCT 0 * ASTER OCT 025000 ENSA DEF NSA NSA ASC 6,NO START ADR HED ABORT COMMAND * (C) HEWLETT PACKARD CO. 1976 * * ABORT * * ABORT THE PROGRAM CURRENTLY RUNNING AT TERMINAL. * MSTRT JSB #TAM STARTUP PROCESSOR DEF *+2 MAKE INITIALIZATION CALL TO #TAM OCT 0 RSS ABORT NOP M0300 BSS 0 CLA STA $BUSY STA $ESC JSB .IOC. CLEAR I/O OCT 0 * JSB IDLE HED TELLOP COMMAND * (C) HEWLETT PACKARD CO. 1976 * * TELLOP * * DISPLAY A MESSAGE ON THE REMOTE OPERATOR DISPLAY * M0400 LDA MSLEN ADJUST WORD COUNT. ADA MD3 SZA,RSS ZERO? JMP M0950 YES, ERROR. STA MSLEN * JSB RMESG SEND THE MESSAGE. DEF *+4 DEF STATS DEF BUFFR+3 DEF MSLEN * JMP QUERY HED ALL RTE COMMANDS * (C) HEWLETT PACKARD CO. 1976 * M0500 LDA B7 SET UP STREAM TYPE STA STYP CLA SET FOR REQUEST STA RRSW CLA,INA SET TO SEND REQ JSB PTPON SET LINE B.USY DEF *+1 CLA,INA SET FOR REQUEST JSB #TAM DEF *+4 DEC 6 DEF STYP DEC -50 25 WORD BUFFER INA,SZA ANY ERRORS? JMP LINER YES...LINE ERROR M0501 CLA,INA SET FOR REQUEST JSB #TAM DEF *+4 DEC 5 DEF STYP PUT REPLY BACK IN REQUEST BUFFER DEC -50 MAX OF 25 WORDS INA,SZA LINE ERROR JMP LINER YES LDA STYP GET FIRST WORD JSB RPYCK SEE IF REPLY JMP M0501 NOT REPLY...IGNORE JSB PTPOF TURN OF LINE BUSY FLAG DEF *+1 LDA BUFAD GET OUTPUT BUFFER ADDRESS LDB MLEN GET LENGTH OF REPLY INB AND MAKE LENGTH INTO WORDS CLE,ERB CONVERT TO WORDS SZB ANYTHING TO PRINT JSB OPDIS SEND REPLY JMP QUERY AND RETURN SPC 2 LINER LDA ETAM2 SEND COM LINE MESSAGE LDB B6 JSB OPDIS "COM LINE ERR" JSB PTPOF TURN OFF LINE BUSY DEF *+1 JMP QUERY AND RETURN TO USER SPC 1 ETAM2 DEF MTAM2 MTAM2 ASC 6,COM LINE ERR HED CREATE XXXXXX COMMAND * (C) HEWLETT PACKARD CO. 1976 * * CREATE XXXXXX,KKK,NNNN,TT,S,CR * * XXXXXX = FILE NAME. * KKK = # BLOCKS. * NNNN = RECORD SIZE, OPTIONAL, .LE. 128 WORDS. * TT = FILE TYPE, OPTIONAL. * S = SECURITY CODE, OPTIONAL. * CR =CART. REF, OPTIONAL. * M0800 JSB NAMCK * LDA CP2 BLOCKS PARAM? SZA,RSS JMP M0950 NO, ERROR. JSB CVT1 CONVERT # BLOCKS. DEF P2 DEF CP2 STA TEMP * LDB CP3 RECORD SIZE? SZB,RSS JMP M0802 NO, IGNORE. JSB CVT1 YES, CONVERT. DEF P3 DEF CP3 STA TEMP+1 SZA SSA LEGAL SIZE? JMP M0950 NO, ERROR. ADA MD129 SSA,RSS JMP M0950 * M0802 LDA B3 LDB CP4 FILE TYPE? SZB,RSS JMP M0810 NO, SET DEFAULT = 3. JSB CVT1 YES, CONVERT. DEF P4 DEF CP4 M0810 STA TEMP+4 * CLA LDB CP5 SECURITY CODE? SZB,RSS JMP M0820 NO, SET DEFAULT = 0. JSB CVT1 YES, CONVERT. DEF P5 DEF CP5 M0820 STA SECUR * CLA LDB CP6 SEE CR SUPPLIED SZB,RSS SUPPLIED? JMP M0840 NO JSB CVT1 YES...CONVERT TO DEC DEF P6 DEF CP6 M0840 STA P6 SAVE CR * JSB RCRET CREATE A REMOTE FILE. DEF *+8 DEF STATS DEF IERR DEF P1 FILE NAME. DEF TEMP # BLOCKS, REC. SIZE. DEF TEMP+4 FILE TYPE. DEF SECUR SECURITY CODE. DEF P6 * JSB FMGER CHECK IF WE HAD A FMGR ERROR JMP M1000 GO CLOSE THE FILE * M0830 JSB FMGER FILE MANAGER ERROR? * JMP QUERY HED RENAME COMMAND * (C) HEWLETT PACKARD CO. 1976 * * RENAME XXXXXX,YYYYYY,S,CR * * XXXXXX = OLD FILE NAME. * YYYYYY = NEW FILE NAME. * S = SECURITY CODE, OPTIONAL. * CR =CART REF, OPTIONAL * M0900 JSB NAMCK IS OLD NAME SPECIFIED? * LDA CP2 IS NEW NAME SPECIFIED? SZA,RSS JMP M0950 NO, ERROR. LDA TAB+2 YES. JSB TRAIL * CLA LDB CP3 SECURITY CODE? SZB,RSS JMP M0910 NO, SET DEFAULT = 0. JSB CVT1 YES, CONVERT. DEF P3 DEF CP3 M0910 STA SECUR * CLA LDB CP4 SEE IF CR SUPPLIED SZB,RSS JMP M0920 NOT SUPPLIED JSB CVT1 CONVERT TO BINARY DEF P4 DEF CP4 M0920 STA P4 SAVE FOR RENAME * JSB RNAME RENAME A REMOTE FILE. DEF *+7 DEF STATS DEF IERR DEF P1 OLD NAME. DEF P2 NEW NAME. DEF SECUR DEF P4 *  JMP M0830 HED CLOSE COMMAND * (C) HEWLETT PACKARD CO. 1976 * * CLOSE XXXXXX * * XXXXXX = FILE NAME. * M1000 JSB NAMCK IS THERE A FILE NAME? * JSB RCLOS CLOSE A REMOTE FILE. DEF *+4 DEF STATS DEF IERR DEF P1 FILE NAME. * JMP M0830 HED PURGE COMMAND * (C) HEWLETT PACKARD CO. 1976 * * PURGE XXXXXX,S * * XXXXXX = FILE NAME * S = SECURITY CODE, OPTIONAL. * CR =CART REF, OPTIONAL * M1100 JSB NAMCK NAME GIVEN? * CLA LDB CP2 SECURITY CODE? SZB,RSS JMP M1110 NO, SET DEFAULT = 0. JSB CVT1 YES, CONVERT. DEF P2 DEF CP2 M1110 STA SECUR * CLA LDB CP3 SEE IF CR SUPPLIED SZB,RSS JMP M1120 NOT SUPPLIED JSB CVT1 CONVERT TO BINARY DEF P3 DEF CP3 M1120 STA P3 SAVE FOR PURGE * JSB RPURG PURGE A REMOTE FILE. DEF *+6 DEF STATS DEF IERR DEF P1 DEF SECUR DEF P3 * JMP M0830 HED DLIST PROCESSOR * (C) HEWLETT PACKARD CO. 1976 * *DLIST [FILTER][,MSEC CODE][,CR][,TYPE] * * WHERE: *MSEC CODE=MASTER SECURITY CODE *CR =DISK LU *TYPE =FILE TYPE FILTER * M1200 LDA CP1 MOVE NAME TO PARMB SZA NAME SUPPLIED? JSB NAMCK YES...SPACE FILL LDA P1 MOVE NAME TO PARMB STA DLSN1 LDA P1+1 STA DLSN1+1 LDA P1+2 STA DLSN3 LDA CP2 MASTER SECURITY CODE SZA,RSS SUPPLIED? JMP M1201 NO JSB CVT1 YES...CONVERT IF DEF P2 DEF CP2 M1201 STA DMCOD SAVE MASTER SECURITY CODE LDA CP3 SEE IF CART LU SUPPLIED SZA,RSS NOT SUPPLIED JMP M1202 JSB CVT1 CONVERT TO BINARY DEF P3 DEF CP3 M1202 STA MDCR SAVE CART. LU LDA CP4 IS IF TYPE FILTER SUPPAXLIED CLE,SZA,RSS SUPPLIED? JMP M1203 NO JSB CVT1 YES...CONVERT IF DEF P4 DEF CP4 CCE SET FOR SUPPLIED M1203 RAL,ERA SET IN SIGN BIT IF SUPPLIED STA DTYP CLA SET FOR NEW REQ STA NEWRQ M1204 CLA,INA SET IN STREAM TYPE STA DSTRM LDA DEC27 54 CHAR LINE STA DLEN SAVE LENGTH JSB PTPON SET LINE BUSY DEF *+1 CLA SET FOR RECIEVE DATA JSB #TAM DEF *+6 DEC 8 DEF DSTRM DEC -50 PRMBA DEF PARMB DEC -54 INA,SZA ANY ERRORS? JMP LINER YES M1205 CLA,INA SET TO RECIEVE REQ JSB #TAM DEF *+4 DEC 5 DEF DSTRM DEC -50 INA,SZA ANY ERRORS? JMP LINER YES LDA DSTRM GET FIRST WORD OF REPLY JSB RPYCK SEE IF REPLY JMP M1205 NOT...IGNORE JSB PTPOF TURN OFF LINE BUSY DEF *+1 LDA DLST SEE IF WE ARE DONE SZA DONE? JMP QUERY YES LDA PRMBA LDB DLEN SEND OUT LINE JSB OPDIS JSB WAIT WAIT FOR TTY TO COMPLETE JMP M1204 GET ANOTHER LINE SPC 1 DEC27 DEC 27 HED RLOAD PROCESSING * (C) HEWLETT PACKARD CO. 1976 * *RLOAD...LOAD A REMOTE PROGRAM * CALLING SEQUENCE * JSB RLOAD * DEF *+5 * DEF LINE STATUS * DEF FILE MANAGER ERROR STATUS * DEF NAME * DEF STARTING ADDRESS * * STATUS ERROR CODES * =#TAM ERROR CODES * * ERROR CODE * 1=PROGL BUSY...TRY LATTER * 0=NO ERROR * -1=OPEN ERROR ON FILE * -2=FILE READ ERROR * -3=TRANSMISSION ERROR * -4=TRANSMISSION ERROR * -5=FILE CLOSE ERROR (MEMORY PROTECT) * -6=NO STARTING ADDRESS * SPC 2 PRGST NOP PRGER NOP PRGNM NOP PRGSA NOP RLOAD NOP JSB .ENTR GET PRAMS DEF PRGST LDA PRGSA GEsT STARTING ADDRESS LOC (OPTIONAL) STA PGSTA SAVE FOR LATTER JSB .IOC. OCT 40000 SSA DRIVERS ALL DONE JMP *-3 NO JSB PTPON SET LINE BUSY DEF *+1 CLA CLEAR OUT TEMPS STA PRGER,I CLEAR OUT ERROR WORD STA LSTAT STATUS WORD STA LODAD ADDRESS (OF DATA STA LDERR ERROR WORD STA LSC SECURITY CODE STA LDNFG DONE FLAG STA LNWRQ NEW REQUEST FLAG STA 3 CLEAR OUT TRANSFER ADDRESS STA PRGSA AND OPTIONAL STARTING ADDRESS STA FATAL CLEAR OUT FATAL FLAG * LDB MD3 MOVE IN NAME LDA LPNMA GET ADDRESS OF NAME AREA IN PARMB STA RLODA SAVE IN TEMP RLOD1 LDA PRGNM,I MOVE IN NAME STA RLODA,I SAVE NAME ISZ PRGNM ISZ RLODA INB,SZB DONE? JMP RLOD1 NO * * NOW GET THE PROGRAM * RLOD2 LDA $ESC DO THEY WANT OUT? SZA,RSS ? JMP RLD22 NO STA LDNFG YES...TELL PROGL STA FATAL SET FATAL NON ZERO RLD22 LDA B3 SET IN STREAM TYPE STA LSTRM CLA,INA JSB #TAM SEND REQ DEF *+4 DEC 6 DEF LSTRM DEC -50 JSB CKLST CHECK LOADER STATUS RLD23 CLA,INA READ REPLY JSB #TAM DEF *+4 DEC 5 DEF LSTRM DEC -50 JSB CKLST LDA LSTRM GET FIRST WORD OF REPLY JSB RPYCK SEE IF REPLY JMP RLD23 NOT REPLY...IGNORE LDA LSTAT READ THE STATUS CPA B1 IS THERE DATA? RSS YES JMP RLOD3 NO JSB MEMCK CHECK MEMORY BOUNDS LDA PLNGH GET LENGTH CLE,ELA CONVERT TO NEGATIVE BYTES CMA,INA STA DLNGH SAVE LENGTH CLA SET TO READ DATA JSB #TAM DEF *+4 DEC 5 DEF LODAD,I LOAD ADDRESS DLNGH NOP JSNLHB CKLST CHECK STATUS JMP RLOD2 GET NEXT RECORD SPC 2 * * HERE IF NO DATA THERE * RLOD3 SSA ERROR? JMP LODER YES LDB FATAL ANY PREVIOUS ERRORS? SZB JMP RDON YES...GET OUT CPA B3 ID SEG COMING? JMP RLOD4 YES JSB #TAM DON'T WANT IT SEND STOP DEF *+2 DEC 2 * RLOD4 LDA LPNAM+1 GET STARTING ADDRESS LDB LODAD SEE IF STARTING ADDRESS SUPPLIED SZB,RSS ZERO...NOT SUPPPLIED CLA STA 3 SET IN STARTING ADDRESS LDB PGSTA DO THEY WANT STARTING ADDRESS SZB STA B,I LDB MD6 SZA,RSS STB PRGER NO..TELL THEM RDON JSB RESET SEE IF BUSY SET JSB PTPOF CLEAR EXC KEY DEF *+1 JMP RLOAD,I AND RETURN SPC 1 SPC 2 * * ROUTINE TO GET LOAD ERROR * LODER CLB SET IN CORRECT ERROR CODE CPA MD2 FILE MANAGER ERROR? CCB YES...-1 ERROR CPA MD3 BUSY? CLB,INB YES...SET TO +1 SZB,RSS HAVE AN ERROR CODE? LDB MD2 NO...NOW WE DO STA PRGER,I SAVE ERROR CODE JMP RDON AND GET OUT SPC 1 * * SUBROUTINE TO CHECK ON LINE STATUS * CKLST NOP STA PRGST,I SAVE STATUS INA,SZA ANY ERRORS? JMP RDON YES JMP CKLST,I NO fN SPC 2 * * SUBROUTINE TO DO MEMORY BOUNDS CHECKING * MEMCK NOP LDA LODAD GET STARTING ADDRESS ADA PLNGH GET ENDING ADDRESS ADA MD1 STA LADDR LWA FOR THIS RECORD * ADA LWAM CHECK UPPER LIMIT USER CORE SSA,RSS JMP MMERR ERROR * LDA LODAD CHECK LOWER LIMIT ADA FWAM SSA,RSS JMP MEXIT OF FWAM LE ADD LE LWAM LDA LADDR CHECK LOW BAS PAGE ADA FWABP SSA JMP MMERR ERROR LDA LADDR ADA LWABP CHECK UPPER LIMIT BASE PAGE SSA,RSS JMP MMERR ERROR * MEXIT JMP MEMCK,I AND RETURN * MMERR LDA DMPV LDB B6 SEND OUT MESSAGE JSB OPDIS "MP VIOLATION" LDA MD5 STA FATAL STA PRGER,I SET IN ERROR CODE JSB #TAM SEND STOP...THIS WILL STOP PROGL DEF *+2 DEC 2 JMP RLOD2 LET PROGL TERMINATE NORMALLY JMP RDON AND GET OUT SPC 1 DMPV DEF MPV MPV ASC 6,MP VIOLATION SPC 1 PGSTA NOP RLODA NOP LPNMA DEF LPNAM HED PROCESS FILE MANAGER ERRORS * (C) HEWLETT PACKARD CO. 1976 * * IF FILE MANAGER ERROR, DISPLAY ERROR MESSAGE. * FMGER NOP LDA IERR SSA,RSS JMP FMGER,I NO ERRORS. * CMA,INA MAKE POSITIVE. LDB FMEDF JSB BTOA CONVERT TO ASCII. * LDA FME LDB B6 JSB OPDIS PRINT MESSAGE. * JMP QUERY * FME DEF FMERR FMEDF DEF FMERR+5 FMERR ASC 6,FMP ERR - HED TRAIL ROUTINE * (C) HEWLETT PACKARD CO. 1976 * * CONVERT TRAILING BINARY ZEROES TO ASCII BLANKS. * * CALLING SEQUENCE: * * (A) = ADDR OF 3-WORD ASCII PARAM. * JSB TRAIL * TRAIL NOP STA TEMP LDA MD3 STA TEMP+1 TLOOP LDB BLNKW LDA TEMP,I SZA,RSS JMP STUFF * CLB AND M377 SZA,RSS LDB BLNK * STUFF LDA TEMP,I IOR B {STA TEMP,I ISZ TEMP ISZ TEMP+1 JMP TLOOP JMP TRAIL,I HED TCE/3 UTILITY SUBROUTINES * (C) HEWLETT PACKARD CO. 1976 ********************* * GET LOGICAL UNIT. ******************************** ********************* * * PURPOSE - * GET LOGICAL UNIT AT THE CENTRAL COMPUTER FOR * THIS TERMINAL. * * CALLING * SEQUENCE: JSB GETLU * DEF *+2 * DEF LU SPC 3 GETLU NOP JSB STBSY SET BUSY ISZ GETLU LDA GETLU,I STA TMP ADDR FOR LU. ISZ GETLU * GETL CLA,INA SEND REQUEST. JSB #TAM DEF *+4 DEC 6 DEF COMND DEC -2 INA,SZA ANY ERRORS? JMP GETL YES...TRY AGAIN * GETL1 CLA,INA RECEIVE REQUEST. JSB #TAM DEF *+4 DEC 5 DEF TEMP DEC -6 * INA,SZA ANY ERRORS? JMP GETL YES, TRY AGAIN. LDA TEMP GET FIRST WORD OF REPLY JSB RPYCK SEE IF REPLY JMP GETL1 NOT REPLY...IGNORE JSB RESET RESET BUSY FLAG * LDA TEMP+2 STORE LOGICAL UNIT. STA TMP,I (A) = LU. * JMP GETLU,I RETURN. * COMND OCT 0 2-WORD "PARMB". NOP SKP * * SUBROUTINE TO CHECK IF REPLY IS RECIEVED * CALLING SEQUENCE * JSB RPYCK * ERROR RETURN * NORMAL RETURN * A REG=FIRST WORD OF REPLY * SPC 1 RPYCK NOP RAL SSA REQUEST OR REPLY ISZ RPYCK REQUEST JMP RPYCK,I AND RETURN SKP .ENTR NOP LDB .ENTR,I STB DEST CMB ADB .ENTR STB MPLS1 ADB DEST ADB MD1 LDA 1,I STA SORCE IOR IBIT STA 1,I RAL,CLE,ERA CMA,INA ADA SORCE,I STA 1 CMA,INA ADA MPLS1 SSA LDB MPLS1 ISZ .ENTR CMB,INB LOOP1 INB,SZB,RSS JMP .ENTR,I ISZ SORCE LDA PSORCE,I IND1 RAL,CLE,SLA,ERA JMP INDIR STA DEST,I ISZ DEST JMP LOOP1 INDIR LDA 0,I JMP IND1 IBIT DEF 0,I * DEST NOP MPLS1 NOP SORCE NOP SKP *************************** * EXECUTE LOADED PROGRAM. ************************** *************************** * * PURPOSE - TRANSFER CONTROL TO A PROGRAM IN THE * TERMINAL. * * CALLING * SEQUENCE: JSB RNPGM * DEF RETURN ADDRESS * DEF START ADDRESS (OPT.) * DEF P1 OPTIONAL PARAMETERS. * DEF P2 ADDR OF FIRST PARAM IS * DEF P3 PASSED IN THE B-REG * DEF P4 TO THE PROGRAM. * DEF P5 SPC 5 RNPGM NOP ENTRY. * JSB SETUP INITIALIZE FOR "RUN PROGRAM". * LDB PARV+1 (B) = ADDR OF OPTIONAL PARAM DEF'S. * LDA PARV,I WAS A START SZA ADDRESS SPECIFIED? STA IADR SAVE THE ADDRESS. LDA IADR SZA JMP IADR,I NO, USE DEFAULT. JMP URTN,I ERROR. SKP ************************ * SEND REMOTE MESSAGE. **************************** ************************ * * PURPOSE - SENDS AN ASCII MESSAGE TO THE CENTRAL * OPERATOR. * * CALLING * SEQUENCE: JSB RMESG * DEF *+4 * DEF STATUS * DEF MESSAGE ADDRESS * DEF MESSAGE LENGTH SPC 5 RMESG NOP ENTRY. * JSB SETUP INITIALIZE FOR "REMOTE MESSAGE". * LDA PARV STA RMSTA DEF STATUS. LDA PARV+1 GET USER MESSAGE ADDR. STA TEMP USE FOR SOURCE BUFFER ADDR. LDB PARV+2,I SSB,RSS USE DEFAULT IF NEGATIVE LENGTH RM1 CMB,INB,SZB,RSS NEGATE WD-CNT, CHECK FOR ZERO JMP RDFLT BAD LENGTH. USE DEFAULT VALUE LDA B MUST BE .LE. 37 WORDS. ADA D37 SSA,RSS JMP RM2 RDFLT LDB D36 JMP RM1 RM2 STB MSLEN SAVE MESSAGE LENGTH LDA BUFAeD DESTINATION BUFFER ADDR. ADA B3 STA TEMP+1 RMOVE LDA TEMP,I MOVE MESSAGE TO OUTPUT BUFFER. STA TEMP+1,I ISZ TEMP ISZ TEMP+1 INB,SZB JMP RMOVE * LDA TMID STORE ID HEADER IN BUFFER. STA BUFFR LDA TMID+2 STA BUFFR+2 LDA LU LU ALREADY KNOWN? SZA JMP RID YES. JSB GETLU NO, GET IT. DEF *+2 DEF LU RID LDB TMIDF JSB BTOA CONVERT LU TO ASCII. * LDA MSLEN RETRIEVE MSG LENGTH CMA,INA FORM POSITVE WORD COUNT ADA B3 ADD HEADER WORD COUNT STA TEMP SAVE LENGTH FOR 'REXEC' CALL * JSB REXEC SEND THE MESSAGE. DEF *+6 RMSTA NOP STATUS. DEF B2 RCODE. DEF B1 CONTROL WORD. DEF BUFFR ADDRESS DEF TEMP LENGTH. * JMP URTN,I RETURN TO CALLER. * D36 DEC 36 TMIDF DEF BUFFR+1 TMID ASC 3,=S : SKP ****************************************** * LOAD PROGRAM FROM CENTRAL AND EXECUTE. *********** ****************************************** * * PURPOSE - CALLS RLOAD TO LOAD THE PROGRAM, THEN * CALLS RNPGM TO EXECUTE IT. * * CALLING * SEQUENCE: JSB CHAIN * DEF RETURN ADDRESS * DEF STATUS * DEF ERROR CODE * DEF PROGRAM NAME. * DEF START ADDRESS (OPT.) * DEF P1 OPTIONAL PARAMS. * DEF P2 * DEF P3 * DEF P4 * DEF P5 SPC 5 CHAIN NOP ENTRY. * JSB SETUP INITIALIZE FOR "CHAIN". LDA URTN STA CHAIN * LDA PARV TRANSFER PARAM ADDR'S. STA CTEMP+2 ADDR OF ISTAT PARAM. LDA PARV+1 STA CTEMP+3 ADDR OF IERR PARAM. LDA PARV+2 STA PNAM ADDR OF PROG NAME. LDA PARV+3 SZA FETCH START ADDR LDA A,I (IF SPECIFIED).  REXEC TIME CALL? CPA D11 RSS JMP CMPL4 NO. LDA P.PTR,I YES. RETURN TIME ARRAY. JSB INDCK CHASE DOWNTHOSE LITTLE BITS STA P.PTR LDB MD5 TLOOP LDA I.PTR,I STA P.PTR,I ISZ P.PTR ISZ I.PTR INB,SZB JMP TLOOP JMP EXIT * CMPL4 CPA D13 REXEC I/O STATUS CALL? RSS JMP EXIT NO. ISZ P.PTR SKIP OVER CONTROL WORD. LDB MD2 YES. PASS PARAMS. JSB PINTG * * RETURN TO USER PROGRAM. * EXIT LDA CALL,I GET RETURN ADDRESS. STA TEMP1 LDA REPLY+2 SET A, B REGISTERS. LDB REPLY+3 JMP TEMP1,I RETURN. SKP ********************** * SUBROUTINE SECTION ******************************* ********************** * * STORE INTEGER PARAM FROM USER CALL INTO PARMB. * INTGR NOP JSB PCHEK IS THE PARAM SPECIFIED? JMP MSSNG NO. LDA B202 YES, STORE CONTROL BYTE. JSB STBYT JSB GET.P FETCH PARAM VALUE. JSB STWRD STORE IN PARMB. JMP INTGR,I (A) HAS THE VALUE. * * STORE OPTIONAL INTEGER PARAM (IF SPECIFIED) FROM * USER CALL INTO PARMB. * OPTN NOP JSB PCHEK IS PARAM SPECIFIED? JMP OPTN,I NO (LEAVE P.PTR ALONE). JSB INTGR YES, STORE IT. JMP OPTN,I (A) HAS THE VALUE. * * STORE 6 CHAR ASCII STRING FROM USER CALL * INTO PARMB. * STRNG NOP JSB PCHEK IS PARAM SPECIFIED? JMP MSSNG NO. * LDA B6 STORE CONTROL BYTE. JSB STBYT LDA MD3 STA TEMP2 WORD COUNTER. JSB GET.A STA TEMP3 STRING START ADDR. * STR LDA TEMP3,I FETCH ASCII CHARACTERS. ALF,ALF JSB STBYT STORE LEFT BYTE. LDA TEMP3,I JSB STBYT STORE RIGHT BYTE. * ISZ TEMP3 BUMP TO NEXT INPUT WORD. ISZ TEMP2 DONE? JMP STR NO. JMP STRNG,I YES, EXIT. * * STORE A-REGISTER CONTENTS INTO NEXT WORD * OF SAVED VALUES. * RPARM NOP LDB U.PTR,I STA B,I ISZ U.PTR JMP RPARM,I * * STORE USER BUFFER LENGTH IN PARMB, DATA-FLAG, * AND SAVE IT. * STLEN NOP JSB INTGR STORE IN PARMB. * SZA,RSS JMP WRONG SPECIFIED, BUT ZERO. SSA,RSS NEGATIVE? JMP STL NO. * CMA,INA YES, MAKE POSITIVE. INA ROUND UP. ERA,CLE,ELA RAR CONVERT TO WORD COUNT. * STL STA PARMB,I STORE IN DATA-FLAG. JSB RPARM PASS BACK TO CALLER. JMP STLEN,I EXIT. * WRONG LDA MD4 JMP SSTAT * * TEST WHETHER THE USER HAS SPECIFIED * A PARAMETER. * JSB PCHEK * ERROR RETURN (PARAM NOT GIVEN) * NORMAL RETURN * PCHEK NOP LDA P.PTR PARAM ADDR CMA,INA ADA CALL,I RETURN ADDRESS. ADA MD1 SSA,RSS ISZ PCHEK JMP PCHEK,I * * GET VALUE OF NEXT PARAM IN USER CALL * GET.P NOP JSB GET.A FETCH PARAM ADDR. LDA A,I GET PARAM VALUE. JMP GET.P,I * * GET ADDRESS OF NEXT PARAM IN USER CALL * AND BUMP PARAM POINTER. * GET.A NOP LDA P.PTR,I GET PARAMETER ADDRESS. JSB INDCK CHASE DOWN THOSE BITS ISZ P.PTR BUMP PARAM POINTER. JMP GET.A,I * * STORE WORD (IN A-REG) IN PARMB. * STWRD NOP STA TEMP2 SAVE WORD. ALF,ALF JSB STBYT STORE LEFT BYTE. LDA TEMP2 JSB STBYT STORE RIGHT BYTE. LDA TEMP2 RESTORE WORD. JMP STWRD,I RETURN. * * STORE BYTE IN NEXT BYTE OF PARMB. * STBYT NOP (A) = BYTE RIGHT JUSTIFIED. AND M377 ISOLATE NEW BYTE. STA TEMP1 SAVE. LDB B.PTR FORM WORD ADDR OF PARMB. CLE,ERB (E) = LEFT/RIGHT FLAG. ADB PARMB * LDA B,I INSERT NEW BYTE INTO PARMB. SEZ,RSS ALF,ALF AND yM377L IOR TEMP1 SEZ,RSS ALF,ALF STA B,I * ISZ B.PTR BUMP RELATIVE BYTE POINTER. JMP STBYT,I RETURN. * * * PASS A-REG CONTENTS TO USER PARAM. * RWORD NOP STA TEMP1 JSB PCHEK IS PARAM SPECIFIED? JMP RWORD,I NO. LDA P.PTR,I GET ADDRESS JSB INDCK CHECK INDIRECTS LDB TEMP1 GET VALUE STB A,I AND SAVE IT ISZ P.PTR JMP RWORD,I * * PASS N PARAMS TO USER PROGRAM. (B)= -N. * PINTG NOP STB TEMP2 PLOOP LDA I.PTR,I JSB RWORD ISZ I.PTR ISZ TEMP2 JMP PLOOP JMP PINTG,I SPC 2 * * SUBROUTINE TO SET THE DRIVER BUSY FLAG * CALLING SEQUENCE * JSB STBSY * B REG LOST * STBSY NOP LDB $BUSY STB SVBSY SAVE PREVIOUS STATUS CLB,INB SET IT BUSY STB $BUSY SET BUSY FLAG JMP STBSY,I AND RETURN SPC 2 * * SUBROUTINE TO CHASE DOWN INDIRECTS * CALLING SEQUENCE * JSB INDCK * A REG=ADDRESS B REG NOT TOUCHED * INDCK NOP RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I RETURN WITH DIRECT ADDRES SKP ********************************* * CONSTANTS AND WORKING STORAGE ******************** ********************************* * B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D124 DEC 124 D154 DEC 154 D160 DEC 160 D162 DEC 162 MD1 DEC -1 MD2 DEC -2 MD3 DEC -3 MD4 DEC -4 MD5 DEC -5 MD7 DEC -7 MD150 DEC -150 MD163 DEC -163 B50 OCT 50 B100 OCT 100 B200 OCT 200 B300 OCT 300 B20K OCT 20000 B30K OCT 30000 B202 OCT 202 B202L OCT 101000 B204 OCT 204 M377 OCT 377 M377L OCT 177400 MSK OCT 177700 * RDATA NOP READ DATA FLAG. FCN NOP FUNCTION CODE. CALL NOP AD9KHFBDR OF USER CALL +1. .FCN NOP 0= REXEC, -= RFA. .RCD NOP REXEC REQUEST CODE. P.PTR NOP USER CALL PARAM POINTER. B.PTR NOP PARMB BYTE POINTER. U.PTR NOP I.PTR NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP ISTAT NOP COMMUNICATION STATUS. $BUSY NOP SVBSY NOP DELAY NOP DEL NOP * PARMB NOP PRMB BSS 26 PARAM BUFFER (PARMB). * RPLY DEF REPLY REPLY BSS 12 REPLY BUFFER. * UPARM DEF UPRM UPRM DEF DADR DEF DLEN DEF PLEN * DABFA DEF PRMBA * PRMBA DEF PRMB PLEN NOP DADR NOP DLEN NOP * BSS 0 * END H fw 91703-18104 1614 S 0122 DS1/B SCE/3 MODULE: #TAM              H0101 ~`ASMB,R,L,C HED #TAM 91703-16104 * (C) HEWLETT PACKARD CO. 1976 NAM #TAM 91703-16104 REV A 760329 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 * ************************************************** * *#TAM TERMINAL ACCESS MONITOR FOR BCS TO RUN IN RTEII * *SOURCE PART # 91703-18104 * *REL PART # 91703-16104 * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 09-30-74 * *MODIFIED BY: BOB SHATZER (04-07-75) * DAN GIBBONS (01-08-76) * ************************************************** SPC 1 * * THIS SUBROUTINE INTERFACES A BCS USER TO THE * D.65 COMMUNICATIONS DRIVER. * ENT #TAM,$C.LU,TMOUT,INT65 * EXT .IOC.,XEQT * * DURING GENERATION, THE USER MUST SPECIFY THE DATA RATE OF HIS * PARTICULAR COMMUNICATIONS LINE IN ORDER FOR THE I/O TIMEOUT * VALUES TO BE SET UP PROPERLY. THIS IS DONE BY DESIGNATING A * DIFFERENT UNIT NUMBER FOR EACH DATA RATE, AS FOLLOWS: * * UNIT # DATA RATE I/O CARD * * 0 1 MEG 12665 * 1 150 12773 * 2 300 12773 * 3 600 12773 * 4 1200 12773 * 5 2400 12773 * 6 4800 12773 * 7 9600 12773 * * IF THE USER'S MODEM RATE IS NOT AS SPECIFIED, THE NEXT SLOWEST * RATE SHOULD BE USED. * * THE SETUP IS DONE BY AN INITIALIZATION CALL TO #TAM, AS SHOWN * BELOW. THIS CALL MUST BE MADE PRIOR TO THE FIRST USAGE OF THE * COMM LINK BY THE SATELLITE OR CENTRAL. IF D.65 IS NOT CONFIGURED * INTO THE SYSTEM, #TAM WILL HALT AT THE END OF THE INITIALIZATION * ATTEMPT (HLT 13B). #TAM IS INITIALIZED UPON ITS FIRST ENTRY,SO * THE INITIALIZATION CALL NEED NOT BE MADE PRIOR TO A CALL TO #TAM. * * ON RETURN TO THE CALLER IF COMPLETED IMMEDIATELY, THE A * REGISTER CONTAINS THE STATUS CODE AND THE B * REGISTER WILL POINT TO THE BUFFER. * * STATUS CODES: * * -3 COMMUNICATIONS I/O ERROR. * -1 REQUEST COMPLETED, NO ERRORS. * 0 REQUEST BEING PROCESSED. * 1 ILLEGAL TAM REQUEST CODE. * 2 COMMUNICATIONS LINE DOWN OR XMSN ERROR. * 3 NOT ENOUGH PARAMS IN TAM CALL. * 4 ILLEGAL REQUEST LENGTH RECEIVED * 5 RFA BUSY (REQUEST OVERFLOW AT REMOTE). * * FOR ERROR STATUS BITS SET IN EQT: * * 61 - BIT 2 LENGTH ERROR . * 62 - BIT 3 ILLEGAL STOP SENT..HAVE RETRIED * 63 - BIT 4 SIMULTANEOUS REQUEST. * * (60-63 DECIMAL = 74-77 OCTAL) * * CALLING * SEQUENCES: * A-REG. = 1 FOR SEND/RECV "REQUEST". * = 0 FOR SEND/RECV "DATA". * * PUT DATA STREAM: * * JSB #TAM * DEF *+4 * DEC 6 * DEF DATA BUFFER * DEC BUFFER LENGTH (NEGATIVE BYTES) * * * GET DATA STREAM: * * JSB #TAM * DEF *+4 * DEC 5 * DEF DATA BUFFER * DEC BUFFER LENGTH (NEGATIVE BYTES) * * * EXTENDED PUT, CONVERSATIONAL - * * TRANSMIT REQUEST AND RECEIVE OR TRANSMIT DATA * (SPECIAL INTERFACE TO D.65 FOR REMOTE CALLS * THAT INVOLVE A DATA BUFFER): * * (A) = 0 FOR RECEIVE DATA * (A) = 1 FOR TRANSMIT DATA * * JSB #TAM * DEF *+6 * DEC 8 * DEF REQUEST BUFFER ADDRESS * DEC REQ. BUFFER LENGTH (NEG. BYTES) * DEF DATA BUFFER ADDRESS * DECi DATA BUFFER LENGTH (NEGATIVE BYTES) * * * TRANSMIT STOP REPLY: * * JSB #TAM * DEF *+2 * DEC 2 * * * INITIALIZE: * * JSB #TAM * DEF *+2 * OCT 0 * * REGISTERS ARE MEANINGLESS UPON ENTRY AND EXIT FROM THIS CALL. * * NOTE THAT THIS CALL MUST BE MADE PRIOR TO USAGE OF THE COM- * MUNICATIONS LINK BY EITHER THE SATELLITE OR CENTRAL. * * #TAM NOP INA STA IMODE SAVE REQUEST/DATA CODE. * THERE JSB $INIT GO AND INITIALIZE I/O LDA D0 GET A NOP STA THERE AND OVERLAY INITIALIZATION CALL * LDA #TAM LDB A,I SAVE RETURN ADDRESS. STB RETRN INA LDB A,I (B) = REQUEST CODE STB RCODE INA STA PARAD ADDR OF PARAMETER LIST * CMA,INA ADA RETRN (A) = NUMBER OF PARAMETERS STA N.PRM * CPB D0 INITIALIZE? JMP RETRN,I YES - RETURN, SINCE IT'S BEEN DONE CPB D2 STOP REPLY? JMP STOP YES, TAKE SHORTCUT. LDA PARAD FETCH BUFFER ADDRESS. JSB INDCK STA TRA1 PLACE INTO IOC CALL. STA RTNB PSEUDO STMID ADDR. ISZ PARAD LDA PARAD,I FETCH BUFFER LENGTH. CMA,INA CONVERT TO WORDS SLA INA RAR STA TRA2 * LDA N.PRM LDB RCODE IS THIS A GET OR A PUT? CPB D5 JMP RECV GET DATA STREAM. CPB D6 JMP SEND PUT DATA STREAM. CPB D8 JMP CNVER PUT, CONVERSATIONAL * CLA,INA ILLEGAL REQUEST CODE. JMP ERRXT ERR3 LDA D3 NOT ENOUGH PARAMETERS SUPPLIED. JMP ERRXT SPC 3 $INIT NOP LDA B7 CONFIGURE IOC CALL. STA $C.LU INITIALIZE LU COUNTER. LDB XEQT GET ADDRESS OF EQT TABLE LDA B,I FETCH # EQT ENTRIES. CMA,INA STA CNTR ADB D2 FETCH @FWA FIRST EQT,WORD 2. CNF1 LDA B,I AND EQTM MASK ALL BUT EQT TYPE CPA D65C IS IT D.65? JMP CNF2 YES. ADB D4 NO, LOOK AT NEXT EQT. ISZ $C.LU BUMP LU COUNTER. ISZ CNTR JMP CNF1 HLT 13B NO D.65 EQT. JMP *-1 * CNF2 ADB MD1 GET TO EQT WORD1 LDA B,I ALF,ALF RAL,RAL AND B7 ISOLATE UNIT NUMBER ADA TMTBL ADD TO TIMEOUT TABLE ADDRESS LDA A,I GET T/O VALUE FROM TABLE STA TMOUT AND SET UP TIMEOUT VALUE * LDA SCNWD SET LU IN STATUS CALL. AND MSK IOR $C.LU STA SCNWD LDA STOPC SET LU IN STOP CALL. AND MSK IOR $C.LU STA STOPC LDA $C.LU SET LU IN CLEAR I/O CALL. STA CLCNW JMP $INIT,I RETURN * * THE FOLLOWING IS A TABLE OF TIMEOUT VALUES FOR EACH COMM LINK * DATA RATE. THE VALUES ARE -2(N+1) WHERE N IS THE NUMBER OF * THREE SECOND INTERVALS REQUIRED TO HANDLE A 512 WORD REQUEST * AND DATA CALL OVER 2000 MILES OF COMMUNICATIONS LINE. THIS * TABLE IS INDEXED BY THE UNIT NUMBER SPECIFIED IN THE D.65 * EQT AT GENERATION TIME. * TMTBL DEF *+1 DEC -3 12665 CARD (1 MEGABIT) DEC -106 12773 CARD (150 BPS) DEC -61 300 BPS DEC -38 600 BPS DEC -27 1200 BPS DEC -21 2400 BPS DEC -19 4800 BPS DEC -17 9600 BPS * SPC 5 CNVER CPA D4 CHECK PARAM COUNT. RSS JMP ERR3 NOT ENOUGH PARAMS. * LDA TRA1 STA TRAA LDA TRA2 STA TRAB * ISZ PARAD GET DATA BUFFER ADDR. LDA PARAD JSB INDCK STA TRA3 * ISZ PARAD LDA PARAD,I FETCH DATA BUFFER LENGTH CMA,INA CONVERT TO WORDS. SLA INA RAR STA TRA4 LDA TRA STA TRA1 LDA D4 STA TRA2 * LD.A IMODE LDB SRAD SEND REQUEST AND DATA COMMAND JMP DIO GO PROCESS REQUEST AND DATA SPC 5 SEND CPA D2 CHECK PARAM COUNT. RSS JMP ERR3 NOT ENOUGH PARAMETERS. * LDA D2 GET MODE WORD LDB DATA GET FOR DATA TRANSFER CPA IMODE IS IT A DATA REQUEST LDB REQ NO...READ REQUEST JMP DIO GO DO IT SPC 5 RECV CPA D2 CHECK PARAM COUNT. RSS JMP ERR3 NOT ENOUGH PARAMS. * LDB REQ GET REQUEST CONTROL WORD LDA B1 GET RECEIVE FLAG...DATA FLAG CPA IMODE DATA OR REQUEST? LDB DATA DATA JMP DIO SPC 3 STOP CLA STA CONWD SET CONWD=0...FAKE READ FOR WAIT INTERVAL JSB .IOC. SEND STOP REPLY. STOPC OCT 30400 JMP *-2 JMP DIO1 SPC 3 * * DIO...A REG CONTAINS READ WRITE FLAG * 1=READ 2=WRITE * B REG CONTAINS SUBMODE * 100=REQ AND DATA 200=DATA 300=REQ * DIO ALF,ALF GET READ WRITE FLAG TO BIT 12 ALF IOR $C.LU MASK IN LU IOR B MASK IN SUBMODE STA CONWD SAVE CONTROL WORD LDA MD10 MAX OF 10 RETRYS ON PARITY OR SIMULTANEOUS REQ. STA PARCT SAVE IN DOWN COUNTER * DIO0 JSB GOIOC PERFORM D.65 IOC CALL. DIO1 LDB TMOUT GET TIMEOUT VALUE STB DELAY SAVE IN DOWN COUNTER CLA STA DEL JSB STATS WAIT FOR COMPLETION. JSB SETER SET TAM ERROR CODE. JMP DIO0 RE-TRY SPC 3 ERRXT BSS 0 LDB RTNB (B) = ADDR OF STMID. JMP RETRN,I SPC 3 GOIOC NOP JSB .IOC. RECEIVE OR TRANSMIT CONWD OCT 0 DATA OR REQUEST. JMP *-2 TRA1 NOP TRA2 NOP JMP GOIOC,I * STATS NOP JSB .IOC. STATUS CALL. SCNWD OCT 40000 SSA,RSS JMP SCN * ISZ DEL COUNT TIME. JMP STATS+1 ISZ DELAY JMP STATS+1 * JSB .IOC. TIME OUT...CLEAR I-O CLCNW OCT 0 LDA B200 FORCE "LINE DOWN " ERROR" * SCN ALF,ALF BIT 6 (NO REQ RECV) SET? RAL SSA JMP GOIOC+1 YES, REPEAT READ CALL. ALF,ALF NO. RAR * JMP STATS,I * SETER NOP (A) = EQT STATUS. AND B377 MASK OFF ALL BUT STATUS CPA D8 SEE IF STOP SENT INB,SZB IF SO,WAS LENGTH=-1 RSS NO..NO STOP, OR LENGTH NOT -1 CLA,INA YES,LEGAL STOP. TREAT SAME AS NO ERRORS SLA BIT 0 LDB MD1 NO ERRORS REQUEST COMPLETED RAR,SLA BIT 1 LDB D4 REQ NOT ACCEPTED...LENGTH ERROR RAR,SLA BIT 2 LDB B75 NO DATA...DATA CALL WITHOUT REQ RAR,SLA BIT 3 LDB B76 ILLEGAL STOP SENT. REPORT AFTER RETRY RAR,SLA BIT 4 LDB B77 SIMULTANEOUS REQUEST. RAR,SLA BIT 5 LDB MD3 PARITY ERROR. RAR,SLA BIT 6 LDB B74 NO REQUEST RECEIVED. RAR,SLA BIT 7 LDB D2 BROKEN LINE CPB B76 ILLEGAL STOP? RSS YES...RETRY CPB B77 SIMULTANEOUS REQUEST? RSS YES..ONE OF THE THREE JMP *+3 NO...IRRECOVERABLE ERROR ISZ PARCT INCREMENT PARITY COUNT RSS RE-TRY ISZ SETER GIVE CONTROL BACK TO USER LDA B JMP SETER,I SPC 1 B377 OCT 377 SPC 1 * INDCK NOP LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I SPC 1 INT65 NOP DUMMY TO SATISFY D.65 EXT JMP INT65,I SKP * CONSTANTS AND WORKING STORAGE. * TMOUT NOP IMODE OCT 0 DATA XMSN MODE, DRIVER SUBMODE. TRA DEF *+1 TRAA OCT 0 ADDR OF DATA BUFFER. TRAB OCT 0 BUFFER LENGTH. TRA3 OCT 0 TRA4 OCT 0 $C.LU OCT 0 LOGICAL /*($UNIT OF REMOTE COMPUTER. DATA OCT 200 DATA SUBMODE REQ OCT 300 REQUEST SUBMODE SRAD OCT 100 REQUEST AND DATA SUBMODE MSK OCT 177700 DEL NOP DELAY NOP PARCT NOP A EQU 0 B EQU 1 RETRN OCT 0 CALLER'S RETURN ADDRESS. RCODE OCT 0 REQUEST CODE. PARAD OCT 0 ADDR OF PARAMETER LIST. N.PRM OCT 0 NUMBER OF PARAMETERS. RTNB OCT 0 (B) RETURNED BY TAM. CNTR OCT 0 MD1 DEC -1 MD3 DEC -3 MD10 DEC -10 D0 OCT 0 B1 OCT 1 D2 OCT 2 D3 OCT 3 D4 OCT 4 D5 OCT 5 D6 OCT 6 B7 OCT 7 B200 EQU DATA NEED OCTAL 200 D8 DEC 8 D65C OCT 32400 EQTM OCT 77400 B74 OCT 74 B75 OCT 75 B76 OCT 76 B77 OCT 77 * BSS 0 * END Ы* g s 91703-18105 1419 S 0122 DS1/B SCE/3 MODULE: D.00D              H0101 ASMB,R,L,C HED D.00D 91703-16105 * (C) HEWLETT PACKARD CO. 1976 NAM D.00D 91703-16105 REV A 740509 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************** * *D.00D TELETYPE DRIVER FOR DS1-B * *SOURCE PART # 91703-18105 * *REL PART # 91703-16105 * *WRITTEN BY: JIM HARTSELL * *DATE WRITTEN* * *DATE MODIFIED: 5-9-74 * ********************************************* * * ***************************************** * D.00 CRT/TELEPRINTER DRIVER FOR * 9701 BCS TERMINALS. ***************************************** * ENT D.00,I.00 * EXT ATTEN EXT $BUSY EXT $ESC * TTY EQU 15B NOMINAL TTY CHANNEL * * THIS MODULE OF THE HP-2116 BASIC CONTROL SYSTEM * SOFTWARE IS DESIGNED TO OPERATE THE ASR-33/35 * TELE-TYPEWRITER. THE FUNCTION OF THIS DRIVER IS * TO INITIATE, CONTINUE AND COMPLETE A READ/WRITE * OPERATION REQUESTED THROUGH INPUT/OUTPUT CONTROL. * * THE DRIVER WILL REJECT A -FUNCTION SELECT- * REQUEST AS NONE OF THE DEFINED FUNCTIONS IS * APPLICABLE FOR THE ASR DEVICE. * * *** D.00 INITIATOR SECTION *** * SKP D.00 NOP D.00 NOP * ENTRY / EXIT * STA SAVA SAVE EQT ENTRY ADDRESS. STB RQA SAVE REQUEST ADDRESS LDA B,I GET WORD 2 OF REQUEST, ROTATE ALF REQUEST CODE TO LOW A AND O17 ISOLATE FUNCTION CODE LDB DFLG CHECK DRIVER FLAG - SZB DRIVER IDLE? SZA,RSS CLEAR? RSSI RSS YES. ACCEPPT COMMAND. JMP REJB REJECT THIS REQUEST. ADA M3 SUBTRACT 3 FROM CODE SSA,RSS IF RESULT +, THEN ILLEGAL CODE, JMP RCER REJECT REQUEST. 1,2 LEGAL. * LDA SAVA,I GET WORD 1 OF EQT ENTRY. AND O77 GET I/O SLOT IOR LIAI STA I.6 LIA TTY (102500) ADA O100 STA I.10 OTA TTY (102600) ADA O1100 STA ISYN1 STC,C TTY (103700) XOR OTBM STA I.9 OTB TTY (106600) * ACC2 ISZ SAVA SET ADDRESS OF EQT ENTRY TO LDA SAVA GET EQT ADDRESS STA EQT2 POINTER TO STATUS INA STA EQT3 POINTER TO LOG LDA D.00 MOVE RETURN ADDRESS... STA I.00 TO "DISMISS INTERRUPT." STA DFLG SET DRIVER FLAG BUSY (NOT = 0). CLA STA CHC AND CHARACTER COUNTER STA SAVAX AND SET TO TELL IOC ALL OK. LDA RQA,I GET FUNCTION CODE ALF AND O17 SZA,RSS CHECK FUNCTION CODE: CLEAR? JMP CLEAR YES. SET STATUS AND EXIT. * LDA RQA,I GET FUNCTION CODE STA FUNC SAVE IT CLB,CLE CLEAR "B", CLEAR "E". ALF,ALF RAL,ELA PUT BINARY MODE BIT INTO ERB SIGN BIT OF B. LDA EQT2,I GET STATUS WORD IOR IBIT SET O-FIELD = 2 (BUSY) AND STA EQT2,I STORE. ISZ RQA ISZ RQA LDA RQA LDA A,I GET BUFFER ADDRESS. RAL,CLE,SLA,ERA IF INDIRECT, JMP *-2 GET DIRECT ADDRESS. STA BUF SAVE BUFFER ADDRESS. STA BUFS ISZ RQA LDA RQA,I GET BUFFER LENGTH. SSA INB,RSS NEGATIVE: FLAG CHARS IN LOG. ALS,SLA POSITIVE: DOUBLE FOR CHARS CMA,INA NEGATIVE: MAKE POSITIVE CHARS. STA IOSYZ SAVE POSITIVE CHAR COUNT STB EQT3,I STORE FLAG IN XMIT LOG LDB FUNC BLF,SLB INPUT OR OUTPUT? JMP INGO INPU-|T. JMP TTYO OUTPUT * RCER CLB,RSS ---REJECT SECTION R. C. ERROR (B=0). REJB LDB IBIT DEVICE/DRIVER NOT AVAILABLE CLA,INA SET (A) NON-ZERO AND JMP D.00,I EXIT TO IOC AND REJECT. * * *** CONTINUATOR SECTION *** * ENTERED AT I.00 BY TTY INTERRUPT. * ISYNC NOP I.10 OTA TTY OUTPUT CHAR OR INSTR LDA SAVEX CLO SLA,ELA STF 1 OVERFLOW ON LDB SAVBX STF 0 ISYN1 STC TTY,C START TTY CLOCK LDA OPINT SZA JMP ISYN2 LDA SAVAX JMP I.00,I DISMISS INTERRUPT ISYN2 CLA STA OPINT JMP ATTEN PROCESS OPERATOR ATTENTION. * I.00 NOP TTY INTERRUPT HERE STA SAVAX SAVE A, STB SAVBX B, ERB,BLS E, SFC 1 AND INB OVERFLOW STB SAVEX I.6 LIA TTY AND O177 REMOVE 8-LEVEL BIT JMP ISYNC,I RETURN TO CALLING ROUTINE. * SKP * * INPUT SECTION * RDCH NOP INPUT A CHARACTER LDB FUNC LDA DA READ AND ECHO INSTRUCTION BLF,BLF SLB,RSS TEST "P" (PRINT) LDA DB READ ONLY INSTRUCTION JSB ISYNC GET A CHARACTER. JSB TSTCH CHECK FOR CONTROL JMP RDCH,I * INGO LDA BUFS RESET STARTING BUFFER ADDRESS. STA BUF CLB JMP INA4 GO GET FIRST CHAR. * IASC2 JSB RDCH READ ASCII CHARACTER STA CH SAVE IT SZA,RSS NULL? JMP IASC2 YES. IGNORE CPA O12 LINE FEED? JMP IASC2 YES, IGNORE. CPA O15 CAR RETURN? JMP IRETN YES, END OF RECORD CPA RUBO RUBOUT? JMP RDEL DELETE RECORD CPA BAKSP BACKSPACE CHAR? JMP DELE DELETE PREVIOUS CHAR. CPA BKSPC BACKSPACE KEY? JMP DELE2 DELETE PREVIOUS CHARACTER. LDB CHC CPB IOSYZ BUFFER FULL (ASCII)?4 JMP IASC2 YES. LOOK FOR CAR RETURN. * * INSERT CHARACTER IN BUFFER * IBIN3 LDB CHC SLB,INB,RSS SKIP IF LOWER CHAR ALF,SLA,ALF UPPER. ALWAYS SKIP X.6 XOR BUF,I COMBINE LOWER WITH PRIOR XOR O40 INSERT/REMOVE BLANK STA BUF,I STORE IN BUFFER SLB,RSS IF LOWER CHAR, ISZ BUF ADD 1 TO BUFFER ADDRESS INA4 STB CHC CHARS IN BUFFER LDA EQT3,I GET MODE SSA,RSS JMP IASC2 ASCII. GO READ CHAR. CPB IOSYZ BUFFER FULL (BINARY)? JMP STAT YES, EXIT. JSB RDCH READ BINARY CHARACTER JMP IBIN3 GO STORE IT. * SKP DELE LDA O137 OUTPUT BACK-ARROW. JSB TYO DELE2 LDB CHC DELETE A CHARACTER. SZB,RSS JMP IASC2 BUFFER EMPTY: IGNORE CCA ADB A SLB,RSS IF LEFT CHAR DELETED, JMP INA4 DONE. ADA BUF STA BUF BACK UP POINTER LDA BUF,I AND O377 GET RIGHT HALF JMP X.6 GO PURGE IT. * RDEL JSB KILL CANCEL INPUT. JMP INGO * KILL NOP LDA O134 OUTPUT BACKSLASH. JSB TYO LDA O15 OUTPUT CARRIAGE RETURN. JSB TYO LDA O12 OUTPUT LINE FEED. JSB TYO JMP KILL,I * TSTCH NOP CHECK FOR CONTROL CHARACTER CPA O33 ESCAPE (OPERATOR BREAK)? JMP CC YES. GO PROCESS IT. CPA O176 JMP CC JMP TSTCH,I * CC LDA $BUSY REMOTE I/O BUSY? SZA,RSS JMP *+3 NO, ACCEPT THE INTERRUPT. STA $ESC YES, SET $ESC JMP TSTCH,I AND IGNORE INTERRUPT. CLA OPERATOR BREAK. STA CHC INA FLAG OPERATOR INPUT. STA OPINT JMP CLEAR CLEAR THE DRIVER. * * PROCESS CARRIAGE RETURN: END OF MESSAGE * IRETN LDA O12 ECHO LINEFEED JSB TYO LDB CHC THESE SIX INSTRUCTIONS ... SZB  DEFAULT A NULL INPUT ... JMP STAT LDA LBLNK INTO A SINGLE BLANK. STA BUF,I ISZ CHC JMP STAT * * STATUS SECTION * CLEAR BSS 0 STAT LDA EQT2,I GET STATUS WORD AND MST (37400) PRUNE PRIOR STATUS STA EQT2,I STORE STATUS WORD LDB CHC LDA EQT3,I DOES USER WANT CHARS OR WORDS? SLA,ELA SKIP IF WORDS. BINARY FLAG TO E RBL,SLB CHARS. DOUBLE AND SKIP. INB WORDS. ROUND COUNT UP. ERB HALVE COUNT, COMBINE BINARY BIT STB EQT3,I STORE IN XMIT LOG. CLB CLEAR DRIVER-BUSY FLAG. STB DFLG * IDLE LDA DA ECHO INPUT JSB ISYNC IDLE LOOP JSB TSTCH CHECK FOR CONTROL CHARACTER JMP IDLE IGNORE INPUT * SKP * * OUTPUT SECTION * TTYO JSB OUTGO DUMP THE BUFFER JMP STAT ALL DONE. * OUTGO NOP SUBROUTINE TO DUMP BUFFER CMA STA CHX -CHAR COUNT-1 CLB STB CHC INITIALIZE OUTPUT COUNT OUTLP JSB GETCH GET CHAR FROM BUFFER SSB,RSS IF BINARY, OR SEZ IF HONESTY MODE, JMP OUTC GO OUTPUT CHAR. LDB CHX CPA O137 IS IT A LEFT ARROW? INB,SZB IS IT ALSO LAST CHARACTER? JMP OUTC NO. GO OUTPUT. JMP OUTGO,I SUPPRESS CR/LF. * OUTC JSB TYO JMP OUTLP * GETCH NOP GET CHAR FROM BUFFER LDA BUF,I GET WORD CONTAINING LDB CHC NEXT CHAR. SLB,RSS ALF,ALF MOVE TO RIGHT HALF AND O177 ISOLATE LOWER CHARACTER. SLB,INB IF CURRENT CHAR IS LOWER, ISZ BUF ADD 1 TO BUFFER ADDRESS STB CHC LDB FUNC BLF,ELB HONESTY TO E BLF BINARY TO SIGN ISZ CHX CHARS ALL GONE? JMP GETCH,I NO, RETURN. SSB,RSS BINARY, OR SEZ HONESTY MODE? JMP OU TGO,I YES. DONE. LDA O15 CAR RTN JSB TYO OUTPUT THE CHARACTER LDA O12 JSB TYO OUTPUT LINEFEED. JMP OUTGO,I ALL DONE. * SKP TYO NOP CHAR OUTPUT SUBROUTINE LDB LOUT PRINT COMMAND I.9 OTB TTY OUTPUT INSTRUCTION JSB ISYNC OUTPUT THE CHARACTER CPA O177 CHECK ECHO. BREAK? JMP TYO,I NO. EXIT. LDA LOUT INA,SZA WAIT FOR BREAK CHAR ... JMP *-1 TO FINISH COMING IN. LDA DB JSB ISYNC GET AN INPUT CHAR JSB TSTCH CHECK FOR CONTROL CPA O177 RUBOUT? RSS JMP TYO,I NO, RETURN. JSB KILL YES, OUTPUT /, CR, LF. JMP STAT FAKE COMPLETION. SKP * CONSTANT, FLAG, AND STORAGE SECTION * A EQU 0 B EQU 1 SUP * SAVAX NOP STORAGE AREA SAVBX NOP FOR SAVING REGISTERS SAVEX NOP WHILE PROCESSING INTERRUPT. * SAVA NOP EQT ADDRESS FUNC NOP REQUESTED FUNCTION RQA NOP REQUEST ADDRESS DFLG NOP DRIVER BUSY FLAG. =0, NOT BUSY * M3 OCT -3 O10 OCT 10 BACKSPACE CHAR(CONT. H) O12 OCT 12 O15 OCT 15 O17 OCT 17 O40 OCT 40 O77 OCT 77 O100 OCT 100 O134 OCT 134 O137 OCT 137 BAKSP EQU O10 BKSPC OCT 31 O33 OCT 33 ESCAPE KEY. O176 OCT 176 O177 OCT 177 RUBO EQU O177 O377 OCT 377 LBLNK OCT 20000 IBIT OCT 100000 MST OCT 37400 LIAI LIA 0 OTBM OCT 5100 O1100 OCT 1100 CH NOP * EQT2 NOP EQT3 NOP BUF NOP BUFS NOP IOSYZ NOP CHC NOP CHX NOP * * LOUT OCT 120000 PRINT OUTPUT DA OCT 160000 ECHO INPUT DB OCT 140000 NON-ECHO INPUT OPINT NOP * BSS 0 CHECK SIZE * END *($$* h t 91703-18106 1604 S 0122 DS1/B SCE/3 MODULE: .IOC.              H0101 KASMB,R,L,C HED IOC 91703-16106 * (C) HEWLETT-PACKARD CO. 1976 NAM IOC 91703-16106 REV A 760123 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * PGMR: J.R.W. * ********** I N P U T / O U T P U T C O N T R O L ********** * * * IOC IS A MODULE OF THE HP-2116 BASIC CONTROL SYSTEM * * WHICH PROVIDES FOR GENERAL I/O DEVICE CONTROL AND * * BUFFERED DATA TRANSMISSION AS REQUESTED BY CALLS * * WITHIN USER PROGRAMS. * * * * THIS VERSION DOES NOT CONTAIN THE ADDITIONAL * * FEATURES (AND PROGRAM LENGTH) TO PROVIDE FOR * * AUTOMATIC BUFFERING OF WRITE AND FUNCTION * * REQUESTS. COMPATIBILITY WITH THE BUFFERED * * VERSION IS MAINTAINED AND THE SPECIAL SECTION * * AT THE ENTRY POINT .BUFR IS PROVIDED TO * * ALLOW A COMMON EXIT POINT FOR COMPLETION * * RETURN OF ALL OUTPUT DRIVERS. * * * * IOC IS RESPONSIBLE FOR: * * * * - PROCESSING USER REQUESTS FOR DATA TRANSMISSION, * * PERIPHERAL DEVICE FUNCTIONS AND DEVICE STATUS. * * * * - PROVIDING PROPER LINKAGE AND CONTROL TO I/O * * EQUIPMENT SOFTWARE DRIVERS FOR PROCESSING THE * <* REQUESTED OPERATIONS. * * * * - MAINTAINING AN EQUIPMENT TABLE WHICH CONTAINS * * THE INFORMATION NECESSARY TO DEFINE AND DESCRIBE * * A PERIPHERAL DEVICE, TO PROCESS REQUESTS AND * * TO SUPPLY OPERATION STATUS. * * * * * * REQUEST DESCRIPTIONS: * * * * - DATA TRANSMISSION ( READ/WRITE ) * * REQUEST CODE: 1 / 2 * * * * (P) JSB .IOC. * * (P+1) (REQUEST CODE,K,P,ORDINAL) * * (P+2) (REJECT POINT) * * (P+3) (BUFFER ADDRESS) * * (P+4) (BUFFER LENGTH) * * (P+6) -NORMAL RETURN- * * * * - FUNCTION SELECT, REQUEST CODE = 3 * * * * (P) JSB .IOC. * * (P+1) (REQUEST CODE,FUNCTION,ORDINAL) * * (P+2) (REJECT POINT) * * (P+3) -NORMAL RETURN- * * * * * * - STATUS/CLEAR, REQUEST CODE = 4/0 * * * * (P) JSB .IOC. * * (P+1) (REQUEST CODE,ORDINAL) >U * * (P+2) -NORMAL RETURN- * * * * * * ENTRY POINTS: .IOC. ENTRY POINT FOR REQUESTS. * * DMAC1: ENTRY POINTS FOR DRIVERS * * DMAC2: UTILIZING A DMA CHANNEL * * FOR DATA TRANSMISSION. * * IOERR: LOCATION OF IOC ERROR HALT * XSQT : HOLDS ADDRESS OF * SYSTEM EQUIPMENT TABLE * XEQT : HOLDS ADDRESS OF I/O * EQUIPMENT TABLE SPC 3 ENT .IOC.,DMAC1,DMAC2,IOERR,XSQT,XEQT ENT .BUFR EXT HALT SPC 2 * THE PCS PROGRAM PERFORMS THE CONSTRUCTION OF * THE BCS MODULES INTO AN ABSOLUTE OPERATING UNIT. * ONE OF THE FUNCTIONS OF -PCS- IS TO CONSTRUCT * THE -SQT- AND -EQT- TABLES AS DESIGNATED FOR A * PARTICULAR CONFIGURATION. AFTER THE 2 TABLES * ARE COMPLETED (LOCATED IN MEMORY JUST BEFORE IOC), * PCS STORES THE FIRST WORD ADDRESS OF EACH TABLE * IN THE WORDS IN IOC LABELLED XSQT AND XEQT. SPC 2 A EQU 00000B "A" REGISTER ADDRESS DEFINITION. B EQU 00001B "B" REGISTER ADDRESS DEFINITION. SPC 2 .IOC. NOP ** ENTRY / EXIT ** INT EQU 00B SYSTEM INTERRUPT FLAG ADDRESS. STF INT ** SET INTERRUPT SYSTEM ACTIVE ** LDA .IOC.,I GET WORD 2 AND POSITION ALF REQUEST CODE TO AND M.17 LOW A, ISOLATE STA R.C. AND SAVE CODE. ADA NMAX SUBTRACT THE MAXIMUM+1 REQUEST SSA,RSS CODE - A POSITIVE RESULT JMP RCER MEANS UNDEFINED CODE - ERROR. LDA .IOC.,I GET WORD 2 AGAIN- AND M.77 ISOLATE ORDINAL FIELD AND STA B SAVE IN B. SZA IF ORDINAL = 0, CHECK REQUEST CODE. JMP IOC0 -NON ZERO, CHECK ORDINAL. CPA R.C. IF REQUES7T IS * CLEAR *, GO TO JMP CLRSY CLEAR ALL UNITS AND DRIVERS. LDA C.04 IF REQUEST IS CPA R.C. FOR * STATUS *, GO TO JMP SSTAT GET TOTAL SYSTEM STATUS. ORER CLA,INA,RSS ENTER: A=1; SKIP. RCER1 LDA C.04 LOAD: A=4. JMP IRER - ORDINAL ERROR FOR REQUEST. SPC 1 IOC0 ADA MIN7 SUBTRACT 7 FROM ORDINAL. IF SSA,RSS RESULT IS POSITIVE, THEN ORDI- JMP IOC1 NAL IS TO EQT. OTHERWISE ADD ADB XSQT ADDRESS OF SQT TO VALUE 1-6, ADB MIN1 SUBTRACT 1 FOR PROPER ENTRY - LDB B,I GET SQT ENTRY IN B. EQT ORDINAL SZB,RSS IF ORDINAL = 0, THE SQT ENTRY JMP SERR NOT DEFINED - ERROR. SPC 1 * CONTROL HERE TO EXAMINE EQT ENTRY SPC 1 IOC1 ADB MIN6 SUBTRACT 6 FROM ORDINAL TO GET * POSITION IN EQT. LDA B GET EQT ORDINAL TO A. CMA,INA SUBTRACT REQUEST (OR SQT) ADA XEQT,I ORDINAL FROM NUMBER OF EQT SSA ENTRIES- A NEGATIVE RESULT MEANS JMP ORER ORDINAL TOO LARGE - ERROR. BLS,BLS MULTIPLY ORDINAL BY 4, SUBTRACT ADB MIN3 3 AND ADD STARTING ADDRESS OF ADB XEQT EQT TO GET ADDRESS OF ENTRY. STB EQTT SAVE FWA OF EQT ENTRY FOR DRIVER. INB SET B= ADDRESS OF WORD 2. SPC 1 * CHECK FOR TYPE OF REQUEST SPC 1 LDA R.C. GET REQUEST CODE TO A CPA C.04 IF CODE = 4, THEN GO TO JMP IOC3 PROCESS STATUS REQUEST. SPC 1 * REQUEST IS FOR DATA TRANSMISSION, FUNCTION SELECT * OR CLEAR OPERATION. SPC 1 LDA B,I GET WORD 2 OF EQT ENTRY. ELA SHIFT THE DEVICE BUSY BIT TO "E". ADB C.02 SET B = ADDRESS OF WORD 4 LDB B,I AND GET DRIVER ADDRESS. STB DRIV SET DRIVER ADDRESS. LDA .IOC.,I LOAD THE I/O CONTROL WORD. AND =B176700 IS|OLATE THE COMMAND. SZA CLEAR REQUEST? CPA =B030000 NO; DYNAMIC STATUS REQUEST? JMP IOC2 DIRECTLY TO DRIVER. SEZ IF DEVICE BUSY, O FIELD = 2, JMP IOC5 GO TO REJECT REQUEST. SPC 1 * SET UP DRIVER LINKAGE AND GO TO DRIVER SPC 1 IOC2 LDB .IOC. SET B = ADDRESS OF REQUEST WORD 2 LDA EQTT SET A = FWA EQT ENTRY JSB DRIV,I GO TO DRIVER - INITIATOR - SECTION SPC 1 * RETURN FROM DRIVER - CHECK FOR REJECT CONDITION SPC 1 M.77 CLE,SLA,ALF DRIVER REJECT? JMP IOC7 (B) = REJECT CONDITION. SPC 1 * NORMAL EXIT SECTION (EXCEPT FOR STATUS REQUEST) SPC 1 LDA R.C. GET REQUEST CODE TO A LDB .IOC. SET B = ADDRESS OF WORD 2. SZA,RSS IF REQUEST CODE = 0, GO TO EXIT JMP IOC3 AS A STATUS REQUEST. ADB C.02 SET B TO P+3 FOR FUNCTION RETURN. ADA MIN3 SUBTRACT 3 FROM REQUEST CODE. SZA IF NOT FUNCTION, THEN SET ADB C.02 B TO P+5 RETURN. JMP B,I ---EXIT TO NORMAL RETURN--- SPC 1 * CONTROL HERE FOR STATUS REQUEST SPC 1 IOC3 LDA B,I SET (A) = WORD 2 OF EQT ENTRY INB AND SET (B) = LDB B,I WORD 3 OF EQT ENTRY IOC4 ISZ .IOC. ADJUST RETURN TO P+2. JMP .IOC.,I EXIT TO CALLER --- SPC 1 * CONTROL HERE FOR SYSTEM STATUS REQUEST (ORDINAL = 0) SPC 1 SSTAT LDA XEQT,I GET # OF EQT ENTRIES, CMA,INA SET NEGATIVE AND STA SIOC SAVE AS AN INDEX. LDB XEQT SET (B) = ADDRESS OF WORD ADB C.02 2 OF FIRST ENTRY. SST1 LDA B,I GET WORD 2 - SSA IF AVAILABILITY FIELD SAYS UNIT JMP SST2 BUSY, THEN COMPLETE REQUEST. ADB C.04 SET (B) FOR NEXT ENTRY ISZ SIOC INDEX EQT COUNTER. JMP SST1 -NOT FINISHED SPC 1 * (A), BIT 15: 1 IF ONE UNIT BUSY; 0 IF NO UNITS BUSY. QSPC 1 SST2 CLB SET B=0 TO INDICATE IOC W/O OUTPUT JMP IOC4 BUFFERING, RETURN TO NORMAL EXIT. SPC 1 * CONTROL HERE FOR SYSTEM CLEAR REQUEST SPC 1 CLRSY LDA XEQT,I GET # OF EQT ENTRIES, CMA,INA SET NEGATIVE AND STA SIOC SAVE FOR INDEX. LDA XEQT SET (A) = ADDRESS OF WORD 1 INA OF FIRST ENTRY. CLR1 STA EQTT SAVE CURRENT WORD 1 ADDRESS. ADA C.03 SET ADDR TO LDA A,I WORD 4, GET AND STA DRIV SET DRIVER ADDRESS. LDA EQTT (A) = EQT ENTRY ADDR. LDB .IOC. (B) = REQUEST WORD 2 ADDRESS. JSB DRIV,I OPERATE DRIVER -- LDA EQTT SET (A) = ADA C.04 ADDR OF NEXT ENTRY ISZ SIOC INDEX EQT COUNTER JMP CLR1 -NOT FINISHED. JMP IOC4 OPERATION COMPLETE, EXIT. SPC 2 * FOLLOWING SECTION ONLY AFFECTS A RETURN TO * AN INTERRUPTED SEQUENCE IN THIS VERSION. * THE CALL IS FROM THE CONTINUATOR SECTION * OF AN OUTPUT DRIVER: SPC 1 * (P) - JSB .BUFR * (P+1)- -RETURN ADDRESS- SPC 2 .BUFR NOP CLF INT TEMPORARY DISABLE INTERRUPT. STA BSAVA TEMPORARY SAVE (A). LDA .BUFR,I GET AND STA .BUFR SET RETURN ADDRESS. LDA BSAVA RESTORE (A) STF INT ENABLE INTERRUPT SYSTEM JMP .BUFR,I RETURN TO INTERRUPTED SEQUENCE SPC 1 BSAVA NOP SPC 2 * REJECT SECTION SPC 1 IOC5 CLB,INB DEVICE BUSY REJECT - SET B(15) = 1 RBR IOC7 ISZ EQTT SET A = WORD 2 OF EQT LDA R.C. LOAD THE REQUEST CODE TYPE. SZB,RSS ILLEGAL REQUEST TYPE REJECT? CPA C.03 YES; CONTROL FUNCTION TYPE? RSS SKIP. JMP RCER1 NO, ILLEGAL READ OR WRITE REQUEST. LDA EQTT,I ENTRY FOR REJECT. JMP IOC4 GO TO EXIT TO P+2. SPC 2 * -ERROR CONDITION SECTION (IRRECOVERABLE ERRORS) SPC 1 RCER CLA,RSS Rp*($EQUEST CODE ERROR - SET A = 0. SERR LDA C.02 SQT ENTRY ERROR - SET A = 2. IRER CCB ENTER: B=-1. ADB .IOC. LET B = USER REQUEST ADDRESS. IOERR HLT 76B SYSTEM ERROR HALT. JMP HALT IRRECOVERABLE HALT OR .IPL. RETURN. SKP * -CONSTANT AND STORAGE SECTION- SPC 1 SIOC NOP HOLDS ADDRESS P+1 OF REQUEST. R.C. NOP HOLDS REQUEST CODE. EQTT NOP HOLDS ADDRESS OF EQT ENTRY FOR DEVICE. DRIV NOP HOLDS ADDRESS OF DEVICE DRIVER. M.17 OCT 000017 R.C. MASK. C.02 DEC 2 CONSTANTS C.03 DEC 3 C.04 DEC 4 USED IN MIN1 OCT -1 IN MIN3 OCT -3 PROCESSING MIN6 OCT -6 MIN7 OCT -7 NMAX OCT -5 NEGATIVE VALUE OF MAX. REQUEST-CODE+1. SPC 1 XSQT NOP HOLDS STARTING ADDRESS OF SQT: SET BY XEQT NOP HOLDS STARTING ADDRESS OF EQT: -PCS- DMAC1 NOP DEFINES FIRST DMA CHANNEL DMAC2 NOP DEFINES SECOND DMA CHANNEL SPC 1 ** END I O C SPC 1 END 4* i u 91703-18107 1611 S 0122 DS1/B SCE/3 MODULE: L65              H0101 ASMB,R,L,C HED L65 91703-16107 * (C) HEWLETT-PACKARD CO. 1976 * NAM L65 91703-16107 REV A 760311 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT L65 EXT .ENTR,.IOC.,TMOUT * * SUBROUTINE TO MAKE IOC CALLS TO D.65 FORTRAN * CALLABLE * * MAY ALSO BE CALLED AS A FUNCTION, IN WHICH * CASE (EXCEPT FOR STATUS OR CLEAR CALLS) AN * ERROR CODE IS RETURNED WHEN THE OPERATION * HAS BEEN COMPLETED. (L65 OPERATIONS ARE NOW * DONE "WITH WAIT", SO OPERATIONS ARE COMPLETED * BEFORE RETURNING TO THE USER.) * * ERROR CODE MEANING * ---------- --------------------- * * -3 COMMUNICATIONS I/O ERROR * -1 REQUEST COMPLETED, NO ERRORS * +1 ILLEGAL PARAMETER IN L65 CALL * +2 LINE DOWN OR TIMEOUT * +4 BUFFER LENGTH ERROR * +61 (75B) MODE NOT COMPATIBLE * +62 (76B) TRANSMISSION NOT INITIATED * +63 (77B) SIMULTANEOUS REQUEST * * * MODIFIED BY DAN GIBBONS * HEWLETT PACKARD * FEBRUARY 11,1976 * SPC 2 * * CALLING SEQUENCES * * (NOTE THAT "SEND-REQUEST" AND "SEND-REQUEST-AND- * SEND/RECEIVE-DATA" CALLS ARE NO LONGER LEGAL.) * * SEND OR RECEIVE DATA SPC 1 * CALL L65(IRW,IDVN,IMODE,IDBUF,IDBFL) * WHERE: * IRW =1 FOR READ 2 FOR WRITE * IDVN =DEVICE REFERENCE * IDBUF=BUFFER FOR DATA STORAGE * IDBFL=DATA BUFFER LENGTH..POSITIVE WORDS ONLY * IRBUF=BUFFER FOR REQUEST STORAGE * IRB@FL=BUFFER LENGTH * IMODE=1 FOR DATA, 2 FOR REQUEST * SKP * RECEIVE REQUEST SPC 1 * CALL L65(IRW,IDVN,IMODE,IRBUF,IRBFL) SPC 2 * SEND STOP SPC 1 * CALL L65(IRW,IDVN) * WHERE: IRW=6 SPC 2 * CLEAR REQUEST SPC 1 * CALL L65(IRW,IDVN) * WHERE: IRW=0 SPC 2 * STATUS REQUEST SPC 1 * CALL L65(IRW,IDVN,ISTAT,ITRLG) * WHERE: * IRW=3 * ISTAT=EQT WORD 2 * ITRLG=EQT WORD 3 SPC 2 * * THE POLLING CALL (IRW=4) AND LISTEN MODE CALL (IRW=5) * ARE NO LONGER SUPPORTED BY THIS VERSION OF THE DRIVER * REVISION C OR LATER. THESE CALLS HAVE BEEN BOTH CONVERTED * INTO CLEAR REQUEST CALLS... * * FOR STATUS CALLS, A AND B REG WILL CONTAIN * CONTENTS OF EQT WORDS 2 & 3 RESPECTIVELY (STATUS * AND TRANSMISSION LOG). * * FOR CLEAR CALLS, CONTENTS OF A AND B REG ARE MEANINGLESS. * SKP * * IRW NOP ADDRESS OF REQUEST CODE IDVN NOP ADDRESS OF UNIT REFERENCE # IMODE NOP ADDRESS OF READ/WRITE SUBMODE IDBUF NOP ADDRESS OF DATA BUFFER IDBFL NOP ADDRESS OF DATA BUFFER LENGTH IRBUF NOP ADDRESS OF REQUEST BUFFER IRBFL NOP ADDRESS OF REQUEST BUFFER LENGTH * L65 NOP JSB .ENTR FETCH PARAMETER ADDRESSES DEF IRW * LDA IRW,I GET REQ CODE AND B7 CHECK FOR LEGAL RANGE (0-6) LDB A CPB IRW,I CPB B7 JMP ERR ILLEGAL PARAMETER ADB REQC INDEX INTO FUNCTION CODE TABLE LDB B,I GET IOC FUNCTION CODE LDA IDVN,I GET DEVICE UNIT REFERENCE # AND B77 CHECK FOR LEGAL RANGE CPA IDVN,I RSS JMP ERR ILLEGAL PARAMETER IOR B MERGE UNIT REFERENCE # RBL STATUS SSB,RSS OR SZB,RSS CLEAR? JMP CS R< YES. RBL,RBL CONTROL SSB,SLB,RSS REQUEST? RSS NO. JMP CON YES. * STA REQ SAVE REQUEST CODE LDA IMODE,I GET MODE WORD CPA D1 CHECK FOR LEGAL VALUES (1,2) JMP OK CPA D2 RSS JMP ERR ILLEGAL PARAMETER LDB IRW,I CHECK FOR SEND-REQ OR SEND-REQ- CPB D2 SEND/RCV-DATA (ILLEGAL) JMP ERR ILLEGAL PARAMETER OK ALF,ALF RAR,RAR SET TO ADD TO SUBMODE ADA REQ SET FOR 1,2,3 FOR SUBMODE STA REQ SAVE LU,SUBMODE AND PRIVLEGE STATUS LDA IDBUF GET DATA BUFFER ADDRESS LDB IDBFL,I GET DATA BUFFER LENGTH STA BUFA SAVE AS BUFFER ADDRESS OF CALL STB LEN SAVE AS LENGTH * JSB .IOC. CALL DRIVER REQ NOP JMP *-2 BUFA NOP LEN NOP * WAIT LDA IDVN,I WAIT HERE UNTIL DONE IOR STATR SET UP STATUS STA REQ3 REQUEST LDA TMOUT SET UP TIME- STA DELAY OUT COUNTER CLA STA DEL * IOC0 JSB .IOC. STATUS CALL REQ3 NOP SSA,RSS COMPLETE? JMP STCHK YES, GO CHECK RETURNED STATUS ISZ DEL COUNT TIME JMP IOC0 ISZ DELAY TIMED OUT? JMP IOC0 NO, CHECK STATUS AGAIN LDA IDVN,I YES, SET UP STA REQ4 CLEAR REQUEST JSB .IOC. CLEAR DRIVER REQ4 NOP LDA B200 YES, SIMULATE TIMEOUT STATUS * STCHK AND B377 MASK OFF ALL BUT STATUS CPA D8 SEE IF STOP SENT INB,SZB IF SO,WAS LENGTH=-1 RSS NO..NO STOP, OR LENGTH NOT -1 CLA,INA YES,LEGAL STOP. TREAT SAME AS NO ERRORS SLA BIT 0 CCB NO ERRORS. REQUEST COMPLETED RAR,SLA BIT 1 LDB D4 REQ NOT ACCEPTED...LENGTH ERROR RAR,SLA BIT 2 LDB B75 NO DATA...DATA CALL WITHOUT REQ  RAR,SLA BIT 3 LDB B76 ILLEGAL STOP SENT RAR,SLA BIT 4 LDB B77 SIMULTANEOUS REQUEST. RAR,SLA BIT 5 LDB MD3 PARITY ERROR. RAR,SLA BIT 6 LDB B74 NO REQUEST RECEIVED. RAR,SLA BIT 7 LDB D2 BROKEN LINE. LDA B A = ERROR CODE * JMP L65,I RETURN WITH ERROR CODE IN * CS STA REQ1 STORE IOC FUNCTION WORD LDA IDBFA GET AN ADDRESS OF A TEMP LOCATION SZB STATUS REQ? JMP IOC1 YES STA IMODE SET IMODE TO POINT TO IDBUF STA IDBUF DITTO IOC1 JSB .IOC. CALL DRIVER REQ1 NOP STA IMODE,I RETURN STATUS WORD STB IDBUF,I RETURN TRANSMISSION LOG JMP L65,I RETURN TO CALLER * * CON STA REQ2 STORE IOC FUNCTION WORD JSB .IOC. CALL DRIVER REQ2 NOP JMP *-2 JMP WAIT GO WAIT FOR COMPLETION * * ERR CLA,INA RETURN WITH =1 TO JMP L65,I INDICATE ILLEGAL PARAMETER * * * REQC DEF RQ RQ OCT 0 CLEAR REQUEST OCT 10100 READ REQUEST OCT 21100 WRITE REQUEST STATR OCT 40000 STATUS REQUEST OCT 0 WAS POLLING...NOW CLEAR REQ. OCT 0 WAS LISTEN MODE...NOW CLEAR REQ. OCT 31400 STOP REQUEST DEL OCT 0 TIMEOUT DELAY OCT 0 COUNTERS MD3 DEC -3 IDBFA DEF IDBUF D1 DEC 1 D2 DEC 2 D4 DEC 4 B7 OCT 7 D8 DEC 8 B74 OCT 74 B75 OCT 75 B76 OCT 76 B77 OCT 77 B200 OCT 200 B377 OCT 377 A EQU 0 B EQU 1 END @ js 91704-18101 1602 S 0222 DS1/B SCE/4 MODULE: %RFAN              H0102 QASMB,R,L,C,F HED %RFAN 91704-16101 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM %RFAN,7 91704-16101 REV A 760105 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 3 **************************************************** * *%RFAN SUBROUTINE TO DO REMOTE RFA * *SOURCE PART # 91704-18101 REV A * *REL PART # 91704-16001 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-15-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: DEC 1975 * ***************************************************** SPC 1 SUP * * * THIS SET OF USER-CALLABLE SUBROUTINES INTERFACES * A DS1B TERMINAL USER TO THE RTE FILE MANAGER AND RTE * EXECUTIVE OF A DS/1B RTE CENTRAL COMPUTER. %RFAN * REQUIRES THE DVR65 DRIVER TO BE COFIGURED INTO THE * RTE-B TERMINAL. * * * CALLING SEQUENCE: * * JSB RXXXX * DEF RETURN ADDRESS * DEF PARAMETER 1 * . * . * . * DEF PARAMETER N * RETURN * * * ENT CCRET,CPURG,COPEN,CREAD,CWRIT ENT CPOSN,CWIND,CCLOS,CNAME,CCONT ENT MBUFS,MBUF2,CLOCF,CAPOS,CSTAT ENT RLU,CLU,CONFG,LSTEN,CLINE,DIMCK ENT CAXTM,CEXTM,CSCHD,CTIM,CMESG ENT DIMFG,M72,REPLY,PRMB,RPLY,FIXNM * * EXT EXEC,.STOP,ERROR EXT .1,.2,.3,.4,.6,.10 EXT .8,.32,.48,FCORE,PROGL EXT M1,M2,M4,M5,M7 EXT B377,B100,B200 EXT STCK EXT DBSY,%TAM,INDCK,SBYTE * * A EQU 0 B EQU 1 * ********************************* * ENTRY POINTS FOR REMOTE CALLS ******************** ********************************* * * CREATE A CENTRAL FILE. * CCRET NOP JSB CQUE NO RETURN. CALL IS POINTER TO DEC 150 ENTRY POINT AND FUNCTION CODE. * * PURGE A CENTRAL FILE. * CPURG NOP JSB CQUE DEC 151 * * OPEN A CENTRAL FILE. * COPEN NOP JSB CQUE DEC 152 * * WRITE ON CENTRAL FILE. * CWRIT NOP JSB CQUE DEC 153 * * READ FROM CENTRAL FILE. * CREAD NOP JSB CQUE SIGN BIT OF FCN CODE SET FOR OCT 100232 READ (FCN = 154). * * POSITION CENTRAL FILE. * CPOSN NOP JSB CQUE DEC 155 * * REWIND CENTRAL FILE. * CWIND NOP JSB CQUE DEC 156 * * CLOSE CENTRAL FILE. * CCLOS NOP JSB CQUE DEC 157 * * RENAME CENTRAL FILE. * CNAME NOP JSB CQUE D158 DEC 158 * * CONTROL CENTRAL FILE. * CCONT NOP JSB CQUE DEC 159 * * LOCATE CENTRAL FILE RECORD. * CLOCF NOP JSB CQUE DEC 160 * * ABS POSITION CENTRAL FILE. * CAPOS NOP JSB CQUE DEC 161 * * READ CENTRAL FILE DIRECTORY. * CSTAT NOP JSB CQUE OCT 100242 READ CALL. FCN = 162. * * REMOTE EXEC CALLS * CAXTM BSS 0 TIME ABSOLUTE..SAME AS INITAL OFFSET CEXTM NOP JSB CQUE GO PROCESS REQUEST OCT 243 REQUEST FUNCTION CODE OF 163. DEC 12 EXEC CODE...12 TIME SCHEDULE SPC 2 * STANDARD SCHEDULE CSCHD NOP JSB CQUE SET PRAMS FOR SCHEDULE CALL OCT 243 DEC 10 EXEC CODE FOR SCHEDULE SPC 2 * TIME REQUEST CTIM NOP JSB CQUE GO SET UP PRAMS FOR TIME REQUEST OCT 243 DEC 11 TIME REQUEST SPC 2 * SEND MESSAGE CMESG NOP JSB CQUE SET UP PRAMS OCT 243 DEC 2 SET UP AS A WRITE REQUEST TO LU 1 SKP ********************************** * BUILD THE PARAM BUFFER (PARMB) ******************* ********************************** * * * WHEN CQUE IS CALLED, TjHE ADDRESS OF THE USER * CALL AND THE FUNCTION CODE CAN BE DETERMINED * VIA THE ENTRY POINT CONTENTS. * CQUE NOP LDA CQUE,I FETCH FUNCTION CODE. CLB,INB CHECK SIGN BIT. SSA,RSS INB STB RDATA SET "READ DATA" FLAG. ELA,CLE,ERA CLEAR SIGN BIT. STA FCN ADA MD163 STA .FCN SET FUNCTION CODE FLAG..ZERO=EXEC CLA STA ISTAT CLEAR ERROR FLAG LDA CQUE FETCH USER CALL ADDRESS. ADA M2 LDA A,I STA CALL * CLA CLEAR DATA BUFR ADDR. STA DADR * * INITIALIZE PARMB: STREAM, SUB-STREAM, FUNCTION CODE. * LDA PRMBA POINT TO PARMB AREA. STA PARMB * LDA .FCN GET FUNCTION CODE FLAG LDB B5 SET FOR EXEC SZA REMOTE EXEC CALL INB NOT EXEC...RFA STB PARMB,I STORE STREAM TYPE. ISZ PARMB * CLA STA PARMB,I SUB-STREAM (NULL). ISZ PARMB * LDA FCN STA PARMB,I FUNCTION CODE. ISZ PARMB * * STORE SPARE WORD, DATA FLAG = 0. * LDA B202L STA PARMB,I 202*000 ISZ PARMB ALF,ALF STA PARMB,I 000*202 ISZ PARMB CLA STA PARMB,I 000*000 * * INITIALIZE DYNAMIC POINTERS. * LDA CALL ADDR OF USER CALL RETURN ADDR. INA MOVE OVER RETURN ADDRESS STA P.PTR POINTER TO USER CALL PARAMETERS. * LDA .2 STA B.PTR PARMB BYTE POINTER. * LDA UPARM ADDR OF SAVED PARAMS. STA U.PTR * * PERFORM COMMON PARMB ENTRY STORAGE ACCORDING TO * CLASS OF CALL (CEXEC OR RFA) * LDA .FCN GET FUNCTION CODE INDICATOR SZA JMP .RFA * .EXEC JSB STERM SET A B202 TERMINATOR LDA CQUE FIND OUT EXEC CODE INA LDA A,I WE HAVE FUNCTION CODE JSB STWRD SAVE FUNCTION EXEC CODE STA .RCD SAVE IT. * CPA .2 JMaP RC1 WRITE. CPA .10 JMP RC10 SCHEDULE. CPA D11 JMP RC11 TIME. CPA D12 JMP RC12 EXECUTION TIME. * LDA M70 ILLEGAL REQUEST CODE. JMP SSTAT * .RFA LDA FCN GET FUNCTION CODE ADA MD153 CHECK IF IT IS A CREATE OPEN PURGE SSA,RSS OR RENAME CPA B5 IF IT IS MOVE NAME TO DCB JSB MNAM JSB STRNG MOVE NAME TO PARMB ISZ P.PTR SKP OVER ERROR STATUS * LDA FCN ADA MD150 ADA RTBL LDA A,I JMP A,I * RTBL DEF *+1 GO TO UNIQUE PROCESSING FOR DEF .CRET THE PARTICULAR RFA CALLS. DEF .PURG DEF .OPEN DEF .WRIT DEF .READ DEF .POSN DEF .WIND DEF .CLOS DEF .NAME DEF .CONT DEF .LOCF DEF .APOS DEF .STAT * * UNIQUE PROCESSING FOR INDIVIDUAL REMOTE EXEC CALLS. * * HERE FOR MESSAGE PROCESSING * WHEN INITILIZATION ROUTINE CALLED REMOTE * LU WAS OBTAINED AND SET AS AN ASC VALUE * RC1 JSB STERM SET IN CONTROL BYTE JSB GET.P GET DISPLAY LU (THEY DON'T KNOW THAT THEY CAN") SZA,RSS IS IT ZERO (NORMALLY SHOULD BE!) INA ZERO...SET LU 1 JSB STWRD SAVE LU JSB STERM SET CONTROL BYTE FOR LENGTH JSB GET.A GET ADDRESS OF MESSAGE STA TEMP1 SAVE ADDRESS MOVE LDA A,I GET LENGTH AND B377 MASK OFF BIT 8 STA B SAVE IN B REG ADA MBUFS CHECK IF IT IS IN RANGE SZB ZERO LENGTH...ERROR SSA,RSS NEGATIVE...IN RANGE JMP WRONG OUT OF RANGE...TREATE AS MISSING PRAM INB INCASE ODD # OF CHARACTERS STB TEMP3 SAVE # OF CHARACTERS CLE,ERB CONVERT TO # OF WORDS CMB,INB NEGATE COUNT LDA MBFA2 GET ADDRESS OF MESSAGE BUFFER STA TEMP2 SAVE CURRENT ADDRESS RC6101 ISZ TEMP1 GET TO CURRENT DATA WORD LDA TEMP1,I GET MESSAGE STA TEMP2,I AND MOVE IT TO BUFFER ISZ TEMP2 GET NEXT OUTPUT WORD ADDRESS INB,SZB DONE? JMP RC101 NO...CONTINUE LDA MBUFA GET MESSAGE BUFFER ADDRESS JSB RPARM SAVE ADDRESS LDA TEMP3 GET LENGTH CLE,ERA CONVERT TO WORD LENGTH SEZ ODD # OF CHARACTERS? JMP RC100 NO STA TEMP3 SAVE # OF WORDS CCB GET A -1 ADB TEMP2 GET ADDRESS OF LAST VALUE STORED LDA B,I GET VALUE AND M377L MASK OFF ALL BUT UPPER 8 BITS IOR .32 MASK IN SPACE STA B,I SAVE LAST WORD LDA TEMP3 GET COUNT AGAIN RC100 ADA .3 ADD IN PREAMBLE JSB RPARM SAVE LENGTH STA PARMB,I SET IN PARMB DATA FLAG JSB STWRD SAVE VALUE IN DATA STREAM JMP READY SEND MESSAGE * RC10 JSB STRNG STORE PROGRAM NAME. ISZ P.PTR GET PAST RETURN STATUS JSB OPTN STORE OPTIONAL PARAMS. JSB OPTN JMP OPT3 * RC11 JMP READY * RC12 JSB STRNG STORE PROG NAME. JSB INTGR IRESL JSB INTGR MTPLE JSB INTGR IOFST: CHECK SIGN. SSA JMP READY INITIAL OFFSET VERSION. JSB INTGR MINS JSB INTGR ISECS JSB STERM SET IN TERMINATOR CLA SET MSECS TO 0 JSB STWRD JMP READY ABSOLUTE START TIME VERSION. * * UNIQUE PROCESSING FOR INDIVIDUAL RFA CALLS. * .CRET ISZ P.PTR SKIP OVER NAME LDA B204 STORE 2-WORD SIZE ARRAY. JSB STBYT JSB GET.A STA TEMP3 DLD TEMP3,I GET FLOATING POINT LENGTH FIX CONVERT IT INTO AN INTEGER JSB STWRD ISZ TEMP3 ISZ TEMP3 GET TO RECORD LENGTH DLD TEMP3,I GET LENGTH FIX CONVERT IT TO FIXED. JSB STWRD JSB INTGR STORE FILE TYPE. JMP OPT2 * .PURG ISZ P.PTR SKP OVER NAME PRAM JMP OPT2 * .OPEN ISZ P.PTR SKP OVER NAME OPT3 JSB OPTN OPT2 JSB OPTN STORE OPTIONAL PARAMS. OPT1 JSB OPTN JMP READY PARMB COMPLETE. * .CLOS EQU OPT1 * .READ JSB GET.A JSB RPARM SAVE DATA BUFR ADDRESS. JSB STLEN STORE LENGTH. JMP OPT2 * .WRIT EQU .READ * .POSN JSB INTGR STORE RECORD NUMBER. JMP OPT1 * .WIND JMP READY * .NAME ISZ P.PTR SKP OVER OLD NAME JSB STRNG STORE NEW NAME. JMP OPT2 * .CONT JSB INTGR STORE CONTROL WORD. JMP OPT1 * .LOCF JMP READY * .APOS JSB INTGR STORE RECORD NUMBER. JMP OPT2 * .STAT LDA .2 RESET BYTE POINTER. STA B.PTR LDA P.PTR BACK UP PARAM POINTER. ADA M1 (NO IERR PARAM) STA P.PTR JSB GET.A JSB RPARM SAVE DATA BUFR ADDRESS. LDA D124 STORE LENGTH STA PARMB,I IN DATA-FLAG AND JSB RPARM GIVE IT TO CALLER. JMP READY * MSSNG LDA M10 MISSING PARAMETER. JMP SSTAT * READY CLA STORE TERMINATION BYTE. JSB STBYT * LDA UPARM POINT TO PLEN STORAGE. ADA .2 STA U.PTR * JSB RPARM PUSH PARAMETER POINTER SKP ****************************************** * TRANSMIT PARMB TO CENTRAL & READ REPLY *********** ****************************************** * LDA DADR GET DATA FLAG SZA IS THERE DATA ON THIS REQUEST? JMP REQAD YES...REQUEST AND DATA CCE SET FOR WRITE REQ JSB %TAM MAKE CALL DEF REPLY ADDRESS OF REPLY BUFFER DEF PRMBA ADDRESS OF PRMB AND LENGTH JMP COMPL WHEN WE GET HERE...RECIEVED RESPONSE SPC 2 * * ONE DATA READ OR WRITE CHECK FOR LEGAL BOUNDS * REQAD LDB DLEN GET LENGTH LDA M72 SET INCASE ZERO LENGTH RECORD SZB CHECK FOR ZERO LENGTH OR SSB NEGATIVE JMP SSTAT YES...TERMINATE CALL LDA RDATA GET DATA FLAG CPA .2 IS IT A WRITE? JMP REQDA YES...DONT CHECK BOUNDS LDA DADR GET STARTING ADDRESS JSB INDCK CHASE DOWN INDIRECTS ADB A GET LAST WORD+2 ADB M2 BACK IT UP TO WITHIN BOUNDS JSB DIMCK CHECK DIMENSIONS REQDA LDA DADR SET FOR SEND DATA AND REQ LDB RDATA READ OR WRITE COMAND RBR,ERB SET E REG IF WRITE DATA JSB %TAM GO MAKE REQ AND DATA CALL DEF REPLY REPLY ADDRESS DEF DADR PRAM ADDRSS..DATA ADD,DATA LEN,REQ ADD,REQ LEN SKP ******************************* * PASS RETURN PARAMS TO USER. ********************** ******************************* * COMPL CPA .1 ALL OK? JMP CMPL1 YES LDB M51 GET GENERAL DRIVER ERROR CPA B100 PARITY ERROR? LDB M52 YES...PARITY ERROR LDA B GET ERROR CODE FOR STATUS JMP SSTAT AND SET IN ERROR CODE CMPL1 LDA REPLY+2 RFAM ERROR CODE? CPA M1 RSS JMP CMPL2 NO. * LDA M11 YES. MAP THE CODE. LDB REPLY+3 CPB .4 JMP SSTAT FILE NOT OPEN. LDA M62 CPB B5 JMP SSTAT REQ. OVERFLOW AT CENTRAL. LDA M71 CPB .8 JMP SSTAT UNDEF. PROG SCHEDULE. CPB D12 JMP SSTAT ILLEGAL LU. LDA M4 CPB D11 ILLEGAL RECORD SIZE? JMP SSTAT LDA M103 SET FOR SOFTWARE BUG * SSTAT STA ISTAT COMMUNICATION STATUS. * CMPL2 LDA ISTAT GET STATUS FLAG SZA,RSS IS IT ZERO? JMP CMPL5 YES...NO ERROR NORMAL TERMINATION STA REPLY+3 SET ERROR CODE IN B REG STA REPLY+4 SET FOR IERR IN FMP CALL CCA GET A -1 STA REPLY+2 SET A REQ=-1...ERROR CMPL5 LDA REPLY+2 SEE IF ERROR OCCURED LDB M6L0 SET FOR ILLEGAL CALL CPA ASCIL IS IT "IL" ILLEGAL CALL STB ISTAT YES...SAVE ERROR CODE CMPL7 LDA CALL INA STA P.PTR PTR TO USER CALL PARAMS. * LDA RPLY ADA .4 STA I.PTR PTR TO REPLY BUFR PARAMS. * LDA .FCN TEST FOR RFA OR CEXEC. SZA,RSS JMP RREXC CEXEC. * LDB FCN RFA. CSTAT? CPB D162 JMP EXIT YES. ALL DONE. * LDA I.PTR,I NO. RETURN IERR. ISZ P.PTR PASS OVER DCB JSB RWORD ISZ I.PTR GET TO FIRST RETURN PRAM LDA ISTAT GET STATUS SZA ANY ERRORS? JMP EXIT YES...DON'T STORE ANYTHING * LDB FCN CPB D154 CREAD? RSS JMP CMPL3 NO. LDA P.PTR MOVE PARAM POINTER. ADA .2 STA P.PTR LDA I.PTR,I YES. RETURN XMSN LOG. JSB RWORD JMP EXIT * CMPL3 CPB D160 CLOCF? RSS JMP EXIT NO. LDB M7 YES. RETURN N PARAMS. JSB PINTG JMP EXIT * RREXC LDA ISTAT GET STATUS WORD SZA ANY STATUS ERRORS? JMP CMPL4 YES...REPORT THEM LDA .RCD GET REQUEST CODE CPA .10 IS IT A SCHEDULE? JMP CMPL6 YES...PASS BACK STATUS CPA D12 SEE IF TIME SCHEDULE JMP CMPL8 YES...CHECK FOR ILLEGAL TIME INTERVAL REQ CPA D11 IS IT A TIME CALL? RSS YES JMP EXIT NO...DONE LDB M5 RETURN TIME ARRAY STB TEMP2 SAVE COUNT TLOOP LDA I.PTR,I JSB RWORD SAVE VALUE ISZ I.PTR ISZ TEMP2 DONE? JMP TLOOP NO...CONINUE JMP EXIT * CMPL4 LDA ISTAT SSA IF POSITIVE, DON'T CONVERT CMA,INA STA ISTAT JSB ERROR ERROR...STATUS ERROR DEF *+3 DEF ISTAT STATUS CODE DEF ERMSG "DS" JMP EXIT TERMINATE CALL * CMPL6 ISZ P.exPTR SKIP OVER NAME...STATUS RETURN LDA REPLY+2 A REG TO SCHEDULE CALL JSB RWORD PASS BACK STATUS JMP EXIT AND TERMINATE * * HERE ON TIME INTERVAL REQ * CMPL8 LDB M72 SET FOR ILLEGAL SCHEDULE CALL LDA REPLY+2 SEE IF REPLY IS ASC..."SC". CPA SCCOD IF SO, TELL WORLD RSS JMP EXIT NO ERROR STB ISTAT SAVE STATUS JMP CMPL4 AND GO COMPLAIN SPC 1 SCCOD ASC 1,SC SPC 1 * * RETURN TO USER PROGRAM. * EXIT CLA CLEAR OUT DIMENSION CHECK FLAG STA DIMFG LDA CALL,I GET RETURN ADDRESS. STA TEMP1 LDA REPLY+2 SET A, B REGISTERS. LDB REPLY+3 JMP TEMP1,I RETURN. SKP ********************** * SUBROUTINE SECTION ******************************* ********************** * * STORE INTEGER PARAM FROM USER CALL INTO PARMB. * INTGR NOP JSB PCHEK IS THE PARAM SPECIFIED? JMP MSSNG NO. JSB STERM SAVE CONTROL BYTE JSB GET.P FETCH PARAM VALUE. JSB STWRD STORE IN PARMB. JMP INTGR,I (A) HAS THE VALUE. * * STORE OPTIONAL INTEGER PARAM (IF SPECIFIED) FROM * USER CALL INTO PARMB. * OPTN NOP JSB PCHEK IS PARAM SPECIFIED? JMP OPTN,I NO (LEAVE P.PTR ALONE). JSB INTGR YES, STORE IT. JMP OPTN,I (A) HAS THE VALUE. * * STORE AN ASCII STRING FROM USER FISRT WORD * CONTAINS THE COUNT OF STRING TO BE STORED * INTO PARMB. * STRNG NOP JSB PCHEK IS PARAM SPECIFIED? JMP MSSNG NO. * LDA .6 STORE CONTROL BYTE. JSB STBYT JSB GET.A GET ADDRESS JSB FIXNM CHECK IF NUMBER INSTEAD OF NAME JMP MSSNG TREAT AS MISSING PRAM IF ERROR STB TEMP3 SAVE ADDRESS OF NAME LDA TEMP3,I GET LENGTH WORD AND B377 MASK OFF ALL BUT COUNT CMA,INA NEGATE COUNT STA TEMP2 SAVE COUNT ADA .6  GET NUMBER OF SPACES NEEDED CMA NEGATE IT -1 STA TEMP4 SAVE # OF SPACES SSA,RSS MAKE SURE NOT OVER 6 CHAR LONG JMP MSSNG TREAT AS AN ERROR STR ISZ TEMP3 GET ADDRESS OF NEXT WORD LDA TEMP3,I GET CHARACTER ALF,ALF GET UPPER CHAR FIRST JSB STBYT SAVE CHARACTER ISZ TEMP2 DONE? RSS NO...CONTINUE JMP STR1 YES LDA TEMP3,I GET RIGHT CHARACTER JSB STBYT ISZ TEMP2 DONE? JMP STR NO STR1 LDA .32 YES...NEED SPACES? ISZ TEMP4 COUNT WILL BE -1 OR LESS RSS NEED SPACE JMP STRNG,I MOVED ALL THE SPACES WE NEEDED JSB STBYT SAVE SPACE JMP STR1 AND CONTINUE * * SUBROUTINE TO MOVE NAME FROM NAME TO DCB * MNAM NOP LDA P.PTR GET CURRENT PRAM ADDRESS STA TEMP4 JSB GET.A GET DCB NAME ADDRESS STA MNAM1 SAVE ADDRESS FOR MOVE ISZ P.PTR WE ARE OK...GET INPUT ADDRESS JSB GET.A GET ADDRESS STA TEMP3 SAVE AS TEMP LDA MNAM1 GET LOWER BOUND LDB MNAM1 GET UPPER BOUND ADB .2 JSB DIMCK SEE IF DIM ARRAY MNAM2 LDB M4 GET DOWN COUNTER LDA TEMP3,I GET SOURCE STA MNAM1,I SAVE VALUE ISZ TEMP3 ISZ MNAM1 INB,SZB DONE? JMP *-5 NO LDA TEMP4 GET CURRENT PRAM ADDRESS STA P.PTR RESET POINTER JMP MNAM,I RETURN SPC 1 MNAM1 NOP SPC 2 * * SUBROUTINE TO DO DIMENSION CHECKING * CALLING SEQUENCE * JSB DIMCK * A REG= START OF ARRAY * B REG= END OF ARRAY * WILL ABORT IF ERROR * DIMCK NOP CMA CMB NEGATE BOUNDS ADA PROGL START OF STACK AREA ADB FCORE END OF STACK AREA SSA MUST BE NEGATIVE SSB MUST BE POSITIVE RSS ERROR...HE BLEW IT...KICeK HIM OFF JMP DIMCK,I RETURN...ALL OK LDA DIMFG SEE IF SPECIAL SZA ZERO, NOT SPECIAL JMP DIMCK,I YES SPECIAL JSB ERROR ERROR...DST ERROR DEF *+3 DEF .1 DEF DST DST ERROR MESSAGE JMP .STOP DOOM...GET OUT DST DEC 3 ASC 2,DST DIMFG NOP SPC 1 * * STORE A-REGISTER CONTENTS INTO NEXT WORD * OF SAVED VALUES. * RPARM NOP LDB U.PTR,I STA B,I ISZ U.PTR JMP RPARM,I * * STORE USER BUFFER LENGTH IN PARMB, DATA-FLAG, * AND SAVE IT. * STLEN NOP JSB INTGR STORE IN PARMB. * SZA,RSS JMP WRONG SPECIFIED, BUT ZERO. SSA,RSS NEGATIVE? JMP STL NO. * CMA,INA YES, MAKE POSITIVE. INA ROUND UP. CLE,ERA CONVERT TO WORD COUNT. * STL STA PARMB,I STORE IN DATA-FLAG. JSB RPARM PASS BACK TO CALLER. JMP STLEN,I EXIT. * WRONG LDA M71 JMP SSTAT * * TEST WHETHER THE USER HAS SPECIFIED * A PARAMETER. * JSB PCHEK * ERROR RETURN (PARAM NOT GIVEN) * NORMAL RETURN * PCHEK NOP LDA P.PTR PARAM ADDR CMA,INA ADA CALL,I RETURN ADDRESS. ADA M1 SSA,RSS ISZ PCHEK JMP PCHEK,I * * GET VALUE OF NEXT PARAM IN USER CALL * GET.P NOP JSB GET.A FETCH PARAM ADDR. LDA A,I GET PARAM VALUE. JMP GET.P,I * * GET ADDRESS OF NEXT PARAM IN USER CALL * AND BUMP PARAM POINTER. * GET.A NOP LDA P.PTR,I GET PARAMETER ADDRESS. RSS RESOLVE LDA A,I INDIRECT RAL,CLE,SLA,ERA ADDRESSES. JMP *-2 ISZ P.PTR BUMP PARAM POINTER. JMP GET.A,I * * STORE WORD (IN A-REG) IN PARMB. * STWRD NOP STA TEMP2 SAVE WORD. ALF,ALF JSB STBYT STORE LEFT BYTE. LDA TEMP2 JSB STBYT STORE RIGHT BYTE. LDA TEZMP2 RESTORE WORD. JMP STWRD,I RETURN. * * STORE BYTE IN NEXT BYTE OF PARMB. * STBYT NOP (A) = BYTE RIGHT JUSTIFIED. AND B377 ISOLATE NEW BYTE. STA TEMP1 SAVE. LDB B.PTR FORM WORD ADDR OF PARMB. CLE,ERB (E) = LEFT/RIGHT FLAG. ADB PARMB * LDA B,I INSERT NEW BYTE INTO PARMB. SEZ,RSS ALF,ALF AND M377L IOR TEMP1 SEZ,RSS ALF,ALF STA B,I * ISZ B.PTR BUMP RELATIVE BYTE POINTER. JMP STBYT,I RETURN. * * * PASS A-REG CONTENTS TO USER PARAM. * RWORD NOP STA TEMP1 JSB PCHEK IS PARAM SPECIFIED? JMP RWORD,I NO. LDA TEMP1 YES. LDB P.PTR,I STA B,I ISZ P.PTR JMP RWORD,I * * PASS N PARAMS TO USER PROGRAM. (B)= -N. * PINTG NOP STB TEMP2 PLOOP LDA I.PTR,I JSB RWORD ISZ I.PTR ISZ TEMP2 JMP PLOOP JMP PINTG,I * * SET CONTROL BYTE * STERM NOP LDA B202 JSB STBYT JMP STERM,I RETURN SKP * * SUBROUTINE TO ACCEPT EITHER A FLOATING POINT # * OR AN ASC II STRING * CALLING SEQUENCE * JSB FIXNM * ERROR RETURN * NORMAL RETURN * A REG=ADDRESS OF FIELD * B REG=NOT CHANGED IF ERROR, OR BUFFER ADDRESS ON RETURN * FIXNM NOP JSB INDCK TRACE DOWN THOSE LITTLE BITS STA FXNMA SAVE ADDRESS OF BUFFER LDA A,I GET COUNT WORD SZA,RSS ERROR...ZERO JMP FIXNM,I ERROR RETURN RAL,SLA NEGATIVE NUMBERS...ILLEGAL JMP FIXNM,I ERROR LDB FXNMA GET ADDRESS OF BUFFER AGAIN ISZ FIXNM GET NORMAL RETURN SSA,RSS BIT 14 SET...NUMERIC JMP FIXNM,I NO...ASC STRING * * IF NUMERIC CONVERT TO ASC AND ADD THE PREFEX "N" * LDB FNBFA GET ADDRESS OF INTERNAL BUFFER INB GET TO FIRST DATA WORD RBL sNLH CONVERT TO BYTE ADDRESS LDA ASCN GET THE PREFEX "N" JSB SBYTE SAVE PREFEX INB GET TO NEXT DATA BYTE ADDRESS STB FXNMB SAVE IN TEMP LOCATION DLD FXNMA,I GET FLOATING POINT WORD FIX CONVERT IT TO INTEGER JSB BNDEC CONVERT TO ASC FXNMB NOP BYTE ADDRESS GOES HERE INA INCREMENT CHARACTER COUNT TO INCLUDE "N" STA FNBF SAVE LENGTH OF NAME LDB FNBFA GET ADDRESS OF NAME BUFFER JMP FIXNM,I AND RETURN SPC 2 ASCN OCT 116 ASC "N" FXNMA NOP FNBFA DEF FNBF FNBF BSS 4 N SKP * * SUBROUTINE TO CONVERT BINARY TO ASC DECIMAL * UNSIGNED * CALLING SEQUENCE * JSB BNDEC * STARTING BYTE ADDRESS WHERE TO PUT OUTPUT * A REG BINARY NUMBER TO BE CONVERTED * UPON RETURN A REG=# OF CHARACTERS * THIS ROUTINE SUPRESSES LEADING ZEROS * BNDEC NOP STA DTEMP SAVE BINARY NUMBER LDB BNDEC,I GET STARTING BYTE ADDRESS STB DTMP1 SAVE FOR STORING ISZ BNDEC GET RETURN ADDRESS LDA .48 GET A ZERO JSB SBYTE SET INCASE WORD ALL ZEROS LDB M5 GET LOOP COUNT STB DCNT SAVE IN DOWN COUNTER LDA DNMA GET ADDRESS WHERE DIVISORS LOCATED STA DTMP2 SAVE IN INCREMENT COUNTER CLA GET A ZERO STA DTMP3 SAVE FOR # OF CHARACTERS CONVERTED BNDC1 CLB NEEDED FOR DIVISON LDA DTEMP GET BINARY NUMBER DIV DTMP2,I GET # OF TIMES IT WILL GO THROUGH STB DTEMP SAVE REMAINDER LDB DTMP3 GET OUTPUT BYTE ADDRESS SZA,RSS IS NUMBER ZERO? SZB AND IS IT A LEADING ZERO? RSS NO...SAVE IN JMP BNDC2 YES...IGNORE IT ADA .48 CONVERT TO ASC LDB DTMP1 GET BYTE ADDRESS WHERE TO PUT IT JSB SBYTE SAVE CHARACTER ISZ DTMP1 GET TO NEXT CHAR ADDRESS ISZ DTMP3 INCREMENT # OF CHAR COUNTERS BNDC2 ISZ DTMP2 GET TO NEXT DIVISOR ISZ DCNT DONE? JMP BNDC1 NO LDA DTMP3 GET COUNT SZA,RSS IS IT ZERO? INA YES...SET FOR ONE CHAR JMP BNDEC,I RETURN SPC 2 DTEMP NOP DTMP1 NOP DCNT NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM DNM DEC 10000,1000,100,10,1 SKP * * SUBROUTINE TO CLEAR LINE AND ENABLE LISTEN MODE * CLINE NOP LDA CLU GET LU AND B77 IOR B200 SET FOR CLEAR LINE STA CNWD SAVE AS CONTROL * JSB EXEC GO CLEAR THE LINE Y DEF *+3 DEF D3 CONTROL DEF CNWD CLA CLEAR DRIVER BUSY STA DBSY JSB LSTEN ENABLE LISTEN MODE JMP CLINE,I RETURN SPC 3 D3 DEC 3 B77 OCT 77 CNWD NOP SKP * * SUBROUTINE TO ENABLE LISTEN MODE * LSTEN NOP LDA CLU GET LU AND B77 IOR B100 SET FOR LSTEN ENABLE STA CNWD * JSB EXEC GO ENABLE DEF *+3 DEF D3 CONTROL DEF CNWD CLB WAIT AWHILE INCASE LINE DOWN INB,SZB JMP *-1 JSB EXEC GO DO A STATUS CHECK DEF *+4 DEF D13 DEF CLU DEF TEMP1 LDA TEMP1 GET STATUS JMP LSTEN,I RETURN SKP ********************************* * CONSTANTS AND WORKING STORAGE ******************** ********************************* * B5 OCT 5 D11 DEC 11 D12 DEC 12 D13 DEC 13 D124 DEC 124 D154 DEC 154 D160 DEC 160 D162 DEC 162 M10 DEC -10 MD150 DEC -150 MD153 DEC -153 MD163 DEC -163 M11 DEC -11 M51 DEC -51 M52 DEC -52 M60 DEC -60 M62 DEC -62 M70 DEC -70 M71 DEC -71 M72 DEC -72 M103 DEC -103 B202 OCT 202 B202L OCT 101000 B204 OCT 204 M377L OCT 177400 MBUFS ABS 0-MGSIZ-MGSIZ MAX # OF CHAR ALLOWED IN MESSAGEGE MBUFA DEF MBUF ADDRESS OF MESSAGE BUFFER MBFA2 DEF MBUF2 ADDRESS OF WHERE TO STORE MESSAGE RLU NOP REMOTE LU # * CLU NOP REMOTE COMPUTER LU RDATA NOP READ DATA FLAG. FCN NOP FUNCTION CODE. CALL NOP ADDR OF USER CALL +1. .FCN NOP 0= CEXEC, -= RFA. .RCD NOP CEXEC REQUEST CODE. P.PTR NOP USER CALL PARAM POINTER. B.PTR NOP PARMB BYTE POINTER. U.PTR NOP I.PTR NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP ISTAT NOP COMMUNICATION STATUS. * PARMB NOP * RPLY DEF REPLY * UPARM DEF UPRM UPRM DEF DADR DEF DLEN [ DEF PLEN * DADR NOP DLEN NOP PRMBA DEF PRMB PLEN NOP * * COMMUNICATION LINE ERROR MESSAGES * ASCIL ASC 1,IL ERMSG DEC 3 ASC 2,DS SKP * * THIS IS ONE TIME CODE USED TO CONFIGURE * THE SYSTEM AS TO WHICH LU DVR65 CARD IS ASSIGNED * THIS AREA OF CORE BECOMES BUFFERS!!!! * BY SETTING THE SIGN BIT ON THE STATUS REQUEST * RETURN WILL BE PASSED BACK TO ME EVEN * IF AN ERROR OCCURES. * IF AN ERROR OCCURES, THE A REG CONTAINS THE ASC * ERROR CODE. * IF A REG= "LU" NOT DONE...LU NOT ASSIGNED * IF A REG= "EQ" ALL FINISHED AND WE COULDN'T FIND * THE LU. IF THIS HAPPENS BSTOP IS CALLED AFTER AN ERROR * MESSAGE IS PRINTED. * AGAIN....WARNING.....THIS IS A ONE TIME SUBROUTINE... * SPC 2 SPC 1 CONFG NOP CLA GET A ZERO LDB M1 GET TO CALLING ADDRESS ADB CONFG STA B,I CLEAR CALLING ROUTINE LDA CLU GET COMM LU SZA DID SOMEBODY ELSE DEFINE IT? JMP CONFG,I RETURN...DON'T DO ANYTHING JMP CNF00 JUMP OVER MESSAGE BUFFER SPC 1 * * SET UP FOR BACKWARD ORG * FOR ONE TIME RUN THRU * * * NOTICE THE GAME WE ARE PLAYING * THE CONSTANT PART OF THE TELLOP MESSAGE IS * STORED HERE, AND THE BUFFER IS OVERLAYED BY ONE * TIME CODE, WHICH IS OVERLAYED BY ANOTHER BUFFER * AGAIN....WATCH OUT!!!!!!!!!!!! * * MBUF ASC 1,=S MBUF1 ASC 1, THIS IS WHERE THE LU IS STORED ASC 1,: * * NOTICE THAT THE VALUE "." IS USED FOR OTHER BUFFERS * . EQU * * * HERE WE CONFIGURE THE SDI CARD * SPC 1 CNF00 CLA,INA SET FOR LU 1 STA CLU SAVE LU CNF1 JSB EXEC MAKE A STATUS CALL DEF *+4 DEF SPSTW SPECIAL STATUS CALL WORD OCT 100013 DEF CLU LU DEF LUST STATUS REUTRNED JMP LUERR HERE ON AN ERROR LDA LUST GET STATUS CPA D65W nIS IT DVR65 DRIVER? JMP CNF0 YES...FOUND IT GET OUR LU CNF2 ISZ CLU JMP CNF1 TRY NEXT LU * * HERE IF WE CONFIGURED THE SDI CARD * NOW GO ENABLE IT AND FIND OUT WHO WE ARE * CNF0 LDA CLU GET COMM LU AND B77 KEEP ONLY THE LU IOR B300 SET UP FOR LSTEN CALL STA CNWD SAVE FOR CALL * JSB EXEC LSTEN CALL FOR THE LINE DEF *+4 DEF D3 CONTROL CALL DEF CNWD LSTEN DEF BITB PARAMETER BUFFER * CLA,CCE SET FOR WRITE REQ...NO DATA JSB %TAM DEF LUBR GET LU RETURN REPLY BUFFER DEF GTLUA ADDRESS OF GTLU PRMB SLA,RSS CHECK FOR DRIVER ERRORS JMP STDVR ERROR..TELL WORLD LDA LUBR+2 GET LU STA RLU SAVE FOR WORLD TO SEE CLB DIV .10 GET LU IN A AND B REG ADA .48 CONVERT TO ASC ADB .48 ALF,ALF MERGE INTO ONE WORD IOR B STA MBUF1 SAVE IN ASC THE LU JMP CONFG,I RETURN * * HERE ON DRIVER ERROR ON GET LU CALL * STDVR JSB EXEC TELL WORLD DEF *+5 DEF .2 DEF .1 DEF DVRA DEF DVRL JSB .STOP AND GET OUT SPC 1 DVRL DEC 16 DVRA ASC 16,COM LIN ERR START UP PHASE RTE-B * * HERE IF WE HAD A STATUS ERROR * LUERR CPA EQWD IS ERROR= TO "EQ"? JMP CNF2 YES...NOT A SERIOUS ERROR * * HERE WE IN BIG TROUBLE...NO SDI CARD * JSB EXEC WE IN BIG TROUBLE...NO DVR65 DEF *+5 DEF .2 WRITE REQUEST DEF .1 TO SYSTEM OUTPUT DEVICE DEF NLUER "NO DVR65 LU ASSIGNED" DEF NLUEL LENGTH JSB .STOP TERMINATE * NLUER ASC 10,NO DVR65 LU ASSIGNED NLUEL DEC 10 D65W OCT 32400 NOTE...THIS CONSTANT WILL DISAPEAR!!! LUST NOP SO WILL THIS TEMP WORD SPSTW OCT 100015 AND THIS EQWD ASC 1,EQ GTLUA DEF LUBR 1 WORD PARMB DEC 2 NEEDED FOR GTLU PARMB LUBR REP 35 MUST BE NOP'S FOR GET LU COMMAND NOP B300 OCT 300 BITB DEF *+1 NOP NOP DEC -1000 TIME OUT NOP NOP DEC -1 SIZ1 EQU * * * * RESET ORG FOR BUFFERS * ORG . * * SET UP MESSAGE BUFFER * MGSIZ EQU SIZ1-.-25 MBUF2 BSS MGSIZ * * NOTICE THAT WE HAVE OVERLAYED CODE!!!!!! * REPLY BSS 35 NOTICE THAT REPLY BUFFER IS USED * BY THE MESSAGE COMMAND!!! * PRMB BSS 35 * SIZE EQU * * END * l 91704-18102 1549 S 0122 DS1/B SCE/4 MODULE: %ASGN              H0101 KASMB,L,R,C,F HED %ASGN 91704-16102 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM %ASGN,7 91704-16102 REV A 751205 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 *********************************************** * *%ASGN HIGH LEVEL RFA INTERFACE ROUTINE * *SOURCE PART # 91704-18102 REV A * *REL PART # 91704-16102 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-13-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: NOV. 1975 * ************************************************ SPC 1 SUP * * * DEFINE ENTRY POINTS * SPC 1 ENT FLPCK,FLRCK,ASGN,UASGN,STATS ENT CLASN SPC 2 * * DEFINE EXTERNALS * EXT SWLST,TSTIT,EPRIN,TYPE EXT CRLF,CWRIT,EINPT,CREAD,READR EXT M2,M3,M4,M5,M7 EXT .32,.10,B377 EXT .ENTR,ERROR,CCLOS,CCRET,COPEN EXT ABYTE,SBYTE EXT DIMFG,EXEC,MOVE,FIXNM SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SKP * * HERE ON PRINT# STATEMENT * A REG CONTAINS THE LU * NOTE....A REG MUST NOT BE LOST IF CONTROL * IS TO BE RETURN TO RTEB... * IF THE LU IS FOUND IN THE LU TABLE * CONTROL IS TRANSFERED TO CORRECT ROUTINE * OTHERWISE CONTROL IS PASSED TO RTEB TO HANDLE I/O * SPC 2 FLPCK NOP JSB FILCK CHECK IF LU MATCHES FILE RSS MATCH...CONTINUE JMP FLPCK,I NO MATCH RETURN SPC 2 * * HERE IF LU MATCHES ONE IN THE FILE TABLE * LDA TABN GET TABLE DISPLACEMENT # MPY FPTS GET DISPLACEMENT TO FILE POINTER TABLE ADA FPT GET ADDRESS OF CORRECT TABLE START STA FILC3 SAVE IN TEMP FOR SWLST JSB SWLST SWITCH LIST DEVICE FILC3 NOP JMP EPRIN GO PROCESS AS A NORMAL PRINT SPC 2 FILT1 NOP FILT2 NOP FILT3 NOP SKP * * HERE ON READ# STATEMENT * A REG CONTAINS LU * IF THE LU IS FOUND IN THE LU TABLE * CONTROL IS TRANSFERED TO CORRECT ROUTINE * OTHERWISE CONTROL IS PASSED TO RTEB TO HANDLE I/O * SPC 2 FLRCK NOP JSB FILCK CHECK IF LU MATCHES FILE RSS WE HAVE A MATCH JMP FLRCK,I NO MATCH...JUST RETURN SPC 2 * * HERE IF LU MATCHES ON A READ REQUEST * LDA TABN GET TABLE NUMBER MPY FNPS LENGTH OF FILE NAME ENTRIES ADA FNPT ADD TO START OF FILE NAME AREA STA RNAMA SAVE FOR DCB ADDRESS ON READ LDB TABN GET TABLE ENTRY AGAIN ADB FSTT GET STATUS TABLE ADDRESS STB RSTA SAVE STATUS TABLE ADDRESS LDB FREDA GET ADDRESS OF FILE READ ROUTINE STB READR SAVE FOR BASIC JMP EINPT GO PROCESS INPUT SPC 2 FREDA DEF FREAD .5 OCT 5 SKP * * ROUTINE TO DO REMOTE READS * WHEN WE COME IN * A REG = POSITIVE CHAR COUNT * B REG = BUFFER ADDRESS * FILE NAME SET UP BY FLRCK * A REG= # OF CHARACTERS RECIEVED * FREAD NOP STB RBUFA SAVE BUFFER ADDRESS CLE,ERA CONVERT TO WORD ADDRESS STA FILT1 SAVE WORD LENGTH * * HERE WE DO THE READ REQUEST * ISZ DIMFG SET FOR SPECIAL REQ JSB CREAD DEF *+6 RNAMA NOP ADDRESS OF NAME BUFFER RSTA NOP ADDRESS OF STATUS WORD RBUFA NOP ADDRESS OF BUFFER DEF FILT1 MAX LENGTH DEF FILT2 ACTUAL LENGTH * * IF END OF FILE...MOVE ZERO TO BUFFER * LDA RSTA,I GET STATUS CPA M12  -12...EOF REACHED JSB ZERO LDA FILT2 GET ACTUAL LENGTH CLE,ELA CONVERT TO BYTE LENGTH JMP FREAD,I NO...ALL OK * * HERE TO MOVE ZERO IN BUFFER * ZERO NOP LDA ZEROF GET ZERO FILL WORD LDB FILT1 GET LENGTH STB FILT2 SET LENGTH TO MAX CMB,INB NEGATE COUNT ZERO1 STA RBUFA,I SAVE WORD ISZ RBUFA GET NEXT ADDRESS INB,SZB DONE? JMP ZERO1 NO JMP ZERO,I YES...RETURN SPC 2 ZEROF OCT 30040 SPACW OCT 20040 M12 DEC -12 SKP * * HERE WE COME IF WE ARE TO WRITE ON FILE #1 * * EACH ENTRY IS 7 WORDS LONG AND IS DESCRIBED BELOW * TO EXPAND THE NUMBER OF WORDS IN EACH ENTRY, * YOU MUST CHANGE THE LABEL "TABS",WHICH IS USED * ALL OVER THE PLACE FOR INDEXING TO CORRECT STARTING * ADDRESS OF ROUTINE TABS EQU 7 LENGTH OF EACH ENTRY * NOP CURRENT BUFFER COUNT ABS 0-BUFS-BUFS+2 MAX BUFFER LENGTH OCT -2 TO TELL SWITCH LIST TO ADD 2 TO ADDRESS FOR EOL PAR. FILE1 NOP SAVE RETURN ADDRESS JSB FILWT WRITE FILE INTO A TEMP BUFFER OCT 0 DEFINE FILE BUFFER #1 (NOTE 1 LESS) FLND1 JSB FILND GO TO END OF LINE ROUTINE SPC 2 * * HERE FOR FILE #2 * NOP ABS 0-BUFS-BUFS+2 OCT -2 FILE2 NOP JSB FILWT OCT 1 FLND2 JSB FILND SPC 2 * * HERE FOR FILE #3 * NOP ABS 0-BUFS-BUFS+2 OCT -2 FILE3 NOP JSB FILWT OCT 2 FLND3 JSB FILND SPC 2 * * HERE FOR FILE #4 * NOP ABS 0-BUFS-BUFS+2 OCT -2 FILE4 NOP JSB FILWT OCT 3 FLND4 JSB FILND SKP * * HERE WHERE ALL BUFFER ROUTINES COME TO HAVE * THERE BUFFERS DUMPED TO CENTRAL * THE CALLING SEQUENCE MUST BE HELD TO OR WE IN BIG TROUBLE * * NOP CURRENT COUNT UPDATED BY SWLST * DEC -72 MAX LINE LENGTH = * OCT -2 FLAG TO TELL SWITCH LIST I WILL HANDLE CRLF *FILEX NOP HERE WE COME FROM BASIC * JSB FILWT THERE WE GO TO FILL THE BUFFER * OCT X FILE BUFFER NUMBER * JSB FILND JSB FILND CRLF ROUTINE (MUST BE IN THAT LOC FOR SWLST) * * SPC 2 FILWT NOP STA FLWTB SAVE - LENGTH CLE,ELB CONVERT WORD ADDRESS TO BYTE ADDRESS STB SBYA SAVE IN SOURCE BYTE ADD. LDA FILWT GET PRAMS OF CALL ADA M2 GET TO CALLING ADDRESS STA *+2 SET FOR SWITCH LIST JSB SWLST SWITCH TO CURRENT DEVICE (SET TYPE WORD!) FLWTA NOP SET A LABEL FOR RETURN AT END OF ROUTINE UPDAT LDA FLWTB GET LENGTH CMA,INA MAKE IT POSITIVE ADA TYPE SET TYPE TO LENGTH AFTER MOVE STA TYPE CLA NEEDED FOR TSTIT JSB TSTIT SEE IF WE EXCEEDED LENGTH SZA,RSS A ZERO...EXCEEDED LENGTH JMP UPDAT YES...RESET TYPE LDA FILWT,I GET BUFFER # MPY FBPS GET STARTING ADDRESS OF CORRECT BUFFER ADA FBPT GET ACTUAL STARTING WORD ADDRESS CLE,ELA CONVERT TO BYTE ADDRESS LDB FILWT GET TO CURRENT DISPLACEMENT WITHIN ADB M5 DATA BUFFER...IT IS 5 WORDS BACK ADA B,I FROM FILWT RETURN...GET BYTE ADD IN BUFER STA DBYA SET FOR DESTINATION START BYTE ADDRESS LDA TYPE GET LENGTH IN BUFFER AFTER WRITE STA B,I RESET CURRENT COUNTER LDA SBYA GET SOURCE BYTE ADDRESS LDB DBYA GET DESTINATION BYTE ADDRESS JSB MOVE MOVE LINE FLWTB NOP LDA .32 GET A SPACE JSB SBYTE ALWAYS END WITH SPACE...TAKE CARE EVEN ODD LDB FLWTA,I GET RETURN ADDRESS JMP B,I RETURN SPC 2 SBYA NOP DBYA NOP SKP * * HERE AT END OF LINE * CALLED BY CRLF ROUTINE INDIRECTLY THROUGH FLNDX * FILND NOP LDA M2 ADA FILND F LDA A,I GET FILE# JSB WRITF WRITE OUT BUFFER...A REG=0 MUST LDB CRLF GET RETURN ADDRESS JMP B,I RETURN SKP * * SUBROUTINE CALLED BY BASIC TO ASSIGN AN LU * TO A REMOTE FILE. * * CALLING SEQUENCE * CALL ASSIGN("FILENAME",LU,ERROR) * B/N TABLE ENTRY SHOULD LOOK LIKE * ASSIGN(R,I,V),SUB=ASGN * SPC 2 AFNMA NOP ALUA NOP AERRA NOP ASGN NOP JSB .ENTR GO GET PRAMS DEF AFNMA LDA AFNMA GET ADDRESS OF NAME LOCATION JSB FIXNM CHECK NAME JMP AER15 STB AFNMA SAVE ADDRESS LDA AFNMA,I GET LENGTH WORD AND B377 ADA M7 CHECK IF IN RANGE SSA,RSS JMP AER15 NOT IN RANGE LDA CM70 GET ERROR CODE LDB ALUA,I GET LU SZB,RSS LU ZERO ILLEGAL JMP AERR LDA B JSB FILCK SEE IF IT IS ASSIGNED JSB CLOSE ASSIGNED...CLOSE FILE JSB ROMCK SEE IF WE HAVE ROOM JMP AERR NO ROOM JSB ASNF HAVE ROOM ASSIGN THE FILE AERR STA AERRA,I SAVE STATUS JMP ASGN,I NO...RETURN SPC 2 CM15 DEC -15 AER15 LDA CM15 JMP AERR SKP * * SUBROUTINE TO SET ALL TABLE ENTRIES AND * EITHER OPEN OR CREATE A FILE * CALLING SEQUENCE * JSB ASNF * NORMAL RETURN * A REG = TABLE INDEX NUMBER * B REG = TABLE # 1 ADDRESS *ALUA= ADDRESS OF LU *AFNMA= FILE NAME ADDRESS * ALSO TABN MUST CONTAIN TABLE # * UPON RETURN A REG= STATUS * ASNF NOP STB FILT2 SAVE ENTRY INTO TABLE ADA FSTT GET STATUS ADDRESS STA OSTA SAVE AS OPEN STATUS ADDRESS STA CRSTA SAVE FOR CREATE STATUS ADDRESS LDA TABN GET TABLE ENTRY # MPY FNPS GET DISPLACEMENT IN NAME BUFFER ADA FNPT GET ADDRESS OF NAME STA ONAMA SAVE DCB-"NAME" ADDRESS STA CRNMA SAVE FOR CREATS,E AS WELL LDA AFNMA ADDRESS OF FILE NAME STA OFNAM SAVE FOR OPEN STA CRFNM SAVE FOR CREATE ISZ DIMFG SET FOR SPECIAL JSB COPEN TRY OPENING THE FILE DEF *+6 ONAMA NOP OSTA NOP OFNAM NOP DEF .0 NO SECURITY CODE DEF .0 NO LU LDA OSTA,I GET STATUS SSA,RSS ALL OK? JMP ASNF1 YES ISZ DIMFG SET FOR SPECIAL JSB CCRET NO...TRY TO CREATE IT DEF *+8 CRNMA NOP CRSTA NOP CRFNM NOP DEF FSIZE DEFINE FILE SIZE AS A FLOATING PT. NUMBER DEF .10 FILE TYPE=10 DEF .0 DEF .0 LDA CRSTA,I GET STATUS ASNF1 LDB ALUA,I GET LU SSA,RSS ALL OK? STB FILT2,I YES...SET FILE AS ASSIGNED JMP ASNF,I RETURN SPC 2 FSIZE DEC 20. MAKE IT 20 RECORDS LONG F.P. .0 OCT 0,0 RECORD SIZE 0 SKP * * FUNCTION CALL MADE BY BASIC * ROUTINE NAME STATS * B/N ENTRY SHOULD LOOK LIKE * STATUS,SUB=STATS * ROUTINE TO GET THE STATUS OF A LOGICAL UNIT * STATS NOP FIX CONVERT LU TO INTEGER STA FILT1 SAVE LU JSB FILCK SEE IF IT IS A FILE RSS YES IT IS A FILE JMP EQTST NOT A FILE DO AN EQT STATUS CALL LDA TABN GET TABLE DISPLACEMENT # ADA FSTT GET STATUS LDA A,I WE HAVE STATUS STAT1 CLB GET A ZERO IN B FLT CONVERT TO FLOATING NUMBER JMP STATS,I RETURN TO BASIC * * HERE IF EQT STATUS CHECK * EQTST JSB EXEC DEF *+4 DEF .13 DEF FILT1 LU IN THAT ADDRESS DEF FILT2 LDA FILT2 GET STATUS AND B377 MASK ALL BUT STATUS JMP STAT1 RETURN TO BASIC SPC 2 .13 DEC 13 SKP * * ROUTINE CALLED BY BASIC TO UNASSIGN AN LU * CALLING SEQUENCE * CALL UNASSGN(LU,ERROR) * B/N ENTRY SHOULD LOOK LIKE * UN ASGN(I),SUB=UASGN * * ERROR WILL BE DS/1-11 * ULUA NOP USTAT NOP UASGN NOP JSB .ENTR DEF ULUA LDA ULUA,I GET LU SZA,RSS ZERO? JMP UAERR YES...ILLEGAL...ERROR JSB FILCK FIND FILE * * HERE WE CLOSE THE FILE * JSB CLOSE CLOSE FILE RSS UAERR LDA CM70 STA USTAT,I JMP UASGN,I RETURN SPC 2 SKP * * ROUTINE CALLED BY BSUPV TO UNASIGN ALL ASSIGNED * FILES. THIS ROUTINE IS CALLED TO PROTECT THE BASIC * USER FROM HIMSELF * CLASN NOP LDA ASGLA GET LU TABLE ADDRESS STA CLGN1 SAVE TABLE ADDRESS LDA MMAXF GET MAX NUMBER OF ENTRIES STA CLGN2 SAVE FOR DOWN COUNTER CLGNA LDA CLGN1,I GET LU SZA,RSS IS THERE ONE? JMP CLGNB NO...ENTRY NOT ASSIGNED...CHECK THE REST JSB UASGN IT IS ASSIGNED...UNASIGN IT DEF *+3 FAKE UNASIGN ROUTINE OUT!!! CLGN1 NOP DEF USTAT PUT STATUS BACK ON ITSELF CLGNB ISZ CLGN1 GET NEXT ENTRY ISZ CLGN2 WE DONE? JMP CLGNA NO...GET NEXT ENTRY JMP CLASN,I DONE...RETURN SPC 1 CLGN2 NOP SKP * * ROUTINE TO CHECK IF FILE MATCHES LU * A REG CONTAINS LU * B REG SAVED IF NO MATCHED * B REG=TABLE #1 ADDRESS IF ENTRY FOUND * UPON RETURN FILT2 CONTAINS - DISPLACEMENT+1 * TABN CONTAINS TABLE NUMBER -1 * FILCK NOP STB FILT1 SAVE B REG CLB GET A ZERO TO CLEAR TABLE COUNT STB TABN RESET TABLE NUMBER TO ZERO LDB MMAXF GET NUMBER OF BUFFERS STB FILT2 SAVE IN DISPLACEMENT COUNTER LDB ASGLA GET ADDRESS OF LU ASSIGNEMENT TABLE FILC1 CPA B,I IS THE LU SPECIFIED MATCHED? JMP FILCK,I YES...DO MATCH RETURN ISZ TABN INCREMENT TABLE NUMBER INB NO...GET TO NEXT ENTRY ISZ FILT2 DONE? JMP FILC1 NO LDB FILT1  YES...RESTORE B REG ISZ FILCK GET NO MATCH RETURN JMP FILCK,I RETURN SPC 1 TABN NOP SKP * * SUBROUTINE TO WRITE A RECORD ONTO A FILE * CALLING SEQUENCE * JSB WRITF * A REG= FILE # * * UPON RETURN FILT3=ADDRESS OF CURRENT LENGTH * A REG=0 TYPE AND CURRENT LENGTH SET TO ZERO * WRITF NOP STA FILT1 SAVE IN TEMP LOCATION MPY FBPS GET DISPLACEMENT IN DATA BUFFER BUFFER ADA FBPT GET STARTING ADDRESS FOR THIS DATA BUFFER STA BUFA SAVE BUFFER ADDRESS LDA FILT1 GET TABLE NUMBER MPY FNPS GET DISPLACEMENT IN NAME BUFFER ADA FNPT GET ADDRESS OF NAME BUFFER STA NAMA SAVE FOR WRITE CALL LDA FSTT GET FILE STATUS TABLE ADDRESS ADA FILT1 GET DISPLACEMENT STA STATA SAVE STATUS ADDRESS LDA FILT1 GET TABLE NUMBER MPY FPTS GET DISPLACEMENT IN ROUTINE BUFFER ADA FPT GET ADDRESS OF ROUTINE BUFFER ADA M3 GET TO LENGTH WORD STA FILT3 SAVE CURRENT LENGTH ADD LDA A,I GET LENGTH SZA,RSS IF LENGTH ZERO DON'T DO ANYTHING JMP WRT1 INA ADD ONE TO CONVERT ODD TO EVEN CLE,ERA CONVERT TO WORD ADDRESS STA FILT2 SAVE LENGTH * * HERE WE DO THE REMOTE FILE WRITE * ISZ DIMFG SET FOR SPECIAL JSB CWRIT DEF *+5 NAMA NOP STATA NOP BUFA NOP DEF FILT2 CLA GET A ZERO STA FILT3,I CLEAR COUNTS STA TYPE CLEAR COUNTS WRT1 JMP WRITF,I RETURN SKP * * SUBROUTINE CLOSE A FILE * CALLING SEQUENCE * JSB CLOSE * RETURN * A REG= FILE # * B REG=ADDRESS OF LOCATION IN TABLE #1 * FILT2 MUST BE SET TO -TABLE NUMBER+1 * WILL CLOSE FILE AND CLEAR ALL ENTRIES * AFTER FLUSHING THE BUFFER * CLOSE NOP CLA GET A ZERO FOR TABLE ENTRY STA B,I CLEAR OUT TABLE LDA TABN GET TABLE NUMBER JSB WRITF FLUSH THE BUFFER LDA NAMA GET ADDRESS OF NAME STA CNAMA SAVE FOR CLOSE REQEST LDA STATA GET STATUS ADDRESS STA CSTA SAVE STATUS JSB CCLOS CLOSE THE FILE DEF *+3 CNAMA NOP CSTA NOP LDA CSTA,I GET STATUS OF CLOSE JMP CLOSE,I RETURN SKP * * ROUTINE TO CHECK IF THERE IS ANY TABLE ROOM * CALLING SEQUENCE * JSB ROMCK * ERROR RETURN B REG=-73...NO ROOM * NORMAL RETURN * UPON RETURN A REG= TABLE NUMBER * B REG= TABLE #1 ADDRESS * ROMCK NOP LDA MMAXF GET MAX TABLE SIZE STA ROMT1 SAVE IN COUNTER CLA GET A ZERO STA TABN RESET TABLE INDEX NUMBER LDB ASGLA GET ADDRESS OF FILE TABLE ROM1 CPA B,I ZERO WORD= AVAILABLE JMP ROM2 ISZ TABN GET TO NEXT TABLE ENTRY INB GET NEXT BUFFER ADDRESS ISZ ROMT1 DONE? JMP ROM1 LDA CM73 JMP ROMCK,I NO ENTRY AVAILABLE RETURN ROM2 ISZ ROMCK GET NORMAL RETURN LDA TABN GET TABLE NUMBER JMP ROMCK,I RETURN * ROMT1 NOP CM70 DEC -70 CM73 DEC -73 SKP * * DEFINE MAX # OF FILES * THE MAX NUMBER OF FILES THAT A USER CAN OPEN * AT ANY ONE TIME IS DEFINED BY THE LABEL "MAXF". * CHANGING THE VALUE OF THIS LABEL WILL CHANGE * THE NUMBER OF FILES THAN CAN BE OPENED. ALL TABLES * WILL MODIFY THEMSELVES TO REFLECT THE CHANGE EXCEPT * THE FILE POINTER TABLE. I AM UNABLE TO AUTOMATE THE * GROWTH OF THIS TABLE AT ASSEMBLY TIME BECAUSE OF * JSB INSTRUCTIONS INTERSPECRED WITH THE CONSTANTS... * 10 POINTS FOR THE ONE WHO CAN HELP ME...L.P. * MAXF EQU 4 * * * DEFINE TABLES NEEDED * SPC 2 * * TABLE #1...LU ASSIGNMENT TABLE * THIS TABLE IS SET BY AN ASSGN CALL * AND CLEARED BY A REASSGN OR <:6CLOSE CALL * IF THE TABLE CONTAINS A ZERO...NO LU * ASGLA DEF *+1 REP MAXF #DEFINE NUMBER OF ENTRIES NOP SPC 2 * * TABLE #2... ROUTINE TABLE * HERE WE DEFINE THE STARTING ADDRESS OF THE ROUTINE * TABLE-"FPT", AND THE LENGTH OF EACH ENTRY IN THE TABLE * -"FPTS", WHICH IS SET TO THE LENGTH OF EACH ENTRY * FPT DEF FILE1 FPTS ABS TABS SPC 2 * * TABLE #3...BUFFER TABLE * HERE WE DEFINE THE STARTING ADDRESS OF THE DATA * BUFFER AREA-"FBPT", AND THE LENGTH OF EACH DATA * BUFFER WITHIN THE AREA-"FBPS". * FBPT DEF FBF FBPS ABS BUFS SPC 2 * * TABLE #4...FILE NAME TABLE * HERE WE DEFINE THE STARTING ADDRESS OF THE * DCB-FILE NAME TABLE-"FNPT",AND THE LENGTH OF * EACH NAME ENTRY-"FNPS". THE NAME GETS PUT IN * THIS BUFFER WHEN WE DO AN OPEN OR A CREATE. * FNPT DEF NAME FNPS ABS NAMES SPC 2 * * TABLE #5...STATUS TABLE * THE NUMBER OF ENTRIES IN THIS TABLE IS DETERMINED * BY MAXF. * FSTT DEF *+1 REP MAXF NOP SPC 2 * * NEGATIVE MAX # OF ENTRIES * * MMAXF ABS 0-MAXF SKP * * FILE BUFFERS--TABLE #3 * BUFFER SIZE IS DEFINED BY "BUFS". * BUFS EQU 37 * * # OF BUFFERS IS DEFINED BY MAXF * FBF REP MAXF LABEL ON REP WILL HAVE ADD OF FIRST WORD BSS BUFS INDIVIDUAL BUFFER SIZE SPC 2 * * NAME BUFFERS--TABLE #4 * LENGTH OF EACH NAME BUFFER IS DEFINED BY "NAMES" * NAMES EQU 4 * * NUMBER OF NAME BUFFERS DEFINED BY "MAXF" * NAME REP MAXF ASC NAMES, MOVE SPACE IN NAME AREA SPC 3 END EQU * END < m| 91704-18103 1607 S 0122 DS1/B SCE/4 MODULE: %INTR              H0101 _ASMB,L,R,C HED %INTR 91704-16103 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM %INTR,1,3 91704-16103 REV A 760212 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ********************************************* * *%INTR PROGRAM TO HANDLE DISTRIBUTED SYSTEM INTERUPTS * *SOURCE PART # 91704-18103 REV A * *REL PART # 91704-16103 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-21-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: DEC 1975 * ********************************************** SPC 1 * * PROGRAM SCHEDULED BY DVR65 ON AN INTERUPT * WILL BRANCH TO CORRECT ROUTINE DEPENDING ON * STREAM TYPE * * DEFINE EXTERNALS * EXT REPLA,EXEC,FRPLY EXT FINDT,TRFLG,MSTFL,MSTB EXT %MOVE,DBSY SPC 2 * * DEFINE ENTRIES * ENT %BUF * * DEFINE LISTING OPTIONS * SUP * * DEFINE A AND B REGS * A EQU 0 B EQU 1 * SPC 3 START ISZ DBSY SET INTERUPT PROG BUSY JSB EQLU GET LU SZA,RSS LU DEFINED? JMP RPERR NO...IGNORE INTERUPT STA LU JSB RREQ READ REQUEST LDA %BUF GET STREAM TYPE AND BIT14 GET REQ/REPLY FLAG STA TEMP SAVE FOR LATTER LDA %BUF GET STREAM AGAIN AND B377 AND KEEP ONLY THE STREAM TYPE STA %BUF SAVE WITH BIT 14 OFF STA B CHECK LIMITS ADB M10 CAN'T BE LARGER THAN 9 SSB SSA LDA D10 SET FOR STREAM ERROR LDB A  GET STREAM AGAIN ADA BRNTA ADB BRNTB STB TEMP1 LDB TEMP SZB,RSS REPLY? LDA TEMP1 NO...REQUEST LDA A,I JMP A,I AND GO TO THE ROUTINE SPC 2 * * REPLY * BRNTA DEF *+1 DEF RFAR GET LU DEF RFAR DLIST DEF RFAR PROGRAM LOAD SAVE DEF RPERR PROGL...ERROR DEF PTPR PROGRAM TO PROGRAM REPLY DEF RFAR REMOTE EXEC REPLY DEF RFAR REMOTE RFA REPLY DEF RPERR OPERATOR COMMANDS...ERROR DEF RPERR FORCED DOWN LOAD...ERROR DEF RPERR UNDEFINED...ERROR DEF RPERR UNDEFINED...ERROR SPC 2 * * REQUEST * BRNTB DEF *+1 DEF GETLU GET LU DEF RERR DLIST DEF RERR PROGRAM LOAD SAVE DEF RERR PROGL DEF PTPR PROGRAM TO PROGRAM..REQUEST DEF REXEC REMOTE EXEC REQUEST DEF RERR FMGR REQUEST DEF RERR OPERATOR COMMANDS DEF RERR FORCED DOWN LOAD DEF RERR UNDEFINED DEF RERR UNDEFINED SPC 2 * * HERE ON RFA REPLY * RFAR LDA REPLA GET REPLY BUFFER ADDRESS STA REPLY SAVE ADDRESS LDA RREQ1 GET SOURCE ADDRESS LDB D35 GET LENGTH JSB %MOVE MOVE TO REPLY BUFFER AREA REPLY NOP REPLY BUFFER ADDRESS LDA LINST GET STATUS OF REQUEST STA FRPLY SET FOR COMPLETION...AND LENGTH JMP TERM TERMINATE ,INTR SPC 3 * * HERE ON GET LU REQUEST * GETLU LDA LU GET LU OF SERIAL INTERFACE STA REFCD SAVE FOR REPLY JSB SRPLY SEND REPLY JMP TERM AND TERMINATE SPC 3 * * HERE FOR PROGRAM TO PROGRAM COMUNICATION * PTPR LDA RREQ1 GET REPLY BUFFER ADDRESS ADA C2 GET TO FUNCTION CODE WORD LDA A,I GET FUNCTION CODE ALF,ALF WANT TO CHECK BIT 7 SSA IS IT A REPLY? JMP RFAR YES...TREAT LIKE RFA SPC 2 * * HERE FOR SLAVE PROGRAM TO PROGRAM ROUTINES * THIS ROUTINE USES FINDT TO GET THE TRAP # * AS SPECIFIED BY CENTRAL. THE TRAP IS THEN SET * AND THE PARMB IS MOVED INTO CORE RESIDENT LIBRARY * FOR LATTER AXCESS BY BASIC ROUTINES THAT HANDLE * SLAVE CALLS. * LDB RREQ1 GET BUFFER ADDRESS ADB C7 GET TO TRAP# LDA B,I GET TRAP# ALF,ALF GET 10'S DIGIT AND B17 MASK OFF THE ASC 60 STB TEMP SAVE ADDRESS OF LU MPY D10 MULTIPY BY 10 STA TEMP1 LDA TEMP,I GET TRAP # AGAIN AND B17 MASK OFF TO BINARY # ADA TEMP1 ALF,ALF GET IN CORRECT POSITON FOR FINDT JSB FINDT SEE IF TRAP ASSIGNED JMP TRPNT TRAP NOT THERE LDA B,I B REG POINTS TO TRAP ACTIVE WORD IOR BIT15 SET TRAP ACTIVE STA B,I SAVE TRAP ACTIVE STA TRFLG SET TRAP PENDING FLAG LDA MSTBA GET MASTER PARMB BUFFER ADDRESS JSB INDCK STA MSTBA CLEAR OFF INDIRECTS LDA RREQ1 GET SOURCE BUFFER ADDRESS LDB D35 GET PARMB LENGTH STB MSTFL SET LENGTH OF TRANSFER JSB %MOVE MOVE PARMB TO CORE RESIDENT LIB MSTBA DEF MSTB BUFFER ADDRESS OF MASTER PARMB AREA JMP TERM ALL DONE, TERMINATE SPC 1 * * HERE IF TRAP NOT SET...SEND A -41 ERROR * TO CENTRAL * TRPNT LDB RREQ1 GET TO STATUS WORD ADB C2 LDA B,I GET STATUS WORD IOR NTERR NOT THERE ERROR... BITS 15,7,2 STA B,I SAVE ERROR STATUS INB GET TO ERROR WORD LDA M41 GET -41 ERROR STA B,I SAVE ERROR JSB ENLIN CLEAR LINE IF REQUIRED JSB SRPLY AND SEND REPLY JMP TERM DONE...TERMINATE SPC 1 M41 DEC -41 SPC 4 * * HERE ON REMOTE EXEC CALLS * REXEC LDA RCODڜ GET REQUEST CODE XOR C3 REVERSE DIRECTION IF READ OR WRITE STA DDIR SAVE DIRECTION FLAG XOR C3 GET IT BACK TO NORMAL IOR BIT15 SET FOR SPECIAL EXEC REQ CODE STA RCOD SAVE REQUEST CODE XOR BIT15 STIP OFF BIT 15 FOR CHECK CPA C1 IS IT A READ? JMP REQ1 YES CPA C2 IS IT A WRITE? JMP REQ2 YES CPA C3 IS IT A CONTROL REQUEST? JMP REQ3 YES CPA D13 IS IT A STATUS REQUEST? JMP REQ13 YES CPA D10 IS IT A TRAP CALL? JMP REQ10 YES * * ILLEGAL EXEC CALL FOR THIS TERMINAL * JSB ENLIN CLEAR THE LINE IF REQUIRED DLD RQER "RQ " REQUEST ERROR SPC 1 * * HERE TO TERMINATE REMOTE EXEC CALLS * A AND B REG CONTAIN CORRECT STATUS * AS TO WHAT THE CENTRAL USER RECEIVES * REDN DST SABRG SAVE A AND B REG JSB SRPLY SEND REPLY JMP TERM AND TERMINATE SPC 2 * * HERE ON READ REQUEST * REQ1 LDA DLEN GET LENGTH OF DATA BUFFER SPC 2 * * HERE ON WRITE REQUEST * REQ2 EQU REQ1 SAME AS READ LDB DLEN GET IT AGAIN ADA MMDBS IS IT GREATER THAN MAX DATA BUF SIZE? SZA OR IS THERE A DATA BUFFER LENGTH SSA,RSS RSS ERROR JMP REQ22 NO ERROR JSB ENLIN CLEAR THE LINE DLD BFER "BF " BUFFER ERROR JMP REDN AND TERMINATE REQUEST * REQ22 LDA DDIR GET DIRECTION AGAIN CPA C2 IS IT A READ (REMEMBER WE INVERTED...) JSB RWEX YES...READ FROM DEVICE FIRST DST ABREG SAVE A AND B REG LDA DDIR GET DATA DIRECTION STA IRW LDA LU GET LU AND B77 KEEP ONLY LOW 6 BITS IOR B300 SET DATA ONLY CODE STA CNWD SAVE JSB EXEC READ OR WRITE TO OR FROM CENTRAL DEF *+7 DEF IRW REQUEST CODE DEF CNWD COONTROL DEF %DBUF DEF DLEN DEF %BUF+33 PASS TIME-TAGS DEF %BUF+34 LDA DDIR GET DIRECTION CLE,ERA SET DIRECTION INTO E REG DLD ABREG GET STATUS AGAIN SEZ IS IT A READ? JSB RWEX NO...WRITE...WRITE TO DEVICE JMP REDN ALL DONE SPC 2 * * HERE ON CONTROL REQUEST * REQ3 JSB EXEC ISSUE LOCAL CONTROL REQUEST DEF *+4 DEF RCOD DEF PRM1 DEF PRM2 NOP ALLOW FOR ERROR CONDITION JMP REDN AND TERMINATE SPC 2 * * HERE ON A TRAP CALL * REQ10 LDA PRM3 GET TRAP # ALF,ALF GET TENS DIGIT AND B17 MPY D10 GET TO TENS POSITION STA TEMP LDA PRM3 GET ONES DIGIT AND B17 IOR TEMP MERGE TENS AND ONES ALF,ALF GET IN CORRECT ORDER FOR CHECK JSB FINDT SEE IF TRAP AVAILABLE JMP TRPER NO...ERROR..NO TRAP...OR NOT IN RUN STATS LDA B,I B REG POINTS TO TRAP ACTIVE FLAG IOR BIT15 SET TRAP ACTIVE STA B,I SAVE TRAP ACTIVE STA TRFLG SET FOR TRAP PENDING CLA SET FOR ALL OK CLB JMP REDN DONE SPC 1 * * HERE IF TRAP ERROR OCCURED * TRPER DLD SC05 SEND ERROR BACK...SCHEDULE ERROR JMP REDN DONE SPC 2 * * HERE ON STATUS REQUEST * REQ13 JSB EXEC ISSUE LOCAL STATUS CALL DEF *+5 DEF RCOD DEF PRM1 DEF PRM1 RETURN STATUS GOES HERE DEF PRM2 OPTION RETURN GOES HERE NOP ALLOW FOR ERROR RETURN JMP REDN AND TERMINATE CALL SPC 3 * * SUBROUTINE TO READ OR WRITE DATA TO I-O DEVICE * CALLING SEQUENCE * JSB RWEX * RWEX NOP JSB EXEC DO THE EXEC CALL DEF *+7 DEF RCOD DEF PRM1 DEF %DBUF DEF PRM2 DEF PRM3 DEF PRM4 NOP INCASE OF ERROR JMP RWEX,I AND RETURN SPC 3 * * SUBROUTINE TO SEND STOP IF NEEDED AND REENABLE LISTEN * MODE * ENLIN NOP LDA LU GET LU OF SDI CARD AND B77 IOR B100 SET IN ENABLE LISTEN MODE BIT STA CNWD SAVE FOR CALL JSB EXEC MAKE THE CALL DEF *+3 DEF D3 CONTROL DEF CNWD LSTEN JMP ENLIN,I AND RETURN SPC 1 ENLN1 NOP SPC 3 * * SUBROUTINE TO SEND REPLY * SRPLY NOP LDA M10 GET ERROR COUNTER STA ERCNT LDA %BUF GET STREAM TYPE IOR B1411 SET IN REPLY FLAG & FRIENDLY BIT STA %BUF AND REPLACE IT * LDA LU AND B77 STA CNWD RETRY JSB EXEC DEF *+5 DEF D2I WRITE DEF CNWD REQUEST ONLY DEF %BUF DEF D35 JMP RTR1 ALLOW FOR ERROR RETURN JSB STAT CHECK STATUS RSS ERROR...TRY AGAIN JMP SRPLY,I AND RETURN RTR1 ISZ ERCNT MAX# OF TIMES? JMP RETRY NO JMP SRPLY,I YES SPC 1 ERCNT NOP * * HERE ON UNKNOWN STREAM ERROR * FOR REQUEST * RERR JSB ENLIN CLEAR LINE IF DATA DLD ILERR "ILRQ"...ERROR MESSAGE RETURNED DST %BUF+2 JSB SRPLY SEND ERROR REPLY JMP TERM AND TERMINATE SPC 2 * * HERE FOR UNKNOW STREAM ERROR * FOR REPLY * RPERR JSB ENLIN CLEAR LINE IF DATA JMP TERM IGNORE INTERUPT SPC 3 * * ROUTINE TO READ A REQUEST * RREQ NOP LDA LU AND B77 STA CNWD JSB EXEC DEF *+5 DEF D1I READ DEF CNWD REQ. ONLY RREQ1 DEF %BUF READ INTO REQUEST BUFFER DEF D35 35 WORDS JMP RPERR ERROR RETURN AND B377 STA LINST SAVE STATUS JSB STAT GO CHECK STATUS JMP RPERR READ ERROR...IGNORmE INTERUPT JMP RREQ,I A REG= BUF ADD B= BUF LEN * * DO A STATUS CHECK * STAT NOP SLA ALL OK? ISZ STAT YES JMP STAT,I YES SPC 3 * * INDIRECT CHASE DOWN * INDCK NOP RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I SPC 3 * * HERE TO TERMINATE PROGRAM * TERM CLA TELL BASIC NOT BUSY STA DBSY JSB EXEC TERMINATE PROGRAM DEF *+2 DEF C6 SKP * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER OF A DEVICE * GIVEN THE ADDRESS OF WORD 4 OF ITS EQUIPMENT TABLE * CALLED AS FOLLOWS: * * LDB EQT4 (PASSED FROM DVR00) * JSB EQLU * A = 0 IF NOT FOUND -OR- * A = THE LOGICAL UNIT NUMBER IF FOUND SUP EQLU NOP ENTRY STB EQT4 SAVE B-REG FOR LATER TEST CLA STA LUNUM SET LU POINTER NEXT LDA LUNUM GET CURRENT LU NUM-1 CPA LUMAX DONE THRU ALL LU'S JMP NTFND YES, NOT FOUND!! ISZ LUNUM BUMP TO CURRENT LU ADA DRT POINT TO TABLE ADDRESS LDA 0,I GET CONTENTS AND O77 MASK OF SUBCHANNEL BITS MPY D15 CALCULATE ADDRESS OF WORD 4 ADA EQTA BASE ADDRESS ADA DM12 SUBTRACK ONE EQT & ADD DEC 3 CPA EQT4 COMPARE?? JMP FOUND YES !! JMP NEXT NO, TRY NEXT ONE SPC 1 NTFND STB LUNUM NOT FOUND RETURN A=0 FOUND LDA LUNUM FOUND RETURN A= LU NUMBER DIV D10 CONVERT TO ASCII ALF,ALF POSITION MOST SIG. DIGIT ADB 0 MIRGE IN LEAST ADB ASC00 CONVERT TO ASCII LDA LUNUM RESTORE BINARY VALUE JMP EQLU,I RETURN SPC 1 EQT4 NOP LUNUM NOP O77 OCT 77 ASC00 ASC 1,00 D15 DEC 15 DM12 DEC -12 EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B SKP * * DEFINE CONSTANTS * LINST NOP LU NOP B10.*00 OCT 100 C6 OCT 6 C2 OCT 2 C1 OCT 1 C3 OCT 3 C7 OCT 7 D10 DEC 10 D35 DEC 35 D13 DEC 13 B17 OCT 17 B77 OCT 77 B300 OCT 300 D3 DEC 3 D1I OCT 100001 D2I OCT 100002 M10 DEC -10 BIT14 OCT 40000 B1411 OCT 44000 NBT14 OCT 137777 BIT15 OCT 100000 NTERR OCT 100204 B377 OCT 377 CNWD NOP IRW NOP DUMMY NOP ABREG BSS 2 TEMP NOP TEMP1 NOP ILERR ASC 1,ILRQ RQER ASC 2,RQ BFER ASC 2,BF SC05 ASC 2,SC05 MDBS EQU 512 MAX DATA BUFFER SIZE MMDBS ABS -MDBS-1 SPC 1 . EQU * SID NOP BSS 1 REFCD NOP BSS 2 SABRG NOP RCOD NOP PRM1 NOP PRM2 NOP PRM3 NOP PRM4 NOP DLEN NOP DDIR NOP SPC 1 ORG . RESET TO MAKE SURE 35 WORD PRAMB %BUF BSS 35 SPC 1 %DBUF BSS MDBS LENGTH OF DATA BUFFER * END EQU * END START 0 n { 91704-18104 1546 S 0222 DS1/B SCE/4 MODULE: %BSPV              H0102 SASMB,R,L,C,F HED %BSPV 91704-16104 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM %BSPV,7 91704-16104 REV A 751114 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ****************************************************** * *%BSPV BASIC SUPERVISOR...MODIFIED FOR DS1-B * *SOURCE PART # 91704-18104 REV A * *REL PART # 91704-16104 REV A * *WRITTEN BY: UNKOWN * *DATE WRITTEN: SAME AS ABOVE * *MODIFIED BY: LARRY POMATTO * *DATE MODIFIED: 8-29-74 * ******************************************************* * * ENT INIT,GTLYN ENT SWLST,LYNCK,LYNC1,LSTIT ENT CHAR,CHARN,DELM,CRLF,ATEMP ENT PGOLM,LIMCK,LOLIM,HILIM,CKLLN,INTIN ENT SWDEV,XQCMD ENT ONS,FROMS,ABREV,XSYNF ENT SCR,FRMTO ENT LSTR,PLSTA,LOKCK,CRLF1 * EXT PROGF,PROGL EXT INBAD,INCNT,BLANK,TYPE,GTCHR EXT LISTA,LISTR,LINE,MFASE,SBUFA EXT .BUFA EXT TFLAG,LIST EXT INDCK EXT PRNIN,TSTIT EXT TBSRH,TBLPT,LNGTH EXT DIGCK,INTCK EXT FNDPS EXT DRQST EXT SYE25,CALER,INVSC EXT MAXSN EXT .1,.2,.3,.7,.10,.32,.48 EXT M1,M2,M3,M8 EXT DEVCT,SETLP EXT FLRCK CHECK FOR "ASSIGNED" READ FILE...DS 1B EXT FLPCK CHECK FOR "ASSIGNED" PRINT FILE DS-1B EXT CONFG GO SET UP DVR65 IN LISTEN MODE EXT CLASN ROUTINE TO "UNASIGN" ALL ASIGNED FILES * ******************************************************* * ** LOKCK ** DUMMY VERSION, TYPE M, ONE EACH * LOKCK NOP JMP LOKCK,I * **h***************************************************** SKP * ************************************************** * * START APPROPRIATE PHASE OF BASIC * ************************************************** * ** INIT JSB CONFG CONFIGURE DVR65...ONE TIME ROUTINE JSB CLASN CLEAN UP ASSIGNED FILES CLA,INA SET A NON ZERO FOR JSB TRAP CALL TO CLEAR OUT TRAP JSB RTINT SET UP FWAM,LWAM FOR RTE TYPE SYSTEMS LDA KEYIA INITIALIZE INPUT DEVICE STA READR TO KEYIN DEVICE LDA BUFA STA .BUFA INIT TTY BUFFER POINTER LDA LWAM JSB INDCK STA LWAM ADA M110 STA SBUFA INIT SYNTAX BUFFER POINTER JSB PRNIN INITIALIZE OUTPUT BUFFER POINTER PATCH JMP SETUP BECOMES "STF 0" JSB EFASE EXECUTION PHASE? RSS NO JMP MFASE YES LDA M8 STA TFLAG LOKCK THROW OUT OPERATOR INPUT LDB RDYA JSB DSPLY DISPLAY "READY" JSB CRLF GTLYN LDA .32 INITIALIZE STA BLANK DELETE CHARACTER FOR GETCR JSB LINE ACCEPT A BASIC LINE JMP GTLYN * SKP * * ONCE ONLY CODE FOLLOWS - AREA THEN USED FOR I/O BUFFER * SETUP LDA FWAM JSB INDCK STA FWAM LDB PROGF CPB PROGL START ADDR=END ADDR? JMP SCRCH YES, SET BOTH TO FWAM, INFORM USER CMA,INA ADA PROGF SSA PROGF < FWAM? JMP SCRCH YES LDA PROGL CMA,INA ADA LWAM SSA PROGL >= LWAM? JMP SCRCH YES ITSOK SSB ADDRESS NEGATIVE? JMP SCRCH YES, GO TXPE "SCR" CPB PROGL HAS LAST LINE BEEN DONE? JMP GOMAN YES, GO TYPE "READY" LDA 1 INCREMENT LINE'S ADDRESS INA BY LENGTH OF LINE ADB 0,I TO GET NEXT LINE ADDRESS LDA 0,I CHECK LINE LENGTH ADA M3 SSA WAS INCREMENT POSITIVE? JMP SCRCH NO ADA M110 SSA WAS INCREMENT REASONABLE? JMP ITSOK YES SCRCH JSB SCR GOMAN LDA PAT STA PATCH FROM SETUP ON IS ONCE-ONLY CODE LDA SETLP STA LPCNT SET UP NBR OF LINE PRTR COLUMNS JMP PATCH * PAT NOP BSS SETUP+37-* 37TH WD OF I/O BUFFER HERE * * END OF ONCE ONLY CODE * SKP * *************************************************** * * SETUP FOR I/O, SWITCH TO REQUESTED ROUTINE * * CALL SEQ: JSB SWLST * DEF (ROUTINE ADDR) * RETURN: P+2: NORMAL EXIT * **************************************************** * SWLST NOP LDA LISTA SOURCE POINTER LDB LISTR DEST POINTER JSB MOVE SAVE PREVIOUS LIST DEVICE STATUS LDA SWLST,I SOURCE POINTER JSB INDCK LDB LISTA DEST POINTER JSB MOVE POST NEW LIST DEVICE STATUS LDA SPTR,I GET OUTPUT FUNCTION CODE STA CRLF1 INITIALIZE FUNCTION WORD PARAMS STA LYNC1 CPA M2 IF CONTROL WORD =-2 JSB CRLFF ROUTINE HANDLE OWN CRLF ISZ SPTR POINT AT SUBROUTINE ENTRY LDA SPTR STA LISTR PUT LIST SUBRTN PTR IN LISTR ISZ SWLST SKIP OVER PARAM JMP SWLST,I * MOVE NOP ADA M3 ADB M3 STA SPTR STB DPTR LDB M2 LDA SPTR,I STA DPTR,I ISZ SPTR ISZ DPTR INB,SZB JMP *-5 JMP MOVE,I * CRLFF NOP LDA SPTR GET ADDRESS OF ADA .4 OF CRLF ROUTINE STA LYNC1 SAVE IN LYNC1 SAVE FOR BRANCH IN CRLF JMP CRLFF,I RETURN * SKP * **************************************************** * * CHECK LINE POSITION & DO ASCII OUTPUT * * CALL SEQ: JSB LYNCK * RETURN: P+1: COMPLETION * *************************************************** * LYNCK NOP STA TEMPA STB TEMPB i  LDA LYNCK ASSUMES JSB LYNCK FOLLOWS ENTRY ADA M2 TO OUTPUT ROUTINE STA *+2 PASS DEVICE STATUS TO SWLST JSB SWLST BSS 1 UPDAT LDA TEMPA CMA,INA ADA TYPE STA TYPE UPDATE CARRIAGE POSITION CLA JSB TSTIT SZA,RSS DID TSTIT DO CR-LF? JMP UPDAT YES LDA TEMPA LDB TEMPB JSB DOIO LYNC1 BSS 1 SET UP BY SWLST JMP LYNCK,I * *************************************************** * * LSTIT IS AN ASC OUTPUT ROUTINE SWITCH * PLIST WILL START IC TO ASC CONV IN BASIC * ************************************************** * LSTIT NOP JSB LSTR,I DO LISTING TASK JMP LSTIT,I & RETURN * PLIST NOP LDA PLIST SET UP RETURN STA LIST LDA LSTAD JSB INDCK ADA .2 STA PLIST LDA HILIM PASS LIMITS LDB LOLIM JMP PLIST,I GOTO LIST+2 * * SKP ***************************************************** * * CHAR WILL FETCH THE NEXT INPUT CHAR * CHARN WILL FETCH THE NEXT NON-BLANK CHAR * ***************************************************** * CHAR NOP LDA .10 SET UP FOR STA BLANK FIXED FORMAT SCAN JSB CHRIN GET INPUT JMP CHAR,I * CHARN NOP LDA .32 SET UP FOR STA BLANK FREE FORMAT SCAN JSB CHRIN GET INPUT JMP CHARN,I * CHRIN NOP CHRN1 JSB GTCHR FETCH NEXT CHAR STA ATEMP CPA .10 EOF? JMP CHRN2 JSB DELM NO, DELIMITER? JMP CHRIN,I YES, IGNORE CLB NO, CLEAR STB CONT. CONT. FLAG JMP CHRIN,I & RETURN CHRN2 LDB CONT. YES, IS CONT. SZB,RSS ENABLED ?? JMP CHRIN,I NO, RETURN LDA M2 YES, GIVE 2 LDB BLNKA BLANKS JSB DSPLY & #: JSB DRQST GET MORE INPUT JMP CHRN1 * SKP * **************************************************** * * DELM WILL TEST FOR A DELIMITER * **************************************************** * DELM NOP CPA .32 BLANK ? JMP DELM,I YES, P+1 RETURN CPA O54 COMMA ? JMP DELM1 YES ISZ DELM NEITHER, TAKE JMP DELM,I P+2 RETURN DELM1 ISZ CONT. INSURE CONT. FLAG IS ON JMP DELM,I (FOR INPUT OUTSIDE OF CHRIN) * ************************************************ * * DO CARRIAGE RETURN, LINE FEED OUTPUT * ************************************************ * CRLF NOP USED AS FLAG BY "LIST" IN BASIC LDA M2 LDB RDYA CPA CRLF1 KLUDGE TO ALLOW BLOCKING UP JMP LYNC1,I OUTPUT, THIS DOES FLUSH JSB DOIO DO CARRIAGE RETURN, LINE FEED CRLF1 BSS 1 SET UP BY SWLST CLA STA TYPE DENOTE NEW LINE JMP CRLF,I * SKP * ****************************************************** * * FIND REQUESTED PROGRAM CORE LIMITS * * CALL SEQ: (A)=NEXT CHAR * JSB PGOLM * RETURN: P+1: EOF DETECTED * P+2: MORE INPUT TO COME * (A)=NEXT CHAR * LOLIM=LOW CORE LIMIT * HILIM=HI CORE LIMIT * ***************************************************** * PGOLM NOP JSB LIMCK FETCH PROGRAM LIMITS STA ATEMP SAVE NEXT CHAR LDA LOLIM JSB FNDPS FIND POSITION NOP OF 1ST STATEMENT NOP STB LOLIM SAVE IT LDA HILIM INA JSB FNDPS FIND POSITION NOP OF LAST STATEMENT NOP STB HILIM SAVE IT LDA ATEMP RETRIEVE NEXT CHAR CPA .10 EOF ?? JMP PGOLM,I YES, TAKE P+1 RETURN ISZ PGOLM JMP PGOLM,I NO, TAK<E P+2 EXIT * * SKP * ******************************************************** * * FETCH PROGRAM LIMITS FROM INPUT BUFFER * ACCORDING TO THE FOLLOWING SYNTAX: * ...... * ...... * ...... * * CALL SEQ: (A)=NEXT CHAR * JSB LIMCK * RETURN: (A)=NEXT CHAR * LOLIM=LO LIMIT * HILIM=HI LIMIT * ******************************************************** * LIMCK NOP CLB,INB SET UP STB LOLIM DEFAULT LIMITS LDB .9999 1-9999 STB HILIM LDB M2 STB CNT1 LDB .10 SET UP FOR STB BLANK FIXED FORMAT SCAN RSS JSB CHAR FETCH NEXT CHAR LIM1 JSB DELM DELIMITER ? JMP *-2 YES, IGNORE JSB DIGCK DIGIT ? JMP LIMCK,I NO,EXIT ADA .48 YES, JSB INTIN FETCH # DEF MAXSN & STB HILIM SAVE IT ISZ CNT1 DONE ? RSS JMP LIM2 STB LOLIM NO, CONTINUE JMP LIM1 LIM2 INB INSURE CMB,INB LOLIM<=HILIM ADB LOLIM SSB,RSS JMP SYE25 IT'S NOT, ERROR LDB .32 OK, SET UP FOR STB BLANK FREE FORMAT INPUT RSS FETCH NEXT JSB CHARN NON-DELIMITER JSB DELM CHARACTER JMP *-2 (A)=NEXT CHAR JMP LIMCK,I & RETURN * SKP * **************************************************** * * CHECK LEGAL LINE # LIMITS OF INPUT * * CALL SEQ: (A)=CHAR COUNT * (B)=BUFFER ADDRESS * JSB CKLLN * RETURN: P+1: OUTSIDE OF LIMITS * P+2: WITHIN LIMITS * *************************************************** * CKLLN NOP CMA SET UP FOR STA INCNT GETCR RBL ROUTINE STB INBA+D LDB LOLIM INPUT LIMITS CPB .1 OTHER THAN RSS 1-9999 ??? JMP CKLL1 LDB HILIM CPB .9999 JMP CKLL2 NO, TAKE P+2 EXIT CKLL1 JSB GETCR YES, FETCH NEXT CHAR JMP CKLLN,I NULL RECORD, TAKE FAIL EXIT CPA .32 IGNORE PRECEEDING JMP CKLL1 BLANKS JSB INTIN GET CURRENT LINE # DEF MAXSN LDA LOLIM CMA,INA ADA 1 SSA #>=LOLIM ? JMP CKLLN,I NO, P+1 CMB,INB ADB HILIM SSB #<=HILIM ? JMP CKLLN,I NO, P+1 CKLL2 ISZ CKLLN JMP CKLLN,I YES, P+2 * * SKP * ***************************************************** * * INTIN WILL BUILD AN INTEGER FROM INPUT * * CALL SEQ: (A)=CURRENT CHAR * JSB INTIN * DEF (MAX #) * RETURN: (B)=INTEGER * ***************************************************** * INTIN NOP STA ATEMP SAVE CUR. CHAR. LDA INTIN,I FETCH JSB INDCK MAXIMUM STA INTI1 ALLOWABLE ISZ INTIN LIMIT LDA SBPTR SAVE STA TEMP1 SBPTR LDA TEMAD STATUS STA SBPTR LDA ATEMP RECOVER CUR.CHAR. JSB INTCK FETCH INTEGER INTI1 BSS 1 STA ATEMP LDA TEMP1 RESTORE STA SBPTR SBPTR STATUS LDA ATEMP JMP INTIN,I * SKP *************************************************** * * SEARCH COMMAND DEVICE TABLE FOR VALID SYNTAX * * CALL SEQ: (A)=CURRENT CHAR * (B)=-TAB LENGTH * JSB SWDEV * DEF (TABLE START ADDRESS) * RETURN: P+2: FAIL RETURN * (A)=CURRENT CHAR * P+3: SUCCES RETURN * (A)=CURRENT CHAR * (B)=TABLE POSITION * TBLPT=ENTRY ADDRESS * ****M********************************************** * SWDEV NOP STA ATEMP SAVE CURRENT CHAR LDA SWDEV,I FIND TABLE START JSB INDCK STA SWDV1 ISZ SWDEV SWDV0 LDA ATEMP RETRIEVE CURRENT CHAR SZB,RSS ANY ENTRIES ? JMP SWDEV,I NO, TAKE FAIL EXIT JSB TBSRH YES, SEARCH DEVICE SWDV1 NOP TABLE JMP SWDV3 NOT FOUND * JSB CHARN FOUND,FETCH NEXT CAHR JSB DELM IGNORE DELIMITERS JMP *-2 STA ATEMP SAVE A LDA COUNT FIND JSB INDCK CURRENT ADA M2 COUNT LDB 0,I SWDV2 CMB & ADB LNGTH COMPUTE CMB,INB TABLE POSITION LDA ATEMP ISZ SWDEV MOVE TO SUCCES RETURN JMP SWDEV,I & EXIT * SWDV3 LDB LNGTH SWDV4 LDA SWDV1,I ALLOW 0 LENGTH SYMBOL AND .7 AS VALID TABLE ENTRY SZA,RSS 0 LENGTH ? JMP SWDV5 ADA .3 NO, MOVE TO NEXT ENTRY ARS ADA SWDV1 STA SWDV1 INB,SZB END OF TABLE ? JMP SWDV4 NO, CONTINUE JMP SWDV0 YES, NO MATCH * SWDV5 LDA SWDV1 0 LNGTH SYMBOL FOUND STA TBLPT SAVE ENTRY ADDRESS JMP SWDV2 * SKP ******************************************************* * * EXECUTE SPECIFIED COMMAND * * CALL SEQ: (A)=NEXT CHARACTER * (B)=EXECUTION TABLE POSITION * JSB XQCMD * DEF (EXECUTION TABLE START) * NOP (USED FOR STORAGE BY XQCMD) * RETURN: P+3: COMPLETION RETURN * P+4: CONTINUATION RETURN (WHEN REQUIRED) * ********************************************************* * XQCMD NOP STA ATEMP SAVE CURRENT CHAR ADB M1 FIND EXECUTION RBL,SLB TABLE ADDRESS JSB CALER LDA XQCMD,I JSB INDCK ADB 0 (B)=EXECUTION TABLE ENTRY ISZ XQCMD STB XQCMD,I SAVE IT IN USER SUPPLIED STORAGE INB LDA 1,I GET ADDRESS OF I/O ROUTINE JSB INDCK FROM BRTBL ISZ XQCMD LDB XQCMD SAVE IT IN CALLER STB 0,I SUPPLIED STORAGE INA STA TEMPX LDB TBLPT GET ADDRESS OF MNEM ENTRY AND LDB 1,I EXTRACT THE LOGICAL UNIT NO. LSR 9 AND RIGHT JUSTIFY LDA ATEMP RECOVER CURRENT CHAR JMP TEMPX,I TRANSFER TO REQUESTED ROUTINE * SKP **************************************************** * * CHECK OCCURANCE OF "ON" OR "FROM" SYNTAX * IF XSYNF=1 ON/FROM/TO MUST OCCUR IN COMMAND SYNTAX * IF XSYNF=1 ON/FROM MUST OCCUR IN COMMAND SYNTAX * IF XSYNF=0 ON/FROM MAY BE OMITTED FROM COMMAND * * CALL SEQ: JSB ONS * RETURN: P+1: FOUND, (A)=NEXT CHAR * * CALL SEQ: JSB FROMS * RETURN: P+1: FOUND, (A)=NEXT CHAR * * ***************************************************** * ONS NOP CHECK "ON" SYNTAX LDB ONA JSB SYNCH CLB SET ON/FROM FLAG TO ZERO STB FRMTO FRMTO FLAG=0 FOR "ON" LDB DEVCT GET -# OF DEVICE MNEM. JMP ONS,I OK, RETURN * FROMS NOP CHECK "FROM" SYNTAX LDB FROMA JSB SYNCH CLB,INB FRMTO FLAG=1 FOR "FROM" STB FRMTO LDB DEVCT GET -# OF DEVICE MNEM. JMP FROMS,I OK, RETURN * SYNCH NOP STB SYNC1 CCB JSB TBSRH SEARCH INPUT BUFFER SYNC1 NOP JMP SYNC2 NOT FOUND JSB CHARN FETCH NEXT NON-BLANK CHAR JSB DELM DELIMITER ? JMP *-2 YES, IGNORE CPA .10 EOF ?? JMP INVSC YES, INPUT ERROR JMP SYNCH,I NO, OK EXIT SYNC2 LDB XSYNF IS SYNTAX REQUIRED SZB ??? JMP INVSC YES, ERROR JMP SYNCH,I g NO, OK EXIT SKP * *************************************************** * * ALLOW SYNTAX ABREVIATION * * CALL SEQ: JSB ABREV * DEF (ABREVIATED SYNTAX) * RETURN: P+1: FOUND * P+2: NOT FOUND, (A)= NEXT CHAR * ************************************************** * ABREV NOP LDA ABREV,I STA ABRE1 ISZ ABREV JSB CHARN CCB JSB TBSRH ABRE1 BSS 1 ISZ ABREV JMP ABREV,I * SKP **************************************************** * * SCRATCH SUBROUTINE * * CALL SEQ: JSB SCR * RETURN: P+1: NORMAL * *************************************************** * SCR NOP LDA FWAM STA PROGF STA PROGL JMP SCR,I * SKP * * STORAGE & CONSTANTS & OTHER THINGS OF INTEREST * SUP BUFA DEF SETUP I/O BUFFER ADDRESS LSTAD DEF LIST INDEX TO LIST ROUTINE IN BASIC COUNT DEF LNGTH INDEX TO TABLE POSITION IN TBSRH LSTR DEF PLIST INIT TO PLIST PLSTA DEF PLIST ADDRESS OF PLIST ROUTINE * CONT. NOP KBD INPUT CONTINUATION FLAG ATEMP NOP CURRENT CHARACTER XSYNF OCT 1 ON.FROM SYNTAX SWITCH, INIT. TO YES LOLIM NOP LOW LIMIT HILIM NOP HIGH LIMIT * O54 OCT 54 .9999 DEC 9999 M110 DEC -110 * RDYA DEF *+1 BASIC'S "READY" MESSAGE OCT 6412 ASC 3,READY * BLNKA DEF *+1 INPUT CONTINUATION PROMPT ASC 1, * ONA DEF *+1 "ON" SYNTAX OCT 2 ASC 1,ON * FROMA DEF *+1 "FROM" SYNTAX OCT 4 ASC 2,FROM * * TEMAD DEF TMP TMP BSS 1 TEMP1 BSS 1 TEMPA BSS 1 TEMPB BSS 1 TEMPX BSS 1 CNT1 BSS 1 SPTR BSS 1 DPTR BSS 1 FRMTO BSS 1 HED ****** DOIO ****** (C) HEWLETT-PACKARD CO. 1976 * ********************************************* * DOIO * * ******************************************** * * T ENT DOIO * EXT EXEC EXT B2000,B777,.63,M1,.1,.2 * DOIO NOP STA LENTH STB BUFAD STORE ADDRESS OF BUFFER LDB DOIO,I GET CONTROL WORD ISZ DOIO LDA 1 AND FMASK EXTRACT FUNCTION CODE ALF STA ICODE AND STORE IT AWAY LDA 1 AND CMASK EXTRACT CONTROL INFO STA ICNWD AND STORE IT AWAY AND DMASK EXTRACT LOGICAL UNIT NBR CPA .2 RSS JMP SETX LDA M1 ADA ICNWD STA ICNWD LU 2 CHANGE TO LU 1 SETX LDA ICODE SET X BIT FOR HONESTY MODE ON CPA .1 INPUT JMP DOIT LDA ICNWD IOR BIT10 STA ICNWD DOIT JSB EXEC MAKE EXEC CALL DEF *+5 DEF ICODE DEF ICNWD BUFAD DEF BUFAD DEF LENTH AND .32 BIT 5 SET MEANS EOF SZA MAKE SURE EOF SHOWS CLB ZERO LENGTH RECORD STB 0 SET CHAR COUNT IN AREG JMP DOIO,I LENTH NOP ICODE NOP ICNWD NOP BIT10 EQU B2000 FMASK OCT 170000 CMASK EQU B777 DMASK EQU .63 HED * BASIC I-O ROUTINES FOR RTE-B * (C) HEWLETT-PACKARD CO. 1976 * ************************************************ * * READR * * ************************************************ * * FCINP EQU 10400B FUNCTION CODE FOR INPUT FCOUT EQU 24000B FUNCTION CODE FOR OUTPUT * **************************************************** * * ENTRY POINTS: * * ENT LOAD,LOADA,L.RDR ENT EREED,RDNBR,REDNO ENT L.PUN,LEADR,ERCRD,RCRD ENT LIST.,L.LST,ELIST ENT DSPLY,DSPLA,EDSPL ENT KEYIA,KEYIN,EINP,ETTYS ENT LPPOS * * * EXTERNAL REFERENCES: * EXT .10,INVSC,MO100,READR EXT EINPT EXT TFLAG,ZERO,EFASE,EFIO,READS EXT EREAD EXT GETCR,BCKSP,SBPTR,M1 EXT FSC,M2,SYMCK,COMM1,ERROR,.STOP EXT TEMPS EXT MO133 J EXT PRINS,EPRIN EXT .1 EXT SEQNO EXT M6,.7,.23 * * ******************************************************* * SKP SKP ***** * GET INPUT PROGRAM (FROM COMMAND) ***** L.RDR NOP CPA .10 EOF ? RSS JMP INVSC NO, ERROR LDA FRMTO SZA,RSS L.RDR AND "ON" INCOMPATIBLE JMP INVSC LDA STFCI SET UP I/O IOR 1 CODE STA FNCTW LDA PLODA SWITCH BASIC TO GET STA READR NEXT RECORD FROM PLOAD ROUTINE LDA L.RDR INA SET RETURN FOR CONTINUATION JMP 0,I LET BASIC PROCESS INPUT * PLOAD NOP JSB LOAD GET A RECORD LDB TMPB2 FETCH BUF ADDR JSB CKLLN LINE LIMITS SATISFIED ? JMP LOAD1 NO, IGNORE IT LDA TFLAG YES,GIVE IT TO BASIC JMP PLOAD,I FOR PROCESSING * * OTHER NAMES FOR L.RDR * PHOT1 EQU L.RDR PHOT2 EQU L.RDR * CARD1 EQU L.RDR CARD2 EQU L.RDR * ** MAKE THEM ENTRY POINTS ALSO * ENT PHOT1,PHOT2,CARD1,CARD2 * SKP ***** * PROVIDE PUNCHED PROGRAM OUTPUT ***** L.PUN NOP JSB SETOT SET UP FOR OUTPUT DEVICE LDA MO133 GIVE LEADER JSB LEADR JSB LSTIT GIVE PROGRAM LDA MO133 JSB LEADR GIVE TRAILER JMP L.PUN,I RETURN ***** * PROVIDE PROGRAM LISTING ***** L.LST NOP JSB SETOT SET UP FOR OUTPUT DEVICE JSB LSTIT LIST PROGRAM JSB LSKIP GIVE FORM FEED JMP L.LST,I & RETURN ***** * SET UP FOR OUTPUT DEVICE ***** * SETOT NOP CPA .10 EOF? RSS JMP INVSC NO,ERROR LDA FRMTO SZA OUTPUT AND "FROM" ARE INCOMPATIBLE JMP INVSC LDA STFCO IOR 1 STA WORD JSB SWLST DEF CTTYS JMP SETOT,I * ** OTHER NAMES FOR OUTPUT * PNCH1 EQU L.PUN PNCH2 EQU L.,bNLHPUN * LP1 EQU L.LST LP2 EQU L.LST * CRT1 EQU L.LST CRT2 EQU L.LST CRT3 EQU L.LST CRT4 EQU L.LST * TTY1 EQU L.LST TTY2 EQU L.LST TTY3 EQU L.LST TTY4 EQU L.LST * ** MAKE THEM ENTRIES TOO * ENT PNCH1,PNCH2,LP1,LP2 ENT CRT1,CRT2,CRT3,CRT4 ENT TTY1,TTY2,TTY3,TTY4 N SKP ***** * ** COME HERE UPON RECOGNIZING THE STRING "READ" AT * SYNTAX TIME, OR WHEN EXECUTING A READ STATEMENT * ***** EREED NOP JSB EFIO EXECUTION PHASE? JMP CKRED NO, GO CHECK SYNTAX JMP EREAD YES, CODE IS IN BASIC INTERPRETER ***** ** HERE AT SYNTAX TIME ***** CKRED JSB GETCR GET NEXT CHAR JMP CKTT1 (END OF INPUT LINE) CPA NUMSN IS THAT CHAR A "#"? JMP CKTT2 YES, SET UP FOR READ# CKTT1 JSB BCKSP NO, BACKUP OVER THAT CHAR JMP READS AND PROCESS NORMAL READ STATEMENT CKTT2 LDB SBPTR GET ADDRESS OF CALL ADB M1 IN SYNTAX BUFFER LDA 1,I AND INCREMENT BRANCH TABLE INA OFFSET BY ONE STA 1,I THEN PUT IT BACK JSB FSC GET FORMULA FOR LU# CPA .10 END OF STATEMENT? JMP READS YES, PROCESS NORMALLY FROM HERE LDB M2 NO, IS THE DELIMITER JSB SYMCK A COMMA DEF COMM1 OR SEMICOLON? RSS JMP READS YES, PROCESS NORMALLY FROM HERE JSB ERROR NO, ERROR 21 DEF *+3 DEF .21 DEF ZERO JSB .STOP ***** * ** HERE TO EXECUTE READ# STATEMENT * ***** RDNBR NOP JSB SEQNO GET NEW LU NUMBER STA TMPA2 SAVE LU NUMBER ISZ TEMPS MOVE INTERP CODE PTR BY END FORMULA JSB FLRCK CHECK IF LU IS "ASSIGNED" ADA STFCI MAKE NEW FUNCT CONTROL WORD STA FNCTW AND PUT IT IN THE CALL TO DOIO LDA TMPA2 RECALL LU NUMBER JSB GETOF GET TABLE OFFSET FOR DEVICE ADA INTBL ADD TABLE ADDRESS LDA 0,I THEN GET ADDRESS OF ROUTINE STA READR AND SET UP FOR INPUT JMP EINPT FROM HERE TREAT AS INPUT STMT ***** * HERE FOR PRINT STATEMENT ***** ELIST NOP JSB EFIO EXECUTION PHASE ? JMP CKTTY SYNTX PHASE CK FOR PRINT# JSB SWLST YES, SWITCH TO LST DEVICE DSPLA DEF DSPLY JMP ~+EPRIN GO EXECUTE STATEMENT * CKTTY JSB GETCR GET NEXT CHAR JMP NOLUK (END OF INPUT LINE) CPA NUMSN IS THAT CHAR "#" JMP UBET YES, SETUP FOR PRINT# NOLUK JSB BCKSP NO,BACKUP OVER THAT CHAR JMP PRINS AND PROCESS NORMALLY UBET LDA SBPTR GET ADDRESS OF ADA M1 CALL IN SYNTX BUFFER LDB 0,I AND INCREMENT BRANCH TBL ADB .1 OFFSET BY ONE STB 0,I THEN PUT IT BACK JMP PRINS FROM THERE PROCESS NORMALLY ***** * HERE FOR INPUT STATEMENT ***** EINP NOP JSB EFIO EXECUTION PHASE ? JMP READS NO, GO CHECK SYNTAX LDA KEYIA YES, SET UP FOR STA READR KBD INPUT JMP EINPT GO EXECUTE INPUT STATEMENT ***** * HERE TO EXECUTE PRINT# ***** ETTYS NOP JSB SEQNO GET NEW LU # JSB FLPCK CHECK IF LU IS AN "ASSIGNED" FILE STA TMPA2 ADA STFCO MAKE NEW FUNCT CONTROL WORD STA WORD AND STORE IT AWAY LDA TMPA2 GET LU NUMBER JSB GETOF ADA OUTBL GET ADDRESS OF TABLE ENTRY LDA 0,I THEN GET ADDRESS OF OUTPUT RTN STA ETT1 AND SET UP OUTPUT JSB SWLST SET UP FOR APPROPIATE DEVICE ETT1 DEF CTTYS JMP EPRIN THEN PROCESS NORMALLY HED ****** INPUT ROUTINES ****** (C) HEWLETT-PACKARD CO. 1976 ***** * READ A RECORD FROM READR ***** LOAD NOP STA TMPA2 SAVE MAX COUNT (-CHARS, BCS CONV.) STB TMPB2 SAVE BUFFER ADDRESS LOAD1 LDA TMPA2 LDB TMPB2 JSB REDNO GET A RECORD CPA ZERO ANY DATA ? JMP EOT NO, JUST LEADER/TRAILER STA TFLAG YES, NEXT TIME WILL BE TRAILER JMP LOAD,I * EOT LDB TFLAG SSB JMP LOAD1 LEADER; GO READ MORE STA TFLAG ASSUME LEADER FOR NEW TAPE NEXT JMP L.RDR,I EXIT TO COMPLETION RETURN ***** ** HERE TO GET INPUTQ LINE ***** REDNO NOP CMA,INA MAKE CHAR COUNT NEGATIVE JSB DOIO DO THE INPUT FNCTW NOP THIS WORD SET UP BY RDNBR JMP REDNO,I ***** * HERE FOR INPUT FROM LU# 1 ***** KEYIN NOP CMA,INA SET CHAR COUNT NEG. STA TMPA2 SAVE A STB TMPB2 SAVE B JSB EFASE EXECUTION PHASE ?? JMP SKPIT NO CCA LDB QMRKA OUTPUT QUESTION MARK JSB DSPLY SKPIT LDA TMPA2 RECOVER CHAR COUNT LDB TMPB2 JSB DOIO GET INPUT ABS FCINP+1 INPUT WITH ECHO FROM LU# 1 JMP KEYIN,I * HED * SMALL ROUTINES FOR EACH OUTPUT * (C) HEWLETT-PACKARD CO. 1976 * ***** * FOR LU# 4 ***** NOP STORAGE FOR CARRIAGE POSITION DEC -73 72 CHARS/LINE ABS FCOUT+4 RCRD NOP JSB LYNCK DO ASCII OUTPUT JMP RCRD,I ***** * FOR LU# 6 ***** LPPOS NOP STORAGE FOR CARRIAGE POSITION LPCNT DEC -81 ABS FCOUT+6 LIST. NOP JSB LYNCK ASCII OUTPUT JMP LIST.,I ***** * FOR LU# 1 * NOP DEC -73 ABS FCOUT+1 DSPLY NOP JSB LYNCK JMP DSPLY,I ***** * FOR MULTI-DEVICE OUTPUT * ***** NOP DEC -73 THIS CODE WORD NOP SETS UP CTTYS NOP A NEW JSB LYNCK "DEVICE" JMP CTTYS,I FOR OUTPUT HED ****** UTILITY ROUTINES ****** (C) HEWLETT-PACKARD CO. 1976 * ***** * OUTPUT LEADER/TRAILER ***** LEADR NOP STA ERCRD SAVE COUNT LDA LYNC1 GET OUTPUT FUNCTION CODE STA LEAD1 LEAD CCA ONE FRAME LDB ZEROA JSB DOIO ASSUME DEVICE ALREADY SWITCHED LEAD1 BSS 1 ISZ ERCRD DONE?? JMP LEAD NO JMP LEADR,I ***** * DO A PAGE EJECT ***** LSKIP NOP CCA 1 CHAR LDB SKPCD JSB CTTYS OUTPUT SKIP CODE JSB CRLF KEEP IN SYNC WITH LP JMP LSKIP,I ***** * ** GETOF ** CONVERT LU # TO OFFSET IN TABLE * * LDA LOGICAL UNIT NUMBER * JSB GETOF * RETURN .A.=OFFSET * * NOTE: AN ERROR RESULTS IF LU IS 0 OR NEGATIVE * ANY LU > 6 RETURNS AN OFFSET OF 7 * ***** * GETOF NOP ADA M1 IF LU IS SSA 0 OR NEGATIVE, JMP LUERR ISSUE ERROR ADA M6 IF LU IS SSA,RSS 7 OF GREATER JMP USE7 THEN RETURN OFFSET OF 7 ADA .7 RSS USE7 LDA .7 JMP GETOF,I * LUERR JSB ERROR DEF *+3 DEF .23 DEF ZERO JSB .STOP HED **** CONSTANTS AND STORAGE **** (C) HEWLETT-PACKARD CO. 1976 ********************************************************* * ** CONSTANTS AND STORAGE * *************************************************** * .21 DEC 21 NUMSN OCT 43 ERCRD NOP ZEROA DEF ZERO EDSPL EQU ELIST SKPCD DEF *+1 OCT 6000 FORM FEED KEYIA DEF KEYIN QMRKA DEF *+1 ASC 1,? TMPA2 BSS 1 TMPB2 BSS 1 LOADA DEF LOAD PLODA DEF PLOAD STFCI ABS FCINP STFCO ABS FCOUT ************************************************* * * TABLES TO SET UP PRINT# AND READ# LU'S * ********************************************************** OUTBL DEF * DEF DSPLY DEF CTTYS DEF CTTYS DEF RCRD DEF CTTYS DEF LIST. DEF CTTYS * INTBL DEF * DEF KEYIN DEF REDNO DEF REDNO DEF REDNO DEF REDNO DEF REDNO DEF REDNO * *********************************************************** HED RTE-B BASIC CONTROL * (C) HEWLETT-PACKARD CO. 1976 **************************************** * RTE-B BASIC CONTROL **************************************** * SPC 5 ENT START * EXT .STOP * START JMP INIT JSB .STOP SPC 5 * ENT RUNIT,.RUN * EXT XH,XL,EENDA,PEXMA * RUNIT NOP RUN THE PROGRAM .RUN CLA STA XH INA STA XL LDA EENDA STA PEXMA JMP INIT SKP ENT ELINK * EXT PXMKA,PEXMA * ELINK LDB PXMKA STB PEXMA JMP INIT SPC 5 ENT EPAUS * EXT M10 * FCNRD EQU 10401B READ CONTROL WORD * EPAUS NOP EXECUTE "PAUSE" LDA M10 LOAD -# OF CHARACTERS LDB PAZA JSB DSPLY OUTPUT "PAUSE" EP1 CLA,INA READ ONE WORD LDB CTRLA JSB DOIO READ ABS FCNRD LDB CTRL GET OPERATOR MESSAGE CPB GO IS IT CONTINUE JMP EPAUS,I YES! CPB AB IS IT ABORT? JSB .STOP YES JMP EP1 * PAZA DEF PAZ PAZ OCT 6412 ASC 3,PAUSE OCT 6412 CRLF * CTRLA DEF *+1 CTRL BSS 1 GO ASC 1,GO AB ASC 1,AB * ENT TRACE * EXT TRAP * TRACE NOP JSB TRAP JMP TRACE,I SKP * * BRANCH AND MNEMONIC TABLE ADDRESS POINTERS * * ENT SRULA,ADRED,CMDAD,ASBTB,SBTBE,FCNTB,XNFOA,STDCA ENT FWAM,LWAM * EXT SRULE,MNEM,CMDS,SBTBL,LSBTB,FCNEX,XNFO,STDCL * SRULA DEF SRULE START OF SPECIAL CALL MNEMONICS ADRED DEF MNEM START OF CALL MNEMONICS CMDAD DEF CMDS START OF COMMAND MNEMONICS SBTBE DEF LSBTB END OF FUNCTION TABLE ASBTB DEF SBTBL START OF BRANCH TABLE FCNTB DEF FCNEX START OF FUNCTION TABLE XNFOA DEF XNFO START OF PARAMETER TYPE TABLE STDCA DEF STDCL END OF SUBROUTINE CALL FWAM NOP FIRST WORD AVAILABLE MEMORY LWAM NOP LAST WORD AVAILABLE MEMEORY HED RTE-B CATCH-ALL MODULE * (C) HEWLETT-PACKARD CO. 1976 SUP PRESS ASCII LISTING **************************************** * RTE-B CATCH-ALL MODULE **************************************** * * ENT RTINT,NORML,OVDVR,.IENT ENT EINT,.FLUN * EXT ERROR,.STOP EXT B377,M8,M1'6,.PACK EXT .15,.23,M1 EXT INDCK,.PEXP,MANT1,MANT2 EXT STRT5,PROGF,PROGL,FCORE,SYMTF,SYMTA EXT M4,ERROR,INDCK,ZERO EXT .1,.2,.4 ** AVMEM EQU 1751B FWA SYSTEM BUFFER BKGRG EQU 1752B FWA BACKGROUND BKLWA EQU 1777B LWA BACKGROUND XEQT EQU 1717B ADDRESS OF BASICS ID SEGMENT ** ** INITIALIZE FWAM,LWAM FOR RTE TYPE SYSTEMS ** * RTINT NOP CLA STA START SETUP SO RE-ENTRY POINT IS BSTOP LDA XEQT GET THE ADDRESS OF BASICS ID SEG ADA .23 GET ADDRESS OF MEMORY BOUNDS LDA 0,I GET LAST WORD OF BASIC INA STA FWAM LDA BKLWA CHECK FOR AVAILABLE BACKGROUND CMA,INA IF NONE THERE THEN ADA BKGRG ASSUME RTE-C OR RTE-B AND SZA THEN RUN IN FOREGROUND JMP RT1 THERE IS BACKGROUND! LDA AVMEM THERE ISNT! ADA M1 RT2 STA LWAM SET UP LWAM FOR BASIC USER AREA JMP RTINT,I RETURN * RT1 LDA BKLWA JMP RT2 * * SKP * * * RTE-B DUMMY OVERLAY DRIVER * * * OVDVR NOP *** ENTER *** STA TMPA3 SAVE AREG STB TMPB3 SAVE BREG LDA OVDVR,I GET CALL TABLE ENTRY ADDRESS JSB INDCK MAKE INTO DIRECT ADDRESS LDB 0,I GET FUNC. CTRL. WRD. INA POINT AT ENTRY POINT OF DRIVER LDA 0,I GET ENTRY ADDRESS JSB INDCK MAKE INTO DIRECT ADDRESS STA TEMP ISZ OVDVR SSB HAS FUNC. GOT JSB ERR0 ON IT JMP OV1 YES! LDA OVDVR STA TEMP,I FAKE JSB TO ENTRY FROM POSITION ISZ TEMP OF DEF FOLLOWING "JSB OVDVR" LDA TMPA3 RESTORE AREG LDB TMPB3 JMP TEMP,I CALL THE DRIVER * OV1 LDA TMPA3 RESTORE REGS LDB TMPB3 JSB TEMP,I EXECUTE FUNCTION RSS IS THERE AN ERROR RETURN JMP OVDVR,I NO! AND .15 MAKE INTO DECIMAL ADA .60 AND ADSxD IN ERROR # OFFSET STA TT2 SAVE FUNCTION NUMBER JSB ERROR PRINT ERROR MESSAGE DEF *+3 DEF TT2 OF THE FORM DEF ZERO "ERROR NN IN LINE XX" JSB .STOP RETURN TO READY IN BASIC * * * * * NORMALIZE (A), (B), AND EXPONENT * * * * NORML NOP SET STA TT2 LEFT SHIFT-COUNTER CLA TO ZERO STA TT1 LDA TT2 SZA,RSS ON SZB ZERO JMP NORM3 CLEAR STA .PEXP EVERYTHING STA MANT1 STORE NORM1 STB MANT2 MANTISSA JMP NORML,I AND RETURN * NORM2 ISZ TT1 COUNT LEFT SHIFTS NORM3 CLE,ELB ROTATE (A) AND ELA (B) LETF INTO (E) SEZ,SSA,RSS TWO HIGHEST BITS 0? JMP NORM2 YES, + UNNORMALIZED SEZ,SSA NO, TWO HIGHEST BITS 1? JMP NORM2 ERA SHIFT TO ERB,CLE NORMALIZED MANTISSA STA MANT1 NO, LDA TT1 COMPUTE CMA,INA CORRECTED ADA .PEXP EXPONENT STA .PEXP VALU LDA MANT1 JMP NORM1 * * THE FOLLOWING THREE ITEMS MUST REMAIN IN THE EXACT ORDER .60 DEC 60 TT1 BSS 1 TT2 BSS 1 TMPA3 EQU TT1 TMPB3 EQU TT2 TEMP BSS 1 * * * * SKP *** UNPACK LOW WORD OF NUMBER ** * .FLUN NOP LDA 1 (A) = (B) AND B377 GET EXPONENT CMB SUBTRACT OFF ADB 0 EXPONENT FROM CMB MANTISSA IN (B) SLA,RAR NEGATIVE EXPONENT? IOR MSK4 (77600) YES, PROPAGATE SIGN JMP .FLUN,I EXIT * *** INTEGERIZE FLOATING POINT NUMBER ** * IFIX NOP STF 1 SET OVERFLOW FLAG STA NORML SAVE (A) JSB .FLUN SSA EXPONENT NON-NEGATIVE? JMP IFIX3 NO. RETURN 0 OR -1. ADA M16 SSA EXPONENT LESS THAN 16? CLF 1 YES. CLEAR OVERFLOW. ADA M8 SSA,RSS EXPONENT LESS THAN 24? JMP IFIX,I NO. ERROR EXIT, NO FRACTION. ADA M8 BINARY POINT TO RT END OF B STA .FLUN SAVE SHIFT COUNT LDA NORML RETRIEVE HIGH MANTISSA JMP IFIX2 * IFIX1 CLE,SLA,ARS LONG RIGHT SHIFT CME SLB,ERB STF 1 SET OVERFLOW IF 1 LOST IFIX2 ISZ .FLUN DONE? JMP IFIX1 NO, SHIFT MORE ISZ IFIX DONE, SKIP RETURN JMP IFIX,I * IFIX3 LDA NORML NEGATIVE EXPONENT; RETRIEVE (A) CLE,SSA CCA,RSS TRUNCATE TO -1 OR 0 CLA,RSS CCB,RSS CLB JMP IFIX2+2 SKIP RETURN * SKP * * SUBROUTINE TO COMPUTE THE ENTIER OF A * NUMBER WHOSE EXPONENT IS LESS THAN 15 * THIS ROUTINE HAS SPECIAL PROPERTIES FOR BASIC: * OVERFLOW IS SET (ON NORMAL RETURN) IF ANY BIT LOST * E IS SET IF HIGH FRACTION BIT LOST * .IENT NOP JSB IFIX JMP .IENT,I OVERFLOW XOR 1 (A) SHOULD BE FULL OF SIGN BITS SSA (B) SHOULD HAVE A SIGN TOO JMP .IENT,I IT DOESN'T, ERROR EXIT. CPA 1 IF (A) WAS ZERO, JMP *+3 ALL WAS OK. CMA IF (A) WAS -1, CPA 1 ISZ .IENT ALSO OK; SKIP RETURN. JMP .IENT,I LEAVE WITH RESULT IN A, B. * SKP * EINT NOP STB TEMP SAVE (B) JSB IFIX JMP EINT1 NOT FIXABLE JSB .PACK BUILD FLTG RESULT DEC 31 JMP EINT,I * EINT1 LDB TEMP RETURN ORIGINAL NUMBER LDA NORML JMP EINT,I * SKP ******************************************************** * * BASIC DOUBLE STORE AND TEST ROUTINE * ******************************************************* * ENT .DST * * .DST NOP STA XTEMP  SAVE INFO STB XTMP1 TO BE STORED LDA TBLAD POINT AT STA PTR RESTRICTED AREA TABLE LDA M4 4 RESTRICTED AREAS STA CTR LDA .DST,I JSB INDCK REMOVE INDIRECT CHAIN STA ADR PROPOSED STORE ADDRESS ISZ .DST SET UP FOR EXIT JSB CHECK CHECK FOR ADR IN RESTRICTED AREA ISZ CTR MORE AREAS? JMP *-2 YES CHKOK LDA XTEMP ALL CLEAR, DO THE STORE STA ADR,I ISZ ADR LDB XTMP1 STB ADR,I JMP .DST,I * CHECK NOP LDA PTR,I GET LOWER LIMIT ISZ PTR LDB PTR,I GET UPPER LIMIT ISZ PTR SET UP FOR NEXT TIME CMA,INA ADA ADR INA SSA (ADR)+1 < LOWER LIMIT? JMP CHKXT YES, OUTSIDE LIMITS THEN CMB,INB ADB ADR SSB,RSS (ADR) >= UPPER LIMIT? CHKXT JMP CHECK,I YES, OUTSIDE LIMITS ISZ CTR INSIDE LIMITS, SIMPLE VARIABLE? JMP ERR NO, ERROR LDB SYMTF START AT BEGINNING OF SYMBOL TABLE NEXT CPB SYMTA ANY MORE ENTRIES? JMP ERR NO, ADR DIDN'T MATCH ANY SMPLE VAR LDA 1,I FETCH VARIABLE NAME AND .15 ISOLATE TYPE FIELD CPA .15 FUNCTION? JMP FN YES, TWO WORD ENTRY CPA .1 1 DIMENSIONAL ARRAY? JMP ARAY YES, SKIP THE ENTRY CPA .2 2 DIMENSIONAL ARRAY? JMP ARAY YES, SKIP THE ENTRY INB POINT AT SIMPLE VAR ADDRESS CPB ADR DO WE WANT TO STORE HERE? JMP CHKOK YES, THEN ALL IS WELL FN ADB .2 SMPL VARS HAVE 3 WORDS PER ENTRY JMP NEXT CHECK NEXT ENTRY * ARAY ADB .4 ARRAYS HAVE 4 WORDS PER ENTRY JMP NEXT CHECK NEXT ENTRY * ERR JSB ERROR DEF *+3 DEF .1 DEF DST JSB .STOP DOOM. * TBLAD DEF TABLE,I * TABLE DEF ZERO BASIC INTERPRETER DEF STR5PA * DEF PROGF INTERP. CODE DEF PROGL * DEF FCORE STACK AREA DEF SYMTF * DEF SYMTF SIMPLE VARIABLE AREA DEF SYMTA * STR5A DEF STRT5 DST DEC 3 ASC 2,DST XTEMP EQU TT1 XTMP1 EQU TT2 PTR BSS 1 CTR BSS 1 ADR BSS 1 MSK4 OCT 77600 * HED RTE-B CALL STATEMENT EXECUTION * (C) HEWLETT-PACKARD CO. 1976 **************************************** * RTE-B BASIC CALL STATEMENT EXECUTION * **************************************** * ENT ECALL,CLXIT ENT XITPT,PTBLA,DSTA,FLOTA,CLXTA * EXT TEMPS,B777,HSTPT,SETSX,PRADD EXT OPMSK,B4000,FORMX,FNDSB,FCORE,TSTPT EXT ERRCD,XEC4,FLOAT,FRTFX,FRTF2 EXT B1000,BHSTP,B177,SCALL EXT .STOP SUP * *** *** ** EXECUTE CALL ** *** *** * ECALL CLA CLEAR PARAMETER AREA STA PTBL STA PTBL+1 STA PTBL+2 STA PTBL+3 STA PTBL+4 STA PTBL+5 STA PTBL+6 STA ARGCT STA ERRCD LDA TEMPS LDA 0,I AND B777 ISOLATE INTERNAL CALL NUMBER STA SCALL SAVE TEMPORARILY LDA HSTPT SAVE HIGH CORE STA MWDNO STACK POINTER LDA PTBLA STA EFMT INITIALIZE PARAMETER POINTER ECAL1 ISZ TEMPS LDA TEMPS LDA 0,I AND OPMSK ISOLATE OPERATOR CPA B4000 RT PAREN (END OF PARAMS)? JMP ECAL2 YES. LDB TEMPS INB LDA 1,I AND OPMSK CPA B1000 QUOTE STRING BEING PASSED? JMP ECAL6 YES JSB FORMX EVALUATE PARAMETER. ECAL3 LDA HSTPT LDA 0,I STA EFMT,I SET UP DEF TABLE FOR .ENTR STA RTRN SAVE ADDRESS OF LAST PARAM ISZ ARGCT ISZ EFMT JMP ECAL1 * ECAL2 LDB ARGPA ADB ARGCT INITIALIZE DEF *+N STB ARGP LDB CLXTA STB XITPT LDB SCALL GET CALL TBL ENTRY NUMBER JSB FNDSB FIND STB ARGCT SAVE B IN ARGCT TEMPORARILY INB LDB 1,I GET CALL TABLE POINTER STB TMPX2 SAVE CALL TBL ENTRY ADDRESS LDB ARGCT RESTORE B FROM ARGCT CMB ADB STDCA LDA SCALL SSB,RSS STANDARD CALL? JSB FRTFX NO, GO DO FORTRAN FIX CCA LOAD ADDRESS OF ADA MWDNO PARAMETER ADDRESSES JSB TMPX2,I CALL EXTERNAL SUBROUTINE OR FUNCTION ARGP DEF *+0 PTBL OCT 0,0,0,0,0,0,0 JMP *+1,I XITPT DEF CLXIT FRTFX MAY CHANGE THIS FLTIT JSB FLOAT FOR FORT. FCNS. RETURNING INTEGER DSTL JSB .DST FOR FORTRAN FUNCTIONS, RETURN RESULT RTRN BSS 1 ADDRESS OF LAST PARAM CLXIT LDA FCORE STA TSTPT RESTORE LDA MWDNO STA HSTPT POINTERS LDB ARGCT CMB ADB STDCA SSB,RSS STANDARD CALL? JSB FRTF2 NO, FIX RETURNED PARAMS LDB ERRCD SZB,RSS ANY ERROR? JMP XEC4 NO. EXECUTE NEXT STATEMENT. ISZ TEMPS LDB PRADD CPB TEMPS ANY FAIL STATEMENT? JSB .STOP NO. ABORT EXECUTION. ISZ TEMPS JMP SETSX GO PROCESS STATEMENT * ECAL6 LDA 1 SAVE POINTER JSB BHSTP ALLOCATE PLACE FOR POINTER STA 1,I PUT " STRING POINTER ON STACK LDA 0,I AND B177 ISOLATE STRING CHARACTER COUNT INA ARS ADA 1,I COMPUTE ADDRESS OF END OF STRING STA TEMPS TO FIND NEXT CALL PARAMETER JMP ECAL3 * * PTBLA DEF PTBL DSTA DEF DSTL FLOTA DEF FLTIT CLXTA DEF CLXIT ARGPA DEF ARGP+1 ADDRESS OF LAST ARG +1 ARGCT BSS 1 NUMBER OF PARAMETERS MWDNO BSS 1 TMPX2 BSS 1 CONTAINS THE ADDRESS OF EXTERNAL SUBROUTINE * EFMT EQU TMPX2 * END START HFBBH p 91704-18105 1613 S 0222 DS1/B SCE/4 MODULE: %OPMD              H0102 [ASMB,R,L,C HED DREAD 91700-16119 REV A 751222 * (C) HEWLETT PACKARD CO. 1976 NAM DREAD,7 91700-16119 REV A 751222 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DREAD EXT READF EXT .ENTR SPC 5 * * DREAD * SOURCE:91700-18119 * BINARY:91700-16119 * SHANE DICKEY * JULY 31,1974 * PRAMS REP 6 NOP DREAD NOP JSB .ENTR DEF PRAMS * * LDA D3 SET UP DEFAULT # OF PARAMETERS STA #PRMS * DLD PRAMS MOVE DEFS FOR 1ST TWO DST PRAM1 * DLD PRAMS+2 MOVE 2ND TWO DST PRAM1+2 * * SZB,RSS WAS THE 6TH ONE THERE? JMP DONE NO DONE * ISZ #PRMS YES INCREMENT COUNT DLD PRAMS+4 MOVE POSSIBLE 3RD & 4TH DST PRAM1+4 * SZA,RSS 3RD PRESENT? JMP DONE NO * ISZ #PRMS YES-INCREMENT COUNT * SZB,RSS 4TH PRESENT? JMP DONE NO * ISZ #PRMS DONE LDA #PRMS CALCULATE RETURN ADA ADDS STA DRTN & PUT IN REBUILT CALL * JSB RFASR JSB CLEAR CLEAR OPTIONAL PARAMETERS LDA PRAMS+1,I GET IERR JMP DREAD,I FINISHED RETURN TO USER SPC 5 RFASR NOP JSB READF DRTN NOP PRAM1 REP 6 NOP JMP RFASR,I SPC 5 CLEAR NOP CLA CLEAR DEFS TO OPTIONAL PARAMETERS CLB DST PRAMS+3 DST PRAM1+3 STA PRAMS+5 STA PRAM1+5 * JMP CLEAR,I SPC 5 * CONSTANTS D3 DEC 3 ADDS DEF DRTN+1 #PRMS NOP END * AN ERROR EXISTS a  ASMB,L,C,F HED %OPMD 91704-16105 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM %OPMD,7 91704-16105 REV A 760323 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ************************************************* * *%OPMD OPERATOR INTERFACE MODULE * *SOURCE PART # 91704-18105 REV A * *REL PART # 91704-16105 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 10-9-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: MAR 1976 * ****************************************************** SPC 1 SPC 2 * * THIS IS A ROUTINE TO HANDLE ALL OPERATOR * COMMANDS USED BY DS1 IN RTE/B * THIS MODULE IS APPENDED IF THE BRANCH NEUMONIC * TABLE REQUIRES ANY OF THE ENTRIES SUP SPC 3 * * DEFINE ENTRY POINTS * ENT %CRET,%CLOS,%PURG,%ON,%RNAM ENT %TLOP,%DLST ENT ABYTE,SBYTE,LENBL ENT %PLOS,MOVE,CHAIN SPC 2 * * DEFINE EXTERNALS * EXT B377,CHAR,ERROR,CHARN,MBUFS EXT .43,.32,.45,M7,M9,.10,M5 EXT DIGCK,INVSC,CCRET,CCLOS,INIT EXT CMESG,MBUF2,CPURG,CSCHD,CNAME,M6 EXT FRMTO,READR,M1,TFLAG,CKLLN,%TAM EXT PROGL,B200,LWAM,.3,.8,.2,RLU EXT EXEC,M4,M2,.1,HILIM,LOLIM EXT INDCK,CRLF,LSTIT,SWLST,TSTIT,TYPE EXT FIXNM,PXMKA,PEXMA,.RUN,BLANK,LINE,SCR EXT CLINE,DIMFG,M8,.ENTR,.6 SPC 3 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SKP * * ROUTINE TO CREATE A FILE AT CENTRAL * FOR AN OPERATOR COMMAND * CALLING SEQUENCE * CREATE F@ILENAME:SECURITY CODE:LABEL:TYPE:FSIZE:RSIZE * %CRET NOP JSB NAMDC DECODE THE NAME LDA FSIZ GET FILE SIZE FLT CONVERT IT TO FLOATING POINT DST SIZE1 SAVE FILE SIZE LDA RSIZ GET RECORD SIZE ADA DM513 512 = MAX REC. LENGTH SSA,RSS RECORDS TOO LONG ? JMP IERR YES, OPERATOR ERROR LDA RSIZ GET RECORD SIZE FLT CONVERT IT TO FLOATING POINT DST SIZE2 SAVE RECORD SIZE ISZ DIMFG JSB CCRET CREATE THE FILE DEF *+8 DEF TEMPB TEMP BUFFER FOR DCB DEF TEMP1 ERROR WORD DEF NAME FILE NAME DEF SIZE1 FLOATING PT FILESIZE DEF FTYPE TYPE DEF SC SECURITY CODE DEF LU LDA TEMP1 GET STATUS SSA IS THERE AN ERROR? JMP FERR YES...ERROR JSB CCLOS NO ERROR...CLOSE FILE DEF *+3 DEF TEMPB TEMP DCB DEF TEMP1 STATUS LDA TEMP1 GET STATUS SSA ANY ERRORS? JMP FERR YES JMP INIT NO...RETURN SPC 2 SIZE1 BSS 2 SIZE1 AND 2 MUST BE INORDER SIZE2 BSS 2 TEMPB BSS 6 B72 OCT 72 B54 OCT 54 DM513 DEC -513 SKP * * SUBROUTINE TO CLOSE AN OPEN FILE * CALLING SEQUENCE * CLOSE FILENAME * %CLOS NOP JSB NAMDC GET THE NAME JSB CCLOS GO CLOSE FILE DEF *+3 DEF NAME FAKE DCB FOR NAME DEF TEMP1 ERROR STATUS LDA TEMP1 GET STATUS SSA ANY ERRORS JMP FERR YES JMP INIT RETURN SKP * * SUBROUTINE TO IMPLEMNT THE PURGE COMMAND * CALLING SEQUENCE * PURGE FILENAME:SECURITY CODE:LU * %PURG NOP JSB NAMDC DECODE THE NAME ISZ DIMFG JSB CPURG DEF *+6 DEF NAME DEF TEMP1 DEF NAME DEF SC PONTR DEF LU LDA TEMP1 GET STATUS SSA ERROR? JMP FERR YES JMP INIT NO SKP * * ROUTINE TO SCHEDULE A PROGRAM TO RUN AT CENTRAL * CALLING SEQUENCE * ON,PNAME,P1,P2,P3,P4,P5 * %ON NOP JSB CHARN GET CHARACTER CPA B54 IS IT A ","? RSS YES JMP IERR NO...ERROR JSB CHAR GET FIRST CHAR OF NAME CLB SET FLAG...SKIP SPACES JSB LNAME GET PROGRAM NAME DEF NAME BUFFER WHERE TO STORE NAME DEC -6 NEG MAX LENGTH+1 LDB PADD GET ADDRESS OF PRAM BUFFER STB TEMP1 SAVE PRAM BUFFER ADDRESS LDB M6 GET MAX NUMBER OF PRAMS+1 STB TEMP2 ONB CPA .10 EOL? JMP ONC YES...ISSUE EXEC CALL ISZ TEMP2 OUT OF ROOM? RSS NO...CONTINUE JMP IERR YES...ERROR JSB GETNM GET NUMBER CLB SET PRAM TO ZERO IF NOT THERE STB TEMP1,I SAVE VALUE ISZ TEMP1 GET TO NEXT VALUE JMP ONB GET NEXT PRAM ONC JSB CSCHD GO SCHEDULE PROGRAM DEF *+8 NAMA DEF NAME DEF TEMP1 DEF P1 DEF P2 DEF P3 DEF P4 DEF P5 * CLA CLEAR CLB THE DST P1 SCHEDULE DST P3 PARAMETERS STA P5 FOR NEXT TIME LDB TEMP1 GET STATUS SZB,RSS ANY ERRORS? JMP INIT NO LDA CM75 ASSUME PROGRAM BUSY RBL SSB CHECK IF ASC MESSAGE LDA CM72 ASC MESSAGE...PROGRAM NOT THERE JMP FERR TELL WORLD SPC 2 P1 NOP P2 NOP P3 NOP P4 NOP P5 NOP PADD DEF P1 CM75 DEC -75 CM72 DEC -72 SKP * * ROUTINE TO IMPLEMENT RENAME COMMAND * CALLING SEQUENCE * RENAME NAME,NEWNAME * %RNAM NOP JSB NAMDC CPA B54 NEXT CHAR MUST BE A "," RSS WELL WHAT DO YOU KֳNOW, IT IS JMP IERR DINGBAT...NAME,NEWNAME...OH WELL DLD NAME GET OLD NAME DST TEMPB AND STORE IT IN A TEMP BUFFER DLD NAME+2 GET LAST FOR CHARS DST TEMPB+2 DLD SC GET SECURITY CODE AND LU DST TEMPB+4 AND SAVE JSB NAMDC GET NEW NAME LDA SC GET NEW SECURITY CODE IOR TEMPB+4 OR IT WITH OLD IF SPECIFIED STA SC LDA LU GET LU IOR TEMPB+5 OR LU'S TOGETHER STA LU ISZ DIMFG JSB CNAME GO CHANGE THE NAME DEF *+7 DEF TEMPB OLD NAME...DCB DEF TEMP1 ERROR RETURN HERE DEF TEMPB OLD NAME DEF NAME NEW NAME DEF SC SECURITY CODE DEF LU LDA TEMP1 ANY ERRORS? SSA ANY ERRORS? JMP FERR YES JMP INIT NO...RETURN SKP * * ROUTINE TO IMPLEMENT THE TELLOP COMMAND * CALLING SEQUENCE * TELLOP0,MESSAGE * %TLOP NOP SPC 1 * * HEY GANG!!!! I AM CHEATING * I AM USING TO MESSAGE BUFFER IN THE REMOTE * RFA MODULE TO STORE THE MESSAGE * YOU NOTICE THAT WHEN WE CALL CMESG THAT ROUTINE * PROCEEDS TO SHIFT EVERYTHING OVER BY ONE WORD * ANYWAY, THE ENTRY POINT MBUF2 IS THE STARTING ADDRESS * WHERE WE CAN START STORING THE TELLOP MESSAGE * SPC 1 LDA MBF2A GET INDIRECTS OFF OF BUFFER ADDRESS JSB INDCK STA MBF2A INCASE THERE ARE ANY LDA MBUFS GET MAX NEGATIVE SIZE OF BUFFER STA %TLP1 SAVE FOR MOVE NAME ROUTINE JSB CHAR GET FIRST CHAR OF MESSAGE CCB SET TO INCLUDE SPACES JSB LNAME MOVE MESSAGE INTO REPLY BUFFER MBF2A DEF MBUF2 %TLP1 NOP MAX NUMBER OF CHARACTERS JSB CMESG NOW WE GO SEND TO MESSAGE DEF *+3 DEF D1 DEF MBUF2 JMP INIT WE HAVE SET IT RETURN * D1 DEC 1 SKP * * ROUTINE TO DO DLIST COMMAND * CALLING SEQUENCE * DLIST FILTER:SC:LU:FILE TYPE:LIST LU * %DLST NOP JSB NAMDC DECODE THE NAME INFO LDB FTYPE GET FILE TYPE CCE SEE IF THEY GAVE IT SZB IF NOT ZERO PROVIDED RBL,ERB SET SIGN BIT STB FTYPE SAVE FILE TYPE LDA DNREQ SEE IF THEY SPECIFIED A LIST DEVICE LDB .1 INCASE THEY DIDN'T...LIST ON SYSTEM STB STRM1 SET IN STREAM TYPE SZA LDB A THEY DID, USE IT STB DLSTD SAVE LIST DEVICE SELECT CODE CLA GET A ZERO TO SAY NEW REQ STA DNREQ %DST1 LDA MBUFS GET LENGTH OF BUFFER CMA,INA MAKE IT POSITIVE RAR MAKE IT INTO WORDS STA DLNGH SAVE FOR CENTRAL TO USE STA DLDLN SAVE FOR %TAM TO USE CLA,CLE,INA SET FOR READ, REQ AND DATA JSB %TAM GO SEND IT DEF STRM1 DEF DLPRM JSB LINST CHECK LINE STATUS LDA DSTAT OUR WE DONE? SZA JMP INIT YES JSB EXEC NO...SEND LINE TO LIST DEVICE DEF *+5 DEF .2 DEF DLSTD DEF MBUF2 DEF DLNGH JMP %DST1 GO FOR MORE SPC 1 DLPRM DEF MBUF2 DLDLN NOP DEF STRM1 ABS DLSIZ IGNORED BY DS1-B' SPC 1 DLSTD NOP DIRECTORY LIST LU SKP * * ROUTINE TO RE-ENABLE THE LINE IF DOWN * CALLING SEQUENCE * ENABLE * LENBL NOP JSB CLINE CLEAR THE LINE JMP INIT AND RETURN TO BASIC SKP * * SUBROUTINE TO PROCESS THE CHAIN COMMAND * CALLING SEQUENCE * CALL CHAIN("FILENAME",SC,LU,LOWER LIM,UPPER LIM) * SPC 1 CNAMA NOP CSCA NOP CLUA NOP CLIMA NOP CULMA NOP CHAIN NOP JSB .ENTR GET PRAMS DEF CNAMA WHERE TO PUT ADDRESS LDA CNAMA GET ADDRESS OF NAME JSB FIXNM GO PROCESS NAME JMP IERR SEND ERROR MESSAGE STB CNAMA SAVE ADDRESS OF NAME LDA M4 GET LOOP COUNTER FOR NAME AREA STA TEMP1 SAVE IN DOWN COUNTER LDA C4040 GET SPACE LDB NAMEA GET ADDRESS OF NAME AREA CHAN0 STA B,I SAVE SPACE INB GET NEXT LOCATION ISZ TEMP1 DONE? JMP CHAN0 NO...CONTINUE LDA CNAMA,I GET LENGTH AND B377 MASK OFF BIT 8 ADA .2 INCLUDE LENGTH CMA,INA NEGATE LENGTH STA CHAN1 SAVE FOR MOVE LDA CNAMA GET ADDRESS (SOURCE) RAL CONVERT TO BYTE ADDRESS LDB NAMEA GET ADDRESS WHERE NAME TO GO RBL CONVERT TO BYTE ADDRESS JSB MOVE MOVE BUFFER CHAN1 NOP LDA CSCA I GET SECURITY CODE STA SC LDA CLUA,I GET LU STA LU CLA,INA SET "FROM" FLAG STA FRMTO LDA CLIMA,I GET LOWER LIMIT STA LOLIM LDA CULMA,I GET UPPER LIMIT STA HILIM JSB PRMIN GO MOVE PARMB LDA PXMKA CONVERT TO PHASE 1 STA PEXMA JSB SCR DELETE OLD PROGRAM LDA LODFA GET ADDRESS OF LOAD FROM DISK ROUTINE STA READR LDA .RUNA GET ADDRESS WHERE RUN ROUTINE LOCATED JSB INDCK STA %PLOS SET FOR COMPLETION RETURN CHAN2 LDA .32 SET UP TO INPUT A LINE STA BLANK JSB LINE GO GET A LINE JMP CHAN2 AND CONTINUE SPC 2 .RUNA DEF .RUN SKP * * SUBROUTINE TO DECODE NAME PRAMS * CALLING SEQUENCE * JSB NAMDC * WILL CALL NAMD0 AFTER CALLING CHAR * NAMDC NOP JSB CHAR GET CURRENT CHAR JSB NAMD0 DECODE THE LINE JMP NAMDC,I RETURN SPC 3 * * SUBROUTINE TO DECODE NAME PRAMS * CALLING SEQUENCE * JSB NAMD0 * A REG= CURRENT CHAR * UPON RETURN * SC=SECURITY CODE * LU=LOGICAL UNIT * FSIZ SIZE OF FILE * RSIZ=SIZE OF EACH RECORD * TYPE=TYPE * NAM=NAME * NAMD0 NOP STA TEMP2 SAVE CURRENT CHAR CLA CLEAR OUT # OF OPTIONAL PRAMS STA NPRMS LDA SPACE GET A WORD OF SPACES LDB SPACE AND ANOTHER DST NAME+1 CLEAR OUT NAME AREA STA NAME+3 LDA M5 GET # OF OPTIONAL PRAMS STA TEMP1 SAVE IN DOWN COUNTER LDB SCA GET ADDRESS OF FIRST OPTIONAL NAME PRAM CLA GET A ZERO NMDCA STA B,I CLEAR OUT WORD INB GET NEXT WORD ISZ TEMP1 DONE? JMP NMDCA NO...CONTINUE CLB SET TO SKIP SPACES LDA TEMP2 RECALL CURRENT CHAR JSB LNAME GET NAME...A REG 0,IGNORE SPACES NAMEA DEF NAME BUFFER WHERE TO PUT NAME DEC -7 MAX LENGTH + 1 SPC 2 * AT THIS POINT WE HAVE MOVED THE NAME IN SPC 1 NMDCC JSB CHRCK CHECK FOR END OF LINE JMP NAMD0,I YES...TERMINATE ROUTINE JSB GETNM GET NUMBER RSS NOT NUMERIC JMP NMDCD NUMERIC SAVE SC CODE JSB CHRCK CHECK FOR DELEM. JMP NAMD0,I END OF LINE JMP NMDCE NO SECURITY CODE ALF,ALF SHIFT TO HIGH ORDER STA SC SAVE TOP HALF SCURITY CODE JSB CHARN GET NEXT CHAR STA B SAVE CHAR JSB CHRCK TERMINATOR NOP EOF...SET FOR SPACE LDA .32 GET A SPACE IOR SC OR IN BOTTOM HALF OF SCURITY WORD STA SC SAVE COMPLETE SECURITY CODE LDA B GET CHARACTER AGAIN JSB CHRCK ARE WE DONE? JMP NAMD0,I YES...RETURN JMP NMDCF YES...GO PROCESS LU JSB CHARN GET ANOTHER CHARACTER RSS NO...CHECK NEXT CHAR...MUST BE A ":" NMDCD STB SC SAVE NUMERIC SECUITY CODE NMDCE JSB CHRCK CHECK FOR TERMINATOR JMP NAMD0,I DONE RSS CONTINUE...GOT A : JMP IERR THEY BLEW IT!!! SPC 2  * WE NOW HAVE PROCESSED THE NAME AND SECURITY CODE * NOW WE ARE GOING TO PROCESS LU,TYPE,SIZE1,SIZE2 SPC 1 NMDCF LDB PONTR GET ADDRESS TO POINTER TO LU TYPE,AND SO ON STB TEMP1 SAVE POINTER LDB M4 REMAINDER NUMBER OF POINTERS STB TEMP2 SAVE IN A DOWN COUNTER NMDCH JSB GETNM GET NUMBER CLB NOT NUMERIC STB TEMP1,I SAVE PRAM VALUE ISZ NPRMS INCREMENT COUNT JSB CHRCK CHECK IF TERMINATOR WAS INCOUNTERED JMP NAMD0,I YES...DONE RSS RECIEVED A ":" JMP IERR HE BLEW IT NMDCG ISZ TEMP1 GET NEXT PRAM ADDRESS ISZ TEMP2 OUT OF ROOM? JMP NMDCH NO...CONTINUE JMP IERR YES...OH WELL SPC 3 SPACE ASC 1, SCA DEF SC TEMP1 NOP TEMP2 NOP NPRMS NOP SPC 1 * * HERE WE ARE USING THIS BUFFER FOR DECODING PRAMS * AS WELL AS A PRAMB FOR LOAD SAVE REQUESTS * WATCH YOURSELF IF YOU NEED TO CHANGE PART OF * THIS TABLE * SPC 1 . EQU * BSS 4 ALLOW 4 WORDS...GET NAME IN CORRECT POSITION SPC 1 NAME OCT 0 LOCATION FOR LENGTH COUNT ASC 3, ACTUAL FILE NAME SC NOP SECURITY CODE LU NOP LU FTYPE NOP FILE TYPE FSIZ NOP FILE SIZE RSIZ NOP RECORD SIZE SPC 1 * * REORG FOR DEFINING LOAD-SAVE PRMB * SPC 1 ORG . STRM NOP STREAM TYPE DCB# NOP DCB#...DEFINED BY CENTRAL...MUST NOT BE MODIFIED LSFG NOP LOAD-SAVE FLAG...0-1..SIGN BIT FERC NOP FILE STATUS LSST NOP LOAD SAVE STATUS...CURRENTLY NOT USED BSS 3 THE NAME GOES HERE...SET UP BY NAMD0 BSS 1 SC...SET BY NAMD0 BSS 1 LU..SET BY NAMD0 BSS 1 FILE TYPE...SET BY NAMD0 BSS 1 FILE SIZE...SET BY NAMD0 LSBLN BSS 1 BUFFER LENGTH LLIM NOP LOWER LIMIT ULyIM NOP UPPER LIMIT BSS 1 NOT USED...SPARE RRLU BSS 1 REMOTE LU...TERMINAL # SPC 1 LSPSZ EQU *-. DEFINE LENGTH OF PARMB SPC 4 * * REORG FOR DEFINING LOAD-SAVE PRMB * SPC 1 ORG . STRM1 NOP STREAM TYPE=1 BSS 1 NOT USED DSTAT NOP STATUS..0 CONTINUE...NOT 0 END DERR NOP DLIST ERROR...CURRENTY NOT USED DLNGH NOP DLIST LENGTH OF PRINT LINE BSS 3 FILTER TO GO HERE BSS 1 LU BSS 1 SC BSS 1 FILE TYPE DNREQ NOP NEW REQ FLAG BSS 7 RESERVED FOR CENTRAL USE DLSIZ EQU *-. LENGTH OF PARMB SPC 3 * * MAKE SURE NO ONE UNDER FLOWS!!! * ORG . BSS 35 SKP * * SUBROUTINE TO GET A FLOATING POINT NUMBER * CONVERT IT, AND RETURN IT IN THE B REG * THE A REG=NEXT CHAR * CALLING SEQUENCE * JSB GETNM * UNABLE TO CONVERT RETURN * CONVERTED RETURN * B REG=NUMBER * GETNM NOP JSB CHARN GET NEXT CHAR CLB,CLE CLEAR E AND B REG STB GTNM1 CLEAR OUT SUM WORD STB GTNM2 CLEAR OUT DIGIT RECIEVED WORD CPA .43 IS IT A "+" CCE SET E=READ ANOTHER CHAR CPA .45 IS IT A "-" CCB,CCE SET B=-1, SET E =READ ANOTHER CHAR STB SIGN SAVE SIGN SEZ READ ANOTHER CHAR? GTNMA JSB CHARN YES JSB DIGCK GO SEE IF DIGIT IS NUMERIC JMP GTNMB NOT NUMERIC...DONE CONVERSION LDA GTNM1 GET PARTICAL SUM IN A REG STB GTNM1 DIGCK RETURN NUMBER IN BOTH A AND B REG MPY .10 MULTIPLY PARTICAL SUM BY 10 ADA GTNM1 AND IN NEXT DIGIT STA GTNM1 SAVE NEW SUM ISZ GTNM2 SET FOR RECIEVED A DIGIT JMP GTNMA GET NEXT DIGIT SPC 1 GTNMB LDB GTNM2 DID WE GET ANY DIGITS? SZB,RSS JMP GETNM,I NO LDB SIGN GET SIGN CLE,ERB IF NEGATIVE, SET E REG LDB GTNM1 GET BINARY VALUE SEZ NEGATIVE VALUE? CMB,INB YES...NEGATE RESULT ISZ GETNM GET DIGIT RETURN JMP GETNM,I RETURN SPC 2 GTNM1 NOP GTNM2 NOP SIGN NOP SKP * * SUBROUTINE TO CHECK IF A CHARACTER IN THE A REG * ISEITHER AN END OF LINE ".10" OR A : "B72" * CALLING SEQUENCE * JSB CHRCK * END OF LINE RETURN * COLEN RETURN * NEITHER RETURN * A REG CONTAINS THE CHARACTER * B AND E REG NOT CHANGED * CHRCK NOP CPA .10 IS IT END OF LINE? JMP CHRCK,I YES...EOL RETURN CPA B54 IS IT A ","? JMP CHRCK,I YES...TREAT AS A EOL ISZ CHRCK CPA B72 IS IT A ":" JMP CHRCK,I ":" RETURN ISZ CHRCK JMP CHRCK,I NO DELM RETURN SKP * * ROUTINE TO MOVE NAME INTO NAME BUFFER * CALLING SEQUENCE * JSB LNAME * DEF BUFFER ADDRESS WHERE TO STORE NAME * DEC -MAX # OF CHARACTERS +1 * A REG=0 IGNORE BLANKS * A REG=-1 INCLUDE BLANKS * RETURN...A REG = DEL CHAR * LNAME NOP STB LNAM2 SAVE BLANK CHAR FLAG STA LNAM3 SAVE CURRENT CHAR CLB GET A ZERO TO CLEAR COUNT LDA LNAME,I GET ADDRESS OF NAME BUFFER STA LNAM1 SAVE COUNT ADDRESS ISZ LNAME GET TO NEXT PARM STB A,I CLEAR OUT COUNT WORD INA GET TO BUFFER...SKP OVER COUNT CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP1 SAVE BYTE ADDRESS LDA LNAME,I GET MAX LENGTH +1 ISZ LNAME GET TO RETURN ADDRESS STA TEMP2 SAVE FOR DOWN COUNTER LDA LNAM3 GET CURRENT CHAR NMDCB LDB LNAM2 GET BLANK FLAG SZB IGNORE BLANKS? JMP LMDCD NO LMDCC CPA .32 IS IT A BLANK? RSS YES...IGNORE IT JMP LMDCD NO...VALID CHAR JSB CHAR GET AA CHARACTER JMP LMDCC CHECK IF IT IS A BLANK LMDCD JSB CHRCK CHECK FOR DELEMETER NOP JMP LNAME,I HIT ONE LDB TEMP1 GT BYTE ADDRESS JSB SBYTE SAVE CHARACTER JSB CHAR GET NEXT CHARACTER ISZ TEMP1 GET NEXT CHAR ADDRESS ISZ LNAM1,I INCREMENT CHAR COUNT ISZ TEMP2 OUT OF ROOM? JMP NMDCB NO..CONTINUE JMP IERR YES...ERROR SPC 2 LNAM1 NOP LNAM2 NOP LNAM3 NOP SKP * * HERE IS WHERE WE COME IF WANT TO A LOAD,SAVE, * RUN,MERGE,OR LIST. THE "FROM","TO" FLAG DIRECTS THE * CONTROL OF THE FILE TRANSFER * WATCH THE SETING OF "FRMTO"... * %PLOS NOP JSB NAMD0 GET NAME,SECURITY CODE... JSB PRMIN SET UP THE LOAD SAVE PRAMB LDA FRMTO GET FROM TO FLAG AGAIN SZA,RSS FROM? JMP PLOS1 NO...TO LDA LODFA GET ADDRESS OF LOAD FILE ROUTINE STA READR SET UP FOR READER...IN BASIC LDA %PLOS GET TO CONTINUATION RETURN INA JMP A,I RETURN SPC 1 LODFA DEF LOADF DEFINE LOAD ROUTINE ADDRESS SPC 2 PLOS1 JSB FNDBF GET SOME BUFFER AREA STA PBUFA SAVE BUFFER ADDRESS STA RRECA SAVE FOR CENTRAL WRITE CMB,INB NEGATE LENGTH STB PBUFL SAVE NEGATIVE LENGTH STB RRECB SAVE LENGTH FOR LATTER JSB SWLST SET UP FOR OUTPUTING ON FILE DEF FSAV JSB LSTIT GO PROCESS OUTPUT (IN BASIC MODULES) CCA SET FOR ALL DONE JSB FLUSH FLUSH THE BUFFER JMP %PLOS,I RETURN SPC 2 PBUFA NOP PBUFL NOP SKP * * SUBROUTINE TO READ DATA ON LOAD COMMAND * BASIC CALLS IT EACH TIME IT WANTS INPUT * B REG= BUFFER ADDRESS * A REG= BUFER LENGTH * UPON RETURN * A REG= BUFFER LENGTH...IN CHARACTERS * LOADF NOP STB RRECA SAVE BUFFER ADDRESS INA GET +1 TOTAL LENGTH CMA,INA NEGATE COUNT STA RRECB SAVE - CHAR CHAR COUNT LODF1 LDA CLOC GET CURRENT ADDRESS LDB CLOC,I GET CONTENTS SZA FIRST TIME THRU SZB,RSS OR END OF BUFFER? JSB FILBF YES..FILL BUFFER FROM CENTRAL LDA CLOC,I GET LENGTH CPA M1 EOF JMP %PLOS,I YES...TAKE COMPLETION RETURN LODF2 ISZ CLOC GET TO FIRST DATA WORD LDB CLOC,I GET DATA WORD CPB C4040 IS IT A SPACE? RSS YES JMP LODF3 NO...CHECK LENGTH ADA M1 DECREMENT COUNT JMP LODF2 TRY AGAIN LODF3 LDB CLOC GET DATA WORD ADDRESS STB TEMP2 SAVE FOR MOVE ADB A GET TO NEXT ENTRY STB CLOC SZA,RSS ANYTHING JMP LODF1 NO...TRY AGAIN RAL CONVERT TO # OF CHARACTERS STA TFLAG SAVE # OF CHARACTERS FOR BASIC CMA,INA NEGATE COUNT STA MOVLN SAVE FOR MOVE CMA,INA GET POSITIVE LENGTH AGAIN ADA RRECB GREATER THAN MAX? SSA,RSS JMP LODF1 YES...IGNORE LINE LDA TEMP2 GET SOURCE ADDRESS OF MOVE RAL CONVERT TO BYTE ADDRESS LDB RRECA GET DESTINATION ADDRESS RBL CONVERT TO BYTE ADDRESS JSB MOVE MOVE THE BUFFER MOVLN NOP LDA TFLAG GET LENGTH JMP LOADF,I RETURN TO BASIC SPC 2 RRECA NOP RRECB NOP C4040 ASC 1, SBUFL EQU 40 LENGTH OF SAVE BUFFER (IN WORDS) SKP * * SUBRTOUTINE TO SAVE A LINE * CALLING SEQUENCE * JSB FSAV * A REG=-LENGTH * B REG=STARTING BYTE ADDRESS * CBUFL NOP CURRENT LENGTH ABS -SBUFL-SBUFL MAX # OF CHAR IN LINE OCT -2 I WILL HANDLE END OF LINE FSAV NOP ENTRY TO ROUTINE JMP *+3 SKP OVER INFO FOR END OF LINE NOP JSB ENDLN END OF LINE ROUTINE STA FSAVL SAVE LENGTH STA SMOVL PNNLHFOR MOVE RBL CONVERT TO BYTE ADDRESS STB FSAVA SAVE BYTE ADDRESS JSB SWLST DEF FSAV UPDAT LDA FSAVL SEE IF LINE IS TOO LONG CMA,INA MAKE LENGTH POSITIVE ADA TYPE ADD TO CURRENT COUNT STA TYPE CLA GET A ZERO FOR TSTIT JSB TSTIT SZA,RSS WILL LINE FIT? JMP UPDAT NO...TRY AGAIN LDB SBUFA GET ADDRESS OF LINE BUFFERGAIN RBL CONVERT TO BYTE ADDRESS ADB CBUFL GET TO END OF CURRENT LINE LDA FSAVA GET BYTE ADDRESS OF ADDITIONAL STUFF JSB MOVE MOVE THE LINE SMOVL NOP LDA .32 GET A SPACE JSB SBYTE MAKE SURE LAST CHAR ALWAYS A SPACE LDA TYPE SET LOCAL COUNT TO CORRECT LENGTH STA CBUFL JMP FSAV,I RETURN TO BASIC SMOVA NOP FSAVL NOP FSAVA NOP SBUFA DEF SBUF N r 91704-18106 1620 S 0122 DS1/B SCE/4 MOD BRTBL SOURCE             H0101 &{ SKP * * HERE IS WHERE WE COME ON END OF LINE CONDITION * ROUTINE CALLED BY CRLF (DEFINED IN BSUPV) * ENDLN NOP ENLN1 LDA CBUFL GET CURRENT LENGTH OF LINE SZA,RSS ANYTHING TO OUTPUT? JMP ENLN3 NO INA SET FOR ONE PAST LENGTH CLE,ERA CONVERT TO WORD LENGTH STA PBUFA,I SAVE LENGTH OF LINE ADA PBUFL CHECK IF BUFFER IS FULL? SSA,INA JMP ENLN2 NO...ROOM IN BUFFER CLA SET FOR BUFFER FULL, NOT DONE JSB FLUSH YES...BUFFER FULL...FLUSH IT JMP ENLN1 TRY AGAIN ENLN2 STA PBUFL SAVE LENGTH AFTER MOVE LDA CBUFL GET CURRENT LENGTH AGAIN CMA NEGATE LENGTH,INCLUDE SPACE CHAR STA ENLNA SAVE FOR MOVE ISZ PBUFA GET TO FIRST DATA WORD LDB PBUFA GET ADDRESS OF PACKING BUFFER RBL CONVERT TO BYTE ADDRESS LDA SBUFA GET ADDRESS OF LINE TO BE MOVED RAL CONVERT TO BYTE ADDRESS JSB MOVE MOVE LINE ENLNA NOP LDA CBUFL GET CURRENT LENGTH AGAIN INA GET ONE MORE CLE,ERA CONVERT TO WORD LENGTH ADA PBUFA RESET CURRENT OUTPUT POINTER STA PBUFA SAVE FOR NEXT TIME CLA CLEAR OUT CURRENT COUNTS STA TYPE DEFINED IN BASIC STA CBUFL DEFINED LOCALY ENLN3 LDB CRLF GET RETURN ADDRESS JMP B,I RETURN SKP * * SUBROUTINE TO MOVE A BUFFER FROM ONE AREA * TO ANOTHER * CALLING SEQUENCE * JSB MOVE * DEC - # OF WORDS...THIS WORD IS LOST!!!! * A REQ=SOURCE ADDRESS (BYTE) * B REG=DESTINATION ADDRESS (BYTE) * UPON RETURN B REG= NEXT BYTE ADDRESS * MOVE NOP STA MOVA SAVE SOURCE BYTE ADDRESS STB MOVB SAVE DESTINATION BYTE ADDRESS MOV1 LDB MOVA GET SOURCE BYTE ADDRESS JSB ABYTE GET A BYTE LDB MOVB GET DESTINATION BTYE ADDRESS JSB SBYTE WSTORE THE BYTE ISZ MOVA GET NEXT SOURCE BYTE ADDRESS ISZ MOVB GET NEXT DESTINATION BYTE ADDRESS ISZ MOVE,I DONE? JMP MOV1 NO...CONTINUE ISZ MOVE GET TO RETURN ADDRESS LDB MOVB GET NEXT DESTINATION BYTE ADDRESS JMP MOVE,I RETURN SPC 1 MOVA NOP MOVB NOP SKP * * SUBROUTINE TO FILL A BUFFER * CALLING SEQUENCE * JSB FILBF * FILBF NOP FLBF1 JSB FNDBF GET SOME BUFFER SPACE STA CLOC SAVE STARTING BUFFER ADDRESS CLE SET FOR READ A RECORD JSB RWREC GO READ FROM CENTRAL JMP FILBF,I NO ERRORS...RETURN JMP FLBF1 NO ROOM AT CENTRAL...TRY AGAIN CLOC NOP SKP * * ROUTINE TO FLUSH A BUFFER BY SHIPPING IT TO CENTRAL * CALLING SEQUENCE * JSB FLUSH * A REG= END OF LINE CONDITION (NORMALLY 0 EOL OR -1 * EOL AND EOF) * FLUSH NOP STA PBUFA,I SAVE END OF BUFFER CONDTION FLSH1 LDB RRECA GET ADDRESS OF BEGINING OF BUFFER CMB,INB NEGATE BUFFER ADDRESS ADB PBUFA GET DIFFERENCE INB INCLUDE END OF BUFFER CONDITION IN LENGTH LDA RRECA GET BUFFER ADDRESS CCE SET FOR WRITE REQUEST JSB RWREC GO WRITE THE RECORD RSS NO ERRORS JMP FLSH1 TRY AGAIN LDA RRECA RESET PACKING BUFFER LDB RRECB GET LENGTH AGAIN STA PBUFA STB PBUFL SAVE ADDRESS AND LENGTH JMP FLUSH,I RETURN SKP * * ROUTINE TO READ OR WRITE A RECORD TO CENTRAL * CALLING SEQUENCE * JSB RWREC * B REG= BUFFER LENGTH * A REG= BUFFER ADDRESS * E REG= 0,READ 1,WRITE * RWREC NOP STB BUFL SAVE BUFFER LENGTH STB LSBLN SAVE BUFFER LENGTH IN PARMB STA DADR SAVE DATA BUFFER ADDRESS CLA,INA SET FOR DATA AND REQ..E REG ALREADY SET JSB %TAM GO DO THE CALL DEF STRM REUPLY BUFFER...SAME AS SEND BUFFER DEF DADR JSB LINST CHECK LINE STATUS JSB EXEC RING BELL...TELL THEM WE ARE DOING ARE THING DEF *+5 DEF .2 DEF .1 DEF DINGA DEF DINGL LDB LSST GET STATUS OF TRANSACTION SZB NO ERRORS CPB M1 OR EOF JMP RWREC,I RETURN LDA FERC GET FMGR STATUS WORD CPB M2 IS IT A FILE MANAGER ERROR? JMP FERR YES LDA M103 DED WE LOOSE THE DCB?? CPB M4 JMP FERR YES...TELL THEM WE HAD SYSTEM PROBLEM JSB EXEC CENTRAL BUFFERS FULL...TELL THEM TO STAND BY DEF *+5 DEF .2 DEF .1 DEF STBYA DEF STBYL CLA SET UP WAIT LOOP LDB M6 WLOP1 INA,SZA INTER LOOP JMP WLOP1 INB,SZB OUTER LOOP JMP WLOP1 ISZ RWREC SET UP FOR RETRY RETURN JMP RWREC,I RETURN SPC 2 DADR NOP BUFL NOP DEF STRM STARTING ADDRESS OF PARMB ABS LSPSZ IGNORED BY DS1-B' SPC 1 M103 DEC -103 STBYA ASC 4,STANDBY STBYL DEC 4 SPC 1 DINGA OCT 3537 RING THERE BELL!!! DINGL OCT 1 SKP * * SUBROUTINE TO FIND AND SIZE UP SOME BUFFER * CALLING SEQUENCE * JSB FNDBF * UPON RETURN * B REG=WORD COUNT * A REG=STARTING ADDRESS * FNDBF NOP LDA PROGL CALCULATE STARTING ADDRESS OF BUFFER ADA B200 SA=PROGL+(3/8)*(LWAM-200B-PROGL) CMA,INA AS PER RAY FARITO ADA LWAM (LWAM-200B-PROGL) CLB MPY .3 3*(LWAM-200B-PROGL) DIV .8 3*(LWAM-200B-PROGL)/8 ADA PROGL WE HAVE THE STARTING ADDRESS ADA B200 GET PAST TEMP TABLES LDB MBUFS FIND OUT IF MESSAGE BUFFER LARGER CMB,INB MBUFS=-BUFFER BYTE COUNT CLE,ERB CONVERT TO + WORD COUNT STB FNDBL SAVE BUFFER LENGTH ADB A ADD TO S.A. OF POSSIBLE BUFFER CMB,INB AVAIL BUFFER * * WHERE P = NUMBER OF PARAMETERS * = ENTRY POINT OF SUBROUTINE * * ********************************************************************** * SBTBL EQU * * * CALL STATEMENTS START HERE * * OCT 100 DEF TIME TIME(T) * OCT 200 DEF SSETP SETP(S,P) * OCT 200 DEF SSTRT START(S,DELAY) * OCT 100 DEF DSABL DSABL(S) * OCT 100 DEF ENABL ENABL(S) * OCT 200 DEF TRNON TRNON(S,TIME) * OCT 200 DEF RGAIN RGAIN(CHANL,GAIN) * OCT 200 DEF SGAIN SGAIN(CHANL,GAIN) * OCT 0 DEF NORM NO PRAMS * OCT 300 DEF PACER PACER(RATE) * OCT 400 DEF AIRDV AIRDV(NUM,CHANL,DATA,ERR) * OCT 400 DEF AISQV AISQZ(NUM,SCHAN,DATA,ERR) * OCT 200 DEF ISETC * * * DS1 CALLS * * OCT 500 DEF CAPOS * OCT 300 DEF CCLOS * OCT 400 DEF CCONT * OCT 700 DEF CCRET * OCT 700 DEF CLOCF * OCT 600 DEF CNAME * OCT 600 DEF COPEN * OCT 400 DEF CPOSN * OCT 500 DEF CPURG * OCT 600 DEF CREAD * OCT 200 DEF CWIND * OCT 500 DEF CWRIT * OCT 300 DEF ASGN * OCT 200 DEF UASGN * OCT 200 DEF CMESG * OCT 700 DEF CAXTM * OCT 400 DEF CEXTM * OCT 700 DEF CSCHD * OCT 500 DEF CTIM * OCT 500 DEF POPEN * OCT 500 DEF PREAD * OCT 500 DEF PWRIT * OCT 300 DEF PCONT * OCT 500 DEF GET * OCT 300 DEF ACEPT * OCT 200 DEF REJCT * OCT 500 DEF CHAIN * OCT 0 DEF FINIS SKP * ********************************************************************** * * * THE FOLLOWING TABLE CONSISTS OF SUBROUTINE ENTRY * POINTS FOR THE SPECIAL STATEMENT ENTRIES IN THE * MNEMONIC TABLE. ENTRIES ARE AS FOLLOWS * * OCT 0 000 000 000 000 000 * DEF * * WHERE = SUBROUTINE ENTRY POINT * * ****************************************U****************************** * STDCL EQU * * * * STATEMENTS WITH NON-STANDARD SYNTAX START HERE * OCT 0 DEF EINP EXECUTE INPUT STATEMENT * OCT 0 DEF ELIST EXECUTE PRINT STATEMENT * OCT 0 DEF ETTYS EXECUTE PRINT# STATEMENT * OCT 0 DEF EREED READ STATEMENT * OCT 0 DEF RDNBR READ# LU; STATEMENT * OCT 0 DEF ETRAP TRAP STATEMENT * SKP * ********************************************************************** * * * THE FOLLOWING TABE DEFINES ENTRY POINTS FOR EXECUTION * OF COMMANDS. TABLE ENTRIES ARE AS FOLLOWS: * * OCT 0 000 000 000 000 000 * DEF * * WHERE: = ENTRY POINT FOR EXECUTION * ********************************************************************** * * SYSTEM COMMANDS START HERE * * OCT 0 DEF %CRET CREATE A FILE * OCT 0 DEF %CLOS CLOSE A FILE * OCT 0 DEF %PURG PURGE A FILE * OCT 0 DEF %ON TURN ON A CENTRAL PROGRAM * OCT 0 DEF %RNAM RENAME A FILE * OCT 0 DEF %TLOP SEND MESSAGE TO CENTRAL * OCT 0 DEF %DLST DO A CENTRAL DIRECTRY LIST * OCT 0 DEF LENBL ENABLE SATELLITE * OCT 0 DEF $DEL DELETE COMMAND * .RUNA OCT 0 DEF $RUN RUN COMMAND * OCT 0 DEF $SAVE SAVE COMMAND * OCT 0 DEF $MERG MERGE COMMAND * OCT 0 DEF $LOAD LOAD COMMAND * OCT 0 DEF $LST LIST COMMAND * OCT 0 DEF $TIM SET TIME COMMAND * OCT 0 DEF $REW REWIND COMMAND * OCT 0 DEF $SKPF SKIP FILE COMMAND * OCT 0 DEF $WEOF WRITE END OF FILE COMMAND * SKP Y* ********************************************************************** * * * THE FOLLOWING TABE DEFINES ENTRY POINTS FOR EXECUTION * OF FUNCTIONS. TABLE ENTRIES ARE AS FOLLOWS: * * OCT F 000 000 PPP 000 000 * DEF * * WHERE: F = 1 IF FUNCTION HAS "JSB ERR0" RETURN * P = NUMBER OF PARAMTERS * = ENTRY POINT FOR EXECUTION * * ********************************************************************** * FCNEX EQU * * * START FUNCTION ENTRY POINTS HERE * OCT 100 DEF ETAB EXECUTE TAB FUCTION * OCT 100100 DEF SIN EXECUTE SINE FUNCTION * OCT 100100 DEF COS EXECUTE COSIN FUNCTION * OCT 100100 DEF TAN EXECUTE TANGENT FUNCTION * OCT 100 DEF ATAN EXECUTE ARC TANGENT FUNCTION * .LOGA OCT 100100 DEF ALOG EXECUTE NATURAL LOG FUNCTION * .EXPA OCT 100100 DEF EXP EXECUTE EXPONENTIAL FUNCTION * OCT 100 DEF ABS EXECUTE ABSOLUTE FUNCTION * OCT 100100 DEF SQRT EXECUTE SQUARE ROOT FUNCTION * OCT 100 DEF EINT EXECUTE INTIER FUNCTION * OCT 100 DEF ERND EXECUTE RANDOM NUMBER FUNCTION * OCT 100 DEF ESGN EXECUTE SIGN FUNCTION * OCT 100 DEF ESWR EECUTE SWITCH REG FUNCTION * OCT 100 DEF IERR EXECUTE ERROR FUNCTION * OCT 100 DEF STATS GET STATUS LSBTB EQU * END OF BRANCH TABLE * SKP ********************************************************************** * * THE FOLLOWING TABLE DEFINES EXECUTION ENTRY POINTS * FOR THE COMMAND DEVICE TABLE. ENTRIES AR AS FOLLOWS: * * OCT 0 * DEF * * WHERE: = EXECUTION ENTRY FOR COMMANDS * ***($******************************************************************** * * COMMAND DEVICE EXECUTION * DEVEX EQU * * OCT 0 TAPE READER DEF PHOT1 * OCT 0 DEF %PLOS FILE LOAD AND SAVE ROUTINE * * ********************************************************************** * * * END s* t  91704-18108 1611 S 0122 DS1/B SCE/4 MODULE: %TAM              H0101 ]ASMB,R,L,C,F HED %TAM 91704-16108 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM %TAM,7 91704-16108 REV A 760309 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ***************************************** * *%TAM TERMINAL ACCESS MONITOR FOR RTE-B * *SOURCE PART # 91704-18108 REV A * *REL PART # 91704-16108 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 8-22-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: MAR 1976 * ***************************************** SUP SPC 2 * SUBROUTINE TO DO ALL REMOTE COMMUNICATION * ALL CALLS STARTING AT THE REMOTE TERMINAL WILL * GO THRU HERE. * CALLING SEQUENCE * JSB %TAM * DEF REPLY BUFFER ADDRESS * DEF PRM ADDRESS * A REG=0REQ ONLY, NOT 0 REQ AND DATA * E REG=READ/WRITE FLAG * SPC 3 * DEFINE ENTRY POINTS SPC 2 ENT %TAM,STCK,RWAIT SPC 2 * DEFINE EXTERNALS EXT REPLA,INDCK,FRPLY EXT CLU,M7,M1,EXEC,B377 EXT B200,WAIT EXT CLINE,DBSY EXT $TIME,#TIME SPC 2 * DEFINE A AND B REG SPC 1 A EQU 0 B EQU 1 SKP * * HERE IS WHERE WE START * %TAM NOP STA SAVEA A CONTAINS A PARAMETER!!!! SAVE IT LDA CLU AND B77 STA CNWD LDA SAVEA RESTORE THE PARAMETER CLB,INB SET FOR READ SEZ WRITE? INB YES STB DIRCT SAVE DIRECTION FLAG STA B GET REQ/DATA FLAF IN B REG LDA %TAM,I GET REYPLY ADDRESS JSB INDCK INDIRECT IT STA REPLA SAVE REPLY ADDRESS FOR REPLY LDA M7 GET RETRY COUNT STA RTRYC SAVE IN DOWN COUNTER CLA STA FRPLY CLEAR OUT WAIT FLAG ISZ %TAM GET TO PRAM ADDRESS LDA %TAM,I GET ADDRESS OF PRAMS ISZ %TAM SET FOR RETURN JSB INDCK INDIRECT IT SZB SEND REQ AND DATA? JMP %TAM2 YES LDB A,I GET REQ ADDRESS STB REQA SAVE BUFFER ADDRESS LDA DIRCT GET DIRECTION IOR BIT15 SET THE NO ABORT BIT STA IRW LDA REQA,I GET WORD 1 OF BUFFER IOR BIT11 SET FRIENDLY BIT STA REQA,I LDA REQA GET PARMB ADDRESS ADA D33 STEP TO TIME TAGS LDB $TIME GET 1ST WORD STB A,I SET IN PARMB STB #TIME SAVE FOR RETURN TEST INA LDB $TIME+1 SAME FOR 2ND WORD STB A,I STB #TIME+1 RQRTY ISZ RTRYC MAX NUMBER OF RETRYS? JMP *+3 NO LDA STWRD GET STATUS WORD JMP %TAM,I RETURN * * MAKE EXEC CALL SEND REQUEST * LDA DBSY WAIT TILL EVERYBODY DONE SZA JMP *-2 JSB EXEC DEF *+5 DEF IRW DEF CNWD REQA NOP REQL DEF D35 JMP RQRTY LINE ERROR JSB STCK DO STATUS CHECKING JMP STCK1 NO ERRORS..WAIT FOR RESPONSE JMP RQRTY ERROR RETRY JMP %TAM,I TERMINATE...TIME OUT OR STOP SPC 3 * * HERE FOR SEND REQ AND DATA * %TAM2 LDB A,I STB DTAD SAVE DATA ADDRESS INA STA DTL SAVE DATA LENGTH INA LDB A,I STB REQDA REQUEST ADDRESS ADB D33 STEP TO TIME TAGS LDA $TIME GET 1ST TIME WORD STA B,I SET IN PARMB STA #TIME SAVE FOR REPLY TEST INB SAME FOR 2ND WORD LDA $TIME+1 STA B,I STA #TIME+1 LD{A REQDA,I GET 1ST WORD OF REQUEST IOR BIT11 SET FRIENDLY BIT STA REQDA,I * LDA DIRCT GET DIRECTION OF DATA LDB B200 CPA D1 DATA READ LDB B100 LDA CLU GET THE LU AND B77 CLEAN IT IOR B SET THE PROPER CONTROL STA CNWD SET CONTROL RDRTY ISZ RTRYC MAX NUMBER OF RETRYS? JMP *+3 NO....CONTINUE LDA STWRD GET STATUS WORD JMP %TAM,I RETURN...WITH ERROR * * MAKE EXEC CALL...REQ AND DATA * LDA DBSY WAIT FOR LINE CLEAR SZA JMP *-2 JSB EXEC DEF *+7 DEF D2I REQ & DATA DEF CNWD REQDA NOP DEF D35 DEF DTAD DTL NOP JMP RDRTY ERROR RETURN JSB STCK CHECK STATUS JMP STCK1 ALL OK JMP RDRTY ERROR...RETRY CPA B10 TIME OUT OR STOP? JMP %TAM,I TIME OUT...GET OUT JMP STCK1 STOP RECIEVED SPC 2 * * HERE WE WAIT FOR REPLY * STCK1 JSB RWAIT GO WAIT FOR RESPONSE DST SABRG SAVE THE REGISTERS LDA REPLA,I GET W0 OF THE PARMB AND BIT13 GET BUZY BIT SZA,RSS SET ? JMP NBZY NO, OK CLB WE WAIT ISZ B SOME TIME JMP *-1 BEFORE RETRYING ISZ B WAIT SOME MORE JMP *-1 LDA REPLA,I GET W0 AGAIN AND NBT13 MASK OFF THE BUSY BIT STA REPLA,I REPLACE JMP RQRTY GO RETRY * NBZY DLD SABRG RESTORE THE REGISTERS JMP %TAM,I RETURN SKP * * SUBROUTINE TO CHECK STATUS OF CALL * CALLING SEQUENCE * JSB STCK * JMP ALL OK * JMP RETRY * JMP STOP RETURN * A REG CONTAINS STATUS WORD * B REG CONTAINS THE LENGTH * RTRYC MUST BE SET BEFORE CALLED * IF MAX NUMBER OF RETRYS FAILS WILL ABORT BASIC * STCK NOP AND B377 MASK ALL BUT STATUS SLA BO ALL OK? JMP STCK,I YES...RETURN ISZ STCK NO...SET FOR RETRY STA STWRD SAVE STATUS WORD SPC 2 * CHECK INDIVIDUAL STATUS BITS FOR ERROR SPC 1 RAR,SLA,RAR CHECK FOR DRIVER BUSY JMP STCK3 BUSY...GO WAIT TRY AGAIN RAR,SLA TIMEOUT? JMP STCK6 YES...TREAT AS STOP...CLEAR LINE RAR,SLA CHECK FOR STOP OR OUT OF SYNC JMP STCK5 GO CHECK RAR,SLA ILLEGAL LENGTH JMP OUT SHOULD NEVER GET HERE.CLEAR LINE-ERR=-51 RAR,SLA PARITY ERROR? JMP STCK3 YES...WAIT AND RETYR RAR,SLA LINE DOWN? RSS YES...TRY "UPING" THE LINE JMP OUT SHOULD NEVER GET HERE.CLEAR LINE-ERR=-51 LDB MD2 STB CNTR2 STCK2 JSB CLINE GO CLEAR THE LINE SLA ALL OK? JMP STCK,I YES...RETRY ISZ CNTR2 RSS JMP OUT+1 * * IF WE ARE UNABLE TO CLEAR LINE * TELL WORLD, WAIT 144 MS * AND TRY CLEARING THE LINE AGAIN. * STAY HERE UNTIL THE LINE CAN BE CLEARED... * LDB B200 WAIT 144 MS AND TRY AGAIN JSB WAIT JMP STCK2 TRY AGAIN SPC 2 STCK3 CLB SET TO WAIT AWHILE INB,SZB JMP *-1 LDA STWRD GET STATUS JMP STCK,I RETURN...RETRY SPC 2 STCK5 CPB M1 LEGAL STOP? JMP STCK7 YES...TERMINATE AND TELL THEM JMP STCK3 NO...WAIT AWHILE AND RETRY SPC 2 STCK6 JSB CLINE TIMEOUT, CLEAR LINE STCK7 LDA STWRD GET STATUS WORD ISZ STCK AND RETURN LIKE A STOP JMP STCK,I AND RETURN SKP * * SUBROUTINE TO WAIT FOR COMPLETION * * CALLING SEQUENCE * JSB RWAIT * JMP RECEIVED VALUE * * THIS ROUTINE IS GOING TO TEST A REPLY FLAG. * IT HAS A TIME OUT SET UP SO THAT IT WILL WAIT * FOR THE REPLY A MAXIMUM OF 10 TIMES THE LINE * TIME OUT. * * RWAIT NOP JSB SEARC ' SEARCH THE EQT TABLE FOR DVR65 CLA GET A NOP STA *-2 THE SEARCH IS NEEDED ONLY ONCE LDB EQENT GET ADDRESS OF EQT ENTRY ADB D13 STEP TO THE TIME OUT WORD LDA B,I GET IT ADA MD1 STA TIMUT SAVE LOOK LDA FRPLY DID THE REPLY ARRIVE ? SZA,RSS JMP WASTE NO, GO WASTE SOME TIME (100MS) DST SABRG SAVE THE REGISTERS CLB YES, CLEAN THE REPLY FLAG STB FRPLY LDA REPLA GET REPLY ADDRESS ADA D33 STEP TO TIME TAGS DLD A,I GET THEM CPA #TIME IS THIS THE RIGHT REPLY ? RSS JMP NOGD NO, IGNORE IT CPB #TIME+1 RSS YES JMP NOGD MISMATCH, IGNORE THIS REPLY DLD SABRG FIRST RESTORE THE REGISTERS JMP RWAIT,I NOW RETURN * WASTE ISZ TIMUT DID WE TIME OUT ? RSS NO JMP OUT YES LDA LENGT STA CNTR ISZ CNTR JMP *-1 JMP LOOK WE SPENT 100 MS HERE, THAT'S ENOUGH * OUT JSB CLINE CLEAR THE LINE LDA MD51 GET A STATUS BACK TO THE CALLER JMP RWAIT,I RETURN SPC 3 * * WE COME HERE IF A REPLY ARRIVES WITH THE WRONG * TIME TAGS. IF DATA IS PENDING (PTOP) WE SEND A * STOP TO CANCEL IT. * NOGD LDB EQENT GET ADDRESS OF EQT ENTRY ADB D11 STEP TO WORD 12 LDA B,I GET WORD 12 AND B1773 MASK OUT THE DP BIT (BIT 8) SZA,RSS DATA PENDING ? JMP LOOK NO, WAIT FOR NEXT REPLY LDA CLU YES, GET PREPARED FOR A SEND STOP AND B77 STA CNWD JSB EXEC SEND A STOP DEF *+3 DEF D3 CONTROL REQUEST DEF CNWD STOP ON COM. LINE. * JMP LOOK GO WAIT FOR NEXT REPLY SPC 3 * * THIS ROUTINE WILL SEARCH THE EQT TABLE FOR THE * ENTRY OF THE COMM LINE. * THE ADDRESS OF THE 1ST WORD OF THE E$"NTRY IS STORED * IN EQENT. * SEARC NOP LDA B1651,I GET # OF EQT ENTRIES CMA,INA NEGATE STA EQT# AND SAVE AS A COUNTER LDB B1650,I GET @ OF 1ST EQT ENTRY ADB D4 STEP TO WORD 5 OF 1ST ENTRY * LOOP1 LDA B,I GET A WORD 5 ALF,ALF RIGHT JUSTIFY THE TYPE AND B77 ISOLATE THE EQT TYPE CPA B65 IS IT THE COMM.LINE JMP FOUND YES (DVR65) ADB D15 STEP TO NEXT ENTRY ISZ EQT# INCREMENT COUNT JMP LOOP1 HLT 2 IF WE COME HERE, IT MEANS THAT THERE IS NO * NO COMM LINE. WE ARE IN TROUBLE. * FOUND ADB DM4 STEP BACK TO WORD 1 STB EQENT JMP SEARC,I RETURN SPC 3 SKP * * DEFINE STORAGE LOCATIONS * DIRCT NOP RTRYC NOP B10 OCT 10 STWRD NOP CNTR NOP CNTR2 NOP LENGT DEC -10000 MD1 DEC -1 MD2 DEC -2 TIMUT NOP D13 DEC 13 EQT# NOP B65 OCT 65 D15 DEC 15 D4 DEC 4 B1650 OCT 1650 B1651 OCT 1651 MD51 DEC -51 D2I OCT 100002 DTAD NOP B77 OCT 77 B100 OCT 100 CNWD NOP IRW NOP BIT11 OCT 4000 D1 DEC 1 D35 DEC 35 D33 DEC 33 SABRG BSS 2 BIT13 OCT 20000 BIT15 OCT 100000 NBT13 OCT 15777 SAVEA NOP EQENT NOP B1773 OCT 177377 D11 DEC 11 D3 DEC 3 DM4 DEC -4 * END $ u  91704-18110 1552 S 0122 DS1/B SCE/4 MODULE: %BUFR              H0101 EASMB,L HED %BUFR 91704-16110 REV A * (C) HEWLETT-PAKARD CO. 1976 NAM %BUFR,6 91704-16110 REV A 751224 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ****************************************************** * *%BUFR BUFFERING MODULE...AND FLAGS * *SOURCE PART # 91704-18110 REV A * *REL PART # 91704-16110 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 8-30-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: DEC 1975 * ******************************************************* SPC 1 * * DEFINE EXTERNALS * SPC 1 EXT $LIBR,$LIBX SPC 2 * * SPC 2 * * DEFINE BUFFER ENTRY POINTS * ENT FRPLY,REPLA ENT #TIME ENT MSTFL,MSTB ENT %MOVE,DBSY SPC 2 * * DRIVER BUSY REQUEST...SLAVE * DBSY NOP SPC 2 * * REPLY PARMB ADDRESS...PLACED THERE BY %TAM * REPLA NOP * * DRIVER STATUS FOR REPLY. TELLS RWAIT (IN %TAM) IF THE * REPLY HAS ARRIVED. * FRPLY NOP SPC 2 * * MASTER PARMB LENGTH...PLACED BY %INTR TO TELL %PTP IF * IF ANYTHING WAS RECEIVED TO SATISFY A GET. * MSTFL NOP * * MASTER PARMB * MSTB BSS 35 * * TIME TAGS OF THE LAST OUTGOING REQUEST * #TIME BSS 2 SPC 2 * * SUBROUTINE TO MOVE WORDS FROM ONE AREA OF CORE TO ANOTHER * CALLING SEQUENCE * JSB MOVE * DEF DESTINATION BUFFER ADDRESS * A REG CONTAINS SOURCE ADDRESS * B REG CONTAINS SOURCE LENGTH * MOVE NOP JSB $LIBR ROUTINE IS PRIVLEDGE    NOP SZB,RSS MAKE SURE NOT ZERO JMP MOVE2 ZERO...DONE STA SADD LDA MOVE,I GET DESTINATION ADDRESS STA DADD CMB,INB NEGATE LENGTH MOVE1 LDA SADD,I GET WORD STA DADD,I SAVE WORD ISZ SADD ISZ DADD INB,SZB DONE? JMP MOVE1 NO MOVE2 ISZ MOVE JSB $LIBX RETURN DEF MOVE SPC 1 SADD NOP DADD NOP %MOVE EQU MOVE SPC 3 END EQU * END   v} 91704-18112 1611 S 0122 DS1/B SCE/4 MODULE:%PTP              H0101 6ASMB,R,L,C HED %PTP 91704-16112 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM %PTP,7 91704-16112 REV A 760316 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * ********************************************* * *%PTP PROGRAM TO PROGRAM INTERFACE FOR SCE-4 * *SOURCE PART # 91704-18114 * *REL PART # 91704-16114 * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-13-74 * *MODIFIED BY: CHUCK WHELAN * *DATE MODIFIED: DEC 1975 * ********************************************** SPC 1 SUP * * SUBROUTINE TO HANDLE PROGRAM TO PROGRAM MASTER * CALLS IN THE RTE/B TERMINAL * THIS PROGRAM USES THE RFAIN PARMB AND REPLY BUFFERS * SPC 2 * * DEFINE EXTERNALS EXT DIMCK,.4,%TAM,.ENTR,.1,M2,EXEC,PRMB,M6 EXT SBYTE,ABYTE,.8,M1,.2 EXT DIMFG,.3,B377,M3,INDCK EXT .10,%MOVE,MSTFL,MSTB,CLU SPC 2 * * DEFINE ENTRY POINTS ENT POPEN,PREAD,PWRIT,PCONT ENT GET,FINIS,ACEPT,REJCT SPC 2 * * DEFINE A AND B REG A EQU 0 B EQU 1 SKP * * HERE ON POPEN CALL * CALLING SEQUENCE * CALL POPEN(PCB,ERROR,NAME,LU,TAG) * LU IS CURRENTLY IGNORED... * POPEN NOP JSB PMOV GO MOVE PRAMS OCT 1 DEFINE FOR POPEN SPC 1 * * HERE ON PREAD * CALLING SEQUENCE * CALL PREAD(PCB,ERROR,BUFFER,BUF LEN,TAG) * PREAD NOP JSB PMOV GO MOVE THE PRAMS INTO THE PARMB OCT 2 DEFINE FOR READ SPC 2 * * HERE FOR PWRIT * CALLING SEQUENCE * SAME AS PREAD * NJPWRIT NOP JSB PMOV OCT 3 DEFINE AS PWRIT SPC 2 * * HERE FOR PCLOSE * CALLING SEQUENCE * CALL PCLOS(PCB,ERROR,TAG) * PCONT NOP JSB PMOV OCT 4 DEFINE FOR PCLOS SKP * * HERE IS WHERE ALL THE ROUTINES COME TO HAVE THEIR * PRAMS MOVED INTO THE PARMB * CALLING SEQUENCE * NOP RETURN ADDRESS (CALLING ROUTINE) * JSB PMOV * OCT XX FUNCTION CODE * PMOV NOP LDA PRMBA GET ADDRESS OF PRMB IN FRAIN JSB INDCK CHASE DOWN INDIRECTS STA PRMBA SO WE DON'T HAVE TO AGAIN STA CPRMA SAVE IN COUNTER ADA D33 STA TITAG SAVE ADDR OF 1ST TIME-TAG INA STA TITAG+1 SAVE ADDR OF 2ND TIME-TAG LDA .4 GET STREAM TYPE JSB STWRD SAVE STREAM TYPE CLA JSB STWRD SET SUB STREAM TO ZERO LDA PMOV GET ADDRESS ADA M2 OF ROUTINE THAT CALLED US LDA A,I GET RETURN ADDRESS STA RTRN JMP ENTR GO GET CALLING PRAMS * * DEFINE LOCATIONS FOR PRAMS PASSED BY CALL * PRM1 NOP PRM2 NOP PRM3 NOP PRM4 NOP PRM5 NOP RTRN NOP ENTR JSB .ENTR GET PRAMS DEF PRM1 LDA PMOV,I GET FUNCTION CODE JSB STWRD SAVE FUNCTION CODE CPA .1 IS IT A POPEN? JSB POPN YES, MOVE NAME TO PCB CLA JSB STWRD MOVE ZERO INTO RESERVED WORDS JSB STWRD * * MOVE PCB TO PARMB LDA PRM1 STA TEMP1 ADDR OF PCB LDA M3 STA TEMP2 COUNTER MPCB1 LDA TEMP1,I GET WORD FROM PCB JSB STWRD SAVE IN PARMB ISZ TEMP1 BUMP ADDR ISZ TEMP2 & COUNTER JMP MPCB1 ITERATE * LDA PMOV,I GET FUNCTION CODE ADA BRTBL GO TO CORRECT ROUTINE JMP A,I AWAY WE GO SPC 1 BRTBL DEF *,I DEF POPN1 DEF PRED DEF PWRT DEF PCLS SPC 2 * * HERE ON CLOSE COMMAND * PCLS LDA PRM3 GET ADDRESS OF TAG FIELD STA PRM5 SAVE TAG FIELD ADDRESS FOR REPLY POPN1 LDA PRM5 GET ADDR OF TAG FIELD LDB CPRMA GET DESTINATION ADDRESS OF TAG MOVE JSB MTAGO MOVE TAG FIELD JMP WREQ NOW WRITE REQUEST SKP * * HERE FOR PREAD * PRED CLB,INB,RSS PREAD * * HERE FOR PWRIT * PWRT LDB .2 PWRIT STB REQDA SAVE DATA DIRECTION LDA PRM5 GET ADDRESS OF TAG FIELD LDB CPRMA GET ADD OF DESTINATION OF TAG JSB MTAGO GO MOVE TAG TO PARMB LDB M71 SET FOR LENGTH ERROR LDA PRM4,I GET LENGTH OF DATA BUFFER SZA CHECK FOR ZERO OR SSA NEGATIVE JMP ERR HE BLEW IT LDB PRMBA GET TO DATA LENGTH WORD ADB .18 STA B,I SAVE LENGTH LDA REQDA GET DATA DIRECTION FLAG CPA .2 IS IT A WRITE COMMAND? JMP WREQ YES...DON'T CHECK BOUNDS LDA PRM3 GET LOWER LIMIT LDB PRM3 ADB PRM4,I GET UPPER LIMIT+1 ADB M2 GET UPPER LIMIT JSB DIMCK CHECK LIMIT * * HERE WE SEND REQUEST * WREQ CLA,CCE SET FOR SEND REQ. ONLY JSB %TAM GO DO IT DEF PRMB DEF PRMBA SKP * * AT THIS POINT WE HAVE SENT THE REQUEST * AND HAVE RECEIVED THE REPLY * CPA B1 ALL OK? JMP CMPL1 YES DVERR LDB M51 SET FOR DRIVER ERROR AND B377 CPA B100 PARITY ERROR? LDB M52 YES * ERROR RETURN ERR STB PRM2,I SET IN ERROR CODE JMP RTRN,I AND RETURN * CMPL1 LDB PRMBA GET ADDRESS OF REPLY BUFFER ADB .3 GET TO STATUS WORD LDB B,I GET ERROR WORD STB PRM2,I SAVE ERROR STATUS SSB ANY ERRORS? JMP RTRN,I YES...DON'T PROCESS FURTHER LDB PRMBA GET ADDRESS OF REPLY ADB .2 GET TO TYPE CODE LDA B,I GET TYPE CODE RAR,RAR MOVE IN ERROR CODE AND .1 MASK ALL BUT REJECT CODE STA PRM2,I SAVE STATUS LDA B,I GET TYPE CODE AGAIN AND B17 MASK OFF ALL BUT TYPE CODE ADA CMPLB GET TO COMPLETION ROUTINE JMP A,I GO TO ROUTINE SPC 2 CMPLB DEF *,I DEF COPN CODE=1 OPEN ACCEPT DEF RDAT CODE=2 READ ACCEPT DEF WDAT CODE=3 CWRIT ACCEPT DEF CCLOS CODE=4 CONTROL ACCEPT DEF COPN CODE=5 OPEN REJECT DEF TAGIT CODE=6 READ REJECT DEF TAGIT CODE=7 WRITE REJECT DEF CCLOS CODE=8 CONTROL REJECT SPC 3 * * HERE FOR POST PROCESSING OF OPEN * COPN LDB PRMBA GET ADDRESS OF REPLY BUFFER ADB .5 GET TO 3 WORD PCB STB TEMP1 SAVE SOURCE ADDRESS LDB M3 GET COUNT STB TEMP2 SAVE IN DOWN COUNTER LDB PRM1 GET DESTINATION ADDRESS COPN1 LDA TEMP1,I GET SOURCE WORD STA B,I SAVE WORD INB GET NEXT DESTINATION ADDRESS ISZ TEMP1 GET NEXT SOURCE ADDRESS ISZ TEMP2 DONE? JMP COPN1 NO...CONTINUE JMP TAGIT MOVE TAG FIELD * * ACCEPTED PREAD POST-PROCESSING * RDAT CLA,INA,RSS A=1 FOR READ DATA * * ACCEPTED PWRIT POST-PROCESSING * WDAT LDA .2 A=2 FOR WRITE DATA STA TEMP2 LDA B300 SEND/RCV DATA ONLY IOR CLU + LU STA CNWD SET DRIVER CONTROL WORD * JSB EXEC CALL DRIVER TO XFER DATA DEF *+7 DEF TEMP2 DEF CNWD DEF PRM3,I DATA BUFFER DEF PRM4,I DATA LENGTH TITAG NOP NOP * SLA,RSS ANY DRIVER ERRORS? JMP DVERR YES * * * MOVE TAG FIELD TO USER AREA AND EXIT * TAGIT LDB PRM5 GET ADDRESS WHERE TO PUT TAG FIELD CCLS1 LDA PRMBA GET ADDRESS OF REPLY BUFFER ADA .8 GET TO TAG FIELD JSB MTAG MOVE TAG BACK TO USER AREA JMP RTRN,I GO BACK TO USER SPC 2 * * HERE FOR POST PROCESSING OF CLOSE * CCLOS LDB PRM3 GET ADDRESS OF TAG FIELD JMP CCLS1 GO TO COMPLETION SPC 4 PRMBA DEF PRMB D33 DEC 33 D35 DEC 35 CPRMA NOP REQDA NOP TEMP1 NOP TEMP2 NOP B1 OCT 1 B17 OCT 17 .5 DEC 5 .18 DEC 18 M46 DEC -46 M47 DEC -47 M71 DEC -71 M51 DEC -51 M52 DEC -52 B100 OCT 100 B300 OCT 300 SPACE ASC 1, DUMMY NOP SKP * * SUBROUTINE TO MOVE NAME TO PCB AREA * POPN NOP LDA PRM3,I GET PROGRAM NAME LENGTH AND B377 MASK OFF ASC FLAG LDB A MOVE INOT B REG CMB,INB NEGATE CHAR COUNT STB PPNS3 SAVE FOR MOVE LDB A GET POSITIVE LENGTH AGAIN ADA M6 CAN NOT BE OVER 5 CHARS LONG ADB M1 MUST BE AT LEAST 1 CHAR LONG SSB,RSS SSA,RSS JMP NMERR NAME NOT IN RANGE...ERROR LDA PRM1 GET PCB ADDRESS LDB A GET UPPER LIMIT ADB .2 JSB DIMCK CHECK FOR RANGE LDA PRM1 GET PCB ADDRESS AGAIN STA PPNS1 SAVE FOR LOOP LDA SPACE GET TWO SPACE CHARACTERS LDB M3 GET LENGTH OF PCB PPNSA STA PPNS1,I SAVE SPACE WORD ISZ PPNS1 GET TO NEXT LOCATION INB,SZB DONE? JMP PPNSA NO LDA PRM1 GET PCB ADDRESS AGAIN CLE,ELA CONVERT TO BYTE ADDRESS STA PPNS1 SAVE FOR MOVE ISZ PRM3 GET PAST LENGTH WORD LDA PRM3 GET ADDRESS OF NAME CLE,ELA CONVERT TO BYTE ADDRESS STA PRM3 SAVE FOR MOVE PPNSB LDB PRM3 GET BYTE ADDRESS SOURCE JSB ABYTE GET CHARACTER LDB PPNS1 GET BYTE ADDRESS DESTINATION JSB SBYTE SAVE BYTE ISZ PPNS1 INC SOURCE BYTE ADDRESS ISZ PRM3 INC DESTINATION BYTE ADDRESS ISZ PPNS3 ' DONE? JMP PPNSB NO JMP POPN,I YES...RETURN TO MAIN LINE CODE SPC 1 PPNS3 NOP PPNS1 NOP SPC 2 * * HERE IF NAME ERROR OCCURED * NMERR LDB M71 NAME ERROR CODE JMP ERR GO PROCESS ERROR SKP * * SLAVE PROGRAM TO PROGRAM READY CALL * CALLING SEQUENCE * CALL GET(ICLASS,IERR,IFUN,ITAG,IL) * RCLSA NOP RERA NOP RFUNA NOP RTAGA NOP RILA NOP GET NOP JSB .ENTR DEF RCLSA LDA MSTFL GET LENGTH OF MASTER REQUEST SZA,RSS IS THERE ONE? JMP RDYER NO...ERROR LDA MSTBA GET BUFFER ADDRESS OF PARMB JSB INDCK DIRECT IT STA MSTBA ADA .5 SEE IF FIRST TIME CLB CPB 0,I IF ZERO...ALREADY ISSUED A READY JMP RDYER ERROR STB A,I CLEAR WORD ADA .3 GET TO TAG FIELD ADDRESS LDB RTAGA SET TO STORE IT JSB MTAG MOVE TAG FIELD LDB MSTBA GET PARMB ADDRESS AGAIN ADB .2 GET TO FUNCTION CODE LDA B,I GET FUNCTION CODE AND .3 MASK OFF ALL BUT FUNCTION CODE STA RFUNA,I SAVE FUNCTION CODE ADB .16 GET TO LENGTH WORD LDA B,I GET LENGTH WORD STA RILA,I SAVE LENGTH WORD CLB,RSS SET FOR ALL OK ERROR RETURN RDYER LDB M46 SET FOR IMPROPER SEQUENCE STB RERA,I SAVE ERROR STATUS JMP GET,I RETURN SPC 1 .16 DEC 16 SKP * * PROGRAM TO PROGRAM ACCEPT CALL * CALLING SEQUENCE * CALL ACEPT(ITAG,IERR,IBUF) * ATAGA NOP AERRA NOP ABUFA NOP ACEPT NOP JSB .ENTR DEF ATAGA LDA AERRA STA PRM2 ADDR OF ERROR PARAMETER LDA ACEPT STA RTRN RETURN ADDR LDA MSTBA CHECK IF READY ISSUED ADA .5 GET TO FLAG WORD LDA A,I GET FLAG WORD SZA READY ISSUED? JMP JERR NO...SEQUENCE ERROR ʌ LDA ATAGA GET ADDRESS OF TAG SOURCE LDB MSTBA GET ADDRESS OF DESTINATION ADB .8 GET TO TAG AREA JSB MTAGO LDB MSTBA GET BUFFER ADDRESS AGAIN ADB .2 GET TO FUNCTION CODE LDB 1,I GET FUNCTION CODE CLA RBR,SLB TEST FOR PREAD OR PWRIT RSS IT IS, SKIP JMP ARPLY POPEN OR PCONT, DO REQ. ONLY LDA MSTBA GET PRMB BUFFER ADDRESS ADA .18 ADDR OF LENGTH WORD STA BFLEN SAVE LENGTH ADDR LDA B100 CODE FOR SEND REQ/ READ DATA SSB,RSS SKIP IF PWRIT ALS ELSE CODE FOR SEND REQ/ SEND DATA ARPLY LDB BIT14 SET FOR NO ERRORS * * A REG HAS MODE FOR DRIVER OPERATION * B REG ORED INTO REPLY FUNCTION CODE WORD * SRPLY IOR CLU A HAS MODE + LU STA CNWD DRIVER CONTROL WORD LDA RPLBT BITS 7 AND 2 IOR B OR IN ACCEPT REJECT BITS LDB MSTBA GET PARMB ADDRESS ADB .2 GET TO FUNCTION CODE WORD IOR B,I OR IN REPLY RESPONSE STA B,I SAVE REPLY INB GET TO ERROR STATUS CLA AND CLEAR IT OUT STA B,I ADB .2 GET TO FIRST WORD OF NAME STB B,I SET FIRST WORD NON ZERO LDA MSTB GET STREAM TYPE IOR B1411 SET IN REPLY BIT-FRIENDLY BIT STA MSTB SAVE STREAM WORD LDA M10 STA RTRY SET RETRY COUNTER * CALL DRIVER TO SEND REPLY SNDR JSB EXEC SEND REPLY DEF *+7 DEF .2 DEF CNWD MSTBA DEF MSTB DEF D35 LENGTH OF REQUEST DEF ABUFA ADDR OF DATA BUFFER BFLEN DEF DUMMY LENGTH OF DATA * STA LSTAT SAVE LINE STATUS SLA,RAR JMP GOOD NO ERRORS SWP AND B40 CLE,ERB SEZ,SZA,RSS JMP FAIL DRIVER ERROR SEZ,RSS JMP BZWT REMOTE IS BUSY SZA SIMULTANEOUS0 REQUEST? JMP SNDR YES, TRY AGAIN * BZWT ISZ RTRY BUMP RETRY COUNTER JMP *+3 OK TO RETRY * FAIL LDA LSTAT OPERATION FAILED JMP DVERR * LDA DLAY INA,SZA DELAY ABOUT 50 MSECS JMP *-1 JMP SNDR RETRY * GOOD RAR,RAR RIGHT JUSTIFY "STOP RCVD" BIT RAR,SLA JMP RCSTP STOP RECEIVED, RETURN -47 CLB CLEAR OUT LENGTH WORD STB MSTFL INCASE ANOTHER READY ISSUED STB PRM2,I SAVE GOOD ERROR STATUS JMP RTRN,I RETURN * RCSTP LDB M47 RETURN ERROR CODE JMP ERR SPC 1 M10 DEC -10 RTRY NOP LSTAT NOP DLAY DEC -12500 B40 OCT 40 BIT14 OCT 40000 B1411 OCT 44000 RPLBT OCT 204 CNWD NOP SKP * * PROGRAM TO PROGRAM REJECT CALL * CALLING SEQUENCE * CALL REJCT(ITAG,IERR) * JTAGA NOP JERRA NOP REJCT NOP JSB .ENTR DEF JTAGA LDA JERRA STA PRM2 ADDR OF ERROR PARAMETER LDA REJCT STA RTRN RETURN ADDR LDB MSTBA GET PARMB ADDRESS ADB .5 GET TO FLAG WORD LDA B,I IS FLAG WORD SET? SZA JMP JERR NO...ERROR...NO READY CALL LDB MSTBA GET DESTINATION BUFFER ADDRESS ADB .8 LDA JTAGA GET SOURCE ADDRESS JSB MTAGO MOVE TAG FOR REPLY CLA SET FOR REQUEST ONLY LDB BIT15 GET REJECT BIT JMP SRPLY GO SEND REPLY & EXIT * * SEQUENCE ERROR OCCURRED JERR LDB M46 -46= SEQUENCE ERROR JMP ERR RETURN WITH ERROR STATUS SPC 1 BIT15 OCT 100000 SKP * * SUBROUTINE TO KEEP THE SYSTEM COMPATABLE * FINIS IS USED ONLY AT CENTRAL CURRENTLY * CALLING SEQUENCE * CALL FINIS(ANY THING) * FINIS NOP ISZ FINIS GET TO RETURN ADDRESS JMP FINIS,I AND RETURN SPC 5 * * SUBROUTINE TO STORE A WORD IN TO THE PARMB * CALLING SEQUENCE P640* JSB STWRD * A REG CONTAINS THE WORD * CPRMA CONTAINS ADDRESS WHERE TO STORE THE WORD * CPRMA IS INCREMENTED AFTER WORD IS STORED * STWRD NOP STA CPRMA,I SAVE WORD ISZ CPRMA GET TO NEXT WORD JMP STWRD,I RETURN SKP * * SUBROUTINE TO MOVE TAG FIELD * CALLING SEQUENCE * JSB MTAG * A REG CONTAINS ADD OF SOURCE TAG FIELD * B REG CONTAINS ADD OF DESTINATION TAG FIELD * MTAG NOP STA MTAGA SAVE SOURCE ADDRESS STB MTAGB SAVE DESTINATION ADDRESS LDA B GET ENDING ADDRESS ADB .8 JSB DIMCK GO CHECK LDA MTAGA GET SOURCE ADDRESS LDB .10 GET LENGTH JSB %MOVE MOVE THE BUFFER MTAGB NOP JMP MTAG,I AND RETURN SPC 2 MTAGA NOP SPC 2 * * SUBROUTINE TO MOVE TAG TO PCB * MTAGO NOP ISZ DIMFG SET FOR SPECIAL JSB MTAG JMP MTAGO,I AND RETURN END EQU * END 6 w  91705-18101 1553 S 0122 DS1/B SCE/5 MODULE: @QUE              H0101 SASMB,R,L,C HED @QUE - PARMB SETUP & QUEING SUBR.*(C) HEWLETT-PACKARD CO. 1976* NAM @QUE,6 91705-16101 REV.A 751230 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * @QUE * SOURCE: 91705-18101 REV.A * BINARY: 91705-16101 REV.A * JIM HARTSELL * AUG. 14, 1974 * MODIFIED BY: C.C.H. (12-30-75]) [DERIVED FROM: 91705-18001 REV.B] * * RE-ENTRANT SUBROUTINE FOR RTE-C SATELLITE * RESIDENT LIBRARY. * * CALLING SEQUENCE: (CALLED BY @REFA) * * JSB @QUE * OCT FCN CODE * OCT USER CALL ADDRESS * DEF PARMB BUFFER * DEF REPLY BUFFER * DEF DATA ADDR (RETURNED) * DEF DATA LENGTH (RETURNED) * DEF PARMB LENGTH (RETURNED) * ERROR RETURN (REQUEST REJECTED) * NORMAL RETURN (REQUEST ACCEPTED) * * FOR ERROR RETURN: FLAG WORD = "REPLY RECEIVED" * (A) = -1 QUEUE IS FULL (RFA BUSY), (B)=0. * (A) = 0 ERROR CODE IN REPLY BUFFER AND * (B) = ASSIGNED QUEUE ENTRY ADDR. * * FOR NORMAL RETURN: FLAG WORD = "PARMB READY" * (B) = ADDR OF ASSIGNED QUEUE ENTRY. * ENT @QUE,%DORM,%ACT,%LU,%CPFL,%TIME * EXT $LIBR,$LIBX,@DEQ * A EQU 0 B EQU 1 * **************************************** * * BEGIN TEMPORARY DATA BLOCK. * TDB NOP DEC 19 LENGTH OF BLOCK. RETRN NOP RETURN ADDR OF CALLER. TEMP1 NOP TEMPORARY DATA. TEMP2 NOP TEMP3 NOP QENT NOP ADDR OF CURRENT QUEUE ENTRY. P.PTR NOP USER CALL PARAM POINTER. B.PTR NOP PARMB RELATIVE BYTE POINTER. U.PTR NOP PTR TO CALLER RETURN PARAMS. STREM NOP STREAM TYPE. TTAGA NOP TIME-TAG ADDRESS. * PASSED PARAMETERS: FCN NOP FUNCTION CODE. CALL NOP ADDR OF USER CALL. PARMB NOP ADDR OF PARMB AREA. REPLY NOP ADDR OF REPLY BUFFER AREA. DADR NOP DATA ADDRESS. DLEN NOP DATA LENGTH. PLEN NOP PARMB LENGTH. * * END OF TEMPORARY DATA BLOCK. * **************************************** * * @QUE NOP ENTRY POINT. * JSB $LIBR SAVE TEMPORARY DATA. DEF TDB * JSB $LIBR DISABLE INTERRUPT SYSTEM. NOP * LDB PAV FETCH PARAMETERS. STB TEMP1 LDB MD7 LOOP LDA @QUE,I STA TEMP1,I ISZ @QUE ISZ TEMP1 INB,SZB JMP LOOP LDA PARMB GET PARAMETER BUFFER ADDRESS. ADA D33 FORM TIME-TAG-ENTRY ADDRESS. STA TTAGA SAVE THE ADDRESS IN THE TDB. * LDA @QUE STA RETRN SET RETURN ADDRESS. * * CLEAN OUT DEAD QUEUE ENTRIES. * LDA %ACT HEAD OF ACTIVE LIST. SCAN LDA A,I ADDR OF NEXT QUEUE ENTRY. SZA,RSS JMP LOCAT QUIT IF DONE. * STA TEMPX SAVE ADDR OF QUEUE ENTRY. ADA B2 GET IT'S ID SEG ADDR. LDB A,I CPB XEQT,I SAME AS CURRENT PROG? JMP DEAD YES. GO KILL THE ENTRY. * ADB D15 NO. GET PROGRAM STATUS. STB TEMP2 LDA B,I AND B17 SZA JMP ALIVE PROGRAM IS SCHEDULED. * LDA TEMP2 PROG DORMANT. CHECK ADA B2 IF IN TIME LIST. LDA A,I ALF,SLA JMP ALIVE IN TIME LIST. * DEAD JSB $LIBX INTERRUPTS BACK ON. DEF *+1 DEF *+1 * JSB @DEQ PROG DEAD. KILL IT'S ENTRY. TEMPX NOP QUEUE ENTRY ADDRESS. B1 OCT 1 * NOP JSB $LIBR INTERRUPTS BACK OFF. NOP * ALIVE LDA TEMPX GO TO NEXT ENTRY. JMP SCAN * * ***** QUEUE THE NEW REQUEST ***** * REMOVE THE LAST ENTRY FROM THE DORMANT LIST AND * LINK IT TO THE END OF THE ACTIVE LIST IN THE * PARMB QUEUE. EXIT FROM THE PRIVILEDGED CODE WITH * (A) = 0 IF NEW ENTRY WAS ADDED, OR * (A) = -1 IF ACTIVE LIST FULL (RFA BUSY). * LOCAT CLB (INTERRUPTS STILL OFF) STB QENT SET FOR "NONE ASSIGNED". CCA QUEUE IS FULL IF DORMANT LIST LDB .DORM IS EMPTY. SZB,RSS JMP Q1 REJECT WITH A = -1. * LDA %ACT FIND LAST ENTRY IN CLB ACTIVE LIST. JSB FIND * STB TEMP1 SAVE ADDR OF LAST ACTIVE ENTRY. * LDA %DORM FIND LAST ENTRY IN JSB FIND DORMANT LIST. * STB TEMP1,I LINK INTO ACTIVE LIST. STB QENT SAVE ADDRESS IN TDB. CLB STB A,I DELETE ENTRY FROM DORMANT LIST. LDA QENT CLEAR FLAG WORD IN NEW ENTRY. INA STB A,I * CLA EXIT WITH (A) = 0 Q1 JSB $LIBX ENABLE INTERRUPT SYSTEM. DEF *+1 DEF *+1 * SSA JMP REJCT REJECT IF QUEUE IS FULL: (A)=-1. * * ENTER PARAMETERS INTO QUEUE ENTRY. * LDA QENT ENTRY ADDRESS (WORD 1) ADA B2 STA TEMP1 ADDR OF WORD 3. * LDB XEQT,I MOVE ID SEGMENT ADDR. STB TEMP1,I ISZ TEMP1 * ADB B6 MOVE PRIORITY. LDA B,I STA TEMP1,I ISZ TEMP1 * ADB B6 MOVE PROGRAM NAME. STB TEMP2 LDB MD3 JSB MOVE * LDA PAV MOVE FUNCTION CODE. LDB A,I STB TEMP1,I ISZ TEMP1 * INA MOVE ADDR OF USER CALL. LDB A,I STB TEMP1,I ISZ TEMP1 * ADA B2 MOVE REPLY BUFR ADDR. LDB A,I STB TEMP1,I ISZ TEMP1 * DLD %TIME GET CURRENT TIME (RTE-II STYLE) DST TEMP1,I INSERT INTO QUEUBE ENTRY, DST TTAGA,I AND INTO PARAMETER BUFFER. * * INITIALIZE PARMB: STREAM, SUB-STREAM, FUNCTION CODE. * LDA FCN DETERMINE STREAM TYPE. CLB CPA D9 JMP SST GETLU STREAM = 0. INB CPA D10 JMP SST DLIST STREAM = 1. ADB B2 SZA,RSS JMP SST PROGL STREAM = 3. INB ADA MD5 SSA JMP SST PTOPC STREAM = 4. INB CPA D158 JMP SST DEXEC STREAM = 5. INB ADA MD158 SSA JMP SST RFA STREAM = 6. INB OPCMD STREAM = 7. SST STB STREM LDA BIT11 IOR 1 STA PARMB,I STORE STREAM TYPE. ISZ PARMB * LDA QENT STA PARMB,I SUB-STREAM (QUEUE ENTRY ADDR). ISZ PARMB * LDA FCN STA PARMB,I FUNCTION CODE. ISZ PARMB * * INITIALIZE DYNAMIC POINTERS. * LDA CALL ADDR OF USER CALL RETURN ADDR. INA STA P.PTR POINTER TO USER CALL PARAMETERS. * LDA B2 STA B.PTR PARMB BYTE POINTER. * LDA UPARM ADDR OF CALLER RETURN PARAMS. STA U.PTR * LDA STREM SZA,RSS CHECK FOR GETLU. JMP PTP2 * CPA B4 CHECK FOR PTOPC. JMP .PTOP * CPA B1 CHECK FOR DLIST. JMP .DLST * CPA B3 CHECK FOR DOWN-LOAD. JMP .DNLD * CPA B7 CHECK FOR REMOTE CONTROL. JMP .RMCN * * STORE SPARE WORD, DATA FLAG = 0. * LDA B202L STA PARMB,I 202*000 ISZ PARMB ALF,ALF STA PARMB,I 000*202 ISZ PARMB CLA STA PARMB,I 000*000 * * PERFORM COMMON PARMB ENTRY STORAGE ACCORDING TO * CLASS OF CALL (RFA, REXEC). * LDA STREM CPA B6 JMP .RFA * .EXEC JSB GET.P FETCH DESTINATION CODE. AND M377 ALF,ALF POSITION. LDB PARMB ADB MD1 IOR B,I t STA B,I STORE IN PARMB. * LDA B202 STORE REQ CODE IN PARMB, JSB STBYT WITH SIGN BIT CLEARED. JSB GET.P ELA,CLE,ERA JSB STWRD * CPA B1 JMP RC1 READ. CPA B2 JMP RC1 WRITE. CPA B3 JMP RC3 I/O CONTROL. CPA D10 JMP RC10 SCHEDULE. CPA D11 JMP RC11 TIME. CPA D12 JMP RC12 EXECUTION TIME. CPA D13 JMP RC13 I/O STATUS. * LDB REPLY ILLEGAL RCODE. ADB B2 LDA AS.RQ STA B,I INB LDA AS.RQ+1 STA B,I JMP REJCT * .RFA LDB P.PTR SET UP POINTER TO CR PARAMETER ADB B4 FOR DCRET,DPURG,DOPEN,DNAME. LDA FCN CPA D151 MOVE DESTINATION PARAM AND JMP .RFA0 FILE NAME TO DCB AREA. INB CPA D158 JMP .RFA0 CPA D152 JMP .RFA0 INB CPA D150 JMP .RFA0 JMP .RFA1 * .RFA0 STB TEMP3 POINTER TO ICR PARAM. JSB MVNAM LDA TEMP3 CHECK IF ICR SPECIFIED. CMA,INA ADA CALL,I ADA MD1 SSA JMP .RFA1 NO. CONTINUE. * LDB TEMP3,I YES. SAVE DESTINATION IN DCB RSS LDB B,I CHASE INDIRECTS. RBL,CLE,SLB,ERB JMP *-2 INB AND CHECK IT. LDB B,I DEST. PARAM. STB TEMP1,I STORE IN DCB (TEMP1 SET BY MVNAM) LDA MD18 SZB JMP MSSNG+1 ILLEGAL. ERROR -18. * .RFA1 LDA FCN DSTAT BYPASS. CPA D162 JMP .RFA2 * JSB STRNG STORE FILE NAME IN PARMB. ISZ P.PTR SKIP OVER IERR PARAM. * .RFA2 LDA FCN ADA MD150 ADA RTBL LDA A,I JMP A,I * RTBL DEF *+1 GO TO UNIQUE PROCESSING FOR DEF .CRET THE PARTICULAR RFA CALLS. DEF .PURG DEF .OPEN DEF .WRIT DEF .READ DEF .POSN DEF .WIND  DEF .CLOS DEF .NAME DEF .CONT DEF .LOCF DEF .APOS DEF .STAT * * UNIQUE PROCESSING FOR INDIVIDUAL REMOTE EXEC CALLS. * RC1 JSB INTGR STORE CONTROL WORD. JSB GET.A JSB RPARM STORE BUFFER ADDR. JSB STLEN STORE BUFFER LENGTH. JMP OPT2 * RC3 JSB INTGR STORE CONTROL WORD. JMP OPT1 * RC10 JSB STRNG STORE PROGRAM NAME. JSB OPTN STORE OPTIONAL PARAMS. JSB OPTN JMP OPT3 * RC11 JMP READY * RC12 JSB STRNG STORE PROG NAME. JSB INTGR IRESL JSB INTGR MTPLE JSB INTGR IOFST: CHECK SIGN. SSA JMP READY INITIAL OFFSET VERSION. JSB INTGR MINS JSB INTGR ISECS JSB INTGR MSECS JMP READY ABSOLUTE START TIME VERSION. * RC13 JSB INTGR STORE CONTROL WORD. JMP READY * * UNIQUE PROCESSING FOR INDIVIDUAL RFA CALLS. * .CRET ISZ P.PTR SKIP OVER FILE NAME. LDA B204 STORE 2-WORD SIZE ARRAY. JSB STBYT JSB GET.A STA TEMP3 ISZ TEMP3 LDA A,I JSB STWRD LDA TEMP3,I JSB STWRD JSB INTGR STORE FILE TYPE. JMP OPT2 * .PURG ISZ P.PTR SKIP OVER FILE NAME. JMP OPT2 * .OPEN ISZ P.PTR SKIP OVER FILE NAME. OPT3 JSB OPTN OPT2 JSB OPTN STORE OPTIONAL PARAMS. OPT1 JSB OPTN JMP READY PARMB COMPLETE. * .CLOS EQU OPT1 * .READ JSB GET.A JSB RPARM RETURN DATA BUFR ADDRESS. JSB STLEN STORE LENGTH. JMP OPT2 * .WRIT EQU .READ * .POSN JSB INTGR STORE RECORD NUMBER. JMP OPT1 * .WIND JMP READY * .NAME ISZ P.PTR JSB STRNG STORE NEW NAME. JMP OPT2 * .CONT JSB INTGR STORE CONTROL WORD. JMP OPT1 * .LOCF JMP READY * .APOS JSB INTGR STORE RECORD NUMBER. JMP OPT2 * .STAT JSB GET.A JSB RPARM RETURN DATA BUFR ADDRESS. LDA D124 STORE LENGTH STA PARMB,I IN DATA-FLAG AND JSB RPARM GIVE IT TO CALLER. JMP READY * * PERFORM PARMB ENTRY STORAGE FOR PROGRAM TO PROGRAM * COMMUNICATION. * .PTOP CLA CLEAR SPARE WORDS. STA PARMB,I ISZ PARMB STA PARMB,I ISZ PARMB LDA FCN FOR POPEN, MOVE PROG NAME CPA B1 TO PCB AREA. JSB MVNAM * LDA MD3 JSB NWRDS MOVE PCB TO PARMB. * ISZ P.PTR SKIP OVER IERR PARAM. LDB P.PTR MOVE P.PTR TO ITAG PARAM. LDA FCN CPA B4 JMP PTP1 ADB B2 STB P.PTR * PTP1 LDA MD10 MOVE ITAG TO PARMB. JSB NWRDS * LDA FCN IF READ/WRITE, PROCESS CPA B1 BUFFER ADDRESS, LENGTH. JMP PTP2 CPA B4 JMP PTP2 * LDA P.PTR BACK UP TO IBUF PARAM. ADA MD3 STA P.PTR JSB GET.A RETURN DATA BUFFER ADDRESS. JSB RPARM JSB GET.P GET BUFFER LENGTH. JSB RPARM RETURN IT TO CALLER. STA PARMB,I STORE IN PARMB. * PTP2 LDA UPARM POINT TO PLEN PARAM. ADA B2 STA U.PTR * PTP3 LDA D35 RETURN PARMB SIZE. JMP RDY GO DISPATCH. * * PERFORM PARMB ENTRY STORAGE FOR SPECIAL DLIST CALL * (USED ONLY BY REMAC). * .DLST ISZ PARMB SKIP OVER SPARE WORD. JSB GET.A RETURN DATA BUFFER ADDRESS. JSB RPARM JSB GET.P GET BUFFER LENGTH. JSB RPARM RETURN IT TO CALLER. STA PARMB,I STORE IN PARMB. * LDA P.PTR IF NOT NEW REQUEST, ADA B4 LEAVE REST OF PARMB ALONE. LDA A,I LDA A,I SZA JMP PTP3 * ISZ PARMB * LDA MD3 STORE FILTER. JSB NWRDS JSB MVWRD SECURITY. JSB MVWRD LABEL. JSB MVWRD TYPE. JSB MVWRD NEW REQ CODE. * JMP PTP3 * * PERFORM PARMB ENTRY STORAGE FOR SPECIAL DOWN-LINK * LOAD CALL (USED ONLY BY APLDR). * .DNLD LDA PARMB BACK UP PARMB POINTER. ADA MD1 STA PARMB JSB MVWRD STORE STATUS WORD. SZA QUIT OF NOT NEW REQUEST. JMP PTP2 ISZ PARMB SKIP SPARE WORDS. ISZ PARMB ISZ P.PTR ISZ P.PTR LDA MD3 JSB NWRDS MOVE FILE NAME. * CLA CLEAR LABEL, SECURITY. LDB MD4 .DNL STA PARMB,I ISZ PARMB INB,SZB JMP .DNL * JMP PTP2 * * PERFORM PARMB ENTRY STORAGE FOR SPECIAL REMOTE * CONTROL OF CENTRAL (USED ONLY BY REMAC). * .RMCN ISZ PARMB SKIP OVER SPARE WORD. CLA CLEAR REQ/REPLY SWITCH. STA PARMB,I ISZ PARMB JSB MVWRD STORE LEN PARAM. LDA MD19 JSB NWRDS MOVE ASCII COMMAND. JMP PTP2 * * PARMB AND QUEUE ENTRY COMPLETE AND * READY FOR DISPATCHING (WELL...ALMOST). * READY CLA STORE TERMINATION BYTE. JSB STBYT * LDA UPARM POINT TO PLEN PARAM. ADA B2 STA U.PTR * LDA B.PTR COMPUTE PARMB SIZE. ADA MD1 CLE,ERA ADA B6 RDY JSB RPARM RETURN PARMB LENGTH. * LDB QENT INB ADDR OF FLAG WORD. LDA B1 STA B,I "PARMB READY" FLAG. * * EXIT TO CALLER VIA NORMAL RETURN. * LDB QENT ADDR OF ASSIGNED QUEUE ENTRY. JSB $LIBX RESTORE TEMPORARY DATA BLOCK DEF TDB AND RETURN TO CALLER. DEC 1 NORMAL RETURN. * * REQUEST REJECTED DUE TO PARAMETER ERRORS. * MSSNG LDA MD10 NOT ENOUGH OR ERROR IN PARAMS. CLE STORE CODE IN A-REG SLOT LDB STREM FOR RFA/DEXEC; IERR SLOT CPB B4 FOR PTOPC. CCE LDB REPLY ADB B2 SEZ INB STA B,I * * EXIT TO CALLER VIA ERROR RETURN. * REJCT LDB QENT (ZERO IF QUEUE FULL) SZB,RSS WAS A QUEUE ENTRY ASSIGNED? JMP REJ 66 NO. (A) = -1. INB YES, SET FLAG = "REPLY RECEIVED" LDA B3 STA B,I LDB QENT * REJ JSB $LIBX RESTORE TEMP DATA BLOCK. DEF TDB DEC 0 ERROR RETURN. HED @QUE - UTILITY SUBROUTINES. * * MOVE FILE/PROGRAM NAME TO DCB/PCB. * MVNAM NOP JSB GET.A GET DCB/PCB ADDR. STA TEMP1 ISZ P.PTR JSB PCHEK JMP MSSNG JSB GET.A GET FILE/PROG NAME ADDR. STA TEMP2 LDB MD3 MOVE THE NAME. JSB MOVE LDA P.PTR RESET PARAM POINTER. ADA MD3 STA P.PTR JMP MVNAM,I * * MOVE N WORDS. (B) = NEGATIVE WORD COUNT. * (TEMP1) = DESTINATION ADDR * (TEMP2) = SOURCE ADDR * MOVE NOP LDA TEMP2,I STA TEMP1,I ISZ TEMP1 ISZ TEMP2 INB,SZB JMP MOVE+1 JMP MOVE,I * * STORE N-WORD PARAMETER INTO PTOPC WORD-ORIENTED * PARMB (NO CONTROL BYTES). * NWRDS NOP (A)= NEG WORD COUNT. STA TEMP1 JSB PCHEK IS PARAM SPECIFIED? JMP MSSNG NO. JSB GET.A PARAMETER ADDRESS. NWD LDB A,I STB PARMB,I INA ISZ PARMB ISZ TEMP1 JMP NWD JMP NWRDS,I * * SUBROUTINE TO MOVE NEXT PARAMETER VALUE * INTO WORD-ORIENTED PARMB. * MVWRD NOP JSB PCHEK JMP MSSNG JSB GET.P STA PARMB,I ISZ PARMB JMP MVWRD,I * * STORE INTEGER PARAM FROM USER CALL INTO PARMB. * INTGR NOP JSB PCHEK IS THE PARAM SPECIFIED? JMP MSSNG NO. LDA B202 YES, STORE CONTROL BYTE. JSB STBYT JSB GET.P FETCH PARAM VALUE. JSB STWRD STORE IN PARMB. JMP INTGR,I (A) HAS THE VALUE. * * STORE OPTIONAL INTEGER PARAM (IF SPECIFIED) FROM * USER CALL INTO PARMB. * OPTN NOP JSB PCHEK IS PARAM SPECIFIED? JMP OPTN,I NO (LEAVE P.PTR ALONE). JSB INTGR YES, STORE IT. JMP OPTN,I (A) HAS THE VALUE. * * STORE 6 CHAR ASCII STRING FROM USER CALL * INTO PARMB. * STRNG NOP JSB PCHEK IS PARAM SPECIFIED? JMP MSSNG NO. * LDA B6 STORE CONTROL BYTE. JSB STBYT LDA MD3 STA TEMP2 WORD COUNTER. JSB GET.A STA TEMP3 STRING START ADDR. * STR LDA TEMP3,I FETCH ASCII CHARACTERS. ALF,ALF JSB STBYT STORE LEFT BYTE. LDA TEMP3,I JSB STBYT STORE RIGHT BYTE. * ISZ TEMP3 BUMP TO NEXT INPUT WORD. ISZ TEMP2 DONE? JMP STR NO. JMP STRNG,I YES, EXIT. * * STORE A-REGISTER CONTENTS INTO NEXT CALLER * RETURN PARAMETER. * RPARM NOP LDB U.PTR,I STA B,I ISZ U.PTR JMP RPARM,I * * STORE USER BUFFER LENGTH IN PARMB, DATA-FLAG, * AND QUEUE ENTRY. * STLEN NOP JSB INTGR STORE IN PARMB. * SZA,RSS JMP MSSNG SPECIFIED, BUT ZERO. SSA,RSS NEGATIVE? JMP STL NO. * CMA,INA YES, MAKE POSITIVE. INA ROUND UP. ERA,CLE,ELA RAR CONVERT TO WORD COUNT. * STL STA PARMB,I STORE IN DATA-FLAG. JSB RPARM PASS BACK TO CALLER. JMP STLEN,I EXIT. * * TEST WHETHER THE USER HAS SPECIFIED * A PARAMETER. * JSB PCHEK * ERROR RETURN (PARAM NOT GIVEN) * NORMAL RETURN * PCHEK NOP LDA P.PTR PARAM ADDR CMA,INA LDB CALL RETURN ADDR ADA B,I ADA MD1 SSA,RSS ISZ PCHEK JMP PCHEK,I * * GET VALUE OF NEXT PARAM IN USER CALL * GET.P NOP JSB GET.A FETCH PARAM ADDR. LDA A,I GET PARAM VALUE. JMP GET.P,I * * GET ADDRESS OF NEXT PARAM IN USER CALL * AND BUMP PARAM POINTER. * GET.A NOP LDA P.PTR,I GET PARAMETER ADDRESS. RSS RESOLVE LDA A,I INDIRECT RAL,CLE,SLA,ERA ADDRESSES. * JMP *-2 ISZ P.PTR BUMP PARAM POINTER. JMP GET.A,I * * STORE WORD (IN A-REG) IN PARMB. * STWRD NOP STA TEMP2 SAVE WORD. ALF,ALF JSB STBYT STORE LEFT BYTE. LDA TEMP2 JSB STBYT STORE RIGHT BYTE. LDA TEMP2 RESTORE WORD. JMP STWRD,I RETURN. * * STORE BYTE IN NEXT BYTE OF PARMB. * STBYT NOP (A) = BYTE RIGHT JUSTIFIED. AND M377 ISOLATE NEW BYTE. STA TEMP1 SAVE. LDB B.PTR FORM WORD ADDR OF PARMB. CLE,ERB (E) = LEFT/RIGHT FLAG. ADB PARMB * LDA B,I INSERT NEW BYTE INTO PARMB. SEZ,RSS ALF,ALF AND M377L IOR TEMP1 SEZ,RSS ALF,ALF STA B,I * ISZ B.PTR BUMP RELATIVE BYTE POINTER. JMP STBYT,I RETURN. * * SUBROUTINE TO FIND END OF LIST * IN THE PARMB REQUEST QUEUE. THIS ROUTINE * IS CALLED WITH THE INTERRUPT SYSTEM DISABLED. * ENTRY: (A) = ADDR OF PTR TO TOP OF LIST. * JSB FIND * RETURN: (A) = ADDR OF LAST-1 ENTRY * (B) = ADDR OF ENTRY * FIND NOP * F1 LDB A,I FETCH NEXT ENTRY. SZB,RSS DESIRED ENTRY? JMP F2 YES. STA TEMP2 NO, KEEP TRACK. STB A JMP F1 LOOP. * F2 LDB A ADDR OF LAST ENTRY. LDA TEMP2 ADDR OF LAST-1 ENTRY. JMP FIND,I EXIT. HED @QUE - STORAGE FOR CONSTANTS. XEQT OCT 1717 ID SEG ADDR OF CURRENT PROGRAM. PAV DEF FCN FWA OF PASSED PARAMS. UPARM DEF DADR B2 OCT 2 B3 OCT 3 B4 OCT 4 B6 OCT 6 B7 OCT 7 B17 OCT 17 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D15 DEC 15 D33 DEC 33 D35 DEC 35 D124 DEC 124 D150 DEC 150 D151 DEC 151 D152 DEC 152 D158 DEC 158 D162 DEC 162 MD1 DEC -1 MD3 DEC -3 MD4 DEC -4 MD5 DEC -5 MD7 DEC -7 MD10 DEC -10 MD18 DEC -18 MD19 DEC -19 MD15=HFB0 DEC -150 MD158 DEC -158 B202 OCT 202 B202L OCT 101000 B204 OCT 204 M377 OCT 377 M377L OCT 177400 BIT11 OCT 4000 AS.RQ ASC 2,RQ %LU NOP LU OF REMOTE COMPUTER. %CPFL NOP "CENTRAL-DOWN" FLAG. %TIME OCT 0,0 CURRENT TIME--RTE-II FORMAT. * * ************************* * * REQUEST QUEUE (INTERRUPTS OFF WHEN LIST PTRS CHANGED). * QSIZE EQU 12 %DORM DEF .DORM ADDR OF HEAD OF DORMANT LIST. %ACT DEF .ACT ADDR OF HEAD OF ACTIVE LIST. .DORM DEF RQ1 HEAD OF DORMANT LIST. .ACT NOP HEAD OF ACTIVE LIST. * * QUEUE ENTRY: * * WORD 1 = LINK WORD * WORD 2 = FLAG WORD: 1 = PARMB READY * 2 = PARMB SENT * 3 = REPLY RECEIVED * WORD 3 = ID SEG ADDR OF USER * WORD 4 = PRIORITY OF USER PROGRAM * WORD 5-7= USER PROGRAM NAME * WORD 8 = FUNCTION CODE * WORD 9 = ADDR OF USER CALL +1 * WORD 10 = ADDR OF REPLY BUFFER * WORD11-12=REQUEST TIME-TAGS. * RQ1 DEF RQ2 QUEUE INITIALIZED WITH ALL BSS QSIZE-1 ENTRIES IN DORMANT LIST. RQ2 DEF RQ3 BSS QSIZE-1 RQ3 DEF RQ4 BSS QSIZE-1 RQ4 DEF RQ5 BSS QSIZE-1 RQ5 DEF RQ6 BSS QSIZE-1 RQ6 DEF RQ7 BSS QSIZE-1 RQ7 OCT 0 BSS QSIZE-1 * ************************* * SIZE EQU * END 4H x 91705-18102 1453 S 0122 DS1/B SCE/5 MODULE: @DISP              H0101 SASMB,R,L,C HED @DISP - 91705-16102 * (C) HEWLETT PACKARD CO. 1976 NAM @DISP,6 91705-16102 REV A 741230 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * @DISP * SOURCE: 91705-18102 * BINARY: 91705-16102 * JIM HARTSELL * JULY 30, 1974 * * PRIVILEDGED SUBROUTINE FOR RTE-C SATELLITE * RESIDENT LIBRARY. @DISP RETURNS THE ADDRESS OF * THE HIGHEST PRIORITY QUEUE ENTRY (OR FIFO) THAT IS * FLAGGED "READY TO SHIP". IF NONE, OR AN ENTRY IS * PENDING A REPLY, @DISP WILL RETURN A ZERO. * * CALLING SEQUENCE: (CALLED BY @REFA, @INTR) * * JSB @DISP * * ON RETURN, (A) = QUEUE ENTRY ADDR, OR ZERO. * ENT @DISP * EXT %ACT,$LIBR,$LIBX * A EQU 0 B EQU 1 * * INITIALIZE TO SEARCH PARMB REQUEST QUEUE. * @DISP NOP JSB $LIBR DISABLE THE INTERRUPT SYSTEM. NOP * LDA MD100 INITIALIZE TO LOWER THAN STA TEMP1 LOWEST POSSIBLE PRIORITY. CLA STA QENT SET FOR "NONE FOUND". LDA %ACT STA TEMP2 TOP OF ACTIVE LIST. * * SEARCH THE QUEUE FOR AN ENTRY THAT'S READY TO SHIP. * LOOP LDA TEMP2,I GET LINK TO NEXT ENTRY. STA TEMP2 SZA,RSS JMP EOL QUIT IF END OF LIST. INA LDB A,I FETCH FLAG WORD. CPB B2 JMP EOLA QUIT IF ENTRY PENDING A REPLY. CPB B1 THIS ONE READY TO SHIP? RSS JMP LOOP NO, GO TO NEXT ENTRY. * * AN ENTRY READY TO SHIP HAS BEEN FOUND. CHECK PRIORITY. * ADA B2 LDB B,I GET PRIORITY. ADB TEMP1 SSB,RSS GREATER THAN CUR   RENT PRIORITY? JMP LOOP NO GO TO NEXT ENTRY. * * THE ENTRY IS HIGHER PRIORITY. UPDATE POINTERS. * LDB A,I UPDATE HIGHEST CURRENT CMB,INB PRIORITY. STB TEMP1 LDA TEMP2 UPDATE ADDRESS OF STA QENT QUEUE ENTRY TO SERVICE. JMP LOOP GO SEARCH REST OF QUEUE. * * END OF LIST OR END OF SEARCH. * EOLA CLA (A) = 0 WHEN ENTRY FOUND THAT JMP EXIT IS PENDING A REPLY. EXIT. * EOL LDA QENT ENTRY FOUND? SZA,RSS JMP EXIT NO, EXIT WITH (A) = 0. INA LDB B2 YES, SET FLAG = "PARMB SENT". STB A,I * LDA QENT ADDR OF QUEUE ENTRY. * EXIT JSB $LIBX ENABLE INTERRUPT SYSTEM. DEF @DISP SPC 5 * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B2 OCT 2 MD100 DEC -100 TEMP1 NOP TEMP2 NOP QENT NOP * SIZE EQU * * END a  y 91705-18103 1613 S 0122 DS1/B SCE/5 MODULE: @DEQ              H0101 SASMB,R,L,C HED @DEQ - 91705-16103 * (C) HEWLETT-PACKARD CO. 1976 NAM @DEQ,6 91705-16103 REV A 760323 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * @DEQ * SOURCE: 91705-18103 * BINARY: 91705-16103 * JIM HARTSELL * AUG. 30, 1974 * * RE-ENTRANT SUBROUTINE FOR RTE-C SATELLITE * RESIDENT LIBRARY TO PROCESS COMPLETION * OF A REMOTE CALL TO THE CENTRAL STATION. * * CALLING SEQUENCE: (CALLED BY @REFA, @INTR) * * JSB @DEQ * OCT QUEUE ENTRY ADDR * OCT ICODE * ERROR RETURN * NORMAL RETURN * * WHERE: * ICODE = 0 USED BY @REFA FOR NORMAL * COMPLETION. IF ERROR RETURN, * THE REPLY BUFFER WILL CONTAIN * AN ASCII ERROR MESSAGE. * * = 1 USED BY @INTR TO * RETURN A QUEUE ENTRY TO THE * DORMANT LIST WHEN A USER HAS * BEEN ABORTED BEFORE HIS * REQUEST HAS COMPLETED SERVICE. * NORMAL RETURN ALWAYS TAKEN. * ENT @DEQ * EXT $LIBR,$LIBX EXT %DORM,%ACT * A EQU 0 B EQU 1 * **************************************** * * BEGIN TEMPORARY DATA BLOCK. * TDB NOP DEC 14 LENGTH OF BLOCK. RETRN NOP RETURN ADDR OF CALLER. TEMP1 NOP TEMPORARY DATA. TEMP2 NOP TEMP3 NOP RTNFG NOP FLAG RETURNED IN E-REG. FCN NOP FUNCTION CODE. REPLY NOP ADDR OF REPLY BUFFER. P.PTR NOP PTR TO USER CALL PARAMS. I.PTR NOP PTR TO REPLY BUFR PARAMS. CALL NOP ADDR OF USER CALL +1. * PASSED PARAMETERS: QENT NOP ADDR OF QUEUE ENTRY. ICODE NOP REQUEST CODE. * * END OF TEMPORARY DATA BLOCK. * **************************************** * * @DEQ NOP ENTRY POINT. * JSB $LIBR SAVE TEMPORARY DATA. DEF TDB * JSB $LIBR NOP * LDA @DEQ,I FETCH CALL PARAMETERS. STA QENT ISZ @DEQ LDA @DEQ,I STA ICODE ISZ @DEQ LDA @DEQ STA RETRN SET RETURN ADDRESS. * JSB $LIBX DEF *+1 DEF *+1 * * CHECK REQUEST CODE. * CLA STA RTNFG LDA ICODE SZA IF NON-ZERO, JMP DEQUE ABORT THE REQUEST. * * NORMAL COMPLETION OF REMOTE REQUEST. * LDB QENT GET FUNCTION CODE. ADB B7 (FROM QUEUE ENTRY) LDA B,I AND B377 MASK. STA FCN SAVE. * INB SAVE ADDR OF USER CALL. LDA B,I STA CALL ADA B2 SET POINTER TO USER CALL STA P.PTR PARAMETERS (IERR OR ICODE). * INB SAVE ADDR OF REPLY BUFFER. LDA B,I STA REPLY * ADA B4 SET POINTER TO REPLY BUFFER STA I.PTR RETURN PARAMETERS. * LDA FCN TEST FUNCTION CODE. CPA D9 JMP .GTLU GETLU. CPA D10 JMP .DLST DLIST. SZA,RSS JMP .DNLD DOWN-LOAD. CPA D200 JMP .RMCN REMOTE CONTROL. ADA MD150 SSA JMP .PTOP ADA MD13 SZA,RSS JMP .EXEC * * REMOTE FILE ACCESS COMPLETION. * LDA REPLY IF A-REG SLOT IS NON-ZERO, ADA B2 STORE THE ERROR CODE IN LDB A,I THE IERR SLOT OF REPLY BUFFER. ADA B2 SZB STB A,I * LDA I.PTR,I PASS IERR TO USER CALL, LDB FCN EXCEPT FOR DSTAT. CPB D162 RSS JSB RWORD ISZ I.PTR * V SSA IF IERR WAS NEGATIVE, DON'T JMP DEQUE PASS OTHER RETURN PARAMS. * LDB FCN CPB D154 REMOTE FILE READ? RSS JMP CMPL1 NO. ISZ P.PTR MOVE PARAM POINTER. ISZ P.PTR LDA I.PTR,I RETURN XMSN LOG. JSB RWORD JMP DEQUE * CMPL1 CPB D160 LOCATE REMOTE RECORD? RSS JMP DEQUE NO. LDB MD7 YES. RETURN N PARAMS. JSB PINTG JMP DEQUE * * REMOTE EXEC CALL COMPLETION. * .EXEC LDA REPLY CHECK A-REG SLOT OF REPLY ADA B2 BUFFER FOR ERROR CODES. LDA A,I * LDB AS.01 CPA MD51 JMP SETER LINE DOWN. CPA MD10 JMP MSSNG MISSING PARAM. * CPA MD1 ERROR FROM CENTRAL? JMP CMPL6 YES * LDB AS.02 CPA MD52 JMP SETER PARITY ERROR. * LDB AS.00 CPA MD103 JMP SETER SOFTWARE BUG! * CPA AS.IO CENTRAL I/O ERROR. JMP BOUNC * CPA AS.SC CENTRAL SCHEDULE ERROR. JMP BOUNC * CPA AS.DS DS ERROR. JMP BOUNC * CPA AS.RQ ILLEGAL REQUEST CODE. JMP BOUNC * LDA P.PTR,I GET REQUEST CODE. JSB INDCK LDA A,I STA TEMP3 ELA,CLE,ERA TAKE OFF SIGN BIT. ISZ P.PTR SKIP PAST IT. * CPA D11 REMOTE TIME CALL? RSS JMP CMPL2 NO. LDA MD5 YES. RETURN TIME ARRAY. JSB PNWDS JMP CMPL3 GO DE-QUE THE ENTRY. * CMPL2 CPA D13 REMOTE I/O STATUS? RSS JMP CMPL3 NO. ISZ P.PTR YES. SKIP OVER CONTROL WORD. LDB MD2 JSB PINTG PASS PARAMETERS. * CMPL3 LDA TEMP3 TAKE NORMAL RETURN IF SIGN BIT SSA SET. ISZ RTNFG JMP DEQUE * CMPL6 LDA REPLY ADA B3 LDA 0,I GET REPLY+3 CPA D11 LENGTH ERROR? RSS YES  JMP MSSNG TREAT AS IO01 LDB AS.03 GIVE DS03 JMP SETER * * PROGRAM TO PROGRAM COMMUNICATION COMPLETION. * .PTOP LDA I.PTR BACK UP REPLY BUFFER POINTER. ADA MD2 STA I.PTR CLA PREPARE FOR NO ERROR. LDB I.PTR,I GET FLAG WORD. SSB INA SET IERR=1 IF REJECTED. ISZ I.PTR LDB I.PTR,I GET ERROR WORD. SZB RETURN 0 OR 1 IF NO ERROR. LDA B HAD ERROR. RETURN NEG CODE. CPA MD11 MAP ERROR CODES. LDA MD44 CPA MD10 LDA MD40 CPA MD51 LDA MD47 CPA MD52 LDA MD48 STA I.PTR,I JSB RWORD ISZ I.PTR ISZ I.PTR * LDA P.PTR RESET POINTER TO PCB AREA. ADA MD2 STA P.PTR * LDA MD3 IF POPEN, MOVE ID INFO TO PCB. LDB FCN CPB B1 JSB PNWDS * ISZ P.PTR SET POINTER TO ITAG PARAM. ISZ P.PTR LDB P.PTR LDA FCN CPA B1 ADJUST REPLY POINTER. JMP *+4 ISZ I.PTR ISZ I.PTR ISZ I.PTR * CPA B4 JMP PTP1 ADB B2 STB P.PTR * PTP1 LDA MD10 PASS TAG FIELD TO USER. JSB PNWDS * JSB DEQ DE-QUE THE REQUEST. LDB REPLY RETURN A = IERR. ADB B3 LDA B,I CLE JMP EXIT * * SPECIAL DLIST CALL COMPLETION. * .DLST LDA P.PTR MOVE PARAM POINTER. ADA B6 STA P.PTR * LSTLD LDA I.PTR BACK UP REPLY BUFFER POINTER. ADA MD2 STA I.PTR * LDB MD3 PASS 3 PARAMS TO USER. JSB PINTG * JMP DEQUE * * SPECIAL DOWN-LOAD CALL COMPLETION. * .GTLU BSS 0 .DNLD LDA P.PTR ADA MD1 STA P.PTR * LDA REPLY CHECK FOR XMSN ERRORS. ADA B3 LDA A,I LDB AS.01 CPA MD51 JMP SETER LINE DOWN. LDB AS.00 CPA MD103 JMP SETER SYSTEM ERROR". * JMP LSTLD * * SPECIAL REMOTE CONTROL COMPLETION. * .RMCN LDA P.PTR BACK UP PARAM POINTER. ADA MD1 STA P.PTR ISZ I.PTR BUMP REPLY BUFFER POINTER. LDA I.PTR,I RETURN MESSAGE LENGTH. JSB RWORD ISZ I.PTR LDA MD19 RETURN ASCII MESSAGE. JSB PNWDS JMP DEQUE * * STORE ASCII ERROR CODES IN REPLY BUFFER. * (FOR REMOTE EXEC AND DOWN-LOAD CALLS) * MSSNG CCE,RSS SETER CLE LDA REPLY REPLY BUFFER ADDRIN B-REG ADA B2 3RD WORD STA ERDST+1 SAVE ADDR FOR ERROR CODE STORE LDA AS.DS "DS". SEZ LDA AS.IO "IO" ERDST DST * SET ASCII ERROR CODE * LDA FCN CHECK FOR DOWN-LOAD. SZA,RSS JMP EMESG * BOUNC LDA P.PTR,I CHECK SIGN BIT OF RCODE. JSB INDCK LDA A,I SSA,RSS IS IT SET? JMP EMESG NO. ABORT THE USER. * DEQUE JSB DEQ DE-QUE THE REQUEST. * * * SET THE A AND B REGISTERS TO THEIR VALUE AFTER * THE REMOTE CALL WAS EXECUTED AT CENTRAL. * LDA RTNFG SET E IF NORMAL DEXEC RETURN ERA WHEN RCODE SIGN BIT SET. LDB REPLY ADB B2 DLD 1,I GET REGS FROM REPLY BUFFER * * EXIT TO CALLER VIA NORMAL RETURN. * EXIT JSB $LIBX RESTORE TEMPORARY DATA BLOCK. DEF TDB DEC 1 * * GENERATE AN ERROR MESSAGE OF THE FORM * * IOXXR PRGNM ADDR * PRGNM ABORTED -OR- PRGNM SUSPEND * * IN THE REPLY BUFFER AND RETURN VIA ERROR EXIT. * EMESG LDA REPLY SET STORE POINTER. STA I.PTR * ADA B2 LDB MD2 JSB PACK STORE "IOXX". * LDA AS.R STORE "R" SUFFIX IF NOT DSP ERROR. LDB REPLY,I CPB AS.DS LDA BLANK STA I.PTR,I ISZ I.PTR * LDA XEQT,I GET ADDR OF PROGRAM NAME ADA D12 LDB MD3 IN ID SEGMENT. JSB PACK STORE "PRGNM". * LDB CALL GE T ADDR OF VIOLATING ADB MD1 USER CALL. LDA I.PTR ADDRESS OF ASCII STORAGE. JSB CONV CONVERT TO ASCII OCTAL & STORE. STA I.PTR SET STORE POINTER. * LDA CRLF STORE CR/LF. STA I.PTR,I ISZ I.PTR * LDA XEQT,I STORE PROGRAM NAME AGAIN ADA D12 LDB MD3 IN SECOND LINE. JSB PACK * LDB REPLY ADDR OF REPLY BUFFER. LDA B,I WORD 1. CPA AS.DS = "DS" ? JMP WORD2 YES. GO CHECK WORD 2. ABRT LDA ABMSG NO. STORE "ABORTED". LDB MD4 JSB PACK JSB DEQ DE-QUE THE REQUEST. CLA JMP EREX * WORD2 INB LDA B,I WORD 2. CPA AS.01 = "01" ? RSS JMP ABRT NO. STORE "ABORTED". LDA SUMSG YES. STORE "SUSPEND". LDB MD4 JSB PACK CLA,INA * EREX JSB $LIBX RESTORE TDB AND TAKE DEF TDB ERROR EXIT. DEC 0 HED @DEQ - UTILITY SUBROUTINES * (C) HEWLETT PACKARD CO. 1976 * SUBROUTINE TO RETURN COMPLETED ACTIVE QUEUE ENTRY TO * THE DORMANT LIST. * DEQ NOP JSB $LIBR DISABLE THE INTERRUPT SYSTEM. NOP * LDA %DORM FIND END OF DORMANT LIST. CLB JSB FINDR * LDA QENT LINK TO RELEASED ENTRY. STA B,I * LDA %ACT FIND PREVIOUS ACTIVE ENTRY. LDB QENT LDB B,I JSB FINDR * LDB QENT LINK IT AROUND RELEASED ENTRY. LDB B,I (IF IT WAS NOT THE LAST ENTRY SZA IN THE ACTIVE LIST) STB A,I CLA CLEAR LINK IN RELEASED ENTRY. LDB QENT STA B,I INB CLEAR FLAG WORD. STA B,I * JSB $LIBX ENABLE INTERRUPT SYSTEM. DEF DEQ RETURN. * * SUBROUTINE TO FIND END OF LIST OR PARTICULAR * ENTRY IN THE PARMB REQUEST QUEUE. THIS ROUTINE * IS CALLED WITH THE INTERRUPT SYSTEM DISABLED. * ENTRY: (A) = ADDR OF PTR TO TO{P OF LIST. * (B) = 0 FOR END OF LIST, OR * = LINK WORD FOR PARTICULAR ENTRY. * JSB FINDR * RETURN: (A) = ADDR OF PREVIOUS ENTRY. * (B) = ADDR OF ENTRY. * FINDR NOP STB TEMP3 CLB STB TEMP2 INITIAL PREVIOUS ENTRY. * F1 LDB A,I FETCH NEXT ENTRY. CPB TEMP3 DESIRED ENTRY? JMP F2 YES. STA TEMP2 NO. KEEP TRACK. STB A JMP F1 * F2 LDB A ADDR OF ENTRY. LDA TEMP2 ADDR OF PREVIOUS ENTRY. JMP FINDR,I RETURN. * * PASS N-WORD PARAM TO USER PROGRAM. * (DOES NOT BUMP P.PTR) * PNWDS NOP STA TEMP1 NEGATIVE WORD COUNT. JSB PCHEK IS PARAM SPECIFIED? JMP PNWDS,I NO. IGNORE THE CALL. LDA P.PTR,I GET PARAM ADDRESS. JSB INDCK TLOOP LDB I.PTR,I MOVE N WORDS. STB A,I ISZ I.PTR INA ISZ TEMP1 JMP TLOOP JMP PNWDS,I * * PASS N PARAMS TO USER PROGRAM. (B) = -N. * PINTG NOP STB TEMP2 PLOOP LDA I.PTR,I JSB RWORD ISZ I.PTR ISZ TEMP2 JMP PLOOP JMP PINTG,I * * PASS A-REG CONTENTS TO USER PARAMETER, IF SPECIFIED. * RWORD NOP STA TEMP1 JSB PCHEK IS PARAM SPECIFIED? JMP RWORD,I NO. IGNORE THE CALL. LDB TEMP1 YES. LDA P.PTR,I JSB INDCK STB A,I LDA TEMP1 ISZ P.PTR JMP RWORD,I * * TEST WHETHER THE USER HAS SPECIFIED A PARAMETER. * JSB PCHEK * ERROR RETURN (PARAM NOT GIVEN) * NORMAL RETURN * PCHEK NOP LDA P.PTR PARAM ADDRESS. CMA,INA ADA CALL,I RETURN ADDRESS. ADA MD1 SSA,RSS ISZ PCHEK JMP PCHEK,I * * RESOLVE INDIRECT PARAMETER ADDRESSES. * INDCK NOP RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I * * MOVE WORDS TO USER REPLY BUFFER. * (A) = SOURCE ADDR, (B) = NEGATIVE WORD* COUNT. * PACK NOP STB TEMP1 CLOOP LDB A,I STB I.PTR,I INA ISZ I.PTR ISZ TEMP1 JMP CLOOP JMP PACK,I * * CONVERT 15-BIT BINARY NUMBER TO 6 CHARACTER * (LEADING BLANK) ASCII FORM OF OCTAL. * CONV NOP STA TEMP1 SAVE STORAGE ADDRESS. RBL POSITION FIRST DIGIT TO BITS 15-13. LDA MD3 STA TEMP2 CONVERT COUNTER = -3. LDA B40 MAKE FIRST CHAR A SPACE. CONV1 ALF,ALF ROTATE CAHR TO UPPER POSITION STA TEMP3 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO BITS 2-0. LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR (60-67). IOR TEMP3 PACK IN UPPER CHAR STA TEMP1,I AND STORE IN STORAGE AREA. ISZ TEMP1 BUMP STORAGE ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW BYTE. LDA B ISOLATE CHAR IN LOW A. AND B7 IOR B60 MAKE AN ASCII CHAR. ISZ TEMP2 BUMP CONVERT COUNTER. JMP CONV1 NOT FINISHED. LDA TEMP1 FINISHED. SET (A) = NEXT STORAGE JMP CONV,I AREA WORD ADDRESS, AND EXIT. HED @DEQ - STORAGE FOR CONSTANTS * (C) HEWLETT PACKARD CO. 1976 XEQT OCT 1717 ID SEG ADDR OF CURRENT PROGRAM. B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B6 OCT 6 B7 OCT 7 B40 OCT 40 B60 OCT 60 B377 OCT 377 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D154 DEC 154 D160 DEC 160 D162 DEC 162 D200 DEC 200 MD1 DEC -1 MD2 DEC -2 MD3 DEC -3 MD4 DEC -4 MD5 DEC -5 MD7 DEC -7 MD10 DEC -10 MD11 DEC -11 MD13 DEC -13 MD19 DEC -19 MD40 DEC -40 MD44 DEC -44 MD47 DEC -47 MD48 DEC -48 MD51 DEC -51 MD52 DEC -52 MD53 DEC -53 MD103 DEC -103 MD150 DEC -150 AS.00 ASC 1,00 AS.01 ASC 1,01 AS.02 ASC 1,02 AS.03 ASC 1,03 AS.IO ASC 1,IO AS.SC ASC 1,SC AS.DS ASC 1,DS AS.R ASC 1,R AS.RQ ASC 1,RQ BLANK ASC 1, CRLF OCT 6412 ABL640MSG DEF ABORT ABORT ASC 4, ABORTED SUMSG DEF SUSP SUSP ASC 4, SUSPEND * SIZE EQU * * END 96 z  91705-18104 1602 S 0122 DS1/B SCE/5 MODULE: @PTPQ              H0101 ]ASMB,R,L,C HED @PTPQ-SLAVE PTOPC MAILBOX SUBR. *(C) HEWLETT-PACKARD CO. 1976* NAM @PTPQ,6 91705-16104 REV A 760106 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * @PTPQ * SOURCE: 91705-18104 REV.A * BINARY: 91705-16104 REV.A * JIM HARTSELL * JULY 30, 1974 * MODIFIED BY: CHW (01-06-76) [DERIVED FROM 91705-18004 REV.C] * * PRIVILEDGED SUBROUTINE FOR RTE-C SATELLITE RESIDENT * LIBRARY. @PTPQ SUPPLIES A MAILBOX FOR A PTOPC PARMB * ARRIVING FROM THE CENTRAL STATION. * @PTPQ ALSO PROVIDES A HOLDING BUFFER FOR PARMB'S * TO BE PASSED FROM @INTR TO @RQPR, PLUS VARIOUS * "SYSTEM COMMON" STORAGE. * * CALLING SEQUENCE: (CALLED BY @INTR) * * (A) = ADDR OF PTOPC PARMB (35 WORDS MOVED) * JSB @PTPQ * ERROR RETURN: MAILBOX FLAG ALREADY UP. * NORMAL RETURN * ENT @PTPQ,%MBOX,%MFLG,%RQUE,%CSID,%CSNM ENT %DLER,DLERR ENT %LIST,%TMOT * EXT $LIBR,$LIBX * B EQU 1 * * CHECK MAILBOX FLAG. * @PTPQ NOP JSB $LIBR DISABLE INTERRUPT SYSTEM. NOP (IN CASE @INTR PRIORITY REDUCED) * STA TEMP SAVE PTOPC PARMB ADDR. * LDA %MFLG SZA JMP EXIT FLAG SET: ERROR EXIT. * * PLACE PTOPC PARMB IN MAILBOX. * LDA DFBOX STA TEMP1 LDB MD35 * LOOP LDA TEMP,I STA TEMP1,I ISZ TEMP ISZ TEMP1 INB,SZB JMP LOOP * LDA %MBOX+2 POPEN CALL? AND B7 CPA B1 RSS JMP STFLG NO. * LDA %MBOX+5 STORE PROG NAME. STA %CSNM+1 LDA %MBOX+6 STA %CSNM+2 LDA %MBOX+7 STA %CSNM+3 * * SEARCH ALL ID SEGMENTS FOR THE SLAVE PROG * NAME AND SET %CSID TO ID SEG ADDR. * LDA KEYWD,I FWA KEYWORD BLOCK. STA TEMP * LOOP1 LDB TEMP,I NEXT ID SEG ADDR. STB %CSID SAVE IT SZB,RSS JMP EXIT QUIT IF DONE, ADB D12 * LDA B,I 1ST 2 CHAR FROM IDSEG. CPA %CSNM+1 INB,RSS MATCH. JMP NEXT MISMATCH. LDA B,I 2ND 2 CHAR FROM IDSEG. CPA %CSNM+2 INB,RSS MATCH. JMP NEXT MISMATCH. LDA B,I 3RD 2 CHAR FROM IDSEG. AND LHALF STA TEMP1 SAVE LEFT HALF. LDA %CSNM+3 AND LHALF CPA TEMP1 JMP STFLG MATCH. * NEXT ISZ TEMP BUMP KEYWORD ADDR. JMP LOOP1 CHECK NEXT ID SEG. * * SET MAILBOX FLAG AND RETURN (NORMAL EXIT). * STFLG CLA,INA STA %MFLG ISZ @PTPQ EXIT JSB $LIBX ENABLE INTERRUPT SYSTEM. DEF @PTPQ SPC 3 * * SUBROUTINE TO RETURN APLDR ERROR NUMBERS. * DLERR NOP JSB $LIBR NOP ISZ DLERR LDA %DLER,I LDB DLERR,I STA B,I ISZ DLERR JSB $LIBX DEF DLERR SPC 3 * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B7 OCT 7 KEYWD OCT 1657 LHALF OCT 177400 TEMP NOP TEMP1 NOP D12 DEC 12 MD35 DEC -35 %TMOT DEC -1500 15 SEC. DEFAULT TIME-OUT. %CSID NOP CURRENT SLAVE ID SEG ADDR. %CSNM DEF *+1 BSS 3 CURRENT SLAVE PROG NAME. %MFLG OCT 0 DFBOX DEF %MBOX %MBOX BSS 35 SLAVE PTOPC MAILBOX. %RQUE DEF *+1 BSS 35 HOLDING BUFFER FOR @RQPR. %DLER DEF *+1 BSS 1 APLDR ERROR NUMBER SLOT. BSS 3 PROG/FILE NAME SLOT. * * * WAIT-LIST FOR PROGRAMS PLACED IN THE OPERATOR SUSPEND * LIST BY @REFA. FIVE-WORD ENTRY PER PROGRAM: * WORD 1 = NEG VALUE INCR BY @CLCK * WORD 2-4 = PROGRAM NAME * WORD 5 = ID S EGMENT ADDRESS. * %LIST DEF *+1 DEC -20 NEG. # ENTRIES. * BSS 100 ALL ZEROES UNL REP 100 OCT 0 LST * SIZE EQU * * END X { 91705-18105 1553 S 0122 DS1/B SCE/5 MODULE: ENABL              H0101 MASMB,R,L,C HED ENABL - ENABLE LISTEN MODE.* (C) HEWLETT-PACKARD CO. 1976 * NAM ENABL,1,5 91705-16105 REV.A 751230 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * ENABL * SOURCE: 91705-18105 REV.A * BINARY: 91705-16105 REV.A * JIM HARTSELL * AUG. 18, 1974 * MODIFIED BY: C.C.H. (12-30-75) [DERIVED FROM: 91705-18005 REV.B] * * * CORE RESIDENT RTE-C SATELLITE START-UP PROGRAM TO FIND * THE LOGICAL UNIT OF THE REMOTE COMPUTER I/O SLOT AND * ENABLE LISTEN MODE ON THE COMMUNICATION LINK. * THIS PROGRAM IS ALSO SCHEDULED BY THE OPERATOR * AND BY @REFA TO RECOVER FROM "LINE DOWN" ERRORS. * ENT ENABL EXT EXEC,%LU,$LIBR,$LIBX,%ACT SUP A EQU 0 B EQU 1 * * FIND LOGICAL UNIT OF CENTRAL STATION. * ENABL LDA B,I SAVE SPECIAL SCHEDULE PARAM. STA SCFLG * ADB B4 LDA B,I SZA JMP QDUMP * CLA,INA INITIALIZE LU COUNTER. STA LU * LDA LUMAX,I GET NEGATIVE NUMBER CMA,INA OF DRT ENTRIES. STA CNTR * LDA DRT,I SET DRT POINTER. STA DRTA * ENBL1 LDA DRTA,I MAKE SURE LU IS ASSIGNED. AND B77 SZA,RSS JMP BUMP * JSB EXEC GET STATUS. DEF *+4 DEF D13 DEF LU DEF CLIO * LDA CLIO ALF,ALF AND B77 ISOLATE EQUIPMENT TYPE. CPA B65 OCTAL 65? JMP ENBL2 YES. "LU" CONTAINS LU. * BUMP ISZ LU BUMP LU COUNTER. ISZ DRTA BUMP DRT POINTER. ISZ CNTR BUMP DRT COUNTER. JMP ENBL1 LOOP IF MORE. * Zj JSB EXEC NO DVR65 IN THE SYSTEM. DEF *+5 DISPLAY ERROR MESSAGE. DEF B2 DEF B1 DEF MSG DEF MSGL JMP EXIT TERMINATE. * * CLEAR LINE AND ENABLE LISTEN MODE. * ENBL2 JSB $LIBR DISABLE INTERRUPTS. NOP LDA LU STA %LU STORE LOGICAL UNIT. JSB $LIBX ENABLE INTERRUPTS. DEF *+1 DEF *+1 * LDA %LU ADA B200 STA CLIO ADA B100 STA ENIO * JSB EXEC CLEAR LINE. DEF *+4 DEF B3 DEF CLIO DEF DFLRN * JSB EXEC ENABLE LISTEN MODE. DEF *+4 DEF B3 DEF ENIO DEF DFLRN * LDA SCFLG CHECK IF SCHEDULED CPA AS.01 BY OPERATOR. JMP EXIT NO. * JSB EXEC DISPLAY COMFORTING MESSAGE. DEF *+5 DEF B2 DEF B1 DEF CMSG DEF D9 * JSB EXEC SCHEDULE @CLCK. DEF *+3 DEF D10 DEF DCLCK * EXIT JSB EXEC TERMINATE. DEF *+2 DEF B6 * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B2 OCT 2 B3 OCT 3 B6 OCT 6 B65 OCT 65 B77 OCT 77 B100 OCT 100 B200 OCT 200 DRT OCT 1652 LUMAX OCT 1653 NO. OF LU'S IN DRT. D9 DEC 9 D12 DEC 12 D13 DEC 13 DRTA NOP CNTR NOP CLIO NOP ENIO NOP LU NOP * * *** DO NOT CHANGE ORDER OF NEXT SIX STATEMENTS *** SPC 1 DFLRN DEF LRN LRN OCT 0,0 DUMMY RN STORAGE--DVR65 COMPATABILITY. DEC -1000 REQUEST & DATA TIMEOUT (SATELLITE ONLY). NOP [#SBIT ADDRESS NOT USED IN SCE/5]. NOP [$CGRN ADDRESS NOT USED IN SCE/5]. OCT -1 PRIMARY: NO YIELD-SIMULTANEOUS REQUESTS. SPC 1 SCFLG NOP DCLCK ASC 3,@CLCK AS.01 ASC 1,01 MSGL DEC 4 MSG ASC 4,NO DVR65 CMSG ASC 9,SATELLITE ENABLED * SKP * BUILT-IN SCE/5 DIAGNOSTIC AID: PERFORM A CORE DUMP OF ALL * ACTIVE ENTRIES IN THE PARMB REQUEST QUEUE AND THEIR * ASSOCIATED PARMB BUFFERS. * * TO DUMP: *ON,ENABL,,,,,LU * * LU = LU OF DISPLAY DEVICE * * IF NO ACTIVE ENTRIES, NOTHING IS DISPLAYED. * QDUMP STA LU STORE OUTPUT LU. LDA %ACT HEAD OF ACTIVE LIST. LINK LDA A,I GET ADDR OF NEXT ENTRY. SZA,RSS JMP EXIT EXIT IF DONE. * STA TEMP2 SAVE ADDRESS OF ENTRY. LDB D12 DISPLAY 12-WORD QUEUE ENTRY. JSB DSPLY LDA TEMP2 DISPLAY IT'S PARMB/REPLY BUFFER. ADA D9 LDA A,I LDB D35 JSB DSPLY * LDA TEMP2 LOOP FOR NEXT QUEUE ENTRY. JMP LINK * * DUMP SPECIFIED CORE. * DSPLY NOP STA ADDR INIT. CORE ADDR POINTER. CMB,INB STB CNTR NEGATIVE WORD COUNTER. LDA MD10 STA LNCNT LINE WORD COUNT. LOOP CLA STA B.PTR RESET BUFFER BYTE POINTER. LDA BLANK START WITH BLANK BYTE. JSB STBYT * LDA MD6 SET FOR 6 CHARACTERS. STA BCNTR * LDB ADDR,I GET NEXT CORE WORD. CLA RRL 1 JMP XXX * LOOP1 BLF,RBR POSITION NEXT 3 BITS. LDA B AND B7 XXX IOR B60 JSB STBYT STORE ASCII BYTE. ISZ BCNTR JMP LOOP1 LOOP TILL DONE. * ISZ ADDR BUMP TO NEXT CORE WORD. LDA BA PRIME FOR BACK ARROW. ISZ CNTR END OF CORE WORDS? JMP EOLCK NO. GO CHECK LINE. * EOD LDA CR STUFF CARRIAGE RETURN. JMP CNTRL * EOLCK ISZ LNCNT END OF LINE (10 CORE WORDS)? JMP CNTRL NO. LDA MD10 YES. RESET WORD COUNTER. STA LNCNT JMP EOD STUFF CARRIAGE RETURN. * CNTRL JSB STBYT STORE CONTROL CHARACTER. * JSB EXEC DISPLAY 4 WORDS. DEF *+5 DEF B2 DEF LU BUFAD DEF ASCBF DEF B4 * LDA CNTR SZA JMP LOOP GO GET NEXT CORE WORD. JMP DSPLY,I EXIT; WHEN DONE. * * STORE A BYTE INTO THE PRINT LINE BUFFER. * STBYT NOP STA TEMP SAVE BYTE. LDA B.PTR BYTE POINTER. CLE,ERA FORM WORD ADDRESS. ADA BUFAD FORM BUFFER ADDRESS. STA TEMP1 SAVE FOR LATER. LDA A,I GET CURRENT WORD FROM BUFFER. SEZ,RSS ALF,ALF POSITION IF NEEDED. AND M377L MASK. IOR TEMP STUFF NEW BYTE. SEZ,RSS ALF,ALF RE-POSITION IF NEEDED. STA TEMP1,I STORE INTO BUFFER. ISZ B.PTR BUMP BYTE POINTER. JMP STBYT,I * SKP * * WORKING STORAGE FOR CORE DUMP SECTION. * B4 OCT 4 B7 OCT 7 B60 OCT 60 D10 DEC 10 D35 DEC 35 MD6 DEC -6 MD10 DEC -10 CR OCT 15 CARRIAGE RETURN. BA OCT 137 BACK ARROW. BLANK OCT 40 M377L OCT 177400 TEMP BSS 1 TEMP1 BSS 1 TEMP2 BSS 1 ADDR EQU CLIO LNCNT EQU ENIO B.PTR EQU SCFLG BCNTR BSS 1 ASCBF BSS 4 SIZE EQU * * END ENABL  | 91705-18106 1606 S 0122 DS1/B SCE/5 MODULE: @INTR              H0101 ^ASMB,R,L,C HED @INTR-COMM. LINE INTERRUPT MODULE.*(C) HEWLETT-PACKARD CO. 1976* NAM @INTR,1,1 91705-16106 REV A 760206 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * @INTR * SOURCE: 91705-18106 REV.A * BINARY: 91705-16106 REV.A * JIM HARTSELL * JULY 30, 1974 * MODIFIED BY: CHW (01-06-76) [DERIVED FROM: 91705-18006 REV.B] * * CORE RESIDENT RTE-C SATELLITE PROGRAM SCHEDULED BY * DVR65 UPON RECEIPT OF AN INTERRUPT CAUSED BY A "TRANSMIT * REQUEST" CALL AT THE CENTRAL STATION. * @INTR READS THE REQUEST AND SCHEDULES THE APPROPRIATE * PROCESSOR. IF THE REQUEST IS A REPLY TO A PARMB, @INTR * DISPATCHES THE NEXT PARMB REQUEST. * ENT @INTR * EXT EXEC,@DEQ,@DISP,%LU,$LIBR,$LIBX EXT @PTPQ,%RQUE,%CSID,%CSNM,%MFLG EXT %LIST,$WORK,$LINK * A EQU 0 B EQU 1 * * READ THE REQUEST BUFFER. * @INTR JSB EXEC RECEIVE REQUEST ONLY. DEF *+7 DEF B1 DEF %LU DEF IRBUF DEF IRBFL DEF DUMMY DEF DUMMY * * CHECK FOR TRANSMISSION ERRORS. * SLA,RSS * SKP * THE REQUEST ARRIVING FROM CENTRAL COULD NOT BE READ. * CASE 1: REPLY TO A REMOTE REQUEST: * USER WILL COME OUT OF OP SUSP LIST, WILL * GET A "DS51 SUSPEND", AND CAN TRY AGAIN. * CASE 2: REQUEST FROM CENTRAL: * CENTRAL WILL DETECT ERROR AND RE-TRY. * JMP EXIT IGNORE REQUEST. STB EQT12 SAVE EQT12 STATUS * * CHECK FOR REPLY OR PARMB. * LDA IRBUF CHECK FOR REPLY BUFFR. RAL (BIT 14 SET IF REPLY) SSA JMP REPLY REPLY. DON'T CARE WHAT TYPE. * RAR PARMB. DETERMINE TYPE. AND B377 ISOLATE THE STREAM TYPE, STA IRBUF AND RESTORE IT. CPA B4 JMP PTOPC PTOPC. * * MOVE PARMB TO HOLDING BUFFER FOR @RQPR. * JSB $LIBR DISABLE INTERRUPTS. NOP LDA RBUFD ADDR OF PARMB. STA TEMP1 LDA %RQUE ADDR OF HOLDING BUFFER. STA TEMP2 LDB MD35 LOOP LDA TEMP1,I MOVE PARMB. STA TEMP2,I ISZ TEMP1 ISZ TEMP2 INB,SZB JMP LOOP JSB $LIBX ENABLE INTERRUPTS. DEF *+1 DEF *+1 * JSB EXEC SCHEDULE @RQPR PROCESSOR FOR DEF *+3 DEXEC/REMOTE CONTROL/FORCE LOAD. DEF SD10 WITHOUT WAIT. DEF D@RQP * * IF PROCESSOR DOES NOT EXIST, OR ALREADY SCHEDULED, * THE REQUEST WILL BE REJECTED. * NOP IGNORE ERROR RETURN. CLB PRIME IERR TO 0. CPA AS.SC JMP REJR SZA,RSS JMP EXIT * REJR LDA AS.RQ SEND BACK "RQ" ERROR. STA IRBUF+5 LDA AS.SP STA IRBUF+6 JMP SNREJ * * REQUEST IS A REPLY TO A PARMB. * SET QUEUE ENTRY FLAG WORD = "REPLY RECEIVED". * REPLY LDB IRBUF+1 CHECK IF A REPLY IS EXPECTED. STB QENT INB LDA B,I CPA B2 RSS JMP DISP NO. IGNORE AND DISPATCH NEXT. * ADB D9 POINT TO THE TIME-TAG WORDS. DLD B,I GET THE TIME-TAGS. CPA IRBUF+33 IF THE FIRST TAG COMPARES, RSS SKIP TO CHECK SECOND ELSE, JMP DISP NOT THE EXPECTED REPLY--IGNORE! CPB IRBUF+34 IF THE SECOND TAG COMPARES, RSS THEN THIS IS OUR REPLY ELSE, JMP DISP NOT THE EXPECTED REPLY--IGNORE! * * JSB $LIBR DISABLE INTERRUPT SYSTEM. NOP * LDA QENT QUEUE ENTRY ADDRESS. INA LDB B3 STB A,I SET FLAG WORD. * JSB $LIBX ENABLE INTERRUPT SYYSTEM. DEF *+1 DEF *+1 * * FIND STATUS OF CORRESPONDING PROGRAM. * * NOTE: SUBROUTINE "ALIVE" DISABLES THE INTERRUPT * SYSTEM WHILE CHECKING STATUS. * JSB ALIVE JMP ABORT USER DEAD. JMP MOVE USER OP SUSPENDED. * SKP * USER PROGAM HAS BEEN ABORTED. CANCEL THE * REQUEST FROM THE PARMB REQUEST QUEUE, AND * DISPATCH THE NEXT PARMB. * ABORT JSB @DEQ QENT NOP B1 OCT 1 * NOP ERROR = NORMAL RETURN. JMP DISP * * USER PROGRAM IS SCHEDULED AND IN CORE. * MOVE REPLY TO USER'S REPLY BUFFER AREA. * MOVE JSB $LIBR NOP LDA RBUFD SET SOURCE POINTER. STA TEMP2 * LDA IRBUF+1 SET DESTINATION POINTER. ADA D9 LDA A,I STA TEMP1 * LDB MD35 SET WORD COUNTER. * MLOOP LDA TEMP2,I MOVE. STA TEMP1,I ISZ TEMP2 ISZ TEMP1 INB,SZB JMP MLOOP * JSB $LIBX DEF *+1 DEF *+1 * JSB CLOCK SET UP FOR RESTART. JMP ENQUE * * * SEND A STOP IF LINE IS IN "DATA PENDING" CONDITION * DISP LDA EQT12 ALF,ALF BIT 8 = DATA PENDING FLAG SLA,RSS JMP ENQUE JUMP IF NOT PENDING DATA XFER * SEND A STOP JSB EXEC DEF *+3 DEF B3 DEF %LU * * NOW THAT A REPLY HAS BEEN RECEIVED, THE NEXT PARMB * CAN NOW BE TRANSMITTED. CHECK IF ONE IS WAITING. * ENQUE JSB @DISP SZA,RSS (A)= QUE ENTRY ADDR, OR ZERO. JMP EXIT NONE WAITING. TERMINATE. * STA QENT A PARMB WAITING. CHECK STATUS. JSB ALIVE JMP ABORT USER DEAD. JSB CLOCK SET UP FOR RESTART. * EXIT JSB EXEC TERMINATE. DEF *+2 DEF B6 * SKP * * SUBROUTINE TO TEST WHETHER USER PROGRAM IS IN OPERATOR SUSPEND LIST. * * CALLING SEQUENCE: * (QENT) = ADDR OF QUEUE ENTRY. * JSB ALIVE * RETURN 1: USER NOT OP SUSPENDED (DEAD). * RETURN 2: USER IN OPERATOR SUSPEND LIST. * ALIVE NOP JSB $LIBR DISABLE INTERRUPT SYSTEM. NOP * LDA QENT GET ADDR OF PROGRAM NAME ADA B2 IN USER'S ID SEGMENT. LDB A,I ADB D12 ADA B2 GET ADDR OF PROGRAM NAME STA NAME * JSB CMPAR COMPARE THE NAMES. JMP DEAD MISMATCH. * LDA TEMP2,I MATCH. GET USER STATUS. AND B17 CPA B6 * ISZ ALIVE PROGRAM IS OP SUSPENDED. DEAD JSB $LIBX PROGRAM IS DEAD. DEF ALIVE * * FIND ENTRY IN WAIT-LIST, SET CLOCK TIME FOR * IMMEDIATE EXECUTION, AND SCHEDULE @CLCK. * CLOCK NOP JSB $LIBR NOP * LDA %LIST ADDR OF WAIT-LIST. LDB A,I STB TEMP NEGATIVE # ENTRIES. ADA B2 STA TEMP2 ADDR OF 1ST PROGRAM NAME. * SKP CLCK1 LDA MD3 STA TEMP3 COUNTER FOR COMPARE. LDA QENT ADA B4 STA TEMP1 ADDR OF PROG NAME IN QUE ENT. LDB TEMP2 ADDR OF PROG NAME IN WAIT-LIST. * CLCK2 LDA TEMP1,I COMPARE NAMES. CPA B,I INB,RSS JMP MISS MISMATCH. ISZ TEMP1 ISZ TEMP3 JMP CLCK2 * LDB TEMP2 MATCH. ADB MD1 CCA SET CLOCK TIME TO -1. STA B,I CLCK3 JSB $LIBX DEF CLOCK * MISS LDA TEMP2 GO TO NEXT ENTRY IN WAIT-LIST. ADA B5 STA TEMP2 ISZ TEMP JMP CLCK1 JMP CLCK3 IGNORE IF NOT FOUND. * * MASTER PTOPC PARMB RECEIVED. * PTOPC LDA RBUFD GET ADDR OF PROG NAME. ADA B5 STA NAME * LDA IRBUF+2 GET FUNCTION CODE. AND B7 CPA B1 RSS JMP PSTAT PREAD/PWRIT/PCONT. * * POPEN PARMB. SCHEDULE THE SLAVE PROGRAM. * LDB %CSID ANY SLAVE PROG ACTIVE? SZB,RSS JMP PSCHD NO. * ADB D15 YES. ALIVE? LDA B,I STATUS WORD OF ID SEG. AND B17  SZA JMP SAME CURRENTLY ALIVE. * SKP JSB $LIBR PREVIOUS SLAVE PROG WAS ABORTED: NOP CLEAR MAILBOX FLAG. CLA STA %MFLG JSB $LIBX DEF *+1 DEF PSCHD GO SCHEDULE NEW SLAVE. * SAME LDA RBUFD CHECK IF POPEN IS FOR CURRENTLY ADA B5 RUNNING SLAVE PROGRAM. LDB %CSNM JSB CMPAR COMPARE NAMES JMP FLGUP MISMATCH. ERROR. JMP PTPQ MATCH. * PSCHD JSB EXEC ATTEMPT TO SCHEDULE. DEF *+3 DEF SD10 WITHOUT WAIT. NAME NOP NAME OF SLAVE PROGRAM * NOP IGNORE ERROR RETURN. LDB MD41 CPA AS.SC CHECK SCHEDULE STATUS. JMP REJRQ NO SUCH PROGRAM. JMP PTPQ NOW (OR WAS) SCHEDULED. * * PREAD/PWRIT/PCONT:PCLOS: * FIND CURRENT STATUS OF SLAVE PROGRAM. * PSTAT LDB IRBUF+5 GET ADDR OF ID SEGMENT ADB D12 STB NAME ADDR OF PROG NAME. ADB B3 LDA B,I STATUS WORD. AND B17 LDB MD45 SZA,RSS JMP REJRQ PROGRAM IS DEAD. * * PLACE PTOPC PARMB IN MAILBOX. * PTPQ LDA RBUFD ADDR OF PARMB. JSB @PTPQ JMP FLGUP * SKP * RESTART USER IF IN OPERATOR SUSPEND LIST. * LDA %CSID GET ID SEGMENT ADDRESS. ADA D15 LDA A,I AND B17 CPA B6 JMP *+2 JMP EXIT NOT OP SUSPENDED. * JSB $LIBR RESTART THE PROGRAM. NOP LDB $DWRK ADDR OF "WORK" IN SCHEDULER. SSB,RSS JMP *+3 ELB,CLE,ERB LDB B,I * LDA %CSID SET-UP FOR $LINK CALL: STA B,I "WORK" INB STA B,I "WLINK" INB ADA B6 STA B,I "WPRIO". * ADA D9 SET STATUS WORD IN CLB,INB ID SEG = SCHEDULED. STB A,I * JSB $LINK REMOVE USER FROM B6 OCT 6 OP SUSP LIST AND OCT 1 ADD TO "$"SCHEDULE LIST. * JSB $LIBX TERMINATE. DEF *+1 DEF EXIT * FLGUP LDB MD42 * SKP * SEND REJECT REPLY BACK TO CENTRAL. USE IRBUF. * REJRQ STB IRBUF+3 STORE ERROR CODE. LDA IRBUF+2 AND B377 IOR RJBTS STA IRBUF+2 STORE FLAG WORD. * SNREJ LDA IRBUF SET REPLY BIT, IOR RPLFL AND FRIENDLY-SATELLITE BIT(#11). STA IRBUF * JSB EXEC SEND REPLY. DEF *+7 DEF B2 DEF %LU DEF IRBUF DEF IRBFL DEF DUMMY DEF DUMMY * JMP EXIT SPC 3 * * COMPARE 3 WORDS CMPAR NOP DST TEMP1 LDB MD3 LOOP1 LDA TEMP1,I CPA TEMP2,I MATCH? RSS YES JMP CMPAR,I NO, RETURN+1 ISZ TEMP1 ISZ TEMP2 INB,SZB JMP LOOP1 ITERATE ISZ CMPAR JMP CMPAR,I RETURN+2 SKP * * CONSTANTS AND WORKING STORAGE. * B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B7 OCT 7 B17 OCT 17 B377 OCT 377 D9 DEC 9 EQT12 NOP DUMMY NOP SD10 OCT 100012 D12 DEC 12 D15 DEC 15 MD1 DEC -1 MD3 DEC -3 MD35 DEC -35 MD41 DEC -41 MD42 DEC -42 MD45 DEC -45 TEMP NOP TEMP1 DEC 0,0 TEMP2 EQU TEMP1+1 TEMP3 NOP $DWRK DEF $WORK RPLFL OCT 44000 RJBTS OCT 100000 AS.RQ ASC 1,RQ AS.SP ASC 1, D@RQP ASC 3,@RQPR AS.SC ASC 1,SC RBUFD DEF IRBUF IRBUF BSS 35 IRBFL DEC 35 * SIZE EQU * * END @INTR $ }  91705-18107 1614 S 0122 DS1/B SCE/5 MODULE: @RQPR              H0101 aASMB,R,L,C HED @RQPR-PROCESS CENTRAL'S REQUESTS. *(C) HEWLETT-PACKARD CO. 1976* NAM @RQPR,1,2 91705-16107 REV.A 760401 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * @RQPR * SOURCE: 91705-18107 REV.A * BINARY: 91705-16107 REV.A * JIM HARTSELL * JULY 30, 1974 * MODIFIED BY: CHW (01-06-76) [DERIVED FROM: 91705-18007 REV.B] * * CORE RESIDENT RTE-C SATELLITE PROGRAM SCHEDULED BY * @INTR UPON RECEIPT OF A REQUEST FROM THE CENTRAL STATION. * WHEN SCHEDULED, (B) = ADDR OF REQUEST BUFFER ADDRESS. * ENT @RQPR * EXT EXEC,$LIBR,$LIBX,$MESS,$TYPE EXT %LU,%RQUE,%DLER EXT %ACT SUP A EQU 0 B EQU 1 * * MOVE PARAM VALUES TO INTERNAL BUFFER. * @RQPR LDA %RQUE GET ADDR OF PARMB. STA RQADR SAVE IT. ADA B5 LDB DV0 * JSB MOVE MOVE PARAM VALUES. MD11 DEC -11 * LDA RQADR,I CHECK FOR REMOTE CONTROL CPA B7 OF SATELLITE BY JMP RMCON CENTRAL OPERATOR. * CPA D8 JMP FRCLD FORCED-LOAD. * CPA B5 JMP DEXEC DISTRIBUTED EXEC. * LDA AS.IL RETURN "ILRQ". LDB AS.RQ JMP SAVE * FIND TYPE OF EXEC CALL AND GO EXECUTE IT. * DEXEC LDA V1 REQUEST CODE. IOR SIGN SET SIGN BIT. STA V1 USE FOR LOCAL EXEC CALLS. ELA,CLE,ERA LDB B2 CPA B1 JMP RD/WR READ FROM I/O DEVICE. LDB B1 CPA B2 JMP RD/WR WRITE ON I/O DEVICE. CPA B3 JMP CNTRL I/O CONTROL. CPA D10 JMP SCHED SCHEDULE PROGRAM. CPA D1#1 JMP TIME TIME OF DAY. CPA D12 JMP XTIME EXECUTION TIME. CPA D13 JMP STAT I/O STATUS. * * ILLEGAL REQUEST CODE. * LDA AS.RQ LDB AS.SP JMP SAVE * * READ OR WRITE SATELLITE I/O DEVICE. * RD/WR ADB SIGN ADD NO-ABORT FLAG TO REQUEST CODE. STB IRW SET FOR SEND/RECV DATA. LDB V3 CHECK LENGTH <512 WORDS. SZB,RSS IF DATA LENGTH =0, JMP RDWRT IGNORE THE COMM. LINE DATA CALL. ADB MD513 SSB,RSS JMP ERLEN ADB D1537 SSB JMP ERLEN CPA B2 JSB DATA WRITE. GET DATA FROM CENTRAL. * RDWRT JSB EXEC READ/WRITE CALL. DEF *+7 DEF V1 RCODE. DEF V2 CONTROL WORD. DEF BUF BUFFER. DEF V3 BUFFR LENGTH. DEF V4 OPT. PARM 1. DEF V5 OPT. PARM 2. NOP STA REPLY+5 SAVE A,B IN REPLY. STB REPLY+6 * LDA V1 ELA,CLE,ERA CPA B1 JSB DATA READ. SEND DATA TO CENTRAL. * JMP REP GO SEND REPLY. * * PERFORM I/O CONTROL ON SATELLITE DEVICE. * CNTRL JSB EXEC DEF *+4 DEF V1 RCODE. DEF V2 CONTROL WORD. DEF V3 OPT. PARM. * NOP JMP SAVE * * SCHEDULE A SATELLITE PROGRAM. * SCHED LDA D10 FORCE "WITHOUT WAIT". IOR SIGN STA V1 * JSB EXEC DEF *+8 DEF V1 RCODE. DEF V2 PROGRAM NAME. DEF V5 OPT. PARAMS. DEF V6 DEF V7 DEF V8 DEF V9 * NOP JMP SAVE * * GET SATELLITE REAL-TIME. * TIME JSB EXEC DEF *+3 DEF V1 RCODE. DEF REPLY+7 TIME ARRAY. * NOP JMP SAVE * * SCHEDULE SATELLITE PROGRAM AT SPECIFIED TIME. * XTIME LDA V2 IF PROG NAME = 0, SZA JMP XTIM1 LDA AS.SC "SC02" ERROR. LDB AS.0޴2 JMP SAVE * XTIM1 LDA V7 FIND WHICH VERSION. SSA,RSS JMP ABS * JSB EXEC INITIAL OFFSET VERSION. DEF *+6 DEF V1 RCODE. DEF V2 PROGRAM NAME. DEF V5 RESOLUTION CODE. DEF V6 EXECUTION MULTIPLE. DEF V7 INITIAL OFFSET. * NOP JMP SAVE * ABS JSB EXEC ABSOLUTE START TIME VERSION. DEF *+9 DEF V1 RCODE. DEF V2 PROGRAM NAME. DEF V5 RESOLUTION CODE. DEF V6 EXECUTION MULTIPLE. DEF V7 HOURS. DEF V8 MINUTES. DEF V9 SECONDS. DEF V10 TENS OF MILLISECONDS. * NOP JMP SAVE * * GET I/O STATUS OF SATELLITE I/O DEVICE. * STAT JSB EXEC DEF *+5 DEF V1 RCODE. DEF V2 CONTROL WORD. DEF REPLY+7 STATUS WORD 1. DEF REPLY+8 STATUS WORD 2. * NOP JMP SAVE * ERLEN LDA AS.DS ILLEGAL LENGTH. LDB AS.03 * * SAVE A,B REGISTERS IN REPLY BUFFER. * SAVE STA REPLY+5 STB REPLY+6 * * COPY HEADER WORDS FROM PARMB TO REPLY. * REP LDA RQADR PARMB IS IN @PTPQ MODULE. LDB DFREP JSB MOVE DEC -5 * * SEND REPLY TO CENTRAL STATION. * SNREP LDA REPLY SET REPLY AND IOR RPLFL FRIENDLY BITS(#14,#11). STA REPLY LDA MD11 INITIALIZE THE STA RTRY RETRY COUNTER. LDB RQADR GET ADDRESS OF THE REQUEST BUFFER. ADB D33 POINT TO THE TIME-TAG WORD. DLD B,I GET THE ORIGINAL TIME-TAGS, DST REPLY+33 AND ADD THEM TO THE REPLY. * SEND JSB EXEC TRANSMIT REQUEST ONLY. DEF *+7 DEF IWRT WRITE--NO ABORT. DEF %LU DEF REPLY DEF D35 DEF DUMMY DEF DUMMY JMP DOWN REPORT THE ERROR--IF ANY. * DST XSTAT (DEBUG AID ONLY) SLA,RAR JMP REXIT NOҔ ERRORS. * SWP AND B40 ISOLATE EQT12 BIT#5 (REMOTE BUSY). CLE,ERB MOVE BUSY-REJECT BIT(EQT5 #1) TO . SEZ,SZA,RSS BUSY-REJECT/REMOTE BUSY OR BOTH? JMP DOWN NEITHER--DRIVER ERROR! SEZ,RSS WAS THE REMOTE SYSTEM BUSY? JMP BZWT YES. GO TO WAIT ONE SECOND. LDB MD8 80 MSEC DELAY IF DRIVER BUSY SZA,RSS WAS IT SIMULTANEOUS REQUEST? JSB WAIT NO, DRIVER BUSY, WAIT AWHILE JMP SEND RETRY * BZWT ISZ RTRY O.K. TO RE-TRY? RSS YES. DO SO VIA TIME LIST. JMP DOWN NO. REPORT THE ERROR! LDB MD100 1 SEC DELAY JSB WAIT JMP SEND TIME'S UP--TRY AGAIN. * SKP * DOWN JSB EXEC DEF *+5 DEF B2 DEF B1 DEF DSMES DEF DSLEN * * EXIT. * REXIT JSB EXEC TERMINATE. DEF *+2 DEF B6 * DSMES ASC 11,DS01 RQPR: REPLY ERROR * * THE CENTRAL OPERATOR HAS SENT AN ASCII RTE-C COMMAND. * PROCESS THE COMMAND THRU RTE-C AS IF IT WAS ENTERED * FROM THE LOCAL OPERATOR CONSOLE, AND SEND ANY REPLY * MESSAGES BACK TO CENTRAL. * RMCON BSS 0 IF SATELLITE OPERATOR IS LDB OPFLG,I CURRENTLY ENTERING A COMMAND, SZB,RSS REJECT CENTRAL OPERATOR. JMP CLJOB * LDA BZYMS LDB DFREP ADB B6 JSB MOVE DEC -6 LDA D12 JMP STLEN * CLJOB JSB JOB PROCESS COMMAND. STLEN STA REPLY+5 STORE +CHAR COUNT IN REPLY. CLA,INA STA REPLY+4 SET REPLY SWITCH. LDA RQADR RETURN SUB-STREAM. INA LDA A,I STA REPLY+1 LDA B7 STORE STREAM. STA REPLY * JMP SNREP GO SEND REPLY. * SKP * CENTRAL HAS SENT A FORCED-LOAD OR PLIST REQUEST. * SCHEDULE APLDR WITH WAIT, THEN SEND REPLY. * FRCLD LDA D9 IOR SIGN STA V5 * JSB EXEC SCHEDULE APLDR WITH WAIT. DEF *+8 DEgF V5 DEF APLDR DEF V0 SCHED PARAMS. DEF V1 DEF V2 DEF V3 DEF V4 * NOP STA REPLY+5 SAVE A,B IN REPLY. STB REPLY+6 * SZA,RSS IF APLDR NOT DORMANT, JMP STATS LDA MD70 SEND BUSY ERROR CODE. STA REPLY+7 JMP SCAN * STATS LDA %DLER STORE APLDR ERROR NUMBER LDB DFREP IN REPLY BUFFER. ADB B7 JSB MOVE DEC -4 * * DON'T SEND REPLY IF A PARMB IS PENDING. * SCAN LDA %ACT HEAD OF ACTIVE LIST. LOOP2 LDA A,I ADDR OF NEXT ENTRY. SZA,RSS JMP REP NO PARMB PENDING. * STA V10 SAVE ENTRY ADDRESS. INA LDA A,I FLAG WORD. CPA B2 JMP DELY ENTRY IS PENDING. LDA V10 NOT PENDING. JMP LOOP2 GO TO NEXT ENTRY. * DELY LDB MD1 SUSPEND FOR SHORT TIME. JSB WAIT JMP SCAN GO LOOK AGAIN. * WAIT NOP STB OFSET JSB EXEC DEF *+6 DEF D12 DEF B0 DEF B1 DEF B0 DEF OFSET * CPB OFSET JMP WAIT,I JMP @RQPR * OFSET NOP * SKP * * SUBR TO PASS COMMAND TO RTE-C AS IF ENTERED LOCALLY. * JOB NOP JSB $LIBR DISABLE INTERRUPTS. NOP LDA JOB LDB HERE SZB,RSS JMP THERE CLA JSB $LIBX DEF *+1 DEF EXIT THERE STA RTN LDB 1735B SZB JMP EXIT1 STA HERE STA JOB LDA RQADR ADA B6 STA PNTR1 LDA TYPE SSA,RSS JMP *+3 ELA,CLE,ERA LDA A,I ADA MD22 STA PNTR2 LDA V0 CMA,INA ARS STA CNTR JSB XFER LDB V0 JSB $MESS SZA,RSS JMP EXIT LDB A,I STB SAVE1 ADB MD1 BRS STB CNTR INA STA PNTR1 LDA DFREP ADA B6 STA PNTR2 JSB XFER LDA SAVE1 CMA,INA EXIT CLB STB HERE EXIT1 JSB $LIBX DEF RTN XFER NOP LOOP1 LDA PNTR1,I STA PNTR2,I ISZ PNTR1 ISZ PNTR2 ISZ CNTR JMP LOOP1 JMP XFER,I RTN NOP HERE NOP TYPE DEF $TYPE * * SUBROUTINE TO SEND OR RECEIVE DATA. * DATA NOP LDA RQADR PARMB ADDRESS ADA D33 POINT TO TIME-TAGS STA TITAG SAVE THEIR ADDRESS INA ADDRESS FOR THE STA TITAG+1 DATA ONLY DRIVER CALL LDA B300 GET DRIVER MODE-BITS FOR DATA-ONLY. IOR %LU INCLUDE THE LOGICAL UNIT NUMBER. STA CONWD SAVE THE CONFIGURED CONTROL WORD. LDA V3 GET BUFFER LENGTH. STA XBUFL SSA,RSS JMP DATA1 CMA,INA NEGATIVE. MAKE POSITIVE INA WORD COUNT. ARS STA XBUFL * DATA1 JSB EXEC DEF *+7 DEF IRW READ WRITE--NO ABORT. DEF CONWD DEF BUF DEF XBUFL TITAG NOP NOP JMP DATER DRIVER ERROR--INFORM CENTRAL. * SLA JMP DATA,I RETURN IF NO ERRORS. * DATER LDA AS.DS ERROR. RETURN "DS02". LDB AS.02 JMP SAVE * * SUBROUTINE TO MOVE N WORDS. * MOVE NOP DST BUF LDB MOVE,I GET COUNT LOOP LDA BUF,I STA BUF+1,I ISZ BUF ISZ BUF+1 INB,SZB JMP LOOP ISZ MOVE JMP MOVE,I SKP * * CONSTANTS AND WORKING STORAGE. * DV0 DEF V0 V0 NOP # PARAMS IN USER CALL. V1 NOP REQUEST CODE. V2 NOP V3 NOP V4 NOP V5 NOP V6 NOP V7 NOP V8 NOP V9 NOP V10 NOP * B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B5 OCT 5 B6 OCT 6 B7 OCT 7 B40 OCT 40 B300 OCT 300 IWRT OCT 100002 CONWD NOP D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 DSLEN EQU D11 D12 DEC 12 D13 DEC 13 D33 DEC 33 D35 DEC 4*($35 D1537 DEC 1537 DUMMY NOP MD1 DEC -1 MD8 DEC -8 MD22 DEC -22 MD70 DEC -70 MD100 DEC -100 MD513 DEC -513 OPFLG OCT 1735 AS.SC ASC 1,SC AS.DS ASC 1,DS AS.02 ASC 1,02 AS.03 ASC 1,03 AS.IL ASC 1,IL AS.RQ ASC 1,RQ AS.SP ASC 1, APLDR ASC 3,APLDR BZYMS DEF *+1 ASC 6,REMOTE BUSY RQADR NOP IRW NOP XBUFL NOP RPLFL OCT 44000 SIGN OCT 100000 RTRY NOP XSTAT OCT 0,0 DFREP DEF REPLY REPLY BSS 35 BUF BSS 512 PNTR1 EQU BUF PNTR2 EQU BUF+1 CNTR EQU BUF+2 SAVE1 EQU BUF+3 * SIZE EQU * * END @RQPR #* ~  91705-18108 1609 S 0222 DS1/B SCE/5 MODULE: APLDR              H0102 YASMB,R,L,C HED APLDR 91705-16108 REV A * (C) HEWLETT-PACKARD CO. 1976 NAM APLDR,1,60 91705-16108 REV A 760224 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * APLDR * SOURCE: 91705-18108 REV.A * BINARY: 91705-16108 REV A * E. WONG, J. HARTSELL * JULY 30, 1974 * * MODIFIED BY: JEAN-PIERRE BAUDOUIN * DATE MODIFIED: DEC 1975 * * * RTE-C APLDR FOR SATELLITE OPERATION * ENT APLDR EXT EXEC,$LIBR,$LIBX,$PVCN EXT DEXEC,%LU,$XSIO,$LIST,$XEQ EXT %DNLD,%DLER,%PRMB SUP * A EQU 0 B EQU 1 KEYWD EQU 1657B BPA1 EQU 1742B BPA2 EQU 1743B RTORG EQU 1746B RTCOM EQU 1747B AVMEM EQU 1751B BKLWA EQU 1777B SUP * * THIS VERSION OF APLDR WILL DOWN-LINK LOAD A PROGRAM * FILE FROM CENTRAL IF THE LO COMMAND CONTAINS A FILE/PROG * NAME AND LU = 0. IF SCHEDULED FROM CENTRAL, THE SIGN * BIT OF PARAMETER 1 MUST BE SET. * * APLDR IS SCHEDULED BY THE SYSTEM WHEN OPERATOR INPUTS * ONE OF THE FOLLOWING: * PL,LU * LO,PNAME,LU,FL,KB * RP,PNAME,LU,FL,KB * * THE SCHEDULE CALL PASSES THE PARAMETERS IN THE FOLLOWING * ORDER: * P1 - KEYBOARD LU # / FUNCTION CODE * P2 - FILE NUMBER / INPUT-OUTPUT LU # * P3 - CHARACTER #1 / CHARACTER #2 * P4 - CHARACTER #3 / CHARACTER #4 * P5 - CHARACTER #5 / CHARACTER #6 * * WHERE FUNCTION CODE IS: * 0 - PROGRAM LIST * 1 - LOAD PROGRAM * 2 - REPLACE PROGRAM * * * * APLDR LDA DKBFN GET ADDR OF BUFFER STA TEMP1 SAVE TEMPORARILY LDA MD5 5 STA TEMP2 RMPLP LDA B,I GET PARAM FROM ID SEG STA TEMP1,I SAVE IN BUFFER INB ISZ TEMP1 ISZ TEMP2 JMP RMPLP * CLA LDB FILLU GET FILE NO.&I/O LU LSR 8 SAVE LEFT HALF STB FILE AS FILE NUMBER. * ALF,ALF SAVE RIGHT HALF STA LU AS I/0 LU. * CLA LDB KBFUN GET KYBD UNIT AND FUNC RRL 1 SIGN BIT SET IF SCHEDULED XOR B1 FROM CENTRAL. SET IDEST. STA IDEST CLE,ERB LSR 8 SAVE LEFT HALF SZB,RSS IF ZERO, LDB CONSL USE DEFAULT STB KYBDU AS KEYBOARD UNIT. * ALF,ALF GET FUNC FROM RIGHT HALF SZA,RSS IS IT LIST? 0 JMP LIST CPA B1 IS IT LOAD? 1 JMP LOAD CPA B2 IS IT REPLACE? 2 JMP REPL JMP ABORT NO, IT IS ERROR. * DKBFN DEF KBFUN MD5 DEC -5 * HED APLDR: LO PGM * (C) HEWLETT-PACKARD CO. 1976 LOAD CLA STA CBUSY LDB %DLER CLEAR ERROR NUMBER. JSB SYSET JSB RMCHK CHECK REMOTE/LOCAL LOAD. JMP LOAD1 LOCAL DEVICE. * LDA NAM12 CENTRAL FILE. STA FLNAM SAVE ALL 6 CHAR AS FILE NAME. LDA NAM34 STA FLNAM+1 LDA NAM50 STA FLNAM+2 * LDA MD5 BLANK TRAILING ASTERISKS IN STA TEMP1 PROGRAM NAME PORTION (FIRST LDA DFNAM 5 CHARACTERS). STA TEMP CCE * LOOP LDA TEMP,I PROGRAM NAME. SEZ ALF,ALF AND B377 CPA B52 CHECK NEXT CHAR FOR "*". RSS JMP BUMP * LDA D10 FOUND. CONVERT TO BLANK., SEZ ALF,ALF XOR TEMP,I STA TEMP,I * BUMP SEZ,RSS GO TO NEXT CHARACTER. ISZ TEMP CME ISZ TEMP1 JMP LOOP * LOAD1 LDA NAM12 IF NO NAME GIVEN SZA,RSS SKIP DUPLIC NAME JMP NODUP  CHECKING JSB RMCHK SKIP CHECK UNTIL LATER JMP *+2 JMP NODUP IF REMOTE LOAD. JSB DUPID CHECK IF DUPLICATE DEF NAM12 ID NAME. * NODUP JSB STRID NOT DUPLI, FIND LOAD2 JSB SRCID A BLANK DFNUL DEF ZERO ID SEG. JMP LOADD NO BLANK ID SEG. JMP LOAD2 KEEP LOOKING. STA CURID GOT IT, SAVE ADDR. * LOAD3 JSB IHILO INIT HI,LO ADDRS LDA DWRD1 INIT SPEC REC STA WORD1 DUMMY ID ADDR. LDA DWRD2 STA WORD2 LDA RSS INITIALIZE SWITCH STA ABS12 FOR SPEC. REC. STA LDRCT INIT LEADER COUNT STA IDOFS INDICATE NO ABS YET. * JSB RMCHK LEAVE LU ALONE IF JMP *+2 DOWN-LINK LOAD. JMP ABS0 * LDA LU GET LU PARAM, SZA,RSS IF ZERO LDA DINPT USE DEFAULT IOR B2300 FOR THE ABS STA LU INPUT UNIT. * * * * READ ABSOLUTE RECORD * * ABS0 JSB RMCHK CHECK FOR REMOTE/LOCAL INPUT. JMP ABS03 LOCAL. * CLA SIGNAL NEW LOAD. STA TEMP LDA %LU LU OF CENTRAL. STA RMLU LDA XEQT,I ID SEG ADDR OF APLDR. STA IDSEG * ABS01 JSB %DNLD REQUEST CORE IMAGE RECORD. DEF *+5 DEF TEMP STATUS. DEF ABSAD ADDR OR ERROR CODE. DEF ABSSZ RETURNED SIZE. DEF FLNAM CENTRAL FILE NAME. * LDA ABSAD SET UP CORE ADDR FOR DATA READ. STA CADR LDA TEMP CHECK FOR ERRORS. SSA,RSS JMP ABS02 NONE. * CPA M2 JMP FMPER ERROR FROM CENTRAL FMP. CPA M3 JMP STNBY CENTRAL BUSY. JMP ABS02 * FMPER LDA ERR05 FMP ERROR. LDB ABSAD CPB M6 LDA ERR03 LDB DFILE JSB ERROR JMP ABORT * STNBY LDA CBUSY ALREADY DISPLAYED MESSAGE? SZA JMP ABS01 YES. LDA ERR06 NOO. LDB DFILE JSB ERROR CLA,INA STA CBUSY JMP ABS01 GO TRY AGAIN. * ABS02 CPA B1 CORE IMAGE RECORD COMING? JMP ABS1 YES. CHECK BASE-PAGE/RT AREA BOUNDS. * LDB SBUF POINT TO SPECIAL RECORD AREA. STB CADR CPA B2 ID SEGMENT COMING? JMP ABS10 YES. WON'T COME BACK FOR MORE. * JMP IDERR DONE, BUT NO ID SEG RECEIVED. * ABS03 JSB DEXEC MAKE REQUEST DEF *+6 TO DEF IDEST DEF B1 READ DEF LU ABS RECORD DEF ABSBF INTO BUF DEF D64 OF MAX SIZE. * AND B240 CHECK FOR EOF/EOT SZA,RSS IS IT EOF? JMP ABS0A NO LDA LDRCT YES, IS IT SZA,RSS JUST LEADER? JMP LOAD5 IS EOF. JMP ABS0 IGNORE LEADER * ABS0A SZB,RSS ANYTHING TRANSMITTED? JMP ABS0 NO * STA LDRCT SET LDRCT FOR EOT LDB ABSCT GET WORD COUNT. BLF,BLF SHIFT TO LOW BITS STB ABSSZ SAVE REC SIZE CMB,INB STB TEMP1 SAVE NEG COUNT LDB ABSAD GET ADDR, START CKSM. LDA DABSD STA TEMP2 SET DATA ADDR. ABS0B LDA TEMP2,I GET A WORD ADB A ADD TO CKSM ISZ TEMP2 BUMP TO NEXT ISZ TEMP1 BUMP COUNT JMP ABS0B REPEAT TIL DONE. * LDA TEMP2,I CPA B COMPARE CKSMS JMP ABS1 MATCHES LDB ERR10 CHECKSUM ERROR- JMP ERPR4 ERR MSG THEN ABORT * * * * FIND WHERE ABSOLUTE RECORD FITS IN CORE * * ABS1 LDA ABSAD OK, SO FETCH ADDR CPA B2 IS IT SPECIAL RECORD? JMP ABS12 YES AND BPMSK IS IT BASE PAGE? CPA ABSAD JMP ABS2 YES, BASE PAGE. * LDA RTORG GET DEFAULT LOWEST ADDR STA TEMP LDA AVMEM GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DMAIN GET PTRS TO MAIN HI/LO LDB D22 SET OFFSET FOR MAIN JMP ABS3 ADDRS IN ID SEG. * ABS2 LDA BPA1 GET DEFAULT LOWEST ADDR STA TEMP LDA BPA2 GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DBASE GET PTRS TO BASE HI/LO LDB D24 SET OFFSET FOR BASE PAGE * * * * FIND THE HI AND LO MEMORY BOUNDS OF FREE CORE * * ABS3 STB IDOFS SAVE OFFSET TO GET ADDRS STA TEMP4 SAVE ADDR OF LFREE ADA B2 STA TEMP5 SAVE ADDR OF HFREE LDA TEMP CMA,INA CHECK IF ABS REC < FWABP USER LINKS ADA ABSAD SSA JMP ABS14 ABS < FWABP, ERROR LDA ABSAD ADA ABSSZ CMA,INA CHECK IF ABS REC > LWAM USER SPACE ADA TEMP1 SSA JMP ABS14 ABS > LWAM, ERROR LDA TEMP4,I CPA TEMP RSS ADDRS ALREADY SET? JMP ABS6 YES, SKIP SEARCH FOR HI/LO * JSB STRID INIT ID SEARCH. ABS4 JSB SRCID SEARCH EACH ID DEF ZERO EXCEPT BLANK ONES, JMP ABS6 FOR THE HI/LO RSS RSS ADDRS WHICH JMP ABS4 DEFINE FREE CORE. CPA CURID IS THIS ID FOR PRG? JMP ABS4 YES, IGNORE THIS ID BOUNDS ADA IDOFS STA TEMP SET ADDR OF ID ADDR. * CMA CHECK IF ID SEG > 22 WORDS ADA ADRID,I SSA JMP ABS4 NEG, IGNORE IF RTE ID SEG. CLA STA TEMP1 CLEAR OVERLAP FLAG * LDA TEMP,I GET ID LOW CMA,INA ADA ABSAD IS ID LOW > ABS REC? SSA JMP ABS4B LOW>ABS, CHECK MORE ISZ TEMP1 LOW<=ABS, CHECK IF OVERLAP JMP ABS5 BY CHECKING IF HI>=ABS * ABS4B LDA TEMP,I GET ID LOW AGAIN CMA SUBTRACT IT ADA TEMP5,I FROM LAST HFREE SSA AND JMP ABS5 IF IT IS LDA TEMP,I LOWER THEN KEEP IT DST TEMP5,I AS NEW HFREE * |ABS5 ISZ TEMP LDA TEMP,I GET ID HIGH ADDR CMA,INA ADA ABSAD SSA,RSS ID HIGH < ADDR OF REC? JMP ABS5B HI<=ABS, CHECK MORE CLA,INA HI>ABS, MIGHT OVERLAP CPA TEMP1 DOES ABS OVERLAP? JMP ABS13 YES, GIVE OF ERR JMP ABS4 NO, IGNORE * ABS5B LDA TEMP,I GET ID HI CMA,INA SUBTRACT IT ADA TEMP4,I FROM LAST LFREE SSA,RSS AND IF IT IS JMP ABS4 LDA TEMP,I HIGHER, WE KEEP IT DST TEMP4,I AS NEW LFREE JMP ABS4 REPEAT FOR EACH ID * * * * ALREADY GOT MEMORY BOUNDS; SEE IF ABS CAN FIT * * ABS6 LDA ABSAD GET ADDR OF ABS REC LDB ABSSZ ADB A GET ADDR OF END OF ABS REC JSB CKBND CHECK BOUNDS WITH LFREE,HFREE JMP ABS13 ERROR. * * * * COPY ABS RECORD TO CORE IF WITHIN BOUNDS * * ABS10 JSB RMCHK CHECK FOR REMOTE/LOCAL INPUT. JMP AB10A LOCAL. * LDA %PRMB PARMB ADDRESS ADA D33 ADDR OF TIME-TAGS STA TAGAD PASS AS 2ND OPT. PARAM * JSB $LIBR SWITCH TO PRIVILEDGED MODE. NOP * LDA ABSSZ SET UP DATA LENGTH. STA ABLEN * CLA PRIVILEDGED MODE. STA $PVCN LDA DEFX SET UP SUSPENSION ADDR. STA XSUSP,I * JSB $XSIO READ CORE IMAGE RECORD. RMLU NOP LU OF CENTRAL. DEF COMPL NOP LIST POINTER. OCT 301 READ. CADR NOP "BUFFER" - BASE PG OR RT AREA. ABLEN NOP WORD LENGTH. RSS RETURN POINT TAGAD NOP 2ND OPT. PARAMETER= TAGS ADDRESS * LDA B102 SET UP FOR I/O SUSPEND. STA FCNCD XLIST JSB $LIST CALL LIST PROCESSOR. FCNCD OCT 0 FUNCTION CODE. IDSEG NOP ID SEG ADDR OF APLDR. * JMP $XEQ GIVE UP CPU. * COMPL LDA B101 SET UP FOR SCHEDULE LIST. STA FCNCD JMP XLIST * RETN CLA,INA SIGNAL CONTINUING LOAD. STA TEMP * LDA CADR IF THIS WAS DUMMY ID SEG, CPA SBUF JMP ABS12 CALL IT QUITS, ELSE JMP ABS01 GO GET MORE DATA. * AB10A LDA ABSSZ SET UP ABSSZ CMA,INA FOR TRANSFER STA TEMP OF RECORD. LDA DABSD SET UP BUFFER STA BADDR ADDR OF DATA WORDS. LDB ABSAD SET UP CORE ADDR. ABS11 LDA BADDR,I GET A DATA WORD. JSB SYSET PUT INTO CORE. INB ISZ BADDR ISZ TEMP JMP ABS11 REPEAT UNTIL DONE. JMP ABS0 GO GET ANOTHER RECORD * * * * PROCESS SPECIAL TRAILER RECORDS. * * ABS12 RSS NOP-ED AFTER 1ST ENTRY.! JMP AB12D SO ONLY DO THIS ONCE. LDA MD28 STA TEMP1 SET COUNTER LDB DDMID TO CLEAR OUT CLA AB12A STA B,I SPECIAL RECORDS INB ISZ TEMP1 JMP AB12A STA ABS12 NOP SWITCH * JSB RMCHK CHECK FOR REMOTE/LOCAL LOAD. JMP AB12D LOCAL. * LDA SBUF REMOTE: THE 18-WORD SPECIAL RECORD STA ABSD1 HAS BEEN READ. LDA M9 STA TEMP1 AB12B DLD ABSD1,I MOVE TO DUMMY ID SEG AREA. STA WORD1,I STB WORD2,I ISZ ABSD1 ISZ ABSD1 ISZ WORD1 ISZ WORD2 ISZ TEMP1 JMP AB12B JMP LOAD6 GO WIND IT UP. * AB12D DLD ABSD1 PICK UP 2 DATA WORDS STA WORD1,I PUT 1ST INTO DUMMY ID. STB WORD2,I PUT 2ND INTO DUMMY ID. ISZ WORD1 BUMP DUMMY ID ISZ WORD2 LOCATIONS. JMP ABS0 * * * * REACHED END-OF-FILE ON PROGRAM INPUT * * LOAD5 LDB IDOFS CHECK IF ANY ABS CPB RSS WAS READ YET. JMP IDERR ERROR IF NONE. LDA WORD1 SPEC REC MUST BE AT END CPA DWRD2 WAS IT THERE? JMP LOAD6 YES. IDERR LDA B5 NO. LDB ERR13 NO SPECIAL RECORDS, JMP ERPR4 PRINT ERR MSG/ABORT * LOAD6 DLD NAM12 NAME GIVEN IN COMMAND? SZA,RSS JMP LOAD7 NO, USE NAME FROM SPEC REC DST PNM12 YES, USE NAME FROM COMMAND LDA NAM50 GET 5TH CHAR STA PNM50 JSB RMCHK IF REMOTE LOAD, CHECK NAME NOW. JMP LOAD8 LOCAL. DID DUP CHECK ALREADY. JSB DUPID REMOTE. NAME GIVEN IN COMMAND. DEF NAM12 JMP LOAD8 LOAD7 JSB DUPID NAME GIVEN IN SPECIAL RECORD, DEF PNM12 CHECK FOR DUPLICATE. * LOAD8 LDB SZCOM GET SIZE OF COMMON SZB,RSS JMP LOD8A SKIP CHECK IF NO COMMON LDA FWAC GET FWA COMMON CMA SUBTR FROM ADA RTORG FWA REAL-TIME COMMON SSA,RSS FWACAVMEM? JMP LOADE YES, ERROR. * LOD8A LDA DMAIN GET FREE AREA POINTERS STA TEMP4 FOR THE MAIN AREA DLD PRGMN GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * LDA DBASE GET FREE AREA POINTERS STA TEMP4 FOR THE BASE PAGE AREA DLD PRGBP GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * * * * MOVE ID SEGMENT TO SYSTEM AREA * * LOD8B LDA PNM50 GET 5TH CHAR AND LHALF MASK OUT TYPE INA FORCE TO TYPE 1 STA PNM50 LDA MD28 DONE LOAD, COPY ID SEG. STA TEMP SET UP COUNT. LDA DDMID SET UP ADDR STA BADDR FOR DATA WORDS. LDB CURID SET ADDR FOR CORE LOC. JMP *+3 DON'T MOVE LINKAGE WORD * LOAD9 LDA BADDR,I JSB SYSET MOVE A WORD TO ID SEG INB ISZ BADDR ISZ TEMP JMP LOAD9 REPEAT TILL DONE. * LDA MSG1+1 SET UP DONE STA BUF MESSAGE WITH LDA MSG1+2 PROG NAME STA BUF+1 LDA DASH INSERT DASH. STA BUF+2 LDB DWRD1+1 GET ADDR OF PROG NAME LDA LINE2 GET ADDR IN MSG FOR NAME INA CLE JSB MVNAM MOVE NAME TO MSG LDA D10 STA TEMP3 JSB DSPLA DISPLAY MESSAGE JMP STOP END APLDR. * * * ERROR RETURNS FROM LOADING SECTION * ABS13 JSB REMER MEMORY ERROR JSB IHILO CLEAR HI,LO ADDR JSB RMCHK JMP ABS1 GO RE-ESTABLISH HI/LO. JMP ABS0 * ABS14 LDB ERR12 ABSLWAM JMP ERPR4 SO ABORT * LOADC LDA B,I GET NAM12 FROM ID SZA,RSS PROG REMOVED YET? JMP LOD8B YES. JSB REMER FINAL MEMORY ERROR JMP LOD8A CHECK AGAIN * LOADD LDA DBLNK NO BLANK STA MT.ID+1 ID SEG LDA A00 SET ZEROES IN MSG STA MT.ID+2 LDA D11 LDB MT.ID SET UP MESSAGE ERMPR JSB STUFP PRINT MESSAGE JMP ABORT THEN ABORT. * LOADE LDB ERR11 ABS USED TOO MUCH COMMON ERPR4 LDA B2 GET COUNT TO JMP ERMPR PRINT ERR MSG, ABORT SKP * **************************** * SUBROUTINES USED IN LOAD AND ABSOLUTE RECORD PROCESSORS * **************************** * * DUPID CHECKS FOR DUPLICATE PROGRAM NAME, ISSUES ERROR * MESSAGE AND ATTEMPTS TO CHANGE PROGRAM NAME. ABORTS IF * STILL NOT UNIQUE. * JSB DUPID * DEF PNAME * * DUPID NOP SEARCH FOR DUPLICATE LDA DUPID,I ID NAME. STA DUPNM SAVE ID NAME. ISZ DUPID DUP1 JSB STRID INIT ID SCANNER. DUP2 JSB SRCID FIND ID SEG DUPNM NOP WITH SAME NAME JMP DUPID,I NO DUPLICATE. JMP DUP2 REPEAT TIL DONE. LDA ERR02 DUPLIC. PROG ERR LDB DUPNM  JSB ERROR * LDA C$$ CHANGE NAME ONLY ONCE CPA DUPNM,I IF NAME ALREADY CHANGED, JMP ABORT THEN ABORT, STA DUPNM,I ELSE SEARCH AGAIN. JMP DUP1 * * **************************** * * SYSET SETS A WORD INTO A CORE LOCATION. * LDA WORD * LDB ADDR * JSB SYSET * * SYSET NOP SYSTEM WORD SETTER. JSB $LIBR TURN OFF THE NOP INTER. SYS. STA B,I STORE WORD INTO SYS. JSB $LIBX RESTORE INTER SYS DEF SYSET AND RETURN. * * *********************************** * * IHILO INITIALIZES DEFAULT HIGH AND LOW BOUNDS * OF FREE MEMORY. * JSB IHILO * * IHILO NOP INITIALIZE HI/LO ADDRS LDA BKLWA TO FIND HIGHEST STA HMAIN AND LOWEST LDA B1647 STA HBASE ADDRS OF UNUSED LDA RTORG CORE WHICH MAY BE STA LMAIN USED FOR LOADING LDA BPA1 STA LBASE ABS PROGRAMS CLA STA LMID STA HMID STA LBID STA HBID JMP IHILO,I RETURN * * ******************************* * * CKBND CHECKS PROGRAM BOUNDS AGAINST THAT OF FREE * CORE (TEMP4 POINTS TO FREE CORE POINTERS). * LDA PRGLO LOW ADDR OF CORE USED * LDB PRGHI HI ADDR * JSB CKBND * * * CKBND NOP CHECK BOUNDS OF PROG DST TEMP AGAINST BOUNDS OF FREE CORE DLD TEMP4,I GET LFREE CMA,INA SUBTR FROM ADA TEMP LOW ADDR SSA ADDR>=LFREE? JMP CKBND,I NO, ERROR * LDA TEMP4 ADA B2 DLD A,I GET HFREE CMA SUBTR FROM ADA TEMP1 HI ADDR SSA ADDR<=HFREE? ISZ CKBND RETURN TO P+2 IF NO ERROR JMP CKBND,I RETURNV TO P+1 IF ERROR * * ************************** * * REMER ISSUES "REM XXX" ERROR MESSAGE IF NEED TO REMOVE * A PROGRAM TO GET SPACE IN CORE, THEN SUSPENDS APLDR. * IF SPACE BELONGS TO THE SYSTEM, APLDR IS ABORTED. * LDB PNAME PROG WHICH MUST BE REMOVED * JSB REMER * * REMER NOP -REM XXXXX- ERROR SZB,RSS MEMORY ERROR. JMP ABS14 OUTSIDE AVAILABLE MEM LDA ERR01 GIVE -REM XXXXX- MESSAGE JSB ERROR * LDA IDEST ABORT IF SCHED BY CENTRAL. SZA,RSS JMP ABORT * JSB RMCHK IF DOWN-LOAD, SEND STOP. JMP SUSP LDA %LU GET LU AND B77 CLEAN FOR STOP STA CNWD JSB EXEC DEF *+3 DEF B3 DEF CNWD SEND STOP * SUSP JSB EXEC CALL EXEC DEF *+2 TO SUSPEND DEF B7 THE APLDR. JMP REMER,I RETURN * * ****************************** * * CHECK FOR DOWN-LINK LOAD FROM CENTRAL STATION DISC. * IF NAME GIVEN ON LO COMMAND, AND LU = 0, TAKE P+2 RETURN * (REMOTE FILE), ELSE P+1 RETURN (LOCAL DEVICE). * RMCHK NOP STA TEMP7 LDA KBFUN P+1 IF NOT LO COMMAND. AND B377 CPA B1 RSS JMP RMCK LDA NAM12 SZA,RSS JMP RMCK P+1 IF NO NAME. LDA LU SZA,RSS ISZ RMCHK P+2 IF LU = 0. RMCK LDA TEMP7 JMP RMCHK,I * * ****************************** * * MD28 DEC -28 * B52 OCT 52 ASTERISK. B101 OCT 101 B102 OCT 102 B377 OCT 377 B240 OCT 240 B1647 OCT 1647 B2300 OCT 2300 * * D24 DEC 24 D33 DEC 33 D64 DEC 64 * XEQT OCT 1717 ADDR OF ID SEGMENT ADDRESS. XSUSP OCT 101730 SUSPENSION ADDRESS. BPMSK OCT 1777 C$$ ASC 1,$$ NAME CHANGE CHAR. DASH ASC 1,- * ABSSZ NOP FILE NOP CURID NOP IDOFS NOP BADDR NOP LDRCT NOP WORD1 NOP WORD2 NOP DEFX DEF RETN POINT OF)q SUSPENSION FOR APLDR. DFILE DEF FLNAM FLNAM BSS 3 * * DO NOT CHANGE ORDER OF FOLLOWING * LMAIN NOP LMID NOP HMAIN NOP HMID NOP LBASE NOP LBID NOP HBASE NOP HBID NOP DMAIN DEF LMAIN ADDR OF HI/LO ADDR FOR MAIN DBASE DEF LBASE ADDR OF HI/LO ADDR FOR BASE PAGE * * DWRD2 DEF DWR2,I DWRD1 DEF *+1,I DUMMY ID ADDRESSES DEF PNM12 NAM12 DEF PNM50 NAM50/TYPE DEF RESML RESOL/MULT DEF HRS HR DEF SEC SEC DEF PRGMN LOW MAIN DEF PRGBP LOW BASE DEF FWAC FWA COMMON DDMYD DEF JMPXF JMP XFER * DWR2 DEF PNM34 NAM34 DEF PRIOR PR DEF SPAR1 SPARE WORD DEF MIN MIN DEF MSEC MSEC DEF PRGM2 HMAIN DEF PRGB2 HBASE DEF SZCOM SIZE COMMON DEF XFER XFER ADDR * HED APLDR: RP PGM * (C) HEWLETT-PACKARD CO. 1976 REPL LDA NAM12 IS IT A SZA,RSS BLANK NAME? JMP REPNO YES, ERROR * REP00 JSB STRID INIT ID SEARCH REP01 JSB SRCID TO FIND ID SEG DFNAM DEF NAM12 WITH SAME NAME JMP REPNO NO SUCH PROG JMP REP01 STA CURID GOT IT, SAVE ID ADDR STB TEMP SAVE ADDR OF ID NAME * JSB $LIBR TURN OFF INT. SYS. NOP ADA D8 LDA A,I POINT OF SUSPENSION SZA IS ZERO? JMP REP03 NO, SUSPEND APLDR ADB B3 LDA B,I SZA IS STATUS DORMANT? JMP REP03 NO, SUSPEND APLDR ADB B2 LDA B,I ALF,CLE,ERA SEZ IN TIME LIST? JMP REP03 YES, SUSPEND APLDR * DLD ZERO CLEAR OUT NAME DST NAM12 -IN CALL SO WE CAN STA NAM50 USE NAME FROM ABS PROG DST TEMP,I CLEAR ID SEGMENT LDB TEMP ADB B2 FOR REPLACEMENT STA B,I BY THE RP COMMAND JSB $LIBX RESTORE INT SYS DEF *+1#2NLH DEF *+1 * LDB B5 DEFAULT LU TO 5. LDA LU SZA,RSS STB LU JMP LOAD3 GO LOAD PROGRAM. * * ERROR RETURNS FROM REPLACE * REP03 JSB $LIBX RESTORE INT SYS DEF *+1 DEF *+1 LDA ERR04 PUT NAME INTO LDB DFNAM -OF XXXXX- BECAUSE JSB ERROR NON-ZERO SUSP OR T-LIST * LDA IDEST ABORT IF SCHED BY CENTRAL. SZA JMP ABORT * JSB EXEC SUSPEND APLDR DEF *+2 DEF B7 JMP REP00 TRY TO REPLACE AGAIN * REPNO LDA ERR03 NO SUCH PROG LDB DFNAM PUT NAME IN ERR MSG JSB ERROR PRINT ERR MSG JMP ABORT THEN ABORT )N HED APLDR: PL PGM * (C) HEWLETT-PACKARD CO. 1976 * LIST PROGRAMS. * LIST LDA LU GET LU PARAM. SZA,RSS IF ZERO, LDA DLIST USE DEFAULT. STA LU SET LIST UNIT. * JSB SPACE PRINT LDA D19 HEADING. LDB HEAD1 JSB PRINT JSB SPACE * LDA DBLNK SET UP OUTPUT BUFFER. STA BUF STA BUF+4 STA BUF+6 STA BUF+13 * CLA CLEAR OUT BLANK ID SEG. STA TEMP5 COUNTER. * JSB STRID INIT ID SCANNER. LIST2 JSB SRCID SEARCH ID SEGS DEF ZERO JMP LIST7 EOF JMP LIST3 NON BLANK ID SEG ISZ TEMP5 BLANK ID SEG JMP LIST2 GO SEE NEXT ONE. * LIST3 STB TEMP1 SAVE NAME ADDR STA TEMP SAVE ID ADDR LDA LINE PUT PROG NAME INA INTO LINE CLE JSB MVNAM * LDB TEMP ADB B6 GET PRIORITY LDA B,I WORD JSB DIV10 DIVIDE BY 10 STA BUF+5 * LDB TEMP ADB D22 GET PROG ADDRS. STB TEMP LDA M2 SET -2 TO GET STA TEMP4 MAIN AND BASE PAGE. LDB LINE INITIALIZE ADDR ADB B7 FOR NUMBER STUFFING. LIST4 LDA TEMP,I GET LOW ADDR. JSB CONV CONVERT TO ASCII. ISZ TEMP LDA TEMP,I GET HIGH ADDR. ADA M1 -1 TO GET REAL HIGH ADDR JSB CONV CONVERT TO ASCII. * INB LEAVE A SPACE. ISZ TEMP ISZ TEMP4 JMP LIST4 GO GET NEXT PAIR OF ADDRS. * LDA D20 LDB LINE JSB PRINT PRINT PROG INFO. * JMP LIST2 GO GET NEXT ID SEG. * LIST7 LDA TEMP5 GET # OF BLANK ID SEGS JSB DIV10 DIVIDE BY 10 STA MT.ID+2 LDA D11 LDB MT.ID JSB PRINT PRINT "# BLANK ID SEGMENTS" * DONE LDA B3 PRINT "DONE" LDB MSG1 AFTER THE "APLDR:" JMP STOP1 * ABORT LDA B4 PRINT "ABORTED" LDB ERR99 AFTER THE "APLDR:" STOP1 JSB STUFP * JSB RMCHK REMOTE OPERATION? JMP STOP NO. * LDA %DLER YES. REM,COM OR MEM ERROR? LDA A,I CPA MD60 JMP SNSTP ADA D67 SZA (-60,-67 OR -68 ERROR CODE) INA SZA JMP STOP NO. * SNSTP LDA %LU GET LU AND B77 SET FOR STOP STA CNWD JSB EXEC YES. SEND "STOP" TO REFUSE DEF *+3 DATA AND TO TELL NPRGL TO DEF B3 TERMINATE DOWN-LOAD. DEF CNWD SEND STOP * STOP JSB EXEC CALL EXEC DEF *+2 TO END DEF B6 APLDR. * SKP * SUBROUTINES FOR APLDR. * * ***************************** * * SPACE PRINTS A BLANK LINE ON LIST DEVICE. * JSB SPACE * * SPACE NOP PRINT BLANK CLA,INA LINE. LDB MSGX (B)=DUMMY BUFFER JSB PRINT JMP SPACE,I * * ***************************** * * PRINT PRINTS A LINE ON LOCAL/REMOTE LIST DEVICE. * LDA WORDS NO. OF WORDS * LDB ADDR ADDR OF TEXT * JSB PRINT * * PRINT NOP STA TEMP1 STB MADDR JSB DEXEC CALL DEXEC DEF *+6 TO PRINT DEF IDEST DEF B2 ON LIST DEVICE DEF LU MADDR NOP DEF TEMP1 JMP PRINT,I * * ******************************** * * STUFP STUFFS A MESSAGE WITH THE IDENTIFIER "APLDR:" AND * PRINTS IT ON CONSOLE. * LDA WORDS * LDB ADDR * JSB STUFP * * STUFP NOP STUFF MESSAGE INTO STB TEMP SPECIAL IDENTIFIER LDB B4 ADD 4 TO ADB A MESSAGE LENGTH STB TEMP3 FOR TOTAL LENGTH CMA,INA STA TEMP2 NEGATIVE COUNT>_. LDB MSG0 STFLP LDA TEMP,I STA B,I INB ISZ TEMP ISZ TEMP2 JMP STFLP JSB DSPLA DISPLAY MESSAGE LDA TEMP,I GET ERROR NUMBER. LDB %DLER CPA M1 JMP *+2 JSB SYSET STORE ERROR NUMBER. JMP STUFP,I RETURN * * ****************************** * * DSPLA PRINTS A MESSAGE ON THE LOCAL CONSOLE. THE MESSAGE * ADDRESS IS IN MSG AND THE WORD LENGTH IS IN TEMP3. * JSB DSPLA * * DSPLA NOP LDA IDEST DON'T DISPLAY IF SZA,RSS SCHEDULED BY CENTRAL. JMP DSPLA,I * JSB EXEC DEF *+5 DEF B2 CALL EXEC DEF KYBDU TO WRITE DEF MSG MESSAGE ON DEF TEMP3 OPERATOR CONSOLE. JMP DSPLA,I RETURN * * ****************************** * * MVNAM MOVES A PROGRAM NAME (3 WORDS) AND FILLS AN * ASCII BLANK IN THE DESTINATION NAME. * E=0 IF PROG NAME, E=1 IF FILE NAME. * LDA DEST ADDR OF DESTINATION FOR NAME * LDB SORC ADDR OF SOURCE NAME * JSB MVNAM * * MVNAM NOP MOVE PROG NAME STA TEMP4 TO GIVEN DESTINATION LDA B,I STA TEMP4,I MOVE CHAR1,2 ISZ TEMP4 INB LDA B,I STA TEMP4,I MOVE CHAR3,4 ISZ TEMP4 INB LDA B,I JSB RMCHK DON'T BLANK LAST CHAR IF JMP MVN1 REMOTE LOAD AND E = 1. SEZ JMP MVN2 MVN1 AND LHALF PUT ASCII BLANK IOR B40 IN CHAR6 MVN2 STA TEMP4,I THEN MOVE JMP MVNAM,I RETURN * * ******************************* * * ERROR PUTS A PROGRAM NAME INTO AN ERROR MESSAGE * THEN PRINTS IT ON THE CONSOLE. * LDA ERRAD ADDR OF ERROR MESSAGE * LDB PNAME ADDR OF PROGRAM NAME * JSB ERROR * * ERROR NOP PUT :NAME INTO STA TEMP6 STB TEMP5 ERR MSG THEN DLD A,I PRINT IT DST BUF MOVE ERR MSG TO OUTPUT AREA LDA TEMP6 FIND IF PROG OR FILE NAME. ADA B2 LDA A,I CLE CPA MD62 CCE CPA MD64 CCE LDB TEMP5 GET ADDR OF NAME LDA LINE2 TO PUT INTO MSG JSB MVNAM LDA D9 STA TEMP3 SET LENGTH FOR JSB DSPLA DISPLAY JSB $LIBR NOP LDA TEMP6 GET MESSAGE ADDR. ADA B2 MOVE TO WORD 3. LDA A,I GET ERROR NUMBER. CLE CHECK FOR PROG/FILE NAME. CPA MD62 CCE CPA MD64 CCE LDB %DLER ADDR OF ERROR BLOCK IN @PTPQ. STA B,I LDB TEMP5 GET ADDR OF PROG/FILE NAME. LDA %DLER DESTINATION ADDR. INA JSB MVNAM MOVE THE NAME. JSB $LIBX DEF ERROR RETURN. * * ***************************** * * STRID INITIALIZES ID SEGMENT SEARCH ROUTINE. * * STRID NOP INITIALIZE ID SCANNER. LDA KEYWD GET KEYWORD ADDRESS STA ADRID STORE AS ID ADDRESS. JMP STRID,I RETURN * * ***************************** * * SRCID FETCHS AN ID SEGMENT AND SEES IF MATCH/NO MATCH/BLANK. * JSB SRCID * DEF PNAME ADDR OF NAME TO SEARCH FOR * * * * A CONTAINS ADDR OF ID SEGMENT * B CONTAINS ADDR OF NAME IN ID SEGMENT * SRCID NOP SEARCH ID SEGMENTS LDA SRCID,I FOR A CERTAIN NAME. STA TEMP1 SAVE ADDR OF NAME ISZ SRCID SET RETURN AT P+2 LDB ADRID,I PICK UP AN ID ADDR SZB,RSS IS IT END OF ID SEGS? JMP EOFID YES ADB D12 BUMP TO NAME IN ID STB TEMP2 SAVE ADDR OF NAME LDA B,I CP'qA TEMP1,I CHECK NAME 1,2 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I CPA TEMP1,I CHECK NAME 3,4 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I AND LHALF STA STRID SAVE TEMPORARILY LDA TEMP1,I AND LHALF CPA STRID COMPARE NAME 5 ISZ SRCID MATCHES, SET RETURN P+4 * NOMAT ISZ SRCID NO MATCH, RETURN P+3 LDA ADRID,I READY FOR RETURN. ISZ ADRID LDB TEMP2 EOFID JMP SRCID,I RETURN. * * ***************************** * SUBROUTINE: CONV (CONVERT 15-BIT BINARY NUMBER * TO 6-CHAR (LEADING BLANK) ASCII FORM OF OCTAL NUMBER * CALLING SEQUENCE: * (A)-BINARY VALUE FOR CONVERSION * (B)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (P) JSB CONV * (P+1) (RETURN): * (A) DESTROYED. * (B) ADDRESS OF NEXT STORAGE * CONV NOP STB TEMP1 SAVE STORAGE AREA ADDRESS LDB A RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA TEMP2 = -3. LDA B40 MAKE FIRST CHARACTER A SPACE. CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA TEMP3 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR TEMP3 PACK IN UPPER CHARACTER STA TEMP1,I AND STORE IN STORAGE AREA. ISZ TEMP1 ADD 1 TO STORAGE AREA ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ TEMP2 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDB TEMP1 FINISHED, SET (B)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * * ******************************K***** * * DIV10 CONVERTS A VALUE TO ASCII CHARACTERS * (DECIMAL CONVERSION, 99 MAX). * LDA VALUE * JSB DIV10 * * DIV10 NOP DIVIDE BY 10 (99 MAX) CLB RETURN ASCII IN (A) DIV D10 ALF,ALF MOVE TO LEFT HALF ADA B ADD REMAINDER ADA A00 MAKE ASCII JMP DIV10,I RETURN SKP * CONSTANTS AND STORAGE. * UNS M9 DEC -9 M6 DEC -6 M3 OCT -3 M2 OCT -2 * B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B40 OCT 40 B60 OCT 60 * D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D19 DEC 19 D20 DEC 20 D22 DEC 22 D67 DEC 67 * SAVEB NOP A00 ASC 1,00 LHALF OCT 177400 ZERO OCT 0,0,0 IDEST OCT 0 ADRID NOP KYBDU NOP LU NOP * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP TEMP6 NOP TEMP7 NOP CBUSY NOP * KBFUN NOP 5-WORD TABLE. FILLU NOP NAM12 NOP NAM34 NOP NAM50 NOP CNWD NOP B77 OCT 77 * SKP * MESSAGES FROM APLDR WITH LOVE. * * ERR01 DEF *+1 ASC 2,REM MD60 DEC -60 ERROR NUMBER. * ERR02 DEF *+1 ASC 2,DUP DEC -61 * ERR03 DEF *+1 ASC 2,NO MD62 DEC -62 * ERR04 DEF *+1 ASC 2,OF DEC -63 * ERR05 DEF *+1 ASC 2,FMP MD64 DEC -64 * ERR06 DEF *+1 ASC 2,BZY OCT 0 * ERR10 DEF *+1 ASC 2,CKSM DEC -66 * ERR11 DEF *+1 ASC 2,COM DEC -67 * ERR12 DEF *+1 ASC 2,MEM DEC -68 * ERR13 DEF *+1 ASC 2,ID? DEC -69 * ERR99 DEF *+1 ASC 4,ABORTED M1 OCT -1 * MSGX DEF *+1 ASC 1, BLANK WORD. * MSG1 DEF *+1 ASC 3,DONE OCT 0 * * MT.ID DEF *+1 ASC 11, BLANK ID SEGMENTS DEC -65 * CONSL EQU B1*($ OPERATOR CONSOLE. DINPT EQU B5 DEFAULT INPUT UNIT. DLIST EQU B6 DEFAULT LIST UNIT. * HEAD1 DEF *+1 ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE * * DBLNK EQU ERR04-2 DOUBLE BLANK WORD DABSD DEF ABSBF+2 SBUF DEF ABSBF+5 AREA FOR SPECIAL REC FROM CENTRAL. DDMID DEF DMYID LINE DEF MSG+4 LINE2 DEF MSG+6 MSG0 EQU LINE * MSG ASC 9, APLDR: BUF EQU MSG+4 * ABSBF BSS 64 * ABSCT EQU ABSBF ABSAD EQU ABSBF+1 ABSD1 EQU ABSBF+2 ABSD2 EQU ABSBF+3 * DMYID EQU ABSBF+35 JMPXF EQU DMYID-4 SPAR1 EQU DMYID-3 FWAC EQU DMYID-2 SZCOM EQU DMYID-1 PRIOR EQU DMYID+6 XFER EQU DMYID+7 PNM12 EQU DMYID+12 PNM34 EQU DMYID+13 PNM50 EQU DMYID+14 RESML EQU DMYID+17 MSEC EQU DMYID+18 SEC EQU DMYID+19 MIN EQU DMYID+20 HRS EQU DMYID+21 PRGMN EQU DMYID+22 PRGM2 EQU DMYID+23 PRGBP EQU DMYID+24 PRGB2 EQU DMYID+25 * BSS 0 SIZE OF APLDR * * END APLDR 6*  91705-18109 1713 S 0222 DS1/B SCE/5 MODULE: REMAC              H0102 FASMB,R,L,C HED REMAC - 91705-16109 * (C) HEWLETT PACKARD CO. 1977 NAM REMAC,1,80 91705-16109 REV 1713 770324 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * REMAC * SOURCE: 91705-18109 * BINARY: 91705-16109 * JIM HARTSELL * JULY 30, 1974 * * RTE-C SATELLITE PROGRAM TO PROVIDE OPERATOR ACCESS * TO THE CENTRAL STATION FOR VARIOUS CONTROL FUNCTIONS. * ENT REMAC * EXT EXEC EXT DOPEN,DREAD,DCLOS,DPOSN EXT DCRET,DWRIT,DPURG,DNAME EXT DEXEC,%DLST,DMESG,%RMCN EXT $MESS,$TYPE,$LIBR,$LIBX EXT %PRMB,%TMOT * A EQU 0 B EQU 1 OPEN EQU DOPEN READF EQU DREAD CLOSE EQU DCLOS POSNT EQU DPOSN CREAT EQU DCRET WRITF EQU DWRIT PURGE EQU DPURG NAMF EQU DNAME * * INITIALIZE TRANSFER STACK. * REMAC STB TEMP SAVE ADDR OF SCHEDULE PARAMS. LDA STKHD RESET STACK POINTER. STA P.STK CLA,INA SET FIRST STACK ENTRY STA P.STK,I FOR LOGICAL UNIT 1 (DEFAULT). STA MODE RESET MODE TO LOCAL. * LDA TEMP,I CHECK IF P1 = ASCII PARAM. AND HB377 SZA,RSS JMP STR NO. MUST BE INPUT LU. * * FETCH SCHEDULE PARAMETERS (FL,NA,ME,SEVERITY,LIST). * LDA A.$TR GENERATE "$TR,FLNAME" IN BUFFER. STA INBUF LDA A.TR1 STA INBUF+1 LDA TEMP,I STA INBUF+2 ISZ TEMP LDA TEMP,I STA INBUF+3 ISZ TEMP LDA TEMP,I STA INBUF+4 ISZ TEMP * LDA B5 SET COUNT. STA INCNT * LDA TEMP,I SET UP DUMMY SCHEDULE PARAMS. STA ALTBK+3 ܌SEVERITY CODE. ISZ TEMP LDA TEMP,I STA ALTBK+2 LIST LU. * LDA DFALT POINT TO DUMMY PARAMS. STA TEMP * STR STA TRFLG SET/CLEAR FLAG FOR QUERY SECTION. * * FETCH SCHEDULE PARAMETERS (LU,LOG,LIST,SEVERITY CODE). * LDA TEMP,I GET LU OF INPUT DEVICE. SZA,RSS JMP STAT IF NONE, USE DEFAULT. CPA B1 IGNORE IF = 1. JMP STAT * LDB P.STK PUT SPECIFIED LU INTO ADB B4 TRANSFER STACK. STB P.STK STA P.STK,I * STAT LDA P.STK,I CLB,INB FORCE LOCAL MODE. JSB EQTYP CHECK EQ. TYPE OF INPUT LU. STA LUTYP * ISZ TEMP LDA TEMP,I GET LU OF LOG DEVICE. SZA JMP SVLOG * DEFLT LDB LUTYP CLA,INA EITHER LU 1 OR SZB,RSS LDA P.STK,I INPUT LU IF TTY DEVICE. SVLOG STA LOGLU * ISZ TEMP LDA TEMP,I GET LU OF LIST DEVICE, SZA,RSS LDA B6 OR USE DEFAULT = 6. STA LSTLU * ISZ TEMP LDA TEMP,I SAVE SEVERITY CODE. STA SEVER * LDA TRFLG IF SCHEDULED WITH FILE NAME, SZA ALREADY HAVE TR SIMULATED. JMP CHK$ * * DISPLAY PROMPT CHARACTER (IF TTY DEVICE). * CONTROL RETURNS HERE WHEN REQUEST PROCESSING COMPLETES. * QUERY LDA P.STK,I CHECK WHETHER CURRENT INPUT STA TEMP STA LUTYP IS FROM A TTY TYPE DEVICE. AND HB377 NON ZERO IF FILE NAME, ELSE LU. SZA JMP REMRD REMOTE FILE. * LDA P.STK,I CLB,INB FORCE LOCAL MODE. JSB EQTYP LOCAL LU: CHECK TYPE. STA LUTYP SZA JMP LOCRD LOCAL LU NOT TTY DEVICE. * JSB EXEC DISPLAY PROMPT ON TTY DEVICE. DEF *+5 DEF B2 DEF P.STK,I DEF PROMP DEF B1 * LDA P.STK,I SET ECHO BIT. IOR B400 STA TEMP * * INPUT OPERATOR REQUEST FROM CURRENT DEVICE OR FILE. * LO CRD JSB EXEC LOCAL SATELLITE LU. DEF *+5 DEF B1 DEF TEMP DEF INBUF DEF D40 * STA TEMP SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. CLA,INA FORCE LOCAL MODE. JSB EOFCK CHECK FOR END OF FILE. JMP TRANS GOT IT. JMP ECHO GO ECHO IF NECCESSARY. * REMRD JSB READF CENTRAL STATION FILE. DEF *+6 (OPENED WHEN FIRST TRANSFER DEF IDCB WAS PERFORMED) DEF IERR DEF INBUF DEF D40 DEF INCNT ACTUAL WORD COUNT. * JSB ERCHK CHECK FOR ERRORS. * LDA INCNT IF EOF, GENERATE TR REQUEST. INA,SZA JMP BUMP TRANS LDA A.$TR STA INBUF LDA A.$TR+1 STA INBUF+1 LDA B2 STA INCNT JMP ECHO * BUMP LDA P.STK ADA B3 ISZ A,I BUMP RECORD COUNT. * * ECHO THE REQUEST IF NOT INPUT FROM TTY DEVICE. * ECHO LDA LUTYP SZA,RSS JMP CKCNT IT IS A TTY DEVICE. * LDA SEVER INHIBIT ECHO IF CPA B1 SEVERITY CODE = 1. JMP CHK$ * JSB EXEC NOT TTY: ECHO. DEF *+5 DEF B2 DEF LOGLU DEF INBUF DEF INCNT * CHK$ LDA INBUF FIRST CHARACTER MUST AND HB377 BE A "$". CPA AS.$ RSS JMP OPER * LDA INBUF BLANK OUT THE "$" SIGN. AND B377 IOR BLANK STA INBUF * CKCNT LDB INCNT IGNORE REQUEST IF NULL. RBL MAKE CHARACTER COUNT. SZB,RSS JMP QUERY * * PARSE THE OPERATOR REQUEST. * LDA BUFAD (A) = BUFAD, (B) = INCNT. JSB $PARS DEF PRAMS PARAMETER BUFFER ADDRESS. JMP M0000 TRY FOR REMAC COMMAND FIRST. * * LOCAL OR CENTRAL RTE COMMAND. * OTHER LDA INCNT SET UP +CHAR COUNT. RAL STA TEMP * LDA MODE IF LOCAL MODE, SEND COMMAND SZA TO RTE-C. JMP LCRTE * * SEND CENTRAL RTE COMMANDS. * JSB %RMCN SEND COMMAND TO CENTRAL. DEF *+3 DEF TEMP # CHARACTERS. DEF INBUF ASCII COMMAND. * STA IERR SAVE ERROR STATUS SSA SKIP IF NO ERROR JMP ERFND GIVE ERROR MSG * LDA TEMP RETURN MESSAGE? SZA,RSS JMP QUERY NO * SSA MAKE SURE LEN IS POSITIVE. JMP OPER * DSPLA CMA,INA NEGATE CHAR COUNT. STA TEMP * JSB EXEC DISPLAY REPLY MESSAGE. DEF *+5 DEF B2 DEF LOGLU DEF INBUF DEF TEMP * JMP QUERY * * PASS COMMAND TO LOCAL RTE-C. * LCRTE JSB JOB PROCESS COMMAND. * SZA IF CHAR CNT NON-ZERO, JMP DSPLA GO DISPLAY REPLY MESSAGE, JMP QUERY ELSE GO PROMPT. * * CHECK THE OPERATOR REQUEST CODE AGAINST THE LEGAL * REQUEST CODES AND JUMP TO THE PROPER PROCESSOR. * * TO ADD NEW REQUEST ONE MERELY: * A. ADDS ASCII OPERATION CODE TO TABLE "LDOPC". * B. ADDS PROCESSOR START ADDRESS TO TABLE "LDJMP". * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. * M0000 LDB OP FETCH OPERATION CODE. STB OPP SET STOP FLAG. LDA LDOPC SET OPERATION TABLE POINTER. STA TEMP1 LDA LDJMP SET PROCESSOR JUMP ADDRESS. STA TEMP2 * M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE. JMP TEMP2,I COMPARES. GO DO IT. * ISZ TEMP1 KEEP LOOKING. ISZ TEMP2 JMP M0030 * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS. * ASC 6,CLCRDLDUEXPU ASC 7,RESTSWTETCTR$$ OPP NOP OP CODE FOR CURRENT REQ. * LDJMP DEF *+1,I JMP ADDRESS FOR EACH OP CODE. DEF M0100 CL REQUEST. DEF M0200 CR REQUEST. DEF M0300 DL REQUEST. DEF M0400 DU REQUEST. DEF M0500 EX REQUEST. DEF M0700 PU REQUEST. DEF M0800 RE REQUEST. X DEF M0900 ST REQUEST. DEF M0990 SW REQUEST. DEF M1000 TE REQUEST. DEF M1100 TC REQUEST. DEF M1200 TR REQUEST. DEF M1300 $$ REQUEST. DEF OTHER ASSUME RTE OPER COMMAND. * OPER LDA D10 INPUT ERROR: 010 OPERS STA IERR JSB ERCHK WON'T RETURN. SKP * * SUBR TO PASS COMMAND TO RTE-C AS IF ENTERED LOCALLY. * JOB NOP JSB $LIBR NOP LDA JOB LDB HERE SZB,RSS JMP THERE CLA JSB $LIBX DEF *+1 DEF EXIT THERE STA RTN LDB 1735B SZB JMP EXIT1 STA HERE STA JOB LDA BUFAD STA PNTR1 LDA TYPE SSA,RSS JMP *+3 ELA,CLE,ERA LDA A,I ADA MD22 REFERENCES $TYPE-22 IN SCHEDULER STA PNTR2 FOR INPUT MESSAGE BUFFER. LDA INCNT LDB 0 CMA,INA ADB MD22 SSB JMP *+4 OK IF NOT > 22 WORDS LDA K44 ELSE SET BACK TO 22 STA TEMP LDA MD22 STA CNTR JSB XFER LDB TEMP JSB $MESS SZA,RSS JMP EXIT LDB A,I STB SAVE ADB MD1 BRS STB CNTR INA STA PNTR1 LDA BUFAD STA PNTR2 JSB XFER LDA SAVE CMA,INA EXIT CLB STB HERE EXIT1 JSB $LIBX DEF RTN XFER NOP LOOP1 LDA PNTR1,I STA PNTR2,I ISZ PNTR1 ISZ PNTR2 ISZ CNTR JMP LOOP1 JMP XFER,I RTN NOP HERE NOP TYPE DEF $TYPE K44 DEC 44 PNTR1 BSS 1 PNTR2 BSS 1 CNTR BSS 1 SAVE BSS 1 HED REMAC: CL REQUEST * (C) HEWLETT PACKARD CO. 1976 * * CL,FLNAME * * CLOSE A FILE AT THE CENTRAL STATION. * M0100 LDB CP1 ERROR IF NO FILE NAME. JSB ASCHK * JSB CLOSE CLOSE THE FILE. DEF *+3 NOTE: IN THE RTE-C SATELLITE, DEF P1 THE DCB MUST CONTAIN THE FILE DEF IERR NAME. * JSB ERCHK CHECK FOR ERRORS. * JMP QUERY HED REMAC: CR REQUEST * (C) HEWLETT PACKARD CO. 1976 * * CR,FLNAME,SECURITY,LABEL,TYPE,#BLOCKS,RECSIZE * * CREATE A DISC FILE AT THE CENTRAL STATION. * M0200 LDB CP1 ERROR IF NO NAME. JSB ASCHK * LDA B3 DEFAULT FILE TYPE TO 3. LDB P4 SZB,RSS STA P4 * LDA D10 DEFAULT # BLOCKS TO 10. LDB P5 SZB,RSS STA P5 LDA P6 SET UP SIZE ARRAY. STA P5+1 * JSB CREAT CREATE THE FILE. DEF *+8 DEF UDCB DEF IERR DEF P1 FILE NAME. DEF P5 # BLOCKS, RECSIZE. DEF P4 FILE TYPE. DEF P2 SECURITY CODE. DEF P3 LABEL. * LDA IERR CHECK FOR ERRORS IF IERR NEG. SSA JSB ERCHK * JMP QUERY HED REMAC: DL REQUEST * (C) HEWLETT PACKARD CO. 1976 * * DL,FILTER,SECURITY,LABEL,TYPE,LISTLU * * LIST CENTRAL STATION FILE DIRECTORY. * M0300 LDB CP1 FILTER SPECIFIED? SZB JMP M0305 * LDA BLANK NO. SET FIRST WORD TO BLANKS. IOR B40 STA P1 JMP M0310 * M0305 LDA D56 SPECIFIED. ASCII? ADB MD2 SZB JMP OPERS NO. ERROR 56. M0310 STB TEMP CLEAR NREQ FLAG. * LDA P4 SET SIGN BIT IF SZA FILE TYPE SPECIFIED. IOR HIBIT STA P4 * CLA,INA CHECK FOR LIST LU. LDB CP5 SZB,RSS SET DEFAULT = 1 IF NOT GIVEN. STA P5 * * REQUEST PRINT LINE FROM CENTRAL STATION. * M0320 JSB %DLST DEF *+11 DEF INBUF BUFFER. DEF D40 MAX. LEN. DEF P1 FILTER. DEF P2 SECURITY. DEF P3 LABEL. DEF P4 TYPE. DEF TEMP NREQ FLAG. DEF TEMP1 STATUS. DEF IERR ERROR CODE. DEF INCNT # VALID DATA WORDS. * 3 LDA TEMP1 DO WE HAVE A PRINT LINE? SZA JMP QUERY NO, ALL DONE. * LDA %PRMB SAVE DLIST REPLY BUFFER. STA TEMP1 LDA SRPLY STA TEMP2 JSB MOV25 * JSB DEXEC DISPLAY PRINT LINE. DEF *+6 DEF MODE DEF B2 RCODE. DEF P5 LU. DEF INBUF DEF INCNT * CLA,INA STA TEMP * LDA SRPLY RESTORE DLIST REPLY BUFFER. STA TEMP1 LDA %PRMB STA TEMP2 JSB MOV25 * JMP M0320 * * MOVE 25 WORDS * MOV25 NOP LDB MD25 LOOP LDA TEMP1,I STA TEMP2,I ISZ TEMP1 ISZ TEMP2 INB,SZB JMP LOOP JMP MOV25,I HED REMAC: DU REQUEST * (C) HEWLETT PACKARD CO. 1976 * * DU,FLNAME,LU,SECURITY,LABEL * * DUMP CENTRAL FILE ON SATELLITE LOGICAL INIT. * M0400 LDB CP1 ERROR IF NO FILE NAME. JSB ASCHK LDB CP2 ERROR IF NO LU. JSB INTCK * LDA P2 TEST FOR PT PUNCH. LDB MODE JSB EQTYP CPA B2 JMP M0402 IT IS A PUNCH. * LDB A LDA P2 IF LINE PRINTER, SET V-BIT IN IOR VBIT CONTROL WORD TO INHIBIT COL. 1 CPB D10 CARRIAGE CONTROL. STA P2 JMP M0405 * M0402 LDA B1000 GENERATE LEADER IOR P2 STA TEMP * JSB DEXEC DEF *+4 DEF MODE DEF B3 DEF TEMP * * OPEN THE CENTRAL FILE. * M0405 JSB OPEN OPEN THE FILE. DEF *+7 DEF UDCB DEF IERR DEF P1 FILE NAME. DEF B0 OPEN OPTIONS. DEF P3 SECURITY CODE. DEF P4 LABEL. * LDB P2 IF FILE TYPE 5(RELOC) ADB B100 OR 7 (ABS), SET FOR CPA B5 BINARY OUTPUT. JMP *+2 CPA B7 STB P2 * LDA IERR CHECK FOR ERRORS IF IERR NEG. SSA JSB ERCHK LDA OPNFL SET UDCB OPEN FLAG. ELA,CLE,ERA IOR HIBIT STA OPNFL * * READ A RECORD FROM CENTRAL FILE. * M0410 JSB READF READ. DEF *+6 DEF UDCB DEF IERR DEF INBUF DEF D128 DEF INCNT XMSN LOG. * JSB ERCHK CHECK FOR ERRORS. * LDA INCNT CHECK FOR EOF. INA SZA,RSS JMP M0420 GOT IT. GO PROCESS. * * OUTPUT THE RECORD ON SATELLITE LOGICAL INIT. * JSB DEXEC DEF *+6 DEF MODE DEF B2 DEF P2 LU. DEF INBUF DEF INCNT * JMP M0410 GO GET NEXT RECORD. * * PROCESS END OF FILE CONDITION. * M0420 LDA P2 GET LOGICAL UNIT. AND B77 STA P2 LDB MODE JSB EQTYP STA B EQUIPMENT TYPE. * LDA B100 SET DEFAULT TO M.T. DEVICE. CPB B2 XOR B1100 PUNCHED TAPE - TRAILER. CPB D10 IOR B1100 LINE PRINTER - PAGE EJECT. IOR P2 INSERT LOGICAL UNIT. STA TEMP * JSB DEXEC PERFORM I/O CONTROL. DEF *+5 DEF MODE DEF B3 DEF TEMP FORMATTED CONTROL WORD. DEF MD1 USED ONLY FOR LP. * JMP M0950 GO CLOSE FILE. HED REMAC: EX REQUEST * (C) HEWLETT PACKARD CO. 1976 * * EX PROCESSOR * * TERMINATE THE OPERATOR INTERFACE PROGRAM. * M0500 JSB EXEC DISPLAY TERMINATION MESSAGE DEF *+5 ON LOG DEVICE. DEF B2 DEF LOGLU DEF TRMSG DEF B6 * JSB CLSFL CLOSE OPEN FILES. * JSB EXEC EXIT. DEF *+2 DEF B6 * TRMSG ASC 6, $END REMAC HED REMAC: PU REQUEST * (C) HEWLETT PACKARD CO. 1976 * * PU,FLNAME,SECURITY,LABEL * * PURGE A CENTRAL STATION FILE. * M0700 LDB CP1 ERROR IF NO FILE NAME. JSB ASCHK * JSB PURGE PURGE THE FILE. DEF *+6 DEF UDCB DEF IERR DEF P1 FILE NAME. DEF P2 SECURITY CODE. DEF P3 LABEL. * LDA IERR SSA JSB ERCHK CHECK FOR ERRORS. JMP QUERY HED REMAC: RE REQUEST * (C) HEWLETT PACKARD CO. 1976 * * RE,OLDNAM,NEWNAM,SECURITY,LABEL * * RENAME A FILE AT THE CENTRAL STATION. * M0800 LDB CP1 ERROR IF NO FILE NAMES. JSB ASCHK LDB CP2 JSB ASCHK * JSB NAMF RENAME THE FILE. DEF *+7 DEF UDCB DEF IERR DEF P1 OLD FILE NAME. DEF P2 NEW FILE NAME. DEF P3 SECURITY. DEF P4 LABEL. * JSB ERCHK CHECK FOR ERRORS. * JMP QUERY HED REMAC: ST REQUEST * (C) HEWLETT PACKARD CO. 1976 * * ST,LU,FLNAME,SECURITY,LABEL,TYPE,#BLOCKS,RECSIZE * * STORE FROM SATELLITE LU ONTO CENTRAL DISC FILE. * M0900 LDB CP2 CHECK SECOND PARAM. SZB,RSS IF NOT GIVEN, ASSUME JMP OTHER RTE STATUS COMMAND. * LDB CP2 ERROR IF FILE NAME JSB ASCHK PARAM NOT ASCII. * LDA B3 DEFAULT FILE TYPE TO 3. LDB P5 SZB,RSS STA P5 * LDA D56 ERROR IF NEGATIVE # BLOCKS. LDB P6 SSB JMP OPERS LDA D10 DEFAULT # BLOCKS TO 10. SZB,RSS STA P6 * LDB CP1 ERROR IF NO LU. JSB INTCK * * CREATE THE CENTRAL DISC FILE. * JSB CREAT CREATE FILE. DEF *+8 DEF UDCB DEF IERR DEF P2 FILE NAME. DEF P6 # BLOCKS. DEF P5 FILE TYPE. DEF P3 SECURITY CODE. DEF P4 LABEL. * LDA IERR CHECK FOR ERRORS IF IERR NEG. SSA JSB ERCHK LDA OPNFL SET UDCB OPEN FLAG. ELA,CLE,ERA IOR HIBIT STA OPNFL * * READ INPUT FROM SATELLITE LOGICAL UNIT. * LDA P1 DETERMINE DEVICE TYPE. LDB MODE JSB EQTYP STA LUTYP SAVE DEVICE TYPE. SZA IF TTY, |JMP M0905 LDA P1 SET ECHO BIT. IOR B400 STA P1 JMP M0910 * M0905 LDA P1 IF FILE TYPE 5 OR 7, IOR B300 SET V AND M BITS. LDB P5 CPB B5 JMP *+3 IOR B2000 IF 7, SET HONESTY BIT. CPB B7 STA P1 * M0910 LDA LUTYP IF DEVICE IS A TTY, SZA DISPLAY INPUT PROMPT CHAR. JMP M0920 * JSB DEXEC IT IS. DISPLAY PROMPT, BECAUSE DEF *+6 OF PERCEPTIBLE DELAY BETWEEN DEF MODE DEF B2 RECORDS. DEF B1 DEF IPRMP ASCII SLASH, SPACE. DEF MD3 * M0920 JSB DEXEC READ THE INPUT RECORD. DEF *+6 DEF MODE DEF B1 DEF P1 LOGICAL UNIT. DEF INBUF DEF D128 * STA TEMP SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. * * CHECK FOR INPUT END OF FILE. * LDA MODE SET UP MODE. JSB EOFCK JMP M0950 GOT IT. LDA INCNT IGNORE NULL NON-CARD INPUT. SZA,RSS JMP M0910 * * WRITE THE RECORD ON CENTRAL DISC FILE. * JSB WRITF DEF *+5 DEF UDCB DEF IERR DEF INBUF DEF INCNT * LDA IERR CHECK FOR ERRORS. SSA,RSS JMP M0910 NONE. GO READ NEXT RECORD. * JSB PURGE ERROR. PURGE FILE. DEF *+6 DEF UDCB DEF TEMP DEF P2 FILE NAME. DEF P3 SECURITY. DEF P4 LABEL. * LDA OPNFL OUTPUT ERROR MESSAGE. ELA,CLE,ERA STA OPNFL JSB ERCHK * * END OF FILE ON INPUT. * M0950 JSB CLOSE CLOSE THE CENTRAL FILE. DEF *+3 DEF UDCB DEF IERR * LDA OPNFL CLEAR UDCB OPEN FLAG. ELA,CLE,ERA STA OPNFL * JMP QUERY B@< 15. * LDA P1 SZA,RSS JMP SETTC INFINITE TIME-OUT. MPY D500 FINITE TIME-OUT. CONVERT CMA,INA TO TENS OF MILLISECONDS. * SETTC JSB $LIBR NOP STA %TMOT STORE NEW TIME-OUT. JSB $LIBX DEF *+1 DEF QUERY RETURN TO OPERATOR. * ZERO ASC 1, 0 TOVAL ASC 3,TC= HED REMAC: TR,XXXXXX REQUEST * (C) HEWLETT PACKARD CO. 1976 * * TR,XXXXXX PROCESSOR. * * TRANSFER CONTROL TO LOCAL LU OR REMOTE FILE. * M1200 LDA P.STK,I IF CURRENT INPUT IS FROM A AND HB377 CENTRAL FILE, CLOSE IT. SZA,RSS JMP M1210 * JSB CLOSE DEF *+3 DEF IDCB DEF IERR * LDA OPNFL ERA,CLE,ELA CLEAR IDCB OPEN FLAG. STA OPNFL * M1210 LDA P1 GET PARAM 1. SZA,RSS IF NOT SPECIFIED, CCA SIMULATE "TR,-1". * SSA,RSS NEGATIVE INTEGER? JMP M1220 NO. * * BACK UP THROUGH TRANSFER STACK. * LDB P.STK TOP OF STACK? BKUP CPB STKHD JMP M0500 YES. SIMULATE "EX" REQUEST. ADB MD4 NO. BACK UP 1 ENTRY. INA,SZA JMP BKUP LOOP TILL DONE. STB P.STK SET NEW STACK ADDRESS. JMP M1250 GO CHECK FOR CENTRAL FILE. * * ADD NEW CONTROL TO THE TRANSFER STACK. * M1220 LDA P.STK BUMP TO NEXT ENTRY. ADA B4 STA P.STK CPA STKEN RSS JMP M1230 * LDA D13 STACK OVERFLOW. ERROR 013. JMP OPERS * M1230 LDB P1 STORE LU OR FILE NAME. STB A,I INA LDB P1+1 STB A,I INA LDB P1+2 STB A,I INA CLB,INB SET RECORD NUMBER TO 1. STB A,I * * IF CENTRAL FILE, OPEN AND OPTIONALLY P^OSITION. * M1250 LDA P.STK,I AND HB377 SZA,RSS JMP QUERY LOCAL LU. GO GET NEXT REQUEST. * JSB OPEN OPEN THE FILE. DEF *+4 DEF IDCB DEF IERR DEF P.STK,I * LDA IERR PROCESS ERRORS ONLY IF SSA IERR IS NEGATIVE. JSB ERCHK ISZ OPNFL SET OPEN FLAG. * LDA P.STK POSITIONING REQUIRED? ADA B3 LDB A,I CPB B1 (REC. CNT MORE THAN 1?) JMP QUERY NO. STB TEMP YES. * JSB POSNT POSITION TO NEXT RECORD. DEF *+5 DEF IDCB DEF IERR DEF TEMP NUR GREATER THAN ZERO. DEF TEMP ABSOLUTE RECORD NUMBER. * JSB ERCHK CHECK FOR ERRORS. JMP QUERY * * TRANSFER STACK. * * FOR EACH ENTRY, WORD 1 = INTEGER LU OR * FIRST 2 FNAME CHAR. * WORD 2,3 = REST OF FNAME. * WORD 4 = NEXT RECORD NUMBER. * P.STK NOP STACK POINTER. STKHD DEF *+1 * BSS 32 8 ENTRIES. * STKEN DEF * STACK LWA+1. HED REMAC: SPECIAL REQUEST * (C) HEWLETT PACKARD CO. 1976 * * $$ * * UNDOCUMENTED COMMAND TO DISPLAY (ON LU 1) A CENTRAL FILE * CONTAINING A USER-PREPARED LIST OF REMAC REQUESTS, ETC. * ASSUMES THE FILE IS NAMED "$REMAC". * M1300 LDA RMCMD SIMULATE A $DU,1,$REMAC. STA P1 LDA RMCMD+1 FILE NAME = "$REMAC". STA P1+1 LDA RMCMD+2 STA P1+2 LDA B1 STA P2 LU = 1. * JMP M0405 GO INTO DU PROCESSOR. * * RMCMD ASC 3,$REMAC HED EMAC: SUBROUTINE SECTION * (C) HEWLETT PACKARD CO. 1976 * * SUBROUTINE TO TEST FOR END OF FILE ON LOCAL DEVICES. * * TEMP = EQT STATUS WORD. * INCNT = EQT WORD COUNT. * LUTYP = EQUIPMENT TYPE. * (A) = 0 FOR CENTRAL, N FOR LOCAL. * JSB EOFCK * EOF RETURN * NORMAL RETURN * EOFCK NOP STA MODEX CLE LDA LUTYP 8 EOF DEPENDS ON DEVICE. SZA,RSS JMP EOF1 TTY. CPA B1 JMP EOF1 PHOTOREADER. CPA D9 JMP EOF4 CARD READER. CPA D13 JMP EOF4 MARK SENSE. CCE DEFAULT TO MAG TAPE. * EOF1 LDA TEMP GET STATUS WORD. ALF,ALF SEZ,RSS IF E=1, CHECK BIT 7. JMP EOF2 SSA JMP EOF3 EOF2 RAL,RAL CHECK BIT 5. SSA,RSS JMP EOF5 NO EOF. * EOF3 LDA LUTYP END OF FILE. SZA IF TTY, OUTPUT CAR. RET. JMP EOF6 * JSB DEXEC DEF *+6 DEF MODEX DEF B2 DEF B1 DEF CR DEF B1 * JMP EOF6 * EOF4 LDA INCNT CHECK FOR BLANK CARD. SZA EOF5 ISZ EOFCK EOF6 JMP EOFCK,I * * SUBROUTINE TO CHECK FOR ASCII PARAMETER. * ASCHK NOP (B) = CODE WORD. LDA D55 SZB,RSS JMP OPERS ERROR 55 IF MISSING. LDA D56 ADB MD2 SZB JMP OPERS ERROR 56 IF NOT ASCII. JMP ASCHK,I * * SUBROUTINE TO CHECK INTEGER PARAMETERS. * INTCK NOP (B) = CODE WORD. LDA D55 SZB,RSS JMP OPERS ERROR 55 IF MISSING. LDA D56 ADB MD1 SZB JMP OPERS ERROR 56 IF NOT NUMERIC. JMP INTCK,I * * SUBROUTINE TO FIND EQUIPMENT TYPE OF AN LU. * EQTYP NOP (A) = LU. (B) = MODE. STA TEMP1 STB MODEX SET UP MODE. * JSB DEXEC DEF *+5 DEF MODEX DEF D13 DEF TEMP1 DEF TEMP2 * LDA TEMP2 ALF,ALF AND B77 CPA B5 DVR05? RSS YES JMP EQTYP,I NO, RETURN. A=EQUIP-TYPE LDA DRT GET PTR TO DEV REF TABLE ADA TEMP1 ADD LU # ADA MD1 MINUS ONE. LDA A,I GET DRT ENTRY FOR THIS LU AND HB174 ISOLATE UNIT # SZA IF UNIT # = 0, RETURN LDA B5 WITH A = 0,  JMP EQTYP,I ELSE A = 5. * * SUBROUTINE TO PROCESS ERRORS IN RFA CALLS. * ERCHK NOP LDA IERR CAN BE POS. OR NEG. SZA,RSS JMP ERCHK,I NO ERROR. * ERFND LDB BLANK MAKE POSITIVE, SET SIGN WORD. SSA,RSS JMP ERCK1 LDB MINUS CMA,INA ERCK1 STB EMSG+3 * CCE DECIMAL CONVERSION. JSB $CVT3 CONVERT TO ASCII. STA B * ADB B2 STORE LAST 2 DIGITS LDA B,I IN MESSAGE BUFFER. IOR LB20 LEADING BLANK TO ASCII 0. STA EMSG+4 ADB MD1 LDA B,I SET UP SIGN AND AND B377 FIRST DIGIT. IOR EMSG+3 IOR B20 LEADING BLANK TO ASCII 0. STA EMSG+3 STORE IN MESSAGE BUFFER. * LDA STKHD RESET STACK POINTER. STA P.STK * JSB EXEC DISPLAY ERROR MESSAGE. DEF *+5 DEF B2 DEF LOGLU DEF EMSG DEF B5 * JSB CLSFL CLOSE FILES CURRENTLY OPEN. * LDA LUTYP SZA,RSS JMP QUERY * LDA A.$TR GENERATE $TR,1 STA INBUF LDA A.TR1 STA INBUF+1 LDA A.TR1+1 STA INBUF+2 LDA B3 STA INCNT JMP ECHO * EMSG ASC 5,REMAC * * SUBROUTINE TO CLOSE THE COMMAND FILE OPEN TO IDCB, * OR USER FILE OPEN TO UDCB IF EITHER OR BOTH ARE OPEN. * CLSFL NOP LDA OPNFL SZA,RSS JMP CLSFL,I BOTH DCB'S ARE CLOSED. * SLA,RSS JMP CLOS2 IDCB NOT OPEN. * JSB CLOSE CLOSE THE COMMAND FILE. DEF *+3 DEF IDCB DEF IERR * LDA OPNFL CLOS2 SSA,RSS JMP CLOS3 UDCB NOT OPEN. * JSB CLOSE CLOSE THE USER FILE. DEF *+3 DEF UDCB DEF IERR * CLOS3 CLA STA OPNFL CLEAR OPEN FLAGS. JMP CLSFL,I RETURN. HED REMAC: PARSE ROUTINE * (C) HEWLETT PACKARD CO. 1976 * * THIS IN-LINE CODE MAY BE OMITTED WHEN RESIDENT * VERSIO=N IS AVAILABLE TO USER PROGRAMS. * $PARS NOP CLE,ELA MAKE CHARACTER ADDR. STA TEMPP SET BUFFER CHAR ADDR. ADA B COMPUTE END ADDRESS. STA TEMP3 SET IT. LDB DM32 CLEAR PARAMETER AREA. STB TEMP LDB $PARS,I CLA MES1 STA B,I INB ISZ TEMP JMP MES1 * STA B,I CLEAR THE PARAM COUNT. STB WSTAT SET ADDRESS OF PARAM COUNT. DEC09 LDA TBUF INITIALIZE TEMP BUFFER ADDRESS. STA TEMP1 STA TEMP2 * DEC10 LDB TEMPP GET THE BUFFER CHAR ADDRESS. CPB TEMP3 IF NO MORE CHARACTERS JMP DEC60 GO PROCESS PARAM. ISZ TEMPP STEP INPUT POINTER. CLE,ERB CONVERT TO WORD. SET UP LOW. LDA B,I GET WORD FROM THE BUFFER. SEZ,RSS CHECK IF TO EXAMINE UPPER/LOWER ALF,ALF UPPER, SO ROTATE. AND B377 MASK OFF ALL BUT LOW ORDER. CPA COM SEE IF A COMMA JMP DEC60 YES. CPA LASCI CHECK IF BLANK CHARACTER. JMP DEC10 YES, SO SKIP CHARACTER. LDB TEMP2 CHECK IF 6 CHARACTERS IN PRAM. CPB TBUFS IF SO JMP DEC10 SKIP STORE. STA TEMP2,I STORE THE CHARACTER. STA SABRT SAVE THE LAST CHARACTER. ISZ TEMP2 STEP FOR NEXT CHAR. * JMP DEC10 GO TO PROCESS NEXT CHARACTER. * * ATTEMPT NUMERIC CONVERSION OF PARAM. * DEC60 LDA WSTAT,I FIRST SET UP POINTERS. RAL,RAL TAKE 4 TIMES THE PARAM NUMBER ADA $PARS,I PLUS THE OP CODE ADDR-1. STA TEMP SET FLAG ADRR. CLE,INA ONE MORE AND WE HAVE STA VALOC THE PARAMETER VALUE LOCATION. LDA TBUF IF NO CHARACTERS CPA TEMP2 INPUT JMP DEC70 GO TRY NEXT ONE. * * NOW TRY FOR A NUMBER * CCB,CLE CHECK FOR LEADING -. LDA TEMP1,I CPA MIN NEGATIVE? CLB,CCE YES, SET P1OR2 TO 0. STB P1OR2 PO?S. SET P1OR2 TO -1. SEZ,CLE WAS IT MINUS? ISZ TEMP1 YES, INCR TO NEXT CHAR. * LDB D10 SET UP THE CONVERSION LDA SABRT BASE. CPA "B" IF B SUFFIX LDB D8 SET FOR BASE 8. STB TEMP4 SET BASE. ISZ TEMP,I SET FLAG TO 1 FOR NUMBER. DEC65 MPY VALOC,I BUMP THE CURRENT VALUE. VALOC EQU *-1 LDB TEMP1,I GET THE NEXT CHAR. ADB DM58 IF GREATER THAN "9" SEZ,CLE,RSS THEN NOT A NUMBER. ADB D10 IF LESS THAN "0" SEZ,CLE,RSS THEN JMP DEC80 NOT A NUMBER ADA B ACCUMULATE THE STA VALOC,I NUMBER. ISZ TEMP1 STEP THE BUFFER ADDRESS. LDA TEMP4 GET THE BASE TO A LDB TEMP1 AND THE NEXT CHAR. LOC. TO B CPB TEMP2 IF END THEN JMP DEC70 GO TO NEXT PARAM. * INB IF BASE 8 CONVERSION CPB TEMP2 AND LAST CPA D10 CHAR. THEN DONE SO SKIP JMP DEC65 ELSE GO GET THE NEXT ONE. * DEC70 LDB VALOC,I CHECK FOR NEGATIVE PARAM. ISZ P1OR2 CMB,INB STB VALOC,I ISZ WSTAT,I COUNT THE PARAMETER. LDA WSTAT,I IF LDB TEMP3 EOL OR CPB TEMPP 8 PARAMS LINE RSS THEN CPA D8 JMP DEC90 GO PROCESS. JMP DEC09 ELSE GO GET NEXT CHARACTER. * DEC80 ISZ TEMP,I SET NOT NUMBER FLAG. LDA AASCI FILL THE PARAM WITH BLANKS. LDB VALOC PARAM ADDRESS TO B. INB DON'T WORRY ABOUT FIRST WORD. STA B,I SET SECOND WORD. CLE,INB STEP TO THIRD WORD. STA B,I SET THIRD WORD TO DOUBLE BLANK. LDB TBUF GET THE TEMP BUFFER POINTER. DEC85 CPB TEMP2 END OF INPUT? JMP DEC70 YES, GO PROCESS NEXT PARAM. CPB STOP 6TH CHAR?. JMP DEC70 YES, END OF PARAM. LDA B,I GET THE CHARACTER. SEZ,RSS IF UPPER CHARACTER ALF,SLA,ALF ROTATE AND SKIP. XOR VALOC,I LOWER ADD THE UPPER CHAR. XOR LASCI ADD/DELETE THE LOWER BLANK. STA VALOC,I STORE THE PACKED WORD. SEZ,CME,INB STEP B, SKIP IF UPPER ISZ VALOC ELSE STEP STORE ADDRESS. JMP DEC85 GO GET OTHER CHAR. * DEC90 ISZ $PARS STEP RETURN ADDRESS. JMP $PARS,I RETURN. * * CONSTANTS & WORKING STORAGE USED ONLY BY $PARS, $CVT3. * PTT DEF ASCI TBUFS BSS 0 PTTE DEF ASCI2 TBUF DEF *+1 BSS 4 ASCI NOP ASCI1 NOP ASCI2 NOP WSTAT NOP TEMPP NOP SABRT NOP DF10 DEF D10 AASCI OCT 020040 "B" OCT 102 ASCII "B". LASCI OCT 000040 DM32 DEC -32 MIN OCT 55 P1OR2 NOP STOP DEF ASCI2 HED REMAC: BINARY TO ASCII CONVERSION * (C) HEWLETT PACKARD CO. 1976 * * THIS IN-LINE CODE MAY BE OMITTED WHEN RESIDENT * VERSION IS AVAILABLE TO USER PROGRAMS. * $CVT3 NOP STB TEMP SAVE B REGISTER. LDB PTTE INIT LOCATION OF BUFFER. STB TEMP1 LDB AASCI SET BUFFER=ASCII BLANKS. STB ASCI STB ASCI1 STB ASCI2 LDB DF10 ASSUME BASE TEN SEZ,CLE,RSS IF BASE EIGHT INB SET UP FOR BASE EIGHT. STB BASE SET CONVERSION BASE ADDRESS. DPCRL CLB START CONVERSION. DIV BASE DIVIDE BY BASE. BASE EQU *-1 DEFINE BY BASE ADDRESS. ADB B20 CONVERT TO ASCII-BLANK. SEZ IF HIGH DIGIT BLF,BLF ROTATE ADB TEMP1,I ADD CURRENT VALUE STB TEMP1,I STORE THE CONVERTED VALUE. CCB,SEZ PREPARE FOR SUBTRACT. ADB TEMP1 IF HIGH CHAR. BACKUP SEZ,CME BUFFER POINTER STB TEMP1 AND RESET. SZA IF MORE DIGITS JMP DPCRL GO SET THE NEXT ONE. * CCE SET E FOR NEXT CALL LDA PTT GET ASCII BUFFER ADDRESS. LDB TEMP RESTORE B. JMP $CVT3,I RETURN. HED REMAC: CONSTANTS AND WORKINGL640 STORAGE * (C) HEWLETT PACKARD CO. 1976 * PARAMETER STORAGE AREA. * DRT EQU 1652B DEV. REF. TABLE POINTER PRAMS NOP FLAG WORD. OP BSS 3 OPERATION CODE. CP1 NOP FLAG WORD. P1 BSS 3 PARAM 1 (UP TO 6 CHARACTERS). CP2 NOP P2 BSS 3 CP3 NOP P3 BSS 3 CP4 NOP P4 BSS 3 CP5 NOP P5 BSS 3 CP6 NOP P6 BSS 3 CP7 NOP P7 BSS 3 PARAM NOP PARAMETER COUNTER. * B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B20 OCT 20 B40 OCT 40 B77 OCT 77 B100 OCT 100 B377 OCT 377 B300 OCT 300 B400 OCT 400 B1000 OCT 1000 B1100 OCT 1100 B2000 OCT 2000 LB20 OCT 10000 HB377 OCT 177400 HB174 OCT 174000 HIBIT OCT 100000 MD1 DEC -1 MD2 DEC -2 MD3 DEC -3 MD4 DEC -4 MD16 DEC -16 MD22 DEC -22 MD25 DEC -25 DM58 DEC -58 D9 DEC 9 D10 DEC 10 D8 DEC 8 (MUST FOLLOW D10 FOR $CVT3) D13 DEC 13 D40 DEC 40 D55 DEC 55 D56 DEC 56 D128 DEC 128 D500 DEC 500 VBIT EQU D128 OPNFL NOP BIT 1 = IDCB; BIT 15 = UDCB. TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP INCNT NOP # WORDS IN INPUT REQUEST. LUTYP NOP EQ. TYPE OF INPUT DEVICE. LOGLU NOP LU OF LOG DEVICE. LSTLU NOP LU OF LIST DEVICE. SEVER NOP SEVERITY CODE. A.$TR ASC 2,$TR A.TR1 ASC 2,R,1 COM OCT 54 CR OCT 6400 AS.$ OCT 022000 IERR NOP PROMP ASC 1,$_ PROMPT CHARACTER. IPRMP ASC 2,/ _ BLANK OCT 020000 MINUS OCT 026400 DFALT DEF ALTBK ALTBK OCT 0,0,0,0 TRFLG NOP BUFAD DEF INBUF SRPLY DEF INBUF+100 INBUF BSS 128 BUFFER. IDCB BSS 4 UDCB BSS 4 * SIZE EQU * * END REMAC 26  91705-18110 1614 S 0122 DS1/B SCE/5 MODULE: @REFA              H0101 XASMB,R,L,C HED @REFA-REMOTE EXEC & FILE ACCESS *(C) HEWLETT-PACKARD CO. 1976* NAM @REFA,7 91705-16110 REV.A 760401 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * @REFA * SOURCE: 91705-18110 REV.A * BINARY: 91705-16110 REV.A * JIM HARTSELL * AUG. 30, 1974 * MODIFIED BY: C.C.H. (12-30-75) [DERIVED FROM: 91705-18010 REV.C] * * LIBRARY SUBROUTINE APPENDED TO RTE-C SATELLITE USER * PROGRAM FOR REMOTE EXEC, REMOTE FILE ACCESS, AND * MASTER PROGRAM TO PROGRAM CALLS TO THE CENTRAL STATION. * ENT DCRET,DPURG,DOPEN,DCLOS ENT DREAD,DWRIT,DPOSN,DWIND ENT DNAME,DCONT,DLOCF,DAPOS,DSTAT * ENT DEXEC * ENT POPEN,PREAD,PWRIT,PCONT,GETLU * ENT %DLST,%DNLD,%RMCN,%PRMB * EXT @QUE,@DEQ,EXEC,%LU,@DISP EXT $LIBR,$LIBX,%CPFL EXT $LIST,%LIST,$XEQ,$PVCN,%TMOT * A EQU 0 B EQU 1 * * * CREATE A CENTRAL FILE. * DCRET NOP JSB CQUE NO RETURN. CALL IS POINTER TO DEC 150 ENTRY POINT AND FUNCTION CODE. * * PURGE A CENTRAL FILE. * DPURG NOP JSB CQUE DEC 151 * * OPEN A CENTRAL FILE. * DOPEN NOP JSB CQUE DEC 152 * * WRITE ON CENTRAL FILE. * DWRIT NOP JSB CQUE DEC 153 * * READ FROM CENTRAL FILE. * DREAD NOP JSB CQUE SIGN BIT OF FCN CODE SET FOR OCT 100232 READ (FCN = 154). * * POSITION CENTRAL FILE. * DPOSN NOP JSB CQUE DEC 155 * * REWIND CENTRAL FILE. * DWIND NOP JSB CQUE DEC 156 * * CLOSE CENTRAL FILE. * DCLOS NOP JSB CQUE DEC 157 * * RENAME CENTRAL FILE. * DNAME NOP JSB CQUE DEC 158 * * CONTROL CENTRAL FILE. * DCONT NOP JSB CQUE DEC 159 * * LOCATE CENTRAL FILE RECORD. * DLOCF NOP JSB CQUE DEC 160 * * ABS POSITION CENTRAL FILE. * DAPOS NOP JSB CQUE DEC 161 * * READ CENTRAL FILE DIRECTORY. * DSTAT NOP JSB CQUE OCT 100242 READ CALL. FCN = 162. * * REMOTE EXEC CALLS * DEXEC NOP LDA DEXEC SAVE RETURN ADDRESS. STA NCALL INA LDB A,I GET IDEST ADDR. LDB B,I IDEST VALUE. SZB JMP LEXEC GENERATE LOCAL CALL. * INA GENERATE REMOTE CALL. LDA A,I GET REQUEST CODE ADDR. LDA A,I GET REQUEST CODE. ELA,CLE,ERA CLEAR SIGN BIT. LDB EFCN ELB,CLE CPA B1 IF READ DATA, SET SIGN BIT CCE IN FUNCTION CODE. ERB STB EFCN JMP *+2 NCALL NOP JSB CQUE EFCN OCT 243 FCN = 163. * * OPEN A CENTRAL PROGRAM. * POPEN NOP JSB CQUE DEC 1 * * READ FROM CENTRAL PROGRAM. * PREAD NOP JSB CQUE IWRT OCT 100002 READ CALL. FCN = 2. * * WRITE TO CENTRAL PROGRAM. * PWRIT NOP JSB CQUE DEC 3 * * CONTROL A CENTRAL PROGRAM. * PCONT NOP JSB CQUE DEC 4 * * GET CENTRAL LU OF THIS SATELLITE. * GETLU NOP JSB CQUE DEC 9 * * SPECIAL ENTRY POINT FOR REMAC. REQUEST A FORMATTED * DIRECTORY LIST PRINT LINE FROM THE CENTRAL STATION. * %DLST NOP JSB CQUE OCT 100012 FCN = 10. * * SPECIAL ENTRY POINT FOR APLDR. REQUEST AN ABSOLUTE * PROGRAM DATA RECORD FROM THE CENTRAL STATION DISC. * %DNLD NOP JSB CQUE DEC 0 * * SPECIAL ENTRY POINT FOR REMAC. SEND ASCII CENTRAL * OPERATOR COMMAND. * %RMCN NOP JSB CQUE DEC 200 SPC 3 * * DESTINATION CODE IN DEXEC CALL WAS NON-ZERO. GENERATE * LOCAL EXEC CALL FROM USER DEXEC CALL, EXECUTE IT, * AND RETURN TO USER WITH A,B INTACT. * LEXEC LDA DLC2 INITIALIZE RETURN ADDRESS. STA LCAL1 * LDA DEXEC GET # PARAMS TO MOVE. CMA ADA DEXEC,I ADA MD1 CMA,INA STA DLEN * LDA DEXEC SET UP MOVE POINTERS. ADA B2 STA PLEN LDA DLC2 STA DADR * LMOVE LDA PLEN,I MOVE CALL PARAMETERS. STA DADR,I ISZ LCAL1 BUMP NEW RETURN ADDR. ISZ PLEN ISZ DADR ISZ DLEN JMP LMOVE * LDA DEXEC,I SET UP RETURN ADDRESS. STA DEXEC * DLD RINST DST DADR,I SET UP RETURNS TO USER. ISZ DADR ISZ DADR STA DADR,I * JSB EXEC EXECUTE LOCAL CALL. LCAL1 NOP LCAL2 NOP RCODE GOES HERE. BSS 6 ROOM FOR 6 MORE PARAMS. NOP SLOP ROOM FOR JMP DEXEC,I NOP (ERROR & NORMAL EXITS) * * DLC2 DEF LCAL2 * * DO NOT CHANGE ORDER OF NEXT TWO STATEMENTS * * RINST JMP DEXEC,I ISZ DEXEC * SKP * WHEN CQUE IS CALLED, THE ADDRESS OF THE USER * CALL AND THE FUNCTION CODE CAN BE DETERMINED * VIA THE ENTRY POINT CONTENTS. * CQUE NOP LDA CQUE,I FETCH FUNCTION CODE. CLB CHECK SIGN BIT. SSA INB STB RDATA SET "READ DATA" FLAG. ELA,CLE,ERA CLEAR SIGN BIT. STA FCN LDA CQUE FETCH USER CALL ADDRESS. ADA MD2 LDA A,I STA CALL RQUE CLA CLEAR DATA BUFR ADDR. STA DADR * * BUILD AND QUEUE THE PARMB. * QUE JSB @QUE FCN NOP FUNCTION CODE. CALL NOP ADDR OF USER CALL. DEF PARMB PARAMETER BUFFER. DEF REPLY REPLY BUFFER. DEF DADR RETURNED DATA BUFR ADDR OR 0. DEF DLEN RETURNED DATA BUFR LENGTH. DEF PLEN RETURNED PARMB LENGTH. * JMP REJ REQUEST REJECTED. GO COMPLETE. *  STB QENT ACCEPTED. SAVE ENTRY ADDRESS. * * THE PARMB IS NOW QUEUED AND READY. FORMAT EXEC CALL * FOR TRANSMISSION, BUT DON'T EXECUTE YET. * LDA IWRT WRITE--NO ABORT. (100002B) STA IRW SET FOR "TRANSMIT ONLY". CLB CPB DADR IS THERE ANY DATA? (SKIP IF TRUE) JMP CONST NO. GO TO FORM CONWORD WITH MODE =0. LDA FCN ARS CPA B1 IS FUNCTION PREAD OR PWRIT? JMP CONST YES, DO REQ. ONLY NOW * * SET UP MODE BITS(#6,7) FOR THE REQUEST & DATA CALL TO DVR65. * LDB IRW GET THE REQUEST CODE. LDA RDATA GET THE "READ DATA" FLAG. SZA IS DATA TO BE READ? ADB MD1 YES. SET REQUEST CODE =1--READ. STB IRW SAVE THE REQUEST CODE. BLR,CLE,RBL POSITION THE DRIVER-MODE INFORMATION BLF TO BITS# 6,7. CONST LDA %LU GET THE LOGICAL UNIT NUMBER. IOR 1 FORM THE CONFIGURED CONWORD, STA CONWD AND SAVE FOR THE CALL TO THE DRIVER. LDA MD4 INITIALIZE THE STA BUZY REMOTE-BUSY RETRY COUNTER. LDA MD10 INITIALIZE THE STA RTRY DRIVER-BUSY RETRY COUNTER. * * REQUEST PERMISSION TO TRANSMIT THE PARMB TO CENTRAL. * DISP CLA SIGNAL PARMB NOT SENT YET. STA SNFLG LDA %TMOT SET UP FOR TIME-OUT. SZA,RSS CLA,INA STA TIME * JSB @DISP SZA (A) = 0 OR ADDR OF QUEUE ENTRY. JMP DISP1 * LDB QENT REPLY INTERRUPT MAY HAVE INB OCCURRED WHILE @DISP HAD LDB B,I INTERRUPTS OFF. SEE IF @INTR CPB B2 CAME THRU AND GAVE US JMP INIT PERMISSION. JMP ZONK * DISP1 CPA QENT OUR QUEUE ENTRY? JMP INIT YES. * STA DQENT NO. DEAD ENTRY, SO DE-QUE! JSB @DEQ DQENT NOP OCT 1 * NOP JMP DISP SEARCH QUEUE AGAIN. * * PERMISSION GRANTED. NO OTHER  REQUESTS ARE OUTSTANDING. * QUEUE ENTRY FLAG WORD = "PARMB SENT". * INIT LDA %CPFL CHECK IF LAST REQUEST FOUND SZA,RSS "LINE DOWN" CONDITION. JMP XMIT NO. * JSB EXEC YES. SCHED ENABL WITH WAIT. DEF *+4 DEF D9 DEF ENABL DEF AS.01 * CLA CLEAR FLAG. JSB STPFL * * XMIT JSB EXEC PERFORM TRANSMISSION. DEF *+7 DEF IRW DEF CONWD DEF PARMB DEF PARSZ DEF DADR POINT TO ADDR OF DATA BUFR(NO Z-BIT) DEF DLEN POINT TO LENGTH OF DATA BUFR(NO Z-BIT) JMP DOWN INFORM USER OF ABORTIVE ERROR. * * USER IN I/O SUSPEND DURING TRANSMISSION. * WHEN COMPLETE, CHECK FOR ERRORS. * DST XSTAT (DEBUG AID ONLY) SLA,RAR JMP GOOD NO ERRORS. * SWP AND B40 ISOLATE EQT12 BIT#5 (REMOTE BUSY). CLE,ERB MOVE BUSY-REJECT BIT(EQT5 #1) TO . SEZ,SZA,RSS BUSY-REJECT/REMOTE BUSY OR BOTH? JMP DOWN NEITHER--DRIVER ERROR! SEZ,RSS WAS THE REMOTE SYSTEM BUSY? JMP BZWT YES. GO TO WAIT A WHILE. SZA NO. SIMULTANEOUS REQUESTS? JMP XMIT YES. LET DVR65 RESOLVE PROBLEM. JMP DELAY DRIVER BUSY--DELAY & RE-CALL. * BZWT ISZ BUZY O.K. TO RE-TRY? JMP ZONK YES. DO SO VIA WAIT LIST. JMP FAIL NO. REPORT THE ERROR! * QKNAP LDA T100M PROBABLY APLDR TRYING TO STA TIME READ DATA FROM CENTRAL. JMP ZONK * DELAY ISZ RTRY DELAY FOR A WHILE, IF RETRIES VALID. JMP QKNAP VALID: TRY AGAIN, IN 100 MSEC; ELSE, FAIL LDA MD103 GIVE UP! JMP DOWN1 * GOOD ISZ SNFLG SIGNAL PARMB SENT. * * THE PARMB HAS BEEN SENT, OR SOMEONE ELSE IS PENDING A REPLY. * SUSPEND THIS USER VIA THE OPERATOR SUSPEND LIST UNTIL A * REPLY ARRIVES OR TIME-OUT OCCURS. THE SCE/5 @CLCK MODULE * WILL RESTART THE USER. * * BEFORE SUSPENDIN.G, ESTABLISH AN ENTRY IN THE WAIT-LIST. * ZONK LDB %LIST LDA 1,I NEG. # ENTRIES. STA TEMP INB * WLOOP LDA 1,I CHECK TIME WORD. SZA,RSS ZERO? JMP SWAIT YES. FOUND EMPTY ENTRY. * ADB B5 ISZ TEMP JMP WLOOP JMP FAIL NONE. SYSTEM FAILURE. * SWAIT STB TEMP1 JSB $LIBR NOP LDA TIME STORE TIME VALUE IN WORD 1. STA TEMP1,I ISZ TEMP1 LDA XEQT,I STORE PROGRAM NAME. ADA D12 STA TEMP ADDR OF NAME IN ID SEG. * LDB MD3 MLOOP LDA TEMP,I STA TEMP1,I ISZ TEMP ISZ TEMP1 INB,SZB JMP MLOOP * LDA XEQT,I STORE ID SEG ADDR. STA TEMP1,I * STA IDSG SUSPEND THE USER. LDA DEFX STA XSUSP,I * CLA PRIVILEDGED MODE. STA $PVCN * JSB $LIST OCT 106 IDSG NOP * JMP $XEQ GIVE UP CPU. DEFX DEF AWAKE RESTART ADDRESS. * * USER HAS BEEN RE-SCHEDULED FROM POINT OF SUSPENSION. * AWAKE LDA QENT REPLY RECEIVED? INA LDA A,I CPA B3 JMP COMPX YES, GO COMPLETE USER CALL. CPA B1 NO. DID WE SEND PARMB? JMP DISP NO. TRY PERMISSION AGAIN. CPA B2 RETRY IF QUEUE WAS FULL. JMP *+2 JMP QUE LDA SNFLG WAS IT A TIME-OUT? SZA JMP DOWN YES. LDA %TMOT NO. PERMISSION HAS BEEN SZA,RSS CLA,INA STA TIME GRANTED TO SEND PARMB. JMP INIT * * CENTRAL MUST HAVE GONE DOWN. SET ERROR CODE * IN REPLY BUFFER FOR @DEQ. * DOWN LDA MD51 JSB STPFL DOWN1 LDB FCN STORE IN A-REG SLOT ADB MD11 FOR RFA/DEXEC; SSB,RSS IERR SLOT FOR PTOPC, DLIST, DNLD. JMP DOWN2 STA REPLY+3 JMP COMPL DOWN2 STA REPLY+2 JMP COMPL * * COMPLETE A REJECTED OR INCOMPLETE REQUEST. * REJ STB QENT  CPA MD1 QUEUE FULL? JMP QKNAP YES, LET SOMEONE COMPLETE A REQUEST JMP COMPL NO. * * REPLY HAS BEEN RECEIVED. * PERFORM COMPLETION PROCESSING. * COMPX LDA IWRT WRITE--NO ABORT. (100002B) LDB FCN FUNCTION CODE CPB B3 IS IT A PWRIT? JMP PDATA YES CPB B2 IS IT A PREAD? RSS YES JMP COMPL PERFORM COMPLETION PROCESSING ADA MD1 FORM READ-REQUEST--NO ABORT. * * P TO P DATA TRANSFERS * PDATA STA IRW SET READ/WRITE TYPE LDA %LU IOR B300 DATA ONLY STA CONWD CONTROL WORD * LDA QENT ADDR OF QUEUE ENTRY ADA D10 POINT TO ITS TIME-TAGS STA TITAG SAVE ADDR FOR DATA ONLY CALL INA STA TITAG+1 & ADDR OF 2ND TIME-TAG * JSB EXEC CALL DRIVER TO DO DATA NOW DEF *+7 DEF IRW DEF CONWD DEF DADR,I DEF DLEN TITAG NOP NOP JMP DOWN DRIVER ERROR DETECTED. * SLA,RSS JMP DOWN ERROR OCCURRED * COMPL LDA CALL,I SET RETURN ADDRESS. STA TEMP * JSB @DEQ QENT NOP ADDR OF QUEUE ENTRY. OCT 0 NORMAL PROCESSING. * JMP DSPLY ERROR RETURN. SEZ NORMAL RETURN. ISZ TEMP IF E=1, BUMP RETURN ADDR. JMP TEMP,I * SKP * * AN ERROR RETURN FROM @DEQ INDICATES SPECIAL * COMPLETION PROCESSING. * (A)= 0: DISPLAY REPLY BUFFER AND TERMINATE. * (A)= 1: DISPLAY REPLY BUFFER, SUSPEND, DE-QUE QUEUE * ENTRY AND REPEAT THE REQUEST. * DSPLY STA FLAG * JSB EXEC DISPLAY ERROR MESSAGE STORED DEF *+5 IN REPLY BUFFER BY @DEQ. DEF B2 DEF B1 LU 1. DEF REPLY DEF D17 * LDA FLAG CHECK FLAG. SZA JMP SUSP GO SUSPEND. * JSB EXEC ABORTIVE ERROR. DEF *+2 TERMINATE (ABORT) THE USER. DEF -m0.*B6 * SUSP JSB EXEC CENTRAL DOWN. SUSPEND UNTIL DEF *+2 RE-STARTED BY "GO" BY OPERATOR. DEF B7 * JMP RQUE RE-TRY THE REQUEST. * * STORE A-REG CONTENTS IN "LINE DOWN" FLAG. * STPFL NOP JSB $LIBR NOP STA %CPFL JSB $LIBX DEF STPFL SKP * CONSTANTS AND WORKING STORAGE. * XSUSP OCT 101730 XEQT OCT 1717 B1 OCT 1 B2 OCT 2 B3 OCT 3 B5 OCT 5 B6 OCT 6 B7 OCT 7 B40 OCT 40 B300 OCT 300 D9 DEC 9 D10 DEC 10 D12 DEC 12 D17 DEC 17 MD1 DEC -1 MD2 DEC -2 MD3 DEC -3 MD4 DEC -4 MD10 DEC -10 MD11 DEC -11 MD51 DEC -51 "LINE DOWN" ERROR CODE. MD103 DEC -103 XSTAT OCT 0,0 TIME NOP T100M EQU MD10 100 MS. WAIT. TEMP NOP TEMP1 NOP BUZY NOP BUSY-RE-TRY COUNTER. RTRY NOP FLAG NOP SNFLG OCT 0 RDATA NOP "READ DATA" FLAG. AS.01 ASC 1,01 ENABL ASC 3,ENABL * DADR NOP DATA BUFFER ADDRESS. DLEN NOP DATA LENGTH. PLEN NOP REQUEST LENGTH. * CONWD NOP CONFIGURED CONTROL WORD. DUMMY NOP DUMMY PARAMETER IRW NOP PARSZ DEC 35 PARAMETER BUFFER LENGTH %PRMB DEF PARMB PARMB BSS 35 PARAMETER BUFFER AREA. REPLY EQU PARMB REPLY BUFFER AREA. * SIZE EQU * * END *J0   91705-18111 1614 S 0122 DS1/B SCE/5 MOD @PTP SOURCE             H0101 ASMB,R,L,C HED @PTP 91705-16111 REV A *(C) HEWLETT-PACKARD CO 1976 NAM @PTP,7 91705-16111 REV A 760401 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * * @PTP * SOURCE: 91705-18111 REV.A * BINARY: 91705-16111 REV.A * JIM HARTSELL * JULY 30, 1974 * MODIFIED BY: C.WHELAN 11-18-75 * * LIBRARY SUBROUTINE APPENDED TO RTE-C SATELLITE USER * PROGRAM FOR SLAVE PROGRAM TO PROGRAM COMMUNICATION * WITH A CENTRAL STATION MASTER PROGRAM. * ENT GET,ACEPT,REJCT,FINIS * EXT EXEC,%LU,%MFLG,%MBOX,%CSID EXT $LIBR,$LIBX,$LIST,$XEQ EXT $PVCN * * * PROCESS "GET" CALL. * GET NOP LDA GET ADA B2 STA P.PTR POINTER TO USER PARAMS LDA GET,I STA GET SET RETURN ADDRESS * LDB IERR CLA STA IERR CLEAR SLAVE ERROR CODE. CPB MD47 COMM ERROR ON PREVIOUS TRY? JMP CLOLD YES, CLEAR OLD XACTION LDB MD46 CHECK CALL SEQUENCE. LDA NEXT SZA JMP SETER IMPROPER SEQUENCE. * SETPT LDB DFBOX POINTER TO PARMB MAILBOX. JSB INDCK ADB B2 MOVE TO WORD 3. STB M.PTR * * CHECK MAILBOX FOR PTOPC PARMB. * CHECK LDA %MFLG IS SOMETHING THERE? SZA JMP FLGUP YES. DON'T GO OP SUSP LIST. * * SUSPEND VIA THE OP SUSP LIST WHILE WAITING FOR THE * NEXT MASTER REQUEST. WHEN A REQUEST ARRIVES, @INTR * WILL RE-SCHEDULE THE USER. * JSB $LIBR NOP * LDA XEQT,I STA IDSG STA %CSID LDA DEFX STA XSUSP,I * CLA PRIVILEDGED MODE. STA $PVCN * JSB $LIST OCT 106 IDSG NOP * JMP $XEQ RELEASE CPU. DEFX DEF CHECK RESTART ADDRESS. * * PASS RETURN PARAMS TO USER. * SETER STB IERR FLGUP LDA IERR RETURN ERROR CODE. JSB RWORD SZA IF ERROR, DON'T PASS PARAMS. JMP GET,I * LDA M.PTR,I RETURN FUNCTION CODE. AND B7 STA FCN JSB RWORD * LDA M.PTR RETURN TAG TO USER. ADA B6 STA M.PTR LDA MD10 STA TEMP LDB P.PTR,I JSB INDCK * MLOOP LDA M.PTR,I MOVE 10 WORDS. STA 1,I ISZ M.PTR INB ISZ TEMP JMP MLOOP ISZ P.PTR * CLA IF READ/WRITE, RETURN LEN. LDB FCN CPB B2 LDA M.PTR,I CPB B3 LDA M.PTR,I JSB RWORD * CLA,INA SET SEQUENCE FLAG. STA NEXT * JMP GET,I RETURN TO USER. * CLOLD STA NEXT RESET SEQ INDICATOR JSB $LIBR NOP STA %MFLG CLEAR MAILBOX JSB $LIBX DEF *+1 DEF SETPT SKP * * PROCESS "ACEPT" AND "REJCT" CALLS. * REJCT NOP LDA REJCT STORE RETURN ADDR. STA ACEPT LDA BT15 BIT 15 = REJECT JMP ACPT * ACEPT NOP LDA BT14 BIT 14 = ACCEPT ACPT STA AC/RJ * LDA ACEPT POINTER TO USER PARAMS. INA STA P.PTR LDA ACEPT,I SET RETURN ADDRESS. STA ACEPT * CLB STB IERR CLEAR SLAVE ERROR CODE. STB JERR CLEAR MASTER ERROR CODE. * LDA MD46 CHECK CALL SEQUENCE. CPB NEXT JMP ERR IMPROPER SEQUENCE. * * CHECK FOR PREAD/PWRIT REQUEST. * LDB DFBOX GET FCN CODE FROM PARMB. JSB INDCK ADB B2 LDA 1,I AND B7 STA FCN LDB B100 CPA B3 JMP WRIT PWRIT REQ: RECEIVE DATA. CPA B2 BLS,SLB SET FOR SEND REQ & DATA, SKIP JMP NODAT POPEN/PCONT. * * PREAD/PWRIT: CHECK FOR REJECT. * WRIT LDA AC/RJ SSA JMP STOP REJECTED. GO SEND STOP. * ADB %LU STB CONWD SET CONTROL WORD FOR REQ. & DATA * * PREPARE TO SEND OR RECEIVE THE DATA BUFFER. * LDA P.PTR ACCEPTED. GET USER BUFR ADDR. ADA B2 LDB 0,I JSB INDCK STB BUFAD * LDB DFBOX GET BUFFER LENGTH. JSB INDCK ADB D18 LDA 1,I STA IDBFL JMP REP * * SEND STOP FOR REJECTED PREAD/PWRIT REQUEST. * STOP JSB EXEC DEF *+5 DEF ICNTL CONTROL--NO ABORT. DEF %LU DEF DUMMY DEF DUMMY JMP DOWN DRIVER ERROR DETECTED. * NODAT LDA %LU STA CONWD SEND REQUEST ONLY * * BUILD REPLY BUFFER (FOR ALL REQUESTS). * REP LDB DFBOX JSB INDCK LDA 1,I STORE STREAM, SUB-STREAM. IOR BTRPY SET REPLY & FRIENDLY BITS STA REPLY INB LDA 1,I STA REPLY+1 * LDA AC/RJ IOR FCN INSERT FUNCTION CODE. STA REPLY+2 * LDA JERR STORE ERROR CODE. STA REPLY+3 * LDA XEQT,I IF POPEN, STORE ID SEG LDB FCN ADDR IN WORD 6. CPB B1 (USED BY @INTR) STA REPLY+5 * LDB P.PTR,I MOVE TAG FROM USER CALL JSB INDCK STB TEMP TO REPLY BUFFER. * LDA DFTAG STA TEMP1 * LDB MD10 * TLOOP LDA TEMP,I STA TEMP1,I ISZ TEMP ISZ TEMP1 INB,SZB JMP TLOOP * STB REPLY+4 CLEAR UNUSED WORDS STB REPLY+6 STB REPLY+7 * LDB DFBOX GET THE ADDRESS OF THE ORIGINAL PARMB. JSB INDCK TRACK DOWN A DIRECT ADDRESS. ADB D33 POINT TO THE TIME-TAG WORD. DLD 1,I GET THE ORIGINAL TIME-TAGS, DST REPLY+33 AND ADD THEM TO THE REPLY. LDA CONWD AND B300 LDB B2 WRITE CODE CPA ^B100 IS IT A SEND REQ & READ DATA? CLB,INB YES, SET READ CODE ADB BT15 ADD THE NO-ABORT FLAG, ALSO. STB IRW LDA MD10 STA RETRY SET RETRY COUNT * DVTRY JSB EXEC TRANSMIT REPLY (AND DATA) DEF *+7 DEF IRW DEF CONWD DEF REPLY DEF D35 DEF BUFAD DEF IDBFL JMP DOWN DRIVER ERROR DETECTED. * SLA,RAR JMP CLSEQ NO ERRORS. * SWP AND B40 ISOLATE EQT12 BIT#5 (REMOTE BUSY) CLE,ERB SEZ,SZA,RSS BUSY-REJECT/REMOTE BUSY OR BOTH? JMP DOWN NEITHER, DRIVER ERROR SEZ,RSS WAS THE REMOTE SYSTEM BUSY? JMP BZWT YES, WAIT A WHILE SZA NO, SIMULTANEOUS REQUEST? JMP DVTRY YES, LET DVR65 RESOLVE PROBLEM JMP WAIT DRIVER BUSY * BZWT ISZ RETRY OK TO RETRY? RSS YES JMP DOWN NO LDB MD90 900 MSEC DELAY RSS WAIT LDB MD9 90 MSEC DELAY STB OFSET * JSB EXEC INTO TIME LIST & SUSPEND DEF *+6 DEF D12 DEF B0 DEF B1 DEF B0 DEF OFSET JMP DVTRY * CLSEQ AND B10 CHECK FOR RECEIVED STOP SZA,RSS SKIP IF STOP RCVD JMP *+3 OTHERWISE RETURN GOOD STATUS * DOWN LDA MD47 RETURN COMMUNICATIONS ERROR ERR STA IERR * ISZ P.PTR JSB RWORD SSA SKIP IF NO ERROR JMP ACEPT,I * CLA CLEAR SEQUENCE FLAG. STA NEXT * JSB $LIBR B0 NOP CLA CLEAR MAILBOX FLAG. STA %MFLG JSB $LIBX DEF ACEPT RETURN TO USER. * * FINIS CALL. * FINIS NOP CLA STA IERR JSB $LIBR NOP STA %CSID CLEAR MAILBOX FLAG AND STA %MFLG CURRENT SLAVE ID SEG ADDR. JSB $LIBX DEF FINIS,I * PASS A-REG CONTENTS TO USER PARAM, BUMP P.PTR. * RWORD NOP  LDB P.PTR,I JSB INDCK STA 1,I ISZ P.PTR JMP RWORD,I * * RESOLVE INDIRECT PARAMETER ADDRESSES. * INDCK NOP RSS LDB 1,I RBL,CLE,SLB,ERB JMP *-2 JMP INDCK,I SKP * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B2 OCT 2 B3 OCT 3 B6 OCT 6 B7 OCT 7 B10 OCT 10 B40 OCT 40 B100 OCT 100 B300 OCT 300 D12 DEC 12 D18 DEC 18 D33 DEC 33 D35 DEC 35 MD9 DEC -9 MD10 DEC -10 MD46 DEC -46 MD47 DEC -47 MD90 DEC -90 BT14 OCT 40000 BT15 OCT 100000 ICNTL OCT 100003 OFSET NOP RETRY NOP DUMMY NOP DUMMY PARAMETER FOR DVR65 COMPATABILITY. CONWD NOP BTRPY OCT 44000 BIT 14= REPLY, BIT 11= FRIENDLY XSUSP OCT 101730 XEQT OCT 1717 TEMP NOP TEMP1 NOP BUFAD NOP NEXT NOP FCN NOP IERR NOP ERR CODE RETURNED TO SLAVE. JERR NOP ERR CODE RETURNED TO CENTRAL. P.PTR NOP M.PTR NOP AC/RJ NOP IRW NOP DFBOX DEF %MBOX IDBFL NOP DFTAG DEF REPLY+8 REPLY BSS 35 * SIZE EQU * * END a   91705-18112 1612 S 0122 DS1/B SCE/5 MOD DMESG SOURCE             H0101 ASMB,R,L,C HED DMESG 91705-16112 * (C HEWLETT PACKARD CO. 1976 NAM DMESG,7 91705-16112 REV A 760319 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * DMESG * SOURCE: 91705-18112 * BINARY: 91705-16112 * JIM HARTSELL JULY 30, 1974 * * LIBRARY SUBROUTINE APPENDED TO RTE-C SATELLITE USER * PROGRAM FOR SENDING MESSAGES TO CENTRAL STATION * OPERATOR CONSOLE (LU 1). * ENT DMESG * EXT DEXEC,GETLU * A EQU 0 * * GET MESSAGE ADDRESS AND LENGTH. * DMESG NOP ISZ DMESG ISZ DMESG LDA DMESG,I JSB INDCK STA BUFAD MESSAGE ADDRESS. ISZ DMESG LDA DMESG,I JSB INDCK LDB A,I ADB MD38 TRUNCATE TO 36 WORDS. LDA A,I SSB,RSS LDA D37 STA BUFL MESSAGE LENGTH (WORDS). CMA,INA STA CNT ISZ DMESG ADJUST RETURN ADDRESS. * * MOVE MESSAGE TO INTERNAL BUFFER. * LDA DFOUT STA TEMP * LOOP LDA BUFAD,I STA TEMP,I ISZ BUFAD ISZ TEMP ISZ CNT JMP LOOP * LDA BUFL ADJUST BUFFER LENGTH. ADA B3 STA BUFL * JSB GETLU GET LU OF THIS SATELLITE. DEF *+2 DEF TEMP * LDA TEMP CONVERT TO ASCII AND LDB DFLU PUT INTO MESSAGE. JSB BTOA * SEND THE MESSAGE WITH ID PREFIX. * JSB DEXEC DEF *+6 DEF B0 DEF B2 DEF B1 DEF OUTBF DEF BUFL * JMP DMESG,I RETURN TO CALLER. * * SUBROUTINE TO CHASE INDIRECTS. * INDCK NOP RSS LDA A,I    RAL,CLE,SLA,ERA JMP *-2 JMP INDCK,I * * BINARY TO ASCII CONVERSION ROUTINE. * * CALLING SQUENCE: * * (A) = BINARY NUMBER. * (B) = ASCII DESTINATION BUFFER ADDRESS. * JSB BTOA * BTOA NOP ENTRY. STA TEMP STB TEMP+1 LDA DECX INIT. DEC. INDEX. STA TEMP+2 CLB (B)=LEFT/RIGHT POINTER. STB TEMP+3 INIT. LEADING ZERO FLAG. * CONV1 CLA STA TEMP+4 INIT. CURRENT DIGIT. LDA TEMP GET VALUE. CONV2 ADA TEMP+2,I ADD TABLE ENTRY. SSA DID IT GO NEGATIVE? JMP CONV3 YES. STA TEMP NO. ISZ TEMP+4 JMP CONV2 LOOP BACK. * CONV3 LDA EMP+3 LEADING ZERO? ADA TEMP+4 SZA,RSS JMP CONV4 YES, IGNORE. LDA TEMP+4 NO. IOR B60 CONVERT TO B60. * SLB,RSS INSERT, L OR R? ALF,SLA,ALF WILL ALWAYS SKIP. IOR TEMP+1,I MERGE RIGHT CAR. STA TEMP+1,I SLB ISZ TEMP+1 MOVER POINTER. INB ISZ TEMP+3 LEADING ZERO FLAG. * CONV4 CCA CPA TEMP+2,I ARE WE DONE? JMP BTOA,I YES, RETURN. ISZ TEMP+2 NO, MOVE DECADE POINTER. CPA TEMP+2,I LAST DIGIT? ISZ TEMP+3 YES. JMP CONV1 NO. * DECX DEF .DIGT .DIGT DEC -10000,-1000,-100,-10,-1 * * * CONSTANTS AND WORKING STORAGE. * B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B60 OCT 60 D37 DEC 37 MD38 DEC -38 CNT NOP BUFL NOP BUFAD NOP TEMP BSS 5 DFLU DEF OUTBF+1 DFOUT DEF OUTBF+3 OUTBF ASC 3,=S : BSS 37 * SIZE EQU * * END -[   91705-18113 1553 S 0122 DS1/B SCE/5 MOD @CLCK SOURCE             H0101 pASMB,R,L,C HED @CLCK - 91705-16113 * (C) HEWLETT PACKARD CO. 1976 NAM @CLCK,1,3 91705-16113 REV.A 751230 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * @CLCK * SOURCE: 91705-18113 * BINARY: 91705-16113 * JIM HARTSELL * DEC. 10, 1974 * MODIFIED BY: C.C.H. (12-30-75) [DERIVED FROM: 91705-18013 REV.B] * * CORE RESIDENT RTE-C SATELLITE PROGRAM SCHEDULED EVERY * 10 MILLISECONDS TO INCREMENT THE TIME VALUES FOR USER * PROGRAMS IN THE WAIT LIST. WHEN THE TIME VALUE GOES TO * ZERO, THE PROGRAM IS RE-STARTED. * ENT @CLCK EXT %LIST,%TIME,EXEC,$LIBR,$LIBX,$LINK,$WORK * A EQU 0 B EQU 1 * * GET CURRENT SYSTEM TIME FOR PARMB TIME-TAGS. * @CLCK JSB EXEC ASK THE SYSTEM DEF *+3 TO PROVIDE DEF D11 THE CURRENT DEF TIMBF TIME-OF-DAY. * LDA TIMBF GET THE 10'S OF MILLISECONDS VALUE. ADA TIMBF+1 ADD SECONDS FOR LEAST TIME-COMPOSITE. LDB TIMBF+2 GET THE MINUTES VALUE. ADB TIMBF+3 ADD HOURS FOR MOST TIME-COMPOSITE VALUE. * JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. DST %TIME SAVE RTE-II STYLE TIME VALUE IN <@QUE>. JSB $LIBX RESTORE THE DEF *+1 SYSTEM'S DEF *+1 DEFENSES. * * BEGIN SCAN OF WAIT-LIST. * LDA %LIST LDB A,I STB TEMP NEGATIVE # OF ENTRIES. INA STA TEMP1 ADDR OF FIRST ENTRY. * LOOP LDA TEMP1,I CHECK IF TIME VALUE SZA,RSS IS ZERO. JMP NEXT YES-GO TO NEXT ENTRY. * * INCREMENT THE TIME VALUE AS EACH I#N-USE ENTRY IS FOUND. * JSB $LIBR NOP LDA TEMP1,I CAN'T USE ISZ. INA SSA STORE NEW TIME IF JMP CLCK1 NEGATIVE OR ZERO. SZA,RSS CLCK1 STA TEMP1,I JSB $LIBX DEF *+1 DEF *+1 * SZA JMP NEXT * * TIME IS UP. CHECK IF PROGRAM STILL IN OP SUSPEND LIST. * LDA TEMP1 ADA B4 LDA A,I ID SEGMENT ADDRESS. STA WORK ADA D15 LDA A,I PROGRAM STATUS WORD. AND B17 CPA B6 IN OPERATOR SUSPEND LIST? JMP SCHED YES. * * MOVE TO NEXT ENTRY IN WAIT-LIST. * NEXT LDA TEMP1 ADA B5 STA TEMP1 ISZ TEMP JMP LOOP * * EXIT WITH RECALL IF END OF LIST. * JSB EXEC RECALL IN 10 MS. DEF *+6 DEF D12 DEF B0 DEF B1 DEF B0 DEF MD1 * JMP @CLCK * SKP * RE-START A USER PROGRAM VIA RTE-C LINKAGE PROCESSOR. * SCHED JSB $LIBR NOP LDB TEMP1 KILL PROG NAME IN INB WAIT-LIST ENTRY. CLA STA B,I LDB $DWRK SSB,RSS JMP *+3 ELB,CLE,ERB LDB B,I * LDA WORK SET UP SCHEDULER VARIABLES: STA B,I "WORK" INB STA B,I "WLINK" INB ADA B6 STA B,I "WPRIO" * ADA D9 SET STATUS WORD IN CLB,INB ID SED = SCHEDULED. STB A,I * JSB $LINK CALL LINKAGE PROCESSOR: B6 OCT 6 REMOVE FROM OP SUSP LIST. B1 OCT 1 LINK INTO SCHEDULE LIST. * JSB $LIBX DEF *+1 DEF NEXT * * CONSTANTS AND WORKING STORAGE. * B0 OCT 0 B4 OCT 4 B5 OCT 5 B17 OCT 17 D9 DEC 9 D11 DEC 11 D12 DEC 12 D15 EQU B17 MD1 DEC -1 TEMP NOP TEMP1 NOP WORK NOP $DWRK DEF $WORK TIMBF BSS 5 * SIZE EQU * END @CLCK    91711-18001 1926 S C0122 &TXPM0 PROCESSOR VERIF. PROG.             H0101 ZFTN4,L C C CPU PSEUDO ON LINE VERIFICATION PROGRAM C PROGRAM TXPM0(3,89),91711-16001 REV 1926 790401 DIMENSION IPARM(5) C C PICK UP CONSOLE LU, PASS COUNT & OUTPUT TITLE MSG C CALL RMPAR(IPARM) LU=IPARM(1) IF(LU.EQ.0) LU=1 IPSCT=IPARM(2) WRITE(LU,10) C C CLEAR ERROR FLAG, ERROR COUNT & CALL TEST SUBROUTINE C IERCT=0 100 IERFG=0 CALL RODFK(IERFG,IERCT) C C ERROR REPORTING AFTER EACH PASS C IF(IAND(IERFG,1B).NE.0) WRITE(LU,20) IF(IAND(IERFG,2B).NE.0) WRITE(LU,30) IF(IAND(IERFG,4B).NE.0) WRITE(LU,40) IF(IAND(IERFG,10B).NE.0) WRITE(LU,50) IF(IAND(IERFG,20B).NE.0) WRITE(LU,60) C C PASS COUNT CHECKING & EXIT MESG C IF(IPSCT.LT.2B) 90,80 80 IPSCT=IPSCT-1 GO TO 100 90 WRITE(LU,70)IERCT C C 10 FORMAT(/" TXPM0 - PROCESSOR TEST RUNNING") 20 FORMAT(/" TXPM0 - MEMORY REF. INST. GROUP FAILURE") 30 FORMAT(/" TXPM0 - ALTER/SKIP INST. GROUP FAILURE") 40 FORMAT(/" TXPM0 - SHIFT/ROTATE INST. GROUP FAILURE") 50 FORMAT(/" TXPM0 - I/O INST. GROUP FAILURE") 60 FORMAT(/" TXPM0 - EAU INST. GROUP FAILURE") 70 FORMAT(/" TXPM0 - PROCESSOR TEST FINISHED ",I5," ERRORS"/) END END$ Y]  91711-18002 1813 S C0122 &RODFK PROCESSOR VERIF. SBRTN.             H0101 V+ASMB,R,L,T HED CPU PSEUDO ON LINE VERIFICATION NAM RODFK 91711-16002 REV 1813 780321 SUP A EQU 0 B EQU 1 SWREG EQU 1 * ENT RODFK EXT .ENTR * ERRFG NOP ERCNT NOP RODFK NOP JSB .ENTR DEF ERRFG * * * ONLY SINGLE OPERATION INSTRUCTIONS ARE TESTED. * IT IS ASSUMED THAT COMBINATIONS AFTER INITIAL * TEST WILL WORK (NOT NECESSARILY TRUE) * * INSTRUCTIONS ARE TESTED IN THE FOLLOWING SEQUENCE: * * RSS SOS SOC STO CLO CLE SEZ CCE CME * CL* SZ* SL* SS* CC* CP* ST* LD* IN* CM* (* = A/B-REG) * OT* LI* MI* TO & FROM S-REG (* = A/B-REG) * STA B,I STB A,I LDA B,I LDB A,I CPA B,I CPB A,I * JMP JSB JSB,I * AND XOR IOR ISZ ADA ADB * ALS ARS RAL RAR ALR ALF (BITS 8-6) * ALS ARS RAL RAR ALR ALF (BITS 2-0) * ELA ERA (BITS 8-6) ELA ERA (BITS 2-0) * * SPC 5 * ARITHMETIC SETTING OF E & O REGISTERS (INA ADA INB ADB) * * EXTEND & OVERFLOW REGISTER RESULTS * * * AD* MEM TO REG. = REG. OVF EXT * + + + 0 0 * + + - 1 0 * + - + 0 1 * - + + 0 1 * - + - 0 0 * + - - 0 0 * - - - 0 1 * - - + 1 1 SKP * RSS JSB ASG RSS FAILED OR I/O CAUSED SKIP JMP *+2 RSS JMP *+4 RSS JMP *+3 JSB MRG JMP FAILED JMP *-2 * STO SOC SOS JSB IOG STO / SOC / SOS CLO SOS SOC JSB IOG CLO / SOS / SOC CLE SEZ,RSS SEZ JSB IOG CLE / SEZ,RSS / SEZ CCE SEZ SEZ,RSS JSB IOG CCE / SEZ / SEZ,RSS CME VFSEZ,RSS SEZ JSB IOG CME / SEZ / SEZ,RSS * CLA SZA JSB ASG SLA JSB ASG SSA JSB ASG CLA SZA SLA SSA CLB SZB JSB ASG SLB JSB ASG SSB JSB ASG CLB / SZB / SLB / SSB * SKP * CCA SZA RSS JSB ASG SLA RSS JSB ASG SSA RSS JSB ASG CCA/SZA/SLA/SSA * CCB SZB RSS JSB ASG SLB RSS JSB ASG SSB RSS JSB ASG CCB/SZB/SLB/SSB * CLA CCB STA TMPA STB TMPB CPA B0 RSS JSB MRG CLA/CPA/SZA CLB CPB B0 RSS JSB MRG CLB/CPB * SKP CPA M1 JSB MRG CPA LDA TMPB LDB TMPA SZA CPA B0 JSB MRG STB/LDA CPB B0 SZB JSB MRG STA/LDB SOS SEZ JSB MRG E / O SET INB CPB B1 RSS JSB ASG SOS SEZ JSB ASG E / O SET INA CPA B0 RSS JSB ASG INB SEZ SOC JSB ASG E NOT SET / O SET CLE SZB SZA JSB ASG INA/INB CPB B1 RSS JSB ASG INB SKP * CCA CLB STA TMPA STB TMPB CPA M1 RSS JSB ASG CCA/CPA CCB CPB M1 RSS JSB ASG CCB/CPB SZA,RSS JSB ASG CCA/CPA/SZA,RSS SZB RSS JSB ASG CCB/CPB/SZB,RSS CPA B0 JSB MRG CPA LDA TMPB LDB TMPA SZA,RSS CPA M1 JSB MRG STB/LDA CPB M1 SZB,RSS JSB MRG STA/LDB SOS SEZ JSB MRG E / O SET INA CPA B1 RS?S JSB MRG INA/CPA SOS SEZ JSB MRG E / O SET INB CPB B0 INB/CPB RSS JSB MRG SEZ SOC JSB MRG E NOT SET / O SET CLE SZB,RSS SZA,RSS JSB ASG INA/INB CPA B1 RSS JSB ASG INA SKP * LDA ALT0 LDB ALT1 STA TMPA STB TMPB CPA ALT0 RSS JSB MRG LDA/CPA CPB ALT1 RSS JSB MRG LDB/CPB LDA TMPB LDB TMPA CPA ALT1 RSS JSB MRG LDA/STB CPB ALT0 RSS JSB MRG LDB/STA INA INB CPA ALT1A RSS JSB ASG INA CPB ALT0A RSS JSB ASG INB SKP * CLA CCB CMA CMB CPA M1 SZB JSB ASG CMA / CMB SSA SSB JSB ASG SSA / SSB SLA SLB JSB ASG SLA / SLB CMA CMB CPB M1 SZA JSB ASG CMA / CMB SSB SSA JSB ASG SSA / SSB SLB SLA JSB ASG SLA / SLB LDA ALT0 LDB ALT1 CMA CMB CPA ALT1 RSS JSB ASG CMA CPB ALT0 RSS JSB ASG CMB SKP * * CHECK SWITCH REGISTER I/O * LIA SWREG GET AND STA SWRX SAVE S-REG. LDB M20 SET ERR COUNT SREGT LDA ALT0 TRY ALTERNATING PATTERNS OTA SWREG CLA LIA SWREG CPA ALT0 RSS JMP ERVF LDA ALT1 OTHER PATTERN OTA SWREG CLA LIA SWREG CPA ALT1 RSS JMP ERVF CCA TRY OUTPUTING OTA SWREG ALL ONE'S CLA LIA SWREG NOW GET IT BACK CPA M1 DID IT ECHO THE 1'S? RSS JMP ERVF NO  CLA TRY OUTPUTING OTA SWREG ALL ZERO'S CLA LIA SWREG GET IT BACK SZA OK JMP ERVF NO SOS SEZ,RSS JMP *+5 * ERVF INB INCR ERR COUNT SZB JMP SREGT OK. ERR CAUSED BY SYST INTRPT JSB IOG S-REG ERR * SKP * LDB M20 SET ERR COUNT SREGU LDA ALT0 TRY ALTERNATING PATTERNS OTA SWREG CLA MIA SWREG CPA ALT0 RSS JMP ERVF1 LDA ALT1 OTHER PATTERN OTA SWREG CLA MIA SWREG CPA ALT1 RSS JMP ERVF1 CCA TRY OUTPUTING OTA SWREG ALL ONE'S CLA MIA SWREG NOW GET IT BACK CPA M1 DID IT ECHO THE 1'S? RSS JMP ERVF1 NO CLA TRY OUTPUTING OTA SWREG ALL ZERO'S CLA MIA SWREG GET IT BACK SZA OK JMP ERVF1 NO SOS SEZ,RSS JMP *+5 * ERVF1 INB INCR ERR COUNT SZB JMP SREGU OK. ERR CAUSED BY SYST INTRPT JSB IOG S-REG ERR LDA SWRX OTA SWREG RESTORE ORIG S-REG * SKP * LDA DTMPB LDB DTMPA STA B,I STB A,I CPA TMPA RSS JSB MRG STA B,I/STB A,I CPB TMPB RSS JSB MRG STA B,I/STB A,I LDA B,I LDB A,I CPA TMPA RSS JSB MRG LDA B,I CPB TMPB RSS JSB MRG LDB A,I LDA A,I LDB B,I CPA B,I RSS JSB MRG CPA B,I/LDA A,I CPB A,I RSS JSB MRG CPB A,I/LDB B,I * CLA STA JB0 STA JB1 JSB *+2 JBR0 JSB MRG JSB JB0 NOP LDA *-1 CPA DJBR0 RSS JSB MRG JSB RETURN ADDRESS CLA JSB *+2,I JBR1 JSB MRG JSB ,I  DEF *+3 JSB MRG JSB ,I JSB MRG JSB ,I JB1 NOP LDA *-1 CPA DJBR1 RSS JSB MRG JSB ,I RETURN ADDRESS SKP * CCA AND B0 SZA JSB MRG AND LDA ALT0 AND ALT1 SZA JSB MRG AND LDA ALT1 AND ALT0 SZA JSB MRG AND CCA AND ALT0 CPA ALT0 RSS JSB MRG AND CCA AND ALT1 CPA ALT1 RSS JSB MRG AND * CLA XOR B0 SZA JSB MRG XOR XOR ALT0 CPA ALT0 RSS JSB MRG XOR XOR ALT1 CPA M1 RSS JSB MRG XOR XOR ALT0 CPA ALT1 RSS JSB MRG XOR XOR ALT1 SZA JSB MRG XOR CCA XOR M1 SZA JSB MRG XOR SKP * CLA IOR B0 SZA JSB MRG IOR IOR ALT0 CPA ALT0 RSS JSB MRG IOR IOR ALT1 CPA M1 RSS JSB MRG IOR CLA IOR ALT1 CPA ALT1 RSS JSB MRG IOR IOR ALT0 CPA M1 RSS JSB MRG IOR SKP * CLA CLB STA TMPA L01 CPA B100K RSS JMP *+5 SOC SEZ JSB IOG E SET / O NOT SET CLO SOS SEZ JSB IOG E / O SET INA SZA,RSS JMP NXT01 INB SZB,RSS JSB ASG INB ISZ TMPA RSS JSB MRG ISZ CPA TMPA RSS JSB MRG ISZ / INA CPB A JMP L01 JSB MRG ISZ / INB NXT01 SEZ SOC JSB MRG E NOT SET / O SET CLE INB SEZ SOC JSB ASG E NOT SET / O SET CLE SZB JSB MRG INB ISZ TMPA JSB MRG ISZ SOS SEZ JSB MRG E / O SET SKP * CLA CCB ADA B1 SOS SEZ JSB MRG E / O SET ADB B1 SEZ SOC JSB MRG E NOT SET / O SET CLE CPA B1 SZB JSB MRG ADA/ADB CCA CLB ADB B1 SOS SEZ JSB MRG E / O SET ADA B1 SEZ SOC JSB MRG E NOT SET / O SET CLE CPB B1 SZA JSB MRG ADA/ADB CLA CCB ADA M1 SOS SEZ JSB MRG E / O SET ADB M1 SEZ SOC JSB MRG E NOT SET / O SET CLE CPA M1 RSS JSB MRG ADA CPB M2 RSS JSB MRG ADB CCA CLB ADB M1 SOS SEZ JSB MRG E / O SET ADA M1 SEZ SOC JSB MRG E NOT SET / O SET CLE CPA M2 RSS JSB MRG ADA CPB M1 RSS JSB MRG ADB LDA ALT0 LDB ALT1 ADB ALT1 SOC SEZ JSB MRG E SET / O NOT SET CLO ADA ALT1A SEZ SOC JSB MRG E NOT SET / O SET CLE CPB ALT0 SZA JSB MRG ADA/ADB LDA ALT1 LDB ALT0 ADA ALT0 SOS SEZ JSB MRG E / O SET ADB ALT1A SEZ SOC JSB MRG E NOT SET / O SET CLE CPA M1 SZB JSB MRG ADA/ADB SKP * BPJP0 JMP *+2,I JSB MRG JMP ,I DEF *+3 JSB MRG JMP ,I JSB MRG " JMP *+2,I JSB MRG " DEF CPJP0 JSB MRG JSB MRG BPJP1 JMP *+2,I JSB MRG DEF CPJP1 JSB MRG JSB MRG * BPJB0 NOP LDA *-1 CPA DJBR2 RSS JSB MRG JSB JSB *+2,I JBR5 JSB MRG JSB ,I DEF CPJB0 JSB MRG " JSB MRG " * SKP * * STORAGE AND CONSTANTS * B0 OCT 0 B1 OCT 1 B2 OCT 2 B4 OCT 4 B10 OCT 10 B20 OCT 20 B100K OCT 100000 M1 OCT -1 M2 OCT -2 M20 OCT -20 TMPA OCT -1 TMPB OCT 0 SWRX NOP ALT0 OCT 125252 ALT1 OCT 052525 ALT0A OCT 125253 ALT1A OCT 052526 * DTMPA DEF TMPA DTMPB DEF TMPB DJBR0 DEF JBR0 DJBR1 DEF JBR1 DJBR2 DEF JBR2 * SKP * LDB ALT1 LDA ALT0 STA TMPA STB TMPB CPA ALT0 RSS JSB MRG LDA/CPA CPB ALT1 RSS JSB MRG " " LDB TMPA LDA TMPB CPA ALT1 RSS JSB MRG STB/CPA CPB ALT0 RSS JSB MRG STA/CPB * JMP *+2 JSB MRG JMP JMP *+4 JSB MRG JMP JMP *+4 JSB MRG JMP JMP *-2 JSB MRG JMP * JMP BPJP0 JSB MRG JMP CPJP0 JMP *+2,I JSB MRG JMP ,I DEF BPJP1 JSB MRG JMP ,I JSB MRG " CPJP1 JMP *+2,I JSB MRG " DEF *+3 JSB MRG " JSB MRG " * CLA STA .JB0 STA .JB1 STA BPJB0 STA CPJB0 JSB *+2 JBR3 JSB MRG JSB .JB0 NOP LDA *-1 CPA DJBR3 RSS JSB MRG JSB (RETURN ADRESS) JSB *+2,I JBR4 JSB MRG JSB ,I DEF *+3 JSB MRG " JSB MRG " .JB1 NOP LDA *-1 CPA DJBR4 RSS JSB MRG JSB ,I (RETURN ADDRESS) JSB BPJB0 JBR2 JSB MRG JSB CPJB0 NOP LDA *-1 CPA DJBR5 RSS JSB MRG JSB ,I SKP * LDA SRGP1 1000100100100111 LDB SRGP2 1001100000100000 <ALS 1001001001001110 BRS 1100110000010000 ARS 1100100100100111 BLR 0001100000100000 ALS 1001001001001110 BLF 1000001000000001 RAR 0100100100100111 BLS 1000010000000010 ARS 0010010010010011 RBR 0100001000000001 ALR 0100100100100110 BLS 0000010000000010 RAL 1001001001001100 BLF 0100000000100000 ARS 1100100100100110 RBL 1000000001000000 ALR 0001001001001100 BRS 1100000000100000 ALF 0010010011000001 RBL 1000000001000001 RAL 0100100110000010 BRS 1100000000100000 ALS 0001001100000100 RBR 0110000000010000 RAR 0000100110000010 BLR 0100000000100000 ALF 1001100000100000 BLS 0000000001000000 CPA SRGP2 RSS JSB SRG SRG INST A-REG. CPB SRGP3 RSS JSB SRG SRG INST B-REG. SOS SEZ JSB SRG E / O SET SKP * LDB SRGP1 1000100100100111 LDA SRGP2 1001100000100000 BLS 1001001001001110 ARS 1100110000010000 BRS 1100100100100111 ALR 0001100000100000 BLS 1001001001001110 ALF 1000001000000001 RBR 0100100100100111 ALS 1000010000000010 BRS t 0010010010010011 RAR 0100001000000001 BLR 0100100100100110 ALS 0000010000000010 RBL 1001001001001100 ALF 0100000000100000 BRS 1100100100100110 RAL 1000000001000000 BLR 0001001001001100 ARS 1100000000100000 BLF 0010010011000001 RAL 1000000001000001 RBL 0100100110000010 ARS 1100000000100000 BLS 0001001100000100 RAR 0110000000010000 RBR 0000100110000010 ALR 0100000000100000 BLF 1001100000100000 ALS 0000000001000000 CPB SRGP2 RSS JSB SRG SRG INST B-REG. CPA SRGP3 RSS JSB SRG SRG INST A-REG. SOS SEZ JSB SRG E / O SET SKP * LDA SRGP1 1000100100100111 LDB SRGP2 1001100000100000 OCT 0020 ALS 1001001001001110 OCT 4021 BRS 1100110000010000 OCT 0021 ARS 1100100100100111 OCT 4024 BLR 0001100000100000 OCT 0020 ALS 1001001001001110 OCT 4027 BLF 1000001000000001 OCT 0023 RAR 0100100100100111 OCT 4020 BLS 1000010000000010 OCT 0021 ARS 0010010010010011 OCT 4023 RBR 0100001000000001 OCT 0024 ALR 0100100100100110 OCT 4020 BLS 0000010000000010 OCT 0022 RAL 1001001001001100 OCT 4027 BLF 0100000000100000 OCT 0021 ARS 1100100100100110 OCT 4022 RBL 1000000001000000 OCT 0024 ALR 0001001001001100 OCT 4021 BRS 1100000000100000 OCT 0027 ALF 0010010011000001 OCT 4022 RBL 1000000001000001 OCT 0022 RAL 0100100110000010 OCT 4021 BRS 1100000000100000 OCT 0020 ALS 0001001100000100 OCT 4023 RBR 0110000000010000 OCT 0023 RAR 0000100110000010 OCT 4024 BLR 0100000000100000 OCT 0027 ALF 1001100000100000 OCT 4020 BLS 0000000001000000 CPA SRGP2 RSS JSB SRG SRG INST A-REG. CPB SRGP3 RSS JSB SRG SRG INST B-REG. SOS SEZ JSB SRG E / O SET SKP * LDB SRGP1 1000100100100111 LDA SRGP2 1001100000100000 OCT 4020 BLS 1001001001001110 OCT 0021 ARS 1100110000010000 OCT 4021 BRS 1100100100100111 OCT 0024 ALR 0001100000100000 OCT 4020 BLS 1001001001001110 OCT 0027 ALF 1000001000000001 OCT 4023 RBR 0100100100100111 OCT 0020 ALS 1000010000000010 OCT 4021 BRS 0010010010010011 OCT 0023 RAR 0100001000000001 OCT 4024 BLR 0100100100100110 OCT 0020 ALS 0000010000000010 OCT 4022 RBL 1001001001001100 OCT 0027 ALF 0100000000100000 OCT 4021 BRS 1100100100100110 OCT 0022 RAL 1000000001000000 OCT 4024 BLR 0001001001001100 OCT 0021 ARS 1100000000100000 OCT 4027 BLF 0010010011000001 OCT 0022 RAL 1000000001000001 OCT 4022 RBL 0100100110000010 OCT 0021 ARS 1100000000100000 OCT 4020 BLS 0001001100000100 OCT 0023 RAR 0110000000010000 OCT 4023 RBR 0000100110000010 OCT 0024 ALR 0100000000100000 OCT 4027 BLF 1001100000100000 OCT 0020 ALS 0000000001000000 CPB SRGP2 RSS JSB SRG SRG INST B-REG. CPA SRGP3 RSS JSB SRG SRG INST A-REG. SOS SEZ JSB SRG E / O SET SKP * LDA SRGEP 0111010001110010 LDB SRGEP 0111010001110010 ERA 0011101000111001 0 ELB 0 1110100011100100 ERA 0001110100011100 1 ELB 1 1101000111001001 ERA 1000111010001110 0 ELB 1 1010001110010010 ERA 1100011101000111 0 ELB 1 0100011100100100 ERA 1110001110100011 1 ELB 0 1000111001001001 ERA 0111000111010001 1 ELB 1 0001110010010011 ERA 1011100011101000 1 ELB 0 0011100100100111 ERA 0101110001110100 0 ELB 0 0111001001001110 ERB 0 0011100100100111 ELA 1011100011101000 0 ERB 1 0001110010010011 ELA 0111000111010001 1 ERB 1 1000111001001001 ELA 1110001110100011 0 ERB 1 0100011100100100 ELA 1100011101000111 1 ERB 0 1010001110010010 ELA 1000111010001110 1 ERB 0 1101000111001001 ELA 0001110100011100 1 ERB 1 1110100011100100 ELA 0011101000111001 0 ERB 0 0111010001110010 ELA 0111010001110010 0 CPA SRGEP RSS JSB SRG SRG E-REG ERROR CPB SRGEP RSS JSB SRG SRG E-REG ERROR SOS SEZ JSB SRG E / O SET SKP * LDA SRGEP 0111010001110010 LDB SRGEP 0111010001110010 OCT 0025 ERA 0011101000111001 0 OCT 4026 ELB 0 1110100011100100 OCT 0025 ERA 0001110100011100 1 OCT 4026 ELB 1 1101000111001001 OCT 0025 ERA 1000111010001110 0 OCT 4026 ELB 1 1010001110010010 OCT 0025 ERA 1100011101000111 0 OCT 4026 ELB 1 0100011100100100 OCT 0025 ERA 1110001110100011 1 OCT 4026 ELB 0 1000111001001001 OCT 0025 ERA 0111000111010001 1 OCT 4026 ELB 1 0001110010010011 OCT 0025 ERA 1011100011101000 1 OCT 4026 ELB 0 0011100100100111 OCT 0025 ERA 0101110001110100 0 OCT 4026 ELB 0 0111001001001110 OCT 4025 ERB 0 0011100100100111 OCT 0026 ELA 1011100011101000 0 OCT 4025 ERB 1 0001110010010011 OCT 0026 ELA 0111000111010001 1 OCT 4025 ERB 1 1000111001001001 OCT 0026 ELA 1110001110100011 0 OCT 4025 ERB 1 0100011100100100 OCT 0026 ELA 1100011101000111 1 OCT 4025 ERB 0 1010001110010010 OCT 0026 ELA 1000111010001110 1 OCT 4025 ERB 0 1101000111001001 OCT 0026 ELA 0001110100011100 1 OCT 4025 ERB 1 1110100011100100 OCT 0026 ELA 0011101000111001 0 OCT 4025 ERB 0 0111010001110010 OCT 0026 ELA 0111010001110010 0 CPA SRGEP RSS JSB SRG SRG E-REG ERROR CPB SRGEP RSS JSB SRG SRG E-REG ERROR SOS SEZ JSB SRG E / AO SET * SKP * CLA STA ALTX STA ALTX+1 DLD ALT0 CPA ALT0 CPB ALT0 JSB EAU DLD CPB ALT1 CPA ALT1 JSB EAU DLD DST ALTX CPA ALTX CPB ALTX JSB EAU DST CPB ALTX+1 CPA ALTX+1 JSB EAU DST * ASR 1 ASL 2 ASR 5 ASL 7 CPA P5240 SOS JSB EAU ASR/ASL CPB P2525 CPA ALT1 JSB EAU ASR/ASL * CLO DLD ALT0 LSR 1 LSL 2 LSR 5 LSL 7 CPA P5240 SOC JSB EAU LSR/LSL CPB P1252 CPA ALT1 JSB EAU * SKP * DLD ALT0 RRR 2 RRL 4 RRR 3 RRL 7 RRR 1 RRL 11 CPA ALT1 CPB ALT0 RSS JSB EAU RRR/RRL SOC JSB EAU * STO LDA ALT0 MPY ALT1 CPA MPYA1 SOC JSB EAU MPY CPB MPYB1 RSS JSB EAU STO LDA ALT1 MPY ALT1 CPA MPYA2 SOC JSB EAU MPY CPB MPYB2 RSS JSB EAU * CLO DLD ALT0 BRS,BRS DIV P7777 CPA DIVA1 SOC JSB EAU DIV CPB ALT1 RSS JSB EAU DIV CLO DLD ALT0 DIV B0 CPA ALT0 SOS JSB EAU DIV CPB ALT1 RSS JSB EAU DIV * JMP RODFK,I EXIT SUBROUTINE SKP ALTX OCT 0 OCT 0 SRGP1 OCT 104447 1000100100100111 SRGP2 OCT 114040 1001100000100000 SRGP3 OCT 000100 SRGEP OCT 072162 011010001110010 P5240 OCT 52400 P2525 OCT 25255 P1252 OCT 125255 MPYA1 OCT 016162 MPYB1 OCT 161616 MPYA2 OCT 107071 MPYB2 OCT 016161 DIVA1 OCT 025253 P7777 OCT 77777 DJBR3 DEF JBR3 DJBR4 DEF JBR4 DJBR5 DEF JBR5 * * * MRG NOP LDbTRNA B1 JSB ERR JMP MRG,I * ASG NOP LDA B2 JSB ERR JMP ASG,I * SRG NOP LDA B4 JSB ERR JMP SRG,I * IOG NOP LDA B10 JSB ERR JMP IOG,I * EAU NOP LDA B20 JSB ERR JMP EAU,I * SKP * ERR NOP IOR ERRFG,I STA ERRFG,I LDA ERCNT,I CPA P7777 RSS INA STA ERCNT,I JMP ERR,I * END 7T  91711-18003 1926 S C0122 &TXPM1 MEMORY VERIF. FATHER             H0101 FTN4,L PROGRAM TXPM1(3,89),91711-16003 REV 1926 790421 C C********************************************************************* C C DESCRIPTION: C ------------ C C THE PURPOSE OF THIS PROGRAM IS TO EXECUTE THE C MEMORY VERIFICATIONS PROGRAM "TXPM2" IN ALL C PARTITIONS, STARTING WITH THE FIRST PARTITION. C C C OPERATING PROCEDURE: C -------------------- C C SCHEDULE THE PROGRAM "TXPM1" USING THE RUN COMMAND: C C :RU,TXPM1,LGLU,# PASSES C C WHERE LGLU = LU ON WHICH MESSAGES ARE LOGGED. C # PASSES = NUMBER OF PASSES OF TEST PROGRAM. C C************************************************************************ C DIMENSION ICMD(30),IPRAM(5),NAME(3),IERR(2),MSG1(15) DIMENSION MSG2(27),MSG3(14),MSG4(15),MSG5(23),MSG6(6) EQUIVALENCE (IERR(2),ICMD) DATA MSG1 /2H ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY, * 2H T,2HES,2HT ,2HRU,2HNN,2HIN,2HG / DATA MSG2 /2H ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY,2H T, * 2HES,2HT ,2HFI,2HNI,2HSH,2HED,2H ,2H ,2H##, * 2H P,2HAR,2HTI,2HTI,2HON,2HS ,2HTE,2HST,2HED/ DATA MSG3 /2H ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY, * 2H T,2HES,2HT ,2HER,2HRO,2HR!/ DATA MSG4 /2H ,2HTX,2HPM,2H1 ,2H- ,2HME,2HMO,2HRY, * 2H T,2HES,2HT ,2HAB,2HOR,2HTE,2HD!/ DATA MSG5 /2H ,2HTX,2HPM,2H1 ,2H- ,2HAT,2HTE, * 2HMP,2HT ,2HTO,2H T,2HES,2HT ,2HNO,2HN-,2HEX, * 2HIS,2HTE,2HNT,2H M,2HEM,2HOR,2HY!/ DATA MSG6 /2HAS,2H,T,2HXP,2HM2,2H, ,2H 0/ DATA NAME /2HTX,2HPM,2H2 / DATA IERR /2H ,2H / C C***************** GET TERMINAL LOGICAL UNIT NO. ********************** C CALL RMPAR(IPRAM) LU=IPRAM(1) IF (LU.LE.0) LU=LOGLU(LU) C C************************ SET UP LOOP ********************************** C IF(IPRAM(2).LE.0) IPRAM(2)=1 C C*********************************************************************** C***e*********** GET NUMBER OF GENERATED PARTITIONS ************** C LAST = NPART(K) C C*******DO ONE LINE SPACE AND DISPLAY INFORMATION MESSAGE ****** C CALL EXEC(3,LU+1100B,1) CALL EXEC(2,LU,MSG1,15) CALL EXEC(3,LU+1100B,1) C C************************ START TESTING ************************ C IPASS = IPRAM(2) ILOOP = 0 50 ITEST = 0 IPART = 1 C C********************* GET PARTITION STATUS ********************* C 100 CALL EXEC(25,IPART,IPAGE,ISIZE,ISTAT) C SKIP UNDEFINED PARTITIONS IF (ISIZE.EQ.-1) GO TO 300 C SKIP MOTHER PARTITIONS IF (IAND(ISTAT,20000B).NE.0) GO TO 300 C C******************* UNASSIGN PROGRAM "TXPM2" ******************* C DO 200 I = 1,6 ICMD(I) = MSG6(I) 200 CONTINUE LENG = 12 MLENG = MESSS(ICMD,LENG) IF (MLENG.LT.0) GO TO 400 C C***** ADJUST PROGRAM SIZE OF "TXPM2" TO FIT ANY PARTITION ***** C ICMD(1) = 2HSZ ICMD(6) = 2H 2 MLENG = MESSS(ICMD,LENG) IF (MLENG.LT.0) GO TO 400 C C********** ASSIGN PROGRAM "TXPM2" TO PARTITION IPART ********** C ICMD(1) = 2HAS ICMD(6) = KCVT(IPART) MLENG = MESSS(ICMD,LENG) IF (MLENG.LT.0) GO TO 400 C C****** INCREASE SIZE OF "TXPM2" TO MATCH PARTITION IPART ****** C ICMD(1) = 2HSZ ICMD(6) = KCVT(ISIZE) MLENG = MESSS(ICMD,LENG) IF (MLENG.LT.0) GO TO 400 C*********************************************************************** C*********************** SCHEDULE "TXPM2" *********************** C CALL EXEC(23,NAME) CALL RMPAR(IPRAM) IF (IPRAM(1).EQ.100000B) CALL EXEC(2,LU,MSG3,15) IF (IAND(IPRAM(1),77777B).NE.0) CALL EXEC(2,LU,MSG5,23) C C********************* TEST ALL PARTITIONS ********************* C ITEST = ITEST+1 300 IF (IPART.GE.LAST) GO TO 350 IPART = IPART+1 GO TO 100 C C**************** COMPLETE ALL PASSES OF THE PROGRAM ************* **** C 350 ILOOP = ILOOP+1 IF(ILOOP.GE.IPASS) GOTO 500 GOTO 50 C C******************** DISPLAY ERROR MESSAGE ******************** C 400 CALL EXEC(2,LU,IERR,MLENG-2) CALL EXEC(2,LU,MSG4,15) GO TO 600 C C**************** DISPLAY TEST FINISHED MESSAGE **************** C 500 MSG2(18) = KCVT(ITEST) CALL EXEC(3,LU+1100B,1) CALL EXEC(2,LU,MSG2,27) CALL EXEC(3,LU+1100B,1) 600 CALL EXEC(13,LU,ISTAT) IF (IAND(ISTAT,100000B).NE.0) GO TO 600 END END$ &  91711-18004 1813 S C0122 &NPART FIND NUMBER OF PART.             H0101 ASMB,L NAM NPART,7 91711-16004 REV 1813 780322 * * * SUBROUTINE TO FIND OUT THE NUMBER OF PARTITIONS * THAT WERE INCLUDED IN THE SYSTEM AT GENERATION TIME. * * ENT NPART EXT EXEC,$OPSY,$MNP * NPART NOP ENTRY POINT LDA DM9 CPA $OPSY RTE-IV? JMP PART YES * JSB EXEC NO - TERMINATE PROGRAM DEF *+4 DEF D6 DEF ZERO DEF D3 TERMINATE IMMEDIATELY * PART LDA $MNP GET # OF PARTITION GENERATED LDB NPART,I GET RETURN ADDRESS JMP B,I RETURN TO CALLER * B EQU 1 D3 DEC 3 D6 DEC 6 DM9 DEC -9 ZERO NOP * END )  91711-18005 1926 S C0122 &TXPM2 MEMORY VERIFICATION SON             H0101 kNASMB,L HED TXPM2 - MEMORY VERIFICATION PROGRAM NAM TXPM2,4,89 91711-16005 REV 1926 790421 EXT EXEC,PRTN * * * * DESCRIPTION: * ------------ * * * THE PURPOSE OF THIS PROGRAM IS TO TEST THE AVAILABLE MEMORY * (DYNAMIC BUFFER AREA) FOR QUICK VERIFICATION OF OPERATING * CONDITION BY ATTEMPTING TO FORCE A MEMORY PARITY ERROR. * PARITY ERRORS ARE HANDLED BY THE RTE-IV MODULE PERR4. * * * NOTE: * ----- * * THIS TEST IS LIMITED TO THE PARTITION IN WHICH * THE VERIFICATION PROGRAM "TXPM2" IS EXECUTING. * * * * OPERATING PROCEDURE: * -------------------- * * * 1. LOAD THE PROGRAM "TXPM2" USING THE OPCODE LBNC. * * 2. ASSIGN THE PROGRAM "TXPM2" TO THE PARTITION TO BE TESTED. * * 3. ADJUST THE PAGE REQUIREMENT FOR "TXPM2" TO INCLUDE ALL * AVAILABLE PAGES IN THE SELECTED PARTITION. * * 4. SCHEDULE "TXPM2" USING THE RUN COMMAND. * * *AS,TXPM2,PTN# * *SZ,TXPM2,SIZE * *RU,TXPM2 * * PTN# - PARTITION NUMBER TO BE TESTED (EXCL. MOTHER PART'N) * SIZE - NUMBER OF PAGES ASSINGED TO PARTITION PTN#. * (*RU,WHZAT,,1 TO DETERMINE PTN# AND SIZE). * * * SUCCESSFUL OPERATION OF THE PROGRAM IS INDICATED BY * NO ERROR MESSAGES DISPLAYED ON THE SYSTEM CONSOLE. * * * * * SKP TXPM2 NOP ENTRY POINT JSB EXEC DEF RTN DEF RQ26 PARTITION SIZE REQUEST DEF FWMEM FIRST WORD AFTER PROGRAM DEF NWMEM # OF WORDS AVAILABLE DEF PSIZE # OF PAGES IN PARTITION * RTN LDA FWMEM STORE FIRST AVAILABLE STA LOC MEMORY LOCATION TO BE TESTED * LDA NWMEM STORE THE NEGATIVE CMA,INA NUMBER OF LOCATIONS TO BE STA COUNT TESTED IN DYNAMIC BUFFER SPACE * LDB DATA DATA PATTERN - 1010101010101010 * LOOP LDA LOC,I CHECK FOR PARITY ERORRS STB LOC,I STORE DATA PATTERN * V   LDA LOC,I LOAD DATA PATTERN CMA,SSA COMPLEMENT DATA PATTERN ISZ PRAM1 SET NONEXISTENT MEMORY FLAG STA LOC,I STORE COMPLEMENT LDA LOC,I CHECK FOR PARITY ERRORS * CLA STA LOC,I CLEAR CONTENTS, SET PARITY BIT LDA LOC,I CHECK FOR PARITY ERRORS * ISZ LOC NEXT MEMORY LOCATION ISZ COUNT ALL DONE? JMP LOOP NO - CONTINUE * JSB PRTN PASS BACK PARAMETERS DEF *+2 DEF PRAM1 * JSB EXEC TERMINATE "TXPM2" DEF *+2 DEF RQ6 * PRAM1 OCT 0 LOC OCT 0 FWMEM OCT 0 NWMEM OCT 0 PSIZE OCT 0 COUNT OCT 0 RQ6 DEC 6 RQ26 DEC 26 DATA OCT 125252 * END TXPM2 R   91711-18006 1926 S C0122 &TXPF0 FIRMWARE VERIF. PROGRAM             H0101 d FTN4,L PROGRAM TXPF0(3,89),91711-16006 REV 1926 790828 IMPLICIT INTEGER(A-Z) COMMON/EBASE/EBASE(5,1) COMMON/FBAS1/FBAS1(5,1) COMMON/FBAS2/FBAS2(5,1) COMMON/SIS1 /SIS1 (5,1) COMMON/SIS2 /SIS2 (5,1) COMMON/FFP /FFP (5,1) COMMON/FFPE1/FFPE1(5,1) COMMON/FFPE2/FFPE2(5,1) COMMON/FFPF1/FFPF1(5,1) COMMON/FFPF2/FFPF2(5,1) COMMON/DBI /DBI (5,1) COMMON/VIS /VIS (5,1) COMMON/EMA /EMA (5,1) C DIMENSION REV(7) REAL FIRM(7) C EQUIVALENCE (REV(1),HFPREV),(REV(2),FFPREV),(REV(3),SISREV), + (REV(4),VISREV),(REV(5),DBIREV),(REV(6),EMAREV), + (REV(7),DISREV) C DATA FIRM / 4HHFP ,4HFFP ,4HSIS ,4HVIS ,4HDBI ,4HEMA ,4HDIS / C********************************************************************* C C RETRIEVE OUTPUT LU C CALL RMPAR(REV) LU = REV(1) IF (LU.LE.0) LU = LOGLU(LU) C C********************************************************************* C C FIND OUT IF THE COMPUTER IS AN M OR AN E/F MACHINE C CALL MORFE(ICODE) IF (ICODE.EQ.1) GOTO 10 WRITE (LU,800) STOP 10 C C********************************************************************* C C GET INSTALLED FIRMWARE REVISION CODES C 10 DBIREV = 0 CALL HFPVF(HFPREV) CALL FFPVF(FFPREV) CALL SISVF(SISREV) CALL VISVF(VISREV) CALL EMAVF(EMAREV) CALL DISVF(DISREV) IF(HFPREV.GT.1.AND.FFPREV.GT.1)DBIREV=FFPREV C********************************************************************* C********************************************************************* C C CHECK FOR FIRMWARE VERIFICATION ERRORS. (ERROR IF REV(I) < 0) C WRITE(LU,803) IERR = 0 DO 20 I=1,7 IF (REV(I).GE.0) GOTO 15 WRITE(LU,900) FIRM(I) IERR = 1 15 IF (REV(I).EQ.0) GOTO 16 WRITE(LU,801) FIRM(I),REV(I)  GOTO 20 16 WRITE(LU,802) FIRM(I) 20 CONTINUE WRITE(LU,803) C IF (IERR.NE.0) STOP 11 C C********************************************************************* C C CHECK FIRMWARE-FIRMWARE COMPATIBILITY C IF (HFPREV.LE.1.OR.FFPREV.GT.1) GOTO 30 WRITE(LU,803) WRITE(LU,901) FIRM(1),FIRM(2) IERR = 1 C 30 IF (SISREV.EQ.0.OR.HFPREV.NE.0) GOTO 40 WRITE(LU,803) WRITE(LU,901) FIRM(3),FIRM(1) IERR = 1 C 40 IF (VISREV.EQ.0.OR.HFPREV.NE.0) GOTO 50 WRITE(LU,803) WRITE(LU,901) FIRM(4),FIRM(1) IERR = 1 C 50 IF (IERR.NE.0) STOP 12 C C********************************************************************* C C CHECK E-SERIES BASE SET C CALL PRSNT(EBASE,IERR,LU) C C IF E-SERIES, TEST FOR ABSENCE OF HFP ENTRY POINTS C IF (HFPREV.EQ.0) CALL ABSNT(FBAS2,IERR,LU) C C IF F-SERIES, TEST FOR PRESENCE OF HFP ENTRY POINTS C IF (HFPREV.GT.0) CALL PRSNT(FBAS1,IERR,LU) C C********************************************************************* C********************************************************************* C C IF NO FFP, TEST FOR ABSENCE OF ALL FFP ENTRY POINTS C IF (FFPREV.GT.0) GOTO 60 CALL ABSNT(FFP,IERR,LU) CALL ABSNT(FFPE1,IERR,LU) CALL ABSNT(FFPE2,IERR,LU) CALL ABSNT(FFPF1,IERR,LU) CALL ABSNT(FFPF2,IERR,LU) GOTO 80 C C FFP PRESENT, SO TEST COMMON ROUTINES C 60 CALL PRSNT(FFP,IERR,LU) C C IF E-SERIES, TEST E-SERIES FFP C IF (HFPREV.GT.0) GOTO 70 CALL PRSNT(FFPE1,IERR,LU) CALL PRSNT(FFPE2,IERR,LU) CALL ABSNT(FFPF1,IERR,LU) CALL ABSNT(FFPF2,IERR,LU) GOTO 80 C C F-SERIES, SO TEST F-SERIES FFP C 70 CALL PRSNT(FFPF1,IERR,LU) CALL ABSNT(FFPE2,IERR,LU) C IF OLD FFP, TEST FOR ABSENCE OF NEW ENTRY POINTS IF (FFPREV.EQ.1) CALL ABSNT(FFPF2,IERR,LU) C IF NEW FFP, TEST FOR PRESENC|E OF NEW ENTRY POINTS IF (FFPREV.GT.1) CALL PRSNT(FFPF2,IERR,LU) C C********************************************************************* C C IF NO SIS, TEST FOR ABSENCE OF SIS ENTRY POINTS C 80 IF (SISREV.GT.0) GOTO 90 CALL ABSNT(SIS1,IERR,LU) CALL ABSNT(SIS2,IERR,LU) GOTO 100 C C SIS PRESENT, TEST COMMON ROUTINES C 90 CALL PRSNT(SIS1,IERR,LU) C C IF OLD SIS, TEST FOR ABSENCE OF NEW ENTRY POINTS IF (SISREV.EQ.1) CALL ABSNT(SIS2,IERR,LU) C C IF NEW SIS, TEST FOR PRESENCE OF NEW ENTRY POINTS C IF (SISREV.GT.1) CALL PRSNT(SIS2,IERR,LU) C C********************************************************************* C********************************************************************* C C IF NO VIS, TEST FOR ABSENCE OF VIS ENTRY POINTS C 100 IF (VISREV.EQ.0) CALL ABSNT(VIS,IERR,LU) C C IF VIS PRESENT, TEST FOR PRESENCE OF VIS ENTRY POINTS C IF (VISREV.GT.0) CALL PRSNT(VIS,IERR,LU) C C********************************************************************* C C IF NO DBI, TEST FOR ABSENCE OF DBI ENTRY POINTS C IF (DBIREV.EQ.0) CALL ABSNT(DBI,IERR,LU) C C IF DBI, TEST FOR PRESENCE OF DBI ENTRY POINTS C IF (DBIREV.GT.0) CALL PRSNT(DBI,IERR,LU) C C********************************************************************* C C IF NO EMA, TEST FOR ABSENCE OF EMA ENTRY POINTS C IF (EMAREV.EQ.0) CALL ABSNT(EMA,IERR,LU) C C IF EMA, TEST FOR PRESENCE OF EMA ENTRY POINTS C IF (EMAREV.GT.0) CALL PRSNT(EMA,IERR,LU) C C********************************************************************* C C PRINT COMPLETION MESSAGE C IF (IERR.NE.0) STOP 77 WRITE(LU,902) C C********************************************************************* C C MESSAGE FORMATS C 800 FORMAT(" TXPF0 - PROGRAM CAN ONLY RUN IN AN E OR F MACHINE") 801 FORMAT(" TXPF0 - MODULE ",A4," WITH REV NUMBER ",I6, +" INSTALLED") 802Y FORMAT(" TXPF0 - MODULE ",A4," NOT INSTALLED") 803 FORMAT(" ") 900 FORMAT(" TXPF0 - VERIFICATION FAILURE IN FIRMWARE", + " MODULE ",A4) 901 FORMAT(" TXPF0 - ERROR. MODULE ",A4,"INCOMPATIBLE WITH", + " MODULE ",A4) 902 FORMAT(" TXPF0 - FIRMWARE VERIFICATION SUCCESSFUL") C C C********************************************************************* END C********************************************************************* C C SUBROUTINE PRSNT(TABLE,IERR,LU),91711-16006 REV 1926 790606 INTEGER TABLE(5,1) C C INSTR = 1 C 10 IF (TABLE(4,INSTR).EQ.TABLE(5,INSTR)) GOTO 40 C IF (TABLE(4,INSTR).EQ.0) GOTO 20 JSB = (TABLE(4,INSTR).AND.074000B) - 014000B IF (JSB.NE.0) GOTO 30 C 20 WRITE (LU,900) (TABLE(I,INSTR),I=1,3) IERR = 1 GOTO 40 C 30 WRITE (LU,901) (TABLE(I,INSTR),I=1,5) IERR = 1 C 40 INSTR = INSTR + 1 IF (TABLE(1,INSTR).NE.0) GOTO 10 RETURN C C 900 FORMAT (" TXPF0 - WARNING - ENTRY POINT ",A2,A2,A2, + " INSTALLED BUT NOT DECLARED") C 901 FORMAT (" TXPF0 - ERROR - ENTRY POINT ",A2,A2,A2, + " DECLARED AS ",O6,", SHOULD BE ",O6) C C********************************************************************* END C********************************************************************* C C SUBROUTINE ABSNT(TABLE,IERR,LU),91711-16006 REV 1926 790606 INTEGER TABLE(5,1) C C INSTR = 1 C 10 IF ((TABLE(4,INSTR).AND.074000B).EQ.014000B) GOTO 20 IF (TABLE(4,INSTR).EQ.0) GOTO 20 C WRITE (LU,900) (TABLE(I,INSTR),I=1,4) IERR = 1 C 20 INSTR = INSTR + 1 IF (TABLE(1,INSTR).NE.0) GOTO 10 RETURN C C 900 FORMAT (" TXPF0 - ERROR - ENTRY POINT ",A2,A2,A2, + " DECLARED (",O6,") BUT NOT INSTALLED") C C********************************************************************* END G   91711-18007 1926 S C0122 &RPTBL TABLE OF ENTRY POINTS             H0101 ,ASMB,L NAM RPTBL 91711-16007 REV 1926 790605 * ENT EBASE EXT .FAD,.FSB,.FMP,.FDV,IFIX,FLOAT EXT .DLD,.DST,.MPY,.DIV EXT .MVW,.CMW,.LBT,.SBT * ENT FBAS1 ENT FBAS2 EXT .XADD,.XSUB,.XMPY,.XDIV,.TADD,.TSUB,.TMPY,.TDIV EXT .FIXD,.FLTD,.XFXS,.DINT,.FIXD,.XFXD,.XFTS,.IDBL EXT .FLTD,.XFTD,.TFXS,.TINT,.TFXD,.TFTS,.ITBL,.TFTD * ENT SIS1 EXT TAN,SQRT,ALOG,ATAN,COS,SIN,EXP,ALOGT,TANH * ENT SIS2 EXT DPOLY,/CMRT,/ATLG,.FPWR,.TPWR * ENT FFP EXT DBLE,SNGL,.DFER,.XFER,.XPAK,.XCOM,..DCM,DDINT EXT .GOTO,..MAP,.ENTR,.ENTP,.PWR2,.FLUN,.PACK,$SETP * ENT FFPF1 EXT .CFER * ENT FFPF2 EXT .BLE,.NGL,..FCM,..TCM * ENT FFPE1 ENT FFPE2 EXT XADD,XSUB,XMPY,XDIV * ENT DBI EXT .DAD,.DSB,.DMP,.DDI,.DSBR,.DDIR,.DNG,.DIN EXT .DDE,.DIS,.DDS,.DCO * ENT VIS EXT .VECT,VPIV,VABS,VSUM,VNRM,VDOT,VMAX,VMAB EXT VMIN,VMIB,VMOV,VSWP,.ERES,.ESEG,.VSET EXT .DVCT,DVPIV,DVABS,DVSUM,DVNRM,DVDOT EXT DVMAX,DVMAB,DVMIN,DVMIB,DVMOV,DVSWP * ENT EMA EXT .EMAP,MMAP,.EMIO * SKP ********************************************************************** * * HP1000 E-SERIES BASE SET * EBASE ASC 3,.FAD JSB .FAD OCT 105000 * ASC 3,.FSB JSB .FSB OCT 105020 * ASC 3,.FMP JSB .FMP OCT 105040 * ASC 3,.FDV JSB .FDV OCT 105060 * ASC 3,IFIX JSB IFIX OCT 105100 * ASC 3,FLOAT JSB FLOAT OCT 105120 * ASC 3,.DLD JSB .DLD OCT 104200 * ASC 3,.DST JSB .DST OCT 104400 SKP ASC 3,.MPY JSB .MPY OCT 100200 * ASC 3,.DIV JSB .DIV OCT 100400 * ASC 3,.MVW JSB .MVW OCT 105777 * ASC 3,.CMW JSB .CMW OCT 105776 * ASC 3, .LBT JSB .LBT OCT 105763 * ASC 3,.SBT JSB .SBT OCT 105764 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * HP1000 F-SERIES BASE SET * FBAS1 ASC 3,.XADD JSB .XADD OCT 105001 * ASC 3,.XSUB JSB .XSUB OCT 105021 * ASC 3,.XMPY JSB .XMPY OCT 105041 * ASC 3,.XDIV JSB .XDIV OCT 105061 * FBAS2 ASC 3,.FIXD JSB .FIXD OCT 105104 * ASC 3,.FLTD JSB .FLTD OCT 105124 * ASC 3,.XFXS JSB .XFXS OCT 105101 * ASC 3,.DINT JSB .DINT OCT 105101 SKP * ASC 3,.XFXD JSB .XFXD OCT 105105 * ASC 3,.XFTS JSB .XFTS OCT 105121 * ASC 3,.IDBL JSB .IDBL OCT 105121 * ASC 3,.XFTD JSB .XFTD OCT 105125 * ASC 3,.TADD JSB .TADD OCT 105002 * ASC 3,.TSUB JSB .TSUB OCT 105022 * ASC 3,.TMPY JSB .TMPY OCT 105042 * ASC 3,.TDIV JSB .TDIV OCT 105062 * ASC 3,.TFXS JSB .TFXS OCT 105102 SKP ASC 3,.TINT JSB .TINT OCT 105102 * ASC 3,.TFXD JSB .TFXD OCT 105106 * ASC 3,.TFTS JSB .TFTS OCT 105122 * ASC 3,.ITBL JSB .ITBL OCT 105122 * ASC 3,.TFTD JSB .TFTD OCT 105126 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * SCIENTIFIC INSTRUCTION SET. * SIS1 ASC 3,TAN JSB TAN OCT 105320 * ASC 3,SQRT JSB SQRT OCT 105321 * ASC 3,ALOG U& JSB ALOG OCT 105322 * ASC 3,ATAN JSB ATAN OCT 105323 * ASC 3,COS JSB COS OCT 105324 * ASC 3,SIN JSB SIN OCT 105325 * ASC 3,EXP JSB EXP OCT 105326 SKP ASC 3,ALOGT JSB ALOGT OCT 105327 * ASC 3,TANH JSB TANH OCT 105330 * OCT 0 END OF TABLE * ********************************************************************** * SIS2 ASC 3,DPOLY JSB DPOLY OCT 105331 * ASC 3,/CMRT JSB /CMRT OCT 105332 * ASC 3,/ATLG JSB /ATLG OCT 105333 * ASC 3,.FPWR JSB .FPWR OCT 105334 * ASC 3,.TPWR JSB .TPWR OCT 105335 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * EXTENDED MEMORY AREA * EMA ASC 3,.EMAP JSB .EMAP OCT 105257 * ASC 3,.EMIO JSB .EMIO OCT 105240 * ASC 3,MMAP JSB MMAP OCT 105241 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * COMMON FAST FORTRAN PROCESSOR * FFP ASC 3,DBLE JSB DBLE OCT 105201 * ASC 3,SNGL JSB SNGL OCT 105202 * ASC 3,.DFER JSB .DFER OCT 105205 * ASC 3,.XFER JSB .XFER OCT 105220 * ASC 3,.XPAK JSB .XPAK OCT 105206 * ASC 3,.XCOM JSB .XCOM OCT 105215 * ASC 3,..DCM JSB ..DCM OCT 105216 * ASC 3,DDINT JSB DDINT OCT 105217 SKP ASC 3,.GOTO JSB .GOTO OCT 105221 * ASC 3,..MAP JSB ..MAP OCT 105222 * ~ ASC 3,.ENTR JSB .ENTR OCT 105223 * ASC 3,.ENTP JSB .ENTP OCT 105224 * ASC 3,.PWR2 JSB .PWR2 OCT 105225 * ASC 3,.FLUN JSB .FLUN OCT 105226 * ASC 3,.PACK JSB .PACK OCT 105230 * ASC 3,$SETP JSB $SETP OCT 105227 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * E-SERIES FFP ADDITIONS * FFPE1 ASC 3,.XADD JSB .XADD OCT 105213 * ASC 3,.XSUB JSB .XSUB OCT 105214 * ASC 3,.XMPY JSB .XMPY OCT 105203 * ASC 3,.XDIV JSB .XDIV OCT 105204 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * E-SERIES FFP ADDITIONS * FFPE2 ASC 3,XADD JSB XADD OCT 105207 * ASC 3,XSUB JSB XSUB OCT 105210 * ASC 3,XMPY JSB XMPY OCT 105211 * ASC 3,XDIV JSB XDIV OCT 105212 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * F-SERIES FFP ADDITIONS * FFPF1 ASC 3,.CFER JSB .CFER OCT 105231 * OCT 0 END OF TABLE * ********************************************************************** * * F-SERIES FFP ENHANCEMENTS * FFPF2 ASC 3,.BLE JSB .BLE OCT 105207 * ASC 3,.NGL JSB .NGL OCT 105214 * ASC 3,..FCM JSB ..FCM OCT 105232 * ASC 3,..TCM JSB ..TCM OCT 105233 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * DOUBLE INTEGER INSTRUCTIONS * DBI ASC 3,.DAD JSB .DAD OCT 105014 * ASC 3,.DSB JSB .DSB OCT 105034 * ASC 3,.DMP JSB .DMP OCT 105054 * ASC 3,.DDI JSB .DDI OCT 105074 * ASC 3,.DSBR JSB .DSBR OCT 105114 * ASC 3,.DDIR JSB .DDIR OCT 105134 * ASC 3,.DNG JSB .DNG OCT 105203 * ASC 3,.DIN JSB .DIN OCT 105210 SKP ASC 3,.DDE JSB .DDE OCT 105211 * ASC 3,.DIS JSB .DIS OCT 105212 * ASC 3,.DDS JSB .DDS OCT 105213 * ASC 3,.DCO JSB .DCO OCT 105204 * OCT 0 END OF TABLE * ********************************************************************** SKP ********************************************************************** * * VECTOR INSTRUCTION SET * VIS ASC 3,.VECT JSB .VECT OCT 101460 * ASC 3,VPIV JSB VPIV OCT 101461 * ASC 3,VABS JSB VABS OCT 101462 * ASC 3,VSUM JSB VSUM OCT 101463 * ASC 3,VNRM JSB VNRM OCT 101464 * ASC 3,VDOT JSB VDOT OCT 101465 * ASC 3,VMAX JSB VMAX OCT 101466 * ASC 3,VMAB JSB VMAB OCT 101467 SKP ASC 3,VMIN JSB VMIN OCT 101470 * ASC 3,VMIB JSB VMIB OCT 101471 * ASC 3,VMOV JSB VMOV OCT 101472 * ASC 3,VSWP JSB VSWP OCT 101473 * ASC 3,.ERES JSB .ERES OCT 101474 * ASC 3,.ESEG JSB .ESEG OCT 101475 * ASC 3,.VSET JSB .VSET OCT 101476 * ASC 3,.DVCT JSB .DVCT OCT 105460 * ASC 3,DVPIV JSB DVPIV >$" OCT 105461 SKP ASC 3,DVABS JSB DVABS OCT 105462 * ASC 3,DVSUM JSB DVSUM OCT 105463 * ASC 3,DVNRM JSB DVNRM OCT 105464 * ASC 3,DVDOT JSB DVDOT OCT 105465 * ASC 3,DVMAX JSB DVMAX OCT 105466 * ASC 3,DVMAB JSB DVMAB OCT 105467 * ASC 3,DVMIN JSB DVMIN OCT 105470 * ASC 3,DVMIB JSB DVMIB OCT 105471 SKP ASC 3,DVMOV JSB DVMOV OCT 105472 * ASC 3,DVSWP JSB DVSWP OCT 105473 * OCT 0 END OF TABLE * ********************************************************************** END }m$   91711-18008 1926 S C0122 &MORFE FIND PROCESSOR TYPE             H0101 &ASMB,L NAM MORFE 91711-16008 REV 1926 790423 ENT MORFE EXT .ENTR,$LIBR,$LIBX * ********************************************************************** * * * ROUTINE TO DISTINGUISH M FROM E OR F MACHINES. * * * * CALL MORFE(ICODE) * * * * RETURNS ICODE = 0 PROGRAM RAN ON AN M MACHINE * * * * ICODE > 0 PROGRAM RAN ON AN E OR AN F MACHINE * * * ********************************************************************** * ICODE NOP RETURN ADDRESS HERE. MORFE NOP ENTRY POINT JSB .ENTR GET ADDRESSES DEF ICODE * * WE RETURN AN M MACHINE RESULT AT THIS POINT. * CLA PUT ZERO INTO THE A REGISTER STA ICODE,I RETURN THE ZERO. * * WE NOW GO CHECK FOR E OR F MACHINE. * INA PUT 1 IN THE A REGISTER JSB $LIBR DISABLE RTE'S DEFENSES. NOP CCB PUT -1 INTO THE B REGISTER OCT 100060 INVOKE TIMER INSTRUCTION, IF ANY. STA ICODE,I CAN ONLY GET HERE IF E OR F MACHINE. JSB $LIBX RE-ENABLE NORMAL RTE OPERATION. DEF *+1 DEF *+1 * * RETURN TO CALLING PROGRAM * JMP MORFE,I * END V  91711-18009 1926 S C0122 &FFPVF FAST FORTRAN VERIF.             H0101 ASMB,L NAM FFPVF 91711-16009 REV 1926 790421 ENT FFPVF EXT .ENTR ********************************************************************** * * * FAST FORTRAN PROCESSOR VERIFICATION SUBROUTINE * * * * CALL FFPVF(ICODE) * * * * RETURNS: ICODE = 0 FFP NOT INSTALLED * * ICODE < 0 FFP VERIFICATION FAILURE * * ICODE > 0 ICODE = FIRMWARE REV. NUMBER * * * ********************************************************************** ICODE BSS 1 * FFPVF NOP ENTRY POINT JSB .ENTR GET ADDRESSES DEF ICODE CLA SET A = 0 CAX SET X = 0 * CCB SET B = 177777B OCT 105226 .FLUN SZA,RSS SKIP IF A # 0 JMP DONE JUMP IF NOT INSTALLED ISX FFP INSTALLED, SET REV = 1 * LIB 1 SET B = S-REGISTER STB TEMP SAVE S-REGISTER IN TEMP CLA SET A = 0 OTA 1 SET S = 0 OCT 105200 FFP SELF-TEST NOP SELF-TEST ERROR RETURN LIA 1 SET A = TEST RESULT LDB TEMP SET B = TEMP OTB 1 RESTORE S-REGISTER * CXB SET B = X CPB =D1 DID TEST EXECUTE? JMP DONE NO, ALL DONE CPA HLT77 YES, CHECK RESULT JMP DONE FFP OK, ALL DONE LDX =D-1 FFP FAILURE, ERROR CODE * DONE STX ICODE,I RETURN ICODE JMP FFPVF,I RETURN * TEMP BSS 1 HLT77 HLT 77B * END %    91711-18010 1926 S C0122 &HFPVF HRDWR. FLT. PT. VERIF.             H0101 ASMB,L NAM HFPVF 91711-16010 REV 1926 790423 ENT HFPVF EXT .ENTR ********************************************************************** * * * HARDWARE FLOATING POINT VERIFICATION SUBROUTINE * * * * CALL HFPVF(ICODE) * * * * RETURNS: ICODE = 0 HFP NOT INSTALLED * * ICODE < 0 HFP VERIFICATION FAILURE * * ICODE > 0 ICODE = FIRMWARE REV. NUMBER * * * ********************************************************************** ICODE BSS 1 * HFPVF NOP ENTRY POINT JSB .ENTR GET ADDRESSES DEF ICODE CLA SET A = 0 CAX SET X = 0 CLB,INB SET B = 1 * OCT 105124 .FLTD SZA,RSS SKIP IF HFP INSTALLED JMP DONE E-SERIES, ALL DONE * ISX HFP INSTALLED, SET REV = 1 LIB 1 SET B = S-REGISTER STB TEMP SAVE S-REGISTER IN TEMP CLA SET A = 0 OTA 1 SET S = 0 OCT 105004 HFP SELF-TEST NOP SELF-TEST ERROR RETURN LIA 1 SET A = TEST RESULT LDB TEMP SET B = TEMP OTB 1 RESTORE S-REGISTER * CXB SET B = X CPB =D1 DID TEST EXECUTE? JMP DONE NO, ALL DONE CPA HLT77 YES, CHECK RESULT JMP DONE HFP OK, ALL DONE LDX =D-1 HFP FAILURE, ERROR CODE * DONE STX ICODE,I RETURN ICODE JMP HFPVF,I RETURN * TEMP BSS 1 HLT77 HLT 77B * END     91711-18011 1926 S C0122 &SISVF SCNTFC. INST. SET VERIF             H0101 xASMB,L NAM SISVF 91711-16011 REV 1926 790421 ENT SISVF EXT .ENTR ********************************************************************** * * * SCIENTIFIC INSTRUCTION SET VERIFICATION SUBROUTINE * * * * CALL SISVF(ICODE) * * * * RETURNS: ICODE = 0 SIS NOT INSTALLED * * ICODE < 0 SIS VERIFICATION FAILURE * * ICODE > 0 ICODE = FIRMWARE REV. NUMBER * * * ********************************************************************** ICODE BSS 1 * SISVF NOP ENTRY POINT JSB .ENTR GET ADDRESSES DEF ICODE CLA SET A = 0 CAX SET X = 0 * CLB SET B = 0 OCT 105321 SQRT JMP DONE JUMP IF NOT INSTALLED ISX SIS INSTALLED, SET REV = 1 * LIB 1 SET B = S-REGISTER STB TEMP SAVE S-REGISTER IN B CLA SET A = 0 OTA 1 SET S = 0 OCT 105337 SIS SELF-TEST NOP SELF-TEST ERROR RETURN LIA 1 SET A = TEST RESULT LDB TEMP SET B = TEMP OTB 1 RESTORE S-REGISTER * CXB SET B = X CPB =D1 DID TEST EXECUTE? JMP DONE NO, ALL DONE CPA HLT77 YES, CHECK RESULT JMP DONE SIS OK, ALL DONE LDX =D-1 SIS FAILURE, ERROR CODE * DONE STX ICODE,I RETURN ICODE JMP SISVF,I RETURN * TEMP BSS 1 HLT77 HLT 77B * END X    91711-18012 1926 S C0122 &EMAVF EXT. MEM. AREA VERIF.             H0101 ASMB,L NAM EMAVF 91711-16012 REV 1926 790604 ENT EMAVF EXT .ENTR ********************************************************************** * * * EXTENDED MEMORY AREA VERIFICATION SUBROUTINE * * * * CALL EMAVF(ICODE) * * * * RETURNS: ICODE = 0 EMA NOT INSTALLED * * ICODE < 0 EMA VERIFICATION FAILURE * * ICODE > 0 ICODE = FIRMWARE REV. NUMBER * * * ********************************************************************** * * ********************************************************************** * * * HERE WE WILL PUT A "JMP 3,I" IN LOCATION 2 IN BASE PAGE AND * * A "DEF LABEL" IN LOCATION 3 IN BASE PAGE * * * * THE A REGISTER IS NOT CHANGED BY RUNNING THIS MICROCODE. * * * * THE B REGISTER = 0 (THE LOGICAL ADDRESS OF ELEMENT). * ********************************************************************** * ORB JMP *+1,I DEF LABEL ORR * ICODE BSS 1 * EMAVF NOP ENTRY POINT JSB .ENTR GET ADDRESSES DEF ICODE CLA SET A = 0 STA ICODE,I SET ICODE = 0 * OCT 105257 .EMAP OCT 0 DEF RTN OCT 0 DEF ARRAY OCT 0 DEF TABLE * JMP EMAVF,I RETURN, NO FIRMWARE * * AT THIS POINT WE INVOKE SELF TEST * LABEL CLA,INA SET A = 1 O  CAX SET X = 1 * LIB 1 SET B = S-REGISTER STB TEMP SAVE S-REGISTER IN TEMP CLA SET A = 0 OTA 1 SET S = 0 OCT 105242 EMA SELF-TEST NOP LIA 1 SET A = TEST RESULT LDB TEMP RESTORE ORIGINAL CONTENTS OTB 1 OF THE S-REGISTER. * CXB SET B = X CPB D.1 REV. 1 FIRMWARE? JMP DONE YES! ALL DONE. CPA HLT77 NO! CHECK SWITCH REGISTER. JMP DONE EMA OK! ALL DONE. LDX DM.1 EMA FAILURE! LOAD ERROR CODE. * DONE STX ICODE,I RETURN ICODE. * JMP EMAVF,I RETURN. * TEMP BSS 1 HLT77 HLT 77B D.1 OCT 1 DM.1 DEC -1 * END   91711-18013 1926 S C0122 &DISVF D.S. FIRMWARE VERIF.             H0101 ASMB,L NAM DISVF 91711-16013 REV 1926 790421 ENT DISVF EXT .ENTR,$LIBR,$LIBX * MIC STE,105304B,0 DSTRBTD SYS SELF TEST IN 21MX-E. MIC STM,105524B,0 DSTRBTD SYS SELF TEST IN 21MX-M. * A EQU 0B THIS IS THE A REGISTER. * ********************************************************************** * * * DISTRIBUTED SYSTEM FIRMWARE VERIFICATION * * * * CALL DISVF(ICODE) * * * * RETURNS: ICODE = 0 DISTRIBUTED SYSTEM FIRMWARE NOT * * INSTALLED OR FAILED * * ICODE > 0 ICODE = FIRMWARE REV. NUMBER * * * ********************************************************************** * ICODE NOP * DISVF NOP ENTRY POINT JSB .ENTR GET ADDRESSES DEF ICODE * * WE NOW GO INVOKE THE DS/1000 SELF-TEST ON LINE. * SELFT LDA STMIN INITIALISE MACRO INSTRUCTION STA SFTIN FOR 21MX-M OPERATION. * JSB $LIBR DISABLE RTE'S DEFENSES! NOP LIB 01B GET CURRENT CONTENTS OF S REGISTER. STB SAVSW SAVE IT, TEMPORARILY. * CCB LDA STEIN GET 21MX-E MACRO INSTRUCTION. OCT 100060 INVOKE TIMER, IF ANY. STA SFTIN CAN ONLY GET HERE IF E OR F MACHINE. * SFTIN STM INVOKE DS/1000 SELF-IDENT TEST. CLA,RSS INVALID FIRMWARE INSTALLED. LIA 01B GET RETURNED REV CODE IN BCD FORMAT. LDB SAVSW GET SAVD SWITCH-REG CONTENTS. OTB 01B RESTORE ORIGINAL CONTENTS OF 'S'. * JSB $LIBX RE-ENABLE NORMAL RTE OPERATION. DEF *+1 DEF *+1 *  STA BCDN SAVE BCD REV CODE. * * WE GO CONVERT TO OCTAL REV CODE. * AND MASK GET THE LOWER FOUR BITS. ADA ATBL0 GET ADDRESS IN CONVERSION TABLE. LDB A,I GET CONTENTS OF CONVERSION TABLE. STB OCTN START BUILDING OCTAL NUMBER. LDA BCDN LOAD A WITH ORIGINAL BCD NUMBER. ALF GET MOST SIG. BCD DIGIT INTO AND MASK THE LOWER FOUR BITS OF A. ADA ATBL3 GET ADDRESS IN CONVERSION TABLE. LDB A,I GET CONTENTS OF CONVERSION TABLE. ADB OCTN CONTINUE BUILDING OCTAL NUMBER. STB OCTN TIDY AWAY INTERIM RESULT. LDA BCDN LOAD A WITH ORIGINAL BCD NUMBER. ALF,ALF GET 2ND MOST SIGNIFICANT BCD AND MASK DIGIT INTO THE LOWER FOUR BITS OF A. ADA ATBL2 GET ADDRESS IN CONVERSION TABLE. LDB A,I GET CONTENTS OF CONVERSION TABLE. ADB OCTN CONTINUE BUILDING OCTAL NUMBER. STB OCTN TIDY AWAY INTERIM RESULT. LDA BCDN LOAD A WITH ORIGINAL BCD NUMBER. ALF,ALF GET 3RD MOST SIGNIFICANT BCD ALF DIGIT INTO THE LOWER AND MASK FOUR BITS OF THE A REGISTER. ADA ATBL1 GET ADDRESS IN CONVERSION TABLE. LDB A,I GET CONTENTS OF CONVERSION TABLE. ADB OCTN COMPLETE BUILDING OCTAL NUMBER. * DONE STB ICODE,I RETURN ICODE JMP DISVF,I RETURN * * TABLE ADDRESS AREA. * ATBL0 DEF TBL0 4TH MOST SIGNIFICANT BCD TABLE. ATBL1 DEF TBL1 3RD MOST SIGNIFICANT BCD TABLE. ATBL2 DEF TBL2 2ND MOST SIGNIFICANT BCD TABLE. ATBL3 DEF TBL3 MOST SIGNIFICANT BCD DIGIT TABLE. * * TABLE AREA. * TBL0 OCT 0,1,2,3,4,5 OCT 6,7,10,11 TBL1 OCT 0,12,24,36,50 OCT 62,74,106,120,132 TBL2 OCT 0,144,310,454,620 OCT 764,1130,1274,1440,1604 TBL3 OCT 0,1750,3720,5670,7640 OCT 11610,13560,15530,17500,21450 * * VARIABLES, STORAGE AND CONSTANTS. * BCDN OCT 0 9 ORIGINAL BCD NUMBER GOES HERE. OCTN OCT 0 INTERMEDIATE & FINAL OCTAL NUMBER. MASK OCT 17 MASK FOR LOWER FOUR BITS. SAVSW OCT 0 TEMP VALUE OF SWITCH REGISTER. STEIN STE 21MX-E&F MACRO INSTRUCTION. STMIN STM 21MX- M MACRO INSTRUCTION. * END -  91711-18014 1926 S C0122 &VISVF VECTOR INST. SET VERIF.             H0101 ASMB,L NAM VISVF 91711-16014 REV 1926 790421 ENT VISVF EXT .ENTR ********************************************************************** * * * VECTOR INSTRUCTION SET VERIFICATION SUBROUTINE * * * * CALL VISVF(ICODE) * * * * RETURNS: ICODE = 0 VIS NOT INSTALLED * * ICODE < 0 VIS VERIFICATION FAILURE * * ICODE > 0 ICODE = FIRMWARE REV. NUMBER * * * ********************************************************************** ICODE BSS 1 * VISVF NOP ENTRY POINT JSB .ENTR GET ADDRESSES DEF ICODE CLA SET A = 0 CAX SET X = 0 * LIB 1 SET B = S-REGISTER STB TEMP SAVE S-REGISTER IN TEMP CLA SET A = 0 OTA 1 SET S = 0 OCT 105477 VIS SELF-TEST NOP SELF-TEST ERROR RETURN LIA 1 SET A = TEST RESULT LDB TEMP SET B = TEMP OTB 1 RESTORE S-REGISTER * CXB SET B = X SZB,RSS DID TEST EXECUTE? JMP DONE NO, ALL DONE CPA HLT77 YES, CHECK RESULT JMP DONE VIS OK, ALL DONE LDX =D-1 VIS FAILURE, ERROR CODE * DONE STX ICODE,I RETURN ICODE JMP VISVF,I RETURN * TEMP BSS 1 HLT77 HLT 77B * END   91711-18015 1926 S C0122 &TXMV0 DISC MEMORY VERIF.             H0101 FTN4,L PROGRAM TXMV0(3,89),91711-16015 REV 1926 790418 C C DISC MEMORY VERIFICATION PROGRAM. C C C GET INPUT PARAMETERS FROM RUN COMMAND C C RU,TXMV0,LIST,TESTLU C C WHERE LIST = LOGICAL UNIT FOR LISTING DEVICE. C DEFAULT IS TERMINAL CONSOLE (LU=1). C TESTLU = DISC LU TO BE TESTED C C C TEST SYSTEM DISC LOGICAL UNIT. C C TEST SEQUENCE IS: C 1. CREATE A FILE (TXM0X) ON THE LU. TYPE 1 FILE. C 2. IF AN ERROR OCCURS, THE FILE MAY HAVE ALREADY C EXISTED. THIS IS AN ERROR CONDITION. PROGRAM C REPORTS ERROR AND STOPS. C 3. OPEN THE FILE. (FILE IS AUTOMATICALLY REWOUND ON OPEN) C 4. WRITE 3 RECORDS TO THE FILE. C 5. READ THE DATA FROM THE FILE AND VERIFY EACH RECORD. C 6. REPORT ALL ERRORS ON LISTING LU. C 7. CLOSE THE FILE AND PURGE FILE. C C INTEGER PNAME(3) INTEGER NAME(3),IDCB(144),IERR,ISIZE(2),ITYPE INTEGER ICR,IPARMS(5),LULIST,LUDISC INTEGER ITEMP,CODE12 INTEGER NUMREC,IBUF(128,3),TBUF(128),NWORDS INTEGER ISTAT(125) INTEGER NERROR INTEGER CODE13 INTEGER I,J,L,LU,OFLAG INTEGER EQT4,EQT5,EQTST INTEGER NDTYPE C ERROR STATUS WORD DISC EQUIPMENT TYPES 031B AND 032B INTEGER M31LEN(8),M32LEN(8) INTEGER M31STR(8),M32STR(8) INTEGER M(125) C C DATA PNAME/2HTX,2HMV,2H0 / DATA NAME/2HTX,2HM0,2HX / DATA ISTAT/125*0/ DATA NERROR/0/ DATA ISIZE/3,128/ DATA ITYPE/1/ DATA IPARMS/5*0/ DATA CODE13/13/ DATA LULIST/1/ DATA IBUF/128*05252B,128*17777B,128*012525B/ DATA LUDISC/0/ DATA M( 1),M( 2),M( 3),M( 4),M( 5)/2HPR,2HOT,2HEC,2HT ,2HSW/ DATA M( 6),M( 7),M( 8),M( 9),M(10)/2HIT,2HCH,2H S,2HET,2H / DATA M(11),M(12),M(13),M(14),M(15)/2HDR,2HIV,2HE ,2HFO,2HRM/ DATA M(16),M(17),M(18),M(19y),M(20)/2HAT,2H S,2HWI,2HTC,2HH / DATA M(21),M(22)/2HSE,2HT / DATA M(23),M(24),M(25),M(26),M(27)/2HHA,2HRD,2HWA,2HRE,2H F/ DATA M(28),M(29),M(30)/2HAU,2HLT,2H / DATA M(31),M(32),M(33),M(34),M(35)/2HFL,2HAG,2HGE,2HD ,2HTR/ DATA M(36),M(37),M(38),M(39),M(40)/2HAC,2HK(,2HPR,2HOT,2HEC/ DATA M(41),M(42),M(43)/2HTE,2HD),2H / DATA M(44),M(45),M(46),M(47),M(48)/2HSE,2HEK,2H C,2HHE,2HCK/ DATA M(49)/2H / DATA M(50),M(51),M(52),M(53),M(54)/2HNO,2HT ,2HRE,2HAD,2HY / DATA M(55),M(56),M(57),M(58),M(59)/2HDE,2HVI,2HCE,2H B,2HUS/ DATA M(60)/2HY / DATA M(61),M(62),M(63),M(64),M(65)/2HER,2HRO,2HR ,2HEX,2HIS/ DATA M(66),M(67)/2HTS,2H / DATA M(68),M(69),M(70),M(71),M(72)/2HEN,2HD ,2HOF,2H T,2HAP/ DATA M(73)/2HE / DATA M(74),M(75),M(76),M(77),M(78)/2HAD,2HDR,2HES,2HS ,2HER/ DATA M(79),M(80),M(81)/2HRO,2HR ,2H / DATA M(82),M(83),M(84),M(85),M(86)/2HDA,2HTA,2H E,2HRR,2HOR/ DATA M(87)/2H / DATA M(88),M(89),M(90),M(91),M(92)/2HUN,2HDE,2HFI,2HNE,2HD / DATA M(93),M(94),M(95),M(96),M(97)/2H S,2HTA,2HTU,2HS ,2HBI/ DATA M(98)/2HT / DATA M(99),M(100),M(101),M(102)/2HDI,2HSC,2H H,2HAR/ DATA M(103),M(104),M(105),M(106)/2HDW,2HAR,2HE ,2HER/ DATA M(107),M(108),M(109),M(110)/2HRO,2HR ,2H ,2H / DATA M31LEN/10,12,10,10,10,05,06,07/ DATA M31STR/01,11,99,99,99,50,55,61/ DATA M32LEN/11,05,06,10,10,10,10,07/ DATA M32STR/88,50,68,99,99,99,99,61/ C C C GET INPUT PARAMETER FOR LISTING LOGICAL UNIT CALL RMPAR(IPARMS) LULIST=IPARMS(1) IF (IPARMS(1).LE.0) LULIST=LOGLU(IPARMS(1)) LUDISC = IPARMS(2) IF ((LUDISC.GT.0).AND.(LUDISC.LT.64)) GO TO 700 C INVALUD LU NUMBER SPECIFIED WRITE(LULIST,9795) (PNAME(J),J=1,3) 9795 FORMAT(/,2X,3A2,"- LU# SPECIFIED FOR DISC IS ILLEGAL."/  1" RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#.") GO TO 850 700 CONTINUE C C MAIN PROGRAM LOOP C C TEST ALL POSSIBLE LU'S ON SYSTEM LU = -LUDISC C TEST TO SEE IF LU IS ASSIGNED TO A KNOWN DISC TYPE. CALL EXEC(CODE13,LUDISC,EQT5,EQT4,EQTST) C C IF CHANNEL NUMBER = 0, THIS LU IS NOT ASSIGNED TO ANY DEVICE IF (IAND(EQT4,077B).NE.0) GO TO 800 C C LU IS UNASSIGNED. DO NOT TEST THIS LU. WRITE(LULIST,5007) (PNAME(J),J=1,3),LUDISC 5007 FORMAT(/,2X,3A2,"- LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GO TO 9999 C MAKE SURE DEVICE IS ASSIGNED TO A DISC DEVICE. 800 NDTYPE = IAND(EQT5,037400B) NDTYPE = NDTYPE / 0400B IF ((NDTYPE.GE.031B).AND.(NDTYPE.LE.033B)) GO TO 900 C LU NOT ASSIGNED TO A KNOWN DISC TYPE. WRITE(LULIST,5004) (PNAME(J),J=1,3),LUDISC 5004 FORMAT(/,2X,3A2,"- LU#",I3," IS NOT ASSIGNED TO A DISC."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GO TO 850 900 CONTINUE C CHECK DISC STATUS TO VERIFY THAT DISC CAN BE TESTED. C IS DISC ONLINE? CALL EXEC(CODE13,LUDISC,EQT5,EQT4,EQTST) IF (IAND(EQTST,0100000B).EQ.0) GO TO 925 C C DISC LU IS DOWN C WRITE(LULIST,5102) (PNAME(J),J=1,3),LUDISC GO TO 850 C C DISC LU IS UP. CHECK TO SEE IF CARTRIDGE IS MOUNTED. GET C STATUS OF CARTRIDGES MOUNTED. C 925 CALL FSTAT(ISTAT) DO 930 J=1,125,4 IF (LUDISC.EQ.ISTAT(J)) GO TO 940 IF (ISTAT(J).EQ.0) GO TO 932 930 CONTINUE C C CARTRIDGE IS NOT MOUNTED C 932 WRITE(LULIST,9321) (PNAME(J),J=1,3),LUDISC 9321 FORMAT(/,2X,3A2,"- LU#",I3,": CARTRIDGE NOT MOUNTED."/ 1" MOUNT CARTRIDGE AND RERUN TEST.") C C WRITE ABORT MESSAGE C 850 CONTINUE WRITE(LULIST,8501) (PNAME(J),J=1,3),LUDISC 8501 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!"/) GO TO 9999 C C START DISC TEST. ALL OPERATIONAL CHECKS HAVE BEEN MADE C 940 CONTINUE WRITE(LULIST,9501) (PNAME(J),J=1,3),LUDISC 9501 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST RUNNING") C TRY CREATING THE TEST FILE TXM0X ON THE DISC. IF AN ERROR C IS RETURNED THEN THE FILE PROBABLY ALREADY EXISTS. TEST C ERROR CODE. IF NOT AN ERROR FOR FILE PREVIOUSLY DEFINED, C THEN PRINT ERROR MESSAGE. C C INITIALIZE FLAG FOR FILE NOT OPENED YET. OFLAG = 0 CALL CREAT(IDCB,IERR,NAME,ISIZE,ITYPE,0,LU) C CREATE OPENS FILE FOR EXCLUSIVE ACCESS. C IERR > 0 NO ERROR. EQUALS SIZE OF FILE ALLOCATED. IF (IERR.NE.-6) GO TO 950 C ERROR = -6. CARTRIDGE NOT FOUND OR NO ROOM. C PROBABLE CAUSE IS CARTRIDGE NO MOUNTED OR CARTRIDGE FULL. WRITE(LULIST,5005) (PNAME(J),J=1,3),LUDISC 5005 FORMAT(/,2X,3A2,"- LU#",I3,": NO ROOM ON DISC FOR TEST FILE.") NERROR = NERROR + 1 GO TO 8000 950 CONTINUE IF (IERR.GT.0) GO TO 1000 IF (IERR.EQ.-2) GO TO 5060 IF (IERR.NE.-2) GO TO 5000 C IERR = -2 FOR FILE ALREADY EXISTS. OPEN THE FILE FOR C EXCLUSIVE ACCESS. CALL OPEN(IDCB,IERR,NAME,0,0,LU) IF (IERR.LT.0) GO TO 5010 C VERIFY FILE TYPE = 1 IF (IERR.NE.1) GO TO 5020 C THIS IS THE CORRECT TEST FILE. OPEN CALLS AUTOMATICALLY C REWIND THE FILE. WRITE, READ, AND VERIFY THREE RECORDS C (384 WORDS) 1000 CONTINUE C SET OPEN FLAG FOR FILE OPENED. OFLAG = 1 CALL WRITF(IDCB,IERR,IBUF,384,1) IF (IERR.LT.0) GO TO 5050 DO 1500 J=1,3 CALL READF(IDCB,IERR,TBUF,128,NWORDS,J) IF (IERR.NE.0) GO TO 5030 DO 1200 L=1,128 IF (TBUF(L).EQ.IBUF(L,J)) GO TO 1200 C DATA VERIFICATION ERROR WRITE(LULIST,5135) (PNAME(K),K=1,3),LUDISC,(NAME(K),K=1,3) 5135 FORMAT(/,2X,3A2,"- LU#",I2,": READ/WRITE DATA DOES NOT VERIFY" 1" ON FILE ",3A2) IF (NERROR.GE.6) GO TO 8000 1200 CONTINUE 1500 CONTINUE C C DATA VERIFIES. CLOSE FILE. CALL CLOSE(IDCB,IERR) IFk (IERR.LT.0) GO TO 5040 C TEST COMPLETED SUCCESSFULLY. WRITE MESSAGE TO LISTING CALL PURGE(IDCB,IERR,NAME,0,LU) IF (IERR.LT.0) GO TO 5070 GO TO 8000 C C ERROR PATHS C 5000 WRITE(LULIST,5100) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5100 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR CREATING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5010 WRITE(LULIST,5110) (PNAME(J),J=1,3), LUDISC,(NAME(J),J=1,3), 1 IERR 5110 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR OPENING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5020 WRITE(LULIST,5120) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5120 FORMAT(/,2X,3A2,"- LU#",I3,": CREATED FILE ",3A2," IS WRONG" 1"TYPE. TYPE=",I4) GO TO 5500 5030 WRITE(LULIST,5130) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5130 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR READING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5040 WRITE(LULIST,5140) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5140 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR CLOSING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5050 WRITE(LULIST,5150) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5150 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR WRITING FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5060 WRITE(LULIST,5160) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5160 FORMAT(/,2X,3A2,"- LU#",I3,": DUPLICATE FILE ",3A2,". " 1 "ERROR=",I4) GO TO 5500 5070 WRITE(LULIST,5170) (PNAME(J),J=1,3),LUDISC,(NAME(J),J=1,3), 1 IERR 5170 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR PURGING FILE ",3A2,". " 1 "ERROR=",I4) C C GET ERROR STATUS FROM DEVICE C 5500 CONTINUE NERROR = NERROR + 1 C GET DEVICE STATUS (I/O STATUS CALL) CALL EXEC(CODE13,LUDISC,EQT5,EQT4,EQTST) C CHECK LOGICAL UNIT DECLARED DOWN IF (EQTST.LT.0) GO TO 5750 C PRINT ERROR STATUS DEPENDING UPON DISC TYPE. EQT5 = EQT5/2 $" DO 5575 K=7,1,-1 IF (IAND(EQT5,1).EQ.0) GO TO 5560 IF (NDTYPE-032B) 5510,5520,5560 C DISC EQUIPMENT TYPE = 031B 5510 WRITE(LULIST,5555) (PNAME(J),J=1,3),LUDISC, 1 (M(M31STR(K)+J-1), J=1,M31LEN(K)) GO TO 5560 C DISC EQUIPMENT TYPE = 032B 5520 WRITE(LULIST,5555) (PNAME(J),J=1,3),LUDISC, 1 (M(M32STR(K)+J-1), J=1,M32LEN(K)) 5555 FORMAT(/,2X,3A2,"- LU#",I3,": ",20A2) C DISC EQUIPMENT TYPE = 033B 5560 EQT5 = EQT5/2 5575 CONTINUE C CLEANUP FOR ERROR CONDITIONS. CLOSE AND PURGE FILE. IF (OFLAG.EQ.0) GO TO 5600 CALL CLOSE(IDCB,IERR) CALL PURGE(IDCB,IERR,NAME,0,LU) 5600 GO TO 8000 5750 WRITE(LULIST,5102) (PNAME(J),J=1,3),LUDISC 5102 FORMAT(/,2X,3A2,"- LU#",I3,", EQT OR LU FOR TEST DISC" 1" IS DOWN."/" UP EQT AND RERUN TEST.") C C END OF MAIN PROGRAM LOOP C 8000 CONTINUE WRITE(LULIST,9810) (PNAME(J),J=1,3),LUDISC,NERROR 9810 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST FINISHED ",I2, 1" ERRORS"/) C C TERMINATE PROGRAM 9999 CONTINUE END END$ $   91711-18016 1926 S C0122 &TXDS0 D.S. SYSTEM VERIF.             H0101 tFTN4,B,L PROGRAM TXDS0(3,89),91711-16016 REV 1926 790427 DIMENSION IBUF(5),ITIM1(5),ITIM2(5),ITIM3(5),ITIM4(5) C C C********************************************* C* TXDS0 * C* PRIMARY SYSTEM DS/1000 TEST * C* RELOC.: 91711-16016 REV 1926 * C* SOURCE: 91711-18016 REV 1926 * C********************************************* C C C LGLU=LOG DEVICE LU, DEFAULT=1 IF SPECIFIED PARAMETER IS .LE. 0 C LU=TEST DEVICE LU, MUST BE LU# OF DS/1000 INTERFACE IN LOCAL CPU C IERR=NUMBER OF ERRORS THAT OCCURRED DURING TEST C C RETRIEVE RUN PARAMETERS C CALL RMPAR(IBUF) LGLU=IBUF IF(IBUF.LE.0)LGLU=LOGLU(LGLU) IF(IBUF(2).LE.0)GOTO 400 LU=IBUF(2) IERR=0 C C GET STATUS OF TEST DEVICE LU C CALL EXEC(13,LU,ISTA1,ISTA2,ISTA3) C C CHECK CHANNEL# IN STATUS WORD TWO, IF NON-ZERO THEN LU IS ENABLED C ICHAN=IAND(ISTA2,77B) IF(ICHAN.EQ.0)410,10 C C TEST DEVICE LU IS ENABLED C C INSURE THAT DEVICE TYPE IS 65 C 10 ITYPE=IAND(ISTA1,37400B) IF(ITYPE.EQ.32400B)15,420 C C CHECK SUBCHANNEL NUMBER IN STATUS WORD 3 C ODD S.C. MEANS CLOSED LOOP, EVEN S.C. MEANS OPEN LOOP. C 15 ISUB=IAND(ISTA3,1) C C CHECK IF COMMUNICATION LINK LU IS DOWN C 20 ISTAT=IAND(ISTA3,100000B) C C CHECK IF COMMUNICATION LINK EQT IS DOWN C 25 IEQT=IAND(ISTA1,140000B) IF((IEQT.EQ.0).AND.(ISTAT.EQ.0))30,440 C C CHECK IF NODE NUMBER OF REMOTE SYSTEM WAS SPECIFIED AT RUN TIME C 30 IF((IBUF(3).GT.0).AND.(IBUF(3).LE.32767))GOTO 70 IF(ISUB.EQ.0)GOTO 45 35 WRITE(LGLU,40)LU,LU 40 FORMAT(/" TXDS0 - LU#",I3,": BE SURE THAT THE REMOTE SYSTEM" 1" TO BE TESTED"/" HAS BEEN INITIALIZED AND IS" 2" CONNECTED TO THE HARDWIRE"/" INTERFACE CONFIGURED" 3" TO LU#",I3," IN THIS LOCAL SYSTEM.") GOTO 55 45 WRITE(LGLU,50)LU,LU 50 FORMAT(/" TXDS0 - LU#",I3,": BE SURE THAT[ THE REMOTE SYSTEM" 1" TO BE TESTED"/" HAS BEEN INITIALIZED AND IS" 2" CONNECTED TO THE MODEM"/" INTERFACE CONFIGURED" 3" TO LU#",I3," IN THIS LOCAL SYSTEM.") 55 WRITE(LGLU,60) LU 60 FORMAT(/" TXDS0 - LU#",I3,": ENTER A NODE NUMBER BETWEEN 1 AND" 1" 32767"/" FOR THE REMOTE SYSTEM TO BE TESTED OR TYPE" 2" /A TO ABORT"/" THIS TEST: _") C CALL EXEC(1,LGLU+400B,IBUF,3) IF(IBUF.EQ.2H/A) GOTO 500 CALL CODE(5) READ(IBUF,*)INODE IF((INODE.GT.0).AND.(INODE.LE.32767)) GOTO 75 WRITE(LGLU,65)LU,INODE 65 FORMAT(/" TXDS0 - LU#",I3,": ",I5," IS AN ILLEGAL NODE NUMBER.") GOTO 55 70 INODE=IBUF(3) C C BEGIN DS/1000 TEST C 75 WRITE(LGLU,80)LU,INODE 80 FORMAT(/" TXDS0 - LU#",I3,": DS/1000 TEST RUNNING ON NODE#" 1,I5) C C GET REMOTE SYSTEM TIME C 270 CALL DEXEC(INODE,11,ITIM1) C C PREVENT INVALID TEST DUE TO SECONDS CHANGING FROM 59 TO 0 C IF(ITIM1(2).GE.58) 270,280 C C GET LOCAL SYSTEM TIME C 280 CALL EXEC(11,ITIM3) C C PREVENT INVALID TEST DUE TO SECONDS CHANGING FROM 59 TO 0 C IF(ITIM3(2).GE.58) 270,290 C C CONVERT PORTION OF LOCAL TIME TO TENS OF MILLISECONDS C 290 MS3=(100*ITIM3(2))+ITIM3(1) C C COMPUTE LOCAL TIME NECESSARY TO INDICATE ELAPSE OF ON SECOND C MS3A=MS3+100 C C GET LOCAL SYSTEM TIME AGAIN C 300 CALL EXEC(11,ITIM4) C C CONVERT PORTION OF NEW LOCAL TIME TO TENS OF MILLISECONDS C MS4=(100*ITIM4(2)+ITIM4(1)) C C LOOP UNTIL ONE SECOND HAS ELAPSED C IF (MS4.LE.MS3A) 300,310 C C GET REMOTE SYSTEM TIME AGAIN C 310 CALL DEXEC(INODE,11,ITIM2) C C INSURE THAT REMOTE NODE SYSTEM TIME WAS INCREMENTED C IF(ITIM2(2).LE.ITIM1(2))450,85 C C COMPLETION MESSAGE C 85 WRITE(LGLU,90)LU,INODE,IERR 90 FORMAT(/" TXDS0 - LU#",I3,": DS/1000 TEST FINISHED ON NODE#" 1,I5," ",I1," ERRORS"/) GOTO 1000 C C ERROR ME SSAGES C 400 WRITE(LGLU,405) 405 FORMAT(/" TXDS0 - LU# SPECIFIED FOR DS/1000 LINK IS" 1" ILLEGAL."/" RERUN TEST SPECIFYING AN INTEGER >0 AND" 2" <64 FOR LU#.") GOTO 500 C 410 WRITE(LGLU,415)LU 415 FORMAT(/" TXDS0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 1000 C 420 WRITE(LGLU,425)LU 425 FORMAT(/" TXDS0 - LU#",I3," IS NOT ASSIGNED TO A DS/1000 LINK."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GOTO 500 C 440 WRITE(LGLU,445)LU 445 FORMAT(/" TXDS0 - LU#",I3,": EQT OR LU FOR DS/1000 LINK IS" 1" DOWN."/" UP EQT AND RERUN TEST.") GOTO 500 C 450 WRITE(LGLU,455)LU,INODE 455 FORMAT(/" TXDS0 - LU#",I3,", NODE#",I5,": TIME TEST FAILED!") IERR=IERR+1 GOTO 85 500 WRITE(LGLU,505)LU 505 FORMAT(/" TXDS0 - LU#",I3,": DS/1000 TEST ABORTED!"/) 1000 END END$   91711-18017 1926 S C0122 &TXIB0 HPIB INTERFACE VERIF.             H0101 +FTN4,L PROGRAM TXIB0(3,89),91711-16017 REV 1926 790428 DIMENSION IBUF(5) C C LGLU=LOG DEVICE LU, DEFAULT=TERMINAL LU IF SPECIFIED PARAMETER IS <=0. C LU=TEST DEVICE LU, MUST BE LU # OF BUS,SUBCHANNEL ZERO C IERR=NUMBER OF ERRORS THAT OCCURRED DURING TEST C C RETRIEVE RUN PARAMETERS C CALL RMPAR(IBUF) LGLU=IBUF IF(IBUF.LE.0)LGLU=LOGLU(LGLU) IF(IBUF(2).LE.0)GOTO 400 LU=IBUF(2) IERR=0 C C GET STATUS OF TEST DEVICE LU C CALL EXEC(13,LU,ISTA1,ISTA2,ISTA3) C C CHECK CHANNEL# IN STATUS WORD TWO, IF NON-ZERO THEN LU IS ENABLED C ICHAN=IAND(ISTA2,77B) IF(ICHAN.EQ.0)410,10 C C TEST DEVICE LU IS ENABLED C C INSURE THAT DEVICE TYPE IS 37 C 10 ITYPE=IAND(ISTA1,37400B) IF(ITYPE.EQ.17400B)15,420 C C CHECK SUBCHANNEL NUMBER IN STATUS WORD 3 C IF ZERO THEN IT IS A BUS LU # C 15 ISUB=IAND(ISTA3,37B) IF(ISUB.EQ.0)20,420 C C CHECK IF BUS LU IS DOWN C 20 ISTAT=IAND(ISTA3,100000B) C C CHECK IF BUS EQT IS DOWN C 25 IEQT=IAND(ISTA1,140000B) IF((IEQT.EQ.0).AND.(ISTAT.EQ.0)) 28,430 C C BEGIN HP-IB TEST C 28 WRITE(LGLU,29)LU 29 FORMAT(/" TXIB0 - LU#",I3,": HP-IB TEST RUNNING") C C GET BUS STATUS C 30 CALL STATS(LU,ISTAT) C C MASK 'REN' LINE TO DETERMINE INITIAL STATE C ISTAT=IAND(ISTAT,20B) IF(ISTAT.EQ.0)35,40 C C SET 'REN' LINE TRUE C 35 CALL RMOTE(LU) C C GET STATUS WORD AND INSURE THAT 'REN' LINE WAS SET C CALL STATS(LU,ISTA1) ISTA2=IAND(ISTA1,20B) IF(ISTA2.EQ.20B)40,450 C C SET 'REN' LINE FALSE C 40 CALL LOCL(LU) C C GET STATUS WORD AND INSURE THAT 'REN' LINE WAS RESET C CALL STATS(LU,ISTA1) ISTA2=IAND(ISTA1,20B) IF(ISTA2.EQ.0)45,460 C C SET 'REN' LINE TRUE C 45 IF(ISTAT.EQ.0)55,50 50 CALL RMOTE(LU) C C GET STATUS WORD AND INSURE THAT 'REN' LINE WAS SET C CALL STATS(LU,ISTA1) ISTA2=IAND(ISTA1,20B)    IF(ISTA2.EQ.20B)55,450 C C COMPLETION MESSAGE C 55 WRITE(LGLU,60)LU,IERR 60 FORMAT(/" TXIB0 - LU#",I3,": HP-IB TEST FINISHED ",I2, 1" ERRORS"/) GOTO 1000 C C ERROR MESSAGES C 400 WRITE(LGLU,405) 405 FORMAT(/" TXIB0 - LU# SPECIFIED FOR HP-IB INTERFACE" 1" IS ILLEGAL."/" RERUN TEST SPECIFYING AN INTEGER >0" 2" AND <64 FOR LU#.") GOTO 500 C 410 WRITE(LGLU,415)LU 415 FORMAT(/" TXIB0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 1000 C 420 WRITE(LGLU,425)LU 425 FORMAT(/" TXIB0 - LU#",I3," SPECIFIED FOR HP-IB INTERFACE" 1" IS NOT ASSIGNED"/" TO SUBCHANNEL 0. RERUN TEST" 2" SPECIFYING CORRECT LU#.") GOTO 500 C 430 WRITE(LGLU,435)LU 435 FORMAT(/" TXIB0 - LU#",I3,": EQT OR LU FOR TEST HP-IB" 1" IS DOWN."/" UP EQT AND RERUN TEST.") GOTO 500 C 450 WRITE(LGLU,455)LU 455 FORMAT(/" TXIB0 - LU#",I3,": 'REN' CONTROL LINE WAS NOT SET.") IERR=IERR+1 GOTO 55 C 460 WRITE(LGLU,465)LU 465 FORMAT(/" TXIB0 - LU#",I3,": 'REN' CONTROL LINE WAS NOT RESET.") IERR=IERR+1 GOTO 55 500 WRITE(LGLU,505)LU 505 FORMAT(/" TXIB0 - LU#",I3,": HP-IB TEST ABORTED!"/) 1000 END END$    91711-18018 1926 S C0122 &TXMT0 MAG TAPE VERIFICATION             H0101 ?FTN4,L PROGRAM TXMT0(3,89),91711-16018 REV 1926 790501 C C GET INPUT PARAMETERS C RU,TXMT0,LIST,TESTLU,LOOPS C WHERE LIST=LOGICAL UNIT FOR LOG DEVICE. DEFAULT IS THE C SYSTEM CONSOLE, LU 1 C TESTLU=MAGNETIC TAPE UNIT TO BE TESTED C LOOPS=NUMBER OF TEST ITERATIONS. DEFAULT IS ONE. C C MODIFIED 790201 BY ED COPE C VIRGIN TAPE READ TEST ADDED C C TEST MAGNETIC TAPE LOGICAL UNIT C C TEST SEQUENCE IS: C 1. REWIND C 2. TEST WRITE RING STATUS C 3. TEST START OF TAPE(SOT) STATUS C 4. WRITE RECORD, LENGTH EQUAL 1024 WORDS C 5. WRITE RECORD, LENGTH EQUAL 512 WORDS C 6. WRITE RECORD, LENGTH EQUAL 256 WORDS C 7. WRITE END OF FILE RECORD C 8. WRITE RECORD, LENGTH EQUAL 1024 WORDS C 9. WRITE RECORD, LENGTH EQUAL 512 WORDS C 10. WRITE RECORD, LENGTH EQUAL 256 WORDS C 11. WRITE END OF FILE RECORD C 12. REWIND C 13. TEST STATUS=SOT C 14. READ RECORD C 15. VERIFY RECORD C 16. READ RECORD C 17. VERIFY RECORD C 18. READ RECORD C 19. VERIFY RECORD C 20. READ RECORD C 21. VERIFY END OF FILE STATUS C 22. READ RECORD C 23. VERIFY RECORD C 24. READ RECORD C 25. VERIFY RECORD C 26. READ RECORD C 27. VERIFY RECORD C 28. READ RECORD C 29. VERIFY END OF FILE STATUS C 30. BACKWARD SPACE RECORD C 31. BACKWARD SPACE RECORD C 32. READ RECORD C 33. VERIFY RECORD C 34. READ RECORD C 35. VERIFY END OF FILE STATUS C 36. REWIND C 37. VERIFY START OF TAPE STATUS C 38. FORWARD SPACE FILE C 39. VERIFY END OF FILE STATUS C 40. READ RECORD C 41. VERIFY RECORD C 42. BACKWARD SPACE FILE C 43. VERIFY END OF FILE STATUS C 44. REWIND C 45. READ RECORD C 46. BACKSPACE RECORD C 47. READ RECORD C 48. VERIFY RECORD C 49. REWIND C & 50. VERIFY START OF TAPE STATUS C 51. ERASE 32 INCHES OF TAPE C 52. REWIND C 53. READ RECORD C 54. VERIFY ZERO LENGTH XMISSION LOG C 55. **TERMINATE TEST** C C C INTEGER IPARMS(5) INTEGER LULIST,LU INTEGER EQT5,EQT4,EQTST INTEGER ERASE INTEGER CODE13 INTEGER NDTYPE INTEGER IREG(2) INTEGER REGA,REGB INTEGER GO,AB INTEGER LOCKOP,UNLOCK INTEGER PNAME(3) INTEGER MAXSTP,CONWD INTEGER REWND,WEOF INTEGER IOCONE,WRITEE,READE INTEGER IOCON,DYNSTA,TEMP INTEGER BUFFER(1024) INTEGER BUFLEN,BUFL(8),TBUF(1026) INTEGER BKSPR,FWSPR,BKSPF,FWSPF INTEGER NERROR,RN INTEGER ST(75) INTEGER LUCMD(33),LLUCMD INTEGER EQOFF( 5),EQON(5),LEQOFF,LEQON INTEGER EMASK(2),EQTASC INTEGER CHAR,CHRMSK(2) INTEGER BUFST EQUIVALENCE (IREG(1),REGA,REG),(IREG(2),REGB) C C C INDEX STMT NO. OPERATION C ----- -------- --------- C 1 500 REWIND C 2 510 WRITE RECORD C 3 520 VERIFY DATA BUFFER C 4 530 WRITE END OF FILE C 5 6000 NO OPERATION C 6 550 BACKWARD SPACE RECORD OPERATION C 7 560 FORWARD SPACE RECORD OPERATION C 8 570 CHECK STATUS FOR WRITE RING C 9 580 CHECK STATUS FOR END OF FILE C 10 590 READ RECORD FROM TAPE C 11 600 CHECK STATUS FOR SOT(START OF TAPE) C 12 610 FORWARD SPACE FILE C 13 620 BACKWARD SPACE FILE C 14 7600 **TERMINATE TEST** C 15 630 ERASE 32 INCHES OF TAPE C 16 640 VERIFY ZERO LENGTH XMISSION LOG C DATA ST( 1),ST( 2),ST( 3),ST( 4),ST( 5)/ 1, 8,11, 2, 2/ DATA ST( 6),ST( 7),ST( 8),ST( 9),ST(10)/ 2, 4, 2, 2, 2/ DATA ST(11),ST(12),ST(13),ST(14),ST(15)/ 4, 1,11,10, 3/ DATA ST(16),ST(17),ST(1$+8),ST(19),ST(20)/10, 3,10, 3,10/ DATA ST(21),ST(22),ST(23),ST(24),ST(25)/ 9,10, 3,10, 3/ DATA ST(26),ST(27),ST(28),ST(29),ST(30)/10, 3,10, 9, 6/ DATA ST(31),ST(32),ST(33),ST(34),ST(35)/ 6,10, 3,10, 9/ DATA ST(36),ST(37),ST(38),ST(39),ST(40)/ 1,11,12, 9,10/ DATA ST(41),ST(42),ST(43),ST(44),ST(45)/ 3,13, 9, 1,10/ DATA ST(46),ST(47),ST(48),ST(49),ST(50)/ 6,10, 3, 1,11/ DATA ST(51),ST(52),ST(53),ST(54),ST(55)/15, 1,10,16,14/ DATA IPARMS/5*0/ DATA LULIST/1/ DATA EQT5,EQT4,EQTST/3*0/ DATA CODE13/13/ DATA GO/2HGO/,AB/2HAB/ DATA LOCKOP/0140001B/,UNLOCK/0100000B/ DATA PNAME/2HTX,2HMT,2H0 / DATA MAXSTP/55/ DATA REWND/0400B/,WEOF/0100B/,BKSPR/0200B/,FWSPR/0300B/ DATA IOCON/3/,DYNSTA/0600B/ DATA BKSPF/001400B/,FWSPF/001300B/ DATA IOCONE/0100003B/,WRITEE/0100002B/,READE/0100001B/ DATA BUFFER/512*012525B,256*017777B,256*052525B/ DATA BUFL/1024,512,256,0,1024,512,256,0/ DATA TBUF/1026*0/ DATA NERROR/0/,RN/1/ DATA LUCMD/2HLU,2H, ,2HXX,30*2H / DATA LLUCMD/8/ DATA EQON/2HEQ,2H, ,2HXX,2H,B,2HU / DATA LEQON/10/ DATA EQOFF/2HEQ,2H, ,2HXX,2H,U,2HN / DATA LEQOFF/10/ DATA EMASK/000105B,042400B/ DATA CHRMSK/00377B,177400B/ DATA ERASE/1200B/ C C C C C GET INPUT PARAMETER FOR LIST LU AND MAG TAPE LU. C CALL RMPAR(IPARMS) IF (IPARMS(1).GT.0) LULIST=IPARMS(1) C C GET ITERATION COUNT C LOOPS = 1 IF(IPARMS(3) .GT. 0) LOOPS = IPARMS(3) C C GET MAG TAPE LU. C IF (IPARMS(2).GT.0) LU=IPARMS(2) IF ((LU.GT.0).AND.(LU.LT.64)) GO TO 40 C ILLEGAL LOGICAL UNIT SPECIFIED WRITE(LULIST,30) (PNAME(J),J=1,3) 30 FORMAT(/,2X,3A2,"- LU# SPECIFIED FOR MAG TAPE IS ILLEGAL."/ 1" RERUN TEST SPECIFYING AN INTEGER >0 AND <64E FOR LU#.") C ERROR EXIT. ABORT MESSAGE. GO TO 1000 C C TEST TO SEE IF LU IS ASSIGNED TO A TAPE. C C GET MAG TAPE STATUS C 40 CALL EXEC(CODE13,LU,EQT5,EQT4,EQTST) C IF CHANNEL NUMBER = 0, LU IS NOT ASSIGNED TO ANY DEVICE. IF (IAND(EQT4,077B).NE.0) GO TO 50 C LU IS NOT ASSIGNED. DO NOT TEST THIS LU. WRITE(LULIST,4005) (PNAME(J),J=1,3),LU 4005 FORMAT(/,2X,3A2,"- LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) C NORMAL EXIT. NO ABORT MESSAGE GO TO 9900 C C MAKE SURE DEVICE IS ASSIGNED TO A MAGNETIC TAPE. C 50 NDTYPE = IAND(EQT5,037400B) NDTYPE = NDTYPE/0400B IF ((NDTYPE.EQ.023B)) GO TO 80 C C LU IS NOT ASSIGNED TO A 7970 MAG TAPE. C WRITE(LULIST,55) (PNAME(J),J=1,3),LU 55 FORMAT(/,2X,3A2,"- LU#",I3," IS NOT ASSIGNED TO MAG TAPE."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") C ERROR EXIT. ABORT MESSAGE GO TO 1000 C C MAKE SURE LU IS NOT DOWN. C 80 CONTINUE N = EQT5/040000B IF ((N.NE.01).AND.(IAND(EQTST,100000B).EQ.0)) GO TO 83 C LU OR EQT IS DOWN WRITE(LULIST,8101) (PNAME(J),J=1,3),LU 8101 FORMAT(/,2X,3A2,"- LU#",I3,": EQT OR LU FOR TEST MAG TAPE" 1" IS DOWN."/" UP EQT AND RERUN TEST.") C ABORT MESSAGE GO TO 1000 C C C LU IS CORRECTLY ASSIGNED. ISSUE MESSAGE TO MOUNT SCRATCH TAPE. C 83 CONTINUE WRITE(LULIST,8301) (PNAME(J),J=1,3),LU 8301 FORMAT(/,2X,3A2,"- LU#",I3,":"/ 1" MOUNT SCRATCH TAPE WITH WRITE RING ON TEST UNIT AND"/ 2" SET UNIT ON-LINE. TYPE /C TO CONTINUE TEST OR" 3" TYPE /A"/" TO ABORT THIS TEST: _") C C RETRIEVE OPERATOR RESPONSE C CALL EXEC(1,LULIST+400B,IBUF,1) IF(IBUF.EQ.2H/C) GOTO 200 IF(IBUF.EQ.2H/A) GOTO 1000 GOTO 83 C C SCRATCH TAPE IS READY. LOCK THE MAGNETIC TAPE LU AND PROCEED C WITH THE TEST. C 200 CONTINUE CALL LURQ(LOCKOP,LU,1) C  ERROR RETURN IF LU COULD NOT BE LOCKED GO TO 9000 C C CHECK CURRENT BUFFERING STATUS OF THE LU C 402 CONWD = LU + DYNSTA C FORCE DEVICE TO BE ACCESSED TO GET OFFLINE STATUS CALL EXEC(IOCON,CONWD) CALL EXEC(CODE13,LU,EQT5,EQT4,EQTST) IF (IAND(EQT5,1).EQ.0) GO TO 210 C UNIT IS OFFLINE WRITE(LULIST,2001) (PNAME(J),J=1,3),LU 2001 FORMAT(/,2X,3A2,"- LU#",I3,": TEST MAG TAPE UNIT OFF-LINE."/ 1" SET UNIT ON-LINE AND RERUN TEST.") GO TO 1000 210 CONTINUE BUFST=IAND(EQT4,040000B) IF (BUFST.EQ.0) GO TO 400 C C DEVICE IS BUFFERED. GET EQT ENTRY FROM LU COMMAND. THEN C FORM AN OPERATOR COMMAND TO FORCE THE DEVICE TO BE UNBUFFERED. C LUCMD(3) = KCVT(LU) N=MESSS(LUCMD,LLUCMD) DO 300 I=1,-N J=MOD(I,2)+1 CHAR = IAND(LUCMD((I+1)/2),CHRMSK(J)) IF (IAND(CHAR,EMASK(J)).EQ.CHAR) GO TO 320 300 CONTINUE C IF CONTROL GETS HERE, THERE IS AN ERROR IN THE SCAN LOOP PAUSE 10 C C I = INDEX INTO COMMAND FOR E, J=LEFT/RIGHT BYTE C 320 GO TO (322,321),J C C 'E' IS IN RIGHT BYTE. EQT ENTRY IS NEXT WORD. C 322 EQTASC =LUCMD((I+2)/2) GO TO 330 C C 'E' IN LEFT BYTE C 321 EQTASC = LUCMD((I+1)/2)*0400B+LUCMD((I+2)/2)/0400B C 330 CONTINUE C EQTASC = EQT ENTRY IN ASCII EQOFF(3) = EQTASC N=MESSS(EQOFF,LEQOFF) 400 CONTINUE C NORMAL RETURN. LU IS LOCKED TO THIS PROGRAM. START TEST. C C*************************************************************** C MAIN PROGRAM LOOP FOR TEST C*************************************************************** C WRITE(LULIST,3001) (PNAME(J),J=1,3),LU 3001 FORMAT(/,2X,3A2,"- LU#",I3,": MAG TAPE TEST RUNNING") C DO 8100 LOOP = 1,LOOPS DO 8000 I=1,MAXSTP C C GET STATUS AND FORCE LAST OPERATION TO BE COMPLETED. C CONWD = LU + DYNSTA CALL EXEC(IOCON,CONWD) CALL ABREG(EQT5,TEMP) C LABEL=ST(I) GO TO (500,510,520,530,6000,550,560,570,580,590, 600,610, 1 620,7600,630,640), LABEL C C**************************************************************** C REWIND THE MAGNETIC TAPE C**************************************************************** C 500 CONWD = LU + REWND CALL EXEC(IOCONE,CONWD) C ERROR RETURN - A-REGISTER = DEVICE STATUS. GO TO 7000 C NORMAL RETURN - GO TO END OF LOOP C REWIND SECOND TIME TO FORCE SOT STATUS TO BE STORED 405 CALL EXEC(IOCONE,CONWD) C ERROR RETURN - A-REG = DEVICE STATUS GO TO 7000 C NORMAL RETURN - GO TO END OF LOOP WITH SOT STATUS SET 410 RN=0 GO TO 6000 C C**************************************************************** C WRITE RECORD TO TAPE C**************************************************************** C 510 CONTINUE CONWD = LU RN = RN + 1 BUFLEN = BUFL(RN) CALL EXEC(WRITEE,CONWD,BUFFER,BUFLEN) C ERROR RETURN. A-REG = DEVICE STATUS. B=TRANSMISSION LOG GO TO 7000 C NORMAL RETURN 515 CONTINUE GO TO 6000 C C*************************************************************** C READ A RECORD FROM THE TAPE C*************************************************************** C 590 CONTINUE CONWD = LU RN = RN + 1 BUFLEN = BUFL(RN)+2 CALL EXEC(READE,CONWD,TBUF,BUFLEN) C ERROR RETURN. A=REG=DEVICE STATUS. B=TRANSMISSION LOG GO TO 7000 C NORMAL RETURN. A-REG=STATUS. B-REG=NUMBER OF WORDS READ. C VERIFY NUMBER OF WORDS. 415 CALL ABREG(REGA,REGB) GO TO 6000 C C**************************************************************** C VERIFY THE DATA BUFFER C**************************************************************** C C REGB = NUMBER OF WORDS TO VERIFY 520 CONTINUE IF (REGB.EQ.BUFL(RN)) GO TO 521 C RECORD LENGTHS DO NOT VERIFY WRITE(LULIST,5221) (PNAME(J),J=1,3),LU,BUFL(RN),REGB GO TO 7500d C COMPARE DATA BUFFERS 521 CONTINUE DO 522 N=1,REGB IF (BUFFER(N).EQ.TBUF(N)) GO TO 522 C DATA VERIFICATION ERROR NERROR = NERROR + 1 WRITE(LULIST,5221) (PNAME(J),J=1,3),LU 5221 FORMAT(/,2X,3A2,"- LU#",I3,": READ/WRITE DATA DOES NOT VERIFY!") IF (NERROR.GE.6) GO TO 7500 C END OF DATA VERIFICATION LOOP 522 CONTINUE GO TO 6000 C C C**************************************************************** C WRITE END OF FILE C**************************************************************** C 530 CONTINUE CONWD = LU + WEOF CALL EXEC(IOCONE,CONWD) C ERROR RETURN. A-REG=STATUS GO TO 7000 C NORMAL RETURN 420 RN = RN + 1 GO TO 6000 C C**************************************************************** C CHECK STATUS. END OF FILE SHOULD BE SET. (EOF) C**************************************************************** C 580 CONTINUE IF (IAND(EQT5,0200B).EQ.0200B) GO TO 6000 C C ERROR -- END OF FILE NOT DETECTED C REGA = EQT5 GO TO 7001 C C C**************************************************************** C BACKWARD SPACE RECORD OPERATION C**************************************************************** C 550 CONTINUE CONWD = LU + BKSPR CALL EXEC(IOCONE,CONWD) C ERROR RETURN. A-REG=STATUS GO TO 7000 C NORMAL RETURN 425 RN = RN - 1 GO TO 6000 C C C**************************************************************** C FORWARD SPACE RECORD OPERATION C**************************************************************** C 560 CONTINUE CONWD = LU + FWSPR CALL EXEC(IOCONE,CONWD) C ERROR RETURN -- A-REG = STATUS GO TO 7000 C NORMAL RETURN 430 RN = RN + 1 GO TO 6000 C C**************************************************************** C CHECK STATUS FOR WRITE RING C**************************************************************** / C 570 CONTINUE IF (IAND(EQT5,4).EQ.0) GO TO 6000 C NO WRITE RING WRITE(LULIST,5701) (PNAME(J),J=1,3),LU 5701 FORMAT(/,2X,3A2,"- LU#",I2,": NO WRITE RING ON SCRATCH TAPE!"/ 1" INSTALL WRITE RING AND UP EQT FOR MAG TAPE. THE TEST"/ 2" WILL CONTINUE.") GO TO 6000 C C C**************************************************************** C TEST START OF TAPE STATUS (SOT) C**************************************************************** C 600 CONTINUE IF (IAND(EQT5,0100B).EQ.0100B) GO TO 6000 C C ERROR -- START OF TAPE NOT DETECTED IN STATUS C REGA = EQT5 GO TO 7001 C C**************************************************************** C FORWARD SPACE FILE C**************************************************************** C 610 CONTINUE CONWD = LU + FWSPF CALL EXEC(IOCONE,CONWD) C ERROR RETURN GO TO 7000 C NORMAL RETURN 435 GO TO 6000 C C C**************************************************************** C BACKWARD SPACE FILE C**************************************************************** C 620 CONTINUE CONWD = LU + BKSPF CALL EXEC(IOCONE,CONWD) C ERROR RETURN GO TO 7000 C NORMAL RETURN 440 IF (RN-4) 621,622,622 C BACKSPACE TO START OF TAPE 621 RN = 0 GO TO 623 C C C BACKSPACE FILE TO A SUBFILE ON TAPE C 622 RN = ((RN-4)/4)*4+3 623 GO TO 6000 C C C********************************************************************* C ERASE 32 INCHES OF TAPE C********************************************************************* C C 630 CONTINUE CONWD = LU + ERASE DO 633 NERASE = 1,64 CALL EXEC(IOCONE,CONWD) C C ERROR RETURN C GO TO 7000 C C NORMAL RETURN C 633 CONTINUE GO TO 6000 C C C********************************************************************* C VERIFY ZERO RECORD LENGTH C*******$Y************************************************************** C C 640 CONTINUE IF(REGB .EQ. 0) GO TO 6000 C C WRITE DIAGNOSTIC MESSAGE C WRITE(LULIST,641) (PNAME(J),J=1,3),LU 641 FORMAT(/,2X,3A2,"- LU#",I3,": EXPECTED ZERO XMISSION LOG NOT " 1 ,"ENCOUNTERED") WRITE(LULIST,642) PNAME,LU,REGB 642 FORMAT(2X,3A2,"- LU#",I3,": XMISSION LOG = ",I6) NERROR = NERROR + 1 GO TO 6000 C C ERROR POINT TO PRINT STATUS BITS. REG B = STATUS FROM EQT5 C 7000 CONTINUE CALL ABREG(REGA,REGB) 7001 CONTINUE WRITE(LULIST,7002) (PNAME(J),J=1,3),LU,REGA 7002 FORMAT(/,2X,3A2,"- LU#",I3,": HARDWARE ERROR, STATUS = ",O6) IF (IAND(REGA,2).NE.0) WRITE(LULIST,7005) (PNAME(J),J=1,3),LU 7005 FORMAT(2X,3A2,"- LU#",I3,": PARITY/TIMING ERROR!") WRITE(LULIST,7007) (PNAME(J),J=1,3),LU,I 7007 FORMAT(2X,3A2,"- LU#",I3,": TEST STEP ",I2) WRITE(LULIST,7008) (PNAME(J),J=1,3),LU,LABEL 7008 FORMAT(2X,3A2,"- LU#",I3,": TEST INDEX",I3) C C INCREMENT ERROR COUNT 7500 CONTINUE NERROR = NERROR + 1 C C**************************************************************** C END OF MAIN LOOP. TEST FOR MAXIMUM ERRORS EXCEEDED. C**************************************************************** 6000 CONTINUE IF (NERROR.GE.6) GO TO 7600 8000 CONTINUE C C MAIN LOOP TERMINATION C 7600 CONTINUE C C PRINT LOOP COUNT C WRITE(LULIST,8110) (PNAME(I),I=1,3),LOOP 8110 FORMAT(2X,3A2," - COMPLETED LOOP NUMBER ",I5) 8100 CONTINUE C C UNLOCK MAG TAPE LU C C C RESTORE ORIGINAL DEVICE BUFFERING STATUS C IF (BUFST.EQ.0) GO TO 7605 C SEND COMMAND TO BUFFER THE EQT ENTRY. EQON(3) = EQTASC N=MESSS(EQON,LEQON) 7605 CONTINUE CALL LURQ(UNLOCK,LU,1) C PRINT TEST FINISHED MESSAGE C WRITE(LULIST,7601) (PNAME(J),J=1,3),LU,NERROR 7601 FORMAT(/,2X,3A2,"- LU#",I3,": MAG TAPE TEST FINISHED ",I4, 1<:6" ERRORS"/) GO TO 9900 C C ERROR PATH FOR RESOURCE NOT LOCKED C 9000 CALL ABREG(REGA,REGB) WRITE(LULIST,9001) (PNAME(J),J=1,3),LU 9001 FORMAT(/,2X,3A2,"- LU#",I3,": MAG TAPE COULD NOT BE LOCKED!") IF (REGA) 9002,1000,9005 C 9002 WRITE(LULIST,9003) (PNAME(J),J=1,3),LU 9003 FORMAT(2X,3A2,"- LU#",I3,": NO RESOURCE NUMBER AVAILABLE!") GO TO 1000 C 9005 WRITE(LULIST,9006) (PNAME(J),J=1,3),LU 9006 FORMAT(2X,3A2,"- LU#",I3,": MAG TAPE ALREADY LOCKED!") C C WRITE TEST ABORT MESSAGE C 1000 WRITE(LULIST,1999) (PNAME(J),J=1,3),LU 1999 FORMAT(/,2X,3A2,"- LU#",I3,": MAG TAPE TEST ABORTED!"/) C C PROGRAM EXIT C 9900 CONTINUE END P<  91711-18019 1926 S C0122 &TXWL0 LINE PRINTER VERIF.             H0101 FTN4,L PROGRAM TXWL0(3,89),91711-16019 REV 1926 790428 C C C THIS TEST IS FOR CHECKOUT OF LINE PRINTERS USING DRIVER DVA12 OR DVB12 C C VARIABLE NAMES USED IN THIS PROGRAM ARE AS FOLLOWS: C IBUF1-6...BUFFERS CONTAINING DATA TO BE PRINTED C IQUE......INPUT FROM CRT TO ABORT OR CONTINUE PROGRAM C IPRAM(1)..LOG DEVICE LU C IPRAM(2)..TEST DEVICE LU C ILUL......PROGRAM NAME FOR LOG LU C ILUT......PROGRAM NAME FOR TEST LU C MLU.......MASK OF ISTAT2 FOR CHECK IF LU IS ASSIGNED C MTYP......MASK OF ISTAT1 FOR DEVICE TYPE CHECK C MAV.......MASK OF ISTAT1 FOR DEVICE AVAILABILITY CHECK C AND STATUS C ISTAT1....EQT WORD 5 C ISTAT2....EQT WORD 4 C ISTAT3....WORD WHICH GIVES LU STATUS & SUBSHANNEL C ISTR......BUFFER LOCATION FOR PROGRAMMABLE STATUS READ C IDOT......BUFFER LOCATION FOR DOT MATRIX & PING-PONG READ C ITYPE.....INPUT FROM CRT FOR TYPE OF PRINTER C IT........A CONSTANT = 1 IF PRINTER IS A 2608A C DIMENSION IBUF1(40),IBUF2(40),IBUF3(41),IBUF4(40),IBUF5(40) 1,IBUF6(22),IQUE(1),IPRAM(5),ISTR(258),IDOT(1154),ITYPE(3) DATA IBUF1/2HAB,2HCD,2HEF,2HGH,2HIJ,2HKL,2HMN,2HOP,2HQR,2HST, 12HUV,2HWX,2HYZ,2H01,2H23,2H45,2H67,2H89,2H!",2H #/ DATA IBUF2/2H$%,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43,2H21, 12H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,2HPQ/ DATA IBUF3/2H0$,2H%&,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43, 12H21,2H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,1HP/ DATA IBUF4/2H*A,2H C,2H E,2H G,2H I,2H K,2H M,2H O,2H Q,2H S, 12H U,2H W,2H Y,2H 0,2H 2,2H 4,2H 6,2H 8,2H !,2H "/ DATA IBUF5/2H B,2H D,2H F,2H H,2H J,2H L,2H N,2H P,2H R,2H T, 12H V,2H X,2H Z,2H 1,2H 3,2H 5,2H 7,2H 9,2H #,2H $/ DATA IBUF6/2H1 ,2H ,2H ,2H ,2H ,2HTO,2HP ,2HOF,2H F,2HOR,2HM!/ CALL RMPAR(IPRAM) IT=0 C C ASSIGN LOG DEVICE LU C ILUL=IPRAM(1) IF(IPRAM(1).LE.0) ILUL=LOGLU(IPRAM(1)) C C ASSIGN TEST DEVI2CE LU C IF(IPRAM(2).LE.0) GOTO 8020 40 ILUT=IPRAM(2) C C********************************************************************* C* SECTION 100 - GET LU AND VERIFY C********************************************************************* C CALL EXEC(13,ILUT,ISTAT1,ISTAT2,ISTAT3) C C CHECK TO SEE IF LU WAS ASSIGNED C MLU=IAND(ISTAT2,77B) IF(MLU) 8000,8000,100 C C CHECK FOR PROPER DEVICE TYPE C 100 MTYP=IAND(ISTAT1,37400B) IF(MTYP-5000B) 8100,110,8100 C C CHECK FOR TEST DEVICE AVAILABILITY C 110 MAV=IAND(ISTAT1,140000B) IF(MAV) 8200,120,8200 C C CHECK TO SEE IF LU IS UP C 120 MAV=IAND(ISTAT3,100000B) IF(MAV) 8200,500,8200 C C********************************************************************* C* SECTION 500 - GRAPHICS AND DOT MATRIX TESTS C********************************************************************* C 500 WRITE(ILUL,505) ILUT 505 FORMAT(/" TXWL0 - LU#",I3,": IS PRINTER A 2608A (Y OR N)? _") CALL EXEC(1,ILUL+400B,ITYPE,1) IF(ITYPE.EQ.2HN ) GOTO 1017 IT=1 WRITE(ILUL,506) ILUT 506 FORMAT(/" TXWL0 - LU#",I3,": DOT MATRIX TEST RUNNING") C C HEADER C WRITE(ILUT,510) 510 FORMAT(30X,"2608A PRINTER TESTS!"///,30X,"DOT MATRIX TEST"//) C C DOT MATRIX READ/WRITE TEST C CALL EXEC(1,ILUT,IDOT,-1153,0) CALL EXEC(3,ILUT+3000B,2) DO 600 I=1,1153 WRITE(ILUT,512) IDOT(I) 512 FORMAT(50(""),A2) 600 CONTINUE CALL EXEC(3,ILUT+3000B,0) C C PING-PONG READ/WRITE TEST C WRITE(ILUT,610) 610 FORMAT(/////30X,"PING-PONG READ/WRITE TEST TO FOLLOW") WRITE(ILUL,612) ILUT 612 FORMAT(/" TXWL0 - LU#",I3,": PING-PONG TEST RUNNING") CALL EXEC(3,ILUT) CALL EXEC(1,ILUT+100B,IDOT,257) DO 620 I=1,257 WRITE(ILUT,615) I,IDOT(I),IDOT(I) 615 FORMAT(20X," BUFFER LOC.(",I3,") = ",@6," = ",A2) 620 CONTINUE C C***************************************]****************************** C* SECTION 1000 - PRINT & LINE SPACE TESTS C********************************************************************* C C WRITE(ILUT,1000) 1000 FORMAT(//////30X,"PRINT VERSION OF SELF-TEST TO FOLLOW") C SELF TEST--PRINT VERSION C WRITE(ILUL,1005) ILUT 1005 FORMAT(/" TXWL0 - LU#",I3,": SELF TEST--PRINT VERSION" 1" RUNNING.") CALL EXEC(3,ILUT+2000B,0) C C DOUBLE SIZE PRINT TEST C WRITE(ILUT,1010) 1010 FORMAT(30X,"DOUBLE SIZE PRINT TEST") WRITE(ILUL,1015) ILUT 1015 FORMAT(/" TXWL0 - LU#",I3,": DOUBLE SIZE PRINT TEST RUNNING.") CALL EXEC(3,ILUT+3000B,1) WRITE(ILUT,1016) 1016 FORMAT(/" DOUBLE SIZE PRINT"/) CALL EXEC(3,ILUT+3000B,0) 1017 WRITE(ILUT,1018) 1018 FORMAT(//////30X,"STANDARD PRINTER TESTS TO FOLLOW") WRITE(ILUL,1019) ILUT 1019 FORMAT(/" TXWL0 - LU#",I3,": CHARACTER & LINE SPACE TEST" 1" RUNNING") C C OUTPUT DATA FROM BUFFERS TO PRINTER C C OUTPUT TEN LINE SPACINGS C CALL EXEC(3,ILUT+1100B,10) C C OUTPUT BUFFER, PRINT COLUMN 1 C CALL EXEC(2,ILUT+200B,IBUF1,-40) C C OUTPUT BUFFER, PRINT COLUMN 1 C CALL EXEC(2,ILUT+200B,IBUF2,-40) C C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. C DO A DOUBLE SPACE, THEN OUTPUT BUFFER. C CALL EXEC(2,ILUT,IBUF3,-41) C C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. C SUPPRESS SPACE (OVERPRINT), THEN OUTPUT BUFFER PRINTING COLUMN 1. C CALL EXEC(2,ILUT,IBUF4,-40) C C OUTPUT BUFFER, PRINT COLUMN 1. C CALL EXEC(2,ILUT+200B,IBUF5,-40) C C SPACE ONE LINE C CALL EXEC(3,ILUT+1100B,1) C C OUTPUT BUFFER TO CHECK CHARACTERS C WRITE(ILUT,1020) 1020 FORMAT(" ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!'#$%&()-=@+<>?:876" 1"543210ZYXWVUTSRQPONMLKJ") C C FIRST CHARACTER INTERPRETED AS A CONTROL CHARACTER C TOP OF FORM, THEN OUTPUT BUFFER. C CALL EXEC(2,ILUT,IBUF6,-22) C C REQUEST TO CONTI=NUE OR ABORT C WRITE(ILUL,1030) ILUT 1030 FORMAT(/" TXWL0 - LU#",I3,": CHARACTER & LINE SPACE TEST" 1" FINISHED") 1040 WRITE(ILUL,1050) ILUT 1050 FORMAT(/" TXWL0 - LU#",I3,": TYPE /C TO CONTINUE NEXT TEST" 1" OR"/" TYPE /A TO ABORT THIS TEST: _") CALL EXEC(1,ILUL+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 2000 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 1040 C C********************************************************************* C* SECTION 2000 - CONTROL FUNCTION TESTS C********************************************************************* C 2000 IF(IT) 2005,2016,2005 C C CONTROL REQUEST FOR STATUS READ & OUTPUT OF STATUS C 2005 WRITE(ILUL,2010) ILUT 2010 FORMAT(/" TXWL0 - LU#",I3,": CONTROL REQUEST FOR STATUS READ." 1" UNIQUE TO 2608A PRINTER.") WRITE(ILUT,2011) 2011 FORMAT(///20X,"CONTROL REQUEST STATUS READ - UNIQUE TO 2608A" 1" PRINTER"///) CALL EXEC(1,ILUT+200B,ISTR,16) DO 2015 I=1,16 WRITE(ILUT,2012) ILUT,I,ISTR(I) 2012 FORMAT(10X," TXWL0 - LU#",I3,": STATUS BUFFER WORD #",I3," - ",@6) 2015 CONTINUE 2016 WRITE(ILUL,2018) ILUT 2018 FORMAT(/" TXWL0 - LU#",I3,": CONTROL FUNCTION TEST RUNNING") C C DO A PAGE EJECT AND WRITE TOP OF FORM MESSAGE C CALL EXEC(3,ILUT+1100B,-1) WRITE(ILUT,2020) 2020 FORMAT(" TOP OF FORM!") C C SKIP TO NEXT 1/6 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ILUT+1100B,61) WRITE(ILUT,2030) 2030 FORMAT(" 1/6 PAGE BOUNDRY!") C C SKIP TO NEXT 1/4 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ILUT+1100B,60) WRITE(ILUT,2040) 2040 FORMAT(" 1/4 PAGE BOUNDRY!") C C SKIP TO NEXT 1/2 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ILUT+1100B,59) WRITE(ILUT,2050) 2050 FORMAT(" 1/2 PAGE BOUNDRY!") C C SKIP TO BOTTOM OF THE PAGE AND PRINT MESSAGE C CALL EXEC(3,ILUT+1100B,62) WRITE(ILUT,2060) 2060 FORMAT("  BOTTOM OF PAGE!") C C SKIP TO APPROXIMATELY 3/4 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ILUT+1100B,45) WRITE(ILUT,2070) 2070 FORMAT(" APPROXIMATELY 3/4 DOWN PAGE!") C C SKIP TO TOP OF NEXT PAGE C CALL EXEC(3,ILUT+1100B,63) WRITE(ILUL,2080) ILUT 2080 FORMAT(/" TXWL0 - LU#",I3,": LINE PRINTER TESTS FINISHED"/) GOTO 9900 C C********************************************************************* C* SECTION 8000 - ERROR MESSAGES C********************************************************************* C 8000 WRITE(ILUL,8010) ILUT 8010 FORMAT(/" TXWL0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 9900 8020 WRITE(ILUL,8025) 8025 FORMAT(/" TXWL0 - LU# SPECIFIED FOR LINE PRINTER" 1" IS ILLEGAL."/" RERUN TEST SPECIFYING AN INTEGER >0" 2" AND <64 FOR LU#.") GOTO 9000 8100 WRITE(ILUL,8110) ILUT 8110 FORMAT(/" TXWL0 - LU#",I3," IS NOT ASSIGNED TO A LINE PRINTER."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GOTO 9000 8200 WRITE(ILUL,8210) ILUT 8210 FORMAT(/" TXWL0 - LU#",I3,": EQT OR LU FOR TEST PRINTER" 1" IS DOWN."/" UP EQT AND RERUN TEST.") C C********************************************************************* C* SECTION 9000 - ABORT MESSAGE AND TERMINATE C********************************************************************* C 9000 WRITE(ILUL,9010) ILUT 9010 FORMAT(/" TXWL0 - LU#",I3,": LINE PRINTER TEST ABORTED!"/) 9900 END END$ g   91711-18020 1926 S C0122 &TXTT0 2645/48 TERMINAL VERIF.             H0101 FTN4,L PROGRAM TXTT0(3,89),91711-16020 REV 1926 791112 C C CHANGED 791112. IF ILUT=0, DO NOT ATTEMPT TO WRITE C ERROR MESSAGES TO ILUT. C C C**************************************** C* TXTT0 * C* PRIMARY SYSTEM 2645/48 TERMINAL TEST * C* RELOC.: 91711-16020 * C* SOURCE: 91711-18020 * C**************************************** C C C THIS PROGRAM IS FOR TESTING KEYBOARD, DISPLAY AND CARTRIDGE C TAPE OPERATION OF DEVICES USING DRIVERS DVR05 OR DVA05. THE C PROGRAM IS INITIATED VIA THE COMMAND C C RU,TXTT0,L,T,LC/M,RC C C WHERE: L IS THE LU OF THE LOG DEVICE (DEFAULT TO 1) C T IS THE LU OF THE KEYBOARD/CRT DEVICE TO BE TESTED. C THIS INPUT IS A MUST! C LC IS THE LU OF THE LEFT CTU TO BE TESTED C THE PROGRAM WILL DEFAULT TO AUTOMATIC MODE. C M SPECIFIES MENU MODE, FOLLOWING PARAMETER C NOT REQUIRED C RC IS THE LU OF THE RIGHT CTU TO BE TESTED C C IF 'T' IS MISSING, THE PROGRAM WILL ABORT AND PRINT AN APPROPRIATE C MESSAGE ON THE LOG DEVICE. IF 'MODE' IS 'M', THE PROGRAM WILL GO C INTO MENU MODE AND ASK FOR EACH TEST TO BE RUN. DEFAULT CONDITION C FOR 'MODE' IS AUTOMATIC. IN THIS CASE TESTS WILL BE RUN ON ALL LU'S C SPECIFIED IN THE RUN STATEMENT PARAMETERS ABOVE. C C THE VARIABLES USED IN THIS PROGRAM ARE AS FOLLOWS: C C IBUFD......DATA STORED IN PROGRAM TO BE TRANSFERRED TO DISPLAY C IBUFT......DATA STORED FORM KEYBOARD INPUT TO BE CHECKED AGAINST C CONTENTS OF IBUFD C IREG.......A & B REGISTERS FOR PARAMATER RETURN OF EXEC CALLS C IA.........A REGISTER (NOT USED IN THIS PROGRAM) C IB.........B REGISTER, USED FOR INPUT CHARACTER COUNT C IQUE.......PROMPT VARIABLE FOR ABORT OR CONTINUE REQUEST C IPRAM(1)...PARAMATER PASSED FOR LOG DEVICE LU C IPRAM(2)...PARAMATER PASSED FOR KEYBOARD/DISPLAY TESGT DEVICE LU C IPRAM(3)...PARAMATER PASSED FOR LEFT-CTU TEST DEVICE LU C IPRAM(4)...PARAMATER PASSED FOR RIGHT-CTU TEST DEVICE LU C IPRAM(5)...PARAMATER PASSED FOR MENU OR NON-MENU MODE C LGLU.......LOG DEVICE LU C ILUT.......LU OF TEST DEVICE KEYBOARD/DISPLAY C LGLUC......LU OF TEST DEVICE LEFT-CTU C ILURC......LU OF TEST DEVICE RIGHT-CTU C ICRTS1.....KEYBOARD/DISPLAY EQT WORD 5 C ICRTS2.....KEYBOARD/DISPLAY EQT WORD 4 C ICRTS3.....BITS 15 & 0-4 OF THIS STATUS WORD GIVES LU AVAILABILITY C AND SUB-CHANNEL RESPECTIVELY OF KEYBOARD/DISPLAY C ILCTU1.....LEFT-CTU EQT WORD 5 C ILCTU2.....LEFT-CTU EQT WORD 4 C ILCTU3.....BITS 15 & 0-4 OF THIS STATUS WORD GIVES LU AVAILABILITY C AND SUB-CHANNEL RESPECTIVELY OF LEFT-CTU C IRCTU1.....RIGHT-CTU EQT WORD 5 C IRCTU2.....RIGHT-CTU EQT WORD 4 C IRCTU3.....BITS 15 & 0-4 OF THIS STATUS WORD GIVES LU AVAILABILITY C AND SUB-CHANNEL RESPECTIVELY OF RIGHT-CTU C MLUCRT.....MASK OF ICRTS2 TO CHECK FOR GENERATED LU ASSIGNMENT C MCRTYP.....MASK OF ICTRS1 TO CHECK FOR PROPER DEVICE TYPE C MCRTAV.....MASK OF ICRTS1 TO CHECK FOR EQT AVAILABILITY C MCRTSC.....MASK OF ICRTS3 TO CHECK FOR LU AVAILABILITY AND C PROPER SUB-CHANNEL ASSIGNMENT C MLULC......MASK OF ILCTU2 TO CHECK FOR GENERATED LU ASSIGNMENT C MLCTYP.....MASK OF ILCTU1 TO CHECK FOR PROPER DEVICE TYPE C MLCAV......MASK OF ILCTU1 TO CHECK FOR EQT AVAILABILITY C MLCSC......MASK OF ILCTU3 TO CHECK FOR LU AVAILABILITY AND C PROPER SUB-CHANNEL ASSIGNMENT C MLURC......MASK OF IRCTU2 TO CHECK FOR GENERATED LU ASSIGNMENT C MRCTYP.....MASK OF IRCTU1 TO CHECK FOR PROPER DEVICE TYPE C MRCAV......MASK OF IRCTU1 TO CHECK FOR EQT AVAILABILITY C MRCSC......MASK OF IRCTU3 TO CHECK FOR LU AVAILABILITY AND C PROPER SUB-CHANNEL ASSIGNMENT C ISTAT1.....VARIABLE CONTAINING EQT WORD 5 TO CHECK FOR WRITE C PROTECT STATUS OF LEFT AND RIGHT-CTU'S C MWP........MASK OF ISTAT1 TO CHECK WRITE PROTECT STATUS C MENU.......VARIABLE TO DETERMINE IF MENU MODE (MENU=1 IN MENU MODE) C IERRK......ERROR COUNTER FOR KEYBOARD/CRT TESTS C IERRL......ERROR COUNTER FOR LEFT CTU TESTS C IERRR......ERROR COUNTER FOR RIGHT CTU TESTS C IERR.......SUM OF IERRK, IERRL AND IERRR DIMENSION IBUFD(40), IREG(2), IQUE(1), IPRAM(5), IBUFT(40) 1, IBUFC1(40), IBUFC2(1) EQUIVALENCE (REG,IREG,IA), (IREG(2),IB) DATA IBUFD/2HU*,2H3L,2HG8,2H =/ DATA IBUFC1/2HAB,2HCD,2HEF,2HGH,2HIJ,2HKL,2HMN,2HOP,2HQR,2HST, 12HUV,2HWX,2HYZ,2H01,2H23,2H45,2H67,2H89/ DATA IBUFC2/1H@/ CALL RMPAR(IPRAM) MENU=0 IERRK=0 IERRL=0 IERRR=0 C C ASSIGN LOG DEVICE LU C LGLU=IPRAM(1) IF(IPRAM(1).LE.0) LGLU=LOGLU(IPRAM(1)) C C ASSIGN KEYBOARD/CRT TEST DEVICE LU C ILUT=IPRAM(2) C C CHECK FOR VALID INPUT TO IPRAM(2) = ILUT C IF(IPRAM(2).LE.0) 5,15 5 IF(ILUT-LGLU) 6,7,6 6 WRITE(LGLU,10) C C THE FOLLOWING LINE ADDED 791112 IF(ILUT.LE.0) GO TO 9950 C 7 WRITE(ILUT,10) 10 FORMAT(/" TXTT0 - NO LU WAS SPECIFIED FOR TEST KEYBOARD/" 1"DISPLAY."/" RERUN TEST SPECIFYING AN LU# FOR TEST" 2" KEYBOARD/DISPLAY."//" TXTT0 - TERMINAL TEST ABORTED!"/) GOTO 9950 C C CHECK FOR MENU MODE C 15 IF(IPRAM(3).NE.1HM) 17,4000 C C CHOOSE TESTS AUTOMATICALLY C 17 IF((IPRAM(2).LE.0).AND.(IPRAM(3).LE.0).AND.(IPRAM(4).LE.0)) 30,20 20 IF(IPRAM(2).LE.0) 22,1000 22 IF(IPRAM(3).LE.0) 24,2000 24 IF(IPRAM(4).LE.0) 9900,3000 30 IF(ILUT-LGLU) 31,32,31 31 WRITE(LGLU,35) 32 WRITE(ILUT,35) 35 FORMAT(/,6X,"TXTT0 - NO TEST LU NUMBERS SPECIFIED"/ 1,30X,"TXTT0 ABORTED!"/) GOTO 9950 C C********************************************************************* C* SECTION 1000 - KEYBOARD/CRT TESTS C********************************************************************* C C C ASSIGN TEST DEVICE KEYBOARD/DISPLAY LU C 1000 ILUT=IPRAM(2) C C GET :KEYBOARD/DISPLAY LU STATUS C 1010 CALL EXEC(13,ILUT,ICRTS1,ICRTS2,ICRTS3) C C CHECK FOR KEYBOARD/DISPLAY GENERATED LU ASSIGNMENT C MLUCRT=IAND(ICRTS2,77B) IF(MLUCRT.EQ.0) 8000,1100 C C CHECK FOR KEYBOARD/DISPLAY DEVICE TYPE C 1100 MCRTYP=IAND(ICRTS1,37400B) IF(MCRTYP.NE.2400B) 8100,1110 C C CHECK FOR KEYBOARD/DISPLAY EQT AVAILABILITY C 1110 MCRTAV=IAND(ICRTS1,140000B) IF(MCRTAV.NE.0) 8200,1120 C C CHECK FOR KEYBOARD/DISPLAY PROPER SUB-CHANNEL ASSIGNMENT C 1120 MCRTSC=IAND(ICRTS3,17B) IF(MCRTSC.NE.0) 8400,1130 C C CHECK FOR KEYBOARD/DISPLAY LU AVAILABILITY C 1130 MCRTSC=IAND(ICRTS3,100000B) IF(MCRTSC.NE.0) 8200,1200 1200 IF(ILUT-LGLU) 1205,1207,1205 1205 WRITE(LGLU,1210) ILUT 1207 WRITE(ILUT,1210) ILUT 1210 FORMAT(/" TXTT0 - LU#",I3,": TERMINAL TEST RUNNING") C C KEYBOARD/DISPLAY DATA TRANSFER TEST WITH ECHO C IF(ILUT-LGLU) 1215,1217,1215 1215 WRITE(LGLU,1220) ILUT 1217 WRITE(ILUT,1220) ILUT 1220 FORMAT(/" TXTT0 - LU#",I3,":"/ 1" TYPE THE FOLLOWING CHARACTERS, THEN PRESS THE RETURN" 2" KEY."/" THE CHARACTERS SHOULD ECHO ON THE TEST DISPLAY" 3" AS THEY ARE TYPED."/" U*3LG8 ="/" _") REG=EXEC(1,ILUT+400B,IBUFT,4) C C VERIFY TRANSFERRED DATA C DO 1230 I=1,IB IF(IBUFD(I).EQ.IBUFT(I)) GOTO 1230 GOTO 8300 1230 CONTINUE C C DISPLAY LINE SPACING TEST C IF(ILUT-LGLU) 1255,1257,1255 1255 WRITE(LGLU,1260) ILUT 1257 WRITE(ILUT,1260) ILUT 1260 FORMAT(/" TXTT0 - LU#",I3,":"/ 1" THERE SHOULD BE 5 LINES OF SPACE BETWEEN THIS" 2" LINE...") CALL EXEC(3,ILUT+1100B,5) IF(ILUT-LGLU) 1263,1267,1263 1263 WRITE(LGLU,1270) 1267 WRITE(ILUT,1270) 1270 FORMAT(" ...AND THIS LINE.") IF(ILUT-LGLU) 1275,1280,1275 1275 WRITE(LGLU,1290) ILUT 1280 WRITE(ILUT,1290) ILUT 1290 FORMAT(/" TXTT0 - LU#",I3,": KEYBOARD DISPLAY TEST FINISHED") wC C DYNAMIC STATUS REQUEST TO FORCE TERMINATION OF PRECEEDING C OPERATION BEFORE MAKING LU/EQT AVAILABILTY CHECK ON NEXT TEST C CALL EXEC(3,ILUT+600B) IF(MENU-1) 22,4015,4015 C C********************************************************************* C* SECTION 2000 - LEFT CTU TESTS C********************************************************************* C C C ASSIGN TEST DEVICE LEFT-CTU LU C 2000 LGLUC=IPRAM(3) C C GET LEFT-CTU LU STATUS C 2010 CALL EXEC(13,LGLUC,ILCTU1,ILCTU2,ILCTU3) C C CHECK FOR LEFT-CTU GENERATED LU ASSIGNMENT C MLULC=IAND(ILCTU2,77B) IF(MLULC.LE.0) 8005,2100 C C CHECK FOR LEFT-CTU DEVICE TYPE C 2100 MLCTYP=IAND(ILCTU1,37400B) IF(MLCTYP.NE.2400B) 8110,2120 C C CHECK FOR LEFT-CTU EQT AVAILABILITY C 2120 MLCAV=IAND(ILCTU1,140000B) IF(MLCAV.NE.0) 8200,2130 C C CHECK FOR LEFT-CTU PROPER SUB-CHANNEL C 2130 MLCSC=IAND(ILCTU3,17B) IF(MLCSC.NE.1) 8410,2140 C C CHECK FOR LEFT-CTU LU AVAILABILITY C 2140 MLCSC=IAND(ILCTU3,100000B) IF(MLCSC.NE.0) 8200,2200 C C LEFT CTU TESTS FOR DATA TRANSFER AND CONTROL C 2200 IF(ILUT-LGLU) 2205,2207,2205 2205 WRITE(LGLU,2210) LGLUC 2207 WRITE(ILUT,2210) LGLUC 2210 FORMAT(/" TXTT0 - LU#",I3,":"/ 1" INSERT 'SCRATCH' CARTRIDGE WITH RECORD TAB SET TO" 2" RECORD"/" INTO LEFT CTU SLOT. TYPE /C" 3" TO CONTINUE WITH"/" CTU TEST OR TYPE /A TO ABORT" 4" THIS TEST: _") CALL EXEC(1,ILUT+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 2300 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 2200 2300 CALL EXEC(2,LGLUC,IBUFC1,-36) CALL EXEC(3,LGLUC+100B) CALL EXEC(2,LGLUC,IBUFC2,-1) CALL EXEC(3,LGLUC+100B) CALL EXEC(3,LGLUC+400B) CALL EXEC(3,LGLUC+1300B) CALL EXEC(1,LGLUC,IBUFT,-1) IF(IBUFC2(1).NE.IBUFT(1)) GOTO 8500 DO 2310 I=1,2 CALL EXEC(3,LGLUC+1400B) 2310 CONTINUE REG=EXEC(1,LGLUC,IBUFT,-36) V- DO 2320 I=1,IB IF(IBUFC1(I).EQ.IBUFT(I)) GOTO 2320 GOTO 8500 2320 CONTINUE CALL EXEC(3,LGLUC+2700B,2) CALL EXEC(1,LGLUC,IBUFT,-1) IF(IBUFC2(1).NE.IBUFT(1)) GOTO 8500 C C TEST TO CHECK LEFT CTU FOR WRITE PROTECT STATUS C 2400 IF(ILUT-LGLU) 2405,2407,2405 2405 WRITE(LGLU,2410) LGLUC 2407 WRITE(ILUT,2410) LGLUC 2410 FORMAT(/" TXTT0 - LU#",I3,":"/ 1" REMOVE CARTRIDGE FROM LEFT CTU AND SET RECORD" 2/" TAB TO PROTECT. RE-INSERT CARTRIDGE" 3" AND TYPE /C TO"/" CONTINUE NEXT TEST OR TYPE /A" 4" TO ABORT THIS TEST: _") CALL EXEC(1,ILUT+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 2415 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 2400 2415 CALL EXEC(3,LGLUC+2700B,1) CALL EXEC(1,LGLUC,IBUFT,-36) CALL EXEC(13,LGLUC,ISTAT1) MWP=IAND(ISTAT1,4B) IF(MWP-4B) 8700,2420,8700 2420 CALL EXEC(3,LGLUC+500B) IF(ILUT-LGLU) 2425,2430,2425 2425 WRITE(LGLU,2440) LGLUC 2430 WRITE(ILUT,2440) LGLUC 2440 FORMAT(/" TXTT0 - LU#",I3,": LEFT CTU TEST FINISHED"/) C C DYNAMIC STATUS REQUEST TO FORCE TERMINATION OF PRECEEDING C OPERATION BEFORE MAKING LU/EQT AVAILABILITY CHECK ON NEXT TEST C CALL EXEC(3,LGLUC+600B) IF(MENU-1) 24,4015,4015 C C********************************************************************* C* SECTION 3000 - RIGHT CTU TESTS C********************************************************************* C C C ASSIGN TEST DEVICE RIGHT-CTU LU C 3000 ILURC=IPRAM(4) C C GET RIGHT-CTU LU STATUS C 3010 CALL EXEC(13,ILURC,IRCTU1,IRCTU2,IRCTU3) C C CHECK FOR RIGHT-CTU GENERATED LU ASSIGNMENT C MLURC=IAND(IRCTU2,77B) IF(MLURC.LE.0) 8010,3100 C C CHECK FOR RIGHT-CTU PROPER DEVICE TYPE C 3100 MRCTYP=IAND(IRCTU1,37400B) IF(MRCTYP.NE.2400B) 8120,3120 C C CHECK FOR RIGHT-CTU EQT AVAILABILITY C 3120 MRCAV=IAND(IRCTU1,140000B) IF(MRCAV.NE.0) 8200,3130 C C CHECK FOR RIGHT-CTU PROPER SUB-CHANNEL C 3130 MRCSC=IAND(IRCTU3,17B) IF(MRCSC.NE.2) 8420,3140 C C CHECK FOR RIGHT-CTU LU AVAILABILITY C 3140 MRCSC=IAND(IRCTU3,100000B) IF(MRCSC.NE.0) 8200,3200 C C RIGHT CTU TESTS FOR DATA TRANSFER AND CONTROL C 3200 IF(ILUT-LGLU)3205,3207,3205 3205 WRITE(LGLU,3210) ILURC 3207 WRITE(ILUT,3210) ILURC 3210 FORMAT(/" TXTT0 - LU#",I3,":"/ 1" INSERT 'SCRATCH' CARTRIDGE WITH RECORD TAB SET TO" 2" RECORD"/" INTO RIGHT CTU SLOT. TYPE /C" 3" TO CONTINUE WITH"/" CTU TEST OR TYPE /A TO ABORT" 4" THIS TEST: _") CALL EXEC(1,ILUT+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 3300 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 3200 3300 CALL EXEC(2,ILURC,IBUFC2,-1) CALL EXEC(3,ILURC+100B) CALL EXEC(2,ILURC,IBUFC1,-36) CALL EXEC(3,ILURC+100B) CALL EXEC(3,ILURC+2700B,2) REG=EXEC(1,ILURC,IBUFT,-36) DO 3330 I=1,IB IF(IBUFC1(I).EQ.IBUFT(I)) GOTO 3330 GOTO 8600 3330 CONTINUE CALL EXEC(3,ILURC+500B) CALL EXEC(1,ILURC,IBUFT,-1) IF(IBUFT(1).NE.IBUFC2(1)) GOTO 8600 CALL EXEC(3,ILURC+1300B) REG=EXEC(1,ILURC,IBUFT,-36) DO 3340 I=1,IB IF(IBUFC1(I).EQ.IBUFT(I)) GOTO 3340 GOTO 8600 3340 CONTINUE CALL EXEC(3,ILURC+1400B) CALL EXEC(3,ILURC+1400B) CALL EXEC(1,ILURC,IBUFT,-1) IF(IBUFC2(1).NE.IBUFT(1)) GOTO 8600 C C TEST TO CHECK RIGHT CTU FOR WRITE PROTECT STATUS C 3500 IF(ILUT-LGLU) 3505,3507,3505 3505 WRITE(LGLU,3510) ILURC 3507 WRITE(ILUT,3510) ILURC 3510 FORMAT(/" TXTT0 - LU#",I3,":"/ 1" REMOVE CARTRIDGE FROM RIGHT CTU AND SET RECORD" 2/" TAB TO PROTECT. RE-INSERT CARTRIDGE" 3" AND TYPE /C TO"/" CONTINUE NEXT TEST OR TYPE /A" 4" TO ABORT THIS TEST: _") CALL EXEC(1,ILUT+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 3515 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 3500 351'5 CALL EXEC(3,ILURC+2700B,1) CALL EXEC(1,ILURC,IBUFT,-1) CALL EXEC(13,ILURC,ISTAT1) MWP=IAND(ISTAT1,4B) IF(MWP-4B) 8800,3600,8800 3600 CALL EXEC(3,ILURC+400B) 3700 IF(ILUT-LGLU) 3705,3710,3705 3705 WRITE(LGLU,3720) ILURC 3710 WRITE(ILUT,3720) ILURC 3720 FORMAT(/" TXTT0 - LU#",I3,": RIGHT CTU TEST FINISHED"/) IF(MENU-1) 9900,4015,4015 C C********************************************************************* C* SECTION 4000 - MENU C********************************************************************* C 4000 IF(ILUT-LGLU) 4001,4002,4001 4001 WRITE(LGLU,4010) 4002 WRITE(ILUT,4010) 4010 FORMAT(//" TXTT0: TERMINAL TEST RUNNING"/) MENU=1 4015 IF(ILUT-LGLU) 4013,4014,4013 4013 WRITE(LGLU,4016) 4014 WRITE(ILUT,4016) 4016 FORMAT(/" TXTT0: TERMINAL TEST MENU"// 1,4X," THE FOLLOWING TERMINAL TESTS CAN BE SELECTED BY" 2" ENTERING THE"/" CORRESPONDING TEST CODES:"// 3" TEST TEST CODE"/ 4" ---- ---------"/ 5" 1) KEYBOARD/DISPLAY TEST /K"/ 6" 2) LEFT CTU TEST /L"/ 7" 3) RIGHT CTU TEST /R"/ 8" 4) END TEST /E"/) 4018 IF(ILUT-LGLU) 4017,4019,4017 4017 WRITE(LGLU,4020) 4019 WRITE(ILUT,4020) 4020 FORMAT(/" TXTT0: ENTER THE CODE FOR THE TERMINAL TEST" 1" THAT YOU WISH TO RUN: _") CALL EXEC(1,401B,IQUE,1) IF(IQUE.EQ.2H/K) GOTO 4100 IF(IQUE.EQ.2H/L) GOTO 4200 IF(IQUE.EQ.2H/R) GOTO 4300 IF(IQUE.EQ.2H/E) GOTO 9900 GOTO 4018 4100 IF(ILUT-LGLU) 4101,4102,4101 4101 WRITE(LGLU,4110) 4102 WRITE(ILUT,4110) 4110 FORMAT(/" TXTT0 - TERMINAL KEYBOARD/CRT TEST"/) C C DYNAMIC STATUS TO TERMINATE OPERATION OF DEVICE BEFORE LU/EQT C AVAILABILITY CHECK C CALL EXEC(3,ILUT+600B) GOTO 1010 4200 IF(ILUT-LGLU) 4201,4202,42dL01 4201 WRITE(LGLU,4210) 4202 WRITE(ILUT,4210) 4210 FORMAT(/" TXTT0: LEFT CTU TEST"/ 1" TXTT0: WHAT IS THE LEFT CTU LU#? _") READ(ILUT,*) LGLUC GOTO 2010 4300 IF(ILUT-LGLU) 4301,4302,4301 4301 WRITE(LGLU,4310) 4302 WRITE(ILUT,4310) 4310 FORMAT(/" TXTT0: RIGHT CTU TEST"/ 1" TXTT0: WHAT IS THE RIGHT CTU LU#? _") READ(ILUT,*) ILURC GOTO 3010 C C********************************************************************* C* SECTION 8000 - ERROR MESSAGES C********************************************************************* C 8000 IF(ILUT-LGLU) 8001,8003,8001 8001 WRITE(LGLU,8002) ILUT 8003 WRITE(ILUT,8002) ILUT 8002 FORMAT(/" TXTT0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 9950 8005 IF(ILUT-LGLU) 8004,8006,8004 8004 WRITE(LGLU,8007) LGLUC 8006 WRITE(ILUT,8007) LGLUC 8007 FORMAT(/" TXTT0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 9950 8010 IF(ILUT-LGLU) 8011,8012,8011 8011 WRITE(LGLU,8015) ILURC 8012 WRITE(ILUT,8015) ILURC 8015 FORMAT(/" TXTT0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 9950 8020 IF(ILUT-LGLU) 8021,8022,8021 8021 WRITE(LGLU,8025) 8022 WRITE(ILUT,8025) 8025 FORMAT(/" TXTT0 - LU# SPECIFIED FOR KEYBOARD/DISPLAY" 1" IS ILLEGAL."/" RERUN TEST SPECIFYING AN INTEGER" 2" >0 AND <64 FOR LU#.") GOTO 9000 8030 IF(ILUT-LGLU) 8031,8032,8031 8031 WRITE(LGLU,8035) 8032 WRITE(ILUT,8035) 8035 FORMAT(/" TXTT0 - LU# SPECIFIED FOR LEFT CTU IS ILLEGAL."/ 1" RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#.") GOTO 9000 8040 IF(ILUT-LGLU) 8041,8042,8041 8041 WRITE(LGLU,8045) 8042 WRITE(ILUT,8045) 8045 FORMAT(/" TXTT0 - LU# SPECIFIED FOR RIGHT CTU IS ILLEGAL."/ 1" RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#.") GOTO 9000 8100 IF(ILUT-LGLU) 8101,8102,8101 8101 WRITE(LGLU,8105) ILUT 8102 WRITE(ILUT,8105) ILUT 8105 FORMAT(/" TXTT0 - LU#",I3," SPECIFIED FOR KEYBOARD/DISPLAY" 1" IS NOT ASSIGNED TO"/" 2645/2648 TERMINAL. RERUN TEST" 2" SPECIFYING CORRECT LU#.") GOTO 9000 8110 IF(ILUT-LGLU) 8111,8112,8111 8111 WRITE(LGLU,8115) LGLUC 8112 WRITE(ILUT,8115) LGLUC 8115 FORMAT(/" TXTT0 - LU#",I3," SPECIFIED FOR LEFT CTU" 1" IS NOT ASSIGNED TO"/" 2645/2648 TERMINAL. RERUN TEST" 2" SPECIFYING CORRECT LU#.") GOTO 9000 8120 IF(ILUT-LGLU) 8121,8122,8121 8121 WRITE(LGLU,8125) ILURC 8122 WRITE(ILUT,8125) ILURC 8125 FORMAT(/" TXTT0 - LU#",I3," SPECIFIED FOR RIGHT CTU" 1" IS NOT ASSIGNED"/" TO 2645/2648 TERMINAL. RERUN TEST" 2" SPECIFYING CORRECT LU#.") GOTO 9000 8200 IF(ILUT-LGLU) 8201,8202,8201 8201 WRITE(LGLU,8210) ILUT 8202 WRITE(ILUT,8210) ILUT 8210 FORMAT(/" TXTT0 - LU#",I3,": EQT OR LU FOR TEST TERMINAL" 1" IS DOWN."/" UP EQT AND RERUN TEST.") GOTO 9000 C C DATA ENTRY OR TRANSMISSION ERROR C 8300 IF(ILUT-LGLU) 8301,8302,8301 8301 WRITE(LGLU,8310) ILUT 8302 WRITE(ILUT,8310) ILUT 8310 FORMAT(" TXTT0 - LU#",I3,": DATA ENTRY OR TRANSMISSION ERROR."/ 1" TYPE /C TO CONTINUE NEXT TEST OR TYPE /A TO ABORT" 2" THIS TEST: _") IERRK=IERRK+1 CALL EXEC(1,ILUT+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 8320 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 8300 8320 IF(MENU-1) 22,4015,4015 8400 IF(ILUT-LGLU) 8401,8402,8401 8401 WRITE(LGLU,8405) ILUT 8402 WRITE(ILUT,8405) ILUT 8405 FORMAT(/" TXTT0 - LU#",I3," SPECIFIED FOR KEYBOARD/DISPLAY NOT" 1" ASSIGNED TO SUBCHANNEL 0."/" RERUN TEST SPECIFYING" 2" CORRECT LU#.") GOTO 9000 8410 IF(ILUT-LGLU) 8411,8412,8411 8411 WRITE(LGLU,8415) LGLUC 8412 WRITE(ILUT,8415) LGLUC 8415 FORMAT(/" TXTT0 - LU#",I3," SPECIFIED FOR LEFT CTU NOT ASSIGNED" 1" TO SUBCHANNEL 1."/" RERUN TEST SPECIFYING CORRECT" 2" LU#.") GOTO 9000 8420 IF(ILUT-LGLU) 8421,8422,8421 8421 WRITE(LG1LU,8425) ILURC 8422 WRITE(ILUT,8425) ILURC 8425 FORMAT(/" TXTT0 - LU#",I3," SPECIFIED FOR RIGHT CTU NOT ASSIGNED" 1" TO SUBCHANNEL 2."/" RERUN TEST SPECIFYING CORRECT" 2" LU#.") GOTO 9000 8500 IF(ILUT-LGLU) 8505,8506,8505 C C REQUEST FOR ABORT OR CONTINUE C 8505 WRITE(LGLU,8510) LGLUC 8506 WRITE(ILUT,8510) LGLUC 8510 FORMAT(/" TXTT0 - LU#",I3,": LEFT CTU READ/WRITE/CONTROL TEST" 1" FAILED!"/" TYPE /C TO CONTINUE NEXT TEST OR TYPE" 2" /A TO"/" ABORT THIS TEST: _") IERRL=IERRL+1 CALL EXEC(1,LGLU+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 8520 IF(IQUE.EQ.2H/A) GOTO 9000 8520 IF(MENU-1) 24,4015,4015 8600 IF(ILUT-LGLU) 8605,8606,8605 C C REQUEST FOR ABORT OR CONTINUE C 8605 WRITE(LGLU,8610) ILURC 8606 WRITE(ILUT,8610) ILURC 8610 FORMAT(/" TXTT0 - LU#",I3,": RIGHT CTU READ/WRITE/CONTROL TEST" 1" FAILED!"/" TYPE /C TO CONTINUE NEXT TEST OR TYPE" 2" /A TO"/" ABORT THIS TEST: _") IERRR=IERRR+1 CALL EXEC(1,LGLU+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 8620 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 8600 8620 IF(MENU-1) 9900,4015,4015 8700 IF(LGLU-ILUT) 8705,8706,8705 C C REQUEST FOR ABORT OR CONTINUE C 8705 WRITE(LGLU,8710) LGLUC 8706 WRITE(ILUT,8710) LGLUC 8710 FORMAT(/" TXTT0 - LU#",I3,": LEFT CTU WRITE PROTECT TEST FAILED" 1"!"/,8X," TYPE /C TO CONTINUE NEXT TEST OR TYPE /A TO ABORT" 2/" THIS TEST: _") IERRL=IERRL+1 CALL EXEC(1,LGLU+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 8720 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 8700 8720 IF(MENU-1) 24,4015,4015 8800 IF(ILUT-LGLU) 8805,8806,8805 8805 WRITE(LGLU,8810) ILURC 8806 WRITE(ILUT,8810) ILURC 8810 FORMAT(/" TXTT0 - LU#",I3,": RIGHT CTU WRITE PROTECT TEST" 1" FAILED!") IERRR=IERRR+1 IF(MENU-1) 9900,4015,4015 C C********************************************************************* C* HFB SECTION 9000 - ABORT MESSAGE AND TERMINATE C********************************************************************* C 9000 IF(ILUT-LGLU)9005,9010,9005 9005 WRITE(LGLU,9015) ILUT 9010 WRITE(ILUT,9015) ILUT 9015 FORMAT(/" TXTT0 - LU#",I3,": TERMINAL TEST ABORTED!"/) GOTO 9950 9900 IERR=IERRK+IERRL+IERRR IF(ILUT-LGLU) 9910,9912,9910 9910 WRITE(LGLU,9920) ILUT,IERR 9912 WRITE(ILUT,9920) ILUT,IERR 9920 FORMAT(/" TXTT0 - LU#",I3,": TERMINAL TESTS FINISHED" 1" ",I2," ERRORS"/) 9950 END END$ $H  91711-18021 1926 S C0122 &TXTT1 2645/48 MULTIPOINT VERI             H0101 FTN4,L PROGRAM TXTT1(3,89),91711-16021 REV 1926 790428 C C C******************************************** C* TXTT1 * C* PRIMARY SYSTEM MULTI-POINT TERMINAL TEST * C* RELOC.: 91711-16021 * C* SOURCE: 91711-18021 * C******************************************** C C C TXTT1 IS A FUNCTIONAL VERIFICATION TEST FOR THE MULTI-POINT C DATA PATH(MP/1000). THE MULTI-POINT EXERCISER IS USED TO C TEST THIS FUNCTION. C C RU,TXTT1,LGLU,MPLU,NN,INL C C WHERE: C C LGLU = LOGICAL UNIT FOR LOGGING MESSAGES. C C MPLU = LOGICAL UNIT OF TERMINAL TO BE TESTED. C C NN = MAXIMUM NUMBER OF ERRORS TO BE REPORTED. DEFAULT C IS 6. C INL = TEST BUFFER SIZE. DEFAULT IS 20 LINES. C C C*************************************************************** C C DECLARATIONS C C*************************************************************** C INTEGER EQT4,EQT5,EQTST INTEGER LGLU,MPLU,NN,INL INTEGER NDTYPE,IREG(2),REGA,REGB INTEGER LOCKOP,UNLOCK INTEGER IOCON EQUIVALENCE (IREG(1),REGA,REG),(IREG(2),REGB) DIMENSION IB(800),IBX(40),IIB(800),IHMXM(2) C C*************************************************************** C C DATA INITIALIZATION C C*************************************************************** C DATA IHMXM/15510B,15544B/ DATA LGLU/1/,NN/5/ DATA IOCON/3/ DATA LOCKOP/0140001B/,UNLOCK/0100000B/ DATA INL/20/ DATA IB/800*0/ C C GET INPUT PARAMETER FOR LIST LU AND TEST LU C CALL RMPAR(IB) LGLU = IB(1) IF (IB(1).LE.0) LGLU = LOGLU(IB(1)) C GET LU TO BE TESTED. MPLU = IB(2) IF (MPLU.NE.0) GO TO 10 C LU TO BE TESTED IS ILLEGAL. WRITE(LGLU,1001) 1001 FORMAT(/" TXTT1 - LU# SPECIFIED FOR MP TERMINAL IS ILLEGAL."/ 1" RERUN TEST ;SPECIFYING AN INTEGER >0 AND <64 FOR LU#.") GO TO 999 C C DETERMINE THE MAXIMUM NUMBER OF ERRORS TO BE REPORTED. C 10 CONTINUE IF (IB(3).GT.0) NN = IB(3) - 1 C DETERMINE THE TEST BUFFER SIZE. IF ZERO DEFAULT TO 20 LINES. INL = IB(4) IF ((INL.LE.0).OR.(INL.GT.20)) INL = 20 C C TEST TO SEE IF LU IS ASSIGNED. C CALL EXEC(13,MPLU,EQT5,EQT4,EQTST) C IF CHANNEL NUMBER = 0, LU IS NOT ASSIGNED TO ANY DEVICE. IF (IAND(EQT4,077B).NE.0) GO TO 30 C LU IS NOT ASSIGNED. DO NOT TEST THIS LU. WRITE(LGLU,2001) MPLU 2001 FORMAT(/" TXTT1 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GO TO 9999 C C MAKE SURE DEVICE IS ASSIGNED TO A MP TERMINAL. C 30 CONTINUE NDTYPE = IAND(EQT5,037400B) NDTYPE = NDTYPE/0400B IF (NDTYPE.EQ.07B) GO TO 50 C LU IS NOT ASSIGNED TO A MP TERMINAL. ABORT TEST. WRITE(LGLU,4001) MPLU 4001 FORMAT(/" TXTT1 - LU#",I3," IS NOT ASSIGNED TO A MP TERMINAL."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GO TO 999 C C MAKE SURE LU IS NOT DOWN C 50 CONTINUE J = EQT5/040000B IF ((J.NE.01).AND.(IAND(EQTST,100000B).EQ.0)) GO TO 90 C LU IS DECLARED DOWN. WRITE(LGLU,6001) MPLU 6001 FORMAT(/" TXTT1 - LU#",I3,": EQT OR LU FOR TEST TERMINAL" 1" IS DOWN."/" UP EQT AND RERUN TEST.") GO TO 999 C C LU IS CORRECTLY ASSIGNED. LOCK THE LU AND PROCEED WITH C THE TEST. C 90 CONTINUE CALL LURQ(LOCKOP,MPLU,1) C ERROR RETURN IF LU COULD NOT BE LOCKED. GO TO 95 C LU IS LOCKED. START MULTI-POINT EXERCISER PROGRAM. 92 GO TO 100 C LU COULD NOT BE LOCKED. 95 CALL ABREG(REGA,REGB) WRITE(LGLU,9501) MPLU 9501 FORMAT(/" TXTT1 - LU#",I3,": MP TERMINAL COULD NOT BE LOCKED!") IF (REGA) 9502,9999,9505 9502 WRITE(MPLU,9503) MPLU 9503 FORMAT(/" TXTT1 - LU#",I3,": NO RESOURCE NUMBER AVAILABLE!") GO TO 999 9505 _WRITE(LGLU,9506) MPLU 9506 FORMAT(/" TXTT1 - LU#",I3,": MP TERMINAL ALREADY LOCKED!") 999 WRITE(LGLU,9991) MPLU 9991 FORMAT(/" TXTT1 - LU#",I3,": MP TERMINAL TEST ABORTED!"/) GO TO 9999 C C START MULTI-POINT EXERCISER PROGRAM C 100 CONTINUE WRITE(LGLU,1003) MPLU 1003 FORMAT(/" TXTT1 - LU#",I3,": MP TERMINAL TEST RUNNING") ICRLF = 6412B CALL CODE C BUILD TEST LINE BUFFER OF 76 ALPHA NUMERIC CHARACTERS C TERMINATED WITH A CR/LF. TOTAL OF 78 CHARACTERS IN TEST C LINE. WRITE(IBX,1010) ICRLF II = 1 C BUILD TEST BUFFER BY WRITING THE LINE NUMBER FOLLOWED BY THE C TEST LINE FOR A TOTAL OF UP TO 20 LINES. C 01,---TEST CH.---CR/LF02---TEST CH.---CR/LF03......... DO 1000 J=1,INL CALL CODE WRITE(IBZ,1005) J 1005 FORMAT(I2) IB(II) = IBZ II = II + 1 1010 FORMAT("ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" 1"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCD",A2) DO 500 I = 1,39 IB(II)=IBX(I) II = II + 1 500 CONTINUE 1000 CONTINUE C CALCULATE THE SIZE OF THE TRANSFER. ICNT = INL*80/2 C CLEAR ERROR DETECTED SW. IS = 0 C TURN OFF ROUTINE POLLING AND SET TO STRIP "GS". CALL EXEC(3,MPLU+2300B,140000B) C FORCE THE TERMINAL TO BLOCK MODE. WRITE(MPLU,1006) C SEQUENCE IS ESCAPE,&,SMALL S,1,D 1006 FORMAT("&s1D") C TRANSMIT THE TEST BUFFER. CALL EXEC(2,MPLU+3000B,IB,ICNT) C SEND A "HOME-UP" AND SIMULATED ENTER TO THE TERMINAL. CALL EXEC(2,MPLU,IHMXM,2) C RECEIVE THE TEXT FROM THE TERMINAL. CALL EXEC(1,MPLU,IIB,800) C COMPARE TEXT TRANSMITTED WITH TEXT RECEIVED. DO 5000 I=1,ICNT IF (IB(I).EQ.IIB(I)) GO TO 5000 C IF A WORD DOES NOT COMPARE, REPORT UP TO NN ERRORS. IS = IS + 1 WRITE(LGLU,1007) MPLU 1007 FORMAT(/" TXTT1 - LU#",I3,": DATA TRANSMISSION ERROR.") IF (IS.GT.NN) GO TO 9000 5000 CONTINUE C CL=EAR EDIT MODE SWITCH AND REENABLE POLLING. 9000 CALL EXEC(3,MPLU+2300B,71401B) C C UNLOCK RESOURCE. C 9500 CONTINUE CALL LURQ(UNLOCK,MPLU,1) WRITE(LGLU,9001) MPLU,IS 9001 FORMAT(/" TXTT1 - LU#",I3,": MP TERMINAL TEST FINISHED ",I2, 1" ERRORS.") 9999 CONTINUE END END$ R  91711-18022 1926 S C0122 &TXTR0 RS232 TERMINAL VERIF.             H0101 FTN4,L PROGRAM TXTR0(3,89),91711-16022 REV 1926 791112 C C CHANGED 791112. IF ILUT=0, DO NOT ATTEMPT TO WRITE C ERROR MESSAGES TO ILUT. C C C************************************** C* TXTR0 * C* PRIMARY SYSTEM RS232 TERMINAL TEST * C* RELOC.: 91711-16022 * C* SOURCE: 91711-18022 * C************************************** C C C THIS PROGRAM IS FOR TESTING KEYBOARD & DISPLAY OPERATION OF C DVR00 TYPE DEVICES. VARIABLES USED IN THIS PROGRAM ARE AS FOLLOWS: C C IBUFD......DATA STORED IN PROGRAM TO BE OUTPUT TO DISPLAY C IBUFT......DATA STORED ON KEYBOARD INPUT TO BE CHECKED AGAINST C THAT IN IBUFD C IREG.......A & B REGISTERS FOR EXEC CALL PARAMATER RETURN C IA.........A REGISTER (NOT USED IN THIS PROGRAM) C IB.........B REGISTER, USED FOR CHARACTER TRANSFER COUNT C IQUE.......PROMPT CODE FROM KEYBOARD FOR ABORT OR CONTINUE C IPRAM(1)...VARIABLE TO PASS PARAMATER OF LOG DEVICE LU C IPRAM(2)...VARIABLE TO PASS PARAMATER OF TEST DEVICE LU C LGLU.......LOG DEVICE LU C ILUT.......TEST DEVICE LU C ISTAT1.....EQT WORD 5 C ISTAT2.....EQT WORD 4 C ISTAT3.....BIT 15 OF THIS VARIABLE GIVES STATUS OF LU C MLU........MASK OF ISTAT2 FOR CHECK OF PROPER LU ASSIGNMENT C MTYP.......MASK OF ISTAT1 FOR CHECK OF PROPER DEVICE TYPE C MAV........MASK OF ISTAT1 & ISTAT3 FOR EQT & LU AVAILABILITY C DIMENSION IBUFD(40), IREG(2), IQUE(1), IPRAM(5), IBUFT(40) EQUIVALENCE (REG,IREG,IA), (IREG(2),IB) DATA IBUFD/2HU*,2H3L,2HG8,2H =/ CALL RMPAR(IPRAM) C C INITIALIZE ERROR COUNTER TO 0 C IERR=0 C C ASSIGN LOG DEVICE LU C LGLU=IPRAM(1) IF(IPRAM(1).LE.0) LGLU=LOGLU(IPRAM(1)) C C ASSIGN TEST DEVICE LU C IF(IPRAM(2).LE.0) GOTO 8120 30 ILUT=IPRAM(2) C C********************************************************************* C* SECTION 100 - GET LU & VERIFY C***************************************w****************************** C CALL EXEC(13,ILUT,ISTAT1,ISTAT2,ISTAT3) C C CHECK GENERATED LU ASSIGNMENT OF TEST DEVICE C MLU=IAND(ISTAT2,77B) IF(MLU) 8000,8000,100 C C CHECK FOR PROPER TEST DEVICE TYPE C 100 MTYP=IAND(ISTAT1,37400B) IF(MTYP) 8100,110,8100 C C CHECK FOR TEST DEVICE EQT AVAILABILITY C 110 MAV=IAND(ISTAT1,140000B) IF(MAV) 8200,120,8200 C C CHECK FOR TEST DEVICE LU AVAILABILITY C 120 MAV=IAND(ISTAT3,100000B) IF(MAV) 8200,1000,8200 C C********************************************************************* C* SECTION 1000 - KEYBOARD/DISPLAY TESTS C********************************************************************* C 1000 IF(ILUT-LGLU) 1005,1007,1005 1005 WRITE(LGLU,1010) ILUT 1007 WRITE(ILUT,1010) ILUT 1010 FORMAT(/" TXTR0 - LU#",I3,": RS232 TERMINAL TEST RUNNING") C C DATA TRANSFER TEST FOR KEYBOARD/DISPLAY WITH ECHO C IF(ILUT-LGLU) 1012,1015,1012 1012 WRITE(LGLU,1020) ILUT 1015 WRITE(ILUT,1020) ILUT 1020 FORMAT(/" TXTR0 - LU#",I3,":"/ 1" TYPE THE FOLLOWING CHARACTERS, THEN PRESS THE RETURN"/ 2" KEY. THE CHARACTERS SHOULD ECHO ON THE TEST DISPLAY"/ 3" AS THEY ARE TYPED."/" U*3LG8 ="/" _") REG=EXEC(1,ILUT+400B,IBUFT,4) C C VERIFY TRANSFERRED DATA C DO 1030 I=1,IB IF(IBUFD(I).EQ.IBUFT(I)) GOTO 1030 GOTO 8300 1030 CONTINUE C C TEST FOR LINE SPACING ON DISPLAY C 1055 IF(ILUT-LGLU) 1056,1057,1056 1056 WRITE(LGLU,1060) ILUT 1057 WRITE(ILUT,1060) ILUT 1060 FORMAT(/"  TXTR0 - LU#",I3,":"/ 1" THERE SHOULD BE 5 LINES OF SPACE BETWEEN THIS" 2" LINE...") CALL EXEC(3,ILUT+1100B,5) IF(ILUT-LGLU)1065,1067,1065 1065 WRITE(LGLU,1070) 1067 WRITE(ILUT,1070) 1070 FORMAT(" ...AND THIS LINE.") IF(ILUT-LGLU) 1075,1077,1075 1075 WRITE(LGLU,1080) ILUT,IERR 1077 WRITE(ILUT,1080) ILUT,IERR 1080 FORMAT(/" TXTR0 - LU#",I3,": RS232 TERMINAL TEST FINISHED " 1,I2," ERRORS"/) GOTO 9900 C C********************************************************************* C* SECTION 8000 - ERROR MESSAGES C********************************************************************* C 8000 WRITE(LGLU,8010) ILUT 8010 FORMAT(/" TXTR0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 9900 8100 WRITE(LGLU,8110) ILUT 8110 FORMAT(/" TXTR0 - LU#",I3," IS NOT ASSIGNED TO RS232 TERMINAL."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GOTO 9000 8120 WRITE(LGLU,8125) 8125 FORMAT(/" TXTR0 - LU# SPECIFIED FOR RS232 TERMINAL IS ILLEGAL."/ 1" RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#.") GOTO 9000 8200 WRITE(LGLU,8210) ILUT 8210 FORMAT(/" TXTR0 - LU#",I3,": EQT OR LU FOR TEST TERMINAL IS" 1" DOWN."/" UP EQT AND RERUN TEST.") GOTO 9000 C C REQUEST TO ABORT OR CONTINUE C 8300 WRITE(ILUT,8310) ILUT 8310 FORMAT(/" TXTR0 - LU#",I3,": DATA ENTRY OR TRANSMISSION ERROR."/ 1" TYPE /C TO CONTINUE NEXT TEST OR TYPE /A TO ABORT"/ 2" THIS TEST: _") IERR=IERR+1 CALL EXEC(1,ILUT+400B,IQUE,1) IF(IQUE.EQ.2H/C) GOTO 1055 IF(IQUE.EQ.2H/A) GOTO 9000 GOTO 8300 C C********************************************************************* C* SECTION 9000 - ABORT MESSAGE AND TERMINATE C********************************************************************* C 9000 IF(ILUT-LGLU) 9005,9010,9005 9005 WRITE(LGLU,9015) ILUT C C FOLLOWING LINE ADDED 791112 IF(ILUT.LE.0) GO TO 9900 C 9010 WRITE(ILUT,9015) ILUT 9015 FORMAT(/" TXTR0 - LU#",I3,": RS232 TERMINAL TEST ABORTED!"/) 9900 END END$   91711-18023 1926 S C0122 &TXTD0 3070 DATACAP TERM. VERI             H0101 )FTN4,L PROGRAM TXTD0(3,89),91711-16023 REV 1926 790428 C C C******************************************* C* TXTD0 * C* PRIMARY SYSTEM DATA ENTRY TERMINAL TEST * C* RELOC.: 91711-16023 * C* SOURCE: 91711-18023 * C******************************************* C C C *** QUICK VERIFICATION FOR THE 3070A/3070B DATA ENTRY TERMINAL *** C C C C C C DESCRIPTION: C ------------ C C THE PROGRAM "TXTD0" WILL INTERACT WITH THE OPERATOR AND C TEST THE NUMERIC DISPLAY, ALL PROMPTING LED'S, THE KEYBOARD, C ALL SPECIAL FUNCTION KEYS, THE MULTIFUNCTION READER AND THE C ALPHANUMERIC STRIP PRINTER. C C C C C OPERATING PROCEDURE: C -------------------- C C SCHEDULE THE PROGRAM "TXTD0" USING THE RUN COMMAND: C C *RU,TXTD0,LGLU,LU C C WHERE LGLU = INTERACTIVE CONSOLE L.U. C C C LU = 3070A/3070B TERMINAL L.U. C C C C C TEST STEPS: C ----------- C C 01 - NUMERIC KEYPAD TEST C 02 - SPECIAL FUNCTION KEY TEST C 03 - READER TEST C 04 - PRINTER TEST C C C C C ERROR CODES: C ------------ C C E1 - OPERATOR ERROR (WRONG KEY) C E2 - TRANSMISSION LOG ERROR (TOO MANY KEYS) C E3 - STATUS ERROR C E4 - CARD READER ERROR DIAGNOSTIC CARD #1 C E5 - CARD READER ERROR DIAGNOSTIC CARD #2 C E6 - PRINTER ERROR (PRINTER OFF OR END OF PAPER) C C C C C C DIMENSION IBUFR(100),KARD1(80),KARD2(80),KEY(12) DIMENSION MSG(8),IPARM(5),IFAIL(6),ITEST(4) C C C *** DIAGNOSTIC CARD #1 *** C C DATA KARD1/7777B,0000B,4000B,2000B,1000B,0400B,0200B,0100B, 1 0040B,0020B,0010B,0004B,0002B,0001B,3777B,5777B, 2 6777B,7377B,7577B,7677B,7737B,7757B,7767B,7773B, 3 7775B,7776B,5252B,2525B,5252B,2525B,5252B,2525B, 4 5252B,2525B,5252B,2525B,5252B,2525B,5252B,2525B, 5 0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 6 0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 7 0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 8 0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B, 9 0000B,0000B,0000B,0000B,0000B,0000B,2100B,0010B/ C C C *** DIAGNOSTIC CARD #2 *** C C DATA KARD2/5403B,4401B,4201B,4101B,0005B,1023B,1013B,1007B, 1 2011B,4021B,1021B,4103B,4043B,4023B,4013B,4007B, 2 6403B,2401B,2201B,2101B,0043B,0023B,0201B,1011B, 3 2003B,2403B,0007B,1005B,2043B,2023B,2013B,2007B, 4 0000B,4006B,0006B,0102B,2102B,1042B,4000B,0022B, 5 4022B,2022B,2042B,4012B,1102B,2000B,4102B,1400B, 6 1000B,0400B,0200B,0100B,0040B,0020B,0010B,0004B, 7 0002B,0001B,0202B,2012B,4042B,0012B,1012B,1006B, 8 0042B,4400B,0000B,0000B,0000B,0000B,0000B,0000B, 9 0000B,0000B,0000B,0000B,0000B,0000B,0000B,0000B/ C C *** DATA STATEMENTS *** C DATA KEY/2H7 ,2H8 ,2H9 ,2H4 ,2H5 ,2H6 , 1 2H1 ,2H2 ,2H3 ,2H- ,2H0 ,2H. / DATA IFAIL/2HE1,2HE2,2HE3,2HE4,2HE5,2HE6/ DATA ITEST/2H01,2H02,2H03,2H04/ DATA KLEAR/2H /,ICODE/100000B/ C C *** GET LGLU AND TEST DEVICE LU *** C CALL RMPAR(IPARM) LGLU=IPARM(1) IF (IPARM(1).LE.0) LGLU=LOGLU(IPARM(1)) LU=IPARM(2) IF (IPARM(2).LE.0) GOTO 200 C C *** GET STATUS OF TEST DEVICE LU *** C CALL EXEC(13,LU,ISTA1,ISTA2,ISTA3) C C *** CHECK IF LU IS ENABLED *** C IF (IAND(ISTA2,77B).NE.0) GOTO 110 WRITE(LGLU,100)LU 100 FORMAT(/" TXTD0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 9999 C C *** CHECK IF DEVICE TYPE IS 47 *** C 110 IFF (IAND(ISTA1,37400B).EQ.23400B) GOTO 150 WRITE(LGLU,120)LU 120 FORMAT(/" TXTD0 - LU#",I3," IS NOT ASSIGNED TO 3070 TERMINAL."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GOTO 220 C C *** CHECK IF LU IS DOWN *** C 150 IF (IAND(ISTA3,ICODE).EQ.0) GOTO 300 WRITE(LGLU,160)LU 160 FORMAT(/" TXTD0 - LU#",I3,": EQT OR LU FOR TEST TERMINAL" 1" IS DOWN."/" UP EQT AND RERUN TEST.") GOTO 220 C C *** ILLEGAL TEST LU *** C 200 WRITE(LGLU,210) LU 210 FORMAT(/" TXTD0 - LU#",I3," SPECIFIED FOR TEST TERMINAL IS" 1" ILLEGAL."/" RERUN TEST SPECIFYING AN INTEGER >0" 2" AND <64 FOR LU#.") 220 WRITE(LGLU,230) LU 230 FORMAT(/" TXTD0 - LU#",I3,": DATA" 1" ENTRY TERMINAL TEST ABORTED!"/) GOTO 9999 C C *** CLEAR TERMINAL *** C 300 WRITE(LGLU,310)LU 310 FORMAT(/" TXTD0 - LU#",I3,": DATA" 1" ENTRY TERMINAL TEST RUNNING") IERR=0 DO 320 I=1,8 MSG(I)=20040B 320 CONTINUE CALL EXEC(3+ICODE,LU+1400B) GOTO 1000 330 CALL EXEC(3+ICODE,LU) GOTO 1000 340 CALL EXEC(3+ICODE,LU+1100B) GOTO 1000 350 CALL ABREG(IA,IB) ITYPE=IAND(IA,1B) IFLAG=IA C C C ********************* START TESTING ********************* C C C *** DISPLAY ALL SEGMENTS AND ALL PROMTING LED'S *** C C *** WAIT FOR DEL AND ENT KEYS *** C C 400 DO 410 I=1,16 IBUFR(I)=2H8. CALL EXEC(2+ICODE,LU+100B,IBUFR,1) GOTO 1000 410 CONTINUE DO 420 LIGHT=97,125,2 WRITE(LU)LIGHT 420 CONTINUE CALL REIO(1+ICODE,LU+100B,IBUFR(1),-1) GOTO 1000 430 CALL REIO(1+ICODE,LU+100B,IBUFR(2),-1) GOTO 1000 440 IF ((IBUFR(1).NE.77440B).OR.(IBUFR(2).NE.5040B)) IERR=IERR+1 IF (ITYPE.EQ.0) GOTO 470 C C *** BUZZER TEST *** C DO 460 I=1,3 CALL EXEC(2+ICODE,LU,3400B,-1) GOTO 1000 450 CALL EXEC(12,0,1,0,-10) 460 CONTINUE 470 CALL EXEC(3+ICODE,LU) GOTO 1000 C C C ************* TEST 01 - NUMERIC KEYPAD TEST ************* C C C *** READ FROM KEYBOARD *** C C 500 MSG(2)=ITEST(1) DO 570 I=1,12 MSG(4)=KEY(I)/256+8192 MSG(7)=KLEAR 510 CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 520 CALL REIO(1+ICODE,LU+500B,IBUFR,-1) GOTO 1000 530 CALL ABREG(IA,IB) CALL EXEC(3+ICODE,LU) GOTO 1000 540 IF (IB.EQ.1) GOTO 550 IF (MSG(7).NE.KLEAR) GOTO 560 MSG(7)=IFAIL(2) GOTO 510 550 IF (IBUFR(1).EQ.KEY(I)) GOTO 570 IF (MSG(7).NE.KLEAR) GOTO 560 MSG(7)=IFAIL(1) GOTO 510 560 IERR=IERR+1 GOTO 580 570 CONTINUE 580 CALL EXEC(3+ICODE,LU+1100B) GOTO 1000 C C C ********** TEST 02 - SPECIAL FUNCTION KEY TEST ********** C C C *** WAIT FOR SRQ AND POLL KEYBOARD STATION *** C C 600 MSG(2)=ITEST(2) MSG(4)=20061B MSG(7)=KLEAR 610 CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 620 CALL EXEC(3+ICODE,LU+1000B) GOTO 1000 630 CALL EXEC(2+ICODE,LU+2000B,35B,1) GOTO 1000 640 CALL EXEC(13,LU,IEQT5) IF (IEQT5.EQ.23435B) GOTO 700 IF (MSG(7).NE.KLEAR) GOTO 650 MSG(7)=IFAIL(3) GOTO 610 650 IERR=IERR+1 C C *** READ SPECIAL FUNCTION KEYS *** C 700 DO 710 I=2,10+ITYPE CALL EXEC(3+ICODE,LU+1200B,I) GOTO 1000 710 CONTINUE DO 770 I=2,10+ITYPE MSG(4)=KCVT(I) MSG(7)=KLEAR 720 IBUFR(1)=0 CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 730 CALL REIO(1+ICODE,LU+400B,IBUFR,10) GOTO 1000 740 CALL ABREG(IA,IB) IF (IB.EQ.0) GOTO 750 IF (MSG(7).NE.KLEAR) GOTO 760 MSG(7)=IFAIL(2) GOTO 720 750 IF (IAND(IA,17B).EQ.I) GOTO 770 IF (MSG(7).NE.KLEAR) GOTO 760 MSG(7)=IFAIL(1) GOTO 720 760 IERR=IERR+1 GOTO 780 770 CONTINUE 780 CALL EXEC(3+ICODE,LU) GOTO 1000 790 CALL EXEC(3+ICODE,LU+1100B) GOTO 1000 C C C ********** TEST 03 - MULTIFUNCTION READER TEST ********** C C C *** READ PUNCHED CARD *** C C 800 IF (IAND(IFLAG,3B).NE.3B) GOTO 900 MSG(2)=ITEST(3) MSG(4)=20061B MSG(7)=KLEAR CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 805 CALL EXEC(2+ICODE,LU+2100B,37400B,-1) GOTO 1000 810 CALL EXEC(3+ICODE,LU+1200B,1) GOTO 1000 C C C ** READER CONFIGURATION: IMAGE MODE, MARKS+HOLES C CLOCK AFTER DATA, LOCAL REJECT C 815 CALL EXEC(3+ICODE,LU+600B,27B) GOTO 1000 820 CALL REIO(1+ICODE,LU+1000B,IBUFR,80) GOTO 1000 825 CALL ABREG(IA,IB) IF (IAND(IA,17B).EQ.1) GOTO 880 IF (IB.NE.80) MSG(7)=IFAIL(4) DO 830 I=1,80 IF (IBUFR(I).EQ.KARD1(I)) GOTO 830 MSG(7)=IFAIL(4) 830 CONTINUE MSG(4)=20062B CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 835 CALL EXEC(2+ICODE,LU+2100B,37400B,-1) GOTO 1000 C C C ** READER CONFIGURATION: IMAGE MODE, HOLES ONLY C NO CLOCK MARKS, LOCAL REJECT C 840 CALL EXEC(3+ICODE,LU+600B,22B) GOTO 1000 845 CALL REIO(1+ICODE,LU+1000B,IBUFR,80) GOTO 1000 850 CALL ABREG(IA,IB) IF (IAND(IA,17B).EQ.1) GOTO 880 IF (IB.NE.66) MSG(7)=IFAIL(5) DO 860 I=1,66 IF (IBUFR(I).EQ.KARD2(I)) GOTO 860 MSG(7)=IFAIL(5) 860 CONTINUE IF (MSG(7).EQ.KLEAR) GOTO 890 CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 870 CALL EXEC(12,0,2,0,-3) 880 IERR=IERR+1 890 CALL EXEC(3+ICODE,LU) GOTO 1000 C C C ************** TEST 04 - STRIP PRINTER TEST ************** C C C *** PRINT ASCII CHARACTER SET *** C C 900 CALL EXEC(3+ICODE,LU+1100B) GOTO 1000 905 CALL ABREG(IA,IB) IF (IAND(IA,5B).NE.5) GOTO 990 MSG(2)=ITEST(4) MSG(4)=KLEAR MSG(7)=KLEAR IF (IAND(IA,40B).EQ.0) GOTO 910 MSG(7)=IFAIL(6) b$" GOTO 970 910 CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 915 CALL EXEC(2+ICODE,LU+2100B,37400B,-1) GOTO 1000 920 IBUFR(1)=20041B DO 925 I=1,31 IBUFR(I+1)=IBUFR(I)+514 925 CONTINUE CALL EXEC(2+ICODE,LU+1100B,IBUFR,32) GOTO 1000 930 IBUFR(1)=5012B IBUFR(2)=5012B IBUFR(3)=5012B CALL EXEC(2+ICODE,LU+1100B,IBUFR,3) GOTO 1000 940 DO 960 I=1,100 CALL EXEC(3+ICODE,LU+1100B) GOTO 1000 950 CALL ABREG(IA,IB) IF (IAND(IA,10B).EQ.0) GOTO 990 960 CONTINUE MSG(7)=IFAIL(3) 970 IERR=IERR+1 CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 980 CALL EXEC(12,0,2,0,-3) 990 GOTO 1020 C C *** TESTING COMPLETED *** C 1000 CALL ABREG(IA,IB) IERR=IERR+1 WRITE(LGLU,1010)LU,IA,IB 1010 FORMAT(/" TXTD0 - LU#",I3,": DATA TRANSMISSION ERROR."/ 1" ERROR REPORTED A=",@6," B=",@6) GOTO 220 1020 CALL EXEC(3+ICODE,LU) GOTO 1000 1030 IF (IERR.EQ.0) GOTO 1060 CALL CODE WRITE(MSG,1040) 1040 FORMAT(" E ",4(2H )) MSG(3)=KCVT(IERR) 1050 CALL EXEC(2+ICODE,LU,MSG,8) GOTO 1000 1060 WRITE(LGLU,1070)LU,IERR 1070 FORMAT(/" TXTD0 - LU#",I3,": DATA ENTRY" 1" TERMINAL TEST FINISHED ",I3," ERRORS"/) 9999 END END$ {j$   91711-18024 1926 S C0122 &TXTD1 3075/6/7 DATACAP VERIF.             H0101 FTN4,Q,C * * DATE: MARCH 15, 1979 * NAME: TXTD1 * SOURCE: 91711-18024 * RELOC: 91711-16024 * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * PROGRAM TXTD1 (3,89),91711-16024 REV 1926 790906 C 23.08.79 C C TXTD1 IS AN ON-LINE FUNCTIONAL VERIFICATION OF THE C 3075A, 3076A, 3077A DATA CAPTURE TERMINALS. C C THIS PROGRAM USES THE SESSION XLUEX INSTRUCTION. C C THIS PROGRAM REQUIRES THE MULTIPOINT SYSTEM HAVE C HAVE NO PENDING READ REQUESTS ON ANY TERMINALS C UNDER TEST. IF THERE SHOULD BE A PENDING READ C REQUEST THE PROGRAM WILL BE DELAYED, FINISHING C AFTER A TIMEOUT. IF NO TIMEOUT HAS BEEN ENTERED, THE C PROGRAM CANNOT COMPLETE ON ITS OWN. C C TO RUN THIS PROGRAM ENTER C C RU,TXTD1[,ILLU][,ILU][,IOP][,INLU][,ITLU] C WHERE: C C ILU = CONSOLE LU C IOP = OP CODE C ILLU = LIST LU C INLU = LINE LU C ITLU = TERMINAL LU C C CALLS : LUCHK DETERMINE MULTIPOINT (SYSTEMS) LU ASSIGNMENT, C RETURN A COMPLETION CODE C ILINE SHOW THE LINKED LIST ORDER FO THE LINE LU = INLU C C BUFFERS IBUFR,IBUFV,IGRUP,KOFLN ARE DECLARED IN COMMON HERE FOR C USE BY SEGMENTS AND SUBROUTINES ELSEWHERE. C IARAY, ILU, AND ILLU ARE VARIABLES DEFINED HERE. INLU, ITLU, C ARE DEFINED HERE IF THE RUN PARAMETERS ARE NONZERO OTHERWISE C INTERACTIVE DATA ENTRY AS REQUIRED FROM THE OPERATOR REDEFINES C THOSE VARIABLES. IXLU IS DEFINED ELSEWHERE AND POINTS TO AN LU C WHICH CANNOT BE VERIFED BY THIS PROGRAM. C C COMMON IARAY(3),ILU(1),ILLU(1),INLU(1),ITLU(1),IXLU(1), +IBUFR(128),IGRUP(30),KOFLN(30),IBUFV(60) DIMENSION IPARM(5),IREG(2),ICWORD(2) DIMENSION INAM1(3),INAM2(3),INAM3(3),INAM4(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA INAM1/2HTX,2HTD,2H2 / DATA INAM2/2HTX,2HTD,2H3 / DATA INAM3/0,0,0/ DATA INAM4/2HIM,2HPT,2HM / DATA ICWORD/0,400B/ C C C CALL RMPAR(IPARM) ILU = 1 ILLU = 1 IOP = 0 IF(IPARM(2).GT.0) ILU=IPARM(2) IF(IPARM(1).GT.0) ILLU=IPARM(1) CALL PNAME(IARAY) CALL IMSG6(ILLU,0,0,0,IARAY,5,11) C CHECK FOR OP CODE IF(IPARM(3).GT.0) IOP = IPARM(3) C C LINE LU C 15 IF(IPARM(4).GT.0) INLU = IPARM(4) C C TERMINAL LU C 16 IF(IPARM(5).GT.0) ITLU=IPARM(5) C C C CHECK FOR ACTIVE LINE LU C 10 IF(IPARM(4).EQ.0) GO TO 18 C C IF THERE IS AN OP CODE, VALIDATE INLU LATER C IF(IPARM(3).NE.0) GO TO 23 C C LINE LU HERE. NO OP CODE. CHECK THE LINE LU C 11 ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) C C FOR INLU DOWN OR EQT DOWN, COMPLETE IMMEDIATELY C IF(IERCD.EQ.1) GO TO 27 IF(IERCD.EQ.3) GO TO 27 C C FOR INLU SET TO EQT 0, COMPLETE IMMEDIATELY C IF(IERCD.EQ.5) GO TO 27 C C IF INLU IS ACTIVE AND TRMLS ARE ASSIGNED, GO TO 12 C IF(IERCD.EQ.7) GO TO 12 C C IF INLU IS ACTIVE AND TRMLS ARE NOT ASSIGNED, GO TO 12 C OTHERWISE, INLU CANNOT BE USED. USE INLU THAT SURVEY C FINDS, GO TO 19. C IF(IERCD.NE.9) GO TO 19 C C SHOW THE LINKED LIST ORDER FOR LINE LU INLU C 12 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C C IS THERE A TRML LU ? IF(IPARM(5).NE.0) GO TO 14 C C NO TRML LU. DO LINE VERIFY USING SPECIFIED INLU. C 13 IOP = 053114B CALL EXEC(8,INAM1,IOP,-1) U C C TRML LU HERE. DO TRML VERIFY USING SPECIFIED INLU, ITLU. C 14 IOP = 053124B CALL EXEC(8,INAM1,IOP,-1) C C IS THERE AN OP CODE ? C 18 IF(IPARM(3).NE.0) GO TO 23 C C NO OP CODE, NO LINE LU. IS THERE TRML LU ? C 19 INLU = 0 IF(IPARM(5).NE.0) GO TO 25 C C NO TRML LU. SHOW MULTIPOINT SYSTEMS SURVEY MESSAGE THEN END C 21 IOP = 020040B GO TO 28 C 25 IOP = 053124B 28 CALL EXEC(8,INAM4,IOP,-1) C C SHOW MULTIPOINT SYSTEM SURVEY MESSAGE C THEN VALIDATE OP CODE. C 23 CALL EXEC(8,INAM2,IOP) C C TXTD1 * CORRECTIVE ACTION NEEDED C 27 CALL IMSG6(ILLU,0,0,0,IARAY,9,11) C C TXTD1 - DONE C 24 CALL EXEC(8,INAM1,020040B) C C THIS IS A DUMMY CALL TO A SUBROUTINE C CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,KEY,IXLU,IARAY) 9999 CONTINUE END END$ x  91711-18025 1926 S C0122 &TXTD2 3075/6/7 VERIF. SEG. 1             H0101 FTN4,Q,C * * DATE: MARCH 15, 1979 * NAME: TXTD2 * SOURCE: 91711-18025 * RELOC: 91711-16025 * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * PROGRAM TXTD2 (5,89),91711-16025 REV 1926 790906 C 31.07.79 C C IF IPARM(2) IS NEGATIVE, THIS SEGMENT WAS CALLED BY IMPTM OR TXTD1. C IF IPARM(2) IS POSITIVE, THIS SEGMENT WAS CALLED BY TXTD3. C C WHEN THE RUN STRING HAS ONLY A LINE AND:OR A TERMINAL LU, A C SURVEY MESSAGE IS MADE THEN IMPTM OVERLAYS ITSELF WITH TXTD2. IN C THE SEGMENT OVERLAY CALL IMPTM FORCE DEFINES THE OP CODE TO BE C VERIFY LINE IF JUST THE LINE LU IS KNOWN, OR VERIFY A TERMINAL C ON THE DEFINED LINE IF THE TERMINAL LU IS ALSO KNOWN. C WHEN THE RUN STRING CONTAINS AN OP CODE FOR LINE VERIFY OR C TERMINAL VERIFY, TXTD1 MAKES THE SEGMENT LOAD CALL FOR TXTD2, C WHICH EXECUTES THE PROCEDURE. WHENEVER THE INTERACTIVE PROMPT C APPEARS AND THE OPERATOR ENTERS AN OP CODE AMONG THOSE EXECUTED C BY TXTD2, TXTD3 MAKES THE SEGMENT OVERLAY CALL TO TRANSFER C CONTROL HERE. C IPARM(2) = -1 ALL INTERACTIVE OPERATOR PROMPTS ARE INHIBITED, C THE CODE COMPLETES IMMEDIATELY. C COMMON IARAY(3),ILU(1),ILLU(1),INLU(1),ITLU(1),IXLU(1), +IBUFR(128),IGRUP(30),IOFLN(30),IBUFV(60) DIMENSION IPARM(5),IOP(1),ICWORD(2),INAM1(3),INAM2(3) DATA ICWORD/0,200B/ DATA INAM1/2HTX,2HTD,2H3 / DATA INAM2/2HCF,2HTM,2HL / C CALL RMPAR(IPARM) IOP = IPARM(1) C WRITE(ILLU,110)IPARM 110 FORMAT(5(2X"IPAR:",I2)) ICWORD(1) = IOR(ILC  U,100000B) 20 IF(IOP.EQ.053124B) GO TO 201 IF(IOP.EQ.044524B) GO TO 205 IF(IOP.EQ.041506B) GO TO 207 IF(IOP.EQ.053114B) GO TO 213 IF(IOP.EQ.020040B) GO TO 900 C C CHECK IN TXTD3 FOR NEXT OPERATION 21 IOP = 0 CALL EXEC(8,INAM1,IOP) C C VT 201 IXLU = IPARM(2) CALL VMPTL(ILU,INLU,ILLU,ITLU,IARAY,IXLU) IXLU = 0 GO TO 30 C C C IT 205 IXLU = 0 CALL UPMPT(ILU,INLU,ILLU,ITLU,-1,IXLU,IARAY) GO TO 21 C C CF 207 CALL EXEC(8,INAM2) C C VL 213 IXLU = IPARM(2) CALL VMPLN(ILU,INLU,ILLU,IARAY,IXLU) IXLU = 0 C C WAS TXTD2 CALLED BY TXTD1 OR IMPTM ? IPARM(2) WILL BE -1 30 IF(IPARM(2)) 900,21 C C TXTD1 - DONE 900 CALL IMSG6(ILLU,0,0,0,IARAY,3,11) END END$ I   91711-18026 1926 S C0122 &TXTD3 3075/6/7 VERIF. SEG. 2             H0101 FTN4,Q,C * * DATE: MARCH 15, 1979 * NAME: TXTD3 * SOURCE: 91711-18026 * RELOC: 91711-16026 * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * PROGRAM TXTD3 (5,89),91711-16026 REV 1926 790906 C 28.06.79 C C THIS SEGMENT IS CALLED BY THE MAIN WHEN THE RUN STRING CONTAINS C A NONZERO OP CODE PARAMETER, WHICH GETS VALIDATED HERE. ELSE C TXTD3 IS ENTERED WHEN IMPTM HAS FINISHED SHOWING THE SURVEY MESSAGE C AND THE OP CODE HAS BEEN FORCED DEFINED TO BE SPACE-SPACE C TO EXIT. THE THIRD CIRCUMSTANCE WHERE PROGRAM CONTROL TRANSFERS TO C TXTD3 HAPPENS WHEN AN OP CODE HAS CAUSED THIS SEGMENT TO BE C OVERLAID WITH IMPTM, CFTML, TXTD2, IWRZZ, AND ONE OF THOSE SEGMENTS C TRANSFERS PROGRAM CONTROL BACK TO TXTD3, WHETHER TO VALIDATE AN C OP CODE ENTERED IN ANOTHER SEGMENT WHICH COULDN'T BE EXECUTED C THERE, OR TO EXIT RUNNING TXTD1. C COMMON IARAY(3),ILU(1),ILLU(1),INLU(1),ITLU(1),IXLU(1), +IBUFR(128),IGRUP(30),KOFLN(30),IBUFV(60) DIMENSION INAM1(3),INAM2(3),INAM3(3),IREG(2),IPARM(5) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA IDB4/0/ DATA INAM1/2HTX,2HTD,2H2 / DATA INAM2/2HIW,2HRZ,2HZ / DATA INAM3/2HIM,2HPT,2HM / C C C CALL RMPAR(IPARM) C C CHECK FOR INLU SET TO EQT 0 C COMPLETE IMMEDIATELY IF TRUE C IF(INLU.EQ.0) GO TO 20 ICCC = 10 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) C C IF INLU POINTS TO EQT 0, COMPLETE IMMEDIATELY C IF(IERCD.EQ.5) GO TO 30 C C C 20 IOP = IPARM(1) 8IF(IOP.EQ.053124B) GO TO 201 IF(IOP.EQ.051526B) GO TO 202 IF(IOP.EQ.044514B) GO TO 203 IF(IOP.EQ.051114B) GO TO 204 IF(IOP.EQ.044524B) GO TO 201 IF(IOP.EQ.051124B) GO TO 206 IF(IOP.EQ.041506B) GO TO 201 IF(IOP.EQ.020040B) GO TO 9999 IF(IOP.EQ.042516B) GO TO 9999 IF(IOP.EQ.027505B) GO TO 9999 IF(IOP.EQ.042530B) GO TO 9999 IF(IOP.EQ.037477B) GO TO 212 IF(IOP.EQ.053114B) GO TO 201 IF(IOP.EQ.043520B) GO TO 214 IF(IOP.EQ.052107B) GO TO 215 IF(IOP.EQ.046116B) GO TO 216 IF(IOP.EQ.047506B) GO TO 208 C C TXTD1 - : 21 WRITE(ILU,219)IARAY READ(ILU,22)IPARM(1) 22 FORMAT(A2) GO TO 20 C C VT,IL,RL,CF,VL,RT,IT C SEGMENT TXTD2 201 CALL EXEC(8,INAM1,IPARM(1),0) C C SV C SEGMENT IMPTM 202 CALL EXEC(8,INAM3,1) C C IL 203 CALL UPMPL(ILU,INLU,ILLU,IARAY) GO TO 21 C C RL 204 CALL DNMPL(ILU,ILLU,IARAY) GO TO 21 C C RT 206 CALL DNMPT(ILU,ILLU,-1,IARAY) GO TO 21 C C OF 208 CALL OFFLN(ILU,INLU,ILLU,IARAY) GO TO 21 C C ?? 212 WRITE(ILLU,231) GO TO 21 C GP SEGMENT IWRZZ 214 CALL EXEC(8,INAM2,3) C C TG SEGMENT IWRZZ 215 CALL EXEC(8,INAM2,5) C C LN C CHECK FOR ACTIVE LINE LU 216 IF(INLU.EQ.0) 2161,2162 C C ASK FOR AN ACTIVE LINE LU 2161 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) 21,2162 2162 ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) C C ACTIVE LINE LU, NO TRMLS ASSIGNED ? IF(IERCD.EQ.7) GO TO 2164 C C OR, ACTIVE LINE LU, TRMLS ASSIGNED ? IF(IERCD.EQ.9) GO TO 2164 INLU = 0 GO TO 2161 C C SHOW LINE BY LINKED LIST ORDER. 2164 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) GO TO 21 C C C 219 FORMAT(/2X3A2,"- :_") 231 FORMAT(/10X"VL VERIFY MULTIPOINT LINE THEN END", +/10X"VT VERIFY TERMINAL", +/10X"SV MULTIPOINT SURVEY MESSAGE", +/10XD "OF OFF-LINE TERMINALS", +/10X"IL INITIALIZE A LINE", +/10X"RL REMOVE A LINE", +/10X"IT INITIALIZE A TERMINAL", +/10X"RT REMOVE A TERMINAL", +/10X"CF CONFIGURE A TERMINAL", +/10X"GP WHO ARE YOU", +/10X"TG WHO ARE YOU ON CURRENT TERMINAL'S GROUP", +/10X"LN MULTIPOINT LINE ASSIGNMENT", +/10X"EN END", +/10X"/E END", +/10X"EX END", +/10X"SP-SP END", +/) C C C TXTD1 - LU MM NOT ASSIGNED, NOT TESTED C 30 ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) 9999 CONTINUE C C TXTD1 - DONE CALL IMSG6(ILLU,0,0,0,IARAY,3,11) END END$   91711-18027 1926 S C0122 &CFTML 3075/6/7 VERIF. SEG. 3             H0101 |FTN4,Q,C * * DATE: MARCH 15, 1979 * NAME: CFTML * SOURCE: 91711-18027 * RELOC: 91711-16027 * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * PROGRAM CFTML (5,89),91711-16027 REV 1926 790906 C 27.08.79 C THIS SEGMENT SHOWS INITIALIZED TERMINAL CONFIGURATION C AND SENDS CONTROL 22 (NAK, WAK, TERMINAL BLOCK SIZE), C CONTROL 23 (DISABLE/ENABLE ROUTINE POLLING, SET EDIT MODE FLAGS), C GROUP/LINE SELECT AND WRITE A MESSAGE TO THE SELECTED C TERMINAL. C THIS SEGMENT IS CALLED BY TXTD2. C THERE IS A LINE VALIDATION AND TERMINAL VALIDATION PROCEDURE C HERE THAT ALLOWS REDEFINING THE TERMINAL OR LINE BY ENTERING C SPACE-SPACE WHEN THE "?? FOR CFTML OP CODE LIST" MESSAGE IS C PRESENT, OR ENTERING ZERO WHEN EITHER THE LINE OR TERMINAL LU C ENTRY MESSAGE IS PRESENT. THIS IS ALSO THE ONLY WAY TO EXIT C THIS SEGMENT AND CLEARS THE LINE LU AND TERMIANL LU NUMBERS C IN LOCAL COMMON. C COMMON IARAY(3),ILU(1),ILLU(1),INLU(1),ITLU(1),IXLU(1), +IBUFR(128),IGRUP(30),IOFLN(30),IBUFV(60) DIMENSION IREG(2),ICWORD(2),INAM1(3),INAM2(3),INAM3(3) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) DATA ICWORD/0,2300B/ DATA IKKK/1/ DATA ICCC/11/ DATA INAM1/2HTX,2HTD,2H3 / DATA INAM2/2HIW,2HRZ,2HZ / DATA INAM3/2HIM,2HPT,2HM / C C TXTD1 - CONFIGURE A TERMINAL 5 CALL IMSG8(ILLU,IARAY,7,11) C C IF INLU IS ZERO, GET A LINE LU IF(INLU.GT.0) GO TO 30 C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO SHTOP. C 15 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 9999 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW ANY MESSAGE C 30 ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.7) GO TO 35 IF(IERCD.EQ.9) GO TO 35 GO TO 15 C C SHOW LINE NUMBER AND TERMINAL LU NUMBER(S) ASSIGNED C TO THIS LINE LU. C 35 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) I4LIN = LINE*10000B C C IF ITLU IS ZERO, GET A TERMINAL LU IF(ITLU.GT.0) GO TO 36 C ENTER TERMINAL LU. IF NO MORE TERMINALS ON THIS LINE, ENTER C 0 TO STOP 16 CALL IMSG7(ILU,ITLU,IARAY,2,11) IF(ITLU.EQ.0) GO TO 15 C C CHECK LU FOR MULTIPOINT TERMINAL ASSIGNMENT C C SHOW ANY MESSAGE 36 CONTINUE 37 ICCC = 6 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.0) GO TO 71 IF(IERCD.EQ.6) GO TO 71 GO TO 16 C C ACTIVE TERMINAL HERE C 70 CONTINUE C GET AN OP CODE IF(IOP.EQ.52102B) GO TO 401 IF(IOP.EQ.42515B) GO TO 402 IF(IOP.EQ.46505B) GO TO 404 IF(IOP.EQ.20040B) GO TO 406 IF(IOP.EQ.37477B) GO TO 407 IF(IOP.EQ.51526B) GO TO 408 IF(IOP.EQ.46116B) GO TO 409 IF(IOP.EQ.43520B) GO TO 410 IF(IOP.EQ.52107B) GO TO 411 C C 71 WRITE(ILU,299)IARAY 299 FORMAT(/2X3A2"- ENTER OP CODE (?? FOR CFTML OP CODE LIST):_") READ(ILU,72)IOP 72 FORMAT(A2) GO TO 70 C TB 401 CALL IMSG8(ILLU,IARAY,2,11) CALL TB(ILU,INLU,ILLU,IARAY,0) GO TO 71 C EM 402 CALL IMSG8(ILLU,IARAY,3,11) IBBB = 0 CALL EM(ILU,ITLU,ILLU,IARAY,IBBB) GO TO 71 C ME 404 CALL IMSG8(ILLU,IARAY,5,11) CALL IOGLS(ILU,ILLU,INLU,IBUFL,IARAY) GO TO 71 C SP-SP 406 CONTINUE GO TO 16 C ?? 407 WRITE(ILLU,27) 27 FORMAT(2/10X"TB SET NAK, WAK, TERMINAL BLOCK SIZE", +/10X"EM SET EDIT MODE AND POLLING GLOBALS", +/10X"ME GROUP-LINE SELECT AND SEN3 D A MESSAGE", +/10X"SV MULTIPOINT SURVEY MESSAGE", +/10X"LN MULTIPOINT LINE ASSIGNMENT", +/10X"GP WHO ARE YOU", +/10X"TG WHO ARE YOU ON CURRENT TERMINAL'S GROUP", +/10X"SP-SP END", +/) GO TO 71 C SV 408 CALL EXEC(8,INAM3,0) C LN 409 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) GO TO 71 C GP 410 CALL EXEC(8,INAM2,3) C TG 411 CALL EXEC(8,INAM2,5) C C C END MULTIPOINT TERMINAL CONFIGURATION C 9999 IOP = 0 CALL EXEC(8,INAM1,IOP) END END$ $  91711-18028 1926 S C0122 &IWRZZ 3075/6/7 VERIF. SEG. 4             H0101  FTN4,Q,C * * DATE: MARCH 15, 1979 * NAME: IWRZZ * SOURCE: 91711-18028 * RELOC: 91711-16028 * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * PROGRAM IWRZZ (5,89),91711-16028 REV 1926 790906 C 31.08.79 C THIS SEGMENT DISPLAYS THE MEMBERS OF AN ACTIVE GROUP OF C 3075A, 3076A, 3077A TERMINALS. C WHEN RETURNING, IGID IS THE ACCEPTED VALUE ENTERED WHICH WAS USED C IN THE "WHO ARE YOU" CALL, AND INAT TELLS HOW MANY TERMINALS C RESPONDED TO THE CALL. IF NO TERMINALS RESPOND, THE DEVICE ID C IS ENTERED, AND XGRUP HAS ONE NON-ZERO WORD, IGID IN THE UPPER BYTE, C IDID IN THE LOWER BYTE, WITH INAT BEING ZERO. C C ILU = CONSOLE LU C INLU = LINE LU C ILLU = LIST LU C ITLU = TERMINAL LU C KY = SELECTS MODE OF WHO ARE YOU C C CALLS: LUCHK DETERMINE THE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: IMSG7 READS ACTIVE TRML LU (SYSTEM) FROM ILU C CALLS: ILINA GET THE LINE NUMBER, LIST LINK POINTER, AND ID C USING AN LU NUMBER C C C C C A KY VALUE IS PASSED THAT ALLOWS IWRU TO GENERATE ALL POSSIBLE C IGID VALUES AND REPORT WHICH IGID HAVE RESPONDED TO THE C "WHO ARE YOU". C C C COMMON IARAY(3),ILU(1),ILLU(1),INLU(1),ITLU(1),IXLU(1), +IBUFR(128),IGRUP(30),IOFLN(30),IBUFV(60) DIMENSION IREG(2),ICWORD(2),IPARM(5) DIMENSION INAM1(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,0/,IREG/0,0/ DATA INAM1/2HT  X,2HTD,2H3 / C C C C CALL RMPAR(IPARM) KY = IPARM(1) C C C C CHECK INLU C IF(INLU.GT.0) GO TO 401 400 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C 401 ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.7) GO TO 402 IF(IERCD.NE.9) GO TO 400 402 ICWORD(1) = IOR(100000B,INLU) C C C FOR ALL GROUPS POLLED, GO TO 9 C IF(KY.EQ.3) GO TO 9 C C KY = 5, WHO ARE YOU ON CURRENT TERMINAL'S GROUP C CHECK ITLU. GET AN ACTIVE TERMINAL LU FOR THIS IF POSSIBLE C 5 IF(ITLU.GT.0) GO TO 404 C 403 CALL IMSG7(ILU,ITLU,IARAY,3,11) IF(ITLU.EQ.0) GO TO 900 404 ICCC = 6 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.NE.6) GO TO 403 C C GET THE TERMINAL'S GROUP CHARACTER C 31 CALL ILINA(ITLU,ILNN,IE16,IE11) KGID = IOR(IAND(IE16,057400B),40B) ID = IOR(KGID,175B) IF(IERCD.EQ.6) 22,900 C C KY = 3, WHO ARE YOU FOR ALL GROUPS ON INLU C 9 ICWORD(1) = IOR(100000B,INLU) C 10 CALL ILINA(INLU,ILNN,IE16,IE11) C C DO WHO ARE YOU ON ALL GROUPS ON CURRENT LINE C ID = 040175B C C J = 1 20 KGID = IOR(IAND(ID,57400B),40B) C C C 21 CONTINUE 22 CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) IOFLN(1) = -1 IXLU = 0 C C C POLL THE LINE AND VERIFY THE GROUP C CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,-1,IXLU,IARAY) C C C C UPDATE THE GROUP POLL CHARACTER IF ITERATING HERE C 574 IF(KY.EQ.5) GO TO 900 C J = J + 1 ID = ID + 400B C 60 IF(J.NE.28) GO TO 20 C C C 900 REG = EXEC(8,INAM1,IPARM) END END$   91711-18029 1926 S C0122 &IMPTM 3075/6/7 VERIF. SEG. 5             H0101 FTN4,Q,C * * DATE: MARCH 15, 1979 * NAME: IMPTM * SOURCE: 91711-18029 * RELOC: 91711-16029 * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * PROGRAM IMPTM (5,89),91711-16029 REV 1926 790906 C 29.10.79 C THIS SEGMENT DISPLAYS THE MULTIPOINT LINE AND TERMINAL C CONFIGURATION FOR THE 3075A, 3076A, 3077A TERMINALS. C C IF IPARM(2) IS NEGATIVE, THIS SEGMENT WAS CALLED BY TXTD1. C IF IPARM(2) IS POSITIVE, THIS SEGMENT WAS CALLED BY TXTD3 OR CFTML. C C FOR IPARM(2) NEGATIVE, A TEST FOR VALID LINE LU IS MADE SINCE THIS C IS THE VERIFY THEN END SELECTION AS DETERMINED BY THE RUN STRING C PARAMETERS. THE INTENT IS TO PROVIDE A PATH TO THE VERIFY SUBROUTINES C CALLED BY TXTD2 FROM TXTD1 WITH THE PROVISION GOOD LINE LU INFORMATION C IS PASSED. THEREFORE A FORCED DEFINE CONDITION IS SET UP (INLU = 0) C WHEN THE RUN STRING ENTRY IS :RU,TXTD1 C INLU IS DEFINED IN IMPXX IF INLU = 0 ON ENTRY TO IMPTM, THEN A TEST C FOR NONZERO INLU IS MADE AFTER ALL EQT HAVE BEEN SURVEYED. SHOULD C THERE BE NO LINE EQT FOUND BY IMPXX, THE VALUE OF INLU REMAINS ZERO C AND A MESSAGE TELLING THERE IS NO MULTIPOINT SYSTEM IS MADE THEN C EXIT FROM TXTD1. FOR A VALID LINE LU (CHECKS ARE MADE IN IMPXX) C TXTD2 CALLS TXTD3 PASSING THE OP CODE PARAMETER FORCE DEFINED BY C TXTD1 IF THIS SEGMENT WAS CALLED BY TXTD1, OR BY THE OPERATOR IF C THIS SEGMENT WAS CALLED BY TXTD3 OR CFTML. C C ILU = CONSOLE LU C ILLU = LIST LU C INLU = LINE LU C C CALLS: IMPXX SHOW THE MULTIPOIt|NT CONFIGURATION C COMMON IARAY(3),ILU(1),ILLU(1),INLU(1),ITLU(1),IXLU(1), +IBUFR(128),IGRUP(30),KOFLN(30),IBUFV(60) DIMENSION INAM1(3),IPARM(5),INAM2(3) DATA INAM1/2HTX,2HTD,2H3 / DATA INAM2/2HTX,2HTD,2H2 / C C CALL RMPAR(IPARM) C C HERE'S THE OP CODE IOP = IPARM(1) C C FOR NONZERO LINE LU, CHECK IT BEFORE THE LU SURVEY C IF(INLU.EQ.0) GO TO 2 ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) C C IF INLU IS NOT A LINE LU, SET INLU = 0, THEN LET IMPXX FIND IT C IF(IERCD.EQ.4) GO TO 2 IF(IERCD.EQ.7) GO TO 2 IF(IERCD.EQ.9) GO TO 2 INLU = 0 C C PREPARE TO CALL IMPXX BY DO LOOP C 2 ID = 040175B C WRITE (ILLU,111) 111 FORMAT(2X"LU",1X"FBIT",1X"EQT",1X"AV",1X"EQW5",1X"S.C.", +"STATE",2X"IN LN ID",8X"MODEL K D LM RM INT PR") C LUMAX=IGET(1653B) CC CC CC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CC CC CC CC DO 5 I=1,LUMAX IFFF = -1 CALL IMPXX(I,ILLU,INLU,IARAY,IFFF) IF(INLU.EQ.I) GO TO 4 GO TO 5 CC CC THERE'S A LINE LU, CHECK IT CC 4 ICCC = 10 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) CC IF(IERCD.EQ.3) GO TO 5 IF(IERCD.EQ.4) GO TO 5 IF(IERCD.EQ.7) GO TO 5 IF(IERCD.EQ.9) GO TO 5 I = LUMAX CC 5 CONTINUE CC CC CC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CC CC CC C C C C CHECK SECOND PARAMETER. WAS IT -1 ? IF(IPARM(2)) 9,10 C C C C C C C YES, CALLED BY MAIN. WAS INLU FOUND BY THE SURVEY ? 9 IF(INLU.EQ.0) GO TO 11 IF(IERCD.EQ.3) GO TO 12 IF(IERCD.EQ.5) GO TO 12 C C GET THE LINKED LIST C C CALL SFILL(LLINK,1,56,0B) C CALL LINK(INLU,ITLU,LLINK,ITMCT) C SHOW THE LU C DO 20 J = 3,LLINK(2) C0 WRITE(ILLU,21)LLINK(J),LLINK(1),LLINK(2),LLINK(J+1) C1 FORMAT(2X"IMPTM LU:",I2X"LINE:",I2X"LU:",I2X"LU:",I2) C C W THERE'S A LINE LU HERE. SHOW THE OFF LINE TERMINALS THEN C CHECK IN TXTD2 FOR THE NEXT OPERATION. C CALL OFFLN(ILU,INLU,ILLU,IARAY) C C IF IOP = SPACE-SPACE, COMPLETE IMMEDIATELY. C IF(IOP.EQ.020040B) GO TO 13 C C IF THE LINE IS ACTIVE WITH TERMINALS ASSIGNED CALL EXEC(8,INAM2,IOP,-1) C C INLU CAN'T BE USED FOR LINE OPERATION. COMPLETE IMMEDIATELY. C 12 IOP = 020040B GO TO 13 C C C C C C C C SECOND PARAMETER IS NOT NEGATIVE. CHECK IN TXTD3 FOR NEXT C OPERATION C 10 CALL EXEC(8,INAM1,IPARM) C C SURVEY COULD NOT FIND LINE LU. C TXTD1 - NO MULTIPOINT SYSTEM C EXIT BY TXTD3 USING OP CODE SPACE-SPACE 11 IOP = 020040B CALL IMSG6(ILLU,0,0,0,IARAY,4,11) 13 CALL EXEC(8,INAM1,IOP) END END$ 2  91711-18030 1926 S C0122 &XXTD1 LIBRARY HEADER             H0101 FTN4,L SUBROUTINE XXTD1,91711-12001 REV 1926 790906 * * DATE: NOV 21,1979 * SOURCE &XXTD1 * SOURCE PART NUMBER 91711-18030 * DUMMY SUBROUTINE XXTD1 TO PROVIDE PART NO. * ON MERGED LIBRARY %XXTD1 91711-12001 * PGMR: N.M. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * RETURN END END$   91711-18031 1926 S C0122 &XXTD2 TXTD1 LIBRARY ASMB             H0101 ASMB,R,L * * DATE: MARCH 15, 1979 * NAME: XXTD2 * SOURCE: 91711-18031 * RELOC: NONE * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * *ASMB,R,L * 02.05.79 * THIS ROUTINE LOADS THE B-REGISTER WITH THE EQT WORD 4 THEN * CALLS ROUTINE TRMLU TO FIND ITS SYSTEM LU NUMBER. * * FORTRAN IV CALL LDARG(INUMB) * * WHERE INUMB = 1 WORD * NAM XXTD2 91711-1X031 REV 1926 791120 * * * * ENT LDARG ENT X13 ENT SHF15 ENT SHFT ENT SHF14 EXT .ENTR EXT TRMLU EXT XLUEX EQT4 OCT 0 ITT OCT 0 BYTE OCT 0 * LDARG NOP JSB .ENTR DEF EQT4 LDB EQT4,I GET THE WORD JSB TRMLU FIND SYSTEM LU FOR EQT4 DEF *+1 STA EQT4,I SAVE THE INTEGER LU VALUE STB ITT,I SAVE THE ASCII LU VALUE JMP LDARG,I RETURN * END *ASMB,R,L * 11.04.79 * THIS ROUTINE REQUESTS STATUS, BYPASSING THE SWITCH TABLE * * FORTRAN IV CALL X13(ITLU,IE5,IE4,IST) * * WHERE ITLU = LU UNDER TEST * IE5 = EQT WORD 5 RETURNED * IE4 = EQT WORD 4 RETURNED * IST = DRT WORD 1 * * * ITEST NOP IEQT5 NOP IEQT4 NOP IEQST NOP * X13 NOP JSB .ENTR DEF ITEST * LDA ITEST,I STA I2 LDA .A SET BIT 15 OF LU UNDER TEST IOR I2 STA I2 * JSB XLUEX REQUEST STATUS, BYPASSING SST DEF RTN DEF I1 DEF I2 DEF I3 DEF I4 DEU  F I5 RTN LDA I3 STA IEQT5,I LDA I4 STA IEQT4,I LDA I5 RETURN VALUES ARE FILLED STA IEQST,I * JMP X13,I I1 DEC 13 I2 OCT 0 NOP I3 OCT 0 I4 OCT 0 I5 OCT 0 .A OCT 100000 * END *ASMB,R,L * 11.04.79 * THIS ROUTINE CLEARS BITS 14-0, THEN ROTATES BIT 15 TO BIT 0. * * FORTRAN IV CALL SHF15(INUMB) * * WHERE INUMB = 1 WORD * * SHF15 NOP JSB .ENTR DEF BYTE LDA BYTE,I GET THE WORD AND MSK0 DELETE BITS 14-0. BIT 15 IS LEFT. RAL BRING BIT 15 TO BIT 0 STA BYTE,I JMP SHF15,I MSK0 OCT 100000 * END *ASMB,R,L * 16.04.79 * THIS ROUTINE MOVES THE UPPER 8 BITS TO THE LOWER 8 BITS IN BYTE. * THE UPPER 8 BITS ARE THEN CLEARED. * * FORTRAN IV CALL SHFT(INUMB) * * WHERE INUMB = 1 WORD * * SHFT NOP JSB .ENTR DEF BYTE * LDB .B INITIALIZE B REGISTER TO ZERO LDA BYTE,I GET THE UPPER BYTE TO BE SHIFTED LSR 8 MOVE 8 ZEROS FROM B REG TO UPPER 8 BITS OF * A REGISTER. STA BYTE,I SAVE BYTE JMP SHFT,I .377 OCT 377 .B OCT 0 * END *ASMB,R,L * 12.04.79 * THIS ROUTINE MOVES BIT 14 TO BIT 0, FILLING 0'S FROM THE LEFT. * * FORTRAN IV CALL SHF14(INUMB) * * WHERE INUMB = 1 WORD * * SHF14 NOP JSB .ENTR DEF BYTE LDA BYTE,I GET THE WORD AND MSK1 DELETE BITS 13-0. BITS 15,14 ARE LEFT. RAL BRING BIT 15 TO BIT 0 RAL BRING BIT 14 TO BIT 0 STA BYTE,I JMP SHF14,I MSK1 OCT 140000 END   91711-18032 1926 S C0122 &XXTD3 TXTD1 LIBRARY FTN4             H0101 FTN4,L SUBROUTINE XXTD3,91711-18032 REV 1926 790906 * * DATE: MARCH 15, 1979 * NAME: XXTD3 * SOURCE: 91711-18032 * RELOC: NONE * PGMR: R.T.A. * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ******************************************************************* * * * RETURN END C END$ CFTN4,L SUBROUTINE DNMPL(ILU,ILLU, +IARAY),91711-1X032 REV 1926 790906 C 23.07.79 C THIS SUBROUTINE REMOVES A MULTIPOINT LINE. C LINES ARE REMOVED WHEN PRESENTLY INITIALIZED. IF A LINE IS C DORMANT A WARNING MESSAGE IS OUTPUT AND NO ATTEMPT TO REMOVE C THE LINE IS MADE. C C ILU = CONSOLE LU C ILLU = LIST LU C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) DATA ICWORD/0,2100B/ DATA ICCC/7/ 5 CALL IMSG6(ILLU,0,0,0,IARAY,6,11) C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. 15 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE IF IERCD = 7 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.NE.7) GO TO 15 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C C REMOVE THE LINE ICW=IOR(100000B,LINE) ICWORD(1) = IOR(100000B,INLU) REG = XLUEX(3,ICWORD,ICW) C 45 CALL IMSG6(ILLU,INLU,LINE,0,IARAY,2,11) C C SET INLU AND ITLU TO ZERO C INLU = 0 ITLU= = 0 C C END MULTIPOINT LINE REMOVAL 900 RETURN END C END$ CFTN4,L SUBROUTINE VMPLN(ILU,INLU,ILLU, +IARAY,IXLU),91711-1X032 REV 1926 790906 C 27.08.79 C THIS SUBROUTINE USES THE MULTIPOINT LINE LU TO FIND THE C TERMINALS TO BE VERIFIED. ALL ACTIVE TERMINALS ARE FOUND C BY A "WHO ARE YOU" POLL ON THE LINE, THE RESPONDING TERMINAL ID C ARE THEN USED TO FIND THE EQT ASSIGNMENTS AND THE LU NUMBERS. C THOSE ID NOT FOUND IN THE EQT FROM THE WRU RESPONSE ARE FLAGGED C AS OFF-LINE. THOSE ID FOUND IN THE EQT BUT NOT AMONG THE WRU C RESPONSE ARE FLAGGED AS EQT VERIFY FAILURES. THE REMAINING LU C ARE VERIFIED. AS EACH LU IS VERIFIED, THOSE LU FAILING THE VERIFY C DISPLAYED WITH COMMENTS. WHEN ALL ACTIVE LU ARE VERIFIED, THE C OFF-LINE TERMINALS ARE VERIFIED. C C ILU = CONSOLE LU C INLU = LINE LU C ILLU = LIST LU C C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C C C DIMENSION IARAY(3),IOFLN(30),IBUFX(28),IGRUP(30) ICNT = 0 C C INITIALIZE BUFFERS C CALL SFILL(IBUFX,1,56,000B) CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) C C TXTD1 - VERIFY LINE C 5 CALL IMSG4(ILLU,0,0,0,0,IARAY,11) C C IF INLU IS ZERO, GET A LINE LU C IF(INLU.GT.0) GO TO 20 C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 19 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW ANY MESSAGE C 20 CALL IMSG4(ILLU,INLU,0,0,1,IARAY,11) ICCC = 11 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) C C IF LINE LU INLU IS INITIALIZED, NO TRMLS ASSIGNED, DO OFF LINE C IF(IERCD.EQ.7) GO TO 29 IF(IERCD.NE.9) GO TO 19 C C SKIP THE LINE LIST IF THE RUN STRING PARAMETERS DIRECT THE C LINE VERIFY. C IF(IXL;U) 23,22 C C LINE IS INITIALIZED, TERMINALS ARE ASSIGNED. SHOW LINE LIST. C 22 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DO THE ACTIVE TERMINALS CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C TXTD1 - VERIFY ACTIVE TERMINALS C 23 CALL IMSG4(ILLU,0,0,0,3,IARAY,11) C L = 1 IF(INLU.EQ.0) GO TO 24 L = INLU - 1 24 L = L+1 ICCC = 10 CALL LUCHK(ILLU,L,IERCD,IARAY,ICCC) C IF(IERCD.EQ.1) GO TO 26 IF(IERCD.EQ.3) GO TO 26 IF(IERCD.EQ.-2) GO TO 26 IF(IERCD.EQ.5) GO TO 25 IF(IERCD.EQ.6) 26,25 25 IF(L.EQ.99) GO TO 29 GO TO 24 C C C C C C C C CALL THE TERMINAL VERIFY SUBROUTINE C C C C 26 IXLU = -1 CALL VMPTL(ILU,INLU,ILLU,L,IARAY,IXLU) GO TO 24 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DO THE OFF LINE TERMINALS CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C TXTD1 - VERIFY OFF LINE TERMINALS C 29 CALL IMSG4(ILLU,0,0,0,2,IARAY,11) ID = 040175B C C C C 30 DO 40 J = 1,27 L = INLU C C SHOW THE OFF LINE ID C CALL IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX,IOFLN,-1) C C ARE THERE OFF LINE TRMLS ? C IF(IOFLN(1)) 40,33 C C ARE ALL ID IN THIS GROUP UNIQUE ? C 33 IF(IBUFX(2) - 1) 50,51 C C YES, OK TO DEAL WITH THIS GROUP C 50 ICCC = 10 CALL LUCHK(ILLU,L,IERCD,IARAY,ICCC) C C IS L A DORMANT MULTIPOINT LU ? C IF(IERCD.EQ.0) 35,34 34 IF(L.EQ.99) GO TO 44 L = L+1 GO TO 33 C C TXTD1 * ab NOT VERIFIED C 51 CALL IMSG3(ILLU,0,0,IBUFX(3),7,IARAY,11) ICNT = ICNT + 1 GO TO 40 C C DORMANT TRML LU HERE C 35 CALL ILINA(INLU,LINE,IE16,IE11) I4LIN = LINE*10000B KK = 1 IDCT = 0 ITLU" = L C C FOR EACH VALID ID, INITIALIZE, VERIFY, AND REMOVE THE TERMINAL C DO 36 K = 2,IOFLN(1) IYLU = 0 KGID = IOR(IAND(IOFLN(K),057400B),40B) 357 ICWG = IAND(IOFLN(K),37400B)/4B ICWD = IAND(IOFLN(K),077B) ICW = IOR((IOR(I4LIN,ICWG)),(ICWD)) C C INITIALIZE TRML, VERIFY TERMINAL C CALL UPMPT(ILU,INLU,ILLU,ITLU,ICW,IYLU,IARAY) IF(IYLU.GT.0) GO TO 41 C C TXTD1 - VERIFY MULTIPOINT TRML LU MMAB PASS C CALL IMSG4(ILLU,ITLU,0,IOFLN(K),5,IARAY,11) C C *LN R TL MM PASS* C C CALL IMSG3(ILLU,LINE,ITLU,IOFLN(K),IARAY,3,11) GO TO 43 C C TXTD1 - VERIFY MULTIPOINT TRML LU MMAB FAIL C 41 CALL IMSG4(ILLU,ITLU,0,IOFLN(K),9,IARAY,11) C C REMOVE TRML C 43 CALL DNMPT(ILU,ILLU,ITLU,IARAY) ICNT = ICNT+1 36 CONTINUE GO TO 40 C C C TXTD1 * AB NOT VERIFIED C 44 DO 45 K = 2,IOFLN(1) 45 CALL IMSG3(ILLU,0,0,IOFLN(K),IARAY,7,11) ICNT = ICNT+1 C C UPDATE THE GROUP UNDER TEST C 40 ID = ID + 400B C C C C C IF(ICNT-1) 42,900 C C TXTD1 - NO OFF LINE TERMINALS PRESENT 42 CALL IMSG4(ILLU,0,0,0,4,IARAY,11) C C END MULTIPOINT VERIFY C 900 RETURN END C END$ CFTN4,L SUBROUTINE VMPTL(ILU,INLU,ILLU,ITLU,IARAY, +IXLU),91711-1X032 REV 1926 790906 C 06.11.79 C THIS SUBROUTINE VALIDATES THE MULTIPOINT LINE LU AND TERMINAL C LU BEFORE VERIFYING THE TERMINAL LU. C IF INLU OR ITLU POINTS TO EQT = 0, NO VERIFY IS MADE. C FOR NEGATIVE IXLU, INTERACTIVE PROMPTS ARE INHIBITED. C FOR INLU NOT USEABLE, NO VERIFY IS MADE. C FOR ITLU HAVING ITS ASSIGNED EQT DOWN, AN ATTEMPT IS C MADE TO UP THE EQT. THE TRML LU IS VERIFIED, THEN IF C THIS LU HAD ITS EQT UPPED BEFORE BEING VERIFIED, THE C EQT IS DOWNED. C C C ILU = CONSOLE LU C INLU = LINE LU C ILLU = LIST LU C ITLU = TERMINAL LU C C CALLS: LUCHK DETERMINE MULTIPOINT (SYS"TEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C C C DIMENSION IGRUP(30),IARAY(3),IOFLN(30) C C INITIALIZE BUFFERS C CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) C C TXTD1 - VERIFY A TERMINAL C 5 CALL IMSG6(ILLU,0,0,0,IARAY,7,11) C C IF INLU IS ZERO, GET A LINE LU C IF(INLU.GT.0) GO TO 20 C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 15 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW ANY MESSAGE C 20 ICCC = 9 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.5) GO TO 900 IF(IERCD.EQ.7) GO TO 19 IF(IERCD.NE.9) GO TO 15 C C 19 IF(IXLU) 24,21 C C SHOW THE LINE C 21 CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C C IF ITLU IS ZERO, GET A TERMINAL LU. CHECK THAT THE TERMINAL LU C IS NOT THE SAME AS THE LINE LU. C 24 IF(ITLU.GT.0) GO TO 27 C IF(INLU.EQ.ITLU) GO TO 30 C C GET A TRML LU C 26 CALL IMSG7(ILU,ITLU,IARAY,3,11) C IF(ITLU.EQ.0) GO TO 15 C C CHECK THE LU C GO TO 27 C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C GET THE TERMINAL EQT NUMBER AND TRY TO UP THE EQT C THE VALUE OF ICCC RETURNED BY LUCHK FOR IERCD = 3 IS C THE INTEGER EQT NUMBER FOR THE TERMINAL LU. C 22 IUPDN = ICCC CALL IMSG3(ILLU,ICCC,IX,0,IARAY,9,11) C C IX IS THE COMPLETION CODE RETURNED BY THE ATTEMPT TO UP AN EQT. C IF IX IS NEGATIVE, THE ATTEMPT HAS FAILED. C GO VERIFY THE TERMINAL ANYWAY, REPORT THE EQT STRUCTURE. C ICCC = 10 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) C IF(IERCD.EQ.6) GO TO 28 C C THIS EQT CANNOT BE VERIFIED. C TXTD1 * LN E TL AB** NOT VERIFIED C 18 CALL IMSG3(ILLU,LINE,ITLU,025052B,IARAY,0,11) GO TO 900 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C CHECK TERMINAL ASSIGNMENT C 27 ICCC = 6 IUPDN = -1 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.3) GO TO 29 IF(IERCD.EQ.5) GO TO 900 IF(IERCD.EQ.6) GO TO 29 IF(IERCD.EQ.-2) GO TO 29 C C THERE'S SOMETHING WRONG WITH USING THIS LU THAT AN :UP,EQT C WON'T FIX. IF THIS IS A VERIFY SPECIFIED TO RUN TO COMPLETION C BY THE RUN PARAMETERS, SHOW A NOT VERIFIED MESSAGE. OTHERWISE C ASK THE OPERATOR FOR ANOTHER LU. C IF(IXLU) 18,26 C C C C C C GET THE TERMINAL ID CHARACTERS FROM THE EQT C 29 CALL ILINA(ITLU,LINE,ITID,IE11) KGID = IOR(IAND(ITID,057400B),40B) ID = IOR(KGID,175B) C C IF THE TERMINAL LU OR EQT IS DOWN, TRY TO UP THE EQT BEFORE C VERIFYING THE TERMINAL LU. C 31 IF(IERCD.EQ.3) GO TO 22 IF(IERCD.EQ.-2) GO TO 22 C C VERIFY THE TERMINAL C 28 IXLU = 0 CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,5,IXLU,IARAY) IF(IXLU.GT.0) GO TO 30 C C TXTD1 - VERIFY MULTIPOINT TRML LU NNAB PASS C CALL IMSG4(ILLU,ITLU,0,ITID,5,IARAY,11) C C *LN L TL NN PASS* C C CALL IMSG3(ILLU,LINE,ITLU,ITID,IARAY,3,11) GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU NNAB FAIL C 30 CALL IMSG4(ILLU,ITLU,0,ITID,9,IARAY,11) C C DOWN THE EQT IF THE EQT WAS UPPED BEFORE VERIFICATON. C 40 IF(IUPDN) 900,41 C C DOWN THE EQT = IUPDN C 41 CALL IMSG3(ILLU,IUPDN,IX,0,IARAY,2,11) C C IX IS THE COMPLETION CODE RETURNED BY THE ATTEMPT TO DOWN THE C EQT. IF IX IS NEGATIVE, THE ATTEMPT HAS FAILED. C C C 900 RETURN END C END$ CFTN4,L SUBROUTINE UPMPL(ILU,INLU,ILLU, +IARAY),91711-1X032 REV 1926 790906 C 23.07.79 C THIS SUBROUTINE INITIALIZES A MULTIPOINT LINE. C LINES THAT ARE ALREADY INITIALIZED WILL NOT BE RE-INITIALIZED AND C A WARNING MESSAGE IS OUTPUT. C C ILU = CONSOLE LU C ILLU = LIST LU C C n7 CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C C C DIMENSION IREG(2),ICWORD(2),IARAY(3),IMESS1(1) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) DATA IMESS1/15505B/ DATA ICWORD/0,0/ DATA IFUN/2000B/ DATA ICCC/4/ C C TXTD1 - INITIALIZE A LINE C 5 CALL IMSG6(ILLU,0,0,0,IARAY,8,11) C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 15 CALL IMSG7(ILU,INLU,IARAY,0,11) IF(INLU.EQ.0) GO TO 9999 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE IF IERCD = 4 C CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.4) GO TO 25 IF(IERCD.EQ.7) GO TO 60 IF(IERCD.EQ.9) GO TO 60 GO TO 15 C C ENTER TIMEOUT AND LINE NUMBER DATA C 25 CALL IMSG7(ILU,ITOV,IARAY,8,11) 35 CALL IMSG7(ILU,ILNN,IARAY,9,11) C C INITIALIZE THE LINE C ICW=IOR(IOR(100000B,(ITOV*1000B)),ILNN) ICWORD(1) = IOR(100000B,INLU) ICWORD(2) = IFUN REG = XLUEX(3,ICWORD,ICW) ID = 17776B ICWORD(2) = 400B REG = XLUEX(2,ICWORD,IMESS1,1,ID) C C TXTD1 - LINE LU N INITIALIZED. ASSIGNED LINE NO. M. C 45 CALL IMSG6(ILLU,INLU,ILNN,0,IARAY,1,11) GO TO 9999 C C SHOW LINE NUMBER AND TERMINAL LU NUMBER(S) ASSIGNED TO THIS LINE 60 CONTINUE CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) C INUM = 0 NO MULTIPOINT DEVICES ASSIGNED C INUM = 1 LINE IS ASSIGNED C INUM > 1 LINE AND TERMINALS ASSIGNED 63 GO TO 15 9999 CONTINUE C C END MULTIPOINT LINE INITIALIZATION C RETURN END C END$ CFTN4,L SUBROUTINE OFFLN(ILU,INLU,ILLU, +IARAY),91711-1X032 REV 1926 790906 C 27.06.79 C THIS SUBROUTINE SHOWS OFF LINE MULTIPOINT TERMINAL ID C FOR ALL GROUPS. ONLY THOSE TERMINAL ID WHICH ARE CLEAR FOR C VERIFICATON ARE SHOWN. C NO PARAMETERS IN THE CALL STRING ARE MODIFIED. C THIS SUBROUTINE IS CALLED BY TXTD3. C C ILLU = LIST LU C INLU = LINE LU C DIMENSION IREG(2),IOFLN(30),IBUFX(28),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) C CALL SFILL(IBUFX,1,56,000B) CALL SFILL(IOFLN,1,60,000B) C C C SKIP THE LINE LU ENTRY IF THE CURRENT INLU IS VALID. C IF(INLU.EQ.0) GO TO 11 ICNT = 0 10 ICCC = 11 CALL LUCHK(ILLU,INLU,IERXX,IARAY,ICCC) IF(IERXX.EQ.7) GO TO 15 IF(IERXX.EQ.9) GO TO 15 C C ENTER THE LINE LU. ENTER 0 TO ABORT C 11 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 GO TO 10 C C C 15 ID = 040175B DO 60 J = 1,27 C SHOW THE OFF LINE ID CALL IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX,IOFLN,1) IF(IOFLN(1)) 60,20 20 ICNT = ICNT+1 60 ID = ID + 400B C C IF(ICNT-1) 61,900 C TXTD1 - NO MULTIPOINT TERMINALS PRESENT 61 CALL IMSG4(ILLU,0,0,0,4,IARAY,11) C 900 RETURN END C END$ CFTN4,L SUBROUTINE IMPXX(ITLU,ILLU,INLU,IARAY, +IFFF),91711-1X032 REV 1926 790906 C 10.29.79 C THIS SUBROUTINE DISPLAYS THE MULTIPOINT LINE AND TERMINAL C CONFIGURATION FOR THE 3075A, 3076A, 3077A TERMINALS. C ITLU, ILLU, INLU, IARAY, IFFF ARE PASSED TO IMPXX IN ALL CASES. C INLU AND IFFF ARE REDEFINED IN THE FOLLOWING WAY: C C ITLU = MULTIPOINT LU C ILLU = LIST LU C INLU = LINE LU C IF ITLU IS A LINE LU, THEN INLU = ITLU. THIS WORKS FOR C A LINE LU BEING THE NUMERICALLY SMALLEST NUMBER AND THEREFORE C THE FIRST TYPE 7 EQT AS THE DRT IS SEARCHED IN ASCENDING C NUMERICAL ORDER. IF A SECOND LINE LU IS DEFINED, INLU WILL C BE REDEFINED AS THE CURRENT LINE LU. GENERATION OF TWO LINES C IN A SYSTEM MUST GROUP INTENDED LU TO BE ATTACHED TO EACH C LINE IN NUMERICAL ORDER BjY LINE LU. (I.E., INLUA, ITLUA1, C ITLUA2, ITLUA3,...,INLUB, INLUB1, INLUB2, INLUB3,...) C IFFF = MESSAGE FORMAT CONTROL ON ENTRY, ITLU CONDITION CODE ON EXIT C = -1, SURVEY MESSAGE ON ENTRY, OTHERWISE VERIFY MESSAGE C = -2, ITLU IS NOT AVAILABLE FOR VERIFICATION ON EXIT C C CALLS: X13 ASSEMBLY ROUTINE FOR STATUS REQUEST ON C SYSTEM LU. C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C CALLS: SHF14 ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWER C TWO BITS OF THE WORD. BITS 15-2 ARE ZEROS. C CALLS: SHF15 ASSEMBLY ROUTINE MOVES BIT 15 TO BIT 0, C BITS 14-1 ARE ZEROS. C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ITSTA GET MULTIPOINT TERMINAL STATUS FROM ACTIVE C MULTIOINT TERMINAL. C C C C DIMENSION IREG(2),IBUFR(128),IMDL5(3),IMDL6(3),IMDL7(3), +IBT41(1),IBT42(1),IBT43(1),IBT44(1),IBT51(1),IBT52(1),IBT53(2), +IMESS1(2),IMESS2(2),IMESS3(2),IMESS4(3),IMESSA(2),IMESSB(2), +IMESSC(3),IBT45(1),IBT46(1),IBT47(3), +XGRUP(30),IBUFS(28),IBUFV(60), +ICWORD(2),IBUFX(28),IBT48(3),IBT49(1),IMESSD(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) INTEGER XGRUP DATA IMDL5/2H30,2H75,2HA / DATA IMDL6/2H30,2H76,2HA / DATA IMDL7/2H30,2H77,2HA / DATA IBT41/2H P/ DATA IBT42/2H M/ DATA IBT43/2H V/ DATA IBT44/2H -/ DATA IBT45/2H */ DATA IBT46/2H**/ DATA IBT47/2H**,2H**,2H* / DATA IBT48/2H*2,2H64,2HX / DATA IBT49/2H*S/ DATA IBT51/2H N/ DATA IBT52/2H A/ DATA IBT53/2H -,2H- / DATA IMESS1/2HLI,2HNE/ DATA IMESS2/2HTR,2HML/ DATA IMESS3/2HDO,2HWN/ DATA IMESS4/2H ,2H ,2H / DATA ICCC/10/ DATA ICWORD/0,0/ DAUTA IMESSD/2H ,2H: ,2H / DATA IMESSC/2H ,2H ,2H / DATA IMESSA/2H ,2H / DATA IMESSB/2H ,2H / ISINT = 0 ISPR = 0 ISRM = 0 ISLM = 0 ISMDL = 0 ISDSY = 0 ISKY = 0 IFBIT = 0 ISCOD = 0 C IDRT= IGET(1652B) IEQTA=IGET(1650B) C IVAL =IGET(IDRT+ITLU-1) IEQQ = IAND(IVAL,077B) C C STATUS REQUEST ON ITLU. X13 SETS BYPASS CONDITION. CALL X13(ITLU,IEQT5,IEQT4,IEQTST) C C CHECK FOR TYPE 7 DEVICE AT THIS LU C IDVC7 = IAND(IEQT5,037400B) CALL SHFT(IDVC7) C IDVC7 HAS LOWER 8 BITS CONTAINING INFORMATION IF(IDVC7.NE.7) GO TO 900 C IF LU IS POINTED TO EQT 0, SHOW THE LU IF(IEQQ.EQ.0) GO TO 12 C CHECK FOR NONZERO SELECT CODE ASSIGNMENT ISCOD =IAND(IEQT4,077B) IF(ISCOD.EQ.0) GO TO 900 C C C DETERMINE IF LU IS DOWN, AND AVAILABILITY OF EQT IAV = IEQT5 CALL SHF14(IAV) IFBIT=IEQTST CALL SHF15(IFBIT) IEQ5S=IAND(IEQT5,377B) C DETERMINE IF LU IS LINE OR TERMINAL IETBL=(IEQQ-1)*15+IEQTA IE11 = IGET(IETBL+10) IEQX = IGET(IETBL+12) IE16 =IGET(IEQX) IE17 =IGET(IEQX+1) LBIT=IE16 CALL SHF15(LBIT) LINE = IAND(IE17,03400B) CALL SHFT(LINE) C INITIALIZE VARIABLES FOR LISTING 12 ILLP=0 ILNN=55B CALL SFILL(IMESSC,1,6,040B) IKY=40B IDSY=40B ILM =40B IRM =40B INT =20040B IPR =40B IHRS=20040B IMIN=20040B C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DETERMINE IF TERMINAL IS INITIALIZED, SHOW NO MESSAGE C C WRITE(ILLU,110) INLU,ITLU 110 FORMAT(2X"IMPXX N:",I2X,"T:",I2) ICCC = 10 20 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) C C IF(IERCD.EQ.-1)GO TO 29 IF(IERCD.EQ.-2)GO TO 29 IF(IERCD.EQ.0) GO TO 21 IF(IERCD.EQ.1) GO TO 30 IF(IERCD.EQ.2) GO TO 40 pu IF(IERCD.EQ.3) GO TO 30 IF(IERCD.EQ.4) GO TO 23 IF(IERCD.EQ.5) GO TO 40 IF(IERCD.EQ.6) GO TO 25 IF(IERCD.EQ.7) GO TO 27 IF(IERCD.EQ.8) GO TO 10 IF(IERCD.EQ.9) GO TO 27 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DORMANT MULTIPOINT TERMINAL C 21 DO 22 J=1,2 IMESSA(J)=IMESS2(J) IMESSB(J)=IMESS4(J) 22 CONTINUE GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DORMANT MULTIPOINT LINE C 23 DO 24 J=1,2 IMESSA(J)=IMESS1(J) IMESSB(J)=IMESS4(J) 24 CONTINUE GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C NONZERO SUBCHANNEL C 29 IMESSA(1) = IBT49 IMESSA(2) = KCVT(IAND(IEQTST,17B)) CALL SFILL(IMESSB,1,4,0040B) C C IF THIS LU SHARES AN EQT, THEN THE EQT MAY HAVE A LINE NUMBER. C IF(IE11.NE.0) ILNN = KCVT(LINE) C C IF THIS LU IS UNAVAILABLE AS WELL, GO FILL IN THE DOWN MESSAGE C IF(IERCD.EQ.-2) GO TO 291 GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C********************************************************************* C C ACTIVE MULTIPOINT TERMINAL C 25 IMESSA(1)=IE16 IMESSA(2)=020040B DO 26 J=1,2 IMESSB(J)=IMESS4(J) 26 CONTINUE ILNN = KCVT(LINE) C C FOR INLU = 0, COMPLETE IMMEDIATELY C IF(INLU.EQ.0) GO TO 10 C C GET TERMINAL CONFIGURATION DATA C C************************************************************** C C INITIALIZE BUFFERS C 13 CALL SFILL(XGRUP,1,60,000B) CALL SFILL(IBUFS,1,56,000B) CALL SFILL(IBUFX,1,56,000B) IBUFL = 128 CALL SFILL(IBUFR,1,256,000B) IF(IE11.NE.0) ILLP = 1 C C 132 CALL LUCHK(ILLU,INLU,IERXX,IARAY,ICCC) C C IF(IERXX.EQ.9) GO TO 133 GO TO 10 C C GET THE GROUP ID FOR ITLU 133 CALL ILINA(ITLU,ILXX,IE1%6,IE11) KGID = IOR(IAND(IE16,057400B),40B) C C GET ALL TERMINALS IN CURRENT GROUP WITH WRU CALL IGRID(INLU,KGID,XGRUP) IF(XGRUP(1)) 608,137 C C CHECK XGRUP FOR DUPLICATE ID. ANY DUPLICATES ARE PUT IN IBUFX. 137 CALL IXBUF(XGRUP,IBUFX) C C GET ALL LU IN CURRENT GROUP RETURNED IN IBUFS C IBUFS(1) = INLU , IBUFS(2) = NUMBER OF NONZERO WORDS IN IBUFS C IBUFS(3) = ITLU1, IBUFS(4) = ITLU2, IBUFS(5) = ITLU3 ... 608 CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) C WERE ANY LU IN CURRENT GROUP ? IBUFS(2) WILL BE 3 OR GREATER. IF(IBUFS(2) - 3) 165,139 C C************************************************************ C THERE ARE LU IN THE CURRENT GROUP. SORT IT OUT. C 139 IDVCT = 0 KK = 1 CALL SFILL(IBUFV,1,120,000B) IBUFV(1) = -1 C C EACH LU IN IBUFS HAS AN ID IN CURRENT GROUP. IF MATCH IS NOT C ONE-ONE SAVE THE DATA. C DO 145 J = 3,IBUFS(2) IDCT = -1 C DO 143 K = 2,XGRUP(1) C COUNT HOW MANY TRML ID ARE IN WRU LIST IF(XGRUP(K).NE.IE16) 143,142 142 IDCT = IDCT+1 IDVCT = IDVCT+1 143 CONTINUE C C IDCT = HOW MANY SIMILAR ID WERE FOUND IN THE CURRENT GROUP C IDCT = 0 IF ONE MATCH WAS FOUND. C IF(IDCT) 144,145,144 C IF MATCH IS NOT ONE-ONE, SAVE THE DATA IN IBUFV 144 CALL IVBUF(IDCT,IE16,IBUFS(J),IBUFV) 145 CONTINUE C C FOR A RESPONSE TO WRU IN THIS GROUP, INAT > 0. FOR THE EXPECTED C ONE-ONE MATCH BETWEEN ID'S IN EQT AND ID'S IN WRU RESPONSES, C AND INAT > 0, SET IDCT = 0. IF((INAT.EQ.IDVCT).AND.(INAT.GT.0)) IDCT = 0 C C************************************************************ C C IF IBUFV HAS ANY DATA ALL IS NOT WELL IF(IBUFV(1).GT.0) IERCT = IERCT+1 C C FIND ID IN WRU LIST ? IF(IDCT) 146,41 C C C NO ID IN WRU LIST. IS THIS A SURVEY OR VERIFY MESSAGE ? 146 IF(IFFF) 164,202 C SURVEY MESSAGE FOR ID NOT IN WRU 164 WRITE(ILLU,213)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,XJILLP,ILNN, +IMESSA,IMESSB IFFF = -2 GO TO 900 C C ID FOUND IN WRU LIST C CHECK IBUFX FOR DUPLICATE ID IN WRU BEFORE GETTING CONFIGURATION C IBUFX(1) = -1 FOR NO DUPLICATE ID IN WRU 41 IF(IBUFX(1)) 147,36 C C C K POINTS TO ID, K-1 POINTS TO HOW MANY THERE ARE IN WRU LIST 36 K = 3 37 IF(IBUFX(K).EQ.IE16) 39,38 C C HAS THE LAST ID IN IBUFX BEEN CHECKED ? 38 IF(K.EQ.IBUFX(1)) 147,44 44 K = K+2 GO TO 37 C C DUPLICATE ID IN WRU, IS THIS A SURVEY MESSAGE ? 39 IF(IFFF) 42,43 C C SURVEY MESSAGE FOR DUPLICATE ID IN WRU 42 WRITE(ILLU,214)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP,ILNN, +IMESSA,IMESSB,IBUFX(K),IBUFX(K-1) IFFF = -2 GO TO 900 C C VERIFY MESSAGE FOR DUPLICATE ID IN WRU 43 WRITE(ILLU,220)ITLU,IEQQ,IMESSA,IMESSB,IBUFX(K),IBUFX(K-1) IFFF = -2 GO TO 900 C C C 147 CONTINUE 165 CONTINUE 163 CONTINUE C C THE ID ARE DISTINCT. IF IMPXX WAS CALLED BY ILIND, IFFF = 1. IF(IFFF) 150,150,202 C C IF THE LU OR EQT IS UNAVAILABLE, DO NOT GET THE TRML STATUS. C REPORT A DOWN SITUATION AND MARK INITIALIZED TRML WITH ***'S C 150 IF(IERCD.EQ.3) GO TO 61 IF(IERCD.EQ.1) GO TO 61 CONTINUE C C************************************************************** C 11 CALL ITSTA(ILLU,ITLU,IERCD,INT,IPR,IRM,ILM,IMDL,IDSY,IKY, +IHRS,IMIN,IARAY) C SAVE TERMINAL CONFIGURATION DATA ISINT = INT ISPR = IPR ISRM = IRM ISLM = ILM ISMDL = IMDL ISDSY = IDSY ISKY = IKY C CHECK ITSTA COMPLETION CODE IF(IERCD.EQ.0) GO TO 50 IF(IERCD.EQ.1) GO TO 69 IF(IERCD.EQ.2) GO TO 64 IF(IERCD.EQ.3) GO TO 65 IF(IERCD.EQ.4) GO TO 66 IF(IERCD.EQ.5) GO TO 67 IF(IERCD.EQ.6) GO TO 63 IF(IERCD.EQ.7) GO TO 70 IF(IERCD.EQ.-1) GO TO 60 C C TERMINAL STATUS AVAILABLE C TERMINAL RIGHT HAND MODULE 50 IF(ISRM.EQ.0) IRM = IBT4:4 IF(ISRM.EQ.1) IRM = IBT41 IF(ISRM.EQ.2) IRM = IBT42 IF(ISRM.EQ.3) IRM = IBT45 IF(ISRM.EQ.4) IRM = IBT43 IF(ISRM.EQ.5) IRM = IBT45 IF(ISRM.EQ.6) IRM = IBT45 IF(ISRM.EQ.7) IRM = IBT45 C TERMINAL LEFT HAND MODULE IF(ISLM.EQ.0) ILM = IBT44 IF(ISLM.EQ.1) ILM = IBT41 IF(ISLM.EQ.2) ILM = IBT42 IF(ISLM.EQ.3) ILM = IBT45 IF(ISLM.EQ.4) ILM = IBT43 IF(ISLM.EQ.5) ILM = IBT45 IF(ISLM.EQ.6) ILM = IBT45 IF(ISLM.EQ.7) ILM = IBT45 C TERMINAL DISPLAY IF(ISDSY.EQ.0) 510,511 510 IDSY = IBT51 GO TO 512 C 511 IDSY = IBT52 512 CONTINUE C C TERMINAL MODEL IF(ISMDL.EQ.0) GO TO 52 IF(ISMDL.EQ.1) GO TO 54 IF(ISMDL.EQ.2) GO TO 56 GO TO 58 C C 3075A 52 DO 53 J=1,3 IMESSC(J) = IMDL5(J) 53 CONTINUE GO TO 501 C C 3076A 54 DO 55 J=1,3 IMESSC(J) = IMDL6(J) 55 CONTINUE C C CONVERT TO ASCII - PRINTER BUSY STATE 501 IPR = IOR(ISPR,60B) C C TERMINAL INTERRUPT STATE 502 INT = IOR(IOR(ISINT*400B,30000B),102B) C C TERMINAL KEYBOARD C 503 IF(ISKY.EQ.0) 513,514 513 IKY = IBT51 GO TO 515 C 514 IKY = IBT52 515 CONTINUE GO TO 10 C C C 3077A 56 DO 57 J=1,3 IMESSC(J) = IMDL7(J) 57 CONTINUE C C SET THE HOURS AND MINUTES IN IMESSD IMESSD(1) = IHRS C ITMIN = IMIN C CALL SPUT(IMESSD,3,072B) C CALL SGET(ITMIN,1,JMT) CALL SGET(ITMIN,2,JMU) CALL SPUT(IMESSD,4,JMT) CALL SPUT(IMESSD,5,JMU) C C THERE'S NO KEYBOARD FOR 3077A C IKY = IBT44 GO TO 10 C C C UNKNOWN TERMINAL 58 DO 59 J=1,3 IMESSC(J) = IBT47(J) 59 CONTINUE GO TO 10 C C C C STATUS DATA IS NOT COMPLETE. ASSEMBLE IMESSA THEN FLAG THE C REMAINING FIELDS AS UNAVAILABLE. C C TRANSMISSION LOG IS ZERO 60 IMESSA(2) = 25052B C SET UNAVAILABLE FLAG IN REMAINIlNG FIELDS 61 CONTINUE IPR = IBT45 INT = IBT46 IRM = IBT45 ILM = IBT45 IDSY= IBT45 IKY = IBT45 C IF(IERCD.EQ.1) 610,612 612 IF(IERCD.EQ.6) 610,620 C 610 IF(IFFF) 611,615 C SURVEY 611 IFFF = -2 GO TO 10 C C VERIFY 615 IFFF = -2 GO TO 201 C 620 DO 62 J=1,3 IMESSC(J)=IBT47(J) 62 CONTINUE GO TO 10 C C TRANSMISSION LOG IS 5, 264X TERMINAL 63 IMESSA(2) = 25052B DO 68 J = 1,3 68 IMESSC(J) = IBT48(J) GO TO 61 C C BYTE 6 IS NOT CR (15B) 64 IMESSA(2) = 25066B GO TO 61 C C C BIT 7 IN BYTE 3 IS CLEAR, SHOULD BE SET 65 IMESSA(2) = 25063B GO TO 61 C C BIT 7 IN BYTE 4 IS CLEAR, SHOULD BE SET 66 IMESSA(2) = 25064B GO TO 61 C C BIT 7 IN BYTE 5 IS CLEAR, SHOULD BE SET 67 IMESSA(2) = 25065B GO TO 61 C C TRANSMISSION LOG IS NOT 3 OR 5, OR WORD 1 IS NOT RIGHT 69 IMESSA(2) = 25061B GO TO 61 C C TRANSMISSION LOG IS 4, UNKNOWN TERMINAL 70 IMESSA(2) = 25067B GO TO 61 C C C C********************************************************************* C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ACTIVE LINE, FILL IMESSA, IMESSB, AND ILNN FIELDS 27 DO 28 J=1,2 IMESSA(J)=IMESS1(J) IMESSB(J)=IMESS4(J) 28 CONTINUE ILNN = KCVT(LINE) INLU = ITLU GO TO 10 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C A MULTIPOINT DEVICE EQT OR LU IS DOWN. IERCD VALUES 5,1,2,3 C ARE TESTED AS SHOWN IN ORDERED LIST. 30 IF(LBIT.EQ.0) GO TO 32 C LINE HERE DO 31 J=1,2 IMESSA(J)=IMESS1(J) IMESSB(J)=IMESS3(J) 31 CONTINUE ILNN = KCVT(LINE) INLU = ITLU GO TO 10 C C C SIGN BIT IS CLEAR, DEVICE IS A TERMINAL. IS IT DORMANT? 32 IF(IE16.EQ.0) GO TO 34 C AN ACTIVE MULTIPOINT TERMINAL HERE. IMESSA(1) = IE16 IMESSA(2) = 020040B ILNN = KCVT(LINE) C C ENTER HERE FROM NONZERO SUBCHANNEL IF IERCD = -2 C 291 DO 33 J=1,2 IMESSB(J)=IMESS3(J) 33 CONTINUE C C IF THIS LU HAS A SUBCHANNEL AND IS UNAVAILABLE, DON'T GET STATUS C IF(IERCD.EQ.-2) GO TO 10 C C IF INLU = 0, WE CAN'T DO ANY LINE OPERATIONS FOR THIS ACTIVE LU. C COMPLETE IMMEDIATELY. C IF(INLU.EQ.0) GO TO 10 C C THE ONLY OTHER WAY TO GET THIS FAR WAS BY STATEMENT 20 C C SET UNAVAILABLE FLAG IN REMAINING FIELDS IF EQT IS IN LINKED LIST C IF(IE11.NE.0) GO TO 13 GO TO 10 C C C DORMANT MULTIPOINT TERMINAL HERE. 34 DO 35 J=1,2 IMESSA(J)=IMESS2(J) IMESSB(J)=IMESS3(J) 35 CONTINUE C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CHECK LINKED LIST POINTER 10 IF(IE11.EQ.0) GO TO 45 ILLP = 1 C C C C C C SEND A SURVEY OR VERIFY MESSAGE C C IS THIS TERMINAL 3077A ? C 45 IF(ISMDL.EQ.2) 46,40 C C USE STATEMENT 47, 48 IF THIS IS SURVEY FORMAT AND 3077A TERMINAL C 46 IF(IFFF) 47,48,202 C C 3077A SURVEY MESSAGE C 47 WRITE(ILLU,204)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD,IE17,ILLP, +ILNN,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM,IRM,IMESSD GO TO 900 C C 3077A VERIFY MESSAGE C 48 WRITE(ILLU,205)ITLU,IEQQ,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM, +IRM,IMESSD GO TO 900 C C STATEMENTS 200, 201 USED FOR 3075A, 3076A TERMINALS. C IF IFFF = -1, SHOW SURVEY MESSAGE. OTHERWISE SHOW VERIFY MESSAGE. C 40 IF(IFFF)200,201,202 C C SURVEY MESSAGE C 200 WRITE(ILLU,210)ITLU,IFBIT,IEQQ,IAV,IEQ5S,ISCOD, +IE17,ILLP,ILNN,IMESSA,IMESSB, +IMESSC,IKY,IDSY,ILM,IRM,INT,IPR C C CHECK IF THIS TERMINAL IS DOWN, SET IFFF = -2 IF IT IS. C IF(IERCD.EQ.-2) IFFF = -2 GO TO 900 C C VERIFY MESSAGE C 201 WRITE(ILLU,211)ITLU,IEQQ,IMESSA,IMESSB,IMESSC,IKY,IDSY,ILM,IRM, +INT,IPR C C INHIBIT ANY MESSAGES TO THE TERMINAL L=4U IF ITLU OR THE EQT IS DOWN C IF(IERCD.EQ.3) IFFF = -2 GO TO 900 C C VERIFY MESSAGE FOR ID NOT IN WRU C 202 WRITE(ILLU,212)ITLU,IEQQ,IMESSA,IMESSB IFFF = -2 GO TO 900 C C C C C C C 3077A SURVEY 204 FORMAT(I4,I4,I4,I3,2XK3"B",1XK2"B",1XK6"B",1XI1,2XR1,1X2A2, +1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2X3A2) C 3077A VERIFY 205 FORMAT(18XI3,I3,2X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2X3A2) C C 3075A,3076A SURVEY 210 FORMAT(I4,I4,I4,I3,2XK3"B",1XK2"B",1XK6"B", +1XI1,2XR1,1X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2XA2,2XR1) C 3075A, 3076A VERIFY 211 FORMAT(18XI3,I3,2X2A2,1X2A2,1X3A2,R1,1XR1,1XR1,2XR1,2XA2,2XR1) 212 FORMAT(18XI3,I3,2X2A2,1X2A2,1X"ID NOT IN WRU LIST") 213 FORMAT(I4,I4,I4,I3,2X@3,"B",1X@2,"B",1X@6,"B",1XI1,2XR1,2(1X2A2), +1X"ID NOT IN WRU LIST") 214 FORMAT(I4,I4,I4,I3,2X@3,"B",1X@2,"B",1X@6,"B",1XI1,2XR1,2(1X2A2), +1XA2" APPEARS",I2" TIMES IN WRU") 220 FORMAT(18XI3,I3,2X2A2,1X2A2,1XA2" APPEARS",I2" TIMES IN WRU") C 900 IF(IERCD.EQ.6) IFFF = -3 RETURN END C END$ CFTN4,L SUBROUTINE ITSTA(ILLU,ITLU,IERCD,IB31,IB32,IB41,IB42,IB51, +IB52,IB53,IHRS,IMIN,IARAY),91711-1X032 REV 1926 790906 C 23.07.79 C THIS SUBROUTINE GETS THE MULTIPOINT TERMINAL STATUS (6 BYTES) C FROM ACTIVE 3075A, 3076A, 3077A TERMINALS. THE CALLING PROGRAM C SHOULD CHECK ITLU BEFORE CALLING THIS SUBROUTINE. C C ILLU = LIST LU C ITLU = LU UNDER TEST C IERCD = COMPLETION CODE C = -1 TRANSMISSION LOG IS ZERO C = 0 TERMINAL STATUS AVAILABLE C = 1 WORD 1 IS NOT RIGHT OR TRANSMISSION LOG IS NOT 3 OR 5 C = 2 BYTE 6 IS NOT CR (15B) C = 3 BIT 7 IN BYTE 3 IS CLEAR, SHOULD BE SET C = 4 BIT 7 IN BYTE 4 IS CLEAR, SHOULD BE SET C = 5 BIT 7 IN BYTE 5 IS CLEAR, SHOULD BE SET C = 6 TRANSMISSION LOG IS 5, 264X TERMINAL C = 7 TRANSMISSION LOG IS 4, UNKNOWN $TERMINAL C C IB31 = OCTAL DIGIT INTERRUPT STATUS C IB32 = PRINTER BUSY FLAG. 1-BUSY. 0-NOT BUSY C IB41 = TERMINAL RIGHT HAND MODULE OCTAL CODE C IB42 = TERMINAL LEFT HAND MODULE OCTAL CODE C IB51 = TERMINAL MODEL NUMBER C IB52 = DISPLAY FLAG. 1-ALPHA 0-NUMERIC C IB53 = KEYBOARD FLAG. 1-ALPHA 0-NUMERIC C IHRS = 3077 HOURS C IMIN = 3077 MINUTES C C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C DIMENSION IREG(2),IBUFR(8),IBUFL(1),IMESS1(1),ICWORD(2), +IMESS3(1),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA IMESS1/15536B/ DATA IBY3/0/ DATA IBY4/0/ DATA IBY5/0/ DATA IBY6/0/ DATA ICWORD/0,0/ DATA IBBB/100000B/ IBUFL = 0 IHRS = 0 IMIN = 0 5 CALL SFILL(IBUFR,1,16,000B) CALL EM(1,ITLU,ILLU,IARAY,IBBB) C STATUS REQUEST FROM THE TERMINAL ICWORD(1) = IOR(100000B,ITLU) CALL XLUEX(2,ICWORD,IMESS1,1) C STRIP RECORD SEPARATORS, CR-LF CHARACTERS WHEN POLLING TERMINAL REG = XLUEX(1,ICWORD,IBUFR,8) IBUFL = IB C IF IB = 0 THERE IS NO RESPONSE FROM TERMINAL. IF(IBUFL.EQ.0) GO TO 10 IF(IBUFL.EQ.1) GO TO 50 IF(IBUFL.EQ.3) GO TO 15 IF(IBUFL.EQ.4) GO TO 56 IF(IBUFL.EQ.5) GO TO 16 GO TO 50 C TRANSMISSION LOG IS ZERO 10 IERCD=-1 100 CALL IMSG6(ILLU,ITLU,0,0,IARAY,0,11) GO TO 998 C 3075A AND 3076A TERMINAL STATUS 15 IERCD=0 IF(IBUFR(1).NE.15534B) GO TO 50 C IBY3 = IBUFR(2) CALL SHFT(IBY3) IBY4 = IAND(IBUFR(2),377B) IBY5 = IBUFR(3) CALL SHFT(IBY5) IBY6 = IAND(IBUFR(3),377B) C 20 IF(IBY6.NE.15B) GO TO 51 IF(IBY3.LT.100B) GO TO 52 IF(IBY4.LT.100B) GO TO 53 IF(IBY5.LT.100B) GO TO 54 C IF(IBUFL.EQ.5) 22,21 C 21 IB31=IAND(IBY3,7B) IB32=(IAND(IBY3,40B))/40B GO TO 23 22 IB31 = 0 IB32 = 0 23 IB41=IAND(IBY4,7B) IB42=(IAND(IBY4,70B))/10B IB51=IAND(IBY5,7B) IB52=IAND(IBY5,20B) IB52 = IB52/20B IB53=IAND(IBY5,40B) IB53 = IB53/40B GO TO 998 C 3077A TERMINAL STATUS OR 264X STATUS ? 16 IERCD=0 IF(IBUFR(1).NE.15534B) GO TO 50 I77A = IAND(IBUFR(4),177400B) IF(I77A.NE.040000B) GO TO 55 C C 3077A STATUS IBY6 = IAND(IBUFR(5),377B) IBY5 = IBUFR(5) CALL SHFT(IBY5) C IBY4 = IAND(IBUFR(4),377B) IBY3 = IBUFR(4) CALL SHFT(IBY3) C IHRS = IBUFR(2) IMIN = IBUFR(3) GO TO 20 C TRANSMISSION LOG LENGTH IS NOT RIGHT 50 IERCD=1 GO TO 998 C TRANSMISSION LOG TERMINATION BYTE IS NOT CR (15B) 51 IERCD=2 GO TO 998 C BIT 7 IN BYTE 3 IS ZERO 52 IERCD=3 GO TO 998 C BIT 7 IN BYTE 4 IS ZERO 53 IERCD=4 GO TO 998 C BIT 7 IN BYTE 5 IS ZERO 54 IERCD=5 GO TO 998 C 264X TERMINAL ENABLE ROUTINE POLLING 55 IERCD = 6 CALL EM(1,ITLU,ILLU,IARAY,1401B) GO TO 999 C UNKNOWN TERMINAL, LEAVE IT WITH ROUTINE POLLING DISABLED 56 IERCD = 7 GO TO 999 C C DATACAP TERMINALS NEED THIS 998 CALL EM(1,ITLU,ILLU,IARAY,101000B) C C 999 RETURN END C END$ CFTN4,L SUBROUTINE LUCHK(ILLU,ITLU,IERCD,IARAY, +ICCC),91711-1X032 REV 1926 790906 C 10.26.79 C THIS SUBROUTINE CHECKS FOR MULTIPOINT LU ASSIGNMENTS RETURNING C TO THE CALLING PROGRAM A COMPLETION CODE (IERCD) C C ILLU = LIST LU C ITLU = LU UNDER TEST C IERCD= COMPLETION CODE RETURNED TO CALLER C = 1 : LU IS DOWN C = 2 : LU IS NOT DEVICE TYPE 7 C = 3 : EQT IS DOWN OR EQT STATE IS NOT CLEAR (IE17) C = 4 : LU IS ASSIGNED TO A DORMANT MULTIPOINT LINE C = 5 : LU HAS NO EQT ASSIGNMENT C = 6 : LU IS ASSIGNED TO AN INITIALIZED MULTIPOINT TERMINAL  C = 7 : LU IS ACTIVE LINE WITH NO TERMINALS ASSIGNED C = 8 : LU IS NOT IN A LINKED LIST C = 9 : LU IS ACTIVE LINE WITH TERMINALS ASSIGNED C = 0 : LU IS ASSIGNED TO A DORMANT MULTIPOINT TERMINAL C =-1 : LU HAS NONZERO SUBCHANNEL C =-2 : LU HAS NONZERO SUBCHANNEL AND THE LU OR EQT OR BOTH C ARE UNAVAILABLE C C ICCC = INTEGER PASSED TO IMSG1 C ICCC = RETURNS INTEGER EQT NUMBER FOR UNAVAILABLE LU NUMBERS C (IERCD = 3,-2) C C CALLS: X13 ASSEMBLY ROUTINE FOR STATUS REQUEST ON C SYSTEM LU. C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C CALLS: SHF14 ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWERE C TWO BITS OF THE WORD. BITS 15-2 ARE ZEROS. C CALLS: SHF15 ASSEMBLY ROUTINE MOVES BIT15 TO BIT 0, C BITS 14-1 ARE ZEROS. C CALLS: IMSG1 SHOW A MESSAGE ASSOCIATED WITH IERCD C C DIMENSION IERCD(1),ITLU(1),IARAY(3),ICCC(1) C C C THERE'S NO EQT ASSIGNMENT FOR ITLU = 0 C IF(ITLU.EQ.0) GO TO 85 IEQTA = IGET(1650B) IDRT = IGET(1652B) ILUMAX= IGET(1653B) IINTBA= IGET(1654B) IINTLG= IGET(1655B) C CHECK EQT ASSIGNMENT FOR THIS LU IVAL =IGET(IDRT+ITLU-1) IEQTQ=IAND(IVAL,077B) IF(IVAL.NE.0) GO TO 10 GO TO 85 C STATUS REQUEST ON ITLU. X13 SETS BYPASS CONDITION. 10 CONTINUE CALL X13(ITLU,IEQT5,IEQT4,IEQST) C CHECK SELECT CODE ASSIGNMENT OF EQT ISCOD=IAND(IEQT4,077B) IF(ISCOD.NE.O) GO TO 20 GO TO 81 C CHECK DEVICE TYPE. MUST BE TYPE 7 20 IDTYPE=IAND(IEQT5,037400B) CALL SHFT(IDTYPE) C IDTYPE HAS LOWER 8 BITS CONTAINING INFORMATION IF(IDTYPE.EQ.07) GO TO 30 GO TO 82 30 IAV=IEQT5 CALL SHF14(IAV) IFBIT=IEQST CALL SHF15(IFBIT) C CHECK FOR NONZERO SUBCHANNEL  ISBCH = IAND(IEQST,17B) IF(ISBCH.NE.0) GO TO 90 C CHECK IF LU IS DOWN AND AVAILABILITY OF EQT IF((IAV.NE.01).AND.(IFBIT.EQ.0)) GO TO 40 IF(IFBIT.EQ.1) GO TO 81 GO TO 83 40 CONTINUE C GET EQT DATA IETBL = (IEQTQ-1)*15+IEQTA IE11 = IGET(IETBL+10) IEQX = IGET(IETBL+12) IE16 = IGET(IEQX) IE17 = IGET(IEQX+1) LBIT = IE16 CALL SHF15(LBIT) IF(LBIT.EQ.1) GO TO 50 C DETERMINE IF THIS IS A DORMANT TERMINAL OR LINE. LBIT = 0 IF(IAND((IOR(IE11,IE16).EQ.0),(ISCOD.GT.025B))) GO TO 60 C LBIT=0 AND IE16 AND IE11 ARE NOT ZERO. LU IS AN INITIALIZED C TERMINAL C NO CHECK ON STATE IF((IE11.NE.0).AND.(IE16.LT.100000B).AND.(IE16.NE.0)) GO TO 86 C IE16 AND IE11 ARE ZERO AND (SELECT CODE) < 26B. DORMANT TERMINAL IF(((IE16.OR.IE11).EQ.0).AND.(ISCOD.LT.026B)) GO TO 80 GO TO 60 C C LBIT=1 DETERMINE IF LINE LU IS DORMANT C C ***PROGRAM PRMPT ADDITION TO SYSTEM****09.04.79**** 50 CONTINUE IF((IE16.EQ.100000B).AND.(IE11.EQ.0)) GO TO 51 IF((IE16.GT.100000B).AND.(IE11.EQ.0)) GO TO 52 C THERE SHOULD BE A POINTER IN IE11 IF(IE11.EQ.0) GO TO 88 C LINE IS INTIALIZED. CHECK FOR CLEAR STATE ISTAT = IAND(IE17,377B) IF(ISTAT.NE.0) GO TO 83 C STATE IS CLEAR. CHECK FOR ASSIGNED TERMINALS IF(IE11.EQ.IETBL) GO TO 87 GO TO 89 C LBIT=1 LINE IS DORMANT. CHECK IF SELECT CODE < 26B 51 IF(ISCOD.GT.025B) GO TO 83 C LINE LU IS DORMANT. CHECK FOR CLEAR EQT STATE ISTAT = IAND(IE17,377B) IF(ISTAT.NE.0) GO TO 83 C STATE IS CLEAR. GO TO 84 C LINE LU IS DORMANT. CHECK FOR CLEAR EQT STATE. IE16=ID SEGMT 52 CONTINUE GO TO 51 C C TERMINAL LU IS DORMANT. CHECK FOR CLEAR EQT STATE C 60 CONTINUE ISTAT = IAND(IE17,377B) IF(ISTAT.NE.0) GO TO 83 C STATE IS CLEAR. CONTINUE C ******* C ******* C DORMANT TERMINAL RETURN 80 IERCD = 0 GO TO 9999 C LU IS DOWN 81 IERCD = 1 GO TO 9999 C LU IS NOT ASSIGNED TO A TYPE 7 DEVICE 82 IERCD = 2 GO TO 9999 C EQT IS DOWN OR EQT STATE IS NOT CLEAR C RETURN THE EQT NUMBER IN PARAMETER ICCC, BUT BEFORE MAKING C THIS ASSIGNMENT, OUTPUT A MESSAGE. 83 IERCD = 3 GO TO 9999 C DORMANT LINE RETURN 84 IERCD = 4 GO TO 9999 C LU NOT ASSIGNED (NO EQT) 85 IERCD = 5 GO TO 9999 C INITIALIZED TERMINAL RETURN 86 IERCD = 6 GO TO 9999 C INTIALIZED LINE WITH NO TERMINALS ASSIGNED 87 IERCD = 7 GO TO 9999 C TYPE 7 EQT IS NOT IN A LINKED LIST (SERIOUS ERROR) 88 IERCD = 8 GO TO 9999 C INITIALIZED LINE WITH TERMINALS ASSIGNED 89 IERCD = 9 GO TO 9999 C NONZERO SUBCHANNEL ASSIGNMENT 90 IERCD = -1 C C CHECK IF LU IS DOWN OR EQT IS UNAVAILABLE. C IF((IAV.NE.01).AND.(IFBIT.EQ.0)) GO TO 9999 C C THIS LU HAS A SUBCHANNEL ASSIGNMENT AND IS UNAVAILABLE. C IERCD = -2 C C 9999 CONTINUE CALL IMSG1(ILLU,ITLU,IARAY,IERCD,ICCC,IEQTQ) ICCC = IEQTQ C C WRITE(ILLU,710)ITLU,IERCD 710 FORMAT(2X"LUCHK ITLU:",I2X"IERCD:",I2) RETURN END C END$ CFTN4,Q,C SUBROUTINE LINK(INLU,ITLU,LLINK, +ITMCT),91711-1X032 REV 1926 790906 C 17.10.79 C THIS SUBROUTINE GETS A LIST OF LU NUMBERS OF TERMINALS ON THE C LINE BY SEARCHING THE EQT LINKED LIST. C ITLU PASSED IS CHECKED FOR LINE MEMBERSHIP, ITMCT INDICATES IF C THE TRML LU WAS FOUND. C C NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF INLU IS C A LINE LU. USE LUCHK BEFORE CALLING LINK. C C ILLU = LIST LU C INLU = LINE LU C ITLU = TERMINAL LU C LLINK = LLINK(1) IS LINE LU NUMBER, LLINK(2) IS IBUFL, THEN C TERMINAL LU NUMBERS. C THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT C IBUFL = NUMBER OF TERMINAL LU IN LLINK, ONE WORD PER TERMINAL, PLUS C ? ONE (FOR THE LINE LU). C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. C C ITMCT = 0 TRML LU WAS NOT FOUND ASSIGNED TO LINKED LIST C = -1 TRML LU WAS FOUND ON THIS LINKED LIST C C C CALLS: ILINA GET THE LINE NUMBER, LIST POINTER C CALLS: LDARG ASSEMBLY ROUTINE TO CALL TRMLU C C SOURCE TERM : LLINK LIST OF TERMINAL LU ON ASSIGNED LINKED LIST C ITMCT VERIFY ITLU COMPLETION CODE C DIMENSION LLINK(28) KK = 2 ITMCT = 0 DO 1 J=1,28 1 LLINK(J) = 0 LLINK(2) = -1 C C GET THE LINE WORD 11 AND WORD 16 CALL ILINA(INLU,ILNN,IE16,IE11) C C DON'T GO ON IF LIST LINK POINTER IS ZERO. THERE IS NO LINE IF(IE11.EQ.0) 901,3 C DON'T GO ON IF THE LINE IS DORMANT 3 IF(IE16.EQ.100000B) 901,4 C C PUT THE LINE LU NUMBER INTO THE FIRST WORD OF LLINK. C STARTING WITH THE LINE EQT, IT11 POINTS TO WORD ONE OF THE C NEXT EQT IN THE LIST. GET THAT LU NUMBER, THEN USE IT TO GET THE C EQT WORD 11 AND 16 DATA CONTAINING LIST POINTER AND LINE NUMBER. C CHECK ITLU AGAINST EACH TERMINAL LU NUMBER RETURNED BY LDARG C FOR IDENTITY, SET ITMCT = -1 IF THEY ARE THE SAME. C PUT ALL TERMINAL LU FOUND ON THIS LINKED LIST INTO LLINK. C ENTER THE LU NUMBER INTO THE NEXT WORD OF LLINK AND INCREMENT KK. C USING THE TERMINAL EQT WORD 11, CHECK IF IT POINTS C TO THE LINE EQT. IF IT DOES, THE LINE SEARCH IS COMPLETE. C EVENTUALLY THE UPDATED LIST POINTER WILL POINT TO THE LINE LU, THEN C A NORMAL EXIT IS TAKEN. C 4 LLINK(1) = INLU IT11 = IE11 IDRT = IGET(1652B) C C DOES THIS LINE LU POINT TO A TERMINAL ? C 5 IF(IE11.NE.(IE11-10)) 51,900 C C YES, SO ADJUST IT4 TO POINT TO WORD 4 AND GET THE SYSTEM LU C 51 IT4 = IT11+3 C C FIRST PUT IT4 INTO THE B-REGISTER C CALL51 LDARG(IT4,ITT) C C GET SYSTEM LU OF THIS EQT. IT4 AND A-REGISTER ARE INTEGER FORMAT C ITT AND B-REGISTER ARE ASCII FORMAT. C CHECK ITLU AGAINST IT4 FOR IDENTITY C IF(IT4.EQ.ITLU) ITMCT = -1 C C MAKE SURE WE'RE NOT DEALING WITH THE LINE LU AGAIN C 52 IF(IT4.NE.INLU) 54,900 C C PUT IT4 INTO LLINK C 54 KK = KK+1 LLINK(KK) = IT4 C C SEARCH NO MORE IF THE LINK POINTER IS THE LINE EQT. C 55 IF(IT11.NE.IE11) 51,900 C C KK = THE NUMBER OF TERMINALS ON THIS LINE C ITMCT = -1 ITLU WAS FOUND AMONG THIS LINKED LIST C = 0 ITLU WAS NOT FOUND AMONG THIS LINKED LIST C 900 LLINK(2) = KK 901 RETURN END C END$ CFTN4,L SUBROUTINE IMSG1(ILLU,ITLU,IARAY,INUM, +IAAA,IEQTQ),91711-1X032 REV 1926 790906 C 31.08.79 C C C ILLU = LIST LU C ITLU = LU NUMBER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9, -1, SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IARAY(3) DATA IBBB/100000B/ IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 IF(INUM.EQ.-1)GO TO 40 IF(INUM.EQ.-2)GO TO 40 GO TO 900 C C TXTD1 - LU MM IS ASSIGNED TO A DORMANT MULTIPOINT TERMINAL 20 WRITE(ILLU,30)IARAY,ITLU 30 FORMAT(2X3A2"- LU ",I2X"ASSIGNED TO A DORMANT MULTIPOINT", +" TERMINAL") GO TO 900 C C TXTD1 - LU MM IS DOWN 21 WRITE(ILLU,31)IARAY,ITLU 31 FORMAT(2X3A2"- LU ",I2X"IS DOWN") GO TO 900 C C TXTD1 - LU MM IS NOT ASSIGNED TO A DEVICE C 22 WRITE(ILLU,32)IARAY,ITLU 32 FORMAT(2X3A2"- LU ",I2X"IS NOT ASSIGNED TO A DEVICE") GO TO 900 C C TXTD1 - EQT ZZ IS DOWN 23 WRITE(ILLU,33)IARAY,IEQTQ 33 FORMAT(2X3A2"- EQT ",I2X"IS DOWN") GO TO 900 C C TXTD1 - LU MM IS ASSIGNED TO A DORMANT MULTIPOINT LINE 24 WRITE(ILLU,34)IARAY,ITLU 34 FORMAT(2X3A2"- LU ",I2X"IS ASSIGNED TO A DORMANT MULTIPOINT", +" LINE") GO TO 900 C C TXTD1 - LU MM NOT ASSIGNED, NOT TESTED 25 WRITE(ILLU,35)IARAY,ITLU 35 FORMAT(2X3A2"- LU ",I2X"NOT ASSIGNED, NOT TESTED") GO TO 900 C C TXTD1 - LU MM IS AN INITIALIZED MULTIPOINT TERMINAL 26 WRITE(ILLU,36)IARAY,ITLU 36 FORMAT(2X3A2"- LU ",I2X"IS AN INITIALIZED MULTIPOINT TERMINAL") GO TO 900 C C TXTD1 - LINE LU MM IS INITIALIZED, NO TERMINALS ASSIGNED 27 WRITE(ILLU,37)IARAY,ITLU 37 FORMAT(2X3A2"- LINE LU ",I2X"IS INITIALIZED, NO TERMINALS", +" ASSIGNED") GO TO 900 C C TXTD1 - LU MM IS NOT IN LINKED LIST 28 WRITE(ILLU,38)IARAY,ITLU 38 FORMAT(2X3A2"- LU ",I2X"IS NOT IN A LINKED LIST") GO TO 900 C C TXTD1 - LINE LU MM IS INITIALIZED, TERMINALS ARE ASSIGNED 29 WRITE(ILLU,39)IARAY,ITLU 39 FORMAT(2X3A2"- LINE LU ",I2X"IS INITIALIZED, TERMINALS ARE", +" ASSIGNED") GO TO 900 C C TXTD1 - LU MM HAS NONZERO SUBCHANNEL ASSIGNMENT 40 WRITE(ILLU,50)IARAY,ITLU 50 FORMAT(2X3A2"- LU",XI2X"HAS NONZERO SUBCHANNEL ASSIGNMENT") GO TO 900 C C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE UPMPT(ILU,INLU,ILLU,ITLU,IGGG,IXLU, +IARAY),91711-1X032 REV 1926 790906 C 26.09.79 C THIS SUBROUTINE INITIALIZES A MULTIPOINT TERMINAL. C TERMINALS THAT ARE INITIALIZED WILL NOT BE RE-INITIALIZED C AND A WARNING MESSAGE IS OUTPUT. C C ILU = CONSOLE LU C INLU = LINE LU C ILLU = LIST LU C ITLU = TERMINAL LU C IGGG = -1 DIAGNOSTIC. CALLED BY TXTD2. C > 0 VERIFY. IGGG IS ICW FOR INITIALIZING A TERMINAL. C C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C CALLS: LUVFY VERIFY TERMINAL LU = ITLU ON LINE LU = INLU C WHICH HAS A SPECIFIED ID FOUND IN THE EQT C CALLS: IXGID GET THE GROUP CHARACTER OR DEVICE CHARACTER C CALLS: ILINA GET THE LINE NUMBER, ID FOR AN LU FROM THE EQT C CALLS: IGRID GET THE GROUP RESPONSE FOR THE SPECIFIED GROUP C CHARACTER ON THE SPECIFIED LINE LU C C C DIMENSION IREG(2),IBUFR(128),ICWORD(2),IOFLN(30),IGRUP(30), +IARAY(3),IMESS1(1) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) IXLU = 0 DATA ICWORD/0,2000B/ DATA IMESS1/15505B/ IF(IGGG.EQ.-1) 5,71 5 CALL IMSG8(ILLU,IARAY,1,11) CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) C C IF INLU IS ZERO, GET A LINE LU IF(INLU.GT.0) GO TO 30 C C ENTER THE LINE CONTROL INFORMATION. IF NO MORE LINES, ENTER C 0 TO STOP. C 15 CALL IMSG7(ILU,INLU,IARAY,1,11) IF(INLU.EQ.0) GO TO 900 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW ANY MESSAGE C 30 ICCC = 9 CALL LUCHK(ILLU,INLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.7) GO TO 25 IF(IERCD.EQ.9) GO TO 25 GO TO 15 C C SHOW LINE NUMBER AND TERMINAL LU NUMBER(S) ASSIGNED C TO THIS LINE LU. C 25 CONTINUE CALL ILINE(INLU,ILLU,INUM,LINE,IARAY) I4LIN = LINE*10000B C C GET GROUP ID C 28 INUM = 0 CALL IXGID(ILU,IGID,KGID,IARAY,INUM) IF(IGID.EQ.20040B) GO TO 15 C C GET ALL RESPONSES TO GROUP KGID ON LINE LU = INLU, PU THE C ID COLLECTED IN BUFFER IGRUP C CALL IGRID(INLU,KGID,IGRUP) C C SHOW THE RESPONDING TERMINALS C IF(IGRUP(1)) 27,26 26 INAT = IGRUP(1) - 1 CALL IMSG2(ILLU,INAT,KGID,2,IARAY,11) DO 27 K = 2,IGRUP(1) CALL IMSG2(ILLU,0,IGRUP(9K),3,IARAY,11) 27 CONTINUE C C ENTER TERMINAL LU. IF NO MORE TERMINALS ON THIS LINE, ENTER C 0 TO STOP C 16 CALL IMSG7(ILU,ITLU,IARAY,2,11) IF(ITLU.EQ.0) GO TO 15 C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE FOR IERCD = 0 C 36 ICCC = 0 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.0) GO TO 70 IF(IERCD.EQ.-1) GO TO 70 GO TO 16 C C GET THE DEVICE ID C 70 INUM = 1 CALL IXGID(ILU,IDID,IXXX,IARAY,INUM) IF(IDID.EQ.020040B) GO TO 16 C C INITIALIZE THE TERMINAL C ICWG = IAND(IGID,37400B)/4B ICWD = IAND(IDID,077B) ICW=IOR((IOR(I4LIN,ICWG)),(ICWD)) GO TO 72 C C IF THIS WAS CALLED WITH ICW DEFINED, ENTER HERE C 71 ICW = IGGG 72 ICWORD(1) = IOR(100000B,ITLU) C C SINCE DATACAP TERMINALS CAN'T HAVE ROUTINE POLLING, SET IT OFF C CALL EM(1,ITLU,ILLU,IARAY,101000B) CALL XLUEX(3,ICWORD,ICW) C C TXTD1 - TRML LU MMAB INITIALIZED, ASSIGNED LINE NO. L C CALL ILINA(ITLU,LINE,ITID,IE11) KGID = IOR(IAND(ITID,057400B),40B) ID = IOR(KGID,175B) CALL IMSG4(ILLU,ITLU,LINE,ITID,8,IARAY,11) C C VERIFY TERMINAL ID ON THIS LINE AND GROUP C 74 CALL LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID,0,IXLU,IARAY) C 900 CONTINUE C C END MULTIPOINT TERMINAL INITIALIZATION C RETURN END C END$ CFTN4,L SUBROUTINE IXGID(ILU,IGID,KGID,IARAY, +INUM),91711-1X032 REV 1926 790906 C 79.10.26 C C THIS SUBROUTINE GETS GROUP AND DEVICE CHARACTERS FROM C THE INTERACTIVE LU = ILU. IGID IS RETURNED WITH A C SPACE-SPACE ASCII CODE IF AN OUT OF BOUNDS ENTRY WAS C MADE, OR THE ASCII CHARACTER IN THE UPPER BYTE FOR GROUP C CHARACTER, ASCII CHARACTER IN THE LOWER BYTE FOR THE C DEVICE CHARACTER. KGID IS RETURNED FOR WITH THE GROUP C CHARACTER IN THE UPPER BYTE AND A SPACE CARACTER IN THE C LOWER BYTE. C DIMENSION IARAY(3) C IFz(INUM.EQ.0) GO TO 100 IF(INUM.EQ.1) GO TO 200 C C C GROUP ID CHARACTER C PARAMETER KGID RETURNS THE GROUP CHARACTER IN THE UPPER BYTE, C SPACE CHARACTER IN THE LOWER BYTE. IGID RETURNS WHATEVER THE C OPERATOR ENTRY IN THE UPPER BYTE. C 100 WRITE(ILU,110)IARAY 110 FORMAT(/2X3A2"- ENTER GROUP ID CHARACTER :_") READ(ILU,111)IGID 111 FORMAT(A1) IF(IGID.EQ.020040B) GO TO 900 IF(IGID.LT.040000B) GO TO 100 IF(IGID.GT.055040B) GO TO 100 C KGID = IOR(IAND(IGID,057400B),40B) GO TO 900 C C C DEVICE ID CHARACTER C PARAMETER KGID IS NOT USED C PARAMETER IGID IS USED TO PASS THE DEVICE CHARACTER C 200 WRITE(ILU,210)IARAY 210 FORMAT(2X3A2"- ENTER DEVICE ID CHARACTER :_") READ(ILU,211)IDID 211 FORMAT(R1) IF(IDID.LT.000100B) GO TO 230 IF(IDID.EQ.000040B) GO TO 230 IF(IDID.GT.000132B) GO TO 230 C 220 IGID = IDID GO TO 900 C 230 IGID = 020040B 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE DNMPT(ILU,ILLU,IGGG, +IARAY),91711-1X032 REV 1926 790906 C 20.06.79 C THIS SUBROUTINE REMOVES A MULTIPOINT TERMINAL. C TERMINALS ARE REMOVED WHEN PRESENTLY INITIALIZED. IF A TERMINAL IS C DORMANT A WARNING MESSAGE IS OUTPUT AND NO ATTEMPT TO REMOVE C THE TERMINAL IS MADE. C C ILU = CONSOLE LU C ILLU = LIST LU C IGGG = -1 DIAGNOSTIC C > 0 VERIFY, ICWORD FOR TERMINAL REMOVAL C ILLU = LIST LU C C C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINE SHOW MULTIPOINT LINE ASSIGNMENT TABLE. C C C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),REG,IA),(IREG(2),IB) DATA ICWORD/0,2100B/ DATA ICCC/6/ IF(IGGG.EQ.-1) 5,61 5 CALL IMSG8(ILLU,IARAY,0,11) C C ENTER THE LINE CONTROL INFORMATION. IȑF NO MORE LINES, ENTER C 0 TO STOP. 15 CALL IMSG7(ILU,ITLU,IARAY,3,11) IF(ITLU.EQ.0) GO TO 9999 ICWORD(1) = IOR(100000B,ITLU) C C CHECK LU FOR MULTIPOINT LINE ASSIGNMENT C SHOW NO MESSAGE FOR IERCD = 6 CALL LUCHK(ILLU,ITLU,IERCD,IARAY,ICCC) IF(IERCD.EQ.6) GO TO 60 GO TO 15 C 61 ITLU = IGGG ICWORD(1) = IOR(100000B,ITLU) 60 CALL ILINA(ITLU,LINE,IE16,IE11) CALL IMSG3(ILLU,LINE,ITLU,IE16,IARAY,1,11) C REMOVE THE TERMINAL ICW = 0 REG = XLUEX(3,ICWORD,ICW) C 62 CALL IMSG4(ILLU,ITLU,LINE,IE16,6,IARAY,11) C C END MULTIPOINT TERMINAL REMOVAL 9999 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG2(ILLU,IPAR1,IPAR2,INUM,IARAY, +IAAA),91711-1X032 REV 1926 790906 C 24.07.79 C MESSAGES ASSOCIATED WITH IWRU C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMESS0(11),IMESS1(11),IMESS2(14),IMESS3(1),IMESS4(4), +IMESS5(13),IMESS6(13),IMESS7(14),ICWORD(2),IREG(2),IMSG(40), +IMESS8(13),IARAY(3),IPB1(1) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ DATA IMESS0/2H- ,2HVE,2HRI,2HFY,2H G,2HID,2H ,2H :, +2H P,2HAS,2HS / DATA IMESS1/2H- ,2HVE,2HRI,2HFY,2H G,2HID,2H ,2H :, +2H F,2HAI,2HL / DATA IMESS2/2H- ,2H ,2H R,2HES,2HPO, +2HNS,2HE(,2HS),2H F,2HRO,2HM ,2HGR,2HOU,2HP / DATA IMESS3/0/ DATA IMESS4/2HOF,2HF ,2HLI,2HNE/ DATA IMESS5/2HID,2H A,2HPP,2HEA,2HRS,2H ,2H ,2HTI,2HME, +2HS ,2HIN,2H E,2HQT/ DATA IMESS6/2HGR,2HOU,2HP ,0,2H F,2HAI,2HLS,2H E,2HQT,2H V,2HER, +2HIF,2HY / DATA IMESS7/2HLU,2H ,0,2H I,2HD:,0,t2H N,2HOT,2H I,2HN ,2HWR, +2HU ,2HLI,2HST/ DATA IMESS8/2HEQ,2HT ,2HFA,2HIL,2HS ,2HGR,2HOU,2HP ,0,2H V, +2HER,2HIF,2HY / CALL SFILL(IMSG,1,80,0040B) IPB1 = KCVT(IPAR1) CALL SGET(IPB1,1,JPB10) CALL SGET(IPB1,2,JPB11) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 - VERIFY GID a : PASS 20 DO 30 J=1,11 30 IMSG(J+4) = IMESS0(J) CALL SHFT(IPAR2) IMSG(11) = IOR(020000B,IPAR2) IBUFL = 15 GO TO 40 C C TXTD1 - VERIFY GID a : FAIL 21 DO 31 J = 1,11 31 IMSG(J+4) = IMESS1(J) CALL SHFT(IPAR2) IMSG(11) = IOR(020000B,IPAR2) IBUFL = 16 GO TO 40 C C TXTD1 - xx RESPONSE(S) FROM GROUP a 22 DO 32 J = 1,14 32 IMSG(J+4) = IMESS2(J) CALL SPUT(IMSG,11,JPB10) CALL SPUT(IMSG,12,JPB11) IMSG(19) = IPAR2 IBUFL = 20 GO TO 40 C C ab 23 IMSG(19) = IPAR2 IBUFL = 20 GO TO 43 C C ab OFF LINE 24 DO 34 J = 1,4 34 IMSG(J+18) = IMESS4(J) IMSG(14) = IPAR2 IBUFL = 22 GO TO 43 C 25 GO TO 900 C C GROUP a FAILS EQT VERIFY 26 DO 36 J = 1,13 36 IMSG(J+20) = IMESS6(J) IMSG(24) = IPAR2 IBUFL = 34 GO TO 43 C C LU mm ID:ab NOT IN WRU LIST 27 DO 37 J = 1,14 37 IMSG(J+20) = IMESS7(J) IMSG(23) = ITLU IMSG(26) = IPAR2 IBUFL = 34 GO TO 43 C C EQT FAILS GROUP a VERIFY 28 DO 38 J =0 1,13 38 IMSG(J+20) = IMESS8(J) IMSG(29) = IPAR2 IBUFL = 33 GO TO 43 C C ab OFF LINE 29 DO 39 J = 1,4 39 IMSG(J+25) = IMESS4(J) IMSG(21) = IPAR2 IBUFL = 29 GO TO 43 C 40 DO 41 J = 1,3 41 IMSG(J+1) = IARAY(J) 43 ICWORD(1) = IOR(100000B,ILLU) CALL REIO(2,ICWORD,IMSG,IBUFL) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG3(ILLU,IPAR1,IPAR2,IPAR3,IARAY,INUM, +IAAA),91711-1X032 REV 1926 790906 C 06.11.79 C THIS SUBROUTINE OUTPUTS A MESSAGE ASSOCIATED WITH CFTML, C DNMPT, UPMPT, VMPLN, VMPTL C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR3 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMS0(1), IMS1(11), IMS2(2), +IMS4(11),IMS5(11),ICWORD(2), IREG(2), IMSG(12),IARAY(3), +IMS6(2),IEQ(1) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA IMS0/0/ DATA IMS1/2H*L,2HN ,0,2H T,2HL ,0,0,2H ,2HOF,2HFL,2HN*/ DATA IMS2/2HDN,2H, / DATA IMS4/2H*L,2HN ,0,2H T,2HL ,0,0,2H V,2HER,2HIF,2HY*/ DATA IMS5/2H*L,2HN ,0,2H T,2HL ,0,0,2H ,2H O,2HNL,2HN*/ DATA IMS6/2HUP,2H, / DATA ICWORD/0,0400B/ DATA IBBB/100000B/ C C INITIALIZE BUFFER IMSG C CALL SFILL(IMSG,1,24,040B) C IF(IAAA.EQ.11) 7,5 C 5 IF(IAAA-10) 6,900 C 6 IF(INUM.EQ.IAAA) GO TO 900 C 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 900 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 * LN E TL ABNN NOT VERIFIED C 20 WRITE(ILLU,30)IPAR1,IPAR2,IPAR3 30 FORMAT(2X"TXTD1 * LINE NO.",I2X"TL ",I2,A2X"NOT VERIFIED") GO TO 900 C C *LN e TL mm OFFLN* 21 DO 31 J = 1,11 31 IMSG(J) = IMS1(J) IBUFL = 11 GO TO 40 C C DOWN THE EQT C FILL IN THE "DN, " THEN GO TO 50 TO PUT IN THE EQT NUMBER C IPAR1 IS THE INTEGER EQT NUMBER, IPAR2 IS THE COMPLETION CODE C 22 DO 32 J = 1,2 32 IMSG(J) = IMS2(J) GO TO 50 C C C *LN e TL mm VERIFY* 24 DO 34 J = 1,11 34 IMSG(J) = IMS4(J) IBUFL = 11 GO TO 40 C C *LN e TL mm ONLN* 25 DO 35 J = 1,11 35 IMSG(J) = IMS5(J) IBUFL = 11 GO TO 40 C C TXTD1 * ab APPEARS OFF LINE nnn TIMES 26 WRITE(ILLU,36)IARAY,IPAR3,IPAR1 36 FORMAT(/2X3A2"* ",A2" APPEARS OFF LINE",I3X"TIMES") GO TO 900 C C TXTD1 * ab NOT VERIFIED 27 WRITE(ILLU,37)IARAY,IPAR3 37 FORMAT(2X3A2"* ",A2X" NOT VERIFIED") GO TO 900 C C TXTD1 * ab APPEARS nnn TIMES IN EQT 28 WRITE(ILLU,38)IARAY,IPAR3,IPAR1 38 FORMAT(2X3A2"* ",A2X" APPEARS",I3X"TIMES IN EQT") GO TO 900 C C UP THE EQT C IPAR1 IS THE INTEGER EQT NUMBER, IPAR2 IS THE COMPLETION CODE. C 29 DO 39 J = 1,2 39 IMSG(J) = IMS6(J) C C C ENTER HERE FROM DOWN AN EQT C 50 IEQ = KCVT(IPAR1) CALL SGET(IEQ,1,JEQ1) CALL SGET(IEQ,2,JEQ2) C CALL SPUT(IMSG,4,JEQ1) CALL SPUT(IMSG,5,JEQ2) C REG = MESSS(IMSG,12) C C FOR ANY MESSAGE RETURNED FROM THE SYSTEM, SET IPAR2 = IA TO C LET THE CALLER KNOW THE ATTEMPT TO UP OR DOWN THE EQT HAS FAILED. C IPAR2 = IA GO TO 900 C 40 CALL EM(1,IPAR2,ILLU,IARAY,IBBB) CALL SPUT(IMSG,5,KCVT(IPAR1)) IMSG(6) = KCVT(IPAR2) IMSG(7) = IPAR3 ICWORD(1) = IOR(100000B,IPAR2) CALL XLUEX(2,ICWORD,IMSG,IBUFL) CALL EM(1,IPAR2,ILLU,IARAY,1401B) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG4(ILLU,IPAR1,IPAR2,IPAR3,INUM,IARAY, +IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C MESSAGES ASSOCIATED WITH IWRU C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR3 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMESS0(7),IMESS1(14),IMESS2(14),IMESS3(13),IMESS4(16), +IMESS5(19),IMESS6(17),IMESS7(14),ICWORD(2),IREG(2),IMSG(28), +IMESS8(23),IMESS9(19),IARAY(3),IPB1(1),IPB2(1) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ DATA IMESS0/2H- ,2HVE,2HRI,2HFY,2H L,2HIN,2HE / DATA IMESS1/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO, +2HIN,2HT ,2HLI,2HNE,2H L,2HU / DATA IMESS2/2H- ,2HVE,2HRI,2HFY,2H O,2HFF,2H L,2HIN, +2HE ,2HTE,2HRM,2HIN,2HAL,2HS / DATA IMESS3/2H- ,2HVE,2HRI,2HFY,2H A,2HCT,2HIV,2HE , +2HTE,2HRM,2HIN,2HAL,2HS / DATA IMESS4/2H- ,2HNO,2H O,2HFF,2H L,2HIN,2HE ,2HTE,2HRM, +2HIN,2HAL,2HS ,2HPR,2HES,2HEN,2HT / DATA IMESS5/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO,2HIN, +2HT ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HPA,2HSS/ DATA IMESS6/2H- ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HLI, +2HNE,2H N,2HO.,2H ,2H R,2HEM,2HOV,2HED/ DATA IMESS7/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO, +2HIN,2HT ,2HTR,2HML,2H L,2HU / DATA IMESS8/2H- ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HIN, +2HIT,2HIA,2HLI,2HZE,2HD.,2H A,2HSS,2HIG,2HNE,2HD ,2HLI,2HNE, +2H N,2HO./ DATA IMESS9/2H- ,2HVE,2HRI,2HFY,2H M,2HUL,2HTI,2HPO, +2HIN,2HT ,2HTR,2HML,2H L,2HU ,2H ,2H ,2H ,2HFA,2HIL/ C ICRLF = 1 CALL SFILL(IMSG,1,56,0040B) IPB1 = KCVT(IPAR1) IPB2 = KCVT(IPAR2) CALL SGET(IPB1,1,JPB10) CALL SGET(IPB1,2,JPB11) CALL SGET(IPB2,1,JPB20) CALL SGET(IPB2,2,JPB21) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA)1 GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 - VERIFY LINE 20 DO 30 J=1,7 30 IMSG(J+4) = IMESS0(J) IBUFL = 11 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT LINE LU mm 21 DO 31 J = 1,14 31 IMSG(J+4) = IMESS1(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IBUFL = 19 C C TXTD1 - VERIFY OFF LINE TERMINALS GO TO 40 22 DO 32 J = 1,14 32 IMSG(J+4) = IMESS2(J) IBUFL = 18 ICRLF = 2 GO TO 40 C C TXTD1 - VERIFY ACTIVE TERMINALS 23 DO 33 J = 1,13 33 IMSG(J+4) = IMESS3(J) ICRLF = 2 IBUFL = 17 GO TO 40 C C TXTD1 - NO OFF LINE TERMINALS PRESENT 24 DO 34 J = 1,16 34 IMSG(J+4) = IMESS4(J) IBUFL = 20 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU mm PASS 25 DO 35 J = 1,19 35 IMSG(J+4) = IMESS5(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IMSG(20) = IPAR3 IBUFL = 23 ICRLF = 3 GO TO 40 C C TXTD1 - TRML LU mm LINE NO. e REMOVED 26 DO 36 J = 1,17 36 IMSG(J+4) = IMESS6(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) IMSG(11) = IPAR3 CALL SPUT(IMSG,34,JPB21) IBUFL = 21 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU mm 27 DO 37 J = 1,14 37 IMSG(J+4) = IMESS7(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IMSG(20) = IPAR3 IBUFL = 21 GO TO 40 C C TXTD1 - TRML LU mm INITIALIZED, ASSIGNED LINE NO. e 28 DO 38 J = 1,23 38 IMSG(J+4) = IMESS8(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) IMSG(11) = IPAR3 CALL SPUT(IMSG,56,JPB21) IBUFL = 28 GO TO 40 C C TXTD1 - VERIFY MULTIPOINT TRML LU mm FAIL 29 DO 39 J = 1,19 39 IMSG(J+4) = IMESS9(J) CALL SPUT(IMSG,37,JPB10) CALL SPUT(IMSG,38,JPB11) IMSG(20) = IPAR3 IBUFL = 23 ICRLF = 3 C 40 DO 41 J = 1,3 41 IMSG(J+1) = IARAY(J) 43 ICWORD(1) = IOR(100000B,ILLU) IF(INUM.EQ.5) GO TO 42 IF(INUM.EQ.9) GO TO 42 DO 44 J = 1,ICRLF 44 WRITE(ILLU,46) 42 CALL REIO(2,ICWORD,IMSG,IBUFL) IF(ICRLF.EQ.1) GO TO 900 DO 45 J = 1,ICRLF 45 WRITE(ILLU,46) 46 FORMAT(/) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG6(ILLU,IPAR1,IPAR2,IPAR3,IARAY,INUM, +IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C C C ILLU = LIST LU C IPAR1 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR2 = INTEGER (I2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C IPAR3 = ASCII (A2 FORMAT) PARAMETER TO SHOW IN A MESSAGE C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IMES0(14),IMES1(22),IMES2(16),IMES3(3),IMES4(11), +IMES5(5),ICWORD(2),IREG(2),IMSG(28), +IPB1(1),IPB2(1),IPB3(1),IARAY(3),IMES6(13) EQUIVALENCE (IREG(1),REG,IA), (IREG(2),IB) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ DATA IMES0/2H- ,2HNO,2H S,2HTA,2HTU,2HS ,2HRE,2HSP,2HON, +2HSE,2H F,2HRO,2HM ,2HLU/ DATA IMES1/2H- ,2HLI,2HNE,2H L,2HU ,0,2H I,2HNI, +2HTI,2HAL,2HIZ,2HED,2H. ,2H A,2HSS,2HIG,2HNE,2HD ,2HLI,2HNE, +2H N,2HO./ DATA IMES2/2H- ,2HLI,2HNE,2H L,2HU ,0,2H L,2HIN, +2HE ,2HNO,2H. ,2H ,2HRE,2HMO,2HVE,2HD / DATA IMES3/2H- ,2HDO,2HNE/ DATA IMES4/2H- ,2HNO,2H M,2HUL,2HTI,2HPO,2HIN,2HT ,2HSY, +2HST,2HEM/ DATA IMES5/2H- ,2HRU,2HNN,2HIN,2HG / DATA IMES6/2H* ,2HCO,2HRR,2HEC,2HTI,2HVE,2H A,2HCT,2HIO,2HN , +2HNE,2HED,2HED/ ICRLF = -1 CALL SFILL(IMSG,1,56,0040B) IPB1 = KCVT(IPAR1) IPB2 = KCVT(IPAR2) C WRITE(ILLU,110) IPAR1,IPAR2,IPAR3 110 FORMAT(2X"IMSG6 :",I2X":",I2X":",A2) CALL SGET(IPB1,1,JPB10) CALL SGET(IPB1,2,JPB11) CALL SGET(IPB2,1,JPB20) CALL SGET(IPB2,2,JPB21) C WRITE(ILLU,111) JPB10,JPB11,JPB20,JPB21 111 FORMAT(2X"IMSG6 :"A2X":",A2X":",A2X":",A2) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 DO 8 J = 1,3 8 IMSG(J+1) = IARAY(J) IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C C TXTD1 - NO STATUS RESPONSE FROM LU mm 20 DO 30 J = 1,14 30 IMSG(J+4) = IMES0(J) CALL SPUT(IMSG,38,JPB10) CALL SPUT(IMSG,39,JPB11) IBUFL = 20 GO TO 40 C C TXTD1 - LINE LU mm INITIALIZED. ASSIGNED LINE NO. e 21 DO 31 J = 1,22 31 IMSG(J+4) = IMES1(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) CALL SPUT(IMSG,54,JPB21) IBUFL = 27 GO TO 40 C C TXTD1 - LINE LU mm LINE NO. e REMOVED 22 DO 32 J = 1,16 32 IMSG(J+4) = IMES2(J) CALL SPUT(IMSG,19,JPB10) CALL SPUT(IMSG,20,JPB11) CALL SPUT(IMSG,31,JPB21) IBUFL = 20 GO TO 40 C C TXTD1 - DONE 23 DO 33 J = 1,3 33 IMSG(J+4) = IMES3(J) IBUFL = 7 ICRLF = 1 GO TO 40 C C TXTD1 - NO MULTIPOINT SYSTEM 24 DO 34 J = 1,11 34 IMSG(J+4) = IMES4(J) IBUFL = 16 GO TO 40 C C TXTD1 - RUNNING 25 DO 35 J = 1,5 35 IMSG(J+4) = IMES5(J) ICRLF = 1 IBUFL = 10 GO TO 40 C C TXTD1 - REMOVE A LINE 26 WRITE(ILLU,36)IARAY 36 FORMAT(/2X3A2"- REMOVE A LINE") GO TO 900 C C TXTD1 - VERIFY A TERMINAL 27 WRITE(ILLU,37)IARAY 37 }FORMAT(/2X3A2"- VERIFY TERMINAL") GO TO 900 C C TXTD1 - INITIALIZE A LINE 28 WRITE(ILLU,38)IARAY 38 FORMAT(/2X3A2"- INITIALIZE A LINE") GO TO 900 C C TXTD1 * CORRECTIVE ACTION NEEDED C 29 DO 39 J = 1,13 39 IMSG(J+4) = IMES6(J) IBUFL = 18 C 40 ICWORD(1) = IOR(100000B,ILLU) IF(ICRFL) 43,41 41 DO 42 J = 1,ICRLF 42 WRITE(ILLU,44) 44 FORMAT(/) 43 CALL REIO(2,ICWORD,IMSG,IBUFL) C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG7(ILU, +IPAR1,IARAY,INUM,IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C C C ILU = LIST LU C IPAR1 = PARAMETER RETURNED TO CALLER C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION ICWORD(2),IARAY(3) DATA ICWORD/0,0400B/ DATA IBBB/100000B/ IPAR1 = 0 IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 24 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 26 IF(INUM.EQ.7) GO TO 27 IF(INUM.EQ.8) GO TO 28 IF(INUM.EQ.9) GO TO 29 C 20 WRITE(ILU,111)IARAY GO TO 40 21 WRITE(ILU,112)IARAY GO TO 40 22 WRITE(ILU,113)IARAY GO TO 40 23 WRITE(ILU,114)IARAY GO TO 40 24 WRITE(ILU,115)IARAY GO TO 40 25 WRITE(ILU,116)IARAY GO TO 40 26 WRITE(ILU,117)IARAY GO TO 40 27 WRITE(ILU,118)IARAY GO TO 40 28 WRITE(ILU,119)IARAY GO TO 40 29 WRITE(ILU,120)IARAY GO TO 40 C C 40 READ(ILU,*)IPAR1 C 111 FORMAT(/2X3A2"- ENTER LINE LU (SYSTEM) (0 TO STOP):_") 112 FORMAT(/2X3A2"- ACTIVE LINE LU (SYSTEM) (0 TO STOP):_") 113 FORMAT(/2X3A2"- ENTER TRML LU (SYSTEM) (0 TO STOP):_") 114 FORMAT(/2X3A2"- ACTIVE TRML LU (SYSTEM) (0 TO STOP):_") 115 FORMAT(2X3A2"- ENTER TRAMSMIT NAK COUNT (0-15):_") 116 FORMAT(2X3A2"- ENTER RECEIVE NAK COUNT (0-15):_") 117 FORMAT(2X3A2"- ENTER WACK COUNT (0-31):_") 118 FORMAT(2X3A2"- ENTER TRML BLOCK FACTOR (0-4):_") 119 FORMAT(/2X3A2"- ENTER TIMEOUT VALUE (0-30):_") 120 FORMAT(/2X3A2"- ENTER LINE NUMBER (0-7):_") C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE IMSG8(ILLU,IARAY,INUM, +IAAA),91711-1X032 REV 1926 790906 C 26.07.79 C C C ILLU = LIST LU C INUM = MESSAGE SELECTION C IAAA = 0-9 SKIP THE SPECIFIED NUMBERED MESSAGE C = 10 SHOW NO MESSAGE C = 11 SHOW ANY MESSAGE C C C DIMENSION IARAY(3) IF(IAAA.EQ.11) 7,5 5 IF(IAAA-10) 6,900 6 IF(INUM.EQ.IAAA) GO TO 900 7 IF(INUM.EQ.0) GO TO 20 IF(INUM.EQ.1) GO TO 21 IF(INUM.EQ.2) GO TO 22 IF(INUM.EQ.3) GO TO 23 IF(INUM.EQ.4) GO TO 900 IF(INUM.EQ.5) GO TO 25 IF(INUM.EQ.6) GO TO 900 IF(INUM.EQ.7) GO TO 27 GO TO 900 C C 20 WRITE(ILLU,30)IARAY 30 FORMAT(/2X3A2"- REMOVE A TERMINAL") GO TO 900 C C 21 WRITE(ILLU,31)IARAY 31 FORMAT(/2X3A2"- INITIALIZE A TERMINAL") GO TO 900 C C TXTD1 - SET NAK, WAK, TERMINAL BLOCK SIZE 22 WRITE(ILLU,32)IARAY 32 FORMAT(/2X3A2"- SET NAK, WAK, TERMINAL BLOCK SIZE") GO TO 900 C C TXTD1 - SET EDIT MODE AND POLLING GLOBALS 23 WRITE(ILLU,33)IARAY 33 FORMAT(/2X3A2"- SET EDIT MODE AND POLLING GLOBALS") GO TO 900 C C TXTD1 - GROUP-LINE SELECT AND SEND A MESSAGE 25 WRITE(ILLU,35)IARAY 35 FORMAT(/2X3A2"- GROUP-LINE SELECT AND SEND A MESSAGE") GO TO 900 C C TXTD1 - CONFIGURE A TERMINAL 27 WRITE(ILLU,37)IARAY 37 FORMAT(/2X3A2"- CONFIGURE A TERMINAL") ICRLF = 1 GO TO 900 C C t900 CONTINUE RETURN END C END$ CFTN4,L SUBROUTINE LUVFY(INLU,ILLU,ITLU,IGRUP,IOFLN,ID,KGID, +KEY,IXLU,IARAY),91711-1X032 REV 1926 790906 C 03.10.79 C C THIS SUBROUTINE IS CALLED BY VMPLN, VMPTL, UPMTL TO VERIFY C TERMINAL = ITLU ON LINE LU = INLU. FIRST THE WHO ARE YOU POLL IS C MADE ON THE CURRENT GROUP = ID, THEN THE EQT IS CHECKED FOR C TERMINAL ID MATCHES AGAINST THE WRU LIST IN BUFFER IGRUP. C IBUFS RETURNED FROM ILINB CONTAINS ANY LU FOUND FOR THE GROUP. C FOR NO LU IN THE GROUP, MAKE SURE THERE WAS NO WRU RESPONSE, C IF THERE WAS, GO ON TO EXAMINE IF THIS IS AN OFF-LINE TERMINAL. C FOR LU RETURNED IN IBUFS, TRY TO MATCH EACH ID FROM THE EQT C TO ONLY ONE ID IN THE WRU, ANY EXTRA ITEMS IN WRU ARE THEN C TESTED FOR BEING OFF-LINE. C DIMENSION IGRUP(30),IBUFS(28) DIMENSION IBUFV(60),IARAY(3),IOFLN(30),IBUFX(28),IBXLU(60) C C INITIALIZE VARIABLES IERCT = 0 IXLU = 0 IBSL = 0 INAT = 0 C INITIALIZE BUFFERS CALL SFILL(IBXLU,1,120,000B) CALL SFILL(IBUFV,1,120,000B) CALL SFILL(IGRUP,1,60,000B) CALL SFILL(IOFLN,1,60,000B) IOFLN(1) = -1 CALL SFILL(IBUFS,1,56,000B) CALL SFILL(IBUFX,1,56,000B) C C IF KEY IS NEGATIVE, GO DIRECTLY TO THE GROUP POLL C IF(KEY.EQ.-1) GO TO 10 C C GET THE TERMINAL'S ID CHARACTERS THEN SHOW C TXTD1 - VERIFY MULTIPOINT TRML LU MMAB C CALL ILINA(ITLU,ILNN,ITID,IE11) CALL IMSG4(ILLU,ITLU,0,ITID,7,IARAY,11) C C GET THE TERMINALS IN THE CURRENT GROUP ID 10 CALL IGRID(INLU,ID,IGRUP) C IF IGRUP(1) = -1 THERE IS NO RESPONSE FROM TERMINALS IF(IGRUP(1)) 55,53 C C SHOW THE RESPONDING TERMINALS 53 INAT = IGRUP(1) - 1 CALL IMSG2(ILLU,INAT,KGID,2,IARAY,11) C DO 54 K = 2,IGRUP(1) 103 CALL IMSG2(ILLU,0,IGRUP(K),3,IARAY,11) 54 CONTINUE C C C WHETHER THERE IS OR THERE IS NOT A REPLY IN THE GROUP, C GET EQT LIST, THEN COMPARE ID FIELD OF EQT WITH WRU LIST. C IBSL FROM ILINB = (# OF TRML LU IN GROUP KGID) + 1 C C 55 CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) C WERE ANY LU IN CURRENT GROUP ? IF(IBUFS(2) -3) 556,56 C C VERIFY THE EQT LIST AGAINST THE WRU LIST C 56 CALL ILIND(ILLU,IGRUP,IBUFS,IBUFV,IDCT,IBXLU,IARAY,KEY) C C IS ITLU 264X TERMINAL ? C IBXLU CONTAINS THE LU IN THIS GROUP WHICH FAIL VERIFICATION C K = 4 560 IF(IBXLU(1).GT.1) 561,554 561 IF(ITLU.EQ.IBXLU(K)) 565,562 562 IF(K.EQ.IBXLU(1)) 554,563 563 K = K+3 GO TO 561 C 565 IXLU = IBXLU(K) IERCT = IERCT + 1 C C C C C IF THERE WAS NO WRU REPLY, EQT TABLE IS NOT CURRENT. HARD ERROR. C FOR ANY MISSING OR DUPLICATE ID IN EQT IBUFV(1) > 0. C 554 IF(IBUFV(1).GT.0) IERCT = IERCT + 1 C C IF THERE WAS NO WRU REPLY, EQT HAS AN ID THAT DOESN'T ANSWER. C 556 IF(INAT.EQ.0) GO TO 57 C C USING THE WRU AND EQT DATA, COMPARE AND CONTRAST TO FIND ANY C OFF-LINE TERMINALS. C CALL ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN,IBUFX,IDCT,-1) C C HOW MANY ID WERE SIMILAR IN EQT LIST ? ANS. SHOULD BE 1. C 558 IF(IDCT-2) 25,26 C C WHEN IBUFX(2) IS ZERO, THERE ARE NO DUPLICATE OFF-LINE ID C 25 IF(IBUFX(2)-1) 57,27 C C DUPLCATE ID IN EQT MESSAGE 26 IERCT = IERCT+1 C C IF THERE WERE NO PROBLEMS, SEND PASS MESSAGE C 57 IF(IERCT-1) 573,27 C C SEND FAIL MESSAGE C TXTD1 - VERIFY GID AB : FAIL C 27 CALL IMSG2(ILLU,0,KGID,1,IARAY,11) GO TO 900 C C SEND PASS MESSAGE C TXTD1 - VERIFY GID AB : PASS C 573 CALL IMSG2(ILLU,0,KGID,0,IARAY,11) C 900 CONTINUE C WRITE(ILLU,110)IXLU,KEY 110 FORMAT(2X"LUVFY IXLU:",I2X"KEY:",I2) END C END$ CFTN4,L SUBROUTINE IXGLS(ILLU,INLU,IBUFR,IBUFL,IGID, +ILNN),91711-1X032 REV 1926 790906 C 25.04.79 C THIS SUBROUTINE SENDS A GROUP/LINE SELECT AND A MESSAGE C TO THE 307״5A, 3076A, 3077A TERMINALS. CHECK THE BUFFER LENGTH C BEFORE CALLING TO ENSURE IT ISN'T ZERO OR TOO BIG. C NO CHECK IS MADE FOR GROUP ID PRESENT ON THE LINE, AND ONLY C THE LAST TWO DECIMAL DIGITS APPEAR IN THE TRANSMISSION LOG. C NOTE: IGID IS FORMED IN IOGLS BEFORE CALLINF IXGLS. C C C ILLU = LIST LU C INLU = LINE LU C IBUFR = ADDRESS OF BUFFER C IBUFL = BUFFER LENGTH C IGID = GID IN UPPER 8 BITS, ZEROS IN LOWER 8 BITS, GROUP SELECT C OR 177376B, LINE SELECT. C ILNN = INTEGER LINE NUMBER C C SOURCE TERM : C DIMENSION IREG(2),IBUFR(128),ICWORD(2),IMESSA(14),IMSG(24), +IMESS1(3),IMESS2(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,400B/ DATA IMESSA/2HME,2HSS,2HAG,2HE ,2H (,0,2H W,2HOR,2HDS,2H) , +2HSE,2HNT,2H T,2HO / DATA IMESS1/2HLI,2HNE,2H / DATA IMESS2/2HGR,2HOU,2HP / CALL SFILL(IMSG,1,48,0040B) C C PREPARE BASIC MESSAGE FORMAT C DO 3 J = 1,14 3 IMSG(J+1) = IMESSA(J) C C CONVERT IBUFL AND LINE NUMBER TO ASCII DIGITS C IMSG(7) = KCVT(IBUFL) LINE = KCVT(ILNN) C C CHECK FOR GROUP SELECT OR LINE SELECT C IF (IGID.EQ.177376B) 5,6 C C MESSAGE TO LINE : FILL IMSG WITH IMESS1 C 5 DO 7 J = 1,2 7 IMSG(J+15) = IMESS1(J) CALL SPUT(IMSG,37,LINE) GO TO 10 C C MESSAGE TO GROUP : SET ID FOR GROUP SELECT, FILL IMSG WITH IMESS2 C 6 ID = IOR(IGID,376B) DO 8 J = 1,3 8 IMSG(J+15) = IMESS2(J) IMSG(19) = IGID C C SEND THE MESSAGE C 10 CONTINUE 100 WRITE(ILLU,110)IMSG ICWORD(1) = IOR(100000B,INLU) REG = XLUEX(2,ICWORD,IBUFR,IBUFL,ID) CONTINUE IF(IBUFL) 910,910,900 C MESSAGE NOT SENT 910 WRITE(ILLU,911)IBUFL GO TO 900 C 110 FORMAT(19A2) 911 FORMAT(2X"MESSAGE NOT SENT, (",I2," WORDS IN BUFFER)") C 900 CONTINUE RETURN END C END$ CFTN4,L SUBROUjTINE IOGLS(ILU,ILLU,INLU, +IBUFL,IARAY),91711-1X032 REV 1926 790906 C 28.08.79 C THIS SUBROUTINE PREPARES A MESSAGE BUFFER AND SENDS C THE MESSAGE TO THE 3075A, 3076A, 3077A TERMINALS. C C ILU = CONSOLE LU C ILLU = LIST LU C INLU = LINE LU C C CALLS: IXGLS GROUP OR LINE SELECT AND SEND THE MESSAGE. C CALLS: ILINA GET MULTIPOINT LINE NUMBER FOR INLU. C C DIMENSION IREG(2),IBUFR(128),IMESSA(4),IMESS1(3),IMESS2(3), +ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA IMESS1/2HGR,2HOU,2HP / DATA IMESS2/2HLI,2HNE,2H / DATA IREG/0,0/ DATA ICWORD/0,2200B/ IBUFL = 128 C INITIALIZE IMESSA CALL SFILL(IMESSA,1,8,0040B) C INITIALIZE THE MESSAGE BUFFER CALL SFILL(IBUFR,1,255,0040B) C GET LINE NUMBER FROM LINE EQT CALL ILINA(INLU,ILNN,IE16,IE11) LINE = KCVT(ILNN) C GET GROUP ID 100 WRITE(ILU,110)IARAY,LINE C ENTER KEY FOR LINE SELECTION, GID CHARACTER FOR GROUP SELECTION 101 READ(ILU,111)IGID IF(IGID.EQ.020040B) GO TO 5 IF((IGID.GT.37440B).AND.(IGID.LT.55440B)) GO TO 7 GO TO 100 C C DEFAULT ENTERED, IGID SET TO LINE SELECT CODE 5 IGID = 177376B C FILL IN MESSAGE 2 DO 3 J = 1,3 3 IMESSA(J) = IMESS2(J) IMESSA(4) = KCVT(ILNN) GO TO 9 C GROUP ID ENTERED, FILL IN MESSAGE 1 7 DO 4 J = 1,3 4 IMESSA(J) = IMESS1(J) IMESSA(4) = IGID C STRIP SPACE CHARACTER IN LOWER BYTE IGID = IAND(IGID,057400B) C C GET A MESSAGE 9 CONTINUE 102 WRITE(ILU,112)IARAY,IMESSA ICW = IOR(400B,ILU) 103 REG = REIO(1,ICW,IBUFR,IBUFL) IBUFL = IB C WRITE THE DATA TO THE PRINTER. SET V BIT TO WRITE COLUMN 1. C ICW = IOR(200B,6) C04 REG = EXEC(2,ICW,IBUFR,IBUFL) C C DON'T SEND ANYTHING IF IBUFL = 0. IF(IBUFL.EQ.0) GO TO 40 C IS THE NUMBER OF WORDS IN THE MESSAGE TOO BIG FOR THE TERMINAL? IF(IBUFL.LT.90) 105,10 C SET THE TERMINAL BLOCKING FACTOR FOR THE LINE C SET FOR 512 BYTES 10 ICW = 043146B 20 ICWORD(1) = IOR(100000B,INLU) 30 REG = XLUEX(3,ICWORD,ICW) GO TO 105 C NO MESSAGE AVAILABLE, DO NOTHING AND RETURN 40 GO TO 900 C C SEND THE MESSAGE TO THE TERMINAL. 105 CALL IXGLS(ILLU,INLU,IBUFR,IBUFL,IGID,ILNN) GO TO 900 C 110 FORMAT(/2X3A2"- ENTER GROUP ID CHARACTER (DEFAULT LINE ",R1,")", +" :_") 111 FORMAT(A1) 112 FORMAT(2X3A2"- MESSAGE TO ",4A2," :_") C 210 FORMAT(2X"IOGLS CHECKPOINT 0 IBUFL = ",I6) 900 RETURN END C END$ CFTN4,L SUBROUTINE ILINA(ITLU,LINE,IE16, +IE11),91711-1X032 REV 1926 790906 C 25.04.79 C THIS SUBROUTINE GETS THE LINE NUMBER AND TERMINAL ID FOR ITLU. C THE TERMINAL MUST BE INITIALIZED BEFORE CALLING ILINA. C NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF THIS IS A C TERMINAL. USE LUCHK BEFORE CALLING ILINA. C C ITLU = LU UNDER TEST C LINE = LINE NUMBER ASSIGNED TO LU UNDER TEST C IE16 = TERMINAL ID C IE11 = LINK LIST POINTER C C C C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C C C SOURCE TERM : LINE CHARACTER IN LOWER BYTE, ZERO FILLED. C IE16 TERMINAL ID FROM EQT WORD 16. C IE11 LINK LIST POINTER EQT WORD 11. C C IEQTA = IGET(1650B) IDRT = IGET(1652B) C EQT ASSIGNMENT FOR THIS LU ITVAL =IGET(IDRT+ITLU-1) IEQTT=IAND(ITVAL,077B) C EQT DATA ITTBL = (IEQTT-1)*15+IEQTA IE11 = IGET(ITTBL+10) ITQX = IGET(ITTBL+12) IE16 = IGET(ITQX) IT17 = IGET(ITQX+1) LINE = IAND(IT17,03400B) CALL SHFT(LINE) RETURN END C END$ CFTN4,L SUBROUTINE ILINE(INLU,ILLU,INUM, +LINE,IARAY),91711-1X032 REV 1926 790906 C 08.31.79 C THIS SUBROUTINE FINDS MULTIPOINT LINE ASSIGNMENTS. C A LINE ASSIGNMENT TABLE IS OUTPUT TO ILLU. THE PARAMETER C "LINE" IS RETURNED RIGHT ADJUSTED, ZERO FILLED, READY FOR KCVT. C C INLU = LINE LU UNDER TEST C ILLU = LIST LU C INUM = COMPLETION CODE C = 0 NO MULTIPOINT DEVICES ASSIGNED C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (INUM-1) ASSIGNED TERMINALS. C LINE = LINE NUMBER ASSIGNED TO LU UNDER TEST C C C C CALLS: X13 ASSEMBLY ROUTINE REQUESTS STATUS ON SYSTEM LU C BYPASSING SWITCH TABLE. C CALLS: SHFT ASSEMBLY ROUTINE MOVES UPPER BYTE TO LOWER BYTE C FILLING ZEROS IN UPPER BYTE. C CALLS: SHF14 ASSEMBLY ROUTINE MOVES UPPER TWO BITS TO LOWER C TWO BITS OF THE WORD. BITS 15-2 ARE ZEROS. C CALLS: SHF15 ASSEMBLY ROUTINE MOVES BIT 15 TO BIT 0, C BITS 14-1 ARE ZEROS. C CALLS: LUCHK DETERMINE MULTIPOINT (SYSTEM) LU ASSIGNMENT, C RETURN A COMPLETION CODE TO THE CALLER. C CALLS: ILINA GET THE LINE NUMBER FROM EQT. C C SOURCE TERM : LINE CHARACTER IN LOWER BYTE, ZERO FILLED. C INUM COMPLETION CODE C C DIMENSION IMESS1(3),IMESS2(3),IMESS3(3), +IMESS4(2),ICWORD(2),IARAY(3),IMSG(20),IMESS5(15),IMESS6(1) DATA IMESS1/2H L,2HIN,2HE / DATA IMESS2/2H T,2HRM,2HL / DATA IMESS3/2HDO,2HWN,2H / DATA IMESS4/0/ DATA IMESS5/2HLN,2H ,2HID,2H ,2HIN,2H L,2HU ,2HFB,2HIT,2H E, +2HQT,2H A,2HV ,2HS.,2HC./ DATA IMESS6/2H*S/ DATA ICWORD/0,400B/ INUM = 0 C IEQTA = IGET(1650B) IDRT = IGET(1652B) ILUMAX= IGET(1653B) CALL SFILL(IMSG,1,40,0040B) C C GET THE LINE NUMBER OF THE LINE LU CALL ILINA(INLU,LINE,IT16,IT11) C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C ITERATE FROM LINE LU = INLU IN ASCENDING NUMERICAL~z ORDER TO LUMAX C CHECK FOR LU POINTING TO NONZERO EQT C C DO 50 I=INLU,ILUMAX IVAL = IGET(IDRT+INLU-1) C C IF THE EQT FIELD IS ZERO, GO ON TO THE NEXT LU. C IEQQ = IAND(IVAL,077B) IF(IEQQ.EQ.0) GO TO 50 C C THE LU POINTS TO AN EQT C STATUS REQUEST ON TEST LU. X13 SETS BYPASS CONDITION. C CALL X13(I,IEQT5,IEQT4,IEQST) C GET THE NONZERO SELECT CODE ASSIGNMENT ISCOD = IAND(IEQT4,077B) C CHECK FOR TYPE 7 DEVICE AT THIS LU IDVC7 = IAND(IEQT5,037400B) CALL SHFT(IDVC7) IF(IDVC7.NE.7) GO TO 50 C DETERMINE IF LU IS DOWN, AND AVAILABILITY OF EQT IAV = IEQT5 CALL SHF14(IAV) IFBIT = IEQST CALL SHF15(IFBIT) C GET TERMINAL LINE NUMBER, ID, AND LINK POINTER CALL ILINA(I,ILNN,IE16,IE11) C LBIT = IE16 CALL SHF15(LBIT) C C IF LINE LU AND TERMINAL LU DON'T HAVE THE SAME NUMBER, GO TO 50 C IF(ILNN.NE.LINE) GO TO 50 INUM = INUM+1 C C C C C SHOW MESSSAGE BANNER THE FIRST ITERATION C IF(INUM.NE.1) GO TO 20 DO 5 J = 1,15 5 IMSG(J+1) = IMESS5(J) WRITE(ILLU,6) 6 FORMAT(/) ICWORD(1) = IOR(100000B,ILLU) CALL REIO(2,ICWORD,IMSG,16) CALL SFILL(IMSG,1,40,0040B) GO TO 20 C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C CHECK LINKED LIST POINTER AND GET AN ASCII LINE NUMBER C 10 IMSG(6) = 020061B IF(IE11.EQ.0) IMSG(6) = 020060B IMLN = KCVT(ILNN) CALL SGET(IMLN,2,IMLN11) CALL SPUT(IMSG,3,IMLN11) GO TO 40 C C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C CHECK THIS LU, SHOW NO MESSAGES C 20 ICCC = 10 CALL LUCHK(ILLU,I,IERCD,IARAY,ICCC) IF(IERCD.EQ.0) GO TO 21 IF(IERCD.EQ.1) GO TO 30 IF(IERCD.EQ.3) GO TO 30 IF(IERCD.EQ.4) GO TO 23 IF(IERCD.EQ.6) GO TO 25 IF(IERCD.EQ.7) GO TO 23 IF(IERCD.EQ.9) GO TO 23 IF(IERCD.EQ.-1)GO TO 26 IF(IERCD.EQ.-2)GO TO 26 GO TO 10 C C FILL IMESSA AND IMESSB C DORMANT TERMINAL 21 DO 22 J=1,3 IMSG(J+2)=IMESS2(J) 22 CONTINUE GO TO 10 C DORMANT LINE 23 DO 24 J=1,3 IMSG(J+2)=IMESS1(J) 24 CONTINUE GO TO 10 C INITIALIZED TERMINAL 25 IMSG(4)=IE16 GO TO 10 C NONZERO SUBCHANNEL 26 CALL SGET(IMESS6,1,ISBCH) CALL SPUT(IMSG,6,ISBCH) CALL SGET(IMESS6,2,ISBCH) CALL SPUT(IMSG,7,ISBCH) ISUB1 = (IAND(IEQST,30B))/10B ISUB2 = IAND(IEQST,7B) ISUB1 = KCVT(ISUB1) ISUB2 = KCVT(ISUB2) CALL SPUT(IMSG,8,ISUB1) CALL SPUT(IMSG,9,ISUB2) C C IF THIS SUBCHANNEL IS ALSO DOWN, GO TO 32 C IF(IERCD.EQ.-2) 261,10 C C C C EQT DOWN OR STATE IS NOT CLEAR 30 IF(LBIT.EQ.0) GO TO 32 C C LINE IS DOWN C DO 31 J=1,3 IMSG(J+2)=IMESS1(J) IMSG(J+16) = IMESS3(J) 31 CONTINUE GO TO 10 C C TERMINAL IS DOWN C 32 IF(IE16.EQ.0) GO TO 34 C C ACTIVE TERMINAL C IMSG(4) = IE16 C C ENTER HERE FROM NONZERO SUBCHANNEL FOR IERCD = -2 C 261 DO 33 J=1,3 IMSG(J+16) = IMESS3(J) 33 CONTINUE GO TO 10 C C DORMANT TERMINAL C 34 DO 35 J=1,3 IMSG(J+2)=IMESS2(J) IMSG(J+16) = IMESS3(J) 35 CONTINUE GO TO 10 C 40 CONTINUE IMLU = KCVT(I) CALL SGET(IMLU,1,ILU10) CALL SGET(IMLU,2,ILU11) CALL SPUT(IMSG,14,ILU10) CALL SPUT(IMSG,15,ILU11) IMSG(9) = KCVT(IFBIT) IMSG(12) = KCVT(IEQQ) IMSG(13) = KCVT(IAV) IMSG(16) = 041040B LCOD1 = IAND(ISCOD,000007B) LCOD1 = KCVT(LCOD1) LCOD2 = (IAND(ISCOD,000070B))/10B LCOD2 = KCVT(LCOD2) CALL SPUT(IMSG,29,LCOD2) CALL SPUT(IMSG,30,LCOD1) CALL REIO(2,ICWORD,IMSG,20) C CALL SFILL(IMSG,1,40,0040B) C 50 IDRT=IDRT+1 C I C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C WRITE(ILLU,6) RETURN END C END$ CFTN4,L SUBROUTINE ILINB(ILLU,INLU,IGID,IBUFS,INAT, +ITMCT),91711-1X032 REV 1926 790906 C 28.06.79 C THIS SUBROUTINE GETS A LIST OF LU NUMBERS OF TERMINALS IN THE C GROUP BY SEARCHING THE EQT. A GROUP ID CHARACTER IS PASSED C TO THIS ROUTINE. C NOTE: NO CHECK IS MADE HERE FOR DRIVER TYPE 7 OR IF INLU IS C A LINE LU. USE LUCHK BEFORE CALLING ILINB. C C ILLU = LIST LU C INLU = LINE LU C IGID = GROUP ID C IBUFS = IBUFS(1) IS LINE LU NUMBER, IBUFS(2) IS IBUFL, THEN C GROUP IGID TERMINAL NUMBERS. C THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT C IBUFL = NUMBER OF TERMINAL LU IN IBUFS, ONE WORD PER TERMINAL, PLUS C ONE (FOR THE LINE LU). C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. C C CALLS: ILINA GET THE LINE NUMBER, LIST POINTER, AND TERMINAL C GROUP ID CHARACTER. C CALLS: LDARG ASSEMBLY ROUTINE TO CALL TRMLU C C SOURCE TERM : IBUFS LIST OF TERMINAL LU ON ASSIGNED LINE C C DIMENSION IBUFS(28) KK = 2 ITMCT = 0 DO 1 J=1,28 1 IBUFS(J) = 0 IBUFS(2) = -1 C C GET THE LINE WORD 11 AND WORD 16 CALL ILINA(INLU,ILNN,IE16,IE11) C C DON'T GO ON IF LIST LINK POINTER IS ZERO. THERE IS NO LINE IF(IE11.EQ.0) 901,3 C DON'T GO ON IF THE LINE IS DORMANT 3 IF(IE16.EQ.100000B) 901,4 C C PUT THE LINE LU NUMBER INTO THE FIRST WORD OF IBUFS. C STARTING WITH THE LINE EQT, IT11 POINTS TO WORD ONE OF THE C NEXT EQT IN THE LIST. GET THAT LU NUMBER, THEN USE IT TO GET THE C EQT WORD 11, 16, AND 17 DATA CONTAINING LIST POINTER, TERMINAL ID, C AND LINE NUMBER. CHECK THE LINE NUMBER AN9D GROUP ID OF THE TERMINAL C EQT TO BE SURE IT'S THE CORRECT LINE AND GROUP. IF IT IS, PUT IT C INTO IBUFS. IF IT DOESN'T CHECK OUT, DON'T PUT ANYTHING INTO IBUFS C FOR THIS EQT. USING THE TERMINAL EQT WORD 11, CHECK IF IT POINTS C TO THE LINE EQT. IF IT DOES, THE GROUP SEARCH IS COMPLETE. C FOR EACH TERMINAL FOUND SATISFYING LINE AND GROUP ID CHECKS, ENTER C THE LU NUMBER INTO THE NEXT WORD OF IBUFS AND INCREMENT KK. C EVENTUALLY THE UPDATED LIST POINTER WILL POINT TO THE LINE LU, THEN C A NORMAL EXIT IS TAKEN. C 4 IBUFS(1) = INLU IT11 = IE11 IDRT = IGET(1652B) C C DOES THIS LINE LU POINT TO A TERMINAL ? 5 IF(IE11.NE.(IE11-10)) 51,900 C YES, SO ADJUST IT4 TO POINT TO WORD 4 AND GET THE SYSTEM LU 51 IT4 = IT11+3 C FIRST PUT IT4 INTO THE B-REGISTER CALL LDARG(IT4,ITT) C GET SYSTEM LU OF THIS EQT. IT4 AND A-REGISTER ARE INTEGER FORMAT C ITT AND B-REGISTER ARE ASCII FORMAT. C VALIDATE LU AS BEING BETTER THAN THE BIT BUCKET IF(IT4.NE.0) 52,900 C MAKE SURE WE'RE NOT DEALING WITH THE LINE LU AGAIN 52 IF(IT4.NE.INLU) 53,900 C GET THE LINE ASSIGNMENT AND GROUP ID OF THIS EQT 53 CALL ILINA(IT4,ILNN,IT16,IT11) C TERMINAL DATA HERE. COMPARE TERMINAL GROUP ID WITH SEARCH VALUE IDG = IOR(IAND(IT16,57400B),40B) C ARE THE GROUP ID THE SAME ? IF(IGID.EQ.IDG) 54,55 C GROUP ID ARE THE SAME. PUT TERMINAL LU INTO IBUFS 54 KK = KK+1 IBUFS(KK) = IT4 C ASSIGN ITID = TERMINAL ID THE FIRST TIME GROUP ID IS FOUND IF(ITMCT.EQ.0) 541,542 541 ITID = IT16 542 ITMCT = ITMCT+1 C SEARCH NO MORE IF THE LINK POINTER IS THE LINE EQT. 55 IF(IT11.NE.IE11) 51,900 C KK = THE NUMBER OF TERMINALS WITH THE SAME GROUP ID C ITMCT = THE NUMBER OF TERMINALS WITH THE SAME GROUP ID AND C DEVICE ID. IF THERE ARE ANY OF THESE, SEND A MESSAGE. C 900 IBUFS(2) = KK 901 RETURN END C END$ CFTN4,L SUBROUTINE ILINC(ILLU,INLU,ITID,IBUFS, +IDCT),91711-1X032 REV 1926 790906 C 28.06.79 C THIS SUBROUTINE USES THE WRU TERMINAL ID CHARACTER TO VERIFY THE C ACTIVE EQT ID LIST FOUND BY ILINB. C THE LINE LU IS USED TO LOCATE THE LINKED LIST. EACH TERMINAL IN C THE LINKED LIST IS TESTED FOR GROUP MEMBERSHIP. IDCT SHOWS HOW C MANY TERMINALS ARE IN THE GROUP UNDER TEST. C C ILLU = LIST LU C INLU = LINE LU USED IN ILINB. C ITID = TERMINAL ID: GROUP ID-DEVICE ID C IBUFS = IBUFS(1) IS LINE LU NUMBER, IBUFS(2) IS IBUFL. THE C TERMINAL LU NUMBERS IN GROUP ITID FOLLOW. C THE NUMBERS ARE SYSTEM LU NUMBERS IN INTEGER FORMAT C IBUFL = NUMBER OF TERMINAL LU IN IBUFS, ONE WORD PER TERMINAL, PLUS C THE LINE LU AT THE HEAD OF THE LIST. C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBUFL-1) ASSIGNED TERMINALS. C C IDCT = COMPLETION CODE C = 0 NO MATCH FOUND IN EQT ID LIST C = 1 ONE MATCH FOUND IN EQT ID LIST C > 1 NUMBER OF DUPLICATE EQT ID FOUND C C DIMENSION IBUFS(28) IDDD = 11 IDCT = 0 IF(IBUFS(1).EQ.0) GO TO 900 IF(IBUFS(2)) 900,4 4 DO 60 J=3,IBUFS(2) C GET THE LINE WORD 11 AND WORD 16 CALL ILINA(IBUFS(J),ILNN,IT16,IT11) C GET THE ID OF EACH TERMINAL IN IBUFS AND COMPARE WITH ITID. FOR C EACH LU WITH A MATCHING ITID, INCREMENT IDCT. 100 IF(ITID.EQ.IT16) 54,60 54 IDCT = IDCT+1 60 CONTINUE 900 RETURN END C END$ CFTN4,L SUBROUTINE ILIND(ILLU,IGRUP,IBUFS,IBUFV,IDCT,IBXLU, +IARAY,IHHH),91711-1X032 REV 1926 790906 C 17.07.79 C THIS SUBROUTINE VERIFIES THE WRU ID LIST IS FOUND IN THE C EQT. THE EQT ID LIST FROM ILINB IS USED HERE. C C ILLU = LIST LU C IGRUP = WRU LIST OF TERMINAL ID IN THE GROUP UNDER TEST C INAT = THE NUMBER OF REPLYS TO THE zWRU ON THIS GROUP C IBUFS = THE FIRST ENTRY IS THE LINE LU FOLLOWED BY IBSL, THEN A C LIST OF TERMINAL LU NUMBERS. THE NUMBERS ARE SYSTEM LU C NUMBERS IN INTEGER FORMAT. C IBSL = NUMBER OF LU NUMBERS IN IBUFS TO VERIFY = IBUFS(1) C = 0 LINE NOT PRESENT IN INLU EQT C = 1 LINE IS INITIALIZED WITH NO ASSIGNED TERMINALS. C > 1 LINE IS INITIALIZED WITH (IBSL-1) ASSIGNED TERMINALS. C IBUFV = IF NONZERO, CONTAINS 3-WORD ENTRY PER FAILURE: IDCT, ID, LU C IBVL = TOTAL NUMBER OF LU WHICH FAILED WRU VERIFY = IBUFV(1) C = 0 ALL IS WELL, NO LU VERIFY FAILURES C > 0 VERIFY FAILURES C = -1 TEST ABORTED. NO TERMINAL LU IN IBUFS. C C DIMENSION IBUFS(28),IGRUP(30),IBUFV(60),IARAY(3),IBXLU(60) C C INITIALIZE VARIABLES AND BUFFERS C IDVCT = 0 IDCT = -1 CALL SFILL(IBUFV,1,120,0B) CALL SFILL(IBXLU,1,120,0B) IBUFV(1) = -1 IBXLU(1) = -1 C C C C C C C DO 60 J = 1,IBUFS(2) IF(J.EQ.2) J = J+1 IAAA = 11 IFFF = 0 IDCT = -1 C J = 1, GET THE LINE WORD 11 AND WORD 16 C J > 2, TERMINAL ID CALL ILINA(IBUFS(J),ILNN,IT16,IT11) IF(J.NE.1) GO TO 100 C C THE FIRST ITERATION SHOWS A MESSAGE HEADER. C WRITE(ILLU,110)IARAY GO TO 20 C C C C C GET THE ID OF EACH TERMINAL IN IBUFS AND SEARCH THE IGRUP LIST. C FOR EACH ID (VIA ILINA) COUNT THE NUMBER OF MATCHES FOUND. IF ONE C MATCH IS FOUND, VERIFY IS GOOD, NO ACTION IS NECESSARY. OTHERWISE C SAVE IDCT, ID, AND LU NUMBER, THEN INCREMENT IERCT. C 100 DO 30 K=2,IGRUP(1) C C COMPARE COMPARE EACH ID FROM THE EQT STRUCTURE WITH THE ID FROM C THE POLL ON THE LINE. COUNT THE NUMBER OF ID MATCHES FOUND AND C THE NUMBER OF TERMINAL LU PROCESSED. C IF(IT16.NE.IGRUP(K)) GO TO 30 IDCT = IDCT+1 IDVCT = IDVCT+1 30 CONTINUE C C IF IT16 IS NOT FOUND IN IGRUP THEN IZDCT = -1, GO TO 31 C IF DUPLICATE IT16 ARE FOUND IN IGRUP THEN IDCT > 0, GO TO 33 C IF ONE MATCH IS FOUND IDCT = 0, GO TO 20 C IF(IDCT) 31,20,33 C C C 31 IFFF = 1 C C UPDATE IBUFV BY APPENDING IDCT, ITID, ITLU TO BUFFER IBUFV C 33 CALL IVBUF(IDCT,IT16,IBUFS(J),IBUFV) C C GET CONFIGURATION MESSAGE FOR LINE AND CLEAR TERMINALS C 20 CALL IMPXX(IBUFS(J),ILLU,IBUFS(1),IARAY,IFFF) C C THE FIRST ITERATION IS THE LINE LU, GO TO 60 C IF(J.EQ.1) GO TO 60 C C C IF ITLU HAS BEEN INITIALIZED IN ORDER TO DEMONSTRATE C SOMETHING HERE, SEND THE FOLLOWING MESSAGES. OTHERWISE C NO MESSAGES ARE SENT. C IF(IHHH.EQ.5) GO TO 40 IF(IHHH.EQ.-1) GO TO 40 C C IMPXX RETURNED A QUALIFICATION CODE, IFFF. IFFF = -2 C SAYS ITLU IS UNAVAILABLE FOR ANY MESSAGE C IFFF = -3 SAYS THIS WAS A 264X TERMINAL. C IF(IFFF.EQ.-2) GO TO 22 C C *LN N TL MMAB ONLN* C 23 CALL IMSG3(ILLU,IBUFS(1),IBUFS(J),IT16,IARAY,5,IAAA) C C *LN N TL MMAB VERIFY* C CALL IMSG3(ILLU,IBUFS(1),IBUFS(J),IT16,IARAY,4,IAAA) C C C IMPXX RETURNED A QUALIFICATION CODE, IFFF. C IFFF = -3, IT WAS OK TO SEND THE MESSAGE IF THIS TRML WAS C JUST INITIALIZED (KEY = 0), BUT FLAG THIS LU AS UNAVAILABLE C FOR FURTHER MESSAGES. C 40 IF(IFFF.EQ.-3) GO TO 22 GO TO 60 C C C C C UPDATE IBUFV FROM WHAT IMPXX TELLS US ABOUT ITLU. C 22 CALL IVBUF(IDCT,IT16,IBUFS(J),IBXLU) C C C 60 CONTINUE C C C C C RETURN 110 FORMAT(/2X3A2"- *VERIFY* LU EQT ID MODEL K D LM RM INT PR") END C END$ CFTN4,L SUBROUTINE TB(ILU,INLU,ILLU,IARAY, +IBBB),91711-1X032 REV 1926 790906 C 10.05.79 C THIS SUBROUTINE SETS THE NAK, WACK COUNTS AND TERMINAL BLOCKING C FACTOR FOR THE LINE C C ILU = CONSOLE LU C ILLU = LIST LU C IBBB = MODE SELECTION C C CALLS: C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCKE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,2200B/ 100 CALL IMSG7(ILU,KTNC,IARAY,4,11) IF(KTNC.GT.17B) 100,101 101 CALL IMSG7(ILU,KRNC,IARAY,5,11) IF(KRNC.GT.17B) 101,102 102 CALL IMSG7(ILU,KWC,IARAY,6,11) IF(KWC.GT.37B) 102,103 103 CALL IMSG7(ILU,KTBF,IARAY,7,11) IF(KTBF.GT.4) 103,200 200 WRITE(ILLU,120)IARAY,KTNC,KRNC,KWC,KTBF LRNC = KRNC*20B LWC = KWC*400B LTBF = KTBF*20000B ICW = IOR(IOR(IOR(LRNC,KTNC),LWC),LTBF) ICWORD(1) = IOR(100000B,INLU) REG = XLUEX(3,ICWORD,ICW) 120 FORMAT(2X3A2"- TNC:",I3," RNC:",I3," WC:",I3," TBF:",I3) RETURN END C END$ CFTN4,L SUBROUTINE EM(ILU,ITLU,ILLU,IARAY, +IBBB),91711-1X032 REV 1926 790906 C 10.05.79 C THIS SUBROUTINE SETS THE EDIT MODE AND POLLING GLOBALS C C ILU = CONSOLE LU C ITLU = LINE LU C ILLU = LIST LU C IBBB = MODE SELECTION C = 0 OPERATOR ENTRY C = ICW VERIFY C C DIMENSION IREG(2),ICWORD(2),IARAY(3) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,2300B/ IF(IBBB.NE.0) 10,100 10 ICW = IBBB GO TO 103 100 WRITE(ILU,110)IARAY 101 READ(ILU,*)KD,KR,KL,KC,KH,KX,KN,KS,KA 102 WRITE(ILU,112)KD,KR,KL,KC,KH,KX,KN,KS,KA IF(KD.EQ.1) 121,122 121 KD = 100000B 122 IF(KR.EQ.1) 123,124 123 KR = 40000B 124 IF(KL.EQ.1) 125,126 125 KL = 20000B 126 IF(KC.EQ.1) 127,128 127 KC = 10000B 128 IF(KH.EQ.1) 129,130 129 KH = 4000B 130 IF(KX.EQ.1) 131,132 131 KX = 2000B 132 IF(KN.EQ.1) 133,134 133 KN = 1000B 134 IF(KS.EQ.1) 135,136 135 KS = 400B 136 IF(KA.NE.1) 137,138 137 KA = 0 138 ICW = IOR(IOR(IOR(IOR(IOR(IOR(IOR(IOR(KD,KR),KL),KC),KH),KX),KN), +KS),KA) 103 ICWORD(1) = IOR(100000B,ITLU) REG = XLUEX(3,ICWORD,ICW) 110 FORMAT(2X3A2"- D R L C H X N S A",/,10X"_") 112 FORMAT(10X9(I1X)) RETURN END C END$ F CFTN4,L SUBROUTINE IWRXX(ILU,INLU,ILLU,ID,IARAY,IBUFX, +IOFLN,IEEE),91711-1X032 REV 1926 790906 C 09.07.79 C C THIS SUBROUTINE CALLS THE SUBROUTINES TO GENERATE OFF-LINE C TERMINAL ID FOR THE LINE UNDER TEST. C C IEEE = -1, CALLED BY VMPLN C IEEE = 1 , CALLED BY IOFLN C C DIMENSION IREG(2),IBUFR(128),IGRUP(30),ICWORD(2),IBUFS(28), +IARAY(3),IBUFV(60),IOFLN(30),IBUFX(28) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,0/,IREG/0,0/ C C C INAT = 0 C C INITIALIZE VARIABLES AND BUFFERS C CALL SFILL(IOFLN,1,60,0B) CALL SFILL(IGRUP,1,60,0B) CALL SFILL(IOFLN,1,60,0B) IOFLN(1) = -1 C CALL SFILL(IBUFR,1,256,0B) IBUFL = 128 C KGID = IOR(IAND(ID,57400B),40B) C C ALL TERMINALS THAT RESPOND TO THE POLL WILL HAVE THEIR ID IN C BUFFER IGRUP. C C CALL IGRID(INLU,ID,IGRUP) C C IF NO WRU RESPONSE FOR THIS GROUP, EXIT C IF(IGRUP(1)) 900,20 20 CALL SFILL(IBUFS,1,56,0B) CALL SFILL(IBUFX,1,56,0B) C C C C C C C USING THE LINKED EQT STRUCTURE FOR LINE LU = INLU, FIND ALL C THE TERMINAL LU NUMBERS THAT ARE INITIALIZED TO TERMINALS IN C GROUP KGID. C CALL ILINB(ILLU,INLU,KGID,IBUFS,INAT,ITMCT) C C IF THERE ARE ANY OFF-LINE ID, SHOW THEM. C CHECK FOR UNIQUE ID AMONG THE GROUP KGID C AREAS VERIFIED ARE EQT LIST, WRU LIST, OFF LINE LIST C CALL ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN,IBUFX,IDCT,IEEE) 900 RETURN END C END$ CFTN4,L SUBROUTINE IGRID(INLU,KGID, +IGRUP),91711-1X032 REV 1926 790906 C 03.08.79 C C WHO ARE YOU ON LINE LU = INLU, GROUP KGID. ALL TERMINALS C THAT REPLY HAVE THEIR ID PUT INTO BUFFER IGRUP. C DIMENSION IREG(2),IBUFR(128),IGRUP(30),ICWORD(2) EQUIVALENCE (IREG(1),IA,REG),(IREG(2),IB) DATA ICWORD/0,0/,IREG/0,0/,INAT/0/ C C INITIALIZE VARIABLES AND BUFFERS C KK = 1 C  CALL SFILL(IGRUP,1,60,000B) IGRUP(1) = -1 C CALL SFILL(IBUFR,1,256,000B) IBUFL = 128 C ICWORD(1) = IOR(100000B,INLU) C FORM THE GROUP POLL CHARACTER ID = IOR(KGID,175B) C 21 REG = XLUEX(1,ICWORD,IBUFR,IBUFL,ID) IBUFL = IB C NUMBER OF RESPONDING TERMINALS = INAT INAT = IBUFL/3 C IF IBUFL = 0 THERE IS NO RESPONSE FROM TERMINALS IF(IBUFL.EQ.0) GO TO 900 C C PUT THE TERMINAL ID INTO IGRUP C IGRUP(1) = INAT+1 I = 1 C C 51 DO 52 NN = 2,IGRUP(1) IGRUP(NN) = IAND(IBUFR(I),077777B) 52 I = I+3 C C C 900 RETURN END C END$ CFTN4,L SUBROUTINE ILINF(INLU,ILLU,IARAY,IGRUP,IBUFS,IOFLN, +IBUFX,IDCT,IEEE),91711-1X032 REV 1926 790906 C 28.08.79 C C IEEE = -1 CALLED BY IWRXX, VMPLN C IEEE = 1 CALLED BY IWRXX, IOFLN C C C C THIS SUBROUTINE OUTPUTS OFF-LINE TERMINAL ID FROM INPUT C BUFFERS IGRUP, IBUFS, AND THE LINE LU. C C IGRUP WAS CREATED BY SUBROUTINE IGRID BY POLLING LINE LU = INLU C WITH THE GROUP POLL CHARACTER UNDER TEST. THEREFORE, BUFFER C IGRUP CONTAINS THOSE TERMINAL'S ID WHICH HAVE RESPONDED TO THE C GROUP POLL ON THE LINE UNDER TEST. C C IBUFS WAS CREATED BY SUBROUTINE ILINB BY FIRST KNOWING THE C LINE LU NUMBER, THEN FOLLOWING THE LINKED LIST STRUCTURE C FOR THE LINE. FOR EACH TERMINAL EQT FOUND, A SYSTEM SUBROUTINE C (TRMLU) RETURNED WITH THE LU NUMBER FOR THAT EQT, WHICH WAS C PUT INTO IBUFS. FOR THE CASE WHERE THE DRT ENTRY WAS ZERO IN C THE EQT FIELD, THE LU IS INDETERMINATE AND TRMLU RETURNED WITH C ZERO, AND THERE WAS NO ENTRY MADE IN IBUFS. C C HERE, THOSE TERMINALS RESPONDING TO THE GROUP POLL HAVE THEIR ID C EXAMINED FOR A SINGLE MATCH AMONG THE ID CONTAINED IN THE LINKED C EQT STRUCTURE FOR THE LINE UNDER TEST. IF THERE IS A SINGLE C ID FOUND OR MULTIPLE ID ARE FOUND IN THE EQT STRUCTURE THAT ARE C THE SAME, THE ID IS PASSED OVER AND THE NEXT ID IN IGRUP IS C UNDER TEST. IF THE ID UNDER TEST IS NOT FOUND IN THE EQT C STRUCTURE, THAT ID IS PUT INTO BUFFER IOFLN. FINALLY, ALL ID C IN BUFFER IOFLN ARE OUTPUT. C C NOTE THE PROCEDURE IS AN ITERATIVE OUTPUT OF OFF-LINE ID BY C GROUP (THERE ARE 27 POSSIBLE GROUPS PER LINE). C C C C C C DIMENSION IBUFS(28),IBUFX(28),IGRUP(30),IOFLN(30),IARAY(3), +IXEQT(30) C C INITIALIZE VARIABLES C KK = 1 LL = 1 C C INITIALIZE BUFFERS IXEQT, IOFLN C CALL SFILL(IXEQT,1,60,000B) CALL SFILL(IOFLN,1,60,000B) IOFLN(1) = -1 CALL SFILL(IBUFX,1,56,000B) C C C C C C FOR EACH MEMBER OF IGRUP, CALL ILINC TO TEST FOR UNIQUENESS. C ILINC TESTS THE TRML ID FOR MEMBERSHIP AMONG ID FOUND IN EQT. C DO 24 K=2,IGRUP(1) 555 CALL ILINC(ILLU,INLU,IGRUP(K),IBUFS,IDCT) C C IDCT = 0, NO ID WAS FOUND IN EQT. THIS TRML IS OFF LINE. C IF(IDCT.EQ.0) 30,24 C C PUT THE OFF LINE ID INTO BUFFER IOFLN C 30 KK = KK+1 IOFLN(KK) = IGRUP(K) IOFLN(1) = KK GO TO 24 C C C C IF IDCT = 1, GO TO 24 THIS IS THE EXPECTED CASE (SINGLE, DISTINCT) C IF IDCT > 1, MORE THAN ONE EQT IS INITIALIZED TO THE SAME TRML. C PUT THE ID INTO BUFFER IXEQT. C 40 IF(IDCT-2) 24,41 C PUT ID INTO IXEQT. 41 LL = LL+1 IXEQT(LL) = IGRUP(K) IXEQT(1) = LL C C PUT IXEQT INTO IBUFX. CALL IXBUF TO TEST FOR SIMILAR ID AMONG C IXBUF. THIS CAN HAPPEN IF THERE ARE SIMILAR ID AMONG IGRUP. C IF(IEEE) 42,24 42 CALL IMSG3(ILLU,IDCT,0,IGRUP(K),8,IARAY,11) C C 24 CONTINUE C C C C C C CHECK FOR ANY OFF-LINE ID NOW. C GO TO 900 IF THERE ARE NO OFF-LINE ID. IF THERE ARE OFF-LINE C ID PRESENT, CHECK FOR NO DUPLICATE ID AMONG THE GROUP POLL LIST, C AND NO DUPLICATE ID AMONG THE EQT ID. C C C C C IF(IOFLN(1)) 900,34 C IXBUF WILL FIND XANY DUPLICATE ID AMONG THE OFF-LINE ID AND C RETURN WITH BUFFER IBUFX CONTAINING ANY DUPLICATE OFF-LINE ID. C THE FIRST WORD OF IBUFX CONTAINS THE COMPLETION CODE. 34 CALL IXBUF(IOFLN,IBUFX) C C IF IBUFX(1) = -1, THERE WAS ONLY 1 OFF LINE ID. C IF(IBUFX(1)) 26,31 C C IF IBUFX(1) = 3,5,7,... THERE APPEARS TO BE SEVERAL SIMILAR ID C A BETTER ALOGORITHM CAN BE MADE BY SKIPPING ID ALREADY IN IBUFX. C HOWEVER, IF IBUFX(2) = 0, THEN NO SIMILAR ID WERE FOUND. C 31 IF(IBUFX(2).EQ.0) 26,32 C C TXTD1 * ab APPEARS OFF LINE nnn TIMES C 32 NN = 2 CALL IMSG3(ILLU,IBUFX(NN),0,IBUFX(NN+1),6,IARAY,11) IF((NN+1).EQ.IBUFX(1)) 900,33 33 NN = NN+2 GO TO 32 C C C C C C C C SHOW THE OFF LINE ID C 26 DO 29 K = 2,IOFLN(1) C SHOW EITHER THE SURVEY OR VERIFY OFF-LINE MESSAGE IF(IEEE) 27,28 C OFF LINE FOR VERIFY MESSAGE 27 CALL IMSG2(ILLU,0,IOFLN(K),4,IARAY,11) GO TO 29 C OFF LINE FOR SURVEY MESSAGE 28 CALL IMSG2(ILLU,0,IOFLN(K),9,IARAY,11) 29 CONTINUE 900 RETURN END C END$ CFTN4,L SUBROUTINE IXBUF(IGRUP,IBUFX),91711-1X032 REV 1926 790906 C 28.08.79 C C CHECK IGRUP FOR DUPLICATE ID, PUT ANY DUPLICATE ID IN BUFFER C IBUFX. C DIMENSION IGRUP(30),IBUFX(28) LL = 2 C INITIALIZE IBUFX DO 5 K = 1,28 5 IBUFX(K) = 0 IBUFX(1) = -1 C DON'T FOOL WITH A SINGLE ID IF(IGRUP(1).EQ.2) GO TO 606 C DO 606 K = 2,IGRUP(1)-1 IDNUM = 1 L = K+1 C COMPARE TWO ID. IF THEY ARE THE SAME, SAVE IGRUP(K) AND THE RUNNING C TOTAL (IDNUM) . 601 IF(IGRUP(K).EQ.IGRUP(L)) 602,603 602 IDNUM = IDNUM+1 IBUFX(LL) = IDNUM IBUFX(LL + 1) = IGRUP(K) 603 IF(L.EQ.IGRUP(1)) 605,604 604 L = L+1 GO TO 601 C ALL THE ID HAVE BEEN TESTED. (A BETTER TEST CAN BE MADE) C ER 605 IBUFX(1) = LL + 1 606 LL = LL + 2 C WRITE(1,110) IBUFX(1),IBUFX(2),IBUFX(3) 110 MtVTPFORMAT(2X"IXBUF BX1:",I2X"BX2:",I2X"BX3:",A2) RETURN END C END$ CFTN4,L SUBROUTINE IVBUF(IDCT,ITID,ITLU, +IBUFV),91711-1X032 REV 1926 790906 C 28.08.79 C C APPEND THE VALUES IDCT, ITID, ITLU TO BUFFER IBUFV, C THEN RETURN. C DIMENSION IBUFV(60),IBVVV(60) C C INITIALIZE IBVVV C CALL SFILL(IBVVV,1,120,0B) C C IS THIS THE FIRST TIME IBUFV IS ENTERED ? C IF(IBUFV(1)) 15,6 C C NO... THERE ARE ENTRIES TO BE PRESERVED. C 6 KK = IBUFV(1) + 1 DO 10 K = 1,IBUFV(1) 10 IBVVV(K) = IBUFV(K) GO TO 17 C C C C YES.. START ENTERING DATA INTO THE SECOND WORD OF IBVVV C 15 KK = 2 C C C C C NEW DATA IS APPENDED TO EXISTING DATA C 17 IBVVV(KK) = IDCT KK = KK + 1 IBVVV(KK) = ITID KK = KK + 1 IBVVV(KK) = ITLU C UPDATE THE BUFFER LENGTH IBVVV(1) = KK C C C C C NOW CLEAR IBUFV TO 0 C CALL SFILL(IBUFV,1,120,0B) C C COPY THE CURRENT DATA INTO IBUFV AND RETURN C DO 30 K = 1,IBVVV(1) 30 IBUFV(K) = IBVVV(K) C C C C C 40 RETURN END END$ BV = 91711-18033 2001 S C0122 &TXMV1 DISC MEMORY VERIF.             H0101 FTN4,L PROGRAM TXMV1(3,100),91711-16033 REV 2001 791024 C C C *********************************************** C * SYSTEM AND PERIPHERAL DISC TEST PROGRAM * C * "TXMV1" * C *********************************************** C C C C C DESCRIPTION: C ------------ C C THE PROGRAM "TXMV1" VERIFIES THE PROPER OPERATION C OF THE SYSTEM DISC OR ANY PERIPHERAL DISC. C C C C OPERATING PROCEDURE: C -------------------- C C SCHEDULE THE PROGAM "TXMV1" FOR EXECUTION WITH THE RUN COMMAND. C C ENTER: RU,TXMV1,LOGLU,DISCLU,ST,MT,XXX C MM C C WHERE C C LOGLU IS THE LU FOR LOGGING AND ERROR MESSAGES. C C DISCLU IS THE DISC LU TO BE TESTED. C C ST RUN OPTIONAL SELF-TEST. C (DEFAULT NO SELF-TEST). C C MT OPTIONAL MEDIA TEST (TESTFILE REST OF CARTRIDGE). C (DEFAULT TESTFILE SIZE 24 BLOCKS). C MM OPTIONAL MEDIA TEST WITH MESSAGES. SAME AS MEDIA C TEST ABOVE. THE FOLLOWING MESSAGE WILL BE REPORTED C EVERY 15-25 SECONDS: C TXMV1 - LU# XX: DISC TEST XX.X% COMPLETE C C XXX OPTIONAL NUMBER OF PASSES. C (DEFAULT RUN ONCE). C C C NOTE: SET BREAK FLAG TO STOP THE DISC TEST. C (USING BR COMMAND) C C C C C C C C TEST SEQUENCE: C -------------- C C 1. RUN THE SELF-TEST (FOR IDC DISC ONLY). C C 2. BINARY SEEK-TEST ACROSS THE ENTIRE SURFACE. C C 3. CREATE TESTFILE "@TEST@" ON DISC LU (FILE TYPE 1). FILE C SIZE IS 24 BLOCKS. IF MT (MEDIA TEST) WAS SPECIFIED IN C RUN COMMAND, REST OF CARTRIDGE IS ALLOCATED TO TESTFILE C "@TEST@". C C 4. WRITE WORST CASE TEST PATTERN EACH CONSISTING OF 128 WORDS C TO TESTFILE "@TEST@" USING FMP CALLS. C C 5. $6READ AND READ/VERIFY THE WRITTEN DATA PATTERN USING DISC C OPERATION LIBRARY SUBROUTINES. REPORT ALL ERRORS. C C 6. REPEAT STEP 4 AND 5 UNTIL THE TESTFILE "@TEST@" IS FILLED. C 17 WORST CASE TEST PATTERN ARE USED AND ROTATED. C C 7. PURGE THE TESTFILE "@TEST@". C C 8. THE ENTIRE TEST IS REPEATED AS MANY TIMES AS SPECIFIED BY C THE OPTIONAL PARAMETER XXX (DEFAULT ONCE). C C C C C C C C C C LIST OF ALL INFORMATION MESSAGES: C --------------------------------- C C C C TXMV1 - LU# XX: DISC TEST RUNNING C C C TXMV1 - LU# 10: DISC TEST XX.X% COMPLETE C (OPTIONAL MESSAGE REPORTED EVERY 15 TO 25 SECONDS) C C C TXMV1 - LU# XX: SELF-TEST PASSED C C C TXMV1 - LU# XX: SELF-TEST NOT AVAILABLE! C C C TXMV1 - LU# XX: DISC TEST FINISHED XXXX PASSES XXXX ERRORS C C C C C C LIST OF ALL ERROR MESSAGES: C --------------------------- C C C C TXMV1 - LU# SPECIFIED FOR TEST DISC IS ILLEGAL. C RERUN TEST SPECIFYING AN INTEGER >0 AND <64 FOR LU#. C C TXMV1 - DISC TEST ABORTED! C C C TXMV1 - LU# XX: NOT ASSIGNED, NOT TESTED! C C C TXMV1 - LU# XX IS NOT A LEGAL DISC. C RERUN TEST SPECIFYING CORRECT LU#. C C C TXMV1 - LU# XX: EQT OR LU FOR TEST DISC IS DOWN. C UP EQT AND RERUN TEST. C C C TXMV1 - LU# XX: CARTRIDGE NOT MOUNTED. C MOUNT CARTRIDGE AND RERUN TEST. C C C TXMV1 - LU# XX: DISC TEST ABORTED! C C C TXMV1 - LU# XX: DRIVE NOT READY! C C C TXMV1 - LU# XX: DISC TRACK MAP TABLE ERROR! C C C TXMV1 - LU# XX: SELF-TEST FAILED! C C C TXMV1 - LU# XX: LOCK/UNLOCK ERROR! C C C TXMV1 - LU# XX: POWER-ON ERROR, RERUN TEST! C C C TXMV1 - LU# XX: HP-IB PARITY ERROR, RERUN TEST! C C C TXMV1 - LU# XX: TIME-OUT ERROR, RERUN TEST! C C C TXMV1 - LU# XX: ERROR FMP-XXX ON TEST FILE @TEST@! C (REFER TO FMP ERROR NUMBER DESCRIPTION IN THE BATCH SPOOL C MONITOR REFERENCE MANUAL) C C C TXMV1 - LU# XX: WRITE/READ DATA COMPARE ERROR! C TRACK# XXX, CYL# XXX, HEAD# X, UNIT# X C DATA XXXXXXB SHOULD BE XXXXXXB C NUMBER OF DATA COMPARE ERRORS: XXX C (ONLY THE FIRST THREE ERRORS ARE DISPLAYED) C C C TXMV1 - LU# XX: DISC STATUS ERROR! S1=XXXXXXB S2=XXXXXXB C (SEE NOTE) C C C TXMV1 - LU# XX: DISC READ ERROR! S1=XXXXXXB S2=XXXXXXB C TRACK# XXX, CYL# XXX, HEAD# X, UNIT# X C (SEE NOTE) C C C TXMV1 - LU# XX: DISC VERIFY ERROR! S1=XXXXXXB S2=XXXXXXB C TRACK# XXX, CYL# XXX, HEAD# X, UNIT# X C (SEE NOTE) C C C C POSSIBLE STATUS-1 ERRORS: C C STATUS-1 ERROR: ILLEGAL OPCODE C C STATUS-1 ERROR: ILLEGAL DRIVE TYPE C C STATUS-1 ERROR: CYLINDER MISCOMPARE C C STATUS-1 ERROR: UNCORRECTABLE DATA ERROR C C STATUS-1 ERROR: HEAD/SECTOR MISCOMPARE C C STATUS-1 ERROR: I/O PROGRAM ERROR C C STATUS-1 ERROR: END OF CYLINDER C C STATUS-1 ERROR: DATA OVERRUN C C STATUS-1 ERROR: ILLEGAL ACCESS TO SPARE TRACK C C STATUS-1 ERROR: DEFECTIVE TRACK C C STATUS-1 ERROR: ACCESS NOT READY DURING OPERATION C C STATUS-1 ERROR: STATUS-2 ERROR C C STATUS-1 ERROR: ATTEMPT TO WRITE ON PROTECTED TRACK C C STATUS-1 ERROR: UNIT UNAVAILABLE C C STATUS-1 ERROR: DRIVE ATTENTION C C C C POSSIBLE STATUS-2 ERRORS: C C STATUS-2 ERROR: DRIVE BUSY C C STATUS-2 ERROR: DRIVE NOT READY C C STATUS-2 ERROR: NO DISC OR HEADS UNLOADED C C STATUS-2 ERROR: SEEK OUT OF BOUND C C STATUS-2 ERROR: FIRST STATUS BIT SET C C STATUS-2 ERROR: DRIVE FAULT C C C C C NOTE: ALL POSSIBLE STATUS-1 AND STATUS-2 ERRORS C ARE REPORTED AFTER THE MAIN ERROR MESSAGE. C C C C C C C COMMON NAME(3),ISTAT(2),ISIZE(2) COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER DIMENSION ICART(125),IPRAM(5),MAP(5) C C************************* RECOVER PARAMETERS ************************ C CALL RMPAR(IPRAM) LULOG=1 IF (IPRAM(1) .GT. 0) LULOG=IPRAM(1) LUDSK=IPRAM(2) ISELF=0 IF (IPRAM(3) .EQ. 2HST) ISELF=1 ISIZE(1)=24 ISIZE(2)=0 IF ((IPRAM(4) .EQ. 2HMT) .OR. (IPRAM(4) .EQ. 2HMM)) ISIZE(1)=-1 LOG=0 IF (IPRAM(4) .EQ. 2HMM) LOG=1 LMAX=1 IF (IPRAM(5) .GT. 0) LMAX=IPRAM(5) C C************** STORE NAME FOR LOGGING AND ERROR MESSAGES ************ C NAME(1)=2HTX NAME(2)=2HMV NAME(3)=2H1 C C************************* ILLEGAL DISC LU *************************** C IF (IAND(LUDSK,177700B) .EQ. 0) GO TO 200 WRITE(LULOG,100) NAME 100 FORMAT(/,2X,3A2,"- LU# SPECIFIED FOR TEST DISC IS ", 1 "ILLEGAL."/,10X,"RERUN TEST SPECIFYING AN INTEGER", 2 " >0 AND <64 FOR LU#.") WRITE(LULOG,110) NAME 110 FORMAT(/,2X,3A2,"- DISC TEST ABORTED!",/) GO TO 820 C C************************ GET STATUS OF DISC LU ********************** C 200 CALL EXEC(13,LUDSK,IEQT5,IEQT4,LUSTAT) C C********************* CHECK IF DISC LU IS ENABLED ******************* C IF (IAND(IEQT4,77B) .NE. 0) GO TO 220 WRITE(LULOG,210) NAME,LUDSK 210 FORMAT(/,2X,3A2,"- LU#",I3,": NOT ASSIGNED, NOT TESTED!",/) GO TO 820 C C******************* CHECK IF DISC DRIVER TYPE IS 32 ***************** C 220 IF (IAND(IEQT5,37400B) .EQ. 15000B) GO TO 260 WRITE(LULOG,230) NAME,LUDSK 230 FORMAT(/,2X,3A2,"- LU#",I3," IS NOT A LEGAL DISC.",/, 1 10X,"RERUN TEST SPECIFYING CORRECT LU#.") 240 WRITE(LULOG,250) NAME,LUDSK 250 FORMAT(/,2X,3A2,"-I LU#",I3,": DISC TEST ABORTED!",/) GO TO 820 C C*********************** CHECK IF DISC IS UP ************************* C 260 IF (IAND(IEQT5,140000B) .EQ. 40000B) GO TO 270 IF (IAND(LUSTAT,100000B) .EQ. 0) GO TO 300 270 WRITE(LULOG,280) NAME,LUDSK 280 FORMAT(/,2X,3A2,"- LU#",I3,": EQT OR LU FOR TEST DISC IS ", 1 "DOWN."/,10X,"UP EQT AND RERUN TEST.") GO TO 240 C C***************** GET DEVICE IDENTIFICATION (IDVID) ***************** C BITS 0-7 HP-IB ADDRESS C BITS 8-15 UNIT# OF DRIVE C 300 CALL EXEC(1,LUDSK+2200B,MAP,5,0,5) IDVID=IAND(MAP(5),16000B)/4 IDVID=IDVID+IAND(MAP(3),17B) C C************************** GET DISC STATUS ************************** C IER=0 CALL XSTAT(LUDSK,IDVID,ISTAT(1),ISTAT(2),IER) IF (IER .GT. 2) GO TO 310 IF (IAND(ISTAT(2),100000B) .EQ. 0) GO TO 330 310 WRITE(LULOG,320) NAME,LUDSK 320 FORMAT(/,2X,3A2,"- LU#",I3,": DRIVE NOT READY!") GO TO 240 C C************************** GET DRIVE TYPE *************************** C C ITYPE=1 FOR 7906 48 SECT/TRK, 4 HEADS, 411 CYL C ITYPE=2 FOR 7920 48 SECT/TRK, 5 HEADS, 823 CYL C ITYPE=3 FOR 7905 48 SECT/TRK, 3 HEADS, 411 CYL C ITYPE=4 FOR 7925 64 SECT/TRK, 9 HEADS, 823 CYL C ITYPE=5 FOR 7910 32 SECT/TRK, 2 HEADS, 748 CYL C ITYPE=6 FOR 9895 30 SECT/TRK, 2 HEADS, 77 CYL C 330 ITYPE=0 MASK=177B IF (IFDVR(LUDSK) .EQ. 0) MASK=377B C C********************* CHECK FOR 7905/7906/7920 ********************** C IDT=IAND(ISTAT(2),17000B)/1000B IF (MAP(1) .NE. 96) GO TO 400 IF (IDT .EQ. 0) ITYPE=1 IF (IDT .EQ. 1) ITYPE=2 IF (IDT .EQ. 2) ITYPE=3 C C************************** CHECK FOR 7925 *************************** C 400 IF (MAP(1) .NE. 128) GO TO 410 IF (IDT .EQ. 3) ITYPE=4 C C************************** CHECK FOR 9895 *************************** C 410 IF (MAP(1) .NE. 60) GO TO 420 ITYPE=6 MASK=37B C C************************** CHECK FOR 7910 *************************** C 420 IF (MAP(1) .EQ. 64) ITYPE=5 C C****************** ILLEGAL DISC TYPE, REPORT EROR ******************* C IF (ITYPE .NE. 0) GO TO 500 WRITE(LULOG,430) NAME,LUDSK 430 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TRACK MAP TABLE ERROR!") GO TO 240 C C*************** CHECK TO SEE IF CARTRIDGE IS MOUNTED **************** C 500 CALL FSTAT(ICART) DO 510 I=1,125,4 IF (LUDSK .EQ. ICART(I)) GO TO 600 IF (ICART(I) .EQ. 0) GO TO 520 510 CONTINUE 520 WRITE(LULOG,530) NAME,LUDSK 530 FORMAT(/,2X,3A2,"- LU#",I3,": CARTRIDGE NOT MOUNTED."/, 1 10X,"MOUNT CARTRIDGE AND RERUN TEST.") GO TO 240 C C************************** START TESTING **************************** C 600 WRITE(LULOG,610) NAME,LUDSK 610 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST RUNNING") C C****************** INITIALIZE PROGRAM PARAMETERS ******************** C INCR=1 NEXT=1 LOOP=1 C C****************** RESET NUMBER OF ERRORS (NERR) ******************** C NERR=0 C C************************ CALL TEST SUBROUTINES ********************** C 700 IF (ISELF .EQ. 1) CALL STEST CALL BSEEK CALL WRTST IF (LOOP .EQ. LMAX) GO TO 800 LOOP=LOOP+1 GO TO 700 C C************** TESTING COMPLETED, REPORT NUMBER OF ERRORS *********** C 800 WRITE(LULOG,810) NAME,LUDSK,LOOP,NERR 810 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST FINISHED",I5, 1 " PASSES",I5," ERRORS",/) 820 END SUBROUTINE STEST C C C ********************************* C * SELF-TEST SUBROUTINE * C ********************************* C C C COMMON NAME(3),ISTAT(2),ISIZE(2) COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,I5,ER DIMENSION IBUF(20) C C******************* EXECUTE SELF-TEST (IDC ONLY) ******************* C IF (IFDVR(LUDSK) .NE. 0) GO TO 1100 WRITE(LULOG,1000) NAME,LUDSK 1000 FORMAT(/,2X,3A2,"- LU#",I3,": SELF-TEST NOT AVAILABLE!") RETURN C 1100 ID=IAND(IDVID,7) IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=577B IBUF(3)=0 IBUF(4)=1004B IBUF(5)=100677B C C************************* INITIATE SELF TEST ************************ C CALL EQTLK(1) CALL EXEC(1,LUDSK+2200B,IBUF,5,1,0) C C*************************** PARALLEL POLL *************************** C 1200 CALL EXEC(1,LUDSK+2200B,IPOLL,1,6,0) IC=IAND(2**(7-ID),IPOLL) IF (IAND(2**(7-ID),IPOLL) .EQ. 0) GO TO 1200 C C*********************** READ SELF TEST RESULT *********************** C IBUF(1)=500B+ID CALL XPRTY(IBUF(1)) IBUF(2)=100577B LEN=-2 CALL EXEC(1,LUDSK+2200B,IBUF,LEN,2,0) CALL EQTLK(0) IF (IAND(IBUF(17),200B) .NE. 0) GO TO 1400 WRITE(LULOG,1300) NAME,LUDSK 1300 FORMAT(/,2X,3A2,"- LU#",I3,": SELF-TEST PASSED") CALL XSTAT(LUDSK,IDVID,ISTAT(1),ISTAT(2),IER) RETURN 1400 CALL XEND(LUDSK,IDVID) WRITE(LULOG,1500) NAME,LUDSK 1500 FORMAT(/,2X,3A2,"- LU#",I3,": SELF-TEST FAILED!") WRITE(LULOG,1600) NAME,LUDSK 1600 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/) CALL EXEC(6) END SUBROUTINE BSEEK C C C ********************************* C * BINARY SEEK TEST * C ********************************* C C C COMMON NAME(3),ISTAT(2),ISIZE(2) COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER DIMENSION NCYL02(8),NCYL05(11),NCYL10(12),NCYL20(12) DATA NCYL02 / 0,1,2,4,8,16,32,64 / DATA NCYL05 / 0,1,2,4,8,16,32,64,128,256,410 / DATA NCYL10 / 0,1,2,4,8,16,32,64,128,256,512,747 / t  DATA NCYL20 / 0,1,2,4,8,16,32,64,128,256,512,822 / C C GET PHYSICAL ADDRESSES: C LTRK=0 LSEC=0 CALL XGTAD(LUDSK,IDVID,LTRK,LSEC,ICYL,IHEAD,ISECT) C GO TO (1000,2000,1000,2000,3000,4000), ITYPE C C****************** BINARY SEEK TEST FOR 7905/7906 ******************* C 1000 DO 1100 I=1,11 ICYL=NCYL05(I) CALL EQTLK(1) CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER) CALL EQTLK(0) CALL CKSTA(1) 1100 CONTINUE RETURN C C******************* BINARY SEEK TEST FOR 7920/7925 ****************** C 2000 DO 2100 I=1,12 ICYL=NCYL20(I) CALL EQTLK(1) CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER) CALL EQTLK(0) CALL CKSTA(1) 2100 CONTINUE RETURN C C********************* BINARY SEEK TEST FOR 7910 ********************* C 3000 DO 3100 I=1,12 ICYL=NCYL10(I) CALL EQTLK(1) CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER) CALL EQTLK(0) CALL CKSTA(1) 3100 CONTINUE RETURN C C********************* BINARY SEEK TEST FOR 9895 ********************* C 4000 DO 4100 I=1,8 ICYL=NCYL02(I) CALL EQTLK(1) CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER) CALL EQTLK(0) CALL CKSTA(1) 4100 CONTINUE RETURN END SUBROUTINE WRTST C C C ********************************* C * WRITE/READ TEST * C ********************************* C C C COMMON NAME(3),ISTAT(2),ISIZE(2) COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER DIMENSION IDCB(144),IBUFR(144),IBUFW(128) DIMENSION IPAT(17),NFILE(3) C C********************** WORST CASE DATA PATTERN ********************** C DATA IPAT / 155555B,177777B,175767B,055555B,002010B,170360B, 1 162745B,000000B,163346B,022222B,033066B,052525B, 2 125252B,106615B,133333B,143306B,007417B/ C C********************** NAME FOR TEST FILE @TEST@ ******************** C DATA NFILE / 2H@T,2HES,2HT@ / C C*********************** CREATE FMP TEST FILE ************************ C IERR=0 ITYP=1 ISECU=0 ICR=-LUDSK CALL CREAT(IDCB,IERR,NFILE,ISIZE,ITYP,ISECU,ICR) IF (IERR .LT. 0) GO TO 3100 MAX=IERR/2 LTRK=IDCB(4) LSEC=IDCB(5) NSPT=IDCB(9) C C*********************** WRITE/READ TEST LOOP ************************ C LEN=128 NUM=0 DO 3000 J=1,MAX C C*********************** TEST THE BREAK FLAG ************************* C IF SET - STOP TESTING AND REPORT FINISHED MESSAGE C IF (IFBRK (IDUMY)) 1000,1200 1000 CALL PURGE(IDCB,IERR,NFILE,ISECU,ICR) IF (IERR .LT. 0) GO TO 3100 WRITE(LULOG,1100) NAME,LUDSK,LOOP,NERR 1100 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST FINISHED",I5, 1 " PASSES",I5," ERRORS",/) GO TO 3300 C C****************** REPORT XX.X% COMPLETE MESSAGE ******************* C 1200 IF (LOG .EQ. 0) GO TO 1400 INCR=INCR+1 IF (IAND(INCR,MASK) .NE. 0) GO TO 1400 PASS=FLOAT(J)+(FLOAT(MAX)*FLOAT(LOOP-1)) PRCNT=100.0*PASS/(FLOAT(LMAX)*FLOAT(MAX)) WRITE(LULOG,1300) NAME,LUDSK,PRCNT 1300 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST",F6.1,"% COMPLETE") C C****************** WRITE DATA PATTERN TO THE DISC ******************* C USING FMP CALLS C WRITE BUFFER IBUFW(128) C 1400 DO 1500 I=1,128 IBUFW(I)=IPAT(NEXT) 1500 CONTINUE CALL WRITF(IDCB,IERR,IBUFW,LEN,NUM) IF (IERR .LT. 0) GO TO 3100 C C********************** READ DATA FROM THE DISC ********************** C USING DISC OPERATION LIBRARY SUBROUTINES C READ BUFFER IBUFR(144) C CALL XGTAD(LUDSK,IDVID,LTRK,LSEC,ICYL,IHEAD,ISECT) CALL EQTLK(1)  CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER) CALL CKSTA(1) C CALL XDRED(LUDSK,IDVID,IBUFR,LEN,ISTAT(1),ISTAT(2),IER) CALL EQTLK(0) CALL CKSTA(2) C C****************** COMPARE WRITE/READ BUFFER ************************ C DISPLAY ONLY THE FIRST THREE ERRORS C N3=0 DO 2500 I=17,144 IF (IBUFR(I) .EQ. IPAT(NEXT)) GO TO 2500 NERR=NERR+1 N3=N3+1 GO TO (2000,2300,2300,2500), N3 2000 WRITE(LULOG,2100) NAME,LUDSK 2100 FORMAT(/,2X,3A2,"- LU#",I3,": WRITE/READ DATA COMPARE ERROR!") IUNIT=IAND(IDVID,7) WRITE(LULOG,2200) LTRK,ICYL,IHEAD,IUNIT 2200 FORMAT(18X,"TRACK#",I4,", CYL#",I4,", HEAD#",I2,", UNIT#",I2) 2300 WRITE(LULOG,2400) IBUFR(I),IPAT(NEXT) 2400 FORMAT(18X,"DATA ",@6,"B SHOULD BE ",@6,"B") 2500 CONTINUE IF (N3 .NE. 0) WRITE(LULOG,2600) N3 2600 FORMAT(18X,"NUMBER OF DATA COMPARE ERRORS:",I4) C C************************* READ VERIFY DATA ************************** C USING DISC OPERATION LIBRARY SUBROUTINES C CALL XGTAD(LUDSK,IDVID,LTRK,LSEC,ICYL,IHEAD,ISECT) CALL EQTLK(1) CALL XSEEK(LUDSK,IDVID,ICYL,IHEAD,ISECT,ISTAT(1),ISTAT(2),IER) CALL CKSTA(1) NSEC=1 CALL XVRFY(LUDSK,IDVID,NSEC,ISTAT(1),ISTAT(2),IER) CALL EQTLK(0) CALL CKSTA(3) NEXT=NEXT+1 IF (NEXT .GT. 17) NEXT=1 LSEC=LSEC+2 IF (LSEC .LT. NSPT) GO TO 3000 LSEC=LSEC-NSPT LTRK=LTRK+1 3000 CONTINUE C C*********************** PURGE FMP TEST FILE ************************* C CALL PURGE(IDCB,IERR,NFILE,ISECU,ICR) IF (IERR .LT. 0) GO TO 3100 RETURN C C************************* REPORT FMP ERROR ************************** C 3100 IFMP=KCVT(-IERR) IF (IAND(IFMP,157400B) .EQ. 0) IFMP=IFMP+10000B WRITE(LULOG,3200) NAME,LUDSK,IFMP 3200 FORMAT(/,2X,3A2,"- LU#",I3,": ERROR FMP-0",A2, 1 " ON TEST FILE @TEST@!") 3300 WRITE(LULOG,3400) NAME,LUDSK 3400 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/) CALL EXEC(6) END SUBROUTINE CKSTA(ICOM) COMMON NAME(3),ISTAT(2),ISIZE(2) COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER C C THIS SUBROUTINE CHECKS THE STATUS AFTER THE C FOLLOWING DISC OPERATION LIBRARY SUBROUTINES: C C - SEEK COMMAND (ICOM=1) C - READ COMMAND (ICOM=2) C - VERIFY COMMAND (ICOM=3) C C C C******************** CHECK ERROR RETURN (IER) *********************** C C IER: C 0 DSJ=0 NORMAL COMPLETION C 1 DSJ=1 ABNORMAL COMPLETION C 2 DSJ=2 POWER-ON OR COMPLETION OF SELF-TEST C 3 DSJ=3 HP-IB PARITY ERROR C 4 LU HAS TIMED-OUT C C IF ((IER .EQ. 0) .OR. (IER .EQ. 1)) GO TO 2000 C IF (IER .EQ. 2) WRITE(LULOG,1000) NAME,LUDSK 1000 FORMAT(/,2X,3A2,"- LU#",I3,": POWER-ON ERROR, RERUN TEST!") C IF (IER .EQ. 3) WRITE(LULOG,1100) NAME,LUDSK 1100 FORMAT(/,2X,3A2,"- LU#",I3,": HP-IB PARITY ERROR, RERUN TEST!") C IF (IER .EQ. 4) WRITE(LULOG,1200) NAME,LUDSK 1200 FORMAT(/,2X,3A2,"- LU#",I3,": TIME-OUT ERROR, RERUN TEST!") C WRITE(LULOG,1300) NAME,LUDSK 1300 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/) CALL EXEC(6) C C***************** CHECK STATUS AFTER READ OR VERIFY ***************** C STATUS-1: IDC STAT SHOULD BE ZERO C 2000 IF (ICOM .EQ. 1) GO TO 2100 IF (IAND(ISTAT(1),17400B) .EQ. 0) RETURN GO TO 2300 C C****************** CHECK STATUS AFTER SEEK COMMAND ****************** C C 7910 ONLY !! *** IGNORE IDC STAT 20B (ILLEGAL ACCESS TO SPARE TRACK) C 2100 IF (ITYPE .NE. 5) GO TO 2200 IF (ISTAT(1) .EQ. 110000B) ISTAT(1)=17400B C C STATUS-2: E-BIT SHOULD BE ZERO C STATUS-1: IDC STAT SHOULD BE 37B C 2200 IF (IAND(ISTAT(2),100000B) .NE. 0) GO TO 2300 IF (IAND(ISTAT(1),17400B) .EQ. 17400B) RETURN C C CHECK FOR NORMAL COMPLETION (ICD STAT 0) C IF (ISTAT(1) .EQ. 0) RETURN C C***************** STATUS ERROR, REPORT ERROR MESSAGE **************** C 2300 CALL ERMSG(ICOM) RETURN END SUBROUTINE ERMSG(ICOM) COMMON NAME(3),ISTAT(2),ISIZE(2) COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER C C THIS SUBROUTINE DETERMINES THE ERROR AND REPORTS C ALL POSSIBLE STATUS ERRORS TO THE LOG DEVICE. C C IUNIT=IAND(IDVID,7) C C********************* INCREMENT NUMBER OF ERRORS ******************** C NERR=NERR+1 C C************************ STATUS ERROR MESSAGE *********************** C IF (ICOM .EQ. 1) WRITE(LULOG,9010) NAME,LUDSK,ISTAT(1),ISTAT(2) 9010 FORMAT(/,2X,3A2,"- LU#",I3,": DISC STATUS ERROR! ", 1 "S1=",@6,2X,"S2=",@6) IF (ICOM .EQ. 1) GO TO 9050 C C************************* READ ERROR MESSAGE ************************ C IF (ICOM .EQ. 2) WRITE(LULOG,9020) NAME,LUDSK,ISTAT(1),ISTAT(2) 9020 FORMAT(/,2X,3A2,"- LU#",I3,": DISC READ ERROR! ", 1 "S1=",@6,2X,"S2=",@6) C C************************ VERIFY ERROR MESSAGE *********************** C IF (ICOM .EQ. 3) WRITE(LULOG,9030) NAME,LUDSK,ISTAT(1),ISTAT(2) 9030 FORMAT(/,2X,3A2,"- LU#",I3,": DISC VERIFY ERROR! ", 1 "S1=",@6,2X,"S2=",@6) C C************* REPORT LOGICAL AND PHYSICAL DISC ADDRESS ************* C WRITE(LULOG,9040) LTRK,ICYL,IHEAD,IUNIT 9040 FORMAT(18X,"TRACK#",I4,", CYL#",I4,", HEAD#",I2,", UNIT#",I2) C C*********************** PROCESS STATUS-1 ERROR ********************** C 9050 IS1=IAND(ISTAT(1),17400B) IS1=IS1/400B C IF (IS1 .EQ. 1) WRITE(LULOG,9101) IF (IS1 .EQ. 3) WRITE(LULOG,9103) IF (IS1 .EQ. 7) WRITE(LULOG,9107) IF (IS1 .EQ. 10B) WRITE(LULOG,9110) IF (IS1 .EQ. 11B) WRITE(LULOG,9111) IF (IS1 .EQ. 12B) WRITE(LULOG,9112)E2 IF (IS1 .EQ. 14B) WRITE(LULOG,9114) IF (IS1 .EQ. 16B) WRITE(LULOG,9116) IF (IS1 .EQ. 20B) WRITE(LULOG,9120) IF (IS1 .EQ. 21B) WRITE(LULOG,9121) IF (IS1 .EQ. 22B) WRITE(LULOG,9122) IF (IS1 .EQ. 23B) WRITE(LULOG,9123) IF (IS1 .EQ. 26B) WRITE(LULOG,9126) IF (IS1 .EQ. 27B) WRITE(LULOG,9127) IF (IS1 .EQ. 37B) WRITE(LULOG,9137) C C********************** PROCESS STATUS-2 ERROR *********************** C IS2=IAND(ISTAT(2),37B) C C C C IF (IAND(IS2,3) .EQ. 1) WRITE(LULOG,9201) IF (IAND(IS2,3) .EQ. 2) WRITE(LULOG,9202) IF (IAND(IS2,3) .EQ. 3) WRITE(LULOG,9203) IF (IAND(IS2,4) .EQ. 4) WRITE(LULOG,9204) IF (IAND(IS2,10B) .EQ. 10B) WRITE(LULOG,9210) IF (IAND(IS2,20B) .EQ. 20B) WRITE(LULOG,9220) RETURN C C************************** STATUS-1 ERRORS ************************** C 9101 FORMAT(18X,"STATUS-1 ERROR: ILLEGAL OPCODE") 9103 FORMAT(18X,"STATUS-1 ERROR: ILLEGAL DRIVE TYPE") 9107 FORMAT(18X,"STATUS-1 ERROR: CYLINDER MISCOMPARE") 9110 FORMAT(18X,"STATUS-1 ERROR: UNCORRECTABLE DATA ERROR") 9111 FORMAT(18X,"STATUS-1 ERROR: HEAD/SECTOR MISCOMPARE") 9112 FORMAT(18X,"STATUS-1 ERROR: I/O PROGRAM ERROR") 9114 FORMAT(18X,"STATUS-1 ERROR: END OF CYLINDER") 9116 FORMAT(18X,"STATUS-1 ERROR: DATA OVERRUN") 9120 FORMAT(18X,"STATUS-1 ERROR: ILLEGAL ACCESS TO SPARE TRACK") 9121 FORMAT(18X,"STATUS-1 ERROR: DEFECTIVE TRACK") 9122 FORMAT(18X,"STATUS-1 ERROR: ACCESS NOT READY DURING OPERATION") 9123 FORMAT(18X,"STATUS-1 ERROR: STATUS-2 ERROR") 9126 FORMAT(18X,"STATUS-1 ERROR: ATTEMPT TO WRITE ON PROTECTED TRACK") 9127 FORMAT(18X,"STATUS-1 ERROR: UNIT UNAVAILABLE") 9137 FORMAT(18X,"STATUS-1 ERROR: DRIVE ATTENTION") C C************************** STATUS-2 ERRORS ************************** C 9201 FORMAT(18X,"STATUS-2 ERROR: DRIVE BUSY") 9202 FORMAT(18X,"STATUS-2 ERROR: DRIVE NOT READY") 9203 FORMAT(18X,"STATUS-2 ERROR: NO DISC t_TRNOR HEADS UNLOADED") 9204 FORMAT(18X,"STATUS-2 ERROR: SEEK OUT OF BOUND") 9210 FORMAT(18X,"STATUS-2 ERROR: FIRST STATUS BIT SET") 9220 FORMAT(18X,"STATUS-2 ERROR: DRIVE FAULT") 9240 FORMAT(18X,"STATUS-2 ERROR: DISC WRITE PROTECTED") END SUBROUTINE EQTLK(IOPTN) C C THIS SUBROUTINE LOCKS THE PROGRAM INTO MEMORY AND LOCKS C THE DISC EQT DURING CRITICAL DISC I/O OPERATIONS. C C COMMON NAME(3),ISTAT(2),ISIZE(2) COMMON LULOG,NERR,LOOP,LMAX,NEXT,INCR,MASK,LOG COMMON ITYPE,LUDSK,IDVID,LTRK,ICYL,IHEAD,ISECT,IER IF (IOPTN .EQ. 1) CALL EXEC(22,IOPTN) CALL EQTRQ(IOPTN,LUDSK) CALL ABREG(IA,IB) IF (IOPTN .EQ. 0) CALL EXEC(22,IOPTN) IF (IA .EQ. 0) RETURN WRITE(LULOG,1000) NAME,LUDSK 1000 FORMAT(/,2X,3A2,"- LU#",I3,": LOCK/UNLOCK ERROR!") WRITE(LULOG,1100) NAME,LUDSK 1100 FORMAT(/,2X,3A2,"- LU#",I3,": DISC TEST ABORTED!",/) CALL EXEC(6) END END$ JT  91711-18034 1926 S C0122 #TXPM0 TXPM0 LOADR COMMAND FIL             H0101 d* LOADER COMMAND FILE FOR PROGRAM TXPM0 1926 91711-18034 RE,%TXPM0 SE,%RODFK EN P  91711-18035 1926 S C0122 #TXPM1 TXPM1 LOADR COMMAND FIL             H0101 f* LOADER COMMAND FILE FOR PROGRAM TXPM1. 1926 91711-18035 RE,%TXPM1 SE,%NPART EN q  91711-18036 1926 S C0122 #TXPM2 TXPM2 LOADR CMD FILE             H0101 * LOADER COMMAND FILE FOR PROGRAM TXPM2. 1926 91711-18036 OP,LB OP,NC RE,%TXPM2 EN   91711-18037 1926 S C0122 #TXPF0 TXPF0 LOADER COMM. FILE             H0101 * LOADER COMMAND FILE FOR PROGRAM TXPF0. 1926 91711-18037 OP,LB RE,%EMAVF RE,%TXPF0 RE,%RPTBL RE,%HFPVF RE,%FFPVF RE,%SISVF RE,%VISVF RE,%DISVF RE,%MORFE FO EN   91711-18038 1926 S C0122 #TXMV0 TXPM0 LOADER COMM. FILE             H0101 (* LOADER COMMAND FILE FOR PROGRAM TXMV0. 1926 91711-18038 RE,%TXMV0 EN ~  91711-18039 1926 S C0122 #TXDS0 TXDS0 LOADER COMM FILE             H0101 * LOADER COMMAND FILE FOR PROGRAM TXDS0. 1926 91711-18039 OP,SS RE,%TXDS0 EN E  91711-18040 1926 S C0122 #TXIB0 TXIB0 LOADER COMM. FILE             H0101 * LOADER COMMAND FILE FOR PROGRAM TXIB0. 1926 91711-18040 RE,%TXIB0 SE,%IB4A EN N  91711-18041 1926 S C0122 #TXMT0 TXMT0 LOADER COMM. FILE             H0101 * LOADER COMMAND FILE FOR PROGRAM TXMT0. 1926 91711-18041 RE,%TXMT0 EN {  91711-18042 1926 S C0122 #TXWL0 TXWL0 LOADER COMM. FILE             H0101  * LOADER COMMAND FILE FOR PROGRAM TXWL0. 1926 91711-18042 RE,%TXWL0 EN k  91711-18043 1926 S C0122 #TXTT0 TXTT0 LOADER COMM. FILE             H0101 %%* LOADER COMMAND FILE FOR PROGRAM TXTT0. 1926 91711-18043 RE,%TXTT0 EN {  91711-18044 1926 S C0122 #TXTT1 TXTT1 LOADER COMM. FILE             H0101 '&* LOADER COMMAND FILE FOR PROGRAM TXTT1. 1926 91711-18044 RE,%TXTT1 EN {  91711-18045 1926 S C0122 #TXTR0 TXTR0 LOADER COMM. FILE             H0101 %#* LOADER COMMAND FILE FOR PROGRAM TXTR0. 1926 91711-18045 RE,%TXTR0 EN w  91711-18046 1926 S C0122 #TXTD0 TXTD0 LOADER COMM. FILE             H0101 * LOADER COMMAND FILE FOR PROGRAM TXTD0. 1926 91711-18046 RE,%TXTD0 EN [  91711-18047 1926 S C0122 #TXTD1 TXTD1 LOADER COMM. FILE             H0101 * LOADER COMMAND FILE FOR PROGRAM TXTD1 1926 91711-18047 LI,%XXTD1 LI,%DECAR RE,%TXTD1 RE,%TXTD2 RE,%TXTD3 RE,%CFTML RE,%IWRZZ RE,%IMPTM EN   91711-18048 2001 S C0122 #TXMV1 TXMV1 LOADR COMM. FILE             H0101 7* LOADER COMMAND FILE FOR PROGRAM TXMV1. 2001 91711-18048 LI,$DSCLB RE,%TXMV1 EN L  91711-18101 1926 S C0122 &RODSK HFP DIAG. SUBROUTINE             H0101 ASMB,R,L,T NAM RODSK 91711-16101 REV 1926 790429 SUP * ENT RODSK EXT .ENTR * EFPP NOP RODSK NOP JSB .ENTR DEF EFPP * * * * FLOATING POINT PROCESSOR INSTRUCTION SET EXECUTION * -------------------------------------------------- * CLA CLEAR ERR COUNTER STA EFPP,I LDA LPCT SET LOOP COUNTER STA LOPCT * * SKP * * SINGLE PRECISION FLOATING POINT INSTRUCTIONS * START DLD D001 OCT 105000 FAD DEF D002 CPA D100 SOC JSB ERR CPB D100+1 RSS JSB ERR * DLD D001+1 OCT 105000 DEF D002+1 CPA D101 SOC JSB ERR CPB D101+1 RSS JSB ERR * DLD D002 OCT 105020 FSB DEF D003 CPA D102 SOC JSB ERR CPB D102+1 RSS JSB ERR * DLD D002+1 OCT 105020 DEF D003+1 CPA D103 SOC JSB ERR CPB D103+1 RSS JSB ERR * SKP * DLD D003 OCT 105040 FMP DEF D004 CPA D104 SOC JSB ERR CPB D104+1 RSS JSB ERR * DLD D003+1 OCT 105040 DEF D004+1 CPA D105 SOC JSB ERR CPB D105+1 RSS JSB ERR * DLD D004 OCT 105060 FDV DEF D005 CPA D106 SOC JSB ERR CPB D106+1 RSS JSB ERR * DLD D004+1 OCT 105060 DEF D005+1 CPA D107 SOC JSB ERR CPB D107+1 RSS JSB ERR * SKP * DLD D005 OCT 105100 FIX CPA D108 SOC JSB ERR * DLD D005+1 OCT 105100 CPA D108+1 SOS JSB ERR * DLD D006 OCT 105100 CPA D108+2 SOC JSB ERR * LDA D006 CLO OCT 105120 FLOAT@ CPA D109 SOC JSB ERR CPB D109+1 RSS JSB ERR * LDA D006+1 OCT 105120 CPA D110 SOC JSB ERR CPB D110+1 RSS JSB ERR * LDA D007 OCT 105120 CPA D111 SOC JSB ERR CPB D111+1 RSS JSB ERR * SKP * DLD D001 OCT 105104 FIXD CPA D112 SOS JSB ERR CPB D112+1 RSS JSB ERR * DLD D001+1 OCT 105104 CPA D113 SOC JSB ERR CPB D113+1 RSS JSB ERR * DLD D003 OCT 105104 CPA D114 SOS JSB ERR CPB D114+1 RSS JSB ERR * DLD D004 OCT 105124 FLOATD CPA D115 SOC JSB ERR CPB D115+1 RSS JSB ERR * DLD D005 OCT 105124 CPA D116 SOC JSB ERR CPB D116+1 RSS JSB ERR * DLD D006 OCT 105124 CPA D117 SOC JSB ERR CPB D117+1 RSS JSB ERR * SKP * * * DOUBLE PRECISION FLOATING POINT INSTRUCTIONS * OCT 105001 XADD DEF RES DEF D001 DEF D001+1 DLD RES CPA D200 SOC JSB ERR CPB D200+1 RSS JSB ERR LDA RES+2 CPA D200+2 RSS JSB ERR * OCT 105001 DEF RES DEF D002 DEF D002+1 DLD RES CPA D201 SOC JSB ERR CPB D201+1 RSS JSB ERR LDA RES+2 CPA D201+2 RSS JSB ERR * OCT 105001 DEF RES DEF D003 DEF D003+1 DLD RES CPA D202 SOC JSB ERR CPB D202+1 RSS JSB ERR LDA RES+2 CPA D202+2 RSS JSB ERR * SKP * OCT 105021 XSUB DEF RES DEF 8D004 DEF D004+1 DLD RES CPA D203 SOC JSB ERR CPB D203+1 RSS JSB ERR LDA RES+2 CPA D203+2 RSS JSB ERR * OCT 105021 DEF RES DEF D005 DEF D005+1 DLD RES CPA D204 SOC JSB ERR CPB D204+1 RSS JSB ERR LDA RES+2 CPA D204+2 RSS JSB ERR * OCT 105021 DEF RES DEF D006 DEF D001 DLD RES CPA D205 SOC JSB ERR CPB D205+1 RSS JSB ERR LDA RES+2 CPA D205+2 RSS JSB ERR * SKP * OCT 105041 XMPY DEF RES DEF D001+1 DEF D002 DLD RES CPA D206 SOS JSB ERR CPB D206+1 RSS JSB ERR LDA RES+2 CPA D206+2 RSS JSB ERR * OCT 105041 DEF RES DEF D002+1 DEF D003 DLD RES CPA D207 SOC JSB ERR CPB D207+1 RSS JSB ERR LDA RES+2 CPA D207+2 RSS JSB ERR * OCT 105041 DEF RES DEF D003+1 DEF D004 DLD RES CPA D208 SOC JSB ERR CPB D208+1 RSS JSB ERR LDA RES+2 CPA D208+2 RSS JSB ERR * SKP * OCT 105061 XDIV DEF RES DEF D004+1 DEF D005 DLD RES CPA D209 SOC JSB ERR CPB D209+1 RSS JSB ERR LDA RES+2 CPA D209+2 RSS JSB ERR * OCT 105061 DEF RES DEF D005+1 DEF D006 DLD RES CPA D210 SOC JSB ERR CPB D210+1 RSS JSB ERR LDA RES+2 CPA D210+2 RSS JSB ERR * OCT 105061 DEF RES DEF D001 DEF D001+1 DLD RES CPA D211 l SOS JSB ERR CPB D211+1 RSS JSB ERR LDA RES+2 CPA D211+2 RSS JSB ERR * SKP * OCT 105101 XFXS DEF D001 CPA D212 SOC JSB ERR * OCT 105101 DEF D006+1 CPA D212+1 SOC JSB ERR * OCT 105101 DEF D001+1 CPA D212+2 SOS JSB ERR * OCT 105105 XFXD DEF D002 CPA D213 SOS JSB ERR CPB D213+1 RSS JSB ERR * OCT 105105 DEF D005 CPA D214 SOC JSB ERR CPB D214+1 RSS JSB ERR * OCT 105105 DEF D006+1 CPA D215 SOC JSB ERR CPB D215+1 RSS JSB ERR * SKP * LDA D002 OCT 105121 XFTS DEF RES DLD RES CPA D216 SOC JSB ERR CPB D216+1 RSS JSB ERR LDA RES+2 CPA D216+2 RSS JSB ERR * LDA D003 OCT 105121 DEF RES DLD RES CPA D217 SOC JSB ERR CPB D217+1 RSS JSB ERR LDA RES+2 CPA D217+2 RSS JSB ERR * LDA D007 OCT 105121 DEF RES DLD RES CPA D218 SOC JSB ERR CPB D218+1 RSS JSB ERR LDA RES+2 CPA D218+2 RSS JSB ERR * SKP * DLD D001 OCT 105125 XFTD DEF RES DLD RES CPA D219 SOC JSB ERR CPB D219+1 RSS JSB ERR LDA RES+2 CPA D219+2 RSS JSB ERR * DLD D003 OCT 105125 DEF RES DLD RES CPA D220 SOC JSB ERR CPB D220+1 RSS JSB ERR LDA RES+2 CPA D220+2 RSS JSB ERR * DLD D007 OCT 105125 DEF RES &G DLD RES CPA D221 SOC JSB ERR CPB D221+1 RSS JSB ERR LDA RES+2 CPA D221+2 RSS JSB ERR * SKP * ISZ LOPCT UPDATE LOOP COUNTER JMP START JMP RODSK,I * * ERR NOP INCREMENT ERR COUNT & RETURN ISZ EFPP,I NOP JMP ERR,I * LPCT DEC -100 LOPCT OCT 0 * SKP * D001 OCT 040000 OCT 040370 D002 OCT 052525 OCT 052770 D003 OCT 121254 OCT 066122 D004 OCT 121113 OCT 044005 D005 OCT 130702 OCT 054477 D006 OCT 115062 OCT 040371 D007 OCT 000000 OCT 000012 * * D100 OCT 045252 OCT 145772 D101 OCT 052770 OCT 121254 D102 OCT 052525 OCT 052770 D103 OCT 052770 OCT 121254 D104 OCT 042122 OCT 076527 D105 OCT 074746 OCT 114012 D106 OCT 046246 OCT 073711 D107 OCT 063513 OCT 050220 D108 OCT 0 OCT 077777 OCT 0 D109 OCT 115062 OCT 000036 D110 OCT 040371 OCT 000036 D111 OCT 0 OCT 0 D112 OCT 077777 OCT 177777 D113 OCT 0 OCT 0 D114 OCT 077777 OCT 177777 D115 OCT 121113 OCT 044076 D116 OCT 130702 OCT 054476 D117 OCT 115062 OCT 040076 SKP RES OCT 0 OCT 0 OCT 0 * * D200 OCT 040370 OCT 052525 OCT 052770 D201 OCT 052525 OCT 052770 OCT 121254 D202 OCT 121254 OCT 066122 OCT 130113 D203 OCT 121113 OCT 044005 OCT 130702 D204 OCT 130702 OCT 054474 OCT 150062 D205 OCT 115062 OCT 040371 OCT 0 D206 OCT 077777 OCT 177777 OCT 177776 D207 OCT 101242 OCT 067312 OCT 101633 D208 OCT 130263 OCT 003057 OCT 016307 D209 OCT 105054 OCT 063261 OCT 117015 D210 OCT 107711 OCT 033204 OCT 034371 D211 OCT 0 OCT 0 OCT 0 D212 OCT 0 9$" OCT 000020 OCT 077777 D213 OCT 077777 OCT 177777 D214 OCT 177307 OCT 004545 D215 OCT 0 OCT 000020 D216 OCT 052525 OCT 0 OCT 000036 D217 OCT 121254 OCT 0 OCT 000036 D218 OCT 0 OCT 0 OCT 0 D219 OCT 040000 OCT 040370 OCT 000076 D220 OCT 121254 OCT 066122 OCT 000076 D221 OCT 050000 OCT 0 OCT 000010 END ?$   91711-18102 1926 S C0122 &TXPF2 SCNTFC. INST. SET DIAG.             H0101 >FTN4,L PROGRAM TXPF2(3,89),91711-16102 REV 1926 791113 C C CHANGED 791113. MAKE CPU M,E,OR F CHECK, AND IF M C THEN STOP WITH APPROPRIATE MESSAGE. C DIMENSION IPARM(5) C C********************************************************************* C* C* SCIENTIFIC INSTRUCTION SET DIAGNOSTIC. C* C* :RU,TXPF2,LGLU,#PASSES C* C* WHERE LGLU = LOGICAL UNIT FOR MESSAGES. C* #PASSES = NUMBER OF TIMES TO RUN TEST. C* C********************************************************************* C C* PICK UP RUN TIME PARAMETERS C CALL RMPAR(IPARM) LGLU = IPARM(1) IF(LGLU.LE.0B) LGLU = LOGLU(IPARM(1)) IPASS = IPARM(2) IF(IPASS.LE.0B) IPASS = 1 C C* INITIALISE ERROR COUNTER C IECNT = 0 C C********************************************************************* C C THE FOLLOWING BLOCK OF LINES ADDED 791113 C C FIND OUT IF THE COMPUTER IS AN M OR AN E/F MACHINE C CALL MORFE(ICODE) IF (ICODE.EQ.1) GOTO 5 WRITE (LGLU,850) STOP 12 850 FORMAT(/" TXPF2 - PROGRAM CAN ONLY RUN IN AN E OR F MACHINE"/) 5 CONTINUE C C******************************************************************** C C* FIND OUT IF HARDWARE FLOATING POINT IS PRESENT C* AND IF SCIENTIFIC INSTRUCTION SET IS PRESENT. C* IF ONE OR OTHER ABSENT EXIT WITH SUITABLE ERROR MESSAGE. C CALL SISVF(SISREV) IF(SISREV.NE.0B) GOTO 10 WRITE(LGLU,800) STOP 10 10 CALL HFPVF(HFPREV) IF(HFPREV.NE.0B) GOTO 20 WRITE(LGLU,810) STOP 11 C C* OUTPUT TEST RUNNING MESSAGE. C 20 WRITE(LGLU,820) C C* RUN THE SCIENTIFIC INSTRUCTION SET TEST C DO 30 J=1,IPASS CALL RODTK(IECNT) 30 CONTINUE C C* CHECK FOR ERRORS AND PRINT MESSAGES, IF NECESSARY. C IF(IECNT.GT.0B) WRITE(LGLU,830) C C* PRINT COMPLETION MESSAGE C WRITE(LGLU,840)IPASS,IECNT C 800 FORMAT(/" TXPF2 - SIS NOT   INSTALLED AND TEST ABORTED!"/) 810 FORMAT(/" TXPF2 - HFPP NOT INSTALLED AND TEST ABORTED!"/) 820 FORMAT(/" TXPF2 - SIS TEST RUNNING") 830 FORMAT(/" TXPF2 - SIS TEST FAILURE") 840 FORMAT(/" TXPF2 - SIS TEST FINISHED",I5," PASSES",I5," ERRORS") C END END$ S   91711-18103 1926 S C0122 &RODTK SIS DIAG. SUBROUTINE             H0101 *ASMB,R,L,T NAM RODTK 91711-16103 REV 1926 790430 SUP * ENT RODTK EXT .ENTR * ESIS NOP RODTK NOP JSB .ENTR DEF ESIS * * * * * SCIENTIFIC INSTRUCTION SET EXECUTION * ------------------------------------ * * CLA CLEAR ERR COUNTER STA ESIS,I LDA LPCT SET LOOP COUNTER STA LOPCT * * * EXECUTE ALL SIS INSTR. WITHOUT ERROR RETURN * (RETURN ADDRESS = SIS INSTR. ADDR. + 2) * START LDA STTP1 GET DATA TABLE POINTER STA TBPT LDA FINP1 GET INSTR. TABLE POINTER STA INSPT LDA INSPT,I STORE SIS INSTR IN PROGRAM SISE1 STA INST1 LDA M4 GET LOOP COUNT STA LCT * DLD TBPT,I EXECUTE FETCHED SIS INSTR. INST1 OCT 0 JSB ERR ERROR JSB TSTRT GO & TEST RESULT ISZ LCT HAVE ALL 4 VALUES BEEN TESTED? JMP INST1-2 NO, RETURN * ISZ INSPT YES, GET NEXT INSTR. LDA INSPT,I SZA IS IT LAST ONE? JMP SISE1 NO, RETURN * * * SKP * * EXECUTE ALL SIS INSTR. WITH ERROR RETURN * (RETURN ADDRESS = SIS INSTR. ADDR. + 1) * LDA STTP2 GET DATA TABLE POINTER STA TBPT LDA FINP2 GET INSTR. TABLE POINTER STA INSPT LDA INSPT,I STORE SIS INSTR IN PROGRAM SISE2 STA INST2 LDA M4 GET LOOP COUNT STA LCT * DLD TBPT,I EXECUTE FETCHED SIS INSTR. INST2 OCT 0 RSS JSB ERR JSB TSTRT GO & TEST RESULT ISZ LCT HAVE ALL 4 VALUES BEEN TESTED? JMP INST2-2 NO, RETURN * ISZ INSPT YES, GET NEXT INSTR. LDA INSPT,I SZA IS IT LAST ONE? JMP SISE2 NO, RETURN * ISZ LOPCT JMP START JMP RODTK,I YES * * * * SUBROUTINE TO TEST SIS INSTR. RESULT * TSTRT NOP ISZ TBPT ISZ TBPT CPA TBPT,I RSS JSB ERR ISZ TBPT  CPB TBPT,I RSS JSB ERR ISZ TBPT JMP TSTRT,I * * * * SUBROUTINE TO INCRMENT ERROR COUNTER * ERR NOP ISZ ESIS,I NOP JMP ERR,I * SKP * LPCT DEC -100 LOPCT OCT 0 * TBPT OCT 0 * * * DATA TABLE, NO ERROR RETURN * STTP1 DEF *+1 * OCT 040000 TAN OCT 000000 OCT 042755 OCT 036400 * OCT 040000 OCT 000002 OCT 061654 OCT 110402 * OCT 100001 OCT 000002 OCT 042756 OCT 135404 * OCT 100001 OCT 000000 OCT 116125 OCT 022402 * * OCT 000000 SQRT OCT 000000 OCT 000000 OCT 000000 * OCT 040000 OCT 000377 OCT 040000 OCT 000000 * OCT 044000 OCT 000004 OCT 060000 OCT 000002 * OCT 044770 OCT 000050 OCT 060515 OCT 136024 * SKP * OCT 040000 ALOG OCT 000000 OCT 123506 OCT 172000 * OCT 060000 OCT 000000 OCT 133132 OCT 074377 * OCT 050000 OCT 001012 OCT 057735 OCT 005404 * OCT 077777 OCT 000441 OCT 131136 OCT 011416 * * OCT 040000 COS OCT 000000 OCT 070124 OCT 120000 * OCT 077000 OCT 000020 OCT 062037 OCT 103400 * OCT 137040 OCT 060010 OCT 120376 OCT 107777 * OCT 100000 OCT 006331 OCT 040000 OCT 000002 * SKP * OCT 040000 SIN OCT 000000 OCT 075273 OCT 120777 * OCT 040000 OCT 000002 OCT 065665 OCT 050400 * OCT 100001 OCT 000000 OCT 112113 OCT 034000 * OCT 076600 OCT 000321 OCT 076577 OCT 177321 * * OCT 040000 EXP OCT 000000 OCT 064604 OCT 123402 * OCT 040000 +H OCT 000002 OCT 053374 OCT 026004 * OCT 123100 OCT 000016 OCT 000000 OCT 000000 * OCT 100000 OCT 000016 OCT 000000 OCT 000000 * SKP * OCT 040000 ALOGT OCT 000000 OCT 131357 OCT 131777 * OCT 077777 OCT 000304 OCT 073000 OCT 171012 * OCT 071110 OCT 000077 OCT 105400 OCT 160012 * OCT 040000 OCT 001235 OCT 102456 OCT 002010 * SKP * * DATA TABLE, WITH ERROR RETURN * STTP2 DEF *+1 * OCT 040000 TAN OCT 000040 OCT 030071 OCT 047522 * OCT 040000 OCT 000376 OCT 030071 OCT 047522 * OCT 134401 OCT 000070 OCT 030071 OCT 047522 * OCT 100001 OCT 000314 OCT 030071 OCT 047522 * * OCT 100001 SQRT OCT 000000 OCT 030063 OCT 052516 * OCT 140000 OCT 000377 OCT 030063 OCT 052516 * OCT 144000 OCT 000004 OCT 030063 OCT 052516 * OCT 100770 OCT 000050 OCT 030063 OCT 052516 * SKP * OCT 000000 ALOG OCT 000000 OCT 030062 OCT 052516 * OCT 100001 OCT 000000 OCT 030062 OCT 052516 * OCT 100000 OCT 001012 OCT 030062 OCT 052516 * OCT 000000 OCT 000400 OCT 030062 OCT 052516 * * OCT 000000 ATAN OCT 000000 OCT 000000 OCT 000000 * OCT 040000 OCT 000000 OCT 073261 OCT 116377 * OCT 040000 OCT 000377 OCT 076555 OCT 154775 * OCT 100001 OCT 000004 OCT 125445 OCT 166002 * SKP OCT 040000 COS OCT 000040 OCT 030065 OCT 047522 * OCT 077000 OCT 000320 OCT 030065 OCnT 047522 * OCT 137000 OCT 000070 OCT 030065 OCT 047522 * OCT 040000 OCT 006440 OCT 030065 OCT 047522 * * OCT 040000 SIN OCT 000040 OCT 030065 OCT 047522 * OCT 077700 OCT 000042 OCT 030065 OCT 047522 * OCT 100070 OCT 000130 OCT 030065 OCT 047522 * OCT 055500 OCT 000066 OCT 030065 OCT 047522 * SKP * OCT 040000 EXP OCT 000020 OCT 030067 OCT 047506 * OCT 040000 OCT 000040 OCT 030067 OCT 047506 * OCT 077667 OCT 000106 OCT 030067 OCT 047506 * OCT 052563 OCT 000024 OCT 030067 OCT 047506 * * OCT 000000 ALOGT OCT 000000 OCT 030062 OCT 052516 * OCT 100000 OCT 000000 OCT 030062 OCT 052516 * OCT 131101 OCT 110002 OCT 030062 OCT 052516 * OCT 123500 OCT 022733 OCT 030062 OCT 052516 * SKP * OCT 040000 TANH OCT 000377 OCT 076545 OCT 176775 * OCT 040000 OCT 000002 OCT 060573 OCT 166000 * OCT 040000 OCT 000010 OCT 040000 OCT 000002 * OCT 100001 OCT 000010 OCT 100000 OCT 000000 * SKP * * INSPT OCT 0 * FINP1 DEF *+1 * OCT 105320 OCT 105321 OCT 105322 OCT 105324 OCT 105325 OCT 105326 OCT 105327 OCT 0 * * * FINP2 DEF *+1 * OCT 105320 OCT 105321 OCT 105322 OCT 105323 OCT 105324 OCT 105325 OCT 105326 OCT 105327 OCT 105330 OCT 0 * * * M4 OCT 177774 LCT OCT 0 * END * * * EXECUTE ALL SIS INSTR. WITH ERROR RETURN * (RETURN ADDRESS = SIS INSTR. ADDR. + 1) * LDA STTP2  GET DATA TABLE POINTER STA TBPT LDA FINP2 GET INSTR. TABLE POINTER STA INSPT LDA INSPT,I STORE SIS INSTR IN PROGRAM JSB SISEX GO & EXECUTE SIS INSTR * * HLT 77B * SKP * * SUBROUTINE TO EXECUTE SIS INSTR * SISEX NOP STA INST LDA M4 GET LOOP COUNT STA LCT * DLD TBPT,I EXECUTE FETCHED SIS INSTR. INST OCT 0 HLT 1B ERROR JSB TSTRT GO & TEST RESULT ISZ LCT HAVE ALL 4 VALUES BEEN TESTED? JMP INST-1 NO, RETURN * ISZ INSPT YES, GET NEXT INSTR. LDA INSPT,I SZA IS IT LAST ONE? JMP SISEX+1 NO, RETURN JMP SISEX,I YES, EXIT SUBROUTINE * * * * * * * SUBROUTINE TO TEST SIS INSTR. RESULT * TSTRT NOP ISZ TBPT ISZ TBPT CPA TBPT,I RSS HLT 1B ISZ TBPT CPB TBPT,I RSS HLT 1B ISZ TBPT JMP TSTRT,I * SKP * TBPT OCT 0 * * * DATA TABLE, NO ERROR RETURN * STTP1 DEF *+1 * OCT 040000 TAN OCT 000000 OCT 042755 OCT 036400 * OCT 040000 OCT 000002 OCT 061654 OCT 110402 * OCT 100001 OCT 000002 OCT 042756 OCT 135404 * OCT 100001 OCT 000000 OCT 116125 OCT 022402 * * OCT 000000 SQRT OCT 000000 OCT 000000 OCT 000000 * OCT 040000 OCT 000377 OCT 040000 OCT 000000 * OCT 044000 OCT 000004 OCT 060000 OCT 000002 * OCT 044770 OCT 000050 OCT 000050 OCT 000050 * SKP * OCT 040000 ALOG OCT 000000 OCT 123506 OCT 172000 * OCT 060000 OCT 000000 OCT 133132 OCT 074377 * OCT 050000 OCT 001012 OCT 000000 OCT 000000 * OCT 077777 OCT 000441 OCT 0000'{00 OCT 000000 * * OCT 040000 COS OCT 000000 OCT 070124 OCT 120000 * OCT 077000 OCT 000020 OCT 000000 OCT 000000 * OCT 147000 OCT 000010 OCT 000000 OCT 000000 * OCT 040000 OCT 006440 OCT 000000 OCT 000000 * SKP * OCT 040000 SIN OCT 000000 OCT 075273 OCT 120777 * OCT 040000 OCT 000002 OCT 065665 OCT 050400 * OCT 100001 OCT 000000 OCT 112113 OCT 034000 * OCT 076600 OCT 000021 OCT 000000 OCT 000000 * * OCT 040000 EXP OCT 000000 OCT 064604 OCT 123402 * OCT 040000 OCT 000002 OCT 053374 OCT 026004 * OCT 123100 OCT 000016 OCT 000000 OCT 000000 * OCT 100000 OCT 000016 OCT 000000 OCT 000000 * SKP * OCT 040000 ALOGT OCT 000000 OCT 131357 OCT 131777 * SKP * * DATA TABLE, WITH ERROR RETURN * STTP2 DEF *+1 * OCT 040000 TAN OCT 000000 OCT 042755 OCT 036400 * OCT 040000 OCT 000002 OCT 061654 OCT 110402 * OCT 100001 OCT 000002 OCT 042756 OCT 135404 * OCT 100001 OCT 000000 OCT 116125 OCT 022402 * * OCT 000000 SQRT OCT 000000 OCT 000000 OCT 000000 * OCT 040000 OCT 000377 OCT 040000 OCT 000000 * OCT 044000 OCT 000004 OCT 060000 OCT 000002 * OCT 044770 OCT 000050 OCT 000050 OCT 000050 * SKP * OCT 040000 ALOG OCT 000000 OCT 123506 OCT 172000 * OCT 060000 OCT 000000 OCT 133132 OCT 074377 * OCT 050000 OCT 001012 OCT 000000 OCT 000000 * P*($ OCT 077777 OCT 000441 OCT 000000 OCT 000000 * * OCT 040000 COS OCT 000000 OCT 070124 OCT 120000 * OCT 077000 OCT 000020 OCT 000000 OCT 000000 * OCT 147000 OCT 000010 OCT 000000 OCT 000000 * OCT 040000 OCT 006440 OCT 000000 OCT 000000 * SKP * OCT 040000 SIN OCT 000000 OCT 075273 OCT 120777 * OCT 040000 OCT 000002 OCT 065665 OCT 050400 * OCT 100001 OCT 000000 OCT 112113 OCT 034000 * OCT 076600 OCT 000021 OCT 000000 OCT 000000 * * OCT 040000 EXP OCT 000000 OCT 064604 OCT 123402 * OCT 040000 OCT 000002 OCT 053374 OCT 026004 * OCT 123100 OCT 000016 OCT 000000 OCT 000000 * OCT 100000 OCT 000016 OCT 000000 OCT 000000 * SKP * OCT 040000 ALOGT OCT 000000 OCT 131357 OCT 131777 * SKP * * INSPT OCT 0 * FINP1 DEF *+1 * OCT 105320 OCT 105321 OCT 105322 OCT 105324 OCT 105325 OCT 105326 OCT 105327 OCT 0 * * * FINP2 DEF *+1 * OCT 105320 OCT 105321 OCT 105322 OCT 105323 OCT 105324 OCT 105325 OCT 105326 OCT 105327 OCT 105330 OCT 0 * * * M4 OCT 177774 LCT OCT 0 * END *   91711-18104 1926 S C0122 &TXPF3 EXTENDED MEMORY DIAG.             H0101 ASMB,R,L HED EMA FIRMAWARE ON-LINE DIAGNOSTIC TXPF3 NAM TXPF3,3,89 91711-16104 REV 1926 790606 * * FOR COSMETIC REASONS THE NAME #EMA HAS REPLACED THE NAME TXPF3. * THE PART NUMBERS AND DATE CODE HAVE ALSO BEEN CHANGED AS FOLLOWS:- * EXT EXEC,.DIO.,.IOI.,.DTA.,MMAP,.EMAP,.EMIO EXT $LIBR,$LIBX,IFBRK ENT TXPF3 EMAA EMA 0,0 * * DATE: 03/23/78 + + DATE: 06:06:79 * NAME: #EMA I I NAME: TXPF3 * SOURCE: 92067-18013 I-> CHANGED TO >I SOURCE: 91711-18104 * RELOC: 92067-16013 I I RELOC: 91711-16104 * PGMR: DJV + + CHANGED BY: HLN * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * EMA FIRMWARE ON-LINE DIAGNOSTIC * * THIS IS A DIAGNOSTIC FOR THE 21MX E-SERIES EMA FIRMWARE. * IT OPERATES UNDER CONTROL OF AN RTE-IV SYSTEM. * * TO EXECUTE: * * RU,TXPF3,LU,#TIMES * * PRINT MESSAGES ON LU. IF LU NEGATIVE, PRINT ONLY ERROR * MESSAGES. DEFAULT IS LU 1. #TIME IS NUMBER OF TIMES TO] * RUN THE DIAGNOSTIC. IF NEGATIVE, RUN CONTINUOUSLY. DEFAULT * IS ONCE. SET BREAK FLAG TO STOP. * A EQU 0 B EQU 1 XID EQU 1717B POINTS TO ID SEGMENT XIDEX EQU 1645B POINTS TO ID SEGMENT EXTENSION BPA2 EQU 1743B BASE PAGE FENCE SWAP EQU 1736B THE SWAP WORD * * SOME BASE PAGE CODE FOR FIRMWARE PRESENCE CHECK. * ORB JMP *+1,I DEF LABEL ORR * * FOLLOWING LOCATIONS ARE USED THROUGHOUT THE PROGRAM * ASV NOP PLACES TO SAVE A BIG OCT 77777 A BIG NUMBER BSV NOP 4 AND B CNTR NOP COUNTS NUMBER OF TIMES THROUGH THE PROGRAM EMASZ NOP WILL HOLD THE NUMBER OF PAGES OF EMA ERCNT NOP COUNTS NUMBER OF ERRORS FLAG NOP IF = 1, DON'T PRINT INFO MESSAGES LSMSG NOP THE LAST MSEG REG +1 LU NOP PUT THE OUTPUT LU HERE M1 DEC -1 MSEG NOP STORES MSEG SIZE IN PAGES NAME NOP POINTS TO NAME OF ROUTINE BEING TESTED (FOR ERRORS) NPAGE NOP HOLDS NUMBER OF PAGES ONE DEC 1 PAGE NOP STORES STARTING PHYSICAL PAGE OF THIS PROG PART NOP HOLDS THE PARTITION NUMBER SAMSG NOP HOLDS START ADDRESS OF MSEG SOFT NOP SET TO ONE IF USING SOFTWARE SPMSG NOP LOGICAL START PAGE MSEG STEMA NOP PHYSICAL START PAGE EMA SWPSV NOP TO SAVE THE SWAP WORD PGSTR NOP HOLDS STARTING LOGICAL PAGE OF THIS PROG TEMP NOP TMPDX NOP HOLDS ID EXT. WORD ZERO TSTNO NOP HOLDS THE CURRENT TEST NUMBER TWO DEC 2 ZERO NOP .1 DEC 1 .2 DEC 2 .6 DEC 6 .22 DEC 22 .25 DEC 25 .27 DEC 27 .29 DEC 29 .35 DEC 35 .1024 DEC 1024 * .EMAA DEF EMAA .NMAP DEF NMAP NMAP ASC 2,MMAP .NMMP DEF NMMP NMMP ASC 2,EMAP .NMMI DEF NMMI NMMI ASC 2,EMIO .MAPS DEF MAPS,I MAPS BSS 32 MAP REGISTERS WILL BE STORED HERE .#EMA DEF TXPF3 * TXPF3 CLE CLEAR A FLAG XLA B,I GET FIRST PARAM (LU) SZA,RSS SKIP IF NOT ZERO INA IF ZERO, MAKE 1 SSA SKIP IF POSITIVE CMA,CCE,INA IF NEG, MAKE POS, SET FLAG STA LU STORE THE LU CLA THE EXTEND BIT FLAGS THAT LU WAS NEG. ERA STA FLAG INB GET #TIMES XLA B,I SZA,RSS SKIP IF NOT ZERO INA IF ZERO, MAKE 1 CMA,INA MAKE NEGATIVE STA CNTR * * CHECK TO SEE IF FIRMWARE IS PRESENT. * CLA SET A = 0 OCT 105257 .EMAP OCT 0 DEF RTN OCT 0 DEF ARRAY OCT 0 DEF TABLE * JSB EXEC NO FIRMWARE. PRINT MESSAGE DEF *+5 AND STOP THE PROGRAM. DEF .2 DEF LU DEF NOFRM DEF .22 JSB EXEC TERMINATE THE PROGRAM. DEF *+2 DEF .6 HLT * LABEL LDA XID GET EMASZ ADA =D28 GO TO WORD 28 IN THE ID SEGMENT XLA A,I GET IT AND =B1777 STA EMASZ XLA XIDEX,I GET MSEG SIZE AND =B37 STA MSEG LDA .#EMA GET THE STARTING LOGICAL PAGE OF THIS PROG CLB ASR 10 STA PGSTR LDA XIDEX GET LOGICAL START PAGE MSEG INA XLA A,I ASL 5 STB A AND =B37 STA SPMSG FORM START PSAGE MSEG ADA MSEG FORM LAST PAGE OF MSEG+1 INA STA LSMSG SAVE IT LDA SPMSG ASL 10 MAKE LOGICAL START ADDRESS OF MSEG STA SAMSG LDA EMASZ COMPUTE MSEG-EMASZ CMA,INA ADA MSEG SSA IF MSEG>=EMASZ, CAN'T RUN JMP CANRN JUMP IF CAN RUN JSB EXEC PRINT MESSAGE DEF *+5 DEF .2 DEF LU DEF CNTRN DEF .35 JSB EXEC PRINT TERMINTED MESSAGE DEF *+5 DEF .2 DEF LU DEF TERM DEF .22 JSB EXEC NOW QUIT DEF *+2 DEF .6 CANRN LDA EMASZ SEE IF EMA BIG ENOUGH FOR A FULL TEST ADA =D-33 SSA,RSS IF NEGATIVE, TOO SMALL JMP ISFRM NEED EMASZ > 32 PAGES JSB EXEC TELL OPERATOR PARTITION TOO SMALL DEF *+5 DEF .2 DEF LU DEF TOSML DEF .27 ISFRM LDA CLMMP CHECK TO SEE IF THE EMA CALLS AND =B74000 HAVE BEEN RP'ED TO THE CPA =B14000 FIRMWARE OPCODES JMP SFTWR JUMP IF STILL JSB LDA CLEMP MUST CHECK ALL THREE AND =B74000 POSSIBLE CALLS CPA T=B14000 COMPARE TO A JSB JMP SFTWR JMP IF STILL A JSB LDA CLEMI CHECK EMIO AND =B74000 CPA =B14000 JMP SFTWR JMP START USING FIRMWARE, GO DO TESTS SFTWR CLA,INA SET A TO 1 STA SOFT SET SOFTWARE FLAG JSB EXEC TELL OPERATOR, USING SOFTWARE DEF START DEF .2 DEF LU DEF NOTFW DEF .35 START LDA SWAP SAVE THE SWAP WORD STA SWPSV JSB $LIBR NOW KLUDGE THE SWAP WORD NOP TO ALLOW SWAPPING LDA =B17 STA SWAP JSB $LIBX DEF *+1 DEF *+1 JSB EXEC NOW LOCK INTO MEMORY DEF *+3 DEF .22 DEF .1 SKP TST00 LDA .NMAP PUT ADDRESS OF "MMAP" IN NAME FOR ERROR OUTPUT STA NAME CLA INITIALIZE THE TEST COUNTER OTA 1 SET THE S REG STA TSTNO CLMMP JSB MMAP CALL MMAP WITH OFFSET NEGATIVE DEF *+3 DEF M1 A -1 FOR THE OFFSET DEF ONE CPA M1 A SHOULD BE -1 JMP TST01 IF SO, THEN DO NEXT TEST JSB NOER IF NOT, PRINT ERROR MESSAGE DEF TST01 * TST01 JSB INTST INCREMENT THE TEST NUMBER JSB MMAP DEF *+3 ASK FOR A NEGATIVE NUMBER OF PAGES DEF ONE DEF M1 CPA M1 A SHOULD BE -1 JMP TST02 IF IT IS, GO TO NEXT TEST JSB NOER PRINT ERROR MESSAGE DEF TST02 * TST02 JSB INTST INCREMENT THE TEST NUMBER LDA MSEG NOW BUILD A CALL TO ASK FOR MORE PAGES INA THAN ARE IN AN MSEG STA TEMP JSB MMAP DEF *+3 DEF ZERO A ZERO OFFSET DEF TEMP CPA M1 A SHOULD BE -1 JMP TST03 JUMP IF SO JSB NOER PRINT ERROR IF NOT DEF TST03 * TST03 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY LDA EMASZ NOW BUILD A REQUEST FOR PAGES BEYOND ADA M1 THE EMA STA {TEMP JSB MMAP DEF *+3 DEF TEMP OFFSET IS EMASZ-1 DEF TWO ASK FOR 2 PAGES CPA M1 A SHOULD BE -1 JMP TST04 JUMP IF SO JSB NOER OTHERWISE PRINT ERROR MESSAGE DEF TST04 * TST04 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY JSB MMAP DO A STANDARD MSEG AND A STANDARD DEF *+3 NUMBER OF PAGES DEF ZERO NO OFFSET DEF MSEG SZA,RSS A SHOULD BE ZERO.(SKIP IF IT IS NOT) JMP A4 JSB INCER PRINT ERROR MESSAGE DEF TST05 A4 JSB ICMPS CHECK MAPS. SHOULD BE INCREMENTAL DEF TST05 * TST05 JSB INTST INCREMENT THE TEST NUMBER AND DISPLAY LDA EMASZ ASK FOR 1 PAGE AT END OF EMA TO ADA M1 CHECK READ/WRITE PROTECT BITS. STA TEMP JSB MMAP DEF *+3 DEF TEMP DEF ONE WANT ONE PAGE SZA,RSS IF NOT ZERO, THEN ERROR JMP A5 JSB INCER PRINT ERROR DEF TST06 A5 JSB LSTMP LAST PAGE OF EMA SHOULD BE MAPPED IN DEF TST06 * TST06 LDA .NMMP CHANGE NAME TO EMAP STA NAME JSB INTST INCREMENT THE TEST NUMBER CLEMP JSB .EMAP CALL .EMAPFROM AN EMA PROGRAM AND DEF *+4 GIVE A NON-EMA ARRAY DEF NEMA START OF ARRAY DEF TNEM6 TABLE DEF ONE ASK FOR FIRST WORD JMPAA6 INCORRECT ERROR RETURN CPB .NEMA SEE IF ADDRESS RIGHT JMP TST07 JUMP IF SO JSB EMAPR ADDRESS WRONG, ERROR DEF TST07 A6 JSB INCER INCORRECT ERROR RETURN DEF TST07 TNEM6 DEC 1 ONE DIMENSION DEC -1 LOWER BOUND IS ONE DEC 1 ONE WORD PER ELEMENT NEMA NOP .NEMA DEF NEMA * TST07 JSB INTST INCREMENT AND DISPLAY THE TEST NUMBER JSB .EMAP TRY A ZERO DIMENSION ARRAY DEF *+4 DEF EMAA THE EMA ARRAY DEF TEMA7 DEF ONE THIS IS IGNORED  JMP A7 INCORRECT ERROR RETURN CPB SAMSG SHOULD BE START OF EMA AREA JMP B7 JUMP IF SO LDA SAMSG A HAS WHAT WAS EXPECTED JSB EMAPR PRINT REAL B, EXPECTED B DEF TST08 A7 JSB INCER BAD ERROR RETURN DEF TST08 B7 JSB TOMPS CHECK THE MAP REGISTERS DEF TST08 TEMA7 NOP ZERO DIMENSIONS DEC 0,0 NO OFFSET * TST08 JSB INTST INCREMENT TEST NUMBER JSB .EMAP TRY NEGATIVE NUMBER OF DIMENSIONS DEF *+4 DEF EMAA DEF TEMA8 THE TABLE DEF ONE JMP A8 SHOULD ERROR RETURN JSB NOER IF NOT, THEN ERROR DEF TST09 A8 JSB EEMAP SEE IF A AND B ARE RIGHT DEF TST09 TEMA8 DEC -32768 NEGATIVE NUMBER OF DIMS DEC -1 DEC 1,0,0 * TST09 JSB INTST JSB .EMAP TRY SUBSCRIPT BELOW LOWER BOUND DEF *+4 DEF EMAA DEF TEMA9 DEF M1 JMP A9 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST10 A9 JSB EEMAP CHECK A AND B DEF TST10 TEMA9 DEC 1 ONE DIMENSION DEC -1 LOWER BOUND IS ONE DEC 1 ONE WORD PER ELEMENT DEC 0,0 OFFSET WORDS * TST10 JSB INTST JSB .EMAP TRY NEGATIVE DIMENSION SIZE DEF *+4 DEF EMAA DEF TEM10 DEF ONE JMP A10 SHOULD ERROR RETURN JSB NOER IF NOT, THEN ERROR DEF TST11 A10 JSB EEMAP CHECK A AND B DEF TST11 TEM10 DEC 1 DEC 0 DEC -1 DEC 0,0 * TST11 JSB INTST JSB .EMAP TRY OFFSET TOO LARGE DEF *+4 DEF EMAA DEF TEM11 DEF ONE JMP A11 SHOULD BE ERROR JSB NOER ERROR IF RETURN HERE DEF TST12 A11 JSB EEMAP SEE IF A AND B RIGHT DEF TST12 TEM11 DEC 1 ONE DIMENSION DEC 0 LOWER BOUND ZERO DEC 1 ONE WORD PER ELE8MENT OCT 0,77777 LARGE OFFSET * TST12 JSB INTST JSB .EMAP TRY ARRAY TO LARGE (>1000000) DEF *+5 DEF EMAA DEF TEM12 DEF .2000 ASK FOR ELEMENT 2,000,001 DEF ONE JMP A12 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST13 A12 JSB EEMAP CHECK A AND B DEF TST13 TEM12 DEC 2 TWO DIMENSIONAL DEC -1 LOWER BOUND 1 DEC 1000 DIMENSION SIZE DEC 0 DEC 1 ONE WORD PER ELEMENT DEC 0,0 NO OFFSET .2000 DEC 2000 * TST13 JSB INTST JSB .EMAP TRY DOUBLE PRECISION CALCULATION OVERFLOW DEF *+6 DEF EMAA DEF TEM13 DEF BIG THIS IS 32767 DEF BIG THIS IS 32767 DEF BIG THIS IS 32767 JMP A13 SOULD BE ERROR RETURN JSB NOER DEF TST14 A13 JSB EEMAP CHECK A AND B DEF TST14 TEM13 DEC 3 A 3D ARRAY DEC -1 FIRST LOWER BOUND 1 DEC 32767 FIRST DIM DEC -1 SAME FOR THE REST DEC 32767 DEC -1 DEC 1 ONE WORD PER ELEMENT DEC 0,0 NO OFFSET * TST14 JSB INTST JSB .EMAP TRY DISPLACEMENT TO LARGE DEF *+5 DEF EMAA DEF TEM14 DEF BIG DEF BIG THIS IS 32767 JMP A14 SHOULD BE ERROR RETURN JSB NOER DEF TST15 A14 JSB EEMAP CHECK A AND B DEF TST15 TEM14 DEC 2 TWO DIMENSIONAL DEC -1 LOWER BOUND 1 DEC 32767 DEC -1 DEC 1 DEC 32767,32767 BIG OFFSET * TST15 JSB INTST JSB .EMAP TRY A 2D ARRAY DEF *+5 DEF EMAA DEF TEM15 DEF ONE DEF ONE JMP A15 SHOULD NOT ERROR RETURN ADB =D-1 B SHOULD BE START MSEG+1 CPB SAMSG SHOULD BE FIRST ELEMENT JMP B15 LDA SAMSG NOT RIGHT, PRINT MESSAGE INA EXPECTED SAMSG+1 INB B WAS DECREMENTED ABOVE JSB EMAPR DEF TST16 A15 JMP INCER IMPROPER ERROR RETURN DEF TST16 B15 JSB TOMPS CHECK MAPS DEF TST16 TEM15 DEC 2 DEC -1 DEC 1024 DEC -1 DEC 1 ONE WORD PER ELEMENT DEC 1,0 ONE WORD OFFSET * TST16 JSB INTST JSB .EMAP FOLLWING 6 TESTS ARE FOR DEF *+3 NON EMA ARRAYS DEF NEMA THIS IS NEG. DIM TEST DEF TNE16 JMP A16 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST17 A16 JSB EEMAP CHECK A AND B DEF TST17 TNE16 DEC -1 * TST17 JSB INTST JSB .EMAP SUBSCRIPT BELOW LOWER BOUND DEF *+4 DEF NEMA DEF TNE17 DEF M1 JMP A17 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST18 A17 JSB EEMAP CHECK A AND B DEF TST18 TNE17 DEC 1 ONE DIM DEC -1 LOWER BOUND 1 DEC 1 * TST18 JSB INTST JSB .EMAP DIM SIZE NEGATIVE DEF *+4 DEF NEMA DEF TNE18 DEF ONE JMP A18 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST19 A18 JSB EEMAP CHECK A AND B DEF TST19 TNE18 DEC 1,-1,-1 * TST19 JSB INTST JSB .EMAP 15 BIT OVERFLOW DEF *+4 DEF NEMA DEF TNE19 DEF BIG THIS IS 32767 JMP A19 SHOULD ERROR RETURN JSB NOER DEF TST20 A19 JSB EEMAP CHECK A AND B DEF TST20 TNE19 DEC 1 ONE DIMENSIONAL DEC 0 LOWER BOUND 0 DEC 2 TWO WORDS PER ELEMENT * TST20 JSB INTST JSB .EMAP 16 BIT OVERFLOW DEF *+4 DEF NEMA DEF TNE20 DEF B4000 JMP A20 SHOULD ERROR RETURN JSB NOER DEF TST21 A20 JSB EEMAP CHECK A AND B DEF TST21 TNE20 DEC 1 DEC 0 DEC 4 4B*40000B SETS THE B REG B4000 OCT 40000 * TST21 JSB INTST JSB .EMAP TRY A 2D ARRAY DEF *+5 DEF NEMA DEF TNE21 DEF *+1,I TRY AN INDIRECT DEF ONE ASK FOR THE ELEVENTH WORD JMP A21 SHOULD NOT ERROR RETURN ADB =D-11 SHOULD NOW BE .NEMA CPB .NEMA SEE IF IT IS JMP TST22 JUMP IF OK LDA .NEMA ADA =D11 ADB =D11 SET B BACK, A HAS EXPECTED VALUE JSB EMAPR PRINT ERROR MESSAGE DEF TST22 A21 JSB INCER INCORRECT ERROR RETURN TNE21 DEC 2 DEC 0 DEC 10 ARRAY IS (X , 10 ) DEC 0 LOWER BOUNDS BOTH 0 DEC 1 ONE WORD PER ELEMENT * TST22 JSB INTST JSB .EMAP TRY A(N)-L(N)>32767 DEF *+4 DEF NEMA DEF TNE22 DEF M1 JMP A22 SHOULD ERROR RETURN JSB NOER ERROR IF NO ERROR RETURN DEF TST23 A22 JSB EEMAP CHECK A AND B DEF TST23 TNE22 DEC 1 ONE DIMENSION DEC -32768 LOWER BOUND IS 32768 DEC 1 * TST23 JSB INTST LDA .NMMI CHANGE NAME TO EMIO STA NAME CLEMI JSB .EMIO NEGATIVE BUFFER LENGTH DEF *+4 DEF M1 NOP NOP JMP A23 SHOULD ERROR RETURN JMP NOER IF NOT, IS AN ERROR DEF TST24 A23 JSB EEMIO CHECK A AND B DEF TST24 * TST24 JSB INTST LDA EMASZ BUFFER OVERFLOWS END STA TEMP OF EMA JSB .EMIO DEF *+5 DEF .2 A 2 WORD BUFFER DEF TEM24 DEF TEMP BUFFER STARTS AT THE LAST DEF .1024 WORD OF EMA JMP A24 SHOULD ERROR RETURN JSB NOER ERROR IF NOT DEF TST25 A24 JSB EEMIO CHECK A AND B DEF TST25 TEM24 DEC 2 TWO DIMENSIONS DEC -1 LOWER BOUND 1 DEC 1024 RANGE DEC -1 LOWER BOUND FOR SECOND SUBSCRIPT DEC 1,0,0 ONE WORD PER ELEMENT AND NO OFFSET * TST25 JSB INTST LDA MSEG BUFFER ONE PAGE BIGGER INA THAN AN MSEG MPY =D1024 STA TEMP JSB .EMIO BUFFER BIGGER THAN AN MSEG DEF *+4 DEF TEMP DEF TEM25 DEF ONE JMP A25 SHOULD RETURN HERE JSB NOER IF NOT, TEHN ERROR DEF TST26 A25 JSB EEMIO CHECK A AND B DEF TST26 TEM25 DEC 1 DEC 0 DEC 1,0,0 ONE WORD PER ELEMENT, NO OFFSET * TST26 JSB INTST JSB .EMIO TRY A STANDARD MSEG DEF *+4 DEF ONE DEF TEM26 DEF ZERO JMP A26 INCORRECT ERROR RETURN CPB SAMSG SEE IF ADDRESS RIGHT JMP B26 JMP IF OK LDA SAMSG A HAS WHAT B SHOULD BE JSB EMIOR PRINT ERROR MESSAGE DEF TST27 A26 JSB INCER INCORRECT ERROR RETURN DEF TST27 B26 JSB ICMPS CHECK THE MAPS DEF TST27 TEM26 DEC 1 DEC 0 DEC 1,0,0 * TST27 JSB INTST JSB .EMIO NON-STANDARD MSEG DEF *+5 DEF .1024 OVERLAPS STANDARD MSEG DEF TEM27 DEF MSEG STARTING ELEMENT AT LAST PAGE DEF .1024 JMP A27 SHOULD NOT ERROR RETURN ADB =D-1023 B SHOULD BE LAST WORD OF CPB SAMSG THE FIRST PAGE OF MSEG JMP B27 ADB =D1023 PUT B BACK THE WAY IT WAS LDA SAMSG IF WRONG, PRINT ERROR JSB EMIOR DEF TST28 A27 JSB INCER WRONG ERROR RETURN DEF TST28 B27 JSB OFMPS GO CHECK MAPS DEF TST28 .3000 DEC 3000 TEM27 DEC 2 2 DIMENSION DEC -1 LOWER BOUND 1 DEC 1024 DEC -1 DEC 1,0,0 ONE WORD PER ELEMENT, NO OFFSET * TST28 JSB INTST LDA .NMMP STA NAME LDA XIDEX SAVE THIS LOCATION STA TEMP JSB $LIBR NOW GO PRIVLEDGED NOP CLA CLEAR THE ID EXT. ADDRESS SO STA XIDEX FIRMWARE THIGNKS THIS IS NON EMA PROG JSB .EMAP GIVE 1D ARRAY DEF *+4 DEF NEMA MUST REMAIN PRIVLEDGED SO THE DEF TNEM6 XIDEX IS NOT RESTORED IN A SWAP DEF ONE JMP A28 SHOULD NOT ERROR RETURN JSB $LIBX DEF *+1 DEF *+1 CPB .NEMA CHECK ADDRESS JMP TST29 JMP IF OK LDA .NEMA THIS IS EXPECTED ANSWER JSB EMAPR EMAP ERROR DEF TST29 A28 JSB $LIBX DEF *+1 DEF *+1 JSB INCER INCORRECT ERROR RETURN DEF TST29 * TST29 JSB INTST LDA .NMAP CHANGE NAME TO MMAP STA NAME JSB $LIBR INTERRUPTS OFF AGAIN NOP CLA CLEAR XIDEX INCASE IT HAS STA XIDEX BEEN RESTORED JSB MMAP MMAP CALL FROM NON EMA PROG DEF *+3 DEF ZERO DEF ONE JSB $LIBX DEF *+1 DEF *+1 CPA =D-1 SHOULD ERRO RETURN JMP TST30 JSB NOER INCORRECT RETURN DEF TST30 * TST30 JSB INTST LDA .NMMI CHANGE NAME TO EMIO STA NAME JSB $LIBR GO PRIVLEDGE TO CLEAR XIDEX NOP CLA CLEAR XIDEX STA XIDEX JSB .EMIO THIS IS ILLEGAL DEF *+4 DEF ONE DEF TEM26 DEF ONE JMP A30 SHOULD RETURN HERE LDA TEMP RESTORE XIDEX STA XIDEX JSB $LIBX SYSTEM BACK ON DEF *+1 DEF *+1 JSB NOER ERROR NOT DETECTED DEF TST31 A30 CAX SAVE A LDA TEMP RESTORE XIDEX STA XIDEX JSB $LIBX DEF *+1 DEF *+1 CXA PUT A BACK JSB EEMIO CHECK A AND B DEF TST31 * TST31 LDA SOFT USING SOFTWARE? SZA SKIP IF NOT JMP TST32 THIS TEST WONT WORK WITH SOFTWARE JSB INTST INCREMENT THE TEST NUMBER LDA .NMMP CHANGE NAME TO EMAP STA NAME JSB MMAP /U FORCE A STANDARD MSEG DEF *+3 DEF ZERO DEF .1 JSB .EMAP CALL EMAP AND ASK FOR DEF *+5 AN ELEMENT IN THE LAST PAGE DEF EMAA DEF TEM31 DEF EMASZ DEF ONE JMP A31 CPB SAMSG B SHOULD BE AT START OF MSEG JMP B31 JMP IF SO LDA SAMSG PRINT ERROR IF NOT JMP EMAPR DEF TST32 A31 JMP INCER INCORRECT ERROR RETURN DEF TST32 B31 JSB GTMPS MUST CHECK MAP REGS LDB SPMSG LOG. START PAGE MSEG LDX .MAPS ADDRESS OF MAPS LAX B,I GET THE FIRST MAP CONTENTS STA TEMP SAVE IT LDA STEMA COMPUTE PHYSICAL PAGE NUMBER OF LAST PAGE ADA EMASZ ADA =D-1 CPA TEMP SEE IF RIGHT JMP C31 JUMP IF OK JSB TOERR PRINT ERROR MESSAGE JMP TST32 C31 INB SECOND MAP REG SHOULD BE PROTECTED LAX B,I AND =B140000 CPA =B140000 JMP *+2 ALL OK JSB TOERR PRINT THE FIRST TO MAP REGS XLA XIDEX,I CHECK NONSTAN MSEG BIT SSA SKIP IF NOT SET JMP TST32 JMP IF OK LDA MSEG BUILD AN APPROXIMATION TO ID EXT 0 IOR =B10000 JMP IDXER GO PRINT ERROR MESSAGE TEM31 DEC 2 2 DIMS DEC -1 DEC 1024 DEC -1 DEC 1 DEC 0,0 NO OFFSET * TST32 EQU * JSB EXEC NOW UNLOCK MEMORY DEF *+3 DEF .22 DEF ZERO JSB $LIBR SET SWAP WORD BACK NOP LDA SWPSV STA SWAP JSB $LIBX DEF *+1 DEF *+1 JSB IFBRK SEE IF BREAK FLAG SET DEF *+1 SSA JMP QUIT LDA CNTR IF CNTR >0, RUN CONTINUOUSLY SSA,RSS SKIP IF NEGATIVE JMP START START OVER ISZ CNTR INCREMENT THE COUNTER JMP START GO AGAIN IF NOT ZERO QUIT LDA ERCNT SEE IF ANY ERRORS SZA SKIP IF RNONE JMP EREND JSB EXEC WRITE TERMINATION MESSAGE DEF *+5 DEF TWO DEF LU DEF GDEND DEF .22 JMP FINE EREND LDA LU CLB SEND FAILED TO PASS MESSAGE JSB .DIO. DEF BDEND DEF FINE LDA ERCNT JSB .IOI. JSB .DTA. FINE JSB EXEC TERMINATE DEF *+2 DEF .6 HLT * * EEMAP - CHECK A AND B ON ERROR RETURN FROM EMAP * SHOULD BE A = "15" AND B = "EM" * EEMAP NOP CPA =A15 RSS JMP WGMP CPB =AEM JMP OKMP JMP IF ALL OK WGMP JSB INCER PRINT ERROR IF NOT RIGHT DEF *+1 RETURN HERE OKMP LDA EEMAP,I GET RETURN ADDRESS JMP A,I RETURN * * EEMIO - CHECK A AND B ON ERROR RETURN FROM EMIO. * SHOULD BE A= "16" AND B= "EM" . * EEMIO NOP CPA =A16 RSS JMP WGIO JUMP IF WRONG CPB =AEM JMP OKIO WGIO JSB INCER WRITE ERROR MESSAGE DEF *+1 OKIO LDA EEMIO,I RETURN JMP A,I * * EMAPR WRITES EMAP ERROR MESSAGE * EMAPR NOP STA ASV THIS IS WHAT B SHOULD BE STB BSV THIS IS WHAT IT IS JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FREMP DEF ENMPR LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. ENMPR ISZ ERCNT BUMP THE ERROR COUNT NOP IN CASE ERCNT OVER FLOWS LDA EMAPR,I GET RETURN ADDRESS JMP A,I RETURN * * EMIOR - WRITES EMIO ERROR MESSAGE * EMIOR NOP STA ASV STB BSV JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRIOR THE FORMAT DEF ENIOR LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. ENIOR ISZ ERCNT INCREMENT THE ERROR COUNTER NOP IN CASE ERCNT OVERFLOWS LDA EMIOR,I RETURN JMP A,I * *  THE FOLLOWING SUBROUTINE GETS THE USER MAP REGISTERS, THE PHYSICAL * START PAGE OF THE USER AREA, AND THE PHYSICAL START PAGE OF EMA. * A SECTION IS PRIVLEGED SO THAT IT WILL NOT BE SWAPPED BETWEEN * ACCESSES. MEMORY LOCK WAS NOT USED BECAUSE IT MAY BE INHIBITED. * GTMPS NOP LDA XIDEX GET THE PHYSICAL START PAGE OF EMA INA IT IS THE SECOND WORD IN THE ID EXT. XLA A,I AND =B1777 STRIP OFF UNWANTED STUFF STA STEMA LDA XID GET THE PARTITION NUMBER ADA =D21 WHICH IS IN WORD 21 OF XLA A,I THE ID SEGMENT AND =B77 MASK OUT JUST PARTITION NUMBER INA STA PART LDA .MAPS PUT ADDRESS OF MAPS BUFFER IN A JSB $LIBR THIS IS REQUIRED BECAUSE USA MAY NOP CAUSE A DM WHEN IT SHOULDN'T USA COPY USER MAPS OUT JSB $LIBX DEF *+1 DEF *+1 JSB EXEC NOW GET PHYSICAL START PAGE OF THIS PARTITION DEF *+6 DEF .25 DEF PART DEF PAGE DEF NPAGE DEF TEMP ISZ PAGE SKIP BASE PAGE JMP GTMPS,I RETURN * * ICMPS CHECKS THE MAP REGISTERS STARTING IN THE USER AREA. * IT ASSUMES THE MAP REG CONTENTS ARE SEQUENTIAL. * ICMPS NOP JSB GTMPS GET THE MAP REGS AND START PHYS. PAGE * * GTMPS GETS THE MAPS (INTO BUFFER MAPS) AND SETS PAGE AND STEMA. * IN THE FOLLOWING, B IS A MAP NUMBER AND X IS THE START OF * THE ARRAY HOLDING THE MAPS. * LDB PGSTR LDX .MAPS START COMPARISON AT MAP FOR BEGINING OF USER AREA ICLP LAX B,I GET MAP REGISTER CONTENTS CPA PAGE SHOULD BE INCREMENTAL PAGES JMP ICEQ JMP IF EQUAL JSB MAPER PRINT ERROR IF NOT DEF ICIDX ICEQ ISZ PAGE INB POINT TO NEXT MAP REG CPB LSMSG SEE IF AT END OF MAP REGS RSS JMP ICLP LOOP BACK IF MORE ICIDX LDA MSEG SHOULD BE MSEG # 0. XCA XIDEX,I kCHECK WORD ZERO OF ID EXT. JMP ICEND JUMP IF OK JMP IDXER GO PRINT ERROR MESSAGE ICEND LDA ICMPS,I GET ADDRESS TO RETURN JMP A,I * IDXER STA ASV SAVE THE EXPECTED VALUE IF IDEX0 JSB PTEST PRINT THE TEST NUMBER LDA LU NOW PRINT IDEX CLOBBERED MESSAGE CLB JSB .DIO. DEF FRIDX DEF NDIDX LDA ASV PRINT EXPECTED VALUE JSB .IOI. XLA XIDEX,I PRINT REAL VALUE JSB .IOI. JSB .DTA. NDIDX ISZ ERCNT NOP JMP EREND ID EXT. WORD 0 IS GONE, SO TERMINATE * INCER NOP SUBROUTINE TO PRINT ERROR IF INCORRECT ERROR RETURN STA ASV SAVE A AND B STB BSV JSB PTEST PRINT THE TEST NUMBER DLD NAME,I GET THE NAME OF THE FAILING ROUTINE DST FRMT2+2 STORE IT IN THE FORMAT LDA LU NOW CALL THE FORMATTER TO OUTPUT THE MESSAGE CLB JSB .DIO. DEF FRMT2 DEF ENDL2 LDA ASV JSB .IOI. PRINT CONTENTS OF A LDA BSV JSB .IOI. PRINT CONTENTS OF B JSB .DTA. ENDL2 ISZ ERCNT INC THE ERROR COUNTER LDA INCER,I GET THE RETURN ADDRESS JMP A,I * INTST NOP INCREMENT THE TEST NUMBER AND PUT ON S ISZ TSTNO LDA TSTNO OTA 1 ADA =D-32 IF > 32, IN A LOOP SSA,RSS IF < 0, OK JMP EREND TERMINATE THE PROGRAM JMP INTST,I * * LSTMP CHECKS THE MAP REGISTERS ASSUMING THE LAST PAGE OF * EMA IS THE ONLY ONE MAPPED IN. THE REST OF THE MSEG * IS PROTECTED. * LSTMP NOP JSB GTMPS GET THE MAPS AND PHYS START PAGE OF THIS PARTITION LDB PGSTR GET LOGICAL START ADDRESS OF THIS PROG LDX .MAPS B POINTS TO MAP REG FOR START OF THIS PROG LSLP LAX B,I GET THE MAP REG CONTENTS CPA PAGE SHOULD MATCH PHYSICAL PAGE JMP LSEQ JSB MAPER PRINT ERROR IF NO MATCH DEF LSEND LSEQ ISZ PAGEF6 INCREMENT PHYSICAL PAGE COUNTER INB INCREMENT POINTER TO MAPS CPB SPMSG SEE IF IN MSEG YET RSS SKIP IF SO JMP LSLP JUMP IF MORE TO CHECK LDA STEMA BUILD THE PHYSICAL PAGE NUMBER FOR ADA EMASZ THE LAST PAGE OF EMA ADA M1 STA PAGE LAX B,I GET NEXT MAP CPA PAGE AND CHECK IT RSS JMP LSER JMP IF BAD INB LSLP2 LAX B,I GET THE MAP REG CONTENTS AND =B140000 REST OF PAGES SHOULD BE READ/WRITE PROTECTED CPA =B140000 SEE IF RIGHT JMP LSEQ2 JUMP IF OK LAX B,I GET MAP REG CONTENTS LSER JSB MAPER PRINT THE ERROR MESSAGE DEF LSIDX LSEQ2 INB CPB =D32 SEE IF AT END OF MAPS RSS IF SO, DO NEXT TEST JMP LSLP2 IF NOT, GO BACK AND DO SOME MORE LSIDX CLB CHECK ID EXT. WORD 0 LDA EMASZ MUST SEE IF LAST PAGE ADA =D-1 ONLY MAPPED IN STANDARD MSEG DIV MSEG SZB IF NO REMAINDER, STAN MSEG JMP NNSTN JUMP IF NON STAN MSEG ASL 5 SHIFT UP MSEG NUMBER IOR MSEG A IS NOW WHAT IDEX0 SHOULD BE XCA XIDEX,I COMPARE TO REAL IDE0 JMP LSEND JUMP IF OK JMP IDXER OTHERWISE PRINT ERROR NNSTN XLA XIDEX,I GET WORD ZERO AND AND =B100037 MASK OUT MSEG # STA TEMP SAVE IT LDA MSEG IDEX0 SHOULD BE MSEG SIZE WITH IOR =B100000 THE SIGN BIT SET CPA TEMP SEE IF RIGHT JMP LSEND JUMP IF OK JMP IDXER PRINT ERROR IF WRONG LSEND LDA LSTMP,I GET RETURN ADDRESS JMP A,I RETURN * MAPER NOP PRINT MMAP ERROR MESSAGE STA ASV WILL HAVE MAP REG CONTENTS ON ENTRY STB BSV WILL HAVE MAP REG NUMBER JSB PTEST PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRMAP DEF ENMAP LDA BSV JSB .IOI0. LDA ASV JSB .IOI. JSB .DTA. ENMAP ISZ ERCNT INCREMENT THE ERROR COUNTER LDA MAPER,I RETURN JMP A,I * * NOER - PRINTS THE MESSAGE THAT AN ERROR CONDITION * WAS NOT DETECTED * NOER NOP STA ASV SAVE A AND B STB BSV JSB PTEST PRINT THE TEST NUMBER DLD NAME,I GET THE NAME OF THE ROUTINE DST FRNER+2 AND STORE IN THE FORMAT LDA LU NOW CALL THE FORMATTER CLB JSB .DIO. DEF FRNER DEF NDNER LDA ASV JSB .IOI. LDA BSV JSB .IOI. JSB .DTA. NDNER ISZ ERCNT INCREMENT THE ERROR COUNTER NOP NOP IN CAES IT OVERFLOWS LDA NOER,I GET THE RETURN ADDRES JMP A,I AND RETURN * * OFMPS - CHECK THE MAP REGISTERS ASSUMING A NON STANDARD MSEG. * THE FIRST PAGE OF THE MSEG IS THE LAST PAGE OF THE * FIRST STANDARD MSEG. ONLY TWO PAGES ARE CHECKED * IN CASE WE ARE IN A SMALL PARTITION. * OFMPS NOP JSB GTMPS GET THE MAP REGS LDA MSEG GET MSEG SIZE ADA =D-1 MINUS 1 ADA STEMA PLUS PHYSICAL START EMA STA PAGE = PHYS. START THIS MSEG LDA =D-2 CHECK ONLY TWO PAGES STA TEMP LDX .MAPS THE ADDRESS OF THE MAPS LDB SPMSG START CHECKING AT THE MSEG OFLP LAX B,I GET MAP CONTENTS CPA PAGE SEE IF RIGHT RSS SKIP IF SO JMP OFER JMP IF ERROR ISZ PAGE GO TO NEXT LOCATION INB ISZ TEMP JMP OFLP OFEND LDA OFMPS,I RETURN JMP A,I OFER JSB MAPER A MAPPING ERROR DEF OFEND * PTEST NOP PRINT THE TEST NUMBER LDA LU CLB JSB .DIO. DEF FRTST THE FORMAT DEF ENDPT LDA TSTNO GET THE TEST NUMBER JSB .IOI. JSB .DTA. ENDPT JMP PTEST,I * * TOMPS - CHECKS THE MAP REGISTERS SET UP BY EMA!KP. * IT CHECKS ONLY THE FIRST TWO BECAUSE THAT IS * ALL THAT THE FIRMWARE VERSION OF EMAP SETS UP. * THE CHECK FOR THE NON-STANDARD MSEG BIT SET * IS NOT DONE IF SOFTWARE IS USED. TOMPS NOP JSB GTMPS GET THE MAP REGS LDB SPMSG GET LOG START PAGE MSEG LDX .MAPS STARTING ADDRESS OF MAPS LAX B,I GET FIRST PHYS. PAGE NUMBER CPA STEMA SEE IF RIGHT JMP *+3 JUMP IF SO JSB TOERR PRINT ERROR MESG. JMP TOEND INB POINT TO NEXT MAP REG CONTENTS LAX B,I ADA =D-1 BACK IT UP ONE CPA STEMA SEE IF THIS ONE RIGHT JMP *+3 JUMP IF SO JSB TOERR GO PRINT ERROR MESG. JMP TOEND LDA SOFT USING SOFTWARE? SZA JMP TOEND YES, END XLA XIDEX,I NONSTAN MSEG BIT SHOULD BE SET SSA,RSS SKIP IF ITS SET JMP *+3 DO ERROR MESSAGE TOEND LDA TOMPS,I GET RETURN ADDRESS JMP A,I RETURN LDA MSEG BUILD AN APROXIMATION OF IOR =B100000 THE ID.EXT. WE EXPECTED JMP IDXER GO DO ID.EXT. ERROR TOERR NOP PRINT THE FIRST TWO MSEG MAP REGS JSB PTEST PRINT THE TEST NUMBER LDA LU NOW PRINT MESSAGE THAT CLB EMAP SET UP MAP REGS WRONG JSB .DIO. DEF FRTWO DEF NDTWO LDA SPMSG GET FIRST MAP REG ADDRESS JSB .IOI. LDA .MAPS AND =B77777 GET ADDRESS OF MAPS ADA SPMSG STA TEMP SAVE IT LDA A,I GET THE MAP REG CONTENTS JSB .IOI. LDA SPMSG INA JSB .IOI. THIS IS THE NEXT MAP REG LDA TEMP INA LDA A,I THIS IS THE CONTENTS JSB .IOI. JSB .DTA. NDTWO ISZ ERCNT BUMP THE ERROR COUNTER NOP JMP TOERR,I RETURN * * FOLLOWING ARE FORMATS AND MESSAGES * SUP TOSML ASC 20, TXPF3 - WARNING - PARTITION TOOrpl SMALL ASC 7,FOR FULL TEST CNTRN ASC 20, TXPF3 - PARTITION IS TOO SMALL TO EXEC ASC 15,UTE THE ON-LINE DIAGNOSTIC TERM ASC 22, TXPF3 - EMA ON-LINE DIAGNOSTIC TERMINATED GDEND ASC 22, TXPF3 - DIAGNOSTIC COMPLETED SUCCESSFULLY BDEND ASC 21,(/," TXPF3 - EMA FAILED TO PASS DIAGNOS ASC 11,TIC*** ",I6," ERRORS") FRMT2 ASC 21,( " NAME INCORRECT ERROR RETURN A =",K7,"B ASC 7, B =",K7,"B") FRMAP ASC 20,(" MMAP ERROR. FIRST MAP REGISTER TO MIS ASC 17,COMPARE = ",I2,", CONTENTS = ",I6) FRIOR ASC 22,(" EMIO ERROR. EXPECTED B =",K7,"B ACTUAL ASC 6,B =",K7,"B") FRTST ASC 14,(/," TXPF3 - TEST ",I2,":") FREMP ASC 22,(" EMAP ERROR. EXPECTED B =",K7,"B ACTUAL ASC 6,B =",K7,"B") FRNER ASC 20,( " NAME DID NOT DETECT ERROR CONDITION ASC 14, A =",K7,"B B =",K7,"B") FRIDX ASC 21,(" ID EXT. WORD ZERO WRONG. EXPECTED =",K7 ASC 12,,"B. ACTUAL =",K7,"B") NOTFW ASC 20, TXPF3 - WARNING - EMA DIAGNOSTIC USING ASC 15, SOFTWARE INSTEAD OF FIRMWARE. FRTWO ASC 12,(" EMAP MAPPING ERROR.", ASC 15,2(/" MAP REG.",I5," =",I8)) NOFRM ASC 22, TXPF3 - ERROR. NO EMA FIRMWARE INSTALLED. END TXPF3 Cr  91711-18105 1926 S C0122 &TXPF4 VECTOR INST. SET DIAG.             H0101 /FTN4,L,Y C********************************************************************** C $EMA(AREA,1) PROGRAM TXPF4(3,89),91711-16105 REV 1926 791113 C C CHANGED 791113. MAKE CPU, M,E,OR F CHECK, AND IF M C THEN STOP WITH APPROPRIATE MESSAGE. C COMMON / AREA / EV1(500) COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3 COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR C DIMENSION V1(600),V2(600),V3(600),V4(600) DIMENSION IBUFF(5) C DOUBLE PRECISION DV1(300),DV2(300),DV3(300),DV4(300),DSUM EQUIVALENCE (V1,DV1),(V2,DV2),(V3,DV3),(V4,DV4) C CALL RMPAR(IBUFF) LU = IBUFF(1) IPASS = IBUFF(2) IPRIV = IBUFF(3) IF (LU.LE.0) LU = LOGLU(LU) IF (IPASS.LE.0) IPASS = 1 CALL EXEC(2,LU,2H ,-2) CALL EXEC(2,LU,44H TXPF4 - VECTOR INSTRUCTION SET DIAGNOSTIC., + -44) C C********************************************************************* C C THE FOLLOWING BLOCK OF LINES ADDED 791113 C C FIND OUT IF THE COMPUTER IS AN M OR AN E/F MACHINE C CALL MORFE(ICODE) IF (ICODE.EQ.1)GO TO 5 CALL EXEC(2,LU,2H ,-2) CALL EXEC(2,LU, *52H TXPF4 - PROGRAM CAN ONLY RUN IN AN E OR F MACHINE.,-52) CALL EXEC(2,LU,2H ,-2) STOP 12 5 CONTINUE C C********************************************************************* C C PERFORM SELF-TEST TO CHECK FIRMWARE INSTALLATION C CALL SELFT(IERR) IF (IERR.EQ.0) GOTO 10 CALL EXEC(2,LU,2H ,-2) CALL EXEC(2,LU,28H TXPF4 - SELF TEST FAILURE.,-28) CALL EXEC(2,LU,2H ,-2) STOP 11 C C********************************************************************** C C MAJOR LOOP C 10 DO 99 IDUMMY = 1,IPASS NMAX = 600 ITEST(1) = 2H ITEST(2) = 1 C C TEST FOR CASES N=0, N<0 C CALL INITV(V1,V2,V3,V4) CALL VADD(V1,1,V2,1,V3,1,0) CALL VCOMP(V3,V4) CALL VADD(V1,1,V2,1,V3,1,Ƨ-1) CALL VCOMP(V3,V4) C C********************************************************************* C********************************************************************* C C TEST SINGLE PRECISION FIRMWARE WITH UNITY INCREMENTS C ITEST(2) = 0 INCR1 = 1 INCR2 = 1 INCR3 = 1 N = NMAX CALL INITV(V1,V2,V3,V4) CALL VTEST(V1,V2,V3,V4) C C********************************************************************* C C TEST SINGLE PRECISION FIRMWARE WITH NON-UNITY INCREMENTS C ITEST(2) = 0 INCR1 = 10 INCR2 = 20 INCR3 = 30 N = NMAX/30 CALL INITV(V1,V2,V3,V4) CALL VTEST(V1,V2,V3,V4) C C C********************************************************************* C C C TEST DOUBLE PRECISION FIRMWARE WITH UNITY INCREMENTS C ITEST(1) = 2H D ITEST(2) = 0 INCR1 = 1 INCR2 = 1 INCR3 = 1 NMAX = NMAX / 2 N = NMAX CALL INITD(DV1,DV2,DV3,DV4) CALL DVTST(DV1,DV2,DV3,DV4) C C C********************************************************************** C C C TEST DOUBLE PRECISION FIRMWARE WITH NON-UNITY INCREMENTS C ITEST(2) = 0 INCR1 = 10 INCR2 = 20 INCR3 = 30 N = NMAX/30 CALL INITD(DV1,DV2,DV3,DV4) CALL DVTST(DV1,DV2,DV3,DV4) C C********************************************************************* C********************************************************************* C C C TEST .ERES IN ASMB C ITEST(1) = 2H . ITEST(2) = ITEST(2) + 1 CALL TERES(IERR) IF (IERR.NE.0) CALL ERROR C C C********************************************************************* C C C IF IPRIV FLAG NOT SET, SKIP PRIVILEGED SECTION C IF (IPRIV.EQ.0) GOTO 40 C C C********************************************************************* C C C LOCK PROGRAM INTO MEMORY FOR NEXT TWO TESTS C CALL EXEC(22,1) C C C********************************************************************** C C C TEST .ESEG IN ASMB C ITEST(2) = ITEST(2) + 1 CALL TESEG(IERR) IF (IERR.NE.0) CALL ERROR C C C********************************************************************* C C C TEST .VSET IN ASMB C ITEST(2) = ITEST(2) + 1 CALL TVSET(IERR) IF (IERR.NE.0) CALL ERROR C C C********************************************************************* C C UNLOCK PROGRAM FROM MEMORY C CALL EXEC(22,0) C C C********************************************************************** C********************************************************************** C C PERFORM AN EMA VECTOR INSTRUCTION TO SEE THAT IT ALL PLAYS C ITEST(1) = 2H ITEST(2) = ITEST(2) + 1 C DO 20 I=1,500 EV1(I) = 100. * SIN(100. * SIN(FLOAT(I))) 20 CONTINUE C CALL WSUM(SUM1,EV1(1),1,500) DSUM = 0.0D0 DO 30 I=1,500 DSUM = DSUM + DBLE((EV1(I))) 30 CONTINUE C CALL TRUNC(DSUM,SUM2) IF (SUM1.NE.SUM2) CALL ERROR C C*********************************************************************** C C PRINT COMPLETION MESSAGE C 40 IF (NERR.NE.0) STOP 11 CALL EXEC(2,LU,2H ,-2) C IF (IPRIV.EQ.0) CALL EXEC(2,LU, + 52H TXPF4 - WARNING, PRIVILEGED INSTRUCTIONS UNTESTED ,-52) CALL EXEC(2,LU,2H ,-2) CALL EXEC(2,LU,44H TXPF4 - VIS DIAGNOSTIC COMPLETE: NO ERRORS, + -44) C C********************************************************************* C C TEST FOR OPERATOR BREAK C IF (IFBRK(I).NE.0) STOP 77 C C********************************************************************* C C END OF MAJOR LOOP C 99 CONTINUE C C********************************************************************* END C********************************************************************* C < SUBROUTINE VTEST(V1,V2,V3,V4) C COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3 COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR C DIMENSION V1(1),V2(1),V3(1),V4(1) DOUBLE PRECISION DSUM C S = 3.14 C C********************************************************************* C C CALL VADD(V1,INCR1,V2,INCR2,V3,INCR3,N) C CALL INITI DO 10 L=1,N V4(I4) = V1(I1) + V2(I2) CALL INCI 10 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C C CALL VSUB(V1,INCR1,V2,INCR2,V3,INCR3,N) C CALL INITI DO 20 L=1,N V4(I4) = V1(I1) - V2(I2) CALL INCI 20 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C C CALL VMPY(V1,INCR1,V2,INCR2,V3,INCR3,N) C CALL INITI DO 30 L=1,N V4(I4) = V1(I1) * V2(I2) CALL INCI 30 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C********************************************************************* C CALL VDIV(V1,INCR1,V2,INCR2,V3,INCR3,N) C CALL INITI DO 40 L=1,N V4(I4) = V1(I1) / V2(I2) CALL INCI 40 CONTINUE C CALL VCOMP(V3,V4) C C********************************************************************* C C CALL VSAD(S,V1,INCR1,V3,INCR3,N) C CALL INITI DO 50 L=1,N V4(I4) = S + V1(I1) CALL INCI 50 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C C CALL VSSB(S,V1,INCR1,V3,INCR3,N) C CALL INITI DO 60 L=1,N V4(I4) = S - V1(I1) CALL INCI 60 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C C CALL V5SMY(S,V1,INCR1,V3,INCR3,N) C CALL INITI DO 70 L=1,N V4(I4) = S * V1(I1) CALL INCI 70 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C********************************************************************* C C CALL VSDV(S,V1,INCR1,V3,INCR3,N) C CALL INITI DO 80 L=1,N V4(I4) = S / V1(I1) CALL INCI 80 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C C CALL VPIV(S,V1,INCR1,V2,INCR2,V3,INCR3,N) C CALL INITI DO 90 L=1,N V4(I4) = S * V1(I1) + V2(I2) CALL INCI 90 CONTINUE C CALL VCOMP(V3,V4) C C C********************************************************************* C CALL VABS(V1,INCR1,V3,INCR3,N) C CALL INITI DO 100 L=1,N V4(I4) = ABS(V1(I1)) CALL INCI 100 CONTINUE C CALL VCOMP(V3,V4) C C********************************************************************* C CALL VSUM(SUM1,V1,INCR1,N) C CALL INITI DSUM = 0.0D0 DO 110 L=1,N DSUM = DSUM + DBLE(V1(I1)) CALL INCI 110 CONTINUE C CALL TRUNC(DSUM,SUM2) IF (SUM1.NE.SUM2) CALL ERROR C C********************************************************************* C********************************************************************* C C CALL VNRM(SUM1,V1,INCR1,N) C CALL INITI DSUM = 0.0D0 C DO 120 L=1,N DSUM = DSUM + DABS(DBLE(V1(I1))) CALL INCI 120 CONTINUE C CALL TRUNC(DSUM,SUM2) IF(SUM1.NE.SUM2) CALL ERROR C C C********************************************************************* C CALL VDOT(SUM1,V1,INCR1,V2,INCR2,N) C CALL INITI DSUM = 0.0D0 C DO 130 L=1,N DSUM = DSUM + DBLE(V1(I1)) * DBLE(V2(I2)) CALL INCIӈ 130 CONTINUE C CALL TRUNC(DSUM,SUM2) IF (SUM1.NE.SUM2) CALL ERROR C C********************************************************************* C CALL VMAX(IMAX1,V1,INCR1,N) C CALL INITI IMAX2 = 1 AMAX = V1(1) C DO 140 L=1,N IF (AMAX.GE.V1(I1)) GOTO 145 IMAX2 = L AMAX = V1(I1) 145 CALL INCI 140 CONTINUE C IF (IMAX1.NE.IMAX2) CALL ERROR C C********************************************************************* C CALL VMAX(IMAX1,V1,INCR1,1) IF (IMAX1.NE.1) CALL ERROR C C********************************************************************* C********************************************************************* C C CALL VMAB(IMAB1,V1,INCR1,N) C CALL INITI IMAB2 = 1 AMAB = ABS(V1(1)) C DO 150 L=1,N IF (AMAB.GE.ABS(V1(I1))) GOTO 155 IMAB2 = L AMAB = ABS(V1(I1)) 155 CALL INCI 150 CONTINUE C IF (IMAB1.NE.IMAB2) CALL ERROR C C C********************************************************************* C C CALL VMIN(IMIN1,V1,INCR1,N) C CALL INITI IMIN2 = 1 AMIN = V1(1) C DO 160 L=1,N IF (AMIN.LE.V1(I1)) GOTO 165 IMIN2 = L AMIN = V1(I1) 165 CALL INCI 160 CONTINUE C IF (IMIN1.NE.IMIN2) CALL ERROR C C C********************************************************************* C CALL VMIB(IMIB1,V1,INCR1,N) C CALL INITI IMIB2 = 1 AMIB = ABS(V1(1)) DO 170 L=1,N IF (AMIB.LE.ABS(V1(I1))) GOTO 175 IMIB2 = L AMIB = ABS(V1(I1)) 175 CALL INCI 170 CONTINUE C IF (IMIB1.NE.IMIB2) CALL ERROR C C********************************************************************** C********************************************************************** C CALL VMOV(V1,INCR1,V3,INCR3,N) C CALL INITI DO 180 L=1E,N V4(I4) = V1(I1) CALL INCI 180 CONTINUE C CALL VCOMP(V3,V4) C C********************************************************************** C CALL INITV(V1,V1,V3,V4) INCR2 = INCR1 C CALL VSWP(V1,INCR1,V3,INCR3,N) C CALL INITI DO 190 L=1,N T = V2(I2) V2(I2) = V4(I4) V4(I4) = T CALL INCI 190 CONTINUE C CALL VCOMP(V1,V2) CALL VCOMP(V3,V4) C C********************************************************************* RETURN END C********************************************************************* C SUBROUTINE DVTST(DV1,DV2,DV3,DV4) C COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3 COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR C DOUBLE PRECISION DV1(1),DV2(1),DV3(1),DV4(1) DOUBLE PRECISION DS,DSUM1,DSUM2,DMAX,DMAB,DMIN,DMIB,DT C DS = 3.14D0 C C********************************************************************* C C CALL DVADD(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) C CALL INITI DO 10 L=1,N DV4(I4) = DV1(I1) + DV2(I2) CALL INCI 10 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C C CALL DVSUB(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) C CALL INITI DO 20 L=1,N DV4(I4) = DV1(I1) - DV2(I2) CALL INCI 20 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C C CALL DVMPY(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) C CALL INITI DO 30 L=1,N DV4(I4) = DV1(I1) * DV2(I2) CALL INCI 30 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C********************************************************************* C CALL DVDIV(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) C CALL INITI DO 40 L=ԙ1,N DV4(I4) = DV1(I1) / DV2(I2) CALL INCI 40 CONTINUE C CALL DVCMP(DV3,DV4) C C********************************************************************* C C CALL DVSAD(DS,DV1,INCR1,DV3,INCR3,N) C CALL INITI DO 50 L=1,N DV4(I4) = DS + DV1(I1) CALL INCI 50 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C C CALL DVSSB(DS,DV1,INCR1,DV3,INCR3,N) C CALL INITI DO 60 L=1,N DV4(I4) = DS - DV1(I1) CALL INCI 60 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C C CALL DVSMY(DS,DV1,INCR1,DV3,INCR3,N) C CALL INITI DO 70 L=1,N DV4(I4) = DS * DV1(I1) CALL INCI 70 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C********************************************************************* C C CALL DVSDV(DS,DV1,INCR1,DV3,INCR3,N) C CALL INITI DO 80 L=1,N DV4(I4) = DS / DV1(I1) CALL INCI 80 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C C CALL DVPIV(DS,DV1,INCR1,DV2,INCR2,DV3,INCR3,N) C CALL INITI DO 90 L=1,N DV4(I4) = DS * DV1(I1) + DV2(I2) CALL INCI 90 CONTINUE C CALL DVCMP(DV3,DV4) C C C********************************************************************* C CALL DVABS(DV1,INCR1,DV3,INCR3,N) C CALL INITI DO 100 L=1,N DV4(I4) = DABS(DV1(I1)) CALL INCI 100 CONTINUE C CALL DVCMP(DV3,DV4) C C********************************************************************* C CALL DVSUM(DSUM1,DV1,INCR1,N) C CALL INITI DSUM2 = 0.0D0 DO 110 L=1,N D-SUM2 = DSUM2 + DV1(I1) CALL INCI 110 CONTINUE C IF (DSUM1.NE.DSUM2) CALL ERROR C C C********************************************************************* C********************************************************************* C C C CALL DVNRM(DSUM1,DV1,INCR1,N) C CALL INITI DSUM2 = 0.0D0 C DO 120 L=1,N DSUM2 = DSUM2 + DABS(DV1(I1)) CALL INCI 120 CONTINUE C IF(DSUM1.NE.DSUM2) CALL ERROR C C C********************************************************************* C C CALL DVDOT(DSUM1,DV1,INCR1,DV2,INCR2,N) C CALL INITI DSUM2 = 0.0D0 C DO 130 L=1,N DSUM2 = DSUM2 + DV1(I1) * DV2(I2) CALL INCI 130 CONTINUE C IF (DSUM1.NE.DSUM2) CALL ERROR C C C********************************************************************* C C C CALL DVMAX(IMAX1,DV1,INCR1,N) C CALL INITI IMAX2 = 1 DMAX = DV1(1) C DO 140 L=1,N IF (DMAX.GE.DV1(I1)) GOTO 145 IMAX2 = L DMAX = DV1(I1) 145 CALL INCI 140 CONTINUE C IF (IMAX1.NE.IMAX2) CALL ERROR C C C C********************************************************************* C********************************************************************* C C CALL DVMAB(IMAB1,DV1,INCR1,N) C CALL INITI IMAB2 = 1 DMAB = DABS(DV1(1)) C DO 150 L=1,N IF (DMAB.GE.DABS(DV1(I1))) GOTO 155 IMAB2 = L DMAB = DABS(DV1(I1)) 155 CALL INCI 150 CONTINUE C IF (IMAB1.NE.IMAB2) CALL ERROR C C C********************************************************************* C C CALL DVMIN(IMIN1,DV1,INCR1,N) C CALL INITI IMIN2 = 1 DMIN = DV1(1) C DO 160 L=1,N IF (DMIN.LE.DV1(I1)) GOTO 165 IMIN2 = L DMIN = DV1(I1) 165 CALL INCI 160 CONTINUE C IF (IMIN1.NE.IMIN2) CALL ERROR S=C C C********************************************************************* C CALL DVMIB(IMIB1,DV1,INCR1,N) C CALL INITI IMIB2 = 1 DMIB = DABS(DV1(1)) DO 170 L=1,N IF (DMIB.LE.DABS(DV1(I1))) GOTO 175 IMIB2 = L DMIB = DABS(DV1(I1)) 175 CALL INCI 170 CONTINUE C IF (IMIB1.NE.IMIB2) CALL ERROR C C********************************************************************** C********************************************************************** C CALL DVMOV(DV1,INCR1,DV3,INCR3,N) C CALL INITI DO 180 L=1,N DV4(I4) = DV1(I1) CALL INCI 180 CONTINUE C CALL DVCMP(DV3,DV4) C C********************************************************************** C CALL INITD(DV1,DV1,DV3,DV4) INCR2 = INCR1 C CALL DVSWP(DV1,INCR1,DV3,INCR3,N) C CALL INITI DO 190 L=1,N DT = DV2(I2) DV2(I2) = DV4(I4) DV4(I4) = DT CALL INCI 190 CONTINUE C CALL DVCMP(DV1,DV2) CALL DVCMP(DV3,DV4) C C********************************************************************* RETURN END C********************************************************************* C SUBROUTINE INITV(V1,V2,V3,V4) C COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR DIMENSION V1(1),V2(1),V3(1),V4(1) C DO 10 I=1,NMAX V1(I) = 100. * SIN(100. * SIN(FLOAT(I))) V2(I) = 100. * COS(100. * COS(FLOAT(I))) V3(I) = 0.0 V4(I) = 0.0 10 CONTINUE C RETURN C C********************************************************************* END C********************************************************************* C SUBROUTINE INITD(DV1,DV2,DV3,DV4) C COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR DOUBLE PRECISION DV1(1),DV2(1),DV3(1),DV4(1) C DO 10 I=1,NMAX DV1(I) = 100D0 * DSIN(100D0 * DSIN(DBLE(FLOAT(I)))) DV2(I) = 100D0 * DCOS(100D0 * DCOS(DBLE(FLOAT(I)))) DV3(I) = 0D0 DV4(I) = 0D0 10 CONTINUE C RETURN C C*********************************************************************** END C********************************************************************* C SUBROUTINE INITI C COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3 COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR C I1 = 1 I2 = 1 I3 = 1 I4 = 1 C ITEST(2) = ITEST(2) + 1 C RETURN C C********************************************************************* END C********************************************************************* C SUBROUTINE INCI C COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3 C I1 = I1 + INCR1 I2 = I2 + INCR2 I3 = I3 + INCR3 I4 = I4 + INCR3 C RETURN C C********************************************************************* END C********************************************************************* C SUBROUTINE VCOMP(V3,V4) C COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR C DIMENSION V1(1),V2(1),V3(1),V4(1) C DO 10 I=1,NMAX IF (V3(I).NE.V4(I)) GOTO 20 10 CONTINUE C RETURN C C 20 CALL ERROR RETURN C C********************************************************************* END C********************************************************************* C SUBROUTINE DVCMP(DV3,DV4) C COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR C DOUBLE PRECISION DV3(1),DV4(1) C DO 10 I=1,NMAX IF (DV3(I).NE.DV4(I)) GOTO 20 10 CONTINUE C RETURN C C 20 CALL ERROR RETURN C C********************************************************************* END C********************************************************************* C SUBROUTINE ERROR C COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR REAL NAMES(23),BUFFR(9) INTEGER IBUFF(2) SHFB EQUIVALENCE (IBUFF(1),BUFFR(8)) DATA NAMES / 4HVADD,4HVSUB,4HVMPY,4HVDIV,4HVSAD,4HVSSB, + 4HVSMY,4HVSDV,4HVPIV,4HVABS,4HVSUM,4HVNRM, + 4HVDOT,4HVMAX,4HVMAB,4HVMIN,4HVMIB,4HVMOV, + 4HVSWP,4HERES,4HESEG,4HVSET,4HWSUM / C DATA BUFFR / 4H TX,4HPF4 ,4H- ER,4HROR ,4HIN I,4HNSTR, + 4HUCTI,4HON / C BUFFR(9) = NAMES(ITEST(2)) IBUFF(2) = ITEST(1) CALL EXEC(2,LU,2H ,-2) CALL EXEC(2,LU,BUFFR,-36) NERR = NERR + 1 RETURN C C********************************************************************* END C********************************************************************* C SUBROUTINE TRUNC(IDBLE,ISNGL) C DIMENSION IDBLE(1),ISNGL(1) C ISNGL(1) = IDBLE(1) IDBLE(2) = IDBLE(2).AND.177400B IDBLE(4) = IDBLE(4).AND.377B ISNGL(2) = IDBLE(2).OR.IDBLE(4) C RETURN C C*********************************************************************** END C********************************************************************* C BLOCK DATA C COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3 COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR C C DATA NERR / 0 / C C********************************************************************** END H  91711-18106 2001 S C0122 &TXMD0 DISC MEMORY DIAG. FTHR.             H0101 FTN4,L PROGRAM TXMD0(3,90),91711-16106 REV.2001 791017. C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C THIS PROGRAM IS THE "FATHER" FOR THE DIAGNOSTICS "TXMD1". C IT WILL RETRIVE ALL THE NECCESARY PARRAMETERS AND RELEASE C THE EQT LOCK IF THE DIAGNOSTICS WILL BE ABORTED, AND INITIALIZE C BACK THE TRACKS USED IN THE DIAGNOSTIC TO ORIGINAL POSITION. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C TO RUN THE HP-IB DISC (7906/20/25H) DIAGNOSTICS YOU HAVE TWO C OPTIONS: DIRECT AND INDIRECT MODE. IN THE INDIRECT MODE THE PROGRAM C WILL COME BACK TO YOU RETREIVING ALL NECESSARY PARAMETRS. C TO RUN IN THE INDERCT MODE ENTER: RU,TXMD0. C C IN THE DIRECT MODE YOU WILL SUPPLY ALL THE PARAMETRS IN THE RUN C COMMAND. TO RUN IN THIS MODE ENTER: C RU,TXMD0,IP1,IP2,IP3,IP4,IP5 C WHERE: IP1=LOGLU (WHERE ALL ERROR MESSAGES WILL BE PRINTED). C IP2=HP-IB DISC LU. C IP3=DISC DRIVE ADDRESS. C IP4=DRIVE TYPE (7906,7920 OR 7925) C IP5=1/0. STOP / DO NOT STOP AFTER THE FIRST FAILURE. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C C C DIMENSION INAM(3),IP(5),IBF(20),ISC(2),IHD(2),ICY(2),IPR(5) DIMENSION IBF1(160),ISTAT(2),ID(5),IW1(19) C C DATA IW1/2HTX,2HMD,2H1 ,2H- ,2H: ,2HRE,2HAD,2HY ,2HDR,2HIV,2HE., +2H E,2HNT,2HER,2H ",2H ",2H ,,2HCR,2H / CALL RMPAR(IP) C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C LOCK PROGRAM INTO MEMORY. C C ICD=22 IOPT=1 CALL EXEC(ICD,IOPT) C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C LOAD IFL1 WITH DATA SO IFL1#IFL2 C C IFL1=2HYE IFL2=7 C C C LOAD THE FAULTS COUNTER TO 0. C IKL=0 C C SET IUN=0 IUN=0 C C C C C C PRINT MESSAGES ON THE CRT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF THIS THE DIRECT MODE SKIP THE MESSAGES. THE DIRECT MODE GETS C THE PARAMETERS REQUIRED FROM RMPAR. C C C IF IP(4)#0 SKIP THIS MESSAGES C IF(IP(4).NE.0)GO TO 603 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C WRITE(1,978) 978 FORMAT(/,"TXMD1 - : HP-IB DISC DIAGNOSTIC",/,/,/,/, +"TXMD1 - : THE DIAGNOSTIC NEEDS TO USE ONE DISC LU FOR ITS" +,/,10X,"TESTS. THE DATA ON THIS LU WILL BE DESTROYED.",/,10X,"THE +DIAGNOSTIC WILL NOT DAMAGE ANY OTHER DATA OUTSIDE THIS" +,/,10X,"LU. BEFORE YOU ASSIGN THE LU FOR THE DIAGNOSTICS USE," +,/,10X,"MAKE SURE YOU DO NOT NEED THE DATA ON THIS LU.",/,/,10X, +"TURN ON FORMAT SWITCH BEFORE CONTINUE.") C GO TO 885 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C DIRECT MODE SECTION CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C IP(1)=LOGLU (WHERE ALL ERROR MESSAGES WILL BE PRINTED). C IP(2)=HPIB DISC LU C IP(3)=DISC DRIVE ADDRESS C IP(4)=DRIVE TYPE (7906,7920 OR 7925) C IP(5)=1/0. STOP/DO NOT STOP AFTER THE FIRST FAILURE. C C C C 603 ILST=IP(1) IF(ILST.EQ.0)ILST=1 ILU=IP(2) IADR=IP(3) IDVID=IADR ISTOP=IP(5) C C GO AND VERIFY THE ILU AND IADR C C GO TO 660 C C 880 IF(IP(4).EQ.7906)GO TO 102 IF(IP(4).EQ.7920)GO TO 104 IF(IP(4).EQ.7925)GO TO 105 C C GO TO 990 C C C END OF DIRECT MODE SECTION. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C C SET UNIT NUMBER TO 0. C 885 IUN=0 C C RTRIEVE ALL NECESARY PARAMETERS. C 806 WRITE(1,107) 107 FORMAT(/,"TXMD1 - : ENTER DISC LU") CALL INDC(IK,ISTAT) IEX=2HEX IF(ISTAT(1).EQ.IEX)GO TO 777 ILU=IK C C C C C C VERIFY THAT THIS IS A HP-IB DISC LU. C C FIRST CHECK THAT THIS IS A 32 TYPE DRIVER, MEAN ITS A DISC LU: C C C CHEKC IF ILU  91711-18117 1926 S C0122 &TXPF1 HRDWR. FLOAT. PT. DIAG.             H0101 FTN4,L PROGRAM TXPF1(3,89),91711-16117 REV 1926 791127 C C 11/27/79 CHANGED PART NUMBER FRON 91711-16100 C TO 91711-16117 C DIMENSION IPARM(5) C C********************************************************************* C* C* HARDWARE FLOATING POINT DIAGNOSTIC. C* C* :RU,TXPF1,LGLU,#PASSES C* C* WHERE LGLU = LOGICAL UNIT FOR MESSAGES. C* #PASSES = NUMBER OF TIMES TO RUN TEST. C* C********************************************************************* C C* PICK UP RUN TIME PARAMETERS C CALL RMPAR(IPARM) LGLU = IPARM(1) IF(LGLU.LE.0B) LGLU = LOGLU(IPARM(1)) IPASS = IPARM(2) IF(IPASS.LE.0B) IPASS = 1 C C* INITIALISE ERROR COUNTER C IECNT = 0 C C* FIND OUT IF HARDWARE FLOATING POINT IS PRESENT C* AND, IF NOT, EXIT WITH ERROR MESSAGE. C CALL HFPVF(HFPREV) IF(HFPREV.NE.0B) GOTO 10 WRITE(LGLU,800) STOP 10 C C* OUTPUT TEST RUNNING MESSAGE. C 10 WRITE(LGLU,810) C C* RUN THE HARDWARE FLOATING POINT TEST C DO 20 J=1,IPASS CALL RODSK(IECNT) 20 CONTINUE C C* CHECK FOR ERRORS AND PRINT MESSAGES, IF NECESSARY. C IF(IECNT.GT.0B) WRITE(LGLU,820) C C* PRINT COMPLETION MESSAGE C WRITE(LGLU,830)IPASS,IECNT C 800 FORMAT(/" TXPF1 - HFPP NOT INSTALLED AND TEST ABORTED!"/) 810 FORMAT(/" TXPF1 - HFPP TEST RUNNING") 820 FORMAT(/" TXPF1 - HFPP TEST FAILURE") 830 FORMAT(/" TXPF1 - HFPP TEST FINISHED",I5," PASSES",I5," ERRORS") C END END$ t^  91711-18119 2040 S C0122 &TXWL0 LINE PRINTER VERIF.             H0101 FTN4,L PROGRAM TXWL0(3,89), 91711-16119 REV.2040 800728 C C C NAME: TXWL0 C SOURCE: 91711-18119 C RELOC: 91711-16119 C PGMR: R.W. (BOISE) C C****************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * C THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C****************************************************************** C C C C THIS TEST IS FOR CHECKOUT OF LINE PRINTERS USING DRIVER DVA12 OR DVB12 C C VARIABLE NAMES USED IN THIS PROGRAM ARE AS FOLLOWS: C IBUF0-10..BUFFERS CONTAINING DATA TO BE PRINTED C IPRAM(1)..LOG DEVICE LU C IPRAM(2)..PROGRAM MODE(1 FOR VERIFICATION,2 FOR DIAGNOSTICS) C IPRAM(3)..TEST DEVICE LU C IPRAM(4)..LINE PRINTER CODE(1 FOR A 2608,2 FOR A 2619,3 FOR C A STANDARD PRINTER UNDER DVA12) C ILUL......PROGRAM NAME FOR LOG LU C ILUT......PROGRAM NAME FOR TEST LU C MLU.......MASK OF ISTAT2 FOR CHECK IF LU IS ASSIGNED C MTYP......MASK OF ISTAT1 FOR DEVICE TYPE CHECK C MAV.......MASK OF ISTAT1 FOR DEVICE AVAILABILITY CHECK C AND STATUS C ISTAT1....EQT WORD 5 C ISTAT2....EQT WORD 4 C ISTAT3....WORD WHICH GIVES LU STATUS & SUBCHANNEL C ISTR......BUFFER LOCATION FOR PROGRAMMABLE STATUS READ C IDOT......BUFFER LOCATION FOR DOT MATRIX & PING-PONG READ C ITYPE.....INPUT FROM CRT SPECIFYING THE TYPE OF THE PRINTER C BEING TESTED C IPRGM.....PROGRAM NAME FOR THE PROGRAM MODE C IPRNT.....VARIABLE USED TO DESCRIBE THE TYPE OF PRINTER C BEING TESTED(1-2608,2-2619,3-STANDARD) C ITSTN.....NUMBER OF DIAGNOSTIC TESTS CURRENTLY AVAILABLE C TO THE OPERATOR - 7 FOR THE 2608,5 FOR THE C 2619,2 FOR A STANDARD PRINTER UNDER DVA12 C  ICNWD.....CONTROL WORD USED IN CALLS TO THE EXECUTIVE C IRPT......NUMBER OF TIMES A PARTICULAR DIAGNOSTIC TEST C WILL BE REPEATED C ITEST.....VARIABLE WHICH CONTAINS THE TEST NO. C NUM.......3 ELEMENT ARRAY WHICH CONTAINS INPUT FROM CRT C C DIMENSION IBUF0(40),IBUF1(40),IBUF2(41),IBUF3(40),IBUF4(40) 1,IBUF5(22),IPRAM(5),ISTR(258),IDOT(1154),IBUF6(66),IBUF7(66) 1,IBUF8(66),IBUF9(66),IBUF10(256),ITYPE(2),NULL(27) DATA IBUF0/2HAB,2HCD,2HEF,2HGH,2HIJ,2HKL,2HMN,2HOP,2HQR,2HST, 12HUV,2HWX,2HYZ,2H01,2H23,2H45,2H67,2H89,2H!",2H #/ DATA IBUF1/2H$%,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43,2H21, 12H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,2HPQ/ DATA IBUF2/2H0$,2H%&,2H'(,2H)-,2H=@,2H+*,2H<>,2H?;,2H:,,2H65,2H43, 12H21,2H0A,2HBC,2HDE,2HFG,2HHI,2HJK,2HLM,2HNO,1HP/ DATA IBUF3/2H*A,2H C,2H E,2H G,2H I,2H K,2H M,2H O,2H Q,2H S, 12H U,2H W,2H Y,2H 0,2H 2,2H 4,2H 6,2H 8,2H !,2H "/ DATA IBUF4/2H B,2H D,2H F,2H H,2H J,2H L,2H N,2H P,2H R,2H T, 12H V,2H X,2H Z,2H 1,2H 3,2H 5,2H 7,2H 9,2H #,2H $/ DATA IBUF5/2H1 ,2H ,2H ,2H ,2H ,2HTO,2HP ,2HOF,2H F,2HOR,2HM!/ DATA IBUF6/5*2HUU,2H*U,4*2HUU,2HU*,5*2HUU,2H*U,4*2HUU, 12HU*,5*2HUU,2H*U,4*2HUU,2HU*,5*2HUU,2H*U,4*2HUU,2HU*, 15*2HUU,2H*U,4*2HUU,2HU*,5*2HUU,2H*U,4*2HUU,2HU*/ DATA IBUF7/5*2H**,2HU*,4*2H**,2H*U,5*2H**,2HU*,4*2H**, 12H*U,5*2H**,2HU*,4*2H**,2H*U,5*2H**,2HU*,4*2H**,2H*U, 15*2H**,2HU*,4*2H**,2H*U,5*2H**,2HU*,4*2H**,2H*U/ DATA IBUF8/4*2H00,4*2H11,4*2H22,4*2H33,4*2H44,4*2H55, 14*2H66,4*2H77,4*2H88,4*2H99,4*2H00,4*2H11,4*2H22,4*2H33, 14*2H44,4*2H55,2*2H66/ DATA IBUF9/66*2HUU/ DATA NULL/27*2H/ CALL EXEC(22,1) CALL RMPAR(IPRAM) C C ASSIGN LOG DEVICE LU C ILUL=IPRAM(1) IF(IPRAM(1).LE.0) ILUL=LOGLU(IPRAM(1)) C C ASSIGN TEST DEVICE LU C IF(IPRAM(3).LE.0) GOTO 8020 40 ILUT=IPRAM(3) C C********************************************************************* C* SECTION 100 - GET LU AND VERIFY * C********************************************************************* C CALL EXEC(13,ILUT,ISTAT1,ISTAT2,ISTAT3) C C CHECK TO SEE IF LU WAS ASSIGNED C MLU=IAND(ISTAT2,77B) IF(MLU) 8000,8000,100 C C CHECK FOR PROPER DEVICE TYPE C 100 MTYP=IAND(ISTAT1,37400B) IF(MTYP-5000B) 8100,110,8100 C C CHECK FOR TEST DEVICE AVAILABILITY C 110 MAV=IAND(ISTAT1,140000B) IF(MAV) 8200,120,8200 C C CHECK TO SEE IF LU IS UP C 120 MAV=IAND(ISTAT3,100000B) IF(MAV) 8200,200,8200 C C********************************************************************* C* SECTION 200 - TEST PRINTER SELECTION * C********************************************************************* C C THIS SECTION GETS THE CODE NO. FOR THE PRINTER TO BE TESTED C AND THEN JUMPS TO THE APPROPRIATE SET OF TESTS C C DEFAULT IS IPRAM(4)=0,IF SO,GO LIST PRINTER CODES C 200 CALL LURQ(1,ILUT,1) IPRGM=IPRAM(2) ICNWD=ILUT+1100B IF(IPRAM(4).EQ.0)GOTO 270 IF(IPRAM(4).EQ.1)GOTO 400 IF(IPRAM(4).EQ.2)GOTO 2500 IF(IPRAM(4).EQ.3)GOTO 5800 C C ILLEGAL PRINTER CODE SPECIFIED AT RUN TIME,SO ABORT TESTS C WRITE(ILUL,280) ILUT 280 FORMAT(/" TXWL0 - LU#",I3,": ILLEGAL LINE PRINTER CODE" 1" SPECIFIED AT RUN TIME.") GOTO 9020 C C LIST ALL PRINTERS AND THEIR RESPECTIVE CODE NO. C 270 IF((IPRGM.LT.0).OR.(IPRGM.GT.2))GOTO 480 WRITE(ILUL,210) 210 FORMAT(/,20X,"LINE PRINTER CODES") WRITE(ILUL,220) 220 FORMAT(/,21X,"PRINTER",5X,"CODE") WRITE(ILUL,230) 230 FORMAT(22X,"2608",9X,"1"/,22X,"2619",9X,"2"/, 122X,"STANDARD",5X,"3"/,22X,"EXIT",9X,"/E,EN,EX") 260 WRITE(ILUL,240) 240 FORMAT(//"PLEASE ENTER PRINTER CODE? _") C C GET THE PRINTER CODE AND CHECK FOR LEGALITY C CALL EXEC(1,ILUL+400B,ITYPE,-4) CALL ABREG(IA,IB) {A IF(IB.GT.2) GOTO 290 IF(ITYPE.EQ.2H/E)GOTO 9030 IF(ITYPE.EQ.2HEN)GOTO 9030 IF(ITYPE.EQ.2HEX)GOTO 9030 IF(IB.GT.1)GOTO 290 IF(ITYPE.EQ.2H1 )GOTO 400 IF(ITYPE.EQ.2H2 )GOTO 2500 IF(ITYPE.EQ.2H3 )GOTO 5800 C C ILLEGAL PRINTER CODE,SO PRINT AN ERROR MESSAGE AND GO GET CORRECT CODE C 290 WRITE(ILUL,250) ILUT 250 FORMAT(/" TXWL0 - LU#",I3,": ILLEGAL LINE PRINTER CODE.") GOTO 260 C C C********************************************************************* C* SECTION 400 - 2608 PRINTER TESTS * C********************************************************************* C 400 IPRNT=1 ITSTN=7 C C CHECK FOR ILLEGAL PROGRAM MODE C IF AN ILLEGAL PROGRAM MODE WAS SPECIFIED AT RUN TIME,THEN ABORT TESTS C IF((IPRGM.GE.0).AND.(IPRGM.LE.2))GOTO 470 480 WRITE(ILUL,5880) ILUT GOTO 9020 C C DEFAULT IS ZERO,IF SO,CALL SUBROUTINE MODE AND GET PROPER PROGRAM MODE C 470 IF(IPRGM.EQ.0)CALL MODE(ILUL,ILUT,IPRGM) C C CLEAR DEVICE AND AUTOMATIC PAGE EJECT MODE C CALL EXEC(3,ILUT) CALL EXEC(3,ICNWD,65) GOTO (420,430),IPRGM C C IF IPRGM=1,THEN RUN THE VERIFICATION PACKAGE(RUN ALL AVAILABLE C TESTS FOR THE 2608 PRINTER ONCE) C 420 IRPT=1 GOTO 500 C C IF IPRGM=2,THEN RUN THE DIAGNOSTIC PACKAGE FOR THE 2608 PRINTER C 430 WRITE(ILUL,440) 440 FORMAT(///,20X,"2608 PRINTER TESTS") WRITE(ILUL,450) 450 FORMAT(/,20X,"NO.",11X,"TEST") C C LIST ALL AVAILABLE TESTS FOR THE 2608 AND THEIR RESPECTIVE TEST NOS. C WRITE(ILUL,460) 460 FORMAT(21X,"1",13X,"DOT MATRIX TEST"/, 121X,"2",13X,"PING/PONG READ/WRITE TEST"/, 121X,"3",13X,"PRINT VERSION OF SELF-TEST"/, 121X,"4",13X,"DOUBLE SIZE PRINT TEST"/, 121X,"5",13X,"STATUS READBACK AND OUTPUT"/, 121X,"6",13X,"12 CHANNEL VFC TEST"/, 121X,"7",13X,"CHARACTER AND LINE SPACE TEST"/, 121X,"/E,EN,EX",6X,"EXIT") C C JUMP TO SUBROUTINEb SELCT TO GET PROPER TEST NO. AND REPEAT VALUE, C THEN JUMP TO SELECTED TEST FOR EXECUTION C 490 CALL SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN) GOTO (500,600,1000,1100,2000,5500,6000,9030),ITEST C C********************************************************************* C* SECTION 500 - 2608 DOT MATRIX TESTS * C********************************************************************* C 500 DO 530 K=1,IRPT WRITE(ILUL,506) ILUT,K 506 FORMAT(/" TXWL0 - LU#",I3,": DOT MATRIX TEST RUNNING, PASS ", 1I2) C C HEADER C WRITE(ILUT,510) 510 FORMAT(54X,"DOT MATRIX TEST"//) C C DOT MATRIX READ/WRITE TEST C CALL EXEC(1,ILUT,IDOT,-1153,0) CALL EXEC(3,ILUT+3000B,2) DO 520 I=1,577 NULL(27)=IDOT(I) CALL EXEC(2,ILUT+200B,NULL,-54) 520 CONTINUE CALL EXEC(3,ILUT+3000B,0) IF(IFBRK(IDMY))9020,530 530 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 490 C C********************************************************************* C* SECTION 600 - 2608 PING-PONG READ/WRITE TEST * C********************************************************************* C 600 DO 630 K=1,IRPT WRITE(ILUT,610) 610 FORMAT(46X,"PING-PONG READ/WRITE TEST TO FOLLOW"//) WRITE(ILUL,612) ILUT,K 612 FORMAT(/" TXWL0 - LU#",I3,": PING-PONG TEST RUNNING, PASS ", 1I2) CALL EXEC(1,ILUT+100B,IDOT,257) DO 620 I=1,257 WRITE(ILUT,615) I,IDOT(I),IDOT(I) 615 FORMAT(47X," BUFFER LOC.(",I3,") = ",@6," = ",A2) 620 CONTINUE IF(IFBRK(IDMY))9020,630 630 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 490 C C********************************************************************* C* SECTION 1000 - 2608 PRINT VERSION OF SELF-TEST * C********************************************************************* C 1000 DO 1030 K=1,IRPT WRITE(ILUT,1010) 1010 FORMAT(46X,"PRINT VERSION OF SELF-TEST TO FOLLOW"//) C SELF TESӃT--PRINT VERSION C WRITE(ILUL,1020) ILUT,K 1020 FORMAT(/" TXWL0 - LU#",I3,": SELF TEST--PRINT VERSION" 1" RUNNING, PASS ",I2) CALL EXEC(3,ILUT+2000B,0) IF(IFBRK(IDMY))9020,1030 1030 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 490 C C********************************************************************* C* SECTION 1100 - 2608 DOUBLE SIZE PRINT TEST * C********************************************************************* C 1100 DO 1120 K=1,IRPT WRITE(ILUT,1110) 1110 FORMAT(55X,"DOUBLE SIZE PRINT TEST") WRITE(ILUL,1115) ILUT,K 1115 FORMAT(/" TXWL0 - LU#",I3,": DOUBLE SIZE PRINT TEST RUNNING," 1" PASS ",I2) CALL EXEC(3,ILUT+3000B,1) WRITE(ILUT,1116) 1116 FORMAT(/" DOUBLE SIZE PRINT"/) CALL EXEC(3,ILUT+3000B,0) IF(IFBRK(IDMY))9020,1120 1120 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 490 C C********************************************************************* C* SECTION 2000 - 2608 STATUS READBACK AND OUTPUT * C********************************************************************* C C CONTROL REQUEST FOR STATUS READ & OUTPUT OF STATUS C 2000 DO 2050 K=1,IRPT WRITE(ILUL,2010) ILUT,K 2010 FORMAT(/" TXWL0 - LU#",I3,": STATUS READBACK TEST RUNNING" 1", PASS ",I2) WRITE(ILUT,2020) 2020 FORMAT(40X,"CONTROL REQUEST STATUS READ - UNIQUE TO 2608" 1" PRINTER"//) CALL EXEC(1,ILUT+200B,ISTR,16) DO 2030 I=1,16 WRITE(ILUT,2040) ILUT,I,ISTR(I) 2040 FORMAT(42X," TXWL0 - LU#",I3,": STATUS BUFFER WORD #",I3," - ",@6) 2030 CONTINUE IF(IFBRK(IDMY))9020,2050 2050 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 490 GOTO 5500 C C********************************************************************* C* SECTION 2500 - 2619 PRINTER TESTS * C********************************************************************* C 2500 IPRNT=2 ITSTN=5 C C CHDECK FOR ILLEGAL PROGRAM MODE C IF AN ILLEGAL PROGRAM MODE WAS SPECIFIED AT RUN TIME,THEN ABORT TESTS C IF((IPRGM.GE.0).AND.(IPRGM.LE.2))GOTO 2570 WRITE(ILUL,5880) ILUT GOTO 9020 C C DEFAULT IS ZERO,IF SO,CALL SUBROUTINE MODE AND GET PROPER PROGRAM MODE C 2570 IF(IPRGM.EQ.0)CALL MODE(ILUL,ILUT,IPRGM) C C CLEAR DEVICE AND AUTOMATIC PAGE EJECT MODE,GO TO TOP OF FORM C CALL EXEC(3,ILUT) CALL EXEC(3,ICNWD,65) CALL EXEC(3,ICNWD,-1) GOTO (2520,2530),IPRGM C C IF IPRGM=1,THEN RUN THE VERIFICATION PACKAGE(RUN ALL AVAILABLE C TESTS FOR THE 2619 PRINTER ONCE) C 2520 IRPT=1 GOTO 3000 C C IF IPRGM=2,THEN RUN THE DIAGNOSTIC PACKAGE FOR THE 2619 PRINTER C 2530 WRITE(ILUL,2540) 2540 FORMAT(///,20X,"2619 PRINTER TESTS") WRITE(ILUL,2550) 2550 FORMAT(/,20X,"NO.",11X,"TEST") C C LIST ALL AVAILABLE TESTS FOR THE 2619 AND THEIR RESPECTIVE TEST NOS. C WRITE(ILUL,2560) 2560 FORMAT(21X,"1",13X,"RIPPLE PRINT TEST"/, 121X,"2",13X,"DATA LINES (SENSITIVE BIT) TEST"/, 121X,"3",13X,"HAMMER ALIGNMENT TEST"/, 121X,"4",13X,"8/12 CHANNEL VFC TEST"/, 121X,"5",13X,"CHARACTER AND LINE SPACE TEST"/, 121X,"/E,EN,EX",6X,"EXIT") C C JUMP TO SUBROUTINE SELCT TO GET PROPER TEST NO. AND REPEAT VALUE, C THEN JUMP TO PROPER TEST ADDRESS C 2590 CALL SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN) GOTO (3000,4000,5000,5500,6000,9030),ITEST C********************************************************************* C* SECTION 3000 - 2619 RIPPLE PRINT TEST * C********************************************************************* C C THIS TEST VERIFIES THAT EVERY PRINTABLE CHARACTER CAN BE PRINTED C IN EVERYONE OF THE 132 COLUMNS C 3000 J=127 DO 3030 I=1,256 IBUF10(I)=J J=J+1 IF(J.EQ.128) J=0 3030 CONTINUE DO 3020 K=1,IRPT WRITE(ILUL,3010) ILUT,K 3010 FORMAT(/" TXWL0 - LU#",I3,": RIPPLE PRINT TEST RUNNING" 1)", PASS ",I2) WRITE(ILUT,3060) 3060 FORMAT(57X,"RIPPLE PRINT TEST"//) DO 3040 J=1,60 WRITE(ILUT,3050)(IBUF10(I),I=J,J+131) 3050 FORMAT(1H ,132R1) 3040 CONTINUE IF(IFBRK(IDMY))9020,3020 3020 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 2590 C C********************************************************************* C* SECTION 4000 - 2619 DATA LINES (SENSITIVE BIT) TEST * C********************************************************************* C C THIS 2619 TEST IS USED TO VERIFY THAT THE CAPACITANCE WHICH C APPEARS BETWEEN THE DATA LINES IN THE COMMUNICATIONS CABLE ARE C NOT AFFECTING DATA TRANSMISSION SIGNALS C 4000 DO 4030 K=1,IRPT WRITE(ILUL,4020) ILUT,K 4020 FORMAT(/" TXWL0 - LU#",I3,": SENSITIVE BIT TEST RUNNING" 1", PASS ",I2) WRITE(ILUT,4040) 4040 FORMAT(57X,"SENSITIVE BIT TEST"//) DO 4010 I=1,30 CALL EXEC(2,ILUT+200B,IBUF6,-132) CALL EXEC(2,ILUT+200B,IBUF7,-132) 4010 CONTINUE IF(IFBRK(IDMY))9020,4030 4030 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 2590 C C********************************************************************* C* SECTION 5000 - 2619 HAMMER MODULE ALIGNMENT TEST * C********************************************************************* C C THIS 2619 TEST IS USED TO CHECK FOR PROPER ALIGNMENT OF THE HAMMER C MODULES(A GROUP OF 8 HAMMERS) C 5000 DO 5040 K=1,IRPT WRITE(ILUL,5030) ILUT,K 5030 FORMAT(/" TXWL0 - LU#",I3,": HAMMER ALIGNMENT TEST RUNNING" 1", PASS ",I2) WRITE(ILUT,5050) 5050 FORMAT(55X,"HAMMER ALIGNMENT TEST"//) DO 5010 I=1,4 CALL EXEC(2,ILUT+200B,IBUF8,-132) DO 5020 J=1,14 CALL EXEC(2,ILUT+200B,IBUF9,-132) 5020 CONTINUE 5010 CONTINUE IF(IFBRK(IDMY))9020,5040 5040 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 2590 C C********************************************************************* C* SECTION 5500 - 2608 ANR.D 2619 VERTICAL CONTROL FUNCTION TESTS * C********************************************************************* C C THIS IS A 2608/2619 TEST USED TO CHECK THE VFC OF THE PRINTER C UNDER TEST. AFTER EACH VFC COMMAND, A CALL TO SUBROUTINE CHAN IS C MADE.CHAN CHECKS TO SEE IF THE LAST VFC COMMAND WAS A TOF OR BOF C VFC COMMAND. C 5500 DO 5630 K=1,IRPT WRITE(ILUL,5640) ILUT,K 5640 FORMAT(/" TXWL0 - LU#",I3,": 2608/2619 VFC TEST" 1" RUNNING, PASS ",I2) WRITE(ILUT,5650) 5650 FORMAT(52X,"2608/2619 VFC TEST") C C DO A CHANNEL 1 (PAGE EJECT) CALL EXEC(3,ICNWD,-1) WRITE(ILUT,5510) 5510 FORMAT("*CHANNEL 1") CALL CHAN(ILUT) C C DO A CHANNEL 3 (SKIP TO NEXT SINGLE SPACE) CALL EXEC(3,ICNWD,56) WRITE(ILUT,5520) 5520 FORMAT("*CHANNEL 3") CALL CHAN(ILUT) C C DO A CHANNEL 4 (SKIP TO NEXT DOUBLE LINE) CALL EXEC(3,ICNWD,57) WRITE(ILUT,5530) 5530 FORMAT("*CHANNEL 4") CALL CHAN(ILUT) C C DO A CHANNEL 5 (SKIP TO NEXT TRIPLE LINE) CALL EXEC(3,ICNWD,58) WRITE(ILUT,5540) 5540 FORMAT("*CHANNEL 5") CALL CHAN(ILUT) C C DO A CHANNEL 7 (SKIP TO NEXT QUARTER PAGE) CALL EXEC(3,ICNWD,60) WRITE(ILUT,5550) 5550 FORMAT("*CHANNEL 7") CALL CHAN(ILUT) C C DO A CHANNEL 6 (SKIP TO NEXT HALF PAGE) CALL EXEC(3,ICNWD,59) WRITE(ILUT,5560) 5560 FORMAT("*CHANNEL 6") CALL CHAN(ILUT) C C DO A CHANNEL 8 (SKIP TO NEXT TENTH LINE) CALL EXEC(3,ICNWD,61) WRITE(ILUT,5570) 5570 FORMAT("*CHANNEL 8") CALL CHAN(ILUT) C C DO A CHANNEL 2 (SKIP TO BOTTOM OF FORM) CALL EXEC(3,ICNWD,62) WRITE(ILUT,5580) 5580 FORMAT("*CHANNEL 2") CALL CHAN(ILUT) C C DO A CHANNEL 11 (SKIP TO LINE BEFORE TOP OF FORM) IF((IPRAM(5).EQ.1).AND.(IPRNT.EQ.2))GOTO 5660 CALL EXEC(3,ICNWD,68) WRITE(ILUT,5590) 5590 FORMAT("*CHANNEL 11") CALL CHAN(ILUT) C C DO A CHANNEL 12 (SKI'P TO TOP OF FORM WITH STATUS) CALL EXEC(3,ICNWD,69) WRITE(ILUT,5600) 5600 FORMAT("*CHANNEL 12") CALL CHAN(ILUT) C C DO A CHANNEL 10 (SKIP TO LINE BEFORE BOTTOM OF FORM) CALL EXEC(3,ICNWD,67) WRITE(ILUT,5610) 5610 FORMAT("*CHANNEL 10") CALL CHAN(ILUT) C C DO A CHANNEL 9 (SKIP TO BOTTOM OF FORM WITH STATUS) CALL EXEC(3,ICNWD,66) WRITE(ILUT,5620) 5620 FORMAT("*CHANNEL 9") CALL CHAN(ILUT) 5660 IF(IFBRK(IDMY))9020,5630 5630 CALL EXEC(3,ICNWD,1) IF(IPRGM.EQ.1)GOTO 6000 GOTO (490,2590),IPRNT C C********************************************************************* C* SECTION 5800 - STANDARD PRINTER TESTS * C********************************************************************* C 5800 IPRNT=3 ITSTN=2 C C CHECK FOR ILLEGAL PROGRAM MODE C IF AN ILLEGAL PROGRAM MODE WAS SPECIFIED AT RUN TIME,THEN ABORT TESTS C IF((IPRGM.GE.0).AND.(IPRGM.LE.2))GOTO 5870 WRITE(ILUL,5880) ILUT 5880 FORMAT(/" TXWL0 - LU#",I3,": ILLEGAL PROGRAM MODE" 1" SPECIFIED AT RUN TIME.") GOTO 9020 C C DEFAULT IS ZERO,IF SO,CALL SUBROUTINE MODE AND GET PROPER PROGRAM MODE C 5870 IF(IPRGM.EQ.0)CALL MODE(ILUL,ILUT,IPRGM) C C CLEAR DEVICE AND AUTOMATIC PAGE EJECT MODE,GO TO TOP OF FORM C CALL EXEC(3,ILUT) CALL EXEC(3,ICNWD,65) CALL EXEC(3,ICNWD,-1) GOTO (5820,5830),IPRGM C C IF IPRGM=1,THEN RUN VERIFICATION PACKAGE(RUN ALL AVAILABLE TESTS FOR C A STANDARD PRINTER UNDER DVA12 ONCE) C 5820 IRPT=1 GOTO 6000 C C IF IPRGM=2,THEN RUN THE DIAGNOSIC PACKAGE FOR A STANDARD PRINTER C UNDER DVA12 C 5830 WRITE(ILUL,5840) 5840 FORMAT(///,20X,"STANDARD PRINTER TESTS") WRITE(ILUL,5850) 5850 FORMAT(/,20X,"NO.",15X,"TEST") C C LIST ALL AVAILABLE TESTS FOR A STANDARD PRINTER UNDER DVA12 C AND THEIR RESPECTIVE TEST NOS. C WRITE(ILUL,5860) 5860 FORMAT(21X,"1",17X,"CHARACTER AND LINE SPACE TEST"/, 121X,"2",17X,"8 CHANNEL VFC TEST"/, 121X,"/E,EN,EX",10X,"EXIT") C C JUMP TO SUBROUTINE SELCT TO GET PROPER TEST NO. AND REPEAT VALUE, C THEN JUMP TO PROPER TEST ADDRESS C 5890 CALL SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN) GOTO (6000,7000,9030),ITEST C********************************************************************* C* SECTION 6000 - STANDARD CHARACTER AND LINE SPACE TEST * C********************************************************************* C 6000 DO 6050 K=1,IRPT WRITE(ILUT,6010) 6010 FORMAT(51X,"CHARACTER AND LINE SPACE TEST"//) WRITE(ILUL,6020) ILUT,K 6020 FORMAT(/" TXWL0 - LU#",I3,": CHARACTER & LINE SPACE TEST" 1" RUNNING, PASS ",I2) C C OUTPUT DATA FROM BUFFERS TO PRINTER C C OUTPUT FIVE LINE SPACINGS C CALL EXEC(3,ICNWD,5) C C OUTPUT BUFFER, PRINT COLUMN 1 C CALL EXEC(2,ILUT+200B,IBUF0,-40) C C OUTPUT BUFFER, PRINT COLUMN 1 C CALL EXEC(2,ILUT+200B,IBUF1,-40) C C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. C DO A DOUBLE SPACE, THEN OUTPUT BUFFER. C CALL EXEC(2,ILUT,IBUF2,-41) C C FIRST CHARACTER INTERPRETED AS CONTROL CHARACTER. C SUPPRESS SPACE (OVERPRINT), THEN OUTPUT BUFFER PRINTING COLUMN 1. C CALL EXEC(2,ILUT,IBUF3,-40) C C OUTPUT BUFFER, PRINT COLUMN 1. C CALL EXEC(2,ILUT+200B,IBUF4,-40) C C SPACE ONE LINE C CALL EXEC(3,ICNWD,1) C C OUTPUT BUFFER TO CHECK CHARACTERS C WRITE(ILUT,6030) 6030 FORMAT(" ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!'#$%&()-=@+<>?:876" 1"543210ZYXWVUTSRQPONMLKJ") C C FIRST CHARACTER INTERPRETED AS A CONTROL CHARACTER C TOP OF FORM, THEN OUTPUT BUFFER. C CALL EXEC(2,ILUT,IBUF5,-22) C IF(IFBRK(IDMY))9020,6050 6050 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 6060 GOTO (7150,7150,7000),IPRNT 6060 GOTO (490,2590,5890),IPRNT C C********************************************************************* C* SECTION 7000 - STANDARD VER_TICAL CONTROL FUNCTION TESTS * C********************************************************************* C C THIS IS A STANDARD VFC TEST FOR EITHER 6 OR 8 LPI PRINTERS C 7000 DO 7010 K=1,IRPT WRITE(ILUL,7070) ILUT,K 7070 FORMAT(/" TXWL0 - LU#",I3,": CONTROL FUNCTION TEST RUNNING" 1", PASS ",I2) WRITE(ILUT,7160) 7160 FORMAT(55X,"CONTROL FUNCTION TEST"//) C C DO A PAGE EJECT AND WRITE TOP OF FORM MESSAGE C CALL EXEC(3,ICNWD,-1) WRITE(ILUT,7080) 7080 FORMAT(" TOP OF FORM!") C C SKIP TO NEXT 1/6 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ICNWD,61) WRITE(ILUT,7090) 7090 FORMAT(" 1/6 PAGE BOUNDRY!") C C SKIP TO NEXT 1/4 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ICNWD,60) WRITE(ILUT,7100) 7100 FORMAT(" 1/4 PAGE BOUNDRY!") C C SKIP TO NEXT 1/2 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ICNWD,59) WRITE(ILUT,7110) 7110 FORMAT(" 1/2 PAGE BOUNDRY!") C C SKIP TO BOTTOM OF THE PAGE AND PRINT MESSAGE C CALL EXEC(3,ICNWD,62) WRITE(ILUT,7120) 7120 FORMAT(" BOTTOM OF PAGE!") C C SKIP TO APPROXIMATELY 3/4 PAGE BOUNDARY AND PRINT MESSAGE C CALL EXEC(3,ICNWD,45) WRITE(ILUT,7130) 7130 FORMAT(" APPROXIMATELY 3/4 DOWN PAGE!") IF(IFBRK(IDMY))9020,7010 7010 CALL EXEC(3,ICNWD,5) IF(IPRGM.EQ.2)GOTO 5890 7150 WRITE(ILUL,7140) ILUT 7140 FORMAT(/" TXWL0 - LU#",I3,": LINE PRINTER TESTS FINISHED"/) GOTO 9900 C C********************************************************************* C* SECTION 8000 - ERROR MESSAGES * C********************************************************************* C 8000 WRITE(ILUL,8010) ILUT 8010 FORMAT(/" TXWL0 - LU#",I3,": NOT ASSIGNED, NOT TESTED!"/) GOTO 9000 8020 WRITE(ILUL,8025) 8025 FORMAT(/" TXWL0 - LU# SPECIFIED FOR LINE PRINTER" 1" IS ILLEGAL."/" RERUN TEST SPECIFYIN<G AN INTEGER >0" 2" AND <64 FOR LU#.") GOTO 9000 8100 WRITE(ILUL,8110) ILUT 8110 FORMAT(/" TXWL0 - LU#",I3," IS NOT ASSIGNED TO A LINE PRINTER."/ 1" RERUN TEST SPECIFYING CORRECT LU#.") GOTO 9000 8200 WRITE(ILUL,8210) ILUT 8210 FORMAT(/" TXWL0 - LU#",I3,": EQT OR LU FOR TEST PRINTER" 1" IS DOWN."/" UP EQT AND RERUN TEST.") GOTO 9000 C C********************************************************************* C* SECTION 9000 - EXIT/ABORT MESSAGES AND TERMINATE * C********************************************************************* C 9020 WRITE(ILUL,9010) ILUT 9010 FORMAT(/" TXWL0 - LU#",I3,": LINE PRINTER TESTS ABORTED!") GOTO 9900 9030 WRITE(ILUL,9040) ILUT 9040 FORMAT(/" TXWL0 - LU#",I3,": LINE PRINTER TESTS EXITED!"/) 9900 CALL LURQ(0,ILUT,1) CALL EXEC(3,ICNWD,64) CALL EXEC(3,ICNWD,-1) 9000 CALL EXEC(22,0) END C C C C********************************************************************* C* SUBROUTINE CHAN * C********************************************************************* C C THIS SUBROUTINE CHECKS TO SEE IF THE LAST VFC COMMAND ISSUED TO C 2608A/2619A PRINTER WAS A CHANNEL 9 OR 12. IF SO,THEN OUTPUT AN C APPROPRIATE MESSAGE. C SUBROUTINE CHAN(ILUT) CALL EXEC(3,ILUT+600B) C C GET THE CURRENT STATUS FOR THE PRINTER UNDER TEST(EQT#5) C CALL EXEC(13,ILUT,ISTAT1) ICHN=IAND(ISTAT1,3) C C IF BIT 0 OF EQT#5 IS 1,THEN A VFC CHANNEL 12 WAS DETECTED C IF BIT 1 OF EQT#5 IS 1,THEN A VFC CHANNEL 9 WAS DETECTED C IF(ICHN.EQ.1)GOTO 10 IF(ICHN.EQ.2)GOTO 20 RETURN 10 WRITE(ILUT,30) 30 FORMAT("* ; MATCHES CH 12") RETURN 20 WRITE(ILUT,40) 40 FORMAT(" ; MATCHES CH 9") RETURN END C C C C********************************************************************* C* ]SUBROUTINE MODE * C********************************************************************* C C THIS SUBROUTINE TALKS INTERACTIVELY WITH THE LOG DEVICE IN ORDER TO C GET THE PROGRAM MODE C SUBROUTINE MODE(ILUL,ILUT,IPRGM) C C LIST THE CURRENT PROGRAM MODES C 30 WRITE(ILUL,10) 10 FORMAT(//,"PLEASE ENTER:"/,8X, 1"1 FOR THE VERIFICATION PACKAGE"/,8X, 1"2 FOR THE DIAGNOSTIC PACKAGE? _") C C READ THE PROGRAM MODE VALUE AND CHECK FOR LEGALITY C CALL EXEC(1,ILUL+400B,IPRGM,-2) CALL ABREG(IA,IB) IF(IB.GT.1)GOTO 60 IF(IPRGM.EQ.2H1 )GOTO 20 IF(IPRGM.EQ.2H2 )GOTO 50 C C IF ILLEGAL,GO AND GET PROPER PROGRAM MODE VALUE C 60 WRITE(ILUL,40) ILUT 40 FORMAT(/" TXWL0 - LU#",I3,": ILLEGAL PROGRAM MODE.") GOTO 30 20 IPRGM=1 RETURN 50 IPRGM=2 RETURN END C C C C********************************************************************* C* SUBROUTINE SELCT * C********************************************************************* C C THIS SUBROUTINE GETS THE PROPER TEST NO. AND REPEAT VALUE C SUBROUTINE SELCT(ILUL,ILUT,ITEST,IRPT,ITSTN) DIMENSION NUM(2) C C GET THE PROPER TEST NO. C 10 WRITE(ILUL,20) 20 FORMAT(//"PLEASE ENTER TEST NO.? _") CALL EXEC(1,ILUL+400B,NUM,-4) CALL ABREG(IA,IB) IF((IB.EQ.0).OR.(IB.GT.2))GOTO 110 IF(NUM.EQ.2H/E)GOTO 120 IF(NUM.EQ.2HEN)GOTO 120 IF(NUM.EQ.2HEX)GOTO 120 IF(IB.GT.1)GOTO 110 ITEST=IAND(NUM,77400B) ITEST=ITEST/256 ITEST=ITEST-60B IF((ITEST.GE.1).AND.(ITEST.LE.ITSTN))GOTO 40 110 WRITE(ILUL,50) ILUT 50 FORMAT(/" TXWL0 - LU#",I3,": ILLEGAL TEST NO.") GOTO 10 120 ITEST=ITSTN+1 RETURN C C GET THE PROPER REPEAT VALUE C 40 WRITE(ILUL,70) ITEST 70 FORMAT(/"HOW MANY TIMES WOULD YOU LIKE TEST ", 1I2," REPEATED(1-99)? _") ZXT CALL EXEC(1,ILUL+400B,NUM,-4) CALL ABREG(IA,IB) IF((IB.EQ.0).OR.(IB.GT.2))GOTO 130 IF(IB.EQ.2)GOTO 30 IRPT=IAND(NUM,77400B) IRPT=IRPT/256 IRPT=IRPT-60B IF((IRPT.GE.1).AND.(IRPT.LE.9))RETURN GOTO 130 30 IVAR=IAND(NUM,77400B) IVAR=IVAR/256 IF((IVAR.LT.60B).OR.(IVAR.GT.71B))GOTO 130 IRPT=(IVAR-60B)*10 IVAR=IAND(NUM,177B) IF((IVAR.LT.60B).OR.(IVAR.GT.71B))GOTO 130 IRPT=IRPT+(IVAR-60B) RETURN 130 WRITE(ILUL,100) ILUT 100 FORMAT(/"TXWL0 - LU#",I3,": ILLEGAL REPEAT VALUE.") GOTO 40 END END$ Z  91711-18201 2001 S C0122 ANSWER ANSWER FILE RTE MI             H0101 ** PART NUMBER 91711-18201 ** ANSWER FILE FOR RTE M GENERATION FOR ** !TXTD1 STAND ALONE ICD DIAGNOSTIC ** NOTE THAT RELOCATABLE IS CALLED %DIAG ** FOR ALL STAND ALONE DIAGNOSTICS GEN ECHO ON ECHO::33 OUTPUT ON !MOUT::33 MAP MODULES ON ECHO::33 END 1 0 0 77677 100 .FAD,RP,105000 .FSB,RP,105020 .FMP,RP,105040 .FDV,RP,105060 IFIX,RP,105100 FLOAT,RP,105120 .MPY,RP,100200 .DIV,RP,100400 .DLD,RP,104200 .DST,RP,104400 .MBT,RP,105765 .MVW,RP,105777 END REL %MSY1 REL %MMP REL %0DV05 REL %DVR00 REL %DVA32 REL %TA32 SEARCH %MDMLB END 100,400 10,DVR00,X=13,B,T=200 11,DVR05,X=13,B,T=200 12,DVA32,D 77,DVR05,X=13,B,T=200 END 1,1 0 0 3 END 10,PRG,DUMY 11,PRG,DUMY 12,PRG,DUMY 13,PRG,DUMY 14,PRG,DUMY 15,PRG,DUMY 16,PRG,DUMY 17,PRG,DUMY 20,PRG,DUMY 21,PRG,DUMY 22,PRG,DUMY 23,PRG,DUMY 24,PRG,DUMY 25,PRG,DUMY 26,PRG,DUMY 27,PRG,DUMY 30,PRG,DUMY 31,PRG,DUMY 32,PRG,DUMY 33,PRG,DUMY 34,PRG,DUMY 35,PRG,DUMY 36,PRG,DUMY 37,PRG,DUMY 40,PRG,DUMY 41,PRG,DUMY 42,PRG,DUMY 43,PRG,DUMY 44,PRG,DUMY 45,PRG,DUMY 46,PRG,DUMY 47,PRG,DUMY 50,PRG,DUMY 51,PRG,DUMY 52,PRG,DUMY 53,PRG,DUMY 54,PRG,DUMY 55,PRG,DUMY 56,PRG,DUMY 57,PRG,DUMY 60,PRG,DUMY 61,PRG,DUMY 62,PRG,DUMY 63,PRG,DUMY 64,PRG,DUMY 65,PRG,DUMY 66,PRG,DUMY 67,PRG,DUMY 70,PRG,DUMY 71,PRG,DUMY 72,PRG,DUMY 73,PRG,DUMY 74,PRG,DUMY 75,PRG,DUMY 76,PRG,DUMY 77,PRG,DUMY END 4 CONFG END END 0 NO REL %CONFG END 0 REL %DUMY END 0 REL %DIAG SEARCH %DGLB SEARCH %DSKLB SEARCH %MSYLB SEARCH %RLIB1 SEARCH %RLIB2 SEARCH %RLIB3 SEARCH %MSYLB END 0 END 0 NO SNAP ON SNAP::33 END   91711-18203 2001 S C0122 &CONFG I-0 CONFIGURE PROG.             H0101 ASMB,R,L NAM CONFG,3 91711-16203 REV.2001 791102 EXT EXEC,$LIBR,$LIBX B EQU 1 * * * THIS IS THE RTE-M1 START UP PROGRAM * * IT ALTERS THE SYSTEM TABLES FOR THE CORRECT * CONSOLE AND DIAGNOSTIC TARGET DEVICE * SELECT CODES AS FOUND IN THE SWITCH REGISTER * (0-5)= CONSOLE , TARGET DEV =(6-11). * * WHEN EVERYTHING IS READY TO GO, THE DIAGNOSTIC * PROGRAM IS SCHEDULED. IF THE DIAGNOSTIC PROGRAM * TERMINATES,THIS PROGRAM CONTINUES. CONFG NOP JSB $LIBR TURN INTERUPT SYSTEM OFF NOP LIA 1 GET CONSOLE & TARGET DEVICE S.C. ALSO AND B77 MASK FOR CONSOLE ONLY STA CONSL SAVE IT IN CONSL LIA 1 GET THE SAME WORD AGAIN AND MSK2 MASK FOR TARGET DEVICE THIS TIME CLB RIGHT JUSTIFY IT LSR 6 STA DEVSC SAVE IT IN DEVSC * * NOW FIX TABLES (EQT,INT,DRT) FOR WHERE CONSOLE * ACTUALLY IS AND WHAT DRIVER IT NEEDS * * RR JSB FIXC FIX CONSOLE LDA DEVSC ANY DEVICE S.C. ENTERED? SZA JSB FDEV YES JSB $LIBX TURN INT SYS BACK ON DEF *+1 DEF *+1 * NOW * * RUN DIAGNOSTIC * * JSB SON SCHEDULE DIAG. FATHER-SON * JSB EXEC TERMINATE PROGRAM DEF *+3 DEF D6 DEF ZERO NOP D6 DEC 6 ZERO NOP * PROGRAM CONSTANTS * CONSL NOP CONSOLE S.C. FLAG NOP NON-ZERO IF CONSOLE S.C. <10 OR >77 EQT OCT 1650 BASE PAGE POINTER TO EQT TABLE DRT OCT 1652 BASE PAGE POINTER TO DRT TABLE INT OCT 1654 BASE PAGE POINTER TO INTERUPT TABLE B22 OCT 22 MSK1 OCT 177700 B77 OCT 77 MSK2 OCT 7700 DEVSC NOP DIAGNOSTIC TARGET DEVICE S.C. * * * NOP SKP SON NOP * * PROGRAM "SON" SCHEDULES THE DIAGNOSTIC OR VERIFICATION * PROGRAM WITH A FATHER-SON RELATIONSHIP. * WHEN THE PROGRAM TERMINATES IT WILL RETURN HERE * JSB EXEC SCHEDULE PROGRAM DEF PRTN WHERE TO RETURN TO DEF ICODE SCHEDULE WITHOUT WAIT DEF NAME PROGRAM NAME DEF IPRM1 1ST PARAMETER TO PASS DEF IPRM2 2ND " " " * DEF IPRM3 3RD * DEF IPRM4 4TH * DEF IPRM5 5TH * * RTN JMP SON,I RETURN TO CONFG * * ICODE DEC 9 NAME ASC 3,DIAG PROGRAM TO BE SCHEDULED IPRM1 OCT 1 LOG LU IPRM2 OCT 2 TEST LU *IPRM3 *IPRM4 *IPRM5 * * SKP FDEV NOP * * * FIX EQT,INTERUPT TABLES FOR CORRECT S.C. ON EQT3,LU4 * * NOP LDB EQT,I GET ADDRESS OF EQT1 WD1 ADB D33 OFFSET FOR EQT3 WD4 LDA B,I GET THE CONTENTS AND MSK1 MASK OFF THE S.C. ADA DEVSC ADD NEW S.C. STA B,I PUT IT BACK * * FIX INT TABLE * NOP LDB INT,I ADDRESS OF S.C. 6 INT. TABLE ADB B2 OFFSET FOR S.C. 10 ADB DEVSC OFFSET FOR DEVICE S.C. +10 ADB MB10 BACK OFF TO CORRECT INT ENTRY LDA EQT,I GET ADDRESS OF EQT1 WD1 ADA F5 OFFSET FOR EQT3 WD1 STA B,I PUT IT IN THERE * * NOP JMP FDEV,I F5 DEC 30 D33 DEC 33 SKP FIXC NOP * * * THIS SUBROUTINE FINDS OUT WHAT KIND OF CONSOLE * IS AT THE GIVEN SELECT CODE AND THEN ALTERS * THE EQT,DRT AND INT TABLES FOR THAT DRIVER * AND SELECT CODE * * NOP CLA OTA 1 CLEAR S.R. * * CHECK FOR CORRECT S.C. BOUNDS * LDA CONSL GET CONSOLE S.C. ADA MB10 <10 ? SSA,RSS JMP AA NO, GO AROUND * STA FLAG YES, SET FLAG <=> 0 JMP FIXC,I EXIT * AA LDA CONSL GET CONSOLE S.C. ADA MB1C >77 ? SSA JMP BB NO, GO AROUND * STA FLAG YES, SET FLAG <=> 0 JMP FIXC,I EXIT * * RECONFIGURE TEST I/O INSTRUCTIONS * FOR THE CORRECT S.C. * BB LDA CN1 ADA CONSL STA CN1 } LDA CN2 ADA CONSL STA CN2 LDA CN3 ADA CONSL STA CN3 LDA CN4 ADA CONSL STA CN4 LDA CN5 ADA CONSL STA CN5 NOP * * EXECUTE TEST I/O INSTRUCTIONS * LDA MRSET CN1 CLF 0 CN2 OTA 0 CN3 SFS 0 IS THIS A DVR00 CONSOLE ? * JMP SKP YES , MAKE NO DRT TBL CHANGE * DVR05 LDB DRT,I NO, CHANGE DRT TBL FOR LU1 = EQT2 LDA B,I AND .3700 MASK OFF EQT REFERENCE ADA D2 ADJUST TO EQT 2 STA B,I PUT IT BACK * LDA D5 SAVE CONSOLE DRIVER TYPE STA CNDVR * SKP LDA C120K CLEAN UP CONSOLE INTF. CN4 OTA 0,C CN5 STC 0,C * * NOW PLACE CORRECT CONSOLE S.C. IN EQT TABLE * NOP LDA CNDVR GET CONSOLE DRIVER TYPE SZA,RSS DVR00 CONSOLE? JMP D00 YES * LDA B22 NO, SET OFFSET TO 22B STA TEMP LDA EQT,I GET ADDRESS OF EQT1 WD1 ADA B17 OFFSET TO EQT2 WD1 STA TEMP2 SAVE IN TEMP2 FOR LATER JMP II * D00 LDA B3 SET OFFSET TO WD4 STA TEMP SAVE IT LDA EQT,I GET ADDRESS OF EQT1 WD1 STA TEMP2 SAVE IT * * * PLACE ADDRESS OF SYS. CONSOLE EQT WD1 INTO * BASE PAGE LOCATION 1675B * II LDB SCON GET ADDRESS LDA TEMP2 GET WD1 ADDRESS OF PROPER EQT STA B,I PUT IT IN * * LDB EQT,I GET ADDRESS OF EQT1 WD1 ADB TEMP OFFSET BY TEMP (22 OR 3) * TO WD4 OF CORRECT EQT LDA B,I PICK OUT WD4 AND MSK1 MASK OFF S.C. ADA CONSL ADD NEW S.C. STA B,I PUT IT BACK * * NOW CHANGE INT TABLE * NOP LDB INT,I GET ADDRESS OF S.C. 6 INT. TBL ADB B2 OFFSET FOR S.C. 10 ADB CONSL OFFSET FOR S.C. + 10 ADB MB10 BACK OFFSET TO S.C. * LDA TEMP2 WD1 ADDRESS OF CORRECT EQT +STA B,I PUT IT INTO CORRECT INT. TBL WD * JMP GO EXIT * *CONSTANTS * MB1C OCT -100 MB10 OCT -10 MRSET OCT 150077 .3700 OCT 3700 D2 OCT 2 C120K OCT 120001 CNDVR NOP CONSOLE DRIVER TYPE D5 OCT 5 SCON OCT 1675 SYS CON. BASE PG POINTER B17 OCT 17 B2 OCT 2 TEMP NOP B3 OCT 3 TEMP2 NOP * * GO JMP FIXC,I EXIT END CONFG   91711-18204 2001 S C0122 &DUMY ILLEGAL INT. PROG.             H0101 fASMB,R,L NAM DUMY,3 91711-16204 REV.2001 791127 EXT EXEC * * * THIS IS A DUMMY PROGRAM THAT DOES NOTHING EXCEPT * MAKE SURE THAT IF AN UNEXPECTED INTERUPT OCCURS * IT WILL BE HANDLED BY THIS PROGRAM INSTEAD OF * CAUSING AN UNEXPECTED INTERUPT ERROR. A POINTER * TO THIS PROGRAM IS IN EVERY INTERUPT TABLE LOCATION * FROM 10-77B EXCEPT THOSE FOR THE CONSOLE,TBG AND * TARGET DEVICE FOR THE ON-LINE DIAGNOSTIC (IF ANY). * * DUMY LIA 1 GET S.R. OTA 1 PUT IT BACK ISZ CT KEEP TRACK OF HOW OFTEN THIS * PROGRAM IS NEEDED * * TERMINATE PROGRAM * NOP JSB EXEC DEF *+3 DEF D6 DEF ZERO NOP CT NOP D6 DEC 6 ZERO NOP END DUMY :  91711-18205 2001 S C0122 &TXMM ICD DISC MEM. DIAG.             H0101 tFTN4,L C C C THIS THE OFF-LINE DIAGNOSTIC FOR THE HP-IB DISCS.(7906/20/25) C DATE 8/28/79. C 11/27/79 CHANGED PART NUMBER FROM 91711-16200 C TO 91711-16205 C C PROGRAM DIAG(3),91711-16205 REV.2001 791127 C DIMENSION IW37(17),IW38(15),IW45(19),IW44(14),IW39(19),IW91(22) DIMENSION IW92(20),IW46(15),IW65(14),IW66(14),IW93(17),IW94(19) DIMENSION IW95(19),IW47(16),IW48(24),IW59(24),IW1(17) C INTEGER STEP DIMENSION INAM(3) DIMENSION IW2(24),IW3(22),IW4(24) DIMENSION IW7(25),IW11(23),IW12(14) DIMENSION IW13(28),IW14(27),IW15(17),IW16(31),IW70(28) DIMENSION IW71(30),IW72(27),IW73(31),IW18(24),IW19(23),IW20(26) DIMENSION IW21(12),IW22(26),IW24(25),IW25(28),IW26(26) DIMENSION IW27(27),IW28(26),IW29(30),IW30(32),IW31(29) DIMENSION IW34(16),IW35(16),IW36(14) DIMENSION IW40(28),IW41(11),IW42(21),IW43(23) DIMENSION IW49(17),IW50(17),IW81(18),IW82(27) DIMENSION IW51(19),IW52(29),IW54(20),IW55(31),IW56(30) DIMENSION IW57(27),IW58(30),IW60(26),IW61(20),IW62(21),IW80(21) DIMENSION IW63(21),IW64(18),IW96(30),IW97(32),IW98(35),IW99(16) DIMENSION ISTAT(2),ID(5),IBF1(160),IBF2(150) DIMENSION IP(5),ICY(4),IHD(4),ISC(4),IBF(35) C C C C C C DATA IW1/2HDI,2HAG,2H ,2H -,2H :,2H H,2HP-,2HIB,2H D,2HIS,2HC , +2HDI,2HAG,2HNO,2HST,2HIC,2H. / C DATA IW2/2HDI,2HAG,2H ,2H- ,2H: ,2HDO,2H Y,2HOU,2H W,2HAN, +2HT ,2HTH,2HE ,2HPR,2HOG,2HRA,2HM ,2HTO,2H S,2HTO,2HP ,2HAF, +2HTE,2HR / C DATA IW3/2H ,2H ,2H ,2H ,2H ,2HTH,2HE ,2HFI,2HRS,2HT ,2H F, +2HAI,2HLU,2HRE,2H ?,2H (,2HYE,2HS ,2HOR,2H N,2HO),2H / C DATA IW4/2HDI,2HAG,2H ,2H- ,2H: ,2HIN,2HPU,2HT ,2HDR,2HIV, +2HE ,2HTY,2HPE,2H. ,2H(7,2H90,2H6,,2H79,2H20,2H O,2HR ,2H79, +2H25,2H) / C C DATA IW7/2HDI,2HAG,2H ,2H- ,2H: ,2HYO,2HU ,2HDI,2HD ,2HNO, +2HT ,2HIN,2HPU,2HT ,2HA ,2HVA,2HLI,2HD ,2HDR,2HIV,2HE ,2H T,2HYP,  +2HE.,2H / C C C DATA IW11/2HDI,2HAG,2H ,2H- ,2H: ,2HWA,2HIT,2HIN,2HG ,2HFO, +2HR ,2HTH,2HE ,2H D,2HRI,2HVE,2H T,2HO ,2HBE,2H R,2HEA, +2HDY,2H. / C DATA IW12/2HDI,2HAG,2H ,2H- ,2H: ,2HDI,2HAG,2H ,2HIS,2H R, +2HUN,2HNI,2HNG,2H. / C DATA IW13/2HDI,2HAG,2H ,2H- ,2H: ,2HPU,2HT ,2HBA,2HCK,2H T, +2HES,2HT ,2HNU,2HMB,2HER,2H S,2HWI,2HTC,2HHE,2HS ,2HAN,2HD , +2HMO,2HDE,2H S,2HWI,2HTC,2HH / C DATA IW14/2H ,2H ,2H ,2H ,2H ,2HTO,2H O,2HP , +2HMO,2HDE,2H. ,2HMA,2HKE,2H S,2HUR,2HE ,2HAL,2HL ,2HTH, +2HE ,2HSW,2HIT,2HCH,2HES,2H S,2HET,2H / C DATA IW15/2H ,2H ,2H ,2H ,2H ,2HPR,2HOP,2HER,2HLY,2H. , +2HEN,2HTE,2HR ,2H" ,2H" ,2H,C,2HR / C DATA IW16/2HDI,2HAG,2H ,2H- ,2H: ,2HPU,2HT ,2HRU,2HN/,2HST, +2HOP,2H S,2HWI,2HTC,2HH ,2HIN,2H S,2HTO,2HP ,2HPO,2HSI,2HTI, +2HON,2H. ,2HEN,2HTE,2HR ,2H" ,2H" ,2H,C,2HR / C C C DATA IW70/2HDI,2HAG,2H ,2H- ,2H: ,2HTH,2HIS,2H P,2HAR,2HT , +2HOF,2H T,2HHE,2H D,2HIA,2HGN,2HOS,2HTI,2HC ,2HRE,2HQU,2HIR, +2HES,2H O,2HPE,2HRA,2HTO,2HR / C DATA IW71/2H ,2H ,2H ,2H ,2H ,2HIN,2HTE,2HRA,2HCT,2HIO, +2HN.,2H Y,2HOU,2H C,2HAN,2H S,2HKI,2HP ,2HTH,2HIS,2H P,2HAR, +2HT ,2HOF,2H T,2HHE,2H T,2HES,2HT.,2H / C DATA IW72/2H ,2H ,2H ,2H ,2H ,2HDO,2H ,2HYO,2HU ,2HWA, +2HNT,2H T,2HO ,2HRU,2HN ,2HTH,2HIS,2H P,2HAR,2HT?,2H (,2HYE, +2HS ,2HOR,2H N,2HO),2H / C DATA IW73/2HDI,2HAG,2H ,2H- ,2H: ,2HPU,2HT ,2HRU,2HN/,2HST, +2HOP,2H S,2HWI,2HTC,2HH ,2HIN,2H R,2HUN,2H P,2HOS,2HIT,2HIO, +2HN.,2H E,2HNT,2HER,2H ",2H ",2H ,,2HCR,2H / C DATA IW18/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2HRN,2H O,2HFF,2H F, +2HOR,2HMA,2HT ,2HSW,2HIT,2HCH,2H. ,2HEN,2HTE,2HR ,2H" ,2H" , +2H,C,2HR / C DATA IW19/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2HRN,2H O,2HN ,2HFO, +2HRM,2HAT,2H S,2HWI,2HTC,2HH.,2HEN,2HTE,2HR ,2H" ,2H" ,2H,C,2HR / C DATA IW20/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2H@RN,2H O,2HN ,2HPR, +2HOT,2HEC,2HT ,2HSW,2HIT,2HCH,2H O,2HN ,2HUP,2HPE,2HR ,2HPL, +2HAT,2HTE,2HR.,2H / C DATA IW21/2H ,2H ,2H ,2H ,2H ,2HEN,2HTE,2HR ,2H" ,2H" , +2H,C,2HR / C DATA IW22/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2HRN,2H O ,2HN ,2HPR, +2HOT,2HEC,2HT ,2HSW,2HIT,2HCH,2H O,2HN ,2HLO,2HWE,2HR ,2HPL, +2HAT,2HTE,2HR.,2H / C C DATA IW24/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2HRN,2H O,2HN ,2HRE, +2HAD,2H O,2HNL,2HY ,2HSW,2HIT,2HCH,2H. ,2HEN,2HTE,2HR ,2H" ,2H" , +2H,C,2HR / C DATA IW25/2HDI,2HAG,2H ,2H- ,2H: ,2HTH,2HE ,2HFO,2HLL,2HOW, +2HIN,2HG ,2HTE,2HST,2H M,2HIG,2HHT,2H B,2HE ,2HDE,2HST,2HRU, +2HCT,2HIV,2HE ,2H!!,2H!!,2H! / C C DATA IW26/2H ,2H ,2H ,2H ,2H ,2HIT,2H W,2HIL,2HL ,2HCH,2HEC, +2HK ,2HTH,2HE ,2HSE,2HCO,2HND,2H P,2HRO,2HTE,2HCT,2H S,2HWI,2HTC, +2HH.,2H / C DATA IW27/2H ,2H ,2H ,2H ,2H ,2HDO,2H Y,2HOU,2H W,2HAN, +2HT ,2HTO,2H R,2HUN,2H T,2HHI,2HS ,2HPA,2HRT,2H ?,2H (,2HYE, +2HS ,2HOR,2H N,2HO),2H / C DATA IW28/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2HRN,2H O,2HFF,2H P, +2HRO,2HTE,2HCT,2H S,2HWI,2HTC,2HH ,2HON,2H L,2HOW,2HER,2H P, +2HLA,2HTT,2HER,2H / C DATA IW29/2HAN,2HD ,2HTU,2HRN,2H O,2HN ,2HPR,2HOT,2HEC,2HT , +2HSW,2HIT,2HCH,2H O,2HN ,2HUP,2HPE,2HR ,2HPL,2HAT,2HTE,2HR., +2H H,2HEN,2HTE,2HR ,2H" ,2H" ,2H,C,2HR / C DATA IW30/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2HRN,2H O,2HFF,2H P, +2HRO,2HTE,2HCT,2H S,2HWI,2HTC,2HH ,2HON,2H U,2HPP,2HER,2H P, +2HLA,2HTT,2HER,2H A,2HND,2H T,2HUR,2HN ,2HON,2H / C DATA IW31/2H ,2H ,2H ,2H ,2H ,2HPR,2HOT,2HEC,2HT ,2HSW, +2HIT,2HCH,2H O,2HN ,2H L,2HOW,2HER,2H P,2HLA,2HTT,2HER,2H. , +2HEN,2HTE,2HR ,2H" ,2H" ,2H,C,2HR / C C C DATA IW34/2HDI,2HAG,2H ,2H- ,2H: ,2HTE,2HST,2H S,2HTE,2HP , +2H ,2H F,2HAI,2HLE,2HD.,2H / C DATA IW35/2H ,2H ,2H ,2H ,2H ,2HCH,2HEC,2HK ,2HTH,2HE , +2HFO,2HLL,2HOW,2HIN,2HG:,2H / C  DATA IW36/2HDI,2HAG,2H ,2H- ,2H: ,2HIS,2H S,2HTI,2HLL,2H R, +2HUN,2HNI,2HNG,2H. / C DATA IW37/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HPR, +2HOC,2HES,2HSO,2HR ,2HBO,2HAR,2HD.,2H / C DATA IW38/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HSE, +2HRV,2HO ,2HBO,2HAR,2HD.,2H / C DATA IW39/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HTR,2HAC, +2HK ,2HFO,2HLL,2HOW,2HER,2H B,2HOA,2HRD,2H. / C DATA IW40/2HDI,2HAG,2H ,2H- ,2H: ,2HSE,2HEK,2H T,2HIM,2HE , +2HTO,2HO ,2HFA,2HST,2H A,2HS ,2HSE,2HT ,2HON,2H T,2HHE,2H S, +2HER,2HVO,2H B,2HOA,2HRD,2H. / C DATA IW41/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HCO,2HIL,2H. / C DATA IW42/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HCA,2HRR, +2HIA,2HGE,2H (,2HLI,2HNE,2HAR,2H M,2HOT,2HOR,2H).,2H / C DATA IW43/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HSE, +2HRV,2HO ,2HCO,2HDE,2H O,2HN ,2HSE,2HRV,2HO ,2HSU,2HRF, +2HAC,2HE.,2H / C DATA IW44/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HDA,2HTA, +2H B,2HOA,2HRD,2H. / C DATA IW45/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HDR,2HIV, +2HE ,2HCO,2HNT,2HRO,2HL ,2HBO,2HAR,2HD.,2H / C DATA IW46/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HPR,2HEA, +2HMP,2H B,2HOA,2HRD,2H. / C DATA IW47/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HFO,2HRM, +2HAT,2H S,2HWI,2HTC,2HH.,2H / C DATA IW48/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HRE,2HAD, +2H O,2HNL,2HY ,2HOR,2H P,2HRO,2HTE,2HCT,2H ,2HSW,2HIT,2HCH, +2HES,2H. / C DATA IW49/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HRU,2HN/, +2HST,2HOP,2H S,2HWI,2HTC,2HH.,2H / C DATA IW50/2HDI,2HAG,2H ,2H- ,2H: ,2HLO,2HOP,2H B,2HAC,2HK ,2HTE, +2HST,2H F,2HAI,2HLE,2HD.,2H / C DATA IW51/2HCH,2HEC,2HK ,2HI/,2HO ,2HCA,2HRD,2H, ,2HHP,2H-I, +2HB ,2HCA,2HBL,2HES,2H A,2HND,2H I,2HDC,2H. / C DATA IW52/2HDI,2HAG,2H ,2H- ,2H: ,2HSE,2HLF,2H T,2HES,2HT , +2HFA,2HIL,2HED,2H O,2HN ,2HTE,2HST,2H ,2H ,2H ,2HSU,2HB-, +2HSE,2HLF,2H T,2HES,2HT ,2H ,2H. / C C DATA IW54/2HDI,2HAG,2H ,2H- ,2H: ,2HSE,2HLF,2H T,2HES, +2HT ,2HFA,2HIL,2HED,2H O,2HN ,2HTE,2HST,2H ,2H ,2H. / C DATA IW55/2H ,2H ,2H ,2H ,2H ,2HRU,2HN ,2HTH,2HE ,2HSU,2HB-, +2HSE,2HLF,2H T,2HES,2HT ,2H(S,2HET,2H T,2HHE,2H T,2HES,2HT , +2HNU,2HMB,2HER,2H S,2HWI,2HTC,2HHE,2HS / C DATA IW56/2H ,2H ,2H ,2H ,2H ,2HTO,2H T,2HHE,2H F,2HAI,2HLE, +2HD ,2HTE,2HST,2H N,2HO.,2H A,2HND,2H M,2HOD,2HE ,2HSW,2HIT, +2HCH,2H T,2HO ,2HSE,2HRV,2HIC,2HE / C DATA IW57/2H ,2H ,2H ,2H ,2H ,2HMO,2HDE,2H).,2HEN,2HTE, +2HR ,2HTH,2HE ,2HSU,2HB-,2HTE,2HST,2H F,2HAI,2HLE,2HD ,2H(I, +2HN ,2HOC,2HTA,2HL),2H / C DATA IW58/2HDI,2HAG,2H ,2H- ,2H: ,2HDI,2HAG,2HNO,2HST,2HIC, +2HS ,2HTE,2HRM,2HIN,2HAT,2HED,2H. ,2H ,2H T,2HES,2HT ,2HFA, +2HIL,2HUR,2HES,2H D,2HET,2HEC,2HTE,2HD / C DATA IW59/2HDI,2HAG,2H ,2H- ,2H: ,2HDR,2HIV,2HE ,2HFA,2HUL,2HT , +2H(S,2HEE,2H O,2HPE,2HRA,2HTO,2HR',2HS ,2HMA,2HNU,2HAL,2HS),2H / C DATA IW60/2HDI,2HAG,2H ,2H- ,2H: ,2HDE,2HFE,2HCT,2HIV,2HE , +2HSE,2HRV,2HO ,2HHE,2HAD,2H O,2HR ,2H I,2HND,2HEX,2H T,2HRA, +2HND,2HUC,2HER,2H. / C DATA IW61/2HDI,2HAG,2H ,2H- ,2H: ,2HDR,2HIV,2HE ,2HSW,2HIT, +2HCH,2HES,2H O,2HR ,2H D,2HET,2HEC,2HTO,2HRS,2H. / C DATA IW62/2HDI,2HAG,2H ,2H- ,2H: ,2HTR,2HAC,2HK ,2H0 ,2HIN, +2HIT,2HIA,2HLI,2HZE,2H I,2HNC,2HOR,2HRE,2HCT,2HLY,2H. / C DATA IW63/2HDI,2HAG,2H ,2H- ,2H: ,2HTR,2HAC,2HK ,2H0 ,2HIN, +2HIT,2HIA,2HLI,2HZE,2H D,2HEF,2HFE,2HCT,2HIV,2HE.,2H / C DATA IW64/2HDI,2HAG,2H ,2H- ,2H: ,2HTR,2HAC,2HK ,2H0 ,2HIN, +2HIT,2HIA,2HLI,2HZE,2H S,2HPA,2HRE,2H. / C DATA IW65/2HDI,2HAG,2H ,2H- ,2H: ,2HDE,2HFF,2HEC,2HTI,2HVE, +2H H,2HEA,2HD.,2H / C DATA IW66/2HDI,2HAG,2H ,2H- ,2H: ,2HDE,2HFF,2HEC,2HTI, +2HVE,2H M,2HED,2HIA,2H. / C C DATA IW80/2H`DI,2HAG,2H ,2H- ,2H: ,2HTO,2H R,2HUN,2H I,2HT , +2HAG,2HAI,2HN,,2HEN,2HTE,2HR:,2H R,2HU,,2HDI,2HAG,2H / C DATA IW81/2HDI,2HAG,2H ,2H- ,2H: ,2HRE,2HAD,2HY ,2HDR,2HIV, +2HE.,2HEN,2HTE,2HR ,2H" ,2H" ,2H,C,2HR / C DATA IW82/2HDI,2HAG,2H ,2H- ,2H: ,2HIS,2H I,2HT ,2HTH,2HE , +2HCO,2HRR,2HEC,2HT ,2HDR,2HIV,2HE ,2HTY,2HPE,2H ?,2H (,2HYE, +2HS ,2HOR,2H N,2HO),2H / C C C DATA IW90/2H / DATA IW91/2HDI,2HAG,2H ,2H- ,2H: ,2HCH,2HEC,2HK ,2HCA,2HBL, +2HES,2H O,2HR ,2HSE,2HLF,2H T,2HES,2HT ,2HPA,2HNE,2HL.,2H / C DATA IW92/2HDI,2HAG,2H ,2H- ,2H: ,2HTR,2HAC,2HK ,2HIN,2HIT, +2HIA,2HLI,2HZE,2H I,2HNC,2HOR,2HRE,2HCT,2HLY,2H. / C DATA IW93/2HDI,2HAG,2H ,2H- ,2H: ,2HTR,2HAC,2HK ,2HIN,2HIT, +2HIA,2HLI,2HZE,2H S,2HPA,2HRE,2H. / C DATA IW94/2HDI,2HAG,2H ,2H- ,2H: ,2HTR,2HAC,2HK ,2HIN,2HIT, +2HIA,2HLI,2HZE,2H D,2HEF,2HEC,2HTI,2HVE,2H. / C DATA IW95/2HDI,2HAG,2H ,2H- ,2H: ,2HTR,2HAC,2HK ,2HIN,2HIT, +2HIA,2HLI,2HZE,2H P,2HRO,2HTE,2HCT,2HED,2H. / C C DATA IW96/2HDI,2HAG,2H ,2H- ,2H: ,2HTU,2HRN,2H O,2HFF, +2H P,2HRO,2HTE,2HCT,2H/R,2HEA,2HD ,2HON,2HLY,2H S,2HWI, +2HTC,2HH.,2H E,2HNT,2HER,2H ",2H ",2H ,,2HCR,2H / C C DATA IW97/2HDI,2HAG,2H ,2H- ,2H: ,2HTH,2HE ,2HDI,2HAG,2HNO, +2HST,2HIC,2H I,2HS ,2HUS,2HIN,2HG ,2HDE,2HST,2HRU,2HCT,2HIV,2HE , +2HTE,2HST,2HS.,2H C,2HHA,2HNG,2HE ,2HTH,2HE / C DATA IW98/2H ,2H ,2H ,2H ,2H ,2HRE,2HMO,2HVA,2HBL,2HE ,2HPL, +2HAT,2HTE,2HR ,2HON,2H T,2HHE,2H 7,2H90,2H6 ,2HOR,2H T,2HHE,2H C, +2HAR,2HTR,2HID,2HGE,2H F,2HOR,2H 7,2H92,2H0/,2H25,2H. / C C DATA IW99/2HDI,2HAG,2H ,2H- ,2H: ,2H E,2HNT,2HER,2H D,2HIS, +2HC ,2HAD,2HDR,2HES,2HS.,2H / C C C C C C C C C C C C LOAD IFL1 WITH DATA SO IFL1#IFL2 C C IFL1=2HYE IFL2=7 C C C LOAD THE FAULTS COUNTER TO 0. C IKL=0 C C SET IUN=0 IUN=0 C C C CALL- EXEC(2,201B,IW1,17) CALL EXEC(2,201B,IW90,1) C C C C C PRINT MESSAGE TO REPLACE THE CARTRIDGE BEFORE STARTING THE TEST. C C CALL EXEC(2,201B,IW97,32) CALL EXEC(2,201B,IW98,35) CALL EXEC(2,201B,IW21,12) CALL EXEC(2,201B,IW90,1) C C C CALL EXEC(1,401B,IHP,1) C C C C LU ASSIGNMENT FOR THIS OFF LINE PROGRAM. C C C C ILST=1 NO LINE PRINTER. ALL MESSAGES WILL BE PRINTED ON C THE CONSOL. C C 603 ILST=1 C C THE DISC LU IS 4. C ILU=4 C C INPUT DISC ADDRESS. FIRST PRINT MESSAGE. C CALL EXEC(2,201B,IW99,16) CALL EXEC(2,201B,IW90,1) C C C INPUT THE ADDRESS. C C CALL INBA(IADR) C C IDVID=IADR C C C C ASK OPERATOR IF THE PROGRAM SHOULD STOP AFTER THE FIRST FAILURE. C C 5555 CALL EXEC(2,201B,IW2,24) CALL EXEC(2,201B,IW3,22) C C INPUT ANSWER CALL EXEC(1,401B,IFL2,1) C C INO=2HNO IYS=2HYE IF(IFL2.EQ.INO)GO TO 6666 IF(IFL2.EQ.IYS)GO TO 6666 GO TO 5555 C C C INPUT DRIVE TYPE. C 6666 CALL EXEC(2,201B,IW4,24) C C INPUT ANSWER. C CALL INDC(ITYP,ISTAT) C C C 880 IF(ITYP.EQ.7906)GO TO 102 IF(ITYP.EQ.7920)GO TO 104 IF(ITYP.EQ.7925)GO TO 105 C C C C C IF IS NOT VALID DRIVE TYPE, PRINT MESSAGE AND INPUT AGAIN. C C C 990 CALL EXEC(2,201B,IW7,25) C C GO TO 6666 C C 102 NCYL=411 NHED=4 NSCT=48 IT=0 GO TO 99 104 NCYL=823 NHED=5 NSCT=48 IT=1 GO TO 99 105 NCYL=823 NHED=9 NSCT=64 IT=3 C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C FIND OUT IF THE RUN/STOP SWITCH IS IN RUN POSITION , IF THE C FORMAT SWITCH IS ON AND IF THE PROTECT READ ONLY SWITCH IS OFF. C C 99 CONTINUE C C C READ DRIVE STATUS. C 98 IDVID=IADR CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) C C CHECK FOR TIME OUT C IF:(IER.NE.4)GO TO 9863 CALL EXEC(2,201B,IW81,18) CALL EXEC(1,401B,IHP,1) C C C CHECK IF ITYP IS THE RIGHT DRIVE TYPE. C 9863 IF(ID(4).EQ.IT)GO TO 9632 CALL EXEC(2,201B,IW82,27) CALL EXEC(1,401B,IHP,1) IYE=2HYE IF(IHP.NE.IYE)GO TO 6666 C C 9632 ISW=IAND(ID(5),2) IFT=IAND(ID(5),32) IPR=IAND(ID(5),64) IF(ISW.NE.0)GO TO 736 IF(IPR.NE.0)GO TO 797 IF(IFT.NE.0)GO TO 737 C C THE FORMAT SWITCH IS OFF. PRINT MESSAGE. C C CALL EXEC(2,201B,IW19,23) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,IHP,1) C GO TO 98 C C RUN/STOP SWITCH IS OFF. PRINT MESSAGE. C 736 CALL EXEC(2,201B,IW73,31) CALL EXEC(2,201B,IW90,1) C C CALL EXEC(1,401B,IHP,1) C C C PARRALLEL POLL. WAIT FOR THE DRIVE TO LOADR UP. C C C PRINT MESSAGE ON CONSOL C C CALL EXEC(2,201B,IW11,23) CALL EXEC(2,201B,IW90,1) C C C 979 CALL EXEC(1,ILU+2200B,ISW,1,6,0) ITEP=7-IADR ITP=2**ITEP ITT=IAND(ITP,ISW) IF(ITT.EQ.0)GO TO 979 GO TO 98 C C C PROTECT/READ ONLY SWITCH IS ON. PRINT MESSAGE. C C 797 CALL EXEC(2,201B,IW96,30) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,IHP,1) C GO TO 98 C C C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 737 CALL EXEC(2,201B,IW12,14) CALL EXEC(2,201B,IW90,1) C C C C C CALCULATE THE CYLINDERS,ICY(1),ICY(2),IHD(1),IHD(2), THAT THE C DIAGNOSTICS WILL USE IN THE DESTACTIVE TESTS. C ICY(1)=3 IHD(1)=0 ISC(1)=0 C ICY(2)=3 IHD(2)=1 ISC(2)=0 C C C C C C STEP=0 C C C CONVERT STEP INTO ASCII AND STORE IT IN IW34(11). IT WILL C DO THAT AT THE BEGINING OF EACH TEST. C C C IW34(11)=KCVT(STEP) C C C C C C LOOP BACK TEST C CALL LOPBK(ILU,IPAS,IADR,IBF) IF(IPAS.EQ.0)GO TO 1 CALL EXEC(2,200B+ILSRT,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW50,17) CALL EXEC(2,200B+ILST,IW51,19) CALL EXEC(2,200B+ILST,IW90,1) C C C IF THE TEST FAILED, INCREASE COUNTER FAULTS BY ONE AND CHECK IF THE C TESTS SHOULD CONTINUE OR STOP. THIS PROCEDURE WILL BE REPEATED C AFTER EACH TEST ALL OVER THE PROGRAM. C C IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 1 STEP=1 C IW34(11)=KCVT(STEP) C C C INITIATES SELFTEST AND CHECK THE RESULT. C CALL DID01(ILU,IADR,IPAS,IBF) IF(IPAS.EQ.0)GO TO 2 C C C CALL CNUMO(IPAS,INAM) IW54(19)=INAM(3) C C 3456 CALL EXEC(2,201B,IW54,20) CALL EXEC(2,201B,IW55,31) CALL EXEC(2,201B,IW56,30) CALL EXEC(2,201B,IW57,27) C C C C C C C READ THE SUB-SELF TEST RESULT IN. C C CALL INBA(ISS) C C IF THE INPUT IS 0 GO AND ASK IT AGAIN. C C C IF(ISS.EQ.0)GO TO 3456 C C C C SEND MESSAGE TO RETURN SWITCHES ON DRIVE SELF TEST PANNEL TO C OP MODE. C C IW52(19)=IW54(19) C CALL CNUMO(ISS,INAM) IW52(28)=INAM(3) C C CALL EXEC(2,201B,IW13,28) CALL EXEC(2,201B,IW14,27) CALL EXEC(2,201B,IW15,17) C C C C CALL EXEC(1,401B,IGF,1) C C C IF(IPAS.EQ.14B)GO TO 523 IF(IPAS.EQ.13B)GO TO 523 IF(IPAS.EQ.12B)GO TO 523 IF(IPAS.EQ.11B)GO TO 523 IF(IPAS.EQ.10B)GO TO 527 IF(IPAS.EQ.7)GO TO 528 IF(IPAS.EQ.6)GO TO 529 IF(IPAS.EQ.5)GO TO 530 IF(IPAS.EQ.4)GO TO 531 IF(IPAS.EQ.3)GO TO 532 IF(IPAS.EQ.1)GO TO 533 C C C 523 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C 527 IF(ISS.EQ.17B)GO TO 720 IF(ISS.EQ.16B)GO TO 721 IF(ISS.EQ.13B)GO TO 722 CALL EXEC(2,200B+ILST,IW52,29) CALL EXE;sC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C IF IT SUB-TEST 17 C 720 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW59,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C IF IT SUB TEST 16 C 721 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C IF IT SUB-TEST 13 C 722 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C TEST NO. 7 C 528 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW90,1) IF(ISS.EQ.17B)GO TO 725 IF(ISS.EQ.16B)GO TO 726 C C FOR SUB-TESTS 15-2 C CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW60,26) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 17 C 725 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB TEST 16 C 726 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C TEST 6 C 529 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) IF(ISSD.EQ.17B)GO TO 730 IF(ISS.EQ.16B)GO TO 731 IF(ISS.EQ.4)GO TO 732 IF(ISS.EQ.3)GO TO 733 IF(ISS.EQ.2)GO TO 734 C C IF IT SUB-TEST 1 C 738 CALL EXEC(2,200B+ILST,IW59,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C 730 CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 16 C 731 CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C SUB-TEST 4 C 732 CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 3 C 733 CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW61,20) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB TEST 2 C 734 CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C TEST 5 C 530 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) IF(ISS.EQ.17B)GO TO 740 IF(ISS.EQ.16B)GO TO 741 IF(ISS.EQ.15B)GO TO 742 IF(ISS.EQ.4)GO TO 732 IF(ISS.EQ.3)GO TO 733 IF(ISS.EQ.2)GO TO 734 GO TO 738 C C SUB-TEST 17 C 740 CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW37,17) CALLo EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 16 C 741 CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 15 C 742 CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C TEST 4 C 531 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) IF(ISS.EQ.17B)GO TO 745 IF(ISS.EQ.16B)GO TO 745 IF(ISS.EQ.4)GO TO 732 IF(ISS.EQ.3)GO TO 733 IF(ISS.EQ.2)GO TO 734 GO TO 738 C C SUB TEST 16-17 C 745 CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C TEST 3 C 532 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) IF(ISS.EQ.17B)GO TO 750 IF(ISS.EQ.16B)GO TO 751 IF(ISS.EQ.15B)GO TO 752 IF(ISS.EQ.14B)GO TO 753 IF(ISS.EQ.13B)GO TO 754 C C SUB-TEST 12-1 C CALL EXEC(2,200B+ILST,IW66,14) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW65,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C SUB-TEST 17 C 750 CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 16 C 751 CALL EXEC(2,200B+ILST,IW37,17) CALL7@ EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW62,21) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C CSUB-TEST 15 C 752 CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW63,21) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 14 C 753 CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW64,18) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 13 C 754 CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW65,14) CALL EXEC(2,200B+ILST,IW66,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C TEST 1 C 533 CALL EXEC(2,200B+ILST,IW52,29) CALL EXEC(2,200B+ILST,IW35,16) IF(ISS.EQ.17B)GO TO 760 IF(ISS.EQ.16B)GO TO 761 IF(ISS.EQ.4)GO TO 732 IF(ISS.EQ.3)GO TO 733 IF(ISS.EQ.2)GO TO 734 GO TO 738 C C SUB-TEST 17 C 760 CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C SUB-TEST 16 C 761 CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) GO TO 777 C C C C C C 777 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 2 STEP=2 C IW34(11)=KCVT(STEP) C C C GETS DSJ VALUE. DSJ SHOULD EQUAL 2 INDICATING A POWER ON CONDITION. C THIS CONDITION CAUSED BY A SELFTEST COMMAND. C CALL XDSJ(ILU,IDVID,IDSJ,IER) IF(IDSJ.EQ.2)GO TO 3 CALL E nXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) C CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 3 STEP=3 C IW34(11)=KCVT(STEP) C C C REQUEST STATUS AND CHECK FOR NORMAL COMPLETE STATUS. C CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) IF(ID(2).EQ.0)GO TO 4 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1000 C C CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) 1000 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 4 STEP=4 C IW34(11)=KCVT(STEP) C C C PERFORM A SEEK AND CHECK FOR DRIVE ATTENTION STATUS. C CALL XSEEK(ILU,IDVID,ICY(1),IHD(1),ISC(1),ISTAT) CALL DECST(ISTAT,ID) IF(ID(2).EQ.37B)GO TO 5 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1010 C CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1010 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 5 STEP=5 C IW34(11)=KCVT(STEP) C C C REQUEST DISC ADDRESS AND CHECK FOR PROPER CYLINDER,HEAD AND SECTOR C VALUES. C CALL DID05(ILU,IDVID,IPAS,ICY(1),IHD(1),ISC(1),ISTAT) IF(IPAS.EQ.0)GO TO 6 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.1)GO TO 1020 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1030 C 1020 nCALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1030 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 6 STEP=6 C IW34(11)=KCVT(STEP) C C C ISSUE A RECALIBRATE COMMAND AND CHECK FOR DRIVE ATTENTION STATUS. C CALL XRCAL(ILU,IDVID,IER) CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) IF(ID(2).EQ.37B)GO TO 7 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1040 C CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW40,28) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW41,11) CALL EXEC(2,200B+ILST,IW42,21) CALL EXEC(2,200B+ILST,IW43,23) CALL EXEC(2,200B+ILST,IW90,1) 1040 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 7 STEP=7 C IW34(11)=KCVT(STEP) C C C ISSUE A REQUEST SECTOR COMMAND AFTER A SEEK COMMAND. CHECK DSJ C FOR DSJ=0 INDICATING NO ERROR. C CALL DID07(ILU,IDVID,IPAS,IADR,ICY(2),IHD(2),ISC(2),ISTAT) IF(IPAS.EQ.0)GO TO 8 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1050 C CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 1050 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 8 STEP=8 C IW34(11)=KCVT(STEP) C C C ISSUE A CLEAR COMMAND,WAIT UNTILL PPOLL INDICATING COMPLETION C OF COMMAND AND CHECK FOR DSJ=2. C CALL DID08(ILU,IADR,IPAS,IUN,IBF) IF(IPAS.EQ.0)GO TO 9 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C C C C CALL STATUS TO CLAEN DSJ C C 9 CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) C C STEP=9 C IW34(11)=KCVT(STEP) C C C DO A SEEK AND CHECK FOR ERROR.DO READ FULL SECTOR AND CHECK FOR ERROR C INDUCING AN ERROR INTO THE BUFFER AS PREPARATION FOR TEST 10. C CALL DID09(ILU,IDVID,IPAS,IBF1,ICY(1),IHD(1),ISC(1),ISTAT) IF(IPAS.EQ.0)GO TO 10 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1060 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1070 C 1060 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1070 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 10 STEP=10 C IW34(11)=KCVT(STEP) C C C WRITE THE SECTOR THAT WAS READ IN STEP 9 (WITH THE INDUCED ERROR) C TO THE SAME LOCATION FROM WHICH IT WAS READ USING THE WRITE C FULL SECTOR COMMAND. C CALL DID10(ILU,IDVID,IPAS,IBF1,ICY(1),IHD(1),ISC(1),ISTAT) IF(IPAS.EQ.0)GO TO 11 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1080 C CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) f CALL EXEC(2,200B+ILST,IW90,1) 1080 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 11 STEP=11 C C IW34(11)=KCVT(STEP) C C SEEK TO THE SECTOR WRITTEN IN STEP 10. ISSUE THE VERIFY C SECTOR COMMAND FOR ONE SECTOR.CHECK FOR DATA ERROR STATUS. C CALL DID11(ILU,IDVID,IPAS,ICY(1),IHD(1),ISC(1),ISTAT) IF(IPAS.EQ.0)GO TO 12 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1090 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1100 C 1090 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1100 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 12 STEP=12 C IW34(11)=KCVT(STEP) C C C SEEK TO THE SECTOR WAS WRITTEN INSTEP 10. ISSUE READ COMMAND C TO READ THAT SECTOR. CHECK FOR DATA ERROR STATUS AND CHCEK C THE DATA READ AGAINST THE WRITTEN DATA. C C C READ WITHOUT OFFSET C IPAS=2 CALL DID12(ILU,IDVID,IPAS,ICY(1),IHD(1),ISC(1),IBF1,IBF2,ISTAT) IF(IPAS.EQ.0)GO TO 13 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.1)GO TO 1110 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1120 C 1110 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1120 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 13 STEP=13 C IW34(11)=KCVT(STEP) C C C REPEAT STEP 12 FOR THE READ WITH OFFSET COMMAND. C C C READ WITH OFFSET C IPAS=3 CALL DID12(ILU,IDVID,IPAS,ICY(1),IHD(1),ISC(1),IBF1,IBF2,ISTAT) IF(IPAS.EQ.0)GO TO 14 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.1)GO TO 1130 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1140 C 1130 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 1140 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 14 STEP=14 C IW34(11)=KCVT(STEP) C C C REPEAT STEP 12 FOR READ WITHOUT VERIFY COMMAND. C C IPAS=4 CALL DID12(ILU,IDVID,IPAS,ICY(1),IHD(1),ISC(1),IBF1,IBF2,ISTAT) IF(IPAS.EQ.0)GO TO 15 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.1)GO TO 1150 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1160 C 1150 CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1160 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 15 STEP=15 C IW34(11)=KCVT(STEP) C C C RESTOR THE ALTERED SECTOR TO ITS ORIGINAL STATE BY WRITING C THE ORIGINAL CONTENTS BACK INTO THE SECTOR USING THE WRITE C FULL SECTOR COMMAND. C C C CORRECT THE DATA INDUCED INTO IBF1. C IBF1(40)=IBF1(40)-5 C C CALL DID10(ILU,IDVID,IPAS,IBF1,ICY(1),IHD(1),ISC(1),ISTAT) IF(IPAS.EQ.0) GO TO 16 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B~+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1170 C CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1170 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 16 STEP=16 C IW34(11)=KCVT(STEP) C C C SET THE FM TO SURFACE MODE. NO AUTO SEEKS, AND SEE IF END-OF CYLINDER C IS DETECTED. C C C LEN=140 IMSK=0 IC=ICY(1) IH=IHD(1) IS=NSCT-1 CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(IPAS.NE.0)GO TO 161 IF(ID(2).EQ.14B)GO TO 17 161 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 1190 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1180 C 1190 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 1180 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 17 STEP=17 C IW34(11)=KCVT(STEP) C C C PUT FM INTO CYL MODE NO AUTO SEEKS , AND SEE IF IT BEHAVES PROPERLY. C C CALL EXEC(2,201B,IW36,14) CALL EXEC(2,201B,IW90,1) IMSK=2 LEN=128 CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(IPAS.NE.0)GO TO 171 IF(IER.EQ.0)GO TO 18 171 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 1210 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1200 C 1210 CALL EXEC(2,200B+ILST,IW37,17) CALL E/XEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1200 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 18 STEP=18 C IW34(11)=KCVT(STEP) C C C NOW READ TWO SECTORS AND CHECK FOR EOC. C C C IH=NHED-1 LEN=140 CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(IPAS.NE.0)GO TO 181 IF(ID(2).EQ.14B)GO TO 19 181 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 1220 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1230 C 1220 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 1230 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 19 STEP=19 C IW34(11)=KCVT(STEP) C C C SET FM TO CYL MODE AUTO INCREMENTAL SEEK AND SEE IF THE SEEK WORKS. C C C IMSK=3 LEN=140 IC=ICY(2) CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(IPAS.NE.0)GO TO 191 IF(ID(2).NE.0)GO TO 191 CALL XLGAD(ILU,IDVID,IC5,IH5,IS5,IER) IF(IER.NE.0)GO TO 191 IF(IC5.EQ.(IC+1))GO TO 20 191 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 1240 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1250 C 1240 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 1250 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 20 STEP=20 C IW34(11)=KCVT(STEP) C C C NOW CHECK FOR CYL MODE AUTO DECREMENTAL SEEK. C C C IMSK=11B IH=0 IC=10 LEN=140 CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(IPAS.NE.0)GO TO 201 IF(IER.NE.0)GO TO 201 CALL XLGAD(ILU,IDVID,IC5,IH5,IS5,IER) IF(IER.NE.0)GO TO 201 IF(IC5.EQ.(IC-1))GO TO 21 201 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 1260 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1270 C 1260 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 1270 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C C 21 STEP=21 C C IW34(11)=KCVT(STEP) C C C INITIALIZE ICY(1) DEFECTIVE WITH ICY(2) AS A SPARE. ALSO MAKE SURE THE C TRACK WAS PROPERLY INITIALIZE. C C C IC1=ICY(1) IH1=IHD(1) IS1=ISC(1) IC2=ICY(2) IH2=IHD(2) IS2=ISC(2) ISPD=1 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.EQ.0)GO TO 22 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1280 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1290 C 1280 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1290 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 22 STEP=22 C IW34(11)=KCVT(STEP) C C C INITIALIZE ICY(2) SPARE FOR ICY(1). C C C 222 IC1=ICY(2) IH1=IHD(2) IS1=ISC(2) IC2=ICY(1) IH2=IHD(1) IS2=ISC(1) ISPD=4  CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) C C IF(STEP.EQ.30)GO TO 301 C C IF(IPAS.EQ.0)GO TO 29 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1300 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1310 C 1300 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1310 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 29 STEP=23 C IW34(11)=KCVT(STEP) C C C CHECK FOR DEFECTIVE STATUS WITHOUT PROTECTED BIT SET. C C C IPAS=2 IC1=ICY(1) IH1=IHD(1) IS1=ISC(1) CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.NE.0)GO TO 291 IF(ID(2).EQ.21B)GO TO 26 291 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.NE.1)GO TO 1320 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1330 C 1320 CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 1330 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 26 STEP=24 C IW34(11)=KCVT(STEP) C C C CHECK FOR ILLEGAL ACCESS TO SPARE TRACK WITHOUT PROTECT BIT SET. C C CALL EXEC(2,201B,IW36,14) CALL EXEC(2,201B,IW90,1) IPAS=2 IC1=ICY(2) IH1=IHD(2) IS1=ISC(2) CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.NE.0)GO TO 261 IF(ID(2).EQ.20B)GO TO 23 261 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.NE.1)GO TO 1340 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1350 C 1340 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1350 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 23 STEP=25 C IW34(11)=KCVT(STEP) C C C INITIALIZE ICY(2) AS PROTECTED. C C C IC1=ICY(2) IH1=IHD(2) IS1=ISC(2) IC2=ICY(2) IH2=IHD(2) IS2=ISC(2) ISPD=2 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.EQ.0)GO TO 24 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1360 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1370 C 1360 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1370 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 24 STEP=26 C IW34(11)=KCVT(STEP) C C C INITIALIZE ICY(2) AS SPARE-PROTECTED WITH ADDRESS=ICY(1) C C C IC1=ICY(2) IH1=IHD(2) IS1=ISC(2) IC2=ICY(1) IH2=IHD(1) IS2=ISC(1) ISPD=6 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTmAT) IF(IPAS.EQ.0)GO TO 25 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1380 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1390 C 1380 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1390 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 25 STEP=27 C IW34(11)=KCVT(STEP) C C C CHECK ON STATUS FOR ILLEGAL ACCESS TO SPARE TRACK. C C C IC1=ICY(2) IH1=IHD(2) IS1=ISC(2) IPAS=2 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.NE.0)GO TO 251 IF(ID(2).EQ.20B)GO TO 27 251 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.NE.1)GO TO 1400 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1410 C 1400 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1410 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 27 STEP=28 C IW34(11)=KCVT(STEP) C C C INITIALIZE ICY(2) AS PROTECTED-DEFECTIVE. C C CALL EXEC(2,201B,IW36,14) CALL EXEC(2,201B,IW90,1) IC1=ICY(2) IH1=IHD(2) IS1=ISC(2) IC2=ICY(2) IH2=IHD(2) IS2=ISC(2) ISPD=3 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.EQ.0)GO TO 28 CA}OLL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1420 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1430 C 1420 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1430 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 28 STEP=29 C IW34(11)=KCVT(STEP) C C C CHECK FOR DEFECTIVE TRACK STATUS WITH PROTECT BIT SET. C C C IF(ID(2).EQ.21B)GO TO 30 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 30 STEP=30 C IW34(11)=KCVT(STEP) C C C SET FM TO CYL MODE AUTO SEEK TO SPARE TRACK AND CHECK THAT AUTO C SEEK WORK. C C C GO TO 222 301 IF(IPAS.NE.0)GO TO 302 IMSK=6 LEN=128 IC1=ICY(1) IH1=IHD(1) IS1=ISC(1) CALL FLMSK(ILU,IDVID,IPAS,IC1,IH1,IS1,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(IPAS.NE.0)GO TO 302 IF(IER.NE.0)GO TO 302 IF(IBF1(50).EQ.4)GO TO 31 302 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 1440 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1450 C 1440 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19)  CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW90,1) 1450 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 31 STEP=31 C IW34(11)=KCVT(STEP) C C SET FM TO CYL MODE NO AUTO SEEKS. THEN REINITIALIZE ICY(1) C SET THE SPD BITS TO 0. C C C IMSK=2 IPAS=2 CALL FLMSK(ILU,IDVID,IPAS,IC1,IH1,IS1,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(IPAS.NE.0)GO TO 311 C C IKJ=1 C C IC1=ICY(1) IH1=IHD(1) IS1=ISC(1) IC2=ICY(1) IH2=IHD(1) IS2=ISC(1) ISPD=0 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.EQ.0)GO TO 32 311 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IKJ.NE.1)GO TO 1460 IF(IPAS.EQ.2)GO TO 1480 1460 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1470 C 1480 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 1470 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 32 STEP=32 C IW34(11)=KCVT(STEP) C C REINITIALIZE ICY(2) C C CALL EXEC(2,201B,IW36,14) CALL EXEC(2,201B,IW90,1) ISPD=0 IC1=ICY(2) IH1=IHD(2) IS1=ISC(2) IC2=ICY(2) IH2=IHD(2) IS2=ISC(2) CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID,IBF1, CNSCT,ISTAT) IF(IPAS.EQ.0)GO TO 35 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 1490 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 1500 C 1F490 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 1500 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C C 35 STEP=35 C IW34(11)=KCVT(STEP) C C C C SET FM TO CYLINDER MODE NO AUTO SEEKS.WRITE A SECTOR OF INCREMENTAL C DATA C C C IC=ICY(1) IH=IHD(1) IS=0 CALL DID35(ILU,IDVID,IPAS,IC,IH,IS,ISTAT,IBF2) IF(IPAS.EQ.0)GO TO 36 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2000 C CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 2000 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 36 STEP=36 C IW34(11)=KCVT(STEP) C C C C SEEK TO THE LOCATION WRITTEN IN STEP 35.READ A SECTOR AND CHECK C FOR THE PROPER DATA. C C CALL DID36(ILU,IDVID,IPAS,IC,IH,IS,ISTAT,IBF2) IF(IPAS.EQ.0)GO TO 40 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 2010 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2020 C 2010 CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) 2020 IKL=IKL+1 IF(IFL1.EQ.IFL2) GO TO 998 C C 40 STEP=40 C IW34(11)=KCVT(STEP) C C THIS TEST COMBINE TEST 40 AND 41 OF THE ORIGINAL DIAGNOSTICS C C C SEEK TO THE CHOSEN CYL,HEAD=0,SECTOR=0.CHECK FOR ERROR AFTER C EACH SEEK. AFTER THE SEEK ISSUE A REQUEST DISC ADDRESS COMMAND, C CHECK TO SEE THAT THE PROPER CYL VALUE IS RETURNED. C C STEP 40 IS REPEATED FOR INCREASING POWER OF 2 CYLINDERS (I.E C SEEK TO CYL 0,1,2,4,8, ETC.) UNTILL THE POWER OF 2 IS GREATER C THAN THE MAXIMUM CYL. C C C CALL DID40(ILU,IDVID,IPAS,NCYL,ISTAT) IF(IPAS.EQ.0)GO TO 45 IF(IPAS.EQ.1)GO TO 402 GO TO 403 C 402 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2030 C 403 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 2030 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 45 STEP=45 C IW34(11)=KCVT(STEP) C C C SEEK TO ICY(1),IHD(1),AND SECTOR 0. VERIFY INCREASING POWER C OF 2 SECTORS UNTILL ALL SECTORS HAVE BEEN VERIFIED.THIS C STEP SKIPPED IF IT IS A DEFECTIVE TRACK. C C CALL DID45(ILU,IDVID,IPAS,ICY(1),IHD(1),ISC(1),NSCT,ISTAT,IBF2) IF(IPAS.EQ.0)GO TO 50 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2040 C CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 2040 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 50 STEP=50 C a IW34(11)=KCVT(STEP) C C C C SEND AN ILLEGALL OPCODE AND CHECK FOR ILLEGAL OPCODE C STATUS C C CALL DID50(ILU,IDVID,IPAS,IADR,IBF) IF(IPAS.EQ.0)GO TO 52 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 52 STEP=52 C IW34(11)=KCVT(STEP) C C C C READ FULL SECTOR AT IC1,IH1,IS1=0.WRITE FULL SECTOR C AT IC2,IH1,IS1=0.SEEK TO SAME LOCATION BUT SECTOR 1 C AND READ A SECTOR. CHCEK FOR CYLINDER MISCOMPARE C STATUS.CORRECT BEFORE PROCEEDING. C C IPAS=7B IC1=ICY(2)+2 IH1=IHD(2) IS1=0 IC2=ICY(2) CALL FMSCP(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH1,IS1,NSCT,ISTAT, +IBF1) IF(IPAS.EQ.0)GO TO 53 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 2050 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2060 C 2050 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 2060 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 53 STEP=53 C IW34(11)=KCVT(STEP) C C C C READ FULL SECTOR ,CHANGE ONE WORD AND WRITE THE ALTERED DATA C BACK INTO THE SAME LOCATION.READ FROM THE ALTERED SECTOR C AND CHCEK FOR DATA ERROR.WRITE INTO THE ALTERED SECTOR C TO CLEAR THE ERROR. C C IPAS=10B IC2=ICY(2) IH1=IHD(2) IS1=0 CALL FMSCP(ILU,IDVID,IPAS,IC2,IH1,IS1,IC2,IH1,IS1,NSCT,ISTAT, +IBF1) IF(IPAS.EQ.0)GO TO 54 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 2070 IKCALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2080 C 2070 CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW90,1) 2080 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 54 STEP=54 C C IW34(11)=KCVT(STEP) C CALL EXEC(2,201B,IW36,14) CALL EXEC(2,201B,IW90,1) C C C REPEAT STEP 52 FOR AN ALTERED HEAD AND CHECK FOR HEAD/SECTOR C MISCOMPARE STATUS. C C IPAS=11B IC2=ICY(2) IH2=IHD(2) IS2=0 IH1=1 IF(IH1.EQ.IH2)IH1=0 CALL FMSCP(ILU,IDVID,IPAS,IC2,IH1,IS2,IC2,IH2,IS2,NSCT,ISTAT, +IBF1) IF(IPAS.EQ.0)GO TO 55 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 2090 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2100 C 2090 CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 2100 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 55 STEP=55 C IW34(11)=KCVT(STEP) C C C C REPEAT STEP 54 FOR AN ALTERED SECTOR. C C IPAS=11B IC1=ICY(2) IH1=IHD(2) IS1=2 IS2=15 CALL FMSCP(ILU,IDVID,IPAS,IC1,IH1,IS1,IC1,IH1,IS2,NSCT,ISTAT, +IBF1) IF(IPAS.EQ.0)GO TO 56 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 2110 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2120 C 2110 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW90,1) 2120 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 56 STEP=56 C IW34(11)=KCVT(STEP) C C C C SEND A LISTEN COMMAND WITH AN ILLEGAL SECONDARY. CHECK FOR C I/O PROGRAM ERROR STATUS. C C CALL DID56(ILU,IDVID,IPAS,IADR,IBF) IF(IPAS.EQ.0)GO TO 57 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 57 STEP=57 C IW34(11)=KCVT(STEP) C C C C SEND A GET COMMAND WITH AN ILLEGAL SECONDARY. CHECK FOR I/O C PROGRAM ERROR STATUS. C C CALL DID57(ILU,IDVID,IPAS,IADR,IBF) IF(IPAS.EQ.0)GO TO 58 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 58 STEP=58 C IW34(11)=KCVT(STEP) C C C C SET FM TO CYL MODE NO AUTO SEEKS.SEEK TO ICY(2),MAXIMUM C HEAD AND SECTOR. ISSUE A READ FULL SECTOR COMMAND TO C READ TWO SECTOTS. CHECK FOR END OF CYLINDER STATUS. C C IPAS=4 IMSK=2 IC=ICY(2) IH=NHED-1 IS=NSCT-1 LEN=140 CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(ID(2).EQ.14B)GO TO 59 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2130 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2140 C 2130 CALL EXEC(2,200B+ILST,IW37,1H7) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 2140 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 59 STEP=59 C IW34(11)=KCVT(STEP) C C C C SET FM TO CYLINDER MODE AUTO INCREMENTAL SEEK, AND NO AUTO C SEEK TO SPARE TRACK.SEEK TO MAXIMUM CYLINDER ,HEAD AND C SECTOR. READ FULL SECTOR FOR TWO SECTORS AND CHECK FOR C EOC STATUS. C C IPAS=4 LEN=140 IC=NCYL-1 IH=NHED-1 IS=NSCT-1 IMSK=2 CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(ID(2).EQ.14B)GO TO 60 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2150 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2160 C 2150 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 2160 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 60 STEP=60 C IW34(11)=KCVT(STEP) C C C C SET FM TO TO CYLINDER MODE, AUTO DECREMENTAL SEEK,AND NO C AUTO SEEK TO SPARE TRACK.SEEK TO CYLINDER 0,MAXIMUM HEAD C AND SECTOR. READ FULL SECTOR FOR TWO SECTORS AND CHECK FOR EOC C STATUS. C C IMSK=11B IC=0 IPAS=4 IH=NHED-1 IS=NSCT-1 LEN=140 CALL FLMSK(ILU,IDVID,IPAS,IC,IH,IS,IBF1,ID,IMSK,LEN,IER,IADR +,ISTAT) IF(ID(2).EQ.14B)GO TO 72 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2170 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW465,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2180 C 2170 CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) 2180 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 72 STEP=72 C IW34(11)=KCVT(STEP) C C C SEEK TO ICY(2),MAXIMUM HEAD+1 AND SECTOR 0. CHECK FOR SEEK C CHECK BIT(BIT 3) SET IN STATUS WORD 2. C C IC=ICY(2) IH=NHED IS=0 CALL SKER(ILU,IDVID,IPAS,IC,IH,IS) IF(IPAS.EQ.0)GO TO 73 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 73 STEP=73 C IW34(11)=KCVT(STEP) C C C C REPEAT STEP 72 FOR ADDRESS MAXIMUM CYLINDER+1,HEAD=1,AND SECTOR 0. C C IC=NCYL IH=1 IS=0 CALL SKER(ILU,IDVID,IPAS,IC,IH,IS) IF(IPAS.EQ.0)GO TO 74 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 74 STEP=74 C IW34(11)=KCVT(STEP) C C C C REPEAT STEP 72 FOR ADDRESS ICY(1),HEAD=1,AND MAXIMUM SECTOR+2 C C IC=ICY(1) IH=1 IS=NSCT+1 CALL SKER(ILU,IDVID,IPAS,IC,IH,IS) IF(IPAS.EQ.0)GO TO 79 CALL EXEC(2,200B+ILST,IW34,16) CAoLL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 79 CALL EXEC(2,201B,IW70,28) CALL EXEC(2,201B,IW71,30) CALL EXEC(2,201B,IW72,27) C CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,IRN,1) C IA=2HYE INO=2HNO IF(IRN.EQ.INO)GO TO 998 IF(IRN.EQ.IA)GO TO 80 GO TO 79 C C 80 STEP=80 C IW34(11)=KCVT(STEP) C C C PUT RUN STOP SWITCH IN STOP POSITION AND CHECK STATUS BITS. C C CALL EXEC(2,201B,IW16,31) C CALL EXEC(2,201B,IW90,1) CALL EXEC(1,401B,IPA,1) C C CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) IF(ID(2).NE.37B)GO TO 8803 ITP=IAND(ID(5),3) IF(ITP.NE.3)GO TO 8803 IF(ID(3).EQ.1)GO TO 81 8803 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW49,17) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 81 STEP=81 C IW34(11)=KCVT(STEP) C C C PUT RUN/STOP SWITCH IN RUN POSITION. CHECK FOR NORMAL STATUS AND C FIRST STATUS BIT. C CALL EXEC(2,201B,IW73,31) C CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,IHP,1) C C PARRALLEL POLL. WAIT FOR THE DRIVE TO LOAD UP. C C C PRINT MESSAGE ON THE CONSOL. C C C C CALL EXEC(2,201B,IW11,23) C CALL EXEC(2,201B,IW90,1) C C C C 735 CALL EXEC(1,ILU+2200B,IPP,1,6,0) ITEP=7-IADR ITP=2**ITEP ITT=IAND(ITP,IPP) IF(ITT.EQ.0)GO TO 735 C C CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) IF(ID(2).NE.0)GO TO 812 ITP=IAND(ID(5),8) IF(ITP.NE.0)GO TO 82 812 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 82 STEP=82 C IW34(11)=KCVT(STEP) C C C INITIALIZE ICY(2) PROTECTED TO CHECK ON FORMAT SWITCH C ISPD=2 IC1=ICY(2) IH1=IHD(2) IS1=0 IC2=ICY(2) IH2=IHD(2) IS2=0 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID, +IBF1,NSCT,ISTAT) IF(IPAS.EQ.0)GO TO 83 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 2190 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2200 C 2190 CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 2200 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 83 STEP=83 C IW34(11)=KCVT(STEP) C C C TURN OF FORMAT SWITCH AND CHECK STATUS BIT. C CALL EXEC(2,201B,IW18,24) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) CALL DECST(ISTAT,ID) ITP=IAND(ID(5),32) IF(ITP.EQ.0)GO TO 84 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 84 STEP=84 C IW34(11)=KCVT(STEP) C C C CHECK FOR ATTEMPT TO WRITE ON PROTECTED TRACK STATUS. C CALL XSEEK(ILU,IDVID,ICY(2),IHD(2),0,ISTAT(1),ISTAT(2),IER) IF(IER.EQ.0)GO TO 2210 C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 842 GO TO 2220 C 2210 CALL XDWRT(ILU,IDVID,IBF2,128,ISTAT(1),ISTAT(2),IER) CALL DECST(ISTAT,ID) IF(ID(2).EQ.26B)GO TO 85 842 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW90,1) 2220 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 85 STEP=85 C IW34(11)=KCVT(STEP) C C C CHECK FOR STATUS-2 ERROR ON WRITE FULL SECTOR C CALL XSEEK(ILU,IDVID,ICY(2),IHD(2),0,ISTAT(1),ISTAT(2),IER) IF(IER.EQ.0)GO TO 2230 C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 851 GO TO 2240 C 2230 CALL XWRFS(ILU,IDVID,IBF1,138,ISTAT(1),ISTAT(2),IER) CALL DECST(ISTAT,ID) IF(ID(2).EQ.23B)GO TO 86 851 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 2240 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 86 STEP=86 C IW34(11)=KCVT(STEP) C C C CHECK FOR STATUS-2 ERROR ON INITIALIjZE COMMAND. C CALL XSEEK(ILU,IDVID,ICY(2),IHD(2),0,ISTAT(1),ISTAT(2),IER) IF(IER.EQ.0)GO TO 2250 C C CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 861 GO TO 2260 C C 2250 CALL XINIT(ILU,IDVID,IBF1,128,0,ISTAT(1),ISTAT(2),IER) CALL DECST(ISTAT,ID) IF(ID(2).EQ.23B)GO TO 87 861 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 2260 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 87 STEP=87 C IW34(11)=KCVT(STEP) C C C TURN ON FORMAT SWITCH AND CHECK STATUS BIT. C CALL EXEC(2,201B,IW19,23) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C CALL DSTAT(ILU,IDVID,ISTAT,ID,IER) ITP=IAND(ID(5),32) IF(ITP.NE.0)GO TO 88 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) CALL EXEC(2,200B+ILST,IW47,16) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW90,1) IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 88 STEP=88 C IW34(11)=KCVT(STEP) C C C REINITIALIZE ICY(2) TO SPD=0 C ISPD=0 IC1=ICY(2) IH1=IHD(2) IS1=0 IC2=ICY(2) IH2=IHD(2) IS2=0 CALL INIT(ILU,IDVID,IPAS,IC1,IH1,IS1,IC2,IH2,IS2,ISPD,ID +,IBF1,NSCT,ISTAT) IF(IPAS.EQ.0)GO TO 89 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.2)GO TO 2270 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2280 C 2270 CALL EXEC(2,200B+ILST,IW47,16) CALLD EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 2280 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C TESTS 89 TO 92 ARE TESTING THE READ ONLY SWITCH. IF IT 7905 OR C 7906 IT WILL MAKE THE TEST ONLY TO THE PLATTER THAT THE ASSIGN LU C USED.IN TEST 93,94 AND 95 IT WILL REPEAT THIS TESTS TO THE OTHER C PLATTER. C C C 89 STEP=89 C IW34(11)=KCVT(STEP) C C C TURN ON READ ONLY SWITCH. DO A SEEK AND CHECK THAT READ ONLY C BIT (BIT 7) IN STATUS WORD 2 IS SET. C C C CHECK IF IS 7905/06 DISC. C IF(NCYL.NE.411)GO TO 891 C C CHECK TO FIND OUT WHICH PLATTER THE ASSIGN LU IS ON. C IF(IHD(1).GT.1)GO TO 892 C C C C IF IS THE UPPER PLATTER ASIGN ITP1=1 C ITP1=1 C CALL EXEC(2,201B,IW20,26) CALL EXEC(2,201B,IW21,12) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C GO TO 895 C C C IF IT IS LOWER PLATTER ASSIGN ITP1=2 C 892 ITP1=2 C CALL EXEC(2,201B,IW22,26) CALL EXEC(2,201B,IW21,12) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C GO TO 895 C C C IF IT IS 7920/25 ASSIGN ITP1=3 C 891 ITP1=3 C CALL EXEC(2,201B,IW24,25) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C C C 895 IC=ICY(1) IH=IHD(1) IS=0 IPAS=0 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) ITEMP=IAND(ID(5),64) IF(IPAS.NE.0)GO TO 899 IF(ITEMP.NE.0)GO TO 90 899 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2290 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2300 C 2290 CALL EXEC(2,200B+ILST,IW48,24)  CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW90,1) 2300 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 90 STEP=90 C IW34(11)=KCVT(STEP) C C C C DO SEEK AND ISSUE WRITE COMMAND AND CHECK FOR STATUS WORD-2 C ERROR STATUS. C C IC=ICY(1) IH=IHD(1) IS=0 IPAS=2 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.NE.0)GO TO 901 IF(ID(2).EQ.23B)GO TO 91 901 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2310 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2320 C 2310 CALL EXEC(2,200B+ILST,IW48,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW90,1) 2320 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 91 STEP=91 C IW34(11)=KCVT(STEP) C C C C REPEAT STEP=90 FOR THE WRITE FULL SECTOR. C C IPAS=3 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.EQ.1)GO TO 911 IF(ID(2).EQ.23B)GO TO 92 911 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2330 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2340 C 2330 CALL EXEC(2,200B+ILST,IW48,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,1k4) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW90,1) 2340 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 92 STEP=92 C IW34(11)=KCVT(STEP) C C C C REPEAT STEP 90 FOR THE INTIALIZE COMMAND. C C IPAS=4 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.NE.0)GO TO 921 IF(ID(2).EQ.23B)GO TO 93 921 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2350 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2360 C 2350 CALL EXEC(2,200B+ILST,IW48,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW90,1) 2360 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C IF IT 7920/25 DRIVE GO TO 97 C 93 IF(ITP1.EQ.3)GO TO 97 C C C STEP=93 C IW34(11)=KCVT(STEP) C C C C REPEAT STEP 89 FOR THE OTHER PLATER C C 9378 CALL EXEC(2,201B,IW25,28) CALL EXEC(2,201B,IW26,26) CALL EXEC(2,201B,IW90,1) CALL EXEC(2,201B,IW27,27) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,INR,1) C C IF(INR.EQ.INO)GO TO 97 IF(INR.EQ.IA)GO TO 7897 GO TO 9378 C C 7897 IF(ITP1.EQ.1)GO TO 933 C CALL EXEC(2,201B,IW28,26) CALL EXEC(2,201B,IW29,30) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C IC=3 IH=0 IS=0 GO TO 935 C C 933 CALL EXEC(2,201B,IW30,32) CALL EXEC(2,201B,IW31,29) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C IC=3 IH=2 IS=0 C C 935 IPAS=0 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.NE.0)GO TO 937 ITEMP=IAND(ID(5),64) IF(ITEMP.NE.0)GO TO 94 937 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2370 CALL MEST(ID,ILST,IPwS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2380 C 2370 CALL EXEC(2,200B+ILST,IW48,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW90,1) 2380 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 94 STEP=94 C C C IW34(11)=KCVT(STEP) C C C C REPEAT STEP 90 FOR THE OTHER PLATTER C C IPAS=2 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.NE.0)GO TO 941 IF(ID(2).EQ.23B)GO TO 95 941 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2390 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2400 C 2390 CALL EXEC(2,200B+ILST,IW48,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW90,1) 2400 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C 95 STEP=95 C IW34(11)=KCVT(STEP) C C C C REPEAT STEP 91 FOR THE OTHER PLATTER C C IPAS=3 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.NE.0)GO TO 951 IF(ID(2).EQ.23B)GO TO 97 951 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2410 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2420 C 2410 CALL EXEC(2,200B+ILST,IW48,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+IKzLST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW90,1) 2420 IKL=IKL+1 IF(IFL1.EQ.IFL2)GO TO 998 C C C C STEP 92 WILL NOT BE REPEATED FOR THE OTHER PLATTER. C C C C 97 STEP=97 C IW34(11)=KCVT(STEP) C C C C TURN OFF READ ONLY OR PLATTER PROTECT SWITCHES. CHECK TO SEE C THAT READ ONLY BIT (BIT 7) IN STATUS WORD-2 IS CLEARED. C C C C CALL EXEC(2,201B,IW96,30) CALL EXEC(2,201B,IW90,1) C CALL EXEC(1,401B,ITP,1) C C C IPAS=0 IC=20 IH=0 IS=0 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.NE.0)GO TO 972 ITEMP=IAND(ID(5),64) IF(ITEMP.NE.0)GO TO 972 C IC=20 IH=2 IS=0 IPAS=0 CALL RESTH(ILU,IDVID,IPAS,IC,IH,IS,ID,ISTAT,IBF1) IF(IPAS.NE.0)GO TO 972 ITEMP=IAND(ID(5),64) IF(ITEMP.EQ.0)GO TO 998 972 CALL EXEC(2,200B+ILST,IW34,16) CALL EXEC(2,200B+ILST,IW35,16) C IF(IPAS.EQ.0)GO TO 2430 CALL MEST(ID,ILST,IPS1,ISTAT,IW37,IW38,IW45,IW44,IW39,IW91,IW92 +,IW46,IW65,IW66,IW93,IW94,IW95,IW47,IW48,IW59) IF(IPS1.EQ.1)GO TO 2440 C 2430 CALL EXEC(2,200B+ILST,IW48,24) CALL EXEC(2,200B+ILST,IW37,17) CALL EXEC(2,200B+ILST,IW39,19) CALL EXEC(2,200B+ILST,IW46,15) CALL EXEC(2,200B+ILST,IW38,15) CALL EXEC(2,200B+ILST,IW44,14) CALL EXEC(2,200B+ILST,IW45,19) CALL EXEC(2,200B+ILST,IW90,1) 2440 IKL=IKL+1 C C C C DIAGNOSTIC TERMINATED, PRINT MESSAGE. C C 998 IW58(18)=KCVT(IKL) CALL EXEC(2,201B,IW58,30) C C C CALL EXEC(2,201B,IW90,1) CALL EXEC(2,201B,IW90,1) C C CALL EXEC(2,201B,IW80,21) C C C C C END END$  . 91730-18001 2001 S C0322 &DVR07 MULTIPOINT DRIVER SOURC             H0103 p4ASMB,L,C,N * NAME : DVR07--2645 MULTIPOINT DVRIVER * SOURCE: 91730-18001 2001 * RELOC: 91730-16001 2001 * PROGMR: G.W.J. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * HED 2645 MULTIPOINT DRIVER (DVR07) 10-02-79 1007 &DV07A NAM DVR07 91730-16001 REV 2001 791022 &DV07A ENT I.07,C.07 EXT $LIST,$TIME * * * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * * [ ] EQT1 * [ ] EQT2 * [ ] EQT3 * [D ][B ][P ][S ][T ][<------UNIT------>][<---SELECT CODE------>] EQT4 * [ AV ][<---EQUIPMENT TYPE--->][DO][OR][ET][BR][<-ERROR CODE->] EQT5 * [ [<-----FUNCTION--->][<---REQUEST CODE----->] EQT6 * [<-----------------INPUT OUTPUT BUFFER POINTER---------------->] EQT7 * [<-------------------INPUT OUTPUT BUFFER LENGTH--------------->] EQT8 * [<------------------------IP1--------------------------------->] EQT9 * [<------------------------IP2--------------------------------->] EQT10 * [<-------------------LINK LIST POINTER------------------------>] EQT11 * [RP][RS][LF][CR][HO][CL][NL][SC]<--------EQT EXT. LTH.-------->] EQT12 * [<-------------------EQT EXT. POINTER------------------------->] EQT13--] * [ ] EQT14 ] * [ ] EQT15 ] * [L ][<-------GROUP ID.------->][<------DEVICE ID.------------->] EQT16<-] * [DF"][BF][SK][OB][AA][LINE NUMBER][<---------STATE------------->] EQT17 * [<---------------WORD COUNT FOR THIS OPERATION---------------->] EQT18 * [<-------------MEMORY ADDRESS POINTER------------------------->] EQT19 * [<-------------LAST WORD AV. MEMORY USER BUFFER--------------->] EQT20 * * NOTE: IF EQT IS A LINE EQT (EQT16 B15=1) EQT16 B0-14 CONTAINS ID SEG ADD * OF A PROGRAM TO BE SCEDULED IF A POS. RESP. RECEVED TO A POLL * AND THERE IS NO PENDING READ RQ. * * INITIATION CALLS: * * LINE: * * CALL EXEC(3,ILU+2000B,ICW) * * WHERE: ILU IS AN LU POINTING TO AN EQT WHICH IS LINKED TO * A 12790A INTERFACE CARD AND DVR07. BIT 15 OF ICW IS * SET TO 1 TO INDICATE THIS IS A LINE SET UP REQUEST. * * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ICW = 1 [ TO VAL ] [ LN ] * TO VAL = THE NUMBER OF 100MS (0-30) ALLOWED FOR LINE TURNAROUND. * A ZERO IN THIS POSITION IMPLIES THE DEFAULT. (3 SEC.) * LN = LOGICAL LINE NUMBER (0-7) * THIS ARGUMENT MUST ALWAYS BE SUPPLIED. * * TOV*256+LN NOTE: IN THE EVENT OF A POWER FAIL AND * THE RESTARTING OF THE MP SYSTEM BY (FIXMP) * THE TIME-OUT VALUE WILL REVERT TO THE * DEFAULT OF 3 SEC. * TERMINAL: * * CALL EXEC(3,2000B+LUN,ICW) * * WHERE: LUN IS A LU POINTING TO AN EQT WHICH IS LINKED TO DVR07. * BIT 15 OF ICW MUST BE ZERO. * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * ICW = 0 [ LN ][ 6 BITS GID ][ 6 BITS DID ] * LN = LINE NUMBER (0-7) * * NOTE: WHEN A TERMINAL IS INITIATED THE "CH" (SELECT CODE) CONTAINED * IN ITS LINE EQT IS MOVED TO THE "CH" IN THE TERMINAL EQT. * USING THE LU AND EQ COMMANDS IN RTE ONE CAN EASILY TELL * WHICH LINE A TERMINAL LU IS LINKED TO. * * GID (GROUP ID) AND DID (DEVICE ID) ARE PRODUCED BY ANDING * ALPHABETIC CHARACTER WITH 77B. * * LINE OPERATIONS: * * LINE OPERATIONS ARE THOSE SPECIAL FUNCTIONS WHICH CAN ONLY BE DONE ON A * LINE CONTROL LOGICAL UNIT. SEE 02645-90005 PP.5.38-5.41. * * "WHO ARE YOU" CALL EXEC (1,LUN,IBUF,IBUFL,ID) * * LUN = A LINE CONTROL LOGICAL UNIT NUMBER. * IBUFL MUST BE LONG ENOUGH TO CONTAIN 3 WORDS PER TERMINAL * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * ID = [ GROUP ID CHARACTOR ][ PARENTHESIS CHARACTOR ] * * RESULTING BUFFER FORMAT: * NOTE: THE RIGHT BYTE OF ID IS FORCED * ----------- TO A PARENTHESIS BY THE DRIVER. IT IS * \ GID \ DID \ IMPORTANT HOWEVER THAT THE GROUP ID * ----------- CHARACTOR BE SUPPLYED AS THE LEFT BYTE * \ ST0 \ ST1 \ OF THE ARGUMENT "ID" IN THE CALL. * ----------- * \ ST2 \ 40B \ * ----------- * * "GROUP/LINE SELECT AND WRITE" * * CALL EXEC (2,LUN,IBUF,IBUFL,ID) * * LUN = A LINE CONTROL LOGICAL UNIT NUMBER * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * GROUP ID = [ GROUP ID CHARACTOR ][ (176B) ] * * LINE ID = [ (176B) ][ (176B) ] * * NOTE: THE RIGHT BYTE OF THE ID IS FORCED TO A 176B * BY THE DRIVER. IT IS IMPORTANT THAT THE GROUP ID * CHARACTOR BE SUPPLYED AS THE LEFT BYTE OF THE ARGUMENT * "ID". SUPPLYING A 176B AS THE LEFT BYTE RESULTS IN * DOING A LINE SELECT WRITE OR A WRITE TOO ALL THE * TERMINALS ON THE LINE. IF A NULL IS IN THE LEFT BYTE * A "^" WILL BE USED RESULTING IN A "LINE" SELECT. * SKP * * SPECIAL CONTROLn' FUNCTIONS: * * FUNCTION 21B - REMOVE * * TO REMOVE A LINE FROM A SYSTEM. * CALL EXEC(3,ILU+2100B,LN) * * ILU = LINE CONTROL LOGICAL UNIT NUMBER * LN = LOGICAL LINE NUMBER WITH BIT 15 SET TO A 1 * * TO REMOVE A TERMINAL FROM A LINE. * CALL EXEC(3,ILU+2100B) * * ILU = TERMINAL CONTROL LOGICAL UNIT NUMBER * * FUNCTION 22B - SET "NAK" AND "WACK" COUNT. * CALL EXEC(3,ILU+2200B,IM) * * ILU = LINE CONTROL LOGICAL UNIT NUMBER * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * IM = [ TBF ][ WACK CNT. ][ RECV NAK ][ XMIT NAK ] * 1,2,4 0-32 0-16 0-16 * FUNCTION 23B - DISABLE ROUTINE POLLING AND/OR SET EDIT MODE FLAGS. * CALL EXEC(3,ILU+2300B,IM) * * ILU = TERMINAL CONTROL LOGICAL UNIT NUMBER * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * IM = D R L C H X N S A * WHERE: * S=1-->SCHEDUAL THE ASYNCHRONUS INTERRUPT PROGRAM ON BREAK. * A=1-->ENABLE "AUTO-ACKNOWLEDGEMENT" * D=1-->DISABLE ROUTINE POLLING. * R=1-->STRIP "RECORD SEPERATOR" FROM INCOMING TEXT. * L=1-->STRIP "LINE FEED" FROM INCOMING TEXT. * C=1-->STRIP "CARRAIGE RETURN" FROM INCOMING TEXT. * H=1-->SEND "HOME" BEFOR SENDING TEXT. * X=1-->SEND "CLEAR DISPLAY" BEFOR SENDING TEXT. * N=1-->APPEND A " CR-LF-ESC-137B " TO TEXT. * NOTE: IF THE TEXT IS TERMINATED WITH A "_" (137B) * THE "CR-LF" WILL NOT BE APPENDED. * * TBF- TERMINAL BLOCKING FACTOR * * 0--> USE THE DEFAULT 256 BYTE RECEIVE BLOCK. DATA COMM. BUFFER=512 * 1--> SPECIFY THE 256 BYTE RECEIVE BLOCK SIZE. DATA COMM. BUFFER=512 * 2--> SPECIFY THE 512 BYTE RECEIVE BLOCK SIZE. DATA COMM. BUFFER=1024 * 3--> MUST NOT BE USED. * 4--> SPECIFY THE 1024 B¡YTE RECEIVE BLOCK SIZE. DATA COM. BUFFER=2048 * 5-7--> MUST NOT BE USED. * * NOTE: "AUTO-ACKNOWLEDGEMENT" CAUSES (BELL-BELL-CR-LF-ESC-137B) * TO BE SENT TO THE TERMINAL AFTER A FULL MESSAGE IS RECEVED. THIS * IS USEFULL WHEN OPERATIND INTERACTIVLY. SKP * * EQT FLAG DEFINITION: * * EQT12 - ROUTINE POLL FLAG, EDIT MODE FLAGS AND EQT EXT LTH. * * BITS 0-2 CONTAIN THE EQT EXT LENGTH (CURRENTLY = 5) * * * (S) BIT 8....1-->SCHEDUAL THE ASYNCHRONUS INTERRUPT PROGRAM ON BREAK. * (N) BIT 9....1-->APPEND A "CR-LF-ESC-137B" TO OUT GOING TEXT. * (X) BIT 10....1-->SEND A "CLEAR DISPLAY" BEFOR SENDING TEXT. * (H) BIT 11....1-->SEND A "HOME UP" BEFOR SENDING TEST. * (C) BIT 12....1-->STRIP "CR" FROM INCOMING TEXT. * (L) BIT 13....1-->STRIP "LF" FROM INCOMING TEXT. * (R) BIT 14....1-->STRIP "RS" FROM INCOMING TEXT. * BIT 15....1-->ROUTINE POLLING DISABLED. * * EQT16 - ID/ID SEG. ADD. * * IF BIT 15 OF EQT16 = 0 THAN THIS EQT IS A TERMNIAL EQT AND THE * REMANING (0-14) BITS CONTAIN THE ID OF THE TERMINAL ASSOCIATED * WITH THIS EQT. * * IF BIT 15 OF EQT16 = 1 THAN THIS EQT IS A LINE CONTROL EQT AND * THE REMAING (0-14) BITS CONTAIN THE ID SEGMENT ADDRESS OF A * PROGRAM TO BE SCEDULED ON ASYNCHRONUS INTERRUPTS. * * EQT17 - CONTROL FLAGS, LINE NUMBER AND DRIVER STATE * * BITS 0-7..STATE OF THE DRIVER RELATIVE TO THIS EQT. (0-256) * STATE 0-->INACTIVE. * * BITS 8-10.LOGICAL LINE NUMBER TO WHICH THIS EQT IS LINKED. * * BIT 11....1-->AUTO-ACKNOWLEDGE EACH FULL MESSAGE AS IT IS RECEVED. * BIT 12....1-->ODD NUMBER OF BYTES IN WRITE BUFFER. * BIT 13....1-->THIS EQT WAS SKIPED ON THE LAST TIME AROUND. * BIT 14....1-->LAST TRANSACTION WAS TERMINATED WITH AN ETB * BIT 15....1-->WAITING FOR A DMA CHANEL. * * EQT5 - STATUS BITS 0-7 * * BITS 0-3..ERROR CODE SEE CONTINUATION ERRORS * BIT 4....1-->BREAK DETECTED. * BIT 5....1-->CONTROL-Y DETECTED (EM) OR ZERO LTH. READ * BIT 6....1-->ODD NUMBER OF BYTES IN THE LAST READ. * BIT 7....1-->(D-O-R-E) DATA OVERRUN ERROR. INPUT MESSAGE * EXCEEDED THE BUFFER. * SKP * * DETECT AND SET MODEM CONTROL LINES. F=06B * * TO DETECT AND SET SELECTED MODEM CONTROL LINES. * R=CALL EXEC(3,ILU+600B,IP) THE "B" REGESTER CONTAINES MODEM STATUS. * * ILU = LINE CONTROL LOGICAL UNIT NUMBER ONLY. * IP = 0-->RETURN MODEM STATUS ONLY. * IP # 0-->SET OR CLEAR THE SELECTED LINES AND RETURN STATUS. * * "B" REGESTER FORMAT * * BIT 15...INTERNAL USE ONLY. * 14...INTERNAL USE ONLY. * 13...(IC) RING DETECTED. * 12...(RR) CARRIER DETECTED. * 11...(CS) CLEAR TO SEND DETECTED. * 10...(DM) DATA SET READY DETECTED. * 09...(SRR) SECONDARY CARRIER DETECTED. * 08...(RT) RECEIVE CLOCK * 07... * 06... BITS 4-7 CONTROL THE BAUD RATE GENERATOR * 05... ON THE 12790A CARD. SEE THE 12790A MANUAL. * 04... * 03...(RS) REQUEST TO SEND ASSERTED. * 02...(SRS) SEC. R-T-S * 01...(TR) DATA TERMINAL READY * 00...(J2 PIN 19) RATE SEL. * NOTE: ONLY (TR) AND (J2 PIN 19-RATE SEL.) CAN BE MODIFIED. * * IP FORMAT FOR DOING MODEM CONTROL: * * BIT 00 =1--> ASSERT J2 PIN 19 (RATE SEL.) * BIT 01 =1--> DEASSERT J2 PIN 19 (RATE SEL.) * BIT 02 =1--> ASSERT DATA TERMINAL READY (TR) * BIT 03 =1--> DEASSERT DATA TERMINAL READY (TR) * BIT 04-15 UNUSED * * NOTE: SETING BOTH ASSERT AND DEASSERT RESULTS IN DEASSERT. * * BIT ASSIGNMENTS IN IP MAY CHANGE DEPENDING ON THE MODEM USED. * CHECK THE 12790A MANUAL FOR SPECIFIC ASSIGNMENTS. * FUNCTION 6 IS NOT EXECUTED UNTIL THE NEXT TIME THE DRIVER IS * POINTING TO THE LINE CONTROL EQדT, SO THERE CAN BE SOME TIME DELAY * BEFORE THE RESULT OF THE CALL IS REALIZED. MAKE THIS CALL TO LINE * CONTROL LU'S ONLY. * SKP * LINKED LIST STRUCTURE * * * THE LINE CONTROL EQT AND ALL OF THE TREMINAL CONTROL EQT'S * ASSOCIATED WITH IT ARE LINKED BY WAY OF A LINK WORD IN EQT11 OF EACH * EQT. EQT11 CONTAINS THE EQT1 ADDRESS OF THE NEXT EQT IN THE LIST, WITH * THE LAST MEMBER OF THE LIST POINTING BACK TO THE LINE CONTROL EQT. * AS TERMNIAL EQT'S ARE ADDED TO THE LINE THEY ARE INSERTED BETWEEN * THE LINE EQT AND THE FIRST TERMINAL EQT. THIS RESULTS IN THE LAST * EQT INITATED BEEING THE FIRST EQT IN THE LIST FOLOWING THE LINE EQT. * IF AN ACTION RELATIVE TO AN EQT WILL RESULT IN AN SUBSEQUENT * INTERRUPT FORM THE INTERFACE CONTROLING THE LINE, THE INTERRUPT TABLE * ENTERY ASSOCIATED WITH THAT INTERFACE WILL BE MODIFIED TO POINT TO * EQT1 OF THE ACTIVE EQT. * * LINE * ______ * EQT1 \ \<----- * / / \ * EQT11\ \--- \ * / / \ \ * EQT16\1---\ \ \ NOTE: EQT16 BIT 15=1-->LINE CONTROL EQT * / / \ \ * EQT20\____\ \ \ * \ \ * TERM \ \ NOTE: THIS WAS THE LAST EQT INITATED. * ______ \ \ * EQT1 \ \<--- \ * / / \ * EQT11\ \--- \ * / / \ \ * EQT16\0---\ \ \ NOTE: TERMINAL EQT'S HAVE A 0 IN BIT 15 OF EQT16. * / / \ \ * EQT20\____\ \ \ * \ \ NOTE: INTERNAL TO THE DRIVER THERE IS A 8 WORD * TERM \ \ TABLE CALLED THE "LINE TABLE". THIS TABLE IS * ______ \ \ ORDERD ON LOGICLA LINE NUMBER (0-7) AND EACH * EQT1 \ \<--- \ ENTERY POINTS TO THE EQT1 WOED ADDRESS OF THE * / / \ LINE CONTROL EQT FOR THAT LINE. * EQT11\ \------ * / / * EQT16\0---\ * / / * EQT20\____\ * SKP * * ERROR-CODES * * INITATOR ERRORS: * * SEE PP.15 FOR INITATOR ERROR CODES * * * CONTINUATION EcRRORS * A REGESTER=1 ERROR CODE IN EQT5 BITS 0-3=: * * 0-REQUEST REJECTED 10-RECEVE BYTE OVERRUN * 1-MODEM OFF 11-TEXT BLOCK OVERRUN * 2-NO TRANSMIT CLOCK 12-NAK OVERRUN * 3-NO CLEAR TO SEND 13-WACK OVERRUN * 4-NO RECEVE CLOCK 14-ACK SEQUENCE ERROR * 5-NO CARRIER DETECT 15-UNRECOGNIZED RESPONSE * 6-NO RESPONSE 16-TERMINAL BUFFER OVERFLOW * 7-BREAK, NO STOP BIT 17-INTERNAL LOGIC ERROR * SKP * * SAMPLE SYSTEM GENERATION: * *EQT ENT. * . * . * M1...SC,DVR07,X=5 <--\-THESE EQT'S ARE GOING TO BE USE FOR LINE * M2...SC,DVR07,X=5 \ CONTROL AND MUST HAVE A 12790A CARD ASSOCIATED * M3...SC,DVR07,X=5 \ WITH THERE SC. * M4...SC,DVR07,X=5 \ * M5...SC,DVR07,X=5 <--\ * M6...SC,DVR07,X=5 * M7...SC,DVR07,X=5 * M8...SC,DVR07,X=5 * . * . *LU ENT. * . * . * N1,M1 LINE CONTROL * N2,M2 * N3,M3 * N4,M4 * N5,M5 LINE CONTROL * N6,M6 * N7,M7 * N8,M8 * . * . *INT ENT. * . * . * SC FOR THE FIRST CARD,PRG,ASIP<--PROGRAM NAME * SC FOR THE SECOND CARD,PRG,ASIP<--PROGRAM NAME * . * * SKP I.07 NOP JSB SETIO GO SETUP IO INST (SC IN A) CLA "A"=0 FOR EQT EXT ONLY STA EQT15,I CLEAR ANY TO VALUE IN EQT15 JSB SETEQ SETUP EQT EXT LDA EQT6,I GET "RC" AND D3 LOW 2 BITS OF EQT6 STA TEMP SAVE RC FOR SETING STATE CPA D3 "RC"=3(CONTROL)? JMP CONT YES, GOTO CONTROL LDB EQT17,I TEST FOR DMA FLAG SSB EQ17 BIT 15=1? JMP STDMA FLAG SET,GO TO DMA SETUP LDB EQT11,I "LLP"=0? SZB,RSS JMP ERR31 ERROR CPA D1 READ? JMP I.01 YES, GO ON LDA EQT16,I NO, OK AND RBYTE CHECK DEV. ID. CPA QM DEV. ID.= A QUOTE MARKq? JMP ERR32 YES, ERROR-WRITE TO A GROUP ID. I.01 LDB EQT8,I TEST BUFFER LENGTH CPA D1 READ REQUEST? SZB YES, BUFF LTH=0? JMP I.01A NO, OK JMP ERR01 YES, ERROR * * NORMAL READ/WRITE OPERATIONS GET STARTED HERE. * I.01A CLE,SZB,RSS IF BF LT=0 DO NOT DO CH WD CHK JMP I.02 NO, GO ON SSB,RSS -(CH)? JMP I.02 NO, GO ON CMB,INB MAKE POSITIVE CLE,SLB ODD? CCE,INB YES, ADD 1 AND SET "E" RBR B=B/2 I.02 LDA EQT17,I SETUP TO CLEAR FLAGS AND B7.4K AND STATE SEZ ODD BYTE? IOR OBWF YES, SET FLAG STA EQT17,I CLA STA EQT18,I CLEAR EQT18 (WC) SZB,RSS BF LTH=0? JMP I.04 YES, GO ON ADB EQT7,I CALC LAST WD AV MEM ADB MIN1 SUBTRACT 1 I.03 STB EQT20,I PUT IT INTO EQT20 (LWAM) LDA EQT7,I GET FIRST WD AV MEM STA EQT19,I PUT IT INTO EQ19(FWAM) LDA EQT5,I CLEAR STATUS IN EQT5 AND LBYTE STA EQT5,I LDB TEMP SET STATE LDA EQT16,I LINE EQT ? SSA EQ16-B15=1-->LINE LDB PLNRS SET STATE TO PROC. LINE RC CCE JSB STE17 SET STATE CPB PLNRS IF DOING A LINE RQ JMP RTNI0 DO NOT DO TIME OUT. JSB GT$TM GET THE CURRENT TIME FROM $TIME DST EQT9,I KEEP IT IN EQ09 AND EQ10. JMP RTNI0 RETURN, GOOD * * IF A ZERO LENGTH WRITE IS DETECTED WE CHECK FOR AN APPEND. * I.E. HOME-UP,CLEAR,CR/LF-ESC 137B * I.04 LDA EQT6,I CHECK FOR EDIT FLAGS IN RQ AND B3.4K SZA JMP I.03 YES, GO ON LDA EQT12,I CHECK FOR EDIT FLAGS IN EQ12 AND B7.0K SZA JMP I.03 YES,rt GO ON JMP ERR01 NO, ERROR SKP * *2 * CONT LDA EQT6,I GET FUNCTION CODE AND B3.7K EQT6,B6-10 SZA,RSS F=0 (CLEAR)? JMP CLEAR YES, GO TO CLEAR RTN CPA FINIT F=20(INIT)? JMP INIT YES, GO TO INIT RTN. CPA FDINT F=21(DINIT)? JMP DINIT YES, GO TO DINIT RTN. CPA FSNWK F=22(SET NAK WACK CNT.)? JMP STNKW YES,GO DO IT CPA FSEMS F=23(SET EDIT MODE FLAGS)? JMP STEMF YES, GO DO IT CPA FMDCT F=6(MODEM CONTROL)? JMP STNKW YES, GO DO IT JMP RTNI4 DO AN AMED. COMP. RTN. INIT LDA EQT7,I GET IPRAM SSA,RSS LINE SETUP REQUEST? JMP TINIT NO, GO TO TERM. INIT RT * * LINE INITIATION STARTS HERE * AND D7 EQT7,B0-2 STA LN SAVE IT ADA LTP ADD TO LINE TAB POINTER STA TEMP SAVE LDA A,I GET TABLE ENTERY SZA =0? JMP ERR33 NO, ERROR-LINE ASSIGNED LDA EQT11,I ALLREADY LINKED? SZA =0? JMP ERR34 YES, ERROR-ALLREADY LINKED * * CHECK FOR THE RESULTS OF THE DIAGNOSTIC IF ANY. * IF ERROR POST ERROR CODE IN EQT5. * JSB GETA GET CONT. OF OUT REG SSA,RSS DIAG.? JMP LIN1 NO, GO ON ELA,CLE,ERA YES, CLEAR BIT 15 SZA,RSS "A"#0-->ERROR JMP LIN1 NO, GO ON AND B17 YES, POST ERROR CODE STA B IN EQT5 LDA EQT5,I AND ECM IOR B STA EQT5,I JMP ERR30 RETURN ERROR * * MAKE ENTERY * LIN1 LDA EQT1 PUT POINTER IN LINE TABLE STA TEMP,I STA EQT11,I DUMMY UP EQT11 LDA EQT12,I SET "RP" FLAG IOR SIGNB STA EQT12,I LDA LN  SAVE LN IN EQT17 ALF,ALF LEFT BYTE STA EQT17,I CLA STA EQT18,I CLEAR (WC) STA EQT19,I CLEAR (FWAM) STA EQT20,I CLEAR (LWAM) LDA EQT4,I SET "S" BIT IN EQT4 IOR B10K STA EQT4,I * * MAKE PROG ENTERY IF POSILBLE * LDA EQT16,I CHECK TO SEE IF SET SSA EQ16-B15=0? JMP LIN1A NO,GO DO TO RQ. JSB INTEN GET INT. TABEL ENT. STB TEMP SAVE ENT. ADD. LDB EQT1 SETUP TO REPLACE INT ENT CMA,CLE,SSA,INA ID. SEG. ENT.? CLA EQT ENT. IOR SIGNB SET L STA EQT16,I ID, PUT IT IN PROG ENT STB TEMP,I LIN1A LDA EQT7,I CHECK FOR A NEW TIME-OUT VALUE AND B17.4 LEFT BYTE OF IPRAM SZA,RSS NEW VALUE? JMP LIN2 NO, SKIP IT RAL,RAL MOVE IT RAL IOR STTOV MERG THE COMMND. JSB OUTAF SEND IT JSB WATE WAIT FOR THE FLAG LIN2 LDA TORQC REQUEST A TIMEOUT JSB OUTAF JMP RTNI4 * * ROUTINE TO GET DMA FROM THE C.07+3 EXIT. * GTDMA LDB SIGNB SET THE WATEING FOR DMA FLAG CLE IN EQT17. JSB STE17 LDB C.07 BUMP THE RETURN POINT ADB D2 LDA D5 A=5-->WANT DMA JMP B,I GO BACK TO THE SYSTEM * * FINIT OCT 2000 FDINT OCT 2100 FSNWK OCT 2200 FSEMS OCT 2300 FMDCT OCT 600 SKP * * ERR01 LDA D1 REQUEST REJECTED JMP ERX+1 ERR30 CLA DIAGNOSTIC FAILED JMP ERX ERR31 LDA D1 INACTIVE LU-EQT (NOT IN LINKED LIST) JMP ERX ERR32 LDA D2 WRITE TO A GROUP POLL ID JMP ERX ERR33 LDA D3 LOGICAL LINE NUMBER ALLREADY ACTIVE JMP ERX ERR34 LDA D4 LU-EQT ALLREADY ACTIVE (IN LINKED LIST) JMP ERX ERR35 LDA D5 LUJHFB-EQT CAN NOT BE USED AS A TERMINAL LU-EQT JMP ERX ERR36 LDA D6 WRONG LINE NUMBER JMP ERX ERR37 LDA D7 NOT A LINE LU JMP ERX ERR38 LDA D8 TERMINALS STILL ON LINE JMP ERX ERR39 LDA D9 NOT A TERMINAL LU ERX ADA D30 ADD OFFSET RTNI CLB CLEAR XLOG FOR RETURN JMP I.07,I RETURN * * RTNI0 CLA NORMAL RETURN JMP RTNI * * RTNI4 LDA D4 IMMEDIATE COMPLETION JMP RTNI * * D8 DEC 8 D9 DEC 9 D30 DEC 30 H SKP * * *4 * * TINIT LDA EQT11,I TEST TO SEE IF IN LIST. SZA JMP ERR34 YES, ERROR LDA EQT16,I TEST TO SEE IF MARKED LINE SSA JMP ERR35 YES, ERROR LDA EQT7,I GET LINE NUMBER (LN) AND B70K EQT7,B12-14 ALF MOVE TO BITS 0-2 STA LN SAVE IN LN * * * TEST TO SEE IF LINE ACTIVE * * ADA LTP ADD LN TO TABEL POINTER LDA A,I GET ENTERY SZA,RSS ACTIVE? JMP ERR36 NO, ERROR STA TEMP SAVE ENTERY ADA D10 GET THE LINK LIST PNT LDB A,I STB EQT11,I MOVE LLP TO EQT11 LDB EQT1 POINT LLP TO OUR EQT1 STB A,I * * * MOVE "CH" SELECT CODE FROM LINE EQT TO * TERMINAL EQT. * * LDA TEMP GET LINE EQT PNT ADA D3 GET EQT4 LDA A,I AND B77 MASK SELECT CODE STA B LDA EQT4,I GET OUR EQT4 AND SCMK MASK OUT SC IOR B PUT NEW SC IN EQT4 IOR B10K SET "S" BIT IN EQT4 STA EQT4,I * * * SET UP ID WORD * * LDA EQT7,I GET PERAM STA B SAVE IT AND GPCMK BUILD GROUP CH. RAL,RAL MOVE TO LEFT BYTE IOR HIOB SET HIGH ORDER BIT STA TEMP SAVE IT LDA B AND B77 BUILD DEV CH CPA QM QUOTE MARK IN LOW BYTE? JMP TI.01 YES, DO NOT SET BIT 6 IOR B100 NO, SET BIT 6 TI.01 STA B SAVE DEV. ID IN "B" IOR TEMP IOR GROUP CH. STA EQT16,I PUT IT INTO EQT LDA LN PUT LN EQT17 ALF,ALF LEFT BYTE STA EQT17,I CLA STA EQT18,I CLEAR (WC) STA EQT19,I CLEWR (FWAM) STA EQT20,I CLEAR (LWAM) LDA >EQT12,I SETUP TO DIAB. RTN. POLL IOR SIGNB SET BIT 15 OF EQT12 CPB QM DEV. ID.= QUOTE MARK? STA EQT12,I YES, RESTORE EQT12 JMP RTNI4 RETURN B100 OCT 100 * SCMK OCT 177700 HIOB OCT 40000 GPCMK OCT 7700 D10 DEC 10 EMFMK OCT 177400 * * THIS IS WHERE WE CHECK TO MAKE SURE THA LINE ONLY CALLS * ARE BEEING MADE TO LINE CONTROL LU-EQT'S. * STNKW LDA EQT16,I CHECK IF LINE EQ? SSA,RSS EQ16 B15=1-->LINE EQ JMP ERR37 NO ERROR C.C LDB D3 SET PRE CONT. STATE CCE JSB STE17 JMP RTNI0 LET C.07 DO IT. * * * 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 * DR RS LF CR HO CL NL SC [EX LTH] * * STEMF LDA EQT12,I PRESERV EQT EXT LTH AND D7 EQ12 B0-2 STA B LDA EQT7,I GET OPT PERAM AND EMFMK STRIP OUT IOR B STA EQT12,I RESTORE LDA EQT17,I SET OR CLEAR "AUTO-ACK" FLAG AND B3.4K LDB EQT7,I SET FLAG? SLB IOR B4.0K YES, SET IT STA EQT17,I RESTORE JMP RTNI4 RETURN * * * NOTE: SETTING THE "K" BIT (BIT 8) ON A READ REQUEST IS EQUIVALENT * TO HAVING SET THE "RS","LF",AND "CR" FLAGS WITH FUNCTION 23B AND * RESULTS IN EDITING OUT ALL "RECORD SEP", LINE FEED, AND CARRAGE * RETURN CHARACTORS FROM INCOMEING TEXT. * SETTING THE "X"(10),"A"(9),OR "K"(8) BITS CORRESPONED TO THE * "HO","CL",AND "NL" IN FUNCTION 23B AND HAVE THE SAME RESULT. * X--HOME * A--CLEAR * K--APEND CR/LF SKP * * * DINIT ROUTINE RMOVES LINES FROM SYSTEM * IF THERE ARE NO TERMINALS ON THAT LINE. * * DINIT LDA EQT7,I LINE REQUEST? SSA,RSS JMP TDINT NO, GO TO TDINT LDINT LDA EQT16,I LINE EQT? SSA,RSS BIT 15 EQT 16 =1 JMP ERR37 NO, ERROR LDA EQT11,I EQT11 SHOULD BE PINTING CPA EQT1 TO MY EQT1 JMP LD.01 YES, GO ON JMP ERR38 NO,ERROR LD.01 LDA EQT7,I GET LN FROM IPRAM AND D7 EQT7,B0-2 ADA LTP SETUP POINTER IN LINE TAB STA TEMP SAVE POINTER LDA A,I GET THE ENTERY CPA EQT1 POINT TO ME? JMP LD.02 YES, GO ON JMP ERR36 NO, ERROR BAD LN LD.02 CLA STA TEMP,I CLEAR TAB ENT STA EQT11,I CLEAR LLP STA EQT17,I CLEAR EQT17 STA EQT18,I CLEAR (WC) STA EQT19,I CLEAR (FWAM) STA EQT20,I CLEAR (LWAM) LDA SC FORCE CARD TO RUN DIAG. IOR STFC AND DISABLE INTERRUPT. STA OFF IOR CLCC CLC STA OFF+1 OFF NOP NOP JMP RTNI4 RETURN * SKP * STFC OCT 102100 CLCC OCT 4600 * * TDINT CHECKS TO SEE IF LINKED, IF SO * THE DEINT IS LEFT TO BE DONE THE NEXT TIME * C.07 POINTS TO THIS TER. EQT. * * TDINT LDA EQT16,I MAKE SURE NOT LINE EQT SSA EQ16-B15=1-->LINE EQT JMP ERR39 LINE EQT, ERROR LDA EQT11,I THIS TER. EQT LINKED? SZA,RSS JMP ERR31 NO, ERROR (NOT ACTIVE) JMP C.C YES, LET C.07 DO IT * SKP * * SETUP DMA XFER HERE * * STDMA JSB STDIO SETUP DMA IO INST. LDA SC BUILD CW1 IOR SIGNB IOR SET CONT MASK ID.00 OTA 6B OUTPUT CW1 ID.01 CLC 2B ARM CW2 SETUP LDA EQT17,I FIND OUT CURRENT STATE AND SSGNB CLEAR DF STA EQT17,I AND RBYTE STA B SAVE STATE IN B REG LDA EQT19,I BUILD CW2 CPB UNLOS STATE=UNLOAD? IOR SIGNB YES, SET CW2 FOR INPUT ID.02 OTA 2B OUTPUT CW2 ELA,CLE,ERA UPDATE EQT19  ADA EQT18,I ADA MIN1 SUBTRACT 1 STA EQT19,I ID.03 STC 2B ARM CW3 SETUP LDA EQT18,I GET WC-->CW3 CMA,INA MAKE NEG. ID.04 OTA 2B OUTPUT CW3 CPB LOADS LOADING BOARD BUFF? JMP ID04A JMP STD.1 SKIP TO UNLOAD ID04A LDA EQT6,I CHECK FOR "M"BIT BIN AND B100 RAL,RAL ALF STA B LDA LOADC OUTPUT LOAD COMMAND IOR B JSB OUTAF JMP ID.05 TO START DMA STD.1 LDA UNL SEND UNLOAD COMMND TO IFC JSB OUTAF LDA EQT16,I LINE EQT ? SSA EQT16-B15=1-->LINE JMP ID.05 YES, SKIP GETTING ID AND B77 CHECK FOR QM CPA QM QM? JMP ID.05 YES, DO NOT STRIP ID JSB WATE WAIT FOR FLAG * * NOTE: THE FIRST WORD IS THE ID AND WE DO NOT WANT IT * STD.0 STC 10B,C SET CONT ON IFC ID.05 STC 6B,C START DMA ID.06 CLC 6B,C DISABLE DMA FLAG JMP RTNI0 RETURN SKP * * *100 * * C.07 NOP JSB SETIO SETUP IO CLA "A"=0 FOR EXT ONLY STA EQT15,I CLEAR ANY TO VALUE IN EQT15 JSB SETEQ SETUP EQT EXT * * * TEST FOR A SYSTEM LEVEL TIMEOUT * IF SO GO TO TIMEOUT ROUTINE * * LDA EQT4,I TEST FOR T BIT ALF EQT4 B11 SSA =1 JMP TIMER YES, GO TO TIMEOUT RTN * * * * * * * NORMAL C.07 PROCESING * * JSB STEV CHECK STATE RETURN IF INACTIVE LDA EQT11,I EQ11=(EQ1) CPA EQT1 JMP IDLE+1 YES, DO TIME OUT JMP NEXT NO GO TO NEXT TER. EQT. IDLE JSB STITE SET INT. TAB ENT LDA TORQC NO, SEND TIMEOUT RQ JSB OUTAF TO IFACE. JMP RTNCT CONTINUATION RETURN * * * NEXT--IS WHE5RE WE MOVE TO THE NEXT EQT IN * THE LINKED LIST. (EQT11-->EQT1 ADD OF NEXT EQT) * * NEXT LDA EQT11,I GET LLP JSB SETEQ SETUP NEW EQT LDA EQSV CHECK TO SEE IF COMPL.EQT. CPA EQT1 JMP IDLE+1 YES, DO A TIMEOUT JSB STEV CHECK STATE RETURN IF INACTIVE LDA EQT16,I INACT. IS THIS A LINE EQT? SSA EQT16 B15=1 -->LINE JMP NEXT YES, GOT TO NEXT EQT LDA EQT12,I RTN. POLL DISABLED? SSA EQ12 B15 =1-->DIS. JMP IDLE YES, DO TIME OUT PSPOL LDA EQT17,I NO, SKIPED THIS EQT YET? STA B RBL,RBL SSB,RSS EQT17 B13=1-->SKIPED JMP C.01 NO FLAG--SKIP IT AND CLSKP FLAG--CLEAR FLAG STA EQT17,I JMP POLLC DO A POLL C.01 IOR B20K SET SKIP FLAG STA EQT17,I JMP NEXT TRY NEXT EQT * * SELECTS START HERE * SELCC LDA EQT16,I SETUP SELECT ID IOR LC IOR LOWER CASE BITS BDCS STA ID LDB SELCS SET SELECT STATE CCE JSB STE17 CLB SET UP TO DO EDIT MODE STB TEMP LDA EQT6,I GET SPECIAL FUNCTION BITS AND B3.4K ALF,RAL STA B SAVE IN "B" LDA EQT12,I GET EDIT MODE FLAGS AND B7.0K EQ12 B9-11 ALF MOVE TO HIGH BITS IOR B ADD THE SP F BITS STA B SAVE IN "B" LDA EQT4,I CHECK FOR GRAPH SUB. CH. AND B3.7K MASK BITS IN EQT 4 CPA GPHMD SUB CH =3? ADB B10K YES, FORCE APP. ESC * L . LDA B GET "B" INTO "A" LDB EQT7,I CHECK FOR FIRST SELECT CPB EQT19,I ON THIS REQUEST.(EQ7=EQ19) JMP FST YES, OK AND B20K NO, ALLOW ONLY (NL) TO GO FST STA TEMP PUT EDIT FLAGS IN TEMP  STA EQT18,I SAVE EDIT FLAGS IN EQT18 JMP C.03 YES, CONTINUE THE SELECT * * POLLS START HERE * POLLC LDA EQT5,I ERROR STATUS AND B17 EQ5-B0-3=ERROR CODE SZA EC OF ZERO-->OK-UP JMP IDLE DOWN DO NOT POLL LDA EQT16,I SETUP POLL ID PWAYP STA ID LDB POLLS SET POLL STATE CCE JSB STE17 CLB SETUP EDIT MODE SWTCHES LDA EQT12,I GET EDIT MODE FLAGS AND B70K EQ12 B 12-14 RAL MOVE TO HIGH BITS STA B LDA EQT6,I CHEK "K" BIT IN RQ AND B400 EQ6 B8 SZA SET? LDB B160K YES, SET ALL SWTC STB TEMP * * C.03 JSB STITE POINT INT. TAB TO EQT LDA PSCMD SEND POLLSEL COMND TO IFC IOR TEMP SET EDIT MODE STCHES JSB OUTAF JSB WATE LDA ID SEND ID JSB OUTA JMP RTNCT CONTINUATION RETURN * * GPHMD OCT 300 CLSKP OCT 7777 B20K OCT 20000 B200 OCT 200 SKP * * * POLL RESP PROC. * * POLL LDB UNLOS SET TO UNLOAD STATE CCE JSB STE17 JSB GETA GET RESP. FROM IFC CLB SSA JMP P.07 A<0--> ERROR STB EQT18,I CLEAR ANY EROR COUNT IN EQ18 CPA ZEOT NEG. RESP. TO POLL? JMP P.05 YES, GO TONEXT EQT. CPA ETXET A=ETXET?-->+RESP FULL MES JMP P.01 YES, GO DO IT CPA ETBET A=ETBET?-->+RESP PART MES JMP P.00 YES, GO DO IT CPA CNYET A=CNYET-->+RESP (EOT) JMP P.06 YES, GO DO IT JMP P.05 UNREC. RESP. DO IT OVER P.00 LDB RETBF SET B/X FLAG TO 1 (ETB) CLE JSB STE17 P.01 LDA EQT5,I TEST FOR ACTIVE RQ SSA,RSS EQT5 B15=1-->ACTIVE JMP SCHDX INACTIeVE TRY A SE JSB DIDL SEND "STC" TO IFC JSB WATE JSB GETA BUILD WC AND ADBMK MASK ADD BITS ADA DM17 SUB CONT BYTES STA B PUT BC IN "B" REG CPA D2 ZERO LTH REC.? (ID ONLY) JMP P.06 YES DO A "EOT" COMP. SLB,RSS ODD? JMP P.02 NO, GO ON INB ODD, MAKE EVEN B<--B+1 LDA EQT5,I SET ODD BYTE STATUS IOR OBF STA EQT5,I P.02 RBR DEVIDE B BY 2 LDA EQT16,I LINE EQT? AND LQMMK LOOK FOR BOTH LINE AND QM CPA QM QM? JMP P.02A YES, SKIP NEXT TEST SSA,RSS EQT16-B15=1-->LINE ADB MIN1 B<--B-1 (ID) P.02A STB EQT18,I PUT WC INTO EQT18 ADB EQT19,I CHECK-TOO BIG? ADB MIN1 CMB,INB ADB EQT20,I EQ19+WC>EQ20? SZB,RSS CHECK FOR ZERO JMP P.03 YES, OK GO ON SSB,RSS JMP P.03 NO, GO ON LDA EQT5,I YES, SET DORE BIT IOR DORE STA EQT5,I LDA EQT19,I COMPUTE NEW WC CMA,INA ADA EQT20,I INA WC=EQ20-EQ19+1 STA EQT18,I P.03 JMP GTDMA GO AFTER DMA * * LQMMK OCT 100077 ADBMK OCT 1777 DM17 DEC -17 * * REQUE POLLS HERE * P.05 LDA EQT5,I ACTIVE? SSA,RSS EQ5-B15=1-->ACTIVE JMP NEXTX NO, GO TO NEXT EQT LDA EQT7,I YES, CHECK FOR ALREADY CPA EQT19,I MOVED DATA EQ7#EQ19 JSB DELTM NO, DID WE TIME OUT YET? LDB PLNRS NO, SETUP FOR PRE-LINE STATE LDA EQT16,I LINE EQT? SSA,RSS EQ16-B15=1-->LINE EQT LDB D1 NO, SET PRE POLL STATE CCE JSB STE17 JMP NEXT GO TO NEXT EQT * * * EOT PROC * * P.06 LDA EQT5,I SET EOT STATUS IOR EOTF STA EQT5,I CLB SET WC TO 0 STB EQT18,I JMP UL.02 COMP. RTN. * * CHECK FOR A LINE EQT IF SO ERROR 05 AND 06 ARE OK. * DO A COMP. RET. WITH XLOG=0. * P.07 ELA,CLE,ERA CLEAR SIGN BIT LDB EQT16,I LINE EQT ? SSB,RSS EQ16-B15=1-->LINE EQT JMP P.08 NO, GO CHECK ERROR CLB SET XLOG TO ZERO CPA D5 ERROR=NO CARRIER DET.? JMP RTNC0 YES...OK ON A "WHO ARE YOU" CPA D6 ERROR=NO RESP.? JMP RTNC0 YES...OK ON A "WHO ARE YOU" JMP RTNCX NO...GO REPORT ERROR * * ON A NORMAL POLL IF ERROR CODE IS 05,06 OR 07 REQUE THE POLL. * P.08 CPA D5 ERROR =5 ? JMP P.09 YES, REQUE UP TO 8 TIMES. CPA D6 ERROR =6 ? JMP P.09 YES, REQUE UP TO 8 TIMES CPA D7 ERROR =7 ? JMP P.09 YES, REQUE UP TO 8 TIMES JMP P.10 NONE OF THE ABOVE, REPORT IT. * * SCHDX JSB SCHED GO DO SCHEDUAL JMP NEXTX GO TO NEXT EQT * * P.09 STA TEMP2 LDB DM8 LDA EQT18,I ALLREADY COUNTING? SZA,RSS EQ18#0 STB EQT18,I NO, START THE COUNTER ISZ EQT18,I YES, BUMP THE COUNTER JMP P.05 TRY AGAIN LDA TEMP2 GIVE UP * * P.10 LDB EQT1,I CHECK FOR AN ACTIVE REQUEST. SZB EQ1#0-->ACTIVE JMP RTNCX YES, REPORT IT. JMP NEXTX GO TO NEXT EQT. SKP * * * DONE UNLOADING--ARE WE DONE WITH RQ? * * UNLOD LDA EQT5,I SETUP TO TEST FOR DORE AND DORE STA B PUT DORE FLAG IN B LDA EQT17,I SETUP TO TEST FOR (B/X) AND RETBF SZB,RSS DORE? (DATA OVERRUN) SZA,RSS B/X=0-->ETX (FULL MES) JMP UL.01 YES TO DORE OR ETX ISZ EQT19,I BUMP4I FWAM JSB RLDMA RELEASE DMA CHAN JMP P.05 GO TO NEXT EQT UL.01 LDB EQT7,I COMPUTE XLOG CMB,INB ADB EQT19,I XLOG=EQT19-EQT7+1 INB LDA EQT8,I WORDS OR CH. SSA,RSS JMP UL.02 WORDS GO ON RBL CH. B<--B*2 LDA EQT5,I CHECK FOR ODD BYTE AND OBF SZA ADB MIN1 SUB 1 UL.02 JSB EQ17C AND B4.0K "AUTO-ACK"? SZA JMP UL.04 YES, GO DO IT UL.03 JMP RTNC0+1 RETURN COMP. REL. DMA * * DO AN AUTO-ACK IF REQUIRED. * UL.04 LDA EQT16,I LINE CONT. EQT? SSA JMP RTNC0+1 YES, DO NOT DO AUTO ACK AND RBYTE MAKE SURE NOT GROUP POLL ID CPA QM EQ16-B0-7=42B-->GROUP POLL ID JMP RTNC0+1 YES, DO NOT DO AUTO ACK STB BSV SAVE "B" REG. LDA LOADC SEND LOAD COMND. JSB OUTAF JSB WATE WAIT FOR FLAG LDA BELL LOAD CARD WITH "BELL" CH. JSB OUTA JSB WATE WAIT FOR FLAG LDA SAXMC SEND SELECT AUTO-XMIT COMND. JSB OUTAF JSB WATE WAIT FOR FLAG LDA EQT16,I SEND ID IOR LC FORCE SELECT JSB OUTA JMP RTC0X DO SP. RTN. JMP P.05 GO TO NEXT EQT SKP * * * HANDEL SELECT RESP. HERE * * SELCT LDB LOADS SET LOAD STATE CCE JSB STE17 JSB GETA GET RESP. SSA JMP SE6 A<0--> ERROR CPA DLE0 A=DLE0 --> POS RES EVEN BLK JMP SE1 YES, OK GO ON JMP SE4 DO IT AGAIN LATER. SE1 LDA EQT8,I ZERO LENGTH REC.? SZA,RSS JMP SE5 YES, DO IT LDB MAXWC CALCULATE MAX WD CNT LDA EQT18,I ANY EDIT FLAGS? SZA,RSS JMP SE1A NO SKIP NEXT CODE SSA ) "HOME" FLAG SET? ADB MIN1 SUBTRACT 1 FOR MAX RAL BUMP TO "CLEAR" SSA "CLEAR" FLAG SET? ADB MIN1 SUBTRACT 1 FROM MAX SE1A STB TEMP PUT MAX IN TEMP LDA EQT19,I ACK, COMPUTE WC CMA,INA ADA EQT20,I WC=EQT20-EQT19+1 INA STA B SAVE WC IN B CMA,INA WC>MAXWC TOO BIG? ADA TEMP CLE SSA,RSS JMP SE2 NO, GO ON CCE YES, SET "E" LDB TEMP TOO BIG SET WC TO TEMP SE2 STB EQT18,I PUT WC INTO EQT18 SEZ,RSS CHECK ETB-ETX? JMP SE3 ETX, GO ON LDB TETBF ETB,SET BIT IN EQT17 CLE JSB STE17 SE3 JMP GTDMA GO GET DMA * * REQUE A SELECT HERE * SE4 LDA EQT7,I CHECK FOR WRITE CONTINUATION CPA EQT19,I EQ7=EQ19-->FIRST SELECT JSB DELTM FIRST SEL. DID WE TIME OUT YET. LDB D2 SET STATE TO PRE SELECT CCE JSB STE17 JMP NEXT * * ON A ZERO LENGTH WRITE FORCE THE BOARD TO RESET IT'S POINTERS * BY SENDINF IT A LOAD COMMAND. THEN TELL IT TO XMIT. * SE5 LDA LOADC SEND LOAD COMMAND JSB OUTAF JMP LOAD+3 THEN TO XMIT SE6 ELA,CLE,ERA CLEAR SIGN BIT CPA D5 ERROR = 5? JMP SE4 YES, REQUE JMP RTNCX NO, REPORT ERROR SKP * * * RETURN HERE AFTER GETING DMA AND LOADING THE IFC BUF * * LOAD JSB GETA CHECK FOR AN ERROR DURING LOAD SSA JMP RTNCX ERROR LDB RESPS SET STATE TO RESP. CCE JSB STE17 STA B AND TETBF "ETB" FLAG SET? SZA,RSS JMP LO.01 NO, GO ON LDA TETB YES, SETUP TO XMIT ETB JMP LO.02 LO.01 SWP AND OBWF ODD BYTE FLAG SET? SZA LDA TOB SET KTO XMIT ODD BYTE LO.02 IOR XMIT SEND XMIT COMND TO IFC JSB OUTAF JSB RLDMA RELEASE DMA JMP RTNCT RETURN CNT SKP * * * RETURN HERE AFTER XMITING * * RESP JSB GETA GET XMIT RESP SSA JMP RTNCX A<0--> ERROR CPA WACK A=WACK? JMP RE.02 YES, ERROR CPA DLE0 A=DLE0 -->OK? JMP RE.02 YES, OK GO ON CPA DLE1 A=DLE1 -->OK? JMP RE.02 YES, OK GO ON CPA RVI A=RVI -->BREAK JMP RE.04 YES, GO DO IT LDB TIOOF SET FOR POS. TERMINAL OVERFLOW ERROR CPA DLEET TERM. OVERFLOW? JMP RTNCX+2 YES REPORT IT LDA URRER UNREC. RESP. ERROR JMP RTNCX REPORT IT. RE.02 LDB EQT8,I RQ COMPLETE SZB,RSS BUF LTH=0? JMP RTNC0 YES, COMP LDB EQT19,I NO, EQ19=EQ20? CPB EQT20,I CLE,RSS CLEAR "E" JMP RE.03 NO, GO TO NEXT RE02A LDB EQT7,I YES, COMPUTE XLOG CMB,INB ADB EQT19,I XLOG=EQT19-EQT7+1 INB LDA EQT8,I WORDS OR CH.? SSA RBL CH. B<-- B*2 LDA EQT17,I ODD BYTE? AND OBWF SZA ADB MIN1 YES, SUB 1 JMP RTNC0 RETURN COMP RE.03 LDA EQT16,I MAKE SURE THIS IS NOT A LINE EQT SSA EQ16-B16=1-->LINE JMP RE02A YES DO COMP. LDA EQT17,I CLEAR ALL BUT LN AND OBF AND B17.4 STA EQT17,I ISZ EQT19,I BUMP FWAM JMP SE4 GO ON RE.04 LDA EQT5,I SET BREAK FLAG IN EQT5 IOR BRKFL STA EQT5,I LDA EQT12,I CHECK FOR RVI SCHEDUAL AND B400 SZA JSB SCHED YES, DO A SCHEDUAL JMP RE.02 CONTINUE * * BRKFL OCT 20 SKP * * SCHED NOP LDA EQT17,I  GET LN AND B3.4K EQT17 B8-10 ALF,ALF ADA LTP GET LINE TAB ENT LDA A,I ADA D12 GET LINE EQT EXT PNT LDA A,I LDA A,I GET EQ16 OF LINE CNT EQ AND SSGNB MASK OFF ID SEG AD B0-14 SZA,RSS =0? JMP SCHED,I YES, GIVER UP STA SCH PUT ID SEG ADD IN LIST CALL LDA EQT4 PUT EQT4 ADD. IN $LIST CALL STA $L4 JSB $LIST CALL $LIST OCT 601 SCH NOP $L4 NOP JMP SCHED,I * * D12 DEC 12 * * CLEAR--IS WHERE THE CLEAR FUNCTION IS DONE. F=0 * CLEAR JSB EQ17C CLEAR STATE AND FLAGS CLB LDA EQT5,I CLEAR ERROR CODE IF ANY AND LBYTE STA EQT5,I STB EQT18,I CLEAR WC STB EQT19,I CLEAR MAP STB EQT20,I CLEAR LWAM JMP RTNI4 SKP * * THIS IS WHERE ALL LINE READ/WRITE GET STARTED. * LNRQ LDA EQT9,I GET OPT PERAM CLB CLEAR "B" IN CASE OF ERROR AND LBYTE GET LEFT BYTE STA ID STORE IN ID LDA EQT6,I CHECK RQ TYPE AND B77 EQT6 B0-5 CPA D1 RC=1-->READ-->WHO ARE YOU JMP PWAY YES, GO DO IT BDC LDA ID BUILD ID SZA,RSS ID=0? LDA BDCLC YES, FORCE LINE BDC IOR BDCC FORCE MINIMUM GROUP SELECT JMP BDCS GO TO SELECT PWAY LDA ID BUILD ID SZA,RSS ID=0? LDA ATSIG FORCE TO FIRST GROUP IOR WAY FORCE WHO ARE YOU JMP PWAYP GO TO POLL SKP * * ALL CONTROL OPERATIONS THAT ARE DONE IN THE C.07 START HERE * CNTX LDA EQSV COMP. IN PROC.? SZA JMP NEXT YES, DO NOT START CNT. NOW LDA EQT6,I GET FUNCTION CODE CLB CLEAR "B" IN CASE OF ERROR AND B3.7K CPA FDINT F=DNLHINIT? JMP CX.01 YES, GO DO IT CPA FSNWK F=SET NAK & WACK? JMP CX.02 YES, GO DO IT CPA FMDCT F=MODEM CONT.? JMP CX.06 YES, GO DO IT JMP RTNC1 NO, ERROR RTN * * * REMOVE A TERMINAL FROM THE LINE * * CX.01 JSB INTEN FIND INT TAB ENT LDA EQT11,I POINT ENT ENT TO NEXT EQT STA B,I STA TEMP3 CLB STB EQT11,I CLEAR STB EQT16,I STB EQT17,I STB EQT18,I STB EQT19,I STB EQT20,I CX01A ADA D10 SCAN THE LINKED LIST FOR LDB A,I THE EQT LINK POINTING TO ME. CPB EQT1 MY EQT1? JMP CX01B YES, GO PATCH THE LINK. LDA B NO, MOVE TO THE NEXT LINK. JMP CX01A CX01B LDB TEMP3 PATCH THE LINK WORD STB A,I LDA TORQC SEND TIMEOUT JSB OUTAF JMP RTCTO RETURN-TIMEOUT RUNNING N SKP * * * DO NAK WACK OVERRIDES * * CX.02 LDA RPSBC SET UP TO READ PROT ST BYTES JSB OUTAF LDB BUFP SETUP BUUUFER POINTER LDA DM8 SET COUNTER FOR EIGHT WORDS STA CNT JMP CX03A SKIP THE "STC" CX.03 JSB DIDL "STC" CX03A JSB WATE WAIT FOR FLAG JSB GETA GET TWO BYTES STA B,I STORE BY POINTER INB BUMP TH POINTER ISZ CNT DONE EIGHT? JMP CX.03 NO, GO AGAIN LDA EQT7,I YES, START BUILDING WORDS AND B360 MASK OFF REC. NAK COUNT ALF MOVE TO LEFT BYTE STA B SAVE IT LDA EQT7,I AND B17 MASK OFF XMIT. NAK COUNT IOR B MERG RECV. NAK CNT STA BUFF+3 PUT IT IN BUFFER LDA EQT7,I LETS DO WACK NOW AND B17.4 STA BUFF+4 PUT IT IN BUFFER LDA EQT7,I CHECK FOR BLOCK SIZE CHANGE AND B160K BIT 13-15 SZA,RSS SKIP IF ZERO JMP CX.04 ZERO, GO ON RAR,ALF MOVE TO LOW NIBB. CLB MPY D250 A*250 STA BUFF+2 PUT IN BUFFER CPA D1000 = 1000? ARS YES, DEV. BY 2 CMA,INA MAKE NEG. ADA D1025 STA BUFF+1 PUT IN BUFFER CX.04 LDA SPSBC SETUP TO RESTORE PROT. ST. BYTES. JSB OUTAF LDB BUFP SETUP POINTER LDA DM8 SETUP COUNTER STA CNT CX.05 JSB WATE WAIT FOR FLAG LDA B,I GET WORD JSB OUTA OUTPUT IT INB BUMP POINTER ISZ CNT DONE EIGHT? JMP CX.05 NO, GO AGAIN CLB SET XLOG = ZERO JMP RTNC0 YES, RETURN * * D1000 DEC 1000 D1025 DEC 1025 D250 DEC 250 DM8 DEC -8 SKP * * * DO MODEM CONTOL * * CX.06 LDA GSMC SEND MODEM CONT COMND JSB OUTAF JSB WATE WAIT FOR FLAG JSB GETA GET MODEM STATUS LDB EQT7,I GET OPT. PERAM. SZB,RSS NON ZERO? JMP CX.07 NO, SKIP NEXT CODE ERB TEST RATE SEL. BIT CONT. SEZ ASSERT RATE SELECT? "E"=1 AND CLBT0 YES, CLEAR BIT 0--ASERT RATE SEL. SLB DEASSERT RATE SEL.? "LSB"=1 IOR D1 YES, SET BIT 0--DEASSERT RATE SEL. RAR MOVE TO "DATA TER. READY" BIT. ERB,ERB MOVE TO NEXT BYTE PARE. SEZ ASSERT "DTR"? "E"=1 AND CLBT0 YES, CLEAR BIT 0--ASERT "DTR" SLB DEASSERT "DTR" "LSB"=1 IOR D1 YES, SET BIT 0 "DTR" RAL RETURN BITS TO PROPER POS. JSB OUTA SEND TO CARD CX.07 STA B SETUP TO RETURN STATUS AND B360 MASK OUT RATE BITS SWP SWAP CMA COMPLEMENT STATUS BITS AND CLRTB CLEAR RATE BITS IOR B RESTORE RATE BITS STA B PUT STATUS IN "B" REG. JSB WATE WAIT FOR FLAG JMP RTNC0 RETURN COMP * * CLRTB OCT 177417 CLBT0 OCT 177776 B360 OCT 360 SKP * * * NEXTX JSB EQ17C CLEAR STATE AND FLAGS JMP NEXT GO TO NEXT EQT * * NORMAL RETURNS START HERE. WE TRY TO GET ANOTHER POLL OR SELECT * STARTED IF WE CAN, BEFOR WE GO BACK TO THE SYSTEM. * RTNC0 JSB EQ17C CLEAR STATE AND ALL FLAGS BUT "AA" LDA EQT1 SAVE A PNT TO EQ1 FOR THE COMPLTED STA EQSV REQUEST STB BSV SAVE XLOG IN B LDA EQT5,I CHECK FOR "BREAK" AND BRKFL SZA,RSS EQ5-B4=1-->BREAK JMP NEXT NO, GO GET SOMETHING NEW STARTED LDA EQT12,I YES, CHECK FOR A "SCHEDUAL" AND B400 SZA,RSS EQ12-B8=1-->"BREAK-SCHEDUAL" JMP NEXT NO, GO GET SOMETHING NEW STARTED LDA BKTDC YES, SEND A 100 MS TIME OUT JSB OUTAF JMP RTC0X DO A COMPLETION RETURN RTC0C JSB SETEQ RESET EQT RTC0X CLA STA EQSV CLEAR PNT LDB BSV RESTORE B REG XLOG STA BSV CLEAR BSV RTCTO LDA SIGNB JMP C.07,I * * ERROR RETURNS ARE DONE HERE. * RTNCX AND B17 MASK LOW 4 BITS FOR ERROR CODE STA B IN "B" JSB EQ17C CLEAR STATE RTNC1 LDA EQT5,I EQT ACTIVE? SSA,RSS EQ5-B15=1? JMP NEXTX NO, FORGET IT AND ECM MASK OUT ERROR CODE IOR B SET NEW CODE STA EQT5,I LDA TORQC YES, SEND TIME OUT TO IFC JSB OUTAF CLA,INA IOR SIGNB CLB JMP C.07,I * * * BKTDC OCT 51776 100 MS TIME OUT SKP * * TIME OUT PROCESSING ROUTINES * DELTM NOP ROUTINE TO CHECK FOR ROLLOVER. LDA EQT14,I TIMER RUNNING? SSA,RSS EQT14<0-->TIMER WANTED JMP DELTM,I NO, RETURN LDA EQT16,I IF LINE EQT FORGET IT. SSA EQ16-B15=1-->LINE JMP DELTM,I LINE, RTEURN JSB GT$TM YES, GO GET CURRENT TIME. CMB NEXT STEPS CALC. THE DIFF. CMA,INA,SZA,RSS INB CLE ADA EQT9,I SEZ INB ADB EQT10,I CMB RESULT IS NEG. MAKE POS. ADB EQT14,I GREATER THAN EQ14-->TIMEOUT SSB JMP DELTM,I CLB YES, TIMEOUT--RTEURN ZERO LTH. REC. JMP RTNC0 * * * GT$TM NOP ROUTINE TO GET TIME LDA 2 IF LOC 2= HLT 2 WE ARE CPA HLT2 WE ARE IN THE SYSTEM MAP. JMP GT$T1 IN SYS. MAP USE "LDA-LDB" XLB $TIME IN USER MAP GO TO OTHER MAP XLA $TIME+1  TO GET $TIME VALUES. JMP GT$TM,I RETURN GT$T1 LDB $TIME GET $TIME VALUES. LDA $TIME+1 JMP GT$TM,I RETURN * * HLT2 OCT 102002 HALT 2 SKP * * * STEV--STATE EV. RETURN TO CALLER IF STATE EQ.0 * OR GO TO STATE CNT CODE. * * STEV NOP LDA EQT2,I TEST FOR A REQUE RUNNING SSA EQ2-B15=1-->REQUE RUNNING JMP RQON YES, GO TAKE CARE OF IT. LDA EQT17,I GET STATE SSA DMA FLAG SET? JMP STDMA YES, GO DO IT AND RBYTE EQT17 B0-7 ADA STTBP ADD STATE NUMBER TO STATE TABLE PNT LDA A,I GET POINTER JMP A,I GO WHERE POINTED STTBP DEF *+1 POINTER TO STATE TABLE ZE DEF STEV,I STATE .EQ. 0 RETURN TO CALLER PP DEF PSPOL STATE=1 PRE POLL (READ) PS DEF SELCC STATE=2 PRE SELECT (WRITE) PC DEF CNTX STATE=3 PRE CONT. (CONTROL) PO DEF POLL SE DEF SELCT UN DEF UNLOD LO DEF LOAD RE DEF RESP PL DEF LNRQ LINE REQUEST * * * REQUE FIXUP ROUTINE * * RQON JSB EQ17C CLEAR ANY POS STATE. LDA MIN1 SET SYSTEM TIMER FOR STA EQT15,I ONE TICK ON THIS EQT. JMP IDLE DO A IFC. TIME OUT. * * SYSTEM TIMEOUTS ARE DONE HERE. * WE IGNORE THEM. * TIMER LDA EQT4,I CLEAR BIT 11 OF EQT4 XOR B4.0K STA EQT4,I SKP * * CONTINUATION RETURNES ARE DONE HERE. * RTNCT LDA EQSV CHECK FOR COMPL. QUED UP SZA JMP RTC0C YES GO DO IT CLB SETUP TO CLEAR REL DMA FLAG. LDA RLFLG GET REL. DMA FLAG STB RLFLG LDB C.07 GET RETURN POINTER. INB BUMP TO CONTINUE. SZA REL DMA ? INB YES, BUMP IT ONCE MORE. JMP B,I RETURN * * RLFLG NOP 0-->NO REL, 6-->REL SKP * * ROUTINE TO OUTPUT THE A REG. TO THE CARD. * OUTA NOP IO.00 OTA 10B,C IO.01 STC 10B JMP OUTA,I * * ROUTINE TO OUTPUT COMMANDS TO THE CARD FROM THE A REG.. * OUTAF NOP IO.02 OTA 10B,C IO.03 STF 10B IO.04 STC 10B JMP OUTAF,I * * ROUTINE TO GET THE OUTPUT REG. OF THE CARD INTO THE A REG.. * GETA NOP IO.05 LIA 10B,C JMP GETA,I * * ROUTINE TO WATE FOR FLAGS FROM THE CARD. (MAX 100 US) * WATE NOP LDA WATET WATE FOR 100 US. IO.06 SFC 10B JMP WATE,I INA,SZA JMP IO.06 JSB EQ17C TIMED OUT-CLEAR STATE JSB STITE POINT INT. TAB TO THIS EQT LDA TORQC SEND A TIMEOUT RQ TO IFC JSB OUTAF LDA EQT5,I SET ALL ERROR BITS. IOR RBYTE STA EQT5,I JMP RTNCT DO CONT. RTN. * * ROUTINE TO DO A "STC" ON THE CARD. * DIDL NOP IO.07 STC 10B,C JMP DIDL,I * * WATET DEC -50 SKP * * * SETEQ ROUTINE--IF "A"#0 SET FULL EQT * =0 SET EQT EXT ONLY * SETEQ NOP SZA,RSS FULL EQT? JMP SETEX NO, GO SET EXT CPA EQT1 ALREADY SET? JMP SETEQ,I YES, EXIT STA EQT1 YES, SET EQT1 INA BUMP STA EQT2 INA STA EQT3 INA STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 INA STA EQT12 INA STA EQT13 INA STA EQT14 INA STA EQT15 SETEX LDA EQT13,I STA EQT16 SET EXT INA STA EQT17 INA STA EQT18 INA STA EQT19 INA STA EQT20 JMP SETEQ,I RETURN EQT16 NOP [L][ID .OR.ID.SEG.] EQT17 NOP 9 [D][B][S][O][A][LN][STATE] EQT18 NOP DMA WORD COUNT EQT19 NOP MEM ADD PNT EQT20 NOP LAST WD AVE MEM USER BUFF SKP * * * SETIO--SETUP IFC IO INST. * (IF NEEDED) * * SETIO NOP STA B SAVE SC IN B REG CMA,INA A<--(-A) ADA SC COMPUTE DIF FROM CURRENT SC SZA,RSS DIF=0? JMP SETIO,I YES, RETURN STB SC NO, SAVE NEW SC CMA,INA NEAGATE STA FIX SAVE DIFF LDB IOTBL SETUP TO MOD. INST. LDA NUMIO GET NUMBER OF INST TO MOD STA FIXC COUNT IN FIXC JSB SETI GO TO SET RTN JMP SETIO,I RETURN IOTBL DEF *+1,I DEF IO.00 DEF IO.01 DEF IO.02 DEF IO.03 DEF IO.04 DEF IO.05 DEF IO.06 DEF IO.07 DEF STD.0 NUMIO ABS IOTBL-*+1 * * * STDIO--DMA IO SETUP RTN * * STDIO NOP CHAN IN BP HAS NEW CHAN LDA CHAN GET NEW CHAN STA B CMA,INA A<--(-A) ADA CHANS COMPUTE DIFF FROM CURR CHAN SZA,RSS DIFF=0? JMP STDIO,I YES, RETURN STB CHANS NO, SAVE NEW CHAN CMA,INA NEAGATE STA FIX SAVE DIFF LDB DIOTB SET UP TO MOD LDA NMDIO GET NUMBER INTS TO MOD STA FIXC COUNT IN FIXC JSB SETI GO TO SET RTN JMP STDIO,I RETURN CHAN EQU 1673B DIOTB DEF *+1,I DEF ID.00 DEF ID.01 DEF ID.02 DEF ID.03 DEF ID.04 DEF ID.05 DEF ID.06 NMDIO ABS DIOTB-*+1 * * INST. MODE SUBROUTINE * SETI NOP SETL LDA B,I GET INTS. ADA FIX ADD DIFF STA B,I PUT IT BACK INB BUMP POINTER ISZ FIXC DONE? JMP SETL PNO, GO AGAIN JMP SETI,I YES, RETURN FIX NOP FIXC NOP * * * STITE-- CHANGE INT TAB ENT * * STITE NOP JSB INTEN COMPUTE ENT LDA EQT1 STA B,I EQT1-->PNT(B) JMP STITE,I RETURN INTBA EQU 1654B * * INTEN NOP GET INT ENT. LDB SC ADB BM6 ADB INTBA SC-6+INTBA LDA B,I GET ENT. JMP INTEN,I RET. * * BM6 OCT -6 SKP * * * RLDMA--RELEASE DMA * * RLDMA NOP LDA EQT3,I CHECK FOR NEW RTIOC SSA,RSS EQ3-B15=1-->NEW RTIOC JMP RL0 NO, GO ON LDB D6 YES, SET RLFLG TO 6 STB RLFLG JMP RLDMA,I RL0 LDA INTBA GET PNT TWO DMA INT STA TEMP DLD INTBA,I GET BOTH ENTS CPA EQT1 CH. B POINT TO ME? JMP RL1 YES, GO FIX IT ISZ TEMP BUMP PNT. CPB EQT1 CH. A POINT TO ME? JMP RL1 JMP RLDMA,I NONE, RETURN RL1 CLA STA TEMP,I CLEAR CH. A JMP RLDMA,I RETURN * * * STE17--SET STAT AND OR FLAG IN EQT17 * "E=1"-->CLEAR STATE FIRST * * STE17 NOP LDA EQT17,I GET EQT17 SEZ CLEAR STATE? AND LBYTE YES IOR B STA EQT17,I RESTORE JMP STE17,I RETURN * * * * EQ17C--CLEAR ALL BUT LN AND "AA" OF EQT17 * * EQ17C NOP LDA EQT17,I GET EQT17 AND B7.4K SAVE LN STA EQT17,I JMP EQ17C,I RETURN SKP * * * A EQU 0 B EQU 1 LTP DEF *+1 REP 8 NOP LTE DEF *-1 SC OCT 10 EQSV NOP BSV NOP CHANS OCT 6 SIGNB OCT 100000 LC OCT 20000 MIN1 DEC -1 MAXWC DEC 500 OBF OCT 100 DORE OCT 200 EOTF OCT 40 OBWF OCT 10000 TETBF OCT 40000 TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP LN EQU TEMP1 0.* ID EQU TEMP4 RETBF EQU TETBF CNT EQU TEMP SKP * * STATE * POLLS DEF PO-ZE SELCS DEF SE-ZE UNLOS DEF UN-ZE LOADS DEF LO-ZE RESPS DEF RE-ZE PLNRS DEF PL-ZE * * COMND * TORQC OCT 5776 PSCMD OCT 2000 UNL OCT 2002 LOADC OCT 2004 XMIT OCT 2006 RPSBC OCT 102002 SPSBC OCT 102004 SAXMC OCT 26000 TOB OCT 40000 TETB OCT 20000 STTOV OCT 1772 GSMC OCT 1774 * * * SP. CH. * * ZEOT OCT 4 ETXET OCT 1404 ETBET OCT 13404 CNYET OCT 14404 BDCC OCT 20176 BDCLC OCT 77000 WAY OCT 175 DLEET OCT 10004 DLE0 OCT 10060 DLE1 OCT 10061 WACK OCT 10073 BELL OCT 3407 RVI OCT 10074 QM OCT 42 ATSIG EQU TETBF URRER OCT 15 TIOOF OCT 16 * * D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 B10K OCT 10000 B160K OCT 160000 B17 OCT 17 B17.4 OCT 17400 LBYTE OCT 177400 ECM OCT 177760 B3.4K OCT 3400 B3.7K OCT 3700 RBYTE OCT 377 B400 OCT 400 B4.0K OCT 4000 B7.0K OCT 7000 B70K OCT 70000 B7.4K OCT 7400 B77 OCT 77 SSGNB OCT 77777 * * EQT1 EQU 1660B EQT2 EQU EQT1+1 EQT3 EQU EQT1+2 EQT4 EQU EQT1+3 EQT5 EQU EQT1+4 EQT6 EQU EQT1+5 EQT7 EQU EQT1+6 EQT8 EQU EQT1+7 EQT9 EQU EQT1+8 EQT10 EQU EQT1+9 EQT11 EQU EQT1+10 EQT12 EQU 1771B EQT13 EQU EQT12+1 EQT14 EQU EQT12+2 EQT15 EQU EQT12+3 * * BUFP DEF *+1 BUFF BSS 8 LENTH EQU * SKP END i0 ' 91730-18002 1805 S C0122 EXMP MULTIPOINT EXERSISER             H0101 HFTN4,L C NAME : EXMP--MULTIPOINT EXERSISER PROGRAM C SOURCE: 91730-18002 1805 C RELOC: 91730-16002 1805 C PROGMR: G.W.J. C C **************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C **************************************************************** C C PROGRAM EXMP(,),91730-16002 REV 1805 780117 DIMENSION IB(800),IBX(40),IIB(800),IHMXM(2) DATA IHMXM/15510B,15544B/ 1 CALL RMPAR(IB) C DETERMINE LIST LOGICAL UNIT NUMBER. IF ZERO SET TO LU 1. IWLU=IB(1) IF(IWLU.EQ.0)IWLU=1 ILU=IB(2) C DETERMINE LU TO BE TESTED. IF ZERO STOP. IF(ILU.EQ.0)STOP 0 C DETERMINE THE MAXIMUM NUMBER OF ERRORS TO BE REPORTED. NN=IB(3) C DETERMINE THE TEST BUFFER SIZE. IF ZERO SET TO 20 LINES. INL=IB(4) IF(INL.LE.0.OR.INL.GT.20)INL=20 IRP=IB(5) ICRLF=6412B CALL CODE C BUILD TEST LINE BUFFER OF 76 ALPHA NUMERIC CHARACTORS C TERMINATED WITH A CR/LF. TOTAL OF 78 CH. IN TEST LINE. WRITE(IBX,101)ICRLF 2 II=1 C BUILD TEST BUFFER BY WRITEING THE LINE NUMBER FOLLOWED BY THE C TEST LINE FOR A TOTAL OF UP TO 20 LINES. C 01,---TEST CH.---CR/LF02---TEST CH.---CR/LF03......... DO 1000 J=1,INL CALL CODE WRITE(IBZ,100)J IB(II)=IBZ 100 FORMAT(I2) II=II+1 101 FORMAT("ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" 1"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCD",A2) DO 500 I=1,39 IB(II)=IBX(I) II=II+1 500 CONTINUE 1000 CONTINUE C CALCULATE THE SIZE OF THE TRANSFER. ICNT=INL*80/2 C CLEAR ERROR DETECTED SW. 1500 IS=0 C TURN OFF ROUTINE POLLING AND SET TO STRIP "GS". T  CALL EXEC(3,ILU+2300B,140000B) C FORCE THE TERMINAL TO BLOCK MODE. WRITE(ILU,200) 200 FORMAT("&s1D") C TRANSMIT THE TEST BUFFER. CALL EXEC(2,ILU+3000B,IB,ICNT) C SEND A "HOME-UP" AND SYMULATED ENTER TO THE TERMINAL. CALL EXEC(2,ILU,IHMXM,2) C RECEVE THE TEXT FROM THE TERMINAL CALL EXEC(1,ILU,IIB,800) C COMPARE TEXT TRANSMITED WITH TEXT RECEVED A WORD AT A TIME. DO 5000 I=1,ICNT IF(IB(I).EQ.IIB(I))GO TO 5000 C IF A WORD DOES NOT COMPARE REPORT UP TO NN ERRORS ANS SET "IS". IS=IS+1 IF(NN.EQ.0)GO TO 5000 WRITE(IWLU,102)I,IB(I),IB(I),IIB(I),IIB(I) 102 FORMAT(1X,"WORD ",I3," SHOULD BE ",A2,1H[,@6,1H]," AND IS ",A2 1,1H[,@6,1H]) NN=NN-1 5000 CONTINUE C CLEAR EDIT MODE SWITCH AND REENABLE ROUTINE POLLING. 6000 CALL EXEC(3,ILU+2300B,0) C IN CASE "NN" WAS ZERO REPORT "NO ERRORS" IF "IS"=0 OR "ERRORS" IF C "IS"#0. C DONE IF(IS.NE.0)GO TO 90 WRITE(IWLU,103) 103 FORMAT(2X,"NO ERRORS") GO TO 98 90 WRITE(IWLU,104)IS 104 FORMAT(1X,I3,1X,"ERRORS") 98 CONTINUE IF(IRP.EQ.0)GO TO 99 CALL EXEC(12,0,2,0,-IRP) GO TO 1500 99 CONTINUE END END$ F   91730-18003 1805 S C0122 DSPMP MULTIPOINT DISPLAY PROGRAM            H0101 vFTN4,L C NAME : DSPMP--MULTIPOINT SYSTEM STATUS DISPLAY PROGRAM C SOURCE: 91730-18003 1805 C RELOC: 91730-16003 1805 C PROGMR: G.W.J. C C **************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C **************************************************************** C C PROGRAM DSPMP(,),91730-16003 REV 1805 780117 DIMENSION ILP(8) C C C DSPMP SCANS THE EQT'S TO FIND THE LINE CONTROL EQT FOR EACH LINE. C A MAXIMUM OF EIGHT LINES CAN BE REPORTED ON. AFTER LOCATING THE C LINE CONTROL EQT'S A REPORT IS MADE FOR THE LINE CONTROL EQT AND C THAN A REPORT IS MADE FOR EACH TERMINAL EQT ON THAT LINE. THE C LINKED LIST IS FOLLOWED TO LOCATE EACH OF THE TERMINAL EQT'S. C C GET THE LU ON TO WHICH THE REPORT IS TO BE MADE. CALL RMPAR(ILP) ILU=ILP(1) C IF NO LU WAS SUPPLIED USE LU 1. IF(ILU.EQ.0)ILU=1 C SETUP POINTERS TO THE EQT IFEQ=IGETX(1650B) INEQ=IGETX(1651B) C SETUP AN INDEX INTO A TABLE WHICH WILL HOLD THE EQT ADDRESS OF C EACH LINE CONTROL EQT. 1 I=1 IEQP=IFEQ C START SCANING THE EQT. DO 5 J=1,INEQ C CHECK FOR DRIVER TYPE 07. IP=IEQP+4 IV=IGETX(IP) IV=IAND(IV,37400B)/256 IF(IV.NE.07B)GO TO 5 C IF TYPE 07 THAN CHECK EQT11 TO SEE IF THIS EQT IS IN A LINKED LIST. IP=IP+6 IV=IGETX(IP) IF(IV.EQ.0)GO TO 5 C IF LINED THAN CHECK FOR BIT 15=1 IN EQT16. (LINE EQT?) IP=IP+2 IP=IGETX(IP) IV=IGETX(IP) IF(IV.GE.0)GO TO 5 C IF LINE EQT THAN MAKE AN ENTERY IN LINE TABLE. ILP(I)=IEQP C BUMP TABLE INDEX I=I+1 C BUMP TO THE NEXT EQT 5 IEQP=IEQP+15 C C C IF I=1 WE DID NOT FIND ANY LINES--STOP IF(I.EQ.1)GO TO 90 C PUT OUT A HEADING ON THE LIST DEVICE. WRITE(ILU,100) 100 FORMAT(1X,"LU EQ A DO OR ET BR EC ICW--- L ID PROG.",/ 1,1X,"EDIT MODE FL. WC- G DF BX SK OB AA RP STATE",/) C MAKE REPORTS ON EACH LINE FOUND DO 1000 II=1,I-1 ILEQ=ILP(II) IF(ILEQ.EQ.0)GO TO 1000 C MAKE A REPORT ON THE LINE CONTROL EQT CALL REPT(ILEQ,IFEQ,ILU) C GET THE LINKED LIST POINTER IP=ILEQ+10 10 IP=IGETX(IP) C IF WE ARE BACK TO THE LINE THAN TERMINATE REPORTING THIS LINE IF(IP.EQ.ILEQ)GO TO 1000 IF(IP.EQ.0)GO TO 1000 C MAKE A REPORT ON EACH TERMINAL EQT. CALL REPT(IP,IFEQ,ILU) IP=IP+10 GO TO 10 C GO TO THE NEXT LINE. 1000 CONTINUE GO TO 99 90 WRITE(ILU,101) 101 FORMAT(1X,"MULTIPOINT SYSTEM INACTIVE") 99 CONTINUE END SUBROUTINE REPT(IPP,IFEQ,ILU) DIMENSION IBF(40),INM(3),ISTB(4),ITB1(3),ITB2(3),ITB3(3) DATA ITB1/2HBU,2HFR,2HD / DATA ITB2/2HSY,2HST,2HM / DATA ITB3/2HCL,2HSI,2HO / C CALCULATE EQT NUMBER 1 IEQN=((IPP-IFEQ)/15)+1 C GET EQT5 IXX=IPP+4 IXX=IGETX(IXX) C DETERMINE AVAILABILITY STATUS IAV=0 IF(IAND(IXX,40000B).NE.0)IAV=IAV+1 IF(IAND(IXX,100000B).NE.0)IAV=IAV+2 C IF AV. ST.=0 SET PROGRAM NAME TO "-----". IF#0 GO CHECK "T" FIELD. IF(IAV.NE.0)GO TO 1000 400 DO 500 N=1,3 500 INM(N)=2H-- GO TO 4000 C GET EQT6 AND MASK OUT "T" FIELD. 1000 IXX=IPP+5 IXX=IGETX(IXX) IXX=IAND(IXX,140000B) C IF "T"=0 GO GET PROGRAM NAME AND MOVE IT TO NAME BUFFER. C IF "T"#0 GO CHECK "T" FIELD TYPE. (BUFFERD-CLASS IO-SYSTEM) IF(IXX.NE.0)GO TO 2000 C GET EQT1 IP=IGETX(IPP) C MASK OF BIT 15 IP=IAND(IP,77777B) C IF EQT1 B0-14=0 SET PGOGRAM NAME TO "-----" IF(IP.EQ.0)GO TO 400 C ADJUST TO NAME PORTION OF ID SEG. IPy =IP+12 C MOVE THE NAME. DO 1500 N=1,3 INM(N)=IGETX(IP) 1500 IP=IP+1 GO TO 4000 C DETERMINE "T" FIELD TYPE. 2000 ITF=0 IF(IAND(IXX,40000B).NE.0)ITF=ITF+1 IF(IAND(IXX,100000B).NE.0)ITF=ITF+2 C MOVE "T" FIELD TYPE NAME TO PROG. BUFFER GO TO (2100,2200,2300)ITF 2100 DO 2150 N=1,3 2150 INM(N)=ITB1(N) GO TO 4000 2200 DO 2250 N=1,3 2250 INM(N)=ITB2(N) GOTO 4000 2300 DO 2350 N=1,3 2350 INM(N)=ITB3(N) 4000 CONTINUE C GET EQT4 IP=IPP+3 IXX=IGETX(IP) C GET SELECT CODE (CH) AND UNIT NUMBER FROM EQ4 ICH=IAND(IXX,77B) IUN=IAND(IXX,3700B)/64 IP=IP+1 C SCAN LU TABLE FOR THIS EQT NUMBER AND UNIT NUMBER. JJ=IGETX(1652B) JM=IGETX(1653B) DO 5 J=1,JM JX=IGETX(JJ) JEQ=IAND(JX,77B) C EQT NUMBER = THIS EQT? IF(JEQ.NE.IEQN)GO TO 4 C IF = AND THIS EQT IS ACTIVE CHECK THE UNIT NUMBER FOR A MATCH. IF(IAV.EQ.0)GO TO 10 JUN=IAND(JX,77000B)/4096 IF(IAND(JX,100000B).NE.0)JUN=JUN+8 IF(JUN.EQ.IUN)GO TO 10 4 JJ=JJ+1 5 CONTINUE C IF NO LU FOUND SET LU TO 0 ILUN=0 GO TO 15 C IF INACTIVE SET LU TO THE FIRST LU FOUND POINTING TO THIS EQT 10 ILUN=J 15 CONTINUE C GET EQ5 IXX=IGETX(IP) C BUILD STATUS FROM EQ5 IST=IAND(IXX,377B) C PRESET SATATUS FLAGS TO "--" DO 16 I=1,4 16 ISTB(I)=2H-- C CHECK FOUR FLAGS AND SET APROP. IF(IAND(IST,200B).NE.0)ISTB(1)=2HDO IF(IAND(IST,100B).NE.0)ISTB(2)=2HOB IF(IAND(IST,40B).NE.0)ISTB(3)=2HET IF(IAND(IST,20B).NE.0)ISTB(4)=2HBR C SET ERROR CODE IN LOW 4 BITS/ IST=IAND(IST,17B) C GET EQ6 (REQUEST CONTROL WORD) IP=IP+1 ICW=IGETX(IP) C GET EQ9 (IPRAM1) IP=IP+3 IP1=IGETX(IP) C IF EQ9=0 SET TO "--" IF(IP1.EQ.0)IP1=2H-- C PRESET "RP" FLAG TO "RP" IRP=2HRP C GET EQ12 IP=IP+3 @ IXX=IGETX(IP) C IF EQ12 BIT 15=1 SET "RP" FLAG TO "--" IF(IXX.LT.0)IRP=2H-- C PRESET SEVEN EDIT MODE FLAGS TO "--" IGF=2H-- ILF=2H-- ICF=2H-- IHF=2H-- IXF=2H-- INF=2H-- ISF=2H-- C CHECK EACH FLAG AND SET APROP. IF(IAND(IXX,40000B).NE.0)IGF=2HR- IF(IAND(IXX,20000B).NE.0)ILF=2HL- IF(IAND(IXX,10000B).NE.0)ICF=2HC- IF(IAND(IXX,4000B).NE.0)IHF=2HH- IF(IAND(IXX,2000B).NE.0)IXF=2HX- IF(IAND(IXX,1000B).NE.0)INF=2HN- IF(IAND(IXX,400B).NE.0)ISF=2HS- C GET EQ16 (ID OR ID SEG.) IP=IP+1 IP=IGETX(IP) C SET ID = TO EQ16 ID=IGETX(IP) C IF ID<0-->LINE EQ. SET ID= TO SELECT CODE CONV. TO ASCII. C IF ID = ID FORCE IP1 TO "--" IF(ID.GT.0)IP1=2H-- IF(ID.LT.0)CALL CNVSC(ICH,ID) C GET EQ17 IP=IP+1 IXX=IGETX(IP) C PRESET DMA FLAG TO "--" IDMA=2H-- C IF DMA FLAG SET SET TO "DF" IF(IXX.LT.0)IDMA=2HDF C PRESET "BX" FLAG TO "EX"--ETX IBX=2HEX C IF "BX" FLAG SET SET TO "EB"--ETB IF((IAND(IXX,40000B)).NE.0)IBX=2HEB C PRESET "SK" FLAG TO "--" ISK=2H-- C IF "SK" FLAG SET SET TO "SK" IF((IAND(IXX,20000B)).NE.0)ISK=2HSK C PRESET "OB" FLAG TO "--" IOB=2H-- C IF FLAG SET SET TO "OB" IF((IAND(IXX,10000B)).NE.0)IOB=2HOB C PRESET "AA" FLAG TO "--" IAA=2H-- C IF FLAG SET SET TO "AA" IF((IAND(IXX,4000B)).NE.0)IAA=2HAA C GET LINE NUMBER ILN=IAND(IXX,3400B)/256 C GET STATE ISTE=IAND(IXX,377B) C GET EQ18 (DMA WORD COUNT) IP=IP+1 C MASK OFF HIGH BITS IWC=IAND((IGETX(IP)),7777B) C CHECK INTERRUPT TABLE TO SEE IS IT IS POINTING TO THIS EQT. IP=ICH-6+IGETX(1654B) IP=IGETX(IP) C IF NOT POINTING HERE SET POINTER TO " " IAP=2H C IF POINTING HERE SET POINTER TO "< " IF(IP.EQ.IPP)IAP=2H< C WRITE THE REPORT ON THE LIST DEVICKE. WRITE(ILU,100)ILUN,IEQN,IAV,ISTB(1),ISTB(2),ISTB(3),ISTB(4),IST 1,ICW,ILN,ID,INM(1),INM(2),INM(3),IAP WRITE(ILU,101)IGF,ILF,ICF,IHF,IXF,INF,ISF,IWC,IP1,IDMA,IBX,ISK 1,IOB,IAA,IRP,ISTE 100 FORMAT(1X,I2,1X,I2,1X,I1,1X,A2,1X,A2,1X,A2,1X,A2,1X,@2,1X 1,@6,1X,I1,1X,1A2,1X,2A2,1A1,1X,A1) 101 FORMAT(1X,6A2,1A1,1X,I3,1X,A1,1X,A2,1X,A2,1X,A2,1X,A2,1X 1,A2,1X,A2,1X,@3,/) RETURN END END$ %   91730-18004 1805 S C0122 CNVSC SUBROUTINE CALLED BY DSPMP            H0101 uASMB,L * NAME : CNVSC-- SUBROUTINE CALLED BY DSPMP * SOURCE: 91730-18004 1805 * RELOC: 91730-16004 1805 * PROGMR: G.W.J. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM CNVSC,7 91730-16004 REV 1805 771219 ENT CNVSC,IGETX EXT $OPSY EXT .ENTR A EQU 0 B EQU 1 SC NOP ID NOP * * CNVSC NOP JSB .ENTR DEF SC LDA SC,I CLB DIV D8 ADB B60 STB SC CLB SZA DIV D8 ADB B60 BLF,BLF ADB SC STB ID,I JMP CNVSC,I * * * IGETX--SPECIAL IGET ROUTINE FOR BOTH RTE-II/III AND IV. * * IGETX NOP DLD IGETX,I SWP LDA A,I STB IGETX LDB $OPSY CPB DM9 JMP RTE4 LDA A,I JMP IGETX,I RTE4 XLA A,I JMP IGETX,I D8 DEC 8 B60 OCT 60 DM9 DEC -9 END h  91730-18005 1926 S C0122 &XLIB MULTIPOINT PERIPHERAL             H0101 *9ASMB,L,C * NAME : XLIB --MULTIPOINT PERIPHERAL SUBROUTINES * SOURCE: 91730-18005 1926 * RELOC: 91730-1X005 1926 * PROGMR: G.W.J. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * HED 2645 MP PERIPHERAL SUBROUTINES (XLIB) 05-08-79 1625 &XLIBX NAM XLIB,7 91730-1X005 REV 1926 PT. OF 91730-12001 790508 ENT XREAD,XWRIT,XCONT EXT .ENTR,EXEC * A EQU 0 B EQU 1 ILU NOP UN NOP IBF NOP IBL NOP ICN EQU IBF IRP EQU IBL * EXITP NOP PERAMATER MOVER AND EXIT MOVE JSB .ENTR MOVE THEM DEF ILU JMP START CONTINUE * XREAD NOP LDA XREAD MOVE EXIT POINTER STA EXITP LDB =B1 SET REQUEST TYPE STB RQ JMP MOVE START SETUP * XWRIT NOP LDA XWRIT MOVE EXIT POINTER STA EXITP LDB =B2 SET REQUEST TYPE STB RQ JMP MOVE START SETUP * XCONT NOP LDA XCONT MOVE EXIT POINTER STA EXITP LDB =B3 SET REQUEST TYPE STB RQ JMP MOVE START SETUP SKP * * R=XREAD(ILU,IUN,IBF,IBL) * WHERE: ILU=THE LOGICAL UNIT NUMBER OF THE TERMINAL * IUN=THE UNIT NUMBER OF THE PERIPHERAL ON THE 2645 * IBF=THE ADDRESS OF THE BUFFER * IBL=THE LENGTH OF IBF(MAX OF -256 CH. OR 128 WD.) * ON RETURN: * "A"=0...REQUEST COMPLETE * "A" NOT 0...ERROR STATUS * "B"=TRANSMITTION LOG OR ZERO IF ERROR * * NOTE: IF IBF IS NEGATIVE STATUS ONLY WILL BE TAKEN AND RETURNED * IN THE "A" REG.. * * STATUS:  CTU PRINTER * * BIT 15...REQUEST ERROR REQUEST ERROR * 14...MP ERROR MP ERROR * 13...BUF. LTH.>128 OR 256 BUF. LTH.>128 OR 256 * 12...BUFF LENGTH = 0 BUFF LENGTH = 0 * 11...END OF FILE UNASSIGNED * 10...LOAD POINT UNASSIGNED * 9...END OF TAPE (EOT) PAPER OUT * 8...WRITE ERROR PRINT ERROR * 7...COMMAND PERFORMED COMMAND PERFORMED * 6...WRITE PROTECTED UNASSIGNED * 5...READ ERROR UNASSIGNED * 4...TAPE BUSY PRINTER BUSY * 3...SOFT ERROR * 2...HARD ERROR BITS 1-3= PRINTER BAUD RATE * 1...END OF VALID DATA * 0...TAPE INSERTED PRINTER CONNECTED * * SKP * * R=XWRIT(ILU,IUN,IBF,IBL) * WHERE: ILU=THE LOGICAL UNIT NUMBER OF THE TERMINAL * IUN=THE UNIT NUMBER OF THE PERIPHERAL ON THE 2645 * IBF=THE ADDRESS OF THE BUFFER * IBL=THE LENGTH OF IBF(MAX OF -256 CH. OR 128 WD.) * ON RETURN: * "A"=0...REQUEST COMPLETE * "A" NOT 0...ERROR STATUS * "B"=TRANSMITTION LOG OR ZERO IF ERROR * * NOTE: IF IBF IS NEGATIVE STATUS ONLY WILL BE TAKEN AND RETURNED * IN THE "A" REG.. * * STATUS: CTU PRINTER * * BIT 15...REQUEST ERROR REQUEST ERROR * 14...MP ERROR MP ERROR * 13...BUF. LTH.>128 OR 256 BUF. LTH.>128 OR 256 * 12...BUFF LTNGTH = 0 BUFF LENGTH = 0 * 11...END OF FILE UNASSIGNED * 10...LOAD POINT UNASSIGNED * 9...END OF TAPE (EOT) PAPER OUT * 8...WRITE ERROR PRINT ERROR * 7...COMMAND PERFORMED COMMAND PERFORMED * 6...WRITE PROTECTED UNASSIGNED * 5...READ ERROR UNASSIGNED * 4...TAPE BUSY PRINTER BUSY * 3...SOFT ERROR * 2...HARD ERROR G BITS 1-3 = PRINTER BAUD RATE * 1...END OF VALID DATA * 0...TAPE INSERTED PRINTER CONNECTED SKP * * R=XCONT(ILU,IUN,ICN,IRP) * WHERE: ILU=THE LOGICAL UNIT NUMBER OF THE TERMINAL * IUN=THE UNIT NUMBER OF THE PERIPHERAL ON THE 2645 * ICN=THE CONTROL CODE TO BE EXECUTED * IRP=THE NUMBER OF TIMES THE REQUEST IS TO BE REPETED * ON RETURN: * "A"=0...REQUEST COMPLETE * "A" NOT 0...ERROR STATUS * "B"=TRANSMITTION LOG OR ZERO IF ERROR * * NOTE: IF ICN IS NEGATIVE STATUS ONLY WILL BE TAKEN AND RETURNED * IN THE "A" REG.. * * STATUS: CTU PRINTER * * BIT 15...REQUEST ERROR REQUEST ERROR * 14...MP ERROR MP ERROR * 13...REP. CNT.>999OO LARGE A REP. CNT.>999 * 12...FUNCTION CODE TOO BIG. FUNCTION CODE TOO BIG * 11...END OF FILE UNASSIGNED * 10...LOAD POINT UNASSIGNED * 9...END OF TAPE (EOT) PAPER OUT * 8...WRITE ERROR PRINT ERROR * 7...COMMAND PERFORMED COMMAND PERFORMED * 6...WRITE PROTECTED UNASSIGNED * 5...READ ERROR UNASSIGNED * 4...TAPE BUSY PRINTER BUSY * 3...SOFT ERROR * 2...HARD ERROR BITS 1-3 = PRINTER BAUD RATE * 1...END OF VALID DATA * 0...TAPE INSERTED PRINTER CONNECTED SKP START LDA ILU,I SETUP READ LU LDB RQ AND =B77 IOR =B400 FORCE "CR-LF-RS" STRIP STA RLU AND =B77 SETUP WRITE LU IOR =B100 STA WLU LDA PUN SETUP UNIT NUMBER IOR UN,I STA SWTCH+1 * * * CPB =B3 DOING A CONT. RQ? JMP XC.00 YES, GO ON JMP CKBFS NO, GO CHECK BUFF DIM SKP * XC.00 LDA ICN,I GET FUNCTION CODE SSA FC<0-->PULL STATUS ONLY. JMP STAT YES, GO DO IT. LDA IRP,I REP. CNT.? SZA,RSS JMP XC.03 NO, GO ON LDB UPOS DEF. TO POSITIVE SSA,RSS NEG. REP. CNT.? JMP XC.01 NO, GO ON CMA,INA MAKE POS. LDB UNEG GET NEG. SIGN XC.01 STB SWTCH+2 PUT "U"-SIGN IN SWITCH BUF STA B LEAGLE REP. COUNT CMB,INB ADB MXCC SSB,RSS TOO BIG JMP XC01A NO, GO ON JMP ER2 YES, ERROR XC01A LDB ZZ PRESET SWTCH STB SWTCH+3 CLB CLEAR "B" FOR DIV DIV D10 DEVIDE A BY 10 BLF,BLF MOVE TO LEFT BYTE ADB ZP ADD RES. IN "B"TO "60"-"P" STB SWTCH+4 SZA,RSS "A"=0? JMP XC.02 YES, DONE CLB NO, CLEAR "B" FOR NEXT CONV DIV D10 ADB SWTCH+3 ADD RES. STB SWTCH+3 SZA,RSS "A"=0? JMP XC.02 YES, DONE ALF,ALF ADA SWTCH+3 NO, ADD RES. IN "A"TO SWTCH+3 STA SWTCH+3 XC.02 LDA ICN,I SET UP CONT. FUNCTION ALF,ALF IOR SIXC STA SWTCH+5 LDA DM12 SET CH. CNT. STA CNT JMP SEND GO ON * * XC.03 LDA DM7 SET CH. CNT. STA CNT LDA ICN,I SET UP CONT. FUNCTION IOR U60 STA SWTCH+2 LDA CAPC PUT CAP. "C" IN SWTCH STA SWTCH+3 JMP SEND SKP * * CKBFS LDA IBL,I CHECK FOA BUFF. LTH. OF 0 SZA,RSS JMP ER1 YES, ERROR SSA WORDS OR CH. JMP CC CH. GO TO CH. CHECK CMA,INA CHECK TOO BIG ADA MXW SSA,RSS JMP XR.01 OK, GO ON JMP ER2 TOO BIG ERROR CC ADA MXC CHECK TOO BIG SSA,RSS JMP XR.01 OK, GO ON JMP ER2 TOO BIG ERROR * * XR.01 CPB =B2 DOING A WRITE? JMP XW.01 YES, GO TO WRITE SETUP LDA ILU,I MUST BE DOING A READ AND =B100 SETUP READ CODE IN SWTCH STA B LDA S60 "S"-"0" SZB IF "M"BIT SET IN CALL IOR =B2 FOCE TO A "2" STA SWTCH+2 LDA R SET "R" IN SWTCH STA SWTCH+3 LDA DM7 SET FOR A COUNT OF 7 STA CNT JMP SEND GO SEND SWTCH SKP * * XW.01 LDB UN,I PUT UNIT NUMBER IN B LDA IBL,I SET UP TO CONV TO ASCII SSA,RSS CH.? RAL NO, A<--A*2 SSA CH.? CMA,INA MAKE POS. STA CCNT SAVE POS CH. CNT. CPB D4 UNIT=4? (PRINTER) ADA =D2 YES, ADD TWO FOR CR/LF LDB DC0 PRESET SWTCH STB SWTCH+2 LDB ZZ STB SWTCH+3 CLB CLEAR "B" FOR DIV DIV D10 DEVIDE A BY 10 ADB SWTCH+3 ADD RES. IN "B"TO SWTCH+3 STB SWTCH+3 SZA,RSS "A"=0? JMP XW.02 YES, DONE CLB NO, CLEAR "B" FOR NEXT CONV DIV D10 BLF,BLF MOVE TO LEFT BYTE ADB SWTCH+3 ADD RES. STB SWTCH+3 SZA,RSS "A"=0? JMP XW.02 YES, DONE ADA SWTCH+2 NO, ADD RES. IN "A"TO SWTCH+2 STA SWTCH+2 XW.02 LDB UN,I CHECK FOR PRINTER LDA CCNT ADA D9 ADD 9 TO COUNT FOR SWITCH CPB D4 UNIT= PRINTER? ADA =D2 YES, ADD 2 FOR CR/LF CMA,INA NEG. STA CNT LDA W SET A "W" IN SWTCH STA SWTCH+4 LDA IBF SET UP FOR BYTE MOVE RAL CH. ADD LDB SWP CCE SET "E" FORCE RIGHT BYTE ELB CH. ADD START IN RIGHT BYTE MBT CCNT MOVE BYTES LDA UN,I SETUP WLU CPA D4 UNIT .EQ. LINE PRINTER JMP XW.03 YES, GO ADD CRLF JMP SEND NO GO SEND IT XW.03 LDA LFCRp MOVE CRLF INTO BUFF SBT ALF,ALF SBT SKP * * SEND JSB EXEC SEND SWTCH DEF *+4+1 DEF D2 DEF WLU DEF SWTCH DEF CNT JMP MPER MP ERROR SZB,RSS XLOG=0? JMP STAT YES, GO PULL STATUS LDA RQ DOING A READ? CPA =B1 YES, GO GET DATA JMP XR.02 JSB EXEC GET WRITE RESP. CH. DEF *+4+1 DEF D1 READ DEF RLU DEF XSTBF DEF DM1 1 CH. JMP MPER MP ERROR SZB,RSS GET A CH.? JMP STAT NO GO GET STATUS LDA XSTBF CHECK CH. AND =B177400 CPA ASCS =S JMP XW02A YES, DO COMPLETION JMP STAT NO, GET STATUS XW02A CLB LDA RQ DOING A CONT. CPA =B3 JMP CL.01 YES, RETURN XLOG=0 LDB IBL,I BUILD A XLOG SSB WORDS.OR.CH.? CMB,INB CH. MAKE POSITIVE CL.01 CLA CLEAR STAT IN "A" JMP EXITP,I RETURN SKP * * XR.02 LDA ILU,I BINARY READ? AND =B100 SZA JMP XR.03 YES, GO DO IT XR02A JSB EXEC NO, DO READ INTO USER BUF DEF *+4+1 DEF D1 DEF RLU DEF IBF,I DEF IBL,I JMP MPER SZB,RSS XLOG=0? JMP STAT YES, PULL STATUS CLA NO, RETURN JMP EXITP,I * * XR.03 JSB EXEC READ INTO TEMP BUF DEF *+4+1 DEF D1 DEF RLU DEF RBUF DEF MXWP2 JMP MPER SZB,RSS XLOG=0? JMP STAT YES, PULL STATUS ADB DM2 SUB. 2 FOR BC ON REC. STB BSV SZB,RSS ANY DATA? JMP XR02A NO, ERROR - TRY TO GET DATA LDA RBUFP SETUP TO MOVE LDB IBF MVW BSV NOP LDB BSV CLA JMP EXITP,I RETURN SKP * * STAT LDA STATC SX*($ETUP SWTCH STA SWTCH+2 JSB EXEC SEND STAT RQ. DEF *+4+1 DEF D2 DEF WLU DEF SWTCH DEF DM5 JMP MPER MP ERROR JSB EXEC GET STAT BYT DEF *+4+1 DEF D1 DEF RLU DEF XSTBF DEF DM7 JMP MPER MP ERROR LDA XSTBF+2 BUILD STATUS WORD AND =B17 ALF STA B LDA XSTBF+2 AND =B7400 IOR B STA B LDA XSTBF+3 AND =B7400 ALF,ALF IOR B CLB JMP EXITP,I SKP * * ER1 LDA ER1C SET STATUS TO ER1 CLB SET XLOG=0 JMP EXITP,I RETURN ER2 LDA ER2C SET STATUS TO ER2 JMP ER1+1 CONT. MPER LDA MPEC SET BIT 15,14 JMP ER1+1 RQ NOP ER1C OCT 110000 ER2C OCT 120000 MPEC OCT 140000 MXW DEC 128 MXWP2 DEC 130 MXC DEC 256 MXCC DEC 999 D1 OCT 100001 READ NO ABORT D2 OCT 100002 WRITE NO ABORT D4 DEC 4 RLU NOP WLU NOP D9 DEC 9 D10 DEC 10 CNT NOP CCNT NOP PUN OCT 70060 UPOS OCT 072453 UNEG OCT 072455 ZP OCT 030160 SIXC ASC 1,0C U60 OCT 072460 CAPC ASC 1,CC R ASC 1,RR W ASC 1,WW S60 OCT 071460 STATC OCT 057000 DM1 DEC -1 ASCS OCT 051400 DC0 OCT 062060 ZZ ASC 1,00 LFCR OCT 005015 SWP DEF SWTCH+4 DM2 DEC -2 DM5 DEC -5 DM7 DEC -7 DM12 DEC -12 BSV NOP RBUFP DEF RBUF+2 SWTCH OCT 15446 NOP NOP NOP OCT 053400 RBUF BSS 128 XSTBF BSS 4 END 4w*   91730-18008 1901 S C0122 MULTIPOINT POWER-FAIL SUBROUTINE             H0101 ASMB,L,C * NAME : FIXMP--MULTIPOINT POWER-FAIL FIXUP SUBROUTINE * SOURCE: 91730-18008 1901 * RELOC: 91730-16008 1901 * PROGMR: G.W.J. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * NAM FIXMP,7 91730-16008 REV 1901 781026 ENT FIXMP EXT $LIBR,$LIBX A EQU 0 B EQU 1 * * FIXMP NOP JSB $LIBR TURN OFF MEMORY PRT. NOP LDA 1651B GET THE NUMBER OF EQT'S CMA,INA MAKE NEG. STA CNT PUT IN COUNTER LDB 1650B GET POINTER TO EQT'S STB PNT PUT IN POINTER LP ADB =D3 GET EQ4 LDA B,I STA SC SAVE IT INB BUMP TO EQ5 LDA B,I GET EQ5 AND =B37400 MASK DRIVER TYPE CPA =B3400 COMP. DV TYPE 7 RSS YES, GO ON JMP NEXT NO, GO TO NEXT EQT ADB =D6 BUMP TO EQ11 LDA B,I GET EQ11 SZA,RSS NON ZERO (ACTIVE)? JMP NEXT NO, GO TO NEXT EQT ADB =D2 BUMP TO EQ13 LDA B,I GET EQ13 LDA A,I GET FIRST WOR OF EXT SSA,RSS BIT 15 SET? LINE EQ? JMP NEXT NO, GO TO NEXT EQT LDA SC BUILD STC INST AND =B77 IOR STFC FORCE THE IFC TO RUN STA I.00 ITS DIAGNOSTIC AGAIN. IOR CLCC STA I.01 XOR STCC STA I.02 I.00 NOP --HERE IS WHERE WE DO IT I.01 NOP I.02 NOP NEXT ISZ CNT DONE ALL EQT'S? JMP NEX1 NO GO ON ISZ FIXMP BUMP RETURN POINT. JSB $LIBX    YES, ON MEMORY PRT. DEF FIXMP AND RETURN NEX1 LDB PNT PUMP PNT TO NEXT EQT ADB =D15 STB PNT JMP LP DO IT ALL AGAIN * * CNT NOP PNT NOP SC NOP STFC OCT 102100 STF COMMAND TO IFC CLCC OCT 4600 MAKE STC INTO CLC STCC OCT 5000 MAKE CLC INTO STC,C END l   91730-18009 1926 S C0122 &AUTO7 MULTIPOINT POWER FAIL             H0101 TASMB,R,L,C * NAME : AUTO7 * SOURCE: 91730-18009 1926 * RELOC: 91730-16009 1926 * PROGMR: G.W.J. BASED ON RTEM E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * * * NOTE: THE ENTRY POINT "XLUEX" IS PROVIDED FOR INTERNAL USE * ONLY. HEWLETT-PACKARD RESERVES THE RIGHT TO REMOVE OR * MODIFY THE CALLING SEQUENCE OR PARAMETER MEANINGS. THE * "XLUEX" CALLING SEQUENCE IS IDENTICAL TO "EXEC" EXCEPT * IN THE CONTROL WORD DEFINITION. * * EXEC CONTROL WORD: ONE WORD PARAMETER DEFINING LOGICAL UNIT * AND FUNCTION CODE. * * XLUEX CONTROL WORD: TWO WORD PARAMETER USED TO DEFINE: * * WORD 1>LOGICAL UNIT (BITS 7-0) * WORD 2>FUNCTION CODE (BITS 10-6) * * THE FUNCTION CODE FIELD IS IDENTICAL TO THE FUNCTION * CODE FIELD DEFINED FOR STANDARD EXEC I/O REQUESTS. * * * HED POWER FAIL RESTART RTN. FOR MULTIPOINT NAM AUTOR,1,1 91730-16009 REV.1926 790206 EXT EXEC,FIXMP,XLUEX * A EQU 0 B EQU 1 * AUTOR NOP ENTRY/TEMPORARY STORAGE JSB FIXMP RESTART MP SYSTEM DEF *+1 * CLA,INA RESET LU# TO STA PLU 1 FOR THIS ENTRY * SRCH JSB XLUEX *SEARCH EQT FOR DVR43* DEF *+5 ERROR RETURN DEF ICODE REQUEST CODE DEF PLU LU# FOR STATUS CALL DEF EQT5 BUF LOCATION DEF EQT4 BUF LOCATION JMP BDLU ERROR ROUTINE * LDA EQT5 AND EMASK MASK OUT STATUS AND AV. KW CPA .43 TEST FOR POWER FAIL DRIVER JMP BDLU1 FOUND DVR43-GO CHECK FOR SC=4 BDLU LDA PLU NOT DVR43--GO TRY AGAIN CPA MAXLU TEST FOR END OF LU#S JMP NO.LU YES-POWER FAIL DRIVER NOT FOUND INA NO-CONTINUE SEARCH--BUMP LU STA PLU SAVE LU# FOR EXEC CALL JMP SRCH * BDLU1 LDA EQT4 GET EQT4 AND B77 MASK TO GET SC CPA B4 SC=4-->POWER FAIL JMP GTIME FOUNF POWER FAIL LU GO GET TIME OF P/F JMP BDLU NO, GO SERCH SOME MORE. * * * * POWER FAIL DRIVER NOT FOUND * NO.LU JSB EXEC DEF *+5 DEF .2 DEF .1 DEF NOBUF DEF NBL CLA STA PLU SET P/F LU. TO 0 FOR SECOND CALL JMP SCAN * * * POWER FAIL DRIVER FOUND * REQUEST READ TO * OBTAIN TIME * GTIME JSB XLUEX DEF GT2 RETURN DEF .1 READ DEF PLU LU OF P/F DRIVER DEF TIME TIME BUFFER DEF .3 BUFFER LENGTH * * * GT2 LDA TIME *CONVERT TIME FOR PRINTING* LDB TIME+1 CLE CLEAR E FOR ADDITION ADA PRS1 ADD POSITIVE 24 HRS. SEZ TO GET A POSITIVE INB TIME ADB PRS2 DIV .6000 DIVIDE BY 6000 STA BUF1 TEMPORARY STORAGE FOR MIN/HRS ASR 16 POSITION B(SEC/10MS) FOR DIVIDE DIV .100 DIVIDE BY 100 TO GET SEC/10MS STB BUF4 SET 10MS VALUE STA BUF3 SET SECONDS VALUE CLB CLB FOR DIVIDE LDA BUF1 GET MIN/HRS DIV .60 SEPARATE STB BUF2 SET MIN LDB R.BUF SET BUFFER AREA POINTER STB TEMP1 FOR THIS CONVERSION LDB N4 SET CONVERSION COUNTER STB TEMP2 * * BACK JSB CNVRT GO CONVERT TO ASCII STA TEMP1,I SAVE IN OUTPUT BUFFER ISZ TEMP2 TEST FOR END OF CONVERSION RSS a JMP DA.YR GO CONVERT DAY AND YEAR ISZ TEMP1 BUMP OUTPUT POINTER ISZ TEMP1 LDA TEMP1,I GET NEXT VALUE JMP BACK GO CONVERT NEXT VALUE * DA.YR LDA TIME+2 FETCH DAY AND YEAR CLB DIV D365 GET YEAR CCE,INB INCRE (B) FOR DAY 0 CORRECTION ADA YEAR1 SET YEAR INTO BUFFER STA YEAR SAVE FOR PRINTING ASR 16 PREPARE TO GET DAY DIV .100 GET HUNDREDS IOR BLK0 STA DAY SAVE IN PRINT BUFFER ASR 16 JSB CNVRT GO GET TENS AND ONES STA DAY+1 SAVE IN PRINT BUFFER LDA YEAR CONVERT YEAR TO ASCII JSB CNVRT STA YEAR * * * * SCAN EQT FOR ALL TTY DEVICES (DVR00) * AND ISSUE WRITE REQUEST (POWER FAIL * TIME MESSAGE ) TO EACH * * * SCAN CLA,INA SET LU#. TO STA TLU 1 FOR SEARCH OF EQT SCAN2 JSB XLUEX DEF *+6 ERROR RETURN POINT DEF ICODE REQUEST CODE DEF TLU LU# FOR STATUS TEST DEF EQT5 BUF LOCATION DEF TIME DUMMY LOCATION FOR EQT4 DEF SUBCH SUBCHANNEL INFO RETURNED HERE JMP BAD LU NOT ASSIGNED-GO TEST NEXT LU * LDA EQT5 FETCH EQT5 AND EMASK GET RID OF STATUS AND AV. SZA,RSS TEST FOR DVR00 JMP PRINT FOUND DVR00 GO PRINT P/F MESSAGE CPA DVR05 IS IT DVR05? JMP SBCHK CHECK SUBCHANNEL TO BE SURE IT IS CRT CPA DVR07 CHECK FOR DRIVER TYPE 07 JMP LINCK CHECK FOR LINE EQT BAD LDA TLU NOT DVR00-CONTINUE CPA MAXLU TEST FOR END OF SCAN JMP DONE YES-GO RESET POINTERS AND CONSTANTS-EXIT INA NO-BUMP LU# STA TLU SET LU# FOR NEXT TEST JMP SCAN2 GO TEST NEXT LU * SBCHK LDA SUBCH IT'S DVR05, IS IT CRT? AND B37 SZA JMP BAD NO JMP PRINT YES, PRINT THE MESS. * * RO]UTINE TO LOCATE MULTIPOINT LINE LU'S. * LINCK LDA TLU GET EQT NUMBER FROM DRT ADA DM1 ADA 1652B LDA A,I AND B77 MASK LOW SIX BITS ADA DM1 CALC. EQT ADD. MPY .15 ADA 1650B STA B SAVE EQT ADD IN "B" ADA .10 GET EQT11 LDA A,I SZA,RSS ACTIVE EQT (EQ11#0)? JMP BAD NO, QUIT LDA B YES, GET EQT ADD BACK ADA .12 GET EQT EXT ADD LDA A,I LDA A,I GET THE CONT. SSA,RSS LINE EQT?(EQT16-B15=1-->LINE) JMP BAD NO,QUIT * * JMP PRINT YES, PRINT MESS. * * NOTE FALL THROUGH TO "PRINT" * * * * * * PRINT POWER FAIL MESSAGE * ON CONSOLE DEVICE FOUND IN SCAN ROUTINE * * * * * PRINT JSB XLUEX DEF *+5 RETURN DEF .2 WRITE COMMAND DEF TLU LU# OF DEVICE DEF MESS P/F MESSAGE DEF MESL. MESSAGE LENGTH JMP BAD GO TEST FOR END OF SEARCH-CONTINUE SPC 5 * * * * CONVERT A TWO DIGIT BINARY NUMBER INTO ASCII * * * * CNVRT NOP CLB DIV .10 GET TENS AND ONES ALF,ALF SHIFT TENS DIGIT INTO UPPER CHAR POSITION IOR ASCII CREATE AN ASCII FIELD IOR B 'OR' IN ONES DIGIT JMP CNVRT,I * * * * SECOND CALL ON P.FAIL ROUTINE RESETS * TO SAVE TIME ON NEXT FAILURE. * * DONE JSB XLUEX DEF *+5 DEF N1 SECOND READ REQUEST DEF PLU LU OF P/F DRIVER. DEF TIME TIME BUFFER DEF .3 BUFFER LEGNTH NOP POINT OF RETURN IF P/F LU. UNKNOWN SPC 5 * * * * * * * * *************EXIT TO SYSTEM************* JSB EXEC DEF *+2 DEF IC2 * * * * * CONSTANT AND STORAGE AREAS * * ICODE OCT 100015 YEAR1 DEC 70 BLK0 OCT 020060 ASCII OCT 030060 EMASK OCT 37400 DVR05 OCT 02400 DVR07 OCT 03400 SUBCH NOP B37 OCT 37 .43 OCT 21400 B4 OCT 4 D365 DEC 365 B77 OCT 77 .2 DEC 2 .3 DEC 3 .1 DEC 1 N1 OCT 100001 PRS1 OCT 153000 PRS2 OCT 203 EQT5 BSS 1 EQT4 BSS 1 TEMP2 EQU EQT5 TEMPORARY STORAGE NOBUF OCT 6412 CR/LF ASC 12, NO POWER FAIL LU FOUND. NBL DEC 13 TIME BSS 3 .6000 DEC 6000 .100 DEC 100 .60 DEC 60 .10 DEC 10 .12 DEC 12 .15 DEC 15 DM1 DEC -1 MESS OCT 6412 ASC 9, POWER FAILED AT BUF1 NOP ASC 1,: BUF2 NOP ASC 1,: BUF3 NOP ASC 1,. BUF4 NOP ASC 4,0 ON DAY DAY BSS 2 ASC 2, OF ASC 1,19 YEAR BSS 1 MESL. DEC 27 TEMP1 BSS 1 TEMPORARY STORAGE **** PLU NOP NOTE : 2 WORD PARAMETER FOR XLUEX NOP **** **** TLU NOP TERMINAL LU OCT 400 SET THE "K" BIT **** * R.BUF DEF BUF1 IC2 DEC 6 N4 OCT -4 MAXLU EQU 1653B END AUTOR W   91731-18001 1926 S C0122 &DVS00 PHYSICAL DRIVER             H0101 ASMB,R,L,C,N HED << RTE ASYNCHRONOUS MULTIPLEXER DRIVER - 12920A/B >> IFN * NAM DVS00,0 91731-16001 REV. 1926 790424 XIF * IFZ NAM DVS00,0 91731-16004 REV. 1926 790424 XIF * **************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978,ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * **************************************************************** * NAME: DVS00 * SOURCE: 91731-18001 * RELOC: 91731-16001 *** SINGLE MUX *** * RELOC: 91731-16004 *** DUAL MUX *** * MANUAL: 91731-90001 * AUTHOR: BILL RAGIN * UPDATES (RXX) BY GREG DOLKAS * LAST UPDATE: (R10) 4/24/79 LINE DROP BUG * (R09) 4/3/79 SET DVR TYPE TO 00 ON DETACH (C 25B) * (R08) 3/22/79 HW VS MODEM BUG, TIMEOUT BUG * (R07) 1/30/79 LINE DROP/BUFFR FLUSH CLEANUP * (R06) 12/17/78 MISSING LINE IN ERTN * (R05) 10/23/78 * (R04) 10/6/78 * (R03) 9/11/78 * (R02) 9/7/78 * (R01) 8/21/78 * SPC 2 * USE Z OPTION FOR DUAL MUX (32 PORT) SPC 2 * ENT IS00,CS00 ENT P00D1 ENT P00C1,P00C2 IFZ ENT P00D2,P00C3,P00C4 XIF EXT $LIST,$PVMP,$OPSY * * NOTE! YOU WILL HAVE $PVMP AS AN UNDEFINED EXTERNAL SYMBOL * DURING AN RTE-II GENERATION. * IGNORE IT, SINCE IT WILL NOT BE CALLED IF THIS IS USED * IN AN RTE-II SYSTEM. * * * ****** PROGRAM DESCRIPTION ****** * * DRIVER 00 OPERATES UNDER THE CONTROL OF THE * I/O CONTROL MODULE OF THE REAL-TIME EXECUTIVE. * THIS DRIVER IS RESPONSIBLE FOR CONTROLLING DATA * TRANSMISSION WITH ANY EIA RS232 COMPATIBLE * 103A OR 202C BELL TYPE MODEMS, AND HARDWIRED * TERMINALS CONNECTED TO THE 12920A ASYNCHRONOUS * MULTIPLEXOR PANEL. TERMINAL SPEED IS PROGRAMMABLE * AND CAN BE DIFFERENT FOR TRANSMIT AND RECEIVE. * THIS DRIVER CAN SENSE SPEED OF TERMINALS OPERATING * AT 10,15,30,60,120 AND 240 CHARACTERS PER SECOND. * THIS DRIVER CAN PROVIDE STALL CHARACTERS FOR * THOSE TERMINALS REQUIRING THIS DELAY * IS00 IS THE ENTRY POINT FOR THE *INITIATION* * SECTION AND CS00 FOR THE *COMPLETION* SECTION. * P00XX IS THE INTERRUPT ENTRY POINT AND HANDLES ALL * TERMINAL SERVICING. TIMEOUT AND PROGRAM SCHEDULING * ARE THE ONLY REASONS FOR ENTERING THE *COMPLETION* * SECTION. * * - THE INITIATION SECTION IS CALLED FROM I/O * CONTROL TO INITIALIZE A DEVICE AND INITIATE * A DATA TRANSFER OR CONTROL FUNCTION. * * CALLING SEQUENCE: * * - ADDRESSES OF DEVICE EQT ENTRY * SET IN "EQT1-EQT15" * * (A) = I/O ADDRESS OF DEVICE * * (P) JSB IS00 * (P+1) - RETURN - * * (A) = 0, OPERATION INITIATED, OR * (A) = REJECT CODE: * * 2, ILLEGAL CONTROL REQUEST, * OR CONTROL FUNCTION HAS * BEEN DONE (E.G., SET EOT * STATUS). * * 3, EQUIPMENT MALFUNCTION OR * NOT READY. * * - THE COMPLETION SECTION IS CALLED BY CENTRAL * INTERRUPT CONTROL TO CONTINUE OR COMPLETE * AN OPERATION. * * CALLING SEQUENCE: * * - ADDRESSES OF DEVICE EQT ENTRY * SET IN "EQT1-EQT15" - * * (A) = I/O ADDRESS OF DEVICE * * (P) JSB CS00 * (P+1) -- COMPLETION RETURN -- * (P+2) -- CONTINUATION RETURN -- * * - COMPLETION RETURN: * (A) = 0, SUCCESSFUL COMPLETION WITH * (B) = # WORDS OR CHARS. TRANSFERRED * * - CONTINUATION RETURN: REGISTERS *  MEANINGLESS. * * * - RECORD FORMATS,FOR THE DEFAULT TTY DRIVER: * * ASCII (INPUT): A STRING OF CHARACTERS TERMIN- * ----- ATED BY A CARRIAGE RETURN. IF THE * REQUESTED LENGTH IS FULFILLED * BEFORE A CARRIAGE RETURN, THE RE- * MAINING CHARACTERS ARE IGNORED * UNTIL A CARRIAGE RETURN IS INPUT. * * SPECIAL CHARACTER PROCESSING: * * LINE-FEED ALWAYS IGNORED AND IS NOT * TRANSMITTED TO USER BUFFER * RETURN - RECORD TERMINATOR AT END OF * A RECORD AND IS NOT TRANSMITTED * TO USER BUFFER OR COUNTED. * SYSTEM RESPONDS WITH A LINE-FEED * TO ACKNOWLEDGE END OF INPUT. * CNTRL-A,CNTRL-H,CNTRL-Y,OR BACKSPACE, DELETES * PREVIOUS CHARACTER AND OUTPUTS A BACK ARROW * IF TTY, OR UNDERBAR FOR MOST CRT'S. * RUB-OUT(DEL)-DELETES CURRENT RECORD; * OUTPUTS '/' THEN RETURN/LINE-FEED * NEXT RECORD IS READ. * CONTROL/D - FOURCES EOT IF ENTERED AT ANY TIME * * ASCII (OUTPUT): A STRING OF CHARACTERS, THE * ----- NUMBER DESIGNATED BY THE * "BUFFER LENGTH" IN THE REQUEST, * TERMINATED BY A RETURN AND * LINE-FEED (SUPPLIED BY THE * DRIVER). * * SPECIAL CHARACTER PROCESSING: * * LEFT-ARROW: IF A LEFT-ARROW IS THE * LAST CHARACTER IN THE USER * BUFFER, THE RETURN/LINE-FEED * AND ARROW CODES ARE NOT OUTPUT. * - PROGRAM SCHEDULING SPC 1 * IF A PROGRAM IS LINKED TO THE TRAP CELL FOR ONE OR * MORE OF THE EQT ENTRIES FOR THIS DRIVER THEN THAT * TTY IS A TERMINAL. * * A TERMINAL, WHEN ENABLED, MAY SCHEDULE THE SO LINKED * PROGRAM (MAY YDBE A DIFFERENT PROGRAM FOR EACH TERMINAL) * BY STRIKING ANY KEY ANY TIME THAT THE TTY IS NOT DOING * INPUT( THE SAME AS GETTING SYSTEM ATTENTION). IF THE * TERMINAL IS THE SYSTEM TTY THE SYSTEM ATTENTION FLAG * IS SET AND THE PROGRAM IS NOT SCHEDULED. * WHEN THE PROGRAM RUNS A CALL TO RMPAR WILL RECOVER * WORDS 4 THRU 8 OF THE EQT OF THE INTERRUPTING * TTY, THAT IS EQT4 IS SET IN THE PROGRAMS B REG. * WORD 3 IS THE SPEED PARAMETER ,FOR RECEIVE ONLY * AND WORD 4 IS THE CHARACTER WHICH * CAUSED THE ATTENTION INTERRUPT. * - BUFFER FLUSHING SPC 1 * AFTER A BUFFER FLUSH CALL ALL WRITES AND * CONTROL REQUESTS ARE IGNORED UNTIL EITHER: * 1.) THE QUE IS EMPTY OR * 2.) AN INPUT REQUEST IS PROCESSED. * * LEGAL SUBFUNCTION VALUES IN CONTROL REQUEST: * * 5 - SET RECEIVE SPEED PARAMETER * - SEE BELOW * 7 - SET END-OF-TAPE STATUS * 12 - R/LF DELAY * - SEE BELOW * 16 - SET SEND SPEED PARAMETER * - SEE BELOW * 17 - SPEED SENSE MODE * - SEE BELOW * 20 - ENABLE TERMINAL * - SEE BELOW * 21 - DISABLE TERMINAL * 23 - FLUSH BUFFER * 24 - REMOVE BUFFER FLUSH * 25 - SET LOGICAL DRIVER ADRESS IN EQT17 * - SEE BELOW * 30 - CLOSE LINE-FOR MODEM USE * 31 - OPEN LINE -FOR MODEM USE * * - THE SPEED PARAMETERS SHOULD BE CALCULATED IN THE * FOLLOWING MANNER: * * PARAMETER = (14,400/BAUD RATE)-1 * * FOR EXAMPLE A 2400 BAUD TERMINAL WOULD HAVE A * SPEED PARAMETER OF (14,400/2,400)-1 OR A VALUE * OF FIVE (5), NUMBERS ENTERED ARE IN OCTAL. * * - THE RETURN/LINE FEED DELAY PARAMETER SHOULD BE CON- * STRUCTED AS FOLLOWS: * * 15 8 7 4 3 0 * *************************** * * * CR * LF * * *************************** * * THE VALUES SHOUL{2D BE THE NUMBER OF STALL CHARACTERS * REQUIRED IN ADDITION TO THE NORMAL SINGLE CHARACTER * DELAY. * * - SET SPEED SENSE MODE: * * PRAM1 CONTAINS THE "SEARCH FOR" CHARACTER * RIGHT JUSTIFED IE. "CR"=15B,"DC1"=21B. * - THE ENABLE PARAMETER IS DEFINED AS FOLLOWS: * * 15!14 13 12!11 10 9! 8 7 6! 5 4 3! 2 1 0 * ************************************************* * *L !S D ! ! S E ! P P CHAR * * *P !C N ! ! B ! SIZE * * ************************************************* * * BITS: USE: * * 15 LINE PLEX - 0=HALF DUPLEX;1=FULL DUPLEX * 14 SECONDRY CHANEL - 0=NO SEC.CHNL;1=SEC.CHNL. * 13 DON'T DOWN LU ON ERROR, =1. DO DOWN =0. * 8 STOP BITS - 0=1 STOP BIT;1=2 STOP BITS. * 7 ECHO - 0= ECHO OFF;1= ECHO ON. * 5-4 PARITY - 0= PARITY OFF,BIT 7 =0. 1 = PARITY * ODD. 2 = EVEN PARITY. 3 = BIT 7 = 1. * 3-0 CHARACTER SIZE - SIZE,NOT INCL.STOP BIT AND PARITY. * * NOTE: IF PRAM1 =0 THE TERMINAL IS ENABLED TO THE LAST * SET OF PARAMETERS GIVEN, OR THE DEFAULT PARAMETERS * IF NONE WERE GIVEN. * * - SET LOGICAL DRIVER ADDRESS: * PRAM1 IS THE ADDRESS OF THE LOGICAL DRIVER * IF PRAM1=0 THEN THE INTERNAL TTY LOGICAL DRIVER * IS SET AS THE LOGICAL DRIVER. * * * * - GENERATION INTO RTE SYSTEM * * THIS IS A PRIVILEGED DRIVER AND REQUIRES USE OF * THE 12936A PRIVILEGED I/O CONTROL CARD, OR A 12620A CARD. * * THE SELECT CODE OF THE HIGHEST PRIORITY MUX CARD * - THAT IS THE LOWEST SELECT CODE - MUST BE INDICATED * IN THE FIRST EQT ENTRY FOR PORT #0. * * * THE FOLLOWING PROCEDURE MUST BE FOLLOWED AT SYSTEM * GENERATION TIME: * * 1.) EQUIPMENT TABLE ENTRIES MUST BE MADE FOR * EVERY PORT USED. THE SELECT CODE MUST * BEGIN WITH XX (S.C.OF DATA LSC) FOR PORT #0 AND INCREASE * CONSECUTIVELY STARTING FROM PORT #1 WHICH IS S.C.41,I.E.: * * USE "M" BIT IN RTE-IV!!! XX,DVS00,B,M,X=11, ETC. * * XX,DVS00,B,X=11 (PORT #0) * 41,DVS00,B,X=11 (PORT #1) * 42,DVS00,B,X=11 (PORT #2) * . . * . . * * NOTE: THESE ARE SIMULATED SELECT CODES -EXECPT FOR XX- * ONE FOR EACH PORT. THIS ALLOWS THE NECESSARY EQT * TABLE SPACE TO KEEP TRACK OF THE I/O FOR THE PORTS. * EACH EQT REQUIRES A 11 WORD EXTENSION. * * 2.) MAKE INTERRUPT TABLE FOR ACTUAL SELECT CODE * OF MUX. FOR EXAMPLE, WITH CARDS IN 10,11,12 AND 13 * * 10,ENT,P00D1(D2) (P00D1(D2) IS PRIV. ENTRY POINT) * 12,ENT,P00C1(C3) (P00C1(C3) IS ENTRY POINT 1ST CONTROL) * 13,ENT,P00C2(C4) (P00C2(C4) IS ENTRY POINT 2ND CONTROL, * IF USED) * * NOTE: D2,C3, AND C4 ARE FOR THE SECOND MUTIPLEXER. * * 3.) MAKE INTERRUPT TABLE ENTRY FOR EACH PORT IN USE. * A PROGRAM MAY BE LINKED TO HANDLE INTERRUPTS. * * 40,PRG,PRMPT -NOTE, THIS IS PSEUDO FOR XX- * 41,PRG,PRMPT * . * . * * * IF YOU DESIRE TO USE A SECOND MULTIPLEXER, THEN THE SELECT * FROM 60 TO 77(OCTAL) MUST BE USED AS ABOVE FOR THE SECOND * 12920B MULTIPLEXER. AGAIN, 'XX' MUST REPLACE THE FIRST CHAN. * * THEN USE 60,61,62 ... FOR EQT. & INT. TABLE ENTRIES * * THE DRIVER HAS INCORPORATED WITHIN IT A TTY DRIVER WHICH * IS DEFAULTED TO AT THE FIRST INITIALAZATION. THIS DRIVER * HAS THE CHARACTERISTICS MENTIONED ABOVE IN THE 'RECORD * FORMAT' DISCUSSION. THE USER MAY ATTACH A UNIQUE LOGICAL * DRIVER BY EXECUTING A CONTROL EXEC. CALL WITH A SUBFUNCTION * OF 25B WITH THE FIRST PARAMETER THE ADDRESS OF THE INIT. * ENTRY. THIS PROGRAM WILL BE EXECUTED DURING INITIALIZATION * AND UPON RECEPT OF EACH DATA INTERRUPT. THE INTERFACE * BETWEEN THE PHYSICAL AND LOGICAL DRIVER IS DISCUSSED * IN THE DVS00 PHYSICAL DRIVER MANUAL 12920-94001. * SKP * * THE DRIVER SAVES STATUS INFORMATION IN EQT5 AND EQT19 * TO KEEP UP WITH THE DATA TRANSMISSIONS. THE FOLLOWING * INFORMATION IS PROVIDED TO ASSIST IN UNDERSTANDING * * EQT5 * * BIT 7 BUFFER FLUSH * BIT 6 BREAK KEY HIT * BIT 5 END-OF-TAPE STATUS * BIT 4 TIME OUT * BIT 3 SPEED SENSE MODE - IN PROGRESS * BIT 2 BAD COMM LINE * BIT 1 PAUSE MODE (USER INTERRUPTED OUTPUT) * BIT 0 TERMINAL IS - ENABLED(1),DISABLED(0). SPC 2 * EQT19 * * BIT 7 READ STALL MODE * BIT 6 NOT USED * BIT 5 TIME OUT CAUSED BY GOOD COMPLETION * BIT 4 1=READ, 0=WRITE IN PROGRESS (USER REQUEST) * BIT 3 0=HARDWIRED, 1=MODEMS ENABLED * BIT 2 BACKSPACE MODE * BIT 1 LINE FEED DELAY MODE * BIT 0 CARRIAGE RETURN DELAY MODE HED 12920B INITIATION SECTION CTABL EQU * CONTROL JUMP TABLE DEF EXINT - EXIT DEF EXINT - WRITE EOF DEF EXINT - BACKSPACE RECORD DEF EXINT - FORWARD SPACE RECORD DEF EXINT - REWIND DEF STREC - SET RECEIVE PARAMETERS DEF EXINT - DYNAMIC STATUS DEF SEOT - SET END-OF-TAPE STATUS DEF EXINT - WRITE EOF DEF EXINT - CLOSE LINE - DOWN THE MODEM DEF CLDLY - R.LF DELAY DEF EXINT - FORWARD SPACE FILE DEF EXINT - BACKSPACE FILE DEF EXINT - FORM FEED DEF STTRM - SET SEND PARAMETERS DEF SSM - SPEED SENSE MODE DEF ENAB - GO ENABLE TERMINAL DEF DISAB - GO DISABLE TERMINAL DEF EXINT - GO SET TIMEOUT - NON MODEM ONLY DEF KAO - GO SET BUFFER FLUSH DEF UKAO - REMOVE BUFFER FLUSH DEF SETLG - SET LOGICAL DRIVER ADDRESS DEF EXINT - WRITE END OF VALID DATA DEF EXINT - LOCATE ABS. FILE/SPACE N LINES DEF LCLOS - CLOSE LINE - DOWN THE MODEM DEF LOPEN - LINE OPEN - UP THE MODEM DEF EXINT - UPDATE THE TERMINAL STATUS * * INITIATION SECTION * DEC 1926 (R04) REVISION CODE FOR CURIOUS FE'S, SE'S & CE'S * IS00 NOP ENTRY FROM IOC SFS 0 SAVE INT SYS. STATUS (SPECIAL CASE CCA,RSS OF FIRST ENTRY WITH INT OFF. FROM START-UP ROUTINE) CLA STA CS00 SAVE FOR EXIT CLF 0 DISABLE INTERRUPTS RTE39 JSB RTE3E (R02) ENABLE SYSTEM MAP INCASE RTE 3 I.0 JMP I.00 OVERLAYED AFTER FIRST EXECUTION BY "NOP" * * I.004 LDB EQT1 GET EQT ADDRESS 1805 JSB SETP SET UP INTERNAL EQT'S 1805 JSB TIMSB GO SET UNIT,DUNIT,NDUNT, AND CONFG. RTE31 JSB RTE3B COULD BE NOP, IF NOT SAVE STATUS RTE37 JSB RTE3A SET UP FOR MAP SWAP. LDB EQ18,I FIRST SZB ENTRY FOR THIS PORT? JMP CONT NO LDA EQT12,I CHECK FOR ADA DM11 AT LEAST ELEVEN EQT EXTENTIONS SSA 1805 JMP ERROR NOT ELEVEN, SOMETHINGS WRONG, ABORT.. LDA EQT4,I GET PORT NUMBER AND B77 ADA DM6 YES SET UP FOR PROGRAM SCHED ADA INTBA INTBA EQU 1654B INTERRUPT TABLE POINTER LDB A,I GET INTERRUPT TABLE ENTRY A EQU 0 B EQU 1 CMB,CLE,SSB,INB ID SEG ADDRESS OR EQT ADDRESS CCB,CCE MUST BE EQT ADDRESS STB EQ18,I SAVE FOR LATER ENTRY LDB EQT1 PUT EQT ADDRESS STB A,I INTO INTERRUPT TABLE LDA EQT4,I IOR BIT12 INDICATE WE HANDLE TIMEOUT STA EQT4,I * LDA DSPD SET DEFAULT SPEEDS STA EQT11,I SET FOR 110 BAUD LDA DLCH SET DEFAULT CHAR STA EQ22,I ECHO,FULL DUPLEX JSB CF920 GO SET IN EQT TABLE LDA LOADR DEFAULT LOGICAL DVR STA EQ17,I PUT INTO EQT TABLE LDA B1201 STA EQ26,I * CONT LDA EQT5,I GET STATUS AND ECLM CLEAR OLD FIELD STA EQT5,I LDA EQT6,I LDB EQ17,I TTY DVR? CPB LOADR ? RAL,CLE,SLA,ERA YES STA EQT6,I CLR SYS REQ. AND B3 CPA B3 CONTROL REQUEST ? JMP CNTRL YES * JMP R.W PREPARE FOR READ/WRITE * DSPD OCT 101202 DEFAULT XMIT-RCV 110 BAUD DM11 DEC -11 1805 SKP HED CONTROL REQUEST PROCESSING ************************************************* * DOES CONTROL REQUEST PROCESSING * ************************************************* * * CNTRL EQU * LDA EQT6,I GET CONTROL WORD LSR 6 SHIFT AND B37 MASK IT STA COUNT SAVE FOR LOG DVR LDB A SAVE IT CPA B24 IS THIS REMOVE FLUSH? JMP CNTR1 YES CPA B31 (R08) LINE OPEN? JMP CNTR1 (R08) YES, ALLOW TO EXECUTE ALWAYS LDA EQT5,I NOW CHECK FOR BUFFER FLUSH AND BIT7 IN BIT 7 SZA,RSS JMP CNTR1 NO, PROCESS COMMAMND JSB NXQU YES, GO CHECK 'Q' JMP EXIT IS FLUSH, IGNORE REQUEST CNTR1 LDA COUNT ADB NB33 CHECK THE RANGE FOR < 33B SSB,RSS JMP ERROR EXIT ADA TBLAD DO TABLE LOOKUP LDA A,I JMP A,I AND GO THERE TBLAD DEF CTABL JUMP ADDRESS TABLE * EXINT LDA EQ17,I GET INIT ADDRESS STA LOGR SAVE LDA COUNT RETRIVE EXEC SUB FUNCTION LDB EQT1 ADDRESS OF THE EQT JSB LOGR,I GO TO INIT OF LOGICAL DVR JMP EXIT IMMEDIATE RETURN STA DADIR SAVE DATA AND DIRECTIVE JSB SRTIM SET LOG TIME IF ANY RAL READ OR WRITE? SSA,RSS WRITE?? JMP ERROR UNLEGAL RESPONSE JMP SWRIT START WRITE * * ERROR LDA B2 ILLEGAL REQUEST JMP EXIT0 AND RETURN * * SET RECEIVE SPEED * STREC LDA EQT7,I GET USER PARAMETER SZA,RSS SUPPLIED ? JMP ERROR NO AND B377 USE BAUD RATE ONLY ALF,ALF POSITION STA EQ11,I PUT INTO TEMP LOC. JSB CF92B GO SET SPEED LDA EQ24,I (R05) SEND TO CARD JSB OUT (R05) JMP EXIT RETURN * * SET TRANSMIT SPEED * STTRM LDA EQT7,I GET USER PARAMETER SZA,RSS VALUE SUPPLIED ? JMP ERROR NO STA EQ11,I PUT IN TEMP LOCATION JSB CF92B GO UPDATE SPEED LDA EQ25,I (R05) SEND TO CARD JSB OUT (R05) JMP EXIT RETURN * * KILL OUTPUT * KAO LDA EQT5,I GET STATUS WORD IOR BIT7 SET IGNORE BIT(7) STA EQT5,I JSB NXQU SEE IF ANYONE ELSE WAITING JMP EXIT THEN RETURN * * REMOVE BUFFER FLUSH * UKAO LDA EQT5,I GET STATUS AND CMB7 REMOVE BIT 7 STA EQT5,I AND RESTORE EQT5 JMP EXIT RETURN * NXQU NOP RTE36 JMP GTDMS NOP IF NOT MAPPED 1805 (1740 RTE) CLDSY LDA EQT1,I ANYONE SUSPENDED? 1740 RTE RAL,CLE,ERA CLEAR SIGN 1805 TPARI LDA A,I CONST. 160000B TRANS. WITH PARITY 1805 CHECK SZA 1740 RTE JMP NXQU,I YES; RETURN LDA EQT5,I NO; CLEAR AND NBIT7 IGNORE BIT 7 STA EQT5,I JMP NXQU,I AND RETURN * * NBIT7 OCT 177577 NOT BIT 7 B1201 OCT 10001 B24 OCT 24 B31 OCT 31 (R08) DTMSK OCT 140377 (R09) DRIVER TYPE MASK CMB05 OCT 177700 CMASK OCT 177710 CMB13 OCT 157777 CMB7 EQU NBIT7 DCLM OCT 177600 DLCH OCT 100210 TERM. DEFAULT LP=1,SC=0,SB=0,E=1,P=0,CZ=8 DM6K DEC -6000 1805 * * * IF IT GETS HERE IT IS MAPPED III/MIII/IV SYSTEM * GTDMS RSA 1740 RTE GET DMS STATUS REG. ALF,SLA 1740 RTE BIT 12 0\1 SYSTEM\USER RSS 1740 RTE JMP CLDSY 1740 RTE SYSTEM MAP XLA EQT1,I 1740 RTE USER MAP CROSS LOAD RAL,CLE,ERA CLEAR SIGN 1805 OCT 101724 1740 RTE XLA A,I IN 2 WORDS 1805 BIT15 DEF A,I OCTAL 100000 1805 JMP CHECK 1740 RTE * * THE ABOVE WORKS ONLY IN 1740 OR LATER RTE SYSTEMS * * * SET END-OF-TAPE * SEOT LDA EQT5,I FETCH STATUS IOR B40 MERGE EOT STA EQT5,I JMP EXIT * * SPEED SENSE MODE * SSM LDA EQT7,I GET SEARCH FOR CHAR. STA EQ21,I SAVE IN EQT LDA B2405 (R05) SET REC&XMIT SPEED TO 2400 STA EQ11,I PUT IN EQT JSB CF92B SET SPEEDS LDA EQ24,I GET INPUT PRAM IOR BIT11 TURN ON AUTO SPEED AND CMB12 TURN EHCO OFF JSB OUT SEND TO MUX LDA EQ25,I FETCH TRANS PRAM AND CMB13 CLEAR INT. ENABLE JSB OUT DISABLE CHANNEL FOR TRANS LDA EQ26,I GET STATE WORD IOR BIT15 TURN ON 'AS' STA EQ26,I RESTORE LDA EQT5,I SET IOR B10 STATUS FOR STA EQT5,I SPEED SENSE LDB DM6K WAIT FOR UP TO 60 1805 STB EQ16,I SECONDS FOR CHARACTER 1805 JMP EXIT1 AND RETURN * * ENABLE TERMINAL * ENAB LDA EQ7,I GET ENABLE PRAM. SZA,RSS PRAM OF ZERO? JMP ENAB1 YES,DEFAULT TO 100210B,OR PREVIOUS STA EQ22,I SAVE FOR SETUP LDA EQ24,I GET REC PRAMS AND RHALF GET SPEED ALF,ALF PUT IN LEFT HALF STA B SAVE LDA EQ25,I GET TRANS PRAMS AND RHALF GET SPEED IOR B REC. AND TRANS SPEED STA EQ11,I SAVE FOR NEW EQ24 AND EQ25 JSB CF920 GO SET UP EQT ENAB1 LDA EQ26,I DEFAULT (R03) AND DM4 TO INA READ STA EQ26,I RESTORE LDA EQ24,I RECEIVE PRAMATERS JSB OUT SEND TO MUX LDA EQ25,I TRANS PRAM JSB OUT TO BOARD LDA EQT5,I SET THE IOR  B1 ENABLE BIT NO. 0 STA EQT5,I IN STATUS JMP EXIT (R07) * * DISABLE TERMINAL * DISAB LDA EQT1 IS THS THE CPA SYSTY SYSTEM TTY?? JMP EXIT YES,CAN'T DOWN THE SYS TTY, IGNORE LDA EQT5,I TAKE OUT THE AND DCLM THE ENABLE BIT NO. 0 STA EQT5,I RESTORE LDA BIT15 NO, DISABLE PORT JSB OUT JMP EXIT * * SET THE LOGICAL DRIVER ADDRESS INTO EQ17 * SETLG LDA EQ22,I (R02) COPY ECHO BIT TO EQ24 AND BIT7 (R02) ...FROM EQ 22 ALF,RAL (R02) STA B (R02) SAVE ECHO BIT LDA EQ24,I (R02) FETCH... AND NBT12 (R02) ...CLEAR BIT 12 IOR B (R02) ...SET UP STA EQ24,I (R02) ...& STUFF LDA EQ7,I GET ADDRESS SZA,RSS IS IT ZERO? LDA LOADR DEFAULT OR RESET TO INTEG. - LOG DVR STA EQ17,I NO, SET IN EQ17 CPA LOADR (R09) DEFAULT LDVR? RSS (R09) JMP EXIT NO, RETURN AS IS LDA EQT5,I (R09) YES, SET DRIVER TYPE TO 00 AND DTMSK (R09) STA EQT5,I (R09) JMP EXIT (R09) NOW RETURN * * SET R/LF DELAY TIMES * CLDLY LDA EQT7,I GET PARAMETER AND B377 ALF,ALF POSITION & SAVE STA B LDA EQ19,I GET OLD VALUE AND B377 IOR B AND UPDATE STA EQ19,I YES SPC 1 EXIT LDA B4 SHOW IMMED COMPL. EXIT0 STA ASAVE SAVE A LDA EQ1 CHECK IF THE SSA,RSS MAPS WERE SWAPPED JMP EXIT3 NO LDA MAPAD YES, SWAP BACK USA EXIT3 LDA ASAVE ISZ CS00 SKIP IF INT SYS OFF ON ENTRY STF 0 ENABLE INTERRUPTS JMP IS00,I AND RETURN SPC 1 * * CLOSE LINE - DISCONNECT MODEM * LCLOS EQU * JSB LCS1 GO CLOSE THE LINE LDA B40 SHOW A GOOD (BIT 5) IOR EQ19,I 1840 DON'T WIPE OUT EQT19 STA EQ\19,I COMPLETION JMP EXIT1 RETURN * LCS1 NOP LDA BIT15 DISABLE JSB OUT FOR DISCONNECT LDA SCDBS DISCONNECT. JSB COUT LDA EQ22,I HALF-DUPLEX? SSA JMP LCS1F NO, FULL LDA SCDBS YES, DROP SA, DISABLE JSB COUT2 INTERRUPTS ON SECOND CONT BOARD LCS1F LDA BIT12 SIGNAL LINE CLOSE TO TIMPH STA EQ26,I LINE STATUS = 0; DOWN. LDB DM500 DELAY 5 SECONDS FOR MODEM HANGUP, 1805 STB EQ16,I THEN COMPLETE LINE CLOSE REQ. 1805 JMP LCS1,I * * PROCESS LINE OPEN REQ. * SPC 1 LOPEN EQU * LDA EQ26,I IS THE LINE IN AND BIT12 USE? SZA,RSS JMP ERROR YES,ERROR RETURN LDA BIT3 (R08) SET ENABLED IOR EQ19,I (R08) ..BIT IN STATUS STA EQ19,I (R08) LDA BIT15 DISABLE JSB OUT DURING LINE UP CLA SET LINE STA EQ21,I FLAG TO ZERO JMP RECOP YES ALWAYS SPC 1 * RECEIVE OPTIONS SPC 1 RECOP EQU * LDA DM4 (R05) SET HDX TURN-AROUND COUNTER STA EQT8,I (R05) JSB RECX1 LDA EQ7,I (R02) SET LOGICAL TIMER... SSA (R02) .. IF PARAM1 IS NEG. STA EQ12,I (R02) JMP EXIT1 * RECX1 NOP LDA B20 SET TRANSITION STATE TO RECEIVE IOR BIT12 SIGNAL LINE OPEN TO TIMPH STA EQ26,I LDA EQ22,I SSA 103 MODEM-HW JMP RECO1 YES LDA SCDAB NO, 202 MODEM HALF DUPLEX JSB COUT A=CD UP AND CA DOWN LDA SSAF RAISE SA AND ENABLE FOR CB JSB COUT2 EQUAL TO ZERO JMP RECX1,I CONTROL REQ. INITIATED RECO1 EQU * ECHO PLEX LDA SCDCA A= CD & CA UP (ECHOPLEX) JSB COUT OUTPUT TO CONTROL BOARD JMP RECX1,I CONTROL REQ. INITIATED. SPC 1 * SEND OPTION SPC 1 * SENXP NOP LDA B40 SET TRANSITION STATE TO TRANSMIT IOR BIT12 SIGNAL LINE OPEN TO TIMPH STA EQ26,I LDB EQ22,I SSB,RSS FULL DUPLEX? (103 MODEM) JMP SENXQ NO LDA SCDCA YES, CD,CA=1 ENAB CC,CF=0 JSB COUT JMP SENXP,I SENXQ LDA SCDAS RAISE CD,CA, DIS. CF,ENABL CC JSB COUT OUT TO MUX CONT #1 LDA SSAB NO. 202 MODEM JSB COUT2 OUTPUT SA DOWN TO MUX BOARD # 2 JMP SENXP,I * SCDBS OCT 140300 LOWER CD,CA & INH. ALL INTERRUPTS SCDCA OCT 140374 RAISE CD,CA (ECHOPLEX 103,HALF DUX SEND 202) SPC 1 HED 12920A-B READ WRITE REQUEST PROCESSING * READ/WRITE REQUEST PROCESSOR * R.W LDB EQT5,I GET STATUS BLF,BLF CHECK BIT 7 SSB IGNORE ? B10 SLA ONLY IF WRITE 1805 ALSO CONSTANT (10B) JMP R.1 CAN'T IGNORE JSB NXQU SEE IF ANYONE ELSE WAITING JMP EXIT * R.1 EQU * LDA EQT5,I SINCE THIS IS AN INPUT REQUEST, AND CMB7 CLEAR THE BUFFER FLUSH BIT STA EQT5,I IN CASE IT MIGHT BE SET LDA EQ19,I CLEAR STATUS AND AND CMASK (R08) COMPLETION BITS LDB EQT6,I (R04) SET R/W FLAG SLB (R04) IOR BIT4 (R04) FOR PAUSE CODE STA EQ19,I RESTORE LDA EQT7,I GET BUFFER ADDRESS CLE,ELA MAKE BYTE POINTER STA EQT9,I LDA EQT8,I GET BUFFER LENGTH SSA WORDS OR CHARS? JMP CHARS CLE,ALS WORDS TO CHARS CMA,INA CHARS STA EQT10,I SAVE AS COUNTER * LDA EQT6,I GET REQUEST LDB EQ17,I GET LOG DVR ADRESS ADB B2 BUMP SLA,RSS ADB B2 GO TO WRITE STB LOGR SAVE RTE38 JSB RTE3C SWAP MAPS CCA LDB EQ1 ADDRESS OF EQT JSB LOGR,I GO GET FIRST CHAR JMP ERROR UNACCEPTABLE RESPONSE STA DADIR SAVE CHAR JSB SRTIM GO SET TIMER, IF ANY  RAL,SLA BIT 15 ON JMP SREAD FOR START READ SSA BIT 15 FOR JMP SWRIT START WRITE JMP ERROR NOT LEGAL HERE * EXIT1 JSB E15ST SET EQT 15 TO RIGHT VALUE EXIT2 CLA FOR CONT, RETURN JMP EXIT0 SKP * * * RTE3A NOP LDX DUNIT SAVE PORT # IN "X" REGISTER CLA OK TO USE X-REG. SINCE RTE-III IS SAVING IT SAX MAPTB CLEAR PORT# ENTRY IN CASE USER MAP IS NOT USED LDB EQT1,I GET LINKAGE TO SUSPENDED PROCESS RBL,CLE,ERB CLEAR SIGN 1805 INB POINT TO CONWD LDA B,I GET CONWD RAL SAVE "T-FIELD"IN BIT 15 AND 0 CMA,SSA,SLA,RSS I/O TYPE = CLASS,BUFFERED, OR SYSTEM JMP RTE3A,I YES! THEN USE SYSTEM MAP INB POINT TO BUFFER ADDRESS IN CALLER'S QUEUE LDA B,I NOTE! NOT BUFFER ADDRESS IN EQT 7 SSA IS THIS REIO REQUEST, OR OTHER BUFFER IN "SAM" JMP RTE3A,I YES THEN USE SYSTEM MAP * * NOTE THAT USING SYSTEM MAP (REIO ETC.) WILL BE MORE * EFFICIENT IN THE PRIVILEGED SECTION OF THIS DRIVER * LDA EQT1,I GET CURRENT USERS ID SEGMENT ADDRESS RAL,CLE,ERA CLEAR SIGN 1805 SAX MAPTB AND SAVE AS NON-ZERO ENTRY IN MAP-TABLE JMP RTE3A,I * * RTE3E: ENABLE SYSTEM MAP. IF RTE-III SYSTEM AND USER TERM. IS * NOT BUFFERED, SYSTEM WILL ENTER IS00 & CS00 WITH USER * MAP ENABLED. IF USER HAS NOT DECLARED SSGA DURING PGM LOAD, * LOGICAL DRIVERS RESIDING IN SSGA CANNOT BE ACCESSED WITH * USER MAP ENABLED. (SYSTEM GOES SPLAT) ENABLING SYSTEM MAP * SIMULATES "M" BIT (RTE-IV) SO EVERYTHING WILL EXIST. * THIS ROUTINE IS (R02) * RTE3E NOP (R02) ENABLE SYSTEM MAP SJP RTE3E,I (R02) ..AND RETURN * * * CONFG - CONFIGURES THE OUTPUT INSTRUCTIONS FOR THE * OUTPUT SUBROUTINES. * * CALLING SEQUENCE: JSB CONFG 4SPC 1 CONFG EQU * NOP LDA SAVSC IOR OTACC CONFIGURE 1805 CPA OTA10 SEE IF CONFIGURED 1805 JMP CONFG,I RETURN 1805 STA OTA10 ALL INA OTA STA OTA20 INSTRUCTIONS. INA STA OTA30 INA STA OTA40 * LDA SAVSC CONFIGURE IOR STCAC STC 1027XX 1805 STA STC10 INST. ADA B3601 LIB 1065XX+1 1805 STA LIB20 CONFIGURE STA LIB21 LIB INSTRUCTIONS XOR B5200 FORM STC,C 1037XX+1 1805 INA BUMP IT 1 1805 STA STCF3 INA STA STCF4 JMP CONFG,I RETURN. SPC 2 SPC 1 OTACC OTA 0 STCAC STC 0 B3601 OCT 3601 1805 B5200 OCT 5200 1805 B2405 OCT 2405 (R05) SKP SPC 2 920,I RETURN. CHAR.R S.OMPLETED. ITS.A WAY T ENTRY TS. REQ.) * COUT2 OUTPUTS CONTROL PARAMETERS TO THE 2ND CONTROL BOARD. SPC 1 COUT2 EQU * NOP IOR UNIT INSERT UNIT # OTA40 OTA SC+3 4TH BOARD (2ND CONTROL BOARD) STCF4 STC SC+3,C JMP COUT2,I SPC 2 * COUT OUTPUTS CONTROL PARAMETERS TO THE 1ST CONTROL BOARD. SPC 1 COUT EQU * NOP IOR UNIT OTA30 OTA SC+2 CONTROL BOARD # 1 STCF3 STC SC+2,C JMP COUT,I SPC 2 * OUT - TRANSMITS 16 BITS TO THE MUX BOARD. SPC 1 OUT EQU * NOP LIB20 LIB SC+1 CHK SEEKING. SSB OK TO SEND? JMP LIB20 NO. WAIT. OTA10 OTA SC OUTPUT DATA/PARAMETERS. LDA UNIT OTA20 OTA SC+1 SEND UNIT #. STC10 STC SC INITIATE TRANSFER. JMP OUT,I SPC 2 * CHAR - TRANSMIT A CHARACTER SPC 1 CHAR EQU * NOP IOR EQ20,I ADD STOP BITS. JSB OUT SEND CHAR TO MUX BOARD. JMP CHAR,I SPC 2 * THIS SUBR OUTPUTS THE A-REGISTER TO THE CONTROL * BOARD CURRENTLY INTERRUPTING. ALLOWS INHIBITING IpNTERRUPTS. SPC 1 OUTCC EQU * NOP OCCSC OTA SC STCSC STC SC,C JMP OUTCC,I SPC 2 CISUB EQU * NOP JSB SRSCU LDA SAVSC IOR OTACC STA OCCSC IOR STCF0 1805 1037XX STA STCSC LDA DUNIT JMP CISUB,I * STCF0 STC 0,C 1805 SPC 2 SKP * *** CONTINUATION SECTION *** * * AT THIS POINT A TIMEOUT HAS OCCURED ON THE BASE EQT15 * CLOCK. EITHER THE LOGICAL OR PHYSICAL TIME VALUES ARE BUMPED * IF ENABLED. IF EITHER TIMES OUT, CONTROL IS PASSED TO THE * RESPECTIVE TIMEOUT PROCESSOR. IF NEITHER IS ENABLED, THEN * THE NORMAL TIMEOUT PROCESSING OCCURS. THE PHYSICAL TIMER * TAKES PRECEDENCE OVER THE LOGICAL TIMER. THE LOGICAL TIMER * WILL BE STARTED IF THE PHYSICAL TIMER IS NOT ENABLED. * TIMEOUT IS THE METHOD PRIVILEGED ROUTINE * HANDLES I/O COMPLETION. * CS00 NOP INTERRUPT ENTRY CLF 0 RTE40 JSB RTE3E (R02) ENABLE SYSTEM MAP LDB EQT1 SET UP THE INTERNAL EQTS 1805 JSB SETP 1805 LDA EQT1,I IS A RAL,CLE,ERA CLEAR SIGN 1805 SZA PROGRAM WAITING ? JMP C.1 YES STA EQT15,I DISALLOW TO LDA EQ24,I PASS SPEED TO AND B377 STA EQT6,I SCHEDULED PROGRAM LDA EQ21,I GET CAUSING STA EQT7,I CHAR AND SAVE JSB SCHED GO SCHEDULE JMP C.2 AND EXIT * C.05 EQU * LDB EQ16,I LOOK AT PHYSICAL TIMER 1805 SZB ENABLED 1805 ISZ EQ16,I YES - BUMP 1805 RSS NOT TIMED OUT YET 1805 JMP TIMPH YES - TIMED OUT 1805 * LDA EQT12,I IS LOGICAL TIME ENABLED SZA ISZ EQT12,I YES, BUMP, IS IT TIMED OUT?? RSS NO CONTINUE JMP TIMRT YES PROCESS LOG. T.O. LDA EQT12,I IS EITHER 1805 IOR EQ16,I TIMER ENABLED? 1805 SZA JMP C.2B (R07) YES, CONTINUE 1805 STA EQT15,I CLEAR BASE CLOCK JMP C.11 C.2B LDA EQ19,I (R08) MODEMS ENABLED? AND BIT3 (R08) SZA,RSS (R08) WELL? JMP C.2A (R08) NO, LINE CONSIDERED GOOD LDB EQ21,I (R07) CHECK FOR BAD LINE RBL (R07) SSB,RSS (R07) JMP C.2A (R07) LINE OK. CONTINUE JSB E15ST (R07) LINE BAD. ABORT JMP TMOUT (R07) C.1 LDA EQT5,I GET STATUS AND B100 CHECK FOR SZA,RSS BREAK KEY HIT JMP C.05 NO CONTINUE JSB SCHED GO SCHEDULE JMP C.12 COMPLETE * C.11 EQU * LDA EQ19,I GET STATUS AND B40 SZA,RSS END OF RECORD? JMP TMOUT NO * * I/O COMPLETION PROCESSOR * C.12 EQU * LDA EQ19,I CLEAR AND NBIT5 OLD STA EQ19,I STATUS LDB EQT6,I GET TLOG LDA EQT5,I GET STATUS AND ECLM CLEAR OLD STUFF SZB,RSS ZERO TLOG ? IOR B40 YES SET EOT STA EQT5,I SAVE IN EQT CLA SHOW COMPLETION CEX.2 STF 0 JMP CS00,I AND RETURN * TMOUT EQU * LDA EQ21,I LOOK FOR LINE AND BIT14 STATE IN BIT 14 ALF PUT INTO BIT 2 SZA (R08) BAD? IOR BIT7 (R08) YES, SET FLUSH STA B SAVE IN B LDA EQT5,I GET STATUS AND ECLM CLEAR IT IOR B BIT 2/7 -BAD LINE IF ON IOR B20 BIT 4 -TIME OUT STA EQT5,I RESTORE CLB ZERO TRANSMISSION LOG LDA EQ22,I LOOK AT THE DON'T AND BIT13 DOWN BIT SZA DOWN OR NOT? CLA,RSS NO LDA B4 NOTIFY OPR AND PROGRAM JMP CEX.2 RETURN * NBIT5 OCT 177737 SKP * * SCHEDULER * SCHED NOP LDB EQT1 CPB SYSTY CHECK FOR SYSTEM CONSOLE SYSTY EQU 1675B RSS JMP C.13 NO WE ARE NOT &ISZ OPATN SET OPERATOR ATTN FLAG OPATN EQU 1734B JMP SCHED,I AND RETURN C.13 EQU * LDA EQT5,I IS TERMINAL ENABLED? SLA,RSS JMP SCHED,I NO,IGNORE LDB EQ18,I GET ID SEG ADDR SZB INITIALIZED ? SSB IS IT SET UP? JMP SCHED,I CAN'T SCHEDULE STB SCH YES, PUT IN CALL LDB EQT4 SET POINTER TO EQT4 STB SCH1 FOR PROGRAM TO DETERMINE PORT CAUSING SCHEDULE JSB $LIST MAKE SCHEDULE CALL OCT 601 1740 RTE SCH NOP ID SEGMENT ADDRESS SCH1 NOP 1740 RTE EQT4 ADDRESS JMP SCHED,I * * CONTINUATOR RETURN * C.2A JSB E15ST SET UP EQT15 1805 C.2 ISZ CS00 INCREMENT EXIT STF 0 ENABLE INTERRUPTS JMP CS00,I AND RETURN * HED LOGICAL TTY DRIVER - READ * * THIS IS A DEFAULT TTY DRIVER * AND IS USED IF NO OTHER WAS SET UP * LODVR NOP JMP LINIT INITIALIZE SPC 1 LRRET NOP LOGICAL READ JMP LREAD SPC 1 LWRET NOP LOGICAL WRITE JMP LWRTE SPC 1 LINIT CLA CLEAR A FOR RETURN CLB JMP LODVR,I THIS DVR DOSEN'T HANDLE SUB FUNCT. * * * LREAD EQU * STA ASAVE SAVE A CPA DM1 FIRST TIME?? RSS YES JMP LREDC NO PROCESS CHAR LDA BIT15 START READ JMP RTNR LREDC AND B177 MASK CHARACTER STA CH SAVE IT LDA ASAVE LOOK FOR BAD LINE SSA LOGICAL TIME OUT? JMP RTNR1 YES AND B60T OR DATA ERROR. SZA OR LINE ERROR JMP RTNR1 LOOKS BAD, EXIT TELL OPR. PRG LDA EQ19,I (R04) GET STATUS AND BIT4 (R04) CHECK R/W FLAG SZA,RSS (R04) SKIP IF NOT WRITE JMP PAUSE CHECK FOR PAUSE LDA CH GET CURRENT CHARACTER SZA NULL ? JMP P.55 NO LDB EQ7,I CHECK DFOR CLE,ELB FIRST CPB EQ9,I CHARACTER JMP RTNR0 YES , IGNORE P.55 EQU * CPA RETN CARRIAGE RETURN ? JMP EOL YES; GO PROCESS END OF RECORD * CPA RUB RUBOUT? JMP P.61 CPA LF LINE FEED? JMP RTNR0 YES IGNORE CPA B10 BACKSPACE??(10)? 1805 JMP P.7 CPA BS CNTRL-H??(31) JMP P.7 CPA CA CONTROL/A(1)? JMP P.7 CPA CONTD CONTROL/D??(4)? JMP P.80 CLB CHECK FOR CPB EQ10,I BUFFER FULL JMP RTNR0 ITS FULL; IGNORE * * STORE CHARACTER IN USER BUFFER * LDB EQ9,I GET CURRENT POSITION CLE,ERB MAKE BYTE POINTER ISZ EQ9,I BUMP TO NEXT SEZ,RSS LEFT OR RIGHT? ALF,ALF LEFT STA CH SAVE LDA B377 GET MASK SEZ ALF,ALF STA BSAVE SAVE TEMP JSB MAPRD CROSS MAP I-O AND BSAVE FROM BUFFER IOR CH NEW CHAR JSB MAPWR TO BUFFER ISZ EQ10,I BUMP BYTE COUNT JMP RTNR0 * * READ RETURN TO PHYSCIAL DRIVER * RTNR0 CLA RTNR LDB EQ14,I ISZ LRRET BUMP FOR GOOD RET RTNR1 JMP LRRET,I RETURN * CH BSS 1 CURRENT CHAR. ASAVE NOP BSAVE NOP * * THIS IS A TABLE - DO NOT REARRANGE * SPNTR DEF *+1 SPEED POINTER FOR DIAG. CHANNELS(16-20) OCT 13 1200 BAUD OCT 27 600 BAUD B300 OCT 57 300 BAUD B150 OCT 137 150 BAUD B110 OCT 202 110 BAUD * * END OF BAUD TABLE * EQT0 NOP ADDRESS OF EQT FOR PORT #0 EQTA EQU 1650B ADDRESS OF FIRST SYSTEM EQT ENTRY RETN OCT 15 CARRIAGE RETURN LF OCT 12 LINE FEED D10 EQU LF RUB OCT 177 RUBOUT B177 EQU RUB B17 OCT 17 1805 BA EQU B150 BACK ARROW (137B) 1805 BS OCT 31 BACKSPACE B1 OCT 1 1805 CA  EQU B1 CONTROL/A B4 OCT 4 1805 CONTD EQU B4 CONTROL/D SLASH EQU B300 / B60T OCT 60000 BIT4 OCT 20 (R04) BIT3 OCT 10 (R08) * * CROSS MAP READ IF EQ1 IS NEG, ADDRESS IN B. * MAPRD NOP LDA EQ1 CHECK FOR NEG SSA JMP *+3 DO CROSS LOAD LDA B,I STANDARD LOAD JMP MAPRD,I XLA B,I FROM USER MAP JMP MAPRD,I * * WRITE TO USER MAP IF EQ1 NEG. ADDRESS IN B. * MAPWR NOP STA BSAVE LDA EQ1 WERE MAPS SWAPPED? SSA JMP *+4 YES LDA BSAVE NO STA B,I JMP MAPWR,I LDA BSAVE XSA B,I CROSS STORE JMP MAPWR,I HED LOGICAL TTY DRIVER - WRITE * * RUBOUT PROCESSOR * P.6 EQU * STB EQ6,I CLEAR RUBOUT FLAG LDA EQ7,I RESET CURRENT BUFFER ADDRESS RAL FOR RE-INPUT STA EQ9,I LDA EQ8,I RESET SSA JMP P.60 BUFFER B60 CLE,ALS 1805 USED AS CONSTANT (60B) CMA,INA LENGTH P.60 STA EQ10,I LDA BIT15 START READING JMP RTNW AGAIN * P.61 LDA EQ6,I SET FLAG TO IOR BIT15 SHOW RUBOUT IN STA EQ6,I PROCESS CLA CLEAR CHAR COUNT STA EQ10,I TO DUMMY OUTPUT LDA SLASH GET SLASH IOR BIT14 START WRITE JMP RTNR RET TO P.D. * * BACKSPACE PROCESSOR * P.7 LDA EQ7,I IF BUFFER EMPTY RAL IGNORE CPA EQ9,I BACKSPACE JMP P.61 * CCA ADA EQ9,I DECREMENT BYTE STA EQ9,I POINTER CCA ADA EQ10,I DECREMENT STA EQ10,I LENGTH LDA EQ22,I (R03) SMART BACKSPACE? ALF,SLA (R03) JMP P.71 (R03) YES, BS ALREADY ECHO'D, RETURN LDA EQ19,I BACKSPACE MODE IOR B4 SET BIT 2 STA EQ19,I LDA BA OUTPUT A BACK ARROW OR UNDERBAR IOR BIT14 START WRITE JMP RTNR AND RETURN TO P.D. P.71 CLA (R03) WAIT FOR NEXT CHAR JMP RTNR (R03) * * * END OF INPUT PROCESSOR * EOL EQU * LDB EQ9,I IF ODD CLE,ERB # OF JSB MAPRD CHARACTERS AND B1774 INPUT, SET IOR B40 BLANK IN SEZ LOWER HALF JSB MAPWR OF LAST WORD * LDA EQ10,I GET INPUT COUNT LDB EQ8,I AND REQUESTED LENGTH SSB JMP P.8 REQUESTED CHARACTERS BLS ADB A SLB,BRS INB JMP P.8A P.8 CMB,INB ADB A P.8A STB EQ6,I STORE TRANSMISSION LOG LDB B200 (R03) READ FLAG JSB CD SET CR DELAY MODE LDA BIT14 SET START WRITE IOR B177 OUT DEL TO TURN LINE AROUND JMP RTNR RETURN TO PHYSICAL DVR * P.80 EQU * JSB GEND GOOD END CLA ZERO STA EQ6,I TLOG JMP RTNR1 RETURN TO P.D. FOR COMPLETION * * INDICATE A GOOD COMPLETION, SET BIT * 5 OF EQT 19, FOR PHYSICAL DRIVER. * GEND NOP LDA EQ19,I GET EQT 19 IOR B40 SET BIT 5 STA EQ19,I RESTOTR JMP GEND,I RETURN * * B1774 OCT 177400 NBT12 OCT 167777 (R02) NOT-BIT-12 LHALF EQU B1774 B200 OCT 200 B400 OCT 400 DMASK OCT 177574 (R02) BIT8 EQU B400 SKP * * OUTPUT SECTION * LWRTE EQU * STA SAVEA SAVE FOR INIT. CHECK CPA DM1 FIRST TIME?? CLA YES ALF,SLA IS IT BREAK?? JMP BREAK BIT-12, YES. BREAK JMP P.92 STATUS OK?.YES; CONTINUE BREAK LDA EQ5,I STA B AND DM3 CLEAR PAUSE BIT IOR B100 SET BREAK STATUS STA EQ5,I LDA EQ21,I CLEAR THE AND CMB12 BREAK FLAG STA EQ21,I AND RESTORE RBR,SLB PAUSE MODE ? JMP P.92 YES RESTART OUTPUT JMP PAUSCv1 RETURN FOR CONT TO P.D. * PAUSE LDA EQ5,I GET STATUS XOR B2 INVERT PAUSE FLAG STA EQ5,I RAR,SLA ALREADY WAITING ? JMP RTNR0 NO-WE WILL WAIT NOW LDA BIT14 YES,START WRITE AGAIN JMP RTNR WITH A SYNC CHAR PAUS1 LDA BIT13 THIS IS A NOP JMP RTNW0 UNTIL THE NEXT REC INT P.92 EQU * LDA SAVEA RESTORE A CPA DM1 IS THIS THE FIRST TIME?? JMP P.93 YEP.. IGNORE LINE CHECK RAL,SLA LOGICAL TIME-OUT? JMP RTNW1 YES SSA LOOK FOR BAD LINE JMP RTNW1 RETURN TO SYSTEM AND TELL THEM. P.93 LDA EQ5,I (R02) PAUSE MODE? RAR,SLA (R02) RSS (R02) JMP *+4 (R02) NO LDA BIT13 (R03) YES, IGNORE INT. CLB (R03) JMP RTNW (R02) WAIT FOR "GO" FROM READ INT. LDA EQ19,I BACKSPACE MODE? AND B4 LOOK FOR SZA,RSS JMP P.94 NO, CONTINUE XOR EQ19,I YES,BACKSPACE MODE STA EQ19,I KNOCK OUT BIT 2 LDA BIT15 START READ JMP RTNW UPON RETURN P.94 LDA EQ19,I CHECK FOR R/LF DELAY MODE AND B3 CHECK FOR STALL SZA JMP STALL WE MUST DELAY CPA EQ10,I BUFFER EMPTY ? JMP EOR YES; OUTPUT END OF RECORD P.95 LDB EQ9,I GET BYTE POINTER ISZ EQ9,I CLE,ERB JSB MAPRD GET NEXT CHARACTER SEZ,RSS ALF,ALF AND B177 ISZ EQ10,I END OF BUFFER JMP RTNW NO, CONTINUE CPA BA YES; BACK ARROW? RSS YES OMIT R/LF JMP RTNW OUTPUT CHARACTER LDA EQ8,I GET TRANSMISSION SSA LOG AND CMA,INA MAKE POSITIVE IF NEEDED STA EQ6,I JSB GEND TELL P GOOD END JMP RTNW1 FORCE TIMEOUT * CD NOP LDA EQ19,I GET CR DELAY ALF (R02) COUNT ANn<D B17 CMA STA EQ10,I LDA EQ19,I SET AND DMASK (R02) CR DELAY IOR B (R02) PUT IN FLAG INA MODE STA EQ19,I IN STATUS JMP CD,I * * END OF OUTPUT PROCESSOR * EOR CLB (R02) WRITE FLAG JSB CD SET UP EQT FOR STALL LDA RETN SEND CR RTNW LDB SAVEA IS THIS INIT.?? CPB DM1 IOR BIT14 YES, START WRITE RTNW0 LDB EQ14,I ISZ LWRET RET TO P.D. RTNW1 JMP LWRET,I * SKP * * STALL PROCESSING * STALL ISZ EQ10,I BUMP STALL COUNT JMP P.14 CONTINUE STALL LDA EQ19,I GET STATUS SLA,RSS JMP P.13 LINE FEED DELAY SO FINISHED INA SWITCH STA EQ19,I TO LINE ALF,ALF (R02) DELAY ELA,RAR (R03) SET E=READ/WRITE FLAG AND B17 CMA LF DELAY COUNT STA EQ10,I AND SET COUNTER LDA EQ24,I IS THE ECHO CMA BIT, BIT 12 OFF? AND BIT12 SZA,RSS (R03) JMP *+3 (R03) ECHO ON LDA BIT12 (R03) DOING READ? SEZ,RSS (R03) LDA LF (R03) NO, OUTPUT LF JMP RTNW RETURN TO P.D. * P.13 EQU * LDA EQ19,I AND DM4 CLEAR DELAY MODES STA EQ19,I LDB EQ6,I CHECK RUBOUT FLAG RBL,CLE,SLB,ERB JMP P.6 WE GOT RUBOUT JSB GEND TELL P. GOOD END JMP RTNW1 WRITE; FORCE T/O P.14 EQU * LDA BIT12 SEND NULL JMP RTNW RETURN TO WRITE HED 12920A-B TABLES AND CONSTANTS * * TABLES AND CONSTANTS * UNIT BSS 1 CURRENT PORT SAVSC BSS 1 SELECT CODE LOADR DEF LODVR IS00A DEF IS00 SC EQU 10B DUMMY SC, RE-DONE BY CONFG AND A INTER. SPEED NOP SENSED SPEED OF CURRENT PORT COUNT OCT 0 GENERAL COUNTER B20 OCT 20 CMB12 OCT 167777 BIT7 OCT 200 BIT11 OCT 4000 BIT12 OCT 10000 BIT13 OCT 20000 BIT14 OCT 40000 B2 OCT 2 B3 OCT 3 B5 OCT 5 B7 OCT 7 1805 B37 OCT 37 B40 OCT 40 B77 OCT 77 B100 OCT 100 B377 OCT 377 RHALF EQU B377 ECLM OCT 177601 NB33 OCT -33 DM1 DEC -1 DM4 DEC -4 DM500 DEC -500 1805 SPC 2 SSAB OCT 140114 LOWER SA FOR HALF DUPLEX SEND. SCDAB OCT 140334 RAISE CD & LOWER CA - 202 RECEIVE. SCDAS OCT 140365 SUPPRESS CF INTERRUPTS. SSAF OCT 140134 RAISE SA ENABLE FOR CB AND SB=0. * RPARI OCT 120000 1805 SBITP DEF *+1 STOP BIT ADDRESS 1805 OCT 43400 1805 EVEN OR NO PARITY OCT 43600 1805 ODD PARITY SPC 2 * * SET UP THE EQT FOR 12920A-B * CF920 EQU * NOP LDB SBITP ADDR OF STOP BITS LDA EQ22,I AND B60 STA SAVEX SAVE PARITY ITEM CPA B20 ODD PARITY? INB YES BUMP TO S.B. OF 43600B CPA B60 PAD BIT 7 ?? INB YES LDA B,I GET S.B. WORD STA EQ20,I SAVE DEVICES STOP BITS. LDA EQ22,I AND B17 CALC. ADA B2 1 START AND 1 STOP BIT. STA B LDA EQ22,I AND BIT8 LOOK FOR STOP BITS SZA 2 STOP BITS? INB YES. LDA SAVEX NO. ONE. CHK PARITY. SZA PARITY ON? INB YES. STB A ADA DM1 AND B7 SAVE 3 BITS ONLY. ALF,ALF LENGTH STA EQ24,I SAVE CHAR LENGTH LDB SAVEX CPB B60 JMP *+3 SZB PARITY ON ? IOR BIT12 YES. PARITY PARAMETER. IOR TPARI SET TRANSMIT AND PARAMETER BITS. STA EQ25,I SAVE PARTIAL TRANS/PARM NO. LDB EQ22,I GET DIRECTOR LDA EQ24,I GET REC PRAM BLF,BLF LOOK AT SIGN SSB FOR ECHO?? IOR BIT12 YES IOR RPARI PUT IN REC ENAB BITS STA EQ24,I RESTOR TO EQT JSB CF92B T  GO SET SPEED * OUTPUT PARAMETERS COMPLETED. CLA STA EQ21,I STA EQ23,I STA EQ16,I INITIALIZE OTHER STA EQ12,I COUNTERS JMP CF920,I RETURN. * * SET THE SPEED PRAMETERS AND ECHO * CF92B EQU * NOP LDA EQ11,I FIND TRANSMIT AND B377 SPEED SZA,RSS ANYTHING THERE? JMP CF92C NO, LEAVE UNCHANGED CPA B110 110 BAUD?? IOR BIT8 YES,BUMP CHAR COUNT FOR 2 STOP BITS STA B YES, SAVE LDA EQ25,I GET CURRENT JSB SZCK CHECK SIZE ADA B PUT IN NEW STA EQ25,I RESTORE CF92C LDA EQ11,I FIND THE ALF,ALF RECEIVE AND B377 PARAMETER SZA,RSS ANYTHING THERE? JMP CF92D NOPE,CONTINUE CPA B110 110 BAUD?? IOR BIT8 YES, BUMP CHAR SIZE STA B SAVE TEMP LDA EQ24,I GET OLD JSB SZCK CHECK SIZE ADA B AND IN NEW STA EQ24,I SAVE CF92D CLA CLEAR STA EQ11,I LOC FOR TO ROUTINE JMP CF92B,I RETURN * * SZCK NOP STA COUNT SAVE TEMP AND RHALF LOOK AT BAUD RATE CPA B110 IS IT 110BAUD?? JMP SZCK0 YES, DEC. CHAR COUNT LDA COUNT NO, MASK FOR NEW SPEED AND LHALF JMP SZCK,I RETURN SZCK0 LDA COUNT GET PRAM AND LHALF MASK OUT SPEED ALF,ALF MOVE TO LOWER ADA DM1 DEC. CHAR SIZE BY 1 ALF,ALF MOVE BACK TO UPPER JMP SZCK,I RETURN * SPC 2 B36K OCT 36000 B76K OCT 76000 * * SRSCU - SAVES RETURN ADDR, SC, CONFIGURES OUTPUT ROUTINE FOR * OUTCC SUBROUTINE AND ACKNOWLEDGEMENT INSTRUCTION. * * CALLING SEQUENCE: LDB X00YZ INTERRUPT ENTRY ADDR. * JSB SRSCU SPC 1 SRSCU EQU * NOP STB RTADD SAVE RETURN ADDR. LIA 4 STA SAVSC bK SAVE SELECT CODE. IOR CLFAC CONFIGURE INTERRUPT STA CLFSC ACKNOWLEDGEMENT INST 1031XX XOR B1400 CONFIGURE LIA INST. 1025XX 1805 (R01) STA *+1 NOP STA DATA AND B76K STRIP OUT LDB SAVSC SEE IF EITHER CPB SAVS1 MUX DATA #1 RSS YES IFZ CPB SAVS2 MUX DATA #2 RSS YES XIF 1805 AND B36K NO KNOCK OUT BIT 14 STA UNIT UNIT AND RT. ALF JUSTIFY UNIT #. RAL,RAL IFZ 1805 LDB SAVS2 WHICH MUX CAUSED CMB,INB,SZB,RSS JMP MUX1 MUX #1 ,NO MUX#2 ADB SAVSC SSB,RSS ADA B20 MUST BE MUX #2, BUMP 16 XIF 1805 MUX1 STA DUNIT CMA,INA STA NDUNT JMP SRSCU,I * * * SETP SETS POINTERS TO CURRENT ENTRY PLUS ITS EXTENSIONS * * CALLING SEQUENCE: LDB ADEQT ADDR OF CURRENT EQT ENTRY * JSB SETP SPC 1 SETP EQU * NOP RBL,CLE,ERB CPB EQ1 ALREADY SET UP? JMP SETP,I YES, DON'T SET EQT'S STB EQ1 NO, UPDATE EQ'S ADB B4 1805 LDA WORK LOOP1 STB A,I INB INA CPA E16A LAST+1 1805 RSS DONE 1805 JMP LOOP1 * LDB EQ13,I LOOP2 STB A,I CPA E26A SEE IF LAST ONE 1805 JMP SETP,I RETURN 1805 INB INA JMP LOOP2 * WORK DEF EQ5 WORKING BUFFER ADDRESS 1805 E16A DEF EQ16 POINTS TO EQ16 1805 E26A DEF EQ26 POINTS TO EQ26 1805 DM16 DEC -16 HED PRIVILEGED INTERRUPT PROCESSING * * P00D1 - PROCESSES DATA INTERRUPTS FROM MUX # 1. * P00D1 EQU * NOP CLF 0 JSB SAVAL SAVE A,B,E, AND O. LDB P00D1 JSB P00DA 1805 ADA DM16 ADD -16 BASE 10 SSA UNIT # < 16 ? JMP P00D0 8PYES. LDB LASM1 IGNORE SPURIOUS INTERRUPTS IN SETUP 1805 P00DB EQU * 1805 ADA SPNTR FIND RIGHT SPEED FROM TABLE 1805 LDA A,I 1805 STA SPEED DIAG. SPEED 1805 SZB,RSS IF LASMX = 0, RETURN 1805 JMP RTN 1805 JSB SETP SET EQT POINTERS 1805 LDB EQ26,I 1805 SSB,RSS AUTO SPEED ACTIVE FOR THIS DEVICE? 1805 JMP RTN NO 1805 JMP P.00D GO PROCESS CHAR FOR AUX CHNLS * P00D0 ADA B20 ADD +16 JSB P00DC FIX UP EQT STUFF 1805 SSA AUTO SPEED REQUIRED FOR THIS MAIN? 1805 STB LASM1 NO - UPDATE LAST MAIN. 1805 JMP P.00D * * P00DC NOP FIX UP EQT'S IN AUTO SPEED 1805 ALF ADA NDUNT ADA EQT0 TO FIND THE LDB A,I PROPER EQT. SZB,RSS EQT ENTRY = 0 ? JMP P00DD YES. LDB A GET EQT ADDRESS JSB SETP LDB EQ1 LDA EQ26,I JMP P00DC,I RETURN 1805 * * P00DA NOP SET DEFAULT SPEED & SAVE ADDRESSES 1805 JSB SRSCU SAVE RTN ADDR,SC,ETC. 1805 LDA B5 MAIN SPEED 1805 STA SPEED SAVE IF THIS IS IT 1805 LDA DUNIT GET UNIT 1805 JMP P00DA,I RETURN 1805 * * * B14 OCT 14 1805 * P00DD ADA B14 FIND LDB A,I ADDR OF EXTENT ADB B5 AND SAVE ADA B2 BUMP TO STA COUNT EQT15 ADDRESS FOR TO 1805 LDA DATA CAUSED THE INT AND RHALF MASK OUT UPPER STA TSAVE (R10) SAVE CHAR LDA B,I (R10) GET EQ21 WORD AND LHALF (R10) SAVE STATUS IOR TSAVE (R10) MERGE WITH CHAR STA B,I SAVE IN EQ21 FOR SCHED CCA TIME OUT RETURN STA COUNT,I ON NEXT CLOCK 1805 JMP RTN TSAVE NOP (R10) SKP * * P00D2 PROCESSES DATA INTERRUPTS FROM MUX # 2. * IFZ DM32 DEC yY-32 1805 SPC 1 P00D2 EQU * NOP CLF 0 JSB SAVAL SAVE A,B,E, AND O. LDB P00D2 JSB P00DA SET STUFF UP 1805 ADA DM32 ADD -32 BASE 10 SSA UNIT # < 16 ? JMP P00DR YES. LDB LASM2 IGNORE SPURIOUS INTERRUPTS DURING SETUP JMP P00DB USE COMMON CODE 1805 * P00DR EQU * ADA B40 RESTORE UNIT #. JSB P00DC FIX UP EQT'S, ETC. 1805 SSA STB LASM2 JMP P.00D LASM2 NOP LAST MAIN TO INT. FOR MUX#2 1805 SAVS2 NOP MUX#2 S.C. 1805 XIF LASM1 NOP LAST MAIN TO INT. FOR MUX#1 1805 SAVS1 NOP MUX#1 S.C. 1805 SKP * * P00C1 - PROCESSING INTERRUPT FROM MUX #1 CONTROL BOARD # 1. * P00C1 EQU * NOP CLF 0 JSB SAVAL SAVE ENVIRONMENT LDB P00C1 P00CA EQU * JSB CISUB SAVE RETURN ADDR,SC, CONFIG. ETC. ALF ADA NDUNT ADA EQT0 ADDR OF EQT TBL JMP P.00C SKP * * P00C2 - PROCESSES INTERRUPTS FROM MUX # 1, CONTROL BOARD # 2. * P00C2 EQU * NOP CLFAC CLF 0 1805 JSB SAVAL SAVE ENVIRONMENT LDB P00C2 JMP P00CA SKP * * P00C3 - PROCESSES INTERRUPTS FROM MUX # 2. CONTROL BOARD # 1. * IFZ SPC 1 P00C3 EQU * NOP CLF 0 JSB SAVAL LDB P00C3 STB P00C1 FLAG FOR CONTROL BOARD 1 JMP P00CA 1805 SKP SPC 1 * * P00C4 - PROCESSES INTERRUPTS FROM MUX # 2, CONTROL BOARD # 2. * P00C4 EQU * NOP CLF 0 JSB SAVAL LDB P00C4 JMP P00CA 1805 XIF SKP * * P.00C IS CALLED BY P00C1-4 TO COMPLETE CONTROL BOARD * INTERRUPT PROCESSING. * SPC 2 P.00C EQU * LDB A EQT ADDRESS JSB SETP SET POINTERS LDA DATA JSB OUTCC JSB UPD23 UPDATE EQT23. (CURRENT LINE ST>ATUS. LDB EQ22,I WHICH CONTROL SIGNAL CHANGED ? SSB FULL DUPLEX TERM? JMP P00C9 YES. LDA EQ26,I AND B60 SZA,RSS XFLG = 0 ? JMP ERTN YES. EXIT. CPA B20 TRANSITION STATE = RECEIVE ? JMP PC1 YES. CHK LINE OPEN STATUS. JSB FCL12 NO. TRANSITIONING TO SEND STATE. CPA B1 CC UP AND CF DOWN? RSS YES JMP RTN NO LDA EQ26,I LOOK FOR LINE TURN AND B3 TO FROM READ TO WRITE-FIRST TIME SZA,RSS JMP P00C8 NOT FIRST TIME XOR EQ26,I REMOVE FIRST TIME STA EQ26,I FLAG LDA EQ22,I IS THIS HALF DUPLEX AND BIT14 WITH SECONDARY SZA,RSS CHANNEL? JMP P00C8 NO THE NEXT COMMANDS ALREADY GIVEN LDA SCDAS DIS CF, CC,CA=1, ENAB CD=0 JSB COUT TO MUX CONT. #1 JMP RTN P00C8 STB A YES. CHKCB AND SB. AND B3 CPA B3 "CB AND SB" UP ? JMP PC2 YES. JMP RTN NO. WAIT FOR THEM. * * PROCESS FULL DUPLEX INTERRUPTS HERE. * SPC 1 P00C9 EQU * LDA EQ26,I AND B60 SZA,RSS DO WE EXPECT THIS INTERRUPT? JMP ERTN NO JSB CLINE GO CHECK THE LINE SSB,RSS CC AND CF UP? JMP PC2 YES. COMPLETE LINE OPEN. JMP RTN NO. EXIT. * * PROCESS LINE OPEN RECEIVE/AUTO SPEED FOR HALF DUPLEX DEVICES. * SPC 1 PC1 EQU * JSB CLINE SSB LINE STATUS = RECEIVE? JMP PC5 PC2 LDA EQ26,I SSA AUTO-SPEED IN PROGRESS? JMP RTN YES. WAIT FOR DATA INTERRUPTS. ALF,SLA IS THIS LINE OPEN - BIT 12 ON? RSS JMP PC3A NO,LINE TURNAROUND PC3 LDA DM200 YES, WAIT 2 SECONDS 1805 9/30/77 JMP COM06 EXIT AND WAIT FOR TIMEOUT. 1805 PC3A SSA SPECIAL XFER TO READ? JMP PC4 YES, LETž T.O. DO WORK LDA EQ26,I IS THIS A WRITE AND B60 CPA B40 OR A READ JMP PC4 WRITE, LET T.O.DO WORK IFZ 1805 LDB SAVS1 GET MUX #1 SC LDA SAVS2 MUX #2 SC CMA,INA,SZA,RSS JMP PC3B USE MUX #1 SC ADA SAVSC IS THIS MUX #2? SSA,RSS LDB SAVS2 YES USE #2 PC3B STB SAVSC SAVE SC JSB CONFG GO CONFIGURE XIF 1805 CLA,INA SET STATE READ STA EQ26,I RESTORE LDA EQ24,I RE-ENABLE FOR JSB OUT READ CLA CLEAR TIMERS JMP COM06 AND EXIT 1805 PC4 CCA STA EQ15,I SET SYSTEM AND STA EQ16,I PHYSICAL FOR NEXT TICK. JMP RTN RETURN PC5 LDA EQ26,I LINE OPEN OR TURN ALF,SLA BIT 12 ON IF OPEN JMP PC3 OPEN, WAIT 2 SEC MORE. LET T.O. DO WORK JMP RTN LINE TURN * DM200 DEC -200 1805 FSTAT NOP * * * LINE ERROR DURING READ OR WRITE * ERTN EQU * IFZ LDB SAVS1 GET 1ST MUX S.C. LDA DUNIT SEE IF REQ FOR AND B20 1ST OR 2ND MUX (BIT 4) SZA WELL??? LDB SAVS2 2ND MUX STB SAVSC (R06) SET BASE SELECT CODE JSB CONFG GO CONGIGURE XIF LDA EQ21,I FIND OUT AND BIT14 WHAT HAPPENED SZA,RSS IS SOMETHING IS WRONG JMP ERT1 NO MUST BE BREAK JSB LCS1 YES, CLOSE THAT LINE...NOW. CLA NOW RESET THE PHYSICAL STA EQ16,I TIME-OUT CLOCK CCA TIMEOUT TO TELL STA EQ15,I OPERATOR OR SYSTEM ERT1 LDA EQ1,I IS THERE A PROGRAM WAITING?? SZA,RSS JMP RTN RETURN TO SYSTEM CLA NOW SEE IF THE LINE WAS IN LDB EQ6,I READ OR WRITE SLB,RSS JMP P00WR TRYING TO DO WRITE JMP P00RR TRYING TO DO READ SKP * P.00D IS USED TO PROCESS ALL DATA INTERRUPTS. * BOTH P00D1 AND P00D2 CALL P.00D TO COMPLETE DATA INTERRUPT * PROCESSING. * SPC 1 P.00D EQU * LDA EQ26,I AND B60 SZA DROP DATA INTER. DURING TRANSITION. JMP RTN LDA EQ19,I (R02) TRYING TO COMPLETE? AND B40 (R02) SZA (R02) JMP RTN (R02) YES, IGNORE ALL INTS! IFZ 1805 JSB CONFG CONFIGURE I/O INSTRUCTIONS. XIF 1805 LIB21 LIB SC+1 = CURRENT DATA STATUS. 1805 STB FSTAT SPC 1 LDB EQ26,I SSB AUTO-SPEED IN PROGRESS? JMP P00CR YES. SLB,RBR LINE STATE = RECEIVE ? JMP RDSTA YES. SLB,RSS NO. LINE STATE = SEND ? JMP RTN ERROR. SPC 2 * CHECK STATUS FOR WRITE REQ. DATA BOARD INTERRUPT. SPC 1 LDA EQ22,I SSA,RSS FULL DUPLEX ? JMP CWST1 NO. SKIP DATA STATUS TEST. LDB FSTAT GET DATA STAUTS. SLB,RSS INTERRUPT DUE TO DATA XMIT ? JMP BKCHK NO. RECEIVED DATA. CHK BREAK. CWST1 CLA YES. JMP P00WR CONTINUE WRITE. SPC 1 * CHECK DATA FOR BREAK CHAR (10 ZEROS IN LSB) SPC 1 BKCHK EQU * LDA DATA IF 10 LSB OF AND B1777 DATA = 0, THEN SZA BREAK. JMP RDSTA NO BREAK DETECTED. PAUSE? LDA BIT12 SET BREAK STATUS BIT. JMP P00WR CALL LOGICAL DVR. * B1777 OCT 1777 B50T OCT 50000 1805 SPC 1 * CHECK STATUS FOR READ REQUEST DATA BOARD INTERRUPT. SPC 1 RDSTA EQU * LDB FSTAT GET DATA STATUS. SLB IF X-MIT INTERRUPT RETURN. JMP RTN LDA DATA (R02) CHECK FOR BRK ON READ AND B1777 (R02) SZA,RSS (R03) TEN ZEROS ??? JMP RTN (R02) YES, IGNORE BREAK CLA RBR,SLB LOST CHAR INDICATED ? IOR BIT13 YES. DATA ERROR.ƅ STA SAVEX LDB EQ22,I BLF,BLF BLF,SLB ODD PARITY ? JMP RDOPC YES. CHK PARITY BIT. RBR,SLB EVEN PARITY ? JMP RDEPC YES. RDST1 LDA DATA PARITY OFF !!! AND RHALF MERGE STATUS IOR SAVEX WITH CHAR AND JMP P00RR CALL LOGICAL DVR. RDOPC EQU * ODD PARITY CHECKING ROUTINE. LDB DATA SSB,RSS ODD PARITY INDICATED? RDOPE IOR BIT13 NO. EVEN. ERROR!!!! RDOKP STA SAVEX YES. - PARITY OK JMP RDST1 SPC 1 RDEPC EQU * EVEN PARITY CHECKING ROUTINE. LDB DATA SSB EVEN PARITY INDICATED ? JMP RDOPE NO. ODD. ERROR !!!! JMP RDOKP YES. - OK SPC 1 * CALL LOGICAL DVR WITH CHARACTER AND STATUS FROM PHYSICAL DVR. (READ REQ.) SPC 1 P00RR EQU * LDB EQ17,I LOGR DVR ADDR ADB B2 STB LOGR SAVE STA SAVEX SAVE A RTE33 JSB RTE3C SWAP MAP IF USER AREA LDA EQ21,I GET LINE STATE AND B50T SAVE BITS 12 AND 14 IOR SAVEX RESTORE FOR LOGICAL DRIVER STA EQ21,I LDB EQ1 JSB LOGR,I INDICATING CONTINUATION JMP COM00 COMPLETION RETURN 1805 STA DADIR JSB SRTIM RAL,SLA START READ DIRECTIVE ? JMP P00SR YES. RAL,SLA START WRITE DIRECTIVE ? JMP P00SW YES, START WRITE RAL,SLA BIT 13? JMP COM05 YES, CONTINUE SSA BIT 12?? JMP NOOP YES, WRITE NULL JMP COM05 CONTINUE SPC 2 * START A READ OPERATION DIRECTIVE ISSUED BY LOGICAL * DRIVER IN RESPONSE TO BEING CALLED FROM P00D(PRIVILEDGED * INTERRUPT DATA PROCESSOR. SPC 1 P00SR EQU * JSB LNCK GO CHECK THE LINE JMP COM01 BAD LINE LDA DADIR IS IT AND BT152 START READ WITH CPA BT152 ECHO? JMP P00S1 YES LDA EQ22,I FIND OUTX IF AND BIT7 IF ECHO IS REQUESTED ALF,RAL MOVE TO POS 12 STA B SAVE LDA EQ24,I GET REC PRAM. AND CMB12 CLEAR ECHO IF ON IOR B UPDATE STA EQ24,I AND RESTORE JMP P00S2 P00S1 LDA EQ24,I GET REC PRAM. AND CMB12 TAKE OUT ECHO STA EQ24,I RESTORE P00S2 JSB SR202 TURN LINE AROUND TO READ STATE. JMP COM05 EXIT. BT152 OCT 104000 1805 SPC 1 * START A WRITE OPERATION DIRECTIVE ISSUED BY LOGICAL * DRIVER IN RESPONSE TO BEING CALLED FROM P00D. SPC 1 P00SW EQU * JSB LNCK GO CHECK THE LINE JMP COM01 BAD LINE JSB SW202 JMP P00SX LINE ALREADY = SEND STATE. JMP COM05 TURNING LINE TO SEND STATE. P00SX LDA DADIR AND RHALF JSB CHAR OUTPUT CHAR JMP COM05 SPC 2 * CALL LOGICAL DVR WITH STATUS FROM PHYSICAL DVR. (WRITE REQ.) SPC 1 P00WR EQU * LDB EQ17,I LOG ADDR ADB B4 STB LOGR SAVE STA SAVEX SAVE A RTE35 JSB RTE3C SWAP MAP IF USER AREA LDA EQ21,I GET LINE STATE AND B50T SAVE BITS 12 AND 14 IOR SAVEX RESTOR FOR LOGICAL DRIVER STA EQ21,I LDB EQ1 JSB LOGR,I CALL TO LOGICAL DVR. JMP COM00 COMPLETION RETURN 1805 STA DADIR TO BE OUTPUT & DIRECTIVES. JSB SRTIM RAL,SLA START READ DIRECTIVE ? JMP P00SR YES. RAL,SLA NO. DIRECTIVE = START WRITE? JMP P00SW YES. RAL,SLA NOP? JMP COM05 RETURN, IGNORE INTERRUPT SSA NULL REQUESTED? JMP NOOP YES. SEND NULL JMP P00SX NO. CONTINUATION. SPC 1 * PROCESS AUTO SPEED SPC 1 P00CR EQU * LDA DATA GET INPUT AND RHALF CHAR. AND STA B LDA EQ21,I AND RHALF MASK CPA B LOOK LIKE EQ21 ENTRY? RSS  YES JMP RTN NO, RETURN FOR NEXT LDA EQ26,I GET LINE STATE WORD IOR BIT8 TURN ON AC COMPLETE STA EQ26,I RESTORE LDA SPEED THIS IS IT ALF,ALF GET THAT SPEED IOR SPEED AND ADJUST IT STA EQ11,I SAVE FOR THE JSB CF92B SPEED SET ROUTINE JMP COM04 COMPLETE RETURN * * * * SEND NULL CHAR FOR STALL * NOOP LDA EQ20,I GET STOP BITS IOR B4377 TURN ON SYNC BIT JSB OUT SEND OUT JMP COM05 RETURN * B4377 OCT 4377 * * HED ASYNC MUX UTILITY ROUTINES * * COMMON RETURN * RTN EQU * LDA SAVEO CLO SLA,ELA STF 1 REGISTERS CLA STA P00C1 LDB SAVB RESTORE B CLFSC CLF SC ACKNOWLEDGE INTERRUPT RTE34 JMP RTE3D OVERLAID IF RTE-II LDA MPFSV LOOK AT MP FLAG SZA,RSS SYSTEM; WAS IT ON? JMP RTN2 YES LDA SAVA RESTORE A REG STF 0 ENABLE INTERRUPTS JMP RTADD,I AND RETURN RTN2 LDA SAVA RESTORE A REG STF 0 ENABLE SYSTEM STC 5 AND MP JMP RTADD,I EXIT * * RTE3D LDX XSV RESTORE PREVIOUS STATE OF CPU LDY YSV LDA UMPFL WERE USER MAPS SWAPPED? SZA,RSS JMP *+3 NO NEED TO RESTORE USER MAP LDA MAPAD YES POINT TO OLD MAP SAVE AREA USA RELOAD THE OLD MAP LDA MPFSV WAS MP FLAG ON?? SZA,RSS JMP RTN3 YES TURN ON MP LDA SAVA RESTORE A STF 0 TURN ON INT SYS. JRS DMSTS RTADD,I RELOAD STATUS, OLD MAP &RETURN RTN3 LDA SAVA RESTORE A STF 0 INT. SYS. ON STC 5 MP ON JRS DMSTS RTADD,I RELOAD STATUS, OLD MAP & RETURN * * RTE3B NOP SSM DMSTS SAVE STATUS OF MEMORY MAPPING SYSTEM CLA STA UMPFL CLEAR USER MAP SWAP FLAG JUST IN CASE STX XSV  SAVE X&Y STY YSV JMP RTE3B,I * * RTE3C NOP MAP SWAP SUBROUTINE LDX DUNIT GET PORT # LBX MAPTB GET USER ID ADDRESS ( 0 FOR NO USER MAP) SZB,RSS NEED TO SWAP USER MAP? JMP RTE3C,I NO! STB UMPFL SET USER MAP RESTORE FLAG TO NON-ZERO LDA MAPAD POINT TO TEMPORARY STORAGE AREA FOR CRNT IOR BIT15 USER MAP, AND SET SIGN BIT TO USA UNLOAD OLD USER'S MAP. RESTORE ON EXIT LDA B GET ID SEGMENT ADDRESS JSB $PVMP ATTEMPT TO LOAD MAP OF CURRENT USER ID. SZA,RSS IF A#0 THEN MAP LOADED OK. JMP RTN FATAL ERROR (USER NOT IN MEMORY). * THEN DO NOT TRANSFER A CHARACTER, BUT MERELY IGNORE * THIS INTERRUPT. RTE-3 WILL HOUSEKEEP THE EQT FOR YOU * LDA EQ1 SET EQ1 NEG CMA,INA AS A FLAG STA EQ1 JMP RTE3C,I RETURN WITH USER MAP ENABLED MAPAD DEF MAPSV * SPC 2 * LOGR ISSUED A "START WRITE" DIRECTIVE WHEN CALLED FROM I.73 TO * INITIATE A WRITE I/O REQ. SPC 1 SWRIT EQU * JSB LNCK LINE STATUS = DOWN ? JMP BADLN YES JSB SW202 NO. LINE IN SEND STATE ? RSS YES. SKIP NEXT INSTRUCTION. JMP EXIT1 NO. LINE BEING TURNED TO SEND LDA DADIR GOOD LINE STATUS: AND RHALF JSB CHAR OUTPUT CHAR JMP EXIT1 SPC 1 * START WRITE ON A HALF DUPLEX LINE (202 MODEM). * RETURN: P+1 = LINE IN SEND DIRECTION (READY). * P+2 = LINE NOT IN SEND DIRECTION. SPC 1 SW202 EQU * NOP LDA EQ25,I GET TRANS PRAM JSB OUT SEND TO MUX LDB EQ22,I SSB,RSS FULL DUPLEX LINE? JMP SW20A NO. HALF DUPLEX. LDA EQ24,I YES. AND CMB12 INHIBIT ECHO JSB OUT ENABLE INTERRUPTS ON READ CHNL. LDA EQ19,I (R08) MODEM ENABLED? AND BIT3 (R08) SZCMA (R08) LDA DM4 (R08) STA B (R08) SET MASK 0=HW, -4=MODEM LDA EQ26,I (R07) SET TO SEND STATE.. AND B (R08) ..BUT DON'T CLEAR MODEM BIT UNLESS HARDWIRED ADA B2 (R07) STATE = SEND. STA EQ26,I SW20A EQU * LDA EQ26,I CPA B2 LINE ALREADY IN SEND STATE? JMP SW202,I YES. RETURN. SPC 1 * TURN OFF READ CHANNEL INTERRUPTS DURING WRITES !!!!! SPC 1 LDA BIT15 INHIBIT INTS. DURING T.A. JSB OUT OUTPUT NEW PARMS. TO MUX . SPC 1 LDA SSAB AND LOWER SA JSB COUT2 LDA EQ22,I IS THIS HALF-DUPLEX AND BIT14 WITHOUT SECONDARY SZA CHANNEL? JMP SW20B NO, COMMANDS TO BE GIVEN LATER LDA SCDAS DISABLE CF,CD=1,CA=1,ENABLE CC=0 JSB COUT OUT TO MUX SW20B LDA DADIR GET DATA AND DIREC. AND RHALF KEEP DATA STA B SAVE LDA EQ21,I EQT ENTRY AND LHALF SAVE STATUS IOR B BUILD NEW STATUS AND DATA FOR STA EQ21,I LINE TURN AROUND LDA EQ26,I SET IOR B40 STATE FLAG STA EQ26,I = SEND (2). LDB DM500 DELAY UP TO 5 SECONDS 1805 STB EQ16,I 1805 ISZ SW202 JMP SW202,I * * CHECK LINE AND * REPORT BAD LINE TO SYSTEM * LNCK NOP LDA EQ26,I SEE IF LINE IS AND B3 IN TRANS, OR REC. SZA,RSS JMP LNCK,I NO, LOOKS BAD LDA EQ21,I LOOK FOR BAD LINE AND BIT14 IN THE LINE STATUS SZA JMP LNCK,I LOOKS BAD RETURN ISZ LNCK LOOK OK BUMP FOR JMP LNCK,I RETURN * * REPORT BAD LINE TO SYSTEM * BADLN CCA STA EQ15,I TIME OUT TO JMP EXIT2 TELL OPERATOR OR SYSTEM * * SPC 1 * READ SPC 1 SREAD EQU * JSB LNCK LINE DOWN ? JMP BADLN YES JSB SR202 6NO. TURN LINE TO RECEIVE STATE. JMP EXIT1 RETURN TO RTE. SPC 1 * THIS SUBROUTINE TURNS HALF DUPLEX LINES TO THE RECEIVE DIRECTION * * RETURN: * A=1 = LINE ALREADY IN RECEIVE DIRECTION. 1805 * A=0 = LINE IN PROCESS OF BEING TURNED TO RECEIVE DIRECTION. SPC 1 SR202 EQU * NOP LDB EQ22,I SSB,RSS FULL DUPLEX? JMP SR20A NO. HALF DUPLEX. LDA EQ19,I (R08) MODEM ENABLED? AND BIT3 (R08) SZA (R08) CONFIGURE MASK LDA DM4 (R08) STA B (R08) SAVE LDA EQ26,I (R07) SET LINE TO RECEIVE.. AND B (R08) WITHOUT TOUCHING MODEM BIT UNLESS HARDWIRED INA (R07) SET LINE STATE TO READ STA EQ26,I LDA EQ24,I JSB OUT SPC 1 * TURN ON READ CHANNEL INTERRUPTS DURING READS !!!!! SR20A EQU * LDA EQ26,I CPA B1 ALREADY THERE? JMP SR202,I LDA BIT15 INHIBIT INTS. DURING T.A. JSB OUT INHIBIT INT THIS PORT DURING LINE T.A. LDA SSAF SA=1, ENAB SB=0,CB=0 JSB COUT2 TO MUX CONT. #2 LDA SCDAB NO. TURN LINE AROUND JSB COUT KEEP CD AND LOWER CA LDA EQ26,I SET ITEM SR (START READ IOR B20 LINE STATE = RECEIVE STA EQ26,I LDB DM500 DELAY UP TO 5 SECONDS 1805 STB EQ16,I 1805 CLA CLEAR A FOR RETURN 1805 JMP SR202,I RETURN SPC 2 * SPC 2 * THIS SUBR UPDATES THE STATI OF BOTH CONTROL BOARDS. SPC 1 UPD23 EQU * NOP LDA DATA AND B3 STRIP UPPER BITS LDB RTADD CPB P00C1 BOARD # 1 INT. JMP P003 YES. LDB EQ22,I NO. BOARD # 2. SSB FULL DUPLEX? JMP RTN YES. ERROR. EXIT. P003 LDB EQ22,I UPDATE EQT23 SSB FULL DUPLEX? JMP P005 YES. LDB RTADD NO. CPB P00C1 CONTROL BOARD # 1 INT? JMP P004 YES. ALF,ALF NO. STA B BOARD # 2. LDA EQ23,I AND B3 KEEP BOARD # 1'S STATUS. JMP P005A P004 EQU * STA B LDA EQ23,I AND B1400 KEEP BOARD # 2'S STATUS. P005A IOR B P005 EQU * LDB EQ22,I RBL SSB,RSS IS SEC. CH. AVAILABLE ? IOR BIT8 NO. SET SEC. REC. (SB) ON. STA EQ23,I SET BOARD STATUS. SLB DEVICE HALF DUPLEX ? JMP TIMD1 NO. FULL DUPLEX. CLB YES. LDA EQ26,I AND B77 CPA B1 LINE IN RECEIVE STATE ? JMP P006R YES. CPA B2 LINE IN SEND STATE ? JMP P007W YES. JMP TIMD2 NO. GOOD STATUS. LET TIMPH TURN * THE LINE AROUND AND CHECK STATUS. P006R EQU * LDA EQ23,I CHK LINE STATUS SIGNALS. AND B1003 KEEP "CB,CF, AND CC". CPA B3 "CF AND CC" UP ? JMP TIMD2 YES. GOOD RECEIVE STATUS. JMP TIMD0 NO. BAD RECEIVE STATUS. SPC 1 P007W EQU * LDA EQ23,I CHK LINE STATUS AND B1401 KEEP "CB,SB, AND CC" . CPA B1401 "CB,SB, AND CC" UP ? JMP TIMD2 YES. GOOD SEND STATUS. SLA,RSS IS "CC" UP?? JMP TIMD0 NO,DATA SET IS DOWN ALF,ALF SLA "SB" DOWN ? 1805 USED AS CONSTANT (8) JMP TIMD0 NO. LINE ERROR. LDB BIT12 YES. BREAK. JMP TIMD2 TIMD1 EQU * FULL DUPLEX. CLB LDA EQ23,I AND B3 103 ,S SHOULD ALWAYS = B3. CPA B3 BOTH CF AND CC UP???? RSS TIMD0 LDB BIT14 LINE ERROR !!!!!!!!!! TIMD2 EQU * LDA EQ21,I SAVE LINE STATUS IN EQ21, LEFT HALF AND RHALF MASK IOR B PUT IN STATUS STA EQ21,I SAVE JMP UPD23,I RETURN. SPC 2 * CHECK LINE STATUS TO SEE IF HALF DUPLEX LINE HAS * COMPLETED LINEW\ TURNAROUND FROM SEND TO RECEIVE * * CLINE EQU * NOP * FETCH CONTROL STATUS AND FORMAT * I EXPECT THE FOLLOWING STATUS: * * * 1. CC (DATA SET READY) - UP * 2. CF (CARRIER) - UP * 3. CB (CLEAR TO SEND) - DOWN * JSB FCL12 AND B3 CPA B3 CC AND CF UP? JMP CLENY YES CLENX CCB NO JMP CLINE,I RETURN INDICATING BAD LINE CLENY LDA B AND B2 SZA CB DOWN? AND SB DON'T CARE JMP CLENX NO CLB INDICATE LINE IN READ STATE JMP CLINE,I RETURN * * B1003 OCT 1003 B1401 OCT 1401 B1400 OCT 1400 B7717 OCT 77717 1805 DM3 DEC -3 1805 DM30 DEC -30 1805 SPC 2 * * GET CONTROL LINE STATUS FOR HALF DUPLEX LINE * FCL12 EQU * NOP LDA EQ23,I AND LHALF ALF,ALF STA B LDA EQ23,I AND RHALF JMP FCL12,I * SPC 2 * INITIATE LOGICAL TIMER SPC 1 SRTIM EQU * NOP SSB,RSS INITIATE/RESET TIMING ? JMP SRTM1 AND RETURN. STB EQ12,I SET TIME OUT VALUE JMP SRTRN RETURN SRTM1 SZB,RSS LOOK FOR LEAVE SAME STB EQ12,I CLEAR LOG TIMER SRTRN LDB EQ21,I CLEAR ANY ELB,CLE,ERB TIME OUT STB EQ21,I FROM PAST JMP SRTIM,I RETURN. SPC 2 * * SETUP SUBROUTINE * SPC 1 TIMSB EQU * NOP CLA STA EQT15,I CLEAR CLOCK LDA EQT4,I FIND PORT NUMBER AND B37 GET 5 BIT PORT NUMBER JSB UNSET GO SET DUNIT,UNIT ETC. IFZ LDA DUNIT IS THIS MUX#1 OR MUX#2? AND B20 LOOK FOR THAT IN BIT 4 OF DUNIT LDB SAVS1 MUX#1 SELECT CODE SZA WELL?? LDB SAVS2 MUX#2 STB SAVSC SAVE FOR CONFIG. JSB CONFG CONFIGURE I/O INST. XIF 1805 JMP TIMSB,I RETU0RN * * SET DUNIT,NDUNT AND UNIT * * ENTER A=LOG. CHAN(SC) OR PORT NUMBER * UNSET NOP STA DUNIT CMA,INA STA NDUNT NEG OF DUNIT FOR EQT SEARCH CMA,INA MAKE POS AGAIN AND B17 TAKE ONLY LAST 4 BITS ALF,ALF SHIFT INTO HIGH ORDER RAL,RAL BITS 10-13 STA UNIT SAVE FOR OUTPUT JMP UNSET,I RETURN * * TIMRT HANDLES LOGICAL TIMEOUT * TIMRT JSB TIMSB LDA EQ21,I GET STATE FLAG IOR BIT15 SET LOGICAL TIME OUT STA EQ21,I FLAG TIMRX LDA EQ17,I ADDR OF LOG DVR LDB EQ6,I LOOK AT REQUEST SLB,RSS ADA B2 WRITE BUMP 4 ADA B2 STA LOGR SAVE IT LDA EQ21,I GET LAST LINE STAT+CHAR LDB EQ1 EQT ADDRESS IN B JSB LOGR,I THAT IT HAS TIMED OUT JMP C.11 ALLOW TIME OUT STA DADIR SAVE DATA-DIR. JSB SRTIM TRY AGAIN SSA,RSS START READ? BIT 15 JMP TWRIT NO JSB LNCK GO CHECK LINE RSS LOOKS BAD JMP TIMRG LOOKS GOOD JSB RECX1 OPEN LINE TO READ JMP TCONT FINISH UP TIMRG JSB SR202 START READ JMP TIMR1 MUST BE TURNED TWRIT RAL LOOK FOR SSA,RSS START WRITE. BIT 14 JMP TIMR1 ASSUME NOP, IGNORE JSB LNCK GO CHECK LINE RSS LOOKS BAD JMP TIMRH LOOKS GOOD JSB SENXP OPEN LINE TO WRITE JMP TCONT TIMRH JSB SW202 START WRITE RSS LINE IN WRITE JMP TIMR1 MUST TURN TO WRITE LDA DADIR GET DATA AND DIR. JMP TIMR4 OUTPUT LOWER 8 BITS TCONT LDA DADIR GET DATA AND RHALF KEEP RIGHT HALF STA EQ21,I SAVE AND CLEAR BAD LINE FLAG LDA EQ26,I TAKE OUT THE XOR BIT12 OPEN LINE FLAG STA EQ26,I JMP TIMR1 RETURN * * TIMPH HANDLES PHYSICAL TIMEOUTS * TIMPH EQU *  JSB TIMSB LDA EQ26,I AND B60 SZA TRANSITION STATE NE 0? JMP TIMR2 YES 9/30/77 LDA EQ26,I CHECK TO SEE IF AND BIT8 TIME OUT IS FROM AUTO SPEED SZA,RSS COMPLETION JMP C.11 NO,LAST CHANCE,SOMETHING WRONG XOR EQ26,I YES,COMPLETE AUTO SPEED STA EQ26,I UPDATE EQ26 JMP C.12 COMPLETION RETURN TIMR1 JSB E15ST SET UP EQT 15 JMP C.2 RETURN THROUGH CONT. * * CHECK LINE OPEN BIT-12 * TIMP1 NOP LDA EQ26,I LOOK FOR AND BIT12 LINE OPEN-CLOSE???? SZA JMP TIMP2 (R05) NO, CHECK LINE TURN AROUND COUNT ISZ TIMP1 BUMP FOR ZERO IN BIT 12 JMP TIMP1,I RETURN * TIMP2 ISZ EQT8,I (R05) INC TURN COUNTER JMP TIMP1,I (R05) STILL OK, RETURN JMP XOFF (R05) BAD LINE, ABORT * TIMR2 CPA B20 RECEIVE? 9/30/77 RSS CK STATUS 9/30/77 JMP TIMWR NO,CONTINUE 9/30/77 * * WE HAVE HAD A TIME OUT IN RECEIVE. CHECK STATUS IF NO CF TURN LINE * JSB CLINE GO CHECK LINE FOR READ SSB,RSS IS IT READ? JMP TIMR3 YES,WE ARE OK 9/30/77 JSB TIMP1 IS THIS A LINE OPEN? RSS YES GO TO SEND JMP XOFF NO. THEN CAN'T TURN LINE JSB SENXP NO,TURN THE LINE TO SEND 9/30/77 JMP TIMR1 EXIT 9/30/77 * TIMR3 EQU * LDA EQ24,I ENABLE READ PORT JSB OUT CLA,INA LINE STATE TO STA EQ26,I RECEIVE STATE. JMP C.12 COMPLETION RETURN * TURNING LINE TO SEND STATE. TIMWR EQU * LDA EQ22,I IS THIS FULL DUPLEX? SSA,RSS JMP TIMW1 NO, HALF-DULPLEX JSB CLINE YES, CHECK LINE SSB LINE OK. IF B IS POS JMP XOFF SɶOMETHING WRONG, TIMEOUT JMP TIMW2 LOOKS OK. CONTINUE TIMW1 JSB FCL12 SLA,RSS CC UP ? JMP XOFF NO. TIMEOUT STB A YES. AND B3 CPA B3 CB AND SB UP ? RSS YES. LINE IN WRITE STATE. SKIP. JMP XOFF TIME OUT TIMW2 LDA EQ26,I SET AND B1177 LINE STATE IOR B2 TO SEND. STA EQ26,I JSB TIMP1 LOOK FOR LINE OPEN JMP TIMR5 IT IS LINE OPEN, COMPLETE LDA EQ21,I TIMR4 AND RHALF OUTPUT CHAR JSB CHAR FROM LOGICAL DVR. JMP TIMR1 EXIT. TIMR5 JSB SR202 LINE OPEN READ AFTER JMP TIMR1 ANY LINE OPEN * B1177 OCT 117000 * * DOWN THE LINE, CAN'T TURN. * XOFF JSB LCS1 CLOSE THAT LINE. LDA EQ21,I NOW SET THE IOR BIT14 BAD LINE FLAG STA EQ21,I CLA CLEAR THE STA EQ16,I PHY COUNTER JMP TIMRX GO TELL LOGICAL-BAD LINE * * COMPLETION HOUSEKEEPING * COM00 EQU * JSB LNCK GO CHECK LINE JMP COM01 LOOKS BAD LDA EQ5,I SPECIAL CASE... BREAK... AND B100 LOOK FOR IT SZA IF ZERO (NOT BREAK) SET TO RECEIVE JMP COM01 YES, IS BREAK SKIP SETTING TO REC. JSB SR202 LEAVE WITH LINE IN RECEIVE SZA 1805 JMP COM01 ALREADY THERE LDA EQ26,I SET PSEUDO IOR BIT11 LINE OPEN MODE STA EQ26,I IN STATE FLAG JMP COM05 CONTINUE TILL LINE TURN COM01 CLA STA EQ12,I CLEAR LOGICAL TIMER STA EQ16,I CLEAR PHYSICAL TIMER CCA STA EQ15,I INT ON NEXT CLOCK JMP RTN SPC 1 COM04 EQU * LDA EQ26,I AND B7717 CLEAR BITS 5&4(TRANS STATE) 4-15-75 STA EQ26,I LDA DM30 AUTO SPEED COMPLETE 1805 COM06 STA EQ16,I WAIT 300 MS TO CLEAR DIAG. PORTS 1805 COM05 JSB E15ST SET UP EQT15 1805 JMP RTN RETURNX * * SET UP EQT15 SUBROUTINE * E15ST NOP SET EQT15 1805 CCB SET B TO -1 1805 LDA EQ16,I CHECK PHYSICAL 1805 SZA,RSS IS PHYSICAL SET? 1805 JMP E15L NO - CHECK LOGICAL 1805 STB EQ16,I FIX UP EQT16 FOR 1 TICK 1805 JMP E15X AND EXIT 1805 E15L LDA EQ12,I GET PHYSICAL TIMER 1805 SZA,RSS ACTIVE? 1805 JMP E15X NO - CLEAR EQT15 1805 STB EQ12,I -1 TO EQT12 1805 MPY D10 CHANGE FROM 100MS TO 10MS 1805 SSA,RSS IS IT POSITIVE? LDA BIT15 YES - MAKE BIG NEG. NUMBER 1805 E15X STA EQ15,I SET UP THE EQT AND EXIT 1805 JMP E15ST,I 1805 * * SAVAL - SAVES THE A,B,E,O, AND MPTFL DATA. SPC 1 SAVAL EQU * NOP DST SAVA SAVE A-AND B-REG. 1805 ERA,ALS SAVE E SOC INA STA SAVEO SAVE O LDA MPTFL STA MPFSV RTE32 JSB RTE3B JMP SAVAL,I * ************************************************************** * THIS AREA WILL BE USED ONLY AT STARTUP. * IT WILL THEN BE USED BY THE MAP SAVE TABLE * AND THE 16 OR 32 WORD MAP POINTER TABLE * DEPENDING ON THE NUMBER OF MULTIPLEXERS. * * *************CAUTION******************** * DO NOT USE CONSTANTS WHICH ARE DEFINED IN * THIS 48 OR 64 WORD AREA FOR ANYTHING ELSE, * AS THEY MAY BE WIPED OUT. * *************CAUTION******************** * ************************************************************* I.00 EQU * 1805 CLB BUILD "NOP" STB I.0 OVERLAY ENTRY TO PREVENT ANY REUSE LDA $OPSY RAR,SLA IS THE DMS FLAG ON? JMP I.01 YES! THEN THIS IS RTE-III STB RTE31 NO! ONLY RTE-II. KILL RTE-III CODE ENTRY POINTS STB RTE32 DITTO! STB RTE33 DITTO! STB RTE34 DITTO! STB RTE35 DITTO! STB RTE36 DITTO! 1805 STB RTE37 DITTO STB RTE38  DITTO STB RTE39 (R02) ..TWO MORE.. STB RTE40 (R02) SKP * I.01 EQU * LDA EQT# SET UP COUNT CMA,INA OF THE TOTAL NUMBER STA COUNT OF EQT ENTRIES * LDB EQTA SEARCH ADB B4 ALL I.001 LDA B,I ENTRIES UNTIL AND M374 DVS00 SZA,RSS EQT TYPE FOUND JMP I.002 NEXT1 ADB B17 MOVE TO NEXT ONE ISZ COUNT END OF EQT'S? JMP I.001 NO RETRY JMP ERROR YES,ERROR-NOT CONFIGURED RIGHT I.002 LDA B CHECK FOR THIS ADA DM3 DRIVER OR LDA A,I THE OTHER DVR00 CPA IS00A WELL?? RSS YES THIS IS THE RIGHT ONE JMP NEXT1 NOPE NOT IT CONTINUE ADB DM4 GET START ADDRESS STB EQT0 AND SAVE ADDR OF MUX#1 EQT'S ADB B3 BUMB TO CHANNEL SELECT CODE LDA B,I GET S.C. AND B77 MASK STA SAVS1 MUX#1 S.C. LDA B,I FIRST EQT WD 4 AND CMB05 MASK S.C. (PORT 0) TO 0 IOR B40 SELECT CODE 40 FOR PORT 0 STA B,I AND RESTORE * CHECK FOR 2ND MUX IFZ ADB D241 LOOK WHERE THE EQT LDA B,I SHOULD BE AND M374 MASK FOR TYPE SZA IS IT THERE? JMP I.003 NO,CONTINUE LDA B LOOK FOR THE ADA DM3 RIGHT DRIVER LDA A,I IN THE EQT CPA IS00A DVS00?? RSS YES JMP I.003 NO,NOT THERE ADB DM1 DROP BACK ONE LDA B,I GET MUX#2 CHANNEL AND B77 SELECT CODE STA SAVS2 SAVE IT LDA B,I RESTORE THE FIRST AND CMB05 EQT TO 0 IOR B60 MAKE ADDRESS 16 STA B,I FOR PORT NUMBER 0 ON MUX#2 ADB DM3 BUILD EQT ADDERSS STB EQMX2 SAVE ADDR XIF * SET THE AUTO SPEEDS I.003 LDA SAVS1 GET MUX#1 S.C. STA SAVSC MUX#1 S.C.v JSB CONFG CONFIGURE FOR MUX#1 LDA BIT14 SET DIAG. SPEEDS AND CLEAR ALL PORTS STA UNIT INTO UNIT ADDRESS JSB SPSET SPEED FOR AUTO SPEED DETECT IFZ LDA SAVS2 DO WE HAVE THE MUX#2? SZA,RSS JMP I.004 NO,DO NOT SET SPEED MUX#2 STA SAVSC YES,CONFIGURE MUX#2 JSB CONFG CONFG ALL I-O LDA BIT14 SET FIRST DIAG CHANNEL STA UNIT INTO UNIT ADDRESS JSB SPSET OUTPUT AUTO SPEEDS LDA EQMX2 IS THERE A MUX#2? SZA,RSS WELL? JMP I.004 NOPE,CONTINUE CMA,INA YES,MAKE NEG. ADA EQT1 REQUEST FOR MUX#2? SSA,RSS JMP I.004 YES,DON'T RE-CONFG LDA SAVS1 NO,A MUX#1 REQUEST STA SAVSC RE-CONFG I-O INST. JSB CONFG FOR MUX#1 XIF JMP I.004 SKIP CONSTANTS, ETC. 1805 * * SET AUTO SPEEDS AND INHIBIT * INTERRUPTS ON ALL PORTS * SPSET EQU * NOP LDA SAVSC GET SELECT CODE 1805 IOR CLFAC SET UP CLF INSTR. 1805 STA CLFSE 1805 LDA DM5 SET COUNTER STA COUNT FOR 5 SPEEDS LDB SPNTR ADDR SPEED BUFFER STB SPEED SAVE FOR INDEX SPSE1 LDA SPEED,I GET SPEED CPA B110 110 BAUD ?? ADA B400 YES BUMP CHAR SIZE ADA B1204 JSB OUT OUTPUT TO MUX LDA UNIT GET UNIT ADDRESS ADA BIT10 BUMP TO NEXT STA UNIT RESTORE CHANNEL ADDRESS ISZ SPEED BUMP B TO NEXT SPEED ISZ COUNT ALL DONE? JMP SPSE1 NO,GO TO NEXT * INHIBIT INTERRUPTS CLA SET UNIT ADDRESS STA UNIT TO FIRST PORT LDB DM16 16 PORTS STB COUNT COUNTER SPSE2 LDA BIT15 ENABLE FOR READ PRAM JSB OUT SEND TO MUX LDB UNIT BUMP UNIT ADB BIT10 TO NEXT PORT STB UNIT AND SAVE ISZ COUNT THROUGH?? JMP SPSE2 d NO CLFSE CLF SC CLEAR FLAG CAUSE ITS ON. JMP SPSET,I ALL DONE,RETURN * IFZ EQMX2 NOP ADDR OF MUX 2 EQT (R05) XIF * B1204 OCT 120400 BIT10 OCT 2000 DM5 DEC -5 * M374 OCT 37400 EXPENDABLE CONSTANT 1805 D241 DEC 241 EXPENDABLE CONSTANT 1805 DM6 DEC -6 EXPENDABLE CONSTANT 1805 ************************************************************* * THE DEFINITIONS BELOW ARE FOR VARIABLES AND TABLES * WHICH OVERLAY THE AREA FROM I.00 TO JUST BEFORE I.004 * BECAUSE THIS CODE IS USED ONLY ONCE AT STARTUP. * THIS ALLOWS SOME SAVINGS IN MEMORY USAGE. * ************************************************************* * MAPSV EQU I.00 SAVE AREA FOR ALTERNATE MAP 1805 MAPTB EQU MAPSV+32 ID SEGMENT ADDRESSES (1 PER PORT) 1805 IFN ### EQU MAPTB+16 SINGLE MUX 16 WORD MAPSV 1805 XIF IFZ ### EQU MAPTB+32 DUAL MUX 32 WORD MAPSV 1805 XIF EQ5 EQU ### 1805 EQ6 EQU ###+1 1805 EQ7 EQU ###+2 1805 EQ8 EQU ###+3 1805 EQ9 EQU ###+4 1805 EQ10 EQU ###+5 1805 EQ11 EQU ###+6 1805 EQ12 EQU ###+7 1805 EQ13 EQU ###+8 1805 EQ14 EQU ###+9 1805 EQ15 EQU ###+10 1805 EQ16 EQU ###+11 1805 EQ17 EQU ###+12 1805 EQ18 EQU ###+13 1805 EQ19 EQU ###+14 1805 EQ20 EQU ###+15 1805 EQ21 EQU ###+16 1805 EQ22 EQU ###+17 1805 EQ23 EQU ###+18 1805 EQ24 EQU ###+19 1805 EQ25 EQU ###+20 1805 EQ26 EQU ###+21 1805 DUNIT EQU ###+22 1805 RIGHT JUSTIFIED UNIT NO. NDUNT EQU ###+23 1805 NEGATIVE DUNIT EQ1 EQU ###+24 1805 FIRST ADDRESS OF EQT LOGR EQU ###+25 1805 POINTS TO LOGICAL DRIVER DATA EQU ###+26 1805 TEMP. DATA STORAGE DADIR EQU ###+27 1805 DATA AND DIRECTIVE SAVEX EQU ###+28 1805 TEMP. STORAGE SAVA EQU ###+29 1805 A REG. SAVE SAVB EQU ###+30 1805 B REG. SAVE MUST FOLLOW SAVA SAVEO EQU ###+31 1805 E & O REG. SAVE DMSTS EQU ###+32 1805 DMSH  STATUS SAVE XSV EQU ###+33 1805 X REG. SAVE YSV EQU ###+34 1805 Y REG. SAVE UMPFL EQU ###+35 1805 USER MAP RESTORE FLAG RTADD EQU ###+36 1805 RETURN ADDR. AFTER INTERRUPT SAVEA EQU ###+37 1805 DIFFERENT A REG. SAVERERRUPT MPFSV EQU ###+38 1805 MEM. PROTECT FLAG SAVE * * * END OF EXPENDABLE CODE * * . EQU 1650B EQT# EQU .+1 MPTFL EQU .+80 EQT1 EQU .+8 EQT4 EQU .+11 EQT5 EQU .+12 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT15 EQU .+84 ORG * DRIVER LENGTH END ~e  4 91731-18002 1926 S C0122 &LDV5A LOGICAL DVR FOR 16             H0101 ASMB,L,C,R,N ***RTE 2640\2644\2645 LOGICAL DRIVER** * NAME: LDVR5 16 PORT VERSION * SOURCE: HP 2644 \2645 RTE LDVR5 91731-18002 * RELOC.: HP 2644A\2645 RTE LDVR5 91731-16003 WITH CTU * RELOC.: HP 264X RTE LDVR5 91731-16002 WITHOUT CTU * * PRMR: B.B. (LOGICAL-LDVR5-MOD B.R.) * * REVISIONS (RXX) BY G.D. * LAST REV: (R06) 4/3/79 SET DVR TYPE TO 05 ON CALL * (R05) 10/19/78 * (R04) 10/3/78 * (R03) 9/18/78 * (R02) 9/11/78 * (R01) 9/7/78 * * ***************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSALATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ***************************************************************** * ****LDVR5 WILL WORK WITH 2640B\2645 * *********************************************** * FOR CTU AND OR PRINTER OPERATION INCLUDE * * "Z" PARAMETER IN ASSEMBLY CONTROL STATEMENT * * ASMB,R,Z * *********************************************** * * *********************************************** * FOR KEYBOARD\DISPLAY OPERATION ONLY * * INCLUDE "N" PARAMETER IN CONTROL STATEMENT * * ASMB,R,N * *********************************************** * *2.1 INPUT/OUTPUT INTERFACE * * LDVR5 WILL COMMUNICATE WITH THE 2644A/2640A VIA THE 12920 * ASYNCHRONOUS DATA COMMUNICATION INTERFACE. LDVR5 WILL ALSO * FUNCTION WITH A 2640A FOR THOSE APPLICATIONS WHERE THE CTU IS * NOT REQUIRED. COMMUNICATION FROM THE 2644A/2640A KEYBOARD MAY BE * IN EITHER CHARACTER OR BLOCK MODE. THE TERMINAL CAN BE USED WITH * "LINE STRAPPING", OR "PAGE STRAPPING" AND HENCE A SINGLE LINE OR * THE AENTIRE DISPLAY MEMORY CAN BE TRANSMITTED AFTER BEING ENABLED. * * *2.2 MAJOR FUNCTIONS * * LDVR5 PROVIDES THE FOLLOWING MAJOR FUNCTIONS: * 1. I/O CONTROL OF CARTRIDGE TAPE UNIT (CTU),CRT,AND TERMINAL PRINTER. * 2. READ OR WRITE REQUEST TO CTU WITH BINARY OR ASCII DATA. * 3. READ OR WRITE REQUEST TO KEYBOARD AND DISPLAY. * 4. STATUS REQUEST TO CTU AND KEYBOARD. * 5. CONSOLE OR TERMINAL USE. * 6. WRITE REQUEST TO TERMINAL PRINTER (2644 2645 ONLY) * * *2.2.1 CTU CONTROL REQUEST * *ICNWD (CONTROL LEFT OR RIGHT CTU AS SELECTED BY LOGICAL UNIT NUMBER) * 01-WRITE END OF FILE * 02-BACKSPACE 1 RECORD * 03-FORWARD SPACE 1 RECORD * 14-BACKSPACE 1 FILE * 13-FORWARD SPACE 1 FILE * 4 -REWIND * 27-LOCATE FILE. THIS IS AN ABSOLUTE FILE NUMBER. * 26-WRITE END OF VALID DATA (EOV) * 10-WRITE EOF IF NOT JUST WRITTEN OR NOT AT BOT * 32-UPDATE INTERNAL TERMINAL STATUS * * *NOTES ON CTU CONTROL REQUEST * * A. A REWIND, BACKSPACE RECORD, OR BACKSPACE FILE WILL PERFORM * NO ACTION IF THE TAPE UNIT IS AT LOAD POINT. THIS CONDITION * WILL BE SET IN THE STATUS WORD (BIT 6 SET). * B. IF THE END-OF-TAPE MARK IS SENSED DURING A WRITE OPERATION, * AN END OF VALID DATA MARK WILL BE RECORDED AUTOMATICALLY. IF * A WRITE REQUEST WAS BEING PROCESSED, THE CURRENT RECORD WILL * BE RECORDED. IF A READ REQUEST WAS IN PROCESS THE CURRENT * RECORD WILL BE READ. THIS CONDITION WILL BE SET IN THE STATUS * WORD. * C. FOR FILE MOTION COMMANDS THE TAPE IS POSITIONED AFTER THE * FILE MARK. * D. READ REQUESTS WILL BE REJECTED IF THE TAPE IS AT EOV. THE * EOV MAY BE OVERWRITTEN WITH DATA OR A FILE MARK UNLESS THE * TAPE IS AT END-OF-TAPE. * E. AN INVALID FUNCTION CODE WILL CAUSE THE DRIVER TO EXIT WITH * THE FUNCTION IGNORED. IF THE FUNCTION CODE IS VALID, EXIT IS * NORMAL. * F. DYNAMIC STATUS PUTS THE STATUS OF THE LAST LEFT OR 4RIGHT * CTU OPERATION IN PRAM1. * * *2.2.2 CRT CONTROL REQUEST * *ICNWD * 11-SPACE "IPRM" LINES -IPRM PG. EJECT 9871 ONLY * 22-SET NEW TIME OUT (IN OPTIONAL PARAMETER) * 24-RESTORE OUTPUT PROCESSING. REQUIRED ONLY IF SOME OF BUFFER IS * TO BE SAVED. * -ANY CONTROL REQUEST, VALID OR INVALID, WILL RESULT IN ENABLING * INTERRUPT ON A TERMINAL IF THE TERMINAL HAS BEEN ENABLED. * * *2.2.3 CTU READ/WRITE REQUEST * * -READ/WRITE FROM LEFT OR RIGHT CTU AS SELECTED BY LOGICAL UNIT * NUMBER. * -IF THE OPERATION FAILED, RETURN WILL BE THROUGH DVS00 WITH BIT * 5 OF EQT 19=0 *ICNWD * * 6 -0/1 IS ASCII/BINARY * 7 -1 AND 6 -0 READ A COMPLETE FILE(ASCII)-ILLEGAL FOR BLK&PG * 10-0/1 IS NOT HONEST/HONEST * * -BINARY INPUT IS A STRING OF CHARACTERS SPECIFIED BY THE BUFFER * LENGTH PARAMETER IN THE REQUEST. IF THE REQUIRED LENGTH IS FILLED * BEFORE A END-OF-RECORD (EOR) IS ENCOUNTERED, THE REMAINING DATA * IS IGNORED AND THE CTU WILL STOP AT THE NEXT EOR. IF A EOR IS * ENCOUNTERED BEFORE THE REQUIRED LENGTH IS FILLED THE CTU WILL * HALT IN THE EOR. * IF BUFFER LENGTH=0, THEN SKIP * ONE RECORD. * -BINARY OUTPUT IS A STRING OF CHARACTERS SPECIFIED BY THE BUFFER * LENGTH PARAMETER IN THE REQUEST. MAXIMUM RECORD LENGTH IS 128 * WORDS. THIS LIMIT IS SET BY THE CTU DATA BUFFER. * -ASCII INPUT IS A STRING OF CHARACTERS TERMINATED BY A CARRIAGE * RETURN (CR). IF THE REQUIRED LENGTH IS FULFILLED BEFORE A CR * IS INPUT, THE REMAINING CHARACTERS ARE IGNORED. IN ANY CASE, A * CR CODE MUST BE INPUT. * -ASCII FILE READ (200B+LU), ALL CHARACTERS ARE READ UNTIL * AN EOF IS ENCOUNTERED,IE. AN 'RS' CHAR. * -ASCII OUTPUT IS A STRING OF CHARACTERS SET BY THE BUFFER LENGTH. * MAXIMUM RECORD LENGTH IS 127 WORDS (CR IS SENT BY LDVR5 ). THE * DRIVER WILL TERMINATE THE REQUEST IF IT SEES A "CR", "LF" OR "RS". * THE DRIVER USES THE "CR" AS A RECORD TERMINATOR ON INPUT * AND THE 2644A USES THE "LF" AS RECORD TERMINATOR ON OUTPUT.A "RS" * IS PASSED TO THE DRIVER WHEN THE CTU ENCOUNTERS A FILE GAP. * * *2.2.4 ASCII OUT TO DISPLAY * * -ASCII OUTPUT IS A STRING OF CHARACTERS, THE NUMBER OF WHICH IS * DESIGNATED BY THE BUFFER LENGTH. THE STRING IS TERMINATED BY A * CARRIAGE RETURN AND LINE FEED (BOTH SUPPLIED BY DRIVER). * -IF AN UNDERSCORE (ASCII 137) IS THE LAST CHARACTER IN THE NEW * BUFFER, THE CARRIAGE RETURN, LINE FEED AND UNDERSCORE CODES ARE * NOT OUTPUT TO THE CRT. * -BUFFER LENGTH SHOULD BE LIMITED TO 80 DISPLAYABLE CHARACTERS. * -THE CURSOR WILL REMAIN IN COLUMN 80 IF CURSOR END-OF-LINE WRAP * AROUND STRAP IS NOT IN. OTHERWISE AN AUTOMATIC CR LF ARE GENERATED. * -HONEST MODE WRITE THE CR AND LF ARE NOT OUTPUT. AN UNDERSCORE * WILL ALWAYS BE OUTPUT TO DISPLAY IF IN BUFFER. * -DURING OUTPUT TO DISPLAY STRIKING ANY KEY WILL FREEZE OUTPUT. TO * RESUME STRIKE ANY KEY. TO GET SYSTEM ATTENTION HIT . * * -BINARY WILL STRIP "ESC", EXCEPT WHEN SUB=3 * *2.2.5 ASCII INPUT FROM KEYBOARD CHARACTER MODE * * THE DRIVER DETECTS WHETHER A CHARACTER MODE OR BLOCK MODE REQUEST * WILL FOLLOW BY EXAMINING THE FIRST CHARACTER. IF IT IS A DC2 * THEN THE DRIVER ASSUMES THE ENTER KEY HAS BEEN PRESSED AND A * BLOCK TRANSMISSION IS PENDING. THE DRIVER RESPONDS WITH A DC1 TO * TRIGGER THE BLOCK TRANSFERS. IF THE FIRST CHARACTER IS NOT A DC1 * THEN THE DRIVER ASSUMES A CHARACTER TRANSFER IS PENDING. * IN CHARACTER MODE THE TERMINAL TRANSMITS A CHARACTER AT A TIME AS * THE KEY IS DEPRESSED. THE RECORD TERMINATION IS A CR OR RS. THE * DRIVER ECHOS A LF. * A RECORD TERMINATOR MUST BE ENTERED TO COMPLETE REQUEST, EVEN IF THE * USERS BUFFER IS FULL. TRANSMISSION LOG IS RETURNED IN EQT 6 * - THERE ARE TWO TYPES OF CHARACTER MODE PROCESSING: HONEST AND NON-HONEST * A. HONEST * ALL CHARACTERS EXCEPT CR AND RS SENT TO USERS BUFFER. * B. NON-HONEST * THE DRIVER WILL PROCESS THE BELOW SPECIAL CHARACTERS: * *DEL (RUBOUT) ASCII 177 * ENTERING DEL WILL DELETE THE CURRENT RECORD AND CAUSE (\, * CRLF)TO BE OUTPUT. THIS IS USED TO DELETE THE CURRENT LINE * AND START A NEW LINE. * *BACKSPACE ASCII 10 * ENTERING BACKSPACE WILL DELETE THE LAST CHARACTER. THE * TERMINAL WILL LOCALLY MOVE THE CURSOR BACK ONE POSITION. * *LINEFEED ASCII 12 * THIS WILL NOT BE SENT TO USER'S BUFFER. * * CNTROL D ASCII 40 * ENTERING CONTROL D WILL CAUSE BIT 5 TO BE SET IN TERMINAL * STATUS WORD AND TRANSMISSION TERMINATED WITH LOG. = 0. THIS * BIT WILL BE CLEARED UPON NEXT ENTRY. * * *2.2.6 ASCII INPUT FROM KEYBOARD BLOCK MODE * * IN BLOCK MODE THE TERMINAL TRANSMITS EITHER A LINE AT A TIME (LINE * STRAPPING) ON A PAGE (PAGE STRAPPING). THE DRIVER DETERMINES TYPE * OF STRAPPING BY A TERMINAL STATUS REQUEST. * A. LINE STRAPPING * THE TERMINATOR IS A CR WHICH IS NOT PASSED TO USER'S * BUFFER. IMBEDDED RS'S ARE NOT PASSED. * B. PAGE STRAPPING * THE TERMINATOR IS A RS WHICH IS NOT PASSED TO USER'S BUFFER. THE * LINE SEPARATORS CR, LF ARE PASSED TO USER'S BUFFER. * C. A "RS" IS NEVER PASSED TO BUFFER * D. BLOCK READS ARE OF 2 TYPES: * 1. TERMINAL ENABLED (ENTER PRESSED) * 2. USER ENABLED ("ESC" SMALL "D" SENT) * * *2.2.7 CTU DYNAMIC STATUS REQUEST (RETURNED IN IBUF) * FOR: CALL EXEC(1,3700B+LU,IBUF,1) , IBUF(1) WILL CONTAIN; * * BIT * 7 -END OF FILE SENSED. A FILE MARK HAS BEEN DETECTED DURING A PRIOR * READ OPERATION OR A FILE MARK HAS JUST BEEN RECORDED. * 6 -LOAD POINT SENSED. CARTRIDGE TAPE IS AT OR BEFORE LOAD * POINT MARKER. MEANINFUL ONLY IF CARTRIDGE IS INSERTED. c * 5 -END OF TAPE SENSED. THE CARTRIDGE TAPE HAS PASED OVER EARLY * WARNING MARKER IN THE TAPE AND AN END-OF-VALID DATA MARK HAS BEEN * RECORDED AUTOMATICALLY. COMMANDS DIRECTING FORWARD MOTION OF TAPE * WILL BE REJECTED. THIS STATUS ONLY HAS MEANING IF A CARTRIDGE IS * INSERTED. * 4 -READ\WRITE ERROR.WRITE 2645 ONLY * A READ ERROR EXISTS IF THREE SUCCESSIVE ATTEMPTS FAILED TO READ * THE DATA IN THE RECORD. THE TAPE IS POSITIONED AFTER THE BAD * RECORD. * 3 -LAST COMMAND ABORTED. THE LAST COMMAND INITIATED FROM THE CPU OR * KEYBOARD WAS UNSUCCESSFULLY PERFORMED. OTHER STATUS CONDITIONS * MAY BE CHECKED FOR CAUSE. * 2 -WRITE PROTECTED. THE FILE PROTECT TAB ON THE CARTRIDGE IS IN THE * POSITION TO PROHIBIT RECORDING OF DATA. THIS STATUS ONLY HAS * MEANING IF A CARTRIDGE IS INSERTED AND A RECORDING OPERATION HAS * BEEN ATTEMPTED. * 1 -END OF VALID DATA. THE CARTRIDGE TAPE DETECTED AN END-OF-VALID * DATA MARK DURING A PRIOR READ OR SEARCH OPERATION OR HAS JUST * COMPLETED RECORDING AN END-OF VALID DATA MARK. IN EITHER CASE, * THE TAPE IS POSITIONED BEFORE THE END-OF VALID DATA MARK. RECORDING * OPERATIONS MAY BE EXECUTED TO OVERWRITE THIS MARK WITH DATA * OR A FILE MARK, UNLESS THE TAPE IS AT END OF TAPE. * 0 -CARTRIDGE NOT INSERTED OR UNIT BUSY. * * *2.2.8 CRT STATUS REQUEST (RETURNED IN IEQT5) * FOR: CALL EXEC(13,LU,IEQT5) * * BIT * 7 -BUFFER FLUSH IN PROGRESS * 6 -BREAK KEY HIT * 5 -CONTROL D ENTERED * 4 -TIME OUT * 3 -SPEED SENSE IN PROGRESS * 2 -BAD COMMUNICATION LINE * 1 -PAUSE MODE * 0 -TERMINAL ENABLED(1) DISABLED(0) * * *2.2.9 CONSOLE OR TERMINAL USAGE. * * IF AT GENERATAION THE 2644A IS IDENTIFIED AS A TERMINAL (VIA THE * INTERRUPT TABLE) THEN STRIKING A KEY WILL SCHEDULE THE PROGRAM * ASSOCIATED WITH THAT TERMINAL IF THE TERMINAL HAS BEEN ENABLED q* VIA A CONTROL REQUEST. * IF THE 2644 IS A CONSOLE THEN STRIKING A KEY WILL GET THE SYSTEM'S * ATTENTION AND A "*" PROMPT WILL BE WRITTEN. * * LINE PROTOCOL: * * THIS DRIVER DOES NOT SUPPORT MAIN CHANNEL * PROTOCOL FOR LINE TURN-AROUND DURING * HALF DUPLEX MODEM USE. LDVR5 RELIES UPON THE * PHYSICAL DRIVER TO PERFORM LINE TURN-AROUNDS * USING REVERSE CHANNEL PROTOCOL. * * USE: * * LDVR5 IS A TYPE 30 PROGRAM. FOR RTE IV IT MUST * RESIDE IN THE SUB-SYSTEM GOBAL AREA, ALSO FOR RTEM-III. * * ******CAUTION***** * * IF LDVR5 IS USED AS A SUBROUTINE TO A USER PROGRAM * THE USER PROGRAM SHOULD LOCK IT SELF INTO CORE * DURING ALL I-O, AND THE DEFAULT TTY DRIVER * MUST BE RE-ATTACHED (SEE BELOW) BEFORE THE * THE USER PROGRAM COMPLETES. * * INITIALIZATION: * * TO ATTACH LDVR5 AS THE LOGICAL DRIVER DO THE FOLLOWING: * * FROM FORTRAN - CALL EXEC(3,2500B+LU,IPRAM) * * WHERE LU = LU NUMBER OF THE RESPECTIVE * DEVICE. * IPRAM = THE ADDRESS OF THE ENTRY * POINT "LINT" IN LDVR5. * * NOTE: THE ADDRESS OF "LINT" MAY BE * OBTAINED FROM THE GENERATOR * LISTING, OR A CALL TO LDVR5 * SEE BELOW FOR CALL FORMAT. * * FROM THE FILE MANAGER: * * :CN,LU,25B,IPRAM PRAMATERS SAME AS ABOVE. * * TO DETACH LDVR5 AND RE-ATTACH THE DEFAULT TTY DRIVER * DO THE FOLLOWING: * * FROM FORTRAN: CALL EXEC(3,2500B+LU,0) * FROM FMGR: :CN,LU,25B,0 * * ****************************************** * SUBROUTINEIS ENTERED TO * * OBTAIN THE ADDRESS OF THE ENTRY POINT * * OF "LINT" FOR ASSIGNING LDVR5 AS THE * * LOGICAL DRIVER x * ****************************************** * CALL SEQUENCE: * * CALL LDVR5(IPRAM) * * WHERE IPRAM = PARAMETER TO RETURN ADDRESS OF "LINT" * FOR THE USER PROGRAM. * * IFN NAM LDVR5,30 91731-16002 REV.1926 790403 XIF * IFZ NAM LDVR5,30 91731-16003 REV.1926 790403 XIF ENT LDVR5,LINT EXT $LIBR,$LIBX LDVR5 NOP JSB $LIBR MAKE PRIVILEGED NOP LDB LDVR5 GET PARAMETERS 1805 LDA B,I GET RETURN ADDRESS 1805 STA LDVR5 SAVE IT FOR EXIT 1805 INB BUMP ADDRESS TO PARAMETER 1805 LDB B,I GET PARAMETER ADDRESS 1805 RBL,CLE,SLB,ERB CHECK FOR INDIRECT 1805 JMP *-2 1805 LDA L5ADR GET ADDRES OF "LINT" STA B,I GIVE ADDRESS TO USER PROG. 1805 JSB $LIBX RETURN DEF LDVR5 * * ***************************************** * * * ENTER HERE FROM PHYSICAL DRIVER * * * ***************************************** * DEC 1926 REVISION CODE. ALWAYS BEFORE LINT (= EQT17-1) * * * LINT NOP INITALIZATION CALLS JMP LINIT COME TO HERE * LRED NOP READ CALLS COME HERE JMP LREAD * LWRT NOP WRITE CALLS COME HERE JMP LWRTE * LINIT STA ASAVE SAVE CONTENTS OF A REG STB BSAVE SAVE B REG. LDA LINT SAVE RETURN STA RTN ADDRESS JSB SETIO CONFIGURE IO LDA EQT27,I FOR BINARY CTU READ AND CMB3 CLR SELECTED BITS STA EQT27,I BIT 0 (0\1=TERM.STAT. READ NO\YES) * JMP I.051 * * * ***************************************************** * "B.X" IS NEG. BINARY NO., "D.X" IS NEG. DECIMAL NO* * "BN" IS SOME BINARY NO. * * SEE BELOW. *  ***************************************************** * L5ADR DEF LINT ASAVE NOP BSAVE NOP RTN NOP CMB3 OCT 177767 CMB5 OCT 177737 CMB12 OCT 167777 B11 OCT 11 DTMSK OCT 140377 (R06) B2400 OCT 2400 (R06) * * * I.051 LDA EQT5,I (R06) SET DRIVER TYPE TO 05 AND DTMSK (R06) IOR B2400 (R06) STA EQT5,I (R06) JSB CDINT ************************************************ * THOSE PORTIONS OF CODE WITHIN AND * * BOUNDRIES ARE DELETED IF OPTION IS NOT * * INCLUDED IS ASSEMBLY CONTROL STATEMENT * ************************************************ * * IFZ SWH1A NOP SWITCH CRT \CTU ,LP= RSS\NOP * JMP I.251 YES! A CTU OR LP REQUEST XIF LDA TEMP4 GET REQUEST RAR SSA,SLA CONT.? JMP I.05C YES SSA,RSS READ OR WRITE JMP I.05W WRITE JMP I.05R READ * ****************************************************************** * * * TIMOT EQU * CLA JMP RTN,I LOOKS LIKE A BAD RET. TIME OUT * * * BREAK NOP LDA EQT5,I SET THE BREAK IOR B100 BIT FOR THE PHYSICAL STA EQT5,I DRIVER LDB EQT13,I KNOCK OUT ADB B5 THE BREAK BIT - 12 - LDA B,I IN EQ21 AND CMB12 STA B,I RESTORE JMP BREAK,I RETURN FOR CHAR PROCESSING * ************************************************* * DOES CONTROL REQUEST PROCESSING FOR * * THE KEYBOARD\DISPLAY. * ************************************************* * *******TERMINAL STATUS****************************** * BIT STATUS * * 5 "CONTROL D" ENTERED * * 7 BUFFER FLUSH ENABLED * * * **************************************************** * * *******CRT CONTROL**********GH************************ * EXEC CODE CRT CONTROL REQUEST * * 11 SPACE LINES * 22 SET TIME OUT * * * **************************************************** * I.05C LDA RDTYP GET CONTROL WORD TYPE LDB EQT7,I SSB,RSS CMB,INB COMPLEMENT OPTIONAL PARAMETER * CPA B11 JMP CN11 GO SPACE LINES CPA B22 JMP CN22 GO SET TIME OUT CPA B32 UPDATE STATUS? JMP CN32 YES * ********************REJECT REQUEST****************** * JMP REJ1 ILLEGAL CONTROL REQUEST * LF OCT 12 B37 OCT 37 B20 OCT 20 B21 OCT 21 B22 OCT 22 B2 OCT 2 B.3 OCT 177775 B100 OCT 100 B200 OCT 200 B17 OCT 17 B32 OCT 32 B70 OCT 70 * **SPACE LINES***** **MAX NO. IS 55** * CN11 SZB,RSS CHECK FOR 0 VALUE CCB CHANGE TO -1 STB EQT7,I ADB B70 MAX NO. OF (CR,LF'S) IS 55 SSB BECAUSE CARD BUFFER IS 128 JMP REJ1 JSB XMIT JSB EORP OUTPUT (CR,LF) JSB ENAK GIVE TERM. TIME TO PROCESS ISZ EQT7,I JMP *-4 CN11A CLA STA EQT29,I SET A REG. EXIT JMP EOOP4 * * * CN22 EQU * PRAM1 HAS THE TIME STB EQT14,I FOR STANDARD TIMEOUT JMP REJ1 RETURN CN32 JSB SPCH1 JSB TERST UPDATE TERMINAL STATUS JMP CN11A **********EQT6 FOR READ\WRITE***************** * * EQT6 FOR READ\WRITE OPERATIONS IS: * * BIT MEANING * * 6 0\1 IS ASCII\BINARY * * 7 -1 AND 6 -0 FILE(ASC) READ * 8 0\1 IS OFF\ON ECHO * * 10 0\1 OFF\ON HONEST MODE * * 9 AND 10 SET USER ENABLED BLOCK READ * * ********************************************** * * LWRTE STA ASAVE SAVE A STB BSAVE AND B LDA LWRT GET ENTRY ADDRESS STA RTN SAVE FOR RETURN JSB SETIO LDA ASAVE IS THE THE FIRST TIME? CPA B.1 JMP LWRT1 YES START WRITE JSB BITCK CHECK CONDITION BITS JMP TIMOT TIMEOUT BIT15 ON JMP TIMOT LINE ERROR BIT 14 ON JMP TIMOT DATA ERROR BIT 13 ON JSB BREAK BREAK BIT 12 ON LDA EQT5,I (R01) PAUSE MODE?? RAR,SLA (R01) JMP REJ3 (R03) YES, IGNORE INT. LDA EQT11,I NO, CONTINUE WITH WRITE SZA,RSS ARE WE TRYING TO COMPLETE? JMP REJ2 YES,IGNORE THE CHAR JMP A,I LWRT1 CLA STA EQT30,I INIT RECORD COUNT JMP I.051 * * * I.05W CLB,RSS SETUP EQT9(RUNNING CHAR. ADD.) AND I05W1 NOP EQT 10 (LAST CHAR. ADD.) LDA EQT7,I GET BUFFER STARTING ADDRESS RAL,CLE MULTIPLY S.A. BY TWO STA EQT9,I STORE AT EQT9 LDA EQT8,I GET BUFFER LENGTH CMA,SSA,INA,RSS COMPLEMENT,ARE THEY CHAR.? JMP I.W1 YES! CMA,INA MAKE POS AGAIN RAL MULTIPLY WORDS X 2 AND * I.W1 ADA EQT9,I STA EQT10,I STORE LAST CHAR. ADD. AT EQT10,I CMA,INA MAKE LAST CHAR. ADD. NEG. ADA EQT9,I - NO. OF CHAR. ARE NOW IN A REG. SZB JMP I05W1,I SZA,RSS IS IT 0 ? JMP I.W32 YES! IT IS ZERO * JSB TRAN1 GOTO OUTPUT SUBROUTINE * LDA TEMP2 IS THIS HONEST MODE? SZA JMP EOOP2 * I.W32 JSB XMIT JSB EORP THIS IS NOT HONEST JMP EOOP2 ABOVE NEEDED FOR INTERRUPT * * ********************************************** * WRITES TO THE DISPLAY,CTU AND PRINTER. * STARTING ADDRESS OF DATA IS EQT9,I * ************************************************** * * TRAN1 NOP LDA TRAN1 SAVE RETURN ADDRESS STA EQT29,I JSB XMIT SET CARD FOR XMIT * TRAN2 EQU * LDB EQT9,I I GET BUFFER ADDRESS X 2 CLE,ERB DIVIDE BY TWO TO GET TRUE ADD. * JSB MAPRD GET WORD SEZ,RSS DO WE WANT UPPER OR LOWER CHAR.? ALF,ALF UPPER! SHIFT TO LOWER AND B377 LOWER! MASK WORD IFZ * SWH1B NOP CRT\CTU=RSS\NOP JMP TRAN3 YES! IGNORE BELOW CHECKS XIF * * LDB FILL DO NOT SEND "ESC" TO CRT ON SZB BINARY WRITE. JMP ON1 LDB TEM11 IS THIS UNIT 3? CPB B3 IF SO SKIP ESC CHECK JMP ON1 CPA ESC IS THIS AN ESCAPE? JMP OUT6B * ON1 CLB,INB SET B REG TO 1 ADB EQT9,I ADD 1 TO EQT9 CPB EQT10,I IS THIS THE LAST WORD? RSS JMP OUT6 NO! CONTINUE LDB TEMP2 IS THIS HONEST? SZB JMP OUT6 THIS IS HONEST,IGNORE UNDERSCORE CPA B137 IS THIS A "_" UNDERSCORE? JMP EOOP8 YES! GO TO END OF OUTPUT PROCESSING JMP OUT6 IFZ TRAN3 LDB FILL IS THIS BINARY? SZB,RSS JMP OUT6 THIS IS BINARY,OUTPUT CHARACTER CPA CR IS IT A ? RSS CPA LF IS IT A LINEFEED? RSS IT IS A CPA RS IS IT A JMP TRAN5 YES,TERMINATE ON OROR XIF * OUT6 JSB OUT1 OUTPUT CHAR. TO CARD.CHAR. OUT6B ISZ EQT9,I INCREMENT CHAR. COUNT LDB EQT9,I GET CURRENT CHAR. ADD.R CPB EQT10,I HAVE WE SENT LAST WORD? JMP TRAN5 THIS IS THE LAST CHARACTER JMP TRAN2 WE HAVE NOT SENT ALL CHAR * TRAN5 LDA EQT29,I GET RETURN ADDRESS JMP A,I RETURN * * *************************************************** * DOES KEYBOARD READ. IF FIRST CHARACTER * * A "DC2" THE DRIVER EXPECTS A BLOCK TRANSFER AND * * WILL SEND A DC1 TO TRIGGER IT. IF THE FIRST * * CHAR. IS NOT A "DC2" THE DRIVER ASSUMES A CHAR. * * TRANSFER. *************************************************** * * LREAD STA ASAVE SAVE A STB BSAVE AND B LDA LRED GET ENTRY ADDRESS STA RTN SAVE FOR RETURN JSB SETIO GO SET UP THE EQ'S LDA ASAVE IS THE THE FRIST CPA B.1 TIME? JMP LWRT1 YES, START TO READ JSB BITCK GO CHECK CONDITION BITS JMP TIMOT TIMOUT BIT 15 ON JMP TIMOT LINE ERROR BIT 14 ON JMP TIMOT DATA ERROR BIT 13 ON NOP BREAK,CAN'T GET ON READ LDA EQT4,I (R03) CRT SUBCHANNEL? AND B3700 (R03) SZA (R03) JMP LRED2 (R03) NO, NO PAUSE ON CTU!!! LDA EQT6,I (R01) DOING READ OR WRITE? SLA (R01) WRITE -> CHECK FOR PAUSE JMP LRED2 (R01) READ, CONTINUE LDA EQT31,I (R01) CHECK LINE DIRECTION SSA (R02) JMP LRED2 (R01) READ, CONTINUE LDA EQT5,I (R01) FLIP PAUSE BIT XOR B2 (R01) STA EQT5,I (R01) RAR,SLA (R01) WAIT NOW? JMP REJ3 (R03) YES, WAIT FOR NEXT INT. LDA BIT12 (R03) NO, OUTPUT NULL TO RESTART WRITE JMP REJ4 (R03) LRED2 LDA EQT11,I NOTHING ELSE, RETURN SZA,RSS ARE WE TRYING TO FINISH? JMP REJ2 YES, IGNORE THIS CHAR. JMP A,I NO * * * I.05R EQU * JSB SPCH1 SET AND SPECIAL CHAR. CLB,INB JSB I05W1 GO SETUP EQT9 AND EQT10 LDA EQT6,I CHECK IF ECHO SET AND B400 ISOLATE BIT 8 (SET ECHO) JSB ECHO SET/CLR = 20/0 ECHO LDA BN9 SET RUBOUT INT. JSB CDSET LDA BN40 SET CONTROL "D" INT. JSB CDSET LDA EQT6,I CHECK FOR USER ENABLED BLOCK READ AND B3000 BITS 9,10 WILL BE SET CPA B3000 JMP C05R3 THIS IS ENABLED BLOCK READ I.05S JSB DC1OT ENABLE TRANSFER * JSB CHRIN GET CHARACTER CPA B22 IS IT A DC2? JMP C05R4 FIRST CHAR. IS A DC2 * * *******THIS IS A CHARACTER TRANSFER********* * * LDA TEMP2 IS THIS HONEST? SZA JSB CLRNT JMP CHPR8 * * CLRNT NOP LDA BN56 CLR. RUBOUT INT. JSB CDSET LDA B412 CLR. CONTROL "D" INT. JSB CDSET JMP CLRNT,I * RS OCT 36 B377 OCT 377 B3700 OCT 3700 (R03) B137 OCT 137 CR OCT 15 BN9 OCT 57712 BN10 OCT 40000 BN11 OCT 43612 BN12 OCT 41512 BN13 OCT 140000 BN40 OCT 40412 B177 OCT 177 B4 OCT 4 B144 OCT 144 B3000 OCT 3000 B1512 OCT 1512 B3612 OCT 3612 BN56 OCT 17712 B412 OCT 412 * * ***********THIS IS A BLOCK TRANSFER********* * * C05R3 LDA EQT27,I THIS IS A BLOCK TRANSFER SSA (R04) RSS YES JMP REJ1 NO ERROR JSB XMIT GO TO TRANSMIT MODE LDA ESC OUTPUT JSB OUT1 LDA B144 OUTPUT SMALL JSB OUT1 C05R4 EQU * LDA EQT27,I GET STATUS AND BN13 SAVE 15-14 CPA BN13 BLOCK AND PAGE? RSS JMP *+4 NO LDA B1512 YES, TAKE CR AS SPECIAL JSB CDSET JMP C05R6 GO READ SSA,RSS IS IT BLOCK? JMP I.05S NO, IGNORE DC2 LDA B3612 REMOVE "RS" INT. ("CR" ONLY FOR LINE) JSB CDSET FOR ASCII CTU, LINE STRAP AND BLOCK * C05R6 JSB CLRNT CLA JSB ECHO TURN OFF ECHO JSB DC1OT TRIGGER TRANSFER C05R7 RSS AND WAIT FOR INTERRUPT * * ********************************************** * PROCESSES DATA ON KEYBOARD AND CTU * * READ REQUESTS. * * BINARY EOR IS DETECTED BY THE CHAR. * * COUNT READ FROM THE TAPE. * ********************************************** * * CHPRC JSB OUT1 EXIT AND AND WAIT FOR CHAR. JSB CHRIN GET CHARACTER CHPR8 LDB FILL SZB,RSS ISv THIS BINARY? JMP CHPR9 YES,THIS IS BINARY * ********THIS IS ASCII******* * * * LDA TEM14 GET DATA WORD SZA,RSS IS IT SPECIAL? JMP CHPR2 NO * IFZ SWH1C NOP SWITCH NOP\RSS =CTU\CRT JMP EOOP5 THIS IS CTU ASCII TRANSFER XIF LDA EQT27,I GET TERMINAL STATUS AND BN13 ISOLATE PAGE(15) AND BLK(14) CPA BN13 ARE THEY BOTH SET? JMP EOOP2 YES,TERMINATE REQUEST LDA TEMP8 GET CHARACTER CPA B177 IS IT A RUBOUT? JMP RUB01 YES! GO PROCESS RUBOUT CPA B4 IS IT A CONTROL "D" (SET EOT) JMP CNTLD YES! GO SET EOT CHP9 JSB XMIT JSB EORP FOR CHAR. OR LINE STRAP BLK REQUES JMP EOOP1 FIRST SEND * * CHPR2 LDA EQT27,I IFZ SWH1D NOP CRT\CTU = RSS\NOP JMP CHPR9 THIS IS A CTU ASCII READ XIF SSA IS IT BLOCK MODE? JMP CHPRA YES! SKIP BELOW CHECKS * LDA TEMP2 IS THIS HONEST MODE? SZA JMP CHPR9 THIS IS HONEST MODE LDA TEMP8 GET CHARACTER JMP LINFD CHAR. TRANSFER AND NOT HONEST ******************************************** * IS CALLED IF RUBOUT CHARACTER IS * * DETECTED. IT DELETES THE CURRENT RECORD * * AND OUTPUTS (/,CR,LF). * ******************************************** * * RUB01 JSB XMIT LDA B134 OUTPUT A SLASH JSB OUT1 JSB EORP GO OUTPUT JMP I.051 RE START INPUT * LINFD CPA LF IS THIS A LINEFEED? JMP CHPRC YES,GO GET NEXT CHARACTER CPA CR IS THIS A CR ? JMP CHP9 YES! IT IS A CR,EXIT CPA B4 IS FIRST CHAR. A CONTROL "D" ? JMP CNTLD YES! * CPA B10 IS THIS A BACKSPACE RSS RSS JMP CHPR9 NO! CONTINUE LDA EQT7,I GET STARTING ADDRESS OF BUFFER RAL MULTIPLY BY 2 > CPA EQT9,I ARE WE AT STARTING ADDRESS? JMP RUB01 YES! PROCESS AS RUBOUT CCB ADB EQT9,I DECREMENT CURRENT ADDRESS STB EQT9,I CLE,ERB DIVIDE BY TWO TO GET TRUE ADDRESS JSB MAPRD (R04) FETCH CHAR AND BN15 MASK HIGH END ADA FILL ADD ASCII FILL CHARACTER JSB MAPWR (R04) RESTORE JMP CHPR6 GO GET NEXT CHARACTER * * B134 OCT 134 BN15 OCT 177400 B40 OCT 40 B60 OCT 60 * CNTLD EQU * SET BIT 5 (EOT) LDA EQT5,I IOR B40 SET BIT 5 STA EQT5,I CLA STA EQT29,I SET AREG. EXIT JMP EOOP4 GO SET B REG. TO 0 AND EXIT * * CHPRA LDA TEMP8 CPA RS REMOVE "RS" JMP CHPR6 CHPR9 EQU * LDB EQT9,I GET CURRENT CHAR. ADD. CPB EQT10,I IS BUFFER FULL? JMP CHPR6 YES BUFFER FULL LDB EQT9,I GET CHARACTER ADDRESS ISZ EQT9,I INCREMENT CLE,ERB CONVERT TO WORD ADDRESS. JSB MAPRD GET CHARACTER STA BSAVE LDA TEMP8 SEZ,RSS IF E=0 THEN EVEN AND ALF,SLA,ALF HENCE SHIFT CHAR. TO UPPER 8.SKIP XOR BSAVE IF ODD ADDRESS XOR WITH CHAR. XOR FILL XOR FILL TO ADD FILL IF EVEN JSB MAPWR REPLACE FULL WORD LDB EQT9,I IS THIS THE LAST WORD? CPB EQT10,I RSS YES IT IS JMP *+5 LDA FILL IF BINARY KEYBOARD REQUEST AND BUFFER ADA TEM10 FULL THEN EXIT CPA B60 JMP EOOP2 YES! EXIT CHPR6 ISZ EQT30,I INCREMENT RECORD LENGTH COUNT.FOR JMP CHPRC IF NOT ZERO GET ANOTHER CHAR. IFZ JMP EOOP5 THIS IS ALL FOR BINARY READ XIF * * READ FROM USER MAP IF EQT1 IS NEG. ADDRESS IN B. * MAPRD NOP LDA EQT1 IS IT NEG.?? SSA JMP *+3 YES, USE USER MP LDA B,I GET CHAR FROM SYSTEM JMP MAPRD,I XLA B,I GET CHAR FROM UeSER MAP JMP MAPRD,I * * WRITE TO USER MAP IF EQT1 IS NEG. ADDRESS IN B. * MAPWR NOP STA BSAVE SAVE TEMP LDA EQT1 ARE MAPS CHANGED? SSA JMP *+4 YES STORE TO USER MAP LDA BSAVE STA B,I NO, PUT IN TO SYSTEM MAP JMP MAPWR,I LDA BSAVE XSA B,I TO USER MAP JMP MAPWR,I IFZ * * * *************************************************** * DOES CTU AND PRINTER REQUEST PROCESSING * *************************************************** * * * I.251 LDA TEMP4 GET REQUEST TYPE(1-3) RAR SSA,SLA JMP I.25C THIS IS CTU OR LP A CONTROL REQUEST SSA JMP I.25R THIS IS CTU A READ REQUEST * *********CTU OR PRINTER WRITE REQUEST********** * CLB,INB JSB I05W1 GO SET EQT9 AND EQT10 LDB FILL SZA IS CHARACTER COUNT ZERO? JMP I25W6 NO! IT IS NOT ZERO SZB,RSS IS IT BINARY JMP REJ1 EXIT WITH A=1 I25W6 SZB IF BINARY MAX LENGTH IS D 256 JMP *+3 FOR ASCII MAX LENTH IS D 254 (NEDED CR,LF) ADA B400 RSS ADA D254 THIS IS ASCII SSA LESS THAN 254 CHARACTERS JMP REJ1 IT IS NOT,THEREFORE EXIT * * JSB CTPRP GO PREP. TERMINAL FOR TRANSFER LDA B144 JSB OUT1 OUTPUT LDA FILL GET FILL CHARACTER SZA IS IT BINARY? JMP I25W2 NO! THIS IS ASCII * ***********CTU BINARY WRITE******** * LDA EQT8,I GET BUFFER LENGTH SSA,RSS IF WORDS MULTIPLY X2 RAL SSA IF CHARACTERS (-) MAKE POS. CMA,INA JSB BINAS GO CONVERT TO ASCII AND SEND * * I25W2 LDA B127 OUTPUT TO INITIALIZE CTU TRANSFER JSB OUT1 * * LDA FILL IS THIS BINARY SZA,RSS JSB ENAK THIS IS BINARY,GO HANDSHAKE LDB EQT8,I GET WORD COUNT SZB IS IT ZERO?(ASCII ONLY,BINARY CHECKED * JSB TRAN1 ALREADY).IT IS NOT ZERO LDA FILL GET FILL CHAR. SZA IS IT BINARY JSB EORP NO! THIS IS ASCII,WRITE A "CR,LF" I25W5 EQU * &&&&FOR INTERRUPT JSB DC1OT GO TRIGGER STATUS REPORT * * JSB CHRIN GET STATUS CHARACTER * JSB OUT1 GET THE @@&&&&*** CR.... LDA EQT33,I CPA B106 FAILURE? JMP I25W7 YES CLA,RSS I25W7 LDA B10 SET BIT 3 IN EQT5 FOR PRINT FAIL LDB TEM10 IS THIS A PRINTER? CPB B64 JMP EOOP6 THIS IS A PRINTER JMP EOOP7 THIS IS A CTU * * D254 DEC 254 B127 OCT 127 B163 OCT 163 B122 OCT 122 B62 OCT 62 * * ***********THIS IS A CTU READ REQUEST******** * I.25R EQU * JSB SPCH1 SET AND AS SPECIAL LDA RDTYP LOOK AT TYPE CPA B37 IS IT? JMP CN6C YES SPECIAL READ LDB TEM10 IF READ FROM PRINTER REJECT CPB B64 JMP REJ1 LDB EQT8,I GET BUFFER LENGTH SZB,RSS IS IT ZERO? JMP CN3C YES --GO SKIP ONE RECORD CLB,INB NO!, IT IS NOT ZERO JSB I05W1 GO SET UP EQT9,EQT10 LDB RDTYP IS THIS A FILE READ? CPB B2 IS THIS IT? RSS YES JMP *+5 NO LDA EQT27,I CHECK FOR BOTH BLOCK AND BN13 AND PAGE STRAP, IF SO CPA BN13 JMP REJ1 REJECT THIS READ JSB CTPRP GO PREP. TERM. FOR CTU TRANSFER LDA B163 JSB OUT1 OUTPUT LDA FILL SZA,RSS IS THIS BINARY? JMP I25R2 YES! THIS IS BINARY LDA B60 OUTPUT A ZERO FOR RECORD LDB RDTYP CPB B2 LDA B64 OR 4 FOR FILE JSB OUT1 LDA B122 OUTPUT JSB OUT1 * * THIS IS ASCII LDA B1512 DISABLE IF FILE READ LDB RDTYP GET TYPE CPB B2 JSB CDSET JMP C05R6 GO TRIGGER TRANSFER FOR ASCII * * ****THIS IS BINARY READ***** * I25R2 LDA B62 OUTPUT <2> JSB OUT1 LDA B122 OUTPUT JSB OUT1 JSB CDINT #### JSB SPCH1 SET FOR INTERRUPT JSB DC1OT TRIGGER BYTE COUNT * LDA B.4 INITIALIZE TO READ 4 BYTES STA EQT30,I CLA I25R5 ALF SHIFT UP STA EQT35,I AND STORE JSB CHRIN GET CHARACTER CPA RS IS IT A" RS"? JMP I25R6 YES,THIS IS ALL AND B17 ISOLATE DATA IOR EQT35,I "OR" WITH LAST BYTE STA EQT35,I SAVE JSB OUT1 GET NEXT LDA EQT35,I GET NUMB AGAIN ISZ EQT30,I IS THIS ALL?? JMP I25R5 NO! GET NEXT BYTE CMA,INA THIS IS ALL,COMPLEMENT STA EQT30,I STORE BINARY RECORD LENGTH. JSB DC1OT TRIGGER TRANSFER JMP C05R7 GO ENABLE TRANSFER I25R6 LDA EQT27,I DO WE NEED TO GET AND BN13 THAT CR? CPA BN13 JMP EOOP5 NO COMPLETE JSB OUT1 YES GET IT JMP EOOP5 * * ***************************************************** * * * * * PRINTER * * 11 SPACE

LINES IF OPTIONAL * * PARAM (+) OR PAGE EJECT IF * * OPTIONAL PARAM (-). * PAGE EJECT 9871 ONLY ***************************************************** * * I.25C LDA RDTYP GET CONTROL WORD STA EQT10,I STORE FOR LATER USE LDB TEM10 GET DEVICE TYPE CPB B64 IS IT A LP? JMP CN28C YES! IT IS A LP CPA B1 IS IT EOF? JMP CN1C YES! CPA B2 IS IT BACKSPACE RECORD? JMP CN50C YES! CPA B3 FORWARD SPACE? JMP CN3C YES! CPA B4 REWIND? JMP CN4C YES! CPA B10 GENERATE LEADER(EOF) JMP CN10C CPA B11 T.O.F TO CTU IS WEOF JMP CN1C WRITE EOF CPA B13 FORWARD SPACE 1 FILE? JMP CN13C YES! CPA B14 BACKSPACE FILE? JMP CN50C YES! CPA B26 WRITE EOV? JMP CN26C YES! CPA B27 LOCATE FILE

OR SPACE

LINES JMP CN27C YES * **************ILLEGAL CONTROL REQUEST************* * * JMP REJ1 * B1 OCT 1 B14 OCT 14 B26 OCT 26 B27 OCT 27 B65 OCT 65 B55 OCT 55 B160 OCT 160 B66 OCT 66 B103 OCT 103 * ******BACKSPACE 1 OR 2 RECORDS****** * BSR1 NOP BACKSPACE 1 LDB B61 GET ASCII <1> LDA BSR1 JMP OVER1 BSR2 NOP BACKSPACE 2 LDA BSR2 LDB B62 GET ASCII <2> OVER1 STA EQT8,I STORE RETURN ADD. STB EQT9,I SAVE 1 OR 2 LDA B55 SEND ASCII (-) JSB OUT4 LDA EQT9,I RETREIVE BS NUMBER JSB OUT1 LDA B160 SEND JSB OUT1 LDA B70 SEND JMP OUT5 * *********WRITE EOF************* * CN1C LDA B65 WRITE END OF FILE JSB OUT4 OUTPUT JMP OUT3 * ***********FORWARD SPACE RECORD************** * FSR1 NOP LDA FSR1 SAVE RETURN ADD. RSS CN3C CLA STA EQT8,I LDA B3 SET CONTROL REQUEST STA TEMP4 BECAUSE MAY GET HERE FROM READ 0 ADA B300 SET FOR FORWARD RECORD IOR EQT6,I ALSO SET IN CONWD BECAUSE WILL EXIT STA EQT6,I LDA B160 JSB OUT4 CN3C1 LDA B61 OUTPUT JMP OUT5 **********REWIND*************** CN4C JSB CTPRP LDA B60 REWIND JMP OUT5 * **********DYNAMIC STATUS***************** CN6C EQU * CLB,INB JSB I05W1 GO SET EQT'S SZA,RSS IS IT ZERO WD COUNT? JMP REJ1 YES , IGNORE REQUEST JSB CTUST GET CTU STATUS STA B LDA TEM11 GET DEVICE TYPE (OCTAL) RAL AND EQT27,I TEST EOF FLAG FOR DEVICE SZA ADB B200 EOF FLAG IS SET. SET IN IBUF LDA EQT7,I GET ADDRESS SWP (R01) SET UP... JSB MAPWR (R01) ...FOR CROSS MAP STORE ISZ EQT9,I BUMP FOR TRANSMIT LOG CLA SET FOR GOOD RETURN STA EQT29,I JMP EOOP3 * * *********LEADER AND TOP OF FORM********** * FOR THIS REQUEST DRIVER WRITES A EOF * * IF IT DID NOT JUST DO SO,OR TAPE IS * * NOT AT LOAD POINT * ***************************************** * CN10C JSB CTUST GET STATUS AND B300 SZA,RSS DID WE JUST WRITE A EOF OR AT LP? JMP CN1C NO! GO WRITE IT JMP EOOP4 YES,DO NOT WRITE TWO IN A ROW * **********FORWARD SPACE 1 FILE ************ * CN13C LDA B62 OUTPUT JSB OUT4 JMP OUT3 * ************BACKSPACE 1 FILE ************* * BSF1 NOP LDA BSF1 _! STA EQT8,I LDA B55 OUTPUT JSB OUT4 LDA B61 OUTPUT JSB OUT1 LDA B160 OUTPUT JSB OUT1 LDA B62 OUTPUT JMP OUT5 * ********WRITE END OF VALID DATA (EOV) * CN26C LDA B66 OUTPUT JSB OUT4 JMP OUT3 * *******LOCATE ABSOLUTE FILE (CTU)********* *****************OR*********************** *******SPACE LINES (PRINTER)************** * CN28C LDA EQT10,I GET CONTROL REQUEST CPA B11 IS IT T.0.F. OR SPACE LINES? RSS JMP REJ1 ONLY LEGAL CONTROL TO PRINTER IS 11B CN27C JSB CTPRP PREP. TERM. FOR CTU REQUEST LDA EQT7,I GET FILE NO. SZA,RSS IF ZERO CHANGE TO 1 INA JSB BINAS CONVERT TO ASCII AND SEND LDA B160 OUTPUT JSB OUT1 LDB TEM10 GET DEVICE TYPE CPB B64 IS IT LP? RSS YES A LP JMP CN27D LDB EQT7,I GET OPTIONAL PARAM. IF (-) THEN T.O.F. SSB,RSS IF (+) THEN SPACE (EQT7) LINES. JMP CN3C1 GO OUTPUT CN27D LDA B62 OUTPUT * OUT5 JSB OUT1 OUT3 LDA B103 OUTPUT JSB OUT1 JMP I25W5 GO WAIT FOR REQUEST COMPLETION OUT4 NOP LDB OUT4 SAVE RETURN ADDRESS STB EQT29,I JSB CTPRP JSB OUT1 LDA EQT29,I JMP A,I * *********BACKSPACE FILE AND RECORD******** * * BACKSPACE FILE AND RECORD REQUIRES SPECIAL PROCESSING * * TO POSITION AND SET STATUS AS A MAG. TAPE UNIT. THIS * * SPECIAL PROCESSING ENABLES THE USE OF EXISTING MTU * * SUBROUTINES. IF THE TAPE IS POSITIONED AFTER AN EOF THEN* * IT WILL MOVE BEFORE THE EOF AND A FLAG SET IN EQT27 * * (BIT3/BIT2 =RIGHT CTU/LEFT CTU) WHICH IS EXAMINED BY * * A DYNAMIC STATUS REQUEST. THESE SPECIAL EOF FLAGS ARE * * NECESSARY BECAUSE THE 264X DOES NOT RETURN EOF STATUS * * BEFORE THE EOF MARK. * * *********************************************************** * * * CN50C LDA EQT27,I SET CN50C ENTRY FLAG IOR B10 BIT3 STA EQT27,I LDB RSS SET CN50C FLAG STB EOOP7 JSB BSR1 ISSUE BACKSPACE 1 RECORD JSB CTUST GET STATUS STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB WE ARE THERE LDA TEM8 NOT AT L.P. AND B200 IF WE ARE AFTER EOF THE BIT 7 SET SZA,RSS JMP CN54C TAPE NOT AFTER EOF CN55C JSB BSR2 ISSUE BACKSPACE 2 RECORDS JSB CTUST IF AT EOF AGAIN WE ARE AFTER ANOTHER EOF STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB LDA TEM8 AND B200 AND HENCE NO FORWARD SPACE SZA DO NOT SET EQT27 EOF FLAG IF JMP EOOPB BETWEEN EOF'S JSB FSR1 FORWARD ONE TO GET US BEFORE EOF * * LDA TEM11 GET DEVICE TYPE RAL FOR SETTING EOF FLAG IN EQT27 IOR EQT27,I BIT1/BIT2=EOF LCTU/EOF RCTU AND BN55 REMOVE CN50C FLAG STA EQT27,I RESTORE IT JSB CTUST GET STATUS IOR B200 ADD EOF BIT STA TEM8 JMP EOOPA * * CN54C LDA EQT10,I TAPE NOT AFTER EOF CPA B2 IS THIS A BS RECORD? JMP EOOPB YES JSB FSR1 GET TAPE TO ORIGINAL POSITION JSB BSF1 BS FILE TO GET US AFTER EOF JMP CN55C NOW POSITION BEFORE EOF XIF * RECIV NOP LDA BIT15 SET CARD UP FOR RECEIVE,CHAR. IOR EQT31,I UPDATE STA EQT31,I FOR NEXT IO OPERATION JMP RECIV,I **************************************************** * SUBROUTINE CHECHS CHARACTER FROM IO CARD* * AND PLACES IT IN A REG. * * SPECIAL CHARCTER STATUS IS ALSO DETERMINED * * TEMP8=DATA * * TEMP14= SPECIAL CHARACTER RESAD * * **************************************************** * CHRIN NOP LDA CHRIN STA EQT37,I CLA CLEAR STA TEM14 SPEC. CHAR. STATUS LDA ASAVE GET REC WORD AND B377 ISOLATE DATA CHAR.(0-7) STA EQT33,I STORE IT LDB FILL IS THIS BINARY? SZB,RSS JMP CHSPJ YES,SKIP CHECKS AND B177 ASCII DATA STA EQT33,I WITHOUT PARITY BIT LDB EQT27,I GET STATE WORD BLF LOOK AT SPECIAL CHAR. BITS SLB,RSS LOOK FOR CR? JMP *+3 NO LOOK NEXT CPA CR YES, LOOK JMP CHSPH IS CR SSB,RSS JMP *+3 NO LOOK NEXT CPA RS YES, LOOK RSS IS RS JMP *+7 LDA EQT27,I IS T BLOCK AND PAGE? AND BN13 CPA BN13 RSS YES, DON'T LOOK FOR CR JSB OUT1 GET THE JMP CHSPH RBL,RBL LOOK FOR R.O. AND CNTL-D SLB,RSS LOOK FOR RUBOUT? JMP *+3 NO, LOOK NEXT CPA B177 IS IT R.O.? JMP CHSPH YES SSB,RSS LOOK FOR CNTL-D? JMP CHSPJ NO,RETURN CPA B4 IS IT CNTL-D? JMP CHSPH YES JMP CHSPJ NO,RETURN CHSPH LDA BN10 FOUND A SPECIAL CHAR. STA TEM14 TURN ON SPEC. CHAR BIT CHSPJ LDA EQT33,I STA TEMP8 GET REC. CHAR LDB EQT37,I JMP B,I THAT CAUSED THE INTERRUPT * * * *********************************************** * SUBROUTINE TRIGGERS BLOCK TRANSFERS * * FROM THE CPU. THIS IS DONE BY SENDING A * * DC1 TO TRIGGER THE TRANSFER AND * * THEN SETTING UP TO RECEIVE DATA. * *********************************************** * DC1OT NOP LDA DC1OT SAVE RETURN ADDRESS STA EQT32,I JSB XMIT SET UP FOR XMIT LDA B21 TO INHIBIT TRANS. UNTIL READY JSB OUT1 OUTPUT DC1 JSB RECIV SET RECIVE MODE JSB OUT1 WAIT FOR REC CHAR. LDA EQT32,I GET RETURN ADDRESS JMP A,I RETURN * B5 OCT 5 BN55 OCT 177767 B10 OCT 10 B400 OCT 400 * * BITCK NOP LDA ASAVE GET CONDITION BITS RAL,SLA JMP BITCK,I BIT 15 ISZ BITCK RAL,SLA JMP BITCK,I BIT 14 ISZ BITCK RAL,SLA JMP BITCK,I BIT 13 ISZ BITCK SSA JMP BITCK,I BIT 12 ISZ BITCK NONE JMP BITCK,I RETURN * * * * * ****************************************************** * SUBROUTINE SETS UP THE SPECIAL CHARACTERS. * * THE SPECIAL CHARACTER IS IN POSITION (THE A REG.) * * . 1/0 IS ADD/DELETE * * SPECIAL CHARACTER. * ****************************************************** * CDSET NOP STA B SAVE IN B RBL PUT ADD/DELETE BIT IN 15 ALF,ALF RAL,RAL PUT CHAR IN LOW ORDER AND B177 FIND OUT WHICH CHAR CPA CR CARRAGE RET.? LDA BIT12 YES CPA RS REC. SEP.? LDA BIT11 TES CPA B177 RUBOUT? LDA BIT10 YES CPA B4 CNTL-D? LDA BIT9 SSB,RSS CMA,RSS NO JMP *+3 DELETE AND EQT27,I ADD RSS IOR EQT27,I STA EQT27,I RESTORE STATUS JMP CDSET,I RETURN * ECHO NOP SET ECHO ON CARD PER A REG. STA B SAVE A LDA EQT31,I AND CMB11 SZB,RSS TURN ECHO ON OR OFF? IOR BIT11 OFF STA EQT31,I RESTORE JMP ECHO,I * *************************************************** * SUBROUTINE INITIALIZES SPEC. CHARS. * * BELOW ARE THE INITIAL CONDITIONS FOR CONTROL: * * * * ALL USED SPECIAL CHARACTERS (EXCEPT * *  RUBOUT) ARE CLEARD * * * *************************************************** * * CDINT NOP LDA B1512 DISABLE CR JSB CDSET LDA B3612 DISABLE RS JSB CDSET LDA BN56 DISABLE RUBOUT JSB CDSET LDA BN40 ENABLE CNTL-D JSB CDSET CLA LDB TEM10 GET DEVICE TYPE ADB TEMP4 AD#### CPB B61 IS IT A CRT IOR B20 YES! TURN ON ECHO JSB ECHO IT IS OFF FOR CTU AND LP * JMP CDINT,I (4 THRU 36) B61 OCT 61 BIT15 OCT 100000 BIT13 OCT 20000 (R03) BIT14 OCT 040000 BIT12 OCT 010000 BIT11 OCT 004000 BIT10 OCT 002000 BIT9 OCT 001000 CMB14 OCT 137777 ESC OCT 33 B136 OCT 136 B.4 OCT 177774 B.7 DEC -7 D.10 DEC -10 * ********************************************* * SUBROUTINE READS TERMINAL STATUS * * AND SETS EQT27 FOR : * * CHARACTER\BLOCK 0\1 (BIT15) * * LINE STRAP\PAGE STRAP 0\1 (BIT14) * ********************************************* * TERST NOP CLA JSB ECHO TURN ECHO OFF JSB SPCH1 JSB XMIT SET XMIT MODE LDA ESC OUTPUT ESCAPE JSB OUT1 LDA B136 OUTPUT CARROT. THESE TWO CHARACTERS JSB OUT1 PREP. TERM. FOR STATUS * JSB DC1OT GO TRIGGER STATUS TRANSMISSION WITH DC1 * LDA D.10 SET TO GET 10 BYTES STA EQT30,I SAVE COUNT RSS TERS1 JSB OUT1 WAIT FOR CHAR. JSB CHRIN GO GET CHAR..IT IS NECESARY TO READ LDB EQT30,I IS THIS THE CPB B.7 ONE ? JMP TERS0 YES CPB B.5 RSS JMP TERS2 AND B2 RAR,RAR STA B LDA EQT27,I RAL,CLE,ERA CLEAR CHAR/BLOCK IOR B UPDATE STA EQT27,I JMP TERS2 TERS0 AND B10 YES LOOK FOR LINE PAGE ALF,ALF  ALF,RAR MOVE TO POS 15 . (LINE\PAGE =0\1) STA B SAVE LDA EQT27,I GET STATUS AND CMB14 CLEAR L/P BIT (14) IOR B UPDATE STA EQT27,I TERS2 LDA TEM14 IS IT A SPECIAL CHAR. ? SZA JMP *+3 YES THE MUST BE A 2640X ISZ EQT30,I BUMP COUNT JMP TERS1 LOOK FOR NEXT LDA B20 ALL FINISHED JSB ECHO SET ECHO CLA STA EQT30,I CLEAR BIN COUNT JMP TERST,I * ************************************************* * SUBROUTINE OUTPUTS AN ENK TO TERMINAL * * AND WAITS FOR AN ACK. * ************************************************* * ENAK NOP LDA ENAK STA EQT33,I SAVE RETURN ADDRESS JSB XMIT SET UP FOR TRANSMIT LDA B5 OUTPUT ENK TO TERMINAL JSB OUT1 WAIT FOR XMIT INTERRUPT JSB RECIV SET START READ-SHEC.CONDITION JSB OUT1 GO SET START READ * LDA EQT33,I GET RETURN ADDRESS JMP A,I RETURN * IFZ * ************************************************ * SUBROUTINE READS THE CTU STATUS * * * *SET BIT0--UNIT BUSY OR CARTRIDGE NOT INSERTED* * BIT1--END OF VALID DATA * * BIT2--CARTRIDGE NOT WRITE ENABLED * *-------------- * BIT3--LAST COMMAND ABORTED * * BIT4--READ\WRITE ERROR * * BIT5--END OF TAPE * * ----------- * BIT6--LOAD POINT * * BIT7--END OF FILE * * * * THE CTU STATUS COMES IN THREE BYTES * * * BYTE * 1 EOF - LP - EOT - WR. ERR(2645) * 2 CMD.AB.- W.P. - RD.ERR. -BUSY(2645) * 3 RD.ERR. - RD.ERR.(HARD) - EOD -C.I. ************************************************ * CTUST NOP LDA CTUST SAVE RETURN ADDRESS STA EQT34,I * CLA TURN OFF JSB ECHO ECHO FOR STATUS READ * JSB CTPRP GO PREP. TERMINAL FOR CTU TRANSFER LDA B136 OUTPUT <^> JSB OUT1 JSB DC1OT TRIGGER TRANSFER WITH DC1 * LDB B.5 INITIALIZE STATUS COUNT STB EQT30,I RSS * * CTUS1 JSB OUT1 JSB CHRIN GET CHARACTER ISZ EQT30,I ARE THESE STATUS BYTES? JMP CTUS1 NO! GO GET NEXT CHAR. AND B17 ALF STA EQT30,I JSB OUT1 JSB CHRIN GET STATUS BYTE NO. 2 AND B15 ISOLATE BITS 0,2,3 IOR EQT30,I "OR" BYTE 1 WITH BYTE 2 STA EQT30,I STORE IT TEMPORARILY JSB OUT1 JSB CHRIN GET BYTE 3 AND B4 CHECK FOR READ ERROR RAL,RAL MOVE TO BIT 4 IOR EQT30,I STA B LDA TEMP8 GET BYTE 3 AND B3 ISOLATE FIRST TWO BITS (WEN AND EOV) XOR B1 COMPL. C.I. IOR B OR WITH BYTES 1 AND2 XOR B10 COMPLEMENT BIT 3 AND B377 ISOLATE STATUS BITS STA EQT30,I SAVE STATUS JSB OUT1 FOR THE LAST CHAR LDA EQT30,I GET STATUS CLB CLEAR STB EQT30,I RECORD COUNT * LDB EQT34,I SAVE RETURN ADDRESS JMP B,I * CTPRP NOP THIS SUBROUTINE PREPARES TERMINAL TO ACCEPT LDB CTPRP SAVE RETURN ADDRESS STB EQT35,I STA EQT32,I CTU CONTROL AND R\W REQUESTS JSB XMIT LDA EQT27,I CHECK FOR KEYBOARD DISABLE BIT AND B20 (BIT4) SZA IF SET ALREADY DISABLED JMP OVER6 LDA ESC JSB OUT1 LDA B143 (SMALL "C") JSB OUT1 LDA B20 IOR EQT27,I SET KEYBOARD DISABLE BIT STA EQT27,I OVER6 LDA ESC JSB OUT1 OUTPUT LDA B46 JSB OUT1 OUTPUT <&> LDA B160 JSB :_OUT1 OUTPUT LDA TEM10 GET DEVICE JSB OUT1 LDA B165 LDB TEMP4 GET REQUEST TYPE CPB B3 IS IT CONTROL? JSB OUT1 YES, SEND LDA EQT32,I RESTORE A REG LDB EQT35,I GET RETURN ADDRESS JMP B,I * * * * * ************************************************ *SUBROUTIONE TAKES A NO. IN A REG. * * (<1000D) AND CONVERTS TO ASCII WITH MSB * * AT BUFF1 AND LSB AT BUFF3. * *THE CHARACTERS ARE SENT MSB FIRST * ************************************************ * BINAS NOP LDB BINAS SAVE RETURN ADDRESS STB EQT32,I SSA IS NUMBER OK? (POSITIVE) JMP BINAS,I NO! LDB BN50 LOAD B WITH DEC -1000 ADB A ADD NUMBER TO -1000 SSB,RSS IS SIGN ZERO? JMP BINAS,I YES! EXIT FOR NUMBER >999 LDB ADDRT GET BUFFER ENDING ADDRESS ADB B2 ADD 2 STB TEMP1 STORE IT AT TEMP1 BINA1 CLB DIV LF DIVIDE NO. IN A REG. BY 10 ADB B60 CONVERT TO ASCII STB TEMP1,I STORE IT. LDB TEMP1 GET NEXT ADDRESS ADB B.1 DECREMENT IT STB TEMP1 RESTORE IT SZA IS THE A REG.(QUOTIENT) =0 ? JMP BINA1 NO! GO DIVIDE A REG. AGAIN LDA ADDRT YES! IT IS ZERO ADA B.1 CPA TEMP1 ARE WE FINISHED? JMP BINA2 YES!NOW GO OUPUT CHAR. CLA NO,GO FILL REMAINING PLACES WITH JMP BINA1 ASCII <0> BINA2 LDB ADDRT GET MSD IN B REG. STB EQT29,I STORE IT FOR LATER USE LDA B.3 SETUP COUNTER STA EQT30,I I25W8 LDA B,I GET ASCII CHAR. IN A REG. JSB OUT1 GO SEND IT! ISZ EQT29,I INCREMENT ADDRESS POINTER LDB EQT29,I RESTORE IN B REG. FOR ISZ EQT30,I ISZ COUNT COUNTER JMP I25W8 THERE ARE MORE,GO GET 'EM LDA EQT32,:%I GET RETURN ADDRESS JMP A,I * ADDRT DEF BUFF1 BUFF1 BSS 3 B46 OCT 46 B165 OCT 165 B15 OCT 15 B30 OCT 30 B143 OCT 143 * XIF ************************************************* * SUBROUTINE IS GENERAL OUTPUT ROUTINE * * TO TERMINAL. CHAR. IS IN A REG. * ************************************************* * OUT1 NOP GENERAL PURPOSE CHARACTER OUTPUT ROUTINE LDB OUT1 STB EQT36,I SAVE RETURN ADDRESS AND B377 CLEAR UPPER HALF STA B SAVE A LDA EQT31,I GET EQT31 AND BN15 SAVE UPPER IOR B UPDATE STA EQT31,I OLD DATA WORD JSB EXIT1 EXIT AND OUTPUT CHARACTER LDA EQT31,I AND BIT11 KEEP ECHO STA EQT31,I CONDITION LDA EQT36,I GET RETURN ADDRESS JMP A,I * * XMIT NOP SET CARD UP FOR XMIT LDA EQT31,I RAL,CLE,ERA KNOCK OUT OLD READ. IOR BIT14 TURN ON START WRITE BIT STA EQT31,I FOR NEXT WRITE JMP XMIT,I * * SPCH1 NOP THIS SUBROUTINE SETS SPECIAL CHAR. INTERRUPTS LDA BN12 JSB CDSET SET INTERRUPT LDA BN11 JSB CDSET SET INTERRUPTS JMP SPCH1,I RETURN * * B.1 OCT 177777 B.5 OCT 177773 BN50 DEC -1000 * * *********************************************** * * *********************************************** * * REJ3 LDA BIT13 (R03) NO-OP -> IGNORE INT JMP REJ4 (R05) REJ2 CLA ERROR RETURN CLB ISZ RTN TO PHYSICAL REJ1 EQU * JMP RTN,I DRIVER * **************************************************** * IS USED FOR CONTINUATION EXITS TO THE * * LOGICAL DRIVER, P+1 RETURNS. * **************************************************** * EXIT1 NOP LDB EXIT1 GET CALLING PROGRAMS ADDRESS+1 STB EQ"T11,I STORE AT EQT11,I FOR INTERRUPT REJ4 STA TEM12 (R05) SAVE DATA/DIR. LDA TEM11 GET DEVICE TYPE CPA B3 CLA LDB EQT14,I GET SET TIMEOUT SZA IF NON CRT THEN SET LDB TOUT 60 SEC. TIME OUT LDA TEM12 DATA DIR. ISZ RTN BUMP FOR CONTINUATION JMP RTN,I AND RETURN * * ********************************************************* * DOES ASCII CTU AND DISPLAY WRITE EOR PROCESSING* ********************************************************* * * EORP NOP LDA EORP SAVE RETURN ADDRESS STA EQT29,I LDA CR OUTPUT A JSB OUT1 LDA LF OUTPUT A JSB OUT1 LDA EQT29,I JMP A,I * * ******************************************** * ENABLES KEYBOARD IF IT HAS BEEN * * LOCKED BY A CTU REQUEST * ******************************************** * KEYBD NOP LDA EQT27,I AND B20 IS IT LOCKED (BIT 4) SET SZA,RSS JMP KEYBD,I NO! JSB XMIT LDA ESC UNLOCK KEYBOARD JSB OUT1 LDA B142 JSB OUT1 SEND SMALL B JSB CDINT LDA EQT27,I AND BN3 REMOVE KEYBD LOCK BIT STA EQT27,I JMP KEYBD,I * EOOP7 NOP IF CN50C FLAG IS SET(BIT3,EQT27) JMP EOOPC THEN EOOP7 IS LDA EQT8,I IT IS SET JMP A,I * EOOP8 LDB TEMP1 THIS EXIT IS USED IF UNDERSCORE CPB CMB5 IS ONLY CHAR. RSS * ********************************************************* * AND ARE ENTRIES FOR COMPLETION (P+1) * * EXITS. THE TERMINAL OR CTU STATUS IS TEMPORARLY PUT * * IN TEMP5. * ********************************************************* * EOOP1 EQU * EOOP2 CLA STA EQT29,I SET A REG. EXIT JMP EOOP3 * EOOPC LDB TEMP4 IF CONTROL ALWAYS GET STATUS& IFZ CPB B3 RSS SZA IF GOOD WRITE DO NOT GET STATUS EOOP5 JSB CTUST YES!,GO UPDATE CTU STATUS EOOP6 STA TEM8 * EOOPB LDA BN55 REMOVE EOF FLAG IN EQT27 LDB TEM11 BECAUSE TAPE HAS MOVED RBL XOR B LDB EQT27,I AND B STA EQT27,I LDA TEM8 * ****************************************************** * A READ TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 0 GOOD READ * * 40 END OF TAPE. GOOD RECORD READ * * 240 EOT+EOF. NO RECORD READ, * * SET FOR NR(A=1) EXIT * * 42 EOT+EOV * * 52 EOT+EOV+ABORT * * * ****************************************************** * * ****************************************************** * A WRITE TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 42 EOT+EOV GOOD RECORD WRITTEN * * 52 EOT+EOV+ABORT (NO RECORD WRITTEN)* * SET ET(A=1) EXIT * * * ****************************************************** * ****************************************************** * READ TO EOV IN MIDDLE OF TAPE * * STATUS * * 200 EOF * * 2 EOV * * 12 EOV+ABORT * * SET NOT READY EXIT * * * ****************************************************** * EOOPA AND B373 REMOVE WRITE PROTECT CPA B240 IF EOF+EOT THEN SET NR JMP OVER4 d CPA B52 IF FAILURE ON WRITE JMP OVER4 DUE TO EOT DO THIS(SAVE REQ.) AND B30 CHECK FOR CMD ABORT SZA OR READ-WRITE ERROR JMP OVER4 SET N.R. CLB STB EQT29,I SET A=0 FOR GOOD EXIT JMP EOOP3 OVER4 CLB,INB SET NR STB EQT29,I SET A REG. EXIT XIF *********************************************************** * IS ENTRY FOR B=0 (TRANS. LOG =0) EXIT. * *********************************************************** * EOOP4 CLA STA EQT8,I SET UP FOR B REG. =0 EXIT * ********************************************************** * SETS 2640\2644 AND IO CARD FOR NEXT INTERRUPT * * OR REQUEST, AND SETS EITHER CTU OR CRT STATUS IN EQT5 * * * IT ALSO SETS THE TRANSMISSION LOG IN B REG. (+CHAR. OR * * + WORDS). IF EQT8 =0 (VIA EOOP4) THEN B=0. * ********************************************************** * EOOP3 EQU * JSB KEYBD ENABLE KEYBD IF LOCKED LDB EQT13,I LOOK TO SEE IF ADB B6 FULL OR HALF DUPLEX LDA B,I WELL?? SSA JSB ENAK FULL DUPLEX, HANDSHAKE BEFORE EXIT CLA,INA SET ECHO ON JSB ECHO IF OFF CLA INDICATE WE ARE TRYING STA EQT11,I TO FINISH LDB EQT9,I GET 2X LAST CHAR. ADDRESS CMB,INB MAKE NEG. ADB EQT7,I SUBTRACT TWO TIMES STARTING ADD. ADB EQT7,I CMB,INB LDA EQT8,I IF WORDS THEN DIV. BY 2 SSA JMP *+4 THESE ARE CHARACTERS SLB IS LSB SET? INB YES! INCREMENT SO EVEN FOR DIVIDE BRS DIVIDE TO CONVERT TO WORDS * SZA,RSS IF EQT8 IS 0 THEN CLEAR B REG. CLB STB EQT6,I SAVE XMIT LOG LDA EQT13,I EXTENT ADDRESS ADA B3 BUMP TO EQ19 LDB EQT29,I WHAT KIND OF END IS IT? SZB SKIP IF GOOD JMP RTN,I BAD RETUcRN LDB A LDA B,I IOR B40 TURN ON BIT 5 STA B,I IN EQ19 FOR GOOD END JMP RTN,I RETURN * * * BN3 OCT 100007 TOUT DEC -600 B373 OCT 373 B142 OCT 142 B240 OCT 240 B106 OCT 106 B64 OCT 64 B300 OCT 300 B3 OCT 3 B6 OCT 6 B13 OCT 13 D.11 DEC -11 B2000 OCT 2000 B52 OCT 52 CMB11 OCT 173777 ********************************************************** * CONFIGURES IO INSTRUCTIONS TO SELECT CODE SET * * IN A REG. * ********************************************************** * SETIO NOP LDA BSAVE GET EQT ADDRESS STA EQT1 SSA CMA,INA MAKE POS. IF NEG. ADA B3 BUMP TO EQT4 STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 ADA B2 STA EQT13 INA STA EQT14 IFN LDA B60 SET FOR CRT IF NO "Z" IN ASMB STATEMENT STA TEM10 XIF * IFZ LDA EQT4,I GET SUBCHANNEL TO IDENTIFY DEVICE LSR 6 SC=0 IS CRT (TEM10=60) AND B37 SC=1 IS L CTU )(TEM10=61) STA TEM11 CPA B3 IS THIS UNIT 3? CLA YES ADA B60 SC=2 IS R CTU (TEM10=62) STA TEM10 SC=4 IS PRINTER (TEM10=64) XIF LDA EQT6,I GET CONTROL WORD LDB TEM10 GET DEVICE CPB B64 IS IT LP? CLA YES! SET FOR ASCII RAR BIT6 1\0 IS BIN\ASCII AND B40 ISOLATE BIT 5 XOR B40 REMOVE BIT 5 IF BINARY STA FILL SET FILL CHARACTER LDA EQT6,I GET WORD AGAIN TO SET HONEST WORD LSR 6 AND B37 STA RDTYP LDA EQT6,I AND B2000 HONEST IS BIT 10 =1 STA TEMP2 * IFZ LDA TEM10 _ CLB CPA B60 SET SWITCH CRT/CTU = RSS/NOP LDB RSS STB SWH1A STB SWH1B STB SWH1C STB SWH1D * XIF * **************************************************** * SETUP EXTENSIONS ON EQT * * * * EQT NO. USE * * 1-8 STANDARD * * 9 RUNNING CHAR. ADDRESS * * 10 LAST CHAR. ADDRESS * * 11 ADDRESS TO GO ON INTERRUPT * * 12 NO. OF EQT EXTENSIONS * * 13 EQT EXTENSION STARTING ADD. * * 14-15 STD * * 16-26 USED BY THE PHYSICAL DRIVER * * 27 TERMINAL STRAPPING AND CTU INFO* * BIT 15 IS 0\1 =CHAR.\BLOCK * * BIT 14 IS 0\1 =LINE\PAGE * * BIT 12 IS CR SEARCH * * BIT 11 IS RS SEARCH * * BIT 10 IS RUBOUT SEARCH * * BIT 9 IS CNTLD SEARCH * * BIT 4 IS KEYBOARD LOCKED * * BIT 3 IS CNC50 FLAG * BIT 2 IS RCTU EOF FLAG * BIT 1 IS LCTU EOF FLAG * BIT 0 IS UNUSED * * 28 STORAGE FOR ICNWD * * 29 RETURN ADDRESS * * AND A REG. EXIT * 30 BINARY RECORD LENTGH * * 31 RETURN ADD. * * 32 AND RETURN ADDRES* * 33 RETURN ADDRESS * * 34 RETURN ADDRESS * * 35 RETURN ADDRESS * * 36 RETURN ADDRESS * * 37 RETURN ADDRESS * * ************************J**************************** * * LDA EQT4,I GET STARTING ADDRESS OF EXT. AND B17 SELECT CODE TELLS MPY B13 THE ADDRESS IN ADA EQADR TEMP STORAGE LDB D.11 STB TEMP1 STORE NO. OF EXT. AT TEMP1 LDB ADR27 GET ADD. OF EQT27 STA B,I STORE S.A. OF EXT. IN IT INA INB ISZ TEMP1 JMP *-4 * CLB IF CN50C FLAG IS SET THEN LDA EQT27,I STORE A AT EOOP7 AND B10 SZA LDB RSS STB EOOP7 * LDA EQT6,I GET CONTROL WORD AND B3 STA TEMP4 STORE REQUEST TYPE AT TEMP4 CPA B3 IS THIS CONTROL? JMP OVER7 YES JMP OVER2 NO,READ OR WRITE OVER7 LDA EQT6,I LSR 6 IF CONTROL TYPE 0 AND B37 THEN SPECIAL PROCESSING REQUIRED SZA,RSS AT JMP OVER3 * * OVER2 LDA EQT6,I RAL,CLE,SLA,ERA CLR 15 IF SYS REQ STA EQT6,I NORMAL NON CNTL 0 REQ. STA EQT28,I STORE CURRENT CONWD FOR SYS. INTERRUPT JMP SETIO,I * * SPECIAL "CONTROL 0" PROCESSING * OVER3 LDA EQT6,I IS THIS A SYSTEM REQ.? SSA,RSS JMP REJ1 NO! * LDA EQT28,I GET OLD CONWD STA EQT6,I PUT IN CURRENT CONWD AND B2 IF WRITE MUST COMPLETE XFER CPA B2 OR TERMINAL WILL HANG JMP OVER9 LDA EQT9,I NO MORE DATA IN USERS BUFFER! STA EQT10,I IT IS GONE!!! OVER9 LDA TEM11 IF NON CRT REQ. WE MUST COMPLETE SZA JMP REJ1 CONTINUE NOT CRT REQ. * JSB KEYBD ENABLE KEYBOARD IF LOCKED LDA EQT6,I RAR SLA,RSS IF WRITE OR CONT. THEN SEND NULL JMP REJ1 THIS IS A CRT READ CLA SEND NULL TO ALLOW CHAR. OUT OF UART JSB OUT1 JMP EOOP1 ADR27 DEF EQT27 EQT1 NOP EQT4 NOP EQT5 NOP EQT6 NOP EQT7 NOP EQT8 NOP EQT9 NOP EQT10 ݌NOP EQT11 NOP EQT13 NOP EQT14 NOP EQT27 NOP EQT28 NOP EQT29 NOP EQT30 NOP EQT31 NOP EQT32 NOP EQT33 NOP EQT34 NOP EQT35 NOP EQT36 NOP EQT37 NOP * * TEMPORARY STORAGE FOR EQT27 TO EQT35 * SUP * * A EQU 0 DEFINE A REG. B EQU 1 DEFINE B REG. * * * * * *CONSTANT STORAGE ********** FILL NOP BINARY ASCII(SPACE = 0\40) TEMP1 NOP TEMP2 NOP HONEST MODE =2000 (NOT =0) TEMP4 NOP REQUEST TYPE (1-3 TEMP8 NOP ASCII DATA WORD TEM8 NOP TEMPORARY STATUS TEM10 NOP IN ASCIIYPE TEM11 NOP DEVICE TYPE(IN BINARY) TEM12 NOP TEM14 NOP COMPLETE DATA WORD ON CARD RDTYP NOP EQADR DEF EQTXX EQTXX BSS 176 ORG * END ^ ) 91731-18003 1926 S C0122 &LDV5B LOG DVR FOR 32 PORT             H0101 זASMB,L,C,R,Z ***RTE 2640\2644\2645 LOGICAL DRIVER** * NAME: LDVR5 32 PORT VERSION * SOURCE: HP 2644 \2645 RTE LDVR5 91731-18003 * RELOC.: HP 2644A\2645 RTE LDVR5 91731-16006 WITH CTU * RELOC.: HP 264X RTE LDVR5 91731-16005 WITHOUT CTU * * PRMR: B.B. (LOGICAL-LDVR5-MOD B.R.) * * REVISIONS (RXX) BY G.D. * LAST REV: (R06) 4/3/79 SET DVR TYPE TO 05 ON CALL * LAST REV: (R05) 10/19/78 * (R04) 10/3/78 * (R03) 9/18/78 * (R02) 9/11/78 * (R01) 9/7/78 * * ***************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSALATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ***************************************************************** * ****LDVR5 WILL WORK WITH 2640B\2645 * *********************************************** * FOR CTU AND OR PRINTER OPERATION INCLUDE * * "Z" PARAMETER IN ASSEMBLY CONTROL STATEMENT * * ASMB,R,Z * *********************************************** * * *********************************************** * FOR KEYBOARD\DISPLAY OPERATION ONLY * * INCLUDE "N" PARAMETER IN CONTROL STATEMENT * * ASMB,R,N * *********************************************** * *2.1 INPUT/OUTPUT INTERFACE * * LDVR5 WILL COMMUNICATE WITH THE 2644A/2640A VIA THE 12920 * ASYNCHRONOUS DATA COMMUNICATION INTERFACE. LDVR5 WILL ALSO * FUNCTION WITH A 2640A FOR THOSE APPLICATIONS WHERE THE CTU IS * NOT REQUIRED. COMMUNICATION FROM THE 2644A/2640A KEYBOARD MAY BE * IN EITHER CHARACTER OR BLOCK MODE. THE TERMINAL CAN BE USED WITH * "LINE STRAPPING", OR "PAGE STRAPPING" AND HENCE A SINGLE LINE OR * THE ENTIRE DISPLAY MEMORY CAN BE TRANSMITTED AFTER BEING ENABLED. * * *2.2 MAJOR FUNCTIONS * * LDVR5 PROVIDES THE FOLLOWING MAJOR FUNCTIONS: * 1. I/O CONTROL OF CARTRIDGE TAPE UNIT (CTU),CRT,AND TERMINAL PRINTER. * 2. READ OR WRITE REQUEST TO CTU WITH BINARY OR ASCII DATA. * 3. READ OR WRITE REQUEST TO KEYBOARD AND DISPLAY. * 4. STATUS REQUEST TO CTU AND KEYBOARD. * 5. CONSOLE OR TERMINAL USE. * 6. WRITE REQUEST TO TERMINAL PRINTER (2644 2645 ONLY) * * *2.2.1 CTU CONTROL REQUEST * *ICNWD (CONTROL LEFT OR RIGHT CTU AS SELECTED BY LOGICAL UNIT NUMBER) * 01-WRITE END OF FILE * 02-BACKSPACE 1 RECORD * 03-FORWARD SPACE 1 RECORD * 14-BACKSPACE 1 FILE * 13-FORWARD SPACE 1 FILE * 4 -REWIND * 27-LOCATE FILE. THIS IS AN ABSOLUTE FILE NUMBER. * 26-WRITE END OF VALID DATA (EOV) * 10-WRITE EOF IF NOT JUST WRITTEN OR NOT AT BOT * 32-UPDATE INTERNAL TERMINAL STATUS * * *NOTES ON CTU CONTROL REQUEST * * A. A REWIND, BACKSPACE RECORD, OR BACKSPACE FILE WILL PERFORM * NO ACTION IF THE TAPE UNIT IS AT LOAD POINT. THIS CONDITION * WILL BE SET IN THE STATUS WORD (BIT 6 SET). * B. IF THE END-OF-TAPE MARK IS SENSED DURING A WRITE OPERATION, * AN END OF VALID DATA MARK WILL BE RECORDED AUTOMATICALLY. IF * A WRITE REQUEST WAS BEING PROCESSED, THE CURRENT RECORD WILL * BE RECORDED. IF A READ REQUEST WAS IN PROCESS THE CURRENT * RECORD WILL BE READ. THIS CONDITION WILL BE SET IN THE STATUS * WORD. * C. FOR FILE MOTION COMMANDS THE TAPE IS POSITIONED AFTER THE * FILE MARK. * D. READ REQUESTS WILL BE REJECTED IF THE TAPE IS AT EOV. THE * EOV MAY BE OVERWRITTEN WITH DATA OR A FILE MARK UNLESS THE * TAPE IS AT END-OF-TAPE. * E. AN INVALID FUNCTION CODE WILL CAUSE THE DRIVER TO EXIT WITH * THE FUNCTION IGNORED. IF THE FUNCTION CODE IS VALID, EXIT IS * NORMAL. * F. DYNAMIC STATUS PUTS THE STATUS OF THE LAST LEFT OR RIAGHT * CTU OPERATION IN PRAM1. * * *2.2.2 CRT CONTROL REQUEST * *ICNWD * 11-SPACE "IPRM" LINES -IPRM PG. EJECT 9871 ONLY * 22-SET NEW TIME OUT (IN OPTIONAL PARAMETER) * 24-RESTORE OUTPUT PROCESSING. REQUIRED ONLY IF SOME OF BUFFER IS * TO BE SAVED. * -ANY CONTROL REQUEST, VALID OR INVALID, WILL RESULT IN ENABLING * INTERRUPT ON A TERMINAL IF THE TERMINAL HAS BEEN ENABLED. * * *2.2.3 CTU READ/WRITE REQUEST * * -READ/WRITE FROM LEFT OR RIGHT CTU AS SELECTED BY LOGICAL UNIT * NUMBER. * -IF THE OPERATION FAILED, RETURN WILL BE THROUGH DVS00 WITH BIT * 5 OF EQT 19=0 *ICNWD * * 6 -0/1 IS ASCII/BINARY * 7 -1 AND 6 -0 READ A COMPLETE FILE(ASCII)-ILLEGAL FOR BLK&PG * 10-0/1 IS NOT HONEST/HONEST * * -BINARY INPUT IS A STRING OF CHARACTERS SPECIFIED BY THE BUFFER * LENGTH PARAMETER IN THE REQUEST. IF THE REQUIRED LENGTH IS FILLED * BEFORE A END-OF-RECORD (EOR) IS ENCOUNTERED, THE REMAINING DATA * IS IGNORED AND THE CTU WILL STOP AT THE NEXT EOR. IF A EOR IS * ENCOUNTERED BEFORE THE REQUIRED LENGTH IS FILLED THE CTU WILL * HALT IN THE EOR. * IF BUFFER LENGTH=0, THEN SKIP * ONE RECORD. * -BINARY OUTPUT IS A STRING OF CHARACTERS SPECIFIED BY THE BUFFER * LENGTH PARAMETER IN THE REQUEST. MAXIMUM RECORD LENGTH IS 128 * WORDS. THIS LIMIT IS SET BY THE CTU DATA BUFFER. * -ASCII INPUT IS A STRING OF CHARACTERS TERMINATED BY A CARRIAGE * RETURN (CR). IF THE REQUIRED LENGTH IS FULFILLED BEFORE A CR * IS INPUT, THE REMAINING CHARACTERS ARE IGNORED. IN ANY CASE, A * CR CODE MUST BE INPUT. * -ASCII FILE READ (200B+LU), ALL CHARACTERS ARE READ UNTIL * AN EOF IS ENCOUNTERED,IE. AN 'RS' CHAR. * -ASCII OUTPUT IS A STRING OF CHARACTERS SET BY THE BUFFER LENGTH. * MAXIMUM RECORD LENGTH IS 127 WORDS (CR IS SENT BY LDVR5 ). THE * DRIVER WILL TERMINATE THE REQUEST IF IT SEES A "CR", "LF" OR "RS". * THE DRIVER USES THE "CR" AS A RECORD TERMINATOR ON INPUT * AND THE 2644A USES THE "LF" AS RECORD TERMINATOR ON OUTPUT.A "RS" * IS PASSED TO THE DRIVER WHEN THE CTU ENCOUNTERS A FILE GAP. * * *2.2.4 ASCII OUT TO DISPLAY * * -ASCII OUTPUT IS A STRING OF CHARACTERS, THE NUMBER OF WHICH IS * DESIGNATED BY THE BUFFER LENGTH. THE STRING IS TERMINATED BY A * CARRIAGE RETURN AND LINE FEED (BOTH SUPPLIED BY DRIVER). * -IF AN UNDERSCORE (ASCII 137) IS THE LAST CHARACTER IN THE NEW * BUFFER, THE CARRIAGE RETURN, LINE FEED AND UNDERSCORE CODES ARE * NOT OUTPUT TO THE CRT. * -BUFFER LENGTH SHOULD BE LIMITED TO 80 DISPLAYABLE CHARACTERS. * -THE CURSOR WILL REMAIN IN COLUMN 80 IF CURSOR END-OF-LINE WRAP * AROUND STRAP IS NOT IN. OTHERWISE AN AUTOMATIC CR LF ARE GENERATED. * -HONEST MODE WRITE THE CR AND LF ARE NOT OUTPUT. AN UNDERSCORE * WILL ALWAYS BE OUTPUT TO DISPLAY IF IN BUFFER. * -DURING OUTPUT TO DISPLAY STRIKING ANY KEY WILL FREEZE OUTPUT. TO * RESUME STRIKE ANY KEY. TO GET SYSTEM ATTENTION HIT . * * -BINARY WILL STRIP "ESC", EXCEPT WHEN SUB=3 * *2.2.5 ASCII INPUT FROM KEYBOARD CHARACTER MODE * * THE DRIVER DETECTS WHETHER A CHARACTER MODE OR BLOCK MODE REQUEST * WILL FOLLOW BY EXAMINING THE FIRST CHARACTER. IF IT IS A DC2 * THEN THE DRIVER ASSUMES THE ENTER KEY HAS BEEN PRESSED AND A * BLOCK TRANSMISSION IS PENDING. THE DRIVER RESPONDS WITH A DC1 TO * TRIGGER THE BLOCK TRANSFERS. IF THE FIRST CHARACTER IS NOT A DC1 * THEN THE DRIVER ASSUMES A CHARACTER TRANSFER IS PENDING. * IN CHARACTER MODE THE TERMINAL TRANSMITS A CHARACTER AT A TIME AS * THE KEY IS DEPRESSED. THE RECORD TERMINATION IS A CR OR RS. THE * DRIVER ECHOS A LF. * A RECORD TERMINATOR MUST BE ENTERED TO COMPLETE REQUEST, EVEN IF THE * USERS BUFFER IS FULL. TRANSMISSION LOG IS RETURNED IN EQT 6 * THERE ARE TWO TYPES OF CHARACTER MODE PROCESSING: HONEST AND NON-HONEST * A. HONEST * ALL CHARACTERS EXCEPT CR AND RS SENT TO USERS BUFFER. * B. NON-HONEST * THE DRIVER WILL PROCESS THE BELOW SPECIAL CHARACTERS: * *DEL (RUBOUT) ASCII 177 * ENTERING DEL WILL DELETE THE CURRENT RECORD AND CAUSE (\, * CRLF)TO BE OUTPUT. THIS IS USED TO DELETE THE CURRENT LINE * AND START A NEW LINE. * *BACKSPACE ASCII 10 * ENTERING BACKSPACE WILL DELETE THE LAST CHARACTER. THE * TERMINAL WILL LOCALLY MOVE THE CURSOR BACK ONE POSITION. * *LINEFEED ASCII 12 * THIS WILL NOT BE SENT TO USER'S BUFFER. * * CNTROL D ASCII 40 * ENTERING CONTROL D WILL CAUSE BIT 5 TO BE SET IN TERMINAL * STATUS WORD AND TRANSMISSION TERMINATED WITH LOG. = 0. THIS * BIT WILL BE CLEARED UPON NEXT ENTRY. * * *2.2.6 ASCII INPUT FROM KEYBOARD BLOCK MODE * * IN BLOCK MODE THE TERMINAL TRANSMITS EITHER A LINE AT A TIME (LINE * STRAPPING) ON A PAGE (PAGE STRAPPING). THE DRIVER DETERMINES TYPE * OF STRAPPING BY A TERMINAL STATUS REQUEST. * A. LINE STRAPPING * THE TERMINATOR IS A CR WHICH IS NOT PASSED TO USER'S * BUFFER. IMBEDDED RS'S ARE NOT PASSED. * B. PAGE STRAPPING * THE TERMINATOR IS A RS WHICH IS NOT PASSED TO USER'S BUFFER. THE * LINE SEPARATORS CR, LF ARE PASSED TO USER'S BUFFER. * C. A "RS" IS NEVER PASSED TO BUFFER * D. BLOCK READS ARE OF 2 TYPES: * 1. TERMINAL ENABLED (ENTER PRESSED) * 2. USER ENABLED ("ESC" SMALL "D" SENT) * * *2.2.7 CTU DYNAMIC STATUS REQUEST (RETURNED IN IBUF) * FOR: CALL EXEC(1,3700B+LU,IBUF,1) , IBUF(1) WILL CONTAIN; * * BIT * 7 -END OF FILE SENSED. A FILE MARK HAS BEEN DETECTED DURING A PRIOR * READ OPERATION OR A FILE MARK HAS JUST BEEN RECORDED. * 6 -LOAD POINT SENSED. CARTRIDGE TAPE IS AT OR BEFORE LOAD * POINT MARKER. MEANINFUL ONLY IF CARTRIDGE IS INSERTED. P* 5 -END OF TAPE SENSED. THE CARTRIDGE TAPE HAS PASED OVER EARLY * WARNING MARKER IN THE TAPE AND AN END-OF-VALID DATA MARK HAS BEEN * RECORDED AUTOMATICALLY. COMMANDS DIRECTING FORWARD MOTION OF TAPE * WILL BE REJECTED. THIS STATUS ONLY HAS MEANING IF A CARTRIDGE IS * INSERTED. * 4 -READ\WRITE ERROR.WRITE 2645 ONLY * A READ ERROR EXISTS IF THREE SUCCESSIVE ATTEMPTS FAILED TO READ * THE DATA IN THE RECORD. THE TAPE IS POSITIONED AFTER THE BAD * RECORD. * 3 -LAST COMMAND ABORTED. THE LAST COMMAND INITIATED FROM THE CPU OR * KEYBOARD WAS UNSUCCESSFULLY PERFORMED. OTHER STATUS CONDITIONS * MAY BE CHECKED FOR CAUSE. * 2 -WRITE PROTECTED. THE FILE PROTECT TAB ON THE CARTRIDGE IS IN THE * POSITION TO PROHIBIT RECORDING OF DATA. THIS STATUS ONLY HAS * MEANING IF A CARTRIDGE IS INSERTED AND A RECORDING OPERATION HAS * BEEN ATTEMPTED. * 1 -END OF VALID DATA. THE CARTRIDGE TAPE DETECTED AN END-OF-VALID * DATA MARK DURING A PRIOR READ OR SEARCH OPERATION OR HAS JUST * COMPLETED RECORDING AN END-OF VALID DATA MARK. IN EITHER CASE, * THE TAPE IS POSITIONED BEFORE THE END-OF VALID DATA MARK. RECORDING * OPERATIONS MAY BE EXECUTED TO OVERWRITE THIS MARK WITH DATA * OR A FILE MARK, UNLESS THE TAPE IS AT END OF TAPE. * 0 -CARTRIDGE NOT INSERTED OR UNIT BUSY. * * *2.2.8 CRT STATUS REQUEST (RETURNED IN IEQT5) * FOR: CALL EXEC(13,LU,IEQT5) * * BIT * 7 -BUFFER FLUSH IN PROGRESS * 6 -BREAK KEY HIT * 5 -CONTROL D ENTERED * 4 -TIME OUT * 3 -SPEED SENSE IN PROGRESS * 2 -BAD COMMUNICATION LINE * 1 -PAUSE MODE * 0 -TERMINAL ENABLED(1) DISABLED(0) * * *2.2.9 CONSOLE OR TERMINAL USAGE. * * IF AT GENERATAION THE 2644A IS IDENTIFIED AS A TERMINAL (VIA THE * INTERRUPT TABLE) THEN STRIKING A KEY WILL SCHEDULE THE PROGRAM * ASSOCIATED WITH THAT TERMINAL IF THE TERMINAL HAS BEEN ENABLED *  VIA A CONTROL REQUEST. * IF THE 2644 IS A CONSOLE THEN STRIKING A KEY WILL GET THE SYSTEM'S * ATTENTION AND A "*" PROMPT WILL BE WRITTEN. * * LINE PROTOCOL: * * THIS DRIVER DOES NOT SUPPORT MAIN CHANNEL * PROTOCOL FOR LINE TURN-AROUND DURING * HALF DUPLEX MODEM USE. LDVR5 RELIES UPON THE * PHYSICAL DRIVER TO PERFORM LINE TURN-AROUNDS * USING REVERSE CHANNEL PROTOCOL. * * USE: * * LDVR5 IS A TYPE 30 PROGRAM. FOR RTE IV IT MUST * RESIDE IN THE SUB-SYSTEM GOBAL AREA, ALSO FOR RTEM-III. * * ******CAUTION***** * * IF LDVR5 IS USED AS A SUBROUTINE TO A USER PROGRAM * THE USER PROGRAM SHOULD LOCK IT SELF INTO CORE * DURING ALL I-O, AND THE DEFAULT TTY DRIVER * MUST BE RE-ATTACHED (SEE BELOW) BEFORE THE * THE USER PROGRAM COMPLETES. * * INITIALIZATION: * * TO ATTACH LDVR5 AS THE LOGICAL DRIVER DO THE FOLLOWING: * * FROM FORTRAN - CALL EXEC(3,2500B+LU,IPRAM) * * WHERE LU = LU NUMBER OF THE RESPECTIVE * DEVICE. * IPRAM = THE ADDRESS OF THE ENTRY * POINT "LINT" IN LDVR5. * * NOTE: THE ADDRESS OF "LINT" MAY BE * OBTAINED FROM THE GENERATOR * LISTING, OR A CALL TO LDVR5 * SEE BELOW FOR CALL FORMAT. * * FROM THE FILE MANAGER: * * :CN,LU,25B,IPRAM PRAMATERS SAME AS ABOVE. * * TO DETACH LDVR5 AND RE-ATTACH THE DEFAULT TTY DRIVER * DO THE FOLLOWING: * * FROM FORTRAN: CALL EXEC(3,2500B+LU,0) * FROM FMGR: :CN,LU,25B,0 * * ****************************************** * SUBROUTINEIS ENTERED TO * * OBTAIN THE ADDRESS OF THE ENTRY POINT * * OF "LINT" FOR ASSIGNING LDVR5 AS THE * * LOGICAL DRIVER x * ****************************************** * CALL SEQUENCE: * * CALL LDVR5(IPRAM) * * WHERE IPRAM = PARAMETER TO RETURN ADDRESS OF "LINT" * FOR THE USER PROGRAM. * * IFN NAM LDVR5,30 91731-16005 REV.1926 790403 XIF * IFZ NAM LDVR5,30 91731-16006 REV.1926 790403 XIF ENT LDVR5,LINT EXT $LIBR,$LIBX LDVR5 NOP JSB $LIBR MAKE PRIVILEGED NOP LDB LDVR5 GET PARAMETERS 1805 LDA B,I GET RETURN ADDRESS 1805 STA LDVR5 SAVE IT FOR EXIT 1805 INB BUMP ADDRESS TO PARAMETER 1805 LDB B,I GET PARAMETER ADDRESS 1805 RBL,CLE,SLB,ERB CHECK FOR INDIRECT 1805 JMP *-2 1805 LDA L5ADR GET ADDRES OF "LINT" STA B,I GIVE ADDRESS TO USER PROG. 1805 JSB $LIBX RETURN DEF LDVR5 * * ***************************************** * * * ENTER HERE FROM PHYSICAL DRIVER * * * ***************************************** * DEC 1926 REVISION CODE. ALWAYS BEFORE LINT (= EQT17-1) * * * LINT NOP INITALIZATION CALLS JMP LINIT COME TO HERE * LRED NOP READ CALLS COME HERE JMP LREAD * LWRT NOP WRITE CALLS COME HERE JMP LWRTE * LINIT STA ASAVE SAVE CONTENTS OF A REG STB BSAVE SAVE B REG. LDA LINT SAVE RETURN STA RTN ADDRESS JSB SETIO CONFIGURE IO LDA EQT27,I FOR BINARY CTU READ AND CMB3 CLR SELECTED BITS STA EQT27,I BIT 0 (0\1=TERM.STAT. READ NO\YES) * JMP I.051 * * * ***************************************************** * "B.X" IS NEG. BINARY NO., "D.X" IS NEG. DECIMAL NO* * "BN" IS SOME BINARY NO. * * SEE BELOW. * ***************************************************** * L5ADR DEF LINT ASAVE NOP BSAVE NOP RTN NOP CMB3 OCT 177767 CMB5 OCT 177737 CMB12 OCT 167777 B11 OCT 11 DTMSK OCT 140377 (R06) B2400 OCT 2400 (R06) * * * I.051 LDA EQT5,I (R06) SET DRIVER TYPE TO 05 AND DTMSK (R06) IOR B2400 (R06) STA EQT5,I (R06) JSB CDINT ************************************************ * THOSE PORTIONS OF CODE WITHIN AND * * BOUNDRIES ARE DELETED IF OPTION IS NOT * * INCLUDED IS ASSEMBLY CONTROL STATEMENT * ************************************************ * * IFZ SWH1A NOP SWITCH CRT \CTU ,LP= RSS\NOP * JMP I.251 YES! A CTU OR LP REQUEST XIF LDA TEMP4 GET REQUEST RAR SSA,SLA CONT.? JMP I.05C YES SSA,RSS READ OR WRITE JMP I.05W WRITE JMP I.05R READ * ****************************************************************** * * * TIMOT EQU * CLA JMP RTN,I LOOKS LIKE A BAD RET. TIME OUT * * * BREAK NOP LDA EQT5,I SET THE BREAK IOR B100 BIT FOR THE PHYSICAL STA EQT5,I DRIVER LDB EQT13,I KNOCK OUT ADB B5 THE BREAK BIT - 12 - LDA B,I IN EQ21 AND CMB12 STA B,I RESTORE JMP BREAK,I RETURN FOR CHAR PROCESSING * ************************************************* * DOES CONTROL REQUEST PROCESSING FOR * * THE KEYBOARD\DISPLAY. * ************************************************* * *******TERMINAL STATUS****************************** * BIT STATUS * * 5 "CONTROL D" ENTERED * * 7 BUFFER FLUSH ENABLED * * * **************************************************** * * *******CRT CONTROL**********Z^************************ * EXEC CODE CRT CONTROL REQUEST * * 11 SPACE LINES * 22 SET TIME OUT * * * **************************************************** * I.05C LDA RDTYP GET CONTROL WORD TYPE LDB EQT7,I SSB,RSS CMB,INB COMPLEMENT OPTIONAL PARAMETER * CPA B11 JMP CN11 GO SPACE LINES CPA B22 JMP CN22 GO SET TIME OUT CPA B32 UPDATE STATUS? JMP CN32 YES * ********************REJECT REQUEST****************** * JMP REJ1 ILLEGAL CONTROL REQUEST * LF OCT 12 B37 OCT 37 B20 OCT 20 B21 OCT 21 B22 OCT 22 B2 OCT 2 B.3 OCT 177775 B100 OCT 100 B200 OCT 200 B17 OCT 17 B32 OCT 32 B70 OCT 70 * **SPACE LINES***** **MAX NO. IS 55** * CN11 SZB,RSS CHECK FOR 0 VALUE CCB CHANGE TO -1 STB EQT7,I ADB B70 MAX NO. OF (CR,LF'S) IS 55 SSB BECAUSE CARD BUFFER IS 128 JMP REJ1 JSB XMIT JSB EORP OUTPUT (CR,LF) JSB ENAK GIVE TERM. TIME TO PROCESS ISZ EQT7,I JMP *-4 CN11A CLA STA EQT29,I SET A REG. EXIT JMP EOOP4 * * * CN22 EQU * PRAM1 HAS THE TIME STB EQT14,I FOR STANDARD TIMEOUT JMP REJ1 RETURN CN32 JSB SPCH1 JSB TERST UPDATE TERMINAL STATUS JMP CN11A **********EQT6 FOR READ\WRITE***************** * * EQT6 FOR READ\WRITE OPERATIONS IS: * * BIT MEANING * * 6 0\1 IS ASCII\BINARY * * 7 -1 AND 6 -0 FILE(ASC) READ * 8 0\1 IS OFF\ON ECHO * * 10 0\1 OFF\ON HONEST MODE * * 9 AND 10 SET USER ENABLED BLOCK READ * * ********************************************** * * LWRTE STA ASAVE SAVE A STB BSAVE AND B LDA LWRT GET ENTRY ADDRESS STA RTN SAVE FOR RETURN JSB SETIO LDA ASAVE IS THE THE FIRST TIME? CPA B.1 JMP LWRT1 YES START WRITE JSB BITCK CHECK CONDITION BITS JMP TIMOT TIMEOUT BIT15 ON JMP TIMOT LINE ERROR BIT 14 ON JMP TIMOT DATA ERROR BIT 13 ON JSB BREAK BREAK BIT 12 ON LDA EQT5,I (R01) PAUSE MODE?? RAR,SLA (R01) JMP REJ3 (R03) YES, IGNORE INT. LDA EQT11,I NO, CONTINUE WITH WRITE SZA,RSS ARE WE TRYING TO COMPLETE? JMP REJ2 YES,IGNORE THE CHAR JMP A,I LWRT1 CLA STA EQT30,I INIT RECORD COUNT JMP I.051 * * * I.05W CLB,RSS SETUP EQT9(RUNNING CHAR. ADD.) AND I05W1 NOP EQT 10 (LAST CHAR. ADD.) LDA EQT7,I GET BUFFER STARTING ADDRESS RAL,CLE MULTIPLY S.A. BY TWO STA EQT9,I STORE AT EQT9 LDA EQT8,I GET BUFFER LENGTH CMA,SSA,INA,RSS COMPLEMENT,ARE THEY CHAR.? JMP I.W1 YES! CMA,INA MAKE POS AGAIN RAL MULTIPLY WORDS X 2 AND * I.W1 ADA EQT9,I STA EQT10,I STORE LAST CHAR. ADD. AT EQT10,I CMA,INA MAKE LAST CHAR. ADD. NEG. ADA EQT9,I - NO. OF CHAR. ARE NOW IN A REG. SZB JMP I05W1,I SZA,RSS IS IT 0 ? JMP I.W32 YES! IT IS ZERO * JSB TRAN1 GOTO OUTPUT SUBROUTINE * LDA TEMP2 IS THIS HONEST MODE? SZA JMP EOOP2 * I.W32 JSB XMIT JSB EORP THIS IS NOT HONEST JMP EOOP2 ABOVE NEEDED FOR INTERRUPT * * ********************************************** * WRITES TO THE DISPLAY,CTU AND PRINTER. * STARTING ADDRESS OF DATA IS EQT9,I * ************************************************** * * TRAN1 NOP LDA TRAN1 SAVE RETURN ADDRESS STA EQT29,I JSB XMIT SET CARD FOR XMIT * TRAN2 EQU * LDB EQT9,I I GET BUFFER ADDRESS X 2 CLE,ERB DIVIDE BY TWO TO GET TRUE ADD. * JSB MAPRD GET WORD SEZ,RSS DO WE WANT UPPER OR LOWER CHAR.? ALF,ALF UPPER! SHIFT TO LOWER AND B377 LOWER! MASK WORD IFZ * SWH1B NOP CRT\CTU=RSS\NOP JMP TRAN3 YES! IGNORE BELOW CHECKS XIF * * LDB FILL DO NOT SEND "ESC" TO CRT ON SZB BINARY WRITE. JMP ON1 LDB TEM11 IS THIS UNIT 3? CPB B3 IF SO SKIP ESC CHECK JMP ON1 CPA ESC IS THIS AN ESCAPE? JMP OUT6B * ON1 CLB,INB SET B REG TO 1 ADB EQT9,I ADD 1 TO EQT9 CPB EQT10,I IS THIS THE LAST WORD? RSS JMP OUT6 NO! CONTINUE LDB TEMP2 IS THIS HONEST? SZB JMP OUT6 THIS IS HONEST,IGNORE UNDERSCORE CPA B137 IS THIS A "_" UNDERSCORE? JMP EOOP8 YES! GO TO END OF OUTPUT PROCESSING JMP OUT6 IFZ TRAN3 LDB FILL IS THIS BINARY? SZB,RSS JMP OUT6 THIS IS BINARY,OUTPUT CHARACTER CPA CR IS IT A ? RSS CPA LF IS IT A LINEFEED? RSS IT IS A CPA RS IS IT A JMP TRAN5 YES,TERMINATE ON OROR XIF * OUT6 JSB OUT1 OUTPUT CHAR. TO CARD.CHAR. OUT6B ISZ EQT9,I INCREMENT CHAR. COUNT LDB EQT9,I GET CURRENT CHAR. ADD.R CPB EQT10,I HAVE WE SENT LAST WORD? JMP TRAN5 THIS IS THE LAST CHARACTER JMP TRAN2 WE HAVE NOT SENT ALL CHAR * TRAN5 LDA EQT29,I GET RETURN ADDRESS JMP A,I RETURN * * *************************************************** * DOES KEYBOARD READ. IF FIRST CHARACTER * * A "DC2" THE DRIVER EXPECTS A BLOCK TRANSFER AND * * WILL SEND A DC1 TO TRIGGER IT. IF THE FIRST * * CHAR. IS NOT A "DC2" THE DRIVER ASSUMES A CHAR. * * TRANSFER. *************************************************** * * LREAD STA ASAVE SAVE A STB BSAVE AND B LDA LRED GET ENTRY ADDRESS STA RTN SAVE FOR RETURN JSB SETIO GO SET UP THE EQ'S LDA ASAVE IS THE THE FRIST CPA B.1 TIME? JMP LWRT1 YES, START TO READ JSB BITCK GO CHECK CONDITION BITS JMP TIMOT TIMOUT BIT 15 ON JMP TIMOT LINE ERROR BIT 14 ON JMP TIMOT DATA ERROR BIT 13 ON NOP BREAK,CAN'T GET ON READ LDA EQT4,I (R03) CRT SUBCHANNEL? AND B3700 (R03) SZA (R03) JMP LRED2 (R03) NO, NO PAUSE ON CTU!!! LDA EQT6,I (R01) DOING READ OR WRITE? SLA (R01) WRITE -> CHECK FOR PAUSE JMP LRED2 (R01) READ, CONTINUE LDA EQT31,I (R01) CHECK LINE DIRECTION SSA (R02) JMP LRED2 (R01) READ, CONTINUE LDA EQT5,I (R01) FLIP PAUSE BIT XOR B2 (R01) STA EQT5,I (R01) RAR,SLA (R01) WAIT NOW? JMP REJ3 (R03) YES, WAIT FOR NEXT INT. LDA BIT12 (R03) NO, OUTPUT NULL TO RESTART WRITE JMP REJ4 (R03) LRED2 LDA EQT11,I NOTHING ELSE, RETURN SZA,RSS ARE WE TRYING TO FINISH? JMP REJ2 YES, IGNORE THIS CHAR. JMP A,I NO * * * I.05R EQU * JSB SPCH1 SET AND SPECIAL CHAR. CLB,INB JSB I05W1 GO SETUP EQT9 AND EQT10 LDA EQT6,I CHECK IF ECHO SET AND B400 ISOLATE BIT 8 (SET ECHO) JSB ECHO SET/CLR = 20/0 ECHO LDA BN9 SET RUBOUT INT. JSB CDSET LDA BN40 SET CONTROL "D" INT. JSB CDSET LDA EQT6,I CHECK FOR USER ENABLED BLOCK READ AND B3000 BITS 9,10 WILL BE SET CPA B3000 JMP C05R3 THIS IS ENABLED BLOCK READ I.05S JSB DC1OT ENABLE TRANSFER * JSB CHRIN GET CHARACTER CPA B22 IS IT A DC2? JMP C05R4 FIRST CHAR. IS A DC2 * * *******THIS IS A CHARACTER TRANSFER********* * * LDA TEMP2 IS THIS HONEST? SZA JSB CLRNT JMP CHPR8 * * CLRNT NOP LDA BN56 CLR. RUBOUT INT. JSB CDSET LDA B412 CLR. CONTROL "D" INT. JSB CDSET JMP CLRNT,I * RS OCT 36 B377 OCT 377 B3700 OCT 3700 (R03) B137 OCT 137 CR OCT 15 BN9 OCT 57712 BN10 OCT 40000 BN11 OCT 43612 BN12 OCT 41512 BN13 OCT 140000 BN40 OCT 40412 B177 OCT 177 B4 OCT 4 B144 OCT 144 B3000 OCT 3000 B1512 OCT 1512 B3612 OCT 3612 BN56 OCT 17712 B412 OCT 412 * * ***********THIS IS A BLOCK TRANSFER********* * * C05R3 LDA EQT27,I THIS IS A BLOCK TRANSFER SSA (R04) RSS YES JMP REJ1 NO ERROR JSB XMIT GO TO TRANSMIT MODE LDA ESC OUTPUT JSB OUT1 LDA B144 OUTPUT SMALL JSB OUT1 C05R4 EQU * LDA EQT27,I GET STATUS AND BN13 SAVE 15-14 CPA BN13 BLOCK AND PAGE? RSS JMP *+4 NO LDA B1512 YES, TAKE CR AS SPECIAL JSB CDSET JMP C05R6 GO READ SSA,RSS IS IT BLOCK? JMP I.05S NO, IGNORE DC2 LDA B3612 REMOVE "RS" INT. ("CR" ONLY FOR LINE) JSB CDSET FOR ASCII CTU, LINE STRAP AND BLOCK * C05R6 JSB CLRNT CLA JSB ECHO TURN OFF ECHO JSB DC1OT TRIGGER TRANSFER C05R7 RSS AND WAIT FOR INTERRUPT * * ********************************************** * PROCESSES DATA ON KEYBOARD AND CTU * * READ REQUESTS. * * BINARY EOR IS DETECTED BY THE CHAR. * * COUNT READ FROM THE TAPE. * ********************************************** * * CHPRC JSB OUT1 EXIT AND AND WAIT FOR CHAR. JSB CHRIN GET CHARACTER CHPR8 LDB FILL SZB,RSS ISv THIS BINARY? JMP CHPR9 YES,THIS IS BINARY * ********THIS IS ASCII******* * * * LDA TEM14 GET DATA WORD SZA,RSS IS IT SPECIAL? JMP CHPR2 NO * IFZ SWH1C NOP SWITCH NOP\RSS =CTU\CRT JMP EOOP5 THIS IS CTU ASCII TRANSFER XIF LDA EQT27,I GET TERMINAL STATUS AND BN13 ISOLATE PAGE(15) AND BLK(14) CPA BN13 ARE THEY BOTH SET? JMP EOOP2 YES,TERMINATE REQUEST LDA TEMP8 GET CHARACTER CPA B177 IS IT A RUBOUT? JMP RUB01 YES! GO PROCESS RUBOUT CPA B4 IS IT A CONTROL "D" (SET EOT) JMP CNTLD YES! GO SET EOT CHP9 JSB XMIT JSB EORP FOR CHAR. OR LINE STRAP BLK REQUES JMP EOOP1 FIRST SEND * * CHPR2 LDA EQT27,I IFZ SWH1D NOP CRT\CTU = RSS\NOP JMP CHPR9 THIS IS A CTU ASCII READ XIF SSA IS IT BLOCK MODE? JMP CHPRA YES! SKIP BELOW CHECKS * LDA TEMP2 IS THIS HONEST MODE? SZA JMP CHPR9 THIS IS HONEST MODE LDA TEMP8 GET CHARACTER JMP LINFD CHAR. TRANSFER AND NOT HONEST ******************************************** * IS CALLED IF RUBOUT CHARACTER IS * * DETECTED. IT DELETES THE CURRENT RECORD * * AND OUTPUTS (/,CR,LF). * ******************************************** * * RUB01 JSB XMIT LDA B134 OUTPUT A SLASH JSB OUT1 JSB EORP GO OUTPUT JMP I.051 RE START INPUT * LINFD CPA LF IS THIS A LINEFEED? JMP CHPRC YES,GO GET NEXT CHARACTER CPA CR IS THIS A CR ? JMP CHP9 YES! IT IS A CR,EXIT CPA B4 IS FIRST CHAR. A CONTROL "D" ? JMP CNTLD YES! * CPA B10 IS THIS A BACKSPACE RSS RSS JMP CHPR9 NO! CONTINUE LDA EQT7,I GET STARTING ADDRESS OF BUFFER RAL MULTIPLY BY 2 > CPA EQT9,I ARE WE AT STARTING ADDRESS? JMP RUB01 YES! PROCESS AS RUBOUT CCB ADB EQT9,I DECREMENT CURRENT ADDRESS STB EQT9,I CLE,ERB DIVIDE BY TWO TO GET TRUE ADDRESS JSB MAPRD (R04) FETCH CHAR AND BN15 MASK HIGH END ADA FILL ADD ASCII FILL CHARACTER JSB MAPWR (R04) RESTORE JMP CHPR6 GO GET NEXT CHARACTER * * B134 OCT 134 BN15 OCT 177400 B40 OCT 40 B60 OCT 60 * CNTLD EQU * SET BIT 5 (EOT) LDA EQT5,I IOR B40 SET BIT 5 STA EQT5,I CLA STA EQT29,I SET AREG. EXIT JMP EOOP4 GO SET B REG. TO 0 AND EXIT * * CHPRA LDA TEMP8 CPA RS REMOVE "RS" JMP CHPR6 CHPR9 EQU * LDB EQT9,I GET CURRENT CHAR. ADD. CPB EQT10,I IS BUFFER FULL? JMP CHPR6 YES BUFFER FULL LDB EQT9,I GET CHARACTER ADDRESS ISZ EQT9,I INCREMENT CLE,ERB CONVERT TO WORD ADDRESS. JSB MAPRD GET CHARACTER STA BSAVE LDA TEMP8 SEZ,RSS IF E=0 THEN EVEN AND ALF,SLA,ALF HENCE SHIFT CHAR. TO UPPER 8.SKIP XOR BSAVE IF ODD ADDRESS XOR WITH CHAR. XOR FILL XOR FILL TO ADD FILL IF EVEN JSB MAPWR REPLACE FULL WORD LDB EQT9,I IS THIS THE LAST WORD? CPB EQT10,I RSS YES IT IS JMP *+5 LDA FILL IF BINARY KEYBOARD REQUEST AND BUFFER ADA TEM10 FULL THEN EXIT CPA B60 JMP EOOP2 YES! EXIT CHPR6 ISZ EQT30,I INCREMENT RECORD LENGTH COUNT.FOR JMP CHPRC IF NOT ZERO GET ANOTHER CHAR. IFZ JMP EOOP5 THIS IS ALL FOR BINARY READ XIF * * READ FROM USER MAP IF EQT1 IS NEG. ADDRESS IN B. * MAPRD NOP LDA EQT1 IS IT NEG.?? SSA JMP *+3 YES, USE USER MP LDA B,I GET CHAR FROM SYSTEM JMP MAPRD,I XLA B,I GET CHAR FROM UeSER MAP JMP MAPRD,I * * WRITE TO USER MAP IF EQT1 IS NEG. ADDRESS IN B. * MAPWR NOP STA BSAVE SAVE TEMP LDA EQT1 ARE MAPS CHANGED? SSA JMP *+4 YES STORE TO USER MAP LDA BSAVE STA B,I NO, PUT IN TO SYSTEM MAP JMP MAPWR,I LDA BSAVE XSA B,I TO USER MAP JMP MAPWR,I IFZ * * * *************************************************** * DOES CTU AND PRINTER REQUEST PROCESSING * *************************************************** * * * I.251 LDA TEMP4 GET REQUEST TYPE(1-3) RAR SSA,SLA JMP I.25C THIS IS CTU OR LP A CONTROL REQUEST SSA JMP I.25R THIS IS CTU A READ REQUEST * *********CTU OR PRINTER WRITE REQUEST********** * CLB,INB JSB I05W1 GO SET EQT9 AND EQT10 LDB FILL SZA IS CHARACTER COUNT ZERO? JMP I25W6 NO! IT IS NOT ZERO SZB,RSS IS IT BINARY JMP REJ1 EXIT WITH A=1 I25W6 SZB IF BINARY MAX LENGTH IS D 256 JMP *+3 FOR ASCII MAX LENTH IS D 254 (NEDED CR,LF) ADA B400 RSS ADA D254 THIS IS ASCII SSA LESS THAN 254 CHARACTERS JMP REJ1 IT IS NOT,THEREFORE EXIT * * JSB CTPRP GO PREP. TERMINAL FOR TRANSFER LDA B144 JSB OUT1 OUTPUT LDA FILL GET FILL CHARACTER SZA IS IT BINARY? JMP I25W2 NO! THIS IS ASCII * ***********CTU BINARY WRITE******** * LDA EQT8,I GET BUFFER LENGTH SSA,RSS IF WORDS MULTIPLY X2 RAL SSA IF CHARACTERS (-) MAKE POS. CMA,INA JSB BINAS GO CONVERT TO ASCII AND SEND * * I25W2 LDA B127 OUTPUT TO INITIALIZE CTU TRANSFER JSB OUT1 * * LDA FILL IS THIS BINARY SZA,RSS JSB ENAK THIS IS BINARY,GO HANDSHAKE LDB EQT8,I GET WORD COUNT SZB IS IT ZERO?(ASCII ONLY,BINARY CHECKED * JSB TRAN1 ALREADY).IT IS NOT ZERO LDA FILL GET FILL CHAR. SZA IS IT BINARY JSB EORP NO! THIS IS ASCII,WRITE A "CR,LF" I25W5 EQU * &&&&FOR INTERRUPT JSB DC1OT GO TRIGGER STATUS REPORT * * JSB CHRIN GET STATUS CHARACTER * JSB OUT1 GET THE @@&&&&*** CR.... LDA EQT33,I CPA B106 FAILURE? JMP I25W7 YES CLA,RSS I25W7 LDA B10 SET BIT 3 IN EQT5 FOR PRINT FAIL LDB TEM10 IS THIS A PRINTER? CPB B64 JMP EOOP6 THIS IS A PRINTER JMP EOOP7 THIS IS A CTU * * D254 DEC 254 B127 OCT 127 B163 OCT 163 B122 OCT 122 B62 OCT 62 * * ***********THIS IS A CTU READ REQUEST******** * I.25R EQU * JSB SPCH1 SET AND AS SPECIAL LDA RDTYP LOOK AT TYPE CPA B37 IS IT? JMP CN6C YES SPECIAL READ LDB TEM10 IF READ FROM PRINTER REJECT CPB B64 JMP REJ1 LDB EQT8,I GET BUFFER LENGTH SZB,RSS IS IT ZERO? JMP CN3C YES --GO SKIP ONE RECORD CLB,INB NO!, IT IS NOT ZERO JSB I05W1 GO SET UP EQT9,EQT10 LDB RDTYP IS THIS A FILE READ? CPB B2 IS THIS IT? RSS YES JMP *+5 NO LDA EQT27,I CHECK FOR BOTH BLOCK AND BN13 AND PAGE STRAP, IF SO CPA BN13 JMP REJ1 REJECT THIS READ JSB CTPRP GO PREP. TERM. FOR CTU TRANSFER LDA B163 JSB OUT1 OUTPUT LDA FILL SZA,RSS IS THIS BINARY? JMP I25R2 YES! THIS IS BINARY LDA B60 OUTPUT A ZERO FOR RECORD LDB RDTYP CPB B2 LDA B64 OR 4 FOR FILE JSB OUT1 LDA B122 OUTPUT JSB OUT1 * * THIS IS ASCII LDA B1512 DISABLE IF FILE READ LDB RDTYP GET TYPE CPB B2 JSB CDSET JMP C05R6 GO TRIGGER TRANSFER FOR ASCII * * ****THIS IS BINARY READ***** * I25R2 LDA B62 OUTPUT <2> JSB OUT1 LDA B122 OUTPUT JSB OUT1 JSB CDINT #### JSB SPCH1 SET FOR INTERRUPT JSB DC1OT TRIGGER BYTE COUNT * LDA B.4 INITIALIZE TO READ 4 BYTES STA EQT30,I CLA I25R5 ALF SHIFT UP STA EQT35,I AND STORE JSB CHRIN GET CHARACTER CPA RS IS IT A" RS"? JMP I25R6 YES,THIS IS ALL AND B17 ISOLATE DATA IOR EQT35,I "OR" WITH LAST BYTE STA EQT35,I SAVE JSB OUT1 GET NEXT LDA EQT35,I GET NUMB AGAIN ISZ EQT30,I IS THIS ALL?? JMP I25R5 NO! GET NEXT BYTE CMA,INA THIS IS ALL,COMPLEMENT STA EQT30,I STORE BINARY RECORD LENGTH. JSB DC1OT TRIGGER TRANSFER JMP C05R7 GO ENABLE TRANSFER I25R6 LDA EQT27,I DO WE NEED TO GET AND BN13 THAT CR? CPA BN13 JMP EOOP5 NO COMPLETE JSB OUT1 YES GET IT JMP EOOP5 * * ***************************************************** * * * * * PRINTER * * 11 SPACE

LINES IF OPTIONAL * * PARAM (+) OR PAGE EJECT IF * * OPTIONAL PARAM (-). * PAGE EJECT 9871 ONLY ***************************************************** * * I.25C LDA RDTYP GET CONTROL WORD STA EQT10,I STORE FOR LATER USE LDB TEM10 GET DEVICE TYPE CPB B64 IS IT A LP? JMP CN28C YES! IT IS A LP CPA B1 IS IT EOF? JMP CN1C YES! CPA B2 IS IT BACKSPACE RECORD? JMP CN50C YES! CPA B3 FORWARD SPACE? JMP CN3C YES! CPA B4 REWIND? JMP CN4C YES! CPA B10 GENERATE LEADER(EOF) JMP CN10C CPA B11 T.O.F TO CTU IS WEOF JMP CN1C WRITE EOF CPA B13 FORWARD SPACE 1 FILE? JMP CN13C YES! CPA B14 BACKSPACE FILE? JMP CN50C YES! CPA B26 WRITE EOV? JMP CN26C YES! CPA B27 LOCATE FILE

OR SPACE

* JSB D$INI * D$INI NOP STA U.PTR PTR TO 1ST USER PARAM ADDR. LDA D$RQB STA P.PTR PTR TO REQUEST BUFFER. * STA TEMP CLEAR REQUEST BUFFER. LDB RQSIZ CLA STA TEMP,I  ISZ TEMP INB,SZB JMP *-3 JMP D$INI,I RETURN. * * STORE A-REG IN REQUEST BUFFER. * D$STW NOP LDB RQSIZ CHECK IF STILL ROOM IN BUFFER. CMB,INB ADB D$RQB CPB P.PTR JMP D$STW,I REQUEST BUFFER OVERFLOW! * STA P.PTR,I STORE WORD. ISZ P.PTR BUMP BUFFER POINTER. LDA BYTCT ADA D2 INCREMENT BYTE COUNTER. STA BYTCT JMP D$STW,I RETURN. (A) = BYTE COUNT. * * STORE N PARAMETERS IN REQUEST BUFFER: (A) = -N. * D$PRM NOP STA TEMP SAVE NEG. # PARAMS. NPM LDA U.PTR,I GET ADDR OF NEXT PARAM. SZA IF NOT SPECIFIED, STORE ZERO. LDA A,I JSB D$STW STORE VALUE IN REQ BUFFER. ISZ U.PTR ISZ TEMP JMP NPM LOOP TILL DONE. JMP D$PRM,I RETURN. (A) = BYTE COUNT. * * STORE N-WORD PARAM IN REQUEST BUFFER: (A) = -N. * D$NWD NOP STA TEMP SAVE NEG. WORD COUNT. LDB U.PTR,I GET ADDR OF PARAM. STB TEMP1 * NWD LDA TEMP1 IF PARAM NOT SPECIFIED, SZA STORE ZERO. LDA TEMP1,I GET NEXT WORD OF PARAM. JSB D$STW STORE IN REQ BUFFER. LDA TEMP1 SZA ISZ TEMP1 ISZ TEMP JMP NWD ISZ U.PTR JMP D$NWD,I RETURN. (A) = BYTE COUNT. * * STORE ASCII STRING IN REQUEST BUFFER. * D$ASC NOP STA ADDR SAVE ADDR OF STRING. STB TEMP SAVE MAX # WORDS (NEG.). SZA,RSS JMP ASC2 QUIT IF NOT SPECIFIED. * CLA CPB N25 SET FLAG IF ONLY DELIMITER CCA IS A PERIOD (FORMMSG). STA DMFLG * ASC1 LDA ADDR,I GET NEXT 2 CHARACTERS. SZA,RSS JMP ASC2 GET OUT IF ZERO WORD. JSB D$STW STORE IN REQUEST BUFFER. LDA ADDR,I ALF,ALF LOOK FOR DELIMITER. AND B377 JSB DELIM JMP ASC2 LEFT BYTE WAS DELIMITER. LDA ADDR,I AND B377  JSB DELIM JMP ASC2 RIGHT BYTE WAS DELIMITER. * ISZ ADDR NO DELIMITER ENCOUNTERED. ISZ TEMP JMP ASC1 LOOP TILL MAXIMUM REACHED. * LDA BLNKS LIMIT REACHED. STORE BLANKS. JSB D$STW JMP D$ASC,I RETURN. (A) = BYTE COUNT. * ASC2 LDA BYTCT JMP D$ASC,I RETURN. (A) = BYTE COUNT. * * DELIM NOP CHECK IF (A) = DELIMITER. STA TEMP1 LDB DMFLG INB,SZB JMP DLM1 CPA PEROD STRING IS FORMS MESSAGE. JMP DELIM,I CHARACTER IS A PERIOD. JMP NODLM LET ANYTHING ELSE THROUGH. * DLM1 CPA SLASH NOT FORMMSG STRING. JMP NODLM LET SLASH THROUGH. CPA PEROD JMP NODLM LET PERIOD THROUGH. * ADA NB60 LET 0-9 THROUGH. SSA JMP DELIM,I ADA NB12 SSA JMP NODLM ADA B72 * ADA NEGA LET A-Z THROUGH. SSA ANYTHING ELSE IS A DELIMITER. JMP DELIM,I ADA NGMAX SSA,RSS JMP DELIM,I * NODLM ISZ DELIM DELIMITER NOT REACHED. JMP DELIM,I * * STORE ZERO IN NEXT N WORDS OF REQUEST BUFFER. * (A) = NEGATIVE # WORDS. * D$ZRO NOP STA TEMP ZRO CLA JSB D$STW ISZ TEMP JMP ZRO JMP D$ZRO,I * * COMPUTE AND STORE REQUEST WORD COUNT IN FIRST BYTE OF REQUEST. * D$WDC NOP LDA RQBUF FIRST WORD OF REQUEST BUFFER. AND B377 CLEAR WORD COUNT BYTE. LDB BYTCT BYTE COUNT FROM REQUEST. INB CLE,ERB MAKE WORD COUNT. ADB D8 ADD FIXED FORMAT LENGTH. BLF,BLF MOVE TO LEFT BYTE. IOR B MERGE WITH MESSAGE CLASS. STA RQBUF STORE FIRST WORD. JMP D$WDC,I RETURN. SKP * * INITIALIZE REPLY VALUE PASSAGE SUBROUTINES. * D$IPM NOP STA U.PTR 1ST RETURN PARAM ADDR IN CALL. STB P.PTR 1ST RETURN VALUE IN REPLY BUFFER. JMP D$IPM,I * * STORE A-REG IN NEXT USER PARAMETER. * D$APM NOP LDB U.PTR,I GET PARAM ADDRESS. SZB SKIP STORE IF PARAM NOT SPECIFIED. STA B,I RETURN THE PARAM VALUE. ISZ U.PTR BUMP TO NEXT PARAM ADDRESS. JMP D$APM,I * * PASS N M-WORD RETURN PARAMS TO CALLER. * (A) = -N, (B) = -M * D$NPM NOP STA TEMP SAVE NEG. # PARAMS. STB TEMP2 SAVE NEG. # WORDS PER PARAM. NPM1 LDB U.PTR,I GET ADDR OF NEXT PARAM. SZB,RSS JMP NPM3 IGNORE OF PARAM NOT SPECIFIED. * LDA TEMP2 STA TEMP1 NPM2 LDA P.PTR,I GET NEXT WORD OF PARAM VALUE. STA B,I PASS TO CALLER. INB BUMP TO NEXT WORD OF PARAMETER. ISZ P.PTR BUMP TO NEXT WORD IN REPLY BUFFER. ISZ TEMP1 BUMP PARAM SIZE COUNTER. JMP NPM2 LOOP FOR M WORDS. * NPM3 ISZ U.PTR BUMP TO NEXT PARAM ADDRESS. ISZ TEMP BUMP # PARAMS COUNTER. JMP NPM1 LOOP FOR N PARAMS. JMP D$NPM,I * * PASS SINGLE N-WORD PARAM TO USER. * D$SPM NOP STA B B = NEG WORD COUNT. CCA A = ONE PARAM. JSB D$NPM PASS THE N-WORD PARAM. JMP D$SPM,I SKP * * CONSTANTS AND WORKING STORAGE. * B20 OCT 20 B21 OCT 21 B22 EQU D18 B25 OCT 25 B72 OCT 72 B77 OCT 77 B377 OCT 377 HB377 BYT 377,0 D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D7 DEC 7 D8 DEC 8 D13 DEC 13 N1 DEC -1 N3 DEC -3 N4 DEC -4 NB12 OCT -12 N25 DEC -25 N40 DEC -40 NB60 OCT -60 N80 DEC -80 SD1 DEF 1,I SD2 DEF 2,I SD3 DEF 3,I RCODE NOP D$SMP OCT 0 SESSION MAIN PROCESS NUMBER. D$LOG OCT 1 LU OF LOG DEVICE. D$INP OCT 401 LU OF INPUT DEVICE. CCE OCT 1000 D$ERR BSS 2 BLNKS ASC 1, PEROD OCT 56 SLASH OCT 57 NEGA OCT -101 NGMAX OCT -33 XEQT EQU 1717B MSGAD DEF MSGBF MSGBF ASC 2,DS00 ERROR MESSAGE :xvrBUFFER. "00" ASC 1,00 "01" ASC 1,01 "05" ASC 1,05 "06" ASC 1,06 "07" ASC 1,07 "DS" ASC 1,DS * INBUF NOP APEND NOP U.PTR NOP P.PTR NOP TEMP NOP TEMP1 NOP TEMP2 NOP ADDR NOP BRFLG NOP BREAK FLAG DMFLG NOP OEFLG NOP OUTPUT ERROR FLAG BIT13 OCT 20000 BIT14 OCT 40000 BIT15 OCT 100000 CLASN NOP BUFL NOP ICCC NOP LCGW OCT 40006 GLOBAL RN LOCK/CLEAR/WAIT/NO-ABORT. LGW OCT 40002 GLOBAL RN LOCK/WAIT/NO ABORT. CLS20 DEF 20,I CLASS READ-WRITE (NO ABORT). CLS19 DEF 19,I CLASS CONTROL - NO ABORT. CLS21 DEF 21,I CLASS GET - NO ABORT. * PRFLG NOP PROMPT FLAG. OLDLN NOP LENGTH OF LAST WRITE. ORCRD BSS 40 LAST WRITTEN BUFFER. @ORCD DEF ORCRD * SEQ# NOP SEQ # STORAGE FOR REPLY VALIDATION. * D$RQB DEF RQBUF RQSIZ ABS -L SIZE OF REQ BUFFER (NEG WORDS). RQBUF BSS L REQUEST BUFFER. BYTCT EQU RQBUF+7 BYTE COUNT WORD (N). * BSS 0 ****** SIZE OF D3KMS ****** * END x Wp 91741-18020 1913 S C0122 DS/1000 MODULE: D65MS              H0101 JSASMB,R,L NAM D65MS,7 91741-16020 REV 1913 790102 SPC 2 ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ******************************************************************* SPC 2 ENT D65MS * * D65MS * SOURCE: 91741-18020 * BINARY: 91741-16020 * EXT D$ABT * * DUMMY D65MS FOR SYSTEMS WITH 1000-3000 LINKS ONLY. * D65MS NOP CCA CALCULATE ADA D65MS CALLING ADDRESS. LDB DS06 LOAD ERROR CODE. JMP D$ABT PRINT MESSAGE AND TERMINATE. * DS06 DEF *+1 ASC 2,DS06 END f X^ 91750-18001 2013 S C0122 &#CLON +              H0101 uhASMB,R,Q,C HED #CLON 91750-1X001 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #CLON,7 91750-1X001 REV.2013 800821 RTE-IVB W/S.M. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #CLON * EXT IDGET,IDDUP,IDRPL,IDRPD,OPEN,CLOSE EXT $CVT1,.MVW,.LBT,.SBT,READF SUP * * NAME: #CLON * SOURCE: 91750-18001 * RELOC: PART OF 91750-12014 * PGMR: JIM HARTSELL * * * >>>>>>> SUBROUTINE TO CLONE A COPY OF A PROGRAM <<<<<<< * CALLED AS A RESULT OF * EXECW & PTOPM CALLS TO #SCSM * * * >>>>>>> RETURNS WITH ADDRESS OF CLONED PROGRAM NAME <<<<<<< * * * >>>>>>> DOES NOT SCHEDULE THE CLONED PROGRAM <<<<<<< * * * * CALLING SEQUENCES: * * CLONE A PROGRAM: * * (A) = LU (DESTINATION SESSION ID). * (B) = ADDRESS OF ORIGINAL PROGRAM NAME-ARRAY. * JSB #CLON * P+1 ERROR RETURN. COULD NOT "RP" TO CLONED ID SEGMENT. * P+2 PROGRAM KNOWN TO SYSTEM BUT CANNOT BE CLONED. * P+3 NORMAL RETURN. (B) = ADDR OF CLONED PROGRAM NAME. * * * RELEASE CLONED ID SEGMENT: * * (A) = 0 * (B) = ADDRESS OF CLONED PROGRAM NAME-ARRAY. * JSB #CLON * SKP B EQU 1 * * CHECK WHICH TYPE OF ENTRY. * #CLON NOP ENTRY. STA CLU SAVE DEST. SESSION ID. STB NAMAD SAVE ADDRESS OF PROGRAM NAME. SZA,RSS CHECK TYPE OF ENTRY. JMP UNCLO GO HANDLE TERMINATION. * * CHECK IF PROGRAM IS KNOWN TO THE SYSTEM. IF IT IS, ATTEMPT TO USE * IDDUnP TO CREATE ANOTHER COPY. IF IT CAN'T BE DUP'D, USE ORIGINAL. * JSB IDGET GET ID SEG ADDR OF PROGRAM. DEF *+2 NAMAD NOP * SZA,RSS JMP UNKNO NOT FOUND. * JSB CLONE GENERATE A NEW NAME INTO "XNAME". JMP EXIT2 COULD NOT CLONE NAME. USE ORIGINAL. * JSB IDDUP DUPLICATE AN ID SEGMENT THAT DEF *+3 IS ALREADY IN THE RTE SYSTEM, DEF NAMAD,I AND GIVE IT THE NEW NAME. DXNAM DEF XNAME * SZA WAS IT DUPLICATED? JMP EXIT2 NO. USE ORIGINAL NAME. JMP EXIT3 YES. USE CLONED NAME. * * PROGRAM NAME NOT KNOWN TO SYSTEM. * LOOK FOR ORIGINAL PROGRAM FILE (TO "RP" AS A CLONE). * UNKNO JSB OPEN TRY TO OPEN THE FILE. DEF *+5 DEF FDCB DEF IERR DEF NAMAD,I DEF B5 FORCE TO TYPE 1. * SSA,RSS ERROR? JMP CLONP NO. GO CHECK "DON'T COPY" FLAG. * LDB NAMAD YES. BLANK 6TH CHAR AND TRY AGAIN. ADB B2 LDA B,I AND B1774 IOR BLANK STA B,I * JSB OPEN DEF *+5 DEF FDCB DEF IERR DEF NAMAD,I DEF B5 FORCE TO TYPE 1. * SSA ERROR? JMP EXIT1 YES. PROGRAM NOT FOUND. * * FOUND. CLONE THE PROGRAM NAME AND "RP" THE PROGRAM FILE. * CLONP JSB READF READ IN THE ID SEGMENT (1ST RECORD). DEF *+5 DEF FDCB DEF IERR DEF IBUF DEF D33 * SSA,RSS JMP CKBIT NO ERROR. * EXITC JSB CLOSE HAD AN ERROR. DEF *+3 DEF FDCB DEF IERR * JMP EXIT1 * CKBIT LDA IBUF+31 CHECK "DON'T CLONE" BIT (BIT 10). ALF,RAL SSA JMP .RP. DON'T CLONE THIS PROGRAM. * JSB CLONE OK TO CLONE. GENERATE A NEW NAME. JMP EXITC COULD NOT CLONE THE NAME. * .RP. JSB IDRPL "RP" THE PROGRAM FILE. DEF *+4 DEF FDCB DEF IERR DEF XNAME  * SZA WAS IT DONE? JMP EXITC NO. FMP ERROR. * JSB CLOSE YES. CLOSE THE FILE. DEF *+3 DEF FDCB DEF IERR * EXIT3 LDB DXNAM RETURN WITH (B) = ADDR OF NEW NAME. ISZ #CLON EXIT2 ISZ #CLON EXIT1 JMP #CLON,I SPC 5 * * ENTRY WITH (A)-REGISTER = 0. RELEASE CLONED ID SEGMENT. * THE RELEASE WILL NOT TAKE PLACE IF THE PROGRAM IS NOT DORMANT... * IN THIS CASE THE ID SEGMENT WILL BE RELEASED BY THE SESSION MONITOR * WHEN THE SESSION IS LOGGED OFF. * UNCLO JSB IDRPD DEF *+3 DEF NAMAD,I DEF IERR * JMP #CLON,I RETURN. SKP * * SUBROUTINE TO FORM THE CLONE OF A PROGRAM NAME INTO ARRAY "XNAME". * IF INTEGER LU (DEST SESSION ID) TO BE ATTACHED IS .GT. 99, OR IF * CLONE WITH LU ALREADY EXISTS IN THE SYSTEM, THE ROUTINE WILL TRY * ".A", ".B", ".C", ... UNTIL ONE IS FOUND THAT CAN BE USED. * RETURNS TO P+1 IF IT CANNOT CLONE, ELSE RETURNS TO P+2. * CLONE NOP * LDA NAMAD MOVE NAME TO NEW NAME AREA. LDB DXNAM JSB .MVW DEF B3 NOP * CLA FIND FIRST ZERO OR BLANK CHARACTER STA TEMP IN NAME, IF ANY. LDA N3 STA CNTR LIMIT COUNT = 1ST 3 CHAR OF NAME. LDB DXNAM RBL BYTE ADDRESS OF 1ST CHARACTER. * LOOP JSB .LBT NEXT CHAR ZERO OR BLANK? SZA CPA B40 JMP SDONE YES. GO SEE WHAT WE GOT. * ISZ TEMP NO. COUNT THE VALID NAME-CHARACTER. ISZ CNTR JMP LOOP GO CHECK NEXT CHARACTER. * SDONE LDA ".@" INITIALIZE FOR ".A", ".B", ".C",... STA NEXT LDA DXNAM INITIALIZE BYTE POINTER TO RAL "LU SUFFIX" ADDRESS OF NAME. ADA TEMP STA PTR * LDA CLU IF LU (SESSION ID) .GT. 99, CMA,INA GO DIRECTLY TO ".A". ADA D99 SSA JMP NXT.X * LDA CLU CONVERT TO ASCII LU (SESSION ID). CCE  JSB $CVT1 CLB SPLIT DIGITS INTO SEPARATE WORDS. RRR 8 STA LUH BLF,BLF STB LUL * LDB B60 IF LUH = BLANK (LU .LE. 9), CPA BLANK STB LUH STORE ASCII ZERO. * NWNAM LDB PTR BUILD CLONED NAME FROM LUH, LUL. LDA LUH JSB .SBT LDA LUL JSB .SBT * JSB IDGET PROGRAM NAME ALREADY IN SYSTEM? DEF *+2 DEF XNAME * SZA,RSS JMP CLNEX NO. TAKE NORMAL RETURN. * NXT.X ISZ NEXT YES. TRY NEXT ".X". CLB SPLIT INTO LUH, LUL. LDA NEXT RRR 8 STA LUH BLF,BLF STB LUL * CMB,INB CHECK IF WE'VE GONE PAST ".Z". ADB B132 SSB,RSS JMP NWNAM NO. KEEP TRYING. RSS YES. ERROR EXIT - CAN'T CLONE. * CLNEX ISZ CLONE BUMP FOR NORMAL EXIT. JMP CLONE,I SKP * * CONSTANTS AND STORAGE. * B2 OCT 2 B3 OCT 3 B5 OCT 5 B40 OCT 40 B60 OCT 60 B132 OCT 132 B1774 OCT 177400 N3 DEC -3 D33 DEC 33 D99 DEC 99 ".@" ASC 1,.@ BLANK OCT 40 TEMP NOP PTR NOP CNTR NOP NEXT NOP LUH NOP LUL NOP CLU NOP XNAME BSS 3 FDCB BSS 144 IERR NOP IBUF BSS 33 * BSS 0 SIZE OF #CLON. * END  Yb 91750-18003 2013 S C0122 &#CVBF              H0101 j_ASMB,R,L,C HED #CVBF 91750-1X003 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #CVBF,7 91750-1X003 REV 2013 791129 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT #CVBF * * NAME: #CVBF * SOURCE: 91750-18003 * RELOC: PART OF 91750-12002 * PGMR: JIM HARTSELL * * EXTERNAL DATA BUFFER FOR INCNV (INCOMING-MESSAGE CONVERTER), AND * OTCNV (OUTGOING-MESSAGE CONVERTER). * SIZE EQU 1024 SIZE OF DATA BUFFER. * #CVBF ABS SIZE DEFINE SIZE OF BUFFER, + WORDS. * BSS SIZE DEFINE BUFFER. * BSS 0 SIZE OF MODULE. * END E{ Z` 91750-18005 2013 S C0122 &#DOWN +              H0101 kASMB,R,Q,C HED <#DOWN> REROUTING ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #DOWN,7 91750-1X005 REV 2013 800318 ALL W/ RR SPC 1 ENT #DOWN SPC 1 EXT #NCNT,#LCNT,#NRV,#CM,#QCLM,#MDCT EXT #LVSC,#FDMN,#NRVS,#CMCT EXT $OPSY,$LIBR,$LIBX,$TIME EXT XLUEX,EXEC,.MVW,.LDX * * NAME: #DOWN * SOURCE: 91750-18005 * RELOC: 91750-1X005 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #DOWN CALLING SEQUENCE: * * < A REG. = LU THAT IS DOWNED > * < B REG. = NODE # > * JSB #DOWN * * * * SKP #DOWN NOP STA LU SAVE DOWN LU STB NODE NOP JSB CONFG LDA #LCNT RR ENABLE? SZA,RSS JMP #DOWN,I .NO LDA LU JSB #LVSC FIND INDEX & SAM ADDR OF DOWN LU JMP #DOWN,I NOT FOUND, NOT RR LINK STA LIX SAVE INDEX AS LIX STB @LV SAVE LV ADDRESS * * CHECK IF LINK IS REALLY DOWN * LDA LU IOR =B100000 STA CONWD LDA =B3600 STA CONWD+1 JSB XLUEX LINK STATUS CALL DEF *+3 DEF NA3 DEF CONWD JSB ERROR LDB 0 ALF,ALF AND =B77 CPA =B65 OLD DRIVER? JMP CKDWN .YES, SKIP CHECK RBR SLB,RSS ANY ERROR? JMP RETRN .NO, TRY THIS LINK AGAIN * * CHECK IF LINK HAS ALREADY BEEN DECLARED DOWN * CKDWN EQU * LDB @LV JSB LDWD --> SAM BUFFER FROM #LVSC SSA LINK!u DOWN ALREADY? JMP RR .NO, TRY REROUTE JSB #NRVS .YES, FIND CURRENT LINK DEF *+2 DEF NODE JSB ERROR CPA LU = TO DOWNED LINK? JMP #DOWN,I .YES, NO RR JMP RETRN .NO, TRY NEW LINK RR EQU * XOR =B100000 .NO, SET LINK TO BE DOWN JSB STWD STORE IT BACK * * WRITE DOWN LINK MESSAGE TO USER * LDA #QCLM SZA,RSS JMP SETUP DLD $TIME DST TOD JSB EXEC SEND MESSAGE TO #QCLM DEF *+8 DEF NA20 DEF K0 DEF MSGBF DEF MSGLN DEF K7 MESSAGE TYPE = 7 DEF K0 DEF #QCLM NOP IGNORE ERROR RETURN * * SET UP INITIAL VALUES FOR THE MAIN LOOP * SETUP EQU * CLA,INA SET UP STA I LOOP INDEX * LDA LIX SET UP STARTING ADA =D-1 ADDRESS OF CM ALS MULTIPLY BY 2 (SIZE OF CM ENTRIES) ADA #CM STA @CM * LDA #NRV SET UP STARTING ADA N.LU ADDRESS OF NRV.LU STA @NRV * * LOOP TO NOTE DOWN LINK FOR ALL NODES * LOOP EQU * LDB @CM --> CM ENTRY JSB LDWD LOAD COST VALUE SZA,RSS ZERO COST? JMP CKEND .YES, NO UPDATE LDA =D2 STA SSLEN 2 WORD STORE LDA @MAX --> VALUE TO BE STORED JSB STWS STORE MAX VALUE IN CM * LDB @NRV --> NRV.LU ENTRY JSB LDWD WILL RETURN NRV.LU WORD AND =B377 MASK OFF ALL EXECPT LU CPA LU EQUAL TO DOWN LU? RSS .YES, SKIP TO FIND NEW MIN JMP CKEND .NO, CHECK END LOOP * LDA I CLB JSB #FDMN FIND NEW MIN LINK JSB ERROR ERROR RETURN * CKEND EQU * LDA MAXH LOOP COUNT EQUAL CPA I TO MAX HOP COUNT? JMP SEND .YES, EXIT LOOP ISZ I UP LOOP COUNT LDA @CM  UP ADA CMIX CM STA @CM ADDRESS LDA @NRV UP ADA NRVSZ NRV STA @NRV ADDRESS JMP LOOP * SEND EQU * CLA,INA SET SEND FLAG STA #CMCT JSB EXEC SCHEDULE SEND PROCESS W/O WAIT DEF *+4 DEF NA10 DEF #SEND DEF K1 DOWN MSG STARTS WITH SEQ# = 2 JSB ERROR * * UP/DOWN COUNTER PROCESSING * LDA =D3 GET SAVED TIME & COUNTER STA LSLEN 3 WORD MOVE LDA @LV GET LV ADDRESS ADA =D2 ADD OFFSET STA @LV LDB @LBUF LOCAL ADDRESS JSB LDWS GET 3 WORDS FROM SAM * JSB EXEC GET CURRENT TIME DEF *+3 DEF NA11 DEF TBUF JSB ERROR * LDA T.DAY MPY =D24 CONVERT CURRENT DAY TO HRS ADA T.HR ADA L.HR - SAVED HOUR SSA CURRENT HR SHOULD BE = OR > ADA =D8760 IF NOT, ADD 1 YEAR (365X24 HRS) SZA,RSS CURRENT HR = SAVED HR? JMP CPSEC .YES, COMPARE SEC ADA =D-1 SZA OVER 1 HOUR? JMP RESET .YES, RESET COUNTER & TIME LDA =D60 CARRY OVER 1 HR CPSEC EQU * ADA T.MIN ADD CURRENT MIN MPY =D60 CONVERT TO SEC ADA T.SEC ADA L.SEC - SAVED SEC ADA =D-300 OVER 5 MIN? SSA,RSS JMP RESET .YES, RESET COUNTER & TIME ISZ L.CNT .NO, UP COUNTER JMP STLV IF DONOT ROLL OVER, STORE LV * LDA LU IF ROLL OVER, DISABLE LINK IOR =B100000 STA CONWD LDA =B3100 STA CONWD+1 JSB XLUEX DISABLE CALL DEF *+3 DEF NA3 DEF CONWD JSB ERROR CLA CLEAR SAVED VALUE STA L.HR STA L.SEC STA L.CNT * LDA #QCLM SZA,RSS JMP STLV DLD $TIME DST TOD JSB EXEC DEF *+8 DEF NA20 D}EF K0 DEF MSGBF DEF MSGLN DEF K5 DEF K0 DEF #QCLM NOP JMP STLV RESET EQU * LDA T.DAY MPY =D24 ADA T.HR CMA,INA STA L.HR RESET HR LDA T.MIN MPY =D60 ADA T.SEC CMA,INA STA L.SEC RESET SEC LDA #MDCT STA L.CNT RESET COUNTER STLV EQU * STORE LV BACK TO SAM LDA =D3 STA SSLEN LDA @LBUF LDB @LV JSB STWS RETRN EQU * ISZ #DOWN JMP #DOWN,I SKP * * ERROR HANDLING * ERROR NOP DST AREG CLA STA #LCNT DISABLE RR LDA #QCLM SZA,RSS JMP #DOWN,I LDA @#DWN CMA,INA ADA ERROR ADA =D-1 STA PREG LDA PNAME STA PGM DLD PNAME+1 DST PGM+1 DLD $TIME DST TOD JSB EXEC DEF *+8 DEF NA20 DEF K0 DEF MSGBF DEF MSGLN DEF K8 DEF K0 NOP JMP #DOWN,I * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP CLEAR CALL TO THIS ROUTINE LDA $OPSY GET O/S TYPE RAR SLA,RSS DMS? JMP INIT .NO, JUST INIT CONSTANT STB LDMOD .YES, MODIFED INSTRUCTIONS STB SDMOD STB LSMOD STB SSMOD * INIT EQU * LDA =B77777 STA MAXC SET UP MAX COST LDA #NCNT CMA,INA STA MAXH SET UP MAX HOP COUNT LDA #LCNT ALS MULTIPLY BY TWO STA CMIX SET UP INCREMENTAL IX FOR CM JMP CONFG,I *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** *** * * STWD STORES ONE WORD FROM LOCAL TO SAM * * CALLING SEQUENCE: * * = WORD TO BE STORED * ==> SAM WORD * STWD NOP JSB $LIBR NOP SDMOD JMP SDSTA XSA 1,I JMP SDJSB SDSTA STA 1,I SDJSB JSB $LIBX DEF STWD * *** *** * * LDWS MOVES WORDS FROM SAM TO LOCAL * * CALLING SEQUENCE: * * ==> SAM WORDS * ==> LOCAL BUFFER * LDWS NOP LSMOD JMP LSMVW JSB .LDX DEF LSLEN MWF JMP LDWS,I LSMVW JSB .MVW DEF LSLEN NOP JMP LDWS,I LSLEN DEC 2 TWO WORD MOVE * *** *** * * STWS MOVES WORDS FROM LOCAL BUFFER TO SAM BUFFER * * CALLING SEQUENCE: * * ==> LOCAL BUFFER * ==> SAM BUFFER * STWS NOP JSB $LIBR NOP SSMOD JMP SSMVW JSB .LDX DEF SSLEN MWI JMP SSJSB SSMVW JSB .MVW DEF SSLEN NOP SSJSB JSB $LIBX DEF STWS * SSLEN DEC 2 2 WORD MOVE * *** SKP * * DATA AREA * K0 DEC 0 K1 DEC 1 K5 DEC 5 K7 DEC 7 K8 DEC 8 NA3 OCT 100003 NA10 OCT 100012 NA11 OCT 100013 NA20 OCT 100024 CONWD BSS 2 LIX NOP DOWN LINK INDEX I NOP LOOP INDEX NODE NOP @#DWN DEF #DOWN PNAME ASC 3,#DOWN #SEND ASC 3,#SEND * MAX BSS 2 MAXC EQU MAX MAX COST MAXH EQU MAX+1 MAX HOP COUNT @MAX DEF MAX ADDRESS OF MAX * @CM NOP POINTER TO CM IN SAM CMIX NOP INCREMENTAL INDEX FOR CM * @NRV NOP POINTER TO NRV IN SAM NRVSZ DEC 3 LENGTH OF NRV ENTRIES N.LU DEC 2 * MSGBF BSS 12 LU EQU MSGBF DOWN LU PREG EQU MSGBF+4 AREG EQU MSGBF+5 TOD EQU MSGBF+7 PGM EQU MSGBF+9 MSGLN ABS *-MSGBF * TBUF BSS 5 T.SEC EQU TBUF+1 T.MIN EQU TBUF+2 T.HR EQU TBUF+3 T.DAY EQU TBUF+4 * @LV NOP LBUF BSS 3 L.HR EQU LBUF L.SEC EQU LBUF+1 L.CNT EQU LBUF+2 @LBUF DEF LBUF END )I$"$ [ f 91750-18006 2013 S C0122 &#DSSM +              H0101 nASMB,R,Q,C,Z IFZ HED #DSSM 91750-1X006 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #DSSM,7 91750-1X006 REV.2013 800519 RTE-IVB W/S.M. XIF IFN HED #DSSM 91750-1X007 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #DSSM,7 91750-1X007 REV.2013 800519 ALL, W/O S.M. XIF * * "Z" OPTION FOR SESSION MONITOR NODE, "N" OPTION FOR NON-SESSION NODE. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #DSSM * EXT PRNT#,$DSCS IFZ EXT READ#,INBF#,PRNL#,EXFR#,ABRT# EXT .UACT,.DRCT,#DFUN,#PASS EXT .MVW,.LBT,.CBT,.MBT,.SBT XIF * * NAME: #DSSM * SOURCE: 91750-18006 * RELOC: PART OF 91750-12014 ("Z"), -12015 ("N") * PGMR: JIM HARTSELL * * SUBROUTINES TO PERFORM OPTIONAL REMOTE SESSION MODIFICATIONS FOR * THE DS/1000 DSMOD PROGRAM. * * CALLING SEQUENCES: * * * PROCESSOR FOR "/U" COMMAND. * * CLA * JSB #DSSM * * * PROCESSOR FOR "/P" COMMAND. * * CLA,INA * JSB #DSSM SKP SUP PRINT EQU PRNT# IFZ READ EQU READ# INBUF EQU INBF# PRNTL EQU PRNL# ERXFR EQU EXFR# ABORT EQU ABRT# XIF A EQU 0 B EQU 1 * * CHECK WHETHER THIS IS A SESSION MONITOR NODE. * #DSSM NOP ENTRY. STA FCODE SAVE FUNCTION CODE. * LDA $DSCS IF NO SESSION MONITOR SSA AT THIS NODE, JMP #DSSM,I RETURN TO CALLER. * IFN JSB PRINT ISSUE "NOT AVAILABLE" MSG IF DEF WARN NON-SESSION MODULE WAS LOADED, JMP #DSSM,I AND IGNORE REQUEST.  XIF * IFZ JSB .DRCT GET DIRECT EXTERNAL ADDRESSES. DEF INBUF STA DINBF JSB .DRCT DEF #DFUN STA DFUN JSB .DRCT DEF #PASS STA PASS * * CHECK #DSSM FUNCTION REQUESTED. * LDA FCODE SZA,RSS JMP PR/U CPA B1 JMP PR/P JMP #DSSM,I * * PROCESS "/U" COMMAND - CHANGE DEFAULT SESSION USER NAME. * PR/U LDA DFUN MOVE CURRENT NAME LDB SMSG0 TO DISPLAY BUFFER. ADB D9 JSB .MVW DEF D11 NOP * JSB PRINT DISPLAY CURRENT NAME. DEF SMSG0 * RDNAM JSB READ ASK THE USER TO "ENTER NEW DEF SMSG1 DEFAULT SESSION USER-NAME". CPA B2 IS THE RESPONSE ASCII? JMP GTLEN YES. ERNAM JSB ERXFR NO. INFORM USER OF ERROR DEF IVRES AND TRY AGAIN. JMP RDNAM * GTLEN CPB /E GET OUT JMP #DSSM,I IF REQUESTED. * LDA PRNTL GET # CHARS INPUT. INA COMPUTE # WORDS. ARS STA TEMP SAVE FOR MOVE. ADA N12 IF GREATER THAN 11, SSA,RSS OUTPUT ERROR MSG JMP ERNAM AND TRY AGAIN. * LDA PRNTL VERIFY WHETHER VALID NAME. CMA,INA LDB DINBF * JSB .UACT DEF BUFR * SSA JMP ERNAM INVALID USER NAME. * LDB BLNKS BLANK OUT CURRENT NAME. LDA DFUN STB A,I LDB A INB JSB .MVW DEF D10 NOP * LDA DINBF MOVE NEW NAME TO #DFUN (IN RES). LDB DFUN JSB .MVW DEF TEMP NOP * JMP #DSSM,I RETURN TO DSMOD. SKP * * PROCESS "/P" COMMAND - CHANGE PASSWORD FOR NON-SESSION ACCESS. * PR/P LDA N10 FIND # CHAR IN CURRENT PASSWORD. STA TEMP CLA STA CNTR INIT CHARACTER COUNTER. LDB PASS RBL BYTE ADDR OF #PASS (IN RES). COUNT JSB .LBT GET NEXT BYT%E IN #PASS. CPA BLANK BLANK? JMP ASKCR YES. ISZ CNTR NO. COUNT # CHAR IN #PASS, ISZ TEMP CHECK IF LIMIT REACHED, JMP COUNT AND GO TRY NEXT CHARACTER. * ASKCR LDA CNTR IF ODD NUMBER OF CHARACTERS, SLA MAKE COUNT EVEN TO ACCOUNT ISZ CNTR FOR TRAILING BLANK ON INPUT. SZA,RSS IF NO CURRENT PASSWORD, JMP ASKNW DON'T ASK USER FOR IT. * JSB READ ASK THE USER TO "ENTER CURRENT DEF SMSG2 PASSWORD FOR NON-SESSION ACCESS". CPA B2 IS THE RESPONSE ASCII? JMP CMPAR YES. ERCUR JSB PRINT NO. INFORM USER DEF IVRES AND JMP ABORT ** ABORT DSMOD ** * CMPAR LDA PRNTL CHECK # CHAR INPUT AGAINST CPA CNTR CURRENT PASSWORD LENGTH. RSS JMP ERCUR NO MATCH. ERROR. LDA DINBF OK. COMPARE PASSWORD. RAL LDB PASS RBL JSB .CBT DEF CNTR NOP JMP ASKNW INPUT MATCHES CURRENT PASSWORD. JMP ERCUR MISMATCH. JMP ERCUR MISMATCH. * ASKNW JSB READ ASK THE USER TO "ENTER NEW DEF SMSG3 PASSWORD FOR NON-SESSION ACCESS". CPA B2 IS THE RESPONSE ASCII? JMP CKLEN YES--GO PROCESS. ERNEW JSB ERXFR NO. INFORM USER DEF IVRES AND JMP ASKNW TRY AGAIN. * CKLEN CLA CPB /D IF USER WANTS "NO PASSWORD", STA PRNTL SET INPUT LENGTH = ZERO. * LDA PRNTL GET # BYTES INPUT. ADA N11 IF GREATER THAN 10, SSA,RSS INFORM USER JMP ERNEW AND TRY AGAIN. * LDA DINBF MOVE NEW PASSWORD TO #PASS. RAL LDB PASS RBL JSB .MBT DEF PRNTL NOP (B) = ADDR OF NEXT BYTE IN #PASS. * LDA PRNTL NEED TO PAD OUT WITH BLANKS? CMA,INA ADA D10 # BYTES TO PAD. SSA,RSS SZA,RSS JMP #DSSM,I NO PADDING NEEDED. RETURN. ADA N1 (A) = + #BYTES -1 REMAINING STA TEMP IN #PASS. SZA,RSS JMP #DSSM,I LDA BLANK JSB .SBT LDA B (B) = ADDR OF NEXT BYTE IN #PASS. ADA N1 JSB .MBT PAD IT OUT. DEF TEMP NOP * JMP #DSSM,I RETURN TO DSMOD. SKP * * CONSTANTS AND STORAGE. * B1 OCT 1 B2 OCT 2 D9 DEC 9 D10 DEC 10 D11 DEC 11 N1 DEC -1 N10 DEC -10 N11 DEC -11 N12 DEC -12 BLANK OCT 40 BLNKS ASC 1, /D ASC 1,/D /E ASC 1,/E BUFR BSS 128 TEMP NOP CNTR NOP DINBF NOP RESOLVED "DEF INBUF". DFUN NOP RESOLVED "DEF #DFUN". PASS NOP RESOLVED "DEF #PASS". * IVRES DEF *+2 DEF D9 ASC 9, INVALID RESPONSE! * SMSG0 DEF *+2 DEF D20 ASC 20, CURRENT NAME = UUUUUUUUUU.GGGGGGGGGG * SMSG1 DEF *+2 DEF D20 ASC 20, ENTER NEW DEFAULT SESSION USER-NAME: _ * * SMSG2 DEF *+2 DEF D20 ASC 20, CURRENT PASSWORD FOR NON-SESSION? _ * * SMSG3 DEF *+2 DEF D20 ASC 20, ENTER NEW PASSWORD FOR NON-SESSION _ * XIF * D20 DEC 20 FCODE NOP * IFN WARN DEF *+2 DEF D20 ASC 20, NOT AVAILABLE IN NON-SESSION VERSION! XIF * BSS 0 SIZE OF #DSSM. * END  \e 91750-18008 2013 S C0122 &#FDMN +              H0101 }`ASMB,R,Q,C HED <#FDMN> REROUTING ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #FDMN,7 91750-1X008 REV 2013 791214 ALL W/ RR SPC 1 ENT #FDMN SPC 1 EXT #NRV,#NODE EXT #LCNT,#LV,#CM EXT $OPSY,$LIBR,$LIBX EXT .ENTR,.LDX,.MVW * * NAME: #FDMN * SOURCE: 91750-18008 * RELOC: 91750-1X008 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #FDMN CALLING SEQUENCE: * * < A REG. = NODE INDEX > * < B REG. = CURRENT MIN COST > * JSB #FDMN * * * * SKP * ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS eOF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * SKP #FDMN NOP DST NIX SAVE NODE IX AND MIN COST NOP JSB CONFG CLA,INA STA MNLIX SET UP MIN INDEX CPA #LCNT ONE LINK ONLY? JMP GETCT .YES STA J SET UP LOOP INDEX * * LOOP TO FIND MIN COST OVER ALL LINKS * LOOP ISZ J UP LOOP INDEX JSB LDCM DEF *+4 DEF NIX DEF J DEF CM1 JMP #FDMN,I ERROR RETURN JSB LDCM DEF *+4 DEF NIX DEF MNLIX DEF CM2 JMP #FDMN,I LDB J LOAD LOOP INDEX LDA CM1 CMA,INA ADA CM2 SSA,RSS CM2 > CM1? STB MNLIX .YES, MNLIX = J CPB #LCNT END LOOP? RSS .YES, EXIT FROM LOOP JMP LOOP .NO, GO BACK TO LOOP * GETCT EQU * JSB LDCM GET MIN COST DEF *+4 DEF NIX DEF MNLIX DEF CM1 JMP #FDMN,I LDA MNLIX COMPUTE ADA =D-1 ADDRESS MPY LVSZ OF ADA #LV LV[MNLIX].LU LDB 0 ==> LV[MNLIX].LU JSB LDWD WILL RETURN LU WORD AND =B377 MASK OFF FLAGS STA LU SAVE IT TEMPORARY CLB LDA CM1 CPA =B77777 IF MAX COST, STB LU LU = 0 * LDA NIX COMPUTE ADA =D-1 ADDRESS MPY NRVSZ OF ADA #NRV NRV[NIX] STA @NRV SAVE IT * * CHECK IF MIN HAS CHANGED * LDA MINC GET PASSED MIN COST CPA CM1 = TO NEW MIN? JMP SETLU .YES, NO CHANGE LDA LU IOR =B100000 SET CHANGE BIT STA LU * SETLU EQU * LDB @NRV ADB N.LU ==> NRV[NIX].LU JSB LDWD WILL RETURN LU WORD AND =B177400 ZERO OUT LU BYTE IOR LU OR IN NEW MIN LINK JSB STWD STORE IT BACK * ISZ #FDMN ADJUST RETURN ADDRESS DLD CM1 LOAD RETURN VALUE JMP #FDMN,I NORMAL RETURN SKP * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP CLEAR CALL TO THIS ROUTINE LDA $OPSY GET O/S TYPE RAR SLA,RSS DMS? JMP CONFG,I .NO STB LDMOD .YES, MOD INSTS STB SDMOD STB LSMOD JMP CONFG,I *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** *** * * STWD STORES ONE WORD FROM LOCAL TO SAM * * CALLING SEQUENCE: * * = WORD TO BE STORED * ==> SAM WORD * STWD NOP JSB $LIBR NOP SDMOD JMP SDSTA XSA 1,I JMP SDJSB SDSTA STA 1,I SDJSB JSB $LIBX DEF STWD * *** *** * * LDCM MOVES WORDS FROM COST MATRIX TO LOCAL BUFFER * * CALLING SEQUENCE: * * JSB LDCM * DEF *+4 * DEF NIX NODE INDEX * DEF LIX LINK INDEX * DEF BUF RETURN BUFFER AREA * * * @NIX NOP @LIX NOP @BUF NOP * LDCM NOP JSB .ENTR GET PARAMETER ADDRESS DEF @NIX * * CM ADDR CALCULATION = (#LCNT(NIX-1)+LIX-1)2+#CM * LDA @NIX,I ADA =D-1 MPY #LCNT SZB JMP LDCM,I ERROR RETURN ADA @LIX,I ADA =D-1 ALS LEFT SHIFT(X2) FOR 2 WORD CM ELEMENTS ADA #CM * LDB @BUF ==> SAM BUFFER JSB LDWS LOAD 2 WORDS FROM SAM * ISZ LDCM ADJUST RETURN ADDR JMP LDCM,I * *** *** * * LDWS MOVES WORDS FROM SAM TO LOCAL * * CALLING SEQUENCE: * * ==> SAM WORDS * ==> LOCAL BUFFER * LDWS NOP LSMOD JMP LSMVW JSB .LDX DEF LSLEN MWF JMP LDWS,I LSMVW JSB .MVW DEF LSLEN NOP JMP LDWS,I LSLEN DEC 2 TWO WORD MOVE * *** SKP * * DATA AREA * XX BSS 2 NIX EQU XX NODE INDEX MINC EQU XX+1 MIN COST MNLIX NOP MIN LINK INDEX LU NOP J NOP LOOP INDEX LVSZ DEC 6 SIZE OF LV ENTRIES * CM1 BSS 2 CM2 BSS 2 * @NRV NOP NRV POINTER NRVSZ DEC 3 SIZE OF NRV ENTRIES N.LU DEC 2 LU OFFSET END ] ]f 91750-18009 2013 S C0122 &#GET              H0101 (ASMB,R,Q,C HED <#GET> DS MSG GET SUBROUTINE * (C) HEWLETT-PACKARD CO. 1980 NAM #GET,7 91750-1X009 REV 2013 800726 ALL SPC 1 ENT #GET SPC 1 EXT .ENTR,EXEC,#PLOG,$OPSY EXT .LDX,.MVW,#LOGR * * NAME: #GET * SOURCE: 91750-18225 * RELOC: 91750-16225 * PGMR: TOM MILNER APR 1980 * * MODIFICATIONS: * --------------- * REQUEST LENGTH INCREMENTED (BY #LSZ) BEFORE CALL, AND * DECREMENTED (BY #LSZ) AFTER CALL -- TKM 05.31.79 * SIGN BIT ON CLASS CLEARED LOCALLY -- TKM 07.24.79 * DELETED 'D65GT' ENTRY POINT AND CHECK * FOR MSG OF LENGTH 1 (MA REQUEST FOR RETRY) -- TKM 09.11.79 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * '#GET' CALLING SEQUENCE: * * JSB #GET * DEF *+6 * DEF CLASS CLASS FOR GET SUSPEND * DEF RQBUF REQUEST BUFFER ADDRESS. * DEF RQLEN MAX REQUEST LENGTH * DEF DABUF DATA BUFFER ADDRESS * DEF DALEN MAX DATA BUFFER LENGTH (0 IF NO DATA). * A & B HAVE ASCII ERROR CODE * A= RCVD REQUEST LEN, B= RCVD DATA LEN * * * * * '#GET' OPERATION: * '#GET' IS CALLED BY ROUTINES WAITING TO RECEIVE REQUESTS ( & POSSIBLY * DATA) ON THEIR CLASS NUMBERS. THE MESSAGE RECEIVED CONSISTS OF 2 * BUFFERS; THE DATA & THE REQUEST (HEADER) BUFFERS. '#GET' * DOES THE FOLLOWING: * 1. PERFORMS A ZERO-LENGTH "GET" ON THE PASSED CLASS NUMBER * 2. MOVES DATA TO USER BUFFER USING LENGTH= MIN(USER LEN,RCVD LEN) * 3. IF SPECIFIED DATA LENGTH EXCEEDED, RETURNS A "DS03" * 4. MOVES THE REQUEST INTO THE USERS BUFFER USING ** LENGTH = MIN (RQLEN, 7) * 5. IF SPECIFIED REQUEST LENGTH EXCEEDED, RETURNS A "DS03" * 6. IF PLOG IS ENABLED, RETHREADS THE REQUEST TO PLOG'S CLASS * OTHERWISE, DEALLOCATES THE BUFFER IN SAM * 7. RETURNS THE RECEIVED REQUEST AND DATA SIZES IN & * * * '#GET' ERROR RETURNS: * * "DS03" - ILLEGAL RECORD SIZE - REQ OR DATA EXCEEDS BUFFER * "DS09" - ILLEGAL PARAMETERS. * A EQU 0 B EQU 1 * * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OFK REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP #GET NOP CLA STA DABUF INITALIZE POINTERS STA DALEN LDA #GET STA ENTRY JMP ENTRY+1 * CLASS NOP RQBUF NOP RQLEN NOP DABUF NOP DALEN NOP * ENTRY NOP JSB .ENTR GET PARAMETER ADDRESSES DEF CLASS * CLB CONFIGURE DMS/NON-DMS INSTRS LDA $OPSY GET OPSYSTEM TYPE RAR,SLA ROTATE DMS BIT STB MOD1 IT'S A DMS SYSTEM, MODIFY INSTR * LDA CLASS,I IOR CONS1 BUFR SAVE, NO DEALLOCATE RAL,CLE,ERA CLEAR BIT 15 (NO WAIT) STA CLASS * LDA DABUF SZA,RSS JMP DS096 LDA RQLEN,I LDB DALEN,I SSB,RSS NEGATIVE? SSA NEGATIVE? JMP DS095 YES, ONE OF 'EM WAS. BAD, BAD, BAD * ADA C#LSZ INCREMENT REQUEST SIZE STA RQLEN CMA,INA ADA C#MXR LARGER THAN MAX SSA ALLOWED? JMP DS033 NO, DS03(3) ERROR. * JSB EXEC DO "GET" ON PASSED CLASS # DEF *+7 DEF D21N DEF CLASS DEF DABUF,I DATA BUFR ADDR DEF D0 DATA LENGTH DEF RQADR REQUEST BUFR ADDR IN SAM RETURNED DEF LENGT RCVD REQUEST BUFFER LENGTH JMP ENTRY,I RETURN TO CALLER, IO00 ERROR IN A,B * STB BRTN SAVE RECEIVED DATA LENGTH LDA B CMB,INB ADB DALEN,I DATA LENGTH - RETURNED LENGTH SSB LDA DALEN,I USER'S DATA LENGTH LESS, USE IT STA ARTN SZA,RSS SHOULD WE MOVE ANY? JMP DOREQ NO! LDB DABUF ADDR OF USER'S DATA BUFFER LDA BRTN CMA,INA REQ ADDR (SAM) - DATA LENGTH = ADA RQADR DATA ADDR (SAM) JSB MOVER DO THE DATA MOVE FROM S.A.M. * DOREQ EQU * * LDB LENGT RCVD REQUEST BUFFER LENGTH STB ARTN CPB D1 CHECK FOR LENGTH 1 MSG JMP ZRET CMB,INB,SZB,RSS JMP ZRET ZERO LENGTH REQUEST, RETURN NOW ADB C#MXR IS THERE MORE THAN OUR BUFFER CAN HOLD? SSB JMP DS034 YES, DS03(4) ERROR. * * * MOVE REQUEST BUFFER FROM SAM TO USER AREA LDB RQBUF USER REQUEST BUFFER ADDRESS LDA RQADR SAM BUFFER ADDRESS JSB MOVER NOW MOVE THE REQUEST * LDB RQBUF ADB C#EC1 --> #EC1 LDA B,I CHECK FOR ERRORS ELA,CLE,ERA IF ERRORS THEN CPA "DS" IGNORE BUFFER LENGTH JMP SUCCS CHECKS * LDB BRTN DATA LENGTH CMB,INB ADB DALEN,I SSB DATA TOO LARGE? JMP DS035 YES, GIVE "DS03" * * SUCCESS! NOW RE-ADJUST LENGTH * SUCCS LDA C#LSZ CMA,INA ADA ARTN SSA,RSS IF ARTN < C#LSZ STA ARTN LEAVE ARTN AS IS... ISZ ENTRY BUMP TO SUCCESSFUL RETURN * * RETHREAD TO PLOG'S CLASS IF IT'S ENABLED * LOGIT LDA #PLOG SZA,RSS PLOG ENABLED? JMP CLSAM NO LDA RQBUF . YES, LOG MESSAGE LDB CLASS JSB #LOGR DO PROGRAM LOGGING JMP CLSAM ERROR RETURN JMP RETRN * ZRET ISZ ENTRY DO NORMAL RETURN FOR ZERO-LENGTH REQ * * DEALLOCATE THE BUFFER IN SAM * CLSAM LDA CLASS ALR,RAR CLEAR "SAVE BUFFER" FLAG STA CLASS * JSB EXEC DO DUMMY GET TO RELEASE BUFFER DEF *+5 DEF D21N DEF CLASS DEF DABUF,I DEF D0 NOP IF ERROR, WE DON'T CARE * * RETURN TO USER RETRN EQU * LDB BRTN DATA LENGTH LDA ARTN REQUEST LENGTH JMP ENTRY,I * * * ERROR ROUTINES * DS033 LDA Q3 RSS DS034 LDA Q4 RSS DS4035 LDA Q5 LDB RQBUF ADB C#ECQ STA B,I LDB "03 ILLEGAL RECORD SIZE JMP ERROR DS095 LDA Q5 RSS DS096 LDA Q6 LDB RQBUF ADB C#ECQ STA B,I LDB "09 ERROR EQU * LDA "DS" DST ARTN ERROR CODE RETURNED IN A & B JMP LOGIT FIRST DEALLOCATE BUFFER * * SUBROUTINE TO MOVE BLOCK OF WORDS FROM S.A.M. TO USER BUFFER * MOVER NOP MOD1 JMP NODMS "NOP" HERE IF DMS SYSTEM JSB .LDX PUT LENGTH IN X REG DEF ARTN MWF MOVE WORDS FROM ALTERNATE (SYSTEM) MAP JMP MOVER,I RETURN * NODMS JSB .MVW DO "MVW" FROM S.A.M. DEF ARTN NOP JMP MOVER,I RETURN SPC 3 * * DATA AREA * ARTN NOP BRTN NOP RQADR NOP LENGT NOP C#MXR ABS #MXR+#LSZ Q3 OCT 000060 Q4 OCT 000100 Q5 OCT 000120 Q6 OCT 000140 C#EC1 ABS #EC1 C#LSZ ABS #LSZ SIZE OF LOCAL APPENDAGE D0 DEC 0 D1 DEC 1 D21N ABS 21+100000B C#ECQ ABS #ECQ CONS1 OCT 060000 BUFR SAVE, DO NOT DEALLOCATE "DS" ASC 1,DS "03 ASC 1,03 "09 ASC 1,09 * SIZE EQU * * END gg ^ h 91750-18010 2013 S C0122 &#GETR              H0101 }[ASMB,R,Q,C HED <#GETR> DS GET SUBROUTINE * (C) HEWLETT-PACKARD CO. 1980 NAM #GETR,7 91750-1X010 REV 2013 800407 ALL SPC 1 ENT #GETR,#SBFA,#SBFL,#SDAL SPC 1 EXT .ENTR,EXEC EXT $OPSY,#CLTA EXT .LDX,.MVW,.CAY * * NAME: #GETR * SOURCE: 91750-18010 * RELOC: 91750-1X010 * PGMR: LYLE WEIMAN APR 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #GETR CALLING SEQUENCE: * * JSB #GETR * DEF *+4 [OR 6 OR 7 OR 8 OR 9] * DEF CLASS CLASS FOR GET SUSPEND * DEF DSHDR DS HEADER ADDRESS * DEF DSHDL DS HEADER (MAX)+LENGTH (ZERO IS VALID). * [DEF USRBF] USER DATA BUFFER. DEFAULT = NO USER DATA MOVED * [DEF USRBL] MAX USER DATA LENGTH. " " " " " * [DEF STATS] DRIVER STATUS (A-REGISTER FROM "GET") RETURNED HERE. * [DEF LLU] OPTIONAL RETURN FOR "LAST LU" WORD * [DEF DELAY] OPTIONAL RETURN FOR 'RTRY' DELAY VALUE * (BAD CLASS #) A & B HAVE ASCII ERROR CODE * A= ACTUAL LENGTH OF HEADER, EXCLUDING "APPENDAGE". * B=ACTUAL LENGTH OF USER DATA BLOCK. * X=3RD OPTIONAL PARAMETER FROM "GET" (REQUEST CODE) * Y=RETURNED SEARCH KEY (BUFFER ADDRESS IN S.A.M.) * * * * * #GETR OPERATION: * #GETR IS CALLED BY ROUTINES WAITING TO RECEIVE REQUESTS ( & POSSIBLY * DATA) ON THEIR CLASS NUMBERS. #GETR DOES THE FOLLOWING: * 1. PERFORMS A CLASS-I/O "GET" ON THE PASSED CLASS NUMBER. * THE USER DATA PORTION (1ST BUFFER) WILL BE MOVED INTO THE * USER BYUFFER AREA, IF ONE IS SUPPLIED, AS MUCH AS THE LENGTH * SUPPLIED. * * NOTE: #SBFA (AN ENTRY POINT) WILL CONTAIN THE VALUE RETURNED IN * THE FIRST "OPTIONAL PARAMETER" WORD (IF DOUBLE-BUFFERING * [I.E., Z-BIT] IS USED, THEN THIS IS THE ADDRESS OF THE SAM * BUFFER). THIS MAY BE USEFUL * FOR CALLERS WHO DO NOT USE DOUBLE-BUFFERING, AND IT IS * ESSENTIAL FOR #PUTR, WHICH USES THIS VALUE TO DETERMINE THE * SAM BUFFER ADDRESS FOR STUFFING DATA. * LIKEWISE, #SBFL WILL CONTAIN THE 2ND OPTIONAL PARAMETER * (IF DOUBLE-BUFFERING IS USED (Z-BIT), THEN THIS IS THE * 2ND BUFFER LENGTH). * 2. MOVES THE REQUEST INTO THE REQUEST BUFFER (UP TO THE * # OF WORDS SPECIFIED IN CALL. * 3. RETURNS THE "RTRY DELAY VALUE" WORD IN 'DELAY' (IF SPECIFIED), AND * THE "LAST LU WORD" IN 'LLU' (IF SPECIFIED). * 4. RETURNS THE RECEIVED REQUEST LENGTH AND STATUS IN THE B AND A REGS, * RESPECTIVELY. * 5. UPON RETURN, THE CLASS BUFFER REMAINS ALLOCATED IN SAM, AND MUST * BE CLEARED OUT OR RE-THREADED. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** SKP CLASS NOP CLASS NUMBER DSHDR NOP ADDRESS TO STORE DS 1000 HEADER DSHDL NOP MAXIMUM LENGTH OF DS 1000 HEADER TO RETURN USRBF DEF K0 USER DATA BUFFER (DEFAULTS TO NO DATA RETURNED) USRBL DEF K0 MAXIMUM AMOUNT OF DATA TO RETURN STATS NOP OPTIONAL RETURN ADDRESS FOR DRIVER STATUS LLU NOP "LAST LU WORD" RETURN ADDRESS DELAY NOP 'RTRY DELAY VALUE' WORD RETURN ADDRESS * #GETR NOP JSB .ENTR GET PARAMETER ADDRESSES DEF CLASS * INI JSB CONFG CONFIGURE DMS/NON-DMS ('NOP' AFTER 1ST CALL) * LDA CLASS,I IOR B6000 BUFR SAVE, NO DEALLOCATE STA CLASS AND =B377 ISOLATE CLASS NUMBER. ADA #CLTA,I COMPUTE ADDRESS OF CLASS TABLE ENTRY. STA CLTBA SAVE ADDMRESS FOR LATER USE. * JSB EXEC DO "GET" ON PASSED CLASS # DEF *+8 DEF K21N DEF CLASS DEF USRBF,I DATA BUFR ADDR DEF USRBL,I DATA LENGTH DEF #SBFA REQUEST BUFR ADDR IN SAM RETURNED DEF #SBFL RCVD REQUEST BUFFER LENGTH DEF IPRM3 3RD OPTIONAL PARAMETER JMP #GETR,I --ERROR RETURN, BAD CLASS#-- * STA STATS,I RETURN DRIVER STATUS STB ARTN+1 SAVE ACTUAL LNTH OF USER DATA BFR FOR RTN TO CALLER STB #SDAL LDB CLTBA GET THE CLASS BUFFER ADDRESS, * LX3 LDA B,I (XLA B,I IF DMS) NOP (REQUIRED FOR DMS) * JSB .CAY AND RETURN THE ADDRESS IN . * INA POINT TO CONWORD IN CLASS BUFFER. STA B LX0 LDA B,I (CROSS) LOAD THE CONWORD. NOP ALF,SLA POSITION Z-BIT, AND TEST FOR Z BUFFER. JMP GETX Z BUFFER PRESENT, GO TO GET CONTENTS. * CLB,RSS NO Z BUFFER, SO SET HEADER LEN. =0. * GETX LDB #SBFL RCVD REQUEST BUFFER LENGTH STB ARTN SAVE ACTUAL LENGTH OF HEADER LDA 1 CMB,INB,SZB,RSS JMP ZRET ZERO LENGTH REQUEST, RETURN NOW ADB DSHDL,I CHECK VS REQUESTED LENGTH SSB WAS IT LARGER? LDA DSHDL,I YES, USE SHORTER LENGTH SZA,RSS LENGTH WANTED = 0? JMP X2 . YES JUST GET APPENDAGE * * MOVE REQUEST BUFFER FROM SAM TO USER AREA * STA DSHDL LDB DSHDR USER REQUEST BUFFER ADDRESS LDA #SBFA SAM BUFFER ADDRESS MOD1 JMP NODMS "NOP" HERE IF DMS SYSTEM JSB .LDX PUT LENGTH IN X REGISTER DEF DSHDL LENGTH OF TRANSFER MWF MOVE WORDS FROM ALTERNATE (SYSTEM) MAP JMP X2 NODMS JSB .MVW "MOVE WORD" DEF DSHDL NOP * X2 EQU * LDB #SBFA RETURN ADB #SBFL THE LAST 2 WORDS OF HEADER ADB =D-1 LX1 LDA B,I (CROSS) LOAD "LAST LU MWORD" NOP (REQUIRED FOR XLA) STA LLU,I RETURN TO CALLER * LDA DELAY ARE WE TO RETURN THE SZA,RSS "RTRY DELAY VALUE" ? JMP ZRET NO ADB =D-1 YES, BACK UP ADDRESS POINTER TO DELAY WORD LX2 LDA B,I (CROSS) LOAD DELAY WORD NOP (REQUIRED FOR XLA) STA DELAY,I RETURN TO CALLER * ZRET EQU * DO NORMAL RETURN FOR ZERO-LNTH BUFFER ISZ #GETR BUMP TO SUCCESSFUL RETURN * * * RETURN TO USER * * LDA @K0 STA USRBF RESET ENTRY ADDRESSES, IN CASE NEXT STA USRBL ENTRY DOESN'T PASS ALL 5 PARAMS JSB .LDX RETURN WITH 3RD OPTIONAL PARAMETER DEF IPRM3 IN (X) CLA STA STATS STA DELAY STA LLU DLD ARTN ADA L#LSZ SUBTRACT APPENDAGE LENGTH JMP #GETR,I * * * * CONFG NOP ROUTINE TO CONFIGURE FOR DMS/NON-DMS INSTR. CLB LDA $OPSY GET OP-SYSTEM TYPE RAR,SLA MAPPED SYSTEM? STB MOD1 YES, CONFIGURE FOR "MWF" INSTR. STB INI CLEAR CALL TO THIS ROUTINE. SLA,RSS DMS SYSTEM? JMP CONFG,I RETURN DLD XLABI YES, PICK UP "XLA B,I" INSTRUCTION DST LX0 DST LX1 DST LX2 DST LX3 JMP CONFG,I * DATA AREA * ARTN EQU CONFG BRTN EQU CONFG+1 #SBFA EQU CONFG+2 ADDRESS OF DS HEADER #SBFL EQU CONFG+3 LENGTH OF DS HEADER IPRM3 EQU CONFG+4 3RD OPTIONAL PARAMETER #SDAL EQU CONFG+5 LENGTH OF DATA BUFFER CLTBA EQU CONFG+6 CLASS TABLE ENTRY ADDRESS. K0 EQU INI THIS LOCN 0 AFTER 1ST CALL @K0 DEF K0 K21N OCT 100025 CLASS "GET", NO ABORT B6000 OCT 060000 XLABI XLA B,I L#LSZ ABS -#LSZ A EQU 0 B EQU 1 * SIZE BSS 0 * END $"$ _ j 91750-18011 2013 S C0122 &#GTPL              H0101 zdASMB,R,Q NAM #GTPL,7 91750-1X011 REV 2013 791129 (L) ENT #GTOP EXT GTOPN SPC 2 * SUBROUTINE TO RETURN THE "OPEN" FLAG FOR DCBS * (VERSION FOR RTE-L) SPC 2 * SOURCE: 91750-18011 * RELOC.: 91750-1X011 * PRGMR: LYLE WEIMAN NOV 1979 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * SPC 2 #GTOP NOP JSB GTOPN ASSEMBLE AN "OPEN" FLAG FOR CALLER DEF *+1 JMP #GTOP,I RETURN END f `f 91750-18012 2013 S C0122 &#GTPX              H0101 {pASMB,R,Q,C NAM #GTPX,7 91750-1X012 REV 2013 791129 (IV,M) ENT #GTOP * * SOURCE: 91750-18012 * RELOC.: 91750-1X012 * PRGMR: LYLE WEIMAN NOV 1979 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * SUBROUTINE TO RETURN THE "OPEN" FLAG FOR DCBS * (VERSION FOR RTE-IV & M) SPC 2 #GTOP NOP LDA XEQT LOAD ID SEGMENT ADDRESS JMP #GTOP,I RETURN XEQT EQU 1717B CURRENTLY-EXECUTING PROGRAM ID SEGMENT ADDR END c ag 91750-18013 2013 S C0122 &#LOGR              H0101 xeASMB,R,Q,C HED <#LOGR> DS LOG SUBROUTINE * (C) HEWLETT-PACKARD CO. 1980 NAM #LOGR,7 91750-1X013 REV 2013 800110 ALL SPC 1 ENT #LOGR SPC 1 EXT #GETR,#RSAX,#RQUE,#PLOG * * NAME: #LOGR * SOURCE: 91750-18013 * RELOC: 91750-1X013 * PGMR: DOUG W. TSUI APR 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #LOGR CALLING SEQUENCE: * * < B REG. = CLASS # TO BE RETHREADED TO PLOG > * JSB #LOGR * BUFFER NOT LOG TO #PLOG * BUFFER LOG TO #PLOG * * * #LOGR OPERATION: * * #LOGR LOGS A CLASS BUFFER TO #PLOG. * IT ALSO CHECKS TO SEE IF THE BUFFER IS AN INCOMING * REQUEST. IF IT IS A REQUEST, THIS MEANS THAT GRPM HAS * CHANGED THE ORIGINAL SEQUENCE NUMBER TO THE LOCAL SEQUENCE * NUMBER. IN THIS CASE, A CALL TO #RSAX IS NECESSARY TO LOOK * UP THE ORIGINAL SEQ# AND 'STUFF IT' INTO THE MESSAGE HEADER * (IN SAM) BEFORE RETHREADING IT TO PLOG'S CLASS. * #LOGR NOP STB CLASS JSB #GETR GET STREAM WORD AND SEQ. # DEF *+4 DEF CLASS DEF DSHDR DEF D2 2 WORDS GET JMP #LOGR,I ERROR RETRUN LDA STREM LOAD STREAM WORD AND REPLY SZA INCOMING REQUEST? JMP REQU NO, JUST REQU * JSB #RSAX CALL RSAX TO GET ORIGINATOR'S DEF *+4 SEQUENCE # AS GRPM HAS PUT A DEF D5 LOCAL SEQUENCE # IN REQUEST HEADER DEF SEQ# DEF STREM STA SEQ# RESTORE ORIGINATOR'S SEQ. # * REQU JSB #RQUE RETHREAD TO PLOG    DEF *+9 DEF NA20 DEF B10K REQUE W/ Z BIT SET DEF D0 DEF D0 DEF DSHDR DEF D2 LEN OF OVERLAY DEF #PLOG DEF CLASS JMP #LOGR,I ERROR RETURN ISZ #LOGR JMP #LOGR,I RETURN * * CLASS NOP DSHDR BSS 2 ASSUME FIRST TWO WORDS IS STREM EQU DSHDR STREAM WORD & SEQ# EQU DSHDR+1 SEQ. # REPLY OCT 40000 B10K OCT 010000 NA20 OCT 100024 D0 DEC 0 D2 DEC 2 D5 DEC 5 END  bi 91750-18014 2013 S C0122 &#LVSC +              H0101 hASMB,R,Q,C HED <#LVSC> REROUTING ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #LVSC,30 91750-1X014 REV 2013 800107 ALL W/ RR SPC 1 ENT #LVSC SPC 1 EXT #LV,#LCNT EXT $OPSY,$LIBR,$LIBX * * NAME: #LVSC * SOURCE: 91750-18014 * RELOC: 91750-1X014 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #LVSC CALLING SEQUENCE: * * < A REG. = LU TO BE FOUND > * JSB #LVSC * * * * SKP #LVSC NOP JSB $LIBR NOP STA LU NOP JSB CONFG CLA,INA SET UP STA LIX POSITION COUNTER LDB #LV GET LV ADDRESS LOOP EQU * JSB LDWD GET LV.LU AND =B377 MASK OFF FLAGS CPA LU FOUND? JMP FOUND .YES LDA LIX .NO, END OF CPA #LCNT LV TABLE? JMP RETRN .YES, ERROR RETURN ISZ LIX .NO, UP LIX ADB LVSZ UP LV ADDRESS JMP LOOP FOUND EQU * LDA LIX LOAD LIX FOR RETURN ISZ #LVSC ADJUST RETURN ADDRESS RETRN JSB $LIBX NORMAL RETURN DEF #LVSC SKP * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP CLEAR CALL TO THIS ROUTINE LDA $OPSY GET O/S TYPE RAR,SLA DMS? STB LDMOD .YES, MOD INST JMP CONFG,I *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLD  A XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** SKP * * DATA AREA * LU NOP LIX NOP LVSZ DEC 6 LENGTH OF LV ENTRIES END 7  cj 91750-18015 2013 S C0122 &#MAAS +              H0101 ucASMB,R,Q,C HED <#MAAS> ASSIGN MA VARIABLES * (C) HEWLETT-PACKARD CO. 1980 NAM #MAAS,7 91750-1X015 REV 2013 800725 ALL (MA) ENT #MAAS EXT #MARL,#MCTR,#MARN,#MTBL,$OPSY,#NODE EXT $LIBR,$LIBX,.MVW,.ENTR,RNRQ,.LDX ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * #MAAS * ------- * SOURCE: 91750-18015 * RELOC: 91750-16015 * PGMR: TOM MILNER 11.01.79 * * ASSIGNS MESSAGE ACCOUNTING (MA) SEQUENCE VARIABLES TO * THE REQUEST/REPLY BUFFER. * * CALL FORMAT: * JSB #MAAS * DEF *+3 * DEF REQUEST/REPLY BUFFER * DEF REQUEST/REPLY BUFFER LENGTH * < ERROR RTN - CONTAINS ERROR CODE > * < GOOD RTN - = UNIQUE MA IDENTIFIER > * * THE '#MAAS' ALGORITHM (IN PASCAL) HAS BEEN APPENDED TO * THE MA ERS FOR THE READER'S AMUSEMENT. #MAAS'S OPERATION IS * AS FOLLOWS: * * 1. ACCESS TO THE MA TABLE IS LOCKED (BY RN). * 2. IF THE MESSAGE IS A REPLY THE SOURCE NODE IS USED FOR * THE SEARCH KEY IN (3.), OTHERWISE THE DESTINATION NODE * IS USED. * 3. THE ENTRY WITH THE DESIRED NODE (FROM 2.) IS SEARCHED * FOR IN THE MA TABLE AND MOVED INTO A LOCAL BUFFER FOR * EASIER ADDRESSING. * 4. IF THE CHANNEL IS... * UP OR PENDING : * MA VARIABLES ARE ASSIGNED TO THE REQUEST BUFFER * AS LONG AS THE RETRY COUNT AND MAX OUTSTANDING * MESSAGES ARE NOT EXECEEDED. * DOWN : *  THE ABOVE PROCEDURE IS EXECUTED AND THE * CONTROL WORD IS MODIFIED TO ADDRESS LU ZERO. * NONMA : * THE MA HEADER IS SET TO ZEROS. * 5. THE CHANNEL RECORD IS RESTORED (IF ANY CHANGES OCCURED) TO * THE MA TABLE AND THE RESOURCE NUMBER IS UNLOCKED. SKP *GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOC CAL APPENDAGE AREA >>> * ****************************************************************** * *GLBLK-END SKP SUP RQBUF NOP ADDRESS OF REQUEST BUFFER RQLEN NOP ADDRESS OF REQUEST BUFFER LENGTH CONWD NOP ADDRESS OF CONTROL WORD (LU) SPC 1 #MAAS NOP JSB .ENTR GET PARAMETER DEF RQBUF JSB CKDMS ONE-TIME CHECK FOR DMS; 'NOP'ED LDA #MCTR SZA MA INITIALIZED IN SYSTEM? JMP WAIT . YES ISZ #MAAS . NO, RETURN IMMEDIATELY JMP #MAAS,I * * LOCK ACCESS TO MA TABLE. * WAIT JSB RNRQ WAIT FOR ACCESS TO TABLE DEF *+4 DEF LK DEF #MARN (MA RESOURCE NUMBER) DEF FETCH (TEMP STORAGE FOR STATUS) NOP * * GET NODE NUMBER BASED ON REPLY BIT * LDB RQBUF ADB C#STR --> STREAM LDA B,I CHECK FOR REQUEST OR REPLY RAL,ELA = REPLY BIT LDB C#SRC --> SOURCE NODE IF REPLY SEZ,RSS LDB C#DST --> DESTINATION NODE IF REQUEST ADB RQBUF LDA B,I GET NODE JSB FETCH FIND MA TABLE ENTRY LDA STATE CPA .NON JMP NOMA * * ASSIGN MA VARIABLES TO MESSAGE HEADER * ASIGN EQU * CLB,INB ADB RQBUF ADB RQLEN,I -->RETRY BITS LDA B,I IOR BIT11 SET MA ASSIGNMENT BIT ADA BIT12 RETRY := RETRY + 1 STA B,I ALF AND B17 ISOLATE RETRY COUNTER SZA,RSS OVER 15 RETRIES? JMP DS05 . YEP TOO BAD... CMA,INA ADA #MARL RETRIES > MAX ? SSA JMP DS05 . TOO MANY RETRIES *-- IF VS > (VA+W) THEN CHANNEL SATURATED LDA VA FIRST CHECK FOR ROLLOVER POINT STA TMP CMA,INA LDB VS ADA B (VS-VA) SSA,RSS IF VS >= VA THEN JMP *+7 OK LDA TMP ELSE BUMP VS & VA BEYOND RvOLLOVER ADA W SSA ADA OFFST ROLLOVER STA TMP ADB W * LDA TMP VA ADA W VA+W CMA,INA ADA B VS-(VA+W) SSA,RSS CHANNEL SATURATED? JMP DS08 . YES, EXCEEDS MAX MSGS FOR THIS CHANNEL * ISZ DIRTY SET "DIRTY" BIT LDB RQBUF ADB C#MAS --> NS LDA VS STA B,I STA IDENT SAVE SEQUENCE # INA VS := VS + 1 SSA ROLLOVER? ADA OFFST STA VS SET NS INB --> NR LDA VR STA B,I SET NR INB --> NC LDA VC STA B,I SET NC * LDA IDENT FORM UNIQUE MA IDENTIFIER LSL 12 ISOLATE LOWER 4 BITS IOR IDX MA TABLE INDEX STA IDENT UNIQUE MA MESSAGE IDENTIFIER ISZ #MAAS GOOD RETURN (P+2) LDA STATE CPA .DOWN RSS JMP EXIT * * IF CHANNEL DOWN (DISCONNECTED) SET #MAS TO * INVALID VALUE (-1). * LDB C#MAS ADB RQBUF --> MAS CCA SET INITIALIZATION STA B,I INDICATOR (MAS = -1) JMP EXIT * DS05 LDB C#ECQ ADB RQBUF LDA B,I AND BM360 CLEAR QUALIFIER BITS IOR Q2 SET QUALIFIER (2) STA B,I LDB "05" TOO MANY RETRIES - SIMULATE TIMEOUT JMP EXIT DS08 LDB C#ECQ ADB RQBUF LDA B,I AND BM360 CLEAR QUALIFIER BITS IOR Q1 SET QUALIFIER (1) STA B,I LDB "08" CHANNEL IS SATURATED - RETURN BUSY ERROR JMP EXIT * NOMA EQU * CLEAR MA REQUEST AREA ISZ #MAAS GOOD RETURN (P+2) * * RESTORE MA VARIABLES IF ENTRY HAS BEEN MODIFIED * EXIT EQU * STB IDENT+1 LDA DIRTY SEE IF MA ENTRY HAS BEEN MODIFIED SZA JSB STORE * JSB RNRQ UNLOCK MA TABLE DEF *+4 HDEF UNLK DEF #MARN (MA RESOURCE NUMBER) DEF FETCH (DUMMY LOCATION) NOP * DLD IDENT = UNIQUE MA MSG IDENTIFIER JMP #MAAS,I RETURN SKP * BEGIN-FETCH * FETCH- FINDS AND UNPACKS CHANNEL RECORD ( = NODE) 10.01.79 * FETCH NOP STA NODE NODE TO SEARCH FOR CLA STA DIRTY CLEAR 'DIRTY' BITS LDA .NON STA STATE INIT STATE TO NON-MA LDB #MCTR = COUNT STB MACTR NUMBER OF MA ENTRIES SZB,RSS ZERO ENTRIES? JMP FETCH,I . YES NO USE HUNTIN' AROUND LDA #MTBL --> MA TABLE ELA,CLE,ERA CLEAR BIT15 -- DEBUG FLAG FLOOP STA LINK -->NEXT ENTRY (SAVE FOR STORE) LDB @REC -->LOCAL BUFFER DMS1 JMP *+5 'NOP'ED IF DMS JSB .LDX DEF RECLN MWF JMP *+4 JSB .MVW DEF RECLN NOP LDB @REC,I NODE NUMBER OF THIS ENTRY CPB NODE IS THIS THE ENTRY? JMP *+4 . YEP ISZ MACTR . NOP, BUMP COUNTER JMP FLOOP AND TRY AGAIN JMP FETCH,I COULDN'T FIND ENTRY RETURN * *-- UNPACK CHANNEL RECORD CLA LDB .TBL+1 STATE WORD WHEN PACKED LSR 2 ISOLATE STATE RAL,RAL STA STATE LSR 8 ISOLATE MAX TIMEOUT VALUE ALF,ALF STA TMAX LSR 2 VS OFFSET (VSO) WHEN PACKED ADB VA CALCULATE VS SSB ADB OFFST ADJUST FOR ROLLOVER STB VS VS:=VA+OFFSET FROM VA LDB .TBL+3 VT1 AND VT2 WHEN PACKED CLA LSR 8 ISOLATE VT2 ALF,ALF STA VT2 STB VT1 LDB .TBL+7 LSR 12 BLF LSR 4 STB VCC CANCEL COUNTER STA VCD DOWN COUNTER * LDA #MCTR CMA,INA INA ADA MACTR INDEX := MACTR - #MCTR + 1 STA IDX JMP FETCH,I SPC 1 MACTR NOP ^ NUMBER OF MA TABLE ENTRIES @REC DEF .TBL --> START OF PACKED RECORD RECLN DEC 10 LENGTH OF MA ENTRY .NON DEC 1 NON-MA STATE DIFF OCT 077777 (SUBTRACTION) CONSTANT FOR ROLLOVER OFFST OCT 100001 (ADDITION) CONSTANT FOR ROLLOVER SPC 2 * STORE- PACKS AND RESTORES CHANNEL RECORD * STORE NOP CLA STA DIRTY SET DIRTY BITS TO 'CLEAN' CPA MACTR CHECK FOR INVALID ENTRY JMP STORE,I AND RETURN IF NO GOOD *-- PACK CHANNEL RECORD LDA VCD ALF LDB VCC LSR 4 STA .TBL+7 LDA VT2 LSL 8 LDB VT1 LSR 8 STA .TBL+3 TIMERS (VT1/VT2) LDA TMAX RAL,RAL IOR STATE LSL 4 LDB VA CMB,INB ADB VS CALCULATE VSO = VS-VA SSB ADB DIFF ADJUST FOR ROLLOVER LSR 4 STA .TBL+1 STATE WORD (MSW) WHEN PACKED LDA NODE STA .TBL RESTORE NODE NUMBER * JSB $LIBR TURN OFF INTERRUPTS NOP LDA @REC -->LOCAL BUFFER LDB LINK -->SAM DMS2 JMP ST2 'NOP'ED IF DMS JSB .LDX DEF RECLN MWI MOVE BACK INTO SAM JMP ST3 ST2 JSB .MVW MOVE BACK INTO SAM DEF RECLN NOP ST3 JSB $LIBX TURN INTERRUPTS BACK ON DEF *+1 DEF *+1 JMP STORE,I END-STORE * END-FETCH SPC 2 *----------------------------------------------------------- * CONSTANTS *----------------------------------------------------------- A EQU 0 B EQU 1 * .DOWN OCT 0 LK OCT 040001 UNLK OCT 040004 W DEC 15 MAX # OUTSTANDING MSGS / CHANNEL B17 OCT 000017 ISOLATE RETRY COUNTER BM360 OCT 177417 Q1 OCT 000020 Q2 OCT 000040 BIT11 OCT 004000 BIT12 OCT 010000 BIT14 OCT 040000 C#STR ABS #STR C#SRC ABS #SRC C#DST ABS #DST C#MAS ABS #MAS C#ECQ ABS #ECQ "05" ASC 1,05 "08" ASC 1,08 SPC d*($1 *----------------------------------------------------------- * STORAGE *----------------------------------------------------------- CKDMS NOP CONFIGURE IF DMS (ROUTINE OVERLAYED) CLA CCB ADB CKDMS ADDRESS OF CALL STA B,I NOP CALL LDB $OPSY RBR,SLB DMS? RSS JMP CKDMS,I . NO RETURN STA DMS1 STA DMS2 JMP CKDMS,I RETURN (END-CKDMS) * OVRSZ EQU *-CKDMS OVERLAY SIZE * * START OF OVERLAY * ORG CKDMS * LOCAL MESSAGE TABLE BLOCK LINK BSS 1 . ADDRESS OF ENTRY NODE BSS 1 . NODE # OF CHANNEL IDX BSS 1 . INDEX INTO MA TABLE DIRTY BSS 1 . DIRTY BITS STATE BSS 1 . CHANNEL STATE TMAX BSS 1 . MAX TIMEOUT TICKS VS BSS 1 . SEND SEQUENCE # .TBL EQU * WORD ZERO OF MESSAGE TABLE WHEN PACKED VT2 BSS 1 . RECEIVER IDLE TIMER VCD BSS 1 . # TIMES CHANNEL DOWN VA BSS 1 . ACKNOWLEDGEMENT VARIABLE VT1 BSS 1 . ACKNOWLEDGEMENT TIMER VR BSS 1 . RECEIVE SEQUENCE # VF BSS 1 . RECEIVE FLAGS VC BSS 1 . CANCEL FLAGS VCC BSS 1 . # CONSECUTIVE CANCELATIONS LERC BSS 1 . LAST ERROR / QUALIFIER REPORTED LERN BSS 1 . LAST NODE REPORTING ERROR * TMP BSS 1 IDENT BSS 2 * SIZE EQU * PROGRAM SIZE END (* d p 91750-18016 2013 S C0122 &#MAPP +              H0101 `ASMB,R,Q,C HED <#MAPP> MA POST PROCESSOR * (C) HEWLETT-PACKARD CO. 1980 NAM #MAPP,7 91750-1X016 REV 2013 801013 ALL (MA) ENT #MAPP * EXT #NQUE,#RQUE,RNRQ,$LIBR,$LIBX EXT .MVW,.LDX,#GBUF EXT #NRVS,EXEC,XLUEX,#RSAX,#GETR,#PUTR * EXT #MCTR,#MAHC,#MARN,#MTBL,#MARL,#MAZE EXT #PLOG,#GRPM,$OPSY,#NODE,#LEVL,#QCLM,#MHCT SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * #MAPP * -------- * * SOURCE PART # 91750-18016 * REL. PART # 91750-1X016 * PROGRAMMER TOM MILNER * WRITTEN 06.20.79 * REVISED 801013 CLARK JOHNSON * * * #MAPP MONITORS OUTGOING AND INCOMING NETWORK MESSAGES. * CALLING SEQUENCE: * * = READ/WRITE COMPETION (0/1) * = LAST LU WORD IN LOCAL APPENDAGE * <#GBUF HAS REQUEST/REPLY BUFFER IN GRPM> * JSB #MAPP * < RETURN IF MESSAGE DISCARDED > * < NORMAL RETURN > * * * THE ALGORITHM (IN PASCAL) HAS BEEN APPENDED TO THE MA ERS FOR * THE READER'S AMUSEMENT. #MAPP'S OPERATION IS AS FOLLOWS: * * 1. ACCESS TO THE MESSAGE TABLE IS LOCKED (BY RN) * * IF THE MESSAGE WAS OUTBOUND * 2. AND WAS TRANSMITTED BY A SLAVE THEN THE MESSAGE IS * 'REQU'D TO A HOLD CLASS FOR POSSIBLE LATER RETRANSMISSION. * THERE IS NO FURTHER PROCESSING FOR OUTBOUND MESSAGES. * * IF THE MESSAGE WAS INCOMING -- * 3. IF THE MESSAGE WAS A REQUEST TO REININITIALIZE THEN THE * CHANNEL STATE IS SET TO PENDING AND AN INITIALIZE RESPONSE * IS ECHOED BACK. * 4. OTHERWISE, PROCESSING IS DETERMINED B)Y THE CHANNEL'S STATE: * DOWN - THE MESSAGE IS DISCARDED AND INITIALIZATION * IS REQUESTED ('INIT' IS SENT) * PENDING - THE MESSAGE IS DISCARDED AND IF IT WAS AN INITIALIZE * RESPONSE THEN THE STATE IS CHANGED TO 'UP' AND THE * NORMAL ACKNOWLEDGEMENT PROCESSING IS PERFORMED. * UP - IF THE MESSAGE IS WITHIN THE ACK 'WINDOW' THE * ACKNOWLEDGEMENT PROCESSING IS DONE. IF IT IS * WITHIN THE RECEIVE 'WINDOW' THEN THE RECEIVE * PROCESSING IS DONE. IF IT IS NOT WITHIN THIS LATTER * WINDOW THE MESSAGE IS DISCARDED. * NONMA - RETURN TO CALLER * 5. UPDATED CHANNEL INFO IS RESTORED (INTO SAM) IN THE MA * MESSAGE TABLE AND THE TABLE IS UNLOCKED (ITS RN FREED UP). SKP * GLOBAL-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUEN)CE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLOBAL-END * G EQU #GBUF SKP #MAPP NOP STA RD.WC SAVE READ/WRITE COMPLETION STB LLU SAVE LAST LU WORD (FROM LOCAL APPENDAGE) JSB CKDMS ONE-TIME CHECK FOR DMS; 'NOP'ED LDA CONWD STA LU+1 INITIALIZE I/O CONTROL WORD STA FSCTR << INITIALIZE FAILSAFE >> CLA STA DIRTY CLEAR DIRTY FLAG STA DSCRD INIT MSG DISCARD FLAG STA MAMSG INITIALIZE MA MESSAGE STA _MAZE INITIALIZE TO OUTBOUND TRAFFIC LDA #MCTR SZA,RSS MA INITIALIZED IN SYSTEM? JMP FLY . NO RETURN * * CHECK FOR NETWORK (STREAM 0) MESSAGES * LDA G+#STR GET STREAM WORD LSL 10 ISOLATE STREAM SZA STREAM ZERO? JMP RSM? . NO CHECK FOR REMOTE SESSION MESSAGE LDA G+#REP . YES CHECK SUBFIELD INDICATOR CPA N1 MA SUBFIELD? RSS JMP FLY . NO, IGNORE ALL OTHER NETWORK MSGS LDA G+#REP+1 . YES GET MA MESSAGE STA MAMSG * * CHECK FOR SPECIAL LOGOFF MSG (STREAM 7) FROM UPLIN * (IE., REMOTE SESSION) AND IGNORE IT TOO * RSM? LDA G+#MAS CHECK FOR NS = -2 CPA N2 AND IGNORE IF IT IS JMP FLY STA NS OTHERWISE SAVE NS * LDA G+#MAR NR STA NR LDA G+#MAC NC STA NC * LDA G+#SRC CHECK FOR STORE & LDB G+#DST FORWARD TRAFFIC CPA #NODE AND IGNORE RSS IT. CPB #NODE RSS JMP FLY CPA B AND IGNORE LOCAL-TO-LOCAL TRAFFIC JMP FLY * * WAIT FOR ACCESS TO MA TABLE * JSB RNRQ WAIT AND DISABLE ACCESS DEF *+4 DEF LK DEF #MARN (MA RESOURCE #) DEF TMP (TMP STORAGE FOR STATUS) ZERO NOP * * CHECK SOURCE/DESTINATION FOR OUTGOING OR INCOMING * LDA G+#STR RAL,ELA REPLY BIT TO LDA G+#DST SEZ,RSS CHECK FOR REPLY JMP QUEST REQUEST CPA #NODE LOCAL NODE? JMP *+3 . YES OUTGO:=TRUE NODE:=SORCE CLB . NO OUTGO:=FALSE NODE:=DEST JMP GTVAR CCB LDA G+#SRC JMP GTVAR QUEST CPA #NODE LOCAL NODE? JMP *+3 . YES OUTGO:=FALSE NODE:=SORCE CCB . NO OUTGO:=TRUE NODE:=DEST JMP GTVAR LDA G+#SRC CLB GTVAR STB TMP SAVE OUTGO FLAG JSB FETCH GET CHANNEL VARIABLES LDA TMP SZA,RSS OUTBOUND MESSAGE? JMP INCOM . NO INCOMING SKP *---------------------------------------------------------------+ * | * PROCESS OUTGOING MESSAGES | * | *---------------------------------------------------------------+ OUTGO EQU * LDB STATE CPB .NON NON MA NODE? JMP EXIT . YES ALL DONE *-- CHECK FOR LOCALLY GENERATED TRAFFIC (CHECK ASSIGNM{ENT BIT) * LDA LLU GET LAST LU WORD AND BIT11 TEST MA ASSIGNMENT BIT SZA,RSS IGNORE IF NOT JMP EXIT SET... * LDA MAMSG CHECK FOR MA MESSAGE SZA IGNORE IF MA MSG PRESENT JMP DOWN? LDA VT1 SET ACK TIMER SZA,RSS IF NOT ALREADY SET ISZ DIRTY AND SET DIRTY FLAG SZA,RSS LDA TMAX STA VT1 DOWN? LDA MAMSG CLEAR IDLE TIMER EXCEPT CPA .RR FOR IDLE TRAFFIC! JMP *+3 CLA STA VT2 CLEAR IDLE TIMER LDB STATE CPB .DOWN CHANNEL DOWN? RSS . YES REQUEST INITIALIZATION JMP SLAV? . NO, CHECK FOR SLAVE TRANSMISSION * * CHANNEL DOWN; TRY TO INITIALIZE * ISZ DIRTY SET DIRTY BIT LDA .PEND CHANGE STATE TO PENDING STA STATE CCA STA VC SO THAT NC:=-1 (ALL MESSAGES CANCELED) ADA #MARL NO RETRIES STA VCC LDA TMAX STA VT1 SET ACKNOWLEDGEMENT TIMER * * FORMAT INITIALIZE MESSAGE * LDA BIRTH INITIALIZE NUMBER SEQUENCE STA VA VA:=BIRTH STA VR VR:=BIRTH STA NS NS:=BIRTH JSB INCR STA VS VS:=BIRTH+1 JSB FMT LDA .INIT INITIALIZE MESSAGE STA RQB+#REP+1 JSB SEND SEND 'INIT' MESSAGE * * IF SLAVE TRANSMISSION SAVE IN HOLD QUEUE TILL ACK * SLAV? LDA MAMSG IGNORE MA MESSAGES SZA JMP EXIT * LDA G+#STR RAL SSA,RSS REPLY? JMP EXIT . NO ALL DONE * LDA VS VALIDITY CHECK - VERIFY JSB DECR THAT MSG IN RANGE OF STA TMP VS-1 AND VA LDA NS JSB RANGE VS-1 >= NS >= VA ?? DEF VA (LOWER BOUND) VA DEF TMP (UPPER BOUND) VS-1 JMP AGAIN OUT OF RANGE - RESEND IT! * * SAVE SLAVES TRANSMISSIONS * ̟ LDA NS GET SEQUENCE # AND FORM LSL 12 UNIQUE MA IDENTIFIER IOR IDX STA G+#MAS SAVE IDENTIFIER * JSB #NQUE REQUEUE TO HOLD CLASS DEF *+9 DEF CLS20 (WRITE/READ) DEF BIT15 (LU=0 BYPASS SESSION SST) DEF ZERO DEF ZERO DEF G (ZBUF OVERLAY) DEF P#MAS (ZBUF OVERLAY LENGTH) DEF #MAHC (DESTINATION CLASS) DEF #GRPM (SOURCE CLASS) JMP *+4 ERROR RETURN LDA BIT15 STA DSCRD SET REQUEUE (BIT15) FLAG JMP *+6 DST MAERR+2 SAVE REGISTERS LDA _MAZE IOR BIT10 SET 'CANNOT REQUEUE' BIT STA _MAZE LDA NS STA G+#MAS JMP EXIT SPC 2 * * FOR DRIVER 65 LINKS, IF RTRY HAS HAD MSG IT MAY HAVE * BEEN PASSED OVER FOR RETRANSMISSION, THEREFORE RESEND IT * AGAIN EQU * SINCE MSG OUT OF WINDOW RESEND IT LDA VS STA RQB+#MAS NS JSB INCR VS:=VS+1 STA VS LDA VR STA RQB+#MAR NR LDA VC STA RQB+#MAC NC * JSB #NRVS FIND LU OF THIS NODE DEF *+2 DEF NODE NOP IOR BIT15 BYPASS SESSION SST STA LU * LDA _MAZE IOR BIT5 'RESENDING SLAVE' BIT STA _MAZE * JSB #NQUE RESEND SLAVE DEF *+9 DEF CLS20 WRITE/READ DEF LU DEF ZERO DEF ZERO DEF RQB ZBUFFER OVERLAY DEF P#MAC ZBUF OVERLAY LENGTH DEF #GRPM (DESTINATION CLASS #) DEF #GRPM (SOURCE CLASS #) RSS ERROR RETURN JMP EXIT DST MAERR+2 SAVE ERROR CODES LDA _MAZE IOR BIT10 << REQUE ERROR ! >> STA _MAZE JMP EXIT SKP *---------------------------------------------------------------+ * | * PROCESS INCOMING MESSAGES - | * | *---------------------------------------------------------------+ INCOM EQU * LDA BIT0 STA _MAZE INBOUND LDA VA LDB NS DST MAERR+2 << DATA FOR FAILSAFE >> LDA MAMSG IS IT AN MA MESSAGE? SZA NO, SO SKIP IT ISZ DSCRD YES, SO DISCARD IT LATER * *-- IF NS=0 THEN STATE:=NONMA LDA NS SZA,RSS FROM MA NODE? JMP GONON . NO CHANGE STATE TO NONMA ISZ DIRTY LDA NR CPA N1 CHECK FOR GRPM ERROR RSS JMP CKMA CHECK FOR MA MESSAGE * *-- NR=-1 MEANS ERROR ECHOED FROM GRPM * LDA G+#ECQ LSR 4 SAVE THIS ERROR MESSAGE FOR AND B17 LATER AND ENCRYPT IT LDB A TO TAKE UP LESS SPACE STA TMP SAVE FOR LATER LDA G+#EC2 AND B17 ALF IOR B STA LERC ERROR CODE / QUALIFIER LDA G+#ENO STA LERN REPORTING NODE NUMBER * DLD G+#EC1 CHECK FOR DS08(4) AND CPA "DS" LET IT GO BACK TO THE USER RSS JMP KILLM CPB "08" RSS JMP KILLM LDA TMP CPA .4 DS08(4)? JMP EXIT . YES PASS IT ON TO THE USER * KILLM EQU * ISZ DSCRD FLUSH THIS MESSAGE LDB MAMSG SZB,RSS MA MSG? JMP EXIT . NO JUST FLUSH MESSAGE LDA G+#EC2 IF DS06 ON STREAM 0 THEN OTHER CPA "06" SIDE DOES NOT HAVE MA JMP GONON TURN OFF MA LDA STATE CPA .PEND JMP FAIL4 IF PENDING THEN CHANGE STATE TO DOWN JMP EXIT * CKMA LDB MAMSG SZB,RSS MA MESSAGE? JMP SETT2 . NO SET IDLE TIMER (VT2) LDA G+#EC2 CHECK FOR "DS06" CPA "06" JMP GONON DS06 MEANS OTHER SIDE HAS NO MA CPB .RR DON'T SET IDLE TIMER RSS O]N .RR MESSAGES SETT2 JSB ITIME BUT SET IT ON ALL OTHERS LDB MAMSG CPB .NR NO RESPONSE? JMP FAIL . YES SET CHANNEL DOWN CPB .INIT INITIALIZE REQUEST? JMP SETUP . YES RE-UP MA JMP CASE. * GONON LDA .NON ALREADY NONMA? CPA STATE JMP EXIT . YES NO NEED TO MODIFY ISZ DIRTY MA TABLE ENTRY IS DIRTY STA STATE STATE CHANGED TO NONMA CLA STA VR STA VT1 STA VT2 STA VCC JSB EXEC SEND "MA REMOVED FROM XXX" TO QCLM DEF *+8 DEF CLS20 DEF ZERO (LU=0) DEF MAERR DEF .1 DEF .4 (ERROR MSG 4) DEF ZERO DEF #QCLM NOP JSB FLUSH CLEAR OUT MA HOLD QUEUE JMP EXIT * * 'NO RESPONSE' RECEIVE FROM CHANNEL TIMER; INFORM MASTERS, * CLEAR SLAVE TRANSMISSIONS FROM HOLD CLASS, STATE TO DOWN. * FAIL EQU * LDA N17 STA FSCTR << INITIALIZE FAILSAFE >> LDA VA ANY MORE OUTSTANDING MESSAGES? CPA VS JMP FAIL4 . NO, DONE W/ MSG CLEANUP *-- FORMAT UNIQUE MA IDENTIFIER LSL 12 IOR IDX STA IDENT *-- BUMP TO NEXT MESSAGE NUMBER LDA VA JSB INCR VA:=VA+1 STA VA * JSB #RSAX SEARCH MASTER TCBS DEF *+3 DEF .11 SEARCH USING MA IDENTIFIER AS KEY DEF IDENT SSB WAS A TCB FOUND? JMP FAIL3 . NO CONTINUE * ADB .3 . YES, --> MASTERS CLASS (TCB+3) JSB LODWD GET CLASS RAL,CLE,ERA CLEAR SIGN STA TMP JSB FMT LDA "DS" STA RQB+#EC1 LDA LERC SZA,RSS ANY ERROR REPORTED? LDA DS053 . NO USE DEFAULT OF DS05(3) CLB RRR 4 EC2 TO , ECQ TO IOR "00" STA RQB+#EC2 BLF,BLF STB RQB+#ECQ QUALIFIER LDA LERN SZA,RSS ANY REPORTING NODE? , LDA #NODE . NO USE LOCAL IOR BIT15 STA RQB+#ENO LDA #NODE STA RQB+#DST * JSB XLUEX SEND MSG TO MASTER DEF *+8 INDICATING A TIMEOUT DEF CLS20 DEF BIT15 LU=0 DEF ZERO DATA BUFFER DEF ZERO DATA LENGTH = 0 DEF RQB REQUEST BUFFER DS05(3) DEF P#MHD REQUEST LENGTH DEF TMP CLASS NUMBER NOP * FAIL3 ISZ FSCTR << FAILSAFE >> JMP FAIL+2 CHECK FOR ANY MORE MSGS * FAIL4 EQU * JSB FLUSH FLUSH MA HOLD QUEUE ISZ VCD BUMP DOWN COUNTER LDA .DOWN STA STATE CHANGE STATE TO DOWN CLA STA VT1 STA VT2 STA VCC JMP EXIT * * ACKNOWLEDGE INITIALIZE REQUEST AND RESPOND WITH 'IR'. * SETUP EQU * RESPOND TO 'INIT' REQUEST LDA VA STA OLDVA SAVE FOR LATER LDA VS STA OLDVS SAVE CURRENT VS FOR LATER JSB ITIME SET IDLE TIMER (VT2) LDA .UP STA STATE CHANGE STATE TO UP LDA NR JSB INCR STA VS VS:=NR+1 STA VA VA:=NR+1 LDA NS JSB INCR STA VR VR:=NS+1 CLA STA VF VF:=0 STA VCC MAX RETRIES CCA STA VC SO THAT NC:=-1 (CAUSE OTHER SIDE TO RETRANSMIT) * * ECHO INITIALIZE MESSAGE WITH 'IR' (INIT RESPONSE) * JSB FMT FORMAT MA MESSAGE LDA G+#STR IOR BIT14 SET REPLY BIT IN STREAM STA RQB+#STR LDA G+#SRC GET SOURCE NODE STA RQB+#SRC LDA #NODE DESTINATION NODE (LOCAL NODE) STA RQB+#DST LDA .IR STA RQB+#REP+1 'IR' MESSAGE * JSB SEND SEND 'IR' *-- RETRANSMIT CURRENTLY UNACKNOWLEDGED MESSAGES (VA TO VS-1) LDA OLDVA LDB OLDVS JSB REXMT RETRANSMIT ANY OUTSTANDING MSGS JMP EXIT SPC 2 * PROCESSING DETERMINED BY STATE OF CHANNEL * CASE. EQU * PROCESSING DETERMINED BY STATE LDA STATE CPA .UP UP? JMP UP. . YES CPA .PEND PENDING? JMP PEND. SPC 2 * * DOWN; IGNORE ALL MESSAGES * DOWN. ISZ DSCRD JMP EXIT SPC 2 * * PENDING; RESPOND IF MA MSG IN VALID RANGE * PEND. EQU * ISZ DSCRD LDA MAMSG SZA,RSS MA MESSAGE? JMP EXIT . NO FLUSH IT LDA VR NOW CHECK THAT JSB DECR MESSAGE IS IN THE RANGE STA TMP OF VR TO VR-1 LDA NS VR >= NS >= (VR-1) ? JSB RANGE DEF TMP (LOWER BOUND) VR-1 DEF VR (UPPER BOUND) VR JMP EXIT OUT OF RANGE - JUST FLUSH MSG * LDA .UP STA STATE STATE:=UP JSB RECVR ADJUST VR JSB ACK ACKNOWLEDGE JMP EXIT SPC 2 * NORMAL PROCESSING; CHANNEL IN 'UP' STATE * RECEIVE MSGS WITHIN RECV 'WINDOW' OTHERWISE DISCARD * IF VR <= NS <= (VR+W+1) THEN RECV ELSE DISCARD * ACKNOWLEDGE MSGS WITHIN ACK 'WINDOW' * IF VA+1 <= NR <= VS THEN ACK; * UP. EQU * LDA MAMSG CHECK FOR RR - IGNORE IF IT IS CPA .RR JMP UP.2 CHECK FOR ACK PROCESSING LDA VR CHECK FOR VALID RECEPTION ADA W ADA N2 VR+W-1 JSB INCR (THIS EXTRA -1+1 IS TO CATCH ROLLOVER) STA TMP LDA NS JSB RANGE TEST FOR WITHIN RANGE DEF VR VR (LOWER BOUND) DEF TMP VR+W-1 (UPPER BOUND) JMP UP.1 OUT OF RANGE - DISCARD LDA MAMSG CHECK FOR CANCEL MESSAGE CPA .CAN AND BYPASS INDIVIDUAL JMP RECV CHECKS, SINCE CAN IS MULTIPLE * *-- SEQUENCE WITHIN WINDOW; BUT ALREADY RECEIVED? LDA VR CMA,INA ADA NS OFFSET IN RECV. WINDOW = NS-VR SSA ADA DIFF ALLOW FOR ROLLOVER JSB POWER CHANGE TO BIT vPOSITION (2**N) AND VF RECEIVE FLAGS SZA,RSS THIS MESSAGE ALREADY RECEIVED? (BIT = 1) JMP RECV . NO RECEIVE IT UP.1 ISZ DSCRD . YES DISCARD DUPLICATE RSS RECV JSB RECVR * UP.2 EQU * LDA VA JSB INCR VA+1 STA TMP LDA NR JSB RANGE TEST FOR WITHIN RANGE DEF TMP VA+1 (LOWER BOUND) DEF VS VS (UPPER BOUND) RSS JSB ACK WITHIN WINDOW, ACKNOWLEDGE SKP *---------------------------------------------------------------+ * EXIT ROUTINE | *---------------------------------------------------------------+ EXIT EQU * LDA IDX SET REMAINING DEBUG BITS LSL 12 ISOLATE MA INDEX (UPTO 16 NODES) IOR _MAZE LDB G+#STR RBL SSB IOR BIT1 'REPLY' BIT LDB MAMSG SZB,RSS IOR BIT2 'DATA MESSAGE' LDB DSCRD CLE,ELB SEZ IOR BIT3 'MSG REQUEUED' SZB IOR BIT4 'MESSAGE DISCARDED' LDB FSCTR SZB,RSS FAILSAFE BEEN PASSED? IOR BIT11 . YES INTERNAL ERROR !!!! STA _MAZE * STA MAERR+1 AND BADMA INTERNAL ERROR? SZA,RSS JMP DBUG? LDA .DOWN AFTER CASTASTROPHIC ERROR STA STATE CHANGE STATE TO DOWN JSB ITIME AND SET IDLE TIMER TO ISZ DIRTY CAUSE RE-INITIALIZATION JSB EXEC TELL QCLM INTERNAL ERROR !!! DEF *+8 DEF CLS20 DEF ZERO (LU=0, NO ZBIT) DEF MAERR DEF .4 (ERROR LENGTH = 4) DEF .9 (ERROR MSG 9) DEF ZERO DEF #QCLM NOP * DBUG? LDA #MAZE DEBUG TRACE ENABLED? SZA,RSS . YES JMP UNLOK . NO CONTINUE JSB XLUEX CLASS WRITE OF DEBUG RECORD DEF *+8 DEF CLS20 DEF BIT15 LU=08 DEF _MAZE DATA RECORD = MA INFO DEF .12 MA INFO LENGTH = 12 DEF G ZBUF = REQUEST BUFFER DEF .15 REQUEST BUFFER LENGTH = 15 DEF #MAZE NOP * UNLOK LDA DIRTY CHECK IF ENTRY DIRTY SZA JSB STORE RESTORE ENTRY * JSB RNRQ ENABLE MESSAGE TABLE ACCESS DEF *+4 DEF CLR DEF #MARN DEF TMP (DUMMY VAR FOR STATUS) NOP * LDA DSCRD IS MESSAGE TO BE DISCARDED? SZA,RSS JMP FLY . NO RETURN TO P+2 SSA WAS THIS MSG REQUEUED? JMP FLY+1 . YES TAKE THE DISCARDED (P+1) EXIT * GULP EQU * 'SWALLOW' MESSAGE LDA #GRPM CLASS NUMBER JSB RELEZ RELEASE MESSAGE SZA IF SUCCESSFUL RETURN TO P+1 FLY ISZ #MAPP RETURN TO P+2 (MSG KEPT) JMP #MAPP,I SKP *---------------------------------------------------------------+ * #MAPP SUBROUTINES | *---------------------------------------------------------------+ SPC 2 * BEGIN-FETCH * FETCH- FINDS AND UNPACKS CHANNEL RECORD ( = NODE) * FETCH NOP STA NODE NODE TO SEARCH FOR CLA STA DIRTY CLEAR 'DIRTY' BITS LDA .NON STA STATE INIT STATE TO NON-MA LDB #MCTR = COUNT STB MACTR NUMBER OF MA ENTRIES LDA #MTBL --> MA TABLE ELA,CLE,ERA CLEAR BIT15 -- DEBUG FLAG FLOOP STA LINK -->NEXT ENTRY (SAVE FOR STORE) LDB @REC -->LOCAL BUFFER DMS1 JMP *+5 'NOP'ED IF DMS JSB .LDX DEF RECLN MWF JMP *+4 JSB .MVW DEF RECLN NOP LDB @REC,I NODE NUMBER OF THIS ENTRY CPB NODE IS THIS THE ENTRY? JMP *+4 . YEP ISZ MACTR . NOP, BUMP COUNTER JMP FLOOP AND TRY AGAIN JMP FETCH,I COULDN'T FIND ENTRY RETURN * *-- V UNPACK CHANNEL RECORD CLA LDB .TBL+1 STATE WORD WHEN PACKED LSR 2 ISOLATE STATE RAL,RAL STA STATE LSR 8 ISOLATE MAX TIMEOUT VALUE ALF,ALF STA TMAX LSR 2 VS OFFSET (VSO) WHEN PACKED ADB VA CALCULATE VS SSB ADB OFFST ADJUST FOR ROLLOVER STB VS VS:=VA+OFFSET FROM VA LDB .TBL+3 VT1 AND VT2 WHEN PACKED CLA LSR 8 ISOLATE VT2 ALF,ALF STA VT2 STB VT1 LDB .TBL+7 LSR 12 BLF LSR 4 STB VCC CANCEL COUNTER STA VCD DOWN COUNTER * LDA #MCTR CMA,INA INA ADA MACTR INDEX := MACTR - #MCTR + 1 STA IDX JMP FETCH,I SPC 1 MACTR NOP NUMBER OF MA TABLE ENTRIES @REC DEF VT2 --> START OF PACKED RECORD RECLN DEC 10 LENGTH OF MA ENTRY .NON DEC 1 NON-MA STATE DIFF OCT 077777 (SUBTRACTION) CONSTANT FOR WRAPAROUND OFFST OCT 100001 (ADDITION) CONSTANT FOR WRAPAROUND SPC 2 * STORE- PACKS AND RESTORES CHANNEL RECORD * STORE NOP CLA STA DIRTY SET DIRTY BITS TO 'CLEAN' CPA MACTR CHECK FOR INVALID ENTRY JMP STORE,I AND RETURN IF NO GOOD *-- PACK CHANNEL RECORD LDA VCD ALF LDB VCC LSR 4 STA .TBL+7 LDA VT2 LSL 8 LDB VT1 LSR 8 STA .TBL+3 TIMERS (VT1/VT2) LDA TMAX RAL,RAL IOR STATE LSL 4 LDB VA CMB,INB ADB VS CALCULATE VSO = VS-VA SSB ADB DIFF ADJUST FOR ROLLOVER LSR 4 STA .TBL+1 STATE WORD (MSW) WHEN PACKED LDA NODE STA .TBL RESTORE NODE NUMBER * JSB $LIBR TURN OFF INTERRUPTS NOP LDA @REC -->LOCAL BUFFER LDB LINK -->SAM DMS2 JMP ST2 'NOP'ED IF DMS JSB G.LDX DEF RECLN MWI MOVE BACK INTO SAM JMP ST3 ST2 JSB .MVW MOVE BACK INTO SAM DEF RECLN NOP ST3 JSB $LIBX TURN INTERRUPTS BACK ON DEF *+1 DEF *+1 JMP STORE,I END-STORE * END-FETCH SPC 2 *---------------------------------------------------------------+ * POWER- CONVERT NUMBER IN TO BIT POSITION (2**N) | *---------------------------------------------------------------+ POWER NOP STB STORE SAVE B AND B17 ONLY ALLOW 4 BITS IOR SHIFT FORMAT SHIFT INSTRUCTION STA *+2 CLA,INA SET A TO 1 DEF *-* (MODIFIED TO LSL XX) SZA,RSS CLA,INA 2**0 = 1 LDB STORE JMP POWER,I SHIFT LSL 16 'LSL' INSTRUCTION SKELETON SPC 2 *---------------------------------------------------------------+ * ITIME- SETS IDLE TIMER (VT2) | *---------------------------------------------------------------+ ITIME NOP LDB VT2 LDA TMAX SET IDLE TIMER (VT2) ARS,ARS TO TMAX/4 SZA,RSS UNLESS LESS THAN 4 INA THEN SET TO 1 SZB,RSS UNLESS ALREADY RUNNING STA VT2 JMP ITIME,I SPC 2 *---------------------------------------------------------------+ * FLUSH- CLEARS OUT ANY MSGS IN MA HOLD QUEUE (KEY IN IDENT) | *---------------------------------------------------------------+ FLUSH NOP CLA,INA STA VS STA VR LDA W SETUP TO CLEAR HOLD QUEUE FL1 STA VA LSL 12 IOR IDX FORM MA IDENTIFIER STA IDENT JSB FIND SEARCH IN HOLD QUEUE JMP FL2 NOT FOUND CONTINUE LDA #MAHC JSB RELEZ FOUND - RELEASE MSG JSB FIND NOW LOOK FOR A DUPLICATE! JMP FL2 LDA _MAZE IOR BIT9 << DUPLICATE MSG IN HOLD QUEUE! >> STA _MAZE JMP *-7 CLEAR HIM FL2 LDA VA CPA VS ALL DONE? JMP FLUSH,I . YEP VS=VA=VR=1 !!! (IMPORTANT) ADA N1 JMP FL1 SPC 2 *---------------------------------------------------------------+ * RECVR- RECEIVE MSG PROCESSING VR+W <--- NS ---> VR | *---------------------------------------------------------------+ BSS 1 (STORAGE) RECVR NOP LDA MAMSG CHECK FOR CANCEL MESSAGE CPA .CAN CANCEL? RSS . YES SET VC JMP RECV2 . NO ADJUST VR LDA NS JSB INCR STA RECVR-1 NEW VR:=NS+1 RECV1 LDA VR CPA RECVR-1 CANCELED ALL MSGS? JMP RECV3 . YES JSB INCR . NO BUMP TO NEXT VR STA VR LDB VF LDA VC LSR 1 SHIFT FLAGS (VC & VF) OVER 1 XOR BIT15 VC IS OPPOSITE OF VF STB VF STA VC JMP RECV1 RECV2 EQU * LDA VR CMA,INA ADA NS (NS-VR) SSA ADA DIFF ALLOW FOR ROLLOVER JSB POWER 2 ** (NS-VR) IE., BIT POSITION IOR VF SET RECEIVE BIT STA VF RECV3 EQU * LDB VF THIS MSG RECEIVED? SLB,RSS JMP RECVR,I . NO NOT YET RECEIVED LDA VR . YES, NEXT EXPECTED VR JSB INCR RECEIVED; BUMP STA VR VR & SHIFT FLAGS OVER LDA VC ERB,CLE,ELB CLEAR LSB - VC(15) WILL = 0 LSR 1 SHIFT VF & VC OVER 1 STB VF STA VC JMP RECV3 SPC 2 *---------------------------------------------------------------+ * ACK- PERFORMS ACK PROCESSING VS <--- NR ---> VA+1 | *---------------------------------------------------------------+ ACK NOP LDA _MAZE IOR BIT7 MSG BEING ACK'ED STA _MAZE CLA STA LERC CLEAR LAST REPORTED ERROR STA LERN *-- RETRANSMIT ANY CANCEL ACKS (VA TO NR-1) LDA VA = VA LDB NR = NR JSB REXMT * * ADJUST VA; RELEASE ANY ACKNOWLEDGED SLAVE MESSAGES; * AND (IF REQUEST) SET BIT IN TCB. * LDA NC STA CFLAG LDA NR STA TMP LDA N17 << SETUP FAILSAFE >> STA FSCTR ACK1 EQU * LDA TMP CPA VA ALL ACKNOWLEDGEMENTS PROCESSED? JMP ACK2 . YES ISZ FSCTR RSS JMP ACK2 << FAILSAFE EXIT >> JSB DECR NR:=NR-1 STA TMP LSL 12 IOR IDX FOR UNIQUE MA IDENTIFIER STA IDENT LDA CFLAG CLE,ELA CANCEL BIT TO AND STA CFLAG SHIFT CANCEL FLAGS OVER SEZ CANCEL ACKED? JMP ACK1 . YES ALREADY TAKEN CARE OF... * JSB #RSAX TRY TO FIND MASTER TCB DEF *+3 AND INDICATE IT WAS ACKED DEF .12 OTHERWISE LOOK FOR SLAVE DEF IDENT MESSAGE. SSB,RSS MASTER FOUND? JMP ACK1 . YES * JSB FIND . NO LOOK FOR SLAVE JMP ACK1 HO HUMM... CAN'T FIND HIM LDA #MAHC JSB RELEZ HURRAH! FOUND HIM! NOW DUMP HIM JMP ACK1 * ACK2 EQU * LDA NR STA VA VA:=NR * * IF NO UNACKNOWLEDGED MESSAGES CLEAR ACK TIMER (VT1) * LDB TMAX CPA VS VS=VA? CLB . YES NO UNACK MSGS, CLEAR TIMER STB VT1 . NO MORE TO ACK; RESET TIMER CLB STB VCC RESET CONSEQUTIVE CANCEL COUNTER JMP ACK,I UND RETURN SPC 2 *---------------------------------------------------------------+ * REXMT- RETRANSMITS CANCEL ACKNOWLEDGEMENTS | * FROM U-1 DOWNTO (AND INCLUDING) L | * = LOWER BOUND (L) = UPPER BOUND (U) | *---------------------------------------------------------------+ REXMT NOP DST RL LDA NC GET CANCEL FLAGS (NC) JMP REX1+2 * REX1 LDA CFLAG ADJUST FOR NEXT CANCEL FLAG CLE,ELA SHIFT LEFT STA CFLAG SZA,RSS ANY MORE CANCEL FLAGS? JMP REXMT,I . NO ALL DONE LDA RU CPA RL END OF WINDOW? JMP REXMT,I . YEP ALL DONE * LDA RU JSB DECR U-1 STA RU U:= U-1 LSL 12 FORM UNIQUE MA IDENTIFIER IOR IDX MA TABLE INDEX STA IDENT LDA CFLAG NC SSA,RSS CANCEL ACKNOWLEDGEMENT? JMP REX1 . NO TRY NEXT BIT LDA _MAZE IOR BIT8 INDICATE CANCEL ACK RECEIVED STA _MAZE * JSB #RSAX SEARCH FOR MASTER TCB DEF *+3 DEF .11 MODE 11 DEF IDENT MA SEQUENCE # SSB TCB FOUND? JMP REX2 . NO LOOK IN SLAVE LIST * ADB .2 . YES, --> SEQUENCE NUMBER (TCB+2) JSB LODWD GET SEQUENCE NUMBER FOR LU MAPPING STA TMP AND SAVE FOR LATER INB --> MASTERS CLASS (TCB+3) JSB LODWD ELA,CLE,ERA CLEAR NO WAIT BIT STA CLASS SAVE CLASS LSL 3 CLEAR UPPER 3 BITS SZA,RSS IF CLASS = 0 THEN JMP REX1 BYPASS MASTER RETRANSMISSION * JSB XLUEX CLASS WRITE/READ TO MASTER DEF *+8 DEF CLS20 DEF BIT15 (LU=0) BYPASS SESSION SST DEF ZERO (DATA BUFFER) DEF ZERO (DATA LENGTH) DEF TMP MESSAGE SEQUENCE # (FOR LU MAPPING) DEF .1 LENGTH = 1 FOR MASTER RETRY REQUEST DEF CLASS MASTERS CLASS NOP SZA SUCCESSFUL WRITE? JMP REX1 . NO TRY NEXT BIT LDA _MAZE . YES SET IOR BIT6 'RESENDING MASTER' BIT STA _MAZE JMP REX1 * REX2 EQU * TRY TO FIND SLAVE TRANSMISSION & RETRANSMIT JSB FIND JMP REX1 MSG NOT FOUND... CONTINUE * JSB #GETR GET ZBUF INTO LOCAL BUFFER DEF *+8 FOR MODIFICATION DEF #MAHC DEF RQB ZBUF DEF P#MAC ZBUF LENGTH DESIRED DEF ZERO DATA BUF DEF ZERO DATA BUF LENGTH DESIRED DEF RANGE (NOT USED) DEF TMP LLU WORD NOP ERROR - IGNORE INA STA CTR OFFSET OF LLU WORD CLE LDA TMP BUMP RETRY COUNT (BITS 12-15) ADA BIT12 IOR BIT11 SET MA ASSIGNMENT BIT (BIT11) STA TMP SEZ TOO MANY RETRYS ( >15)? JMP REX3 . YES JUST RELEASE MSG * JSB #PUTR REPLACE LLU WORD DEF *+3 DEF CTR OFFSET OF LLU WORD DEF TMP NEW LLU NOP ERROR - IGNORE * LDA VS STA RQB+#MAS NS JSB INCR VS:=VS+1 STA VS LDA VR STA RQB+#MAR NR LDA VC STA RQB+#MAC NC * JSB #NRVS FIND LU OF THIS NODE DEF *+2 DEF NODE NOP IOR BIT15 BYPASS SESSION SST STA LU * LDA _MAZE IOR BIT5 'RESENDING SLAVE' BIT STA _MAZE * JSB #NQUE FINALLY! RESEND SLAVE DEF *+9 DEF CLS20 WRITE/READ DEF LU DEF ZERO DEF ZERO DEF RQB ZBUFFER OVERLAY DEF P#MAC ZBUF OVERLAY LENGTH DEF #GRPM (DESTINATION CLASS #) DEF #MAHC (SOURCE CLASS #) RSS JMP REX1 DST MAERR+2 SAVE ERROR CODES LDA _MAZE IOR BIT10 << REQUE ERROR ! >> STA _MAZE JMP REX1 * REX3 LDA #MAHC JSB RELEZ RELEASE MSG - CHANNEL BUSY JMP REX1 * CFLAG BSS 1 CANCEL FLAG RL BSS 1 LOWER LIMIT OF SEQUENCE # RU BSS 1 UPPER LIMIT OF SEQUENCE # SPC 2 *---------------------------------------------------------------+ * RANGE- IF P1 <= <= P2 RETURN TO P+2 ELSE P+1 | *-------------------------ǚ--------------------------------------+ BSS 1 (STORAGE) RANGE NOP STA RANGE-1 DLD RANGE,I GET PARAMETER ADDRESSES ISZ RANGE ISZ RANGE LDA A,I GET LOWER BOUND (P1) LDB B,I GET UPPER BOUND (P2) STA LO CMA,INA TEST FOR LOWER BOUND <= UPPER ADA B SSA,RSS JMP RANG2 LOWER BOUND <= UPPER (NO ROLLOVER) *-- PUSH WINDOW BEYOND "WRAP AROUND" POINT LDA RANGE-1 PUSH TEST ITEM ADA W SSA CHECK FOR WRAP AROUND ADA OFFST STA RANGE-1 LDA LO PUSH LOWER LIMIT ADA W SSA ADA OFFST ADJUST FOR (POTENTIAL) ROLLOVER ADB W PUSH UPPER LIMIT SSB ADB OFFST ADJUST FOR (POTENTIAL) ROLLOVER RSS RANG2 LDA LO CMA,INA ADA RANGE-1 SSA JMP RANGE,I TOO LOW - RETURN P+1 CMB TEST FOR <= P2 (UPPER LIMIT) ADB RANGE-1 SSB,RSS OK? JMP RANGE,I TOO HI - RETURN P+1 ISZ RANGE GOOD RETURN - P+2 JMP RANGE,I LO BSS 1 SPC 2 *---------------------------------------------------------------+ * LOAD WORD FROM SAM; -->SAM | *---------------------------------------------------------------+ LODWD NOP DMS4 JMP *+4 NOP IF DMS XLA B,I RSS LDA B,I JMP LODWD,I SPC 2 *---------------------------------------------------------------+ * INCR/DECR - INCREMENTS/DECREMENTS AND ALLOWS FOR ROLLOVER + *---------------------------------------------------------------+ INCR NOP INA SSA ADA OFFST ALLOW FOR ROLLOVER JMP INCR,I * DECR NOP ADA N1 SZA,RSS LDA DIFF ALLOW FOR ROLLOVER SSA ADA DIFF JMP DECR,I SPC 2 *---------------------------------------------------------------+ * FMT- FORMATS MA MESSAGE BUFFER (STJREAM ZERO ONLY) | *---------------------------------------------------------------+ FMT NOP FORMAT MA MESSAGES CLA STA RQB ZERO BUFFER LDA @RQB LDB A INB JSB .MVW DEF RQBLN NOP LDA BIT12 STREAM WORD STA RQB+#STR LDA #NODE SOURCE NODE STA RQB+#SRC LDA NODE DESTINATION NODE STA RQB+#DST LDA #LEVL UPGRADE LEVEL STA RQB+#LVL LDA #MHCT SET HOP COUNT STA RQB+#HCT LDA VS JSB DECR VS-1 STA RQB+#MAS NS LDA VR STA RQB+#MAR NR LDA VC STA RQB+#MAC NC CCA MA INDICATOR STA RQB+#REP LDA BIT11 SET MA ASSIGNMENT BIT STA RQB+#REP+1+#LSZ (BIT11) IN LLU WORD JMP FMT,I SPC 2 *---------------------------------------------------------------+ * SEND- SENDS MA MESSAGE ACROSS CHANNEL (LU FROM NRV) | *---------------------------------------------------------------+ BSS 1 (STORAGE) SEND NOP JSB #NRVS FIND LU DEF *+2 DEF NODE NOP IOR BIT15 BYPASS SESSION SST STA LU * LDA #GRPM SET THE 'NO IOR BIT15 WAIT' STA SEND-1 BIT!!! * JSB XLUEX SEND MESSAGE (CLASS WRITE/READ) DEF *+8 DEF CLS20 DEF LU DEF ZERO DEF ZERO @RQB DEF RQB DEF RQBLN DEF SEND-1 GRPM'S CLASS NUMBER NOP JMP SEND,I SPC 2 *---------------------------------------------------------------+ * FIND- FIND SLAVE MSG, RETURN P+1 NOT FOUND, P+2 FOUND. | *---------------------------------------------------------------+ FIND NOP JSB #NQUE FIND SLAVE MSG - KEY IN 'IDENT' DEF *+9 DEF N40 (SEARCH) DEF BIT15 (LU=0 AND DOUBLE WORD CONWD) DEF IDENT (SEARCH KEY) DEF N = CLASS | *---------------------------------------------------------------+ BSS 1 (STORAGE) RELEZ NOP STA RELEZ-1 SAVE CLASS # LDA #PLOG SZA,RSS IS LOGGING ENABLED??? JMP RELE2 . NO GULP MESSAGE * RELE1 JSB #RQUE . YES REQUEUE TO PLOG DEF *+9 DEF CLS20 WRITE/READ DEF BIT15 (LU=0 AND DOUBLE WORD CONWD) DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF #PLOG (DESTINATION CLASS) DEF RELEZ-1 (SOURCE CLASS) CCA,RSS ERROR RETURN CLA SUCCESSFUL RETURN JMP RELEZ,I ... UND RETURN * RELE2 LDA RELEZ-1 ALR,RAR ZERO BIT 14 (AND 15) STA RELEZ-1 * JSB EXEC DO CLASS GET TO DE-ALLOCATE MSG DEF *+5 DEF CLS21 DEF RELEZ-1 CLASS NUMBER DEF ZERO DEF ZERO CCA,RSS ERROR RETURN CLA SUCCESSFUL RETURN JMP RELEZ,I ... UND RETURN SKP *---------------------------------------------------------------+ * CONSTANTS | *---------------------------------------------------------------+ A EQU 0 B EQU 1 * BIRTH OCT 000001 START OF NUMBER SEQUENCE (1-77777B) CLS20 DEF 20,I CLS21 DEF 21,I CLASS GET W DEC 15 MAX # OUTSTANDING MSGS / CHANNEL "DS" ASC 1,DS "00" ASC 1,00 DS053 OCT 123 ENCRYPTED DS05(3) "06" ASC 1,06 "08" ASC 1,08 BIT12 OCT 010000 BIT14 OCT 040000 BIT15 OCT 100000 NOTE! THESE TWO WORDS MUST STAY COANWD OCT 010100 TOGETHER !!!!!!! ('BIT15' & 'CONWD') B17 OCT 17 P#MAS ABS #MAS+1 N#MAS ABS -#MAS-1 1'S COMPLEMENT OFFSET P#MAC ABS #MAC+1 P#MHD ABS #MHD+1 N1 DEC -1 N2 DEC -2 N17 DEC -17 N40 DEC -40 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .9 DEC 9 .11 DEC 11 .12 DEC 12 .15 DEC 15 RQBLN ABS #REP+2+#LSZ CLR OCT 040004 LK OCT 040001 * MA DEBUG BITS (WHEN SET) BIT0 OCT 0001 . INBOUND BIT1 OCT 0002 . REPLY BIT2 OCT 0004 . DATA MESSAGE BIT3 OCT 0010 . MESSAGE REQUEUED BIT4 OCT 0020 . MESSAGE DISCARDED BIT5 OCT 0040 . RESENDING SLAVE MSG BIT6 OCT 0100 . RESENDING MASTER REQUEST BIT7 OCT 0200 . ACK BEING PROCESSED BIT8 OCT 0400 . CANCEL ACK RECEIVED BIT9 OCT 1000 . << DUPLICATE MSG IN #MAHC !!! >> BIT10 OCT 2000 . << REQUEUE ERROR !!! >> BIT11 OCT 4000 . << WINDOW SCREWED UP !!! >> BADMA OCT 7000 INTERNAL ERROR CONDITIONS * * MA MESSAGE VALUES .RR OCT 01 . RECEIVER READY .INIT OCT 02 . INITIALIZE REQUEST .IR OCT 04 . INITIALIZE RESPONSE .CAN OCT 10 . MESSAGE CANCEL .NR OCT 20 . NO RESPONSE * * MA STATE VALUES .DOWN OCT 0 . DOWN .UP OCT 2 . UP .PEND OCT 3 . PENDING SPC 2 *---------------------------------------------------------------+ * STORAGE | *---------------------------------------------------------------+ CKDMS NOP CONFIGURE IF DMS (ROUTINE OVERLAYED) CLA CCB ADB CKDMS ADDRESS OF CALL STA B,I NOP CALL LDB $OPSY RBR,SLB DMS? RSS JMP CKDMS,I . NO RETURN STA DMS1 STA DMS2 STA DMS4 JMP CKDMS,I RETURN (END-CKDMS) * * START OF OVERLAY * ORG CKDMS * b< (UNPACKED) MA TABLE BLOCK LINK BSS 1 . ADDRESS OF ENTRY MAERR EQU * . MA INTERNAL ERROR MSG BLOCK NODE BSS 1 . NODE # OF CHANNEL BSS 3 . DEBUG INFORMATION IDX BSS 1 . INDEX INTO MA TABLE DIRTY BSS 1 . DIRTY BITS STATE BSS 1 . CHANNEL STATE TMAX BSS 1 . MAX TIMEOUT TICKS _MAZE BSS 1 . DEBUG VS BSS 1 . SEND SEQUENCE # .TBL EQU * WORD ZERO OF MESSAGE TABLE WHEN PACKED VT2 BSS 1 . RECEIVER IDLE TIMER VCD BSS 1 . # TIMES CHANNEL DOWN VA BSS 1 . ACKNOWLEDGEMENT VARIABLE VT1 BSS 1 . ACKNOWLEDGEMENT TIMER VR BSS 1 . RECEIVE SEQUENCE # VF BSS 1 . RECEIVE FLAGS VC BSS 1 . CANCEL FLAGS VCC BSS 1 . # CONSECUTIVE CANCELATIONS LERC BSS 1 . LAST ERROR / QUALIFIER REPORTED LERN BSS 1 . LAST NODE REPORTING ERROR * END-MA TABLE BLOCK TMP BSS 1 CTR BSS 1 RD.WC BSS 1 READ/WRITE COMPLETION (0/1) FSCTR BSS 1 FAILSAFE ... OLDVA BSS 1 OLDVS BSS 1 MAMSG BSS 1 DSCRD BSS 1 0=RTN P+2, -=RTN P+1, +=DO GET & RTN P+1 LU BSS 2 IDENT BSS 1 LLU BSS 1 LAST LU WORD FROM LOCAL APPENDAGE NS BSS 1 NR BSS 1 NC BSS 1 CLASS BSS 1 RQB BSS #REP+3+#LSZ REQUEST BUFFER * SIZE EQU * PROGRAM SIZE END  e 91750-18018 2013 S C0122 &#MAS2              H0101 7ASMB,Q NAM #MAST,7 91750-1X018 REV.2013 800408 MEF W/3K & NO RTE LINKS SPC 2 ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ******************************************************************* SPC 2 ENT #MAST,#RQB,#MSTC,#TTOV * * NAME: #MAST * SOURCE: 91750-18019 * BINARY: 91750-1X019 * PRGMR: TOM MILNER * EXT D$ABT * * DUMMY #MAST FOR SYSTEMS WITH 1000-3000 LINKS ONLY. * SPC 1 * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1Ki DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * ****************************************************************** * * * P T O P B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT * * #SCSM * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * SPC 1 #MAST NOP CCA CALCULATE ADA #MAST CALLING ADDRESS. LDB DS06 LOAD ERROR CODE. JMP D$ABT PRINT MESSAGE AND TERMINATE. * DS06 DEF *+1 ASC 2,DS06 #RQB BSS #TAG ALLOW ROOM FOR POPEN TO STORE PARAMS. #MSTC EQU #RQB #TTO0a V EQU #RQB END j fn 91750-18019 2013 S C0122 &#MAST              H0101 YASMB,R,Q,C HED <#MAST> MASTER REQUEST INTERFACE * (C) HEWLETT-PACKARD CO. 1980* NAM #MAST,7 91750-1X019 REV 2013 801010 ALL ENT #MAST,#RQB,#TILT,#MSTC,#TTOV * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * EXT .ENTR,EXEC,RNRQ,CLRQ,XLUEX EXT #NRVS,#MAAS,#GET,#RSAX EXT #MSSM,PGMAD,DSERR * EXT #WAIT,#NODE,#QRN,#GRPM,#TBRN,#LEVL EXT #BREJ,$OPSY,#OTCV,#MHCT * * NAME: #MAST * SOURCE: 91750-18019 * RELOC: 91750-1X019 * PGMR: TOM MILNER APR 1979 * REVISED: CLARK JOHNSON 801010 CORRECT CLEANUP OF TCBS AND CLASSES * * * * * #MAST CALLING SEQUENCE: (NOTE: FOR WRITE W/O * WAITING FOR REPLY, INCLUDE THE FOLLOWING CODE * BEFORE THE #MAST CALL). * * EXT #MSTC NO WAIT FLAG AND REPLY CLASS # * LDA CLASS PRE-ALLOCATED CLASS # FOR REPLY * STA #MSTC SET NO WAIT FLAG * . * . * JSB #MAST * DEF *+7 OR 8 * DEF CONWD CONTROL WORD/ERROR-RETURN FLAG (BIT#15). * DEF RQLEN REQUEST LENGTH. * DEF DABUF OUTGOING DATA BUFFER ADDRESS * DEF DLWRT OUTGOING BUFFER LENGTH (OR ZERO) * DEF DLRED INCOMING BUFFER LENGTH (OR ZERO) * DEF RPLEN MAX REPLY LENGTH * DEF INBUF (OPTIONAL) INCOMING DATA BUFFER ADDRESS * A & B HAVE ASCII ERROR CODE (ALSO IN REPLY 5 & 6) * A= RCVD REQ LEN, B= RCVD DATA LEN (OR 0) * * * * CONWD DESCRIPTION: * * BIT#15 - ERROR-RETURN FLAG (RETURN W/ ERRORS IF SET) * BIT#14 -NO TIMEOUT (IF SET) * BIT#0 - NO-REPLY OPTION (IF SET) * SKP M~* * * #MAST PERFORMS THE FOLLOWING FUNCTIONS: * 1. RETURNS DS00 TO CALLER IF SYSTEM IS QUIESCENT. * 2. ALLOCATES A CLASS NUMBER FOR THE REQUEST. * 3. DOES A LOCK/WAIT ON THE "RES" TABLE ACCESS RN. * 4. CREATES A MASTER TCB * 5. CONVERTS DESTINATION NODE TO LU * 6. SENDS THE REQUEST(/DATA) * 6. CALLS "#GET" TO AWAIT THE REPLY(/DATA) * 8. IF REPLY WAS A "QUIESCENT-REJECT", PUTS SELF IN TIME-LIST. * 9. IF ERROR FLAG IN 7TH REPLY WORD = 1, DOES ERROR RETURN. * 10. CLEARS THE MASTER CLASS # AND TCB. * 11. IF REPLY OK, GIVES RETURN WITH RCVD LENGTHS IN A & B. * * #MAST ERROR PROCESSING: * * 1. IF SIGN BIT(#15) OF CONWD PARAMETER IS SET, ASCII ERROR CODES * ARE SUPPLIED TO THE CALLER IN THE & REGISTERS, UPON * RETURN TO THE POINT IN THE CALLING SEQUENCE. * 2. IF THE SIGN BIT IS NOT SET, THEN THE CALLER'S PROGRAM IS * ABORTED, AFTER PRINTING AN ERROR MESSAGE ON THE SYSTEM * CONSOLE. * * #MAST ERROR MESSAGES: * * "DS00" - DS1000 IS SHUT-DOWN! * (1) #GRPM = 0 * (2) #QRN = 0 * (3) SYSTEM QUIESCENING * "DS02" - DRIVER DETECTED ERROR (PARITY, ETC.) * "DS03" - REQUEST LENGTH ERROR * (2) REQUEST LENGTH TOO SMALL * (3) REQUEST LENGTH TOO LARGE * "DS04" - LOGICAL UNIT INVALID OR NO CLCT ENTRY. * "DS05" - MASTER REQUEST TIMEOUT (COURTESY OF 'UPLIN'). * (1) MASTER REQUEST ACKNOWLEDGED BY MA * "DS07" - 'RES' TABLE-ACCESS ERROR. * (1) NO LEVEL CONVERTERS * "DS08" - REMOTE BUSY FAILURE - NO SAM, ETC * "DS09" - PARAMETER ERROR. * (1) NOT ENOUGH PARAMETERS * (2) NEGATIVE WRITE DATA LENGTH * (3) " READ " " * (4) " MAX REPLY DATA LENGTH * "IOXX" - \ * - RTE SYSTEM DETECTED ERRORS. * "RNXX" - / * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #MSTN * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SPC 1 A EQU 0 dB EQU 1 SKP #MSTC NOP NO WAIT CLASS NUMBER PLUGGED HERE #MAST NOP LDB #MSTC LDA K2 SZB NO WAIT? LDA K14 . YES GET NO WAIT CODE STA GETCB SET #RSAX CONTROL WORD TO GET TCB CLA INITIALIZE BEFORE RUN STA RPLEN STA INBUF STA MA.ID LDA CONWX STA LU+1 INITIALIZE CONTROL WORD LDB #MAST STB ENTRY SETUP FOR .ENTR JMP ENTRY+1 SPC 1 CONWD NOP CONTROL WORD ADDRESS. RQLEN NOP REQUEST BUFFER LENGTH. DABUF NOP OUTGOING DATA BUFFER ADDRESS OR DUMMY PARAMETER. DLWRT NOP WRITE DATA LENGTH (OR ZERO) DLRED NOP READ DATA LENGTH (OR ZERO) RPLEN NOP MAX EXPECTED REPLY LENGTH INBUF NOP INCOMING DATA BUFFER ADDRESS SPC 2 ENTRY NOP (ARTIFICAL?) ENTRY/EXIT JSB .ENTR OBTAIN DIRECT ADDRESSES DEF CONWD FOR PARAMETERS & RETURN POINT. LDB RPLEN SZB,RSS FIRST 6 PARAMETERS PASSED? JMP DS091 NO, GIVE ILLEGAL REQUEST * LDA DLWRT,I CHECK PARAMETERS FOR POSITIVE LENGTH SSA JMP DS092 LDA DLRED,I SSA JMP DS093 LDA RPLEN,I SSA JMP DS094 * LDB INBUF SZB,RSS LDB DABUF SET 7TH PARM TO 3TH IF NOT GIVEN STB INBUF * * CLEAR OUT REQUEST BUFFER * CLB,INB ADB @RQB ADB RQLEN,I --> 2ND APPENDAGE WORD CLA STA B,I CLEAR 2ND WORD (INCLUDES RETRY COUNT) STA RQB+#EC1 STA RQB+#EC2 STA RQB+#ENO STA RQB+#ECQ STA RQB+#MAS STA RQB+#MAR STA RQB+#MAC STA RQB+#SID * * FILL IN HOP COUNT FROM 'RES' * LDA #MHCT STA RQB+#HCT * * CHECK FOR NO-REPLY OPTION * LDB BIT15 LDA CONWD,I GET CONWD SLA TEST FOR NO-REPLY BIT (BIT 0) STB RQB+#ECQ IF SET, jSET BIT15 IN ECQ * * * CHECK FOR LOCAL SYSTEM SHUT-DOWN OR QUIESCENT STATUS. * START EQU * CLB STB SEQN CLEAR SEQ # ALLOCATED FLAG STB CLSFG CLEAR CLASS # ALLOCATED FLAG CPB #GRPM IS THE DS/1000 SYSTEM SHUT-DOWN? JMP DS001 YES. GO TELL CALLER THE SAD NEWS. * * REQUESTS WILL BE FORCED TO WAIT HERE, IF LOCAL SYSTEM HAS BEEN QUIESCED. * LDA #QRN CHECK IF #QRN IS VALID SZA,RSS JMP DS002 * JSB RNRQ GO TO RTE TO CHECK FOR SYSTEM QUIESCENCE. DEF *+4 DEF LCGNW DEF #QRN CHECK SYSTEM-QUIESCENCE RESOURCE NUMBER. DEF TEMP SAVE RN STATUS JMP PASER * RTE ERROR - PASS CODE TO CALLER * CLA,INA IS RN CLEAR? CPA TEMP RSS JMP DS003 . NO, TELL USER SYSTEM QUIESCENED/ING * LDA #MSTC CHECK IF CLASS # ALREADY ASSIGNED STA CLASN SZA JMP S1 BYPASS CLASS REQUEST * * REQUEST A CLASS NUMBER ALLOCATION FROM RTE. * JSB CLRQ REQUEST CLASS NUMBER DEF *+4 DEF CLRQ1 ALLOCATION CONTROL WORD DEF CLASN CLASS NUMBER DEF ZERO INDICATE NO OWNERSHIP JMP DS085 ERROR! CANNOT ALLOCATE CLASS NUMBER! LDA CLASN INDICATE CLASS NUMBER HAS BEEN ALLOCATED STA CLSFG * S1 EQU * LDA CONWD,I RAL,ELA MOVE TIMEOUT SUPPRESS FLAG (BIT14) LDA CLASN TO BIT15 RAL,ERA OF CLASS WORD STA TEMP * LDA #NODE LOCAL NODE NUMBER STA RQB+#SRC SET ORIGINATOR NODE (US) LDA RQB+#DST GET DESTINATION NODE CPA N1 ALWAYS LOCAL? LDA #NODE YES! GET LOCAL NODE # STA RQB+#DST SET DESTINATION FIELD * * CONVERT DESTINATION NODE TO LU * JSB #NRVS SEARCH NRV (LU RETURNED IN ) DEF *+6 DEF RQB+#DST (NODE NUMBER FOR SEARCH) DEF TMOUT MASTER TIME-OUT DHEF UPLVL UPGRADE LEVEL OF DEST. NODE DEF NABOR NEIGHBOR FLAG (IGNORED) DEF RQB+#DST NODE # FROM NRV (NEEDED IF -LU USED) JMP GETDS ERROR RTN - NODE NOT IN NRV STA LU SAVE COMMUNICATIONS LINK LU * LDA #TTOV GET TRANSACTION T/O OVERRIDE SZA IS IT SPECIFIED (NON-ZERO)? STA TMOUT .YES, OVERRIDE THE T/O VALUE * * WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE IN 'RES'; ADD NEW ENTRY. * LDA #MSTC CHECK NO WAIT FLAG SZA JMP MAAS BYPASS WAIT CODE * JSB RNRQ WAIT FOR TCB AVAILABLE (#MAST ONLY) DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT FOR IT/NO ABORT. DEF #TBRN TABLE-ACCESS SPACE-AVAILABLE RN. DEF CLNUP (DUMMY PARAMETER). JMP PASER * RTE ERROR - PASS ERROR CODE TO USER * * MAAS LDA UPLVL CHECK UPGRADE LEVEL - CANNOT SZA,RSS HAVE MA TO LEVEL ZERO! JMP ALLOC THIS TURNS OFF MA TO THIS NODE. * * GET MESSAGE ACCOUNTING (MA) SEQUENCE NUMBER * JSB #MAAS MA ASSIGNMENT DEF *+3 DEF RQB (REQUEST BUFFER) DEF RQLEN,I (REQUEST LENGTH) JMP MAERR ERROR - RETURN W/ DS08 STA MA.ID UNIQUE MA IDENTIFIER * ALLOC JSB #RSAX ALLOCATE TCB DEF *+6 DEF GETCB ADD MASTER TCB DEF TEMP PASS CLASS # & TIMEOUT FLAG DEF MA.ID UNIQUE (MA) MESSAGE IDENTIFIER DEF RQB+#DST PASS DESTINATION NODE DEF TMOUT MASTER TIME-OUT SSB ANY ERRORS? JMP RESER * ERROR: "DS07" (NOT LIKELY) STA RQB+#SEQ STORE SEQ # IN REQUEST STA SEQN SAVE LOCALLY, BECAUSE IT CAN BE CLOBBERED IN RQST * * VERIFY REQUEST LENGTH * LDA MINLN CHECK REQUEST LENGTH CMA,INA ADA RQLEN,I MUST BE AT LEAST THE MINIMUM SSA JMP DS032 GIVE DS03 IF < MINIMUM LDA MAXLN CMA ADA RQLEN,I > SSA,RSS JMP DS033 GIVE DS03 IF > MAXIMUM * * ASSIGN REMOTE SESSION ID (IN REQUEST) * CLA JSB #MSSM =0 JMP PASER ERROR RETURN * * NOW SEND THE REQUEST(/DATA) * LDA LU LOAD COMMUNICATIONS LINK LU IOR BIT15 BYPASS SESSION SST STA LU DESTINATION LU W/ CONTROL BITS LDB #GRPM GRPM'S CLASS NUMBER STB CLASS * LDA RQB+#LVL GET LEVEL NUMBER (IN HEADER) AND UPMSK MASK UPPER BYTE IOR #LEVL INCLUDE IN THIS SYSTEM'S UPGRADE LEVEL STA RQB+#LVL * LDA RQB+#STR GET STREAM WORD AND B77 CLEAR THE RETRY COUNTERS IOR #BREJ INITIALIZE TO REQUIRED VALUE IOR BIT12 SET "> LEVEL 0" INDICATOR STA RQB+#STR * * CHECK DESTINATION NODE UPGRADE LEVEL - IF LESS THAN * "ME" (LOCAL NODE LEVEL) SEND TO REQUEST/REPLY CONVERTER * FOR TRANSMISSION. LDA #LEVL IS MY UPGRADE LEVEL CMA,INA HIGHER THAN ADA UPLVL THAT OF DESTINATION SSA,RSS NODE? JMP WRITE . NO, MESSAGE DOESN'T NEED CONVERSION. * * DESTINATION NODE'S UPGRADE LEVEL IS LOWER THAN LOCAL NODE. * PASS THIS MESSAGE THROUGH OUT-BOUND MESSAGE CONVERTER * BEFORE TRANSMISSION. * LDA #OTCV CLASS # OF OUTPUT CONVERTER SZA,RSS CONVERTERS AVAILABLE? JMP DS071 . NO BADO BADO ... STA CLASS LDA BIT15 BYPASS SESSION SST STA LU * WRITE EQU * LDA RQLEN,I ADA C#LSZ BUMP LENGTH FOR LOCAL BUFFER STA LEN CCB ADB @RQB ADB A --> LAST WORD OF REQUEST LDA B,I IOR BIT8 SET "DS STATUS" BIT STA B,I * JSB XLUEX DO CLASS WRITE/READ TO DEST. LU DEF *+8 DEF CLS20 NO ABORT DEF LU DESTINATION LU DEF DABUF,I DEF DLWRT,I DATA BUFFER LENGTH OR ZERO @RQB DEF RQB REQUEuST ADDRESS DEF LEN REQUEST LENGTH DEF CLASS JMP PASER DO ERROR RETURN * LDA RQB+#SEQ RETURN SEQUENCE NUMBER TO CALLER STA REG LDA #MSTC CHECK FOR NO WAIT CALL SZA JMP RTN AND RETURN SKP * * DO A CLASS GET TO WAIT FOR A REPLY FOR THIS TRANSACTION. * JSB #GET WAIT FOR REPLY DEF *+6 DEF CLASN SPECIFY MASTER CLASS NO.--NO RELEASE. DEF RQB REPLY ADDRESS DEF RPLEN,I SPECIFY MAXIMUM REPLY LENGTH. DEF INBUF,I DATA BUFFER ADDR DEF DLRED,I DATA LENGTH OR ZERO JMP PASER * GET ERROR: GO TO PROCESS * DST REG SAVE REGS FOR RETURN * * CHECK FOR PROPER REPLY. * SZA,RSS CHECK FOR ZERO REPLY LENGTH. JMP DS05 * ZERO LENGTH: GO PROCESS TIMEOUT ERROR * CPA K1 MA RETRY REQUEST? JMP RETRY . YES, RESEND MESSAGE DLD RQB+#EC1 CHECK FOR DS05 RETURNED CPA "DS" BY MA AND PERFORM NORMAL RSS TIMEOUT PROCESSING (MA JMP *+3 WILL HAVE SET QUALIFIER) CPB "05" JMP DS05 CLA,INA =1 JSB #MSSM LOG RETURNED SESSION ID (IF ANY) LDB RQB+#ENO GET NODE REPORTING ERROR * * CHECK THAT REPLY DOESN'T CONTAIN ERROR SSB,RSS IS SIGN BIT SET (IN ERROR NODE)? JMP GOODX . NO, NO ERROR DLD RQB+#EC1 CHECK FOR REMOTE BUSY ("DS08") CPA "DS" DS TYPE ERROR? RSS . YES CHECK MORE JMP ERPLY . NO CORN-TINUE CPB "08" "DS08"? JMP SUSPD . YES, GO SUSPEND AWHILE JMP ERPLY ELSE DO ERROR EXIT * GOODX JSB CLNUP GO TO CLEAN UP BEFORE EXITING. * * RETURN TO USER AT NORMAL RETURN POINT. * RTN DLD REG = RCVD REQUEST & DATA LENGTHS ISZ ENTRY SET EXIT POINTER FOR NORMAL RETURN. JMP ENTRY,I RETURN TO THE CALLER. SKP * SUSPD CLB T CPB #WAIT DO WE DELAY OR RETURN ERROR DS08? JMP ERPLY NO WAIT SPEC'D, GIVE DS08 TO CALLER * DELAY AWHILE THEN TRY AGAIN JSB CLNUP RETURN MASTER CLASS # & TCB * JSB EXEC GO TO THE RTE 'EXEC' DEF *+6 IN ORDER TO PLACE DEF K12 INTO THE TIME-LIST, DEF ZERO THIS PROGRAM, FOR A PERIOD DEF K2 OF DELAY IN SECONDS, DEF ZERO (ONCE-ONLY) AS DETERMINED BY A DEF #WAIT NEGATIVE VALUE <#WAIT> IN 'RES'. * JMP START NOW, RE-SUBMIT THE REQUEST. * RETRY EQU * BEFORE RETRY, JSB CLNUP RELEASE THE TCB AND CLASS NUMBERS ALLOCATED JMP START THEN, RE-SUBMIT THE REQUEST. * SKP * * SUBROUTINE TO RELEASE THE MASTER CLASS & CLEAR THE MASTER TCB * CLNUP NOP ENTRY/EXIT LDA CLSFG CHECK IF CLASS ALLOCATED SZA,RSS IF CLASS NEVER ASSIGNED, JMP CLTCB TRY THE TCB... * JSB CLRQ RELEASE CLASS NUMBER & PENDING BUFS DEF *+3 DEF CLRQ2 FUNCTION 2 DEF CLASN CLASS NUMBER ZERO NOP * CLTCB EQU * LDA SEQN CHECK IF TCB ALLOCATED, SZA,RSS AND IF JMP CLNUP,I NOT, RETURN * ELSE ... JSB #RSAX CLEAR MASTER TCBS DEF *+3 DEF K6 CLEAR MASTER TCB CODE DEF SEQN PASS SEQ # JMP CLNUP,I RETURN. SPC 2 * * ERROR PROCESSING SECTION. * MAERR STB TEMP JSB RNRQ UNLOCK TCB LOCK DEF *+4 DEF ULGW DEF #TBRN DEF CLNUP (DUMMY) NOP LDB TEMP JMP GETDS DS001 LDA Q1 #GRPM = 0 RSS DS002 LDA Q2 #QRN = 0 RSS DS003 LDA Q3 SYSTEM QUIESCENING LDB "00" SYSTEM IS SHUT-DOWN: "DS00". JMP STQLF STORE QUALIFIER IN (A) DS032 LDA Q2 DS03/2 - RECORD LENGTH TOO SMALL RSS DS033 LDA Q3  DS03/3 - RECORD LENGTH TOO BIG LDB "03" JMP STQLF STORE QUALIFIER IN (A) DS05 JSB #RSAX TEST 'REQUEST ACKED' BIT DEF *+3 DEF K16 DEF SEQN LDB Q1 SZA DID REQUEST MAKE IT TO OTHER SIDE? STB RQB+#ECQ . YES OVERRIDE QUALIFIER LDB "05" DS05 - MASTER REQUEST TIMEOUT JMP GETDS DS071 LDA Q1 DS07/1 - NO LEVEL CONVERTERS LDB "07" JMP STQLF RESER EQU * CPB N3 JMP DS08 LDA Q3 DS07/3 - #RSAX ERROR LDB "07" JMP STQLF DS085 LDA Q5 DS08(5) - CANNOT ALLOCATE STA RQB+#ECQ CLASS NUMBER! DS08 LDB "08" JMP GETDS DS091 LDA Q1 RSS DS092 LDA Q2 RSS DS093 LDA Q3 RSS DS094 LDA Q4 LDB "09" DS09 - BAD PARAMETERS * STQLF EQU * STA RQB+#ECQ STORE QUALIFIER IN (A) * * LOCAL ERRORS HAVE NODE NUMBER INSERTED INTO RQB * GETDS LDA "DS" GET FIRST HALF OF ERROR MESSAGE "DS". * PASER DST RQB+#EC1 SAVE ERROR MESSAGE IN REPLY (NO MATTER WHAT) LDB RQB+#ENO LDA #NODE LOCAL NODE REPORTING ERROR IOR BIT15 SET ASCII ERROR BIT SZB,RSS THEN, DONT OVERLAY IF SOME NODE # IS ALREADY THERE STA RQB+#ENO * ERPLY JSB CLNUP GO TO CLEAN UP BEFORE EXITING. LDA CONWD,I GET ERROR-RETURN FLAG. ELA POSITION TO FOR TESTING. DLD RQB+#EC1 GET ERROR CODES SEZ ABORT OR RETURN TO CALLER? JMP ENTRY,I . RETURN TO CALLER * * ABORT THE CURRENT PROGRAM * #TILT NOP CLA STA ABMSG INDICATE CURRENT PGM NAME WANTED JSB PGMAD DEF *+2 DEF ABMSG * JSB DSERR EXPAND ERROR CODES DEF *+2 DEF RQB (OVERLAY TO SAVE SPACE) * JSB EXEC DEF *+5 DEF K2 DEF K1 DEF ABMSG DEF K32 * JSB EXEC BYE BYE... DEF *+2 DEF K6 SKP *-------Ha---------------------------------------------- * CONSTANTS *----------------------------------------------------- Q1 OCT 000020 Q2 OCT 000040 Q3 OCT 000060 Q4 OCT 000100 Q5 OCT 000120 BIT8 OCT 000400 BIT12 OCT 010000 BIT15 OCT 100000 CLRQ1 OCT 140001 ALLOCATE CLASS FUNCTION CLRQ2 OCT 140002 DEALLOCATE CLASS FUNCTION B77 OCT 77 UPMSK OCT 177400 CONWX OCT 010100 CLS20 DEF 20,I CLASS WRITE/READ--NO ABORT LCGNW OCT 140006 GLOBAL RN LOCK/CLEAR/NO WAIT/NO-ABORT. LGW OCT 040002 GLOBAL RN LOCK/WAIT/NO ABORT. ULGW OCT 040004 UNLOCK K1 DEC 1 K2 DEC 2 K6 DEC 6 K12 DEC 12 K14 DEC 14 K16 DEC 16 K32 DEC 32 N1 DEC -1 N3 DEC -3 "00" ASC 1,00 "03" ASC 1,03 "05" ASC 1,05 "07" ASC 1,07 "08" ASC 1,08 "09" ASC 1,09 "DS" ASC 1,DS * C#LSZ ABS #LSZ REQUEST APPENDAGE SIZE MINLN ABS #MHD MINIMUM REQUEST LENGTH MAXLN ABS #MXR MAXIMUM REQUEST LENGTH *----------------------------------------------------- * STORAGE *----------------------------------------------------- SUP SEQN NOP SEQUENCE NUMBER #TTOV NOP TRANSACTION T/O OVERRIDE WORD * * NOTE: ABMSG MUST IMMEDIATELY PRECEDE #RQB BUFFER * DO NOT DISTURB THIS ORDER! * ABMSG ASC 8,XXXXX ABORTED! #RQB EQU * RQB BSS #MXR+#LSZ REG BSS 2 RETURN REGISTER INFORMATION. MA.ID BSS 1 UNIQUE (MA) MESSAGE IDENTIFIER GETCB BSS 1 RSAX COMMAND WORD TO GET A TCB LU BSS 2 DESTINATION LU TMOUT BSS 1 MASTER TIME-OUT VALUE UPLVL BSS 1 DESTINATION UPGRADE LEVEL NABOR BSS 1 NEIGHBOR FLAG FOR #NRVS CALL (IGNORED) TEMP BSS 1 TEMPORARY STORAGE. CLASN BSS 1 CLASS NUMBER STORAGE. CLASS BSS 1 CLSFG BSS 1 CLASS ALLOCATED FLAG LEN BSS 1 SIZE EQU * END ^HFBBH gx 91750-18020 2013 S C0122 &#MSSM +              H0101 pASMB,R,Q,C,Z IFZ HED #MSSM 91750-1X020 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #MSSM,7 91750-1X020 REV.2013 801013 RTE-IVB W/S.M. XIF IFN HED #MSSM 91750-1X021 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #MSSM,7 91750-1X021 REV.2013 801013 ALL, W/O S.M. XIF * * "Z" OPTION FOR SESSION MONITOR NODE, "N" OPTION IF NON-SESSION NODE. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #MSSM,#NAT,#NASR,#OVR,D$OVR,#DFSN,#NEWX * EXT SESSN,RNRQ,#RSAX,#LDEF,#TBRN,$OPSY,#POOL,#IDSG EXT #RQB,PGMAD,LUTRU,.CBT,.MVW,#MHCT,LOGLU,#NODE EXT #BREJ,#NRVS,#GRPM,EXEC,#OTCV,#LEVL,$DSCS,XLUEX RQB EQU #RQB IFN EXT $LIBR,$LIBX XIF IFZ EXT ISMVE,$SMII XIF * * NAME: #MSSM * SOURCE: 91750-18020 * RELOC: PART OF 91750-12014 ("Z"), -12015 ("N") * PGMR: JIM HARTSELL * * SUBROUTINES TO PERFORM OPTIONAL SESSION-MONITOR PROCESSING * OF DS/1000 REQUESTS FOR THE #MAST MODULE. * * THIS MODULE, CALLED BY #MAST, IS APPENDED TO USER PROGRAMS FOR * RFA, DEXEC, PTOP, DLIST, AND DMESS REQUESTS. IT CONTAINS THE * NETWORK ACCOUNT TABLE WHICH IS USED TO KEEP TRACK OF EVERY REMOTE * NODE ACCESSED BY THIS USER AND THE SESSION ID AT THAT NODE. THE * SESSION ID CAN BE 0 (NO SESSION MONITOR AT THE NODE) OR 254 (SPECIAL * NON-SESSION ACCESS TO SESSION MONITOR NODE). * * ********************************************************** * * * * * R E M O T E S E S S I O N O V E R R I D E * * * H * * * < FOR OVERRIDE, USER MUST SET (EXT) #OVR NON-ZERO > * * * < #MSSM DOES NOT RESET #OVR > * * * * * ********************************************************** SKP * * CALLING SEQUENCES: * * STORE SOURCE AND DESTINATION SESSION ID IN REQUEST, IF APPLICABLE. * IF DESTINATION NODE = SOURCE NODE, SET DESTINATION SESSION ID = * SOURCE SESSION ID. IF DEST ID IS NOT IN NETWORK ACCOUNT TABLE, * LOOK FOR FATHER PROGRAM WITH A REMOTE SESSION ID AND BUILD * LOCAL NAT ENTRY. IF NO FATHER SESSION, LOOK FOR LOCAL SESSION * ID IN #POOL AND BUILD NAT ENTRY (SESSION WAS CREATED FROM * REMOTE NODE). NEXT, SEE IF PROGRAM WAS SCHEDULED IN A NON-SESSION * NODE FROM A SESSION NODE AND BUILD NAT ENTRY IF APPLICABLE. * IF NONE OF THE ABOVE, SET FLAG TO TELL "#MSDF" THAT THE REPLY WILL * CONTAIN A DEFAULT SESSION ID AND IF SO, A NAT ENTRY WILL BE NEEDED. * * CLA * JSB #MSSM * P+1 ERROR RETURN. (A,B) = ASCII ERROR CODE. * P+2 NORMAL RETURN. * * * * RETRIEVE DEFAULT SESSION ID FROM REPLY IF FLAG IS SET AND * BUILD NETWORK ACCOUNT TABLE AND PROCESS NUMBER LIST ENTRIES: * * CLA,INA * JSB #MSSM * * * FIND SPECIFIC ENTRY FOR A NODE NUMBER OR NEXT AVAILABLE ENTRY * IN THE NETWORK ACCOUNT TABLE. * * (A) = NODE NUMBER, OR ZERO TO FIND AVAILABLE ENTRY. * JSB #NASR * (A) = SESSION ID * (B) = ADDR OF ENTRY, ZERO IF NOT FOUND. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERنS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119  * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP * * STORE SOURCE AND DESTINATION SESSION IDENTIFIER (IF ANY) IN * REQUEST (SOURCE OR DESTINATION NODE MAY OR MAY NOT BE UNDER * SESSION MONITOR CONTROL). * * SESSION ID 0 = NO SESSION MONITOR * 1 = SPECIAL NON-SESSION ACCESS TO S.M. NODE * N>1 = NORMAL SESSION ID * SUP A EQU 0 B EQU 1 * #MSSM NOP SZA CHECK TYPE OF ENTRY. JMP MSDF GO RETRIEVE DEFAULT SESSION ID. * STA DFALT CLEAR "DEFAULT SESSION" FLAG. * JSB #NEWX CHECK FOR NEW EXECUTION. * LDA LOCID GET SAVED LOCAL SESSION ID. SSA IF NEGATIVE, GO DO FIRST-TIME FETCH JSB GTLOC OF LOCAL ID (EXCEPT FOR RTE-M3). * AND B377 ALF,ALF STORE SOURCE (LOCAL) ID IN LEFT BYTE STA B (CAN BE 254 IF FROM SYS CONSOLE IN LDA RQB+#SID A SESSION-MONITOR NODE) AND B377 IOR B STA RQB+#SID OF REQUEST SESSION ID WORD. * LDA RQB+#STR IF AND B77 CPA K7 REQUEST RSS JMP CKOVR FROM LDA RQB+#CML CPA K2 DLGON/DLGOF/DLGNS, RSS JMP CKOVR EXIT LDA RQB+#CMS CPA "XX" NOW. JMP RETRN * CKOVR LDA K254 TEST SPECIAL OVERRIDE FLAG. LDB #OVR SZB JMP STSID SET. ALLOW NON-SESSION ACCESS (ID=254). * LDA LOCID GET LOCAL (SOURCE) SESSION ID. LDB RQB+#DST IF REQUEST IS TO THE LOCAL NODE, CPB RQB+#SRC SET DESTINATION SID = JMP STSID SOURCE SID (NO NAT ENTRY). * LDA RQB+#DST SEE IF DEST NODE IS IN THIS USER'S JSB #NASR NETWORK ACCOUNT TABLE (NAT). SZB,RSS IF NOT, GO LOOK FOR ANCESTOR JMP FNROO THAT HAS AN ACTIVE SESSION, ETC. * JSB SEQCK FOUND. CHECK IF CORE-RES RESTART. JMP HAVE NO. * FNROO JSB ROOTS GO LOOK FOR ANCESTOR, ETC. * HAVE AND B377 ISOLATE DESTINATION SESSION ID. * SZA,RSS IF NO SESSION ID RETURNED, JMP RETRN RETURN TO CALLER. * LDB SLAVE USER SCHEDULED FROM A SZB SESSION AT REMOTE NODE? JMP STSID YES. GO STORE DEST. SESSION ID. * STA TEMP NO. SAVE DEST SID. VERIFY BY CCB SEARCHING PNL. ADB #LDEF ADDRESS OF PNL HEADER ADDRESS. LDB B,I GET ADDR OF FIRST ENTRY. STLST SZB,RSS END OF LIST? JMP GONE YES. DEST SID NOT FOUND. JSB LODWD NO. GET NEXT ADDRESS. STA NXTAD SAVE NEXT ADDRESS. ADB K4 POINT TO ID SEG ADDRESS. JSB LODWD GET IT. SSA JMP NXLST IGNORE BAD ENTRIES. INB POINT TO DEST SID WORD. JSB LODWD GET DEST SESSION ID. CPA TEMP SAME? JMP STSID YES. GO STORE SID IN REQUEST. NXLST LDB NXTAD NO. GET NEXT ADDRESS. JMP STLST GO CHECK NEXT ENTRY. * STSID AND B377 STORE DEST. SESSION ID IOR RQB+#SID IN RIGHT BYTE OF REQUEST STA RQB+#SID SESSZION ID WORD. * JMP RETRN RETURN TO CALLER. SKP * ******************************************************************* * * THE FOLLOWING CODE IN SUBROUTINE #MSSM IS ONLY DONE ONCE * PER USER PROGRAM EXECUTION. * ******************************************************************* SPC 2 * * LOCAL USER HAS A NETWORK ACCOUNT TABLE (NAT) ENTRY FOR THE DESTINATION * NODE BUT THERE IS NO PROCESS NUMBER LIST (PNL) ENTRY (FOR THIS * PARTICULAR NODE). IF THE LOCAL PROGRAM OWNED THE REMOTE SESSION, THE * PROGRAM MUST BE MEMORY RESIDENT OR TERMINATED PREVIOUSLY WITH RESOURCE * SAVE. THE NAT ENTRY REPRESENTS A PRIOR-EXECUTION REMOTE SESSION THAT * WAS LOGGED OFF BY UPLIN (USER DID NOT LOG OFF). SINCE THIS IS A NEW * EXECUTION OF THE PROGRAM, RELEASE ALL NAT ENTRIES (AND NATX, IF ANY). * IF THE LOCAL PROGRAM IS A SON, WHERE A FATHER OWNED THE REMOTE SESSION, * CLEAR THE NAT ENTRY AND RETURN A "RS01" ERROR. * GONE LDA RQB+#DST JSB #NASR GET SESSION ID WORD. SSA,RSS DID FATHER OWN SESSION? JMP GONE1 NO. WE MUST BE A NEW EXECUTION. * CLA YES. RELEASE SINGLE NAT ENTRY. STA B,I JMP RS01 RETURN WITH "RS01" (SESSION GONE). * GONE1 JSB CLNAT RELEASE OLD NAT. * CLA CLEAR FLAGS. STA SLAVE STA XEQT INA SET FLAG TO SIGNAL "WAITING STA DFALT FOR DEFAULT SESSION. JMP RETRN RETURN TO CALLER. SKP * * PERFORM ONE-TIME RETRIEVAL OF LOCAL SESSION IDENTIFIER (IF ANY). * GTLOC NOP * CLA STA BUFR STA LOCID * JSB PGMAD GET USER'S ID SEG ADDR. DEF *+3 DEF BUFR DEF XEQT * JSB SESSN SEE IF UNDER SESSION. DEF *+2 DEF XEQT * SEZ,RSS RUNNING UNDER SESSION? JMP GTSID YES. GO GET SESSION ID. * JSB LOGLU NO. GET SYSTEM LU (NOT IN SESSION) DEF *+2 OF SCHEDULING TERMINAL. b? DEF TEMP DUMMY PARAM. (A) = LU. * LDB $DSCS IF THIS IS A SESSION-MONITOR SSB,RSS NODE, SET LOCAL SESSION ID = 254 LDA K254 FOR NON-SESSION "RETURN" ACCESS. STA LOCID SLAVE MONITOR "ATACH" WILL CHECK JMP GTLOC,I FIRST TO SEE IF IN A SESSION NODE. * GTSID STB TEMP GET SESSION TERM. LU (SESSION ID). * (MIGHT HAVE BEEN SCHEDULED BY EXECW * AND "LOGLU" WON'T DO.) IFZ JSB ISMVE MOVE DATA FROM SCB. DEF *+5 DEF TEMP SESSION WORD FROM ID SEG. DEF $SMII POINT TO SESSION IDENTIFIER. DEF LOCID LOCATION TO BE FILLED. DEF K1 GET 1 WORD. XIF * LDA LOCID GET LOCAL SESSION ID. JMP GTLOC,I GO STORE IN REQUEST BUFFER. SKP * * CHECK FOR NEW EXECUTION. * #NEWX NOP * JSB #IDSG GET PROGRAM SEQUENCE COUNTER DEF *+5 FROM USER'S ID SEGMENT. DEF K0 OURSELF. DEF K1 TENTATIVE ITEM NUMBER. DEF CNTR RETURNED SEQUENCE COUNTER. DEF TEMP RETURNED OP SYSTEM TYPE. * LDA TEMP IS THIS RTE-M3? CPA N5 JMP RTEM3 YES. WE DON'T HAVE PRG SEQ #. * LDA CNTR GET PROGRAM SEQUENCE COUNTER. CPA PGSEQ SAME AS BEFORE? (CAN BE ZERO). JMP #NEWX,I YES. RETURN. STA PGSEQ NO. SET NEW NUMBER. * JSB CLNAT RELEASE NETWORK ACCOUNT TABLE. * CCA RESET LOCAL ID (FOR ALL STA LOCID SYSTEMS EXCEPT RTE-MIII). * CLA CLEAR FLAG. STA SLAVE * JMP #NEWX,I RETURN TO CALLER. * PGSEQ OCT 0 CURRENT PROGRAM SEQUENCE NUMBER. * * ***** BEGIN SPECIAL CODE FOR RTE-MIII SYSTEMS ***** * * DETECT NEW EXECUTION AS FOLLOWS: IF THERE ARE NO ACTIVE PNL ENTRIES * FOR THIS PROCESS, AND THE USER WAS NOT SCHEDULED BY EXECW (IN A SLAVE * PROCESS) k, THEN IT IS SAFE TO CLEAR THE NAT. IN THIS CASE, IT WILL * EITHER BE A NEW EXECUTION OR ALL REMOTE SESSIONS HAVE BEEN LOGGED OFF. * IF RUNNING IN A SLAVE PROCESS, THE "EXECW SEQ #" WILL BE USED IN * "SEQCK" TO DETECT NEW EXECUTION. * NOTE: IF #OVR SET, THERE WILL BE NO PNL ENTRIES. * RTEM3 EQU * IFN LDA #OVR REMOTE SESSION OVERRIDE? SZA JMP #NEWX,I YES. FORGET NEW EXECUTION TEST. * JSB GTLOC GET LOCAL [SESSION] ID, IF ANY. * CLA CLEAR "HAVE PNL" FLAG. STA TEMP2 * JSB $LIBR GO PRIVILEDGED. NOP * CCB SEARCH PNL FOR AN ENTRY BELONGING ADB #LDEF TO THIS PROCESS. LDB B,I ADDRESS OF PNL HEADER. NEWX1 JSB LODWD GET ADDR OF NEXT PNL ENTRY. SZA,RSS JMP NEWX5 END OF LIST. * LDB A STB NXTAD SAVE ADDR OF NEXT PNL ENTRY ADDR. ADB K3 FIRST, CHECK IF THIS PNL IS FOR JSB LODWD THIS PROCESS (SAME TERMINAL LU). AND B377 CPA LOCID RSS JMP NEWX3 NO. * INB SECOND, CHECK IF GOOD PNL ENTRY. JSB LODWD SSA JMP NEWX3 NO. * CMA,INA THIRD, SEE IF OWNER IS ALIVE. STA TEMP * JSB PGMAD GET STATUS OF PROGRAM. DEF *+3 DEF BUFR DEF TEMP * SSB JMP NEWX2 TIME LIST. SZB,RSS JMP NEWX3 DORMANT. * NEWX2 CLB,INB SET "HAVE PNL" FLAG. STB TEMP2 * NEWX3 LDB NXTAD GO CHECK NEXT PNL ENTRY. JMP NEWX1 * NEWX5 LDA TEMP2 IS THERE A PNL FOR THIS PROCESS? SZA JMP LBEX YES. * LDA XEQT NO. CHECK IF PROGRAM SCHEDULED STA IDPTR FROM A REMOTE NODE (BY EXECW). * NEWX4 CLA STA BUFR LDA IDPTR CMA,INA STA TEMP * JSB PGMAD GET ID SEG ADDR OF FATHER. DEF *+6 DEF BUFR DEF TEMP DEF TEMP1 DEF TEMP1 ;| DEF FATHR * LDA FATHR FATHER PROGRAM? SZA,RSS JMP NEWX9 NO. STA IDPTR YES. CMA,INA STA FATHR * JSB PGMAD GET FATHER'S NAME. DEF *+3 DEF BUFR DEF FATHR * LDA BUFAD IS HIS NAME EXECW? LDB @EXCW (IF SO, THE "EXECW SEQ #" IN THE JSB .CBT #POOL AND NAT ENTRIES WILL BE DEF K5 USED TO DETECT NEW EXECUTION.) NOP * JMP LBEX YES. "SEQCK" WILL CATCH NEW EXECUTION. NOP NO, JMP NEWX4 CHECK FOR FATHER'S FATHER. * NEWX9 JSB CLNAT RELEASE OLD NAT ENTRIES. CLA STA SLAVE CLEAR FLAG. * LBEX JSB $LIBX RETURN. DEF #NEWX * @EXCW DEF *+1 ASC 3,EXECW XIF JMP #NEWX,I INSURE AGAINST WRONG LIBRARY. * * ***** END SPECIAL CODE FOR RTE-MIII SYSTEMS ***** * * * SUBROUTINE TO RELEASE ALL NETWORK ACCOUNT TABLE ENTRIES. * CLNAT NOP LDB #NAT RELEASE OLD NAT ENTRIES. STB TEMP LDA NAT# STA CNTR * CLN1 LDA B,I WAS THIS NAT ENTRY IN USE? SZA,RSS ((B) = "TEMP") JMP NXENT NO. GO CHECK NEXT NAT ENTRY. ADB K2 YES. WAS THERE A NATX (IF REMAT)? LDA B,I CPA #DFSN (SKIP "DEFAULT SESSION") CLA CLB SZA STB A,I YES. RELEASE NATX ENTRY. CLA STA TEMP,I RELEASE NAT ENTRY. NXENT LDB TEMP BUMP TO NEXT NAT ENTRY. ADB K4 STB TEMP ISZ CNTR JMP CLN1 JMP CLNAT,I RETURN. SKP * * (REQUIRED ONLY FOR RTE-M BECAUSE IT HAS NO PROG SEQ CNT IN ID SEGMENT.) * CHECK FOR NEW EXECUTION OF A CORE RESIDENT PROGRAM SCHEDULED-WITH-WAIT * FROM A REMOTE NODE (IF THE NAT ENTRY FOR THE DESTINATION NODE HAS * A NON-ZERO "EXECW SEQ #", AND THERE IS NO #POOL ENTRY CONTAINING THIS * SEQ #, THEN THIS IS A NEW EXECUTION). * IF NEW EXECUTION, RELEASE ALL NETWORK ACCOUNT TABLE (NlAT) ENTRIES. * SEQCK NOP (A) = DEST SID, (B) = ADDR OF NAT. STA SAVA SAVE (A) FOR P+1 EXIT. * ADB K3 LDA B,I GET "EXECW SEQ #" FROM NAT ENTRY. AND B377 SZA,RSS SCHEDULED BY EXECW? JMP EXIT1 NO. EXIT P+1. STA SEQNO YES. SAVE SEQUENCE NUMBER. * LDB #POOL GET ADDR OF SID POOL. SZB,RSS JMP EXIT1 GET OUT IF NONE. JSB LODWD STA CNTR SAVE NEG. # POOL ENTRIES. INB * SEQLP JSB LODWD GET NEXT "IN USE" POOL ENTRY. SSA,RSS JMP NXSEQ STB POOLA SAVE ADDR OF ENTRY. ADB K2 JSB LODWD GET EXECW SEQ #. ALF,ALF AND B377 CPA SEQNO SAME AS ONE IN NAT ENTRY? JMP EXIT1 YES. TAKE P+1 EXIT. LDB POOLA NO. * NXSEQ ADB POOSZ CHECK NEXT POOL ENTRY. ISZ CNTR JMP SEQLP * JSB CLNAT NOT FOUND. RELEASE ALL NAT ENTRIES. * ISZ SEQCK TAKE P+2 EXIT FOR NEW EXECUTION. EXIT1 LDA SAVA RESTORE SID FOR P+1 EXIT. JMP SEQCK,I RETURN TO CALLER. SKP ************************************************************************ * * R O O T S ********* R O O T S * ************************************************************************ * * FIRST, PERFORM ONE-TIME SEARCH FOR AN ANCESTOR IN A SCHEDULE-WITH-WAIT * CHAIN THAT ALREADY HAS A SESSION ESTABLISHED AT THE DESTINATION * NODE. IF FOUND, LATCH THIS USER ONTO THAT SESSION. * ROOTS NOP LDA XEQT SET POINTER TO THIS STA IDPTR USER'S ID SEGMENT. CLA CLEAR "SCHEDULED FROM STA SLAVE REMOTE SESSION" FLAG. STA SEQNO CLEAR "EXECW SEQ #". * CHKFW CLA SIGNAL PGMAD ROUTINE. STA BUFR LDA IDPTR CMA,INA STA TEMP * JSB PGMAD FIND ID SEG ADDR OF NEXT ANCESTOR. DEF *+6 BUFAD DEF BUFR DEF TEMP NE$GATIVE ID SEGMENT ADDRESS. DEF TEMP1 DUMMY. DEF TEMP1 DUMMY. DEF FATHR RETURNED ID SEG ADDR OF FATHER. * LDA FATHR NEXT ANCESTOR WAITING? SZA,RSS JMP FPOOL NO. CHECK SESSION ID POOL. STA IDPTR YES. * LDB #LDEF SEARCH PROCESS NUMBER LIST (PNL) ADB N1 FOR ANCESTOR'S IDSEG ADDR. LDB B,I ADDR OF PNL HEADER. JSB LODWD IF NO PNL ENTRIES, NO SZA,RSS SENSE IN CHASING DOWN JMP FPOOL FATHER PROGRAMS. * PNLST JSB LODWD (CROSS) LOAD ADDR OF NEXT PNL ENTRY. SZA,RSS (A) = ADDR OF NEXT ENTRY. JMP CHKFW NOT FOUND. CHECK NEXT ANCESTOR. * LDB A POINT TO 5TH WORD IN PNL ENTRY. ADB K4 JSB LODWD (CROSS) LOAD 5TH WORD. CPA IDPTR DO IDSEG ADDRESSES MATCH? JMP CKNOD YES. GO CHECK NODE NUMBER. * ADB N4 NO (ALSO NO MATCH IF "BAD ENTRY" JMP PNLST BIT IS SET IN PNL ENTRY). * CKNOD ADB N2 POINT TO REMOTE NODE # IN PNL. LDA RQB+#DST GET REQUESTED NODE NUMBER. STA TEMP1 SAVE FOR COMPARE. JSB LODWD DOES PNL ENTRY HAVE EXPECTED CPA TEMP1 DESTINATION NODE NUMBER? JMP GETID YES. ADB N2 NO. KEEP LOOKING (FATHER HAS A JMP PNLST SESSION AT ANOTHER NODE). * GETID ADB K3 YES. GET ID OF ANCESTOR'S JSB LODWD SESSION AT REMOTE NODE. AND B377 IOR BIT15 SET "FATHER OWNS SESSION" BIT. STA TEMP * BLNAT CLA BUILD NETWORK ACCOUNT TABLE JSB #NASR ENTRY FOR THIS REMOTE NODE. SZB,RSS (B) = ADDR OF AVAIL. ENTRY. JMP NROOM NO ROOM. * LDA TEMP1 STORE NODE #. STA B,I INB LDA TEMP STORE SESSION ID WORD. STA B,I INB CLA CLEAR ADDR OF ASCII USER NAME. STA B,I INB LDA SEQNO STORE "EXECW S!EQ #", IF ANY. STA B,I * LDA TEMP DESTINATION SESSION ID. JMP ROOTS,I GO STORE ID IN REQUEST. * * SECOND, PERFORM ONE-TIME SEARCH FOR LOCAL SESSION ID IN THE SESSION ID * POOL (#POOL). IF THERE, THIS SESSION WAS CREATED FROM A REMOTE * NODE: IF THE USER'S DESTINATION NODE IS THE SESSION-ORIGINATING NODE, * LATCH USER ONTO THE REMOTE SESSION (IF ANY) AT THE ORIGINATING NODE * FOR INTER-SESSION COMMUNICATION. * FPOOL LDA $DSCS THIS NODE UNDER REMOTE SESSION? SSA JMP NONSM NO. CAN'T BE A SLAVE SESSION. * LDB #POOL GET ADDR OF SID POOL. SZB,RSS JMP PROCS GET OUT IF NONE. JSB LODWD GET NEG. # OF POOL ENTRIES. STA CNTR SAVE COUNTER. INB POINT TO WORD 1 OF 1ST ENTRY. * LOOP JSB LODWD (CROSS) LOAD A POOL SESSION ID. SSA,RSS JMP NEXT ENTRY NOT IN USE. AND B377 ENTRY IN USE: CPA LOCID SAME AS THE LOCAL SESSION ID? JMP RMSSN YES. NEXT ADB POOSZ NO. GO TO NEXT ENTRY. ISZ CNTR JMP LOOP JMP PROCS NOT FOUND. GO CHECK "PROCESS". * RMSSN INB FOUND. JSB LODWD RETRIEVE ORIGINATOR'S NODE # STA TEMP1 (BECOMES DESTINATION NODE). * CPA RQB+#DST MAKE SURE MASTER IS TALKING RSS TO NODE THAT CREATED SESSION! JMP SDFLT NO. GO TAKE DEFAULT SESSION. * INB RETRIEVE ORIGINATOR'S SESSION ID JSB LODWD (BECOMES DESTINATION SESSION). AND B377 STA TEMP * JSB LODWD RETRIEVE "EXECW SEQ #". ALF,ALF AND B377 STA SEQNO SAVE FOR NAT ENTRY. * CLA,INA SET "SCHEDULED FROM STA SLAVE REMOTE SESSION" FLAG. * JMP BLNAT GO FINISH UP. * * THIRD, SEE IF PROGRAM, OR * FOURTH, A FATHER PROGRAM WAS SCHEDULED IN A NON-SESSION NODE FROM * A SESSION NODE. IF FOUND, SET UP TO DIRECT MASTER REQUESTS BY THIES * USER TO THE ORIGINATOR'S SESSION. * NONSM LDA XEQT NO. SET POINTER TO THIS STA IDPTR USER'S ID SEGMENT. * NXTPG LDA IDPTR NEGATE ID SEG ADDR FOR CALL. CMA,INA STA TEMP * JSB PGMAD GET ASCII NAME FROM DEF *+6 INDICATED ID SEGMENT. DEF BUFR DEF TEMP DEF TEMP1 DEF TEMP1 DEF FATHR ALSO GET ID SEG ADDR OF FATHER. * LDB #POOL SEARCH #POOL FOR ASCII NAME. SZB,RSS JMP PROCS GET OUT IF NONE. JSB LODWD NEG. # OF POOL ENTRIES. STA CNTR SAVE COUNTER. INB POINT TO 1ST WORD OF 1ST ENTRY. STB ADDR * NLOOP JSB LODWD (CROSS) LOAD A NULL "POOL SID". SSA,RSS JMP NNEXT ENTRY NOT IN USE. * INB DOES THE ORIGINATING NODE JSB LODWD NUMBER MATCH THE MASTER CPA RQB+#DST USER'S DESTINATION NODE? RSS JMP NNEXT NO. * ADB K2 YES. MOVE NAME FROM #POOL ENTRY JSB LODWD IN S.A.M. TO LOCAL BUFFER. STA NAME INB JSB LODWD STA NAME+1 INB JSB LODWD STA NAME+2 * LDB NAMAD RBL BYTE ADDR OF NAME FROM POOL ENTRY. LDA BUFAD RAL BYTE ADDR OF USER'S NAME. JSB .CBT COMPARE 5-CHAR PROG NAMES. DEF K5 NOP JMP NSFND MATCH. NOP MISMATCH. NNEXT LDB ADDR MISMATCH. GO TO NEXT ENTRY. ADB POOSZ STB ADDR ISZ CNTR JMP NLOOP * LDA FATHR PROGRAM NAME NOT IN #POOL. SZA,RSS IS A FATHER PROGRAM WAITING? JMP PROCS NO. GO CHECK "PROCESS". STA IDPTR YES. JMP NXTPG GO CHECK FOR FATHER'S NAME IN #POOL. * NSFND LDB ADDR PROG NAME FOUND IN #POOL ENTRY. JMP RMSSN GO BUILD NAT ENTRY. * * FIFTH, IF THIS PROGRAM HAS THE SAME SCHEDULING LU AS SOME OTHER * PROGRAM (SAME "PROCESS"), S`AND THE OTHER PROGRAM HAS A PNL ENTRY * FOR A REMOTE SESSION AT THE DESTINATION NODE, DEFAULT THIS * PROGRAM TO THE EXISTING REMOTE SESSION FOR THIS "PROCESS". * (FOR PROGRAMS SCHEDULED WITHOUT WAIT.) * PROCS JSB LOGLU GET SCHEDULING LU. DEF *+2 DEF TEMP (DUMMY PARAM) * SZA,RSS JMP SDFLT IF ZERO, GO USE DEFAULT. STA TEMP SAVE SCHEDULING LU. * JSB LUTRU MAKE SURE ITS A SYSTEM LU. DEF *+3 DEF TEMP DEF REALU (USE FOR PNL ENTRY) * LDB #LDEF SEARCH PNL. ADB N1 LDB B,I ADDR OF PNL HEADER. PNLSR JSB LODWD GET ADDR OF NEXT PNL ENTRY. SZA,RSS JMP SDFLT NOT FOUND. GO TAKE DEFAULT. * LDB A POINT TO WORD 3 OF PNL ENTRY. ADB K2 JSB LODWD GET REMOTE NODE #. CPA RQB+#DST SAME AS USER'S DESTINATION? JMP *+3 YES. GO CHECK TERMINAL LU. ADB N2 NO. GO TO NEXT PNL ENTRY. JMP PNLSR STA TEMP1 SAVE NODE # FOR NAT ENTRY. INB POINT TO LOCAL TERMINAL LU. JSB LODWD GET TERMINAL LU. AND B377 CPA REALU SAME AS OUR SCHEDULING LU? RSS JMP PNLNX NO. GO CHECK NEXT PNL ENTRY. INB YES. BAD ID SEGMENT? JSB LODWD SSA,RSS JMP ALIVE NO. USE THIS SESSION. ADB N1 YES. IGNORE THIS PNL ENTRY PNLNX ADB N3 (COULD BE GOOD ONE AFTER THIS ONE). JMP PNLSR * ALIVE INB GET EXISTING REMOTE SESSION ID. JSB LODWD AND B377 STA TEMP JMP BLNAT GO BUILD A NAT ENTRY. * * SIXTH, USER DOES NOT HAVE AN ANCESTOR WITH A REMOTE SESSION. SET FLAG * FOR #MSDF TO WATCH FOR ASSIGNMENT OF DEFAULT SESSION BY THE REMOTE * SESSION MONITOR (RSM) WHEN THE REPLY ARRIVES (IF REMOTE NODE IS UNDER * SESSION MONITOR CONTROL). * SDFLT CLA MAKE SURE A NAT SLOT WILL JSB #NASR BE THERE WHEN WE NEED IT SZB,RSS (AVOID LOG-ON IF NOT). JMP NROOM ERROR - NO ROOM. * CLA,INA HAVE ROOM. GET DEFAULT SESSION. STA DFALT CLA JMP ROOTS,I RETURN. * RS01 LDA "RS" LDB "01" JMP ERTN NROOM LDA "RS" LDB "03" JMP ERTN RETRN ISZ #MSSM SET FOR P+2 NORMAL RETURN. ERTN JMP #MSSM,I RETURN TO CALLER. SKP * * PERFORM ONE-TIME RETRIEVAL OF DEFAULT SESSION ID (OR ZERO) * FROM THIS FIRST REPLY BUFFER AND BUILD AN ENTRY IN THE * NETWORK ACCOUNT TABLE (NAT), EVEN IF THERE IS NO SESSION * MONITOR AT THE REMOTE NODE. * MSDF LDA DFALT LOOKING FOR POSSIBLE ASSIGNMENT SZA,RSS OF DEFAULT SESSION? JMP CKRS1 NO. GO CHECK FOR "RS01". * * THE FOLLOWING CODE IN SUBROUTINE #MSDF IS ONLY DONE ONCE PER * USER PROGRAM EXECUTION. IF DEST NODE DOES NOT HAVE S.M. OR S.M. NOT * INITIALIZED, RETURNED DESTINATION SESSION ID WILL BE ZERO. * CLA YES. CLEAR THE FLAG. STA DFALT LDA RQB+#ENO IS SIGN BIT SET IN SSA,RSS IN ERROR NODE WORD? JMP MSDF1 NO. * LDA RQB+#SID YES. WAS A SESSION CREATED? AND B377 SZA JSB KILIT YES. GET RID OF IT JMP #MSSM,I AND RETURN. * MSDF1 CLA JSB #NASR BUILD NAT ENTRY SZB,RSS FOR THIS REMOTE NODE. JMP NOMOR NO ROOM. (SHOULD NOT HAPPEN.) * STB TEMP SAVE NAT ENTRY ADDRESS. LDA RQB+#DST STORE NODE # IN NAT ENTRY. STA TEMP,I STA TEMP1 SAVE FOR PNL ENTRY. ISZ TEMP LDA RQB+#SID STORE DEST SESSION ID WORD AND B377 IN NAT ENTRY STA TEMP,I (CAN BE ZERO). ISZ TEMP CLB SZA DEPENDING ON SESSION ID, LDB #DFSN STB TEMP,I STORE 0 OR ADDR OF ASCII "DEFAULT" ISZ TEMP IN NAT ENTRY. CLB STB TEMP,I CLEAR "EXECW SEQ #" IN NAT ENTRY. * SZA,RSS ID = 0 (NO SESSION MONITOR)? JMP #MSSM,I YES. RETURN. STA TEMP NO. SAVE SESSION ID FOR PNL. * CLA,INA INIT SCHEDULING SYSTEM LU STA REALU FOR PNL ENTRY. * JSB LOGLU GET SCHEDULING LU. DEF *+2 DEF TEMP2 (DUMMY). * SZA,RSS JMP CRNRQ IF ZERO, USE REALU = 1. STA TEMP2 * JSB LUTRU MAKE SURE WE HAVE DEF *+3 PHYSICAL SCHEDULING LU. DEF TEMP2 DEF REALU * CRNRQ JSB RNRQ BUILD PROCESS # LIST ENTRY. DEF *+4 WAIT FOR AVAIL LIST ENTRY SPACE. DEF LGW LOCK GLOBAL RN/WAIT/NO ABORT. DEF #TBRN TABLE-ACCESS RN. DEF TEMP2 DUMMY. JMP RESER ERROR. * JSB #RSAX ADD PNL ENTRY. DEF *+6 DEF K8 REQUEST CODE. DEF REALU LOGGING LU. DEF TEMP SESSION ID. DEF TEMP1 DESTINATION NODE. DEF RTBIT MPE/RTE BIT = RTE. * SSB,RSS SKIP IF ERROR. JMP #MSSM,I RETURN. * RESER JSB KILIT GET RID OF BAD REMOTE SESSION. LDA "DS" LDB "07" SEND "DS07" JMP ERRUP NOMOR JSB KILIT GET RID OF BAD REMOTE SESSION. LDA "RS" LDB "03" SEND "RS03" ERRUP DST RQB+#EC1 STORE IN REPLY BUFFER. LDA #NODE IOR BIT15 SET ENODE "ASCII ERROR" BIT. STA RQB+#ENO JMP #MSSM,I RETURN TO CALLER. SPC 3 * * CHECK FOR "RS01" ON REPLY (REMOTE SLAVE MONITOR COULD NOT * ATTACH TO THE DESTINATION SESSION ID). * CKRS1 LDA RQB+#ENO ASCII ERROR RETURNED? SSA,RSS JMP #MSSM,I NO. LDA RQB+#EC1 YES. "RS01"? CPA "RS" RSS JMP #MSSM,I NO. LDA RQB+#EC2 CPA "01" RSS YES. JMP #MSSM,I NO. * * "RS01" CAME BACK. RELEASE PNL (IF ANY) AND NAT ON THIS END, SINCE * THE REMOTE SESSION IS NO LONGER AVAILABLE. * LDA RQB+#SID GET THE "BAD" DEST SESSION ID. AND B377 STA TEMP ** JSB #RSAX RELEASE THE PNL ENTRY, EVEN IF A DEF *+4 FATHER PROGRAM OWNS IT. IGNORE DEF K10 ERROR IN CASE NO ENTRY EXISTS. DEF TEMP DESTINATION SESSION ID. DEF RQB+#DST DESTINATION NODE NUMBER. * LDA RQB+#DST FIND THE NAT ENTRY FOR JSB #NASR THE DESTINATION NODE. SZB,RSS JMP #MSSM,I NONE THERE. STB TEMP SAVE ADDR OF NAT ENTRY. * ADB K2 SEE IF THERE IS A NATX ENTRY LDB B,I (IF THIS IS REMAT). SZB,RSS JMP FLNAT NO. CPB #DFSN JMP FLNAT (SKIP "DEFAULT SESSION") * CLA YES. CLEAR THE NATX ENTRY. STA B,I LDA B INB JSB .MVW DEF K10 NOP * FLNAT LDB TEMP RELEASE THE NAT ENTRY. CLA STA B,I LDA B INB JSB .MVW DEF K4 NOP * JMP #MSSM,I ALL DONE. SKP * * ROUTINE TO PERFORM A NON-DLGOF LOG-OFF OF A SESSION THAT * CANNOT BE USED DUE TO A LOCAL ERROR. SIMILAR ROUTINE IN #UPSM & #DISM * (BUT BUILT FROM INFORMATION IN THE REPLY BUFFER). * KILIT NOP CLA RESET. STA LGF+#SEQ STA LGF+#MAR STA LGF+#MAC LDA K7 BUILD STREAM WORD. IOR #BREJ IOR BIT12 SET "LEVEL 1 & ABOVE" BIT. STA LGF+#STR LDA RQB+#SRC STORE SOURCE NODE NUMBER. STA LGF+#SRC LDA RQB+#DST STORE DESTINATION NODE NUMBER. STA LGF+#DST CLA,INA STORE UPGRADE LEVEL. STA LGF+#LVL LDA N2 SET TO BYPASS MESSAGE ACCOUNTING. STA LGF+#MAS LDA #MHCT SET HOP COUNT. STA LGF+#HCT LDA RQB+#SID STORE SOURCE SESSION ID ONLY. AND B1774 STA LGF+#SID LDA K2 STORE COMMAND LENGTH. STA LGF+#CML LDA "XX" STORE "XX" COMMAND. STA LGF+#CMS CCA STORE "NO-REPLY" REQ CODE. STA LGF+#LGC LDA RQB+#SID STORE SESSION ID TO BE LOGGED OFF. AND B377 STA LGF+#LNL * JSB #NRVS SEARCH NRV (LU RETURNED IN (A)). DEF *+4 DEF LGF+#DST NODE # FOR SEARCH. DEF TEMP DUMMY. DEF TEMP1 UPGRADE LEVEL OF DEST. NODE. JMP KILEX ERROR. NODE NOT IN NRV. * IOR BIT15 BYPASS SESSION SST. STA LU SAVE COMMUNICATIONS LINK LU. LDB #GRPM GRPM'S CLASS NUMBER. STB CLASS * LDA #LEVL IS LOCAL UPGRADE LEVEL CMA,INA HIGHER THAN ADA TEMP1 THAT OF DEST. NODE? SSA,RSS JMP WRITE NO. NO CONVERSION NEEDED. * LDA #OTCV YES. SEND TO MESSAGE CONVERTER. STA CLASS CLA STA LU * WRITE LDA L#LNL GET LENGTH OF REQUEST. ADA C#LSZ BUMP FOR LOCAL BUFFER. STA LEN CCB ADB @RQB ADB A (B) -> LAST WORD OF REQUEST. LDA B,I IOR BIT8 SET "DS STATUS" BIT. STA B,I * JSB XLUEX DO CLASS WRITE/READ TO DEST. LU. DEF *+8 DEF CLS20 NO ABORT. DEF LU DEST. LU & CONTROL WORD. DEF TEMP NO DATA. DEF K0 @RQB DEF LGF REQUEST BUFFER. DEF LEN REQUEST LENGTH. DEF CLASS I/O CLASS. NOP IGNORE ERROR. * KILEX JMP KILIT,I RETURN. * LGF BSS #LNL+1 "NO-REPLY" LOGOFF REQ BUFFER. BSS 2 "APPENDAGE" AREA. LU NOP OCT 10100 (LU+1) "Z" BIT & "WRITE" INDICATOR. SKP * * SUBROUTINE TO FIND ENTRY IN NETWORK ACCOUNT TABLE (NAT) * FOR A GIVEN NODE NUMBER. FIND AVAILABLE ENTRY BY SPECIFYING * NODE = 0. * * (A) = NODE NUMBER * JSB #NASR * (A) = SESSION ID * (B) = ADDR OF ENTRY, ZERO IF NOT FOUND * #NASR NOP STA NDNUM SAVE NODE NUMBER. LDB #NAT FWA NETWORK ACCOUNT TABLE. LDA NAT# SET FOR # ENTRIES. STA CNTR * SCAN LDA B,I GET NODE F {ROM NAT ENTRY. CPA NDNUM COMPARE TO REQUESTED NODE. JMP FOUND FOUND. * ADB K4 KEEP LOOKING. ISZ CNTR JMP SCAN * CLB NOT FOUND: (B) = 0. CLA JMP #NASR,I * FOUND LDA B FOUND: (B) = ENTRY ADDR. INA LDA A,I (A) = SESSION ID WORD. JMP #NASR,I * SPC 3 * * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM. * LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE. RAR,SLA SKIP IF NON-DMS. JMP *+3 DMS. GO EXECUTE XLA. LDA B,I NON-DMS. PICK UP SAM WORD. JMP LODWD,I RETURN. XLA B,I CROSS-LOAD SAM WORD. JMP LODWD,I RETURN. SKP * CONSTANTS AND STORAGE. * K0 DEC 0 K1 DEC 1 K2 DEC 2 K3 DEC 3 K4 DEC 4 K5 DEC 5 K7 DEC 7 K8 DEC 8 K10 DEC 10 K254 DEC 254 B77 OCT 77 B377 OCT 377 BIT8 OCT 400 BIT12 OCT 10000 BIT15 OCT 100000 B1774 OCT 177400 N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 "01" ASC 1,01 "03" ASC 1,03 "07" ASC 1,07 "DS" ASC 1,DS "XX" ASC 1,XX "RS" ASC 1,RS LGW OCT 40002 POOSZ DEC 7 SIZE OF #POOL ENTRY. SLAVE OCT 0 SEQNO NOP SAVA NOP CLASS NOP LEN NOP CLS20 OCT 100024 NXTAD NOP FATHR NOP REALU NOP ADDR NOP RTBIT NOP LOCID OCT -1 NDNUM NOP POOLA NOP CNTR NOP TEMP NOP TEMP1 NOP TEMP2 NOP NAMAD DEF NAME NAME BSS 3 BUFR BSS 3 IDPTR NOP DFALT NOP XEQT NOP #OVR OCT 0 SPECIAL OVERRIDE FLAG. D$OVR EQU #OVR #DFSN DEF DFN DFN ASC 22,DEFAULT SESSION L#LNL ABS #LNL+1 C#LSZ ABS #LSZ SPC 5 * * NETWORK ACCOUNT TABLE (NAT). 16 ENTRIES: * NODE #, SESSION ID, ADDR OF ASCII USER NAME, RESERVED WORD. * NAT# DEC -16 NEGATIVE # ENTRIES. #NAT DEF *+1 ADDR OF NETWORK ACCOUNT TABLE. REP 64 OCT 0 * BSS 0 SIZE OF #MSSM. * END 8xvrrx h 91750-18022 2013 S C0122 &#NRVS              H0101 jASMB,R,Q,C HED <#NRVS> NRV SEARCH ROUTINE NAM #NRVS,30 91750-1X022 REV 2013 800407 ALL * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * ENT #NRVS * * EXT #MSTO,#NCNT,$OPSY,#NRV EXT $LIBR,$LIBX,.ENTP EXT #RR7 * * NAME: #NRVS * SOURCE: 91750-18022 * RELOC: 91750-1X022 * PGMR: LYLE WEIMAN APR '79 ** ** * * * #NRVS CALLING SEQUENCE: * * JSB #NRVS * DEF RTN * DEF NODE NODE NUMBER FOR SEARCH * [DEF TIMOT] RETURNED: MASTER TIME-OUT (OVERRIDE OR #MSTO) * [DEF FMT#] RETURNED: UPGRADE LEVEL OF ] * [DEF NAYBR] RETURNED: NON-ZERO IF NODE IS NEIGHBOR TO LOCAL, * [DEF NODE#] RETURNED: NODE NUMBER, WHEN PARAMETER * ON ENTRY CONTAINS -LU * * * * NOTE 1: WHEN "NEIGHBOR ADDRESSING" IS USED, "DS04" ERRORS CAN * OCCUR IF NO ENTRY IN THE NRV HAS BEEN IDENTIFIED SPECIFICALLY * AS THE NEIGHBOR ON THE LU SPECIFIED. * SKP * NRV TABLE FORMAT: * * +--------------------------+ * #NRV----> ! CPU NUMBER (16-BITS) ! * +--------------------------+ * ! TIME-OUT ! XXXX !LEVEL # ! * ! (8 BITS) !4 BITS!4 BITS ! * +----------+---------------+ * !RESERVED!N! COMM-LINK LU ! * !(7 BITS)! ! (8 BITS) ! * +----------+---------------+ * * N = 1 IF CPU IS NEIGHBOR TO LOCAL NODE, ELSE 0 * * LEVEL # = 0 IF NODE IS DS/1000 (91740, * 1 " " " DS/100-IV (91750A), ETC. * * XXXX = RESERVED FOR FUTURE USE SPC 2 * ARGUMENTS LIST: NODE NOP REMOTE NODE NUMBER, OR - LU TIMOT NOP RETURNED:MASTER T.O. OVERRIDE, OR #MSTO FMT# NOP RETURNED: REMOTE NODE'S UPGRADE LEVEL NAYBR NOP RETURNED: NEIGHBOR(#0)/NON-NEIGHBOR(0)/FLAG NNODX NOP RETURNED: REMOTE NODE # ("NEIGHBOR" ADDRESSING ONLY) SPC 1 #NRVS NOP ENTRY/EXIT JSB $LIBR GO PRIVILEGED NOP JSB .ENTP DEF NODE FOR PARAMETERS & RETURN POINT. INT JSB INIT LDA #NCNT INTITIALIZE CNTR STA TEMP CLA,INA INITIALIZE POSITION COUNTER STA POS * * CONVERT DESTINATION NODE TO LU * LDA NODE,I SSA ABSOLUTE DESTINATION CODE ? (NEIGHBOR) JMP ABS YES, SEARCH FOR NEIGHBOR NODE. FDLU STA NODE LDB #NRV * LOOP JSB LODWD GET A CPU # CPA NODE IS IT THE GOOD ONE ? JMP CPUFD YES ISZ POS BUMP POSITION NUMBER ADB NRVSZ POINT TO NEXT NODE IN TABLE ISZ TEMP END OF TABLE ? JMP LOOP NO, CONTINUE * * NODE NOT FOUND. TAKE ERROR EXIT. * DS04 EQU * LDB "04" JMP EXIT2 TAKE ERROR RETURN * * * HERE WHEN GIVEN A NEGATIVE NODE # (- LINK LU) ABS EQU * CMA,INA MAKE IT >0 JSB #RR7 FIND NEIGHBOR IN LINK VECTOR RSS NOT FOUND, A = LU JMP FDLU FOUND, A = NODE IOR B400 SET "NEIGHBOR" BIT STA NODE SAVE LDB #NRV ADB D2 ADVANCE TO LU WORD LOOP2 EQU * JSB LODWD OBTAIN LU WORD AND =B777 MASK LU & "NEIGHBOR" BIT CPA NODE MATCH THE ONE WE WANT? JMP ABSF YES--FOUND IT ISZ POS NO, BUMP POSITION # ADB NRVSZ ADVANCE POINTER ISZ TEMP ' END OF LOOP? JMP LOOP2 NO, CONTINUE JMP DS04 NOT FOUND. * ABSF EQU * HERE WHEN NEIGHBOR NODE # FOUND ADB M2 BACK UP TO NODE NUMBER JSB LODWD OBTAIN NODE NUMBER STA NODE * CPUFD EQU * HERE WHEN NODE HAS BEEN LOCATED IN NRV INB BUMP TO TIME-OUT/FORMAT # WORD JSB LODWD FETCH TIME-OUT & FORMAT # STA TEMP SAVE BOTH PARTS AND =B17 ISOLATE MESSAGE FORMAT NUMBER STA FMT#,I RETURN TO CALLER LDA TEMP RECOVER NRV WORD 2 ALF,ALF ROTATE TIME-OUT FIELD TO LOW HALF AND =B377 MASK SZA,RSS MASTER TIME-OUT OVERRIDE? LDA #MSTO NO, USE GENERAL TIME-OUT STA TIMOT,I RETURN MASTER TIME-OUT INB BUMP TO WORD JSB LODWD FETCH THE COMMUNICATION LINK LU STA TEMP AND =B377 ISOLATE STA COMLU RETURN TO CALLER LDA TEMP SET "NEIGHBOR" INDICATOR, IF NODE IS A NEIGHBOR AND B400 STA NAYBR,I LDA NODE STA NNODX,I RETURN REMOTE NODE # IF NECESSARY ISZ #NRVS TAKE NO-ERROR EXIT SPC 2 EXIT EQU * LDB POS RETURN WITH POSITION # IN (B) * EXIT2 EQU * CLA INITIALIZE DEFAULT- STA FMT# ABLE PARAMETERS STA TIMOT FOR NEXT CALL STA NAYBR STA NNODX LDA COMLU RETURN WITH (LU) IN (A) JSB $LIBX RESTORE MEMORY PROTECT & RETURN TO CALLER DEF #NRVS SPC 2 SPC 2 * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM LODWD NOP MOD1 JMP X1 (NOP) IF DMS SYSTEM XLA 1,I CROSS-LOAD SAM WORD JMP LODWD,I X1 LDA 1,I NON-DMS. PICK UP SAM WORD JMP LODWD,I RETURN * * SUBROUTINE TO CONFIGURE LOAD/CROSS-LOAD INSTRUCTION * INIT NOP CLB LDA $OPSY RAR,SLA STB MOD1 STB INT JMP INIT,I * * DATA AXREA * * EQUATE TEMPORARY STORAGE LOCATIONS TO LOCATIONS IN * THE EXECUTED-ONE-TIME-ONLY CONFIGURATION CODE AREA, * TO SAVE A LITTLE MEMORY. * TEMP EQU INIT TEMPORARY STORAGE POS EQU INIT+1 COMLU EQU INIT+2 * NRVSZ DEC 3 # WORDS PER NRV ENTRY "04" ASC 1,04 M2 DEC -2 D2 DEC 2 B400 OCT 400 END v ir 91750-18023 2013 S C0122 &#PKUP              H0101 `ASMB,Q,C,N HED <#PKUP> PICK UP SCHEDULE PARAMS * (C) HEWLETT-PACKARD CO. IFN ***** NAM #PKUP,7 91750-1X023 REV.2013 790516 ALL EXCEPT RTE-M XIF ***** IFZ ***** NAM #PKUP,7 91750-1X024 REV.2013 790516 RTE-M XIF ***** SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: #PKUP *SOURCE: 91750-18023 * RELOC: 91750-1X023 * PGMR: DMT LST ************************** #PKUP ************************* * * * SOURCE: 91750-18023 * * * * BINARY: 91750-1X023 (N-OPTION FOR NON-RTE-M NODES) * * (Z-OPTION FOR RTE-M NODES) * * * * PROGRAMMER: DAVE TRIBBY * * * * FEBRUARY 13, 1979 * * * ************************************************************** SPC 1 * * SUBROUTINE TO RETRIEVE UP TO 5 SCHEDULING PARAMETERS. * * CALLING SEQUENCE: JSB #PKUP * DEF *+4 * DEF MASK NUMBER & TYPE OF PARAMETERS * DEF ARRAY RETURNED INFORMATION ARRAY * DEF DEFLU INTERACTIVE LU NO. FOR USER * * NOTE: B-REGISTER MUST NOT BE MODIFIED BEFORE CALLING #PKUP * BECAUSE IT PICKS UP THE SCHEDULING PARAMETER FROM RTE. * * MASK HAS THE FOLLOWING FORMAT: * BITS 8-10 (LEFT BYTE): NUMBER OF PARAMETERS TO RETRIEVE * BIT 0: 1 IF 1ST PARAMETER IS TO BE RETURNED IN NAMR FORMAT (10 WORDS) * 0 IF 1ST PARAMETER IS TO BE RETURNED IN A SINGLE WORD * BITS 1-4: SAME INFORMATION FOR PARAMETERS 2-5 * EXAMPLE: 5 PARAMETERS, FIRST IS NAMR, REST ARE SINGLE WORDS: * MASK BYT 5,1 * * DEFAULT LU IS THE FIRST PARAMETER, IF INTERACTIVE, ELSE LOGLU VALUE. * SPC 1 EXT IFTTY,.ENTR,.MVW,RMPAR UNL IFN ***** LST EXT NAMR,LOGLU,EXEC UNL XIF ***** LST ENT #PKUP * A EQU 0 A-REGISTER B EQU 1 B-REGISTER SUP SPC 5 #PKUP NOP ENTRY POINT. STB SAVEB SAVE B-REGISTER. CLA CLEAR PARAMETER ADDRESSES. STA MASK STA ARRAY STA DEFLU LDA #PKUP SET UP FOR STA RETRN .ENTR CALL. JMP RETRN+1 SPC 1 MASK NOP PARAMETERS. ARRAY NOP DEFLU NOP RETRN NOP JSB .ENTR DEF MASK * LDA ARRAY IF SECOND PARAM WAS SZA,RSS NOT SPECIFIED, JMP RETRN,I RETURN. * LDA MASK,I GET MASK WORD. STA LMASK SAVE LOCALLY. ALF,ALF AND B7 CMA,INA STA PCNT SAVE NEG # PARAMS. SZA,RSS IF ZERO, JMP ALDON RETURN. * LDB SAVEB RESTORE B-REGISTER. JSB RMPAR PICK UP DEF *+2 SCHEDULING PARAMS. @RPRM DEF RPRM LDA RPRM SZA,RSS IF FIRST PARAM IS 0, JMP SETLU SET TO LOGLU. STA LDFLU STORE DEFAULT LU. AND HB377 IF LEFT BYTE IS NOT SZA ZERO, MUST BE ALPHABETIC. JMP SETLU JSB IFTTY IF NON-INTERACTIVE DEF *+2 LU NUMBER, DEF LDFLU USE LOGLU. / SSA JMP GTSTR * FIRST PARAMETER IS NON-INTERACTIVE. SET DEFAULT LU VIA LOGLU. SETLU EQU * UNL IFN ***** LST JSB LOGLU PICK UP LOG LU. DEF *+2 DEF #PKUP UNL XIF ***** LST UNL IFZ ***** LST CLA,INA USE 1 FOR LOGLU. UNL XIF ***** LST STA LDFLU STORE AS DEFAULT. * GTSTR EQU * UNL IFN ***** LST JSB EXEC PICK DEF *+5 UP DEF D14 COMMAND DEF D1 STRING. DEF STRNG DEF DN80 STB STRLN SAVE LENGTH. * SZB IF NO STRING WAS PASSED, JMP STPNT UNL XIF ***** LST LDA @RPRM SET UP POINTER STA PNTR1 TO RMPAR PARAMS. UNL IFN ***** LST JMP GTPR1 GO TO RMPAR PARAM LOOP. * STPNT CLA,INA POINT TO STA PNTR FIRST COLUMN. * JSB PNAMR SKIP OVER JSB PNAMR "RU,," * JSB PNAMR PARSE PARAMETER. CPA "NO" IF "NO", SKIP OVER IT. SPC 2 * LOOP TO PICK UP SPECIFIED NUMBER OF PARAMETERS. GTPRM JSB PNAMR LST LDB LMASK POSITION PARAMETER MASK ERB BIT INTO E-REG AND SAVE STB LMASK SHIFTED MASK. SEZ IF NAMR FORMAT IS DESIRED, JMP MVNAM GO MOVE IT. * STA ARRAY,I STORE SINGLE WORD. ISZ ARRAY BUMP POINTER. JMP LPEND GO TO END OF LOOP. * * MOVE 10-WORD NAMR ARRAY. MVNAM LDA @NAMR SOURCE ADDR. LDB ARRAY DESTINATION. JSB .MVW DEF D10 MOVE 10 WORDS. NOP STB ARRAY UPDATE DEST. POINTER. * LPEND ISZ PCNT BUMP PARAM. COUNTER. JMP GTPRM IF MORE, GET NEXT PARAMETER. JMP ALDON OTHERWISE, ALL DONE. SPC 2 * * THIS ĖSECTION MOVES RMPAR PARAMS WHEN NO STRING WAS SENT. * UNL XIF ***** LST GTPR1 LDA PNTR1,I ISZ PNTR1 BUMP POINTER. JSB STRWD STORE VALUE. LDB LMASK POSITION PARAMETER MASK ERB BIT INTO E-REG AND SAVE STB LMASK SHIFTED MASK. SEZ,RSS IF NOT NAMR FORMAT, JMP LPEN2 GO TO END OF LOOP. * UNL IFZ ***** LST LDB PNTR1 IF THIS ISN'T CPB @RPM1 THE 1ST PARAM, SSA OR IF NEGATIVE, JMP NUMER FORCE TO NUMERIC. AND HB377 CHECK FOR SZA ASCII. JMP ASCII * UNL XIF ***** LST NUMER LDA DN2 CLEAR STA COUNT TWO JSB CLR WORDS. CLA,INA STORE 'NAMR' JSB STRWD STATUS WORD. LDA DN6 CLEAR STA COUNT LAST 6 JSB CLR WORDS. * LPEN2 ISZ PCNT BUMP PARAM. COUNTER. JMP GTPR1 IF MORE, GET NEXT PARAMETER. SPC 2 * ALL DONE SETTING UP ARRAY. ALDON LDA LDFLU STORE STA DEFLU,I DEFAULT LU. JMP RETRN,I RETURN TO CALLER. SKP UNL IFN ***** LST * SUBROUTINE TO CALL NAMR PARSE ROUTINE * CALLING SEQUENCE: * JSB PNAMR * * PNAMR NOP ENTRY POINT JSB NAMR CALL DEF *+5 NAMR @NAMR DEF NAME ROUTINE. DEF STRNG DEF STRLN DEF PNTR LDA NAME LOAD PARAM. JMP PNAMR,I RETURN. SPC 2 NAME BSS 10 NAMR PARAMETERS. PNTR NOP COLUMN POINTER. STRNG BSS 40 SCHEDULING STRING. STRLN NOP STRING LENGTH (BYTES). UNL XIF ***** LST UNL IFZ ***** LST * FIRST PARAMETER IS ASCII. SET UP 'NAMR' FORMAT. * ASCII LDA RPRM+1 GET SECOND PARAM. SZA,RSS IF ZERO, LDA BLANK USE BLANK. JSB STRWD STORE. LDA RPRM+2 GET THIRD PARAM. SZA,RSS IF ZERO, LDA BLANK USE BLANK. JSB STRWD STORE. LDA B27 STORE 'NAMR' JSB STRWD STATUS WORD LDA RPRM+3 AND LAST JSB STRWD TWO PARAMS. LDA RPRM+4 JSB STRWD LDA DN4 CLEAR LAST STA COUNT 4 NAMR WORDS. JSB CLR * CLEAR REST OF REQUESTED PARAMETERS. ISZ PCNT IF NONE, RSS JMP ALDON ALL DONE. * CLA A-REG COUNTS # OF WORDS. LDB LMASK GET BIT MASK. NXTBT ERB SHIFT BIT INTO E-REG. SEZ IF 'NAMR' FORMAT ADA DN9 ADD 9 TO COUNT. ADA DN1 (OTHERWISE, JUST 1.) ISZ PCNT DONE? JMP NXTBT NO--STAY IN LOOP. STA COUNT YES--STORE WORD COUNT. JSB CLR CLEAR THOSE WORDS. JMP ALDON RETURN TO CALLER. UNL XIF ***** LST SPC 2 * SUBROUTINE TO CLEAR "COUNT" WORDS IN "ARRAY" * CLR NOP ENTRY. CLA CLEAR. CLOOP JSB STRWD STORE. ISZ COUNT DONE? JMP CLOOP NO! JMP CLR,I RETURN. SPC 2 * SUBROUTINE TO STORE A-REG IN ARRAY STRWD NOP ENTRY STA ARRAY,I STORE. ISZ ARRAY BUMP POINTER. JMP STRWD,I RETURN. SPC 2 COUNT NOP NUMBER OF WORDS TO CLEAR. BLANK ASC 1, SPC 5 *** CONSTANTS *** * DN2 DEC -2 DN6 DEC -6 D10 DEC 10 HB377 BYT 377,0 B7 OCT 7 UNL IFZ ***** LST DN1 DEC -1 DN4 DEC -4 DN9 DEC -9 B27 OCT 27 @RPM1 DEF RPRM+1 UNL XIF ***** LST UNL IFN ***** LST D1 DEC 1 D14 DEC 14 DN80 DEC -80 "NO" ASC 1,NO V$" UNL XIF ***** LST SPC 1 *** MISCL. STORAGE *** * LMASK NOP LOCAL PARAM. MASK. LDFLU NOP LOCAL DEFAULT LU. PCNT NOP PARAMETER COUNT. PNTR1 NOP POINTER TO PARAMETER. SAVEB NOP B-REG HOLDER. RPRM BSS 5 'RMPAR' PARAMETERS. SPC 1 BSS 0 *** SIZE OF SUBROUTINE *** SPC 1 END $ j u 91750-18024 2013 S C0122 &RDBAM &RDBAM             H0101 ASMB HED RDBAM - REMOTE DATA BASE ACCESS MONITOR NAM RDBAM,148,30 91750-16024 REV.2013 800523 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18024 * RELOC: 91750-16024 * * * ******************************************************************* * * * * RDBAM is the Remote Data Base Access Monitor. It performs the following * sequence of operations: * * 1) When first scheduled (by LSTEN or UPLIN) get class number from first * parameter, and store in the * program's memory space. The second scheduling parameter is the * error LU (first time through). Set it to 1. * * 2) Make sure the Remote Data Base Access Program (RDBAP) resides in * the system. If not, send a message to the log device. * * 3) Check the RDBAP table to see if any RDBAP copies were previously * scheduled. If so, for each copy of RDBAP scheduled, if copy is * not up, release its class, remove its entry from the table, and * remove the copy from the system. * * 4) Do a class GET on the class from 1 to await a Remote Data Base Access * (RDBA) request. * * 5) When a request is received, make sure the request buffer is no larger * than our maximum buffer size (now 30 words). If a zero length re- * quest, flush it from the class and return to 4. If request size okay * bring it into the program memory. * * 6) If RDBA Index of request a -1 (negative one), this is a special * clean-up request from the DS software. The RDBA mode word contains * either the first two characters of the master program's name or a * negative inteDger. * * A) If the mode word contains a positive value (two characters): * * I ) Look for master's entry in RDBAP copy scheduling table. * If found, then if RDBAP copy still up, reroute the mes- * sage to it and return to 4. * * II ) If entry found but RDBAP copy is in a bad state, remove * the copy from the system, release its class number, and * remove its entry from the scheduling table. * * III) Flush request from our class (through PLOG if enabled) * and send a successful reply to requestor. * * IV ) Return to 4. * * B) Mode word contains a negative number. For each RDBAP copy * scheduled: * * I ) If copy dormant or on its class get, abort it and remove * it from the system. * * II ) Release the copy's class number and remove it from the * scheduling table. * * III) Go to 5-A-III. * * 7) If RDBA Index of request is a -2 (negative two), this is a "remove * me, I'm done" request from an RDBAP copy. The RDBA mode word con- * tains the copy's index into the RDBAP copy scheduling table. Deter- * mine the copy's entry in the scheduling table using this index. * Remove the copy from the system, release its class and remove it * from the scheduling table. Flush the request from our class and * return to 4. * * 8) All other Indices are RDBA requests. Get the RDBA index and bound * bound check it. (Each IMAGE call has its own Index, for instance * DBOPN's Index is 36.) * * 9) If Index is not within bounds, flush request from class (through * PLOG if enabled) and send a reply with the proper DS error code, * then go to 4. * * 10) If the Index is 36 (i.e. DBOPN call) then: * * A) See if there is an RDBAP copy scheduled for this master. If * so, go to 11. * * Q B) If no copy scheduled, then get next free entry in RDBAP copy * scheduling table. If no free entry, flush request from class * (through PLOG if enabled), send a reply with the proper DS * error code, then return to 4. * * C) Ask C.RP to bring up a new copy of RDBAP suffixing the copy * with the ASCII equivalent of the copy's index into the schedul- * ing table plus one. If C.RP is unsuccessful, flush the request * from our class (through PLOG if enabled), send a reply with * the proper DS error code, then return to 4. * * D) Allocate a class for this copy of RDBAP. If any error, remove * RDBAP copy from system, flush the request from our class (through * PLOG if enabled), send a reply with the proper DS error code, * then return to 4. * * E) Schedule the RDBAP copy sending it its class, its index, and * our class. If unsuccessful, remove the RDBAP copy from the * system, release its class, remove its scheduling table entry, * flush the request from our class (through PLOG if enabled), * send a reply with the proper DS error code, then return to 4. * * F) Go to 12. * * 10) If the RDBA Index is not 36, the index into the scheduling table * for this master's copy of RDBAP is in the request buffer. Pick * it up and determine the address of the copy's entry in the table * with it. * * 11) Make sure the RDBAP copy is still up. If not, remove it from the * system, release its class number, remove it from the scheduling * table, flush the request from our class (through PLOG if enabled) * send a reply with the proper DS error code, then return to 4. * * 12) Transfer the request from our class to the RDBAP copy's class. * * 13) Go to 4. * SKP ********************************************************************** ***  *** * Standard DS/1000 equates * *** *** *$ * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * *$ *** *** ********************************************************************** RQBUF BSS 30 ********************************************************************** * * * DS/1000 RDBA Communications consist of two descriptive buffers: * * 1) Request buffer * * 2) Reply buffer * * These two static buffers are as described below. * * * ********************************************************************** *** *** * * * Request buffer - one buffer of from 12 to 21 words per RDBA call * * * *** *** RBSTR EQU RQBUF+#STR DS/1000 stream word RBSEQ EQU RQBUF+#SEQ DS/1000 sequence number RBSRC EQU RQBUF+#SRC DS/1000 source node number RBDST EQU RQBUF+#DST DS/1000 destination node number RBIDX EQU RQBUF+#REQ RDBA call Index RBMOD EQU RQBUF+#REQ+1 RDBA call mode RBID EQU RQBUF+#REQ+2 RDBA call item or set number * or for a DBOPN, the level code word RBITM EQU RQBUF+#REQ+3 Search item number for DBFND RBMRT EQU RQBUF+#REQ+5 For DBOPN, the max. return RT size RBLEN EQU RQBUF+#REQ+6 Word size of ibase parameter RBBAS EQU RQBUF+#REQ+7 Ibase parameter * MAXRQ DEC 30 Maximum request buffer length *** *** *** *** * * * Reply buffer - one buffer of 13 words per RDBA call (standard re- * * ply header only sent back by RDBAM upon an -error). * * * *** * * RBSTR EQU RQBUF+#STR DS 1000 stream word * RBSEQ EQU RQBUF+#SEQ DS/1000 sequence number * RBSRC EQU RQBUF+#SRC DS/1000 source node number * RBDST EQU RQBUF+#DST DS/1000 destination node number RBEC1 EQU RQBUF+#EC1 DS/1000 1st error code word RBEC2 EQU RQBUF+#EC2 DS/1000 2nd error code word RBEC3 EQU RQBUF+#ENO DS/1000 error node number upon an error * RPLEN DEC 13 Standard reply header length *** *** ********************************************************************** SKP ********************************************************************** * * * RDBAP copy scheduling table * * The scheduling table resides in the module RD.TB in SSGA. It * * consists of information necessary for the co-ordination of RDBAP * * copy scheduling and request routing. Further detail follows. * * * ********************************************************************** *** *** * * * RDBAP copy scheduling table - one 8 word entry per RDBAP copy * * * *** *** BPSIZ DEC 8 Entry size * BPID# DEC 0 Master program's name - 3 words BPNOD DEC 3 Master's node number BPNAM DEC 4 Name of RDBAP copy - 3 words BPCLS DEC 7 Class number for RDBAP copy *** *** ***  *** * * * The first two words in this subroutine contain: * * 1) the number of copies of RDBAP currently scheduled * * 2) the number of entries in the scheduling table * * * * The scheduling table starts in the third word of the module. * * * *** *** * * ENT RDBAM EXT #PLOG,#RQUE,.CMW,#GETR,#LOGR,DTACH EXT .ENTR,.MVW,C.RP,EXEC,RD.TB,RDEXT,RMPAR * A EQU 0 B EQU 1 * * Get our class number and set its save buffer, no deallocate bits. * Then set the error lu to 1. * RDBAM NOP JSB RMPAR DEF *+2 DEF CLASS * * Detach from a session. If RDBAM was loaded under a session, it will * belong to that session. * JSB DTACH DEF *+1 * * Set the error LU to the console LU1. * CLA,INA STA ERLU * * Ask C.RP to check to make sure that RDBAP is there. * LDB RDBAP CLA,INA JSB C.RP JSB BAPER Not there, warn user. * * If C.RP had to duplicate the ID, ask it to undo the find. The A regi- * ster will be non-zero in this case. * SZA,RSS JMP CHK0 LDB RDBAP CLA JSB C.RP NOP Ignore errors. * * See if we are being rescheduled after having been aborted. If so, the * count of RDBAP copies in use may be non-zero, and the states of these * copies should be checked. * CHK0 LDA RD.TB Entry point in SSGA is RD.TB LDB A,I SZB,RSS JMP GET No copies scheduled. * * For each copy of RDBAP scheduled, make sure it is still up, i.e. it is * non-dormant. This is done by trying to schedule it without wait. If * the schedule works Nor aborts, the copy is dormant and should be removed * from the scheduling table. * CMB,INB Two loop counters: STB CNTR1 1) -(# of copies scheduled) INA LDB A,I 2) -(# of entries in table) SZB,RSS # of entries = 0? JMP GET Nothing we can do about it. CMB,INB STB CNTR2 * INA A -> scheduling table. CLB,INB Set index in scheduling STB INDEX table to one. * CHK1 STA ENTAD LDB A,I If the entry is not empty, SZB,RSS JMP CHK4 JSB SCHED SCHED will schedule it DEF *+1 for us. JMP CHK2 Schedule aborted. * AND LOFOR Low four bits of A reg. = SZA status of copy at schedule. JMP CHK3 If zero, copy was dormant * CHK2 JSB TERM terminate it JSB RID and remove it from table. * CHK3 ISZ CNTR1 Done with all scheduled copies? RSS JMP GET Yes - go to class get. * CHK4 ISZ INDEX Update index into table LDA ENTAD Get next entry's address ADA BPSIZ ISZ CNTR2 and continue for all JMP CHK1 entries in table. * * Do a class GET on our passed class to await an RDBA request. The get * allows abort since an abort indicates our class number is incorrect * and after aborting, UPLIN will bring us back with the correct class * number, hopefully. If UPLIN cannot bring us back something is dras- * tically wrong anyway. * * If this is a zero-length request, then just flush it from the system. * Else, check the length of the request to make sure it is within the * upper bound of an RDBA request buffer * * * The request length is okay. Move the request from system memory into * our own buffer. * * * Set the clean-up flag to FALSE * GET CLA STA FLAG * * * JSB #GETR DEF *+6 DEF CLASS DEF RQBUF DEF MAXRQ DEF MNAME,I DEF D3 JMP CLERR Error return, class must be bad * * Save the request buffer length and the data buffer length * STA RQLEN STB DALEN SKP * * Check to see if this is a special clean-up request from the DS software. * The RDBA Index for such a request is -1 (negative one). * LDA RBIDX INA,SZA JMP RDBA7 Not a clean-up request. * * This is a clean-up request, get the master's name and node # from * the request (next four words after Index). If the first word of the name * is > zero, get its associated RDBAP copy's entry in the RDBAP table. If * the copy is up and running, send it a clean-up request, else do the * clean-up for it. * * If the first word of the name is < zero, this is a shut down clean-up, * abort all RDBAP copies. * LDA RBMOD SSA JMP CLNA Shut down clean-up. * * Single copy clean-up. Get the copy's entry in the scheduling table. * JSB SERCH DEF *+3 DEF RBMOD DEF RBMOD+3 JMP CLN3 No entry for it found. RSS Entry found JMP CLN3 No entry for it found. * * Copy for master found, see if it is dormant by scheduling it. If it * is dormant the schedule should either abort or succeed. * JSB SCHED DEF *+1 JMP CLN2 Schedule aborted. * AND LOFOR Check schedule state. CMA,INA If state is 1, 2, or 3 INA,SZA,RSS JMP CLN1 copy is still up. INA,SZA,RSS JMP CLN1 INA,SZA JMP CLN2 * * Copy is still there, ask SWTCH to switch the clean-up message from our * class to its. * CLN1 JSB SWTCH RSS Error return, clean-up the copy ourselves. JMP GET Return to class get. * * Copy was dormant, ask TERM to get rid of it and RID to remove it from * the scheduling table. * CLN2 ISZ FLAG Set the get-rid-of-RDBAP flag CLN3 CLB Clear the error word JMP EREXT * * Constants and variables. * RQADR NOP RQLEN NOP D21 DEC 21 * SKP * * Clean up all RDBAP copies request. Set up a loop to check each entry in * the RDBAP copy scheduling table for a scheduled copy. If there is one * in it, see if it is executing (i.e. non-dormant or not on its class get). * If so, just release its class and remove its entry in the scheduling * table. If not, remove it from system, and then release its class and * entry. * CLNA LDA RD.TB Two loop counters. LDB A,I 1) -(# of copies scheduled) SZB,RSS If no copies scheduled, JMP CLN3 just send reply. CMB,INB STB CNTR1 INA LDB A,I 2) -(# entries in table) SZB,RSS # of entries = 0? JMP CLN3 Yes - just send reply. CMB,INB STB CNTR2 * CLB,INB Set index into table to 1. STB INDEX INA Get table address. * CLNA1 STA ENTAD LDB A,I Entry empty? SZB,RSS JMP CLNA4 Yes * JSB SCHED No - executing? DEF *+1 JMP CLNA2 No - not there! * AND LOFOR SZA,RSS Dormant, JMP CLNA2 CPA D3 or on its class get? RSS JMP CLNA3 No, (it aborts on next class get) * CLNA2 JSB TERM Terminate the copy. CLNA3 JSB RID Remove it from the table. * ISZ CNTR1 Done with all scheduled copies? RSS JMP CLN3 Yes - send reply. * CLNA4 ISZ INDEX Bump index LDA ENTAD get next entry ADA BPSIZ ISZ CNTR2 and continue for JMP CLNA1 entries in table. JMP CLN3 Then, go send reply. SKP * * Check to see if this is a special "remove me" request from an RDBAP copy. * The RDBA Index for such a request is -2. The A rNegister at this point * contains the RDBA Index plus 1, therefore, if the A register is -1 now, * this is a "remove me" request. * RDBA7 INA,SZA JMP RDBA8 No - a valid RDBA request. * * Get index into RDBAP copy table from the 6th word of the request. This * gives us the address of the copy's entry in the scheduling table by: * ((Index - 1) * length of entry) + address of scheduling table. * CCA ADA RBMOD CLB MPY BPSIZ LDB RD.TB ADB D2 ADA B STA ENTAD * * Ask TERM to remove the RDBAP copy from the system, and RID to remove its * entry in the scheduling table. Then, remove the request from our class * and return to the class get. * ISZ FLAG JMP OFFIT SKP * * This is a valid RDBA request. Our first action is to bound check the * RDBA Index (5th word of the request buffer). The Index must be within * [36..45]. * RDBA8 LDA RBIDX CMA,INA ADA D45 Is the index < 46? SSA JMP IDXER No - index error. * ADA M10 Yes - is it > 35? SSA,RSS JMP IDXER No - index error. * * Now, check the Index for a DBOPN call. The Index for DBOPN is 36, but * by the bounds check done above, 36 has been mapped into a -1. * INA,SZA JMP NOTOP * * This is a DBOPN request, we need to check for an RDBAP copy already * scheduled for this master. While checking, we also need to get the * index for the first free entry in the RDBAP copy table in the event * this is the first request from the master. The master program's name * is the data received with the request buffer. Ask SERCH to do the * check for us. * JSB SERCH DEF *+3 DEF MNAME,I DEF RBSRC JMP BUERR No RDBAP copy up and no room! JMP RDBA9 RDBAP copy up. * * There is no current copy of RDBAP for this master, get one for it. * LDB RDBAP LD.hA EMPTY INA JSB C.RP JMP BUERR Did not work! * * Build the entry for the master-copy pair. * STB TEMP Save pointer to copy's name for later. LDA EMPTY STA INDEX Save its index for later. * ISZ RD.TB,I Bump copy count. * ADA M1 CLB MPY BPSIZ Get the address of the entry LDB RD.TB for this copy (derived from index). ADB D2 ADA B STA ENTAD * STA B 1st - 3rd words: LDA MNAME master's name. JSB .MVW DEF D3 DEC 0 * LDA RBSRC 4th word: STA B,I master's node number. * INB 5th - 7th words: LDA TEMP copy's name JSB .MVW DEF D3 DEC 0 * LDA CLSWD 8th word: STA B,I class number, STB CLSAD allocated one. JSB EXEC DEF *+5 DEF NA19 Class control, no abort DEF D0 LU = 0 DEF D0 CLSAD ABS *-* JMP CLERR Abortion return! * LDA CLSAD,I Did we get a class? AND MAPHI SZA,RSS JMP CLERR NO! * IOR BIT13 Yes - reset nodeallocate bit STA CLSAD,I and do a class get to JSB EXEC remove class control DEF *+5 buffer from class. DEF NA21 DEF CLSAD,I DEF DUMMY DEF D0 JMP CLERR Abortion return. * * Schedule the RDBAP copy, then join with non-open processing to pass it * the reqeust. * ISZ FLAG Set the get-rid-of-RDBAP flag * JSB SCHED DEF *+1 JMP BUERR Schedule did not work! Go to busy error exit. JMP JOIN * * Constants and variables. * M10 DEC -10 D45 DEC 45 CLSWD OCT 160000 * MNAME DEF *+1 BSS 3 * RDBAP DEF *+1 ASC 3,RDBAP SKP * * We come here if the request was not a DBOPN. We assume that a monitor * alr'eady exists for the request and that the index for its entry in the * RDBAP copy scheduling table is in the high order byte of the 12th word * of the request buffer. We get the index from the buffer and calculate * the entry's address from it by : * ((Index - 1) * length of entry) + address of copy table. * NOTOP LDA RBBAS ALF,ALF AND LOBYT STA INDEX ADA M1 CLB MPY BPSIZ LDB RD.TB ADB D2 ADA B STA ENTAD * * Make sure the copy is still there by trying to schedule it. If the * schedule aborts or succeeds, we need to clean up after the copy and * send the master a schedule error. * RDBA9 JSB SCHED DEF *+1 JMP BAM2 Abortion return. * AND LOFOR If low four bits of A = zero, SZA RDBAP copy was dormant. JMP JOIN * BAM2 ISZ FLAG Get copy out of system, remove it's table entry JMP SCERR and send master an error reply. * * All went well. Transfer the request from RDBAM's class to the RDBAP * copy's class. Then, return to the class get. * JOIN JSB SWTCH RSS Error return JMP GET Normal return CPA M10 If too many requests error, JMP BUERR send a busy error JMP CLER2 else send a class error. * * Constants and variables. * LOFOR OCT 17 LOBYT OCT 377 DALEN NOP * SKP * * Error handlers. * SIZER LDB M153 Illegal request length JMP EREXT * IDXER LDB M159 Illegal Index parameter. JMP EREXT * CLERR ISZ FLAG No class available CLER2 LDB M158 or class errror from #REQU. JMP EREXT * SCERR LDB M144 RDBAP copy not up. JMP EREXT * BUERR LDB M156 System is too busy error. * EREXT CLA Set the error code for the reply. DST ERROR * LDB #PLOG Flush the request from our class. If SZB,RSS PLOG is enabled,  give JMP ZREQ the request to it * JSB #LOGR JMP EXT3 Error exit * ZREQ LDA RQLEN If this was a zero-length SZA,RSS request, just return to JMP OFFIT class GET. * EXT3 JSB RDEXT Else, send reply with DEF *+6 DS error code to orginator. DEF RQBUF DEF RPLEN DEF DUMMY DEF D0 no data DEF ERROR two word error code NOP ignore any errors. * * Remove class buffer from our class * OFFIT JSB RMOVE * * LDA FLAG Any more clean-up to do? SZA,RSS JMP GET No - return to class get. * JSB TERM Yes - get rid of new JSB RID copy of RDBAP. JMP GET Then return to class get. * * Constants and variables. * M159 DEC -159 M158 DEC -158 M156 DEC -156 M153 DEC -153 D0 EQU BPID# * NA21 OCT 100025 * DUMMY NOP ERROR BSS 2 CLAS2 NOP CLASS BSS 5 ERLU EQU CLASS+1 FLAG NOP SKP * * SERCH is a utility subroutine for RDBAM which searches the RDBAP copy * scheduling table for a copy of RDBAP associated with the master whose * name is the same as that passed and for the first empty entry in the * table, leaving its index in EMPTY. * * The calling sequence for SERCH is: * * JSB SERCH * DEF *+3 return address * DEF IDSNM master program's name * DEF SRCND master program's node number * * * * IDSNM NOP SRCND NOP SERCH NOP JSB .ENTR DEF IDSNM * * Set up parameters for table search. * LDA ZRD.TB Two loop counters: LDB A,I 1) -(# of copies scheduled) CMB,INB STB CNTR1 INA LDB A,I 2) -(# of entries in table) SZB,RSS If # of entries = 0, JMP SRCH7 take error return. CMB,INB STB CNTR2 * INA A -> RDBAP copy scheduling table CLB STB EMPTY EMPTY = ENTAD = 0 STB ENTAD INB First index into table is one. STB INDEX * * BEGIN MAJOR LOOP * * BEGIN MINOR LOOP * SRCH0 STA TABAD LDB A,I If the entry is not empty, SZB,RSS JMP SRCH3 LDB IDSNM compare the master names. JSB .CMW DEF D3 DEC 0 JMP SRCH1 A match NOP JMP SRCH2 Not a match * SRCH1 LDB A,I A match, compare node numbers. CPB SRCND,I RSS A match, entry found. JMP SRCH4 Not a match, try next * LDA TABAD Set up ENTAD for return STA ENTAD and return P+2. JMP SRCH6 * SRCH2 ISZ CNTR1 Not a match, done with all scheduled copies? JMP SRCH4 No LDA EMPTY Yes - did we already find SZA an empty entry? JMP SRCH5 Yes JMP SRCH4 No * * END MINOR LOOP * SRCH3 LDB INDEX Empty entry found, LDA EMPTY first one? SZA,RSS STB EMPTY Yes - save its index. * SRCH4 LDA TABAD Get next entry's address ADA BPSIZ ISZ INDEX bump index ISZ CNTR2 and try next one. JMP SRCH0 * * END MAJOR LOOP * * Here when entire table is searched. * LDA EMPTY Did we find an empty entry? SZA,RSS JMP SRCH7 No SRCH5 ISZ SERCH Yes return P+3. SRCH6 ISZ SERCH Entry found, return P+2. SRCH7 JMP SERCH,I Return. SKP * * RID is a utility subroutine for RDBAM which remove an RDBAP copy from * tؾhe scheduling table by releasing its class number and zeroing the * first word of its entry. * * The calling sequence for RID is: * * ENTAD = address of RDBAP copy's entry in scheduling table to * get rid of. * JSB RID * * RID NOP * * Get the RDBAP copy's class number, clear its save buffer bit and set * its save class and no wait bits. * LDB ENTAD ADB BPCLS LDA B,I CCE,SZA,RSS If class never allocated, JMP RID3 just clear entry. AND MAPHI IOR BIT13 RAL,ERA STA CLAS2 * * Set up a loop to remove all requests on this class number, then to re- * lease the class number. * RID1 CCA Set the release retry STA TEMP switch to -1. * RID2 JSB EXEC Go to RTE to release class buffer. DEF *+5 DEF NA21 Class get, no abort DEF CLAS2 DEF DUMMY DEF D0 RSS Ignore errors. * ISZ TEMP Release processing completed? JMP RID3 Yes - zero entry. INA,SZA No - all pending reqs. cleared? JMP RID1 No - continue to clear requests. * LDA CLAS2 Yes - remove save class XOR BIT13 number bit (bit 13) STA CLAS2 and return for final JMP RID2 deallocation. * * Set the first word of the entry to zero to signify the entry is empty, * decrement the copy count, then return. * RID3 CLA STA ENTAD,I CMA ADA RD.TB,I STA RD.TB,I JMP RID,I SKP * * SCHEDule is a utility subroutine for RDBAM which schedules the RDBAP * copy described in the entry of the RDBAP copy scheduling table speci- * fied in ENTAD. The schedule is immediate, without wait and the RDBAP * copy is passed: * 1) its class number * 2) its index into the scheduling table * 3) RDBApjM's class number * * The calling sequence for SCHED is: * * ENTAD = address of RDBAP copy's entry in scheduling table * INDEX = index into scheduling table for RDBAP copy's entry * JSB SCHED * DEF *+1 return address * * * SCHED NOP JSB .ENTR DEF SCHED * * Get addresses of RDBAP copy's name and class number in entry, and put * them into scheduling EXEC call. * LDA ENTAD ADA BPNAM STA NAMAD ADA D3 STA CLADR * * Schedule RDBAP copy. * JSB EXEC DEF *+6 DEF NA10 Immediate schedule, no wait, no abort NAMAD ABS *-* CLADR ABS *-* DEF INDEX DEF CLASS JMP SCHED,I Abortion return point. * ISZ SCHED JMP SCHED,I Normal return point. SKP * * TERMinate is a utility subroutine for RDBAM which terminates the copy * of RDBAP specified by the entry in the scheduling table pointed to by * ENTAD and removes it from the system. * * The calling sequence for TERM is: * * ENTAD = address of RDBAP copy's entry in scheduling table * JSB TERM * * TERM NOP * * Get address of RDBAP copy's name and put it in terminating EXEC call. * LDA ENTAD ADA BPNAM STA OFNAM * * Go to RTE to terminate the copy normally. * JSB EXEC DEF *+4 DEF NA6 Terminate, no abort. OFNAM ABS *-* DEF D0 Normal completion. NOP Ignore errors. * * Ask C.RP to remove the copy's ID segment from the system. * LDB OFNAM CLA JSB C.RP NOP Ignore errors. JMP TERM,I Return to caller. * * NA6 OCT 100006 SKP * * SWTCH is a utility subroutine for RDBAM which calls #RQUE to transfer * a request from RDBAM's class to the class of the RDBAP copy specified * fG by the entry of the scheduling table pointed to by ENTAD. * * The calling sequence for SWTCH is: * * ENTAD = address of entry in scheduling table for RDBAP copy * JSB SWTCH * * * SWTCH NOP * * Get the RDBAP copy's class number from its entry in the scheduling table * and call #RQUE. * LDA ENTAD ADA BPCLS LDB A,I STB CLAS2 * JSB #RQUE DEF *+9 DEF D20N DEF B10K DEF D0 send the data buffer unmodified DEF D0 DEF D0 send the request buffer unmodified DEF D0 DEF CLAS2 DEF CLASS * RSS Error return ISZ SWTCH bump return point. JMP SWTCH,I Return. SKP * * RMOVE is a utility subroutine which removes the current request from * RDBAM's class number. * * The calling sequence for RMOVE is: * * CLASS = RDBAM's class number * JSB RMOVE * * RMOVE NOP * * Get class number, remove its save buffer bit, set its save class and * no waits bits. * LDA CLASS XOR BIT14 STA CLAS2 * * Go to RTE to release class buffer. * JSB EXEC DEF *+5 DEF NA21 Class get, no abort DEF CLAS2 DEF DUMMY DEF D0 No data NOP Ignore errors. JMP RMOVE,I SKP * * This short subroutine is bid up when RDBAM is first scheduled and is * unable to find the type 6 file named RDBAP. It merely prints a warning * message to the system console and returns. * BAPER NOP * JSB EXEC DEF *+5 DEF NA2 write, no abort DEF ERLU error lu passed by LSTEN DEF BAMES warning message DEF D22 message length NOP ignore abort return * CLA Set A to zero so as to skip JMP BAPER,I Krpl call to C.RP on return. * BAMES ASC 22,/RDBAM - WARNING RDBAP MUST BE IN THE SYSTEM * D20N OCT 100024 D22 DEC 22 NA2 OCT 100002 M144 DEC -144 M1 DEC -1 D2 DEC 2 D3 DEC 3 * MAPHI OCT 17777 BIT13 OCT 020000 BIT14 OCT 040000 NA19 OCT 100023 NA10 OCT 100012 B10K OCT 010000 * CNTR1 NOP CNTR2 NOP TABAD NOP ENTAD NOP EMPTY NOP INDEX NOP TEMP NOP END RDBAM END$ r k 91750-18025 2013 S C0122 &#PUTR              H0101 lASMB,R,Q,C HED <#PUTR> DS "PUT" SUBROUTINE * (C) HEWLETT-PACKARD CO. 1980* NAM #PUTR,7 91750-1X025 REV 2013 791129 ALL * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * ENT #PUTR SPC 1 EXT .ENTR,$LIBR,$LIBX EXT #SBFL,#SBFA LENGTH & ADDRESS OF CURRENT RQST EXT $OPSY * * NAME: #PUTR * SOURCE: 91750-18025 * RELOC: 91750-1X025 * PGMR: LYLE WEIMAN JUNE 1979 * * * * PURPOSE: * #PUTR IS CALLED BY GRPM WHEN IT NEEDS TO MODIFY PART OF THE DS * HEADER. WHILE IT IS MUCH CLEANER AND PREFERABLE TO COPY AS MUCH OF * THE HEADER AS MAY BE MODIFIED INTO A LOCAL BUFFER, MODIFY IT THERE, * THEN USE THE OVER-WRITING FEATURE OF SUBROUTINE #RQUE, IT IS SOMETIMES * MORE EFFICIENT SIMPLY TO PLACE THE UPDATE INFORMATION DIRECTLY INTO * THE HEADER, PARTICULARLY WHEN UPDATING DATA NEAR THE END OF THE HEADER. * SPC 2 * #PUTR CALLING SEQUENCE (NOTE: THIS ROUTINE ASSUMES THAT #GETR HAS * BEEN CALLED PREVIOUSLY. IT USES THE ADDRESS * AND BUFFER LENGTH OF THE LAST DS HEADER * PROCESSED BY #GETR, WHICH IS LEFT OVER FROM * THE #GETR CALL AND COMMUNICATED TO #PUTR VIA * ENTRY POINT) : * * JSB #PUTR * DEF *+3 * DEF OFFSET INTO HEADER TO START WRITING ( >= 0) * DEF DATA TO OVERLAY DS HEADER IN SAM * ATTEMPT MADE TO WRITE PAST END OF BUFFER * (A) & (B) MEANINGLESS SPC 3 * #PUTR OPERATION: * 1. O VERIFY THAT A REQUEST BUFFER HAS BEEN READ PREVIOUSLY. * ENTRY POINTS #SBFL AND #SBFA ARE USED FOR COMMUNICATION BETWEEN * #PUTR AND #GRPM FOR THIS DETERMINATION. * 2. VERIFY THAT THE OFFSET SPECIFIED RESIDES WITHIN THE REQUEST * BUFFER. * 3. TURN OFF MEMORY PROTECTION, STORE THE DATA WORD IN THE REQUEST * BUFFER AT THE OFFSET SPECIFIED, RESTORE MEMORY PROTECTION, AND * RETURN TO THE CALLER. * * IF THE VERIFICATION TESTS ABOVE ARE NOT PASSED, THE EXIT * IS TAKEN, WITHOUT CAUSING ANY DAMAGE TO THE REQUEST BUFFER. SKP OFSET NOP OFFSET ODATA NOP OVERLAY DATA * #PUTR NOP JSB .ENTR GET PARAMETER ADDRESSES DEF OFSET * INI JSB CONFG CONFIGURE DMS/NON-DMS ('NOP' AFTER 1ST CALL) * LDB OFSET,I LOAD OFFSET LDA #SBFL SSB,RSS IF NEGATIVE OFFSET OR CMA,INA,SZA,RSS NO BUFFER, THEN JMP #PUTR,I RETURN WITHOUT CAUSING DAMAGE! * * CHECK FOR "OFFSET" > LENGTH OF BUFFER * ADA OFSET,I SUBTRACT FROM TRUE LENGTH OF DATA SSA,RSS WRITING PAST END OF BUFFER? JMP #PUTR,I YES, EXIT * * END OF VERIFICATION TESTS * ISZ #PUTR ADJUST FOR "GOOD" EXIT * JSB $LIBR LOWER MEMORY-PROTECT FENCE NOP (PRIVILEGED) ADB #SBFA COMPUTE ADDRESS OF DATA AREA LDA ODATA,I LOAD DATA TO OVERLAY * MOD1 XSA B,I (STA B,I IF NOT DMS SYSTEM) STORE DATA * JSB $LIBX RESTORE MEMORY PROTECTION & RETURN TO CALLER DEF #PUTR * * THIS CODE IS EXECUTED ONLY ONCE. IT CHANGES THE "XSA B,I" INSTRUCTION * AT LABEL "MOD1" TO A "STA B,I" INSTRUCTION IF THE RTE IS NOT * USING THE DYNAMIC MAPPING SYSTEM (DMS). * CONFG NOP ROUTINE TO CONFIGURE FOR DMS/NON-DMS INSTR. CLB CLEAR CALL TO THIS STB INI ROUTINE LDA $OPSY GET OP-# SYSTEM TYPE RAR,SLA ROTATE MAPPED-MEMORY BIT TO LSB. USING DMS? JMP CONFG,I YES, RETURN NOW LDA STA YES, CHANGE XSA B,I TO STA B,I DST MOD1 JMP CONFG,I RETURN * DATA AREA * A EQU 0 B EQU 1 * STA STA B,I SIZE BSS 0 * END d lt 91750-18026 2013 S C0122 &#RMSM +              H0101 jASMB,R,Q,C,Z IFZ HED #RMSM 91750-1X026 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #RMSM,7 91750-1X026 REV.2013 800725 RTE-IVB W/S.M. XIF IFN HED #RMSM 91750-1X210 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #RMSM,7 91750-1X210 REV.2013 800725 ALL, W/O S.M. XIF * * "Z" OPTION FOR SESSION MONITOR NODE, "N" OPTION IF NON-SESSION NODE. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #RMSM * EXT DLGON,DLGOF,DLGNS,#NODE,DSERR EXT #RQB,REIO,.ENTR,#NAT,#NASR EXT .LBT,.SBT,.SFB,.MBT,.MVW RQB EQU #RQB IFZ EXT PGMAD,SESSN,ISMVE,.UNAM,$SMD# XIF * SUP * * NAME: #RMSM * SOURCE: 91750-18026 * RELOC: PART OF 91750-12014 ("Z"), -12015 ("N") * PGMR: JIM HARTSELL * * SUBROUTINES TO PERFORM OPTIONAL SESSION-MONITOR PROCESSING * FOR THE DS/1000 REMAT MODULE. * * CALLING SEQUENCES: * * PROCESSOR FOR REMAT COMMAND "AT" (ATTACH): * * JSB #RMSM * DEF *+7 * DEF B1 REQUEST CODE. * DEF INBUF "AT" COMMAND STRING ADDR. * DEF INCNT LENGTH OF STRING IN WORDS. * DEF NODE1 REMAT "NODE1" VARIABLE. * DEF NODE2 REMAT "NODE2" VARIABLE. * DEF LOGLU REMAT LOGGING LU. * * * PROCESSOR FOR REMAT COMMAND "DE" (DETACH): * * JSB #RMSM * DEF *+7 * DEF B2 REQUEST CODE. * DEF CP1 PARAM 1 FLAG (PARSE BUFFER). * DEF CP2 PARAM 2 FLAG (PARSE BUFFER). * DEF NODE1 * DEF NODE2 * DEF LOGLU * * * PRE-PROCESSOR FOR REMAT "SW" COMMAND NODE-SWITCH. REMOVE (& SAVE) * ACCOUNT-NAME QUALIFIERS FROM THE SW COMMAND STRING AND PACK FOR * RE-PARSE. * * JSB #RMSM * DEF *+7 * DEF B3 REQUEST CODE. * DEF INBUF COMMAND BUFFER. * DEF INCNT COMMAND LEN, +WORDS, ADJUSTED ON RETURN. * DEF NODE1 * DEF NODE2 * DEF LOGLU * * SZA IF NECESSARY, * JSB $PARS RE-PARSE CONVERTED SW COMMAND. * * * SUPPLEMENTARY POST-PROCESSOR FOR "SW" COMMAND NODAL DISPLAY. DISPLAY * ACCOUNT NAMES FOR CURRENT SESSION (IF ANY) AT NODE1 AND NODE2. * * JSB #RMSM * DEF *+7 * DEF N1 REQUEST CODE. * DEF DUMMY * DEF DUMMY * DEF NODE1 * DEF NODE2 * DEF LOGLU * * * SUPPLEMENTARY POST-PROCESSOR FOR "SW" COMMAND. LOG ON TO ACCOUNT * NAMES GIVEN IN ORIGINAL SW COMMAND QUALIFIERS FROM "REQ CODE 3" CALL * TO #RMSM. * * JSB #RMSM * DEF *+2 * DEF N2 REQUEST CODE. * * * SUPPLEMENTARY POST-PROCESSOR FOR "EX" COMMAND. LOG OFF ALL REMAINING * ACTIVE REMOTE SESSIONS. * * JSB #RMSM * DEF *+2 * DEF B0 REQUEST CODE. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ******************************k************************************ * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP A EQU 0 B EQU 1 * RCODE NOP #RMSM REQUEST CODE. BUFAD NOP BUFFER ADDRESS. LEN NOP LENGTH OF BUFFER (+WORDS). NODE1 NOP NODE2 NOP LOGLU NOP LOGGING LU. * CP1A EQU BUFAD PARAMETER 1 FLAG. CP2A EQU LEN PARAMETER 2 FLAG. * #RMSM NOP JSB .ENTR DEF RCODE * LDA RCODE,I CHECK REQUEST CODE. SZA,RSS JMP EXSUP "EX" SUPPLEMENTARY PROCESSING. SSA JMP SWSUP "SW" SUPPLEMENTARY PROCESSING. * * "REMOTE SESSION" COMMAND "AT", "DE", OR "SW". REMOVE ALL IMBEDDED * BLANKS FROM THE COMMAND STRING (IN REMAT'S INPUT BUFFER). * PI CPA B2 JMP PROC "DE" COMMAND. * LDA LEN,I LENGTH OF STRING IN WORDS. ALS CMA,INA STA CNTR NEGATIVE # BYTES IN STRING. * LDA BUFAD FWA COMMAND STRING. RAL STA SRCE SOURCE BYTE ADDRESS. STA DEST DESTINATION BYTE ADDRESS. * LOOP LDB SRCE GET NEXT BYTE IN STRING. JSB .LBT STB SRCE * CPA B40 TEST THE CHARACTER. JMP NEXT SKIP OVER IF BLANK. * LDB DEST STORE IF NON-BLANK. JSB .SBT STB DEST * NEXT ISZ CNTR GO TO NEXT CHARACTER. JMP LOOP LOOP TILL DONE. * LDA B40 END OF COMMAND STRING. ISZ SRCE GUARANTEE 1 TRAILING BLANK. LDB DEST FILL OUT WITH TRAILING BLANKS FILL JSB .SBT UP TO AND INCLUDING CPB SRCE THE SOURCE BYTE POINTER RSS (REMAT BUFFER IS LONGER THAN JMP FILL LONGEST ALLOWED COMMAND STRING). * * GO TO REQUIRED PROCESSOR. * PROC LDA RCODE,I ADA JMPTB LDA A,I JMP A,I * JMPTB DEF * DEF PR.AT "ATTACH" COMMAND. DEF PR.DE "DETACH" COMMAND. DEF PR.SW "SWITCH" COMMAND. SKP * * PROCESSOR FOR "AT" COMMAND: CREATE NON-INTERACTIVE SESSION AT * NODE1 OR NODE2 OR BOTH. * * #AT,USER1NAMEX.GROUPNAMEX/PASSWORDXX,USER2NAMEX.GROUPNAMEX/PASSWORDXX * #AT,/PASSWORD1X,/PASSWORD2X * PR.AT CLA CLEAR "NO 2ND PARAM" FLAG. STA NO2ND * LDA COMMA SCAN FOR FIRST COMMA (START LDB BUFAD OF USER NAME FOR NODE1). RBL BYTE ADDRESS. JSB .SFB TERMINATE ON BLANK. RSS FOUND: B=BYTE ADDR OF COMMA. JMP #RMSM,I NOT FOUND. RETURN. * INB STB FIRST BYTE ADDR 1ST CHAR OF USER-NAME. * JSB .SFB SCAN FOR SECOND COMMA (END OF NAME). JMP AT1 FOUND. ADB N1 NOT FOUND. BACK UP FOR "LAST". CLA,OINA SET FLAG FOR "NO 2ND PARAM". STA NO2ND AT1 STB LAST BYTE ADDR OF LAST CHAR +1. * LDA FIRST IS THE FIRST USER NAME NULL? CMA,INA ADA LAST SZA,RSS JMP AT2 YES. * LDA NODE1,I NO. LOG ON AT NODE1. JSB LOGON * AT2 LDA NO2ND ALREADY KNOW NO 2ND USER-NAME? SZA JMP #RMSM,I YES. RETURN NOW. * LDB LAST NO. SET "FIRST" TO BYTE ADDR OF INB CHAR FOLLOWING SECOND COMMA. STB FIRST LDA COMMA SET TEST & TERM BYTES. JSB .SFB SCAN FOR END OF USER-NAME. RSS FOUND A COMMA. ADB N1 FOUND A BLANK. STB LAST BYTE ADDR OF LAST CHAR + 1. * LDA FIRST IS 2ND USER-NAME NULL? CMA,INA ADA LAST SZA,RSS JMP #RMSM,I YES. RETURN NOW. * LDA NODE2,I NO. LOG ON AT NODE2. JSB LOGON * JMP #RMSM,I RETURN. SKP * * PROCESSOR FOR "SW" COMMAND: FIND ACCOUNT NAME QUALIFIERS (IF ANY) * FOR THE NODE1 AND NODE2 PARAMETERS, SAVE IN ANOTHER AREA, REMOVE FROM * COMMAND STRING, REPACK COMMAND STRING, AND SIGNAL REMAT TO CALL $PARS * TO RE-PARSE THE SW COMMAND STRING. * * #SW,NODE1:USER.GROUP/PASSWORD,NODE2:USER.GROUP/PASSWORD,SECURITY * #SW,NODE1:/PASSWORD,NODE2:/PASSWORD,SECURITY * PR.SW LDB BLANK BLANK OUT STORAGE AREA LDA UNAM1 FOR ACCOUNT-NAME QUALIFIERS. STB A,I LDB A INB JSB .MVW DEF D33 (ONE EXTRA WORD PER NAME) NOP * CLA STA XTRCT RESET "EXTRACTION FLAG". * LDA COMMA SCAN TO 1ST COMMA, LDB BUFAD TERMINATE ON BLANK. RBL BYTE ADDR OF SW COMMAND STRING. JSB .SFB RSS FOUND: B = BYTE ADDR OF COMMA. JMP EXIT NOT FOUND. RETURN. INB STB FIRST SAVE ADDR OF NODE PARAM. * LDB BUFAD STORE 2 COMMAS AT END OF STRING. ADB LEN,I j RBL LDA COMMA JSB .SBT JSB .SBT * LDA UNAM1 POINT TO AREA FOR NODE1 QUALIFIER. LDB FIRST STARTING BYTE ADDR FOR SCAN. JSB FNAME EXTRACT NODE1 QUALIFIER (IF ANY). * LDA UNAM2 POINT TO AREA FOR NODE2 QUALIFIER. JSB FNAME EXTRACT NODE2 QUALIFIER (IF ANY). * LDA XTRCT FOR EXIT, SET A = EXTRACTION FLAG. RSS EXIT CLA * JMP #RMSM,I RETURN. SKP * * SUBROUTINE TO EXTRACT USER-NAME QUALIFIER (IF ANY). * (A) = STORAGE AREA ADDR FOR QUALIFIER. * (B) = STARTING BYTE ADDR IN STRING FOR SCAN. * JSB FNAME * FNAME NOP RAL STA DEST BYTE ADDR FOR STORING NAME. * LDA COLON SCAN FOR 1ST COLON, JSB .SFB TERMINATE ON COMMA. RSS FOUND. JMP FNAME,I NOT FOUND. RETURN. * INB STB FIRST BYTE ADDR OF USER NAME. * LDA COMA2 SCAN FOR COMMA, JSB .SFB TERMINATE ON COMMA. NOP WILL ALWAYS BE FOUND. STB LAST "FOUND". SAVE ADDR OF COMMA. * LDA FIRST CMA,INA ADA LAST STA BYTLN # BYTES (+) IN USER-NAME. INA STA CNTR # BYTES (+) TO DELETE FROM STRING. CPA B1 JMP DELET NONE TO MOVE. * LDA FIRST MOVE USER-NAME QUALIFIER. LDB DEST JSB .MBT DEF BYTLN NOP * DELET LDB BUFAD COMPUTE # CHAR TO MOVE TO ADB LEN,I REPACK THE SW COMMAND STRING. RBL LDA LAST CMA,INA ADA B INA STA TEMP * LDA LAST DELETE QUALIFIER FROM COMMAND STRING. LDB FIRST ADB N1 JSB .MBT DEF TEMP NOP * LDA CNTR BLANK OUT THE RESIDUE. CMA,INA ((B) = ADDR OF FIRST BYTE.) STA TEMP LDA B40 CLEAR JSB .SBT ISZ TEMP JMP CLEAR * LDA CNTR ADJUST TOTAL SW COMMAND ARS h3LENGTH FOR REMAT. CMA,INA ADA LEN,I STA LEN,I (WORDS) * ISZ XTRCT FLAG THAT EXTRACTION WAS PERFORMED. LDB CNTR BACK UP STRING POINTER, SINCE CMB,INB QUALIFIER WAS DELETED FROM STRING. ADB LAST INB JMP FNAME,I EXIT. B = ADDR FOR NEXT SCAN. SKP * * PROCESSOR FOR "DE" COMMAND: DETACH FROM AND RELEASE SESSION * AT NODE1 AND/OR NODE2. * * #DE BOTH NODE1 & NODE2. * #DE,N1 NODE1 ONLY. * #DE,N2 NODE2 ONLY. * #DE,N1,N2 BOTH NODE1 & NODE2. * PR.DE LDA CP1A,I PARAMETER GIVEN? SZA JMP WHICH YES. LDA NODE1,I NO. DETACH FOR BOTH NODES. JSB LOGOF LDA NODE2,I JSB LOGOF JMP #RMSM,I RETURN. * WHICH LDB CP1A GET PARAMETER P1. INB LDB B,I LDA NODE1,I CPB "N1" IF NODE1, JSB LOGOF LOG OFF FOR NODE1. LDA NODE2,I CPB "N2" IF NODE2, JSB LOGOF LOG OFF FOR NODE2. * LDA CP2A,I SECOND PARAMETER GIVEN? SZA,RSS JMP #RMSM,I NO. * LDB CP2A YES. GET PARAMTER P2. INB LDB B,I LDA NODE1,I CPB "N1" IF NODE1, JSB LOGOF LOG OFF FOR NODE1. CPB "N2" IF NODE2, JSB LOGOF LOG OFF FOR NODE2. * JMP #RMSM,I RETURN. SKP * * SUBROUTINE TO RELEASE NON-INTERACTIVE SESSION AND CLEAR LOCAL * NATX ENTRY. * IF THIS IS A NEW EXECUTION AND THE NAT HAS OLD INFO, IT WILL BE * CLEARED BY THE DLGOF ROUTINE AND THE LOGOFF WILL BE IGNORED. * LOGOF NOP STA NODE SAVE DEST. NODE NUMBER. CPA #NODE JMP LOGOF,I SKIP IT IF LOCAL NODE NUMBER. * JSB DLGOF LOG OFF. DEF *+3 DEF IERR DEF NODE * LDB IERR CHECK FOR ERROR. SZB,RSS JMP LOGOF,I NO ERROR. RETURN. * LDA "OF" SET FOR LOGOF ERROR MESSAGE. STA EMSG+2 JSB ERROR DISPLAY ERROR MESSAGE. * JMP LOGOF,I RETURN. SPC 5 SKP * * SUBROUTINE TO MOVE USER NAME TO NETWORK ACCOUNT TABLE EXTENSION (NATX) * WITH ALIGNMENT ON WORD BOUNDARY, AND LOG ON. SET POINTER IN THE * NETWORK ACCOUNT TABLE (NAT) TO THE LOCAL NATX ENTRY. * NOTE -- IF THE DESTINATION NODE DOES NOT HAVE SESSION MONITOR, THE * NATX ENTRY WILL STILL BE FILLED WITH THE SPECIFIED USER-NAME, * BUT THE "SW" DISPLAY WILL SHOW "(NONE)". * LOGON NOP STA NODE SAVE DESTINATION NODE NUMBER. * LDA FIRST COMPUTE BYTE LENGTH OF NAME. CMA,INA ADA LAST STA BYTLN NEG # BYTES TO MOVE. CMA SEE IF WITHIN RANGE. ADA D33 (MAX IS 32 BYTES) SSA,RSS JMP LXX OK. DLD "SM04 NG. GIVE "NO SUCH USER" ERROR. JMP LYY * LXX LDA NATX# FIND AVAILABLE NATX ENTRY. STA CNTR LDB DNATX ADDR OF NATX 1ST ENTRY. LOOP1 LDA B,I GET NEXT ENTRY WORD 1. SZA,RSS JMP DESTP FOUND AN AVAILABLE ENTRY. ADB D11 GO TO NEXT ENTRY. ISZ CNTR JMP LOOP1 LOOP TILL DONE. DLD "RS03 NONE AVAILABLE. LYY DST RQB+#EC1 DISPLAY LOGON ERROR "RS03" LDA #NODE (NODE LIMIT EXCEEDED). IOR BIT15 STA RQB+#ENO LDA RQB+#ECQ AND NOTQ STA RQB+#ECQ LDA "ON" STA EMSG+2 JSB ERROR JMP #RMSM,I * DESTP STB UNAME SAVE ADDR OF NATX ENTRY. RBL DESTINATION BYTE POINTER. LDA FIRST SOURCE BYTE POINTER. * JSB .MBT MOVE BYTES. IF PASSWORD ONLY, DEF BYTLN FIRST CHARACTER IS A "/". NOP * LDA BYTLN BLANK OUT THE REST OF THE FIELD. STA TEMP (B) = ADDR OF NEXT BYTE. LOOP2 LDA TEMP CPA D33 (32 BYTES IS MAX SIZE) JMP PRIME LDA B40 JSB .SBT ISZ TEMP JMP LOOP2 * PRIME LDA BYTLN SET # WORDS.w INA ARS STA TEMP * LDB FIRST CHECK IF THIS IS NON-SESSION REQ. JSB .LBT CPA SLASH JMP N.S. YES (PASSWORD ONLY WAS SPECIFIED). * JSB DLGON DO NON-INTERACTIVE LOG-ON. DEF *+5 ON RETURN, (A) = NAT ENTRY ADDR. DEF IERR CALL COULD RESULT IN LOG-OFF DEF NODE OF PRIOR SESSION BEFORE LOG-ON. UNAME NOP DEF TEMP JMP CKERR GO CHECK FOR ERROR. * N.S. JSB DLGNS REQUEST NON-SESSION ACCESS. DEF *+5 ON RETURN, (A) = NAT ENTRY ADDR. DEF IERR CALL COULD RESULT IN LOG-OFF DEF NODE OF PRIOR SESSION (IF ANY). DEF UNAME,I PASSWORD. DEF TEMP * CKERR LDB IERR CHECK FOR ERRORS. SZB JMP ERRLG GO PROCESS ERROR. * ADA B2 POINT TO 3RD WORD OF NAT ENTRY. LDB UNAME STORE ADDRESS OF NATX STB A,I IN THE NAT ENTRY. JMP LOGON,I RETURN. * ERRLG LDA "ON" SET FOR LOGON ERROR MESSAGE. STA EMSG+2 JSB ERROR DISPLAY ERROR MESSAGE. * CLA CLEAR NATX ENTRY. STA UNAME,I * JMP LOGON,I RETURN. SKP * * SUBROUTINE CALL "DSERR" AND PRINT ERROR MSG. * ERROR NOP * JSB DSERR CALL ROUTINE TO RETURN DEF *+2 DS ERROR PARAMETERS. DEF EMSG+4 * JSB REIO DISPLAY ERROR MESSAGE: DEF *+5 "RS01" -> "RS08" FROM DLGON, DEF ICD2 "DS01" -> "DS09" FROM DS, OR DEF LOGLU,I "SM01" -> "SM13" FROM LOGON. DEF EMSG DEF D28 NOP ERROR RETURN. * JMP ERROR,I RETURN. * EMSG ASC 4,/LOGON: BSS 24 BUFFER FOR "DSERR". SKP * * SUPPLEMENTARY PROCESSING FOR "SW" COMMAND. * SWSUP CPA N1 IF RCODE = -1, JMP DSPLY GO DISPLAY ACCOUNT NAMES. CPA N2 IF RCODE = -2, JMP LGON GO LOG ON TO NODE1 AND/OR NODE2. JMP #RMSM,I BAD RCODE. * * DISPLAY ACCOUNT NAMES FOR CURRENT SESSION (IF ANY) AT NODE1 AND NODE2. * DSPLY LDB BLANK BLANK OUT LINE. LDA UNAM1 STB A,I LDB A INB JSB .MVW DEF D33 NOP * LDA NODE1,I IF SESSION AT NODE1, LDB UNAM1 MOVE NAME TO PRINT LINE. JSB GTNAM * LDA NODE2,I IF SESSION AT NODE2, LDB UNAM1 ADB D11 JSB GTNAM MOVE NAME TO PRINT LINE. * JSB REIO DISPLAY "ACCOUNT NAME = " DEF *+5 DEF ICD2 DEF LOGLU,I DEF LINE1 DEF D18 NOP ERROR RETURN. * JSB REIO DISPLAY ACCOUNT NAMES OR "(NONE)". DEF *+5 (ALSO "(NONE)" FOR SPECIAL DEF ICD2 NON-SESSION ACCESS.) DEF LOGLU,I DEF UN1 DEF D22 NOP ERROR RETURN. * JMP #RMSM,I RETURN. * NONAD DEF DFLT DFLT ASC 4,(NONE)/ LINE1 ASC 18,ACCOUNT NAME = ACCOUNT NAME = SPC 3 * * SUBROUTINE TO RETRIEVE ASCII USER NAME OF SESSION AT A NODE. * (A) = NODE NUMBER * (B) = DEST ADDR IN PRINT LINE FOR USER NAME. * GTNAM NOP STB DEST SAVE PRINT LINE ADDR. * IFZ CPA #NODE IS IT THE LOCAL NODE? RSS JMP SNODE NO. REMOTE NODE. * CLA STA BUFR * JSB PGMAD YES. GET USER'S ID SEGMENT ADDR. DEF *+3 DEF BUFR DEF XEQT * JSB SESSN IS USER RUNNING UNDER A SESSION? DEF *+2 DEF XEQT * SEZ JMP NONE NO. NO USER NAME TO DISPLAY. * STB TEMP YES. SAVE SCB POINTER. * JSB ISMVE MOVE DATA FROM THE SCB. DEF *+5 DEF TEMP SESSION WORD FROM ID SEGMENT. DEF $SMD# POINT TO DIRECTORY ENTRY NUMBER. DEF CNTR LOCATION TO BE FILLED. DEF B1 NUMBER OF WORDS TO FETCH. * LDA CNTR GET USER NAME CORRESPONDING LDB RBUFuA TO DIRECTORY ENTRY # OF JSB .UNAM CURRENT LOCAL SESSION. DEF ERBUF SZA JMP NONE ERROR. * LDA RBUF ISOLATE BYTE LEN OF USER NAME. SZA,RSS JMP NONE NO NAME. ALF,ALF AND B377 STA CNTR BYTE LEN OF USER NAME PORTION. LDA RBUF GET BYTE LEN OF GROUP NAME AND B377 AND SAVE TEMPORARILY. STA TEMP1 * LDB RBUFA SET DEST BYTE POINTER FOR MOVE. RBL STB TEMP SAVE FOR FINAL MOVE TO PRINT LINE. LDA B SET SOURCE BYTE POINTER FOR MOVE. ADA B2 JSB .MBT LEFT JUSTIFY USER NAME PORTION. DEF CNTR NOP ((B) WILL POINT TO LOC. OF PERIOD.) * LDA TEMP1 ANY GROUP NAME? SZA,RSS JMP BFILL NO. GO DO TRAILING BLANK FILL. ADA CNTR YES. ADD TO TOTAL BYTE LEN. INA ACCOUNT FOR INSERTED PERIOD. STA CNTR * LDA DOT STORE PERIOD OF "USER.GROUP". JSB .SBT * LDA RBUFA POINT TO GROUP NAME (BYTE ADDR). ADA B6 RAL SOURCE POINTER ((B) = DEST PTR). JSB .MBT MOVE GROUP NAME. DEF TEMP1 NOP ((B) WILL POINT TO 1ST BYTE TO FILL.) * BFILL LDA CNTR COMPUTE # BYTES TO BLANK OUT. CMA,INA ADA D21 SZA,RSS JMP MVNAM NONE. GO DISPLAY (TEMP & CNTR ARE SET). * STA BYTLN + # BLANK BYTES NEEDED, -1. LDA BLANK STORE FIRST BLANK BYTE. JSB .SBT LDA B BLANK FILL. ADA N1 JSB .MBT DEF BYTLN NOP * JMP MVNAM GO DISPLAY (TEMP & CNTR ARE SET). XIF * SNODE JSB #NASR SEARCH FOR NODE # GIVEN IN (A). SZB,RSS JMP NONE NOT FOUND. * ADB B2 FOUND. (B) = NAT ENTRY ADDR, (A) = SID. LDB B,I ADDR OF ASCII USER NAME IN NATX. SZB,RSS JMP NONE NO USER NAME. * ANZD B377 IF NO DESTINATION SESSION ID, SZA,RSS I.E. NO SESSION MONITOR, ETC., LDB NONAD CHANGE DISPLAY TO SHOW "(NONE)". RBL BYTE ADDR OF USER NAME IN NATX. STB TEMP LDA N22 MAXIMUM # BYTES UP TO A SLASH. STA CNTR * LOOP3 JSB .LBT LOOK FOR A SLASH (START OF PASSWORD). CPA SLASH JMP OUTP ISZ CNTR JMP LOOP3 * OUTP LDA CNTR MOVE BYTES UP TO SLASH (PASSWORD) ADA D22 TO PRINT LINE. STA CNTR SZA ANYTHING TO MOVE? JMP MVNAM YES. * NONE LDA B6 NO. MOVE "(NONE)" TO DISPLAY. STA CNTR LDA NONAD RAL RSS MVNAM LDA TEMP (IF PASSWORD ONLY, LDB DEST DISPLAY WILL BE "(NONE)".) RBL JSB .MBT DEF CNTR NOP * JMP GTNAM,I RETURN. SKP * * LOG ON TO ACCOUNT NAMES (IF ANY) SPECIFIED IN THE SW COMMAND * NODE QUALIFIERS. * LGON LDA UN1 QUALIFIER FOR NODE1? CPA BLANK JMP LGON2 NO. * LDB UNAM1 YES. SET UP "FIRST" & "LAST". JSB SETUP LDA NODE1,I LOG ON AT NODE1. JSB LOGON * LGON2 LDA UN2 QUALIFIER FOR NODE2? CPA BLANK JMP #RMSM,I NO. * LDB UNAM2 YES. SET UP "FIRST" & "LAST". JSB SETUP LDA NODE2,I LOG ON AT NODE2. JSB LOGON * JMP #RMSM,I RETURN. SKP * * SUPPLEMENTARY PROCESSING FOR "EX" COMMAND. * LOG OFF ALL REMOTE "SESSIONS" STILL ACTIVE - THIS INCLUDES CALLING * DLGOF FOR NON-SESSION-MONITOR NODES AND NON-SESSION ACCESS TO SESSION- * MONITOR NODES TO RELEASE PNL AND NAT ENTRIES. * IF THIS IS A NEW EXECUTION AND THE NAT HAS OLD INFO, THE NAT WILL BE * CLEARED BY THE DLGOF ROUTINE AND THE LOGOFF WILL BE IGNORED. * EXSUP LDA #NAT FWA NETWORK ACCOUNT TABLE. STA DEST LDA NAT# SET FOR # ENTRIES. STA CNTR * SCAN LDA DEST,I GET NODE # FROM NEXT ENTRYc. SZA,RSS JMP NEXT1 NOT IN USE. * JSB LOGOF LOG OFF SESSION AT NODE IN (A). * NEXT1 LDA DEST ADVANCE TO NEXT NAT ENTRY. ADA B4 STA DEST ISZ CNTR JMP SCAN LOOP TILL DONE. * JMP #RMSM,I RETURN. SPC 5 * * SUBROUTINE TO FIND END OF EXTRACTED & SAVED USER NAME, AND * SET UP "FIRST" & "LAST" BYTE POINTERS. * SETUP NOP RBL STB FIRST BYTE ADDR OF USER NAME. LDA BLANK SCAN FOR END OF NAME. JSB .SFB NOP WILL ALWAYS BE FOUND. STB LAST SET "LAST" POINTER. JMP SETUP,I RETURN. SKP * * CONSTANTS AND STORAGE. * B1 OCT 1 B2 OCT 2 B4 OCT 4 B6 OCT 6 B40 OCT 40 B377 OCT 377 BIT15 OCT 100000 NOTQ OCT 177417 D11 DEC 11 D18 DEC 18 D21 DEC 21 D22 DEC 22 D28 DEC 28 D33 DEC 33 N1 DEC -1 N2 DEC -2 N22 DEC -22 ICD2 OCT 100002 BLANK OCT 20040 BLANK,BLANK COMMA OCT 20054 BLANK,COMMA COLON OCT 26072 COMMA,COLON COMA2 OCT 26054 COMMA,COMMA SLASH OCT 57 "N1" ASC 1,N1 "N2" ASC 1,N2 "ON" ASC 1,ON "OF" ASC 1,OF "RS03 ASC 2,RS03 "SM04 ASC 2,SM04 SRCE NOP DEST NOP CNTR NOP NO2ND NOP FIRST NOP LAST NOP NODE NOP BYTLN NOP TEMP NOP IERR NOP XTRCT NOP BUFR BSS 3 UNAM1 DEF UN1 UNAM2 DEF UN2 UN1 BSS 17 (ONE EXTRA WORD) UN2 BSS 17 (ONE EXTRA WORD) * IFZ XEQT NOP DOT OCT 56 ASCII PERIOD. TEMP1 NOP RBUFA DEF RBUF RBUF BSS 11 ERBUF BSS 128 XIF SPC 5 NAT# DEC -16 NEG. # NAT ENTRIES. NATX# DEC -16 NEG. # NATX ENTRIES. * DNATX DEF *+1 NETWORK ACCOUNT TABLE EXTENSION REP 256 (NATX) FOR 16 16-WORD USER-NAMES. OCT 0 * BSS 0 SIZE OF #RMSM. * END TRNNT m 91750-18028 2013 S C0122 &#RQUE              H0101 [ASMB,Q,C,Z * ASSEMBLE FOR RTE-M,IV * IFN HED *<#RQUL> - CLASS REQUEUEING: RTE-L * (C) HEWLETT-PACKARD CO. 1980* NAM #RQUL,6 91750-1X028 REV.2013 800808 L EXT EXEC,$CLTA XIF IFZ HED *<#RQUE> - CLASS REQUEUEING: RTE-M/IV*(C) HEWLETT-PACKARD CO.1980* NAM #RQUE,30 91750-1X027 REV.2013 800808 MEF EXT $CLAS,$DLAY,$RNTB,$SCD3 XIF EXT .CBX,.CMW,.MVW,.ENTP,$LIBR,$LIBX,$OPSY ENT #CLTA,#NQUE,#PRGL,#QLIM,#RQUE UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< SUP IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * NAME: #RQUE * SOURCE: 91750-18027 [RTE-M,IV: 'Z' ASSEMBLY OPTION] * RELOC: 91750-1X027 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * NAME: #RQUL * SOURCE: 91750-18028 [RTE-L: 'N' ASSEMBLY OPTION] * RELOC: 91750-1X028 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * PGMR: C. HAMILTON [ 08/08/80 ] * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * #RQUE IS A CORE-RESIDENT SYSTEM SUBROUTINE, USED BY THE DISTRIBUTED * SYSTEMS SOFTWARE PACKAGE IN THE RTE-L, M, AND DISC-BASED RTE OPERATING * SYSTEMS ENVIRONMENTS. ITS PURPOSE IS TO PROVIDE A FAST, CORE-SAVING * METHOD FOR TRANSFERRING PREVIOUSLY-QUEUED CLASS I/O BUFFERS FROM ONE * CLASS TO ANOTHER CLASS. ALTERNATELY, IT CAN BE USED TO RE-QUEUE THE * COMPLETED CLASS-TRANSACTION ONTO A DEVICE QUEUE. #RQUE MAY BE * USED TO SEARCH FOR AND REQUEUE A SPECIFIC BLOCK IN A CLASS QUEUE. * * THE ADVANTAGES GAINED THROUGH THE USE OF <#RQUE> INCLUDE: * 1. ONCE GRANTED ADEQUATE SYSTEM AVAILABLE MEMORY(SAM) FOR THE INITIAL * CLASS READ OPERATION, INCOMING TRANSACTIONS WILL NOT BE IMPEDED * IN THEIR PROGRESSION THROUGH THE VARIOUS NETWORK-PROCESSING * MODULES, DUE TO INABILITY TO ALLOCATE SUFFICIENT S.A.M. FOR USE * IN THE EXCHANGE OF DATA BETWEEN THE NETWORK PROGRAMS. THE INITIALLY * ALLOCATED S.A.M. BUFFER IS RETAINED FOR THE LIFE OF THE * TRANSACTION, AND IS SIMPLY EXCHANGED AMONGST THE VARIOUS MODULES. * 2. INTERMEDIATE PROCESSORS REQUIRE ONLY MINIMUM SIZE LOCAL BUFFERS. * THE QUEUEING ROUTINES NEED NOT ALLOCATE BUFFER SPACE FOR THE * ENTIRE TRANSACTION, PRIOR TO PASSING IT ON TO THE NEXT * PROCESSOR'S CLASS. * 3. SYSTEM OVERHEAD CAN BE MINIMIZED, DUE TO THE AVOIDANCE OF INTER- * MEDIATE ALLOCATION/DE-ALLOCATION OF S.A.M., AND ALSO, BY * AVOIDING WORD-MOVE TRANSFERS BETWEEN USER'S BUFFERS AND S.A.M. * * #RQUE OPERATION: * * 0. IF ENTRY VIA #NQUE, TRANSFER RETURN ADDRESS TO #RQUE. GO TO 1. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * 1. ON FIRST ENTRY, CONFIGURE THE MODULE. * A. IF BIT #1 OF $OPSY =1, THEN OP-SYSTEM USES DMS HARDWARE, * REQUIRING THE USE OF DMS FIRMWARE MACRO INSTRUCTIONS. * B. IF DMS, THEN CLEAR THE DMS-BYPASSING 'JMP' INSTRUCTIONS. * C. IF NON-DMS, ALLOW 'JMP' INSTRUCTIONS TO REMAIN. * D. IF DMS, CONVERT 'MVW' 'NOP' INSTRUCTIONS TO 'MWF' 'RSS'. * E. CLEAR THE PATH TO THE INITIALIZATION ROUTINE. * * 2. GET PARAMETERS & SAVE LOCALLY, IN PREPARATION FOR DMS MAP SWITCH. * A. IF ANY PARAMETER, EXCEPT KEYWORD, IS MISSING, REJECT: IO01! * B. IF ICNWD SIGN =1, GET SECOND WORD OF 'XLUEX' CONWORD. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * 1. GET PARAMETERS AND SAVE LOCALLY. * A. IF ANY PARAMETER, EXECPT KEYWORD, IS MISSING, REJECT: IO01! * B. MOVE PARAMETERS INTO LOCAL STORAGE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * C. IF CONWORD Z-BIT =1, SAVE ADDRESS (VICE CONTENTS) FOR IBUFR,IPRM3. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * D. IF ICLAS =-1: BLOCK SIZE RESET, GO TO 7. (EXIT) NOT USED IN RTE-L. * E. IF REQUEST CODE IS POSITIVE, GO TO 2. TO VERIFY SOURCE CLASS. * F. IF REQUEST CODE IS NEGATIVE, CHECK FOR A RECOGNIZED CODE VALUE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * D. IF ICLAS =-1: BLOCK SIZE RESET, GO TO *.Q FOR QUICK PROCESSING. * E. OBTAIN CALLER'S PRIORITY, FOR USE IN EQT LINKING. * F. IF REQUEST CODE IS POSITIVE, GO TO *.P. TO CHECK FOR CONTROL REQ. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * G. IF RC=-17 TO -20, SET SEARCH FLAG =-1: SEARCH BOTH BUFFERS. * H. IF RC=-27 TO -30, SET SEARCH FLAG =-2: SEARCH DATA BUFFER, ONLY. * I. IF RC=-37 TO -40, SET SEARCH FLAG =-3: SEARCH Z-BUFFER, ONLY. * J. IF RC IS NEGATIVE, BUT NONE OF THE ABOVE VALUES, REJECT: "RQ "! * K. CONVERT NEGATIVE REQUEST CODE TO POSITIVE, WITH NO-ABORT BIT =1. * L. IF SEARCH MODE, AND ILEN NEG., MOVE SINGLE WORD SEARCH REFERENCE * TO INTERNAL BUFFER, AND BYPASS BUFFER MOVE CHECKING. * M. IF ILEN POSITIVE, VERIFY THAT CALLER'S SEARCH-REFERENCE BUFFER * LENGTH IS <= LENGTH OF INTERNAL BUFFER; ELSE, REJECT: IO01! * N. MOVE CALLER'S REFERENCE DATA TO INTERNAL BUFFER.g * O. IF SEARCH AND CONTROL REQUEST, POINTER TO CONTROL PARAMETER SET * EQUAL TO END OF REFERENCE BUFFER +1. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * P. IF DMS SYSTEM, SAVE MAP STATUS & SWITCH TO SYSTEM MAP. * * 3. GET THE SOURCE-CLASS PARAMETER & CHECK ITS VALIDITY. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * 2. GET THE SOURCE CLASS PARAMETER & CHECK ITS VALIDITY. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * A. IF 0, OR GREATER THAN MAX. CLASS NO., THEN--ERROR: IO00! * B. COMPUTE & SAVE CLASS-TABLE ENTRY ADDRESS. * C. IF ENTRY =0, THEN NOT ASSIGNED--ERROR: IO00! * D. IF SOURCE-CLASS, VERIFY THAT SOMETHING QUEUED; ELSE--ERROR: IO00! * E. SAVE ADDRESS OF QUEUED ENTRY (ADDRESS POINTS TO S.A.M.) * F. IF SEARCH FLAG >=0, GO TO *.U. TO SEARCH FOR CLASS TERMINATOR. * G. CONFIGURE ADDRESS POINTERS TO CLASS HEADER PARAMETERS. * H. IF SEARCH FLAG =-1/-2, SET SEARCH FWA=FWA CLASS DATA BUFFER. * I. IF SEARCH FLAG =-1, END OF SEARCH = END OF CLASS BLOCK+1. * J. IF SEARCH FLAG =-2, END OF SEARCH = END OF CLASS DATA BUFFER+1. * K. IF SEARCH FLAG =-3, & Z-BIT NOT SET IN HEADER CONWORD, GO TO *.U; * ELSE, START SEARCH =FWA Z-BUFFER, END SEARCH =END CLASS BLOCK+1. * L. IF 'ILEN' NEGATIVE, MAKE POSITIVE AND ADD -AS AN OFFSET- TO THE * START OF SEARCH ADDRESS, TO FORM A SINGLE-WORD SEARCH ADDRESS. * M. IF OFFSET SEARCH ADDRESS IS BEYOND END OF CLASS BUFFER, GO TO * *.U. TO IGNORE THIS PARTICULAR CLASS BLOCK. * N. IF 'ILEN' NEGATIVE, ENO OF SEARCH = START OF SEARCH+1. * O. SEARCH CLASS BLOCK DATA BUFFER(S) FOR WORD =FIRST REFERENCE WORD. * P. IF NO FIRST WORD MATCH, CONT(INUE SEARCH TO END OF CLASS BUFFER(S). * Q. MATCH: DO A WORD-BY-WORD COMPARISON. IF NO MATCH, GO BACK TO *.O. * R. COMPLETE MATCH: CLEAR 'ILEN' TO AVOID OVERWRITE OF HEADER PARAMS. * S. SAVE CLASS TABLE ADDRESS AND SET BLOCK POINTERS = LOCATED BLOCK * FOR DEQUEUE AND REQUEUE OPERATIONS. * T. SET SEARCH FLAG =+N: BLOCK LOCATED. * U. TRACK-DOWN/SAVE TERMINATOR ADDRESS; IF LINK WORD=0: ERROR IO00! * V. ACCUMULATE A COUNT = NUMBER OF BLOCKS QUEUED ON THE CLASS. * W. COMPARE SECURITY CODES; IF MIS-MATCH--ERROR: IO00! * X. ENSURE THAT NO ONE IS WAITING ON SOURCE-CLASS; ELSE: ERROR IO10! * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * 4. SAVE SOURCE-CLASS ADDRESS POINTERS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * 3. SAVE SOURCE CLASS ADDRESS POINTERS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * A. IF SEARCH FLAG STILL NEGATIVE, SEARCH FAILED. REJECT: IO01! * B. IF NON-SEARCH, SET ADDRESS POINTERS TO CLASS HEADER PARAMETERS. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * 5. CHECK VALIDITY OF DESTINATION-CLASS PARAMETER (VIA 3.A.). UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * 4. CHECK VALIDITY OF DESTINATION-CLASS PARAMETER (VIA 2.A). * A. IF NOLIM =0 AND BLOCK COUNT >MAX. ALLOWED(#QCNT): ERROR DS08! UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * A. IF -1, RESET NEG. BLOCK SIZE VALUE TO POS.; IGNORE OTHER PARAMS. * B. IF NOLIM =0 AND BLOCK COUNT > MAX. ALLOWED (#QCNT): ERROR DS08! * * 6. CHECK FOR "LU" SPECIFICATION. * A. IF NOT SUPPLIED, GO TO 9. TO VERIFY CALLER'S BUFFER LENGTHS. * B. CHECK FOR VALID LU: EQT#0, DEVICE NOT A DISC, ELSE ERROR IO02! * C. IF LU OR DEVICE IS DOWN, REJECT: ERROR DS08! * D. CALCULATE AND SAVE THE EQT ADDRESS. * * 7. CHECK FOR LU LOCKING. * A. IF NOT LOCKED, GO TO 8. TO CHECK REQUEST CODE. * B. IF LOCKED, AND PASSWORD NOT SUPPLIED, REJECT WITH ERROR: LU03! * C. IF LOCKED, AND PASSWORD INCORRECT, REJECT WITH ERROR: LU03! * * 8. CHECK 'ICODE', AND CONFIGURE THE CONTROL WORD. * A. MUST BE 17,18,19,20, OR ELSE REQUEST REJECTED: ERROR RQ . * B. CONFIGURE COMPLETE CONWORD(EQT WORD#6 FORMAT), BASED UPON CALLER'S * 'ICNWD' & DRT SUBCHANNEL SPECIFICATIONS. * C. IF DESTINATION CLASS PENDING-REQUEST COUNT =255D, REJECT: DS08! * D. IF PROCESSING CONTROL REQUEST, SET 'ILEN'=0 (DATA IS INVALID). * * 9. CHECK FOR AND VERIFY CALLER'S BUFFER LENGTH SPECIFICATIONS. * A. IF 'Z'-BIT NOT SET IN 'ICNWD', IGNORE CHAR. TO WORD CHECKS. * B. CHECK 'ILEN' FOR NEGATIVE(CHARS.) LENGTH, & CONVERT TO WORDS. * C. SAVE WORD-MOVE COUNTS FOR BOTH DATA & 'Z' BUFFER MODIFICATION. * D. IF NOTHING IS TO BE MOVED INTO CLASS BUFFER(S), GO TO 11. * E. IF CALLER'S TOTAL WORD-MOVE COUNT > CLASS BUFFER SIZE: ERROR IO04! * F. IF CONWORD IN CLASS HEADER HAS 'Z'-BIT(#12)=0, GO TO 10. * G. IF 'IPRM4' LENGTH EXCEEDS CLASS Z-BUFFER SPACE: ERROR IO04! * H. IF 'ILEN' LENGTH EXCEEDS CLASS DATA BUFFER SPACE: ERROR IO04! * * 10. MOVE CALLER'S DATA-IF ANY-INTO CLASS DATA AND/OR Z-BUFFER IN S.A.M. * * 11. DE-QUEUE COMPLETED CLASS REQUEST FROM SOURCE-CLASS QUEUE. * A. RE-LINK REMAINING ENTRIES BACK INTO SOURCE-CLASS QUEUE. * * 12. CHECK (AGAIN) FOR "LU" SPECIFICATION. * A. IF NOT SUPPLIED, GO TO 12.I TO ALLOW OVERLAY OF OPT. 'GET' PARAMS. * * B. IF LU & CONWORD WERE SUPPLIED, REPLACE CONWORD IN COMPLETED * REQUEST WITH USER-SUPPLIED PARAMETER. * C. ENSURE 'T'-FIELD OF CONWORD =3, AND THAT BIT #11 =0 (FOR RTIOC). * D. OVERLAY WORD #3 OF COMPLETED REQUEST WITH THE USER'S PRIORITY. * E. IF WRITE-REQUE, NEGATE BLOCK SIZE TO PREVENT RTIOC'S * ARBITRARY RELEASE OF THE DATA BUFFER. IF ALREADY NEG. MAKE POS. * F. REPLACE CLASS WORD OF COMPLETED REQUEST WITH THE DESTINATION- * CLASS PARAMETER. * G. IF RC=19, MOVE USER'S CONTROL PARAMETER INTO CLASS HEADER. * H. IF 'ILEN' #0, MOVE CALLER'S DATA LENGTH INTO CLASS HEADER. * I. IF Z-BIT IN HEADER CONWORD =0, AND OPTIONAL PARAMETERS SUPPLIED, * REPLACE WORD #7 AND/OR #8 IN CLASS HEADER WITH USER'S PARAMETERS. * J. IF LU NOT SUPPLIED, GO TO 14. TO REQUEUE THE CLASS BLOCK. * K. ADD 1 TO THE DESTINATION-CLASS PENDING REQUEST COUNT, IF < 255. * * 13. LINK THE NEW REQUEST (ACCORDING TO PRIORITY) INTO THE EQT QUEUE. * A. IF THE EQT IS CURRENTLY ACTIVE, THE DEED IS DONE--GO TO 16. * B. IF INACTIVE, INITIATE I/O OPERATION VIA $DLAY IN RTIOC. GO TO 16. * * 14. RE-QUEUE THE COMPLETED REQUEST ONTO THE DESTINATION-CLASS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * 5. RE-QUEUE THE LOCATED CLASS BLOCK. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * A. IF SEARCH FLAG =0, GO TO *.E. * B. CLASS SEARCH: IF SOURCE CLASS # DESTINATION CLASS, GO TO *.E. * C. SOURCE CLASS = DESTINATION CLASS: LOCATED CLASS BLOCK IS TO * BE REQUEUED TO THE HEAD OF THE SOURCE CLASS. * D. SET CLASS TABLE ENTRY = ADDRESS OF LOCATED BLOCK SET FIRST WORD * OF BLOCK = CLASS TERMINATOR-IF SINGLE ENTRY, OR ADDRESS OF NEXT UNL <<<<<<<<<<<<<<<<<<<<<<<<<<+<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * BLOCK IN CLASS QUEUE. GO TO *.F. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * BLOCK IN CLASS QUEUE. GO TO 7. * E. SET RETHREAD AND NO-WAIT BITS(#15,13) IN DESTINATION CLASS WORD. * F. IF REQUEST FOR CLASS CONTROL BLOCK REQUEUE, MAKE SPECIAL CALL. * G. CALL SYSTEM TO RETHREAD BLOCK TO END OF DEST. CLASS OR DEVICE. * H. IF SYSTEM CANNOT PROCESS REQUEST, RETURN ERROR: DS08! UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * E. LINK SOURCE BLOCK TO END OF DESTINATION CLASS QUEUE: MOVE DEST. * CLASS TERMINATOR TO WORD #1 OF SOURCE BLOCK; SET FIRST WORD OF * LAST BLOCK IN DEST. QUEUE EQUAL TO ADDRESS OF SOURCE BLOCK. * F. IF NEG. BLOCK LENGTH IN WORD#4 OF CLASS HEADER, MAKE IT POSITIVE. * G. OVERLAY WORD #5 OF COMPLETED REQUEST WITH DESTINATION-CLASS NO. * H. IF NEWLY-ADDED REQUEST IS ONLY ENTRY IN QUEUE, THEN GO TO 14.J. * TO CHECK FOR A WAITING PROGRAM. * I. IF OTHER ENTRIES ARE PRESENT, THEN GO TO 16. * J. CHECK TERMINATOR FOR PROGRAM-WAITING BIT(#14); IF NONE, GO TO 16. * K. IF A PROGRAM IS WAITING, SCHEDULE IT AND RETURN, VIA 16. * * 15. ERROR PROCESSING. * A. SET ASCII ERROR CODES. RETURN CODES TO CALLER IN . * B. REQUESTED ACTION NOT PERFORMED. GO TO 16. * * 16. EXIT PROCESSING. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * 6. ERROR PROCESSING. * A. SET ASCII ERROR CODES. RETURN CODES TO CALLER IN . * B. REQUESTED ACTION NOT PERFORMED. GO TO 7. * * 7. EXIT PROCESSING. UNK"L <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * A. IF 'ICODE' NO-ABORT BIT(#15) =1, AND NO ERROR HAS BEEN DETECTED, * SET RETURN POINT TO END-OF-PARAMETER-LIST +2. * B. IF ERROR DETECTED OR NO-ABORT BIT(#15) =0, SET RETURN POINT * TO END-OF-PARAMETER-LIST +1. * C. CLEAR ALL <.ENTP> PARAMETER ADDRESS LOCATIONS. * D. RETRIEVE ERROR CODES-IF ANY-FOR RETURN TO CALLER VIA . * E. IF DMS ENVIRONMENT, RESTORE THE USER MAP. * F. RETURN TO THE CALLER. SKP * JSB #RQUE/#NQUE * #RQUE CALLING SEQUENCE >>> NON-SEARCH <<< * * DEF *+9[OR *+10] (#NQUE ENTRY IGNORES 'ICLAS' QUEUE LIMIT CHECKS) * DEF ICODE REQUEST CODE: 17,18,19,20 [NEGATIVE: SEE SEARCH MODE] * DEF ICNWD CONTROL WORD(S) * DEF IBUFR DATA BUFFER ADDRESS OR "OPTIONAL" CONTROL PARAMETER. * DEF ILEN DATA BUFFER LENGTH (+WORDS/-CHARACTERS). * DEF IPRM3 GET-RETURN PARAMETER #1 OR Z-BUFFER ADDRESS * DEF IPRM4 GET-RETURN PARAMETER #2 OR Z-BUFFER LENGTH (+WDS/-CHARS) * DEF ICLAS DESTINATION CLASS NUMBER * DEF KCLAS SOURCE CLASS NUMBER * [DEF KEY] LU-LOCK PASSWORD (RN) [OPTIONAL] * =ASCII CODE[RETURN HERE IF ERROR & ICODE SIGN =1] * = 0 * * WHERE: * ICODE = REQUEST CODE: 17,18,19,20 (EQUIVALENT TO CLASS READ, CLASS * WRITE, CLASS CONTROL, OR CLASS WRITE-READ). A POSITIVE VALUE * SIGNIFIES A REQUEST FOR A REQUEUEING OF THE FIRST BLOCK IN * SOURCE CLASS(KCLAS) QUEUE ONTO THE END OF THE DESTINATION * CLASS(ICLAS) QUEUE; OR, IF THE LOGICAL UNIT FIELD OF THE * CONTROL WORD(ICNWD) IS NON-ZERO, THEN THE SOURCE CLASS BLOCK * WILL BE REQUEUED TO THAT DEVICE WHICH IS ASSOCIATED WITH THE * SPECIFIED LOGICAL UNIT. * * *** NOTE: IF THE LOGICAL UNIT IS ZERO, THEN ANY, OF THE FOUR * RECOGNIZED REQUEST CODES MAY BE SPECIFIED, IN ORDER * TO REQUEST A CLASS-TO-CLASS REQUEUE OPERATION. * IF THE LOGICAL UNIT IS NON-ZERO, THEN THE CONTROL * WORD IN THE CLASS HEADER (PASSED TO THE I/O DRIVER) * WILL BE CONFIGURED TO INCLUDE THE PROPER REQUEST * CODE VALUE (17:=1,18:=2,19:=3,20:=1), TO ALLOW * PROCESSING AS A NORMAL CLASS I/O REQUEST. * * ICNWD = CONTROL WORD, SPECIFIED IN CONVENTIONAL SINGLE WORD FORMAT * OR AS A DOUBLE WORD ('XLUEX' FORMAT) PARAMETER: * * SINGLE CONTROL WORD: * * *15*14*13*12*11*10* 9* 8* 7* 6* 5* 4* 3* 2* 1* 0* * +-----------------------------------------------+ UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * ! 0! X! X! Z! X! FUNCTION ! LOGICAL UNIT ! X=PASSED ON UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * ! 0! X! X! Z! X! FUNCTION ! LOGICAL UNIT ! X=IGNORED UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * +-----------------------------------------------+ * * **NOTE: BIT #15 MUST =0 FOR SINGLE WORD CONWORD** * * DOUBLE ('XLUEX') CONTROL WORD: * * WORD #1 * *15*14*13*12*11*10* 9* 8* 7* 6* 5* 4* 3* 2* 1* 0* * +-----------------------------------------------+ UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * ! 1! RESERVED ! LOGICAL UNIT ! UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!! !!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * ! 1! RESERVED ! LOGICAL UNIT ! UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * +-----------------------------------------------+ * * ** NOTE: WORD #1, BIT #15 MUST =1 FOR 'XLUEX' ** * * WORD #2 * *15*14*13*12*11*10* 9* 8* 7* 6* 5* 4* 3* 2* 1* 0* * +-----------------------------------------------+ UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * ! X! X! X! Z! X! FUNCTION ! RESERVED ! X=IGNORED UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * ! X! X! X! Z! X! FUNCTION ! RESERVED ! X=PASSED ON UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * +-----------------------------------------------+ * * **NOTE: IF 'LU'#0, THE 'KCLAS' BLOCK IS REQUEUED TO A DEVICE. * * IBUFR = USER BUFFER, CONTAINING DATA WHICH WILL BE USED TO * . OVERLAY THE CLASS DATA BUFFER IN S.A.M. THIS PARAMETER IS * O A DUMMY PLACE HOLDER, WHEN 'ILEN' =0. * R * . * IBUFR = "OPTIONAL" CONTROL PARAMETER, WHEN 'ICODE' =19. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * *** NOTE: REQUIRED BY #RQUE; "OPTIONAL" FOR THE DRIVER, ONLY. * * ILEN = LENGTH, IN +WORDS OR -CHARACTERS, OF THE AMOUNT OF DATA * TO BE MOVED FROM 'ITBUFR' TO THE CLASS DATA BUFFER. THE * LENGTH MAY BE <= THE S.A.M. BUFFER SPACE. THE CLASS HEADER * TRANSMISSION LOG WILL BE SET TO THE VALUE OF ILEN. * WHEN 'ILEN' =0, NO CHANGE IS MADE TO THE CLASS DATA BUFFER. * * IPRM3 = WHEN 'ICNWD' 'Z'-BIT =1: USER DATA BUFFER, CONTAINING DATA * O WHICH WILL BE USED TO OVERLAY THE CLASS 'Z' BUFFER IN S.A.M. * R * IPRM3 = WHEN 'ICNWD' 'Z'-BIT =0: OPTIONAL PARAMETER, WHICH WILL BE * STORED IN THE CLASS-BLOCK HEADER IN S.A.M. * THIS PARAMETER CAN BE RETRIEVED AS THE FIRST OPTIONAL * PARAMETER IN A SUBSEQUENT 'GET' REQUEST. WHEN 'IPRM3' =0, * NO CHANGE IS MADE TO THE CLASS BUFFER HEADER. * * IPRM4 = WHEN 'ICNWD' 'Z'-BIT =1: LENGTH IN +WORDS OR -CHARACTERS OF * . THE AMOUNT OF DATA TO BE MOVED FROM THE CALLER'S 'IPRM3' * . BUFFER INTO THE CLASS 'Z' BUFFER. THE LENGTH MAY BE <= THE * O ACTUAL 'Z' BUFFER SPACE IN S.A.M., BUT THE ORIGINAL 'Z' * R BUFFER LENGTH SPECIFICATION IN THE CLASS BUFFER HEADER * . WILL REMAIN UNCHANGED. * . * IPRM4 = WHEN 'ICNWD' 'Z'-BIT =0: OPTIONAL PARAMETER, WHICH WILL BE * STORED IN THE CLASS BLOCK HEADER IN S.A.M. * THIS PARAMETER CAN BE RETRIEVED AS THE SECOND OPTIONAL * PARAMETER IN A SUBSEQUENT 'GET' REQUEST. WHEN 'IPRM4' =0, * NO CHANGE IS MADE TO THE CLASS BUFFER HEADER. * * ICLAS = CLASS NUMBER, ONTO WHICH THE COMPLETED REQUEST IS TO BE * RE-QUEUED OR, THE CLASS WHICH IS TO RECEIVE I/O COMPLETION * INFORMATION, WHEN THE REQUEST HAS BEEN RE-QUEUED ONTO UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * AN EQUIPMENT TABLE ENTRY. IF -1, OTHER PARAMETERS ARE IGNORED * AND THE CURRENTLY-QUEUED SOURCE-CLASS BLOCK SIZE IS MADE POS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * A DEVICE QUEUE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * * KCLAS = CLASS NUMBER, FROM WHICH THE FIRST-QUEUED COMPLETED REQUEST * IS TO BE REMOVED. * * * KEY = OPTIONAL 'RN' NUMBER, WHICH MAY BE SPECIFIED TO ALLOW * THE CALLER TO REQUEUE A CLASS BUFFER ONTO A DEVICE WHICH * HAS BEEN LOCKED BY THE LU-LOCKING PROCEDURE. THE VALUE * SPECIFIED MUST BE THAT WHICH WAS RETURNED BY 'LURQ'. * *************************************************************************** UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * JSB #RQUE/#NQUE * #RQUE CALLING SEQUENCE >>> SEARCH MODE <<< * * DEF *+9[OR *+10] (#NQUE ENTRY IGNORES 'ICLAS' QUEUE LIMIT CHECKS) * DEF ICODE REQUEST CODE: NEGATIVE= CLASS SEARCH; SEE BELOW. * DEF ICNWD CONTROL WORD(S) * DEF IBUFR SEARCH BUFFER ADDRESS. * DEF ILEN SEARCH BUFFER LEN(+WORDS) OR OFFSET(1'S COMPLEMENT WDS) * DEF IPRM3 GET-RETURN PARAMETER#1 OR Z-BUFFER ADDRESS * DEF IPRM4 GET-RETURN PARAMETER#2 OR Z-BUFFER LENGTH (+WDS/-CHARS) * DEF ICLAS DESTINATION CLASS NUMBER * DEF KCLAS SOURCE CLASS NUMBER * [DEF KEY] LU-LOCK PASSWORD (RN) [OPTIONAL] * = ASCII CODE [RETURN HERE IF ERROR] * = 0 * * WHERE: * * ICODE = REQUEST CODE: -17,-18,-19,-20;-27,-28,-29,-30;-37,-38,-39,-40; * (RESPECTIVELY EQUIVALENT TO CLASS READ, CLASS WRITE, CLASS * CONTi ROL, AND CLASS WRITE-READ, WITHIN ALL GROUPS OF CODES.) * A NEGATIVE VALUE SIGNIFIES A USER'S REQUEST TO SEARCH WITHIN * A SPECIFIC PORTION (SEE TABLE, BELOW) OF ALL CLASS BLOCKS * WHICH ARE QUEUED ON THE SOURCE CLASS, IN ORDER TO LOCATE AND * REMOVE THAT PARTICULAR BLOCK WHICH MATCHES THE USER-SPECIFIED * SEARCH-REFERENCE DATA (SEE 'IBUFR','ILEN', BELOW). IF THE * USER HAS SPECIFIED A LOGICAL UNIT OF ZERO, AND IF THE SOURCE * (KCLAS) AND DESTINATION CLASS (ICLAS) NUMBERS ARE EQUAL, THEN * THE LOCATED--IF ANY--CLASS BLOCK WILL BE REQUEUED TO THE HEAD * OF THE SOURCE CLASS QUEUE. IF THE SOURCE AND DESTINATION * CLASS NUMBERS ARE NOT THE SAME, THEN THE LOCATED--IF ANY-- * CLASS BLOCK WILL BE REQUEUED ONTO THE END OF THE DESTINATION * CLASS QUEUE. * IF THE USER HAS SPECIFIED A NON-ZERO LOGICAL UNIT, THEN THE * LOCATED CLASS BLOCK WILL BE REQUEUED TO A DEVICE, AS NOTED * ABOVE, FOR POSITIVE REQUEST CODES. * * ICODE VALUES * +--------+--------+--------+--------+-+--------+ * IF LU#O,! CLASS ! CLASS ! CLASS ! CLASS !*! SEARCH ! * BECOMES:! READ ! WRITE ! CONTROL!WRT-READ!*! BUFFER ! * +--------+--------+--------+--------+-+--------+ * ! 17 ! 18 ! 19 ! 20 !*! NONE ! * +--------+--------+--------+--------+-+--------+ * ! -17 ! -18 ! -19 ! -20 !*! ALL ! * +--------+--------+--------+--------+-+--------+ * ! -27 ! -28 ! -29 ! -30 !*!DATA BUF! * +--------+--------+--------+--------+-+--------+ * ! -37 ! -38 ! -39 ! -40 !*! Z-BUF. ! * +--------+--------+--------+--------+-+--------+ * * ICNWD = SAME AS NON-SEARCH MODE; SEE ABOVE. * *  IBUFR = USER REFERENCE BUFFER, CONTAINING 1 TO 10 WORDS, FOR COM- * . PARISON WITH CLASS BLOCK DATA, WHEN SEARCHING FOR CLASS BLOCK. * . * . *** NOTE: FOR THE CASE OF MULTI-WORD REFERENCE OPERATIONS, * . WHEN THE LOCATED BLOCK IS TO BE REQUEUED ONTO AN EQT AS A * . CLASS I/O CONTROL REQUEST('ICODE'= -19,-29,-39, AND 'ICNWD' * . LU FIELD #0), THE WORD IMMEDIATELY FOLLOWING 'IBUFR' * . (LOCATION ='IBUFR'+'ILEN') MUST CONTAIN THE "OPTIONAL" * . CONTROL PARAMETER WHICH WILL BE SPECIFIED TO THE DEVICE * . DRIVER. THIS PARAMETER IS REQUIRED BY #RQUE, BUT MAY BE * . OPTIONAL FOR THE DRIVER. * . * ILEN = POSITIVE WORD COUNT >0: SIZE OF USER'S REFERENCE BUFFER. * * IBUFR = SINGLE WORD SEARCH REFERENCE, FOR COMPARISON WITH A SINGLE * . WORD IN THE CLASS BLOCK, WHICH IS LOCATED AT AN OFFSET INTO * . THE SPECIFIED BUFFER(SEE 'ICODE'), AS DEFINED BY 'ILEN'. * . * . *** NOTE: FOR THE CASE OF THE SINGLE WORD SEARCH, WHEN THE * . LOCATED BLOCK IS REQUESTED TO BE REQUEUED ONTO AN EQT AS * . A CLASS I/O CONTROL REQUEST (ICODE=-19,-29,-39; 'ILEN' IS * . NEGATIVE; AND 'ICNWD' LU FIELD #0), 'IBUFR' MUST POINT TO * . A 2-WORD ARRAY: WORD#1 =SINGLE WORD SEARCH REFERENCE, AND * . WORD#2 ="OPTIONAL" CONTROL PARAMETER. * . * ILEN = 1'S COMPLEMENT, SIGNIFYING A SINGLE-WORD SEARCH REFERENCE. * THIS VALUE IS CONVERTED TO A POSITIVE OFFSET FOR COMPUTATION * OF A SPECIFIC ADDRESS WITHIN THE SPECIFIED CLASS BLOCK BUFFER * (SEE 'ICODE'). THE CONTENTS OF THIS ADDRESS WILL BE COMPARED * TO THE SINGLE WORD SEARCH REFERENCE (SEE 'IBUFR'), WHEN * ATTEMPTING TO LOCATE THE DESIRED CLASS BLOCK. * * IPRM3 = SAME AS NON-SEARCH MODE; SEE ABOVE. * * IPRM4 = SAME AS NON-SEARCH MODE; SEE ABOVE. * * ICLAS = SAME AS NON-SEARCH MODE; SEE ABOVE. * * KCLAS = SAME AS NON-SEARCH MODE; SEE ABOVE. * * ** NOTE: FOR CLASS SEARCH OPERATIONS, WHEN 'LOGICAL UNIT' =0, * IF DESTINATION CLASS = SOURCE CLASS, THEN * THE LOCATED CLASS BLOCK WILL BE REQUEUED ONTO THE * HEAD OF KCLAS. IF ICLAS # KCLAS, THE LOCATED CLASS * BLOCK WILL BE REQUEUED ONTO THE END OF ICLAS. * * KEY = SAME AS NON-SEARCH MODE; SEE ABOVE. * SKP * * #RQUE ERROR INDICATIONS: * * ERROR DETECTION WILL RESULT IN A RETURN TO THE CALLER, WITH THE * REQUESTED ACTION NOT PERFORMED. * * THE -REGISTERS WILL CONTAIN ASCII ERROR CODES, AS FOLLOWS: * * IO00 : INVALID CLASS SPCIFICATION. * * IO01 : PARAMETER MISSING, OR INVALID, OR CLASS SEARCH FAILED. * * IO02 : INVALID LOGICAL UNIT. * * IO04 : INVALID BUFFER SPECIFICATION. * * IO10 : PROGRAM WAITING ON SOURCE CLASS (REQUEUEING NOT ALLOWED). * * DS08 : RESOURCES NOT AVAILABLE OR 'ICLAS' QUEUE LIMIT EXCEEDED. * * LU03 : LOGICAL UNIT LOCKED/INVALID PASSWORD. * * RQ : REQUEST CODE IS INVALID. * SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * * RTE-M,IV CLASS QUEUE DESCRIPTION: * * * CLASS TABLE * +---------------+ * $CLAS ....+ NO. CLASSES(3)+ CLASS BLOCK #1 LAST CLASS BLOCK * +---------------+ +---------------+ +----------------+ * (CLASS#3) + POINTER +->->+ POINTER +->->+ 1XX(TERMINATOR)+ * +---------------+ +---------------+ +----------------+ * (CLASS#2) +1XX(ALLOCATED) + + CONWORD + + + * +---------------+ +---------------+ +----------------+ * (CLASS#1) +000(AVAILABLE) + +PRIORITY/STATUS+ + + * +---------------+ +------~---------+ +----------------+ * + BLOCK SIZE + + + * +---------------+ +----------------+ * + CLASS WORD + + + * +---------------+ +----------------+ * +DATA LEN/CON PR+ + + * +---------------+ +----------------+ * +GET P1/Z-BUF AD+ + + * +---------------+ +----------------+ * +GET P2/Z-BUF LN+ + + * +---------------+ +----------------+ * + + + + * + DATA + + + * + + + + * + BUFFER + + + * + + + + * +---------------+ +----------------+ * + + + + * + Z - BUFFER + + + * + (OPTIONAL) + + + * + + + + * +---------------+ +----------------+ * * * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * * RTE-L CLASS QUEUE DESCRIPTION: * * * CLASS TABLE * +---------------+ * $CLTA ->->+ NO. CLASSES(3)+ CLASS BLOCK #1 LAST CLASS BLOCK * +---------------+ +---------------+ +----------------+ * (CLASS#3) +  POINTER +->->+ POINTER +->->+ 1XX(TERMINATOR)+ * +---------------+ +---------------+ +----------------+ * (CLASS#2) +1XX(ALLOCATED) + + CONWORD + + + * +---------------+ +---------------+ +----------------+ * (CLASS#1) +000(AVAILABLE) + +DATA ADR/CON PR+ + + * +---------------+ +---------------+ +----------------+ * +DA.LN/PRM2/XLOG+ + + * +---------------+ +----------------+ * +GET R1/Z-BUF AD+ + + * +---------------+ +----------------+ * +GET R2/Z-BUF LN+ + + * +---------------+ +----------------+ * +PRIORITY/STATUS+ + + * +---------------+ +----------------+ * + BLOCK SIZE + + + * +---------------+ +----------------+ * + CLASS WORD + + + * +---------------+ +----------------+ * + GET PARAM UV + + + * +---------------+ +----------------+ * + + + + * + DATA + + + * + + + + * + BUFFER + + + * + + + + * +---------------+ +----------------+ * + + + + * + Z - BUFFER + +  + * + (OPTIONAL) + + + * + + + + * +---------------+ +----------------+ * * * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SKP #NQUE NOP ALTERNATE ENTRY: NO #QCNT LIMIT CHECKS. JSB $LIBR DECLARE THIS TO BE UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> NOP A PRIVILEGED ROUTINE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DEF TDB A RE-ENTRANT ROUTINE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LDA #NQUE TRANSFER THE ALTERNATE-ENTRY FLAG STA NOLIM SAVE PROTECTED COPY OF '#NQUE'. STA #RQUE (RETURN POINTER) TO NORMAL ENTRY POINT. JMP GETPR GO TO OBTAIN USER'S PARAMETERS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> TDB NOP TEMPORARY DATA BLOCK. ABS #RQUE-TDB TDB SIZE. RTNPT NOP RETURN POINTER. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> NOLIM NOP PROTECTED COPY OF '#NQUE'. ICODE NOP REQUEST CODE. ICNWD NOP CONTROL WORD(S). IBUFR NOP DATA BUFFER ADDRESS OR CONTROL PARAMETER. ILEN NOP DATA BUFFER LENGTH IPRM3 NOP RETURN PRAM.1 OR Z-BUFFER ADDRESS. IPRM4 NOP RETURN PRAM.2 OR Z-BUFFER LENGTH. ICLAS NOP DESTINATION CLASS NUMBER. KCLAS NOP SOURCE CLASS NUMBER. KEY NOP LU-LOC°K PASSWORD (RN). #RQUE NOP NORMAL ENTRY. JSB $LIBR DECLARE THIS TO BE UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DEF TDB A RE-ENTRANT ROUTINE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> NOP A PRIVILEGED ROUTINE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> GETPR JSB .ENTP OBTAIN DIRECT ADDRESSES PRPTR DEF ICODE FOR ALL PARAMETERS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> STA RTNPT SAVE RETURN ADDRESS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CLA =0 FOR 'CONFG' & 'ERR' INITIALIZATION UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> STA EXADJ INITIALIZE FOR ERROR RETURN. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> INIT JMP CONFG CONFIGURE ON FIRST PASS; NOP,THEREAFTER. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> STA ERCOD INITIALIZE THE STA ERCOD+1 ERROR STORAGE STA SERFL AND SEARCH FLAG =0. LDB DM9 INITIALIZE A STB TEMP COUNTER FOR PARAMETER PROCESSING. CPA ICNWD IF A CONTROL WORD WASN'T SPECIFIED, JMP ERI01 THEN REJECT THE REQUEST. * DLD ICNWD,I GET THE USER'S CONTROL WORD(S). SSA,RSS IF THE SIGN OF WORD#1 IS CLEAR, JMP STCON THEN IT'S A SINGLE ZCONWORD. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LDA B GET FUNCTION BITS FROM WORD#2. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> AND B77 IT'S 'XLUEX' FORMAT: ISOLATE LU IOR B AND FORM A SINGLE CONWORD. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> STCON STA CONWD SAVE LOCALLY. LDB PRPTR GET POINTER TO PARAMETER ADDRESSES. PLOOP LDA B,I GET THE PARAMETER ADDRESS (OR ZERO). CPB KEYPT IF THIS IS THE PASSWORD PARAMETER, JMP GETKY THEN IT'S OPTIONAL, SO IGNORE CCHECKS; SZA,RSS ELSE, IF PARAMETER WAS NOT SUPPLIED, JMP ERI01 THEN REJECT THE INVALID REQUEST! * CPB IBUFP IF THIS IS THE BUFFER ADDRESS PARAMETER, JMP SVPRM THEN RETAIN AN ADDRESS, NOT A VALUE. CPB IPR3P IF THIS IS POSSIBLE Z-BUFFER ADDRESS, UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> STA IPR3A SAVE IT AS SOURCE FOR Z-BUF. OVERLAY. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP SVPRM THEN THE ADDRESS WILL BE REQUIRED. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> GETKY LDA A,I GET THE USER-SUPPLIED PARAMETER. STA B,I SAVE PARAMETER, LOCALLY. SVPRM INB ADVANCE PARAMETER ADDRESS POINTER. ISZ TEMP ALL PARAMETERS PROCESSED? JMP PLOOP NO. CONTINUE PROCESSING. LDA ICLAS GET DESTINATION CLASS PARAMETER. CPA DM1 IF IT'S A BLOCK |SIZE RESET REQUEST, THEN UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP EXIT IGNORE IT IN THE RTE-L ENVIRONMENT; * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP MAPSW BYPASS NEEDLESS PROCESSING. * LDA XPRIO,I GET CALLERS PRIORITY, STA PRIOR AND SAVE FOR LATER USE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LDA ICODE GET CALLER'S REQUEST CODE. STA B SAVE A COPY IN . RAL POSITION BITS #15,#14 FOR NEG. CODE TEST. SSA,SLA,RSS IF THE REQUEST CODE IS POSITIVE, THEN UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP CNTL? IT'S NOT A SEARCH. CHECK FOR CONTROL. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP CKSCL IT'S NOT A SEARCH; SKIP INITIALIZATION. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * RAR RESTORE THE NEGATIVE REQUEST CODE. ADA D16 IF THE REQUEST CODE SSA,RSS IS BETWEEN -1, AND -16, JMP ERRQ THEN IT IS IN ERROR: "RQ "! * ADA D4 IF THE REQUEST CODE SSA,RSS IS BETWEEN -17, AND -20, JMP SM1 THEN IT'S A SEARCH MODE 1 REQUEST. * ADA D6 IF THE REQUEST CODE SSA,RSS IS BETWEEN -21, AND -26, JMP ERRQ THEN IT IS AN ERROR: "RQ "! * ADA D4 IF THE REQUEST CODE SSA,RSS IS BETWEEN -27, AND -30, JMP SM2 THEN IT'S A SEARCH MxODE 2 REQUEST. * ADA D6 IF THE REQUEST CODE SSA,RSS IS BETWEEN -31, AND -36, JMP ERRQ THEN IT IS AN ERROR: "RQ "! * ADA D4 IF THE REQUEST CODE SSA IS BEYOND -40, THEN JMP ERRQ IT IS AN ERROR: "RQ "! * ADB D20 CONVERT REQUEST CODE: -17 TO -20. LDA DM3 SEARCH FLAG =-3: Z-BUFFER, ONLY. JMP INITS GO COMPLETE SEARCH INITIALIZATION. * SM2 ADB D10 CONVERT REQUEST CODE: -17 TO -20. LDA DM2 SEARCH FLAG =-2: DATA BUFFER, ONLY. JMP INITS GO COMPLETE SEARCH INITIALIZATION. * SM1 LDA DM1 SEARCH FLAG =-1: ENTIRE BUFFER. INITS STA SERFL SET SEARCH FLAG FOR 'CLCHK'. CMB,CCE,INB CONVERT TO POSITIVE REQUEST CODE, RBL,ERB ADD THE NO-ABORT BIT(#15), AND STB ICODE RESTORE AS POSITIVE REQUEST CODE. LDA ILEN GET REFERENCE-DATA BUFFER LENGTH. SSA,RSS IF POSITIVE, THEN JMP MVREF GO TO OBTAIN THE REFERENCE DATA; * LDA IBUFR,I ELSE, IT'S AN OFFSET, SO GET STA RFBUF THE SINGLE-WORD REFERENCE, ISZ IBUFR POINT TO "OPTIONAL" CONTROL PARAM., UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP CNTL? AND BYPASS THE BUFFER MOVE. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP CKSCL AND BYPASS THE BUFFER MOVE. * SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> MVREF CMA,INA,SZA,RSS MAKE REFERENCE BUFFER LENGTH NEGATIVE. JMP ERI01 IF LENGTH IS ZERO: "IO01" ERROR! * ADA RFMAX IF HIS BUFFER EXCEEDS THE INTERNAL SSA REFERENCE BUFFER BUFFER SIZE, JMP ERI01 TiHEN REJECT THE REQUEST! * LDA IBUFR GET THE REFERENCE BUFFER ADDRESS. LDB RFBFA GET ADDRESS OF INTERNAL BUFFER, JSB .MVW AND MOVE DATA TO LOCAL BUFFER. DEF ILEN NOP STA IBUFR SET POINTER TO "OPTIONAL" CONTROL PARAM. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * LDB ICODE GET THE REQUEST CODE, AGAIN. CNTL? RBR POSITION FOR TESTING. SSB,SLB,RSS SKIP, IF THIS IS A CONTROL REQUEST; JMP MAPSW ELSE, IGNORE OPTIONAL PARAMETER. * LDA IBUFR,I CONTROL: GET THE ACTUAL PARAMETER, STA IBUFR AND SAVE IT FOR LATER USE. * MAPSW JMP CKSCL BYPASS MAP CODE:NON-DMS / NOP:DMS RSA GET CURRENT MAP STATUS. RAL,RAL POSITION CURRENT STATUS FOR RESTORATION. STA DMSTS SAVE FOR RESTORATION, UPON EXIT. SJP CKSCL ENABLE SYSTEM MAP, AND CONTINUE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * CKSCL LDA KCLAS GET THE SOURCE CLASS-WORD. JSB CLCHK GO TO DETERMINE ITS VALIDITY. LDA SERFL IF THE SEARCH FAILED SSA TO LOCATE THE SPECIFIED JMP ERI01 BUFFER, THEN REPORT ERROR IO01! * SZA IF THIS IS A SEARCH OPERATION, JMP CKDCL THEN THE POINTERS ARE ALREADY SET. * DLD BLKAD SAVE THE SOURCE-CLASS ADDRESS POINTERS: DST SBLK =SAM BLOCK FWA, =CLASS TABLE ADDR. STA B SAVE BLOCK ADDRESS FOR USE BY 'SETP'. JSB SETP ESTABLISH POINTERS TO THE CLASS HEADER. * CKDCL LDA ICLAS GET THE DESTINATION CLASS-WORD. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CPA DM1 IF THE PARAMETER IS =-1, THEN JMP RESET GO TO RESET POSSIBLE NEG. BLOCK SIZE. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CPA KCLAS IF SOURCE CLASS = DESTINATION CLASS, NO UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP CNWCK NEED TO VERIFY AGAIN OR CHECK Q-COUNT. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP SRCH? NEED TO VERIFY AGAIN OR CHECK Q-COUNT. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * JSB CLCHK ELSE, GO TO VERIFY ITS VALIDITY. * LDA NOLIM GET ALTERNATE-ENTRY FLAG. SZA IF IT IS SET, THEN NO CHECKING DESIRED, UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP CNWCK SO BYPASS DESTINATION QUEUE LIMIT TEST. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP SRCH? SO BYPASS DESTINATION QUEUE LIMIT TEST. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LDB QCNT GET BLOCK COUNT FOR DESTINATION CLASS. ADB #QLIM SUBTRACT MAXIMUM ALLOWABLE COUNT. CLE,SSB,RSS IF MAXIMUM EXCEEDED, REJECT THE REQUEST. JMP ERDS8 THEN ANOTHER BLOCK IS NOT ACCEPTABLE. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CNWCK LDA ICNWD GET THE USER-SPECIFIED CONWORD ELA,RAR GET XLUEX SIGN BIT --IF ANY. AND B377 ISOLATE LU FIELD: BITS# 7-0. SEZ,RSS IF IT'S XLUEX FORMAT, SKIP; AND B77 ELSE, ISOLATE ONLY BITS# 5-0. STA LU SAVE THE MASKED LOGICAL UNIT NO. SZA,RSS IF IT'S LOGICAL UNIT NO. 0 JMP LENCK SKIP THE EQT CHECKS. SPC 1 * VERIFY THAT CALLER HAS REQUESTED DATA FOR A VALID LOGICAL UNIT NO. SPC 1 ADA DM1 SUBTRACT ONE, FOR VALIDITY CHECKING. STA B SAVE FOR DRT INDEXING. CMA,CLE IF THE SPECIFIED LU NUMBER ADA LUMAX IS NOT IN THE RANGE: SEZ,RSS 1<=LU<=LUMAX, THEN JMP ERI02 THE LU IS INVALID! * * RETRIEVE THE CONTENTS OF THE DEVICE REFERENCE TABLE ENTRY. SPC 1 ADB DRTA FIND THE DEVICE REFERENCE TABLE ENTRY LDA B INDEX INTO ADA LUMAX THE SECOND HALF OF THE DRT. LDA A,I GET WORD 2 OF THE DRT ENTRY. SSA IF THE SIGN IS SET, THEN JMP ERDS8 THE LU IS DOWN--REJECT THE CALL! * LDA B,I GET THE CONTENTS OF THE DRT ENTRY. STA DRTEN SAVE THE DRT ENTRY TEMPORARILY. AND B77 ISOLATE THE EQT ORDINAL. SZA,RSS IF THE ORDINAL IS ZERO, JMP ERI02 REJECT: ILLEGAL TO REQUE TO EQT #0! SKP * CALCULATE THE ADDRESS OF THE EQUIPMENT TABLE ENTRY LINKED TO THE LU. SPC 1 ADA DM1 ORDINAL-1 =RELATIVE EQT ENTRY ORDINAL. MPY D15 RELATIVE ENTRY*WORDS/ENTRY =OFFSET. LDB A GET EQT-ENTRY OFFSET IN . ADB EQTA FORM ABSOLUTE EQT-ENTRY ADDRESS IN . STB EQTAD SAVE THE EQT ADDRESS FOR THE CALLER. * ADB D4 POINT TO WORD #5 OF THE EQT ENTRY. LDA B,I GET THE CONTENTS. RAL,SLA IF THE DEVICE IS BUSY, OR IT IS JMP CDISC WAITING FOR DMA--CONTINUE; SSA ELSE, IF IT IS DOWN, JMP ERDS8 THEN REJECT THE REQUEST! * CDISC AND B74K ISOLATE THE EQUIPMENT TYPE CODE. CPA B30K IF THE EQT IS LINKED TO A DISC FILE, JMP ERI02 * ERRO7aR: INVALID LU! * LDA DRTEN GET THE DRT ENTRY. LSR 6 MOVE LU LOCK FLAG (BITS#10-6) TO LSB'S. AND B37 ISOLATE THE RN INDEX VALUE. SZA,RSS IS THE LOGICAL UNIT LOCKED? JMP PASS NO, NO OTHER CHECKING REQUIRED. * LDB KEY YES, GET THE USER-SUPPLIED PASSWORD. SZB,RSS IF CALLER DID NOT SUPPLY PASSWORD, JMP ERLU3 THEN ACCESS IS DENIED; ELSE, STA B SAVE THE RN TABLE INDEX VALUE. ADA RNTBA INDEX INTO THE RN TABLE LDA A,I AND EXTRACT THE ENTRY CONTENTS. AND B377 ISOLATE CURRENT USER'S INDEX VALUE, ALF,ALF AND POSITION TO UPPER BYTE. IOR B RE-CONSTITUTE A VALID PASSWORD. CPA KEY DOES THE CALLER QUALIFY TO USE THE LU? JMP PASS YES, CONTINUE PROCESSING THE REQUEST. JMP ERLU3 NO, REJECT THE REQUEST. * PASS LDB ICODE GET THE CALLER'S REQUEST CODE. RBL,CLE,ERB REMOVE THE 'NO-ABORT' BIT. ADB DM17 IF THE CALLER'S REQUEST CODE CLE,SSB IS LESS THAN 17 (CLASS READ), JMP ERRQ THEN THE REQUEST IS UNACCEPTABLE! * ADB DM4 IF THE CALLER'S REQUEST CODE CLE,SSB,RSS IS GREATER THAN 20 (WRITE-READ), JMP ERRQ IT ALSO, IS NOT ACCEPTABLE! * ADB D5 RESTORE THE MASKED REQUEST CODE. CLE CPB D4 IF THE CODE IS =4 (WRITE-READ), CLB,INB THEN CONVERT IT TO 1 (READ). LDA CONWD GET THE FUNCTION DATA. AND B137C ISOLATE 'Z' & FUNCTION (BITS# 12,10-6). STA CONWD SAVE THEM TEMPORARILY. * LDA DRTEN GET DRT ENTRY, AGAIN. AND B174K ISOLATE SUB-CHANNEL BITS (#15-13). ELA,ALF POSITION MSB TO , AND RAL,RAL POSITION LSB'S TO BITS #5-2. IOR CONWD INCLUDE THE CALLER'S FUNCTION, AND SEZ IF THE SUB-CHANNEL MSB WAS SET, THEN IOR BIT13 SET BIT #13 OF THE CpONWD, ALSO. IOR B INCLUDE CALLER'S REQUEST CODE, AND STA CONWD SAVE THE CONWD FOR LATER USE. * LDA TERMA,I GET THE DESTINATION-CLASS TERMINATOR. AND B377 ISOLATE THE PENDING REQUEST COUNT. CPA B377 IF IT HAS ALREADY REACHED MAXIMUM (255), JMP ERDS8 THEN REJECT THE NEW REQUEST! * CLA CPB D3 IF THIS IS A CONTROL REQUEST, STA ILEN THEN DATA LENGTH MUST BE IGNORED. LENCK LDB CONWD GET THE CONTROL WORD, AND POSITION BLF,CLE,ERB THE Z-BIT(#12) TO , FOR TESTS. CLB,SEZ,RSS IF THIS ISN'T A DOUBLE-BUFFERED REQUEST, JMP DLNCK THEN BYPASS THE Z-BUFFER LENGTH CHECK; LDB IPRM4 ELSE, GET THE Z-BUFFER LENGTH VALUE. SSB,RSS IF LENGTH IS IN NEGATIVE BYTES, SKIP; JMP DLNCK ELSE, GO ACCUMULATE DATA BUFFER LENGTH. BRS CONVERT BYTE COUNT TO NEGATIVE WORDS, CMB,INB AND MAKE THE WORD COUNT POSITIVE. DLNCK LDA ILEN GET CALLER'S DATA BUFFER LENGTH. SSA,RSS IF LENGTH IS IN NEGATIVE BYTES, SKIP; JMP SAVLN ELSE, GO SAVE WORD-MOVE LENGTHS. ARS CONVERT BYTE COUNT TO NEGATIVE WORDS, CMA,INA AND MAKE THE WORD COUNT POSITIVE. SAVLN DST TEMP SAVE: =DATA MOVE CNT.,=Z MOVE CNT. ADA B ADD TOTAL NUMBER OF WORDS TO BE MOVED. CMA,INA,SZA,RSS MAKE TOTAL NEG., AND IF IT'S =0, JMP DEQUE THEN THE BUFFERS REMAIN UNTOUCHED. * LDB BLKSP,I GET THE TOTAL BLOCK SIZE. SSB IF THE BLOCK SIZE IS ALREADY NEGATIVE, CMB,INB MAKE IT POSITIVE, FOR THE LENGTH CHECK. ADB NHDSZ SUBTRACT HEADER: REMAINDER= BUFFER SIZE. ADA B ADD USER'S SIZE TO ACTUAL BUFFER SIZE. SSA USER'S REQUEST > ACTUAL BUFFER SIZE? JMP ERI04 YES! REJECT THE REQUEST: ERROR -8. * LDA CONWP,I GET CONTROL WORD FROM CLASS HEADER. ALF,CLE,ERA POSITION>/ Z-BIT TO , FOR TESTING. SEZ,CLE,RSS IF THE DOUBLE-BUFFER BIT ISN'T SET, JMP MVDAT THEN BYPASS ADDITIONAL LENGTH CHECKS. LDA ZLENP,I GET QUEUED Z-BUFFER LENGTH FROM S.A.M. CMA IF THE USER-SPECIFIED ADA TEMP+1 NUMBER OF WORDS TO BE MOVED SSA,RSS EXCEEDS THE AVAILABLE BUFFER SPACE, JMP ERI04 THEN THE REQUEST CANNOT BE HONORED! * LDA DABFA GET THE FWA OF THE DATA BUFFER IN S.A.M. ADA TEMP ADD NUMBER OF CALLER'S WORDS TO BE MOVED, CMA,INA AND FORM AN OFFSET VALUE FOR TESTING. ADA ZBUFP,I IF THE MOVE WILL EXCEED THE ALLOCATED SSA MEMORY FOR THE CLASS DATA BUFFER, JMP ERI04 THEN THE REQUEST CANNOT BE PROCESSED! * MVDAT LDB TEMP GET THE DATA BUFFER MOVE COUNT. SZB,RSS IS THE DATA BUFFER TO BE MODIFIED? JMP ZMOVE NO. CHECK FOR Z-BUFFER MODIFICATION. * LDA CONWP,I GET CONWORD FROM CLASS HEADER. AND D3 ISOLATE REQUEST CODE. CPA D3 IF THIS IS A CLASS CONTROL BUFFER, JMP ERI04 THEN OVERLAYING DATA IS UNACCEPTABLE! * JSB .CBX SAVE MOVE COUNT IN [DMS USE ONLY]. LDA IBUFR GET CALLER'S DATA BUFFER ADDRESS. LDB DABFA GET ADDRESS OF DATA BUFFER IN S.A.M. DMS1 JSB .MVW MOVE FROM USER TO CLASS [DMS: MWF,RSS]. DEF TEMP NOP * ZMOVE LDB TEMP+1 GET THE OPTIONAL BUFFER MOVE COUNT. SZB,RSS IS THE Z-BUFFER TO BE MODIFIED? JMP DEQUE NO. GO TO DEQUEUE THE CLASS BLOCK. * *#####STA ZLENP,I YES. SAVE Z-BUFFER LENGTH: WORDS, *#####STB ZBUFP,I AND ADJUSTED Z-BUFFER ADDRESS. JSB .CBX SAVE MOVE COUNT IN [DMS USE ONLY]. LDA IPR3A GET CALLER'S Z-BUFFER ADDRESS. LDB ZBUFP,I GET ADDRESS OF Z-BUFFER IN S.A.M. DMS2 JSB .MVW MOVE FROM CALLER TO CLASS [DMS:MWF,RSS]. DEF TEMP+1 NOP * SKP UNL <<<<<<<<<<<<<<=<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SRCH? LDA SERFL IF THIS IS NOT A SZA,RSS CLASS SEARCH OPERATION, THEN JMP XCALL GO TO CALL THE SYSTEM. * JSB $LIBR LOWER THE M.P. FENCE, IN ORDER TO NOP FACILITATE CLASS LIST MANIPULATION. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DEQUE LDA SQHED IF THE REQUEST IS TO LDB SBLK RE-QUEUE ONTO THE SAME CLASS, CPB TERMA AND ONLY ONE ENTRY IS PRESENT, THEN STA TERMA POINT TO CORRECT TERMINATOR ADDRESS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LDA SBLK,I DE-QUEUE THE COMPLETED CLASS REQUEST STA SQHED,I FROM THE SOURCE-CLASS QUEUE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LDB CONWP,I RETAIN ORIGINAL CONWORD FOR LATER USE. LDA LU GET THE MASKED LOGICAL UNIT NO. SZA,RSS IF NONE WAS SUPPLIED, THEN GO TO JMP OPTPR CHECK FOR OVERLAY OF OPTIONAL PARAMS. * LDA CONWD GET THE CONFIGURED CONTROL WORD. AND CLR11 ENSURE THAT BIT #11 IS CLEAR, IOR CLAST THAT T-FIELD =3, STA CONWP,I AND USE THE CONFIGURED PARAMETER. CCE,SLA SET =1 FOR WRITE REQUEST. CLE SET =0 FOR READ/CONTROL. LDA PRIOR GET THE EQT QUEUEING PRIORITY NUMBER. STA STPRP,I STORE THE PRIORITY INTO THE ENTRY. LDA BLKSP,I GET THE BLOCK LENGTH, AND MAKE IT  CMA,SSA,INA NEGATIVE -OR POSITIVE, IF ALREADY NEG. SEZ IF IT'S A WRITE REQUEST, SAVE NEG. SIZE STA BLKSP,I TO PREVENT 'RTIOC' FROM RELEASING S.A.M. * LDA ICLAS STORE THE CLASS-WORD FOR THE PROGRAM STA CLSWP,I THE 5TH WORD OF THE CLASS REQUEST. LDA ICODE GET THE CALLER'S REQUEST CODE. RAR POSITION FOR CONTROL REQUEST CHECKS. SSA,SLA,RSS IF NOT A CONTROL REQUEST, JMP NOTCN THEN BYPASS CONTROL PROCESSING. * LDA IBUFR GET "OPTIONAL" CONTROL PARAMETER. STA CONTP,I TRANSFER PARAMETER TO BLOCK HEADER. * NOTCN LDA ILEN GET DATA LENGTH SPECIFICATION. SZA IGNORE THE LENGTH PARAMETER? STA XLOGP,I NO. OVERLAY PARAM. WITH CALLER'S VALUE. OPTPR BLF,SLB IF THERE IS A Z-BUFFER PRESENT, JMP CK4LU THEN DO NOT ALTER 'Z' SPECIFICATIONS. * LDA IPRM3 GET OPTIONAL GET-RETURN-PARAMETER #1. SZA IGNORE IT? STA ZBUFP,I NO. MOVE USER'S PARAM. TO BLOCK HEADER. LDA IPRM4 GET OPTIONAL GET-RETURN-PARAMETER #2. SZA IGNORE IT? STA ZLENP,I NO. MOVE USER'S PARAM. TO BLOCK HEADER. * CK4LU LDA LU IF A LOGICAL UNIT NUMBER SZA,RSS WAS NOT SPECIFIED, THEN JMP REQUE GO REQUEUE THE BLOCK ONTO DEST. CLASS. * ISZ TERMA,I ADD 1 TO THE PENDING-REQUEST COUNT. JSB LINK LINK INTO EQT QUEUE BY PRIORITY. SEZ IF THE EQT WAS ACTIVE, JMP EXIT RETURN TO THE CALLER; ELSE, LDA EQTAD GET THE EQT ADDRESS, AND JSB $DLAY GO TO INITIATE THE I/O OPERATION. JMP EXIT RETURN--OPERATION COMPLETE. * REQUE LDA SERFL IF THIS IS NOT A SZA,RSS CLASS SEARCH OPERATION, THEN JMP ENDLS REQUEUED BLOCK GOES TO END OF QUEUE. * LDA ICLAS IF SEARCHING, AND THE DESTINATION CLASS CPA KCLAS IS EQUAL TO THE SOURCE CLASS, THEN THE JMP HEDLS LOCATED BLOCK GOES TO HEAD OF LIST; JMP ENDLS ELSE, ADD TO END OF DEST. CLASS. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEDLS LDA SCTBA,I GET CURRENT CLASS TABLE ENTRY. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CLE,SSA IF CLASS QUEUE IS EMPTY (AFTER DEQUE), CCE THEN SET 'TERMA' MOD. FLAG. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> STA SBLK,I SET NEW BLOCK'S LINK =POINTER OR TERM. LDA SBLK GET POINTER TO NEW BLOCK AND STA SCTBA,I SET INTO CLASS TABLE ENTRY. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SEZ,CLE IF THE FLAG IS SET, STA TERMA UPDATE THE CLASS TERMINATOR ADDRESS. JMP NEGBL BYPASS END OF QUEUE LINKAGE. * ENDLS LDA TERMA,I GET DESTINATION CLASS-TERMINATOR, LDB SBLK AND ADDRESS OF SOURCE BLOCK. STA B,I END-OF-QUEUE IS 1RST WORD OF NEW BLOCK. STB TERMA,I LINK THE NEW BLOCK AT END-OF-QUEUE. LDA ICLAS GET THE DESTINATION CLASS WORD, STA CLSWP,I AND REPLACE THE OLD WITH THE NEW. * NEGBL LDA BLKSP,I GET THE BLOCK LENGTH. IF IT IS CMA,SSA,INA,RSS NEGATIVE, MAKE IT POSITIVE, AND STA BLKSP,I RESTORE THE BLOCK SIZE VALUE. * LDA DQHED IF CLASS-TERMINATOR WAS THE ONLY THING CPA TERMA IN THE DESTINATION CLASS, THEN RSS ANY WAITING PROGRAM MUST BE SCHEDULED; JMP EXIT ELSE: OPERATION COMPLETE--RETURN. * LDB SBLK,I GET CLASS-TERMINATOR FROM IT'S NEW LOCN. RBL,CLE,SLB,ELB POSITION WAIT-BIT(#14) TO . SEZ,RSS IF SOMEONE IS WAITING, SKIP TO SCHEDULE; JMP EXIT * ELSE: OPERATION COMPLETE--RETURN. * RBR,RBR REPOSITION TERMINATOR (LESS BIT#14), STB SBLK,I AND RESTORE IT TO ITS RIGHTFUL PLACE. * JSB $SCD3 SCHEDULE WAITER(=CLASS-TABLE ADDRESS) * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JSB $LIBX RESTORE THE M.P. FENCE, DEF *+1 AND ALSO RE-ENABLE THE DEF HEDCK INTERRUPT CAPABILTIY. * HEDCK LDA KCLAS IF SOURCE CLASS = DESTINATION CLASS, CPA ICLAS THEN THE TASK IS DONE: THE BLOCK JMP EXIT IS ALREADY AT THE HEAD OF 'KCLAS'. * XCALL LDA ICLAS ADD NO-WAIT & RETHREAD BITS ##### IOR SGN13 TO MEET THE REQUIREMENTS ##### STA ICLAS OF THE RTE-L OPERATING SYSTEM. ##### * LDA ICODE IF THE REQUEUE REQUEST CPA D19N REFERS TO A CLASS CONTROL BLOCK, JMP CTLRQ USE THE SPECIAL CALLING SEQUENCE. * JSB EXEC CALL THE SYSTEM TO REQUEUE THE BLOCK. DEF RTN DEF ICODE REQUEST CODE: 17,18,20 (NO-ABORT) DEF CONWD CONTROL WORD DEF IBUFR,I DATA BUFFER FOR OVERLAY. DEF ILEN LENGTH OF DATA BUFFER OVERLAY. DEF IPRM3,I OPT. PARAM./Z-BUF. FOR OVERLAY. DEF IPRM4 OPT. PARAM./LEN. FOR Z-BUF. OVERLAY. DEF ICLAS DESTINATION CLASS NUMBER(BIT#15,13=1) DEF KCLAS SOURCE CLASS NUMBER. DEF KEY LU-LOCK PASSWORD (OPTIONAL). RTN JMP SAVER ERROR-RETURN POINT. * SSA IF THE BLOCK COULD NOT BE REQUEUED, JMP ERDS8 TELL CALLER OF RESOURCE PROBLEM: DS08! * JMP EXIT ALL IS WELL. COMPLETE THE REQUEST. * CTLRQ JSB EXEC CALL SYSTEM TO RETHREAD A CONTROL BLOCK. DEF RTNC DEF ICODE REQUEST CODE = 19 (NO-ABORT) DEF CONWD CONTROL WORD. DEF IBUFR,I OPTIONAL PRAM.1 (F"OR OVERLAY). DEF ICLAS DESTINATION CLASS (BITS#15,13=1). DEF ILEN OPTIONAL PRAM.2 (FOR OVERLAY). DEF IPRM3,I OPT. PRAM.3/Z-BUF. FOR OVERLAY. DEF IPRM4 OPT. PRAM.4/LEN. FOR Z-BUF. OVERLAY. DEF KCLAS SOURCE CLASS. DEF KEY OPTIONAL LU-LOCK PASSWWORD(RN). RTNC JMP SAVER ERROR-RETURN POINT. * SSA IF THE BLOCK COULD NOT BE REQUEUED, JMP ERDS8 TELL CALLER OF RESOURCE PROBLEM: DS08! * SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> EXIT LDA ERCOD = THE ERROR CODE WORD #1, LDB ICODE AND THE CALLER'S REQUEST CODE. SSB,RSS IF THE REQUEST CODE SIGN BIT IS NOT SET, JMP CLPRM GO DIRECTLY TO PREPARE FOR NEXT ENTRY; SZA,RSS ELSE, IF NO ERROR HAS BEEN DETECTED, UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ISZ EXADJ THEN SET RETURN TO P+2: NORMAL RETURN UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ISZ #RQUE THEN SET RETURN TO P+2: NORMAL RETURN. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CLPRM LDA DM9 CLEAR STA NOLIM ALL OF THE LDB PRPTR PARAMETER CLA ADDRESSES CLOOP STA B,I IN PREPARATION INB FOR THE ISZ NOLIM NEXT JMP CLOOP USER'S REQUEST. DLD ERCOD NORMAL RETURN:=0 ERROR:=ASCII. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> EXIT2 JMP LBEX BYPASS MAP CODE: NON-DMS / NOP: DMS JRS DMSTS LBEX *** RESTORE THE APPROPRIATEp MAPS. *** * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LBEX JSB $LIBX RETURN TO THE CALLER, VIA THE UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DEF TDB EXADJ NOP * SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DEF #RQUE RTE PRIVILEGED ROUTINE PROCESSOR. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * * ERROR PROCESSING SECTION. * ERDS8 DLD "DS" DS08: RESOURCES NOT AVAILABLE. JMP SAVER UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ERLU3 DLD "LU" LU03: LOGICAL UNIT LOCKED/ACCESS DENIED. JMP SAVER UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ERRQ DLD "RQ" RQ : REQUEST CODE IS INVALID. JMP SAVER ERI00 LDB "00" IO00: INVALID CLASS SPECIFICATION. JMP GETIO ERI01 LDB "01" IO01: PARAMETER MISSING OR INVALID. JMP GETIO UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ERI02 LDB "02" IO02: INVALID LOGICAL UNIT. JMP GETIO ERI04 LDB "04" IO04: INVALID BUFFER. JMP GETIO UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ERI10 LDB "10" IO10: PROGRAM WAITING ON SOURCE CLASS. GETIO LDA "IO" GET THE ASCII "IO" MESSAGE PREFIX, * SAVER DST ERCOD AND SAVE THE CONFIGURED ERROR MSG. JMP EXIT GO TO RETURN TO THE CALLER. * "00" ASC 1,00 "01" ASC 1,01 UNL <<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>> "02" ASC 1,02 "04" ASC 1,04 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> "10" ASC 1,10 "IO" ASC 1,IO "DS" ASC 2,DS08 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> "LU" ASC 2,LU03 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> "RQ" ASC 2,RQ * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * RESET CURRENTLY-QUEUED SOURCE-CLASS BLOCK SIZE WORD TO A POSITIVE VALUE. *[RE-QUEUED CLASS WRITES HAVE NEGATIVE BLOCK SIZE TO PREVENT BUFFER RELEASE] * RESET LDA BLKSP,I GET THE BLOCK SIZE VALUE. CMA,SSA,INA,RSS IF IT'S NEGATIVE, MAKE IT POSITIVE, STA BLKSP,I AND RESTORE THE CORRECT VALUE. JMP EXIT RETURN. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SKP CLCHK NOP ENTRY/EXIT: CLASS VALIDITY CHECKING STA TEMP SAVE THE CLASS-WORD FOR LATER USE. AND B377 ISOLATE THE CLASS NUMBER STA B SAVE IT FOR A TABLE INDEX. CMA,CLE,INA,SZA,RSS IF THE NUMBER IS ZERO, CLE,RSS PREPARE FOR AN ERROR-EXIT. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ADA DFCLS,I IF IT IS GREATER THAN MAXIMUM, UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ADA $CLTA+0,I IF IT IS GREATER THAN MAXIMUM, UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>u>>>>>>>>>>>>>>>>>> CLA,SEZ,RSS THEN TAKE THE JMP ERI00 ERROR EXIT. * STA QCNT INITIALIZE CLASS QUEUE BLK CNT. =0. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ADB DFCLS COMPUTE, AND SAVE, UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ADB $CLTA+0 COMPUTE, AND SAVE, UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> STB DQHED THE CLASS-TABLE ENTRY ADDRESS. STB TEMP+2 SAVE PREVIOUS LINK ADDRESS FOR SEARCH. LDA TEMP GET THE CLASS WORD. LDB B,I GET THE CLASS-TABLE ENTRY. CPA KCLAS IF THE SOURCE-CLASS IS BEING CHECKED, SSB,RSS THEN CONFIRM THAT SOMETHING IS QUEUED. SZB,RSS ALSO VERIFY THAT THE CLASS IS ASSIGNED. JMP ERI00 * ERROR: NOT ASSIGNED OR NO QUEUE. * CCE,SSB,RSS IS THIS THE CLASS-TERMINATOR? CLE,RSS NO SET BLOCK-COUNT FLAG. LDB DQHED YES, GET THE CORRECT ADDRESS. STB BLKAD SAVE ADDR.=CLASS-QUEUE POINTER, IF ANY. SEZ,CLE,RSS DO NOT COUNT TERMINATOR, IF NULL QUEUE. LOOP ISZ QCNT COUNT NUMBER OF QUEUED BLOCKS. NOP LDA SERFL GET THE SEARCH FLAG. SSA IF THE FLAG IS SET, JSB SERCH THEN GO TO SEARCH THE BLOCK. LDA B,I TRACK SSA DOWN THE JMP SAVAD CLASS TERMINATOR. SZA,RSS IF THE LINK WORD IS ZERO, JMP ERI00 THEN THE CLASS QUEUE IS CORRUPT! * STB TEMP+2 SAVE LAST LINK-WORD ADDRESS FOR SEARCH. LDB B,I LAST BLOCK NOT YET LOCATED, JMP LOOP SO CONTINUE THE SEARCH. * SAVAD STB TERMA SAVE THE CLASS-TERMINATOR ADDRESS. LDA TEMP ISOLATE THE 6 AND SCMSK USER-SPECIFIED SECURITY CODE, STA B AND SAVE IT FOR COMPARISON. LDA TERMA,I GET THE CLASS-TERMINATOR. AND SCMSK ISOLATE ITS SECURITY CODE. CPA B IF THEY COMPARE, THEN RSSIN RSS ALL'S WELL--PROCEED; JMP ERI00 ELSE, REPORT THE ERROR! * LDA TEMP GET THE CLASS-WORD, AGAIN. CPA KCLAS IF IT'S THE SOURCE-CLASS, THEN RSS SKIP TO CHECK FOR WAITERS; JMP CLCHK,I ELSE, RETURN TO THE CALLER. * LDB TERMA,I GET THE CLASS-TERMINATOR. RBL POSITION THE WAIT-BIT(#14) FOR TEST. SSB IF SOMEONE IS WAITING, JMP ERI10 THEN RE-QUEUEING IS IMPROPER! JMP CLCHK,I VALID CLASS: RETURN--POINTERS SET. * * CLASS SEARCH: EXAMINE SOURCE-CLASS BLOCK FOR STRING = CALLER'S STRING. * SERCH NOP STB TEMP+1 SAVE THE CURRENT-BLOCK FWA. JSB SETP GO TO ESTABLISH BLOCK POINTERS. LDA SERFL GET THE SEARCH FLAG VALUE. ADA D2 CHECK FOR MODE 1 OR 2. SSA IS IT MODE 1 OR 2? JMP MODE3 NO, GO TO PROCESS MODE3. * LDB CONWP,I GET CONWORD FROM CLASS HEADER. RBR POSITION BITS #0,1 FOR RC=3 TEST. SSB,SLB,RSS IF NOT A CLASS CONTROL BUFFER, JMP M1OR2 CONTINUE SEARCH PROCESSING; JMP EOS ELSE, IGNORE THIS BUFFER. * M1OR2 LDB DABFA MODE 1/2: DATA BUFFER FWA STB PNTR1 IS STARTING POINT FOR SEARCH. SZA MODE 1 OR 2? JMP MODE1 MODE 1: GO SET END POINT. * LDA XLOGP,I MODE 2: GET XLOG (DATA BUFFER LENGTH). SSA,RSS IS THE SPECIFICATION NEGATIVE? JMP ENDM2 NO--NO NEED FOR CONVERSION. * ARS YES, CONVERT TO WORD COUNT, CMA,INA AND MAKE THE LENGTH POSITIVE. ENDM2 ADA B COMPUTE AND SAVE: STA ENDCB END-OF-SEARCH = FWA DATA BUF. + XLOG. JMP CKOFS GO CHECK FOR SINGLE WORD SEARCH. * MODE1 LDA BLKSP,I GET THE CLASS BLOCK SIZE. SSA NEGATIVE SPECIFICATION? CMA,INA YES, MAKE POSITIVE. ADA B COMPUTE ADA NHDSZ AND SAVE: END-OF-SEARCH = STA ENDCB FWA DATA BUF.+ BLOCK SIZE - HEAD SIZE. JMP CKOFS GO CHECK FOR SINGLE WORD SEARCH. * MODE3 LDA CONWP,I IF THIS IS A Z-BUFFER SEARCH ALF,SLA AND THIS CLASS BLOCK JMP *+2 DOES NOT CONTAIN A Z-BUFFER, JMP EOS THEN, IGNORE THIS BLOCK. * LDB ZBUFP,I STARTING POINT FOR MODE3 STB PNTR1 IS FIRST WORD OF Z-BUFFER. LDA ZLENP,I GET Z-BUFFER LENGTH. SSA,RSS IS IT NEGATIVE? JMP ENDM3 NO--SKIP CONVERSION TO WORDS. * ARS CONVERT TO WORD COUNT CMA,INA AND MAKE IT POSITIVE. ENDM3 ADA B COMPUTE AND SAVE: STA ENDCB END-OF-SEARCH= FWA Z-BUF. + Z-BUF LEN. * CKOFS LDA ILEN GET USER'S REFERENCE BUF. LENGTH. CMA,SSA IF IT'S POSITIVE(FULL SEARCH), JMP SCAN GO SCAN SPECIFIED NUMBER OF WORDS; * ADB A ELSE, ADD POSITIVE OFFSET VALUE, STB PNTR1 AND SET START-OF-SEARCH POINTER. CMA,INA IF THE OFFSET ADA ENDCB STARTING ADDRESS IS SZA EQUAL TO, OR IF IT IS SSA BEYOND THE END OF THE SEARCH BUFFER, JMP EOS THEN IGNORE THIS BLOCK. * CLA,INA END-OF-SEARCH POINTER ADA B IS COMPUTED TO BE EQUAL STA ENDCB TO START+1 FOR SINGLE WORD SEARCH. SCAN LDA RFBUF GET FIRST REFERENCE FROM CALLER, SLOOP CPA B,I AND COMPARE TO CLASS BUFFER WORD. JMP SRCHA THEY'RE EQUAL, SO COMPARE ALL THE REST. NEXT1 INB NOT EQUAL, SO ADVANCE CLASS BUFFER ADDR. STB PNTR1 AND RETAIN THE POINTER. CPB ENDCB IF WE'VE EXAMINED THE ENTIRE CLASS BUFF. JMP EOS THEN THIS IS NOT THE DESIRE"D BLOCK JMP SLOOP ELSE, CONTINUE THE SEARCH. * SRCHA LDA ILEN GET USER'S REFERENCE LENGTH. SSA IF IT'S NEGATIVE, JMP FOUND THEN THE MATCH HAS BEEN MADE. * LDA RFBFA =COMPARE BUFF. ADDR,=CLASS BUF AD. JSB .CMW DO A WORD-BY-WORD COMPARISON. DEF ILEN NOP JMP FOUND THIS IS THE DESIRED BLOCK. NOP IT'S NOT THIS ONE, LDA RFBUF SO RETRIEVE 1RST WORD OF CALLER'S REF. LDB PNTR1 AND THE CLASS BUFFER POINTER, JMP NEXT1 AND GO TO FIND A NEW STARTING POINT. * FOUND CLA PREVENT THE TRANSFER OF INVALID DATA STA ILEN INTO THE REQUEUED CLASS BLOCK. LDA DQHED SAVE THE CLASS TABLE ADDRESS (SOURCE), STA SCTBA FOR POSSIBLE USE IN REQUEUEING. DLD TEMP+1 =CURRENT BLK AD.,=PREVIOUS LINK AD. DST SBLK SAVE POINTERS TO LOCATED BLOCK. STA SERFL SET SEARCH FLAG =BLOCK FOUND (POS,#0). EOS LDB TEMP+1 END OF SEARCH: RESTORED. JMP SERCH,I RETURN TO FIND CLASS TERMINATOR. * ENDCB NOP ADDRESS: END OF CLASS BLOCK SEARCH+1. PNTR1 NOP POINTER INTO CLASS DATA BUFFER. SCTBA NOP CLASS TABLE ENTRY ADDRESS (SOURCE). SERFL NOP SEARCH FLAG:0=NONE,-=SEARCHING,+=FOUND. SKP * ESTABLISH POINTERS TO ELEMENTS OF CLASS BLOCK HEADER. * SETP NOP =CLASS BLOCK ADDRESS; =DON'T CARE. LDA DM8 ESTABLISH STA ENDCB POINTERS LDA HEDP TO THE SETLP INB SOURCE-CLASS STB A,I BLOCK HEADER INA WHICH IS LOCATED ISZ ENDCB IN SYSTEM JMP SETLP AVAILABLE MEMORY. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ADB D2 COMPUTE DATA BUFFER ADDRESS. STB DABFA CONFIGURE THE POINTER. UNL <<<<<<F<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> JMP SETP,I RETURN. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * LINK CLASS REQUEST INTO EQT QUEUE, ACCORDING TO PRIORITY. * [ CODE SIMULATES RTIOC, SINCE ENTRY INTO RTIOC'S 'LINK' NOT PROVIDED. ] * LINK NOP LDB EQTAD GET EQT QUEUE-HEAD ADDRESS. CLE,RSS SET FIRST-FLAG AND SKIP TO START SCAN. * LINK1 SEZ,CCE,RSS IF FIRST, RESET FLAG & SKIP FIRST ENTRY. JMP LINK4 GO TO START THE SCAN. STB TEMP SAVE ADDRESS OF ENTRY UNDER EXAMINATION. INB POINT TO SECOND WORD OF THE ENTRY. LDA B,I GET THE CONTROL WORD. INB ADVANCE POINTER TO ENTRY'S THIRD WORD. AND CLAST ISOLATE THE REQUEST TYPE ('T'BITS#15,14). RAL,RAL POSITION TO BITS#1,0 TO TEST & CLEAR. SLA,ARS TEST FOR BUFFERED REQUEST & CLEAR BIT. JMP LINK2 BUFFERED: POINTS TO PRIORITY. SLA,ARS TEST FOR SYSTEM REQUEST & CLEAR BIT. JMP LINK3 SYSTEM: USE PRIORITY =0; =0. ADB D4 NORMAL USER REQ.: PRIOR. IN ID WORD#7. LINK2 LDA B,I GET PRIORITY OF ENTRY UNDER EXAMINATION. LINK3 LDB TEMP GET THE ENTRY'S ADDRESS. CMA,INA SUBTRACT THE ENTRY'S PRIORITY FROM ADA PRIOR THE PRIORITY OF THE NEW REQUEST. SSA IF CURRENT ENTRY'S PRIORITY IS LOWER JMP LINK5 THAN NEW ONE, GO LINK-IN NEW REQUEST. * LINK4 STB TEMP+1 SAVE ADDRESS OF PREVIOUS ENTRY. LDB B,I GET ADDRESS OF NEXT ENTRY IN QUEUE. ELB,CLE,ERB CLEAR POSSIBLE SIGN AND SAVE . SZB IF END-OF-LIST: SKIP TO ADD NEW ENTRY; JMP LINK1 ELSE, CONTINUE THE SCAN. * LINK5 LDA SBLK GET THE ADDRESS OF THE NEW ENTRY. STB SBLK,I LINK LOWER PRIORITY ENTRIES OR 0 (EOL). XOR TEMP+1,I KEEP THE SIGN AND C100K OF THE OLD WORD XOR TEMP+1,I IF IT WAS SET. STA TEMP+1,I LINK NEW REQ. AFTER HIGHER PRIOR. ENTS. JMP LINK,I RETURN:=0 START I/O;=1 I/O ACTIVE. * SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SKP UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * A EQU 0 B EQU 1 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DRTA EQU 1652B DRT POINTER. EQTA EQU 1650B EQT POINTER. LUMAX EQU 1653B DRT ENTRY COUNT. XPRIO EQU 1726B CALLER'S PRIORITY-WORD POINTER. B37 OCT 37 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> B77 OCT 77 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> B174K OCT 174000 B137C OCT 13700 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> B377 OCT 377 CLASS NUMBER MASK. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> B30K OCT 30000 B74K OCT 74000 BIT13 OCT 20000 C100K DEC 32767 CLAST OCT 140000 T-FIELD FOR CLASS REQUESTS CLR11 OCT 173777 BIT #11 MASK FOR RTIOC COMPATABILITY. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D2 DEC 2 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D3 DEC 3 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>P>>>>>> D4 DEC 4 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D5 DEC 5 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D6 DEC 6 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D8 DEC 8 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D10 DEC 10 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D15 DEC 15 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> D16 DEC 16 D20 DEC 20 DM1 DEC -1 DM2 DEC -2 DM3 DEC -3 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DM4 DEC -4 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DM8 DEC -8 DM9 DEC -9 UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DM10 DEC -10 D19N OCT 100023 NO-ABORT CLASS CONTROL CODE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DM17 DEC -17 DFCLS DEF $CLAS+0 DIRECT CLASS TABLE ADDRESS. #CLTA DEF DFCLS CLASS TABLE ADDRESS POINTER. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEDP DEF CONWP ADDRESS OF FIRST SOURCE-CLASS POINTER. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEDSZ EQU D10 SIZE OF CLASS BLOCK HEADER. NHDSZ EQU DM10 NEG. BLOCK HEADER SIZE. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEDSZ EQU D8 SIZE OF CLASS BLOCK HEADER. NHDSZ EQU DM8 NEG. SIZE OF HEADER. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> IBUFP DEF IBUFR UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> IPR3A NOP ADDRESS: USER'S Z-BUFFER OVERLAY DATA. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> IPR3P DEF IPRM3 KEYPT DEF KEY RFBFA DEF RFBUF ADDRESS: SEARCH COMPARISON BUFFER. RFBSZ EQU 10 SIZE OF CLASS SEARCH COMPARISON BUFFER. RFMAX ABS RFBSZ MAXIMUM SIZE: CLASS SEARCH BUFFER. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> RNTBA DEF $RNTB+0 RN TABLE ADDRESS. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SCMSK OCT 17400 CLASS SECURITY-CODE MASK. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SGN13 OCT 120000 NO-WAIT,RETHREAD BITS(#15,13) * #CLTA DEF $CLTA+0 CLASS TABLE ADDRESS POINTER. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * #PRGL EQU 0 LU FOR MESSAGES: DEFAULT = NONE. #QLIM DEC -11 -[(MAX. ALLOWABLE QUEUED BLOCKS)+1] SKP * >> DO NOT CHANGE ORDER OF 'BLKAD','DQHED','SBLK','SQHED' << * BLKAD NOP DESTINATION: ADDRESS =SAM BLOCK POINTER. DQHED NOP DESTINATION: CLASS-QUEUE START CONWD NOP  CONFIGURED I/O CONTROL WORD. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DRTEN NOP DRT ENTRY FOR SPECIFIED LU. DMSTS NOP DMS MAP STATUS EQTAD NOP EQT ADDRESS UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ERCOD BSS 2 ERROR CODE STORAGE (ASCII) TERMA NOP DESTINATION: CLASS-HEADER ADDRESS UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LU NOP MASKED LOGICAL UNIT NUMBER. PRIOR NOP CALLING PROGRAM PRIORITY. UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> QCNT NOP CLASS QUEUE BLOCK COUNT ACCUMULATION. RFBUF BSS RFBSZ CLASS SEARCH COMPARISON BUFFER. SBLK NOP SOURCE: ADDRESS =SAM BLOCK POINTER. SQHED NOP SOURCE: CLASS-TABLE ADDRESS TEMP BSS 3 TEMPORARY STORAGE * * TABLE OF POINTERS TO SOURCE-CLASS HEADER PARAMETERS >>DO NOT CHANGE<<. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IFN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNN LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CONWP NOP ADDRESS: CONTROL WORD. CONTP NOP ADDRESS: OPTIONAL CONTROL PARAMETER. XLOGP NOP ADDRESS: BUFFER LENGTH/TRANSMISSION LOG. ZBUFP NOP ADDRESS: OPTIONAL PARAM./Z-BUFFER ADDR. ZLENP NOP ADDRESS: OPTIONAL PARAM./Z-BUFFER LEN. STPRP NOP ADDRESS: I/O STATUS / USER PRIORITY. BLKSP NOP ADDRESS: TOTAL BLOCK SIZE (WORDS). CLSWP NOP ADDRESS: CLASS IDENTIFICATION INFO. * DABFA NOP FWA: DATA BUFFER. * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CONWP NOP ADDRESS: CONTROL WORD STPRP NOP ADDRESS: USER PRIORITY / I/O STATUS BLKSP NOP ADDRESS: TOTAL BLOCK SIZE (WORDS). CLSWP NOP ADDRESS: CLASS IDENTIFICATION INFO. XLOGP NOP ADDRESS: BUF.LEN/CONTROL PRAM/TLOG ZBUFP NOP ADDRESS: OPTIONAL PARAM./Z-BUFFER ADDR. ZLENP NOP ADDRESS: OPTIONAL PARAM./Z-BUFFER LEN. * DABFA NOP FWA: DATA BUFFER. CONTP EQU XLOGP ADDRESS: CONTROL REQUEST PARAMETER * UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFZ ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ORG BLKAD ONE-TIME CONFIGURATION IN STORAGE AREA. * CONFG LDB $OPSY GET THE OP-SYSTEM IDENTIFIER. RBR,CLE,ERB POSITION DMS BIT(#1) TO . CLB,SEZ,CLE,RSS IF DMS SYSTEM, SKIP TO ENABLE DMS JMP NODMS CODE; ELSE JUST CLEAR CONFG. CALL. STA MAPSW ALLOW SWITCHING TO THE SYSTEM MAP. STA EXIT2 PROVIDE FOR MAP RESTORATION, UPON EXIT. LDA MWFIN GET THE DMS 'MOVE-WORDS-FROM' MACRO LDB RSSIN AND AN ARBITRARY SKIP: 'RSS'. DST DMS1 OVERLAY THE 'MVW' & ITS FOLLOWING 'DEF'. DST DMS2 FOR USE IN MAPPED-SYSTEM ENVIRONMENTS. NODMS CLA SET =0, FOR NORMAL INITIALIZATION. STA INIT NO FURTHER NEED FOR CONFIGURATION. JMP INIT+1 RETURN TO NORMAL PROCESSING. * MWFIN MWF 'MOVE-WORDS-FROM' MACRO CODE. ORR UNL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< XIF !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LST >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> * SIZE EQU *-#NQUE < SIZE OF THIS MODULE > * END  n2 91750-18029 2013 S C0122 &#RRX +              H0101 BASMB,R,Q,C HED <#RRX> REROUTING INIT. ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #RRX,7 91750-1X029 REV 2013 800328 ALL W/ RR SPC 1 EXT $OPSY,$LIBR,$LIBX EXT .LDX,.MVW,PGMAD EXT #PRNT,#READ,#SYSR,#PRSB,#RR4 EXT #LV,#LCNT,#CM,#NODE ENT #RR1,#RR2,#RR3 * * NAME: #RRX * SOURCE: 91750-18029 * RELOC: 91750-1X029 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * SKP * * #RR1 CALLING SEQUENCE: * * < B REG. = #NCNT > * JSB #RR1 * < A REG. = SAM SIZE FOR REROUTING > * #RR1 NOP CMB,INB MAKE #NCNT POSITIVE STB NCNT SAVE IT JSB #PRNT ASK FOR # OF LINKS DEF LINK? JSB #READ CPA =B1 NUMERIC RESPONSE? RSS JMP ERROR .NO, ERROR SSB POSITIVE? JMP ERROR .NO, ERROR STB LCNT STORE ANSWER AS LINK COUNT SZB,RSS RR ENABLE? JMP NORR .NO JSB PGMAD .YES, CHECK IF #SEND IS AROUND DEF *+2 DEF #SEND SZA,RSS MISSING ID SEGMENT? JMP ERR1 .YES NORR EQU * LDA NCNT MPY LCNT ALS MULT BY TWO FOR 2 WORD CM ENTRIES STA CMLEN STORE THIS AS SAM SIZE FOR CM LDA LCNT MPY LVSZ SAM SIZE FOR LV ADA CMLEN TOTAL SAM SIZE FOR RR IN REG. A JMP #RR1,I RETURN * ERROR JSB #SYSR WRITE ERROR MESG TO USER DEF LKERR ERR1 JSB #SYSR DEF SDERR SKP * * #RR2 CALLING SEQUENCE: * * < A REG. = NODE #, B REG. = LU PARSE TYPE > * JSB #RR2 SETS INITIAL VALUES IN COST MATRIX * #RR2 NOP DST NODE NOP2 JSB INIT2 INIT #CM,#LCNT LDA LCNT SZA,RSS JMP #RR2,I DLD NODE CPA #NODE LOCAL NODE? JMP ZERO .YES, ZERO OUT CM ENTRIES CPB =D1 LU GIVEN? JMP ZERO .YES, ZERO OUT CM ALSO DLD MAX RR NODES, SET CM ENTRIES TO INFINITE DST CMVAL JMP SETCM ZERO CLA NON-RR NODES, CM ENTRIES = 0 STA CMVAL STA CMVAL+1 * * SET CM ROW TO MAX VALUE OR ZERO * SETCM LDA LCNT GET # OF LINKS CMA,INA STA J LOOP LDA @CMVA LDB @CM JSB STWS ISZ @CM ISZ @CM ISZ J JMP LOOP JMP #RR2,I * * CONFIGURE THE SYSTEM ENVIRONMENT & INIT. GLOBAL VARIABLES * INIT2 NOP CLB STB NOP2 CLEAR CALL TO THIS ROUTINE STB #LCNT LDA $OPSY GET SYS TYPE RAR,SLA DMS? STB SSMOD .YES, MOD INST * LDA LCNT MPY LVSZ ADA #LV STA #CM CM STARTS AFTER LV STA @CM JMP INIT2,I SKP * * #RR3 CALLING SEQUENCE: * * * #PRSB = PARSED BUFFER * JSB #RR3 SETS LU AND COST IN LINK VECTOR * #RR3 NOP NOP3 JSB INIT3 LDA LCNT GET # OF RR LINKS REQUESTED BY USER CPA #LCNT HAVE WE USED IT ALL UP? JMP #RR3,I .YES, JUST RETURN LDA #PRSB+1 GET LU FROM USER BUFFER STA L.LU SAVE IT JSB #RR4 CHECK OLD LINK LDA #PRSB+4 GET COST TYPE SZA,RSS DEFAULT COST? JMP DEFAU .YES LDA #PRSB+5 .NO, PICK UP USER SPECIFIED LINK COST SZA,RSS ZERO COST? JMP ERR3 .YES, ERROR SSA < ZERO? JMP ERR3 .YES, ERROR RSS DEFAU INA DEFAULT COST = 1 STA L.CST SAVE COST ADA =D-100 SSA,RSS JMP ERR3 * LDA @LVAL LD B @LV JSB STWS LDA @LV ADA LVSZ UP LINK POINTER STA @LV ISZ #LCNT UP # OF RR LINKS NOP JMP #RR3,I * ERR3 EQU * JSB #SYSR DEF CTERR INIT3 NOP CLA STA NOP3 CLEAR CALL TO THIS ROUTINE STA L.TM STA L.TM+1 STA L.CNT CCA STA L.NBR LDA #LV STA @LV LDA LVSZ STA SSLEN SET LDWS TO MOVE LVSZ WORDS JMP INIT3,I SKP SKP *** * * STWS MOVES WORDS FROM LOCAL BUFFER TO SAM BUFFER * * CALLING SEQUENCE: * * ==> LOCAL BUFFER * ==> SAM BUFFER * STWS NOP JSB $LIBR NOP SSMOD JMP SSMVW JSB .LDX DEF SSLEN MWI JMP SSJSB SSMVW JSB .MVW DEF SSLEN NOP SSJSB JSB $LIBX DEF STWS * SSLEN DEC 2 2 WORD MOVE * *** SKP * * DATA AREA * MAX OCT 77777 THIS 2 WORDS MUST NCNT NOP BE TOGETHER LCNT NOP NOP * CMVAL BSS 2 @CMVA DEF CMVAL @CM NOP CMLEN NOP * D6 DEC 6 D9 DEC 9 D11 DEC 11 D21 DEC 21 * LINK? DEF *+2 DEF D11 ASC 11,# OF REROUTING LINKS?_ LKERR DEF *+2 DEF D9 ASC 9,LINK SPEC. ERROR! SDERR DEF *+2 DEF D21 ASC 21,REROUTING IS ENABLED BUT #SEND IS MISSING CTERR DEF *+2 DEF D6 ASC 6,COST ERROR! * NODE BSS 2 J NOP #SEND ASC 3,#SEND * @LV NOP LVSZ DEC 6 LVAL BSS 6 L.LU EQU LVAL L.CST EQU LVAL+1 L.TM EQU LVAL+2 L.CNT EQU LVAL+4 L.NBR EQU LVAL+5 @LVAL DEF LVAL END  ow 91750-18030 2013 S C0122 &#RR4 +              H0101 hCASMB,R,Q,C HED <#RR4> REROUTING INIT. ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #RR4,7 91750-1X030 REV 2013 791206 ALL W/ RR SPC 1 EXT XLUEX,#GRPM ENT #RR4 * * NAME: #RR4 * SOURCE: 91750-18030 * RELOC: 91750-1X030 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * * * #RR4 CALLING SEQUENCE: * * * < A REG. = LU > * JSB #RR4 SEND UP INDICATION TO GRPM IF OLD LINK * #RR4 NOP STA LU SET UP LU WORDS IOR =B100000 SET NO SST BIT STA CONWD CLA STA CONWD+1 JSB XLUEX GET DRIVER TYPE DEF *+4 DEF D13 DEF CONWD DEF DTYPE RETURN VALUE HERE LDA DTYPE ALF,ALF AND =B77 ISOLATE DRIVER TYPE CPA =B65 OLD DRIVER? RSS .YES, SKIP NEXT INST. JMP #RR4,I .NO, NO FURTHER ACTION LDA LU IOR =B400 STA LU+1 CLA STA CONWD LDA =B10000 STA CONWD+1 JSB XLUEX SEND UP INDICATION TO GRPM DEF *+8 DEF D20 DEF CONWD DEF D0 DEF D0 DEF LU DEF D2 DEF #GRPM JMP #RR4,I * * DATA AREA * B10K OCT 10000 CONWD BSS 2 D0 DEC 0 D2 DEC 2 D13 DEC 13 D20 DEC 20 LU BSS 2 DTYPE NOP END ,-   pw 91750-18031 2013 S C0122 &#RR5 +              H0101 jCASMB,R,Q,C HED <#RR5> REROUTING INIT. ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #RR5,7 91750-1X031 REV 2013 791206 ALL W/ RR SPC 1 EXT XLUEX,$OPSY EXT #LV,#LCNT ENT #RR5 * * NAME: #RR5 * SOURCE: 91750-18031 * RELOC: 91750-1X031 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * * * #RR5 CALLING SEQUENCE: * * * JSB #RR5 DISABLE ALL RR LINKS * #RR5 NOP NOP JSB CONFG LDA #LCNT SZA,RSS JMP #RR5,I CMA,INA STA J SET UP LOOP INDEX LDB #LV STB @LV SET UP LV ADDR LOOP EQU * JSB LDWD GET LU WORD AND =B377 IOR =B100000 STA CONWD JSB XLUEX DISABLE CALL DEF *+3 DEF D3 DEF CONWD ISZ J RSS JMP #RR5,I LDB @LV ADB LVSZ STB @LV JMP LOOP JMP #RR5,I SKP *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP LDA $OPSY RAR,SLA STB LDMOD JMP CONFG,I SKP * * DATA AREA * CONWD NOP OCT 3100 J NOP D3 DEC 3 @LV NOP LVSZ DEC 6 END    qx 91750-18032 2013 S C0122 &#RR6 +              H0101 lCASMB,R,Q,C HED <#RR6> REROUTING SETUP ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #RR6,7 91750-1X032 REV 2013 791206 ALL W/ RR SPC 1 EXT XLUEX,$OPSY,$LIBR,$LIBX EXT .LDX,.MVW EXT #LV,#LCNT,#NCNT,#CM ENT #RR6 * * NAME: #RR6 * SOURCE: 91750-18032 * RELOC: 91750-1X032 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * #RR6 CALLING SEQUENCE: * * * JSB #RR6 ENABLE ALL RR LINKS * #RR6 NOP LDA #LCNT SZA,RSS JMP #RR6,I NOP JSB CONFG * * SET CM VALUE TO MAX * LDA #NCNT STA I SET UP LOOP COUNTER CMA,INA STA MAX+1 SET UP MAX HOP COUNT LDB #CM STB @CM SET UP CM ADDR LOOP EQU * LDB @CM JSB LDWD SZA,RSS ZERO COST? CCA .YES, SET FLAG STA ZFLAG LDA #LCNT CMA,INA STA J LOOP1 LDA @MAX LDB @CM ISZ ZFLAG SKIP STORE IF ZERO COST JSB STWS ISZ @CM ISZ @CM ISZ J JMP LOOP1 ISZ I JMP LOOP * * ENABLE ALL RR LINKS * LDA #LCNT CMA,INA STA J SET UP LOOP INDEX LDB #LV STB @LV SET UP LV ADDR LOOP2 EQU * JSB LDWD GET LU WORD AND =B377 STA OPT IOR =B100000 STA CONWD JSB XLUEX ENABLE CALL DEF *+4 DEF D3 DEF CONWD DEF OPT ISZ J RSS JMP #RR6,I LDB @LV ADB LVSZ STB @LV JMP LOOP2 JMP #RR60  ,I JMP #RR6,I SKP *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** *** * * STWS MOVES WORDS FROM LOCAL BUFFER TO SAM BUFFER * * CALLING SEQUENCE: * * ==> LOCAL BUFFER * ==> SAM BUFFER * STWS NOP JSB $LIBR NOP SSMOD JMP SSMVW JSB .LDX DEF SSLEN MWI JMP SSJSB SSMVW JSB .MVW DEF SSLEN NOP SSJSB JSB $LIBX DEF STWS * SSLEN DEC 2 2 WORD MOVE * *** * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP LDA $OPSY RAR SLA,RSS JMP CONFG,I STB LDMOD STB SSMOD JMP CONFG,I SKP * * DATA AREA * CONWD NOP OCT 3000 OPT NOP J NOP D3 DEC 3 @LV NOP LVSZ DEC 6 I NOP @CM NOP ZFLAG NOP MAX OCT 77777 NOP @MAX DEF MAX END =v  ry 91750-18033 2013 S C0122 &#SCSM +              H0101 aASMB,R,Q,C HED #SCSM 91750-1X033 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #SCSM,7 91750-1X033 REV.2013 800507 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #SCSM * EXT $DSCS,#RPB,#POOL,#CLON EXT $LIBR,$LIBX,$OPSY,.DRCT,.MVW * RQB EQU #RPB * SUP * * NAME: #SCSM * SOURCE: 91750-18033 * RELOC: PART OF 91750-12014, -12015 * PGMR: JIM HARTSELL * * * * SUBROUTINE TO PERFORM SESSION-MONITOR PREPROCESSING AND POSTPROCESSING * OF DEXEC SCHEDULE REQUESTS FOR THE EXECW MODULE AND FOR POPEN, FINIS * REQUESTS FOR THE PTOPM MODULE. * * CALLING SEQUENCES: * * PREPROCESSING: * * CLA * JSB #SCSM * P+1 ERROR RETURN. COULD NOT PERFORM REQUESTED CLONING. * P+2 NORMAL RETURN. * * * POSTPROCESSING...WHEN SCHEDULED PROGRAM TERMINATES: * * (A) = ADDRESS OF PROGRAM NAME * JSB #SCSM SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO  * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 800221 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ******E************************************************************ * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #ZOF EQU #PM1 Z-BUFFER OFFSET FOR DEXEC(1,2,3,13) #ZLN EQU #PM2 Z-BUFFER LENGTH FOR DEXEC(1,2,3,13) #PR2 EQU #PM2+1 2ND OPT. PARAMETER FOR DEXEC(3) [RTE-L]. #KEY EQU #PR2+1 KEYWORD(RN) FOR DEXEC(1,2,3) [RTE-L]. #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24)(5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #ST4 EQU #ST3+1 ISTA4 FOR DEXEC(13) [RTE-L]. #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SPC 5 * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT * * #SCSM * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END SKP A EQU 0 B EQU 1 * * #SCSM NOP ENTRY. LDB $OPSY RBR,SLB SKIP IF NON-DMS. CLB,RSS JMP ENTYP STB MOD1 DMS. * ENTYP SZA CHECK TYPE OF ENTRY. JMP UNCLO GO HANDLE TERMINATION. * LDB #POOL IF #POOL NOT SET UP, SZB,RSS JMP EXIT DON'T DO ANYTHING. * LDA RQB+#STR CHECK TYPE OF REQUEST. AND B77 CPA B3 JMP SCSM1 CPA B4 JMP SCSM2 JMP SMNOD * SCSM1 JSB .DRCT DEXEC(9) REQUEST: DEF RQB+#PGN GET ADDR OF PROGRAM NAME. STA NAMAD LDA RQB+#ICD IF BIT 11 OF ICODE ALF [  IS SET, JMP SCSM3 SET "CLONE FLAG". * SCSM2 JSB .DRCT POPEN REQUEST: DEF RQB+#PCB GET ADDR OF SLAVE PROG NAME. STA NAMAD LDA RQB+#FCD IF BIT 13 OF FCODE RAL,RAL IS SET, SCSM3 CLB SET "CLONE FLAG". SSA INB STB CFLAG * SMNOD LDA $DSCS SESSION MONITOR NODE? SSA,RSS JMP CLONE YES. GO CHECK FOR CLONING. * * NON-SESSION NODE. BUILD A TEMPORARY #POOL ENTRY FROM WHICH THE * SCHEDULED PROGRAM'S #MSSM ROUTINE CAN FIND THE SOURCE NODE AND * SESSION FROM WHICH THE PROGRAM WAS SCHEDULED. THIS IS USED FOR * REDIRECTING THE PROGRAM'S REMOTE REQUESTS TO THE ORIGINATING SESSION * AT AN HP 1000 OR AN HP 3000. * >>>> CAUTION! <<<< WHEN EXECW GETS THE SMARTS TO SCHEDULE MORE * THAN ONE PROGRAM AT A TIME, THERE CAN BE MORE THAN ONE #POOL ENTRY * WITH THE SAME PROGRAM NAME (AND NO POOL SESSION ID)... WILL NEED * A WAY FOR #MSSM'S "ROOTS" ROUTINE (CASE 3) TO TELL WHICH ONE. * LDA RQB+#SID SOURCE SESSION ID IN REQUEST? ALF,ALF (OR MPE PROCESS NUMBER) AND B377 SZA,RSS JMP EXIT NO. RETURN. * STA SSID YES. SAVE THE SOURCE SESSION ID. LDB #POOL FIND AN AVAILABLE #POOL ENTRY. JSB LODWD GET # POOL ENTRIES (NEGATIVE). STA TEMP INB POINT TO 1ST POOL ENTRY. LOOP JSB LODWD (CROSS) LOAD WORD 1 OF ENTRY. SSA,RSS IS SIGN BIT SET? JMP IDFND NO. THIS ENTRY IS AVAILABLE. ADB POOSZ BUMP ADDR TO NEXT ENTRY. ISZ TEMP END OF POOL? JMP LOOP NO. CONTINUE. * JMP EXIT YES. CAN'T REDIRECT FOR THIS USER! * IDFND IOR BIT15 SET SIGN BIT FOR "IN USE". JSB STUFF STORE BACK TO S.A.M. STB POOLA SAVE ADDRESS OF #POOL ENTRY. * INB BUILD THE TEMP #POOL ENTRY. LDA RQB+#SRC STORE SOURCE NODE NUMBER. JSB STUFF INB LDA SSID STORE SOURCE SESSION ID. JSB STUFF CNAME INB LDA NAMAD STA ADDR LDA ADDR,I STORE SCHEDULEE'S NAME. JSB STUFF INB ISZ ADDR LDA ADDR,I JSB STUFF INB ISZ ADDR LDA ADDR,I JSB STUFF * LDA SEQNO BUMP #POOL ENTRY "EXECW SEQUENCE CPA B377 NUMBER" THAT #MSSM USES TO DETECT CLA A NEW SCHEDULE OF A CORE-RESIDENT INA PROGRAM BY EXECW (AND CAN THEN STA SEQNO CLEAR PRIOR NETWORK ACC'T TABLE). LDB POOLA ADB B2 STORE EXECW SEQ # IN #POOL ENTRY. JSB LODWD (FETCH SEQNO WORD, AND B377 CLEAR OLD SEQNO, ALF,ALF SWITCH BYTES, IOR SEQNO INSERT NEW SEQNO, ALF,ALF AND SWITCH BACK.) JSB STUFF * EXIT ISZ #SCSM EXIT TO NORMAL EXECW/PTOPM PROCESSING. JMP #SCSM,I * * SESSION NODE. CREATE A COPY OF THE PROGRAM IF "RW" FROM REMAT, * OR IF SPECIAL "CLONE" POPEN REQUEST. * CLONE CLA INITIALIZE "CLONED" FLAG STA CLONF FOR #POOL ENTRY. LDA CFLAG IS CLONING REQUESTED? SZA,RSS JMP CATLG NO. * LDA RQB+#SID YES. GET DESTINATION SESSION ID. AND B377 STA TEMP SAVE FOR #POOL SEARCH. CPA D254 IF USER HAS NON-SESSION ACCESS, JMP EXIT DON'T CLONE (NO #POOL ENTRY). * LDA RQB+#STR IF REQUEST IS FROM A 3000, SSA IGNORE "LOCAL NODE" TEST. JMP CLON1 LDA RQB+#SRC IF DESTINATION NODE = CPA RQB+#DST SOURCE NODE, JMP EXIT DON'T CLONE (NO #POOL ENTRY). * CLON1 LDA TEMP GET DESTINATION SID. LDB NAMAD GET ADDRESS OF PROGRAM NAME. * JSB #CLON CLONE THE PROGRAM. JMP #SCSM,I COULD NOT CLONE SP'D PROGRAM. JMP CATLG PROG KNOWN TO SYS BUT CAN'T CLONE IT. * LDA B PROGRAM WAS CLONED. LDB NAMAD MOVE NEW NAME TO JSB .MVW DEXEC/POPEN REQUEST. DEF B3 NOP * LDA BIT14 SET "CLONED" FLAG STA CLONF FOR #POOL ENTRY. * CATLG LDB #POOL FIND #POOL ENTRY AND STORE JSB LODWD NAME (CAN BE CLONED NAME). STA CNTR INB LOOP2 JSB LODWD (CROSS) LOAD NEXT POOL SID. SSA,RSS JMP NEXT1 NOT IN USE. AND B377 IN USE. COMPARE DEST SID. CPA TEMP JMP FOUND FOUND. NEXT1 ADB POOSZ GO TO NEXT #POOL ENTRY. ISZ CNTR JMP LOOP2 JMP EXIT NOT IN #POOL. * FOUND STB POOLA SAVE ADDRESS OF #POOL ENTRY. JSB LODWD SET "CLONED" BIT IN #POOL ENTRY IOR CLONF IF PROGRAM WAS CLONED. JSB STUFF ADB B2 BUMP POINTER. * JMP CNAME GO STORE PROGRAM NAME IN ENTRY. SKP * * PERFORM PROCESSING FOR TERMINATION OF EXECW-SCHEDULED PROGRAMS * AND FOR PTOP SLAVE PROGRAMS. * UNCLO EQU * STA NAMAD SAVE ADDR OF PROGRAM NAME. * * SEE IF PROGRAM NAME IN IN A #POOL ENTRY (WHETHER S.M. NODE OR NOT). * LDB #POOL GET ADDR OF SID POOL. SZB,RSS IF NOT SET UP, JMP #SCSM,I DON'T DO ANYTHING. JSB LODWD GET NEG. # OF POOL ENTRIES. STA CNTR SAVE COUNTER. INB POINT TO WORD 1 OF 1ST ENTRY. STB POOLA * LOOP1 LDA NAMAD RESET NAME ARRAY POINTER. STA PTR LDB POOLA JSB LODWD (CROSS) LOAD NEXT POOL SID. SSA,RSS JMP NEXT NOT IN USE. * ADB B3 IN USE. COMPARE PROGRAM NAMES. JSB LODWD CPA PTR,I RSS JMP NEXT INB JSB LODWD ISZ PTR CPA PTR,I RSS JMP NEXT INB JSB LODWD AND B1774 STA TEMP ISZ PTR LDA PTR,I AND B1774 CPA TEMP JMP CKSID NAMES MATCH. POOLA = POOL ENTRY ADDR. * NEXT LDB POOLA NO MATCH. ADsB POOSZ STB POOLA ISZ CNTR JMP LOOP1 GO CHECK NEXT #POOL ENTRY. * JMP #SCSM,I NAME NOT FOUND IN #POOL. * * NAME FOUND IN A #POOL ENTRY. * CKSID LDA $DSCS SESSION NODE? SSA JMP RPOOL NO. * * CHECK IF PROGRAM WAS CLONED & RELEASE ITS ID SEGMENT. * LDB POOLA CHECK "CLONED" BIT IN #POOL ENTRY. JSB LODWD RAL (CHECK BIT 14) SSA,RSS JMP CLNAM NOT CLONED. GO CLEAR NAME. * ELA,CLE,ERA CLONED. CLEAR FLAG IN #POOL ENTRY. RAR JSB STUFF CLA LDB NAMAD JSB #CLON RELEASE CLONED ID SEGMENT. * CLNAM LDA N3 CLEAR PROG NAME IN #POOL ENTRY. STA TEMP LDB POOLA ADB B2 CLA JMP CLENT * * RELEASE TEMPORARY #POOL ENTRY. * RPOOL LDB POOLA JSB LODWD GET WORD 1. AND B377 CLEAR LEFT-BYTE FLAGS. JSB STUFF STORE BACK. * LDA POOSZ CLEAR WORDS 2-LAST. CMA,INA INA STA TEMP LDB POOLA CLA CLENT INB JSB STUFF ISZ TEMP JMP CLENT * JMP #SCSM,I RETURN TO CALLER. SKP * * LOAD WORD FROM S.A.M, CROSS-LOAD IF DMS SYSTEM. * LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE. RAR,SLA SKIP IF NON-DMS. JMP *+3 DMS. GO EXECUTE XLA. LDA B,I NON-DMS. PICK UP SAM WORD. JMP LODWD,I RETURN. XLA B,I CROSS-LOAD SAM WORD. JMP LODWD,I RETURN. SPC 5 * * SUBROUTINE TO STORE A WORD IN S.A.M. * STUFF NOP JSB $LIBR GO PRIVILEGED. NOP MOD1 JMP STUF2 NOP HERE IF DMS. XSA B,I STORE IN ALTERNATE MAP. RSS STUF2 STA B,I JSB $LIBX RETURN. DEF STUFF SKP * * CONSTANTS AND STORAGE. * B377 OCT 377 BIT14 OCT 40000 BIT15 OCT 100000 B2 OCT 2 B3 OCT 3 B4 OCT 4 B77 OCT 77 B1774 OCT 177400 D254 DEC 254 N3 DEC -3640 POOSZ DEC 7 SIZE OF #POOL ENTRY. SEQNO OCT 0 CLONF NOP CFLAG NOP ADDR NOP SSID NOP NAMAD NOP CNTR NOP POOLA NOP PTR NOP TEMP NOP * BSS 0 SIZE OF #SCSM. * END 6 s  91750-18034 2013 S C0122 &#SLAV              H0101 zhASMB,Q,R,C HED <#SLAV> SLAVE REPLY INTERFACE * (C) HEWLETT-PACKARD CO. 1980 NAM #SLAV,7 91750-1X034 REV 2013 800331 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #SLAV,#RPB,#SKEY EXT #OTCV,#LEVL,#BREJ,#RPCV,#GRPM,#MHCT * EXT XLUEX,.ENTR EXT #NRVS,#MAAS,#RSAX SPC 2 * #SLAV * ---------------- * SOURCE PART # 91750-18229 * * REL PART # 91750-16229 * * WRITTEN BY TOM MILNER * * DATE WRITTEN JUNE 1979 * * MODIFICATIONS * ------------- * SET BIT8 (DS STATUS BIT) IN LAST WORD OF REQUEST BUF * TKM 05.23.79 * MOVED REPLY BUFFERS TO LOCAL -- TKM 06.01.79 * ADDED ENTRY POINT 'C.BUF' WHEN 'Z' OPTION USED - TKM 06.25.79 * CHANGED #RSAX ERROR RETURN TO RETURN DS07 - TKM 07.09.79 * NOW SET BIT14 (REPLY BIT) IN STREAM WORD * AND ADDED MESSAGE ACCOUNTING (MA) -TKM 07.23.79 * PLUG IN HOP COUNT (#HCT) IN REPLY BUFFER -TKM 09.13.79 * CHECK FOR LEVEL CONVERTERS PRESENT - TKM 11.06.79 * INCLUDED 'XLUEX' CALLS FOR LU > 63 -TKM 12.05.79 * ADDED #SKEY ENTRY POINT FOR #RQUE/#NQUE -TKM 03.17.80 * ------------- SPC 2 * THIS ROUTINE SENDS SLAVE REQUESTS * CALLING SEQUENCE: * JSB #SLAV * DEF *+4 * DEF RQLEN REQUEST LENGTH * DEF DABUF DATA BUFFER * DEF DATAL DATA LENGTH * * * * * #SLAV IS CALLED BY DS/1000 MONITORS TO SEND A REPLY AND * T POSSIBLY DATA BACK TO THE ORIGINATING NODE. IT PERFORMS THE * FOLLOWING STEPS: * 1. DEALLOCATES THE SLAVE TCB, IF THIS FAILS TAKES THE * ERROR RETURN. * 2. VERIFIES THAT #MHD <= (REPLY LENGTH) <= #MXR AND IF NOT * RETURNS A DS03 ERROR. * 3. CONVERTS THE NODAL ADDRESS OF THE ORIGINATING CPU * TO AN OUTPUT LU. IF LU CONVERSION FAILS, A DS04 ERROR * IS RETURNED. * 4. DOES A CLASS I/O WRITE/READ OF THE REPLY(/DATA) TO * GRPM'S CLASS NUMBER (OR RPCNV'S CLASS IF A 3000 WAS * WAS THE REQUEST ORIGINATOR. * 5. RETURNS SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1>P SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SPC 3 A EQU 0 B EQU 1 SKP RQLEN NOP DABUF NOP DATAL NOP * #SLAV NOP JSB .ENTR GET CALLER'S PARAMETERS DEF RQLEN LDA CONWX STA LU+1 INITIALIZED CONTROL WORD * JSB #RSAX DELETE #SLAV TCB DEF *+4 DEF K7 DEF RPB+#SEQ DEF RPB+#STR STREAM WORD SSB JMP DS07 TCB SEARCH FAILED, ERROR RETURN STA RPB+#SEQ RESTORE OLD SEQ # IN REPLY * * CHECK NO-REPLY OPTION * LDA RPB+#ECQ LOAD NO-REPLY BIT SSA,RSS IS IT SET? JMP *+3 .NO ISZ #SLAV .YES, ADJUST FOR JMP #SLAV,I GOOD RETURN * * CLEAR OUT PARTS OF REPLY BUFFER * CLA STA RPB+#MAS STA RPB+#MAR STA RPB+#MAC *-- FILL IN HOP COUNT LDA #MHCT STA RPB+#HCT CCB ADB @RPB ADB C#LSZ ALLOW FOR LOCAL APPENDAGE ADB RQLEN,I --> 2ND WORD OF LOCAL APPENDAGE LDA BIT8 SET DS STATUS BIT & CLEAR 2ND WORD OF STA B,I LOCAL APPENDAGE. * * VERIFY REPLY LENGTH * LDB "03" LDA MINLN CHECK REPLY LENGTH CMA,INA ADA RQLEN,I SSA JMP GETDS GIVE DS03 IF < MINIMUM LDA MAXLN CMA ADA RQLEN,I SSA,RSS JMP GETDS GIVE DS03 IF > MAXIMUM * * MODIFY STREAM WORD * LDA RPB+#STR GET THE STREAM WORD OF THE REPLY. AND RTYCT CLEAR THE OLD RETRY COUNTER. IOR #BREJ INITIALIZE NEW RETRY COUNT. IOR BIT14 SET REPLY BIT  IOR BIT12 SET ">LEVEL 0" INDICATOR STA RPB+#STR RESTORE MODIFIED STREAM WORD. * * CHECK FOR REPLY TO DS/3000 REPLY CONVERTER. * LDB #RPCV PRESET = "RPCNV'S" CLASS NO. CLE,ELA POSITION DS/3000 BIT#15 TO . CLA,SEZ,CLE IF THIS IS A DS/3000 REPLY, SET LU=0, JMP RPL3K THEN BYPASS DS/1000 PROCESSING. * * CLEAR MA RETRY TICKS IN APPENDAGE * LDB @RPB ADB RQLEN,I INB --> RETRY TICKS LDA B,I AND MAMSK STA B,I * * CONVERT DESTINATION NODE TO AN LU # * JSB #NRVS SEARCH NRV FOR LU NUMBER DEF *+4 DEF RPB+#SRC (NODE NUMBER) DEF LU (NOT USED) DEF UPLVL (UPGRADE LEVEL OF DEST. NODE) JMP GETDS ERROR RETURN (IF NODE NOT IN NRV) STA LU LU NUMBER OF NODE * * ASSIGN MESSAGE ACCOUNTING (MA) SEQUENCE NUMBER * JSB #MAAS MA ASSIGNMENT DEF *+3 DEF RPB (REPLY BUFFER) DEF RQLEN,I (REPLY BUFFER LENGTH) JMP GETDS BUSY ERROR CODE DS08 IN * * ASSIGN LEVEL# AND SEND THE REQUEST(/DATA) * LDA RPB+#LVL LEVEL WORD AND BM17 MASK (OFF) #LVL BITS IOR #LEVL AND PLUG IN CURRENT UPGRADE STA RPB+#LVL LEVEL. * * CHECK DESTINATION UPGRADE LEVEL - IF LESS THAN ME SEND * MESSAGE TO REQUEST/REPLY CONVERTERS FOR TRANSMISSION. * LDA #LEVL IS UPGRADE LEVEL OF LOCAL NODE CMA,INA HIGHER THAN ADA UPLVL THAT OF ORIGINATION SSA,RSS NODE? JMP SETUP . NO WRITE OUT AS IS * LDB #OTCV OUTPUT CONVERTERS CLASS SZB,RSS CONVERTERS THERE? JMP DS071 . NO DS07 QUALIFIER 1 CLA OUTPUT TO BIT BUCKET JMP RPL3K * SETUP LDB #GRPM GET "GRPM'S" CLASS NUMBER. LDA LU GET LU RPL3K IOR BIT15 BYPAS SESSION SST STA LU SAVE CONFIGURED CONWHhD. STB CLASS SAVE CLASS NUMBER (#GRPM,#RPCV,#OTCV). * LDA RQLEN,I ADA C#LSZ STA RQLEN BUMP REQUEST SIZE FOR LOCAL APPENDAGE * JSB XLUEX DO CLASS WRITE/READ DEF *+8 DEF CLS20 NO ABORT DEF LU LU DEF DABUF,I DATA BUFFER ADDRESS DEF DATAL,I DATA LENGTH @RPB DEF RPB REPLY BUFFER ADDRESS DEF RQLEN REPLY LENGTH DEF CLASS * JMP #SLAV,I ERROR RTN TO P+1 ISZ #SLAV JMP #SLAV,I GOOD RTN TO P+2 * DS071 LDA BIT4 DS07/1 - NO CONVERTERS STA RPB+#ECQ DS07 LDB "07" RETURN DS07 ERROR GETDS LDA "DS" JMP #SLAV,I RETURN WITH ERROR CODE SKP *----------------------------------------------------- * CONSTANTS *----------------------------------------------------- * MAXLN ABS #MXR MAXIMUM REQUEST/REPLY HEADER MINLN ABS #MHD MINIMUM " " C#LSZ ABS #LSZ BIT4 OCT 000020 BIT8 OCT 000400 BIT12 OCT 010000 BIT14 OCT 040000 BIT15 OCT 100000 BM17 OCT 177760 MAMSK OCT 007777 CONWX OCT 010100 RTYCT OCT 170077 CLS20 DEF 20,I CLASS WRITE/READ--NO ABORT K7 DEC 7 "03" ASC 1,03 "07" ASC 1,07 "DS" ASC 1,DS *----------------------------------------------------- * STORAGE *----------------------------------------------------- #SKEY BSS 1 NOTE! THIS WORD MUST COME BEFORE RPB! RPB EQU * #RPB BSS #MXR+#LSZ REPLY BUFFER LU BSS 2 UPLVL BSS 1 CLASS BSS 1 * SIZE EQU * END ] t ~ 91750-18036 2013 S C0122 &#UP +              H0101 ]AASMB,R,Q,C HED <#UP> REROUTING ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #UP,7 91750-1X036 REV 2013 800422 ALL W/ RR SPC 1 ENT #UP SPC 1 EXT #NCNT,#NRV,#GRPM,#NODE EXT #LCNT,#CM,#QCLM EXT #LVSC EXT $OPSY,$LIBR,$LIBX,$TIME EXT XLUEX,EXEC,.ENTR,.LDX,.MVW * * NAME: #UP * SOURCE: 91750-18036 * RELOC: 91750-1X036 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #UP CALLING SEQUENCE: * * < A REG. = LU THAT IS COMING UP > * JSB #UP * * * * NOTE: #UP DOES NOT ENABLE A LINK TO START TRANSMITTING * USER MESSAGE, IT MERELY SENDS A DUMMY MESSAGE SO * THAT #UPDA WILL ENABLE THE OPERATION. THIS IS DUE * TO THE LINK RESTRICATION THAT A LINK UP INDICATION * ONLY GUARANTEES TRANSMISSION BUT NOT RECEPTION. * THUS, THE DUMMY MESSAGE SERVES AS A SIMPLE INITIAL * EXCHANGE HANDSHAKE. * SKP * ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM,˯ RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * SKP #UP NOP STA LU SAVE UP LU NOP JSB CONFG LDA #LCNT RR ENABLE? SZA,RSS JMP #UP,I .NO * * CHECK IF LINK IS REALLY UP * LDA LU IOR =B100000 STA CONWD LDA =B3600 STA CONWD+1 JSB XLUEX LINK STATUS CALL DEF *+3 DEF NA3 DEF CONWD JSB ERROR LDB 0 ALF,ALF AND =B77 CPA =B65 OLD LINK? JMP PREP SKIP CHECK RBR SLB ANY ERROR? JMP #UP,I .YES, IGNORE THIS UP INDICATION * * * PREPARE THIS NODE'S COSTS TO BE SENT TO THE NEW NEIGHBOR * PREP EQU * LDA LU LDB LU IOR =B100000 STA CONWD SAVE THIS AS THE CONTROL WORD LDA =B10100 STA CONWD+1 CMB,INB STB DESTN SET NEGATIVE LU AS DESTINATION NODE CLA SET UP STA I LOOP INDEX LDB #NRV STB @NRV SET UP NRV ADDRESS * LOOP EQU * LDA @DABF STA @DA SET UP DATA BUFFER ADDR CLA STA DALEN SET UP DATA LEN * LOOP1 EQU * ISZ I UP LOOP INDEX LDB @NRV ADB N.LU ==> NRV.LU JSB LDWD WILL RETURN NRV.LU WORD AND =B377 MASK OFF ALL EXCEPT LU SZA NRV.LU = 0? JSB #LVSC .NO, FIND INDEX OF LU CLA,INA CANNOT FIND LU, USE 1ST LINK STA MNLIX STORE IT AS MIN LINK INDEX LDB @NRV ==> NRV.NODE JSB LDWD WILL RETURN NRV.NODE WORD STA @DA,I STORE IT IN DATA BUFFER ISZ @DA UP @DA TO POINT TO COST AND HOP COUNT JSB LDCM CALL TO LOAD COST AND H.C. FROM CM DEF *+4 DEF I DEF MNLIX @DA NOP JSB ERROR ISZ @DA UP DATA ISZ @DA BUFFER ADDRESS LDB @NRV UP ADB NRVSZ NRV STB @NRV ADDRESS LDA DALEN ADA =D3 STA DALEN UP DATA LEN CPA MXLEN = MAZ BUF LEN? JMP SEND .YES, SEND IT LDA N CPA I ALL NODES? RSS .YES, SEND IT JMP LOOP1 * * SEND COSTS TO THE NEW NEIGHBOR * SEND EQU * LDA #GRPM LOAD CLASS # IOR =B100000 OR IN NO WAIT FOR SAM BIT STA CLASS JSB XLUEX SEND IT OUT DEF *+8 DEF NA20 DEF CONWD DEF DABUF DEF DALEN DEF RQBUF DEF RQLEN DEF CLASS JSB ERROR ERROR RETURN y SZA,RSS NO SAM FOR MESSAGE? JMP *+3 .NO, SKIP AROUND ISZ #UP .YES, ADJUST RETURN JMP #UP,I TO RETRY LATER LDA N CPA I END LOOP? JMP #UP,I .YES, RETURN JMP LOOP BACK TO LOOP SKP * * ERROR HANDLING * ERROR NOP DST AREG CLA STA #LCNT DISABLE RR LDA #QCLM SZA,RSS JMP #UP,I LDA @#UP CMA,INA ADA ERROR ADA =D-1 STA PREG LDA PNAME STA PGM DLD PNAME+1 DST PGM+1 DLD $TIME DST TOD JSB EXEC DEF *+8 DEF NA20 DEF K0 DEF MSGBF DEF MSGLN DEF K8 DEF K0 DEF #QCLM NOP JMP #UP,I * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP CLEAR CALL TO THIS ROUTINE LDA $OPSY GET O/S TYPE RAR SLA,RSS DMS? JMP INIT .NO STB LDMOD .YES, MOD INSTS STB SDMOD STB LSMOD * INIT EQU * LDA #NCNT CMA,INA STA N * LDA =B10000 STA STREM LDA #NODE STA SRC# CLA STA SEQ# UP MSG STARTS WITH SEQ# = 0 STA RQBUF+#REQ JMP CONFG,I *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** *** * * STWD STORES ONE WORD FROM LOCAL TO SAM * * CALLING SEQUENCE: * * = WORD TO BE STORED * ==> SAM WORD * STWD NOP JSB $LIBR NOP SDMOD JMP SDSTA XSA 1,I JMP SDJSB SDSTA STA 1,I SDJSB JSB $LIBX DEF STWD * *** *** * * LDCM MOVES WORDS FROM COST MATRIX TO LOCAL BUFFER * * CALLING SEQUENCE: * * JSB LDCM * DEF *+4 * DEF NIX NODE I9NDEX * DEF LIX LINK INDEX * DEF BUF RETURN BUFFER AREA * * * @NIX NOP @LIX NOP @BUF NOP * LDCM NOP JSB .ENTR GET PARAMETER ADDRESS DEF @NIX * * CM ADDR CALCULATION = (#LCNT(NIX-1)+LIX-1)2+#CM * LDA @NIX,I ADA =D-1 MPY #LCNT SZB JMP LDCM,I ERROR RETURN ADA @LIX,I ADA =D-1 ALS LEFT SHIFT(X2) FOR 2 WORD CM ELEMENTS ADA #CM * LDB @BUF ==> SAM BUFFER JSB LDWS LOAD 2 WORDS FROM SAM * ISZ LDCM ADJUST RETURN ADDR JMP LDCM,I * *** *** * * LDWS MOVES WORDS FROM SAM TO LOCAL * * CALLING SEQUENCE: * * ==> SAM WORDS * ==> LOCAL BUFFER * LDWS NOP LSMOD JMP LSMVW JSB .LDX DEF LSLEN MWF JMP LDWS,I LSMVW JSB .MVW DEF LSLEN NOP JMP LDWS,I LSLEN DEC 2 TWO WORD MOVE * *** SKP * * DATA AREA * CONWD BSS 2 WRITE CONTROL WORD NA3 OCT 100003 NA20 OCT 100024 K0 DEC 0 K6 DEC 6 K8 DEC 8 I NOP LOOP INDEX N NOP # OF NODES IN THE NET MNLIX NOP MIN LINK INDEX CLASS NOP @#UP DEF #UP PNAME ASC 3,#UP * @NRV NOP NRV POINTER NRVSZ DEC 3 SIZE OF NRV ENTRIES N.LU DEC 2 LU OFFSET * RQBUF BSS #MHD+#LSZ+1 STREM EQU RQBUF SEQ# EQU RQBUF+1 SRC# EQU RQBUF+2 DESTN EQU RQBUF+3 RQLEN ABS *-RQBUF * DABUF BSS 384 MAX BUFFER SIZE = 128*3 MXLEN ABS *-DABUF DALEN NOP @DABF DEF DABUF ADDRESS OF DATA BUFFER * MSGBF BSS 12 LU EQU MSGBF UP LU PREG EQU MSGBF+4 AREG EQU MSGBF+5 TOD EQU MSGBF+7 PGM EQU MSGBF+9 MSGLN ABS *-MSGBF END 'z$"$ u  91750-18037 2013 S C0122 &#UPDA +              H0101 bASMB,R,Q,C HED <#UPDA> REROUTING ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #UPDA,7 91750-1X037 REV 2013 800423 ALL W/ RR SPC 1 ENT #UPDA SPC 1 EXT #MHCT,#NODE,#GRPM,#QCLM EXT #LCNT,#CM,#NRV,#RQUE,#CMCT EXT #LVSC,#NRVS,#FDMN,#GETR EXT $OPSY,$LIBR,$LIBX,$TIME EXT EXEC,.ENTR,.LDX,.MVW * * NAME: #UPDA * SOURCE: 91750-18037 * RELOC: 91750-1X037 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #UPDA CALLING SEQUENCE: * * < A REG. = LU OF THE UPDATE MESSAGE > * JSB #UPDA * * * * SKP #UPDA NOP STA LU LDA #LCNT SZA,RSS JMP #UPDA,I NOP JSB CONFG LDA LU JSB #LVSC JMP #UPDA,I STA LIX STB @LV ADB LV.C ==> LV[LIX].COST JSB LDWD GET THAT COST STA LKCST SAVE IT AS THE LINK COST * JSB #GETR GET THE UPDATE MESSAGE DEF *+6 DEF #GRPM DEF RQBUF DEF RQLEN DEF DABUF DEF DALEN JSB ERROR LDA EC1 SZA ERROR RETURN? JMP #UPDA,I .YES, JUST RELEASE MSG STB I STORE LENGTH FOR LOOP CONTROL STB OVLEN SAVE IT AS OVERLAY LEN ALSO * * CHECK FOR INITIAL EXCHANGE MESSAGES (SEQ# = 0 OR 1) * LDA SEQ# GET SEQ # SZA ZERO? CPA K1 ONE? RSS .YES, SKIP NEXT JUMP JMP UPDA .NO, JUST DO UPDATE * * } IF INIT EXCH MSG, CHECK LINK * LDB @LV GET ADDR OF LV JSB LDWD ==> SAM BUFFER SSA IS LINK UP ALREADY? JMP NEIBR .YES, SKIP TO UP NEIGHBOR INFO IOR =B100000 .NO, SET LINK UP JSB STWD STORE IT BACK * * SEND UP LINK MESSAGE TO USER * LDA #QCLM SZA,RSS JMP NEIBR DLD $TIME DST TOD JSB EXEC DEF *+8 DEF NA20 DEF K0 DEF MSGBF DEF MSGLN DEF K6 DEF K0 DEF #QCLM NOP * * SET UP NEIGHBOR INFO IF NECESSARY * NEIBR EQU * LDB @LV GET LINK VECTOR ADDR ADB LV.N ADD NEIGHBOR OFFSET JSB LDWD GET NEIGNBOR NODE # SSA,RSS NEIGHBOR NODE SET ALREADY? JMP UPDA .YES, SKIP TO DO UPDATE LDA SRC# .NO, GET SOURCE NODE # JSB STWD STORE IT AS NEIGHBOR * JSB #NRVS FIND THAT NODE IN NRV DEF *+5 DEF SRC# DEF DUMMY T/O DEF DUMMY LEVEL # DEF NAYBR NEIGHBOR BIT JMP UPDA ERROR RETURN LDA NAYBR GET NEIGHBOR BIT SZA IS IT SET? JMP UPDA .YES, SKIP TO UPDATE LDA 1 GET NODE IX ADA =D-1 MPY NRVSZ ADA #NRV ADA NV.LU SET UP ADDR IN NRV LDB 0 JSB LDWD LOAD THAT WORD IOR =B400 SET NEIGHBOR BIT JSB STWD STORE IT BACK * * UPDATE THIS NODE'S INFO * UPDA EQU * LDA @DABF STA @DA * LOOP EQU * LDA @DA,I LOAD NODE # CPA #NODE = TO LOCAL NODE? JMP CHK .YES, SKIP UPDATE JSB #NRVS FIND NODE INDEX DEF *+2 @DA NOP JMP CHK1 STB NIX STORE IT SZA NRV.LU = 0? JSB #LVSC .NO, FIND LIX TO MIN COST CLA,INA USE 1ST LINK STA MNLIX * JSB LDCM FIND MIN COST DEF *+4 DEF NIX  DEF MNLIX DEF MNCST JSB ERROR JSB LDCM FIND COST TO NODE DEF *+4 DEF NIX DEF LIX DEF CM JSB ERROR LDA CM SZA,RSS ZERO COST? JMP CHK2 .YES, NO UPDATE * LDA @DA GET DATA ADDRESS INA UP ADDR TO GET DLD 0,I COST & H.C. STB CM+1 SAVE HOP COUNT ADB #MHCT - MAX HOP COUNT SSB,RSS > MAX? JMP SETMX .YES,SET MAX COST CPA =B77777 INFINITE COST? JMP SETMX .YES, SET MAX COST ISZ CM+1 UP HOP COUNT ADA LKCST ADD THE LINK COST SSA IF NOT TOO BIG, SAVE IT AS COST SETMX EQU * LDA =B77777 SET COST TO MAX STA CM SAVE IT * JSB STCM STORE NEW COST AND H.C. DEF *+4 DEF NIX DEF LIX DEF CM JSB ERROR LDA NIX LDB MNCST JSB #FDMN FIND NEW MIN JSB ERROR DST MNCST STORE NEW MIN COST JMP CHK2 * CHK EQU * LDA K0 STA MNCST STA MNCST+1 JMP CHK2 CHK1 EQU * LDA =B77777 STA MNCST CHK2 EQU * ISZ @DA POINT TO COST DLD MNCST LOAD MIN COST FROM THIS NODE DST @DA,I ISZ @DA POINT TO H.C. ISZ @DA POINT TO NEXT ENTRY LDA I ADA =D-3 STA I SZA END LOOP? JMP LOOP .NO CLA,INA .YES, SET SEND FLAG STA #CMCT JSB EXEC SCHEDULE SEND PROCESS DEF *+4 DEF NA10 DEF #SEND DEF SEQ# PASS SEQUENCE # JSB ERROR LDA SEQ# NEED TO EXCHANGE INITIAL MESSAGE? SZA = 0? CPA K1 = 1? RSS JMP #UPDA,I .NO ISZ SEQ# .YES, FIRST UP SEQ # LDA #NODE STA SRC# LDA LU CMA,INA STA DESTN LDA LU IOR =B100000 STA CONWD  JSB #RQUE SEND IT BACK OUT DEF *+9 DEF NA20 DEF CONWD DEF DABUF DEF OVLEN DEF RQBUF DEF RQLEN DEF #GRPM DEF #GRPM JSB ERROR ISZ #UPDA JMP #UPDA,I SKP * * ERROR HANDLING * ERROR NOP DST AREG CLA STA #LCNT DISABLE RR LDA #QCLM SZA,RSS JMP #UPDA,I LDA @#UPD CMA,INA ADA ERROR ADA =D-1 STA PREG LDA PNAME STA PGM DLD PNAME+1 DST PGM+1 DLD $TIME DST TOD JSB EXEC DEF *+8 DEF NA20 DEF K0 DEF MSGBF DEF MSGLN DEF K8 DEF K0 DEF #QCLM NOP JMP #UPDA,I * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP CLEAR CALL TO THIS ROUTINE LDA $OPSY GET O/S TYPE RAR SLA,RSS DMS? JMP CONFG,I .NO, JUST RETURN STB LDMOD .YES, MOD INSTS STB SDMOD STB LSMOD STB SSMOD JMP CONFG,I *** * * LDWD LOADS ONE WORD FROM SAM TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** *** * * STWD STORES ONE WORD FROM LOCAL TO SAM * * CALLING SEQUENCE: * * = WORD TO BE STORED * ==> SAM WORD * STWD NOP JSB $LIBR NOP SDMOD JMP SDSTA XSA 1,I JMP SDJSB SDSTA STA 1,I SDJSB JSB $LIBX DEF STWD * *** *** * * LDCM MOVES WORDS FROM COST MATRIX TO LOCAL BUFFER * * CALLING SEQUENCE: * * JSB LDCM * DEF *+4 * DEF NIX NODE INDEX * DEF LIX LINK INDEX * DEF BUF RETURN BUFFER AREA * * * @LNIX NOP @LLIX NOP @LBUF NOP * LDCM NOP JSB .ENTR GET PARAMETER aADDRESS DEF @LNIX * * CM ADDR CALCULATION = (#LCNT(NIX-1)+LIX-1)2+#CM * LDA @LNIX,I ADA =D-1 MPY #LCNT SZB JMP LDCM,I ERROR RETURN ADA @LLIX,I ADA =D-1 ALS LEFT SHIFT(X2) FOR 2 WORD CM ELEMENTS ADA #CM * LDB @LBUF ==> SAM BUFFER JSB LDWS LOAD 2 WORDS FROM SAM * ISZ LDCM ADJUST RETURN ADDR JMP LDCM,I * *** *** * * STCM MOVES WORDS FROM LOCAL BUFFER TO COST MATRIX * * CALLING SEQUENCE: * * JSB STCM * DEF *+4 * DEF NIX NODE INDEX * DEF LIX LINK INDEX * DEF BUF BUFFER AREA TO BE STORED * * * @SNIX NOP @SLIX NOP @SBUF NOP * STCM NOP JSB .ENTR GET PARAMETER ADDRESS DEF @SNIX * * CM ADDR CALCULATION = (#LCNT(NIX-1)+LIX-1)2+#CM * LDA @SNIX,I ADA =D-1 MPY #LCNT SZB JMP STCM,I ERROR RETURN ADA @SLIX,I ADA =D-1 ALS LEFT SHIFT(X2) FOR 2 WORD CM ELEMENTS ADA #CM * LDB 0 ==> CM BUFFER IN SAM LDA @SBUF ==> LOCAL BUFFER JSB STWS STORE 2 WORDS TO SAM * ISZ STCM ADJUST RETURN ADDR JMP STCM,I * *** *** * * LDWS MOVES WORDS FROM SAM TO LOCAL * * CALLING SEQUENCE: * * ==> SAM WORDS * ==> LOCAL BUFFER * LDWS NOP LSMOD JMP LSMVW JSB .LDX DEF LSLEN MWF JMP LDWS,I LSMVW JSB .MVW DEF LSLEN NOP JMP LDWS,I LSLEN DEC 2 TWO WORD MOVE * *** *** * * STWS MOVES WORDS FROM LOCAL BUFFER TO SAM BUFFER * * CALLING SEQUENCE: * * ==> LOCAL BUFFER * ==> SAM BUFFER * STWS NOP JSB $LIBR NOP SSMOD JMP SSMVW JSB .LDX DEF SSLEN MWI JMP SSJSB SSMVW JSB .MVW DEF SSLEN NOP SSJSB JSB $LIBX DEF STWS * SSW$"LEN DEC 2 2 WORD MOVE * *** SKP * * DATA AREA * K0 DEC 0 K1 DEC 1 K6 DEC 6 K8 DEC 8 NA10 OCT 100012 NA20 OCT 100024 I NOP LIX NOP NIX NOP MNLIX NOP LKCST NOP DUMMY NOP NAYBR NOP OVLEN NOP CONWD NOP OCT 10100 Z & WRITE BIT @#UPD DEF #UPDA #SEND ASC 3,#SEND PNAME ASC 3,#UPDA * CM BSS 2 MNCST BSS 2 * @LV NOP LV.C DEC 1 LV.N DEC 5 * NRVSZ DEC 3 NV.LU DEC 2 * MSGBF BSS 12 LU EQU MSGBF PREG EQU MSGBF+4 AREG EQU MSGBF+5 TOD EQU MSGBF+7 PGM EQU MSGBF+9 MSGLN ABS *-MSGBF * RQBUF BSS 5 STREM EQU RQBUF SEQ# EQU RQBUF+1 SRC# EQU RQBUF+2 DESTN EQU RQBUF+3 EC1 EQU RQBUF+4 RQLEN ABS *-RQBUF DABUF BSS 384 BUFFER SIZE = 128*3 DALEN ABS *-DABUF @DABF DEF DABUF END _{$ v  91750-18038 2013 S C0122 &#UPSM +              H0101 nASMB,R,Q,C HED #UPSM 91750-1X038 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #UPSM,7 91750-1X038 REV.2013 800324 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #UPSM * EXT XLUEX,$OPSY,$LIBR,$LIBX,#POOL EXT #BREJ,#NRVS,#GRPM,#OTCV,#LEVL,#NODE,#MHCT * SUP * * NAME: #UPSM * SOURCE: 91750-18038 * RELOC: PART OF 91750-12014, -12015 * PGMR: JIM HARTSELL * * SUBROUTINE TO PERFORM REMOTE HP1000 SESSION CLEANUP FOR UPLIN. * * CALLING SEQUENCES: * * TO LOG OFF AN ABANDONED REMOTE HP 1000 SESSION: * * (A) = ADDR OF PNL ENTRY * JSB #UPSM * * * BUMP "IDLE TIME" TIMER ON ALL ACTIVE #POOL ENTRIES: * * CLA * JSB #UPSM SPC 5 *********************************************************************** * * * * * * N O T E ! ! * * * * * * * * * THIS MODULE BUILDS A LEVEL 1 REQUEST AND WRITES IT DIRECTLY * * TO THE DRIVER (ON GRPM'S CLASS VIA XLUEX CALL). * * * *********************************************************************** SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * T * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP A EQU 0 B EQU 1 * #UPSM NOP ENTRY. * SZA,RSS CHECK TYPE OF CALL. JMP CLOCK GO BUMP #POOL TIMERS. * * PERFORM A NON-DLGOF NO-REPLY LOG-OFF OF A REMOTE HP 1000 SESSION * THAT HAS BEEN ABANDONED DUE TO THE MASTER PROGRAM TERMINATING WITHOUT * LOGGING OFF OR BEING PREMATURELY ABORTED. SIMILAR ROUTINE IN #MSSM * AND #DISM, BUT REQUEST IS BUILT FROM PNL ENTRY INFO. * * ON ENTRY, (A) = ADDRESS OF PNL ENTRY * STA B CLA RESET CERTAIN SLOTS. STA LGF+#SEQ STA LGF+#MAR STA LGF+#MAC LDA B7 BUILD STREAM WORD. IOR #BREJ IOR BIT12 SET "LEVEL 1 & ABOVE" BIT. STA LGF+#STR ADB B2 POINT TO 3RD WORD OF PNL ENTRY. JSB LODWD (CROSS) LOAD DEST NODE NUMBER. STA LGF+#DST STORE IN LOG-OFF REQUEST. LDA #NODE STA LGF+#SRC STORE SOURCE NODE # IN REQUEST. CLA,INA STA LGF+#LVL STORE UPGRADE LEVEL # IN REQUEST. LDA N2 M STA LGF+#MAS SET TO BYPASS MESSAGE ACCOUNTING. LDA #MHCT STA LGF+#HCT SET HOP COUNT. INB POINT TO 4TH WORD OF PNL ENTRY. JSB LODWD (CROSS) LOAD SOURCE SESSION ID. AND B377 ALF,ALF STA LGF+#SID (DEST SID ZERO.) ADB B2 POINT TO 6TH WORD OF PNL ENTRY. JSB LODWD (CROSS) LOAD DEST. SESSION ID. AND B377 STA LGF+#LNL STORE SESSION ID TO BE LOGGED OFF. * SZA IF NO REMOTE SESSION, CPA D254 JMP #UPSM,I EXIT NOW. LDA B2 STORE COMMAND LENGTH. STA LGF+#CML LDA "XX" STORE "XX" COMMAND. STA LGF+#CMS CCA STORE "NO-REPLY" REQ CODE. STA LGF+#LGC * JSB #NRVS SEARCH NRV (LU RETURNED IN (A)). DEF *+4 DEF LGF+#DST NODE # FOR SEARCH. DEF TEMP DUMMY. DEF UPLVL UPGRADE LEVEL OF DEST. NODE. JMP #UPSM,I ERROR. NODE NOT IN NRV. * IOR BIT15 BYPASS SESSION SST. STA LU SAVE COMMUNICATIONS LINK LU. LDB #GRPM GRPM'S CLASS NUMBER. STB CLASS * LDA #LEVL IS LOCAL UPGRADE LEVEL CMA,INA HIGHER THAN ADA UPLVL THAT OF DEST. NODE? SSA,RSS JMP WRITE NO. NO CONVERSION NEEDED. * LDA #OTCV YES. SEND TO MESSAGE CONVERTER. STA CLASS CLA STA LU * WRITE LDA L#LNL GET LENGTH OF REQUEST. ADA C#LSZ BUMP FOR LOCAL BUFFER. STA LEN CCB ADB @RQB ADB A (B) -> LAST WORD OF REQUEST. LDA B,I IOR BIT8 SET "DS STATUS" BIT. STA B,I * JSB XLUEX DO CLASS WRITE/READ TO DEST. LU. DEF *+8 DEF CLS20 NO ABORT. DEF LU DEST. LU & CONTROL WORD. DEF TEMP NO DATA. DEF B0 @RQB DEF LGF REQUEST BUFFER. DEF LEN REQUEST LENGTH. DEF CLASS I/O CLASS. NOP IGNORE ERROR. q] * JMP #UPSM,I RETURN. * LGF BSS #LNL+1 "NO-REPLY" LOGOFF REQ BUFFER. BSS 2 "APPENDAGE" AREA. SKP * * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM. * LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE. RAR,SLA JMP *+3 LDA B,I NON-DMS. JMP LODWD,I XLA B,I DMS. JMP LODWD,I SPC 3 * * SUBROUTINE TO STORE A WORD IN SAM. * STUFF NOP JSB $LIBR GO PRIVILEGED. NOP MOD1 JMP STUF2 NOP HERE IF DMS. XSA B,I STORE IN ALTERNATE MAP. RSS STUF2 STA B,I JSB $LIBX DEF STUFF SKP * * BUMP TIMER ON ALL ACTIVE #POOL ENTRIES. * CLOCK CLA LDB $OPSY SET UP "STUFF" ROUTINE. RBR,SLB SKIP IF NON-DMS. STA MOD1 MODIFY FOR DMS. * LDB #POOL GET ADDR OF SID POOL. SZB,RSS JMP #UPSM,I IGNORE IF ZERO. JSB LODWD STA TEMP SAVE # POOL ENTRIES (NEG.) INB SCAN STB POOLA SAVE POOL ENTRY ADDRESS. JSB LODWD GET WORD 1 OF NEXT ENTRY. SSA,RSS ENTRY IN USE? JMP BUMP NO. GO TO NEXT ONE. * ADB B6 YES. POINT TO TIMER WORD. JSB LODWD GET TIMER WORD. CPA MAX IS IT 32767? JMP BUMP YES. LEAVE IT ALONE. INA NO. ADD 1 (REPRESENTS ABOUT 5 SEC.). JSB STUFF STORE BACK INTO #POOL ENTRY. * BUMP LDB POOLA ADVANCE TO NEXT #POOL ENTRY. ADB POOSZ ISZ TEMP BUMP LOOP COUNT. JMP SCAN LOOP TILL DONE. * JMP #UPSM,I RETURN TO CALLER (UPLIN). SKP * * CONSTANTS AND STORAGE. * B0 OCT 0 B2 OCT 2 B6 OCT 6 B7 OCT 7 BIT8 OCT 400 BIT12 OCT 10000 BIT15 OCT 100000 B377 OCT 377 MAX OCT 77777 D254 DEC 254 N2 DEC -2 CLS20 OCT 100024 "XX" ASC 1,XX POOLA NOP POOSZ DEC 7 SIZE OF #POOL ENTRY. TEMP NOP UPLVL NOP LU NOP OCT 10100 &$"(LU+1) "Z" BIT & "WRITE". CLASS NOP LEN NOP L#LNL ABS #LNL+1 C#LSZ ABS #LSZ * BSS 0 SIZE OF #UPSM. * END $ w  91750-18039 2013 S C0122 &.CLGF              H0101 ucASMB,R,Q,C HED .CLGF 91750-1X039 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM .CLGF,7 91750-1X039 REV.2013 800429 RTE-IVB W/S.M. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT .CLGF * EXT $DSCS,EXEC,$LGOF,LUSES * * * NAME: .CLGF * SOURCE: 91750-18039 * RELOC: PART OF 91750-12014 * PGMR: G.L.M. * * * PURPOSE: DO A LOG-OFF * RETURN A CLASS NUMBER FOR INTEGERATION OF RESULT. * * * CALLING SEQUENCE: JSB .CLGF * CONTROL WORD (BIT 15=DISMOUNT PRIVATE) * (BIT 14=DISMOUNT GROUP) * (BIT 13=KILL ACTIVE PROGS) * (BITS 7-0 = SESSION ID) * * * RTN (A)-1= SESSION NOT INITIALIZED OR NOT INSTALLED * ELSE = CLASS# TO FETCH RESULT * * NOTE: IF (A)=0 SCB NOT FOUND (ID WAS NOT CORRECT) * * SKP .CLGF NOP XLA $DSCS FETCH DISC POOL POINTER (UP\DOWN FLAG) SSA IF NEGATIVE JMP ERR1 WE CAN'T CONTINUE * LDA .CLGF,I FETCH CONTROL PARM AND B377 ISOLATE ID STA ID * JSB LUSES DEF LURTN DEF ID FIND THIS SCB * LURTN SZA,RSS IF NOT FOUND JMP ERR2 EXIT A=0 STA ID SAVE FOR LOG-OFF CALL * * XLA $LGOF FETCH LGOFF CLASS # SZA,RSS IF NOT DEFINED JMP ERR1 SESSION NOT YET UP * IOR SAVC . MAKE SURE THE CLASS # ISN'T RELEASED STA LGC SAVE LGOFF CLASS NUMBER * * MAKE SURE LGOFF EXISTS AND IS EXECUTING \  * JSB EXEC DEF EX.4 DEF DS10 DEF LGOFF EX.4 EQU * NOP POSSIBLE ERROR CONDITION CPB "05" IF SCO5 ERROR JMP ERR1 DON'T GO ANY FURTHER * * GET CLASS # FOR RESPONSE FROM LGOFF * CLA STA CCLAS FORCE ALLOCATION * JSB EXEC DEF EX1 DEF D18 CLASS WRITE DEF NOP LU 0 DEF * DEF NOP ZERO LENGTH TRANSFER DEF * DEF * DEF CCLAS CLASS # RETURNED HERE EX1 EQU * * * * * * ISSUE CLASS WRITE-READ TO LGOFF * * * JSB EXEC DEF EX3 DEF DS20 NO-ABORT CLASS WRITE-READ DEF NOP LU 0 DEF CCLAS BUFFER ADDR DEF D1 LENGTH DEF .CLGF,I IOP1= PASSED CONTROL PARM DEF ID SCB ADDR OF SESSION TO KILL DEF LGC LGOFF CLASS NUMBER EX3 EQU * * JMP ERR1 IF CLASS REQUEST REJECTED, BAD NEWS. * * * * MAKE SURE LGOFF IS EXECUTING * * JSB EXEC DEF EX4 DEF DS10 NO-ABORT SCHED, NO QUEUE OR WAIT DEF LGOFF EX4 EQU * * NOP POSSIBLE ERROR RETURN * * LDA CCLAS RETURN COMMUNICATION CLASS IOR SAVC SET SAVE CLASS BIT RSS ERR1 CCA BAD STATE OF SESSION ERR2 ISZ .CLGF BUMP RTN JMP .CLGF,I * * LGOFF ASC 3,LGOFF B377 OCT 377 DS10 OCT 100012 D1 DEC 1 DS20 OCT 100024 NOP NOP ID NOP SAVC OCT 20000 CCLAS NOP LGC NOP D18 DEC 18 "05" ASC 1,05 END   x 91750-18040 2013 S C0122 &APLDL              H0101 v}ASMB,R,L,C HED APLDR-L 91750-16040 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM APLDR,1,40 91750-16040 REV.2013 800314 L SPC 1 * NAME: APLDL * SOURCE: 91750-18040 * RELOC: 91750-16040 * PGMR: JERRY BELDEN * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT APLDR ENT WRITF,OPEN.,TMP.,O.BUF ENT SECUR,FINFO SPC 1 EXT #CNOD,#NODE EXT RMPAR,PRTN,EXEC,DSTIO,.ENTR EXT PL..,IO..,LO.. SPC 1 APL.. DEF PL.. AIO.. DEF IO.. ALO.. DEF LO.. SPC 3 * * NAME: APLDR (L) * SOURCE: 91750-182?? * BINARY: 91750-162?? * PRGRMR: GAB * DATE: 13 JUN 79 * SKP * * APLDR-L IS A PROGRAM WHICH WILL EXECUTE A SUBSET OF THE * RTE-L ACTION ROUTINES. IT IS SCHEDULED LOCALLY BY COMND (DS * VERSION) OR BY EXECW (DS MONITOR). THE ACTION ROUTINES WHICH * ARE AVAILABLE ARE THOSE THAT MUST DO THEIR OWN MASTER CALLS. * SPECIFICALLY, THESE ARE 'LO','PL', AND 'IO'. * * THE FOLLOWING COMMAND STRINGS CAUSE APLDR-L TO BE * SCHEDULED: * * IO * PL[,XX] (XX IS THE PROGRAM LIST OPTION) * LO,PNAME,SC,CRN (LOAD COMMAND VIA 'COMND') * LO,PNAME:SC:CRN (LOAD COMMAND VIA 'REMAT') * * APLDR-L IS SCHEDULED WITHTHE FOLLOWING PARAMETERS: * * P1 - REMOTE SCHED[15]/LU[11:4]/FUNCTION[3:0] * P2 - LOAD FILE SECURITY CODE ('LO' ONLY) OR * UNUSED * P3 - CHARS 1 & 2 OF FILE NAME ('LO') OR * LIST OPTION ('PL') OR * UNUSED * P4&P5 - LAST 4 CHARS. FILE NAME ('LO') OR * UNUSED )* * WHERE FUNCTION IN P1 IS COMMAND TYPE: * 0 IS PL, 1 IS LO, AND 5 IS IO * SKP APLDR NOP ENTRY POINT JSB RMPAR PICK UP PARAMETERS DEF *+2 DEF ERLUF ARRAY ADDRESS JSB EXEC PICKUP UP LAST TWO PARAMETERS DEF *+5 DEF STCOD STRING PICKUP RCODE DEF .1 RETRIEVE FUNCTION DEF FINFO WILL CONTAIN CRN & FILE NODE # DEF .2 FOR 'LO' (2 WORDS) JMP APERR ERROR SZA ANY STRING ? JMP TERM1 NO, DON'T PROCESS (ILLEG. FATHER) CPB .2 2 PARAMETERS ? RSS JMP TERM1 NO, DON'T PROCESS LDA ERLUF REMOTE FLAG/LU/FUNCTION ALF,ALF ISOLATE LU FOR ALF CONSOLE/LIST AND B77 STA TMP. CLA STA IPRAM CLEAR ACTION ROUTINE ERR FLG. XOR B200 SET HONESTY MODE BIT FOR PRINT STA TMP.+1 SUBFUNCTION WORD (CONWD) LDA ERLUF AND B17 ISOLATE FUNCTION * LDB APL.. PRESET JUMP ADDR TO F=0 CPA .1 'LO' COMMAND ? LDB ALO.. YES CPA .2 OTHER 'LO' COMMAND? LDB ALO.. YES CPA .5 'IO' ? LDB AIO.. YES * * NEW ACTION ROUTINES ACCESSED VIA EXECW SHOULD INCLUDE * FUNCTION TEST & TRANSFER ADDRESS HERE. * JSB B,I CALL THE ROUTINE DEF *+4 DEF .1 PARAMETER COUNT (1 MAX) DEF PRGNM-1 PARAMETER BUFFER (PARSE FORMAT) DEF IPRAM ERROR CODE * * RETURN PROCESSING * LDA IPRAM ELA,CLE,ERA DON'T PRINT IO ERRORS SZA JMP ELOG AN ERROR, OUTPUT IT * TERM. JSB PRTN YES, RETURN ANY ERROR TO FATHER DEF *+2 DEF IPRAM TERM1 JSB EXEC DONE DEF *+2 DEF .6 SKP * * DUMMY OPEN CALL * ODCB BSS 2 * OPEN. NOP JSB .ENTR DEF ODCB JMP OPEN.,I SKP * * DUMMY WRITF ROUTINE (DOES ALL ASCII OUTPUT) * WDCB NOP WERR NOP WBUF NOP WLEN NOP * WRITF NOP JSB .ENTR DEF WDCB LDA TMP. WRITING TO SZA,RSS LU ZERO? JMP WRTRN YES, IGNORE LDA ERLUF LOCAL OR REMOTE SCHEDULE ? SSA,RSS SCHEDULED BY COMND ? JMP LOCAL YES LDA #CNOD SSA JMP LOCAL -1 IS LOCAL CPA #NODE NODE # MATCH ? JMP LOCAL YES * JSB DSTIO MUST BE REMOTE DEF *+6 DEF #CNOD DESTINATION NODE DEF N2 WRITE / NO ABORT DEF TMP. 2 WORD LU DEF WBUF,I DEF WLEN,I JMP DSERR * WRTRN CLA SET NO ERROR STA WERR,I INTO USER'S LOG JMP WRITF,I RETURN * DSERR DST IPRAM+1 SAVE ERROR LDA BIT15 STA IPRAM INDICATE IT JMP WRTRN DONE * LOCAL JSB EXEC DO LOCAL OUTPUT DEF *+5 DEF .2 WRITE DEF TMP. LU DEF WBUF,I DEF WLEN,I JMP WRTRN SKP * * ERROR PROCESSING * ELOG LDA IPRAM GET BACK ERROR LDB BLNK SET DEFAULT TO POSITIVE SSA LDB BSIGN NEG, GET MINUS SIGN STB ESGN SAVE ASCII SIGN SSA NEG ? CMA,INA YES, SET POS. CLB CLEAR B FOR DIVIDE DIV .10 DIVIDE BY 10. 2-DIGIT ERRORS ONLY ADB B60 MAKE REMAINDER ASCII ADA B60 MAKE QUOTIENT ASCII ALF,ALF POSITION QUOTIENT TO UPPER HALF IOR B PUT IN SECOND DIGIT STA ERCDE JSB WRITF OUTPUT THE ERROR DEF *+5 DEF DUMMY DEF DUMMY DEF ERBUF DEF .4 JMP TERM. DONE * ERBUF ASC 2,CMND ESGN NOP SIGN ERCDE NOP ERROR CODE IN ASCII * BLNK ASC 1, BSIGN ASC 1, - * APERR DST IPRAM+1 SAVE ERROR CODE LDA BIT15 STA IPRAM INDICATE ERROR MESSAGE JMwP TERM. DONE SKP * * CONSTANTS * .1 DEC 1 .2 DEC 2 .4 DEC 4 .5 DEC 5 .6 DEC 6 .10 DEC 10 B17 OCT 17 B60 OCT 60 B77 OCT 77 B200 OCT 200 BIT15 OCT 100000 N2 OCT 100002 STCOD OCT 100016 RCODE FOR STRING RECOVERY * A EQU 0 B EQU 1 SPC 2 * * LOCAL DATA * O.BUF EQU * DUMMY ENTRY REQ'D BY ACTION ROUTINES DUMMY NOP IPRAM BSS 5 RETURNED ERROR CODE TMP. BSS 2 LU (1ST WORD) & SUBFUNCTION (2ND) FINFO BSS 2 REMOTE FILE CRN & NODE # FOR 'LO' * * DO NOT ARRANGE THE NEXT 3 PARAMETERS (5 WORDS) * ERLUF NOP REMOTE FLAG/LU/FUNCTION SECUR NOP LOAD FILE SECURITY CODE PRGNM BSS 3 LOAD FILE NAME OR PL OPTION END APLDR uE y

LINES JMP CN27C YES * **************ILLEGAL CONTROL REQUEST************* * * JMP REJ1 * B1 OCT 1 B14 OCT 14 B26 OCT 26 B27 OCT 27 B65 OCT 65 B55 OCT 55 B160 OCT 160 B66 OCT 66 B103 OCT 103 * ******BACKSPACE 1 OR 2 RECORDS****** * BSR1 NOP BACKSPACE 1 LDB B61 GET ASCII <1> LDA BSR1 JMP OVER1 BSR2 NOP BACKSPACE 2 LDA BSR2 LDB B62 GET ASCII <2> OVER1 STA EQT8,I STORE RETURN ADD. STB EQT9,I SAVE 1 OR 2 LDA B55 SEND ASCII (-) JSB OUT4 LDA EQT9,I RETREIVE BS NUMBER JSB OUT1 LDA B160 SEND JSB OUT1 LDA B70 SEND JMP OUT5 * *********WRITE EOF************* * CN1C LDA B65 WRITE END OF FILE JSB OUT4 OUTPUT JMP OUT3 * ***********FORWARD SPACE RECORD************** * FSR1 NOP LDA FSR1 SAVE RETURN ADD. RSS CN3C CLA STA EQT8,I LDA B3 SET CONTROL REQUEST STA TEMP4 BECAUSE MAY GET HERE FROM READ 0 ADA B300 SET FOR FORWARD RECORD IOR EQT6,I ALSO SET IN CONWD BECAUSE WILL EXIT STA EQT6,I LDA B160 JSB OUT4 CN3C1 LDA B61 OUTPUT JMP OUT5 **********REWIND*************** CN4C JSB CTPRP LDA B60 REWIND JMP OUT5 * **********DYNAMIC STATUS***************** CN6C EQU * CLB,INB JSB I05W1 GO SET EQT'S SZA,RSS IS IT ZERO WD COUNT? JMP REJ1 YES , IGNORE REQUEST JSB CTUST GET CTU STATUS STA B LDA TEM11 GET DEVICE TYPE (OCTAL) RAL AND EQT27,I TEST EOF FLAG FOR DEVICE SZA ADB B200 EOF FLAG IS SET. SET IN IBUF LDA EQT7,I GET ADDRESS SWP (R01) SET UP... JSB MAPWR (R01) ...FOR CROSS MAP STORE ISZ EQT9,I BUMP FOR TRANSMIT LOG CLA SET FOR GOOD RETURN STA EQT29,I JMP EOOP3 * * *********LEADER AND TOP OF FORM********** * FOR THIS REQUEST DRIVER WRITES A EOF * * IF IT DID NOT JUST DO SO,OR TAPE IS * * NOT AT LOAD POINT * ***************************************** * CN10C JSB CTUST GET STATUS AND B300 SZA,RSS DID WE JUST WRITE A EOF OR AT LP? JMP CN1C NO! GO WRITE IT JMP EOOP4 YES,DO NOT WRITE TWO IN A ROW * **********FORWARD SPACE 1 FILE ************ * CN13C LDA B62 OUTPUT JSB OUT4 JMP OUT3 * ************BACKSPACE 1 FILE ************* * BSF1 NOP LDA BSF1 _! STA EQT8,I LDA B55 OUTPUT JSB OUT4 LDA B61 OUTPUT JSB OUT1 LDA B160 OUTPUT JSB OUT1 LDA B62 OUTPUT JMP OUT5 * ********WRITE END OF VALID DATA (EOV) * CN26C LDA B66 OUTPUT JSB OUT4 JMP OUT3 * *******LOCATE ABSOLUTE FILE (CTU)********* *****************OR*********************** *******SPACE LINES (PRINTER)************** * CN28C LDA EQT10,I GET CONTROL REQUEST CPA B11 IS IT T.0.F. OR SPACE LINES? RSS JMP REJ1 ONLY LEGAL CONTROL TO PRINTER IS 11B CN27C JSB CTPRP PREP. TERM. FOR CTU REQUEST LDA EQT7,I GET FILE NO. SZA,RSS IF ZERO CHANGE TO 1 INA JSB BINAS CONVERT TO ASCII AND SEND LDA B160 OUTPUT JSB OUT1 LDB TEM10 GET DEVICE TYPE CPB B64 IS IT LP? RSS YES A LP JMP CN27D LDB EQT7,I GET OPTIONAL PARAM. IF (-) THEN T.O.F. SSB,RSS IF (+) THEN SPACE (EQT7) LINES. JMP CN3C1 GO OUTPUT CN27D LDA B62 OUTPUT * OUT5 JSB OUT1 OUT3 LDA B103 OUTPUT JSB OUT1 JMP I25W5 GO WAIT FOR REQUEST COMPLETION OUT4 NOP LDB OUT4 SAVE RETURN ADDRESS STB EQT29,I JSB CTPRP JSB OUT1 LDA EQT29,I JMP A,I * *********BACKSPACE FILE AND RECORD******** * * BACKSPACE FILE AND RECORD REQUIRES SPECIAL PROCESSING * * TO POSITION AND SET STATUS AS A MAG. TAPE UNIT. THIS * * SPECIAL PROCESSING ENABLES THE USE OF EXISTING MTU * * SUBROUTINES. IF THE TAPE IS POSITIONED AFTER AN EOF THEN* * IT WILL MOVE BEFORE THE EOF AND A FLAG SET IN EQT27 * * (BIT3/BIT2 =RIGHT CTU/LEFT CTU) WHICH IS EXAMINED BY * * A DYNAMIC STATUS REQUEST. THESE SPECIAL EOF FLAGS ARE * * NECESSARY BECAUSE THE 264X DOES NOT RETURN EOF STATUS * * BEFORE THE EOF MARK. * * *********************************************************** * * * CN50C LDA EQT27,I SET CN50C ENTRY FLAG IOR B10 BIT3 STA EQT27,I LDB RSS SET CN50C FLAG STB EOOP7 JSB BSR1 ISSUE BACKSPACE 1 RECORD JSB CTUST GET STATUS STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB WE ARE THERE LDA TEM8 NOT AT L.P. AND B200 IF WE ARE AFTER EOF THE BIT 7 SET SZA,RSS JMP CN54C TAPE NOT AFTER EOF CN55C JSB BSR2 ISSUE BACKSPACE 2 RECORDS JSB CTUST IF AT EOF AGAIN WE ARE AFTER ANOTHER EOF STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB LDA TEM8 AND B200 AND HENCE NO FORWARD SPACE SZA DO NOT SET EQT27 EOF FLAG IF JMP EOOPB BETWEEN EOF'S JSB FSR1 FORWARD ONE TO GET US BEFORE EOF * * LDA TEM11 GET DEVICE TYPE RAL FOR SETTING EOF FLAG IN EQT27 IOR EQT27,I BIT1/BIT2=EOF LCTU/EOF RCTU AND BN55 REMOVE CN50C FLAG STA EQT27,I RESTORE IT JSB CTUST GET STATUS IOR B200 ADD EOF BIT STA TEM8 JMP EOOPA * * CN54C LDA EQT10,I TAPE NOT AFTER EOF CPA B2 IS THIS A BS RECORD? JMP EOOPB YES JSB FSR1 GET TAPE TO ORIGINAL POSITION JSB BSF1 BS FILE TO GET US AFTER EOF JMP CN55C NOW POSITION BEFORE EOF XIF * RECIV NOP LDA BIT15 SET CARD UP FOR RECEIVE,CHAR. IOR EQT31,I UPDATE STA EQT31,I FOR NEXT IO OPERATION JMP RECIV,I **************************************************** * SUBROUTINE CHECHS CHARACTER FROM IO CARD* * AND PLACES IT IN A REG. * * SPECIAL CHARCTER STATUS IS ALSO DETERMINED * * TEMP8=DATA * * TEMP14= SPECIAL CHARACTER RESAD * * **************************************************** * CHRIN NOP LDA CHRIN STA EQT37,I CLA CLEAR STA TEM14 SPEC. CHAR. STATUS LDA ASAVE GET REC WORD AND B377 ISOLATE DATA CHAR.(0-7) STA EQT33,I STORE IT LDB FILL IS THIS BINARY? SZB,RSS JMP CHSPJ YES,SKIP CHECKS AND B177 ASCII DATA STA EQT33,I WITHOUT PARITY BIT LDB EQT27,I GET STATE WORD BLF LOOK AT SPECIAL CHAR. BITS SLB,RSS LOOK FOR CR? JMP *+3 NO LOOK NEXT CPA CR YES, LOOK JMP CHSPH IS CR SSB,RSS JMP *+3 NO LOOK NEXT CPA RS YES, LOOK RSS IS RS JMP *+7 LDA EQT27,I IS T BLOCK AND PAGE? AND BN13 CPA BN13 RSS YES, DON'T LOOK FOR CR JSB OUT1 GET THE JMP CHSPH RBL,RBL LOOK FOR R.O. AND CNTL-D SLB,RSS LOOK FOR RUBOUT? JMP *+3 NO, LOOK NEXT CPA B177 IS IT R.O.? JMP CHSPH YES SSB,RSS LOOK FOR CNTL-D? JMP CHSPJ NO,RETURN CPA B4 IS IT CNTL-D? JMP CHSPH YES JMP CHSPJ NO,RETURN CHSPH LDA BN10 FOUND A SPECIAL CHAR. STA TEM14 TURN ON SPEC. CHAR BIT CHSPJ LDA EQT33,I STA TEMP8 GET REC. CHAR LDB EQT37,I JMP B,I THAT CAUSED THE INTERRUPT * * * *********************************************** * SUBROUTINE TRIGGERS BLOCK TRANSFERS * * FROM THE CPU. THIS IS DONE BY SENDING A * * DC1 TO TRIGGER THE TRANSFER AND * * THEN SETTING UP TO RECEIVE DATA. * *********************************************** * DC1OT NOP LDA DC1OT SAVE RETURN ADDRESS STA EQT32,I JSB XMIT SET UP FOR XMIT LDA B21 TO INHIBIT TRANS. UNTIL READY JSB OUT1 OUTPUT DC1 JSB RECIV SET RECIVE MODE JSB OUT1 WAIT FOR REC CHAR. LDA EQT32,I GET RETURN ADDRESS JMP A,I RETURN * B5 OCT 5 BN55 OCT 177767 B10 OCT 10 B400 OCT 400 * * BITCK NOP LDA ASAVE GET CONDITION BITS RAL,SLA JMP BITCK,I BIT 15 ISZ BITCK RAL,SLA JMP BITCK,I BIT 14 ISZ BITCK RAL,SLA JMP BITCK,I BIT 13 ISZ BITCK SSA JMP BITCK,I BIT 12 ISZ BITCK NONE JMP BITCK,I RETURN * * * * * ****************************************************** * SUBROUTINE SETS UP THE SPECIAL CHARACTERS. * * THE SPECIAL CHARACTER IS IN POSITION (THE A REG.) * * . 1/0 IS ADD/DELETE * * SPECIAL CHARACTER. * ****************************************************** * CDSET NOP STA B SAVE IN B RBL PUT ADD/DELETE BIT IN 15 ALF,ALF RAL,RAL PUT CHAR IN LOW ORDER AND B177 FIND OUT WHICH CHAR CPA CR CARRAGE RET.? LDA BIT12 YES CPA RS REC. SEP.? LDA BIT11 TES CPA B177 RUBOUT? LDA BIT10 YES CPA B4 CNTL-D? LDA BIT9 SSB,RSS CMA,RSS NO JMP *+3 DELETE AND EQT27,I ADD RSS IOR EQT27,I STA EQT27,I RESTORE STATUS JMP CDSET,I RETURN * ECHO NOP SET ECHO ON CARD PER A REG. STA B SAVE A LDA EQT31,I AND CMB11 SZB,RSS TURN ECHO ON OR OFF? IOR BIT11 OFF STA EQT31,I RESTORE JMP ECHO,I * *************************************************** * SUBROUTINE INITIALIZES SPEC. CHARS. * * BELOW ARE THE INITIAL CONDITIONS FOR CONTROL: * * * * ALL USED SPECIAL CHARACTERS (EXCEPT * *  RUBOUT) ARE CLEARD * * * *************************************************** * * CDINT NOP LDA B1512 DISABLE CR JSB CDSET LDA B3612 DISABLE RS JSB CDSET LDA BN56 DISABLE RUBOUT JSB CDSET LDA BN40 ENABLE CNTL-D JSB CDSET CLA LDB TEM10 GET DEVICE TYPE ADB TEMP4 AD#### CPB B61 IS IT A CRT IOR B20 YES! TURN ON ECHO JSB ECHO IT IS OFF FOR CTU AND LP * JMP CDINT,I (4 THRU 36) B61 OCT 61 BIT15 OCT 100000 BIT13 OCT 20000 (R03) BIT14 OCT 040000 BIT12 OCT 010000 BIT11 OCT 004000 BIT10 OCT 002000 BIT9 OCT 001000 CMB14 OCT 137777 ESC OCT 33 B136 OCT 136 B.4 OCT 177774 B.7 DEC -7 D.10 DEC -10 * ********************************************* * SUBROUTINE READS TERMINAL STATUS * * AND SETS EQT27 FOR : * * CHARACTER\BLOCK 0\1 (BIT15) * * LINE STRAP\PAGE STRAP 0\1 (BIT14) * ********************************************* * TERST NOP CLA JSB ECHO TURN ECHO OFF JSB SPCH1 JSB XMIT SET XMIT MODE LDA ESC OUTPUT ESCAPE JSB OUT1 LDA B136 OUTPUT CARROT. THESE TWO CHARACTERS JSB OUT1 PREP. TERM. FOR STATUS * JSB DC1OT GO TRIGGER STATUS TRANSMISSION WITH DC1 * LDA D.10 SET TO GET 10 BYTES STA EQT30,I SAVE COUNT RSS TERS1 JSB OUT1 WAIT FOR CHAR. JSB CHRIN GO GET CHAR..IT IS NECESARY TO READ LDB EQT30,I IS THIS THE CPB B.7 ONE ? JMP TERS0 YES CPB B.5 RSS JMP TERS2 AND B2 RAR,RAR STA B LDA EQT27,I RAL,CLE,ERA CLEAR CHAR/BLOCK IOR B UPDATE STA EQT27,I JMP TERS2 TERS0 AND B10 YES LOOK FOR LINE PAGE ALF,ALF  ALF,RAR MOVE TO POS 15 . (LINE\PAGE =0\1) STA B SAVE LDA EQT27,I GET STATUS AND CMB14 CLEAR L/P BIT (14) IOR B UPDATE STA EQT27,I TERS2 LDA TEM14 IS IT A SPECIAL CHAR. ? SZA JMP *+3 YES THE MUST BE A 2640X ISZ EQT30,I BUMP COUNT JMP TERS1 LOOK FOR NEXT LDA B20 ALL FINISHED JSB ECHO SET ECHO CLA STA EQT30,I CLEAR BIN COUNT JMP TERST,I * ************************************************* * SUBROUTINE OUTPUTS AN ENK TO TERMINAL * * AND WAITS FOR AN ACK. * ************************************************* * ENAK NOP LDA ENAK STA EQT33,I SAVE RETURN ADDRESS JSB XMIT SET UP FOR TRANSMIT LDA B5 OUTPUT ENK TO TERMINAL JSB OUT1 WAIT FOR XMIT INTERRUPT JSB RECIV SET START READ-SHEC.CONDITION JSB OUT1 GO SET START READ * LDA EQT33,I GET RETURN ADDRESS JMP A,I RETURN * IFZ * ************************************************ * SUBROUTINE READS THE CTU STATUS * * * *SET BIT0--UNIT BUSY OR CARTRIDGE NOT INSERTED* * BIT1--END OF VALID DATA * * BIT2--CARTRIDGE NOT WRITE ENABLED * *-------------- * BIT3--LAST COMMAND ABORTED * * BIT4--READ\WRITE ERROR * * BIT5--END OF TAPE * * ----------- * BIT6--LOAD POINT * * BIT7--END OF FILE * * * * THE CTU STATUS COMES IN THREE BYTES * * * BYTE * 1 EOF - LP - EOT - WR. ERR(2645) * 2 CMD.AB.- W.P. - RD.ERR. -BUSY(2645) * 3 RD.ERR. - RD.ERR.(HARD) - EOD -C.I. ************************************************ * CTUST NOP LDA CTUST SAVE RETURN ADDRESS STA EQT34,I * CLA TURN OFF JSB ECHO ECHO FOR STATUS READ * JSB CTPRP GO PREP. TERMINAL FOR CTU TRANSFER LDA B136 OUTPUT <^> JSB OUT1 JSB DC1OT TRIGGER TRANSFER WITH DC1 * LDB B.5 INITIALIZE STATUS COUNT STB EQT30,I RSS * * CTUS1 JSB OUT1 JSB CHRIN GET CHARACTER ISZ EQT30,I ARE THESE STATUS BYTES? JMP CTUS1 NO! GO GET NEXT CHAR. AND B17 ALF STA EQT30,I JSB OUT1 JSB CHRIN GET STATUS BYTE NO. 2 AND B15 ISOLATE BITS 0,2,3 IOR EQT30,I "OR" BYTE 1 WITH BYTE 2 STA EQT30,I STORE IT TEMPORARILY JSB OUT1 JSB CHRIN GET BYTE 3 AND B4 CHECK FOR READ ERROR RAL,RAL MOVE TO BIT 4 IOR EQT30,I STA B LDA TEMP8 GET BYTE 3 AND B3 ISOLATE FIRST TWO BITS (WEN AND EOV) XOR B1 COMPL. C.I. IOR B OR WITH BYTES 1 AND2 XOR B10 COMPLEMENT BIT 3 AND B377 ISOLATE STATUS BITS STA EQT30,I SAVE STATUS JSB OUT1 FOR THE LAST CHAR LDA EQT30,I GET STATUS CLB CLEAR STB EQT30,I RECORD COUNT * LDB EQT34,I SAVE RETURN ADDRESS JMP B,I * CTPRP NOP THIS SUBROUTINE PREPARES TERMINAL TO ACCEPT LDB CTPRP SAVE RETURN ADDRESS STB EQT35,I STA EQT32,I CTU CONTROL AND R\W REQUESTS JSB XMIT LDA EQT27,I CHECK FOR KEYBOARD DISABLE BIT AND B20 (BIT4) SZA IF SET ALREADY DISABLED JMP OVER6 LDA ESC JSB OUT1 LDA B143 (SMALL "C") JSB OUT1 LDA B20 IOR EQT27,I SET KEYBOARD DISABLE BIT STA EQT27,I OVER6 LDA ESC JSB OUT1 OUTPUT LDA B46 JSB OUT1 OUTPUT <&> LDA B160 JSB :_OUT1 OUTPUT LDA TEM10 GET DEVICE JSB OUT1 LDA B165 LDB TEMP4 GET REQUEST TYPE CPB B3 IS IT CONTROL? JSB OUT1 YES, SEND LDA EQT32,I RESTORE A REG LDB EQT35,I GET RETURN ADDRESS JMP B,I * * * * * ************************************************ *SUBROUTIONE TAKES A NO. IN A REG. * * (<1000D) AND CONVERTS TO ASCII WITH MSB * * AT BUFF1 AND LSB AT BUFF3. * *THE CHARACTERS ARE SENT MSB FIRST * ************************************************ * BINAS NOP LDB BINAS SAVE RETURN ADDRESS STB EQT32,I SSA IS NUMBER OK? (POSITIVE) JMP BINAS,I NO! LDB BN50 LOAD B WITH DEC -1000 ADB A ADD NUMBER TO -1000 SSB,RSS IS SIGN ZERO? JMP BINAS,I YES! EXIT FOR NUMBER >999 LDB ADDRT GET BUFFER ENDING ADDRESS ADB B2 ADD 2 STB TEMP1 STORE IT AT TEMP1 BINA1 CLB DIV LF DIVIDE NO. IN A REG. BY 10 ADB B60 CONVERT TO ASCII STB TEMP1,I STORE IT. LDB TEMP1 GET NEXT ADDRESS ADB B.1 DECREMENT IT STB TEMP1 RESTORE IT SZA IS THE A REG.(QUOTIENT) =0 ? JMP BINA1 NO! GO DIVIDE A REG. AGAIN LDA ADDRT YES! IT IS ZERO ADA B.1 CPA TEMP1 ARE WE FINISHED? JMP BINA2 YES!NOW GO OUPUT CHAR. CLA NO,GO FILL REMAINING PLACES WITH JMP BINA1 ASCII <0> BINA2 LDB ADDRT GET MSD IN B REG. STB EQT29,I STORE IT FOR LATER USE LDA B.3 SETUP COUNTER STA EQT30,I I25W8 LDA B,I GET ASCII CHAR. IN A REG. JSB OUT1 GO SEND IT! ISZ EQT29,I INCREMENT ADDRESS POINTER LDB EQT29,I RESTORE IN B REG. FOR ISZ EQT30,I ISZ COUNT COUNTER JMP I25W8 THERE ARE MORE,GO GET 'EM LDA EQT32,:%I GET RETURN ADDRESS JMP A,I * ADDRT DEF BUFF1 BUFF1 BSS 3 B46 OCT 46 B165 OCT 165 B15 OCT 15 B30 OCT 30 B143 OCT 143 * XIF ************************************************* * SUBROUTINE IS GENERAL OUTPUT ROUTINE * * TO TERMINAL. CHAR. IS IN A REG. * ************************************************* * OUT1 NOP GENERAL PURPOSE CHARACTER OUTPUT ROUTINE LDB OUT1 STB EQT36,I SAVE RETURN ADDRESS AND B377 CLEAR UPPER HALF STA B SAVE A LDA EQT31,I GET EQT31 AND BN15 SAVE UPPER IOR B UPDATE STA EQT31,I OLD DATA WORD JSB EXIT1 EXIT AND OUTPUT CHARACTER LDA EQT31,I AND BIT11 KEEP ECHO STA EQT31,I CONDITION LDA EQT36,I GET RETURN ADDRESS JMP A,I * * XMIT NOP SET CARD UP FOR XMIT LDA EQT31,I RAL,CLE,ERA KNOCK OUT OLD READ. IOR BIT14 TURN ON START WRITE BIT STA EQT31,I FOR NEXT WRITE JMP XMIT,I * * SPCH1 NOP THIS SUBROUTINE SETS SPECIAL CHAR. INTERRUPTS LDA BN12 JSB CDSET SET INTERRUPT LDA BN11 JSB CDSET SET INTERRUPTS JMP SPCH1,I RETURN * * B.1 OCT 177777 B.5 OCT 177773 BN50 DEC -1000 * * *********************************************** * * *********************************************** * * REJ3 LDA BIT13 (R03) NO-OP -> IGNORE INT JMP REJ4 (R05) REJ2 CLA ERROR RETURN CLB ISZ RTN TO PHYSICAL REJ1 EQU * JMP RTN,I DRIVER * **************************************************** * IS USED FOR CONTINUATION EXITS TO THE * * LOGICAL DRIVER, P+1 RETURNS. * **************************************************** * EXIT1 NOP LDB EXIT1 GET CALLING PROGRAMS ADDRESS+1 STB EQ"T11,I STORE AT EQT11,I FOR INTERRUPT REJ4 STA TEM12 (R05) SAVE DATA/DIR. LDA TEM11 GET DEVICE TYPE CPA B3 CLA LDB EQT14,I GET SET TIMEOUT SZA IF NON CRT THEN SET LDB TOUT 60 SEC. TIME OUT LDA TEM12 DATA DIR. ISZ RTN BUMP FOR CONTINUATION JMP RTN,I AND RETURN * * ********************************************************* * DOES ASCII CTU AND DISPLAY WRITE EOR PROCESSING* ********************************************************* * * EORP NOP LDA EORP SAVE RETURN ADDRESS STA EQT29,I LDA CR OUTPUT A JSB OUT1 LDA LF OUTPUT A JSB OUT1 LDA EQT29,I JMP A,I * * ******************************************** * ENABLES KEYBOARD IF IT HAS BEEN * * LOCKED BY A CTU REQUEST * ******************************************** * KEYBD NOP LDA EQT27,I AND B20 IS IT LOCKED (BIT 4) SET SZA,RSS JMP KEYBD,I NO! JSB XMIT LDA ESC UNLOCK KEYBOARD JSB OUT1 LDA B142 JSB OUT1 SEND SMALL B JSB CDINT LDA EQT27,I AND BN3 REMOVE KEYBD LOCK BIT STA EQT27,I JMP KEYBD,I * EOOP7 NOP IF CN50C FLAG IS SET(BIT3,EQT27) JMP EOOPC THEN EOOP7 IS LDA EQT8,I IT IS SET JMP A,I * EOOP8 LDB TEMP1 THIS EXIT IS USED IF UNDERSCORE CPB CMB5 IS ONLY CHAR. RSS * ********************************************************* * AND ARE ENTRIES FOR COMPLETION (P+1) * * EXITS. THE TERMINAL OR CTU STATUS IS TEMPORARLY PUT * * IN TEMP5. * ********************************************************* * EOOP1 EQU * EOOP2 CLA STA EQT29,I SET A REG. EXIT JMP EOOP3 * EOOPC LDB TEMP4 IF CONTROL ALWAYS GET STATUS& IFZ CPB B3 RSS SZA IF GOOD WRITE DO NOT GET STATUS EOOP5 JSB CTUST YES!,GO UPDATE CTU STATUS EOOP6 STA TEM8 * EOOPB LDA BN55 REMOVE EOF FLAG IN EQT27 LDB TEM11 BECAUSE TAPE HAS MOVED RBL XOR B LDB EQT27,I AND B STA EQT27,I LDA TEM8 * ****************************************************** * A READ TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 0 GOOD READ * * 40 END OF TAPE. GOOD RECORD READ * * 240 EOT+EOF. NO RECORD READ, * * SET FOR NR(A=1) EXIT * * 42 EOT+EOV * * 52 EOT+EOV+ABORT * * * ****************************************************** * * ****************************************************** * A WRITE TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 42 EOT+EOV GOOD RECORD WRITTEN * * 52 EOT+EOV+ABORT (NO RECORD WRITTEN)* * SET ET(A=1) EXIT * * * ****************************************************** * ****************************************************** * READ TO EOV IN MIDDLE OF TAPE * * STATUS * * 200 EOF * * 2 EOV * * 12 EOV+ABORT * * SET NOT READY EXIT * * * ****************************************************** * EOOPA AND B373 REMOVE WRITE PROTECT CPA B240 IF EOF+EOT THEN SET NR JMP OVER4 d CPA B52 IF FAILURE ON WRITE JMP OVER4 DUE TO EOT DO THIS(SAVE REQ.) AND B30 CHECK FOR CMD ABORT SZA OR READ-WRITE ERROR JMP OVER4 SET N.R. CLB STB EQT29,I SET A=0 FOR GOOD EXIT JMP EOOP3 OVER4 CLB,INB SET NR STB EQT29,I SET A REG. EXIT XIF *********************************************************** * IS ENTRY FOR B=0 (TRANS. LOG =0) EXIT. * *********************************************************** * EOOP4 CLA STA EQT8,I SET UP FOR B REG. =0 EXIT * ********************************************************** * SETS 2640\2644 AND IO CARD FOR NEXT INTERRUPT * * OR REQUEST, AND SETS EITHER CTU OR CRT STATUS IN EQT5 * * * IT ALSO SETS THE TRANSMISSION LOG IN B REG. (+CHAR. OR * * + WORDS). IF EQT8 =0 (VIA EOOP4) THEN B=0. * ********************************************************** * EOOP3 EQU * JSB KEYBD ENABLE KEYBD IF LOCKED LDB EQT13,I LOOK TO SEE IF ADB B6 FULL OR HALF DUPLEX LDA B,I WELL?? SSA JSB ENAK FULL DUPLEX, HANDSHAKE BEFORE EXIT CLA,INA SET ECHO ON JSB ECHO IF OFF CLA INDICATE WE ARE TRYING STA EQT11,I TO FINISH LDB EQT9,I GET 2X LAST CHAR. ADDRESS CMB,INB MAKE NEG. ADB EQT7,I SUBTRACT TWO TIMES STARTING ADD. ADB EQT7,I CMB,INB LDA EQT8,I IF WORDS THEN DIV. BY 2 SSA JMP *+4 THESE ARE CHARACTERS SLB IS LSB SET? INB YES! INCREMENT SO EVEN FOR DIVIDE BRS DIVIDE TO CONVERT TO WORDS * SZA,RSS IF EQT8 IS 0 THEN CLEAR B REG. CLB STB EQT6,I SAVE XMIT LOG LDA EQT13,I EXTENT ADDRESS ADA B3 BUMP TO EQ19 LDB EQT29,I WHAT KIND OF END IS IT? SZB SKIP IF GOOD JMP RTN,I BAD RETUcRN LDB A LDA B,I IOR B40 TURN ON BIT 5 STA B,I IN EQ19 FOR GOOD END JMP RTN,I RETURN * * * BN3 OCT 100007 TOUT DEC -600 B373 OCT 373 B142 OCT 142 B240 OCT 240 B106 OCT 106 B64 OCT 64 B300 OCT 300 B3 OCT 3 B6 OCT 6 B13 OCT 13 D.11 DEC -11 B2000 OCT 2000 B52 OCT 52 B77 OCT 77 (R05) BM40 OCT 177740 (R05) CMB11 OCT 173777 ********************************************************** * CONFIGURES IO INSTRUCTIONS TO SELECT CODE SET * * IN A REG. * ********************************************************** * SETIO NOP LDA BSAVE GET EQT ADDRESS STA EQT1 SSA CMA,INA MAKE POS. IF NEG. ADA B3 BUMP TO EQT4 STA EQT4 INA STA EQT5 INA STA EQT6 INA STA EQT7 INA STA EQT8 INA STA EQT9 INA STA EQT10 INA STA EQT11 ADA B2 STA EQT13 INA STA EQT14 IFN LDA B60 SET FOR CRT IF NO "Z" IN ASMB STATEMENT STA TEM10 XIF * IFZ LDA EQT4,I GET SUBCHANNEL TO IDENTIFY DEVICE LSR 6 SC=0 IS CRT (TEM10=60) AND B37 SC=1 IS L CTU )(TEM10=61) STA TEM11 CPA B3 IS THIS UNIT 3? CLA YES ADA B60 SC=2 IS R CTU (TEM10=62) STA TEM10 SC=4 IS PRINTER (TEM10=64) XIF LDA EQT6,I GET CONTROL WORD LDB TEM10 GET DEVICE CPB B64 IS IT LP? CLA YES! SET FOR ASCII RAR BIT6 1\0 IS BIN\ASCII AND B40 ISOLATE BIT 5 XOR B40 REMOVE BIT 5 IF BINARY STA FILL SET FILL CHARACTER LDA EQT6,I GET WORD AGAIN TO SET HONEST WORD LSR 6 AND B37 STA RDTYP LDA EQT6,I AND B2000 HONEST IS BIT 10 =1  STA TEMP2 * IFZ LDA TEM10 CLB CPA B60 SET SWITCH CRT/CTU = RSS/NOP LDB RSS STB SWH1A STB SWH1B STB SWH1C STB SWH1D * XIF * **************************************************** * SETUP EXTENSIONS ON EQT * * * * EQT NO. USE * * 1-8 STANDARD * * 9 RUNNING CHAR. ADDRESS * * 10 LAST CHAR. ADDRESS * * 11 ADDRESS TO GO ON INTERRUPT * * 12 NO. OF EQT EXTENSIONS * * 13 EQT EXTENSION STARTING ADD. * * 14-15 STD * * 16-26 USED BY THE PHYSICAL DRIVER * * 27 TERMINAL STRAPPING AND CTU INFO* * BIT 15 IS 0\1 =CHAR.\BLOCK * * BIT 14 IS 0\1 =LINE\PAGE * * BIT 12 IS CR SEARCH * * BIT 11 IS RS SEARCH * * BIT 10 IS RUBOUT SEARCH * * BIT 9 IS CNTLD SEARCH * * BIT 4 IS KEYBOARD LOCKED * * BIT 3 IS CNC50 FLAG * BIT 2 IS RCTU EOF FLAG * BIT 1 IS LCTU EOF FLAG * BIT 0 IS UNUSED * * 28 STORAGE FOR ICNWD * * 29 RETURN ADDRESS * * AND A REG. EXIT * 30 BINARY RECORD LENTGH * * 31 RETURN ADD. * * 32 AND RETURN ADDRES* * 33 RETURN ADDRESS * * 34 RETURN ADDRESS * * 35 RETURN ADDRESS * * 36 RETURN ADDRESS * * 37 RETURN ADDRESS * * **************************************************** * * LDA EQT4,I GET STARTING ADDRESS OF EXT. AND B77 (R05) SELECT CODE ADA BM40 (R05) MINUS 40 = PORT NUMBER MPY B13 THE ADDRESS IN ADA EQADR TEMP STORAGE LDB D.11 STB TEMP1 STORE NO. OF EXT. AT TEMP1 LDB ADR27 GET ADD. OF EQT27 STA B,I STORE S.A. OF EXT. IN IT INA INB ISZ TEMP1 JMP *-4 * CLB IF CN50C FLAG IS SET THEN LDA EQT27,I STORE A AT EOOP7 AND B10 SZA LDB RSS STB EOOP7 * LDA EQT6,I GET CONTROL WORD AND B3 STA TEMP4 STORE REQUEST TYPE AT TEMP4 CPA B3 IS THIS CONTROL? JMP OVER7 YES JMP OVER2 NO,READ OR WRITE OVER7 LDA EQT6,I LSR 6 IF CONTROL TYPE 0 AND B37 THEN SPECIAL PROCESSING REQUIRED SZA,RSS AT JMP OVER3 * * OVER2 LDA EQT6,I RAL,CLE,SLA,ERA CLR 15 IF SYS REQ STA EQT6,I NORMAL NON CNTL 0 REQ. STA EQT28,I STORE CURRENT CONWD FOR SYS. INTERRUPT JMP SETIO,I * * SPECIAL "CONTROL 0" PROCESSING * OVER3 LDA EQT6,I IS THIS A SYSTEM REQ.? SSA,RSS JMP REJ1 NO! * LDA EQT28,I GET OLD CONWD STA EQT6,I PUT IN CURRENT CONWD AND B2 IF WRITE MUST COMPLETE XFER CPA B2 OR TERMINAL WILL HANG JMP OVER9 LDA EQT9,I NO MORE DATA IN USERS BUFFER! STA EQT10,I IT IS GONE!!! OVER9 LDA TEM11 IF NON CRT REQ. WE MUST COMPLETE SZA JMP REJ1 CONTINUE NOT CRT REQ. * JSB KEYBD ENABLE KEYBOARD IF LOCKED LDA EQT6,I RAR SLA,RSS IF WRITE OR CONT. THEN SEND NULL JMP REJ1 THIS IS A CRT READ CLA SEND NULL TO ALLOW CHAR. OUT OF UART JSB OUT1 JMP EOOP1 AD<R27 DEF EQT27 EQT1 NOP EQT4 NOP EQT5 NOP EQT6 NOP EQT7 NOP EQT8 NOP EQT9 NOP EQT10 NOP EQT11 NOP EQT13 NOP EQT14 NOP EQT27 NOP EQT28 NOP EQT29 NOP EQT30 NOP EQT31 NOP EQT32 NOP EQT33 NOP EQT34 NOP EQT35 NOP EQT36 NOP EQT37 NOP * * TEMPORARY STORAGE FOR EQT27 TO EQT35 * SUP * * A EQU 0 DEFINE A REG. B EQU 1 DEFINE B REG. * * * * * *CONSTANT STORAGE ********** FILL NOP BINARY ASCII(SPACE = 0\40) TEMP1 NOP TEMP2 NOP HONEST MODE =2000 (NOT =0) TEMP4 NOP REQUEST TYPE (1-3 TEMP8 NOP ASCII DATA WORD TEM8 NOP TEMPORARY STATUS TEM10 NOP IN ASCIIYPE TEM11 NOP DEVICE TYPE(IN BINARY) TEM12 NOP TEM14 NOP COMPLETE DATA WORD ON CARD RDTYP NOP EQADR DEF EQTXX EQTXX BSS 176+176 (R05) ORG * END  ) 91740-18001 1913 S C0522 DS/1000 MODULE: LSTEN              H0105 AASMB,R,L,C,N HED DS/1000 INITIALIZATION * (C) HEWLETT-PACKARD CO. 1979 * IFZ NAM LSTEN,19,26 91740-16072 REV 1913 790126 XIF IFN NAM LSTEN,19,26 91740-16001 REV 1913 790126 XIF SPC 1 ENT LSTEN SPC 1 EXT READF,CLOSE,OPEN,RNRQ,PRTN,REIO,PGMAD,CNUMD EXT EXEC,MESSS,$LIBR,$LIBX,$OPSY,RMPAR,PARSE,#RSAX EXT #ST04,#MRTH,$BMON,#ST10 EXT #FWAM,#TBRN,#MSTO,#NULL,#QRN,#LDEF EXT #BREJ,#SVTO,#WAIT,#SWRD,#NODE,#NRV,#NCNT EXT #GRPM,#QCLM,#NCLR,#SCLR,#RFSZ,#RTRY EXT #CNOD,#LNOD EXT #LU3K,#QZRN,#RQCV,#RPCV,#QXCL EXT D$EQT,D$XS5,D$LID,D$RID,#SAVM EXT DRTEQ IFZ EXT D65MS,#BUSY,#PNLH XIF SUP * * NAME: LSTEN * SOURCE: 91740-18001 * RELOC.: 91740-16001 * PGMR: C. HAMILTON [ 02/12/77 ] * D. TRIBBY [ 03/17/77 ] DS/3000 CHANGES * ** MODIFIED TO HANDLE DVR07 [11/18/77] DMT ** MODIFIED TO PROVIDE SHUTDOWN [6-15-78] LAW ** ** MODIFIED TO PROVIDE COMMENTS [6-23-78] LAW ** ** MODIFIED FOR REMOTE DATA BASE ACCESS [10-27-78] CEJ * * * USE "Z" OPTION TO INCLUDE SHUTDOWN CAPABILITY * USE "N" OPTION TO EXCLUDE SHUTDOWN CAPABILITY * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 5 * LSTEN SERVES A DUAL PURPOSE. IT IS USED, PRIMARILY, TO INITIALIZE * THE DISTRIBUTED SYSTEMS NETWORK THROUGH ESTABLISHMENT OF THE * REQUIRED RESOURCES (CLASS NUMBERS, RESOURCE NUMBERS, TRANSACTION * LISTS, POINTERS, TIMERS, AND CONSTANTS), THROUGH THE ACTIVATION * OF 'LISTEN' MODE FOR EACH SPECIFIED COMMUNICATION LINE INTERGFACE, * AND BY SCHEDULING THOSE MONITOR-PROGRAMS WHICH SERVICE INCOMING * REQUESTS FROM REMOTE NETWORK NODES. SPC 3 * LSTEN'S SECONDARY PURPOSE IS TO ALLOW THE USER TO RE-ENABLE A * COMMUNICATION LINE INTERFACE, WHICH HAS BEEN INACTIVATED BY * UNFORESEEN MALFUNCTIONS. IT MAY ALSO BE USED TO BRING THE * NETWORK TO A QUIESCENT STATE, IN ORDER TO ADJUST SYSTEM TIMING, * OR FOR ANY OTHER PURPOSE WHICH REQUIRES SUSPENSION OF NETWORK * OPERATIONS, AT THIS PARTICULAR NODE. * SKP * +----------------------------------------------------------------+ * !SCHEDULING FOR INITIALIZATION: ! * +----------------------------------------------------------------+ * * *ON,LSTEN,(INPUT LU),(ERROR LU) * * SCHEDULE TO ACCEPT RESPONSES FROM A PERIPHERAL DEVICE. * * NOTE: IF SCHEDULING PARAMETERS ARE NOT SUPPLIED, LU #1 IS THE DEFAULT. * IF THE (INPUT LU) IS LINKED TO AN INTERACTIVE DEVICE, * INTERROGATORY REMARKS WILL BE DISPLAYED ON THE DEVICE. * THE (ERROR LU), IF SPECIFIED, MUST BE LINKED TO AN * INTERACTIVE DEVICE. * * *ON,LSTEN,FI,LE,NM [,SECURITY CODE [,CARTRIDGE NUMBER] ] * * SCHEDULE TO ACCEPT RESPONSES FROM A FILE . * * NOTE: ANY ERRORS WILL BE REPORTED ON LU #1; WILL THEN ABORT. * * CALL EXEC(10,NAME,-1,ICLAS,IRELN) * * USE A START-UP PROGRAM TO SCHEDULE WITH RESPONSES PASSED * IN I/O CLASS AND LENGTH . (THIS MODE IS INDICATED * BY A NEGATIVE FIRST PARAMETER.) * * +--------------------------------------------------------------+ * !INITIALIZATION QUERIES AND VALID RESPONSES (IN NORMAL ORDER): ! * +--------------------------------------------------------------+ * * NOTE: CONTROL FILE RESPONSES CONSIST OF ONE RECORD PER RESPONSE. * /A : ABORT IS A VALID RESPONSE TO ALL QUERIES. * * /LSTEN: SYSTEMS CONNECTED TO THIS NODE * /LSTEN: HP 1000?  * /LSTEN: HP 3000? * * /LSTEN: NO OF ACTIVE TRANSACTIONS? <1-100 (/D =DEFAULT OF 20)> * NOTE: EACH TRANSACTION USES 5 WORDS OF SYSTEM-AVAILABLE-MEMORY. * * NOTE: FOLLOWING QUESTIONS ARE ASKED ONLY WHEN HP3000 IS CONNECTED * /LSTEN: MAX NO. OF CONCURRENT HP3000 USERS? <1-10 (/D=DEFAULT OF 4)> * NOTE: EACH CONCURRENT USER REQUIRES 14 WORDS OF SAM * * /LSTEN: LU OF HP3000? * * /LSTEN: ENTER 0 FOR HALF, 1 FOR FULL DUPLEX: * NOTE: ASKED ONLY FOR MODEM LINK. * * /LSTEN: LOCAL ID SEQUENCE? <15 CHAR MAX: /E IF NONE> * NOTE: ASKED ONLY FOR MODEM LINK. * * /LSTEN: REMOTE ID SEQUENCE? <15 CHAR MAX: /E IF NONE> * NOTE: ASKED ONLY FOR MODEM LINK. * * END HP3000 OPTION. * * NOTE: FOLLOWING QUESTIONS ASKED ONLY WHEN HP1000'S ARE CONNECTED: * /LSTEN: ENABLE LU# ? * /LSTEN: ENABLE LU# ? * * /LSTEN: NDT FILE NAME [,SC[,CR]]? AAAAAA,NN,NN (FILE NAME) THIS FILE * DEFINES THE NETWORK DESCRIPTION TABLE & IS CREATED BY PROGRAM "NDTGN" * * /LSTEN: LOCAL CPU #? <1-32767 (DEFINES LOCAL NODE NUMBER) > * * NOTE: NDT TABLE MAY BE INTERACTIVELY CREATED, AS SHOWN BELOW: * * * /LSTEN: NDT FILE NAME [,SC[,CR]]? <0> (SPECIFY INTERACTIVE 'NDTGN') * * /LSTEN: LOCAL CPU #? <1-32767 (DEFINE LOCAL NODE NUMBER) > * * /LSTEN: NUMBER OF NODES? * * /LSTEN: CPU#,LU,TIMEOUT? * * (CPU# = 0 TO 32767 [NODAL ADDRESS]) * * (LU [DV-65]: 0=LOCAL NODE, 0 * /LSTEN: MONITOR NAME? * * /LSTEN: INPUT # OF FILES: <1 TO 255 (TOTAL FILES OPEN TO ALL NODES)> * NOTE: ASKED ONLY FOR /D OPTION, OR WHEN SPECIFIED. * * /LSTEN: SECURITY CODE? * * /LSTEN: OPERATION? < (SEE SECONDARY MODE FOR VALID RESPONSES) > * * ONCE THE SYSTEM HAS BEEEN INITIALIZED, SUBSEQUENT SCHEDULING OF * WILL CAUSE ENTRY INTO THE SECONDARY MODE OF OPERATION. * IN THIS MODE, THE USER MAY RE-ENABLE COMMUNICATION LINE INTERFACES, * SCHEDULE ADDITIONAL MONITORS, DISPLAY THE NODAL ROUTING VECTOR, * OR PLACE THE SYSTEM INTO QUIESCENT MODE. ONCE THE SYSTEM HAS BEEN * MADE QUIESCENT, THE USER MAY, ONLY, RESTART THE QUIESCENT SYSTEM. SKP * +--------------------------------------------------------------+ * !SCHEDULING FOR SECONDARY MODE OF OPERATION: ! * +--------------------------------------------------------------+ * * *ON,LSTEN,(LINE LU#),(ERROR LU#) * * THIS PROCEDURE IS USED TO RE-ENABLE THE LINE INTERFACE FOR A * SINGLE LOGICAL UNIT NUMBER. THERE IS NO INTERACTION WITH THE * USER, UNLESS AN ERROR IS DETECTED. IN THE EVENT OF ERROR * DETECTION, THE USER WILL BE QUERIED ON THE (ERROR LU#) DEVICE. * * (INPUT LU#),(ERROR LU#) < DEFAULT = LU#1 FOR BOTH > * / * *ON,LSTEN, : -1,CLASS #,RECORD LENGTH * FI,LE,NM [,SECURITY CODE [,CARTRIDGE NUMBER] ] * * IN SECONDARY MODE, SCHEDULING WITH AN INTERACTIVE TERMINAL * AS THE (INPUT LU#) DEVICE, OR UNDER THE CONTROL OF A COMMAND FILE, * WILL ALLOW THE USER TO SELECT SEVERAL POSSIBLE OPERATIONS. * * +-------------------------------------------------------------------+ * !SECONDARY MODE QUERIES AND VALID RESPONSES: ! * +-------------------------------------------------------------.------+ * * NOTE: /A (ABORT ) IS A VALID RESPONSE TO ALL QUERIES. * * **** ACCEPTABLE RESPONSES--NON-QUIESCENT SYSTEM **** * * -------------- TO RE-ENABLE A LINE ----------------- * * /LSTEN: OPERATION? * (REPEAT FOR AS MANY AS DESIRED) * /LSTEN: ENABLE LU# ? * * ---------------- TO DISPLAY THE NODAL ROUTING VECTOR -------- * * /LSTEN: OPERATION? LOAD-NODE= NNNNN (OR "NONE") [DISPLAYED FOR RTE-M, ONLY] * * --------------- TO ADJUST SYSTEM TIMING -------------------- * /LSTEN: OPERATION? * [ RESOLUTION = 5 SECONDS ] (DEFAULT VALUE = 45) * * /LSTEN: SLAVE T/O [5 TO 1275 SECONDS] ? <5 TO 1275 (NUMERIC RESPONSE)> * [ RESOLUTION = 5 SECONDS ] (DEFAULT VALUE = 30) * * /LSTEN: REMOTE-BUSY RETRIES [1 TO 10]? <1 TO 10(NUMERIC)> * (DEFAULT VALUE =3) * * /LSTEN: REMOTE-QUIET WAIT [0 TO 7200 SEC.]? <0 TO 7200 (NUMERIC)> * (DEFAULT VALUE =0) * * ---------------- TO TEMPORARILY SUSPEND NETWORK TRANSACTIONS ----- * (I.E., "QUIESCE" THE NODE) * * /LSTEN: OPERATION? * END LSTEN (TERMINATION MESSAGE) * * NOTE: WHEN QUIESCENT, PRINTS "SYSTEM IS QUIESCENT" ON LU#1. * * --------- TO SCHEDULE ADDITIONAL MONITORS ------- * * /LSTEN/: OPERATION? * /LSTEN: MONITOR NAME? * /LSTEN: OPERATION? * END LSTEN (TERMINATION MESSAGE) * * ----------- TO SHUTDOWN DS ACTIVITY & RELEASE RESOURCES --- * * /LSTEN: OPERATION? SD * /LSTEN: SYSTEM SHUTDOWN * /LSTEN: # ACTIVE TCBS: NNNNN * /LSTEN: # ACTIVE HP 3000 SESSIONS: NNNNN * /LSTEN: SECURITY CODE? * END LSTEN (TERMINATION MESSAGE) * * "SHUTDOWN" MAY BE INVOKED WHENEVER LSTEN IS SCHEDULED IN THE * SECONDARY MODE. WHEN SHUTDOWN IS COMPLETE, ALL RESOURCES OF * ANY KIND WHICH WERE ALLOCATED TO NETWORK-RELATED ACTIVITY * DURING THE PREVIOUS INITIALIZATION ARE RETURNED TO RTE. * THIS INCLUDES ALL CLASS NUMBERS, CLASS BUFFERS, RESOURCE NUMBERS, * NETWORK-RELATED PROGRAMS (GRPM,RTRY,QCLM,UPLIN,QUEX,QUEZ, * RPCNV,RQCNV,QUEUE,ETC.) AND ALL ALLOCATED SAM ARE RETURNED TO RTE. * THIS MEANS ALL SYSTEM RESOURCES. ALL COMMUNICATION LOGICAL UNITS * DEFINED IN THE NRV ARE CLEARED: THEY WILL NOT RESPOND TO INCOMING * MESSAGES. ALL SLAVE MONITORS ARE ABORTED AND THEIR CLASS NUMBERS * AND ANY BUFFERS OUTSTANDING ARE CLEARED (NOTE: ALL FILES CURRENTLY * OPEN TO 'RFAM' WILL BE LOST. FILES WHICH HAVE BEEN WRITTEN ON WILL * BE CORRUPTED). ALL MASTER PROGRAMS WAITING * FOR REPLIES ARE GIVEN A MASTER TIME-OUT ERROR. IF THEY REPEAT THEIR * REQUEST, THEY WILL RECEIVE A DS00 ERROR. * * THEREFORE, USE CARE IN DETERMINING WHEN TO RE-INITIALIZE. * * THE NEXT TIME LSTEN IS SCHEDULED, IT WILL REQUEST INITIALIZATION. * * THE USER SHOULD ALSO BE AWARE THAT WHENEVER DS/1000 IS * INITIALIZED, A BLOCK OF SAM IS ALLOCATED SEMI-PERMANENTLY FOR THE * DS-RELATED TABLE AREAS (TCBS, NRV, ETC.). IT IS NOT RETURNED TO * RTE UNTIL DS IS SHUTDOWN OR THE SYSTEM IS RE-BOOTED. INITIALIZING * DS WHILE OTHER PROGRAMS HAC)VE SAM: BLOCKS ALLOCATED WILL FRAGMENT SAM: * THAT IS, IT MAY DIVIDE THE "LARGEST POSSIBLE SAM BLOCK" (THE * SIZE OF WHICH RTE DETERMINES AT BOOT-UP) INTO TWO PORTIONS. IT WILL * THEN NOT BE POSSIBLE FOR A PROGRAM TO OBTAIN SUCH A LARGE BLOCK, * ALTHOUGH RTE WON'T KNOW THIS, WHICH MAY CAUSE A "DEADLOCK" CONDITION: * THE PROGRAM WILL BE WAITING FOR A BLOCK WHICH CAN NEVER BE GRANTED. * IT WILL BE PLACED INTO UNAVAILABLE MEMORY SUSPENSION DURING THIS * TIME, WHICH WILL HAVE THE SIDE EFFECT OF PREVENTING ANY * OTHER PROGRAMS OF LOWER PRIORITY FROM GAINING ANY SAM AT ALL, * EVEN SMALL BLOCKS WHICH COULD BE GRANTED (THIS IS A POLICY ENFORCED * BY RTE WHOSE PURPOSE IS TO ASSURE THAT HIGH-PRIORITY PROGRAMS * ARE NOT LOCKED OUT BECAUSE A SERIES OF SMALL-BLOCK SAM ALLOCATIONS * BY LOW-PRIORITY PROGRAMS PREVENTS A LARGE BLOCK FROM EVER BECOMING * FREE). THIS IN TURN MAY FORCE MORE PROGRAMS INTO UNAVAILABLE * MEMORY SUSPENSION THAN ACTUALLY BELONG THERE. * * THIS LEADS TO THE CONCLUSION THAT IT MAY BE HAZARDOUS (IN TERMS * OF AVOIDING DEADLOCKS AND MAXIMIZING OVERALL THRUPUT) TO * FREQUENTLY RE-INITIALIZE THE DS SYSTEM. IT ALSO FOLLOWS THAT IT * SHOULD BE INITIALIZED ON BOOT-UP. HOWEVER, THE USER WHO NEEDS TO * SHUT THE SYSTEM DOWN OCCASIONALLY, AND THEN START IT UP AGAIN * AND WHO CANNOT AFFORD TO SHUT THE SYSTEM DOWN TO RE-BOOT, SHOULD * TRY TO ARRANGE FOR INITIALIZATION TO OCCUR AT TIMES WHEN THE * OTHER DEMANDS UPON SAM ARE VERY SMALL OR NON-EXISTENT. * * * NOTE 1: THE NUMBER OF ACTIVE TCBS AND # OF ACTIVE HP 3000 SESSIONS * ARE PRINTED IN ORDER TO GIVE SOME INDICATION OF THE RELATIVE * DISTRIBUTED-SYSTEMS REMOTE ACTIVITY. IF THERE EXIST EITHER ACTIVE * TCBS OR ACTIVE HP 3000 SESSIONS, THEN SHUTTING DOWN WILL PROBABLY * INTERFERE WITH SOME USER OF THE SYSTEM (THAT IS, TERMINATE ALL * HIS PROCESSES ABNORMALLY, PERHAPS CAUSING OPEN FILES TO BE CORRUPTED >Y* OR, IN EXTREME CASES, PERHAPS DESTROYING A REMOTE DATA BASE). * IT IS STRONGLY RECOMMENDED THAT THE USER FIRST BROADCAST HIS * INTENTION TO SHUT THE SYSTEM DOWN TO ALL REMOTE USERS, GIVING * THEM TIME TO CLOSE THEIR FILES AND LOG OFF BEFORE DOING SO. * * IF THE SECURITY CODE ENTERED IS NON-NUMERIC, OR DOES NOT MATCH * THE ORIGINAL SET-UP SECURITY CODE, SHUTDOWN WILL NOT OCCUR. * IF YOU HAVE ASKED FOR SHUTDOWN, BUT DECIDE YOU DON'T WANT TO AFTER * SEEING THAT THE SYSTEM IS BEING USED, ENTER A ZERO FOR THE SECURITY * CODE (OR ANY NUMERIC, OR ANY INCORRECT SECURITY CODE). * * NOTE 2: ONCE SHUTDOWN HAS BEEN COMPLETED, THE NEXT TIME LSTEN * IS SCHEDULED IT WILL ENTER THE INITIALIZATION MODE. SKP * --------------- TO LIST ALL COMMANDS ------------------------ * * /LSTEN: OPERATION? * /LSTEN: QUIESCENT RE-START * /LSTEN: SECURITY CODE? < AA (MUST MATCH ORIGINAL SECURITY CODE)> SKP * * ERROR MESSAGES--INTERPRETATION AND APPROPRIATE ACTION: * ----------------------------------------------------- * * [ ALL MESSAGES ARE PRECEDED BY "/LSTEN:", OR, IN RTE-IVA/B * NODES, THE ACTUAL NAME OF THE "CLONED" ID-SEGMENT BEING * USED, E.G., "/LST09:"] SPC 1 * CLASS I/O ERROR - A REQUIRED CLASS NUMBER CANNOT BE ALLOCATED. * IS ABORTED. THIS ERROR MAY REQUIRE * RE-GENERATION WITH A LARGER ALLOTMENT OF CLASS NO'S. * * PROG NAME MUST BE 'LSTEN' - INTERNAL SECURITY CHECKS REQUIRE THAT * THE NAME OF THE PROGRAM BEING RUN TO INITIALIZE THE SYSTEM BE * NAMED 'LSTEN'. IN RTE-IVA & B SYSTEMS, THE USER'S COPY OF FMGR * WILL GENERALLY "CLONE" AN ID SEGMENT FOR HIM/HER WHEN DIRECTED * TO RUN A PROGRAM. TO AVOID THIS PROBLEM, RUN 'LSTEN' FROM THE * SYSTEM CONSOLE WHEN INITIALIZING OR SHUTTING DOWN THE SYSTEM. * * END LSTEN - NORMAL COMPLETION MESSAGE. THE TEN CHARACTERS COMPRISING * THE MESSAGE ARE ALSO RETURNED IN THE 5-WORD TEMPORARY * STORAGE AREA OF A SCHEDULER'S I.D. SEGMENT. THEY MAY BE * RECOVERED THROUGH THE USE OF . * IF HAS BEEN ABORTED, THE FIVE WORDS OF RETURNED- * DATA CONSIST OF: 100000B,ER, L,ST,EN * * ERROR: MON?: AAAAA - THE SPECIFIED MONITOR IS NOT IN THE SYSTEM. * ABORT , USING /A COMMAND, AND THEN LOAD * THE MONITOR INTO THE SYSTEM. RE-START . * * ERROR: STAT: AAAAA - THE MONITOR'S STATUS IS NOT 'DORMANT', AND * THEREFORE IT CANNOT BE SCHEDULED. * ABORT , USING /A COMMAND, AND THEN USE * RTE OPERATOR COMMANDS TO CHANGE THE STATUS. * * FILE ERROR - IMPROPER RESPONSE TO "INPUT # OF FILES". RETRY. * * INVALID NAME! - MONITOR NAME IS NOT RECOGNIZED BY . RETRY. * * INVALID RESPONSE! - OPERATOR ENTRY ERROR. RETRY. * (NO RETRY ALLOWED FOR QUIESCENT OR RE-START MODE) * * LSTEN ABORTED - IF INITIALIZATION WAS IN PROGRESS, THEN ALL ALLOCATED * RESOURCES HAVE BEEN RETURNED TO RTE. * * LU ERROR - IMPROPER LU# SPECIFIED, OR LU# NOT LINKED TO DVA65. RETRY. * * NODE SPEC. ERROR - IMPROPER NODAL REFERENCE VALUE. ABORTED! * CORRECT INITIALIZATION ANSWERS AND RESTART . * * NO SYSTEM MEMORY! - INSUFFICIENT SYSTEM AVAILABLE MEMORY FOR USE BY * THE NETWORK. SYSTEM CANNOT BE INITIALIZED. * _ IS ABORTED. RE-GENERATION OF RTE MAY * BE REQUIRED. * * READ ERROR - END-OF-FILE OR FMGR ERROR HAS BEEN DETECTED ON THE * INPUT DEVICE/FILE. THE QUESTION IS REPEATED ON THE * (ERROR LU) DEVICE. THE USER MAY SUPPLY THE REQUIRED * RESPONSE FROM THIS DEVICE. * * RN ERROR - A REQUIRED RESOURCE NUMBER CANNOT BE ALLOCATED; * IS ABORTED. RE-GENERATION, WITH A LARGER * ALLOTMENT OF RESOURCE NUMBERS, MAY BE REQUIRED. * * ID SEGMENT NAME MUST BE 'LSTEN' -- INITIALIZATION AND SHUTDOWN FUNCTIONS * CANNOT BE PROCESSED UNLESS THE PROGRAM NAME IS 'LSTEN'. * NOTE THAT SOME RTES WILL CREATE A COPY OF A PROGRAM WHEN * RUN FROM A NON-SYSTEM CONSOLE. ACTION: RUN 'LSTEN' FROM * SYSTEM CONSOLE. * * TR FILE ERROR - THE FILE MANAGER CANNOT PROCESS THE FILE * WHICH WAS SPECIFIED IN THE SCHEDULING * PARAMETERS. CORRECT THE FILE PROBLEM, * AND RE-SCHEDULE . * * ** UPLIN NOT SCHEDULED - THE SYSTEM TRANSACTION-MONITOR AND CLEANUP * PROGRAM COULD NOT BE SCHEDULED. * IS ABORTED! DETERMINE NATURE OF * PROBLEM AND CORRECT. RE-SCHEDULE . * * ANSWER YES OR NO - THE QUESTION REQUIRES A "YES" OR "NO" ANSWER * SKP PRAM NOP INPUT LU OR FIRST 2 CHARS. OF FILE NAME. NOP ERROR LU OR SECOND 2 CHARS. OF FILE NAME. NOP THIRD TWO CHARS. OF FILE NAME. NOP FILE SECURITY CODE--OPTIONAL. NOP FILE CARTRIDGE NUMBER--OPTIONAL. * SPC 2 * DEFINE MASTER TCB FORMAT * NXSTC EQU 0 NEXT TCB ENTRY TIMOT EQU 1 TIMEOUT COUNTER UD EQU TIMOT U & D FLAGS IN TIME-OUT WORD LOCSQ EQU 2 LOCAL SEQUENCE NUMBER MSCLS EQU 3 MASTER CLASS NUMBER IDSG@ EQU 4 MASTER'S ID SEGMENT NUMBER SPC 2 * DEFINE NRV FORMAT * NRVZ@ EQU 2 NUMBER OF WORDS PER ENTRY XMTL@ EQU 1 OFFSET TO GET TO TRANSMISSION LU SPC 2 LSTEN EQU * JSB RMPAR GET THE DEF *+2 PARAMETERS DEF PRAM FOR LOCAL USE. * LDA XEQT SAVE MY ID STA IDADR SEGMENT ADDRESS ADA D12 COPY ACTUAL NAME IN MY ID SEGMENT TO RAL LOCAL STORAGE FOR ERROR & PROMPT MESSAGES. LDB @MYNM MBT B5 * LDA @ENMG INITIALIZE ADDRESS OF RETURN PARAMS TO 'FATHER' PRGM STA $RTRN LDA $OPSY GET THE SYSTEM SPECIFICATIONS. RAR,RAR BIT#15: 1=DMS BIT#0: 1=RTE, 0=RTE-M. STA OPTYP SAVE THE USEFUL SYSTEM SPECIFICATIONS. SSA,RSS JMP NODMS THIS IS A NON-DMS SYSTEM * DLD XSBAI GET THE CROSS-STORE INSTRUCTION, DST STLNK AND CONFIGURE THE TWO NULL-LINK DST STERM INSTRUCTIONS FOR DMS OPERATION. DST LOOP3 DLD XCBAI DST NCHEK DLD XSANP DST STNOP DLD XLANP DST DSNR1 DST DSNR2 DST DSNR3 DLD XLABI PICK UP XLA B,I IFZ DST DSNR4 DST DSNR5 DST DSNR7 DST DSNR8 XIF DLD MWII DST NRMOV * * PICK UP READ LU NODMS LDA PRAM GET THE INPUT LU--IF ANY. UNL * TO INVOKE DEBUG, ADD FOLLOWING CODE: * EXT DBUGR * CPA M1 * RSS WE WANT DEBUG * JMP LSTN1 NO DEBUG * JSB DBUGR * DEF *+1 * CLB,INB TERMINATE * JMP TERM4 AND SAVE RESOURCES. LST LDB #FWAM GET "ALREADY-INITIALIZED" INDICATOR. STB ONTWO SAVE IN OPTION 1/2 FLAG WORD CLB INITIALIZE EQUIPMENT TYPE CODE STB TYPEQ TO INDICATE AN INTERACTIVE DEVICE. STB CLFLG CLEAR CLASS I/O FLAG. * LDB B1  IF LU NOT SUPPLIED, DEFAULT TO LU 1 SZA SUPPLIED? LDB A YES AND BT137 LU OR FILE? SZA CLB FILE...CLEAR FILE FLAG STB RLU SAVE READ LU OR 0 (FILE). SZB,RSS LU OR FILE? JMP LSTN2 FILE * JSB TTY? CHECK DEF RLU READ LU. SZB,RSS TTY? IOR B400 YES...SET IN ECHO BIT STA RLU SAVE AS INPUT LU STB TYPEQ SAVE INPUT DEVICE EQUIPMENT CODE. * * PICK UP ERROR LU LDA PRAM+1 SZA IS ERROR LU SUPPLIED? JMP LSTN2+1 YES...SAVE IT. LDA RLU NO. GET THE INPUT LU. SZB IS INPUT LU INTERACTIVE? LSTN2 LDA B1 NO...DEFAULT TO SYSTEM CONSOLE. STA ERLU SAVE ERROR LU * JSB TTY? CHECK DEF ERLU ERROR LU. SZB TTY? LDA B1 NO...SET TO SYSTEM TTY IOR B400 STA ERLU * JSB CHCKN SEE IF FILE JMP LSTN3 NOT FILE * LDA PRAM WAS 1ST PARAMETER SSA NEGATIVE? JMP CLASS YES--DO CLASS READ. * JSB OPENX OPEN THE FILE JMP *+2 OPEN ERROR! JMP LSTN3 OPEN WAS SUCCESSFUL. * JSB SYSER SYSTEM ERROR DEF TRFM "TR FILE ERROR" * LSTN3 LDB ONTWO OPTION 1/2 FLAG SZB OPTION 1? JMP OPTN2 NO...OPTION 2 * CPA B65 ATTEMPT TO INITIALIZE WITH SDI LU#? JMP LUER1 YES. SKIP TO REPORT THE ERROR. CPA B61 ALSO CHECK HP3000 DRIVERS JMP LUER1 CPA B66 JMP LUER1 CPA B67 RSS JMP INITL NO. GO TO START THE INITIALIZATION. * LUER1 JSB SYSER INFORM THE USER OF THE DEF LUERM " LU ERROR"--NO RETURN. * NLHHN SKP * SUBROUTINE TO CHECK DRIVER TYPE * CALLING SEQUENCE: JSB TTY? * DEF * UPON RETURN, A-REG=LU NUMBER, B-REG=0 IF INTERACTIVE * TTY? NOP LDA TTY?,I STORE ADDRESS OF STA CHKLU LU IN EXEC CALL. ISZ TTY? SET RETURN ADDRESS. * JSB EXEC MAKE STATUS CALL. DEF *+6 DEF D13 CHKLU DEF *-* DEF TEMP1 DEF TEMP DEF SBCNL * LDA TEMP1 GET EQT WORD 5. ALF,ALF ISOLATE AND B77 DRIVER TYPE. LDB A CPA B5 IF DVR05 JMP SBCH? OR CPA B7 DVR07. JMP SBCH? CHECK SUBCHANNEL. JMP LSN1A SBCH? LDA SBCNL ISOLATE AND SUBMK SUBCHANNEL. SZA,RSS IF ZERO, CLB IT'S INTERACTIVE. LSN1A LDA CHKLU,I A-REG := LU NUMBER. JMP TTY?,I RETURN. SPC 3 * SET UP DCB FOR DUMMY READFS DMDCB OCT 0,0 DIRECTORY ADDR DEC 2 FILE TYPE DEC 1,1 TRACK,SECTOR OF FILE DEC 2 # OF SECTORS (128 WORDS TOTAL) RECL BSS 1 RECORD LEN (3RD PARAMETER) OCT 200 1 BLOCK IN DCB DEC 96 # SECTORS/TRACK IDADR BSS 1 ID SEGMENT ADDRESS DEC 1,1 CURRENT TRACK,SECTOR DEF INDCB+16 ADDRESS OF DCB DATA OCT 100000 DATA IS IN DCB DEC 1 RECORD # DEC 0 EXTENT # @DMDC DEF DMDCB @DCB DEF INDCB * CLASS STA CLFLG SET CLASS I/O FLAG < 0. LDA $BMON CHECK FOR NEW DCB FORMAT SZA NEW? JMP ABORT NEW FORMAT NOT ALLOWED. LDA PRAM+2 GET RECORD STA RECL LENGTH. JSB EXEC MOVE DEF *+5 DCB DEF CLS21 DATA DEF PRAM+1 VIA DEF INDCB+16 CLASS DEF D128 I/O. JMP ABORT [ERROR RETURN] LDA @DMDC MOVE LDB @DCB DCB HEADER MVW D15 INFORMATION. JMP LSTN3 CONTINUE WITH NORMAL PROCESSING. SKP * INITIALIZATION CONTROL SECTION. * INITL EQU * ENTER HERE FOR FIRST RUN JSB CKLSN CHECK TO SEE IF OUR NAME IS "LSTEN" * JSB PRINT TELL USER: DEF MSG1 "SYSTEMS CONNECTED TO THIS NODE:" * LDA ASC10 ASK USER TO SPECIFY JSB CPUCK "HP 1000?" RMSA NOP * LDA ASC30 ASK USER TO SPECIFY JSB CPUCK "HP 3000?" RM3K NOP 3000 FLAG * IOR RMSA \ MAKE SURE SZA > AT LEAST ONE TYPE NODE JMP DT001 / WAS SPECIFIED JSB ERROR OTHERWISE-- DEF IVRES "INVALID RESPONSE" LDA TYPEQ INPUT FROM SZA TTY? JMP ABORT NO--ABORT. JMP INITL YES--TRY AGAIN * DT001 JSB SAM CALCULATE TCB NEEDS LDA RM3K IF NO HP3000 SZA,RSS INCLUDED JMP DT002 SKIP FOLLOWING BLOCK * JSB D3000 HP3000 INITILIZATION LDA RMSA IF NO HP1000 SZA INCLUDED, JMP DT002 LDB SAMSZ SET-UP SAM BLOCK JSB SGCO JMP DT003 AND SKIP FOLLOWING BLOCK. * DT002 CLA PREPARE FOR STA LTEMP LU ENTRY TESTING. JSB LUIN READ IN & INITIALIZE THE SPECIFIED LU'S LDA LTEMP SEE IF THEY ENTERED ANY LU'S SZA,RSS ? JMP ABORT NO...DIDN'T ENTER ANY LU'S JSB FRMT FORMAT ROUTE VECTORS * DT003 CLE JSB MSET SCHEDULE MONITORS & SET UP STREAM LISTS. * JSB SECOD SET NETWORK SECURITY CODE FOR THIS NODE. JSB SCHDQ SCHEDULE QUEUEING PROCESSORS, JMP OPT20 AND SEE WHAT ELSE USER WANTS * * SUBROUTINE TO ASK CPU QUESTIONS & INTERPRET RESPONSES CPUCK NOP STA MSG2+4 JSB PRINT PRINT THE QUESTION DEF MSG2 JSB READ READ THE RESPONSE CLA,INA CPB "YE" YES? JMP CPUC2 YES, SET THE FLAG CLA CPB "NO" NO? JMP CPUC2 CLEAR FLAG JSB ERXFR INFORM USER OF ERROR DEF ERR1 "ANSWER YES OR NO" JMP CPUCK+4 RETRY QUESTION * CPUC2 STA CPUCK,I SET CPU FLAG ISZ CPUCK SET CORRECT RETURN ADDRESS JMP CPUCK,I RETURN * SUBMK OCT 37 ASC10 ASC 1,10 ASC30 ASC 1,30 SBCNL NOP * MSG1 DEF *+2 DEF D16 ASC 16, SYSTEMS CONNECTED TO THIS NODE: MSG2 DEF *+2 DEF D6 ASC 6, HP 1000? _ ERR1 DEF *+2 DEF D9 ASC 9, ANSWER YES OR NO! SKP * SUBROUTINE TO OBTAIN CLASS & RESOURCE #S AND CALCULATE TCB BLOCK SIZE SPC 1 SAM NOP ENTRY/EXIT: SYS. AV. MEM. SET-UP. LDA D20 INITIALIZE DEFAULT NO. STA PRAM OF TRANSACTIONS =20. JSB PRINT ASK THE USER TO SPECIFY THE: DEF MSG0 " NO. OF ACTIVE TRANSACTIONS?" SOVER JSB READ READ THE RESPONSE. CPA B1 IF THE RESPONSE WAS NUMERIC, JMP SVALU GO TO PROCESS IT; ELSE, DETERMINE CPB /D IF DEFAULT VALUE IS TO BE USED. JMP SDFLT USE THE DEFAULT VALUE (32). * SERR JSB ERXFR IMPROPER REPLY: DEF IVRES GO TO INFORM THE USER OF THE ERROR; JMP SOVER THEN ALLOW ANOTHER CHANCE. * SVALU STB PRAM SAVE NO. OF TRANSACTIONS, TEMPORARILY. SSB,RSS IF VALUE NEGATIVE--INFORM USER OF ERROR. CMB,INB,SZB,RSS NEGATE THE NUMBER & CHECK FOR ZERO. JMP SERR * ERROR: NUMBER IS INVALID--TRY AGAIN * ADB D100 ADD THE MAXIMUM ALLOWABLE NO. (100). SSB IS THE SPECIFIED NO. ALLOWABLE? JMP SERR NO. GO INFORM HIM OF THE ERROR! * SDFLT LDB PRAM GET THE NUMBER OF TRANSACTIONS. CMB,INB FORM A LOOP COUNT STB LOOPC SAVE THE LOOP COUNT. LDA PRAM GET THE NUMBER OF TRANSACTIONS. MPY B5 N CALCULATE: MEMORY SIZE(WORDS) = STA SAMSZ (TRANSACTIONS)*(5 WDS./TRANSACTION) * LDA RM3K SZA,RSS JMP SAM,I NO HP3000--SKIP BELOW CODE * LDA B4 INITIALIZE DEFAULT NUMBER OF STA TST#+1 CONCURRENT USERS = 4 JSB PRINT ASK USER TO SPECIFY DEF MSG4 "MAX NO. CONCURRENT HP3000 USERS?" SOV1 JSB READ READ RESPONSE CPA B1 RESULT NUMERIC? JMP SVAL1 YES--PROCESS IT CPB /D DEFAULT WANTED? JMP SDFL1 USE DEFAULT OF 4 SERR1 JSB ERXFR IMPROPER REPLY: DEF IVRES INFORM USER OF ERROR JMP SOV1 AND TRY AGAIN SVAL1 STB TST#+1 SAVE # OF USERS SSB,RSS IF NEGATIVE--ERROR CMB,INB,SZB,RSS NEGATE NUMBER & CHECK FOR ZERO JMP SERR1 REPORT ERROR ADB D10 ADD MAXIMUM NUMBER ALLOWED (10) SSB BEYOND RANGE? JMP SERR1 YES--REPORT ERROR SDFL1 LDA TST#+1 MPY D14 STA TSTSZ SAVE # WORDS IN TST. ADA SAMSZ ADD NO. WORDS FOR TRANSACTIONS STA SAMSZ STORE TOTAL SAM NEEDED JMP SAM,I RETURN * SKP * SUBROUTINE TO OBTAIN SYSTEM AVAILABLE MEMORY & INITIALIZE NULL LIST. SPC 1 SGCO NOP ENTRY/EXIT STB TEMP SAVE TOTAL WORDS REQUIRED LDA DM3 STA RETRY SET # OF RETRIES FOR "DELAY" ROUTINE SREPT JSB #RSAX GO TO THE DEF *+3 SYSTEM RESOURCE-CONTROL ROUTINE, DEF ZERO TO REQUEST SYSTEM AVAILABLE MEMORY, DEF TEMP IN THE AMOUNT SPECIFIED BY THE USER. * CPA M1 IF THE AMOUNT WILL NEVER BE AVAILABLE, JMP NOMER INFORM THE USER OF THE PROBLEM. SZA HAS THE MEMORY BEEN ALLOCATED? JMP GETRN YES. GO TO GET RNS & CLASSES JSB DELAY NO. IT'S NOT AVAILABLE NOW--WAIT. JMP NOMER * RETRIES EXHAUSTED: INFORM USER! JMP SREPT TRY AGAIN FOR MEMORY ALLOCHATION. * GETRN CLE GET A JSB RNSUB RESOURCE NUMBER DEF TBRN# FOR THE TABLE-ACCESS RN. CLE GET A JSB RNSUB RESOURCE NUMBER DEF QRN# FOR THE SYSTEM-QUIESCENT RN. * LDA RM3K SZA,RSS JMP SGPP NO HP3000--SKIP THIS CODE * CLE GET A JSB CLSUB CLASS NUMBER DEF QXCL# FOR "QUEX" LDA QXCL# ALR,CLE,RAR CLEAR THE BUFFER SAVE BIT STA QXCL# JSB RNSUB GET A RESOURCE NUMBER DEF QZRN# FOR "QUEZ" LISTEN MODE JSB RNRQ GLOBAL LOCK RN DEF *+4 DEF GLOCK DEF QZRN# DEF TEMP1 CLE GET A JSB CLSUB CLASS NUMBER DEF RQCV# FOR REQUEST CONVERTER LDA RQCV# ALR,CLE,RAR CLEAR THE BUFFER SAVE BIT STA RQCV# JSB CLSUB GET A CLASS NUMBER DEF RPCV# FOR REPLY CONVERTER LDA RPCV# ALR,RAR CLEAR THE BUFFER SAVE BIT STA RPCV# * LDA RMSA SZA,RSS JMP NULNK JUMP IF NO DS/1000 * SGPP CLE GET A JSB CLSUB CLASS NUMBER DEF GRPM# FOR THE GENERAL PRE-PROCESSOR MODULE. CLE GET A JSB CLSUB CLASS NUMBER DEF RTRY# FOR THE WRITE RETRY MODULE CLE GET A JSB CLSUB CLASS NUMBER DEF QCLM# FOR THE ERROR LOG MONITOR. * NULNK JSB CLEAR GO TO CLEAR SYSTEM DATA AREA IN . LDA LOOPC COUNT FOR NUMBER OF TCBS STA TEMP JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. LDA #FWAM GET THE ADDRESS OF THE S.A.M. BLOCK, STA #NULL AND INITIALIZE HEAD OF NULL LIST. STA B LINK JMP SLOPX * SLOOP ADB B5 THE STLNK STB A,I NULL [CONTAINS XSB A,I: DMS] NOP LIST [NOP: RTE-II, DEF A,I: DMS] STB A F WITH SLOPX ISZ TEMP FIVE- JMP SLOOP WORD CLB NULL STERM STB A,I ENTRIES. [CONTAINS XSB A,I: DMS] NOP [NOP: RTE-II, DEF A,I: DMS] * * CPB RM3K DS/3000 ENABLED? JMP INIT NO, BYPASS THIS CODE * LDA TSTSZ CAX X-REG := # WORDS IN TST ADA NRVSZ ADA NRVSZ CMA,INA A-REG := -(#WORDS IN TST AND NRV) ADA #SAVM + SAM BLOCK SIZE ADA #FWAM + BLOCK'S STARTING ADDRESS STA TST# STORE TST ADDRESS * LOOP3 STB A,I [XSB A,I FOR DMS] NOP STORE INA ZEROES DSX IN JMP LOOP3 TST SKP * * INITIALIZE ALL GLOBAL RN'S, CLASS NUMBERS, AND COUNTERS IN 'RES'. * INIT LDA QCLM# GET THE CLEANUP MONITOR'S CLASS NO. CCE ALR,ERA REMOVE THE BUFFER SAVE BIT & SET NO WAIT BIT STA QCLM# SAVE THE CLASS WORD. * LDA LSBFA SOURCE = LOCAL BUFFER. LDB #SCLR DESTN = DATA AREA. MVW D18 MOVE THE DATA TO . * JSB $LIBX RESTORE THE DEF SGCO SYSTEM'S DEFENSES. * NOMER JSB SYSER GO TO INFORM THE USER THAT DEF NOMEM MEMORY IS UN-AVAILABLE--NO RETURN. * * DO NOT CHANGE ORDER OF ENTRIES (MATCHES ORDER IN )!! * LSBFA DEF TBRN# LOCAL 'RES' DATA BUFFER ADDRESS. TBRN# NOP TABLE-ACCESS RESOURCE NUMBER. QRN# NOP SYSTEM-QUIESCENT RESOURCE NUMBER. GRPM# NOP GENERAL PRE-PROCESSOR CLASS NUMBER. QCLM# NOP QUEUE CLEAN-UP MONITOR'S CLASS NUMBER. NOP ACTIVE TRANSACTION COUNTER. ABS 256-9 MASTER-REQUEST TIMEOUT(LOWER BYTE -9). ABS 256-6 SLAVE-REQUEST TIMEOUT(LOWER BYTE -6). RTRY# NOP WRITE-RETRY MODULE'S CLASS NUMBER. NOP D65MS QUIESCENT WAIT INTERVAL. NOP NODE SDECURITY CODE. OCT 6000 REMOTE-BUSY REJECT RETRY COUNT (-3). RPCV# NOP HP3000 REPLY CONVERTER CLASS NO. RQCV# NOP HP3000 REQUEST CONVERTER CLASS NO. LU3K# NOP LU NUMBER OF HP3000 QZRN# NOP QUEZ RN QXCL# NOP QUEX CLASS NO. TST# NOP HP3000 TRANS. STATUS TBL. ADDR NOP SIZE OF TST * XSBAI XSB A,I DMS: CROSS-STORE VIA ALTERNATE MAP. XCBAI XCB A,I CROSS-COMPARE XSANP XSA NPNT,I CROSS-STORE XLANP XLA NPNT,I CROSS-LOAD XLABI XLA B,I MWII MWI MOVE TO ALTERNATE MAP NOP (THIS 'NOP' REQ'D HERE!) * MSG0 DEF *+2 DEF D15 ASC 15, NO. OF ACTIVE TRANSACTIONS? _ IVRES DEF *+2 DEF D9 ASC 9, INVALID RESPONSE! NOMEM DEF *+2 DEF D9 ASC 9, NO SYSTEM MEMORY! MSG4 DEF *+2 DEF D18 ASC 18, MAX NO. CONCURRENT HP3000 USERS ? _ * LOOPC NOP LOOP COUNTER * SPC 4 * * DELAY SUBROUTINE: DELAY EXECUTION FOR 1-SECOND. * SET (BEFORE ENTRY) TO NEGATIVE NUMBER OF PASSES * ALLOWED THROUGH , BEFORE RETURN TO P+1 ERROR-RETURN. * NORMAL RETURN IS TO P+2, FOLLOWING DELAY OF 1-SECOND. * DELAY NOP ENTRY/EXIT: DELAY SUBROUTINE. JSB EXEC WAIT DEF *+6 1 SECOND DEF D12 TO ALLOW DEF ZERO SYSTEM DEF B1 CONDITIONS TO DEF ZERO CHANGE DEF DM100 AS REQUIRED. ISZ RETRY IF RETRY COUNT IS NOT EXHAUSTED, ISZ DELAY THEN SET RETURN TO P+2; ELSE, IF JMP DELAY,I EXHAUSTED, RETURN TO P+1--ERROR! * RETRY NOP RE-TRY COUNTER * SKP * SUBROUTINE TO INITIALLY ENABLE AN HP3000 LU * D3000 NOP * JSB PRINT ASK THE USER DEF D3MS1 "LU OF HP3000?". D3010 JSB READ GET THE RESPONSE. CPA B1 IF THE RESPONSE WAS NUMERIC, JMP D3020 GO TO PROCESS IT; ELSE DETERMINE D3ER1 JSB ERXFR DEF LUERM "LU ERROR". JMP D3010 TRY AGAIN. * D3020 STB LU3K# SAVE HP3000 LU INTERNALLY FOR NOW. * JSB EXEC GO TO RTE DEF *+4 TO GET THE DEF SD13 EQUIPMENT TYPE-CODE DEF LU3K# LINKED TO THE LU # DEF NCNT SUPPLIED BY THE USER. JMP D3ER1 INVALID LU. * CLA STA SWTCH SWTCH := 0 (HARD-WIRED) LDA NCNT ISOLATE THE ALF,ALF EQUIPMENT AND B77 TYPE-CODE. CPA B61 IF NOT DVG61, JMP D3025 CPA B66 DVG66, OR JMP D3025 CPA B67 DVG67, JMP D3000,I JMP D3ER1 IT IS AN INVALID LU. * D3025 LDA B2 SWTCH := 2 (MODEM) STA SWTCH * * SET UP EQT EXTENSION FOR SLC. * JSB PRINT ASK THE USER WHETHER DEF D3MS2 HALF- OR FULL-DUPLEX. D3060 JSB READ GET THE RESPONSE. CPA B1 IF THE RESPONSE WAS NUMERIC, JMP D3070 GO PROCESS IT. D3065 JSB ERXFR REPORT RESPONSE ERROR. DEF IVRES JMP D3060 ALLOW ANOTHER CHANCE. * D3070 LDA B WAS RESPONSE 0 OR 1? AND DM2 SZA JMP D3065 NO. ALLOW ANOTHER CHANCE. RBR POSITION TO BIT 15, STB SAVA AND SAVE TEMPORARILY. * LDA D$EQT+1 AND NOT15 CLEAR PRESENT DUPLEX BIT. IOR SAVA STORE DUPLEX BIT IN STA D$EQT+1 EQT EXTENSION, WORD 2. * LDA D$XS5 GET WORD S+5 OF EQT EXTENSION. AND DM3 CLEAR PRESENT "SWITCHED" BIT. IOR SWTCH STORE SWITCHED OR NON-SWITCHED BIT STA D$XS5 IN EQT EXTENSION, WORD S+5. * * GET LOCAL AND REMOTE ID SEQUENCES. * LDA NCNT IF NOT MODEM LINK, SKIP. SZA,RSS JMP D3030 * JSB PRINT ASK THE USER DEF D3MS4 "LOCAL ID SEQUENCE?"  JSB READ GET THE RESPONSE. LDA PRNTL GET # BYTES THAT WERE INPUT. CPB /E IF ID SEQ NOT WANTED, JMP D3027 SKIP IT. LDB D$LID JSB STRID STORE LOCAL ID SEQ IN "RES". * D3027 JSB PRINT ASK THE USER DEF D3MS5 "REMOTE ID SEQUENCE?" JSB READ GET THE RESPONSE. LDA PRNTL GET # BYTES THAT WERE INPUT. CPB /E IF ID SEQ NOT WANTED, JMP D3030 SKIP IT. LDB D$RID INB SKIP WORD FOR RETURN PARAM. JSB STRID STORE REMOTE ID SEQ IN "RES". * D3030 JMP D3000,I RETURN * * NOT15 OCT 77777 SWTCH DEC 0 CHANGED TO 1 FOR MODEM GLOCK OCT 100002 SAVA OCT 0 TEMP NOP D3MS1 DEF *+2 DEF D8 ASC 8, LU OF HP3000? _ D3MS2 DEF *+2 DEF D20 ASC 20, ENTER 0 FOR HALF, 1 FOR FULL DUPLEX: _ D3MS4 DEF *+2 DEF D11 ASC 11, LOCAL ID SEQUENCE? _ D3MS5 DEF *+2 DEF D11 ASC 11, REMOTE ID SEQUENCE? _ * * SUBROUTINE TO STORE ID SEQUENCE IN "RES". * (A) = # BYTES * (B) = ADDRESS IN "RES". * INBUF = ASCII INPUT BUFFER (ADDR = DINBF). * STRID NOP STB TEMP1 DESTINATION ADDR. * LDB A IS # BYTES .LE. 16? ADB DM17 SSB,RSS LDA D16 NO. TRUNCATE TO 16 BYTES. STA TEMP1,I STORE # BYTES. STA B BRS GET LAST CHARACTER IN BUFFER. ADB M1 ADB DINBF LDA B,I AND D255 CPA D32 IS IT A BLANK? JMP STR1 YES. LDA TEMP1,I NO. ARE THERE 16 BYTES? CPA D16 RSS JMP STR2 NO. STR1 LDA B,I YES. CLEAR THE BLANK (OR 16TH BYTE), AND DM256 STA B,I LDA TEMP1,I AND DECREMENT BYTE COUNT. ADA M1 STA TEMP1,I INA STR2 ISZ TEMP1 CLE,ERA NO. OF WORDS TO STORE. LDB TEMP1 DESTINATION ADDRESS STA TEMP1 # OF WORDS LDA DINBF SOURCE ADDRESS MVW TEMP1 PERFORM MOVE * JMP STRID,I RETURN TO CALLER SKP * OPTION 2 IS ENTERED WHEN SYSTEM IS ALREADY INITIALIZED. * OPTN2 JSB CHCKN SEE IF THEY WANT TO READ FROM A FILE JMP *+2 NO...IT'S AN LU. JMP OPT20 YES CPA B65 IS IT DVA65? JMP OPT22 YES CPB #LU3K IS IT THE HP3000 LU? JMP OPT23 YES OPT20 JSB PRINT DEF OPMES " OPERATION?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES. CONTINUE PROCESSING. JMP EXPLN NO...EXPLAIN THE POSSIBILITIES! CPB /E REQUEST TO TERMINATE? JMP TERM YES. GO TO OBLIGE. CPB EX TERMINATE (ALTERNATE)? JMP TERM YES. GO TO OBLIGE. CPB /S REQUEST TO SCHEDULE MONITOR(S)? JMP SKEDM YES. GO TO SET UP TO SCHEDULE. CPB /T REQUEST TO MODIFY TIMING? JMP TIME YES. CPB /N REQUEST TO DISPLAY NRV? JMP DSNRV YES. SATISY THE REQUEST. IFZ CPB SD REQUEST TO SHUT DOWN? JMP SHUTD YES, GO RELEASE RESOURCES XIF CPB ?? IS THE USER PUZZLED? JMP EXPLN YES...GIVE HIM SOME ASSISTANCE. JSB RNRQ GO TO RTE DEF *+4 TO OBTAIN THE DEF GLCNW STATUS OF THE DEF #QRN SYSTEM QUIESCENT DEF TEMP1 RESOURCE NUMBER. LDB PARSB+1 GET THE USER COMMAND, AGAIN. LDA TEMP1 GET THE STATUS OF #QRN. CPA B7 IF THE SYSTEM IS ALREADY QUIESCENT, JMP QCHNG THEN ONLY /R IS ALLOWED; ELSE, CPB /L REQUEST TO RE-ENABLE A LINE? JMP OPT21 YES. GO TO DETERMINE THE LU NUMBER. CPB /Q REQUEST TO MAKE THIS NODE QUIESCENT? JMP QUIES YES.GO TO PROCESS THE REQUEST. JMP EXPLN USER IS CONFUSED...HELP HIM! * QCHNG CPB /R REQUEST TO RE-START FROM QUIESCE_NCE? JMP REQUE YES. GO TO START IT UP AGAIN. * EXPLN JSB PRNTX EXPLAIN THE COMMANDS DEF EXPMS TO THE CONFUSED USER. JMP OPT20 REPEAT THE QUESTION. * SKP SKEDM CCE =1 TO DISALLOW DEFAULT SCHEDULING. JSB MSET GO TO SCHEDULE MONITOR(S). JMP OPT20 RETURN TO CHECK FOR OTHER OPTIONS. * OPT21 JSB LUIN GO TO ENABLE THE LINE. JMP OPT20 CHECK FOR OTHER OPTIONS. * OPT22 STB LTEMP SAVE THE SPECIFIED LOGICAL UNIT NO. JSB LUSET GO TO SET UP THE LOGICAL UNIT NO. JMP OPT2E * RTE-DETECTED ERROR--TRY AGAIN! * JMP TERM THEN DON'T ASK FOR MORE INPUT; ELSE, * OPT23 JSB EN3K RE-ENABLE HP3000 LINK JMP TERM AND TERMINATE * OPT2E JSB ERROR REPORT THE DEF LUERM " LU ERROR", JMP TERM AND TERMINATE. * GLCNW OCT 100006 GLOBAL LOCK/CLEAR--NO WAIT. SKP * ROUTINE TO SET ROUTE VECTORS * FRMT NOP JSB PRINT ASK FOR THE FILE NAME DEF NAME? JSB READ GET IT STB NONDT SAVE NON-NDT INDICATOR. PARS2 EQU *+1 DLD PARSB+1 DST PRAM SAVE THE 1ST 2 WORDS OF THE FILE NAME LDA PARSB+3 STA PRAM+2 LDA PARSB+5 GET FILE SECURITY CODE, LDB PARSB+9 AND CARTRIDGE NO.--IF ANY. DST PRAM+3 SAVE FOR FILE-OPEN CALL. * JSB PRINT ASK FOR THE CPU # DEF LOC? JSB READ READ IT CPA B1 NUMERIC? CLE,SSB YES. IS IT NEGATIVE? JMP FRMER * IMPROPER RESPONSE! * STB XNODE SAVE IT LOCALLY LDA NONDT SZA,RSS NON-NDT PROCESSING? JMP INTER YES--DO INTERACTIVE SET-UP. LDB PRAM IF CLASS I/O READ, SSB ERROR? JMP FRMER YES, DISPLAY ERROR MESS. JSB OPEN OPEN NDT FILE DEF *+7 DEF NDTCB DEF TEMP1 SAVE ERROR CODE HERE. DEF PRAM FILE NPAME DEF ZERO EXCLUSIVE OPEN DEF PRAM+3 SECURITY CODE (OR 0) DEF PRAM+4 CARTRIDGE REF. # (OR 0) SSA ERROR? JMP FRMER DISPLAY ERROR MESSAGE. * LDA XEQT GET ADDRESS OF NEXT AVAILABLE LOCATION ADA D23 FOLLOWING THIS MODULE = HI MAIN + 1 LDA 0,I GET ADDR OF AVAILABLE CORE LDB 0 CMA,INA COMPUTE # OF WORDS ADA BGLWA AVAILABLE IN OUR PARTITION STA TEMP ADA DM33 BIGGER THAN SSA,RSS PARSE BUFFER? JMP *+4 YES LDB PARS2 NO, USE PARSE BUFFER LDA D33 MAX REC SIZE = 33 STA TEMP STB BFADR SET RECORD BUFFER ADDRESS * JSB READX READ IN THE FIRST NDT RECORD CMB,SSB,INB IF # NODES <= 0 JMP FRMER REPORT ERROR. * CBX X = # OF NODES RNOD? LAX BFADR,I GET THE NODE NUMBER. CPA XNODE DOES NEXT RECORD DEFINE OUR VECTORS? JMP POSN YES, GO TO OBTAIN THE RECORD. DSX HAVE ALL NODES BEEN COMPARED? JMP RNOD? NO. TRY THE NEXT ONE. JMP FRMER YES--ERROR: THIS NODE NOT SPECIFIED! * SKIPR JSB READF POSITION FORWARD DEF *+5 IN ORDER TO DEF NDTCB READ THE RECORD DEF TEMP1 WHICH WILL DEFINE DEF PRAM OUR ROUTE VECTORS. DEF ZERO (ZERO LENGTH = SKIP) SSA ANY ERRORS? JMP FRMER YES--REPORT IT. POSN DSX SKIPPED ENOUGH? JMP SKIPR NO--DO IT AGAIN. * JSB READX READ THE NRV (NODES/LUS/TIMEOUTS) FOR THIS CPU BRS COMPUTE # OF NODAL ADDRESS WORD PAIRS CMB,INB,SZB,RSS JMP FRMER ZERO IS ILLEGAL STB PARSB+1 JSB IVECT SET-UP NRV PROCESSING LDA NRVSZ GET SIZE OF NRV MOVE ALS STA NO2MV SAVE FOR MVW CAY * NXTLU LAY BFADR,I GET LU OUT OF BUFFER SSA NEGATIVENLH LU SPECIFIED? JMP FRMER YES AND B77 SZA,RSS LU=0? JMP *+4 YES, NO CHECK STA LTEMP JSB LUTST VERIFY THIS IS TIED TO DVA65 JMP LUERX NO, NDT FILE SCREWED UP DSY DSY JMP NXTLU TRY NEXT * JSB CLOSX CLOSE THE NDT FILE * LDB #NRV ADDRESS OF NRV IN SAM LDA BFADR ADDR OF RECORD BUFFER INA POINT TO 1ST NODAL PAIR JSB $LIBR LOWER FENCE NOP LDX NO2MV LOAD X FOR MWI. NRMOV MVW TEMP1 MOVE NRV TO SAM (MWI IF DMS) JSB $LIBX DEF FRMT DONE WITH NRV SET-UP * NO2MV NOP NUMBER OF WORDS TO MOVE. RN SKP SPC 2 * THIS ROUTINE READS AN NDT RECORD AND CHECKS THAT IT DIDN'T * EXCEED OUR BUFFER SIZE READX NOP JSB READF READ NDT RECORD DEF *+5 DEF NDTCB DEF TEMP1 BFADR NOP POINTS TO EITHER PARSE BUFFER OR DEF TEMP AVAILABLE CORE SSA JMP FRMER FILE ERROR LDA BFADR,I 1ST WORD HAS -(REC SIZE-1) LDB 0 ADA TEMP ADD BUFFER SIZE CMA,INA SSA WAS RECORD LARGER THAN BUFFER? JMP READX,I NO, RECORD OK, RETURN SKP * FRMER LDA NONDT SZA,RSS RUNNING OUT OF AN NDT FILE? JMP FRMEI NO JSB CLOSX YES. CLOSE THE NDT FILE, JSB SYSER AND INFORM THE USER OF THE ERROR: DEF FERMG FILE ERROR * FRMEI JSB ERROR DEF NOSZR NODE SPEC. ERROR * JSB #RSAX RETURN ANY SAM ALLOCATED DEF *+3 DEF B1 DEF #FWAM JMP FRMT+1 RETRY NRV SET-UP * LUERX JSB SYSER DEF LUERM * NAME? DEF *+2 DEF D14 ASC 14, NDT FILE NAME [,SC[,CR]]? _ * LOC? DEF *+2 DEF D8 ASC 8, LOCAL CPU # ? _ * NUMB? DEF *+2 DEF D10 ASC 10, NUMBER OF NODES ? _ * NODEF DEF *+2 DEF D10 ASC 10, CPU#,LU,TIMEOUT ? _ * * * * * * DO NOT CHANGE ORDER OF NEXT TWO STATEMENTS * * * * * CNODE OCT -1 CURRENT-USER NODE; -1=INACTIVE. OCT -1 DOWN-LOAD NODE: INITIAL VALUE. * NCNT NOP NODE LOOP COUNTER (-NO. OF NODES). NPNT NOP LOCAL NRV TABLE POINTER. NONDT NOP INTERACTIVE FLAG / WORD-MOVE COUNT. XNODE NOP LOCAL SAVE OF LOCAL NODE # * SKP * INTERACTIVE ROUTE VECTOR PROCESSING. * INTER JSB PRINT ASK FOR DEF NUMB? NUMBER OF NODES? JSB READ GET THE ANSWER. CPA B1 NUMERIC? SZB,RSS ZERO JMP FRMER YES--ERROR! JSB IVECT SET-UP FOR NRV PROCESSING * GETN JSB PRINT ASK FOR NRV DATA: DEF NODEF "CPU#,LU,TIMEOUT?" JSB READ GET RESPONSE. CPA B1 NUMERIC CPU#? SSB YES. NEGATIVE? JMP FRMER * INVALID RESPONSE! LDA NRVSZ GET THE NUMBER OF NODES. ADA NCNT SUBTRACT NUMBER NOT YET PROCESSED, SZA,RSS IF NONE PROCESSED YET, JMP STNOD BYPASS DUPLICATE CPU# CHECK. CAX INITIALIZE COUNTER =CPU#'S PROCESSED. LDA #NRV GET POINTER TO FIRST CPU#. NCHEK NOP [DMS XCB GOES HERE FOR RTE-III/IV] CPB A,I IF THIS NODE IS A DUPLICATE, JMP FRMER THEN YELL ABOUT IT! ADA B2 ADVANCE POINTER TO NEXT CPU#. DSX ALL CPU#'S BEEN CHECKED? JMP NCHEK NO. CONTINUE CHECKING. * STNOD LDA 1 JSB SVNRV SAVE NODE # IN NRV TABLE LDA PARSB+5 GET THE LU--IF ANY. SZA IF IT'S #0, JMP STRLU GO TO SAVE IT; LDB PARSB+1 GET NODE AGAIN CPB XNODE ELSE, IF =0, IS IT LOCAL CPU#? JMP NEXTN YES, SAVE 0, AND GET NEXT ONE. JMP FRMER * ERROR: 0 INVALID, IF NOT LOCAL! * STRLU STA NVCTR SAVE THE LU--TEMPORARILY. SSA IF IT'S NEGATIVE, JMP FRMER GIVE ERROR STA LTEMP INITIALIZE FOR VERIFICATION. JSB LUTST GO TO VERIFY THE LU. JMP FRMER * ERROR: INVALID LU! * LDA NVCTR GET THE SPECIFIED LU AGAIN. * LDB PARSB+8 GET TIMEOUT SPECIFICATION. CPB B2 IF THE PARAMETER IS INVALID, JMP FRMER THEN SCREAM ABOUT IT! LDB PARSB+9 CMB,INB,SZB,RSS IF IT IS NULL, OR ZERO, JMP NEXTN THEN IGNORE IT. SSB,RSS T/O<0? JMP FRMER YES, ERROR LDA 1 ADB D1275 SSB JMP FRMER JSB CFSEC ALF,RAL POSITION TO RAL BITS #13-7. IOR NVCTR INCLUDE THE LU#, * NErXTN JSB SVNRV STUFF IN THE LU/TIMEOUT WORD ISZ NCNT HAVE ALL NODES BEEN PROCESSED? JMP GETN JMP FRMT,I YES, RETURN * SAMSZ NOP # WORDS IN SAM BLOCK TSTSZ NOP # WORDS IN TST NRVSZ NOP # WORDS IN NRV NVCTR NOP * SPC 1 * SUBROUTINE TO SAVE NRV ENTRY IN SAM SVNRV NOP JSB $LIBR NOP STNOP STA NPNT,I NOP ISZ NPNT JSB $LIBX DEF SVNRV * SPC 1 * SUBROUTINE TO SET-UP FOR NRV INITIALIZATION IVECT NOP SSB NEGATIVE? JMP FRMER YES--ERROR! STB NRVSZ SAVE # OF NRV ENTRIES BLS B REG := # OF WORDS NEEDED ADB SAMSZ ADD SIZE OF SAM BLOCK UP TO NOW JSB SGCO GO INITIALIZE SAM BLOCK AND RES AREA LDA SAMSZ GET SAM SIZE WITHOUT NRV ADA #FWAM COMPUTE ADDR OF NRV IN SAM STA #NRV AND SAVE IT IN "RES". STA NPNT LDA PARSB+1 GET THE NUMBER OF NODES CMA,INA NEGATE & SAVE STA NCNT FOR USE AS LOOP COUNTER STA #NCNT LDA XNODE STA #NODE SAVE LOCAL NODE # IN RES DLD CNODE INITIALIZE RES NODAL ADDRESSES DST #CNOD JMP IVECT,I RETURN SKP * ROUTINE TO OPEN ANSWER FILE. * OPENX NOP * LDB BLNKS DOUBLE BLANK CLA CPA PRAM+2 LAST 2 CHARS SPECIFIED? STB PRAM+2 NO, USE BLANKS CPA PRAM+1 3RD & 4TH SPECIFIED? STB PRAM+1 NO ,USE BLANKS * JSB OPEN OPEN THE FILE DEF *+7 DEF INDCB DEF TEMP1 ERROR-RETURN LOC'N. DEF PRAM FILE NAME LOC'N. DEF ZERO EXCLUSIVE OPEN. DEF PRAM+3 SECURITY CODE (OR 0). DEF PRAM+4 CARTRIDGE NO. (OR 0). SSA,RSS ERRORS? ISZ OPENX NO--RETURN VIA P+2. JMP OPENX,I RETURN. * * ROUTINE TO CLOSE NDT FILES. CLOSX NOP LDA CLFLG IF DUMMY SSA DCB,  JMP CLOSX,I RETURN! JSB CLOSE DEF *+2 DEF NDTCB JMP CLOSX,I RETURN TO CALLER. * SKP * NRV DISPLAY ROUTINE. * DSNRV LDA #NCNT GET ADDRESS OF NO. OF NODES. STA NCNT SAVE THE NUMBER OF NODES. CMA,INA,SZA,RSS ANYTHING SPECIFIED? JMP OPT20 NO--IGNORE THE REQUEST! STA NONDT SAVE THE NEGATIVE LOOP COUNT. * LDA #NODE GET LOCAL NODE NUMBER. JSB CNVTD CONVERT IT TO ASCII, DEF LOCLN AND CONFIGURE THE MESSAGE. LDA NONDT GET THE NUMBER OF NODES. JSB CNVTD CONVERT TO ASCII, DEF NNODS AND CONFIGURE MESSAGE. JSB PRNTX PRINT THE FIRST MESSAGE DEF NODM1 WITHOUT A HEADER. * LDA #NRV GET THE NRV ADDRESS, STA NPNT AND SAVE THE POINTER. * DLOOP EQU * * DSNR1 LDA NPNT,I GET A NODE NUMBER. NOP [RESERVED FOR XLA] ISZ NPNT ADVANCE THE POINTER. JSB CNVTD CONVERT DEF NODEN & CONFIGURE. * DSNR2 LDA NPNT,I GET TIMEOUT/LU NOP [RESERVED FOR XLA] AND B77 ISOLATE THE LU. JSB CNVTD CONVERT DEF VECTR & CONFIGURE. * DSNR3 LDA NPNT,I GET TIMEOUT/LU, AGAIN. NOP [RESERVED FOR XLA] ISZ NPNT ADVANCE POINTER. AND BT137 RETAIN THE TIMEOUT VALUE (BITS#13-7). ALF,ALF POSITION VALUE RAL,RAL TO THE LOWER BYTE. SZA IF =0, THEN NO FILLING NEEDED. IOR DM256 FILL-IN THE UPPER BYTE. CMA,INA MAKE THE VALUE POSITIVE (OR 0). MPY B5 MULTIPLY BY FIVE JSB CNVTD CONVERT DEF NRVTO & CONFIGURE. * JSB PRNTX PRINT NODAL ADDRESS DATA DEF NRVMS WITHOUT THE HEADER. * ISZ NCNT ANY MORE TO PROCESS? JMP DLOOP YES, CONTINUE. SKP LDA OPTYP GET THE SYSTEM SPECIFICATION. SLA FOR NON-RTE-M SYSTEMS, JMP OPT20 THE PROCESS IS COMPLETE. * LDA #LNOD GET THE DOWN-LOAD NODE NUMBER. CPA M1 IF IT HAS NOT BEEN USED, JMP PRAPM THEN IGNORE THE CONVERSION. JSB CNVTD CONVERT TO ASCII, DEF APNOD AND CONFIGURE THE MESSAGE. * PRAPM JSB PRNTX PRINT NODE NUMBER (OR "NONE"), DEF APMSG WITHOUT A HEADER. JMP OPT20 PROCESS COMPLETE--CHECK FOR NEW REQUEST. * SPC 3 NODM1 DEF *+2 DEF D33 ASC 10, NRV SPECIFICATIONS: OCT 6412 ASC 7, LOCAL NODE#: LOCLN ASC 3, ASC 8,, NO. OF NODES= NNODS ASC 3, OCT 6412 * NRVMS DEF *+2 DEF D22 ASC 3, NODE= NODEN ASC 3, ASC 3,, LU= VECTR ASC 3, ASC 3,, TO= NRVTO ASC 3, ASC 3,(SEC.) OCT 6412 * APMSG DEF *+2 DEF D17 ASC 13, LAST LOAD-NODE= APNOD ASC 3,NONE OCT 6412 * BT137 OCT 37700 * SKP * NETWORK TIMING-VALUE MODIFICATION SECTION * TIME JSB GETV GO TO GET CURRENT VALUES. JSB PRNTX PRINT SECTION HEADER. DEF TMES " TIMING MODIFICATION" * JSB GTIME GET MASTER TIMEOUT VALUE DEF MSTMG DEF D1275 JMP TI.SV JSB CFSEC STA #MSTO * TI.SV JSB GTIME GET SLAVE TIMEOUT VALUE DEF SLVMG DEF D1275 JMP TI.BR JSB CFSEC STA #SVTO * TI.BR JSB GTIME GET BUSY REJECT RETRY WAIT DEF BZMG DEF D10 JMP TI.WA ADA M1 ALF,ALF BITS 11-8 HAVE BUSY RETRY COUNT AND B7400 ISOLATE THEM STA #BREJ * TI.WA JSB GTIME GET REMOTE-QUIET WAIT DEF WAITM DEF D7200 JMP OPT20 STA #WAIT JMP OPT20 DONE WITH THIS SECTION SKP * SUBROUTINE TO ASK FOR, GET, AND VERIFY A TIMING PARAMETER * GTIME NOP LDA GTIME,I GET MSG ADDR STA GTI1 ISZ GTIME LDA GTIME,I GET MAX ALLOWED VALUE ADDR STA VCKAD SAVE IT ISZ GTIME * JSB PRINT PRINT THE QUESTION GTI1 NOP STORE MSG ADDR HERE GTI2 JSB READ GET RESPONSE SZA,RSS ANY CHANGE DESIRED? JMP GTIME,I NO CPA B1 NUMERIC RESPONSE? JMP VCHEK YES, CHECK THE LIMITS CPB /E DONE WITH TIMING PARAMETERS? JMP OPT20 YES * GTER JSB ERXFR INVALID RESPONSE DEF IVRES JMP GTI2 * VCHEK SSB VALUE NEGATIVE? JMP GTER YES, ERROR LDA GTI1 CMB,INB,SZB,RSS WAS VALUE NON-ZERO? CPA TI.WA+1 NO, IS THIS QUIESCENT WAIT? RSS YES, LOWER LIMIT OK JMP GTER NO, INPUT ERROR LDA 1 ADB VCKAD,I MAX-INPUT VALUE SSB TOO LARGE? JMP GTER YES ISZ GTIME NO, RETURN IT IN A JMP GTIME,I * SKP * * ROUTINE TO GET CURRENT SYSTEM TIMING VALUES FOR REPORT TO USER. * GETV NOP ENTRY/EXIT LDA #MSTO GET MASTER TIMEOUT VALUE. ADA DM256 FORM FULL DATA WORD. CMA,INA MAKE IT POSITIVE. MPY B5 CONVERT TO SECONDS JSB CNVTD GO TO CONVERT IT TO ASCII. DEF MSVAL SPECIFY DESTINATION OF RESULT. * LDA #SVTO GET SLAVE TIMEOUT VALUE. ADA DM256 FORM FULL DATA WORD. CMA,INA MAKE IT POSITIVE. MPY B5 CONVERT TO SECONDS JSB CNVTD GO TO CONVERT IT TO ASCII. DEF SLVAL SPECIFY DESTINATION OF RESULT. * LDA #BREJ GET REMOTE-BUSY RETRY COUNT. ALF,ALF RIGHT JUSTIFY IOR DM16 SET BITS 15-4 CMA MAKE IT POSITIVE JSB CNVTD GO TO CCONVERT IT TO ASCII. DEF RTVAL SPECIFY DESTINATION OF RESULT. * LDA #WAIT GET QUIESCENT-WAIT INTERVAL VALUE. CMA,INA MAKE IT POSITIVE. JSB CNVTD GO TO CONVERT IT TO ASCII. DEF WTVAL SPECIFY DESTINATION OF R]qESULT. JMP GETV,I RETURN. * CNVTD NOP ENTRY/EXIT: ASCII CONVERSION ROUTINE. STA TEMP1 SAVE THE RAW DATA, TEMPORARILY. LDA CNVTD,I GET THE DESTINATION ADDRESS. STA STUFM CONFIGURE THE CALL TO 'CNUMD'. JSB CNUMD GO TO DEF *+3 CONVERT DEF TEMP1 THE VALUE STUFM NOP TO ASCII. ISZ CNVTD ADJUST THE RETURN POINTER, JMP CNVTD,I AND RETURN TO THE CALLER. * SPC 1 * UTILITY SUBROUTINE CFSEC NOP ENTRY/EXIT CCB CONVERT SECONDS TO DIV B5 FIVE SECOND INTERVALS. ADB B2 IF THE REMAINDER IS SSB THREE OR MORE, ADA M1 ROUND TO NEXT INTERVAL. SZA,RSS INSIST UPON A CCA MINIMUM COUNT = -1. AND D255 MASK OFF HIGH BITS JMP CFSEC,I RETURN SKP * TMES DEF *+2 DEF D70 ASC 19, TIMING MODIFICATION--CURRENT VALUES: OCT 6412 OCT 6412 MAMSG ASC 8, MASTER T/O = BLNKS EQU MAMSG+6 MSVAL ASC 3, OCT 6412 ASC 8, SLAVE T/O = SLVAL ASC 3, OCT 6412 ASC 8, REMOTE-BUSY = RTVAL ASC 3, OCT 6412 ASC 8, REMOTE-QUIET = WTVAL ASC 3, OCT 6412 OCT 6412 * MSTMG DEF *+2 DEF D17 ASC 17, MASTER T/O [5 TO 1275 SECONDS] ?_ SLVMG DEF *+2 DEF D17 ASC 17, SLAVE T/O [5 TO 1275 SECONDS] ?_ BZMG DEF *+2 DEF D16 ASC 16, REMOTE-BUSY RETRIES [1 TO 10]?_ WAITM DEF *+2 DEF D18 ASC 18, REMOTE-QUIET WAIT [0 TO 7200 SEC]?_ * VCKAD EQU GETV * SKP * SUBROUTINE TO VERIFY THAT LU IS LINKED TO 'DVA65'. * LUTST NOP JSB DRTEQ GO TO OBTAIN DEF *+2 THE EQT ADDRESS DEF LTEMP FOR SPECIFIED LOGICAL UNIT. SSB IF THE LU IS INVALID, JMP LUTST,I TAKE THE ERROR EXIT! * ADB B4 POINT TO EQT WORD 5 LDA B,I GET STATUS WORD. ALF,ALF AND B77 ISOLATE THE EQUIPMENT TYPE-CODE. CPA B65 IS THE LU LINKED TO 'DVA65'? JMP *+2 YES. CONTINUE THE VERIFICATION. JMP LUTST,I NO. ERROR: RETURN TO P+1. * ADB B7 ADVANCE THE EQT POINTER. LDA B,I GET CONTENTS OF EQT WORD 12 ADA NEQSZ IF LESS THAN MINIMUM EQT EXTENSION SIZE, SSA JMP LUTST,I THE LU CANNOT BE INITIALIZED! * INB GET THE EQT EXTENSION ADDRESS DLD B,I AND THE DEVICE TIMEOUT VALUE SZA IF THE EXTENSION ADDRESS=0, SZB,RSS OR NO TIMEOUT HAS BEEN SPECIFIED JMP LUTST,I THE LU CANNOT BE INITIALIZED! ISZ LUTST ADVANCE RETURN POINTER, JMP LUTST,I AND TAKE THE GOOD EXIT. SPC 2 * SUBROUTINE TO SET-UP & ENABLE A LOGICAL UNIT NO. (VIA DVA65). * LUSET NOP * LDA LTEMP GET THE LOGICAL UNIT NUMBER. IOR B100 SET FOR ENABLE LISTEN REQUEST STA LTEMP SAVE THE CONFIGURED CONTROL WORD. * JSB EXEC GO TO RTE DEF *+3 TO REQUEST THAT DEF SD3 'DVA65' SET UP & ENABLE DEF LTEMP LISTEN MODE FOR THE LU JMP LUSET,I * RTE-DETECTED ERROR--TRY AGAIN! * ISZ LUSET SET FOR NORMAL RETURN (P+2). JMP LUSET,I RETURN TO THE CALLER. SKP * SUBROUTINE TO RE-ENABLE HP3000 LU * * TURN OFF QUEX. UPLIN WILL BRING IT BACK UP, AND QUEX WILL * GO THROUGH ITS ABORT CYCLE. EN3K NOP JSB MESSS CALL RTE MESSAGE PROCESSOR. DEF *+3 DEF OFFQX DEF D10 NOP JMP EN3K,I RETURN * OFFQX ASC 10,OF,QUEX,1 SPC 3 * PROGRAM TERMINATION PROCESSOR. * TERM CLA CPA #FWAM SAM ALLOCATED? JMP *+3 NO CPA ONTWO IS THIS INITIAL ENTRY? JSB SUPLN YES! SCHEDULE "UPLIN" JSB CHCKN WAS THERE A FILE JMP TERM1 NO...DON'T CLOSEl IT LDA CLFLG IS IT A DUMMY DCB? SSA JMP TERM1 YES...DON'T CLOSE IT * JSB CLOSE CLOSE DEF *+3 THE DEF INDCB CONTROL DEF TEMP1 FILE. * TERM1 LDA $RTRN,I IF PROGRAM IS BEING ABORTED CPA ABPRM THEN IGNORE JMP TERM3 THE END MESSAGE. * JSB PRNTX GO TO PRINT THE @ENMG DEF ENDMG TERMINATION MESSAGE--SANS HEADER. * TERM3 JSB PRTN RETURN ERROR INFORMATION DEF *+2 TO THE BATCH PROCESSOR $RTRN NOP (CONTAINS DEF TO ENMSG OR ABPRM) CLB PREPARE FOR NORMAL TERMINATION. STB TCOD CONFIGURE THE TERMINATION CODE. JSB EXEC GO TO THE DEF *+4 RTE EXECUTIVE DEF D6 TO TERMINATE DEF ZERO THIS PROGRAM, DEF TCOD AND-PERHAPS-TO SAVE RESOURCES. JMP LSTEN GO BACK TO THE BEGINNING. TCOD NOP (TERM. CODE: 0-NORMAL/1-SAVE RESOURCES) SKP * COMMUNICATION LINE ENABLING ROUTINE. * LUIN NOP JSB PRINT DEF UPLUM " LINE LU?_" JSB READ READ A RECORD CPA B1 WAS INPUT BINARY? JMP SAVLU YES. GO TO PROCESS THE LU. CPB /E END OF LIST? JMP LUIN,I YES. RETURN LUERR JSB ERXFR DEF LUERM "LU ERROR" JMP LUIN+3 TRY AGAIN * SAVLU STB LTEMP SAVE TEMPORARILY. CPB #LU3K HP3000 LU? JMP DT004 YES JSB LUTST GO VERIFY THAT LU IS LINKED TO 'DVA65'. JMP LUERR NOT A DVR 65...ERROR * JSB LUSET GO TO SET UP & ENABLE THE LU. JMP LUERR * RTE-DETECTED ERROR--TRY AGAIN! * JMP LUIN+1 GO TO REQUEST ANOTHER LU NUMBER. * DT004 JSB EN3K ENABLE HP3000 LU JMP LUIN+1 GO TO REQUEST ANOTHER LU NUMBER * LTEMP NOP TEMPORARY LOGICAL UNIT NO. STORAGE. SKP D0 DEC 0 D7 DEC 7 D8 DEC 8 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D14 DEC 14 D15 DEC 15 D16 DEC 16 D17 DEC 17 D18 DEC 18 D20 DEC 20 D23 DEC 23 D22 DEC 22 D32 DEC 32 D33 DEC 33 D70 DEC 70 D100 DEC 100 D128 DEC 128 D255 DEC 255 D1275 DEC 1275 D7200 DEC 7200 DM2 DEC -2 DM3 DEC -3 DM4 DEC -4 DM7 DEC -7 EQTSZ EQU D7 MINIMUM COMM. DRIVER EQT EXTENSION SIZE NEQSZ EQU DM7 NEGATIVE OF MINIMUM EQT EXTENSION SIZE DM16 DEC -16 DM17 DEC -17 DM33 DEC -33 DM100 DEC -100 DM256 DEC -256 B17 EQU D15 B61 OCT 61 B65 OCT 65 B66 OCT 66 B67 OCT 67 B77 OCT 77 B100 OCT 100 B400 OCT 400 B7400 OCT 7400 SD3 OCT 100003 SD13 OCT 100015 M1 EQU CNODE RLU NOP TEMP1 NOP /A ASC 1,/A /D ASC 1,/D /E ASC 1,/E EX EQU /E /L ASC 1,/L /N ASC 1,/N /Q ASC 1,/Q SD ASC 1,SD /R ASC 1,/R /S ASC 1,/S /T ASC 1,/T ?? ASC 1,?? "YE" ASC 1,YE "NO" ASC 1,NO TYPEQ NOP CLFLG NOP ONTWO NOP OPTYP NOP SPC 5 * * ROUTINE TO GET SIZE OF OVERFLOW FILE FOR USE BY 'RFAM'. * FILIN NOP JSB PRINT DEF FILMG " INPUT # OF FILES: _" JSB READ CPA B1 INPUT NUMERIC? JMP GFIL2 YES * JSB ERXFR DEF FERMG "FILE ERROR" JMP FILIN+3 RETRY * GFIL2 STB #RFSZ JMP FILIN,I AND RETURN TO THE CALLER. SKP * CLASS NUMBER ALLOCATION/DE-ALLOCATION SUBROUTINE. * * ENTER: & - DON'T CARE (DESTROYED ON RETURN). * = 0 - REQUEST A CLASS ALLOCATION FROM RTE. * = 1 - RETURN A CLASS NUMBER TO THE SYSTEM. * - CLASS NUMBER ADDRESS. * NOTE: DE-ALLOCATION ERRORS ARE IGNORED! * CLSUB NOP ENTRY/EXIT: CLASS SUBROUTINE. LDA DM3 INITIALIZE RE-TRY COUNTER FOR 3 PASSES, STA RETRY IN CASE SYS. MEM. UN-AVAILABLE. CLA,SEZ,RSS IF RETURN OPTION: SET TO IGNORE ERRORS; LDA RSSIN ELSE, SET TO RECOGNIZE ERRORS. STA ER7RIN CONFIGURE ERROR-HANDLING INSTRUCTION. * LDB CLSUB,I GET THE CLASS NUMBER ADDRESS. ISZ CLSUB SET RETURN TO . LDA B,I GET THE CLASS NUMBER--IF ANY. ALR,RAR REMOVE BUFFER-SAVE BIT(#14)--IF ANY. SEZ,RSS IF REQUEST TO GET A CLASS, CLA USE ZERO CLASS NUMBER. IOR CLREQ SET NO-WAIT/CLASS-SAVE BITS(15,13). STA B,I SAVE MODIFIED CLASS NO. SPECIFICATION. STB CLSAD CONFIGURE THE CALL WITH CLASS NO. ADDR. SEZ DE-ALLOCATION REQUEST? JMP DEALC YES. GO TO RETURN THE CLASS NUMBER. * CLALC JSB EXEC GO TO RTE DEF *+5 TO REQUEST DEF CLCTL THE ALLOCATION DEF ZERO OF A CLASS NUMBER, DEF ZERO WHICH WILL BE RETURNED TO CLSAD NOP THE SPECIFIED STORAGE ADDRESS. JMP CLERR REPORT THE SYSTEM-LEVEL ERROR. * SSA,RSS ALLOCATION ERROR? JMP CLRTN NO. GO CLEAR PENDING REQUEST. CPA DM2 YES. NO MEMORY AT PRESENT TIME? JSB DELAY YES--WAIT A WHILE & RE-TRY. JMP CLERR *ERROR: NO CLASS# OR RE-TRIES EXHAUSTED. JMP CLALC GO TO RE-TRY THE ALLOCATION REQUEST. * DEALC JSB EXEC GO TO RTE DEF *+8 TO WRITE A DEF CLS18 ZERO LENGTH DEF ZERO RECORD INTO DEF ZERO THE CLASS, WHICH DEF ZERO IS TO BE DEF ZERO DE-ALLOCATED. DEF ZERO THIS WILL ALLOW DEF CLSAD,I SUSPENDED PROGRAMS NOP TO BE ABORTED. * SETSW CCA SET THE RELEASE RE-TRY SWITCH STA CEXIT TO =-1. * CLRTN JSB EXEC GO TO RTE DEF *+5 TO CLEAR DEF CLS21 THE PENDING DEF CLSAD,I REQUEST DEF ZERO ON THE DEF ZERO CLASS. ERRIN NOP IGNORE ERRORS(YES-NOP; NO-RSS)? RSSIN RSS YES. SKIP TO CHECK FOR DE-ALLOCATION. JMP CLERR NO--REPORT THE CLASS ERROR. ISZ CEXIT RELEASE PROCESSING COMPLETE? JMP REM15 YES. GO CLEAR THE NO-WAIT BIT(#15). * CPA =AIO IO ERROR? JMP CLSUB,I YES, RETURN TO CALLER CPA M1 NO. ARE ALL PENDING REQUESTS CLEARED? RSS YES. SKIP TO CHECK FOR DE-ALLOCATION. JMP SETSW NO. CONTINUE TO CLEAR REQUESTS. * LDA ERRIN GET ALLOCATION/DE-ALLOCATION INDICATOR. SZA IF ALLOCATION IN PROCESS, JMP REM15 GO TO REMOVE BIT#15 & RETURN. * LDA CLSAD,I FOR DE-ALLOCATION: GET CLASS WORD, AND CLMSK REMOVE NON-RELEASE BIT(#13), STA CLSAD,I AND RESTORE CLASS WORD. JMP CLRTN GO TO RETURN THE CLASS NUMBER TO RTE. * REM15 LDA CLSAD,I GET THE CLASS WORD ALR,RAR CLEAR "NO WAIT" BIT IOR CBITS SET SAVE BUFFER & NO DEALLOCATE BITS STA CLSAD,I RESTORE THE CLASS WORD. * JMP CLSUB,I RETURN TO THE CALLER. * CLCTL OCT 100023 CLREQ OCT 120000 CLS18 OCT 100022 CLS21 OCT 100025 CBITS OCT 60000 CLMSK OCT 117777 CEXIT EQU FILIN * CLERR JSB SYSER GO TO INFORM THE USER OF A DEF CLSER CATASTROPHIC CLASS-PROCESSING ERROR. * SKP * NETWORK SECURITY CODE PROCESSOR. * * [ CAUTION: DO NOT MAKE CHANGES TO ,,OR RTNS. ] * SECOD NOP ENTRY/EXIT: SECURITY CODE ROUTINE. JSB PRINT DEF SECMS " SECURITY CODE?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES.CONTINUE PROCESSING. JMP SECOD+1 NO. ASK AGAIN. SPC 1 UNL JSB S LST STB #SWRD SAVE MODIFIED SECURITY CODE IN 'RES'. JMP SECOD,I RETURN. SPC 1 SECMS DEF *+2 DEF D9 ASC 9, SECURITY CODE? _ * UNL S EQU * OCT 0,60001,20NLH11,23,2011 JMP *-2 AND *+7 IOR *+7 STA *+1 OCT 0,7000,60001 JMP *-12,I OCT 17,100020,2003,5477 LST SKP * SYSTEM QUIESCEING ROUTINE (SUSPEND NETWORK COMMUNICATIONS). * * [ CAUTION: DO NOT MAKE CHANGES TO ,, OR RTNS.] * QUIES JSB PRINT DEF QHED " SYSTEM QUIESCENCE" QASK JSB PRINT DEF SECMS " SECURITY CODE?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES. CONTINUE PROCESSING. JMP QASK NO. ASK AGAIN. SPC 1 UNL JSB S LST CPB #SWRD DOES THE CALLER KNOW THE SECRET? JMP QUIET <> LET HIM PASS! JSB ERROR <> INFORM HIM OF DEF IVRES THE ERROR OF JMP ABORT HIS WAYS!!! SPC 1 QUIET JSB RNRQ GO TO RTE DEF *+4 TO REQUEST DEF B2 A GLOBAL LOCK DEF #QRN UPON THE QUIESCENT DEF TEMP1 RESOURCE NUMBER. * JMP TERM GO TO TERMINATION. * 7N SKP * RE-START A FORMERLY QUIESCED SYSTEM. * * [ CAUTION: DO NOT MAKE CHANGES TO ,, OR RTNS.] * REQUE JSB PRINT DEF RQHED " QUIESCENT RE-START" RQASK JSB PRINT DEF SECMS " SECURITY CODE?_" JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES. CONTINUE PROCESSING. JMP RQASK NO. ASK AGAIN. UNL JSB S LST SPC 1 CPB #SWRD DOES THE USER KNOW THE SECRET? JMP QOVER <> ALLOW RE-START. JSB ERROR INFORM HIM OF DEF IVRES THE ERROR OF JMP ABORT HIS WAYS!!!! SPC 1 QOVER JSB RNRQ GO TO RTE DEF *+4 TO REQUEST DEF B4 AN UNLOCKING OF DEF #QRN THE QUIESCENT DEF TEMP1 RESOURCE NUMBER. JMP OPT20 CHECK FOR OTHER OPTIONS. * SPC 1 QHED DEF *+2 DEF D9 ASC 9, SYSTEM QUIESCENCE RQHED DEF *+2 DEF D10 ASC 10, QUIESCENT RE-START * SKP * RESOURCE NUMBER ALLOCATION/DE-ALLOCATION ROUTINE. SPC 1 * ENTER: & - DON'T CARE (DESTROYED ON RETURN) * = 0 - ALLOCATE GLOBALLY & LOCK LOCALLY * - 1 - DE-ALLOCATE * - ADDRESS FOR RETURN OF RESOURCE NUMBER * NOTE: DE-ALLOCATION ERRORS ARE IGNORED! * NOTE: RN'S ARE LOCKED LOCALLY, TO PREVENT USE UNTIL COMPLETES. * RNSUB NOP ENTRY/EXIT: RN ALLOCATION/RELEASE RTN. CCB,SEZ IF THIS IS A DE-ALLOCATION REQUEST, CLB THEN RESET THE FLAG TO IGNORE ERRORS. STB ERRN SAVE THE ERROR-PROCESSING FLAG. LDA GALCA INITIALIZE FOR GLOBAL ALLOCATION. SEZ IF THE REQUEST IS FOR DE-ALLOCATION, LDA DALCA THEN GET DE-ALLOCATE REQUEST CODE. STA RNCOD CONFIGURE CALL WITH PROPER REQUEST CODE. LDA RNSUB,I GET THE STORAGE ADDRESS FOR TH/E RN. STA RNAD CONFIGURE THE CALL WITH RN ADDRESS. ISZ RNSUB SET RETURN ADDRESS TO BYPASS RN ADDRESS. * JSB RNRQ GO TO RTE TO REQUEST OR RETURN A DEF *+4 GLOBALLY ALLOCATED/LOCALLY LOCKED RNCOD NOP RESOURCE NUMBER. RNAD NOP DEF RNST DUMMY STATUS INFO STORAGE. ISZ ERRN IF DE-ALLOCATION REQUEST ERROR-- JMP RNSUB,I OR NORMAL COMPLETION: RETURN. * JSB SYSER ALLOCATION ERROR: INFORM THE CALLER. DEF RNERM CATASTROPHIC ERROR--NO RETURN! * GALCA DEF GALC ADDRESS OF ALLOCATION CODE. DALCA DEF DALC ADDRESS OF DE-ALLOCATION CODE. GALC OCT 140021 GLOBAL ALLOCATE/LOCAL LOCK/NO ABORT DALC OCT 140040 RELEASE GLOBAL/NO ABORT ERRN EQU CLSUB ERROR-HANDLING SWITCH(0-IGNORE/1-REPORT) RNST EQU SECOD RN STATUS STORAGE (NOT USED). * SKP * DEFINE TOTAL # OF MONITORS * * [ ADD 1 TO THE VALUE FOR EACH NEW MONITOR TO BE ADDED ] * #MON EQU 9 MNMON ABS -#MON DEFINE NEGATIVE NUMBER OF MONITORS. SPC 1 NAMA DEF NAMES SPC 1 NAMES ASC 3,DLIST DIRECTORY LISTING MONITOR. B1 DEC 1 STREAM 1 ZERO OCT 0 NO ABORT! * CNSLM ASC 3,CNSLM HP3000 CONSOLE MONITOR B2 DEC 2 STREAM 2 OCT 0 NO ABORT! * ASC 3,EXECW SCHEDULE-WITH-WAIT MONITOR. B3 DEC 3 STREAM 3 OCT 100000 ABORT O.K. * ASC 3,PTOPM PROGRAM-TO-PROGRAM MONITOR. B4 DEC 4 STREAM 4 OCT 0 NO ABORT! * ASC 3,EXECM REMOTE EXEC-REQUEST MONITOR. B5 DEC 5 STREAM 5 OCT 0 NO ABORT! * RFAM ASC 3,RFAM REMOTE FILE ACCESS MONITOR. D6 DEC 6 STREAM 6 OCT 0 NO ABORT! * ASC 3,OPERM REMOTE OPERATOR-REQUEST MONITOR. B7 DEC 7 STREAM 7 OCT 100000 ABORT O.K. * ASC 3,PROGL ABSOLUTE PROGRAM-LOADING MONITOR. D9 DEC 9 STREAM 9 K OCT 0 NO ABORT! * ASC 3,RDBAM REMOTE DATA BASE ACCESS MONITOR DEC 10 STREAM 10 OCT 0 NO ABORT! SKP * ROUTINE TO VERIFY THAT WE ARE RUNNING UNDER THE NAME OF * "LSTEN", NOT SOME PHANTOM COPY. * * CALLING SEQUENCE: * JSB CKLSN * * OTHERWISE, ERROR MESSAGE "/LSTEN: ID SEG NAME MUST BE 'LSTEN'" * WILL BE PRINTED AND THE PROGRAM WILL * TERMINATE. * CKLSN NOP LDA @LSTN LOAD BYTE ADDRESS OF "LSTEN" LDB @MYNM LOAD BYTE ADDRESS OF OUR NAME(FROM ID SEGMENT) CBT B5 CHECK 5 BYTES JMP CKLSN,I STRINGS ARE EQUAL--WE'RE OK. NOP STRINGS DO * HERE WHEN WE'RE NOT CALLED 'LSTEN' JSB PRINT PRINT ERROR MESSAGE DEF CKMS1 JMP ABORT AND STOP. SPC 1 CKMS1 DEF *+2 DEF D13 ASC 10, PROG NAME MUST BE ' LSTN ASC 3,LSTEN' @LSTN DBL LSTN SPC 3 * * ROUTINE TO SCHEDULE USER-SPECIFIED SLAVE MONITORS. * MSET NOP ENTRY/EXIT: MONITOR SCHEDULING RTN. CLA,SEZ,RSS IF =1, DISALLOW DEFAULT SCHEDULING. CCA INITIALIZE A FLAG TO ALLOW STA MFLAG DEFAULT SCHEDULING ON FIRST PASS. MLOOP LDA MNMON INITIALIZE A COUNTER STA MCNT FOR THE NO. OF MONITORS TO SCHEDULE. LDB NAMA INITIALIZE THE STB NAMPT PROGRAM NAME-ARRAY POINTER. * JSB PRINT ASK FOR THE DEF MONMS " MONITOR NAME? _" * JSB READ GET THE USER'S RESPONSE. CPB /E ALL DONE? JMP MSET,I YES. RETURN FOR NEXT OPERATION. CPB /D CHECK FOR DEFAULT SCHEDULING. RSS IF IT IS A "/D", THEN SKIP FOR DEFAULT; JMP MNAM ELSE, CONTINUE CHECKING. ISZ MFLAG IF THIS IS NOT A 1RST-PASS DEFAULT JMP NAMER REQUEST--ERROR!--ELSE, 0H JMP MDFLT DEFAULT: GO TO SCHEDULE ALL MONITORS. * MNAM CPA B2 IF RESPONSE WAS ASCII-ALPHA. CHARACTERS, JMP *+2 THEN SKIP TO CHECK FOR A VALID NAME; JMP NAMER ELSE, INFORM THE USER OF HIS ERROR! * LDB NAMPT POINT TO FIRST NAME. MCOMP STB NAMPT SAVE THE POINTER. LDA PARS2 ADDRESS OF USER'S MONITOR NAME. CMW B3 COMPARE THE THREE WORDS. JMP MFOUN ALL COMPARE--GO TO SCHEDULE. NOP NO COMPARISON. ADB B2 ADD OFFSET FOR NEXT NAME ENTRY. ISZ MCNT HAVE ALL OF THE NAMES BEEN CHECKED? JMP MCOMP NO. GO TO CHECK THE NEXT ONE. * NAMER JSB ERROR INFORM THE USER OF HAVING SUPPLIED AN DEF INVNM " INVALID NAME!" JMP MLOOP GO BACK TO TRY AGAIN. * SKP MFOUN CLA,CLE CLEAR 'MFLAG' IN ORDER TO STA MFLAG DIS-ALLOW DEFAULT SCHEDULING. * JSB MSKED GO TO SCHEDULE THE MONITOR. JMP MLOOP GO TO ASK FOR THE NEXT NAME. * MDFLT CLE SPECIFY MONITOR SCHEDULING. JSB MSKED GO TO SCHEDULE A MONITOR. LDA NAMPT ADVANCE THE ADA B5 NAME-ARRAY POINTER TO POINT STA NAMPT TO THE NEXT MONITOR'S NAME. ISZ MCNT HAVE ALL MONITORS BEEN SCHEDULED? JMP MDFLT NO. GO TO SCHEDULE THE NEXT ONE. JMP MSET,I YES. RETURN FOR THE NEXT OPERATION. * CNSDF DEF CNSLM RFMDF DEF RFAM SCHNW OCT 100012 STMPT NOP NAMPT NOP MCNT NOP MFLAG NOP SPC 1 * DO NOT CHANGE ORDER OF 'MCLAS' & 'IDAD' * SPC 1 MCLAS NOP IDAD NOP * QUES ASC 2,MON? ASTAT ASC 2,STAT SMES DEF *+2 DEF D10 ASC 4, ERROR: ERCOD ASC 3, : SNAM ASC 3,XXXXX MONMS DEF *+2 DEF D8 ASC 8, MONITOR NAME? _ INVNM DEF *+2 DEF B7 ASC 7, INVALID NAME! * SKP * SUBROUTINE TO SCHEDULE A MONITOR & INITIALIZE ITS LIST-HEADER ENTRY. * MSKED NOP ENTRY/EXIT: MONITOR SCHEDULER. SEZ MONITOR OR OTHER? JMP SCHED GO TO SCHEDULE ANOTHER PROCESSOR. * LDA NAMPT GET THE NAME-ARRAY POINTER. CPA CNSDF ABOUT TO SCHEDULE ? RSS YES. CHECK FURTHER. JMP GETID NO. GO AHEAD AND SCHEDULE LDB #LU3K IS HP3000 CONNECTED? SZB,RSS YES. GO AHEAD AND SCHEDULE. JMP MSKED,I NO. IGNORE SCHEDULING OF * GETID JSB PGMAD GO TO GET MONITOR'S ID SEGMENT ADDRESS. DEF *+2 DEF NAMPT,I ADDRESS OF MONITOR'S NAME. SZA,RSS IS THE MONITOR PRESENT? JMP MON? NO. INFORM THE USER. STA IDAD YES. SAVE I.D. SEGMENT ADDRESS. LDA B GET MONITOR'S STATUS INTO . AND B17 ISOLATE THE MONITOR'S STATUS. SZA IS IT DORMANT? JMP STERR NO. INFORM USER OF ERROR. * CLE GET A JSB CLSUB CLASS NUMBER DEF MCLAS FOR THE MONITOR. LDB NAMPT GET THE NAME-ARRAY POINTER. ADB B3 ADVANCE TO THE STREAM-LIST ENTRY. LDA B,I GET STREAM NUMBER ADA B2 COMPUTE ADA #LDEF LIST HEADER LDA 0,I ADDRESS. INA POINT TO CLASS NO IN HEADER STA STMPT SAVE FOR 'RES' INITIALIZATION. INB ADVANCE TO THE ABORT-FLAG ENTRY. LDA IDAD GET THE I.D. SEGMENT ADDRESS. IOR B,I INCLUDE THE ABORT-FLAG BIT(#15)--IF ANY. STA IDAD RESTORE THE FLAGGED I.D. SEGMENT ADDRESS * LDA NAMPT GET THE NAME-ARRAY POINTER. CPA RFMDF IF 'RFAM' IS BEING SCHEDULED, THEN JSB FILIN GET THE FILE COUNT FOR IT. * DLD MCLAS GET CLASS NO. & ID SEG. ADDRESS. DST STMPT,I STORE INTO STREAM LIST-HEADER IN 'RES'. SKP * SCHED JSB EXEC GO TO RTE DEF *+5 TO SCHEDULE DEF SCHNW THE MONITOR DEF NAMPT,I  WITHOUT WAIT. DEF MCLAS SCHEDULING PARAMETER #1. DEF ERLU SCHEDULING PARAMETER #2. JMP STCOD * ERROR--REPORT TO USER * SZA WAS IT CORRECTLY SCHEDULED? JMP STERR NO--INCORRECT STATUS ERROR. * JMP MSKED,I RETURN TO THE CALLER (=STATUS). * MON? DLD QUES GET THE MONITOR-MISSING INDICATOR. JMP STCOD SAVE FOR THE ERROR MESSAGE. STERR DLD ASTAT GET THE STATUS-PROBLEM INDICATOR. STCOD DST ERCOD SAVE THE ERROR CODE. * DLD NAMPT,I GET THE NAME DST SNAM OF THE MONITOR, LDB NAMPT AND SAVE IT ADB B2 FOR USE IN LDA B,I THE ERROR-REPORT STA SNAM+2 MESSAGE. * JSB ERROR GO TO PRINT THE DEF SMES ERROR MESSAGE. JMP MSKED,I RETURN TO THE CALLER. SPC 3 * SCHEDULE , THE TRANSACTION MONITOR & CLEANUP PROGRAM, * TO RUN EVERY FIVE SECONDS. * SUPLN NOP JSB EXEC GO TO THE DEF *+6 RTE EXECUTIVE DEF SCHTM TO TIME-SCHEDULE @UPLN DEF UPLIN DEF B2 TO BE RUN DEF B5 EVERY FIVE SECONDS; DEF DM2 TO BEGIN IN TWO SECONDS. RSS IF A SYSTEM ERROR IS DETECTED, SKIP; JMP SUPLN,I ELSE, RETURN TO THE CALLER. * JSB SYSER INFORM THE USER OF A CATASTROPHIC ERROR: DEF UPMES 'UPLIN' WAS NOT SCHEDULED. [NO RETURN] * SCHTM OCT 100014 UPMES DEF *+2 DEF D12 ASC 2, ** UPLIN ASC 3,UPLIN ASC 7,NOT SCHEDULED! SKP * * SCHEDULE QUEUEING PROCESSORS: * 1000 LINK: ,,& . * 3000 LINK: ,& . * SCHDQ NOP ENTRY/EXIT LDB NAMAD ADDR OF DS/1000 MODULES LDA RMSA 1000 ENABLED FLAG SZA,RSS DS/1000 ENABLED? ADB D9 NO, POINT TO MODULES FOR 3000 STB NAMPT SAVE RUNNING POINTER MPY DM3 A = -3 IF 1000 CONNECTED, ELSE 0 LDB RM3K IF 3000 CONNECTED, SZB ADD ADA DM2 -2. STA NCNTR NCNTR = - NO. OF MONITORS TO SCHEDULE. CLA SET THE CLASS PARAMETER =0 (DUMMY), STA MCLAS SINCE IT'S ALREADY STORED IN . * SCHDL CCE SPECIFY OTHER-PROCESSOR SCHEDULING. JSB MSKED GO TO SCHEDULE THE PROCESSOR. SZA CATASTROPHIC ERROR? JMP ABORT YES ** ABORT ** LDA NAMPT GET THE NAME-ARRAY POINTER. ADA B3 ADD AN OFFSET FOR NEXT NAME ENTRY. STA NAMPT UPDATE THE ARRAY POINTER. ISZ NCNTR ALL QUEUEING PROCESSORS BEEN SCHEDULED? JMP SCHDL NO. GO TO SCHEDULE THE NEXT ONE. JMP SCHDQ,I YES. RETURN TO THE CALLER. * NCNTR EQU SUPLN NAMAD DEF *+1 POINTER TO FIRST PROGRAM'S NAME. ASC 3,GRPM GENERAL PRE-PROCESSING MONITOR. ASC 3,RTRY WRITE RETRY PROCESSOR. ASC 3,QCLM ERROR LOG PROCESSOR. ASC 3,RQCNV HP3000 REQUEST CONVERTER ASC 3,RPCNV HP3000 REPLY CONVERTER .QUEZ ASC 3,QUEZ SERVANT TO QUEX ASC 3,QUEX RTE-MPE LINK MESSAGE PROCESSOR .QUE ASC 3,QUEUE RTE-RTE LINK MESSAGE READER NAMA2 DEF .QUEZ NAMA3 DEF .QUE * SKP * SUBROUTINE TO PRINT MESSAGES ON INTERACTIVE TERMINALS--ONLY. * * CALLING SEQUENCES: * * JSB PRINT....PRINT:" /LSTEN:" JSB PRNTX....PRINT:"" * DEF MESSAGE DEF MESSAGE * PRNTX NOP ENTRY/EXIT: PRINT W/O HEADER LDA PRNTX GET THE RETURN ADDRESS. STA PRINT SAVE FOR THE RETURN. LDA A,I GET THE MESSAGE ADDRESS, STA OLDAD AND SAVE FOR ERROR-TRANSFER ROUTINE. DLD A,I GET THE MESSAGE SPECIFICATIONS, DST PRNT1 AND CONFIGURE THE CALLING SEQUENCE. JMP PRNT0 GO TO PRINT THE MESSAGE W/O )*HEADER. * PRINT NOP NORMAL ENTRY/EXIT DLD NORMA RE-ESTABLISH THE DST PRNT1 NORMAL MESSAGE SPECIFICATIONS. LDA MSGAD INITIALIZE THE STA BUFPT MESSAGE BUFFER POINTER. LDB PRINT GET ADDRESS OF MESSAGE INFORMATION. LDB B,I TRACK DOWN RBL,CLE,SLB,ERB A DIRECT JMP *-2 ADDRESS. LDA RDER IF THE ERROR-TRANSFER ROUTINE IS SZA,RSS IN CONTROL, BYPASS 'OLDAD' UPDATING. STB OLDAD SAVE IT FOR THE ERROR-TRANSFER ROUTINE. DLD B,I GET BUFFER ADDRESS AND LENGTH. STA MSPNT SAVE FOR SOURCE POINTER. LDB B,I GET THE MESSAGE LENGTH. STB PRNTL INCLUSION OF THE HEADER. CMB,INB IF THE MESSAGE LENGTH ADB D20 EXCEEDS THE MAXIMUM SSB BUFFER SIZE, THEN JMP PRNTA IGNORE THE REQUEST; ELSE, DLD MSPNT TRANSFER THE MESSAGE MVW PRNTL TO THE PRINT BUFFER. LDA PRNTL GET THE MESSAGE LENGTH. ADA B5 ADD IN THE HEADER SIZE. STA PRNTL SAVE TOTAL MESSAGE LENGTH. * PRNT0 LDA TYPEQ GET TTY FLAG LDB ERFLG GET ERROR FLAG SZB,RSS ERROR OR SZA,RSS OR INTERACTIVE RSS YES...PRINT MESSAGE JMP PRNTA NO ERROR AND NOT INTERACTIVE LDA RLU GET INTERACTIVE LU SZB ERROR? LDA ERLU YES...ERROR LU STA PRTLU SAVE AS PRINT LU * SKP JSB REIO PRINT MESSAGE DEF *+5 DEF B2 DEF PRTLU PRINT LU PRNT1 DEF HEDMS MESSAGE ADDRESS. DEF PRNTL MESSAGE LENGTH. PRNTA ISZ PRINT POINT TO RETURN ADDRESS JMP PRINT,I RETURN SPC 1 @MYNM DBL MYNAM BYTE ADDRESS OF OUR REAL NAME ERLU NOP ERROR LOGICAL UNIT NO. PRTLU NOP PRNTL NOP OLDAD NOP PREVIOUS MESSAGE ADDRESS. BUFPT NOP NORMA DEF HEDMS DEF PRNTL MSPNT NOP RMSGAD DEF MSGBF HEDMS OCT 6412 CARRIAGE-RETURN/LINEFEED. ASC 1, / MYNAM ASC 3,LSTEN: CHANGED TO ACTUAL PROGRAM NAME MSGBF BSS 20 * * ROUTINE TO DECIDE WHICH TYPE OF INPUT DEVICE * EITHER FILE OR LU * IF LU, A-REG WILL CONTAIN LU TYPE, B-REG = READ LU, E=0 * CALLING SEQUENCE * JSB CHCKN * * * CHCKN NOP LDB RLU GET READ-DEVICE LU. LDA TYPEQ GET EQUIPMENT TYPE CODE. CLE,SZB,RSS LU OR FILE ISZ CHCKN FILE JMP CHCKN,I AND RETURN * * SUBROUTINE TO PRINT SYSTEM ERROR MESSAGES AND * ABORT * CALLING SEQUENCE * JSB SYSER * DEF ERR MESSAGE * SYSER NOP LDA SYSER,I GET MESSAGE SPECIFICATION ADDRESS. STA SYSAD CONFIGURE CALL TO PRINT ROUTINE. ISZ ERFLG SET ERROR FLAG. JSB PRINT SYSAD NOP JMP ABORT AFTER MESSAGE...ABORT SKP * SUBROUTINE TO READ FROM A SELECTED INPUT DEVICE * WILL PARSE THE INPUT AND PLACE RESULT IN A BUFFER * CALLED PARSB. IF FIRST PARAMETER = '/A' WILL GO TO 'ABORT'. * CALLING SEQUENCE * JSB READ * UPON RETURN A REG=PARSB, B REG=PARSB+1 * READ NOP LDA DM4 ALLOW THREE STA RETRY ERROR-RETRIES. READA LDA RLU GET READ LU LDB RDER IS THIS AN ERROR READ? SZB LDA ERLU YES...READ FROM ERROR DEVICE. SZA,RSS IF THE SOURCE IS FROM A FILE, JMP READB THEN GO TO FILE READ ROUTINE. STA PRTLU SAVE READ LU JSB REIO ISSUE THE READ DEF *+5 DEF B1 DEF PRTLU DINBF DEF INBUF DEF INBFS SZB EOF HIT? JMP READC NO REDER JSB ERXFR INDICATE ERROR, AND ALLOW RE-TRY. DEF READM JMP READA TRY AGAIN SPC 1 READB JSB READF READ FROM A FILE DEF *+6 DEF INDCB DEF TEMP1 DEF INBUF DEF INBFS DEF PRNTL LDB PRNTL GET LENGTH SSA,RSS FILE ERROR? SZB,RSS OR ZERO-LENGTH RECORD? JMP REDER YES--PROCESS THE ERROR. * READC EQU * CLE,ELB CONVERT TO BYTE LENGTH STB PRNTL SAVE LENGTH LDA INBUF GET AND =B77400 FIRST CPA ASTSK CHARACTER: ASTERISK(*) ? JMP READA YES, READ ANOTHER ONE JSB PARSE GO PARSE INPUT DEF *+4 DEF INBUF DEF PRNTL DEF PARSB CLA,CLE CLEAR OUT READ-ERROR FLAG STA RDER DLD PARSB LOAD A AND B REG CPB /A IF RECORD'S FIRST 2 CHARS. =/A JMP *+2 SKIP TO CHECK NEXT TWO. JMP READ,I ELSE, RETURN. LDB PARSB+2 GET NEXT TWO CHARACTERS. CPB BLNKS IF THEY ARE BLANKS, JMP ABORT THEN PROCESS THE ABORT REQUEST! JMP READ,I ELSE, RETURN. BREADC LDB PARSB+1 ELSE, RESTORE , JMP READ,I AND RETURN. * RDER NOP ASTSK OCT 25000 ASCII "*" IN HIGH BYTE SPC 2 * ROUTINE TO PRINT ERROR MESSAGE. * * CALLING SEQUENCE: * * JSB ERROR * DEF * * WILL SET ERROR FLAG FOR RETRY * ERROR NOP LDA ERROR,I GET MESSAGE SPECIFICATION ADDRESS. STA ERRAD CONFIGURE CALL TO PRINT ROUTINE. ISZ ERFLG FORCE MESSAGE TO ERROR DEVICE. JSB PRINT PRINT THE ERROR MESSAGE. ERRAD NOP CLA CLEAR THE STA ERFLG ERROR-DEVICE FLAG. ISZ ERROR BYPASS THE MESSAGE-SPECIFICATION. JMP ERROR,I AND RETURN SPC 1 ERFLG NOP SPC 2 * PRINT THE ERROR MESSAGE AND REPEAT THE QUESTION ON THE (ERROR LU) DEVICE. * * CALLING SEQUENCE: * * JSB ERXFR * DEF * ERXFR NOP ENTRY/EXIT: ERROR TRANSFER ROUTINE ISZ RDER SET READ ERROR FLAG. ISZ RETRY ALL RETRIES BEEN EXHAUSTED? JMP *+2 NO. TRY AGAIN. JMP ABORT YES--ABORT THE PROCESS! B@<* LDA ERXFR,I GET MESSAGE ADDRESS. STA ERAD1 ISZ ERFLG FORCE THE USE OF THE (ERROR LU). JSB PRINT GO TO PRINT ERAD1 NOP * JSB PRINT GO TO REPEAT THE QUESTION DEF OLDAD,I ON THE (ERROR LU) DEVICE. CLA CLEAR OUT STA ERFLG THE ERROR FLAG, ISZ ERXFR SET RETURN ADDRESS JMP ERXFR,I AND RETURN. * SKP wB SKP * SYSTEM SHUTDOWN ROUTINE (RELEASE ALL NETWORK-RELATED RESOURCES) * IFZ SHUTD EQU * JSB CKLSN CHECK TO SEE IF OUR NAME IS "LSTEN" * JSB PRINT DEF SDHED "SYSTEM SHUTDOWN" LDA #BUSY CONVERT # ACTIVE TCBS TO ASCII JSB CNVTD DEF SHT.1 JSB PRINT DEF SHTM1 CLA INITIALIZE # OF STA KILL3 ENTRIES COUNTER LDB #PNLH GET ADDRESS OF HP 3000 PROCESS # LIST SHUT. EQU * START OF PNL-COUNTING LOOP SZB,RSS END OF LIST? JMP SHUT0 YES DSNR7 LDA B,I (XLA B,I IF IN DMS) NOP (RESERVED FOR XLA INSTR. IF DMS) ISZ KILL3 BUMP COUNTER STA B JMP SHUT. CONTINUE IN LOOP * SHUT0 EQU * LDA KILL3 CONVERT # HP 3000 SESSIONS TO ASCII JSB CNVTD DEF SHT.2 JSB PRINT DEF SHTM2 JSB PRINT " SECURITY CODE?" DEF SECMS JSB READ GET THE RESPONSE. CPA B2 ASCII RESPONSE? RSS YES, CONTINUE PROCESSING JMP SHTER NO. PRINT ERROR MESSAGE UNL JSB S LST CPB #SWRD DOES THE CALLER KNOW THE SECRET? JMP SHUT1 YES, LET HIM PASS SHTER EQU * HERE TO PRINT ERROR MESSAGE JSB ERROR <> INFORM HIM OF DEF IVRES THE ERROR OF JMP ABORT HIS WAYS!! * SHUT1 EQU * * CHECK FOR SLAVE PROGRAM-TO-PROGRAM COMMUNICATION ACTIVITY LDA #ST04+1 GET "PTOPM" CLASS NUMBER SZA,RSS ACTIVE? JMP SHUT2 NO. * * ISSUE "SO" TO PTOPM, SO AS TO ABORT ALL SLAVES CURRENTLY * ACTIVE. * CLA PLACE A ZERO IN PROGRAM NAME STA $PRG PORTION OF REQUEST, MEANING STA $PRG+1 "ABORT ALL SLAVES" STA $PRG+2 STA ECOD1 INITIALIZE ERROR FIELDS STA ECOD3 LDA D6 STA $FPfUNC SAVE PTOP FUNCTION CODE LDA B4 STA $STRM SET STREAM TYPE (4) LDA #NODE LOCAL NODE # STA $DSND SET REQST DESTINATION NODE JSB D65MS SEND REQUEST (NO DATA) DEF *+8 DEF CNWD1 NO ABORT DEF PB DEF D11 11 WORD REQUEST DEF D0 DEF D0 NO DATA ASSOCIATED WITH REQST DEF D0 NO REPLY DATA DEF D11 MAX REPLY LENGTH NOP D65MS DETECTED ERROR (IGNORE) SPC 2 SHUT2 EQU * * CHECK FOR SLAVE REMOTE DATA BASE ACCESS COMMUNICATION ACTIVITY. LDA #ST10+1 GET "RDBAM" CLASS NUMBER SZA,RSS ACTIVE? JMP SHUT3 NO. * * ISSUE A CLEAN-UP REQUEST TO RDBAM, SO AS TO ABORT ALL REMOTE * DATA BASE ACCESS PROGRAMS CURRENTLY ACTIVE. * CCA PLACE A -1 IN RDBA INDEX STA $INDX AND MODE WORDS OF REQUEST, STA $MODE MEANING "ABORT ALL ACTIVE RDBA SLAVES". CLA INITIALIZE ERROR NODE. STA ECOD3 LDA D10 SET STREAM TYPE (10). STA $STRM LDA #NODE LOCAL NODE NUMBER, STA $DSND SET REQUEST DESTINATION NODE. * JSB D65MS SEND REQUEST (NO DATA) DEF *+8 DEF CNWD1 NO ABORT DEF PB DEF B7 SEVEN WORD REQUEST DEF D0 NO DATA ASSOCIATED WITH REQUEST DEF D0 DEF D0 NO REPLY DATA DEF B7 MAX REPLY LENGTH NOP D65MS DETECTED ERROR (IGNORE). SPC 2 SHUT3 EQU * CLA STA ONTWO CLEAR THE "OPTION 1/2" FLAG STA #NULL SET # AVAILABLE TCBS TO ZERO LDB #GRPM LOAD GRPM'S CLASS NUMBER STB GRPM# SAVE LOCALLY & CAUSE ALL FURTHER MASTER STA #GRPM CALLS TO RETURN "DS00" ERROR TO USER LDB #QRN (SAME THING FOR HP 3000-LINK MASTER STA #QRN CALLS) STB QRN# JSB RNRQ LOCK THE QUIESCENCE RN TO DEF *+4 # PREVENT NEW REQUESTS FROM DEF GLOCK BEING RECEIVED FROM REMOTE NODES, OR DEF QRN# DEF TEMP1 ISSUED BY LOCAL MASTERS. * LDA @UPLN SET UP TO KILL "UPLIN" STA NAMPT JSB KILLM KILL "UPLIN" * * SEND TIME-OUT INDICATION TO ALL MASTERS CURRENTLY WAITING * FOR REPLIES. * LDB #MRTH ADDR OF LIST HEADER CKMST EQU * SZB,RSS END OF LIST? JMP SHUT5 YES. DSNR4 LDA B,I (CROSS) LOAD ADDR OF NEXT TCB NOP [RESERVED FOR XLA] STA LSTAD SAVE NEXT TCB ADDRESS ADB =LMSCLS POINT TO CLASS NUMBER IN TCB DSNR5 LDA B,I (CROSS) LOAD CLASS NUMBER NOP [RESERVED FOR XLA] STA CLASN STORE JSB EXEC WRITE ZERO-LENGTH RECORD INTO CLASS DEF *+8 (FORCES DS05 ERROR TO BE RETURNED TO DEF CLS18 USER) DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF CLASN MASTER CLASS # NOP IGNORE ERRORS LDB LSTAD RECOVER NEXT TCB ADDRESS JMP CKMST GO CHECK FOR ANOTHER MASTER SPC 2 * SET UP TO CALL "ABRT" SUBROUTINE, WHICH WILL RELEASE REMAINING * RESOURCES SHUT5 EQU * LDA #RTRY GET RTRY'S CLASS NUMBER STA RTRY# SAVE FOR "ABORT PROCESSING LDA #QCLM STA QCLM# LDA #RPCV STA RPCV# LDA #RQCV STA RQCV# LDA #QZRN GET QUEZ'S RESOURCE NUMBER STA QZRN# LDA #TBRN GET TABLE ACCESS RESOURCE NUMBER STA TBRN# LDA #QXCL GET QUEX'S CLASS NUMBER STA QXCL# JSB ABRT GO ABORT ALL SLAVE MONITORS, ALL RNS, ETC. JSB PRINT "SHUTDOWN COMPLETED." DEF SHTMS JMP TERM TERMINATE & RETURN "END LSTEN" TO 'FATHER' SPC 2 SHTMS DEF *+2 DEF D10 ASC 10,SHUTDOWN COMPLETED. XIF SPC 2 * * SUBROUTINE TO CALL KILLM & INCREMENT NAME POINTER R * BY 3 KILL3 NOP JSB KILLM LDA NAMPT ADA D3 STA NAMPT JMP KILL3,I RETURN TO CALLER SPC 2 * DEFINE REQUEST BUFFER IFZ PB BSS 11 REQUEST BUFFER * DEFINE REQUEST/REPLY BUFFER FORMAT DSTRM EQU PB DDEST EQU PB+3 REQST DESTINATION NODE # ECOD1 EQU PB+4 ERROR CODES ECOD2 EQU PB+5 ECOD3 EQU PB+6 DLST EQU PB+7 STATUS $DSND EQU PB+3 REQUEST DESTINATION NODE $STRM EQU PB REQUEST STREAM TYPE $FUNC EQU PB+7 P-TO-P FUNC CODE $PRG EQU PB+7 PROGRAM NAME $INDX EQU PB+4 RDBA INDEX WORD $MODE EQU PB+5 RDBA MODE WORD SPC 2 CLASN NOP LSTAD NOP CNWD1 OCT 100000 D65MS CONTROL WORD SHTM1 DEF *+2 DEF D10 ASC 7,# ACTIVE TCBS: SHT.1 BSS 3 STORAGE FOR # ACTIVE TCBS COUNT(IN ASCII) SHTM2 DEF *+2 DEF D16 ASC 13,# ACTIVE HP 3000 SESSIONS: SHT.2 BSS 3 STORAGE FOR # HP 3000 SESSIONS SDHED DEF *+2 DEF D8 ASC 8, SYSTEM SHUTDOWN XIF SKP * HERE ON ANY ABORT CONDITIONS * WILL CLEAR ALL LU'S, FLAGS, * DE-ALLOCATE CLASS NUMBERS, * AND TERMINATE ALL MONITORS. * CALLING SEQUENCE * JMP ABORT * ABORT EQU * JSB ABRT CALL SUBROUTINE JSB PRINT PRINT "LSTEN ABORTED" @ABPR DEF ABRTM LDA @ABPR RETURN ERROR TO 'FATHER' PRGM STA $RTRN JMP TERM SPC 2 ABRT NOP SUBROUTINE TO ABORT EVERYTHING LDA ONTWO OPTION 1 OR 2 SZA JMP ABRT4 OPTION 2 * CPA #FWAM IF SAM HAS NOT BEEN ALLOCATED, JMP ABRT4 THEN GO TO COMPLETION. * * TURN OFF "LISTEN MODE" FOR EACH COMMUNICATION DRIVER * AND RE-INSERT EQT EXTENSION LENGTH * DLD #NCNT SET UP NRV SCAN LOOP SZA,RSS NRV? JMP ABRT2 NO. DST CNTPT ABRT1 EQU * ADB =LXMTL@ ADVANCE POINTER TO TRANSMISSON LU WRD * GET OTRANSMISSION LU DSNR8 LDA B,I (XLA B,I IN DMS) NOP (PART OF XLA INSTR. ABOVE IF IN DMS) AND XMASK MASK LU STA LTEMP SAVE FOR A SECOND IOR CLSTN SET SUBFUNCTION BITS STA XLU STB PRINT SAVE (B) JSB EXEC ISSUE "CLEAR LISTEN MODE" CALL TO DRIVER DEF *+3 DEF NBRT3 NO-ABORT, CODE 3 DEF XLU NOP JSB DRTEQ FIND EQT ENTRY DEF *+2 FOR LU BEING SHUT DOWN DEF LTEMP SSB VALID LU? JMP SHT0 NO, SOME PROBLEM HERE ADB D11 ADVANCE TO EQT 12 STB LTEMP SAVE FOR A SECOND * JSB $LIBR GO PRIVILEGED NOP LDA EQTSZ GET CORRECT EQT SIZE STA LTEMP,I STORE BACK IN EQT FOR NEXT TIME JSB $LIBX DEF *+1 DEF *+1 SHT0 EQU * LDB PRINT RECOVER (B) ADB =LNRVZ@-XMTL@ ADVANCE TO NEXT ENTRY ISZ CNTPT BUMP COUNTER. DONE? JMP ABRT1 NOT YET DONE LDA NAMA3 SET UP & STA NAMPT ABORT CLA JSB KILL3 "QUEUE" SPC 2 ABRT2 EQU * LDA MNMON GET NEGATIVE NUMBER OF MONITORS. STA MCNT SAVE AS A LOOP COUNTER. LDB NAMA GET THE ADDRESS OF THE NAME-ARRAY. ABMON STB NAMPT SAVE AS A POINTER. ADB B3 POINT TO THE STREAM NUMBER LDA 1,I GET STREAM NUMBER ADA B2 ADA #LDEF COMPUTE ADDR OF LIST HEADER ADDR LDA 0,I GET LIST HEADER ADDR INA POINT TO MONITOR CLASS NUMBER STA CNTPT SAVE ADDRESS LDA A,I GET THE MONITOR CLASS NO.--IF ANY. SZA,RSS IS THIS MONITOR ACTIVE? JMP ABNEX NO. GO TO TRY THE NEXT MONITOR. JSB KILLM GO TO TERMINATE THE MONITOR. * CLEAR THE CLASS # AND ID SEGMENT ADDR STORED IN STREAM HEADER CLA CLB DST CNTPT,I * ABNEX LDB NAMPT GET THE NAME-ARRAY POINTER. ADB WB5 ADVANCE THE POINTER TO THE NEXT ENTRY. * ISZ MCNT HAVE ALL MONITORS BEEN ABORTED? JMP ABMON NO. GO BACK TO KILL THE NEXT ONE. * * LDA NAMAD GET POINTER TO 'GRPM' NAME ARRAY. STA NAMPT SET POINTER FOR TERMINATION. LDA GRPM# GET 'GRPM' CLASS NUMBER. SZA JSB KILL3 GO TO TERMINATE 'GRPM'. * LDA RTRY# GET "RTRY" CLASS NUMBER SZA JSB KILL3 GO TO TERMINATE "RTRY" * LDA QCLM# GET 'QCLM' CLASS NUMBER. SZA JSB KILL3 GO TO TERMINATE 'QCLM'. * LDA RQCV# GET "RQCNV" CLASS NUMBER SZA IF OK, JSB KILL3 GO TO TERMINATE "RQCNV" * LDA RPCV# GET "RPCNV" CLASS NUMBER SZA IF OK, JSB KILL3 GO TO TERMINATE "RPCNV" * CCE GO TO RELEASE THE JSB RNSUB RESOURCE NUMBER DEF TBRN# FOR TABLE-ACCESS CONTROL. CCE GO TO RELEASE THE JSB RNSUB RESOURCE NUMBER DEF QRN# FOR SYSTEM-QUIESCENCE CONTROL. * LDA #LU3K IF NO HP3000 SZA,RSS IN SYSTEM, JMP ABRT3 SKIP NEXT BLOCK * LDA NAMA2 SET UP STA NAMPT AND CLA ABORT JSB KILL3 "QUEZ" LDA QXCL# ABORT "QUEX" JSB KILL3 * CCE GO RELEASE THE JSB RNSUB RESOURCE NUMBER DEF QZRN# FOR QUEZ "LISTEN MODE" SPC 2 ABRT3 EQU * JSB #RSAX GO TO THE SYSTEM-RESOURCE DEF *+3 CONTROL-ROUTINE, IN ORDER TO DEF B1 RETURN SYSTEM AVAILABLE MEMORY, DEF #FWAM WHICH WAS PREVIOUSLY ALLOCATED. CLA CLEAR #FWAM FLAG STA #FWAM JSB CLEAR GO TO CLEAR SYSTEM DATA AREA IN . * ABRT4 EQU * JMP ABRT,I RETURN TO CALLER * CNTPT BSS 2 CNTR/POINTER FOR NRV/CLEAR LISTEN MODE LOOP XLU NOP CLSTN OCT 20\.0 SUBFUNCTION BITS FOR "CLEAR LISTEN MODE" CALL TO DRIVER XMASK EQU B77 TRANSMISSION LU FIELD MASK SKP * ROUTINE TO "KILL" A PROGRAM * * ENTRY: (A) = MONITOR'S CLASS NUMBER (NEED NOT HAVE ONE) * KILLM NOP ENTRY/EXIT: TERMINATION ROUTINE STA MCLAS SAVE THE CLASS NUMBER DLD "OF" BUILD "OF,,1" FOR MESSAGE PROCESSOR DST OFMS1 DLD NAMPT,I GET FIRST 4 CHARS OF NAME DST OFMS1+2 SAVE LDB NAMPT GET ADB D2 5TH LDA B,I CHARACTER AND =B77400 AND MASK IOR COMMA INCLUDE COMMA STA OFMS1+4 LDA "1" STA OFMS1+5 JSB MESSS KILL PROGRAM DEF *+4 DEF OFMS1 "OFF,,1" DEF D12 DEF D0 NO PRINTED MESSAGE LDA MCLAS IS THERE A CLASS # ASSIGNED? CCE,SZA,RSS ?? JMP KILLM,I NO, RETURN TO CALLER JSB CLSUB YES, RELEASE THE PROGRAM'S DEF MCLAS CLASS NUMBER. JMP KILLM,I RETURN TO THE CALLER. SPC 1 ABPRM OCT 100000 ASC 1,ER OFMS1 BSS 6 "OFF,,1" MESSAGE "OF" ASC 2,OFF, "1" ASC 1,1 COMMA OCT 54 ASCII , (COMMA) D2 EQU B2 D3 EQU B3 NBRT3 OCT 100003 NO-ABORT CONTROL CONTROL * * ROUTINE TO CLEAR 'LSTEN'-INITIALIZED ENTRIES IN . SPC 1 CLEAR NOP ENTRY/EXIT LDA #NCLR INITIALIZE A COUNTER FOR THE STA TEMP SIZE OF THE AREA TO BE CLEARED. LDB #SCLR GET A POINTER TO THE START OF THE AREA. CLA CLOOP STA 1,I THE INB 'LSTEN'-INITIALIZED ISZ TEMP STORAGE LOCATIONS JMP CLOOP IN 'RES'. JMP CLEAR,I RETURN SKP * FERMG DEF *+2 DEF D6 ASC 6, FILE ERROR * RNERM DEF *+2 DEF B5 ASC 5, RN ERROR * LUERM DEF *+2 DEF B5 ASC 5, LU ERROR * TRFM DEF *+2 `0.*DEF D8 ASC 8, TR FILE ERROR * FILMG DEF *+2 DEF D10 ASC 10, INPUT # OF FILES: _ * READM DEF *+2 DEF D6 ASC 6, READ ERROR * ABRTM DEF *+2 DEF D8 ASC 8, LSTEN ABORTED! * CLSER DEF *+2 DEF D9 ASC 9, CLASS I/O ERROR * ENDMG DEF *+2 DEF B5 ENMSG ASC 5, END LSTEN * UPLUM DEF *+2 DEF B7 ASC 7, ENABLE LU# ?_ * OPMES DEF *+2 DEF B7 ASC 7, OPERATION? _ * NOSZR DEF *+2 DEF D9 ASC 9, NODE SPEC. ERROR! * SKP * EXPMS DEF *+2 DEF EXPML MESSAGE LENGTH OCT 6412 CARRIAGE-RETURN/LINE-FEED ASC 9, ??: LIST COMMANDS OCT 6412 ASC 5, /A: ABORT! OCT 6412 ASC 7, /E: TERMINATE OCT 6412 ASC 10, /L: RE-ENABLE LINE OCT 6412 ASC 8, /N: DISPLAY NRV OCT 6412 ASC 9, /Q: QUIESCE NODE OCT 6412 ASC 12, /S: SCHEDULE MONITOR(S) OCT 6412 ASC 9, /T: ADJUST TIMING OCT 6412 IFZ ASC 16, SD: SHUTDOWN&RELEASE RESOURCES OCT 6412 XIF OCT 6412 ASC 12, QUIESCENT SYSTEM ONLY: OCT 6412 ASC 9, /R: RE-START NODE OCT 6412 EXPML ABS *-EXPMS-2 MESSAGE LENGTH * SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B BGLWA EQU 1777B INBFS EQU D20 INBUF BSS 20 PARSB BSS 34 INDCB BSS 144 USED FOR ANSWER FILES. NDTCB BSS 144 USED FOR NDT FILE SPC 1 BSS 0 << SIZE OF 'LSTEN' >> SPC 1 END LSTEN 50 B 91740-18002 1840 S C0122 &UPLIN              H0101 ASMB,L,R,C HED UPLIN: 91740-16002 REV 1840 (C) HEWLETT-PACKARD CO. 1978 NAM UPLIN,17,3 91740-16002 REV 1840 780726 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * UPLIN * * SOURCE PART # 91740-18002 * * REL PART # 91740-16002 * * WRITTEN BY: CHUCK WHELAN * * DATE WRITTEN DEC 1976 * * MODIFIED FOR HP3000 BY DAVE TRIBBY, MARCH 1977 * *************************************************************** SPC 3 * * * EXTERNAL REFERENCES EXT EXEC,$LIBR,$LIBX EXT MESSS,$OPSY EXT #RSAX,#RPCV EXT RNRQ,#BUSY,#QRN,#LDEF EXT #GRPM,#LU3K,#QXCL,#TST SPC 3 * UPLIN FOR DS/1000 UPLIN IS SCHEDULED EVERY 5 SECONDS TO PERFORM * THE FOLLOWING FUNCTIONS: * 1. CHECKS/WAITS FOR SYSTEM QUIESCENCE. PRINTS OPERATOR MESSAGE * WHEN QUIESCENCE IS ACHIEVED. * 2. UPDATES SLAVE "TCB" TIMEOUT VALUES, AND IF A TRANSACTION HAS * TIMED OUT, THE TCB IS PURGED, AND IF THE MONITOR ABORT * FLAG IS SET, THE MONITOR IS ABORTED. * 3. AFTER PROCESSING EACH SLAVE TCB LIST, UPLIN CHECKS TO SEE IF * THE CORRESPONDING MONITOR IS DORMANT, AND IF SO, RESCHEDULES IT. * 4. UPDATES MASTER TCB TIMEOUT VALUES, AND IF A MASTER TCB TIMES-OUT, * IT CHECKS THE PROGRAM STATUS. IF DORMANT OR THE "BAD * CONTENTS" FLAG IN THE TCB IS SET, THE MASTER CLASS NUMBER * AND THE TCB ARE CLEARED. IF IN A "WAIT" STATE, IT WRITES * A NULL REQUEST TO THE MASTER REQUESTERS CLASS. * 5. SCANS THE HP3000 PROCESS NUMBER LIST AND SENDS A "KILL" * REQUEST FOR ABANDONED PROCESS NUMBERS. * 6. RESCHEDULES "GRPM","RTRY", OR "QCLM" IF THEY ARE DORMANT. * 7. CHECKS FOR ANY DOWNED COMMUNICATIONS EQTS, AND DOES "ENABLE * LISTEN" REQUESTS TO ANY FOUND. * * * EQTA EQU 1650B FWA OF EQUIPMENT TABLE DRT EQU 1652B FWA OF DEVICE REFERENCE TABLE LUMAX EQU 1653B NO OF LOGICAL UNITS (IN DRT) SKP UPLIN EQU * * * CHECK FOR SYSTEM QUIESCENCE * LDA GLCW GET GLOBAL RN LOCK/CLEAR COMMAND RAL,ARS SET THE NO-WAIT BIT QRNWT STA RNCW SAVE CONFIGURED CONTROL WORD * JSB RNRQ GO TO RTE TO REQUEST DEF *+4 RESOURCE NUMBER STATUS, DEF RNCW OR TO AWAIT CLEARING OF THE RN. DEF #QRN ADDR OF QUIESCENT RN DEF TEMP RETURN STATUS JMP SLVTS IGNORE ERRORS * LDA RNCW IF PROGRAM HAS BEEN AWAITING CPA GLCW THE CLEARING OF #QRN, THEN JMP SLVTS BYPASS THE MESSAGE CODE. * LDA TEMP QRN STATUS LDB #BUSY ACTIVE TCB COUNT CPA K7 IF QRN WAS LOCKED GLOBALLY, SZB AND NO ACTIVE TCB'S EXIST, SKIP JMP SLVTS ELSE BYPASS QUIESCENT CODE. * JSB EXEC INFORM DEF *+5 THE DEF K2 OPERATOR DEF K1 THAT THE DEF QMES SYSTEM DEF K10 IS QUIESCENT. * LDA GLCW RETURN TO IMMOBILIZE UPLIN JMP QRNWT SKP * * THIS SECTION PROCESSES SLAVE TRANSACTIONS & MONITORS * SLVTS LDA $OPSY RAR,SLA IS THIS AN RTE-III OR RTE-IV? RSSI RSS YES JMP SLVT2 NO LDB RSSI GET "RSS" STB MODI1 MODIFY TO DO CROSS-MAP STORE STB MODI2 MODIFY TO DO CROSS-MAP LOAD * SLVT2 LDA K2 ADA #LDEF STA LPNT PNTR TO SLAVE LIST HEADER ADDRS IN RES CLA STA STREM SET STREAM # CKLST LDB LPNT,I  GET ADDRESS OF HEADER INB STB MCLSA SAVE ADDR OF MONITOR CLASS # INB STB MSEGA ADDR OF MONITOR'S ID SEGMENT ADDR LDB 1,I GET ID SEG ADDR SZB,RSS DOES MONITOR EXIST? JMP NXLST NO LDB LPNT,I NXTCB STB LSTAD SAVE ADDR OF ADDR OF NEXT TCB * * ENTER HERE TO CHECK EACH SLAVE TCB * CKTCB LDB LSTAD PICK UP ADDR OF ADDR OF TCB JSB LODWD (CROSS)LOAD ADDR OF TCB SZA,RSS IS IT THERE? JMP CKMON NO, END OF THIS LIST JSB TSTCB BUMP TIMER IN TCB JMP NXTCB DIDN'T TIMEOUT, CHECK NEXT TCB SKP * * SLAVE TRANSACTION HAS TIMED OUT * ADB K2 COMPUTE ADDR OF SEQ # JSB LODWD (CROSS)LOAD 1ST TIME TAG WORD STA SEQ# * JSB #RSAX DELETE SLAVE TCB DEF *+4 DEF K7 DEF SEQ# SLAVE SEQ # DEF STREM STREAM * SSB SKIP IF ENTRY DELETED JMP NXLST WHOOPS! IGNORE THIS LIST * * CHECK FOR HP3000 TST CLEANUP LDA #LU3K IF NO REMOTE SZA,RSS HP3000, JMP CONT SKIP THIS SECTION LDX #TST+1 X-REG = NUMBER OF TST ENTRIES LDB #TST B-REG = POINTER INTO TST LOOP JSB LODWD (CROSS)LOAD 1ST TST WORD STB WRD1 INB SZA,RSS IF ZERO, JMP BUMP LOOK AT NEXT ENTRY. JSB LODWD (CROSS)LOAD 2ND TST WORD CPA SEQ# SEQUENCE NUMBER? JMP FOUND YES--DONE LOOKING. BUMP ADB K13 POINT TO NEXT TST ENTRY DSX DECREMENT COUNTER JMP LOOP IF NOT DONE, CHECK NEXT ENTRY JMP CONT LOOP FELL THROUGH--DONE * * ACTIVITY WAS INITIATED FROM HP3000 FOUND INB GET TST WORD 3 JSB LODWD (HOLDING CLASS) CCE,SZA,RSS ZERO? JMP RPC YES--PROCESS "RPCNV" RAL,ERA NO--SET BIT 15 TO STA PRAM1 DEALLOCATE CLASS JSB DEFLU , AND FLUSH BUFFER. CLA (CROSS) STORE ZERO LDB WRD1 IN TST WORD 1 JSB STRWD FOR RELEASE JMP CONT CONTINUE * RPC JSB EXEC TRY TO SCHEDULE RPCNV DEF *+4 WITH "REJECT" PASSWORD DEF K10N IN CASE IT IS WAITING DEF RPCNM TO BE RESCHEDULED FOR DEF SEQ# NEXT CONTINUATION REPLY. NOP * SZA,RSS WAS RPCNV DORMANT? JMP CONT YES, CONTINUE (RPCNV WILL RELEASE TST) * CLA NO, RPCNV NEEDS TO SEND A STA TEMP REJECT REPLY TO THE WAITING 3000. * JSB EXEC CLASS WRITE A 2-WORD DUMMY DEF *+8 REPLY TO RPCNV DEF K20N DEF ZBIT WORD 1 = 0 DEF DUMMY WORD2 = SEQ# DEF K0 (RPCNV WILL RELEASE TST ENTRY) DEF TEMP DEF K2 DEF #RPCV NOP * CONT EQU * CONTINUE * * CHECK MONITOR ABORT FLAG LDA MSEGA,I SSA,RSS SKIP IF SET JMP CKTCB NOT SET, DON'T ABORT IT, CHECK NEXT TCB * * ABORT THE MONITOR BY GENERATING AN "OF,(NAME),1" MESSAGE * RAL,CLE,ERA ISOLATE ID SEG ADDRESS ADA K12 ADDR OF NAME LDB FLDAD ADDRESS OF NAME FIELD MVW K2 MOVE 1ST 4 CHARS LDA 0,I GET 5TH AND B1774 CLEAR RHW IOR COMMA INCLUDE A COMMA STA MSNAM+2 * JSB MESSS CALL RTE MESSAGE PROCESSOR DEF *+3 DEF OFMES "OFF,XXXXX,1" DEF K12 SZA,RSS IF MSG. RETURNED, SKIP TO RESTORE CMD. JMP UPMON NOW GO & RESCHEDULE IT * DLD "OFF" DST OFMES RESTORE "OFF," LDA "1@" STA MSNAM+3 RESTORE ABORT OPTION PARAMETER (1). JMP UPMON GO TO RE-SCHEDULE THE MONITOR. * "OFF" ASC 2,OFF, "1@" ASC 1,1 * * THIS CODE CHECKS MONITOR STATUS TO SEE IF IT HAS ABORTED CKMON LDA MSEGA,I MONITORS ID SEGMENT ADDRESS RAL,CLE,ERA CLEABR OFF SIGN BIT SZA,RSS ADDR SPECIFIED? JMP NXLST NO ADA K12 POINT TO NAME LDB FLDAD MVW K3 MOVE NAME LDA 0,I GET STATUS BITS AND K15 ISOLATE STATUS BITS SZA SKIP IF DORMANT JMP NXLST ELSE MONITOR IS STILL GOING * * RESCHEDULE MONITOR UPMON LDA MCLSA,I GET CLASS NUMBER OF MONITOR RAL,CLE,ERA CLEAR SIGN BIT STA PRAM1 * JSB EXEC SCHEDULE MONITOR, PASS CLASS NUMBER DEF *+4 DEF K10N FLDAD DEF MSNAM ADDR OF MONITOR NAME DEF PRAM1 NOP * * DONE WITH THIS SLAVE LIST, START ON NEXT NXLST ISZ LPNT POINT TO NEXT LIST HEADER ADDRESS ISZ STREM BUMP STREAM NUMBER LDA STREM CPA K11 DONE? RSS YES JMP CKLST PROCESS NEXT LIST * * DONE WITH SLAVE MONITOR/TRANSACTION PROCESSING SKP * * PROCESS MASTER TCBS * LDB #LDEF ADDR OF LIST HEADER ADDRS INB LDB 1,I GET ADDR OF MASTER HEADER CKMST STB LSTAD SAVE ADDR OF NEXT TCB'S ADDR CKMS2 LDB LSTAD PICK-UP ADDR OF ADDR OF NEXT TCB JSB LODWD (CROSS)LOAD ADDR OF NEXT TCB SZA,RSS JMP PNLST NO MORE MASTER TCBS TO PROCESS * JSB TSTCB UPDATE THIS TCB'S TIME JMP CKMST DIDN'T TIME-OUT, DO NEXT TCB * * MASTER TCB HAS TIMED OUT * ADB K3 POINT TO 4TH WORD OF MASTER TCB JSB LODWD (CROSS)LOAD CLASS NUMBER IOR BIT15 CLASS # WITH "NO WAIT" BIT SET STA PRAM1 * INB POINT TO 5TH WORD OF MASTER TCB JSB LODWD (CROSS)LOAD ID SEGMENT ADDRESS RAL,CLE,SLA,ERA CLEAR OFF SIGN BIT JMP CREPT "BAD CONTENTS", CLR CLASS & TCB ADA K15 POINT TO STATUS LDA 0,I AND K15 ISOLATE STATUS SZA,RSS DORMANT? JMP CREPT YES, CLEAR IT ALL CPA K3 IS IT "WAIT" STATE&? RSS YES JMP NXMST NO * * WRITE A NULL REQUEST INTO THE MASTER REQUESTERS CLASS JSB EXEC DEF *+8 DEF K20N CLASS WRITE/READ, NO ABORT DEF ZBIT DEF DUMMY DEF K0 ZERO DATA LENGTH DEF DUMMY DEF K0 ZERO REQUEST LENGTH DEF PRAM1 CLASS NUMBER * K0 NOP * NXMST LDB XACTA GET ADDR OF NEXT TCB ADDR JMP CKMST GO CHECK FOR NEXT TCB * * MASTER REQUESTER IS DORMANT, CLEAR CLASS AND TCB * CREPT JSB DEFLU CLEAR CLASS LDB XACTA CLEAR MASTER REQUESTER'S TCB ADB K2 POINT TO SEQ # IN TCB JSB LODWD GET IT STA SEQ# JSB #RSAX CALL #RSAX TO PURGE MASTER TCB DEF *+3 DEF K6 DEF SEQ# SEQUENCE NUMBER OF MASTER TCB * SSB,RSS SKIP IF TCB NOT DELETED, IGNORE REST JMP CKMS2 CONTINUE WITH NEXT TCB ON CHAIN * SKP * * PROCESS THE HP3000 PROCESS NUMBER LIST. * PNLST CCB GET ADDR OF PNL HEADER. ADB #LDEF LDB 1,I * CKPNL JSB LODWD (CROSS)LOAD ADDR OF NEXT PNL ENTRY. SZA,RSS JMP RSCHD DONE WITH PNL ENTRIES. * LDB 0 STB XACTA SAVE ADDRESS OF NEXT TABLE ENTRY. ADB K2 POINT TO 3RD WORD OF PNL ENTRY. JSB LODWD (CROSS)LOAD PROCESS # STA KLBUF+4 SAVE FOR POSSIBLE "KILL". * ADB K2 POINT TO 5TH WORD OF PNL ENTRY. JSB LODWD (CROSS)LOAD ID SEG ADDR. SSA JMP KILL SEND "KILL" IF IDSEG IS BAD. ADA K15 POINT TO STATUS. LDA 0,I AND K15 ISOLATE STATUS. SZA,RSS DORMANT? JMP KILL YES. SEND "KILL". LDB XACTA NO. GO ON TO NEXT ENTRY. JMP CKPNL * * SEND A "KILL" REQUEST TO THE 3000 DIRECTLY THROUGH QUEX. * SINCE THE "FROM PROCESS #" IN THE REQUEST IS ZERO (NORMALLY THE * MASTER CLASS NUMBER), QUEX WILL SEND $STDLIST TO "CNSLM" AJND * IGNORE THE FINAL REPLY. * KILL LDA #QXCL I/O CLASS # FOR QUEX SZA,RSS IS HP3000 UP? JMP RSCHD NO. LEAVE PNL AS IS. SSA IS HP3000 DISCONNECTED? JMP RSCHD YES. LEAVE PNL AS IS. * JSB EXEC CLASS WRITE "KILL" REQUEST TO QUEX. DEF *+8 DEF K20N DEF K0 DEF KLBUF DEF K8 DEF K8 DEF K0 DEF #QXCL NOP IGNORE ERRORS. * JSB #RSAX DELETE PNL ENTRY. DEF *+3 DEF K10 CODE FOR "REMOVE". DEF KLBUF+4 SEQUENCE NUMBER. * * LDB XACTA RESTORE ADDR OF NEXT ENTRY. JMP CKPNL GO CHECK NEXT ENTRY. * KLBUF BYT 10,6 LENGTH,CLASS OCT 0 OCT 27 STREAM OCT 0,0,0,0,0 * SKP * * RESCHEDULE HP1000 AND/OR HP3000 MONITORS IF THEY ARE DORMANT * RSCHD LDA #LU3K IF NO HP3000 SZA,RSS CONNECTED, JMP RE1K GO RESCHEDULE HP1000 MONITORS. * * RESCHEDULE "QUEX", "RQCNV", OR "RPCNV" IF THEY ARE DORMANT * JSB SCHDL TRY TO SCHEDULE QUEX (IF DORMANT) ASC 3,QUEX JSB SCHDL TRY TO SCHEDULE RQCNV (IF DORMANT) ASC 3,RQCNV JSB SCHDL TRY TO SCHEDULE RPCNV (IF DORMANT) RPCNM ASC 3,RPCNV * LDA #GRPM IF NO HP1000 SZA,RSS CONNECTED, JMP EXIT ALL DONE! SPC 1 * * RESCHEDULE "GRPM", "RTRY", OR "QCLM" IF THEY ARE DORMANT * RE1K JSB SCHDL TRY TO SCHEDULE GRPM (IF DORMANT) ASC 3,GRPM JSB SCHDL TRY TO SCHEDULE RTRY (IF DORMANT) ASC 3,RTRY JSB SCHDL TRY TO SCHEDULE QCLM (IF DORMANT) ASC 3,QCLM * SKP * * CHECK FOR DOWNED COMMUNICATION LINES * LDA LUMAX NUMBER OF LOGICAL UNITS CMA,INA STA LCNT SET COUNTER LDA B101 STA LU MODE= 1 FOR "ENABLE LISTEN" LDA DRT ADDR OF DEVICE REFERENCE TABLE UPEQ2 STA LPNT LDWjA 0,I PICK-UP DRT ENTRY AND B77 ISOLATE EQT NUMBER ADA N1 MPY K15 REL.POS. IN EQT ADA EQTA POINT TO 1ST WORD OF EQT ADA K4 ADDR OF EQT5 LDB 0 LDA 0,I CONTENTS OF EQT 5 ALF,ALF AND B77 ISOLATE EQUIPMENT TYPE CODE CPA B65 DVR65? JMP UPEQ4 YES, SEE IF IT'S UP * UPEQ3 ISZ LU BUMP LU IN CONTROL WORD LDA LPNT INA INCREMENT DRT POINTER ISZ LCNT JMP UPEQ2 PROCESS NEXT DRT ENTRY * * ALL LU'S HAVE BEEN CHECKED, EXIT UPLIN * EXIT JSB EXEC DEF *+2 DEF K6 * * PROCESS COMMUNICATIONS EQT * UPEQ4 ADB K7 POINT TO EQT12 LDA 1,I GET EQT12 AND BMSKS ISOLATE "BROKEN LINE" & "LISTEN" FLAGS ALF,ALF RAL,CLE,ELA E= BROKEN LINE FLAG SEZ BROKEN LINE? JMP UPEQ5 YES SZA LISTEN ENABLED? JMP UPEQ3 YES, OK ADB N1 POINT TO EQT11 LDA 1,I GET EQT11 SZA,RSS HAS THIS EQT BEEN INITIALIZED? JMP UPEQ3 NO * * ISSUE AN "ENABLE LISTEN" REQUEST UPEQ6 JSB EXEC DEF *+3 DEF K3N DEF LU CONTROL MODE = 1 NOP JMP UPEQ3 * * CHECK TO SEE IF BROKEN LINE JUST OCCURRED * UPEQ5 STB TEMP SAVE EQT12'S ADDRESS * JSB $LIBR GO PRIVILEGED NOP LDA TEMP,I GET EQT12 AND B6MSK CLEAR "BROKEN LINE" FLAG STA TEMP,I JSB $LIBX GO UNPRIVILEGED DEF *+1 DEF *+1 JMP UPEQ6 SKP * SUBROUTINES SPC 2 * THIS ROUTINE BUMPS THE TIMEOUT IN A TCB * TSTCB NOP LDB 0 STB XACTA SAVE ADDRESS OF THIS TRANSACTION INB POINT TO 2ND WORD OF TCB JSB LODWD (CROSS)LOAD TIMER SSA JMP TSTC1+1 TIMEOUT ALREADY RESET AND FLMSK SAVE FLAG BITS (14-8) STA FLBYT * LDA STREM GET STREAM CPA K3 SLAVE EXECW REQUEST? JMP LONGT YES, SET LONG TIMEOUT CPA K8 SLAVE LOADM REQUEST? JMP LONGT YES, SET LONG TIMEOUT CPA K11 MASTER TCB? RSS YES JMP TSTC1 NO, JUST DO A TICK ADB K2 JSB LODWD GET CLASS WD/ TIMEOUT FLAG ADB N2 SSA,RSS LONG TIMEOUT FOR THIS TCB? JMP TSTC1 NO, JUST DO A TICK * LONGT LDA LTIME 20 MINUTE TIMEOUT IOR FLBYT RESTORE FLAG BITS (14-8) JMP TSTC2 * TSTC1 JSB LODWD RELOAD TIMER AND B377 ISOLATE IT CPA B377 IS IT ABOUT TO ROLL OVER? JMP TSTC5 YES, DON'T BUMP IT, RETURN + 2 * JSB LODWD (CROSS)LOAD TIMER AGAIN INA BUMP TIMER TSTC2 JSB STRWD (CROSS)STORE RSS RETURN +1 FOR NOT TIMED-OUT TSTC5 ISZ TSTCB RETURN +2 FOR TCB TIMED-OUT LDB XACTA TCB ADDR INTO B REG JMP TSTCB,I RETURN SPC 3 * SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV) * LODWD NOP MODI2 LDA 1,I GET WORD FROM TCB (RSS IF DMS SYSTEM) JMP LODWD,I RETURN IF RTE-II XLA 1,I LOAD WORD FROM ALTERNATE MAP JMP LODWD,I SPC 3 * SUBROUTINE TO STORE A WORD IN ALTERNATE MAP (IF RTE-III OR IV) * STRWD NOP JSB $LIBR LOWER FENCE NOP MODI1 NOP RSS HERE IF DMS SYSTEM JMP TSTC3 XSA 1,I STORE INTO SYSTEM MAPPED LOCATION RSS * BELOW INSTRUCTION IS EXECUTED FOR NON-DMS SYSTEMS ONLY TSTC3 STA 1,I STORE UPDATED TIMER IN TCB JSB $LIBX RAISE FENCE DEF STRWD RETURN SPC 3 * SUBROUTINE TO DEALLOCATE AND FLUSH AN I/O CLASS * DEFLU NOP CCA SET THE RELEASE RE-TRY SWITCH STA TEMP TO -1 * CLRTN JSB EXEC GO TO RTE TO RELEASE CLASS NUMBER DEF *+5 DEF K21N CLASS GET/NO ABORT DEF PR<:6AM1 MASTER CLASS/RELEASE/NO WAIT DEF K0 DEF K0 RSS IGNORE ERRORS ISZ TEMP RELEASE PROCESSING COMPLETED? JMP DEFLU,I YES. RETURN. INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP DEFLU+1 NO. CONTINUE TO CLEAR REQUESTS * LDA PRAM1 GET THE CLASS NUMBER AGAIN AND CLMSK EXCLUDE THE NO-DE-ALLOCATION BIT(#13) STA PRAM1 RESTORE THE MODIFIED CLASS WORD JMP CLRTN RETURN FOR FINAL DE-ALLOCATION SPC 3 * SUBROUTINE TO SCHEDULE A PROGRAM (IF DORMANT) * SCHDL NOP JSB EXEC SCHEDULE DEF *+4 DEF K10N DEF SCHDL,I DEF K0 PRAM TO KEEP RPCNV HAPPY NOP LDA SCHDL SET RETURN ADA K3 ADDRESS JMP 0,I RETURN SKP * DATA AREA * PRAM1 NOP LU NOP RNCW NOP LPNT NOP LCNT NOP STREM NOP XACTA NOP LSTAD NOP MCLSA NOP MSEGA NOP TEMP DEC 0,0 WRD1 NOP SEQ# EQU TEMP+1 DUMMY NOP * K1 DEC 1 K2 DEC 2 K3 DEC 3 K4 DEC 4 K6 DEC 6 K7 DEC 7 K8 DEC 8 K10 DEC 10 K11 DEC 11 K12 DEC 12 K13 DEC 13 K15 DEC 15 B65 OCT 65 B77 OCT 77 COMMA OCT 54 B101 OCT 101 B377 OCT 377 BMSKS OCT 2100 FLMSK OCT 077400 ZBIT OCT 10000 BIT15 OCT 100000 LTIME OCT 100020 K3N OCT 100003 K10N OCT 100012 K20N OCT 100024 K21N OCT 100025 GLCW OCT 40006 GLOBAL RN LOCK/CLEAR - NO ABORT B1774 OCT 177400 CLMSK OCT 157777 B6MSK OCT 177677 N1 DEC -1 N2 DEC -2 * FLBYT NOP * OFMES ASC 2,OFF, MSNAM BSS 3 ASC 1,1 * QMES ASC 10, SYSTEM IS QUIESCENT * END UPLIN &<  91740-18003 1740 S C0122 DS/1000 MODULE: RFAM              H0101 _3ASMB,L,R,C HED RFAM2 * SINGLE DCB - RFA MONITOR * (C) HEWLETT-PACKARD CO. 1977 NAM RFAM,19,30 91740-16003 REV 1740 771019 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * SINGLE DCB VERSION OF RFA MONITOR * * SOURCE PART # 91740-18003 REV 1740 * * REL PART # 91740-16003 REV 1740 * * WRITTEN BY: CHUCK WHELAN * * DATE WRITTEN: DEC 1976 * * MODIFIED BY: * * DATE MODIFIED: * *************************************************************** SPC 2 EXT EXEC,D65GT,D65SV EXT APOSN,CLOSE,FCONT,CREAT,LOCF,NAMF EXT OPEN,POSNT,PURGE,READF,FSTAT,RWNDF EXT WRITF,#NODE SUP * BUFSZ EQU 128 MAXIMUM DATA BUFFER * SPC 3 ICLAS NOP RFAM2 LDA B,I GET THE CLASS STA ICLAS HED RFAM: ACTIVATOR * (C) HEWLETT-PACKARD CO. 1977 * * WE COME HERE INITIALLY AND EACH TIME A REQUEST HAS BEEN PROCESSED. * GO JSB D65GT WAIT FOR A REQUEST TO COME DEF *+6 DEF ICLAS CLASS # DEF REQST BUFFER DEF D14 MAXIMUM LENGTH OF THE INCOMING BUFFER DTBFA DEF DTBFR DATA BUFFER ADDRESS DEF BUFLN MAXIMUM DATA LENGTH JMP ERR53 MUST BE A LENGTH ERROR * STA RQLN SAVE THE REQUEST LENGTH LDA REQST+4 GET THE FUNCTION CODE SSA CHECK FOR VALIDITY JMP ERR25 <0, NO GOOD ADA DM14 CHECK UPPER BOUND SSA,RSS JMP ERR25 >13, NO GOOD EITHER * * SINCE FUNCTION CODE LOOKS OK}, WE USE IT AS INDEX IN A TABLE * TO GO TO THE PROPER PREPROCESSING. * CLA STA IERR LDA REQST+4 GET FCODE AGAIN ADA JSBTB LDA 0,I STA CALLI SET UP "JSB" ADR LDA REQST+4 ADA BRNCH ADD TO THE BEGINNING OF THE BRANCH TABLE JMP A,I GO EXECUTE THE PREPROCESSING HED RFAM: ORIENTATION * (C) HEWLETT-PACKARD CO. 1977 * * * WE WILL TRY TO DESCRIBE HERE THE FLOW OF OPERATIONS * IN THIS PROGRAM. * * * * 1. EACH REQUEST IS PROCESSED IN 4 PHASES: * - PREPROCESS * - FMP CALL BUILDING * - EXECUTION OF THE FMP CALL * - POSTPROCESS * * THE CHOICE OF THE PROCESSOR IS MADE EACH TIME BY USING * THE REQUEST CODE AS AN INDEX IN A BRANCH TABLE. * * * 2. PREPROCESSING * THE READER SHOULD FIND IN THE PREPROCESSING BRANCH TABLE * (BRNCH) THE LABEL AT WHICH THE CURRENT PREPROCESS WILL START. * * * * 3. FMP CALL FORMATING. * THE TABLE WE WILL USE TO SELECT A PROCESSOR IS BLDTB. * IN THIS PART WE ONLY SET THE ADDRESSES OF THE PARAMETERS * IN THE CALL BUFFER. * * * 4. POSTPROCESSING * ON COMPLETION OF THE FMP CALL WE GO TO "DONE" WHERE THE * SELECTION OF THE PREPROCESSOR IS DONE THROUGH THE TABLE * PSTBL. * * PST05 USED FOR DNAME AND DPURG * IF THE FILE WAS OPEN BEFORE THE FMP CALL AND THE CALL * WAS EXECUTED WITHOUT ERROR, THE CURRENT RFAMD ENTRY * IS DELETED. * * PST04 USED FOR DCRET * IF THE ICR WAS NOT SPECIFIED IN THIS REQUEST, SET THE * PROPER CRN VALUE IN THE RFAMD ENTRY. * IN ANY CASE, FIND THE RFAMD ENTRY # AND PASS IT TO * THE USER. * * PST00 USED FOR DSTAT * SET THE DATA LENGTH TO 125 WORDS. * * PST02 USED FOR DREAD * SET THE DATA LENGTH * * PST03 USED FOR DOPEN * IF THE ICR WAS SPECIFIED IN THE REQUEST, THE RFAMD * ENTRY # IS SET IN THE REQST, AND THE REPLY IS SENT. * IF THE ICR WAS NOT SPECIFIED IN THE REQUEST, THE * LEGALITY OF THIS OPEN IS CHECKED, AND EITHER: * - REJECTED (ERR -08) THE TYPE OF THE OPEN MAY HAVE * BE RESTORED * - ACCEPTED, THE CRN IS SET IN THE RFAMD ENTRY AND THE ENTRY * NUMBER IS SET IN THE REQST. * THE REPLY IS SENT. * * * 5. IF THE OPERATION WAS A SUCCESSFUL CLOSE, THE CURRENT RFAMD * ENTRY IS DELETED. * * * * HED RFAM: PREPROCESSING * (C) HEWLETT-PACKARD CO. 1977 SPC 3 * * HERE ON A "DCRET" BRN3 LDA %NAME CURRENT DCB ID SZA IS ENTRY AVAILABLE? JMP ERR28 NO, GIVE ERROR -28 * BRN31 LDB FNAMA LDA NAMA MVW D5 SET UP CURRENT ENTRY: NAME, CRN, ID SEG LDA REQST+2 GET ORIGINATOR'S NODE STA %NODE & SAVE IN LOCAL ENTRY JMP BUILD CURRENT ENTRY IS ALL SET! SPC 3 * * HERE ON A DOPEN * BRN4 JSB CKENT SET CRN, CHECK NAME, NODE, AND ID JMP BRN31 OK OR CURRENT ENTRY IS EMPTY SPC 3 * * PROCESSOR FOR FLUSH * BRN6 LDB FNAMA LDA NAMA CMW D3 COMPARE NAME WITH CURRENT ENTRY JMP *+3 MATCHES NOP JMP ERR11 DOESN'T MATCH, GIVE DCB NOT OPEN * LDB REQST+9 CPB DM1 CLOSE ALL? JMP BUILD YES, DO IT CPB %NODE IS IT THE ASSIGNED NODE? JMP BUILD YES, FLUSH IT JMP ERR11 NO, GIVE DCB NOT OPEN SPC 3 * * HERE FOR DPURG AND DNAME * BRN8 JSB CKENT CHECK NAME, NODE, AND ID STA TMPAD VALUE=0 IF NO CURRENT ENTRY JMP BUILD OK TO PROCEED SPC 3 * * * HERE FOR DSTAT. THIS IS A SPECIAL CALL, IT DOES NOT * NEED ANY DCB. SPECIAL TREATMENT. * BRN10 JSB FSTAT DEF *+2 DEF DTBFR STATUS BUFFER * LDB D125 SET THE LENGTH OF THE JMP REPLY+1 DATA BUFFER & RETURN SPC 3 * * ENTER HERE FOR FUNCTIONS WHICH MUST ALREADY HAVE OPEN DCB * BRN1 LDB %NAME LDA REQST+6 CPA %SEQ IS IT CORRECT ENTRY NUMBER? SZB,RSS YES, IS ENTRY STILL OPEN? JMP ERR26 ANSWER TO EITHER IS NO, GIVE -26 SKP SPC 3 * HERE WE BRANCH TO THE PROPER CALL SETUP ROUTINE. * BUILD LDA DCBA STA LDCB INITIALIZE DCB ADDR IN CALL LDA NAMA STA LDCB+2 INITIALIZE ADDR OF FILE NAME ADA D6 STA LDCB+3 INITIALIZE ADDR OF SIZE/OPTNL PARAM LDB PARAM GET ADDR OF PARAMETER DESTINATION LDA REQST+4 GET FCODE AGAIN ADA BLDTB MAP IN "BUILD" TABLE JMP A,I GO PREPARE THE CALL TO FMP * SPC 3 * * CALL BUILDER FOR DWRIT * BLD12 LDA DTBFA STA LDCB+2 SET BUFFER ADDRESS IN CALL INB SPC 3 * * CALL BUILDER FOR DAPOS,DCLOS,DCONT,DPOSN,DWIND,FLUSH * BLD0 LDA RQLN REQUEST LENGTH ADA DM7 COMPUTE # OF PARAMETERS + 1 CAX LDA LENA =REQST+7 * BLDCM DSX DECREMENT COUNT INA,RSS JMP BLD01 DONE MOVING PARAMETER "DEF"S * BLDC2 STA 1,I STORE "DEF" IN CALL SEQUENCE INB JMP BLDCM ITERATE SPC 3 * * CALL BUILDER FOR DCRET * BLD3 LDA TYPEA ADDR OF TYPE STA LDCB+4 * LDB D3 * * THE FOLLOWING PART IS COMMON TO DCRET, DNAME,DOPEN * AND DPURG, IT SETS THE SECURITY CODE AND THE CRN IN THE CALL * BLD31 ADB PARAM COMPUTE ADDR WITHIN CALL LDA SECUA GET ADDRESS OF ISECU STA B,I SET IT IN THE CALL LDA CRA GET ADDRESS OF ICR INB STEP TO NEXT PARAM IN CALL STA B,I SET IT IN THE CALL LDA A,I GET CRN SZA PRESENT ? INB YES, PUSH B TO NEXT JMP BLD01 DONE HERE, GO COMPLETE AND CALL SPC 3 * * CALL BUILDER FOR DLOCF * BLD4 LDX D7 SET COUNTER LDA LENA PARAMETERS START AT REQST+7 JMP BLDC2 GO SET-UP "DEF"S TO PARAMETERS SPC 3 * * CALL BUILDER FOR DNAME * BLD5 LDB D2 LDA TMPAD WAS THE FILE ALREADY OPEN ? SZA JMP BLD31 YES, DCB ADDRESS ALREADY SET JMP BLD81 NO, USE DATA BUFFER AS DCB SPACE. SPC 3 * * CALL BUILDER FOR DOPEN * * BLD6 CLB SET "FILE NOT OPEN" STB %DCB+9 STATUS * LDB D2 JMP BLD31 GO COMPLETE THE CALL SPC 3 * * CALL BUILDER FOR DPURG * BLD8 LDA NAMA GET FILE NAME ADDRESS STA LDCB+2 SET IT IN CALL CLB,INB BLD81 LDA DTBFA GET THE ADDRESS OF THE DATA BUFFER STA LDCB USE IT AS THE DCB ADDRESS FOR THIS CALL JMP BLD31 GO COMPLETE SPC 3 * * CALL BUILDER FOR DREAD * BLD9 LDA REQST+8 REQUESTED DREAD LENGTH CMA,INA ADA BUFLN BUFFER SIZE - REQUESTED LENGTH SSA BUFFER EXCEEDED? JMP ERR53 YES, GIVE LENGTH ERROR LDA DTBFA GET ADDRESS OF DATA BUFFER STA LDCB+2 SET IT IN CALL CLB STB REQST+7 PRE-INITIALIZE RETURNED LENGTH LDA CRA GET ADDRESS OF REQUEST LENGTH LDB LENA ALWAYS PASS LEN BACK. GET ITS ADDR DST LDCB+3 INA LDB A,I GET NUM SZB,RSS PRESENT ? JMP BLD91 NO STA LDCB+5 YES, SET IN CALL CLB,INB GET A 1 BLD91 ADB PARAM FIND RETURN ADDRESS ADB D3 * * WRAP-UP PREPROCESSING * BLD01 STB CALL+1 SET THE RETURN ADDRESS CLA STA 1,I CLEAN OUT REST OF CALL INB CPB RTN MORE? JMP CALL NO, GO EXECUTE FMGR CALL JMP *-4 YES HED RFAM: POSTPROCESSING * (C) HEWLETT-PACKARD CO. 1977 * * POSTPROCESS FOR DNAME AND DPURG * PST05 CLB CPB TMPAD WAS IT AN ALREADY OPEN FILE ? JMP REPLY NO LDA IERR GET COMPLETION CODE dSSA,RSS ERROR ? STB %NAME NO, DELETE THE OLD ENTRY JMP REPLY SEND THE REPLY SPC 2 * * POSTPROCESS FOR DCRET AND DOPEN * PST04 LDA IERR SSA ANY ERROR ? JMP CLENT YES, JUST CLEAR OUT CURRENT ENTRY * LDA REQST+8 GET ICR SZA SPECIFIED ? JMP PST41 YES * LDA %DCB NO, GET 1ST WORD OF DCB AND B77 GET DISC LU CMA,INA STA REQST+8 REPLACE IN THE REQST PST41 JSB LUCR TRANSFORM INTO CRN STB %CRN SET IT * ISZ %SEQ BUMP CURRENT SEQUENCE NUMBER NOP LDA %SEQ STA REQST+7 SAVE IT IN REQUEST JMP REPLY SPC 2 * * WE COME HERE AFTER A DREAD * PST02 LDB REQST+7 GET LENGTH OF DATA SSB SKIP IF NOT EOF CLB ELSE DO ZERO LENGTH XFER JMP REPLY+1 SPC 2 * * POST PROCESS FOR FLUSH * PST08 CLA,INA ONE FLUSHED ENTRY STA IERR SET AS COMPLETION CODE * CLENT CLB STB %NAME CLEAN OUT CURRENT ENTRY HED RFAM: SEND REPLY * (C) HEWLETT-PACKARD CO. 1977 * * POST-PROCESSING COMPLETED, SET-UP TO SEND REPLY * REPLY CLB SET FOR NO DATA RETURNED STB LENGT LDA #NODE GET LOCAL NODE # STA REQST+6 SET AS COMPLETION LOCATION LDA IERR SET THE COMPLETION CODE STA REQST+5 IN THE REQST LDA REQST GET THE STREAM TYPE IOR BIT14 SET THE REPLY BIT STA REQST REPLACE * LDA REQST+4 GET THE ICODE ADA LNTBL INDEX IN THE REPLY LENGTH TABLE LDA A,I GET THE LENGTH STA RQLN SET THE LENGTH * * THE REPLY REQST IS READY, SEND IT BACK * JSB D65SV DEF *+5 DEF REQST DEF RQLN REQST LENGTH DEF DTBFR DATA BUFFER DEF LENGT LENGTH * NOP IGNORE THE ERROR RETURN FROM D65SV * * IF THE OPERATION WASe A DCLOS, AND IT WORKED PROPERLY, WE * HAVE TO DELETE THE RFAMD ENTRY. * LDA REQST+4 GET OPCODE FOR THE LAST TIME CPA D1 DCLOS ? CLB,RSS JMP PST06 * * LDA IERR GET COMPLETION CODE SSA,RSS ERROR ? STB %NAME NO, CLEAR OUT CURRENT ENTRY * PST06 LDX DM9 GET A COUNTER CLB GET A 0 PST07 SBX REQST+14 CLEAN THE OPTIONAL AREA ISX JMP PST07 CONTINUE JMP GO GET NEXT REQUEST. HED RFAM: UTILITY ROUTINES * (C) HEWLETT-PACKARD CO. 1977 * * THIS ROUTINE CHECKS FILE NAME, CARTRIDGE REFERENCE, NODE, AND * ID SEGMENT ADDRESS IN THE NEW REQUEST AND RETURNS IF THEY * MATCH THE CURRENT ENTRY * CKENT NOP JSB LUCR CONVERT POSSIBLE LU TO CRN LDA %NAME SZA,RSS CURRENT ENTRY AVAILABLE JMP CKENT,I YES LDA REQST+2 CPA %NODE NODES MATCH? RSS YES JMP ERR28 NO, GIVE NO TABLE SPACE ERROR? SZB,RSS WAS CRN SPECIFIED LDB %CRN NO, USE CURRENT ENTRY'S CRN STB REQST+8 LDB FNAMA LDA NAMA CMW D5 COMPARE NAME,CRN, & ID SEGMENT ADDRS JMP CKENT,I MATCHED OK NOP JMP ERR28 DOESN'T MATCH, GIVE NO TABLE SPACE ERROR * * THIS ROUTINE WILL TRANSFORM A NEGATIVE DISC LU * INTO A CARTRIDGE NUMBER. BOTH INPUT AND RESULTS * ARE PASSED VIA REQST+8. THE RESULT WILL ALSO BE * FOUND IN B REGISTER. IF AN ERROR IS DISCOVERED * WE WILL DIRECTLY JUMP TO THE ERROR ROUTINE. * LUCR NOP LDB REQST+8 SSB,RSS IS IT AN LU? JMP LUCR,I NO * CMB,INB YES, MAKE IT POSITIVE AND STB DTBFR SET UP STATUS CALL. * JSB EXEC GET EQUIPMENT-TYPE CODE DEF *+4 DEF D13I DEF DTBFR USE DTBFR FOR CONWD DEF DTBFR+1 AND EQT5. JMP ERR06 ILLEGAL LU * LDA DTBFR+1 GET EQT5 ALF,ALJF AND B77 ISOLATE EQUIP-TYPE CODE LDB REQST+8 IF DVR05 (CTU SYSTEM), CPA D5 RETURN WITH JMP LUCR,I B = -LU. * JSB FSTAT GET INFO ON THE CURRENTLY DEF *+2 MOUNTED CARTRIGES. DBFAD DEF DTBFR SEND THE INFO IN THE DATA BUFFER * LDA DBFAD DCB BUFFER ADDR LP84 LDB 0,I GET W1 OF ENTRY CMB,INB CPB REQST+8 IS IT OUR LU? JMP FND84 YES SZB,RSS END OF TABLE ? JMP ERR06 YES, ILLEGAL DISC LU ADA D4 PUSH THE ADDR TO THE NEXT ENTRY JMP LP84 CONTINUE * FND84 ADA D2 STEP TO THE CRN LDB 0,I GET IT STB REQST+8 SET IT IN THE REQST JMP LUCR,I SPC 3 * * THIS IS THE SKELETON OF THE FMP CALL * PARAM DEF LDCB+2 DEF LDCB CALL JSB CALLI,I CALL FMP ROUTINE NOP DEF RTRN LDCB DEF %DCB ADDRESS OF DCB IF ANY DEF IERR ERROR REP 8 NOP * DONE LDA REQST+4 GET FCODE ADA PSTBL POST-PROCESSING TABLE JMP 0,I JUMP TO POST-PROCESSOR RTN DEF DONE * CALLI NOP ADR OF FMP CALL SPC 3 ERR06 JSB ERRXX DEC -6 ERR11 JSB ERRXX DEC -11 ERR25 JSB ERRXX DEC -25 ERR26 JSB ERRXX DEC -26 ERR28 JSB ERRXX DEC -28 ERR53 JSB ERRXX DEC -53 * ERRXX NOP LDA ERRXX,I STA IERR SET THE ERROR CODE IN THE REPLY JMP REPLY AND SHIP IT. SPC 3 HED RFAM: DATA AREA * (C) HEWLETT-PACKARD CO. 1977 A EQU 0 B EQU 1 SPC 2 **** DEFINE CURRENT OPEN RFAM ENTRY **** %NAME DEC 0,0,0 %CRN NOP %IDSG NOP %NODE NOP %SEQ NOP **** END OF CURRENT ENTRY **** SPC 2 DM14 DEC -14 DM9 DEC -9 DM7 DEC -7 DM1 DEC -1 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D13I OCT 100015 D125 DEC 125 BUFLN ABS BUFSZ BIT14 OCT 40000 B77 OCT 77 v FNAMA DEF %NAME NAMA DEF REQST+5 ADDR OF THE FILE NAME LENA DEF REQST+7 ADDR OF LENGTH CRA DEF REQST+8 ADDR OF THE ICR SECUA DEF REQST+10 ADDR OF ISECU TYPEA DEF REQST+13 ADDR OF TYPE DCBA DEF %DCB * * VARIABLES LENGT NOP IERR NOP TMPAD NOP RQLN NOP REQUEST LENGTH HED RFAM: TABLES * (C) HEWLETT-PACKARD CO. 1977 BRNCH DEF *+1,I DEF BRN1 DAPOS DEF BRN1 DCLOS DEF BRN1 DCONT DEF BRN3 DCRET DEF BRN1 DLOCF DEF BRN8 DNAME DEF BRN4 DOPEN DEF BRN1 DPOSN DEF BRN8 DPURG DEF BRN1 DREAD DEF BRN10 DSTAT DEF BRN1 DWIND DEF BRN1 DWRIT DEF BRN6 FLUSH * JSBTB DEF *+1 DEF APOSN DEF CLOSE DEF FCONT DEF CREAT DEF LOCF DEF NAMF DEF OPEN DEF POSNT DEF PURGE DEF READF NOP DEF RWNDF DEF WRITF DEF CLOSE FLUSH * BLDTB DEF *+1,I CALL BUILDING TABLE DEF BLD0 DAPOS DEF BLD0 DCLOS DEF BLD0 DCONT DEF BLD3 DCRET DEF BLD4 DLOCF DEF BLD5 DNAME DEF BLD6 DOPEN DEF BLD0 DPOSN DEF BLD8 DPURG DEF BLD9 DREAD NOP DEF BLD0 DWIND DEF BLD12 DWRIT DEF BLD0 FLUSH * SPC 3 LNTBL DEF *+1 REPLY LENGTH TABLE D7 DEC 7 DAPOS DEC 7 DCLOS DEC 7 DCONT DEC 8 DCRET D14 DEC 14 DLOCF DEC 7 DNAME DEC 8 DOPEN DEC 7 DPOSN DEC 7 DPURG DEC 8 DREAD DEC 7 DSTAT DEC 7 DWIND DEC 7 DWRIT DEC 7 FLUSH SPC 3 PSTBL DEF *+1,I POST PROCESSING TABLE DEF REPLY DAPOS DEF REPLY DCLOS DE <:6F REPLY DCONT DEF PST04 DCRET DEF REPLY DLOCF DEF PST05 DNAME DEF PST04 DOPEN DEF REPLY DPOSN DEF PST05 DPURG DEF PST02 DREAD NOP DEF REPLY DWIND DEF REPLY DWRIT DEF PST08 FLUSH HED RFAM: BUFFERS * (C) HEWLET-PACKARD CO. 1977 REQST REP 14 NOP * DTBFR BSS BUFSZ %DCB BSS 144 * SIZE EQU * * END RFAM2 M<  91740-18004 1740 S C0322 DS/1000 MODULE: RFAM              H0103 b5ASMB,L,R,C HED RFAM 91740-16004 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 NAM RFAM,19,30 91740-16004 REV 1740 771019 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * RFAM RFA MONITOR * * SOURCE PART # 91740-18004 REV 1740 * * REL PART # 91740-16004 REV 1740 * * WRITTEN BY: JEAN-PIERRE BAUDOUIN * * DATE WRITTEN: JUNE 1976 * * MODIFIED BY: CHUCK WHELAN * * DATE MODIFIED: OCTOBER 1976 * *************************************************************** SPC 2 EXT EXEC,D65GT,D65SV EXT APOSN,CLOSE,FCONT,CREAT,LOCF,NAMF EXT OPEN,POSNT,PURGE,READF,FSTAT,RWNDF EXT WRITF,#NODE,#RFSZ EXT $LIBR,$LIBX,$CVT3,$OPSY IFZ EXT DBUG XIF SUP SPC 3 ICLAS NOP RFAM2 LDA B,I GET THE CLASS STA ICLAS * IFZ CPA D99 DO THEY WANT DBUG ? RSS YES JMP INIT NO, NORMAL FLOW * JSB DBUG DEF *+1 * JSB EXEC NOW THAT DBUG HAS BEEN CALLED DEF *+4 TERMINATE AND SAVE RESOURCES DEF D6 DEF D0 DEF D1 * JMP RFAM2 GO BACK TO START XIF * JMP INIT GO EXECUTE THE INITIALIZATION PHASE SPC 3 HED RFAM: ACTIVATOR * (C) HEWLETT-PACKARD CO. 1977 * * WE COME HERE THE FIRST TIME WHEN THE INITIALIZATION IS COMPLETED * WE COME BACK HERE EACH TIME A REQUEST HAS BEEN PROCESSED. * AS USUAL, WE HANG ON A CLASS WAITING FOR A REQUEST TO COME. * [k THE CLASS HAS BEEN PASSED TO US BY LSTEN AT SYSON TIME. * GO JSB D65GT WAIT FOR A REQUEST TO COME DEF *+6 DEF ICLAS CLASS # BPARM DEF PARMB BUFFER DEF D14 MAXIMUM LENGTH OF THE INCOMING BUFFER DTBFA DEF DTBFR DATA BUFFER ADDRESS DEF D512 MAXIMUM DATA LENGTH JMP GO IGNORE ERROR RETURN * STA RQLN SAVE THE REQUEST LENGTH LDA PARMB+4 GET THE FUNCTION CODE SSA CHECK FOR VALIDITY JMP ERR25 <0, NO GOOD ADA DM14 CHECK UPPER BOUND SSA,RSS JMP ERR25 >13, NO GOOD EITHER * * SINCE FUNCTION CODE LOOKS OK, WE USE IT AS INDEX IN A TABLE * TO GO TO THE PROPER PREPROCESSING. * LDA PARMB+4 GET FCODE AGAIN ADA BRNCH ADD TO THE BEGINNING OF THE BRANCH TABLE JMP A,I GO EXECUTE THE PREPROCESSING HED RFAM: ORIENTATION * (C) HEWLETT-PACKARD CO. 1977 * * * WE WILL TRY TO DESCRIBE HERE THE FLOW OF OPERATIONS * IN THIS PROGRAM. * * * * 1. EACH REQUEST IS PROCESSED IN 4 PHASES: * - PREPROCESS * - FMP CALL BUILDING * - EXECUTION OF THE FMP CALL * - POSTPROCESS * * THE CHOICE OF THE PROCESSOR IS MADE EACH TIME BY USING * THE REQUEST CODE AS AN INDEX IN A BRANCH TABLE. * * * 2. PREPROCESSING * THE READER SHOULD FIND IN THE PREPROCESSING BRANCH TABLE * (BRNCH) THE LABEL AT WHICH THE CURRENT PREPROCESS WILL START. * HERE IS A DESCRIPTION OF THESE PREPROCESSES. * * BRN2 USED BY DCLOS * SCAN THE RFAMD TABLE FOR OTHER USERS OF THIS FILE. * ONLY USER ? * - YES => BRN9, GET READY FOR A REAL FILE CLOSE. * - NO => BRN7, FAKE A CLOSE, SEND THE REPLY. * * BRN8 USED FOR DPURG AND DNAME * SCAN THE RFAMD LIST FOR USERS OF THIS FILE. * - FILE NOT CURRENTLY USED => BRN5, PREPARE THE FMP CALL * - FILE CURRENTLY USED, BUT ONLY BY US => BRN9, GET * l CURRENT DCB, THEN BUILD THE CALL. * - FILE CURRENTLY USED BY SOMEONE ELSE, RESTORE THE * TYPE OF THE OPEN IF NECESSARY (WE MIGHT HAVE HAD TO * OPEN THE FILE TO LOCATE IT IF ICR WAS NOT SPECIFIED) * THEN REJECT THE REQUEST (ERR -08) * * BRN4 USED ONLY BY DOPEN * IS ICR SPECIFIED ? * - YES, CHECK THE LEGALITY OF THIS OPEN (BRN41) * REJECT (ERR -08) IF ILLEGAL. * - NO, SKIP THE CHECKING, IT WILL BE DONE LATER. * => BRN3 * * BRN3 USED BY DCRET * GET A DCB SPACE IN CORE. SWAP AN OLD DCB IF NECESSARY. * GET AN RFAMD ENTRY, LINK IT TO THE LIST AND FORMAT IT. * * BRN1 USED BY DAPOS, DCONT, DLOCF, DPOSN, DREAD, DWIND * AND DWRIT. * THE RFAMD ENTRY # PASSED IN THE PARMB IS CHECKED FOR * FOR VALIDITY. * THE ENTRY IS LOCATED. * THE DCB IS BROUGHT TO CORE IF CURRENTLY ON DISC. * THE RFAMD IS RELINKED: * - IF THE DCB WAS ALREADY IN CORE, THE ENTRY IS ADVANCED * ONE POSITION (I.E. INSERTED BEFORE THE ENTRY IN FRONT * ITSELF). * - IF THE DCB HAD TO BE BROUGHT TO CORE, THE ENTRY IS * INSERTED AS THE "LAST" ENTRY IN THE "DCB IN CORE" PART * OF THE RFAMD. * WE THEN GO TO PREPARE THE CALL. * * BRN10 FOR DSTAT ONLY * CALL FSTAT AND GO DIRECTLY TO THE REPLY SECTION * * BRN6 FOR FLUSH ONLY * - DELETE THE PROPER RFAMD TABLE ENTRIES AND RETURN * TO THE DCB FREE LIST THE DCB SPACES WHICH ARE NOT * ANY MORE NEEDED. * - MAKE A DECISION ON WETHER OR NOT WE HAVE TO CLOSE * THIS FILE. IF YES, JMP BRN9 FOR STANDARD CLOSE, ELSE * JMP BRN7 FOR TERMINATION. * * * 3. FMP CALL FORMATING. * THE TABLE WE WILL USE TO SELECT A PROCESSOR IS BLDTB. * IN THIS PART WE ONLY SET THE ADDRESSES OF THE PARAMETERS * IN THE CALL BUFFER. * * * 4. POSTPROCESSING * ON COMPLETION OF THE FMP CALL WE GO TO "DONE" WHERE THE * SELECTION OF THE PREPROCESSOR IS DONE THROUGH THE TABLE * PSTBL. * * PST05 USED FOR DNAME AND DPURG * IF THE FILE WAS OPEN BEFORE THE FMP CALL AND THE CALL * WAS EXECUTED WITHOUT ERROR, THE CURRENT RFAMD ENTRY * IS DELETED. * * PST04 USED FOR DCRET * IF THE ICR WAS NOT SPECIFIED IN THIS REQUEST, SET THE * PROPER CRN VALUE IN THE RFAMD ENTRY. * IN ANY CASE, FIND THE RFAMD ENTRY # AND PASS IT TO * THE USER. * * PST00 USED FOR DSTAT * SET THE DATA LENGTH TO 125 WORDS. * * PST02 USED FOR DREAD * SET THE DATA LENGTH * * PST03 USED FOR DOPEN * IF THE ICR WAS SPECIFIED IN THE REQUEST, THE RFAMD * ENTRY # IS SET IN THE PARMB, AND THE REPLY IS SENT. * IF THE ICR WAS NOT SPECIFIED IN THE REQUEST, THE * LEGALITY OF THIS OPEN IS CHECKED, AND EITHER: * - REJECTED (ERR -08) THE TYPE OF THE OPEN MAY HAVE * BE RESTORED * - ACCEPTED, THE CRN IS SET IN THE RFAMD ENTRY AND THE ENTRY * NUMBER IS SET IN THE PARMB. * THE REPLY IS SENT. * * * 5. IF THE OPERATION WAS A SUCCESSFUL CLOSE, THE CURRENT RFAMD * ENTRY IS DELETED. * * * * HED RFAM: PREPROCESSING * (C) HEWLETT-PACKARD CO. 1977 SPC 3 * * HERE FOR DCLOS * BRN2 JSB ENTCK CHECK THE VALIDITY OF THE ENTRY # STA CRFAD ENTRY # OK. A = ADDRESS OF ENTRY. ADA D2 STEP TO THE FILE NAME LDB FNAMA GET THE DESTINATION ADDRESS MVW D4 MOVE THE FILE NAME AND THE CRN * LDA FIRST SET THE START POINTER TO STA PNTR1 SEARCH FROM THE FIRST ENTRY. * BRN21 JSB SERCH SEARCH THE LIST JMP BRN9 UNSUCCESFUL SEARCH => OK * * SUCCESSFUL SEARCH. IS IT US ? * LDA PNTR1 GET SEARCH POINTER CPA CRFAD COMPARE TO CURRENT ENTRY RSS YES, US, NO PROBLEM JMP BRN22 NO, FAKE THE CLOSE. LDA PNTR1,I GET NEXT TO SEARCHED ENTRY STA PNTR1 RESET THE SEARCH POINTER JMP BRN21 CONTINUE TO SCAN. * BRN22 CLA SET FOR NO ERROR STA IERR JMP BRN7 RETURN SPC 3 * * HERE FOR DPURG AND DNAME * BRN8 JSB BRN84 SET UP FOR LIST SCAN. CLB STB TMPAD JSB SERCH SCAN THE LIST JMP BRN5 UNSUCCESFUL SEARCH => OK. * * IF THE FILE IS OPENED TO US AND ONLY TO US, * WE ARE ALLOWED TO EXECUTE THE REQUEST. * PNTR1 POINTS TO THE MATCHING ENTRY * JSB US? IS IT OUR ENTRY ? JMP BRN81 NO, NOT US STA TMPAD SAVE ENTRY ADDRESS SSB EXCLUSIVE OPEN ? JMP BRN82 YES, WE ARE THE ONLY USER * LDA A,I GET ADDRESS OF NEXT ENTRY STA PNTR1 SET THE POINTER TO CONTINUE THE SEARCH JSB SERCH DO IT RSS NO BODY ELSE IN THE GAME, EXECUTE JMP BRN81 SOME ONE ELSE, FORGET IT * LDA TMPAD GET ENTRY ADDRESS BRN82 STA CRFAD SET FOR DCB RETREIVAL JSB FNDX FIND THE ENTRY # JMP BRN91 GET THE DCB AND EXEC THE REQ. * * SUCCESSFUL SEARCH, WE CANNOT PURGE NOR RENAME A FILE OPEN TO * SOMEONE ELSE. * * THE FILE WAS FOUND TO BE CURRENTLY OPENED TO SOMEONE. * TO FIND THIS WE MIGHT HAVE HAD TO OPEN THE FILE. * IF THE CURRENT OWNER(S) HAD IT NON EXCLUSIVELY OPENED, * WE HAVE TO RESTORE THIS STATUS. * BRN81 LDA DFLFL SZA,RSS DID WE HAVE TO DO AN OPEN ? JMP ERR08 NO LDA PNTR1 GET ADDRESS OF RFAMD ENTRY ADA D7 STEP TO THE NODE NUMBER LDA A,I GET IT SSA "EXCLUSIVE" BIT SET ? JMP ERR08 YES, WE DID NOT CHANGE ANYTHING * CLB SET THE DCB IN STB DTBFR+9 "FILE NOT OPEN" STATUS * JSB OPEN NO, REOPEN, NON EXCLUSIVELY DEF *+7 DEF DTBFR USE DATA A,REA AS DCB DEF IERR1 DEF PARMB+5 FILE NAME DEF D1 OPTION DEF PARMB+10 ISECU DEF PARMB+8 ICR * JMP ERR08 NOW, SEND ERROR SPC 3 * * WE COME HERE FOR DOPEN * BRN4 LDA PARMB+8 GET ICR SZA,RSS PRESENT ? JMP BRN3 NO, WE WILL DO THE CHECKING LATER JSB BRN41 YES JMP BRN3 OK TO OPEN JMP ERR08 CANNOT OPEN SPC 3 * * HERE WE WILL CREATE AN RFAMD ENTRY. * THIS ENTRY WILL BE POSITIONED AT THE END OF THE * LIST OF RFAMD ENTRIES POINTING TO IN-CORE-DCB'S. * WE WILL ALSO TAKE CARE OF FINDING A DCB SPACE AND * LINKING IT TO ITS RFAMD ENTRY. * BRN3 LDA BFREE GET FREE RFAMD-LIST HEAD POINTER SZA,RSS ANY FREE ENTRY ? JMP ERR28 NO, REJECT. * LDA FCORE GET FREE DCB-LIST HEAD POINTER. SZA ANY ROOM IN CORE ? JMP CRT1 YES, WE DONT HAVE TO SWAP ANYONE OUT. * * SINCE THERE IS NO ROOM FOR ANOTHER DCB IN CORE AT * THIS TIME, WE HAVE TO MAKE SOME ROOM. WE WILL SWAP * OUT THE "LAST" DCB. * JSB WLAST WRITE "LAST" DCB TO DISC * LDA LAST GET THE ENTRY ADDRESS INA STEP TO "PREVIOUS" POINTER LDB A,I GET ADDRESS OF PREVIOUS STB LAST RESET LAST ADA D7 STEP TO THE DCB POINTER CLB STB A,I SET IT FOR "DCB ON DISC" * JMP CRT2 * CRT1 LDB FCORE,I TAKE 1 DCB OUT OF THE STB FCORE FREE LIST AND RELINK THE LIST STA LDCB SAVE THE ADDRESS OF "OUR" DCB * * NOW THAT WE HAVE A DCB, LET'S TAKE CARE OF THE RFAMD ENTRY. * CRT2 LDA BFREE TAKE 1 OUT OF THE FREE LIST LDB BFREE,I AND RELINK THE FREE LIST STB BFREE * STA CRFAD SAVE ADDRESS OF OUR RFAM ENTRY LDB LDCB GET DCB ADDRESS ADA D8 STEP TO DCB POINTER STB A,I SET IT ADB D9 STEP TO THE OPEN FLAG AND DESTROY IT STB B,I BY MAKING IT DIFFERENT FROM RFAM'S ID SEG ADDRESS * * NOW INSERT CRFAD IN THE LIST * LDA LAST SZA IS THERE ANYTHING IN THIS LIST ? JMP CRT3 YES * * CRFAD WILL BE THE 1ST ENTRY OF THE LIST. * LDB CRFAD STB LAST SET IN-CORE LIMIT LDA FIRST SZA,RSS IS THE LIST EMPTY ? JMP CRT21 YES JSB INSRT INSERT STA FIRST RESET THE LIST HEAD JMP BRN31 * CRT21 STB FIRST STA 1,I NO "NEXT" INB STA 1,I NO "PREVIOUS" EITHER JMP BRN31 ALL DONE FOR THIS CASE. * * WE HAVE TO INSERT THE NEW ENTRY AFTER THE "LAST" ONE * CRT3 CPA CRFAD ALREADY IN PLACE? JMP CRT33 YES LDB CRFAD ADDR OF CURRENT ENTRY LDA LAST,I GET NEXT(LAST) STA 1,I STORE IN CURR. ENTRY STB LAST,I LINK OLD LAST TO THIS ONE SZA,RSS BOTTOM? JMP *+3 YES **** INA STB 0,I INB LDA LAST STA 1,I PREV(CRFAD)=OLD LAST CRT33 LDA LAST,I GET "NEXT" OF LAST STA LAST UPDATE LAST * * AN RFAMD ENTRY IS CREATED AND LINKED INTO THE LIST. * WE NOW HAVE TO FILL THE BLANKS IN THE RFAMD ENTRY. * BRN31 LDB CRFAD GET POINTER TO NEW RFAMD ENTRY. ADB D2 STEP TO FILE NAME LDA NAMA MVW D3 MOVE THE FILE NAME LDA PARMB+8 GET ICR STA B,I SET IT IN CRFAD LDA PARMB+9 GET THE ID SEGMENT @ OF THE OWNER INB STA B,I LDA PARMB+2 GET ORIGIN NODE INB STA B,I * * ALL SET ! * JMP BRN5 SPC 2 * * SUBROUTINE TO SWAP OUT THE "LAST" IN-CORE DCB. * FIRST FIND ITS DISC ADDRESS. * WLAST NOP LDA LAST GET CORE ADDRESS OF RFAMD ENTRY. JSB FNDX FIND ENTRY # JSB CALDS CALCULATE DISC ADDRESS * LDA LAST NOW FI[ND ITS CORE ADDRESS ADA D8 STEP TO DCB ADDRESS LDB A,I GET IT STB LDCB SAVE * ADB D12 STEP TO FILE POSITION POINTER CBX SAVE THE ADDRESS LDB B,I GET THE POINTER LDA LDCB GET THE DCB ADDRESS CMA,INA SUBTRACT FROM FILE POSITION ADB A POINTER TO FORM RELATIVE POINTER. STX A RETRIEVE POINTER ADR STB A,I SET RELATIVE POINTER INTO DCB * JSB EXEC NOW WRITE THE DCB DEF *+7 ON THE DISC. DEF D2I WRITE DEF IDISC DISC LU DEF LDCB,I CORE ADDRESS DEF D144 LENGTH DEF CTRK TRACK # DEF CSCT SECTOR ADDRESS * JMP DSCER DISC ERROR * JMP WLAST,I RETURN SPC 3 * * PREPROCESSOR FOR FLUSH * BRN6 CLA STA IERR SET FOR NO ERROR IN CASE OF NO ENTRY STA TMPNX SET A FLUSHED ENTRY COUNTER STA FLFLG SET A FLUSH FLAG TO INDICATE THE * ABSENCE/PRESENCE OF ENTRIES CORRESPONDING TO THIS FILE * WHICH MUST NOT BE FLUSHED. LDA NAMA LDB FNAMA SET THE FILE ID FOR THE SEARCH MVW D4 LDA FIRST STA PNTR1 SEARCH FROM THE START JSB BRN62 JMP ERR11 NO ENTRY MATCHES, GIVE "DCB" NOT OPEN * ISZ TMPNX INC THE ENTRY COUNTER LDA PNTR1 SAVE THE ENTRY @, WE WILL STA TMPAD USE IT FOR THE CLOSE BRN61 LDA PNTR1,I CONTINUE THE SEARCH STA PNTR1 JSB BRN62 JMP BRN64 ALL DONE ISZ TMPNX ONE MORE LDA PNTR1 JSB DELET DELETE THIS ENTRY JMP BRN61 CONTINUE * BRN64 LDA TMPAD LDB FLFLG GET THE FLUSH FLAG SZB DO WE CLOSE THIS FILE ? JMP BRN65 NO STA CRFAD SET THE ENTRY ADDRESS FOR THE CLOSE LDA D8 STA RQLN JMP BRN9 GO FOR A CLOSE * BRN65 JSB DELET DELETE THIS ENTRY JMP BRN7 AND RETURN. SPC 3 * * HERE WE DO THE COMMON PART OF NEARLY EVERY REQUEST * BRN1 JSB ENTCK FIRST, CHECK THE VALIDITY OF THE ENTRY. STA CRFAD SAVE THE ADDRESS OF THE CURRENT ENTRY. * * IN THIS PART, KNOWING THE ADDRESS OF THE CURRENT RFAMD * ENTRY (CRFAD) WE WILL DETERMINE IF THE MATCHING DCB * IS IN CORE OR ON DISC. IF THE DCB IS ON DISC, IT WILL * BE BROUGHT UP TO CORE. THIS MAY REQUIRE THE SWAPPING OUT * OF ANOTHER DCB. * BRN9 LDA PARMB+6 GET THE ENTRY # BRN91 STA SWNX AND SAVE IT FOR THE DISC ACCESS LDA CRFAD GET POINTER TO THE ENTRY. ADA D8 STEP TO THE DCB POINTER LDA A,I GET IT SZA IS DCB ON DISC ? JMP CASE1 NO * * SINCE WE HAVE TO BRING THE DCB INTO CORE, WE HAVE * TO FIND ROOM FOR IT. * LDA FCORE GET FREE DCB LIST HEAD POINTER SZA ANY FREE DCB SPACE ? JMP SWIN1 YES, SWAP IN ONLY. * * WE WILL SWAP OUT THE "LAST" IN-CORE DCB. * JSB WLAST WRITE "LAST" DCB TO DISC * LDB LAST ADB D8 STEP TO THE DCB POINTER CLA STA B,I SET IT FOR DCB ON DISC STA TMP1 THIS FLAG MEANS THAT WE HAD TO SWAP OUT JMP SWIN2 * SWIN1 STA LDCB SAVE ADDRESS OF LOCAL DCB LDA LDCB,I GET "NEXT" TO LDCB STA FCORE RELINK THE DCB FREE LIST CCA STA TMP1 SET THE FLAG TO "NO SWAP OUT" * SWIN2 LDA SWNX GET NUMBER OF RFAMD ENTRY JSB CALDS FIND WHERE OUR DCB IS ON DISC * JSB EXEC GET THE DCB INTO CORE DEF *+7 DEF D1I DEF IDISC DEF LDCB,I DEF D144 DCB LENGTH DEF CTRK TRACK # DEF CSCT SECTOR NUMBER * JMP DSCER DISC ERROR * * NOW THAT THE DCB IS IN, RESET THE DCB POINTER IN CRFAD * AND THE FILE POSITION POINTER IN THE DCB. * LDA CRFAD ADA D8 STEP TO DCB POINTER LDB LDCB GET ADDRESS OF DCB STB A,I SET THE POINTER ADB D12 STEP TO RELATIVE FILE POSITION PTR LDA B,I GET IT ADA LDCB ADD DCB ADR TO FORM ABSOLUTE FILE STA B,I POSITION POINTER & SET INTO DCB. * * NOW IS TIME TO RELINK THE RFAMD LIST. * WE HAVE 3 SEPARATE CASES: * 1) THE DCB WAS ALREADY IN CORE. WE SWITCH * CRFAD WITH ITS PREVIOUS ENTRY EXCEPT IF CRFAD * THE FIRST ENTRY. IF CRFAD WAS THE 2ND AND-OR * LAST ENTRY, THE FIRST AND-OR LAST POINTERS * HAVE TO BE RESET. * 2) THE DCB WAS ON DISC AND THERE WAS ROOM * IN CORE. CRFAD IS INSERTED AFTER THE "LAST" ENTRY, * AND LAST IS RESET TO POINT TO CRFAD. IF BEFORE THE * INSERTION LAST=0 (I.E. THERE IS NO DCB IN CORE ) * THEN INSERT CRFAD BEFORE FIRST AND RESET FIRST AND * LAST TO CRFAD. * 3) THE DCB WAS ON DISC AND THERE WAS NO ROOM * IN CORE. INSERT CRFAD BEFORE LAST AND RESET LAST * TO CRFAD. IF FIRST=LAST, RESET ALSO FIRST (CASE * OF ONLY ONE DCB IN CORE). * LDA TMP1 GET FLAG SZA,RSS WHAT CASE IS THIS ? JMP CASE3 GUESS * * HERE WE TREAT CASE 2 * LDA LAST GET ADDRESS OF LAST SZA LIMIT CASE ? JMP CASE2 NO, NORMAL CASE2 LDA CRFAD TAKE CRFAD OUT JSB COUT OF LIST. LDA FIRST INSERT IT ON TOP OF THE LIST JSB INSRT * STA LAST RESET LAST STA FIRST RESET FIRST JMP BRN5 ALL DONE. * * NOW FOR REAL CASE 2 * CASE2 LDA LAST,I GET NEXT TO LAST CPA CRFAD CRFAD ALREADY IN PLACE? JMP CAS21 YES, NO INSERTION NECESSARY. LDA CRFAD JSB COUT TAKE CRFAD OUT OlF ITS LIST. LDA LAST,I SET POINTER JSB INSRT OF CRFAD AFTER LAST. * CAS21 STA LAST RESET LAST. JMP BRN5 ALL DONE FOR CASE2 * * HERE ON CASE 3 * CASE3 LDA CRFAD JSB COUT TAKE CRFAD OUT OF THE LIST LDA LAST SET POINTER JSB INSRT CRFAD BEFORE LAST STA LAST RESET LAST LDB 0 INA STEP TO PREVIOUS OF CRFAD LDA A,I GET IT SZA,RSS IS CRFAD FIRST NOW ? STB FIRST RESET FIRST TO CRFAD. JMP BRN5 GO AWAY * * HERE FOR CASE 1 * CASE1 STA LDCB SAVE ADDRESS OF DCB LDA CRFAD CPA FIRST ALREADY TOP OF LIST? JMP BRN5 YES, DONE * JSB COUT REMOVE CRFAD FROM ITS SLOT LDA CRFAD INA LDA A,I GET PREV(CRFAD) JSB INSRT BEFORE PREVIOUS. * INA LDA A,I GET PREV(CRFAD) SZA IS CRFAD NOW FIRST ENTRY ? JMP CAS11 NO LDA CRFAD YES, GET ITS ADDRESS AGAIN STA FIRST RESET FIRST. * CAS11 LDB CRFAD,I GET ADDR OF NEXT LDA LAST WAS LAST POINTING TO CRFAD CPA CRFAD BEFORE THE SWITCH ? STB LAST YES, RESET LAST TO CRFAD(NEXT) JMP BRN5 ALL DONE SPC 3 * * HERE FOR DSTAT. THIS IS A SPECIAL CALL, IT DOES NOT * NEED ANY DCB. SPECIAL TREATMENT. * BRN10 JSB FSTAT DEF *+2 DEF DTBFR STATUS BUFFER * CLA STA IERR SET FOR NO ERROR LDB D125 SET THE LENGTH OF THE JMP PST01 DATA BUFFER & RETURN SPC 3 * * HERE WE BRANCH TO THE PROPER CALL SETUP ROUTINE. * BRN5 LDA PARMB+4 GET THE FUNCTION CODE ADA JSBTB ADD POINTER TO FMP CALL DEF-TABLE LDA A,I GET ADR OF FMP CALL STA CALLI SET IT LDA PARMB+4 GET FCODE AGAIN ADA BLDTB MAP IN "BUILD" TABLE JMP A,I GO PREPARE THE CALL TO FMP g* SPC 3 * * CALL BUILDER FOR DAPOS,DCLOS,DCONT,DPOSN,DWIND * BLD0 LDB PARAM GET @ OF NEXT PARAM DEST. * BLD02 LDA RQLN GET THE REQUEST LENGTH CMA,INA ADA D8 SET A PARAMETER COUNTER SZA,RSS NO PARAMETER ? JMP BLD01 STA CNTR1 LDA BPARM GET ADDRESS OF PARMB ADA D8 STEP TO NEXT PARAMETER ORIGIN * BLDCM STA B,I SAVE IN CALL INB INA STEP TO NEXT PARAM ISZ CNTR1 DONE ? JMP BLDCM NO * BLD01 STB CALL+1 SET THE RETURN ADDRESS JSB NOPS CLEAN THE END OF THE BUFFER JMP CALL EXECUTE THE CALL SPC 3 * * CALL BUILDER FOR DCRET * BLD3 LDA BPARM GET @ OF PARMB ADA D5 STEP TO NAME STA LDCB+2 ADA D6 STEP TO SIZE STA LDCB+3 ADA D2 STEP TO TYPE STA LDCB+4 * LDA CRFAD GET THE ADDRESS OF THE RFAMD ENTRY ADA D7 STEP TO THE NODE # LDB A,I GET IT CCE RBL,ERB SET THE EXCLUSIVE-OPEN BIT STB A,I RESTORE THE WORD * LDB PARAM ADB D3 SET B TO CURRENT RETURN * * THE FOLLOWING PART IS COMMON TO DCRET, DNAME,DOPEN * AND DPURG, IT SETS THE SECURITY CODE AND THE CRN IN THE CALL * BLD31 LDA SECUA GET ADDRESS OF ISECU STA B,I SET IT IN THE CALL LDA CRA GET ADDRESS OF ICR INB STEP TO NEXT PARAM IN CALL STA B,I SET IT IN THE CALL LDA A,I GET CRN SZA PRESENT ? INB YES, PUSH B TO NEXT JMP BLD01 DONE HERE, GO COMPLETE AND CALL SPC 3 * * CALL BUILDER FOR DLOCF * BLD4 LDB PARAM LDA DM7 STA CNTR1 USE AS PARAMETER COUNTER LDA BPARM GET ADDRESS OF PARMB ADA D7 STEP TO 1ST RETURN PARAMETER BLD41 STA B,I SET @ OF RETURN PARAM. IN CALL INA INC PARAMETER @ NLH INB INC CALL POINTER ISZ CNTR1 ALL DONE ? JMP BLD41 NO, CONTINUE JMP BLD01 YES, COMPLETE AND EXECUTE SPC 3 * * CALL BUILDER FOR DNAME * BLD5 LDA BPARM GET @ OF PARMB ADA D5 STEP TO NAME STA LDCB+2 SET @ OF NAME IN CALL ADA D6 GET @ OF NNAME STA LDCB+3 SET IN CALL LDB PARAM ADB D2 SET FOR THE REST LDA TMPAD WAS THE FILE ALREADY OPEN ? SZA JMP BLD31 YES, DCB ADDRESS ALREADY SET JMP BLD81 NO, USE DATA BUFFER AS DCB SPACE. SPC 3 N* * CALL BUILDER FOR DOPEN * BLD6 LDA PARMB+11 GET OPEN OPTION CCE,SLA EXCLUSIVE ? JMP BLD61 NO LDA CRFAD YES, GET ADDRESS OF RFAMD ENTRY ADA D7 TO SET "EXCLUSIVE" FLAG IN NODE WORD. LDB A,I GET THE NODE NUMBER RBL,ERB SET THE SIGN BIT STB A,I REPLACE IN THE ENTRY * BLD61 LDA BPARM GET THE ADDRESS OF THE PARMB ADA D5 STEP TO THE FILE NAME STA LDCB+2 SET IT IN THE CALL TO FMP ADA D6 STEP TO THE OPEN OPTION STA LDCB+3 SET IT IN THE CALL * LDA LDCB SET THE ADA D9 DCB IN CLB "FILE NOT OPEN" STB A,I STATUS * LDB PARAM ADB D2 GET CURRENT RETURN ADDRESS JMP BLD31 GO COMPLETE THE CALL SPC 3 * * CALL BUILDER FOR DPURG * BLD8 LDA NAMA GET FILE NAME ADDRESS STA LDCB+2 SET IT IN CALL LDB PARAM INB BLD81 LDA DTBFA GET THE ADDRESS OF THE DATA BUFFER STA LDCB USE IT AS THE DCB ADDRESS FOR THIS CALL JMP BLD31 GO COMPLETE SPC 3 * * CALL BUILDER FOR DREAD * BLD9 LDA DTBFA GET ADDRESS OF DATA BUFFER STA LDCB+2 SET IT IN CALL LDA BPARM ADA D8 GET ADDRESS OF REQUEST LENGTH STA LDCB+3 SET IN CALL CLB CLEAR RETURNED LENGTH WORD STB LEN TO AVOID CONFUSION ON ERROR LDB LENA ALWAYS PASS LEN BACK. GET ITS @ STB LDCB+4 INA LDB A,I GET NUM SZB,RSS PRESENT ? JMP BLD91 NO STA LDCB+5 YES, SET IN CALL CLB,INB GET A 1 BLD91 ADB PARAM FIND RETURN ADDRESS ADB D3 JMP BLD01 GO COMPLETE AND EXECUTE SPC 3 * * CALL BUILDER FOR DWRIT * BLD12 LDA DTBFA STA LDCB+2 SET BUFFER ADDRESS IN CALL LDB PARAM INB GET RETURN ADDRESS JMP BLD02  GO COMPLETE AND EXECUTE SPC 3 HED RFAM: POSTPROCESSING * (C) HEWLETT-PACKARD CO. 1977 * * WE COME HERE AFTER RETURNING FROM THE FMP CALL * DONE LDA PARMB+4 GET FCODE ADA PSTBL MAP IN THE POST PROCESSING TABLE JMP A,I SPC 3 * * POSTPROCESS FOR DNAME AND DPURG * PST05 LDA TMPAD WAS IT AN ALREADY OPEN FILE ? SZA,RSS JMP BRN7 NO LDB IERR GET COMPLETION CODE SSB,RSS ERROR ? JSB DELET NO, DELETE THE OLD ENTRY JMP BRN7 SEND THE REPLY SPC 3 * * POSTPROCESS FOR DCRET * PST04 LDA IERR SSA ANY ERROR ? JMP INDX YES, DONT WORRY ABOUT ALL THIS * LDA PARMB+8 GET ICR SSA LU ? JMP PST41 YES SZA SPECIFIED ? JMP INDX YES, IT'S A CRN * LDA LDCB,I GET 1ST WORD OF DCB AND B77 GET DISC LU CMA,INA STA PARMB+8 REPLACE IN THE PARMB PST41 JSB LUCR TRANSFORM INTO CRN LDA CRFAD GET THE @ OF THE RFAMD ENTRY ADA D5 STEP TO THE CRN STB A,I SET IT JMP INDX DO THE INDEX THING SPC 3 * * WE COME HERE AFTER A DREAD * PST02 LDB LEN GET LEN STB PARMB+7 SAVE IN REPLY SSB SKIP IF NOT EOF CLB ELSE DO ZERO LENGTH XFER JMP PST01 SPC 3 * * WE COME HERE AFTER A CALL TO DOPEN * PST03 LDA PARMB+8 GET ICR SZA WAS IT SPECIFIED ? JMP INDX YES, PASS THE RFAMD ENTRY #, THAT'S ALL LDA IERR GET THE COMPLETION CODE SSA ERROR ? JMP INDX YES LDA LDCB,I NO, GET 1ST WORD OF DCB CPA MAGLU RTE-M "MAGIC LU" TYPE 0 FILE? JMP MGLU1 YES, SET SPECIAL CODE IN PARMB+8 AND B77 ISOLATE THE DISC LU CMA,INA MAKE IT <0 (FOR LU) MGLU1 STA PARMB+8 REPLACE IT IN THE PARMB * JSB BRN41 FIND THE LEGALITY OF THIS OPEN JMP PST31 LEGAL, WE ARE IN LUCK ! * * THIS OPEN HAS BEEN FOUND TO BE ILLEGAL, THIS MEANS * THAT AT LEAST ONE OTHER USER HAS THIS FILE OPENED, * AND AT LEAST ONE OF US HAS IT OPENED EXCLUSIVELY. * THE PROBLEM NOW IS TO FIND IF OUR OPEN CHANGED THE * TYPE OF OPEN (X/NON-X) AND TO RESTORE THE OLD TYPE * IF IT HAS BEEN CHANGED. * LDA PARMB+11 GET OUR OPEN OPTION SLA DID WE DO AN EXCLUSIVE OPEN ? JMP NOX3 NO LDA PNTR1 YES WE DID, GET THE ADDRESS OF THE ADA D7 OTHER USER'S RFAMD ENTRY. LDA A,I GET THE NODE # SSA DID HE ALSO DO AN EXCLUSIVE OPEN ? JMP BAD03 YES, NO TYPE PROBLEM (THIS ALSO PROVES * THAT HE IS THE ONLY OTHER USER OF THIS FILE) CLA RESTORE THE STATUS STA OPT03 OF THE FILE TO NON EXCLUSIVE OPEN JMP OP03 * NOX3 CLA,INA SET FOR EXCLUSIVE OPEN STA OPT03 CLA STA DTBFR+9 SET DCB IN NON OPEN STATUS * OP03 JSB OPEN DEF *+7 DEF DTBFR WE WILL NOT NEED THE DCB DEF IERR1 DEF PARMB+5 FILE NAME DEF OPT03 OPTION DEF PARMB+10 ISECU DEF PARMB+8 ICR * BAD03 LDA DM8 GET THE ERROR CODE STA IERR SET IT IN THE REPLY * LDA CRFAD GET ADDRESS OF CURRENT RFAMD ENTRY JSB DELET DELETE IT JMP BRN7 SEND THE REPLY SPC 3 PST31 LDA PARMB+8 GET THE CRN LDB CRFAD GET THE @ OF THE RFAMD ENTRY ADB D5 STEP TO THE ICR STA B,I SET IT JMP INDX DO THE INDEX THING SPC 3 * * POST PROCESS FOR FLUSH * PST08 LDA TMPNX GET THE # OF FLUSHED ENTRIES STA IERR SET AS COMPLETION CODE LDA CRFAD DELETE THE LAST ENTRY JSB DELET JMP BRN7 SEND THE REPLY SPC 3 * * THIS WILL SET THE RFAMD ENTRY NUұMBER IN THE PARMB * INDX LDA IERR GET THE ERROR RETURN FROM FMP SSA,RSS ANY ERROR ? JMP INDX1 NO LDA CRFAD ERROR, DELETE THE ENTRY. JSB DELET JMP BRN7 INDX1 LDA CRFAD GET ADDRESS OF THE CURRENT RFAMD ENTRY JSB FNDX CALCULATE IT'S NUMBER STA PARMB+7 SAVE SPC 3 BRN7 CLB SET FOR NO DATA RETURNED * PST01 STB LENGT LDA #NODE GET LOCAL NODE # STA PARMB+6 SET AS COMPLETETION LOCATION LDA IERR SET THE COMPLETION CODE STA PARMB+5 IN THE PARMB LDA PARMB GET THE STREAM TYPE IOR BIT14 SET THE REPLY BIT STA PARMB REPLACE * LDA PARMB+4 GET THE ICODE ADA LNTBL INDEX IN THE REPLY LENGTH TABLE LDA A,I GET THE LENGTH STA PRMBL SET THE LENGTH * * THE REPLY PARMB IS READY, SEND IT BACK * JSB D65SV DEF *+5 DEF PARMB DEF PRMBL PARMB LENGTH DEF DTBFR DATA BUFFER DEF LENGT LENGTH * NOP IGNORE THE ERROR RETURN FROM D65SV * * IF THE OPERATION WAS A DCLOS, AND IT WORKED PROPERLY, WE * HAVE TO DELETE THE RFAMD ENTRY. * LDA PARMB+4 GET OPCODE FOR THE LAST TIME CPA D1 DCLOS ? RSS YES JMP PST06 * * LDA IERR GET COMPLETION CODE SSA ERROR ? JMP PST06 YES, DO NOT DELETE THE ENTRY LDA CRFAD GET ADDRESS OF ENTRY JSB DELET GO DELETE IT AND ITS DCB * PST06 LDA DM9 GET A COUNTER STA CNTR1 LDA BPARM GET ADDRESS OF PARMB ADA D5 STEP TO OPTIONAL AREA CLB GET A 0 PST07 STB A,I CLEAN THE OPTIONAL AREA INA ISZ CNTR1 JMP PST07 CONTINUE JMP GO GET NEXT REQUEST. SPC 3 HED RFAM: UTILITY ROUTINES * (C) HEWLETT-PACKARD CO. 1977 * * THIS ROUTINE WILL PICK UP THE FILE NAME ANlD THE CARTRIDGE * NUMBER FROM THE PARMB AND SET THEM FOR THE CALL TO SEARCH. * * IF AN LU IS PASSED INSTEAD OF THE CARTRIDGE #, THIS IS * CONVERTED TO THE CR #, WHICH IS ALSO SAVED IN PARMB+8. * SINCE THIS ROUTINE IS CALLED JUST BEFORE A SEARCH, WE * ALSO SET THE SEARCH POINTER TO THE FIRST WORD OF THE * RFAMD TABLE. * BRN84 NOP LDA PARMB+8 GET THE ICR PARAMETER SZA,RSS PRESENT ? JMP DEFLT NO, DEFAULT CLB STB DFLFL SET THE DEFAULT FLAG SSA LU ? JSB LUCR YES JMP OK84 NO, CRN * * WE WANT TO FIND ON WHICH LU OUR FILE IS. WE WILL * DO AN EXCLUSIVE OPEN ON THIS FILE AND LOOK IN THE * DCB. * WE COME HERE ONLY ON A DNAME OR A DPURG * DEFLT CCB STB DFLFL SET THE DEFAULT FLAG CLB STB DTBFR+9 * JSB OPEN DEF *+6 DEF DTBFR SEND THE DCB INTO THE DATA AREA DEF IERR1 DEF PARMB+5 FILE NAME DEF D0 EXCLUSIVE OPEN DEF PARMB+10 ISECU * SSA SUCCESFUL OPEN ? JMP ERRXX DONT GO ANY FURTHER LDA DTBFR GET 1ST WORD OF DCB AND B77 GET THE LU CMA,INA STA PARMB+8 SET IT IN THE PARMB JSB LUCR CONVERT TO CRN * OK84 LDA NAMA GET ADDRESS OF FILE NAME LDB FNAMA MVW D4 SET THE FILE NAME FOR THE SEARCH LDA FIRST WE ALSO SET THE SEARCH POINTER STA PNTR1 TO THE BEGINNING OF THE TABLE * JMP BRN84,I SPC 3 * * THIS ROUTINE WILL TRANSFORM A NEGATIVE DISC LU * INTO A CARTRIDGE NUMBER. BOTH INPUT AND RESULTS * ARE PASSED VIA PARMB+8. THE RESULT WILL ALSO BE * FOUND IN B REGISTER. IF AN ERROR IS DISCOVERED * WE WILL DIRECTLY JUMP TO THE ERROR ROUTINE. * LUCR NOP LDA PARMB+8 GET LU/CR CPA MAGLU RTE-M "MAGIC-LU" CODE? JMP LUCR,I YES, JUST RETURN SSA,RSS LU?  JMP LUCR1 NO CMA,INA YES, MAKE IT POSITIVE AND STA DTBFR SET UP STATUS CALL. * JSB EXEC GET EQUIPMENT-TYPE CODE DEF *+4 DEF D13I DEF DTBFR USE DTBFR FOR CONWD DEF DTBFR+1 AND EQT5. JMP ERR06 ILLEGAL LU * LDA DTBFR+1 GET EQT5 ALF,ALF AND B77 ISOLATE EQUIP-TYPE CODE LDB PARMB+8 IF DVR05 (CTU SYSTEM), CPA D5 RETURN WITH JMP LUCR,I B = -LU. * LUCR1 JSB FSTAT GET INFO ON THE CURRENTLY DEF *+2 MOUNTED CARTRIGES. DBFAD DEF DTBFR SEND THE INFO IN THE DATA BUFFER * LDA DBFAD DCB BUFFER ADDR LP84 LDB 0,I GET W1 OF ENTRY CMB,INB CPB PARMB+8 IS IT OUR LU? JMP FND84 YES SZB,RSS END OF TABLE ? JMP ERR06 YES, ILLEGAL DISC LU ADA D4 PUSH THE ADDR TO THE NEXT ENTRY JMP LP84 CONTINUE * FND84 ADA D2 STEP TO THE CRN LDB 0,I GET IT STB PARMB+8 SET IT IN THE PARMB JMP LUCR,I SPC 3 * * ROUTINE TO DELETE AN ENTRY FORM THE RFAMD TABLE AND * TO LINK ITS DCB BACK INTO THE FREE LIST. * WHEN A CALL IS MADE TO THIS ROUTINE, A REGISTER * SHOULD CONTAIN THE POINTER TO THE ENTRY TO BE DELETED. * THE ID SEGMENT ADDRESS ( WORD 6 ) IS SET TO ZERO AS * A PROTECTION AGAINST PROGRAMS WHICH TRY TO ACCESS A * FILE AFTER HAVING CLOSED IT. AFTER THIS PRECAUTION * IS TAKEN, ANY ATEMPT TO ACCESS THIS ENTRY WILL BE * REJECTED AS AN ERROR -26. * DELET NOP STA DELAD SAVE ENTRY ADDRESS ADA D6 STEP TO THE ID SEG @ CLB ZERO THIS WORD STB A,I ADA D2 STEP TO THE DCB POINTER. LDA A,I GET THE ADDRESS SZA,RSS DCB IN CORE NOW ? JMP DELT1 NO, DONT WORRY ABOUT THE DCB * LDB FCORE GET THE POINTER TO THE 1ST FREE DCB STB A,I SET IT AS NEXT TO CUJ\RRENT DCB STA FCORE SET CURRENT DCB AS 1ST FREE DCB. * LDA LAST WAS IT THE CPA DELAD LAST DCB IN CORE ? INA,RSS YES JMP DELT1 NO LDA A,I STA LAST RESTORE "LAST" * DELT1 LDA DELAD JSB COUT REMOVE RFAMD ENTRY FROM IS LIST * * NOW INSERT IT IN THE FREE RFAMD LIST. * LDB BFREE GET ADDRESS OF 1ST FREE ENTRY STB DELAD,I SET AS NEXT TO CURRENT LDA DELAD GET ADDRESS OF CURRENT STA BFREE SET AS FIRST IN FREE LIST * JMP DELET,I ALL DONE, RETURN. SPC 3 * * THIS ROUTINE REMOVES AN ENTRY FROM THE RFAMD LIST AND * RESTORES THE LINKS AROUND IT. THE ADDRESS OF THE ENTRY * TO BE REMOVED IS PASSED IN A REG. THIS ROUTINE INCLUDES * PROTECTION FOR REMOVAL OF FIRST OR LAST ENTRY AND * CHANGE OF "FIRST" IF 1ST ENTRY IS REMOVED. * COUT NOP STA DELAD INA STEP TO PREVIOUS LDA A,I GET PREV(DELAD) LDB DELAD,I GET NEXT(DELAD) INB STEP TO PREV(NEXT(DELAD)) STA B,I PREV(NEXT(DELAD)) <= PREV(DELAD) LDB DELAD,I GET NEXT(DELAD) SZA,RSS ANY PREV ? STB FIRST NO, FIRST <= NEXT(DELAD) STB A,I NEXT(PREV(DELAD)) <= NEXT(DELAD) JMP COUT,I RETURN SPC 3 * * THIS ROUTINE WILL INSERT AN RFAMD ENTRY BEFORE THE ENTRY POINTED * AT BY PNTR1, THE ADDRESS OF THE ENTRY TO BE INSERTED IS IN CRFAD. * PNTR1 SHOULD NOT BE = 0. THIS ROUTINE WILL TAKE CARE OF THE * CASE WHERE PNTR1 POINTS TO THE FIRST ENTRY. * INSRT NOP STA PNTR1 SAVE ADDRESS OF ENTRY CPA CRFAD ALREADY IN PLACE ? JMP INSRT,I YES INA STEP TO PREVIOUS LDA A,I GET ADDRESS OF PREVIOUS. LDB CRFAD INB STA B,I PREV(CRFAD)<=PREV(PNTR1) LDB CRFAD SZA DOES PNTR1 POINT TO THE 1ST ENTRY ? STB A,I NO, NENXT(PREV(PNTR1))<=CRFAD LDA PNTR1 STA B,I NEXT(CRFAD)<=PNTR1 INA STB A,I PREV(PNTR1)<=CRFAD LDA 1 RETURN CRFAD IN A * JMP INSRT,I RETURN SPC 3 * * THIS ROUTINE WILL CALCULATE AN RFAMD ENTRY #. * THE ADDRESS OF THE ENTRY IS PASSED IN THE A REGISTER. * THE RESULT IS RETURNED IN A REGISTER. * IS A TABLE DISCREPENCY IS DETECTED, WE JUMP TO * THE PROPER ERROR ROUTINE (-29) * FNDX NOP STA TMPNX SAVE THE ADDRESS CLB CMA,INA ADA END SSA IS THE ENTRY IN PART 1 ? JMP INDX2 NO LDA START YES (A>0) JMP INDX3 * INDX2 LDA XSTRT GET ADDRESS OF FWA 2ND PART LDB ENT#1 GET # ENTRIES IN 1ST PART INDX3 STB ENTN INITIALIZE THE NUMBER OF ENTRIES CMA,INA ADA TMPNX FIND THE DISTANCE FROM FIRST WORD DIV D9 DIVIDE BY LENGTH OF ENTRY SZB THIS IS TO TEST THE VALIDITY OF CRFAD JMP ERR29 NO GOOD !!! ADA ENTN ADD TO DISPLACEMENT JMP FNDX,I RETURN SPC 3 * * THIS ROUTINE CALCULATES THE DISC ADDRESS OF A DCB * AND STORES IT IN CTRK AND CSCT (RESPECTIVELY TRACK * AND SECTOR). UPON ENTRY TO THIS ROUTINE, A CONTAINS * THE NUMBER OF THE MATCHING RFAMD ENTRY. * CALDS NOP CLB DIV DCBTR DIVIDE BY THE NUMBER OF DCB'S PER TRACK ADA ISTRK ADD THE # OF THE 1ST TRK STA CTRK SAVE THE TRACK NUMBER LDA B MPY D3 STA CSCT SAVE THE SECTOR # * JMP CALDS,I RETURN SPC 3 * * CALLING SEQUNCE : JSB BRN41 * * * BRN41 NOP JSB BRN84 SET UP THE PARAMETERS FOR THE SCAN. BRN4L JSB SERCH SCAN THE LIST. JMP BRN41,I UNSUCCESFUL SEARCH => OK. * JSB US? JMP NOTUS THIS IS NOT OUR ENTRY * * SINCE THtSIS FILE IS ALREADY OPENED TO US AND WE TRY * TO OPEN IT AGAIN, WE WILL ACT AS THE FMP: DELETE * CURRENT ENTRY AND REOPEN THE FILE (IF POSSIBLE). * LDB PNTR1,I GET NEXT TO CURRENT STB PNTR1 UPDATE THE POINTER FOR THE REST OFTHE SCAN JSB DELET GO DELETE THIS ENTRY JMP BRN4L CONTINUE THE SCAN. * NOTUS SSB SIGN BIT SET ? (I.E. EXCLUSIVE OPEN) JMP ERR41 YES, FORGET ABOUT OPENING THIS ONE. * * THE FILE HAS BEEN FOUND TO BE OPEN, BUT NOT EXCLUSIVELY * ARE WE TRYING TO OPEN IT EXCLUSIVELY ? * LDA PARMB+11 GET OUR OPEN OPTION SLA,RSS BIT 1 SET ? JMP ERR41 NO, REJECT. LDA PNTR1,I GET NEXT TO CURRENT. STA PNTR1 RESET SEARCH POINTER. JMP BRN4L CONTINUE THE SCAN. * ERR41 ISZ BRN41 SET FOR BAD RETURN JMP BRN41,I SPC 3 * * THIS ROUTINE WILL DO THE SPECIAL SEARCH FOR * THE FLUSH PREPROCESSOR * BRN62 NOP JSB SERCH JMP BRN62,I UNSUCCESSFUL RETURN LDB PARMB+9 GET THE OWNER'S NODE CPB DM1 FLUSH ALL ? JMP BRN63 YES LDA PNTR1 GET ENTRY ADDRESS ADA D7 STEP TO THE NODE # LDA A,I GET IT ELA,CLE,ERA STRIP THE SIGN BIT CPA PARMB+9 DESIRED NODE ? JMP BRN63 YES LDA PNTR1 STA FLFLG SET THE FLUSH FLAG FOR "NO CLOSE" LDA PNTR1,I NO, CONTINUE THE SEARCH STA PNTR1 JMP BRN62+1 * BRN63 ISZ BRN62 SET FOR OK RETURN JMP BRN62,I RETURN SPC 3 * * THIS ROUTINE WILL SEARCH THE RFAMD TABLE FOR AN ENTRY * WITH A CERTAIN FILE NAME AND CARTRIDGE NUMBER. * CALL: PNTR1 SHOULD CONTAIN THE ADDRESS OF THE FIRST * ENTRY TO BE LOOKED AT. * FNAME SHOULD CONTAIN THE FILE NAME AND THE * CARTRIDGE NUMBER (TOTAL 4 WORDS) * RETURN: PNTR1=0 => UNSUCCESSFUL SEARCH RETURN AT * 7 JSB + 1 * PNTR1#0 => SUCCESSFUL SEARCH, RETURN AT JSB+2, PNTR1 * CONTAINS THE ADDRESS OF THE MATCHING ENTRY. * SERCH NOP LDB PNTR1 GET ADDRESS OF 1ST ENTRY. JMP SRC1 GO CHECK FOR END OF LIST * SRCLP ADB D2 STEP TO THE 1ST NAME WORD LDA FNAMA CMW D4 COMPARE JMP SRC3 SUCCESSFUL SEARCH NOP LDB PNTR1,I GET ADDRESS OF NEXT ENTRY STB PNTR1 RESET RUNNING POINTER SRC1 SZB END OF LIST ? JMP SRCLP NO, CONTINUE THE SEARCH JMP SERCH,I YES, UNSUCCESSFUL SEARCH SRC3 ISZ SERCH SET SUCCESSFUL RETURN JMP SERCH,I RETURN SPC 3 * * THIS ROUTINE WILL PICK UP THE RFAMD ENTRY # IN PARMB+6. * IT WILL CHECK FOR BOUNDS AND FOR THE OWNER ID. * IF ALL IS OK, RETURN AT JSB+1 WITH A REGISTER POINTING * TO THE ENTRY. ELSE RETURN AT ERR26. * ENTCK NOP LDA PARMB+6 GET ENTRY # SSA POSITIVE ? JMP ERR26 NO, ILLEGAL. CMA ADA ENT#T COMPARE WITH TOTAL # OF ENTRIES SSA JMP ERR26 ENT#>TOTAL # ENTRIES LDB START GET ADDRESS OF 1ST ENTRY IN LINEAR ORDER LDA ENT#1 GET # ENTRIES IN 1ST PART CMA,INA ADA PARMB+6 ADD ENTRY CURRENT ENTRY NUMBER SSA,RSS IS ENTRY IN 1ST PART ? LDB XSTRT NO, RESET START ADDRESS STB TSTRT SAVE LDA PARMB+6 MPY D9 * ENTRY # IN ITS PART BY THE ENTRY LENGTH ADA TSTRT ADD TO START. * * NOW, A CONTAINS A POINTER TO THE CURRENT ENTRY * LDB A ADB D6 STEP TO OWNER'S ID LDB B,I GET IT CPB PARMB+5 DOES IT MATCH ? SZB,RSS YES, MAKE SURE IT'S NOT ZERO JMP ERR26 NO, THIS IS NOT US LDB A ADB D7 STEP TO THE NODE# LDB B,I GET IT ELB,CLE,ERB STRIP SIGN BIT OFF CPB PARMB+2 DOES IT MATCH CURRENT REQUESTER'S NODE #? JMP ENTCK,I YES JMP ERR26 NO, INTRUDER SPC 3 * * THIS ROUTINE WILL COMPARE THE OWNER ID PART OF AN * RFAMD ENTRY WITH THE OWNER ID OF THE CURRENT REQUEST. * CALLING SEQUENCE: * JSB US? * "PNTR1" IS IN A * RFAMD "NODE" IS IN B * US? NOP LDA PNTR1 LDB A ADB D6 STEP TO OWNER'S ID LDB B,I GET IT CPB PARMB+9 DOES IT MATCH ? RSS JMP US?NO NO, THIS IS NOT US LDB A ADB D7 STEP TO THE NODE# LDB B,I GET IT ELB,CLE,ERB STRIP SIGN BIT OFF CPB PARMB+2 DOES IT MATCH CURRENT REQUESTER'S NODE #? ISZ US? YES, SET FOR OK RETURN US?NO LDB 0 ADB D7 ADDR OF RFAMD: 8TH WORD LDB 1,I GET IT (NODE) JMP US?,I RETURN SPC 3 * * THIS ROUTINE FILLS THE END OF THE CALL BUFFER WITH 0'S * THIS ROUTINE IS CALLED WITH B CONTAINING THE * ADDRESS OF THE 1ST WORD TO BE NOPED. * NOPS NOP CLA NOPS1 STA B,I INB CPB RTN END ? JMP NOPS,I YES JMP NOPS1 NO SPC 3 * * THIS IS THE SKELETON OF THE FMP CALL * PARAM DEF LDCB+2 RETRN DEF LDCB CALL JSB CALLI,I CALL FMP ROUTINE NOP DEF RTRN LDCB NOP ADDRESS OF DCB IF ANY DEF IERR ERROR REP 8 NOP JMP DONE RETURN RTN DEF *-1 * CALLI NOP ADR OF FMP CALL HED RFAM: ERROR HANDLING * (C) HEWLETT-PACKARD CO. 1977 ERR06 LDA DM6 JMP ERRXX ERR11 LDA DM11 JMP ERRXX ERR08 LDA DM8 JMP ERRXX ERR25 LDA DM25 JMP ERRXX ERR26 LDA DM26 JMP ERRXX ERR28 LDA DM28 JMP ERRXX DSCER CCA,RSS ERR29 LDA DM29 * ERRXX STA IERR SET THE ERROR CODE IN THE REPLY JMP BRN7 AND SHIP IT. SPC 3 HED RFAM: CONSTANTS * (C) HEWLETT-PACKARD CO. 1977 A EQU 0 B EQU 1 DM29 DEC -29 DM28 DEC -28 DM26 DEC -26 DM25 DEC -25 DM14 DEC -14 DM11 DEC -11 DM9 DEC -9 DM8 DEC -8 DM7 DEC -7 DM6 DEC -6 DM1 DEC -1 D0 DEC 0 D1 DEC 1 D1I OCT 100001 D2 DEC 2 D2I OCT 100002 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D9 DEC 9 D12 DEC 12 D13I OCT 100015 D99 DEC 99 D125 DEC 125 D144 DEC 144 D512 DEC 512 XEQT EQU 1717B BGLWA EQU 1777B SECT2 EQU 1757B BIT14 OCT 40000 B77 OCT 77 MAGLU OCT 177400 1ST DCB ENTRY FOR "M" MAGIC LU'S START NOP ADDRESS OF LINEAR 1ST RFAMD ENTRY FIRST NOP HEAD POINTER OF THE RFAMD LIST LAST NOP POINTER TO THE LAST DCB-IN-CORE RFAMD * ENTRY BFREE NOP HEAD POINTER OF THE RFAMD FREE LIST FCORE NOP HEAD POINTER OF THE DCB FREE LIST XSTRT NOP ENT#1 NOP NUMBER OF RFAMD ENTRIES IN PART 1 ENT#T NOP NUMBER OF RFAMD ENTRIES (TOTAL) ISTRK NOP ADDRESS OF DISC TRACKS CONTAINING IDISC NOP THE DCB'S DCBTR NOP NUMBER OF DCB'S PER TRACK LENA DEF LEN FNAMA DEF FNAME NAMA DEF PARMB+5 @ OF THE FILE NAME CRA DEF PARMB+8 @ OF THE ICR SECUA DEF PARMB+10 @ OF ISECU RFMDA DEF RFAMD HED RFAM: VARIABLES * (C) HEWLETT-PACKARD CO. 1977 PNTR1 NOP CNTR1 NOP TMP1 NOP CTRK NOP CSCT NOP TSTRT NOP FNAME BSS 4 IERR1 NOP LENGT NOP CRFAD NOP ADDRESS OF CURRENT RFAMD ENTRY LEN NOP ENTN NOP OPT03 NOP PRMBL NOP DFLFL NOP IERR NOP TMPAD NOP DELAD NOP RQLN NOP REQUEST LENGTH TMPNX NOP FLFLG NOP SWNX NOP HED RFAM: TABLES * (C) HEWLETT-PACKARD CO. 1977 BRNCH DEF *+1,I DEF BRN1 DAPOS DEF BRN2 DCLOS DEF BRN1 DCONT DEF BRN3 DCRET DEF BRN1 DLOCF DEF BRN8 DNAME DEF BRN4 DOPEN DEF BRN1 DPOSN NLH DEF BRN8 DPURG DEF BRN1 DREAD DEF BRN10 DSTAT DEF BRN1 DWIND DEF BRN1 DWRIT DEF BRN6 FLUSH * JSBTB DEF *+1 DEF APOSN DEF CLOSE DEF FCONT DEF CREAT DEF LOCF DEF NAMF DEF OPEN DEF POSNT DEF PURGE DEF READF NOP DEF RWNDF DEF WRITF DEF CLOSE FLUSH * BLDTB DEF *+1,I CALL BUILDING TABLE DEF BLD0 DAPOS DEF BLD0 DCLOS DEF BLD0 DCONT DEF BLD3 DCRET DEF BLD4 DLOCF DEF BLD5 DNAME DEF BLD6 DOPEN DEF BLD0 DPOSN DEF BLD8 DPURG DEF BLD9 DREAD NOP DEF BLD0 DWIND DEF BLD12 DWRIT DEF BLD0 FLUSH * SPC 3 FaNLNTBL DEF *+1 REPLY LENGTH TABLE D7 DEC 7 DAPOS DEC 7 DCLOS DEC 7 DCONT D8 DEC 8 DCRET D14 DEC 14 DLOCF DEC 7 DNAME DEC 8 DOPEN DEC 7 DPOSN DEC 7 DPURG DEC 8 DREAD DEC 7 DSTAT DEC 7 DWIND DEC 7 DWRIT DEC 7 FLUSH SPC 3 PSTBL DEF *+1,I POST PROCESSING TABLE DEF BRN7 DAPOS DEF BRN7 DCLOS DEF BRN7 DCONT DEF PST04 DCRET DEF BRN7 DLOCF DEF PST05 DNAME DEF PST03 DOPEN DEF BRN7 DPOSN DEF PST05 DPURG DEF PST02 DREAD NOP DEF BRN7 DWIND DEF BRN7 DWRIT DEF PST08 FLUSH HED RFAM: BUFFERS * (C) HEWLET-PACKARD CO. 1977 PARMB REP 14 NOP * DTBFR BSS 512 . EQU * ORG DTBFR MS1 ASC 17,RFAM: LIMITED BUFFER SPACE, THE NU ASC 19,MBER OF FILES HAS BEEN LIMITED TO MS1A DEF *-2 MS2 ASC 17,RFAM: LIMITED DISC SPACE, THE NUMB ASC 19,ER OF FILES HAS BEEN LIMITED TO MS2A DEF *-2 BSS 8 FILLER HED RFAM: INITIALIZATION * (C) HEWLETT-PACKARD CO. 1977 * * THIS PART IS THE INITIALIZATION. ALL CODE IN THIS * SECTION MUST LIE WITHIN THE DATA BUFFER AREA 'DTBFR', * AND WILL BE OVERLAYED WITH DATA LATER. IT MUST NOT * EXCEED THE 'DTBFR' AREA SINCE THE RFAMD AND IN-CORE * DCB'S FOLLOW IMMEDIATELY AFTER. IF EXCEEDED, THE * 'EQU' AT 'CHECK' SHOULD GIVE AN ASSEMBLY ERROR. * * THE INITIALIZATION WORKS AS FOLLOW: * 1) FIND HOW MUCH ROOM WE HAVE IN THE PROGRAM * ITSELF AND AFTER THE PROGRAM, IN ITS PARTITION * 2) LINK THE RFAMD TABLE, RESERVING AS MANY * ENTRIES AS REQUIRED IN THE CALL FROM LSTEN * 3) DEPENDING ON THE ROOM LEFT,: REQUIRE DISC TRACKS * FOR THE DISC RESIDENT DCB'S. * 4) LINK THE IN-CORE DCB LIST. * * * * DESCRIPTION OF AN RFAMD ENTRY * * 1) RFAMD ENTRY IN THE ACTIVE LIST (I.E. CURRENTLY USED) * W0 POINTER TO NEXT ENTRY * W1 POINTER TO PREVIOUS ENTRY * W2-W4 FILE NAME. * W5 CARTRIDGE NUMBER * W6 ID SEGMENT ADDRESS ! FILE "OWNER" * W7 NODE NUMBER. BIT 15! IDENTIFICATION * SET INDICATES AN * EXCLUSIVE OPEN * W8 DCB POINTER. THIS WORD IS EQUAL TO 0 IF THE * DCB IS CURRENTLY DISC RESIDENT. IT IS EQUAL * TO THE ADDRESS OF THE DCB IF THE DCB IS IN * CORE. * * 2) RFAMD ENTRY IN THE FREE LIST (I.E. NOT CURRENTLY USED) * W0 POINTER TO THE NEXT ENTRY * W1-W9 DONT CARE * * * DESCRIPTION OF A DCB ENTRY * * * 1) DCB IN THE ACTIVE LIST * W0-W143 144 WORD DCB * * 2) DCB IN THE FREE LIST * W0 POINTER TO THE NEXT FREE DCB SPACE * W1-W143 DONT CARE * * * IN ALL FOUR THREADED LISTS OF THIS PROGRAM, THE END * OF LIST MARKER IS A NULL (0) POINTER TO THE NEXT ENTRY. * * FOR THE DESCRIPTION OF THE HEAD OF LIST POINTERS, REFER * TO THE "CONSTANTS" SECTION IN THE PERMANENT PART OF THIS * PROGRAM. * SPC 3 INIT JSB EXEC SWAP CONTROL DEF *+3 DEF D22 SWAP ALL PARTITION DEF D3 * * LDA XEQT GET OUR ID SEG ADR ADA D14 POINT TO WORD 15 ('TYPE') LDA A,I GET IT AND B7 ISOLATE 'TYPE' MODULO 8 CLB CPA D1 ARE WE MEMORY RESIDENT? INB YES, SO NO DCB'S IN EXTENSION STB FLG1 SET EXTENSION |FLAG * LDA XEQT GET OUR CURRENT ID SEGMENT ADDRESS ADA D23 POINT TO HI MAIN ADDR + 1 LDA 0,I GET IT STA XSTRT SAVE (XTENTION START) * LDA FLG1 GET EXTENSION FLAG SZA CAN WE HAVE DCB'S IN EXTENSION? JMP INIT4 NO LDA XSTRT YES, SO MAY BE ROOM FOR CMA,INA SOME DCB'S. ADA BGLWA CALCULATE ROOM AVAILABLE IN EXTENSION ADA DM143 FIND IF THERE IS ENOUGH CLB ROOM IN THE EXTENSION FOR AT SSA LEAST ONE DCB. INB NO, CAN'T HAVE DCB'S IN EXTENSION STB FLG1 SET A FLAG TO INDICATE THIS * * LDB #RFSZ GET THE # OF FILES REQUESTED STB RFSZ ADB DM1 TEST FOR <=0 SSB "NO SWAP" REQUEST ? JMP NOSWP YES * INIT4 CLA INITIALIZE # RFAMD ENTRIES STA ENT#1 STA ENT#T * * LINK THE FREE RFAMD LIST * THE HEAD POINTERS ARE: * BFREE (FREE LIST) * FIRST (CURRENT LIST) * LAST (LAST ENTRY REFERING TO AN IN-CORE DCB) * START (ADDRESS OF THE FIRST RFAMD ENTRY IN * LINEAR ORDER) * INIT5 LDA RFSZ GET THE # OF ENTRIES REQUESTED CMA,INA STA CNTR1 USE AS COUNTER * * THE RUNNING POINTER PNTR1 IS ALREADY INITIALIZED * LDA RFMDA GET ADDRESS OF TABLE START STA START STA BFREE STA PNTR1 SET ALL POINTERS * LOOP1 LDB FLG1 GET THE "SMALL EXTENSION" FLAG SZB,RSS SET ? JMP LOP12 NO, NO PROBLEM ADA D153 SEE IF ENOUGH ROOM LEFT IN THE INTERNAL CMA,INA BUFFER FOR ONE MORE DCB & RFAMD ENTRY ADA END SSA,RSS JMP LOP13 YES, ENOUGH ROOM CLA NO, NOT ENOUGH ROOM LDB PNTR1 ADB DM9 STEP BACK TO LAST ENTRY STA B,I SET IT AS LAST ENTRY OF THE LIST. LDA ENT#1 STA ENT#T SET THE TOTAL # OF ENTRIES JMP TREQ GO TAKE CARE OF SWAPPING * LOP12 ADA D17 CMA ADA END COMPARE WITH THE END OF THE 1ST PART SSA WILL THERE BE ENOUGH ROOM FOR THE NEXT * ENTRY? JMP INT01 NO LOP13 LDA PNTR1 YES GET CURRENT POINTER AGAIN ADA D9 GET ADDRESS OF NEXT ENTRY STA PNTR1,I SAVE AS "NEXT" TO CURRENT ENTRY STA PNTR1 PUSH CURRENT POINTER TO NEXT ENTRY ISZ ENT#1 INCREMENT # OF ENTRIES IN 1ST PART * ISZ CNTR1 INCREMENT REQUIRED-ENTRIES COUNTER JMP LOOP1 CONTINUE CLA SET THE END OF LIST MARK LDB PNTR1 ADB DM9 STEP BACK TO THE LAST ENTRY STA B,I LDA ENT#1 GET NUMBER OF ENTRIES IN PART #1 STA ENT#T SAVE AS TOTAL NUMBER OF ENTRIES JMP TREQ NOW GO DO THE TRACK REQUEST IF NECESSARY * SPC 3 * * WE COME HERE IF THERE IS NOT ENOUGH ROOM IN THE FIRST * PART (I.E. INSIDE THE PROGRAM) FOR THE ENTIRE RFAMD TABLE. * INT01 ISZ ENT#1 INC # ENTRIES IN 1ST PART LDB ENT#1 STB ENT#T SET CURRENT TOTAL # ENTRIES ISZ CNTR1 ALL DONE BUT ONE ? RSS NO JMP INT04 YES, SPECIAL CASE LDA XSTRT GET ADDRESS OF THE 1ST WORD OF 2ND PART STA PNTR1,I SAVE AS "NEXT" TO CURRENT ENTRY STA PNTR1 UPDATE RUNNING POINTER TO NEXT ENTRY JMP LOP11 CONTINUE * INT04 CLA SET THE END OF LIST MARK STA PNTR1,I LDA XSTRT STA PNTR1 RESET PNTR1 TO THE SECOND PART JMP TREQ GO REQUEST TRACKS IF NECESSARY SPC 3 LOP11 ADA D153 SEE IF WE HAVE ENOUGH SPACE FOR 1 DCB CMA AND ONE RFAMD ENTRY. ADA BGLWA COMPARE WITH FWA SYSTEM MEMORY. SSA,RSS ENOUGH ROOM ? JMP LOP21 YES CLA NO, TERMINATE THE LIST = LDB PNTR1 STEP BACK ADB DM9 TO PREVIOUS ENTRY STA B,I MARK IT AS LAST ENTRY ISZ ENT#T JMP TREQ GO TAKE CARE OF THE SWAPPING. * LOP21 LDA PNTR1 GET ADDRESS OF CURRENT ENTRY AGAIN LDB PNTR1 ADA D9 STEP TO NEXT ENTRY STA PNTR1,I SAVE AS "NEXT" TO CURRENT ENTRY STA PNTR1 UPDATE RUNNING POINTER ISZ ENT#T INC THE TOTAL NUMBER OF ENTRIES ISZ CNTR1 ALL DONE ? JMP LOP11 NO, CONTINUE CLA YES, SET THE END OF LIST MARK STA B,I SPC 3 * * BY THE TIME WE COME HERE, THE COMPLETE RFAMD LIST WILL BE * LINKED AS A FREE LIST. PNTR1 NOW POINTS TO THE NEXT * AVAILABLE WORD, I.E. THE 1ST WORD OF THE IN-CORE DCB SPACE. * WE WILL NOW CALCULATE THE NUMBER OF DCB'S WE CAN KEEP IN CORE * AT A TIME AND REQUEST DISC TRACK(S) IF THIS NUMBER IS LESS * THAN THE NUMBER OF RFAMD ENTRIES WE HAVE. * TREQ LDA PNTR1 GET ADDRESS OF NEXT WORD CMA,INA ADA END FIND # OF WORDS IN 1ST PART SSA,RSS JMP INT02 CLA A<0 => NO ROOM IN PART 1 STA PRT1# => NO DCB IN PART 1 LDA PNTR1 JMP INT03 INT02 CLB SET B FOR DIVISION DIV D144 DIVIDE SPACE BY LENGTH OF 1 ENTRY STA PRT1# SAVE THE INTEGER PART AS # DCB IN 1ST PART LDA XSTRT GET ADDRESS OF 1ST WORD OF SECOND PART * * HERE WE LOOK AT PART 2 IN THE SAME FASHION * INT03 CMA,INA ADA BGLWA GET ROOM IN XTENTION(SIGN ALREADY TESTED) CLB SET B FOR DIVISION DIV D144 LDB FLG1 GET EXTENSION FLAG SZB CAN WE HAVE DCB'S IN EXTENSION? CLA NO, SO SET PRT2# TO ZERO STA PRT2# SAVE # DCB'S IN PART 2 ADA PRT1# FIND TOTAL NUMBER OF IN-CORE DCB'S STA TOT# SAVE SPC 3 * * NOW WE DECIDE IF WE NEED ANY DISC SPACE. * LDA ENT#T GET # O*F RFAMD ENTRIES CMA,INA ADA TOT# COMPARE TO # OF IN-CORE DCB'S CLB SET FOR NEXT DIVISION SSA,RSS JMP GREAT A=0 OR A>0 * * A>=0 : * I HAVE GOOD NEWS FOR YOU: WE DONT NEED ANY DISC SPACE * THIS ALSO MEANS THAT THERE WILL BE NO DCB SWAPPING * => FASTER FILE ACCESS. GO LINK THE DCB'S * * HERE WE FIND HOW MANY TRACKS WE NEED, AND WE REQUEST * THEM. WE NEED 3 SECTORS (64 WORDS EACH) PER TRACK. * LDA $OPSY FIRST WE BETTER SEE IF RAR,RAR WE EVEN HAVE A SYSTEM DISC. SLA,RSS DO WE? JMP NOSWP NO, WE ARE IN RTE-M * LDA TRK# SEE IF THE TRACKS ARE ALREADY SZA ASSIGNED (SECOND TIME AROUND) JMP GREAT YES THEY ARE * LDA SECT2 GET THE NUMBER OF SECTORS PER TRACK DIV D3 STA DCBTR SAVE THE NUMBER OF DCB'S/TRACK LDA ENT#T GET # OF RFAMD ENTRIES CLB DIV DCBTR DIVIDE BY THE NUMBER OF DCB'S/TRACK SZB INA ROUND TO NEXT TRACK IOR BIT15 SET THE NO WAIT BIT STA TRK# SAVE * * WE SET THE NO-WAIT BIT SINCE IF WE CANT GET THE TRACKS * WE WANT WE WILL TRY TO COMPROMISE. * JSB EXEC DEF *+6 DEF D4 TRACK REQUEST DEF TRK# DEF ISTRK NUMBER OF 1ST TRACK DEF IDISC LU OF DISK DEF ISEC # SECTORS/TRACK (FORGET IT) * CCA GOOD ALLOCATION ? CPA ISTRK RSS JMP GREAT YES, GO LINK THE DCB'S SPC 3 LOWER ADA TRK# TRY TO SETTLE FOR ONE LESS TRACK STA TRK# SZA,RSS IS THIS NO TRACK AT ALL ? JMP NOSWP YES! GO TO THE OPTIMISATION ROUTINE * JSB EXEC DEF *+6 DEF D4 DEF TRK# DEF ISTRK DEF IDISC DEF ISEC * CCA CPA ISTRK HOW WAS THIS ONE ? JMP LOWER BAD, CONTINUE TO REDUCE OUR REQUEST LDA TRK# {3OK, NOW FIND HOW MANY DCB'S MPY DCBTR WE ARE ALLOWED TO HAVE STA RFSZ JMP INIT4 TRY AGAIN SPC 3 * * WE WILL FIND HERE THE LARGEST POSSIBLE # OF ENTRIES * NOT REQUIRING DCB SWAPPING. * NOSWP LDA FLG1 GET EXTENSION FLAG SZA ARE DCB'S ALLOWED IN EXTENSION? JMP NSWP2 NO, DEFAULT TO MINIMUM LDA XSTRT YES CMA,INA ADA BGLWA FIND SIZE OF INTERNAL BUFFER STA Y LDB RFMDA CMB,INB ADB END FIND THE SIZE OF THE INTERNAL BUFFER STB X ADA B TOTAL SIZE CLB DIV D153 FIND IDEAL NUMBER STA IDEAL SAVE THE RESULT MPY D9 FIND SIZE OF RFAMD IN THIS CONFIGURATION CMA,INA ADA X FIND ROOM LEFT IN 1ST BUFFER AFTER SSA THE IDEAL RFAMD HAS BEEN BUILD.ANY ROOM ? JMP NSWP1 NO * CLB DIV D144 FIND # OF DCB'S THAT WOUD BE ALLOWED TO STA IERR BE IN INTERNAL BUFFER STB IERR1 CLB LDA Y DIV D144 FIND # OF DCB'S IN EXTENSION ADA IERR TOTAL # NSWP4 SZA,RSS NONE ? JMP NSWP2 GO DEFAULT TO MINIMUM * CPA IDEAL JMP NSWP3 IDEAL, DONE LDB A INB CPB IDEAL JMP NSWP3 LDB IERR1 FIND REMAINDER OF PREVIOUS DIVISION ADB DM10 SSB EASY TO IMPROVE ? INA YES JMP NSWP3 DONE * NSWP1 CLB LDA X DIV D9 GET # RFAMD ENTRIES IN 1ST PART CMA,INA ADA IDEAL # ENTRIES IN EXTENSION STA RQLN SAVE TEMPORARILY MPY D9 RFAMD SPACE IN EXTENSION CMA,INA ADA Y DCB SPACE IN EXTENSION CLB DIV D144 # DCB'S IN EXTENSION STA IERR LDA RQLN SZA,RSS 1ST DCB STARTS AT THE BEGINNING OF XTENTION ? LDB D99 YES STB IERR1 LDA IERR  RETRIEVE # DCB'S IN EXTENSION JMP NSWP4 D23 DEC 23 * NSWP2 LDA D2 GET MINIMUM # DCB'S NSWP3 STA RFSZ JMP INIT4 SPC 3 * * HERE WE LINK THE DCB'S AS A FREE LIST * GREAT LDA PNTR1 ADDRESS OF THE FWA STA FCORE SET THE HEAD-OF-THE-FREE-DCB-LIST-POINTER * CLB CPB PRT1# DID WE FIND ROOM IN 1ST PART ? JMP INIT1 NO, => THERE IS ROOM IN PART 2 (ALREADY * TESTED FOR) * INB CPB PRT1# JMP INIT2 CURRENT IS LAST IN PART 1 LDB PRT1# CMB,INB STB CNTR1 SET COUNTER JMP LOOP4 * * IF PNTR1 IS STILL IN THE 1ST PART, WE HAVE TO UPDATE * FCORE AND PNTR1 TO XSTRT. * INIT1 CMA,INA -PNTR1 INA ADA END FIND IF PNTR1 IS IN THE 1ST PART SSA JMP INIT3 A<0 => PNTR1 IN 2ND PART, OK LDA XSTRT GET ADDRESS OF 2ND PART STA FCORE RESET FREE DCB LIST HEAD POINTER STA PNTR1 RESET RUNNING POINTER JMP INIT3 START LINKING * LOOP2 ADA D144 GET ADDRESS OF NEXT DCB STA PNTR1,I SET "NEXT" TO CURRENT STA PNTR1 UPDATE RUNNING POINTER LOOP4 ISZ CNTR1 JMP LOOP2 * INIT2 LDB PRT2# SZB,RSS IS THERE ROOM IN PART 2 ? JMP INIT6 NO, QUIT LDA XSTRT GET ADDRESS OF FWA IN 2ND PART STA PNTR1,I SAVE AS "NEXT" TO CURRENT STA PNTR1 UPDATE RUNNING POINTER * * HERE WE LINK THE 2ND PART OF THE DCB FREE LIST * INIT3 LDA PNTR1 CLB,INB GET A 1 CPB PRT2# ONLY ONE LEFT ? JMP INIT6 YES, TERMINATE * LOOP3 ADA D144 GET THE ADDRESS OF THE NEXT DCB STA PNTR1,I SAVE AS "NEXT" TO CURRENT STA PNTR1 UPDATE RUNNING POINTER INB INC COUNT CPB PRT2# DONE ? RSS YES JMP LOOP3 NO, CONTINUE * INIT6 CLA SET THE END OF LIST MARK STA PNTRo36401,I * * WE WILL NOW REPORT TO THE OPERATOR THE ACTUAL NUMBER * OF FILES IF THIS NUMBER IS NOT WHAT WAS REQUESTED. * WE WILL ALSO GIVE A REASON FOR THE CHANGE. * LDA ENT#T CCE CPA RFSZ JMP INIT7 JSB $LIBR NOP STA #RFSZ RESET #RFSZ FOR LATER RESCHEDULES JSB $CVT3 JSB $LIBX DEF *+1 DEF *+1 INA DLD A,I SET THE # OF FILES IN THE MESSAGE DST MS1A,I JSB EXEC DEF *+5 DEF D2 DISPLAY THE MESSAGE DEF D1 DEF MS1 DEF MSL1 * JMP GO * INIT7 LDA RFSZ CPA #RFSZ CHANGE DUE TO TRACK ALLOCATION PROBLEM ? JMP GO NO CCE JSB $LIBR NOP STA #RFSZ JSB $CVT3 JSB $LIBX DEF *+1 DEF *+1 INA DLD A,I FORMAT THE MESSAGE DST MS2A,I JSB EXEC DEF *+5 DEF D2 DEF D1 DEF MS2 DEF MSL2 * JMP GO PRT1# NOP PRT2# NOP TOT# NOP TRK# NOP ISEC NOP RFSZ NOP * MSL1 DEC 36 MSL2 EQU MSL1 B7 OCT 7 D17 DEC 17 D22 DEC 22 BIT15 OCT 100000 DM143 DEC -143 DM10 DEC -10 D153 DEC 153 X NOP Y NOP IDEAL NOP FLG1 NOP CHECK EQU .-* WILL GIVE ERROR IF INIT TOO LARGE RFAMD EQU . RFAMD'S START HERE * ORG .+306 LEAVE ROOM FOR 2 RFAMD'S & DCB'S * END DEF * END RFAM2 V6 ) 91740-18005 1840 S C0222 &EXECM              H0102 |ASMB,R,L,C HED EXECM: 'EXEC' REQUEST PROCESSOR * (C) HEWLETT-PACKARD CO. 1978 * NAM EXECM,19,30 91740-16005 REV 1840 780721 SPC 1 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 1 * * NAME: EXECM DS/1000 'EXEC' REQUEST MONITOR * SOURCE: 91740-18005 * RELOC: 91740-16005 * PGMR: C. HAMILTON [07/21/78] * SPC 2 EXT DRTEQ,PGMAD EXT $CLAS,$LIBR,$LIBX,$OPSY,EXEC EXT #BREJ,#GRPM,#NODE,#NCNT,#PLOG,#REQU,#RPCV,#RSAX A EQU 0 B EQU 1 KEYWD EQU 1657B XEQT EQU 1717B XTEMP EQU 1721B XPRIO EQU 1726B SUP SPC 2 EXECM JMP CONFG CONFIGURE: 1RST TIME; 'NOP' THEREAFTER. LDA B,I GET THE PASSED PARAMETER. IFZ EXT DBUG SZA JMP SETCL JSB DBUG DEF *+1 JSB EXEC DEF *+4 DEF D6 DEF D0 DEF D1 JMP EXECM+1 XIF * SETCL STA SAVCL SAVE CLASS NUMBER. IOR BIT15 PREPARE A NO-WAIT CLASS WORD # STA RDCLS FOR CLASS-READ REQUESTS. # ALR,RAR REMOVE BUFFER-SAVE BIT(#14) FROM CLASS. STA PURCL SAVE FOR CLASS-PURGE ROUTINE. AND B377 ISOLATE THE ORDINAL, # ADA DFCLS AND COMPUTE THE # STA CLTBA CLASS-TABLE ENTRY ADDRESS. # * SKP * WAITS IN GENERAL WAIT QUEUE, UNTIL A NEW REQUEST ARRIVES, * OR UNTIL A CLASS READ/WRITE/CONTROL REQUEST COMPLETES. * GET JSB EXEC PERFORM A CLASS 'GET', DEF *+8 IN ORDER TO UN-OBTRUSIVELY AWAIT DEF D21 ARRIVAL OF REQUESTS & I/O COMPLETION. DEF SAVCL SPECIFY: MONITOR'S CLASS DABFA DEF DABUF SPECIFY: DATA BUFFER ADDRESS. DEF D0 IGNORE DATA--INITIALLY. DEF SAMAD RETURNED: REQUEST BUFFER ADDRESS. DEF SAMLN RETURNED: REQUEST LENGTH. DEF SAMRC RETURNED: REQUEST CODE. * DST SAVA SAVE THE REGISTERS. * LDA D7 PREPARE FOR A STA RPLYL MINIMUM-LENGTH REPLY. CMA,INA ADA SAMLN IF THE REQUEST-LENGTH SSA IS LESS THAN THE MINIMUM: 7, JMP CLNUP IT CANNOT BE PROCESSED--IGNORE IT! * CLA SET =0, TO PREPARE STA BL/CP FOR REPLY W/O DATA. * LDA SAMLN GET THE REQUEST LENGTH. CAX PREPARE FOR POSSIBLE DMS WORD-MOVE. ADA DM16 IF THE REQUEST LENGTH SSA,RSS IS GREATER THAN 15 WORDS, JMP CLNUP THEN THE REQUEST IS UNACCEPTABLE! * LDA SAMAD SOURCE = REQUEST BUFFER IN S.A.M. LDB RQBFA DESTINATION = LOCAL REQUEST BUFFER. DMS1 MVW SAMLN OBTAIN REQUEST PARAMETERS ('MWF',IF DMS). * LDA RQBUF+4 GET THE REQUEST CODE FROM THE CALLER. STA RCODE SAVE THE REQUEST CODE FOR LATER USE. * LDB RQBUF GET THE STREAM WORD. # RBL,SLB,RBL IF THIS IS A NEW DS/3000 REQUEST, # JSB GD3K GO TO FLAG IT AS SUCH. # * # LDB SAMRC GET THE RETURNED REQUEST CODE. CLE,SZB IS THIS A NEW REQUEST? JMP RWCMP NO-PROCESS READ/WRITE/CNTRL COMPLETION. * JSB PLOG EXAMINE NEED FOR REQUEST LOGGING. * CPA D99 SPECIAL REQUEST FOR PROGRAM STATUS? JMP PGMST YES--GO TO ACCOMODATE THE CALLER. STA B NO.SAVE REQUEST CODE FOR VALIDITY CHECK. SZB IF REQUEST CODE=0--REJECT: ERROR "DS06"! ADB yUPLIM FORM A NEGATIVE TABLE INDEX. SSB,RSS 0 < REQUEST CODE < 27 ? JMP ERDS6 NO! OUT OF RANGE--ERROR: "DS06". * IOR BIT15 INCLUDE NO-ABORT BIT(#15), STA RQBUF+4 AND RESTORE THE REQUEST CODE. * ADB TABAD COMPUTE PRE-PROCESSOR ADDRESS. CLE PREPARE FOR A 'NO ERROR' REPLY. JMP B,I GO TO EXECUTE THE PRE-PROCESSING. * SPC 3 * ERROR PROCESSING SECTION. * ERDS6 LDB "06" "DS06": ILLEGAL REQUEST CODE. JMP GETDS ERDS8 LDB "08" "DS08": INSUFFICIENT RESOURCES. GETDS LDA "DS" JMP ERRTN ERIO1 LDB "01" "IO01": IMPROPER OR MISSING PARAMETER. JMP GETIO ERIO2 LDB "02" "IO02": ILLEGAL LOGICAL UNIT. JMP GETIO ERIO7 LDB "07" "IO07": DRIVER REJECTED ILLEGAL REQUEST. GETIO LDA "IO" JMP ERRTN ERSC1 LDB "01" "SC01": MISSING SCHEDULING PARAMETER. JMP GETSC ERSC2 LDB "02" "SC02": ILLEGAL SCHEDULING PARAMETER. JMP GETSC ERSC5 LDB "05" "SC05": PROGRAM NOT DEFINED. GETSC LDA "SC" * ERRTN CCE ERROR RETURN. JMP DONE * SPC 2 * "01" ASC 1,01 "02" ASC 1,02 "05" ASC 1,05 "06" ASC 1,06 "07" ASC 1,07 "08" ASC 1,08 "DS" ASC 1,DS "IO" ASC 1,IO "SC" ASC 1,SC * SKP * REPLY PROCESSING SECTION. * DONE DST RQBUF+4 STORE REGISTERS IN WORDS 5&6 OF REPLY. CLA,SEZ,RSS IF THIS IS A NORMAL RETURN, JMP CLERR GO TO CLEAR THE REPLY-ERROR INDICATOR. STA BL/CP ELSE, PREPARE FOR REPLY SANS DATA. LDB D7 ESTABLISH THE STB RPLYL MINIMUM-LENGTH REPLY. * CLERR LDA #NODE GET THE LOCAL NODE NUMBER. ELA,CLE,RAR INCLUDE ASCII-ERROR FLAG (BIT#15). STA RQBUF+6 STORE THE ERROR INDICATOR--IF ANY. * LDB CLTBA,I GET THE CLASS-HEADER ADDRESS. ADB D8 POINT TO THE DATA BUFFER. ADB BL/CP ESTABLISH THE REPLY AFTER THE DATA. STB RPLAD SAVE THE NEW REPLY ADDRESSׄ. * LDA RQBUF GET THE STREAM WORD. AND RPMSK REMOVE THE OLD RE-TRY COUNT, IOR #BREJ AND INCLUDE THE NEW. IOR BIT14 ADD THE REPLY FLAG (BIT#14). STA RQBUF RESTORE THE MODIFIED WORD. * LDA RPLYL GET THE REPLY LENGTH. CAX PREPARE FOR A DMS "MWI". CMA,INA ADA SAMLN IF THE REPLY-LENGTH EXCEEDS SSA THE AVAILABLE CLASS BUFFER, THEN INFORM JMP ERDS8 THE USER OF THE ERROR OF HIS WAYS! * JSB CLTCB GO TO CLEAR THE TRANSACTION RECORD. STA RQBUF+1 RESTORE THE ORIGINAL SEQUENCE NUMBER. * LDA RQBFA GET THE REPLY-DATA ADDRESS. LDB RPLAD GET THE REPLY ADDRESS IN S.A.M. JSB $LIBR NOP DMS2 MVW RPLYL MOVE REPLY TO CLASS BUFFER. [DMS: 'MWI'] JSB $LIBX DEF *+1 DEF REPLY * SKP * REPLY LDA RQBUF GET THE STREAM WORD. # RAL,CLE,SLA,ERA SET = DS/3000 BIT(#15)--IF ANY. # JMP LOCAL DS/3000 REPLY: REQUEUE VIA #RPCV. # LDA RQBUF+2 GET THE SOURCE NODE NO. CPA #NODE IF THE REPLY IS FOR THIS NODE, JMP LOCAL THEN RE-QUEUE IT TO <#GRPM>. * DLD #NCNT GET NRV SIZE AND ADDRESS CAX X HAS COUNTER FOR NODAL ADDRESS PAIRS * NLOOP LDA B,I GET A NODAL ADDRESS FROM THE NRV TABLE. NOP (XLA B,I IN THESE 2 INSTRUCTIONS IF DMS) INB POINT TO THE ASSOCIATED ROUTING VECTOR CPA RQBUF+2 IF THIS IS THE SOURCE-NODE ENTRY, JMP GETLU GO TO GET THE ROUTING VECTOR (LU); INB ELSE, ADVANCE THE ENTRY-POINTER, AND ISX IF ALL ENTRIES HAVE NOT BEEN CHECKED, JMP NLOOP GO TO EXAMINE THE NEXT NRV ENTRY. * JMP CLNP0 ENTRY NOT FOUND--FORGET THE REPLY! * GETLU LDA B,I ENTRY FOUND: GET THE LOGICAL UNIT NO. NOP (XLA B,I IN THESE 2 INSTRUCTIONS IF DMS) AND B77 REMOVE POSSIBLE TIMEOUT DATA. IOR B100 INCLUDE THE 'WRITE-BIT(#6)'. STA RQBUF+5 SAVE THE CONWD FOR USE BY 'CONWP'. LDA D1 SIMULATE A CLASS 'WRITE-READ' REQUEST. STA RCODE INITIALIZE PARAMETER FOR 'CONWP'. JSB CONWP GO PREPARE CONWD FOR USE BY <#REQU>. IOR ZBIT ADD DOUBLE-BUFFER BIT(#12) FOR , STA CONWD AND RESTORE THE MODIFIED CONWD. * JSB #REQU CALL <#REQU> DEF *+9 TO TRANSFER THE REPLY DEF SAVCL FROM CLASS DEF #GRPM [COMPLETION VIA <#GRPM>] DEF RQBUF+5 TO THE LU WHICH LINKS THE CALLER. DEF CONWD SPECIFY: COMM. LINE CONWORD DEF XPRIO,I PRIORITY LEVEL DEF BL/CP REPLY DATA LENGTH--IF ANY DEF RPLAD REVISED REPLY-BUFFER ADDRESS DEF RPLYL REPLY-BUFFER LENGTH SSA,RSS IF THE RE-QUEUEING WAS SUCCESSFUL, THEN JMP GET GO TO AWAIT NEXT REQUEST/COMPLETION; JMP CLNP0 ELSE, GO CLEAN UP & FORGET REPLY! * SKP * PRE-PROCESS FOR READ/WRITE AND CONTROL REQUESTS RC=1,2,3 * RWC JSB CONWP PREPARE CONTROL WORD & CHECK DEVICE. * LDB RQBUF+6 GET BUFFER LENGTH/CONTROL PARAMETER. STB BL/CP INITIALIZE <#REQU> PARAMETER. * LDA RCODE GET THE REQUEST CODE. CPA D1 IF THIS IS A READ REQUEST, JMP *+2 THEN SKIP TO CHECK FOR WRITE-READ; JMP REQUE ELSE, SIMPLY RE-QUEUE THE REQUEST. * LDA RQBUF+5 GET THE CALLER'S CONTROL WORD. ALF POSITION INTER-ACTIVE BIT(#11) TO SIGN. SSA,RSS IS THIS AN INTER-ACTIVE WRITE-READ? JMP CLSRD NO. GO TO CLASS-READ PROCESSING. # * ISZ CONWD YES. CONVERT REQUEST CODE TO 'WRITE(2)'. LDA RQBUF+8 GET WRITE LENGTH FROM OPT. PRAM. #2 STA BL/CP INITIALIZE WRITE LENGTH FOR <#REQU>.  SSA IF CHARACTERS WERE SPECIFIED, ARS CONVERT TO A NEGATIVE WORD COUNT. SSA,RSS IF CHARACTERS--SKIP: ALREADY CONVERTED. CMA,INA VERIFY THAT THE ADA SAVB SPECIFIED LENGTH IS SSA CONTAINED WITHIN RECEIVED BUFFER; JMP ERIO1 ELSE, IT'S A PARAMETER ERROR! * JSB #RSAX GO TO THE DEF *+4 TCB MANAGEMENT ROUTINE DEF D5 TO SEARCH FOR DEF RQBUF+1 THE CURRENT REQUEST DEF RQBUF ON STREAM. SSB,INB IF THE TCB EXISTS, POINT TO 2ND WORD; JMP CLNP0 ELSE, CLEAN UP: NOTHING MORE POSSIBLE! * LDA D16 ALLOW A 20 MINUTE TIMEOUT JSB STORE FOR THE WRITE-READ REQUEST. JMP REQUE GO TO RE-QUEUE THE REQUEST. * SKP * * * NOTE: THIS PROCESSOR MAY BE REPLACED BY A SIMPLE, EXPEDIENT, # * * * RE-QUEUEING OF THE CLASS-READ REQUEST, IF THE APPROPRIATE # * * * DATA BUFFER IS ALLOCATED BY , UPON ENTRY OF THE # * * * REQUEST INTO THE LOCAL NODE. # * # CLSRD LDA RQBUF+5 GET THE CALLER'S CONTROL WORD. # IOR ZBIT INCLUDE DOUBLE-BUFFER SPECIFICATION. # STA RQBUF+5 RESTORE MODIFIED CONTROL WORD. # * # JSB EXEC CALL 'EXEC' # DEF *+8 TO PERFORM # DEF D17N A CLASS-READ. # DEF RQBUF+5 SPECIFY: CALLER'S CONWORD # DEF * DUMMY READ BUFFER # DEF RQBUF+6 READ-BUFFER LENGTH # DEF RQBUF REQUEST-BUFFER ADDRESS # DEF SAMLN REQUEST-BUFFER LENGTH # DEF RDCLS CLASS--NO WAIT. # JMP ERRTN SYSTEM-DETECTED ERROR--TELL CALLER! # * # SZA IF THE REQUEST WAS NOT PROPERLY QUEUED,# JMP ERDS8 THEN, TELL CALLER: RESOURCE PROBLEM; # JMP CLNP0 ELSE, CLEAN UP & AWAIT COMPLETION # * # * READ/WRITE/CONTROL CLASS-COMPLETION PROCESSING * RWCMP CPB D3 IF IT IS A CONTROL REQUEST, JMP FINIS THEN GO TO PREPARE THE REPLY. [=0] LDA RQBUF+5 GET THE CALLER'S CONTROL WORD. ALF,ELA POSITION WRITE-READ BIT(#11) TO . LDA RQBUF+6 GET THE CALLER'S DATA-LENGTH VALUE. CPB D1 IF A 'READ' HAS COMPLETED, THEN JMP LENCK GO TO PROCESS THE REPLY DATA-LENGTH. CLB,SEZ,CLE,INB,RSS IF NORMAL WRITE-COMPLETION, JMP FINIS GO TO PREPARE THE REPLY. * STA BL/CP WRITE-READ: SAVE READ LENGTH FOR <#REQU>, STB RCODE AND INITIALIZE 'RCODE' FOR 'CONWP'. JSB CONWP GO TO PREPARE CONTROL WORD FOR <#REQU>. JMP REQUE RE-QUEUE AS 'READ' FOR SPECIFIED DEVICE. * LENCK LDB SAVB GET THE TRANSMISSION LOG: +CHARS/+WORDS CLE,SSA,RSS IF CHARACTERS WERE SPECIFIED, SKIP; JMP SETLN ELSE, GO TO SAVE THE WORD COUNT. SLB,BRS CONVERT CHARACTER COUNT TO WORDS, AND INB IF ODD ADD ONE TO THE WORD COUNT. SETLN STB BL/CP SAVE THE REPLY DATA-LENGTH FOR <#REQU>. * FINIS LDA SAVA GET EQT5 STATUS WORD. AND BIT14 ISOLATE THE "DRIVER-REJECT" BIT(#14). CLE,SZA IF THE DRIVER REJECTED THE REQUEST, JMP ERIO7 THEN INFORM CALLER OF ERROR: "IO07"; DLD SAVA ELSE, GET THE REGISTERS FOR CALLER. JMP DONE GO COMPLETE THE REPLY.[=0: NO ERRORS] * SKP * RE-QUEUEING PROCESSOR: CONSERVE ALREADY-ALLOCATED SYSTEM RESOURCES * BY RE-Q,UEUEING THE REQUEST AS A CLASS-I/O REQUEST FOR A DEVICE. * REQUE JSB #REQU CALL <#REQU>, TO MOVE DEF *+7 THE CURRENTLY-QUEUED REQUEST DEF SAVCL FROM CLASS, TO THE DEVICE; DEF SAVCL WITH COMPLETION REPORTED TO . DEF RQBUF+5 SPECIFY: DEVICE LOGICAL UNIT NUMBER DEF CONWD CONFIGURED CONTROL WORD DEF XPRIO,I PRIORITY LEVEL DEF BL/CP BUFFER LENGTH/CONTROL PARAMETER * SSA,RSS IF THE RE-QUEUEING WAS SUCCESSFUL, JMP GET THEN, GO TO AWAIT COMPLETION; JMP ERDS8 ELSE, REPORT: RESOURCE ERROR! * * THE 'CONWP' SUBROUTINE PREPARES THE ACTUAL CONWORD WHICH IS TO BE * PASSED TO THE DEVICE DRIVER. THE CONWORD WILL INCLUDE ALL ITEMS * WHICH NORMALLY CONFIGURES: 'T'-FIELD[BITS#15,14-ADDED BY #REQU], * SUB-CHANNEL(BITS#13,5-2),SUBFUNCTION(BITS#10-6),RCODE(BITS#1-0). * [THIS PROCESSOR IS REQUIRED, DUE TO THE LACK OF ACCESS TO * 'WORD2' PROCESSOR]. * CONWP NOP ENTRY/EXIT: CONTROL WORD PREPARATION LDA RQBUF+5 GET THE CALLER-SUPPLIED CONWORD. AND B3700 ISOLATE SUBFUNCTION(BITS#10-6) STA CONWD SAVE THEM, TEMPORARILY. JSB DRTEQ GO TO GET THE DEF *+3 LU-LOCK & SUB-CHANNEL BITS DEF RQBUF+5 FOR THE SPECIFIED DEF DRTEN LOGICAL UNIT NUMBER. SSB,RSS IS IT AN INVALID LOGICAL UNIT, SZB,RSS OR IS IT LINKED TO THE 'BIT BUCKET'? JMP ERIO2 YES, TELL CALLER: LOGICAL UNIT ERROR! AND B3700 IF THE LOGICAL UNIT SZA IS CURRENTLY LOCKED, JMP ERDS8 THEN REJECT THE REQUEST: 'DS08'. * ADB D4 POINT TO FIFTH WORD OF THE EQT ENTRY. LDB B,I GET THE EQT'S STATUS WORD. RBL,CLE,SLB IF BIT #15 IS SET, THEN IT'S BUSY, JMP *+3 OR AWAITING A DMA CHANNEL--CONTINUE; SSB ELSE, IF THE DEVICE IS DOWN, T>HEN JMP ERDS8 REJECT THE REQUEST: RESOURCE PROBLEM! * LDA DRTEN GET THE DRT ENTRY, AGAIN. AND B174K ISOLATE SUB-CHANNEL BITS FROM DRT ENTRY. ELA,ALF POSITION MSB TO , AND RAL,RAL POSITION LSB'S TO BITS #5-2. IOR CONWD INCLUDE THE CALLER'S SUBFUNCTION, AND SEZ IF THE SUB-CHANNEL MSB WAS SET, THEN IOR B20K SET BIT #13 OF THE CONWORD, ALSO. IOR RCODE INCLUDE CALLER'S REQUEST CODE, AND STA CONWD SAVE THE CONWD FOR USE BY <#REQU>. JMP CONWP,I RETURN. * * PROGRAM SCHEDULE, TIMED EXECUTION, AND PROGRAM COMPLETION * PKILL EQU * PROGRAM TERMINATION. RC=6 * SCHED JSB PSTAT GO TO GET PROGRAM STATUS. RC=10,12 SZA ANY ATTEMPT TO CPA XEQT REMOTELY CONTROL JMP ERSC5 IS UN-ACCEPTABLE! ERROR: "SC05". * LDB RCODE GET THE REQUEST CODE. CPB D6 PROGRAM TERMINATION REQUEST? JMP *+2 YES. SKIP TO DETERMINE LINEAGE. JMP SCHD0 NO. IT'S A NORMAL SCHEDULE REQUEST. * ADA D20 POINT TO WORD #21 IN I.D. SEGMENT. LDA A,I GET THE CONTENTS. AND B377 ISOLATE THE FATHER'S I.D. SEG. NO. ADA KEYWD COMPUTE THE ADDRESS OF ADA DM1 THE KEYWORD TABLE ENTRY. LDA A,I GET THE FATHER'S I.D. SEGMENT ADDRESS. CPA XEQT OUR OFFSPRING? JMP SCHD0 YES, WE CAN HONOR THE REQUEST. JMP PASON NO. MUST HAVE BEEN THE SIRE. * SCHD0 LDA SAMLN GET THE REQUEST BUFFER SIZE. LDB RTNDF GET THE DEFAULT RETURN POINTER. ADA DM8 SUBTRACT THE MINIMUM REQUEST SIZE. ADB A COMPUTE THE ACTUAL RETURN ADDRESS, STB RTNAD AND CONFIGURE THE RETURN POINTER. SZA,RSS ANY ADDITIONAL PARAMETERS? JMP SCHD2 NO. GO CLEAR REMAINDER OF CALL BUFFER. SSA WERE WE SUPPLIED WITH ENWOUGH PARAMETERS? JMP ERSC1 NO. * ERROR: SC01 ! * CAX YES. SAVE ADDITIONAL PARAMETER COUNT. LDA PR3DF = ADDRESS OF NEXT USER-PARAMETER LDB RTNDF =ADDRESS OF NEXT CALL-BUFFER LOCATION. SCHD1 STA B,I STORE PARAM ADDR INTO CALL BUFFER. INA ADVANCE PARAMETER POINTER. INB ADVANCE CALL BUFFER POINTER. DSX ALL PARAMETERS PROCESSED? JMP SCHD1 NO. PROCESS THE NEXT ONE. * CLA PREPARE TO CLEAR REST OF CALL BUFFER. SCHD2 CPB LASTA LAST CALL BUFFER LOCATION CLEARED? JMP SCHD3 YES. GO TO COMPLETE THE CALL. STA B,I NO. CLEAR THE LOCATION. INB ADVANCE THE CALL BUFFER POINTER, AND JMP SCHD2 GO TO CLEAR THE NEXT LOCATION. * SKP SCHD3 LDA STRAD+1 GET THE STRING-SIZE POINTER--IF ANY. SZA,RSS PASSING A STRING TO THE PROGRAM? JMP SCHD4 NO. BYPASS DATA BUFFER RECOVERY. LDA SAVB YES. GET THE DATA BUFFER SIZE. CAX SAVE COUNT FOR POSSIBLE DMS MOVE. CMA,INA,SZA,RSS FORM A NEGATIVE VALUE. ANY DATA? JMP ERSC2 NO--IMPROPER PARAMETERS! * LDB D512 GET MAXIMUM DATA BUFFER SIZE. ADB A IF THE TRANSMITTED DATA BUFFER SSB EXCEEDS THE ALLOWABLE SIZE, JMP ERSC2 THEN THE REQUEST CANNOT BE PROCESSED! * ADA SAMAD COMPUTE DATA BUFFER ADDRESS IN S.A.M. LDB DABFA GET THE LOCAL DATA BUFFER ADDRESS. STB STRAD ESTABLISH STRING-BUFFER ADDRESS IN CALL. DMS4 MVW SAVB MOVE DATA TO LOCAL BUFFER [DMS: MWF]. * SCHD4 DLD ERRIN LOAD THE ERROR-DETECTION INSTRUCTIONS. DST RTNAD,I STORE THEM AT END OF CALLING SEQUENCE. * * THE CONFIGURED 'EXEC' CALLING SEQUENCE IS EXECUTED BELOW. * JSB EXEC BUFFER FOR ASSEMBLING EXEC REQS. RTNAD DEF PR3AD RETURN POINTER (CONFIGURED). DEF RQBUF+4 REQUEST CODE (SUPPLIED BY CALLER)  DEF RQBUF+5 POINTER TO FIRST REQUEST PARAMETER. PR3AD NOP CONFIGURED POINTERS (7-MAX.) TO NOP USER-SUPPLIED CALLING-PARAMETERS, NOP WHICH RESIDE IN THE REQUEST BUFFER. NOP UN-USED CALLING-SEQUENCE LOCATIONS ARE NOP DYNAMICALLY CHANGED TO 'NOP'. STRAD NOP STRING-BUFFER ADDRESS--IF ANY. NOP STRING-LENGTH POINTER--IF ANY. NOP [ ERROR-DETECTION INSTRUCTIONS: WILL BE NOP POSITIONED TO FOLLOW LAST POINTER ] ENDBF JMP DONE REQUEST COMPLETED. =0:NORMAL;=1:ERROR * SPC 2 * * TIME REQUEST PROCESSING RC=11 * STIME LDA D13 GET THE REPLY SIZE. STA RPLYL SET THE REPLY LENGTH * JSB EXEC REQUEST CURRENT SYSTEM TIME. DEF *+4 DEF RQBUF+4 RCODE = 11 (SIGN IS SET). DEF RQBUF+7 TIME IS RETURNED TO REPLY BUFFER. DEF RQBUF+12 SO IS THE YEAR. CCE RETURN ERROR-INFO TO THE CALLER! JMP DONE ALL IS WELL--RETURN THE TIME DATA. * SKP * I/O OR PARTITION STATUS-REQUEST PROCESSING * PARST EQU * RC=25 ISTAT LDA D10 GET THE REPLY SIZE. RC=13 STA RPLYL SET THE LENGTH OF THE REPLY * JSB EXEC REQUEST STATUS FOR THE I/O DEVICE. DEF *+6 DEF RQBUF+4 RCODE = 13/25 (SIGN IS SET). DEF RQBUF+5 CONWORD(LU) / PARTITION NUMBER DEF RQBUF+7 RETURN- RC=13: EQT#5 / RC=25: FIRST PAGE PR3DF DEF RQBUF+8 RETURN- RC=13: EQT#4 / RC=25: NO. PAGES DEF RQBUF+9 RETURN- RC=13: LU STAT/RC=25: PART. STAT CCE 'EXEC' ERROR-INFO RETURNED TO CALLER. JMP DONE RETURN TO CALLER WITH STATUS INFO. SPC 1 PASON LDA RQBUF GET THE STREAM WORD RC=6,9,23,24 XOR D6 CONVERT TO STREAM-3 . LDB SAMAD GET REQUEST BUFFER ADDRESS IN S.A.MB. JSB STORE GO TO REPLACE STREAM TYPE IN CLASS BUFFER. JSB CLTCB GO TO CLEAR RECORD FROM STREAM. LDB SAMAD POINT TO THE SECOND WORD OF THE REQUEST CLE,INB BUFFER IN S.A.M. [=0:PASS TO <#GRPM>] JSB STORE REPLACE THE ORIGINAL SEQUENCE NUMBER. * LOCAL LDA #GRPM DESTINATION CLASS IS <#GRPM'S>, # SEZ UNLESS THIS IS A DS/3000 REPLY, # LDA #RPCV IN WHICH CASE, IT'S <#RPCV'S> CLASS. # STA CLTCB ESTABLISH THE DESTINATION CLASS NUMBER.# LDA RQBUF GET THE STREAM WORD. # AND BIT14 ISOLATE THE REPLY FLAG(BIT#14) # SZA,RSS IS THIS A REPLY, OR A FORWARD PASS? # JMP LOCRQ FORWARD PASS: SET PLAY IN MOTION. # * LDB CLTBA,I REPLY: GET CLASS HEADER ADDRESS. # ADB D2 POINT TO THE THIRD WORD. # LDA FAKST GET FAKE DVA65 STATUS (32401B) FOR GRPM# JSB STORE REPLACE STATUS WORD IN CLASS HEADER. # ADB D3 ADVANCE POINTER TO WORD #6. # LDA BL/CP GET THE REPLY DATA LENGTH. # JSB STORE REPLACE THE TRANSMISSION LOG IN HEADER.# INB ADVANCE POINTER TO FIRST OPT. PARAMETER# LDA RPLAD GET THE NEW REPLY-BUFFER ADDRESS. # JSB STORE REPLACE THE FIRST OPTIONAL PARAMETER. # INB ADVANCE POINTER TO SECOND OPT. PARAM. # LDA RPLYL GET THE REPLY LENGTH. # JSB STORE REPLACE THE SECOND OPTIONAL PARAMETER. # * LOCRQ JSB #REQU RE-QUEUE DEF *+3 THE REQUEST DEF SAVCL FROM CLASS DEF CLTCB ONTO THE DESTINATION CLASS. SSA,RSS IF THE OPERATION WAS SUCCESSFUL, JMP GET GO TO AWAIT NEXT REQUEST/COMPLETION; JMP CLNP0 ELSE, SIMPLY CLEAN UP--WHAT ELSE? * * THE FOLLOWING PROGRAM-STATUS REQUEST PROCESSING IS SUPPORTED * >>>>>>>>>>>>>>>> +:NLHIN DS/1000 NETWORKS--ONLY! <<<<<<<<<<<<<<<< * PGMST JSB PSTAT GO TO GET THE PROGRAM'S STATUS. RC=99 SZA DOES THE PROGRAM EXIST? JMP GETST YES. GO TO PROCESS THE STATUS. CCA NO. SET =-1 FOR ERROR INDICATION! JMP RTNER GO TO RETURN THE ERROR INFORMATION. * GETST LDA B GET THE STATUS WORD. AND D15 ISOLATE THE STATUS. RAL,ERA INCLUDE THE 'SEGMENT' FLAG. RTNER STA RQBUF+7 SAVE FOR RETURN TO THE CALLER. LDB D8 ESTABLISH A STB RPLYL REPLY LENGTH OF 8 WORDS. CLB,CLE =0 FOR RETURN TO CALLER. JMP DONE RETURN THE INFO TO THE CALLER. VN* HED EXECM: PROCESSING SUBROUTINES.* (C) HEWLETT-PACKARD CO. 1978 * * CLNUP JSB CLTCB ELIMINATE RECORD OF OFFENDING REQUEST. JMP CLNP0 COMPLETE THE CLEAN UP PROCESS. * SPC 3 CLTCB NOP ENTRY/EXIT: TCB-CLEARING PROCESSOR. JSB #RSAX GO TO THE TCB-MANAGEMENT PROCESSOR DEF *+4 TO CLEAR THE RECORD OF THE CURRENT DEF D7 SLAVE-STREAM ENTRY - WHICH IS DEF RQBUF+1 IDENTIFIED BY IT'S SEQUENCE NUMBER- RQBFA DEF RQBUF AND STREAM NO. SSB,RSS IF THE OPERATION WAS SUCCESSFUL, JMP CLTCB,I RETURN TO CALLER. [= ORIG. SEQ. NO.] * CLNP0 JSB #REQU RESET THE POSSIBLE DEF *+3 NEGATIVE BLOCK-SIZE WORD, DEF PURCL BEFORE ATTEMPTING TO DEF DM1 RELEASE THE CLASS BUFFER. * SSA IF SOMETHING FAILED, JMP GET THEN NOTHING MORE CAN BE DONE! * JSB EXEC RETURN THE CURRENT CLASS BUFFER. DEF *+5 DEF D21 CLASS GET. DEF PURCL CLASS/BUFFER RELEASE/SAVE CLASS. DEF DABUF DUMMY DATA-BUFFER ADDRESS. DEF D0 DATA NOT DESIRED. JMP GET RETURN TO AWAIT A NEW REQUEST/COMPLETION. * SPC 3 PSTAT NOP PROGRAM STATUS SUBROUTINE. JSB PGMAD DEF *+2 DEF RQBUF+5 PROGRAM 'NAME' IS IN REQUEST BUFFER. JMP PSTAT,I RETURN. * SPC 3 STORE NOP STORE , VIA , INTO PROTECTED AREA. JSB $LIBR D0 NOP DMS3 STA B,I [ DMS: XSA B,I ] NOP JSB $LIBX DEF STORE * SKP * PLOG NOP REQUEST BUFFER LOGGING ROUTINE. LDB #PLOG GET THE REQUEST-LOGGER'S CLASS NO. SZB,RSS IS LOGGING DESIRED? JMP PLOG,I NO. RETURN TO NORMAL PROCESSING. STB STORE YES. SAVE THE CLASS NO. LOCALLY. * JSB EXEC WRITE DEF *+8 THE DEF D20N REQUEST DEF ZBIT BUFFER, DEF DABUF IN THE DEF D0 EXPECTED DEF RQBUF FORMAT, DEF SAMLN TO THE DEF STORE LOGGER'S NOP CLASS. * LDA RCODE RECOVER THE REQUEST CODE, JMP PLOG,I AND CONTINUE NORMAL PROCESSING. * SPC 2 * * THIS CODE IS REQUIRED BECAUSE <#RQCV> DOES NOT REQUEUE INCOMING REQUESTS. * GD3K NOP DS/3000 NEW-REQUEST ANALYSIS. # SSB IS THIS AN I/O COMPLETION? # JMP GD3K,I YES. RETURN FOR NORMAL PROCESSING. # LDA B20K NO. GET THE OLD REQUEST BIT(#13), # IOR RQBUF AND ADD IT TO THE STREAM WORD. # STA RQBUF SAVE MODIFIED WORD FOR CLASS READ. # LDB SAMAD GET REQUEST BUFFER ADDRESS IN S.A.M. # JSB STORE SET THE FLAG FOR NEXT ENTRY. # CLB SIMULATE NEW REQUEST FROM <#REQU> # LDA RCODE RESTORE . # ISZ GD3K BYPASS LOAD OF RETURNED CLASS RC # JMP GD3K,I RETURN TO NORMAL PROCESSING. # * HED EXECM: CONSTANTS/VARIABLES/TABLES * (C) HEWLETT-PACKARD CO. 1978 DM16 DEC -16 DM8 DEC -8 DM1 DEC -1 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D10 DEC 10 D13 DEC 13 D15 DEC 15 D16 DEC 16 D20 DEC 20 D17N OCT 100021 CLASS-READ/NO-ABORT # D20N OCT 100024 CLASS WRITE-READ--NO ABORT. D21 DEC 21 D99 DEC 99 PROGRAM STATUS REQUEST CODE. D512 DEC 512 MAXIMUM DATA BUFFER SIZE. CONWD NOP CONFIGURED CONTROL WORD STORAGE. B77 OCT 77 B100 OCT 100 'WRITE' INDICATOR. B377 OCT 377 BIT14 OCT 40000 STREAM-WORD REPLY FLAG. BIT15 OCT 100000 RCODE NOP CURRENT REQUEST CODE. RPMSK OCT 170077 STREAM-WORD RETRY-COUNT MASK. B3700 OCT 3700 LU-LOCK/CONW"ORD SUBFUNCTION MASK. B20K OCT 20000 SUB-CHANNEL 'MSB' FOR CONWORD. B174K OCT 174000 DRT SUB-CHANNEL ISOLATION MASK. FAKST OCT 32401 SIMULATED DVA65 GOOD-COMPLETION STATUS. ZBIT OCT 10000 DOUBLE-BUFFER BIT(#12). SAMAD NOP REQUEST BUFFER ADDRESS IN S.A.M. SAMLN NOP REQUEST BUFFER LENGTH. SAMRC NOP RETURNED I/O REQUEST CODE. * RPLAD NOP REVISED REPLY-BUFFER ADDRESS IN S.A.M. RPLYL NOP REPLY LENGTH (CONFIGURED). BL/CP NOP BUFFER LENGTH/CONTROL PARAMETER RTNDF DEF PR3AD LASTA DEF ENDBF * * * * DO NOT CHANGE ORDER OF NEXT 4 STATEMENTS * * * * ERRIN CCE,RSS CONFIGURED-'EXEC'-REQUEST CLE ERROR-DETECTION INSTRUCTIONS. SAVA NOP REGISTER STORAGE FOR SAVB NOP AND FOR . * * * * * * * * * * * * * * * * * * * * * * * * * * * SKP * * PRE-PROCESSOR 'JUMP' TABLE. * LOW1 DEF RWC RCODE 1 = READ REQ DEF RWC RCODE 2 = WRITE REQ DEF RWC RCODE 3 = CONTROL DEF ERDS6 RCODE 4 = UNDEFINED(DISC ALLOC) DEF ERDS6 RCODE 5 = UNDEFINED (PKG.TRK.REL) DEF PKILL RCODE 6 = PROGRAM TERMINATION DEF ERDS6 RCODE 7 = UNDEFINED(PRG.SUSPEND) DEF ERDS6 RCODE 8 = UNDEFINED(SEG.LOAD) DEF PASON RCODE 9 = SCHEDULE W/WAIT DEF SCHED RCODE 10= PROGRAM SCHED(WON'T WAIT) DEF STIME RCODE 11= TIME REQUEST DEF SCHED RCODE 12= EXECUTION TIME DEF ISTAT RCODE 13= I/O STATUS DEF ERDS6 RCODE 14= UNDEFINED (STRING GET) DEF ERDS6 RCODE 15= UNDEFINED (GLOBAL TRK. ALLOC.) DEF ERDS6 RCODE 16= UNDEFINED (GLOBAL TRK. RLS.) DEF ERDS6 RCODE 17= UNDEFINED (CLASS READ) DEF ERDS6 RCODE 18= UNDEFINED (CLASS WRITE) DEF ERDS6 RCODE 19= UNDEFINED (CLASS CONTROL) DEF ERDS6 RCODE 20= UNDEFINED (CLASS WRITE-READ) DEF ERDS6 RCODE 21= UNDEFINED (CLASS GET) DEF ERDS6  RCODE 22= UNDEFINED (SWAP CONTROL) DEF PASON RCODE 23= QUEUE-SCHEDULE W/WAIT DEF PASON RCODE 24= QUEUE-SCHEDULE W/O WAIT DEF PARST RCODE 25= PARTITION STATUS DEF ERDS6 RCODE 26= UNDEFINED (MEMORY SIZE RTE-IV) TABAD DEF *,I * UPLIM ABS LOW1-* REQUEST CODE LIMIT-VALUE: -(MAX. RCODE+1) * SPC 2 DABUF BSS 512 DATA BUFFER DRTEN EQU DABUF TEMPORARY STORAGE: DRT ENTRY. RQBUF BSS 15 REQUEST BUFFER SAVCL NOP CLASS NO. W/BUFFER-SAVE & CLASS-SAVE PURCL NOP CLASS NO. W/CLASS-SAVE ONLY. RDCLS NOP SAME AS 'SAVCL' W/NO-WAIT # CLTBA NOP CURRENT CLASS BUFFER POINTER. # DFCLS DEF $CLAS CLASS TABLE ADDRESS. # * HED EXECM: INITIAL CONFIGURATION * (C) HEWLETT-PACKARD CO. 1978 ORG DABUF CONFIGURATION: EXECUTED ON FIRST ENTRY. * CONFG LDA $OPSY GET THE SYSTEM SPECIFICATION. AND D2 ISOLATE THE DMS BIT(#1). SZA,RSS IF THIS IS NOT A DMS SYSTEM, JMP NODMS THEN NO NEED TO MODIFY CODE; DLD MWFI ELSE, CHANGE DST DMS1 THE 'MVW' MACRO'S DST DMS4 TO 'MWF' DMS-EQUIVALENTS, DLD MWII AND CHANGE OTHER 'MVW' DST DMS2 TO A 'MWI' DMS-EQUIVALENT. DLD XLAI CHANGE THE 'LDA B,I' DST NLOOP INSTRUCTIONS TO DMS'S DST GETLU 'XLA B,I' EQUIVALENT. LDA XSAI CHANGE THE 'STA B,I' INSTRUCTION DST DMS3 TO DMS'S 'XSA B,I' EQUIVALENT. * NODMS CLA NO NEED TO STA EXECM GO THRU THIS AGAIN! * LDB DFCLS GET A # RSS DIRECT ADDRESS # LDB B,I FOR THE # RBL,CLE,SLB,ERB BEGINNING # JMP *-2 OF THE # STB DFCLS CLASS TABLE.  # * LDB XTEMP GET POINTER TO SCHEDULING PARAMETER, JMP EXECM+1 AND GO TO START OPERATIONS. * MWFI MWF NOP MWII MWI NOP XLAI XLA B,I XSAI OCT 101725 'XSA' INSTRUCTION * * ORR SIZE * END EXECM ~  91740-18006 2026 S C0122 &OPERM +              H0101 ASMB,R,L,C HED OPERM 91740-16006 REV 2026 * (C) HEWLETT-PACKARD CO. 1977 NAM OPERM,19,30 91740-16006 REV 2026 800429 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT OPERM EXT MESSS,EXEC,D65SV,D65GT EXT #NODE IFZ EXT DBUG XIF SUP * * OPERM * SOURCE: 91740-18006 * BINARY: 91740-16006 * PRGMR: BOB SHATZER * DATE: 29 DEC 75 * MODIFIED BY JEAN-PIERRE BAUDOUIN * DATE: JULY 1976 * MODIFIED BY GAB * DATE: JULY 1979 * * OPERM IS THE CCE MONITOR WHICH RECEIVES OPERATOR REQUESTS INIT- * IATED BY A REMOTE CPU. THIS MONITOR OPERATES ON STREAM 7. * OPERM LDA B,I GET INPUT PARAMETER IFZ SZA,RSS IS IT A ZERO? JMP *+3 YES - CALL DEBUG XIF STA CLSN NO - NORMAL SCHEDULE - SAVE CLASS NUMBER JMP OPER1 GO TO GET THE FIRST REQUEST * IFZ JSB DBUG CALL DEBUG IF P1 WAS 0 DEF *+1 JSB EXEC TERMINATE...SAVE RESOURCES DEF *+4 DEF B6 DEF B0 DEF B1 JMP OPERM TRY AGAIN XIF * OPER1 JSB D65GT WAIT FOR REQUEST DEF *+6 DEF CLSN CLASS # DEF PARMB REQUEST BUFFER DEF D25 MAX LENGTH =25 DEF B0 NO DATA ASSOCIATED DEF B0 JMP OPER1 IGNORE THE COMMUNICATION ERROR * LDA PARMB+4 GET LENGTH SZA,RSS IF ZERO...SEND BACK ZERO TO THEM JMP DONE * JSB MESSS CALL SYSTEM MSG PROCESSOR WITH MESSAGE DEF *+3 DEF PARMB+5 THE REPLY WILL COME IN THE SAME AREA DEF PARMB+$4  4 * CMA,INA MAKE SYSTEM REPLY LENGTH POSITIVE BYTES CLE,ERA MAKE THIS POSITIVE WORDS SEZ INA DONE STA RPLY+7 SAVE LENGTH IN WORDS INTO REPLY ADA D8 ADD STANDARD LENGTH OF PARMB STA LEN SAVE AS REPLY LENGTH * DLD PARMB GET STREAM TYPE & SEQUENCE NO. IOR BIT14 SET IN FOR REPLY DST RPLY SAVE AS REPLY STREAM & SEQ. NO. * DLD PARMB+2 DST RPLY+2 MOVE THE REQUEST HEADER CLA CLEAR CLB ERROR DST RPLY+4 LOCATIONS. LDA #NODE GET LOCAL NODE # STA RPLY+6 * JSB D65SV SEND REPLY DEF *+5 DEF RPLY DEF LEN DEF B0 DEF B0 NOP IGNORE THE ERROR RETURN * JMP OPER1 WAIT FOR ANOTHER REQUEST * B EQU 1 B0 OCT 0 B1 OCT 1 B6 OCT 6 D8 DEC 8 D25 DEC 25 BIT14 OCT 40000 CLSN NOP RPLY BSS 3 DO NOT REARANGE THIS AREA PARMB BSS 28 LEN NOP * END OPERM   91740-18007 1913 S C0122 DS/1000 MODULE: PTOPM              H0101 IASMB,R,L,C HED PTOPM 91740-16007 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 NAM PTOPM,19,30 91740-16007 REV 1913 781130 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT PTOPM EXT EXEC,$OPSY EXT D65SV,#REQU,#PLOG,PGMAD,#NODE SPC 3 * * PTOPM * SOURCE:91740-18007 * BINARY:91740-16007 * PGMR: CHUCK WHELAN * DATE: DEC 1976 * * MODIFIED BY: LYLE WEIMAN, AUG '78 SPC 3 * THIS IS THE DS/1000 VERSION OF PTOPM * * IT RECEIVES NEW REQUESTS FOR THE FOLLOWING P TO P FUNCTION CODES: * 1 = POPEN * 2 = PREAD * 3 = PWRIT * 4 = PCONT * 5 = PCLOS (BIT 7= 1 IF GENERATED BY LOCAL "FINIS") * 6 = SLAVE OFF * 7 = SLAVE LIST * * PTOPM MAINTAINS PARALLEL TABLES OF OPEN SLAVE PROGRAM ID SEGMENT * ADDRESSES AND THEIR CORRESPONDING CLASS NUMBERS. THESE TABLES * ARE USED TO DETERMINE THE CLASS NUMBER FOR RETHREADING THE * CLASS BUFFER ON "POPEN","PREAD","PWRIT", AND "PCONT" REQUESTS. * "PCLOS", "SLAVE OFF" AND "SLAVE LIST" REQUESTS ARE HANDLED WITHIN * PTOPM WHICH DOES THE NECESSARY PROCESSING AND SENDS THE REPLY VIA * "D65SV" (EXCEPT FOR LOCAL "FINIS" REQUESTS WHICH HAVE NO REPLY). * SKP PTOPM LDA 1,I IS P1=I/O CLASS STA CLASS PTOPM CLASS ALR,RAR CLEAR SAVE BUFFER BIT STA CLAS2 FOR "CLSAM" ROUTINE CLB LDA $OPSY RAR,SLA SKIP IF NON-DMS STB MOD1 SET FOR DMS * * ISSUE GET ON I/O CLASS GET JSB EXEC GET REQUEST DEF *+7 DEF K21N DEF CLASS DEF IRBUF DEF K0 DEF BFADR AD DR OF REQUEST IN SAM DEF RQLEN RCVD REQUEST LENGTH NOP * LDA RQLEN ADA N7 SSA REQ LENGTH >= 7? JMP EROUT NO, ERROR ADA N25 SSA,RSS REQ LENGTH < 32? JMP EROUT NO ,ERROR * LDA BFADR LDB RQADR SET TO MOVE REQUEST TO INTERNAL BUFFER MOD1 JMP RQLOC NOP HERE IF DMS LDX RQLEN MWF MOVE REQUEST FROM SYSTEM MAP JMP *+4 * RQLOC MVW RQLEN MOVE REQUEST * CLA STA $ERR+1 INITIALIZE ERROR STA $ENOD FIELDS LDA $PCB STA IDSEG SAVE POSSIBLE ID SEG ADDR LDA $FUNC AND K7 ISOLATE FUNCTION CODE ADA CODEA ADD ADDRESS OF PROCESS TABLES JMP 0,I AND GO DO IT SPC 3 EROUT JSB CLSAM IRRECOVERABLE ERROR, CLEAR SAM JMP GET & GO BACK TO "GET" * SKP * * PROCESS "POPEN" OPENP JSB PGMAD CONVERT PGM NAME TO ID SEG ADDR DEF *+2 DEF $NAME SZA,RSS WAS ID SEGMENT FOUND? JMP ER41 NO STA IDSEG SAVE ID SEGMENT ADDRESS CCA SET FLAG TO SAY WE WILL ALLOW PROGRAM STA CLSAM TO BE DORMANT * JSB SERCH THIS PGM ALREADY OPEN? JMP SCD1 YES, BE SURE SLAVE PROGRAM IS ALIVE. * SEZ,RSS IS TABLE FULL? JMP ER42 YES, ERROR * LDB FSTAD 1ST AVAILABLE ENTRY ADDR STB SEGAD LDA IDSEG STA 1,I SET THIS ID SEG ADDR INTO SLAVE LIST ADB NTOTL STB CLSAD ADDR FOR CLASS # * LDA BIT13 GET "NEW CLASS" CLASS WORD STA CLSAD,I TO SET UP CALL * JSB EXEC GET THE I O CLASS NUMBER DEF *+8 BY GETTING AN I-O CLASS DEF K20 DEF K0 DEF IRBUF DEF K1 DEF K1 DEF K1 DEF CLSAD,I SZA HOW WAS THE ALLOCATION ? JMP ERMS BAD, ERROR EXIT STA CLSAM SET FLAG T%7O SAY PROGRAM MUST NOT BE DORMANT. * CLEAR REQUEST LDA CLSAD,I STA *+2 JSB DOGET THE PREVIOUS WRITE READ LEFT NOP A DUMMY REQUEST IN THE CLASS, CLR IT. K0 NOP IGNORE ABORT CONDITION * SCD1 EQU * SCHEDULE THE PROGRAM * JSB EXEC DEF *+4 SCHEDULE REQUESTED PROGRAM DEF K10N WITHOUT WAIT & PASS IT DEF $NAME IT'S I/O CLASS AS PARAMETER DEF CLSAD,I P1 JMP BADPG ERROR RETURN-RTE TRIED TO ABORT US * SZA,RSS WAS PROGRAM DORMANT? JMP REQU# YES, IT'S OK. LDA CLSAM NO, IT WASN'T. WAS THIS A NEW ENTRY TO OUT SZA,RSS TABLES? JMP BADOP YES, SO WE EXPECT PROGRAM TO BE DORMANT. * * POPEN IS OK, RETHREAD CLASS BUFFER TO SLAVE PROGRAM * REQU# JSB #REQU RETHREADING SUBROUTINE DEF *+3 DEF CLASS PTOPM CLASS CLSAD NOP SLAVE PGM'S CLASS * SSA,RSS ANY RETHREADING ERRORS JMP GET NO, BACK TO GET CPA N10 MAXIMUM QUEUE SIZE EXCEEDED? JMP ER58 YES, RETURN -58 ERROR JMP ER48 GIVE -48 ERROR FOR ALL OTHERS. * BADPG JSB FINIS DEALLOCATE CLASS & CLEAR ENTRY JMP ER41 GIVE ERROR -41 * BADOP JSB FINIS DEALLOCATE CLASS & CLEAR ENTRY JMP ER44 GIVE ERROR -44 SKP * * ENTER HERE ON PREAD, PWRIT, OR PCONT * READP JSB SERCH SEARCH FOR ENTRY RSS JMP ER44 NOT FOUND, ERROR * LDA CLSAD,I CLASS # FROM TABLE CPA $PCB+1 DOES IT MATCH CLASS IN PCB? RSS YES, CONTINUE JMP ER103 NO, ERROR SPC 2 * CHECK THAT SLAVE PROGRAM IS "ALIVE" LDB SEGAD,I GET PROGRAM'S ID SEGMENT ADDRESS ADB K15 ADVANCE TO STATUS LDA B,I AND B17 ISOLATE STATUS SZA DORMANT? JMP REQU# NO, RE-THREAD ON CLASS NUMBER ADB K2 ADVANCE TO TIME-LIST WORD LDA B,I LOAD ID SEGMENT WORD 18 ALF ROTATE TO LSB SLA IN TIME LIST? JMP REQU# YES, WE'LL ASSUME IT'LL COME OUT IN TIME. * SLAVE PROGRAM IS DORMANT. CLEAR OUT CLASS BUFFER JSB FINIS CLEAR OUT CLASS BUFFER LDB M45 ERROR -45: SLAVE PROGRAM IS DORMANT JMP ERR * SKP * * PROCESS "SL" REQUESTS FROM REMAT * SLIST JSB CLSAM CLEAR THE CLASS BUFFER CLA STA NAMBF INITIALIZE COUNT OF OPEN PGMS LDX NTOTL COUNTER LDB NAMAD POINTER FOR STORING PGM NAMES * SL10 LAX P#END GET NEXT SLAVE ID SEG ADDR SZA,RSS IS THIS ENTRY FULL? JMP SL20 NO ISZ NAMBF BUMP COUNT OF SLAVE PGMS ADA K12 POINT TO NAME IN ID SEG MVW K3 MOVE NAME INTO OUTPUT BUFFER SL20 ISX ALL ENTRIES EXAMINED? JMP SL10 NO * LDA NAMLN JMP REPLY+1 WRITE SLAVE LIST WITH REPLY SKP * * HANDLE SLAVE OFF REQUESTS HERE SOFF LDA $PCB ID SEG ADDR TO CLEAR SZA CLEAR ALL REQUEST? JMP FINIT NO * JSB CLSAM CLEAR CLASS BUFFER LDA NTOTL STA CNTR INITIALIZE SLAVE LIST COUNT LDB A#IDS POINT TO ID SEG ADDR LIST CL10 LDA 1,I GET NEXT ENTRY SZA,RSS THIS SLOT FULL? JMP CL20 NO STB SEGAD SAVE ADDR OF ID SEG ADDR ADB NTOTL STB CLSAD SAVE ADDR OF CLASS # * JSB FINIS GO CLEAN OUT THIS ONE LDB SEGAD * CL20 INB BUMP LIST POINTER ISZ CNTR MORE? JMP CL10 YES JMP FINEX NO, DONE SPC 2 * FINIT JSB PGMAD CONVERT NAME TO ID SEG ADDR DEF *+2 DEF $NAME STA IDSEG SAVE ID SEGMENT ADDRESS * * ENTER HERE ON "PCLOS" OF "FINIS" REQUESTS * CLOSP JSB CLSAM CLEAR CLASS BUFFER JSB SERCH IS PROGRAM IN CURRENT LIST? JSB FINIS YES, CLEAN OUT ENTRY IN CURRENT LIST LDA $FUNC ALF,ALF TEST BIT 7 OF FUNCTION CODE SSA IS THIS A "FINIS" REQUEST? JMP GET YES, NO REPLY REQUIRED * FINEX CLB STB $ERR+1 NO ERROR CODE JMP REPLY SEND REPLY * SKP * CLEAR ENTRY OUT OF CURRENT LIST, AND ABORT PROGRAM IF IT'S HANGING * ON THE CLASS SO THE CLASS NUMBER CAN BE DEALLOCATED. * FINIS NOP * NOW CLEAR ALL REQUESTS FROM THE I/O CLASS * (ONE AT A TIME) AND CAUSE IT TO BE RELEASED LDA CLSAD,I GET CLASS NUMBER IOR B1315 SET BIT 13 & 15 IN CLASS WORD STA TEMP THEN SAVE FOR CALL STA CLFLG SET CLASS CLEAR FLAG NON-ZERO * NXGET JSB DOGET GET REQUEST TEMP NOP JMP ABTIT FIRST, PGM MUST BE TERMINATED * CLB CPB CLFLG RELEASE PROCESSING COMPLETE? JMP FIEND YES INA,SZA ALL PENDING REQUESTS CLEARED? JMP NXGET NO, CLEAR MORE STA CLFLG SET FOR ONE MORE LDA TEMP AND CLR13 CLEAR NO DE-ALLOCATE FLAG STA TEMP JMP NXGET * * ABORT USER PROGRAM ABTIT LDB NAMA LDA SEGAD,I ADA K12 ADDR OF NAME IN ID SEG MVW K3 MOVE INTO NAME FIELD LDA NAME+2 AND B1774 CLEAR RHW STA NAME+2 * JSB EXEC TERMINATE PROGRAM DEF *+3 DEF K6N NAMA DEF NAME CLB,RSS GET OUT IF WOULD HAVE ABORTED JMP NXGET NOW RELEASE CLASS # * FIEND STB SEGAD,I CLEAR ENTRY IN PTOPM'S LIST JMP FINIS,I & EXIT * SKP * PROCESS ERRORS AND ABNORMAL CONDITIONS HERE * THE B REGISTER CONTAINS THE DETECTED ERROR CODE * RECOGNIZED ERROR CONDITIONS * -41 NON-EXISTENT SLAVE PROGRAM * -42 CURRENT LIST FULL-NO ROOM-RETRY * -44 PROGRAM NOT OPEN IN PTOPM'S TABLE * -45 PROGRAM IS DORMANT (PWRIT, PREAD, PCONT ONLY) * -48 ABORTIVE COMMUNICATIONS ERROR * -58 SLAVE PROGRAM IS NON-DORMANY<T, BUT MAXIMUM QUEUE DEPTH * EXCEEDED (SLAVE PROGRAM IS LAGGING BEHIND). * -103 BAD PCB OR BAD FUNCTION CODE * ER41 LDB M41 JMP ERR * ERMS CLA STA SEGAD,I CLEAR ENTRY IN CURRENT LIST * ER42 LDB M42 JMP ERR * ER44 LDB M44 JMP ERR * ER48 LDB M48 JMP ERR ER58 LDB M58 JMP ERR * ER103 LDB M103 ILLEGAL PCB ERR STB $ERR+1 STORE ERROR WORD LDB #NODE STB $ENOD PASS LOCAL NODE * JSB CLSAM CLEAR THE CLASS BUFFER * REPLY CLA STA CNTR SET LENGTH OF DATA * JSB D65SV SEND THE REPLY DEF *+5 RQADR DEF IRBUF REQUEST BUFFER DEF RQLEN REQUEST LENGTH DEF NAMBF DEF CNTR ZERO UNLESS "SL" NOP JMP GET SKP * * THIS SUBROUTINE SEARCHES FOR AN ENTRY IN THE SLAVE PGM LIST * SERCH NOP LDB A#IDS POINTER TO ID SEG ADDRS LDA NTOTL STA CNTR COUNTER CLE E SET TO 1 WHEN FREE SLOT FOUND SNXT LDA 1,I GET NEXT ID SEG ADDR CPA IDSEG EQUAL TO ONE WE'RE LOOKING FOR? JMP GOTIT YES! SZA,RSS THIS SLOT FREE? SEZ,CCE YES, SKIP IF 1ST FREE SLOT RSS STB FSTAD SAVE ADDR OF 1ST FREE SLOT INB ISZ CNTR MORE? JMP SNXT YES ISZ SERCH REQUESTED ID SEG NOT FOUND JMP SERCH,I RETURN * GOTIT STB SEGAD SAVE ADDR OF ID SEG ENTRY ADB NTOTL STB CLSAD SAVE ADDR OF ITS CLASS # JMP SERCH,I RETURN SPC 2 * * DO A CLASS I/O DUMMY GET * DOGET NOP JSB EXEC DEF *+5 DEF K21N DEF DOGET,I CLASS # DEF DUMMY DEF K0 RSS SKIP IF WE COULD HAVE ABORTED ISZ DOGET ELSE RETURN TO P+2 ISZ DOGET JMP DOGET,I RETURN SKP * * CLEAR PTOPM'S CLASS BUFFER OR RETHREAD TO PLOG * CLSAM NOP LDA #PLOG SZA  LOGGING? JMP LOGIT YES * CLAR EQU * JSB EXEC CLASS GET (ZERO LENGTH) DEF *+5 DEF K21 DEF CLAS2 DEF DUMMY DEF K0 * CLSEX LDA $STRM IOR BIT14 SET REPLY FLAG IN REQUEST STA $STRM JMP CLSAM,I RETURN SPC 2 LOGIT JSB #REQU RETHREADING ROUTINE DEF *+3 DEF CLASS PTOPM'S CLASS DEF #PLOG SSA ANY ERRORS? JMP CLAR YES, SIMPLY DELETE BUFFER JMP CLSEX SKP * * DATA AREA * BFADR NOP CNTR NOP RQLEN NOP IDSEG NOP SEGAD NOP FSTAD NOP CLASS NOP CLAS2 NOP K1 DEC 1 K2 DEC 2 K3 DEC 3 K7 DEC 7 K15 DEC 15 K12 DEC 12 K20 DEC 20 K21 DEC 21 K6N OCT 100006 K10N OCT 100012 K21N OCT 100025 CODEA DEF CODES,I CODES DEF ER103 CODE 0: ERROR DEF OPENP CODE 1: POPEN DEF READP CODE 2: PWRIT DEF READP CODE 3: PREAD DEF READP CODE 4: PCONT DEF CLOSP CODE 5: PCLOS DEF SOFF CODE 6: SLAVE OFF DEF SLIST CODE 7: SLAVE LIST BIT13 OCT 020000 BIT13 B17 OCT 17 BIT14 OCT 040000 B1315 OCT 120000 B1774 OCT 177400 CLR13 OCT 157777 N7 DEC -7 N10 DEC -10 N25 DEC -25 M41 DEC -41 M42 DEC -42 M44 DEC -44 M45 DEC -45 M48 DEC -48 M58 DEC -58 M103 DEC -103 CLFLG NOP DUMMY NOP NAMAD DEF NAMBF+1 NAMLN ABS NENT+NENT+NENT+1 SIZE OF "SL" BUFR * * DEFINE P TO P REQUEST BUFFER * IRBUF BSS 31 A EQU 0 B EQU 1 * $STRM EQU IRBUF $ERR EQU IRBUF+4 $ENOD EQU IRBUF+6 $FUNC EQU IRBUF+7 $PCB EQU IRBUF+8 $NAME EQU IRBUF+8 * NAME BSS 3 * * DEFINE SLAVE PGM LIST & VARIABLES * NENT EQU 20 SET # OF ENTRIES A#IDS DEF P#IDS POINT TO ID SEG ADDRS A#CLS DEF A#CLS POINT TO SLAVE CLASS #S NTOTL ABS -NENT -# OF ENTRIES * P#CLS BSS NENT+NENT DEFINE THE SLAVE LIST TABLE P#IDS EQU P#CLS+NENT P#END EQU P#IDS+NENT UNL [0.* ORG P#CLS REP NENT+NENT INITIALIZE TABLE TO ZEROES NOP LST * NAMBF BSS NENT+NENT+NENT+1 BUFFER FOR "SL" * SIZE EQU * * END PTOPM 0   91740-18008 1740 S C0122 DS/1000 MODULE: EXECW              H0101 ;ASMB,R,L,C HED EXECW 91740-16008 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 NAM EXECW,19,30 91740-16008 REV 1740 770728 SPC 1 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME: EXECW * SOURCE: 91740-18008 * RELOC: 91740-16008 * PGMR: C. HAMILTON [07/28/77] * * IS THE DS/1000 MONITOR, WHOSE FUNCTION IS TO PROCESS ALL * REQUESTS, WHICH ARE FORWARDED TO THIS NODE VIA SLAVE STREAM #3. ALL OF * THESE REQUESTS WILL HAVE BEEN ORIGINATED THROUGH A USER'S REQUEST TO THE * USER-INTERFACE MODULE. REQUESTS PROCESSED BY ARE * HANDLED ON A 'FIRST COME, FIRST SERVED' BASIS! THUS, IF IS * 'WAITING' FOR COMPLETION OF A PREVIOUSLY-SCHEDULED PROGRAM, A NEW * REQUEST CANNOT BE HONORED, UNTIL THE PREVIOUS REQUEST HAS COMPLETED. * * THE CURRENT USER'S NODE NUMBER WILL BE STORED IN #CNOD, IN . * ( WHEN IS INACTIVE, #CNOD WILL CONTAIN -1 ) * * NOTE: SPECIAL PROCESSING IS PROVIDED FOR THE RTE-M ABSOLUTE LOADER * (SEE INFORMATION FOR SUBROUTINE 'APLCK'). * * THOSE REQUESTS WHICH ARE ACCEPTABLE FOR PROCESSING VIA * MAY BE CLASSIFIED UNDER THE FOLLOWING 'EXEC' REQUEST CODES: * * 6 - TERMINATE A PROGRAM (PREVIOUSLY SCHEDULED VIA ) * * 9 - SCHEDULE A PROGRAM WITH 'WAIT' (REPLY RETURNED UPON COMPLETION) * * 23 - QUEUE-SCHEDULE A PROGRAM WITH 'WAIT' (SCHEDULE WHEN AVAILABLE) * (REPLY RETURNED UPON COMPLETION OF SCHEDULED PROGRAM) * * NOTE: FOR RC=9,23 PARAMETERS RETURNED FROM THE SCHEDULEE-VIA 'PRTN' OR * 'PRTM'-WILL BE PASSED TO THE CALLER. [ SETS =-1, *  TO INFORM THAT PARAMETERS HAVE BEEN RETURNED.] * * 24 - QUEUE-SCHEDULE A PROGRAM IMMEDIATELY (SCHEDULE WHEN AVAILABLE) * (REPLY RETURNED AS SOON AS PROGRAM IS SCHEDULED) * * ERRORS, ORIGINATING IN : * * "DS06" - ILLEGAL REQUEST CODE (NOT 6,9,23,24) * * "DS08" - INSUFFICIENT MEMORY FOR 'STRING BUFFER', OR NOT DORMANT. * * "SC01" - MISSING SCHEDULING PARAMETER. * "SC02" - ILLEGAL SCHEDULING PARAMETER. * "SC05" - ATTEMPT TO CONTROL , OR UNDEFINED PROGRAM. * "XXNN" - [ RTE SYSTEM-ORIGINATED ERRORS ] SKP * EXT D65GT,D65SV,PGMAD,#CNOD,#LNOD,#NODE EXT $LIBR,$LIBX,$OPSY,EXEC A EQU 0 B EQU 1 KEYWD EQU 1657B XEQT EQU 1717B SUP SPC 2 EXECW LDA B,I GET THE PASSED PARAMETER. IFZ EXT DBUG SZA JMP SETCL JSB DBUG DEF *+1 JSB EXEC DEF *+4 DEF D6 DEF D0 DEF D1 JMP EXECM+1 XIF * SETCL STA SAVCL SAVE CLASS NUMBER. * CLB LDA $OPSY GET THE SYSTEM SPECIFICATION. AND D4 ISOLATE THE RTE-M BIT(#2). SZA IF NOT RTE-M, SKIP; STB SCHD0 ELSE, PREVENT PROCESSING. * * CALL TO 'GET' A NEW REQUEST. * GET JSB D65GT WE WAIT FOR A REQUEST TO ARRIVE DEF *+6 DEF SAVCL MONITOR'S CLASS DEF RQBUF REQUEST BUFFER ADDRESS. DEF D16 MAXIMUM REQUEST LENGTH. DABFA DEF DABUF DATA BUFFER ADDRESS. DEF D512 MAXIMUM DATA BUFFER SIZE. JMP GET IGNORE INITIAL ERRORS! * DST SAVA = REQUEST LENGTH; = DATA LENGTH. LDA D7 INITIALIZE FOR A STA RPLYL MINIMUM-LENGTH REPLY. * SKP * * EXAMINE AND VERIFY THE REQUEST CODE (VALID CODES: 6,9,23,24) * LDA RQBUF+4 GET THE REQUEST CODE. CPA D6 TERMINATION REQUEST? JMP PKILL YES, GO TO KILL THE PROGRAM. (CPA D9 SCHEDULE WITH WAIT? JMP SCHED YES. GO TO SCHEDULE & WAIT. CPA D23 QUEUE-SCHEDULE WITH WAIT? JMP SCHED YES--THAT'S ACCEPTABLE. CPA D24 QUEUE-SCHEDULE WITHOUT WAIT? JMP SCHED YES--ACCEPT THAT REQUEST, ALSO. * DLD DS06 ERROR "DS06": BAD REQUEST CODE. JMP ERRTN RETURN ERROR-CODE TO CALLER. ERSC1 DLD SC01 ERROR "SC01": MISSING PARAMETER. JMP ERRTN ERSC2 DLD SC02 ERROR "SC02": INVALID PARAMETER. JMP ERRTN RETURN ERROR-CODES TO CALLER. ERSC5 DLD SC05 ERROR "SC05": IMPROPER PROGRAM REFERENCE. JMP ERRTN ERDS8 DLD DS08 ERROR "DS08": INSUFFICIENT RESOURCES. * ERRTN CCE,RSS ERROR RETURN. SCDON CLB,CLE SCHEDULE-RETURN (NO PARAMETERS). * DONE DST RQBUF+4 STORE REGISTERS IN WORDS 5&6 OF REPLY. LDA #NODE GET THE LOCAL NODE NUMBER, AND ELA,CLE,RAR INCLUDE ASCII-ERROR FLAG (BIT#15). STA RQBUF+6 STORE THE ERROR INDICATOR--IF ANY. LDA RQBUF GET THE STREAM WORD. IOR BIT14 ADD THE REPLY FLAG (BIT#14). STA RQBUF RESTORE THE MODIFIED WORD. LDA DM1 RESET #CNOD =-1, TO INDICATE JSB STCND THAT IS INACTIVE. * * CALL TO INDICATE, TO THE USER, THAT THE REQUEST IS COMPLETE. * JSB D65SV TRANSMIT DEF *+5 THE REPLY DEF RQBUF BACK TO DEF RPLYL THE ORIGINAL DEF DABUF REQUESTOR'S DEF D0 NODE. NOP IGNORE ERRORS--WE CAN DO NOTHING! JMP GET RETURN FOR THE NEXT REQUEST/COMPLETION. * SKP * PROGRAM COMPLETION, SCHEDULE W/WAIT, & QUEUE-SCHEDULEING RC=6,9,23,24 * PKILL EQU * PROGRAM TERMINATION SHARES 'SCHED' CODE. * SCHED IOR BIT15 ADD NO-ABORT BIT(#15) TO REQUEST CODE, STA RQBUF+4 AND SAVE FOR THE CALL TO 'EXEC'. JSB PGMAD GO TO GET THE SCHEDULEE'S STATUS. DEF *+2 THE PROGRA%M OF INTEREST DEF RQBUF+5 IS NAMED IN THE REQUEST BUFFER. * SZA ANY ATTEMPT TO CPA XEQT REMOTELY-CONTROL JMP ERSC5 IS UN-ACCEPTABLE! ERROR: "SC05". * STB STRAD SAVE PROGRAM STATUS FOR 'APLCK'. LDB RQBUF+4 GET THE REQUEST CODE. ELB,CLE,ERB REMOVE THE NO-ABORT BIT(#15). CPB D6 PROGRAM TERMINATION REQUEST? JMP *+2 YES. SKIP TO DETERMINE LINEAGE. JMP SCHD0 NO. IT'S A NORMAL SCHEDULE REQUEST. * ADA D20 POINT TO WORD #21 IN I.D. SEGMENT. LDA A,I GET THE CONTENTS. AND B377 ISOLATE THE FATHER'S I.D. SEG. NO. ADA KEYWD COMPUTE THE ADDRESS FOR THE ADA DM1 FATHER'S KEYWORD-TABLE ENTRY. LDA A,I GET THE FATHER'S I.D. SEGMENT ADDRESS. CPA XEQT OUR OFFSPRING? JMP SCHD0+1 YES, WE CAN HONOR THE REQUEST. JMP ERSC5 NO. WE CANNOT PROCESS THE REQUEST! * SCHD0 JSB APLCK CHECK FOR [NOP: RTE-II/III/IV] * LDA SAVA GET THE REQUEST LENGTH. ADA DM16 IF THE LENGTH [AFTER APLCK COMPENSATION] SSA,RSS EXCEEDS FIFTEEN WORDS, THEN JMP ERSC2 IT IS AN INVALID REQUEST! * LDA SAVA GET THE REQUEST BUFFER SIZE, AGAIN. LDB RTNDF GET THE DEFAULT RETURN POINTER. ADA DM8 SUBTRACT THE MINIMUM REQUEST SIZE. ADB A COMPUTE THE ACTUAL RETURN ADDRESS, STB RTNAD AND CONFIGURE THE RETURN POINTER. SZA,RSS ANY ADDITIONAL PARAMETERS? JMP SCHD2 NO. GO CLEAR REMAINDER OF CALL BUFFER. * SSA WERE WE SUPPLIED WITH ENOUGH PARAMETERS? JMP ERSC1 NO. * ERROR: SC01 ! CAX YES. SAVE ADDITIONAL PARAMETER COUNT. LDA PR3DF = ADDRESS OF NEXT USER-PARAMETER LDB RTNDF =ADDRESS OF NEXT CALL-BUFFER LOCATION. SCHD1 STA B,I STORE PARAM ADDR INTO CALL BUFFER. INA ADVANCE PARAMETER POINTER. INB ADVANCE CALL BUFFER POINTER. DSX ALL PARAMETERS PROCESSED? JMP SCHD1 NO. PROCESS THE NEXT ONE. * CLA PREPARE TO CLEAR REST OF CALL BUFFER. SCHD2 ADB D2 ADVANCE POINTER PAST ERROR INSTRUCTIONS. CPB LASTA LAST CALL BUFFER LOCATION CLEARED? JMP SCHD3 YES. GO TO COMPLETE THE CALL. STA B,I NO. CLEAR THE LOCATION. INB ADVANCE THE CALL BUFFER POINTER, AND JMP SCHD2+1 GO TO CLEAR THE NEXT LOCATION. * SCHD3 LDA STRAD+1 GET THE STRING-SIZE POINTER--IF ANY. SZA,RSS PASSING A STRING TO THE PROGRAM? JMP SCHD4 NO. BYPASS DATA-BUFFER SET-UP. LDA DABFA GET LOCAL DATA BUFFER ADDRESS, STA STRAD AND ESTABLISH STRING-POINTER IN CALL. * SCHD4 DLD ERRIN LOAD THE ERROR-DETECTION INSTRUCTIONS. DST RTNAD,I STORE THEM AT END OF CALLING SEQUENCE. * LDA RQBUF+2 GET THE SOURCE-NODE. JSB STCND ESTABLISH CURRENT USER'S NODE IN . LDB DM1 PREPARE FOR RETURN-PARAMETER CHECKING. * * THE CONFIGURED 'EXEC' CALLING SEQUENCE IS EXECUTED BELOW: * JSB EXEC BUFFER FOR ASSEMBLING 'EXEC' REQUESTS. RTNAD DEF PR3AD RETURN POINTER (CONFIGURED). DEF RQBUF+4 REQUEST CODE (SUPPLIED BY CALLER) DEF RQBUF+5 POINTER TO FIRST REQUEST PARAMETER. PR3AD NOP CONFIGURED POINTERS (7-MAX.) TO NOP USER-SUPPLIED CALLING-PARAMETERS, NOP WHICH RESIDE IN THE REQUEST BUFFER. NOP UN-USED CALLING-SEQUENCE LOCATIONS ARE NOP DYNAMICALLY CHANGED TO 'NOP'. STRAD NOP STRING-BUFFER ADDRESS--IF ANY. NOP STRING-LENGTH POINTER--IF ANY. NOP [ ERROR-DETECTION INSTRUCTIONS: WILL BE NOP POSITIONED TO FOLLOW LAST POINTER ] ENDBF CPA DM1 REJECTING A STRING-PASSING REQUEST? JMP ERDS8 YES, SKIP TO RETURN "DS08".r SEZ NO. WAS A SYSTEM-LEVEL ERROR DETECTED? JMP DONE YES. RETURN THE ERROR CODES TO CALLER! * CPB DM1 IF NO PARAMETERS WERE RETURNED, JMP SCDON THEN RETURN TO CALLER WITH =0; STA STCND ELSE, SAVE THE STATUS TEMPORARILY. * LDA B SOURCE=RETURN-PARAMETERS IN I.D.SEGMENT. LDB RTPRM DESTN.=EIGHTH WORD OF REPLY BUFFER. MVW D5 MOVE THE PARAMETERS TO THE REPLY BUFFER. * LDA D12 SET THE STA RPLYL REPLY LENGTH =12 WORDS. LDA STCND RECOVER THE PROGRAM STATUS. CCB,CLE INDICATE: PARAMETERS RETURNED--NO ERROR. JMP DONE COMPLETE THE REQUEST PROCESSING. * SKP * SET #CNOD IN : + NODE # = CURRENT CALLER; -1 = INACTIVE. * STCND NOP JSB $LIBR D0 NOP STA #CNOD SET INTO #CNOD, IN . JSB $LIBX DEF STCND RETURN. * * SPECIAL PROCESSING FOR IN RTE-M ENVIRONMENT: * * IF NOT SCHEDULING , RETURN; ELSE, CHECK STATUS. * IF NOT DORMANT, REJECT "DS08"; ELSE, STORE SECURITY CODE AND * CARTRIDGE REFERENCE NO. INTO I.D. SEGMENT WORDS #27,28. * STORE REQUEST'S SOURCE-NODE INTO #CNOD IN , AND ALSO STORE * FILE-LOCATION NODE INTO #LNOD IN . * APLCK NOP ADA D12 POINT TO I.D. SEGMENT WORD #13 (NAME). RAL FORM A BYTE ADDRESS STA B FOR THE PROGRAM'S I.D. SEGMENT "NAME". * LDA APLBA GET THE REFERENCE BYTE ADDRESS. CBT D5 IF THIS IS AN SCHEDULE REQUEST, JMP APSET THEN GO TO PROCESS IT'S PARAMETERS; JMP APLCK,I ELSE, NO FURTHER SPECIAL JMP APLCK,I PROCESSING IS REQUIRED. * APSET LDA STRAD GET THE I.D. SEGMENT STATUS WORD. AND B17 ISOLATE CURRENT STATUS. SZA IF IT IS NOT AVAILABLE, JMP ERDS8 THEN, NOTHING MORE CAN BE DONE! * LDA SAVA R*($ COMPENSATE FOR THE CPA D16 THREE ADDITIONAL ADA DM3 REQUEST-PARAMETERS, USED TO STA SAVA SPECIFY DOWN-LOADING. * CLE,ERB CONVERT FROM BYTE, TO WORD ADDRESS. ADB D12 POINT TO I.D. SEGMENT WORD #27. LDA RQBUF+13 GET THE SECURITY CODE. JSB $LIBR NOP STA B,I SET SECURITY CODE INTO I.D. WORD #27. CLE,INB LDA RQBUF+14 GET THE CARTRIDGE REFERENCE NUMBER. STA B,I SET CRN INTO I.D. SEGMENT WORD #28. * LDA RQBUF+15 GET LOCATION-NODE FOR THE RELOC. FILE. STA #LNOD SET #LNOD IN , FOR . JSB $LIBX DEF APLCK RETURN. * APLBA DBL *+1 REFERENCE-NAME BYTE ADDRESS. ASC 3,APLDR * SKP DM16 DEC -16 DM8 DEC -8 DM3 DEC -3 DM1 DEC -1 D1 DEC 1 D2 DEC 2 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D9 DEC 9 D12 DEC 12 D16 DEC 16 B17 OCT 17 D20 DEC 20 D23 DEC 23 D24 DEC 24 D512 DEC 512 B377 OCT 377 BIT14 OCT 40000 BIT15 OCT 100000 DS06 ASC 2,DS06 DS08 ASC 2,DS08 SC01 ASC 2,SC01 SC02 ASC 2,SC02 SC05 ASC 2,SC05 RPLYL NOP RTPRM DEF RQBUF+7 PR3DF DEF RQBUF+8 RTNDF DEF PR3AD LASTA DEF ENDBF * * * * DO NOT CHANGE ORDER OF NEXT FOUR STATEMENTS * * * * ERRIN CCE,RSS CLE SAVA NOP NOP * * * * * * * * * * * * * * * * * * * * * * * * * * * * SAVCL NOP DABUF BSS 512 RQBUF BSS 16 * * BSS 0 [ SIZE OF ] * END EXECW +*   91740-18009 2001 S C0222 &DLIST              H0102 ASMB,C,Q,N IFN * START RTE CODE HED DLIST 91740-16009 REV 2001 * (C) HEWLETT-PACKARD CO. 1980 XIF * END RTE CODE * IFZ * START RTE-M FLOPPY CODE HED DLIST 91740-16010 REV 2001 * (C) HEWLETT-PACKARD CO. 1980 XIF * END RTE-M FLOPPY CODE * IFN * START RTE CODE NAM DLIST,19,30 91740-16009 REV 2001 791029 XIF * END RTE CODE * IFZ * START RTE-M FLOPPY CODE NAM DLIST,19,30 91740-16010 REV 2001 791029 XIF * END RTE-M FLOPPY CODE SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************* * * DIRECTORY LIST MONITOR FOR DS-1000 * IFN = RTE SYSTEMS * IFZ = RTE-M FLOPPY-BASED SYSTEMS * * NAME: DLIST * SOURCE: 91740-18009 ('IFN' VERSION) * SOURCE: 91740-18010 ('IFZ' VERSION) * RELOC: 91740-16009 ('IFN' VERSION) * RELOC: 91740-16010 ('IFZ' VERSION) * PGMR: DAN GIBBONS * * * MODIFIED BY: JEAN-PIERRE BAUDOUIN (MAY 1976) * DAN GIBBONS (JANUARY 1979) * C.HAMILTON: ADD CART. LIST, 'OPEN TO', EXTENT NO.(10/78) * D.GIBBONS: MAKE COMPAT. WITH MSTR SECU CODE ENCRYPTION * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * * ENT DLIST * EXT EXEC,D65SV,D65GT,#NODE * IFN * ST ART RTE CODE EXT $CL1,$CL2,FSTAT,$BMON XIF * END RTE CODE IFZ * START RTE-M FLOPPY CODE EXT .DRCT,$CDIR,$XECM XIF * END RTE-M FLOPPY CODE * * A EQU 0 B EQU 1 SUP HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1980 * * MAIN ROUTINE STARTS HERE * DLIST NOP LDA B,I SEE IF THEY WANT DEBUG STA CLSSN SAVE CLASS NUMBER * IFN * START RTE CODE INIT LDA $BMON CHECK TYPE OF SYSTEM SZA PRE-RTE4B SYSTEM? JMP NEWSY NO, SETUP FOR NEW DRCTRY FRMT LDA TATSD YES, GET # TRKS IN SYS DISC ADA M1 GET TO LAST TRACK CLB SET FOR SECTOR ZERO JMP SETCD GO SET CARTRIDGE DRCTRY DISC ADR * CDTRK NOP CARTRIDGE DRCTRY TRACK # CDSEC NOP CARTRIDGE DRCTRY SECTR # * NEWSY LDA MSCA ADJUST MSTR SEC CODE ADR ADA D128 FOR NEW CARTRIDGE DRCTRY STA MSCA FORMAT. LDA DBFA1 ADJUST BUFR PTR TO ADA D128 2ND BLOCK OF CARTRIDGE STA DBFAD DIRECTORY BUFR. LDA $CL1 GET CARTRIDGE DRCTRY TRK ADR LDB $CL2 GET SECTR ADR OF 2ND BLOCK ADB D2 OF CARTRIDGE DRCTRY. * SETCD STA CDTRK SET DRCTRY TRK # STB CDSEC AND SECTOR #. XIF * END RTE CODE SPC 1 DLST0 JSB D65GT DO A GET CALL DEF *+6 DEF CLSSN DEF IRBUF DEF D23 DEF D0 NO DATA DEF D0 JMP DLST0 IGNORE ERROR CALL * LDA BROUT GET ADDRESS OF CURRENT COROUTINE SZA,RSS JMP SUB1 JMP A,I GO TO SPECIFIED SUBROUTINE SPC 2 SUB2A DEF SUB2 SUB3A DEF SUB3 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB7A DEF SUB7 SUB9A DEF SUB9 SB10A DEF SUB10 SB11A DEF SUB11 DON1A DEF DONE1 SPC 5 * * HERE ON NEW REQUEST * SUB1 EQU * IFN * START RTE CODE LDA DBFA1 GET DIRECTORY DATA BUFR ADR STA LUDSP SAVE FOR LU LOOPING SUB2 LDA D2 GET LU OF SYSTEM DISC STA WCLU SAVE AS WANTED LU LDA CDTRK GET CARTRIDGE DRCTRY TRACK # STA WTRCK SAVE IN WANTED TRACK LDB CDSEC GET CARTRIDGE DRCTRY SECTOR # STB WSEC SAVE IN WANTED SECTOR LDA DBFAD READ 128 WORDS CONTAINING MSTR JSB GETSC SECURITY CODE. * LDA $BMON CHECK SYSTEM TYPE SZA,RSS PRE-RTE4B SYSTEM? JMP SUB2B YES, DRCTRY & MSC ARE IN DBUF JSB FSTAT NO, READ IN 253 WORD DEF *+3 CARTRIDGE DIRECTORY DEF DBUF (IN OLD FORMAT). DEF D253 * SUB2B LDA LUDSP,I GET LU OF CARTRIDGE SZA,RSS DONE? XIF * END RTE CODE * IFZ * START RTE-M FLOPPY CODE * LDA M1 INITIALIZE VARIABLES TO ENSURE STA CTRCK FRESH FILE DIRECTORY COPY STA CSEC IS READ AT LEAST ONCE. STA CCLU * JSB .DRCT GET ADR OF FLOPPY DIRECTORY DEF $CDIR STA LUDSP SAVE FOR LU LOOPING SUB2B EQU * SUB2 JSB .DRCT GET ADR OF DIRECTORY DEF $CDIR ADA M1 GET TO END-OF-DIRECTORY ADR LDA A,I GET THE ADDRESS CPA LUDSP DONE? JMP DONE YES LDA LUDSP,I GET LU OF CARTRIDGE SZA DONE OR $CDIR CPA M2 NOT INITIALIZED? XIF * END RTE-M FLOPPY CODE * JMP DONE YES LDA FLTR IF FILTER-WORD #1 CPA M1 IS EQUAL TO A -1, THEN JMP *+2 THIS IS A CARTRIDGE LIST REQUEST; JMP SUB20 ELSE, PROCESS THE DIRECTORY LIST. LDA FLTR+1 IF FILTER-WORD #2 SZA,RSS IS EQUAL TO A 0, THEN JMP SUB8 BEGIN THE CARTRIDGE LIST; JMP SUB10 ELSE, CONTINUE LISTING. SUB20 LDB BROUT SEE IF FIRST TIME SZB JMP SUB22 NOT FIRST TIME *. IFZ * START RTE-M FLOPPY CODE LDA $XECM GET RTE-M SECURITY CODE STA MSCA,I SAVE IT XIF * END RTE-M FLOPPY CODE CPB MCODF MSTR SECU SUPPLIED? (NOTE: =0) JMP SUB22 NONE--NO SPECIAL ACCESS. LDA MSCA,I GET MASTER SECURITY CODE. SZA,RSS IF NONE, ALLOW ACCESS. JMP SUB22 NO SYS SECU CODE, SO ALLOW ACCESS * IFN * START RTE CODE LDB $BMON CHECK TYPE OF SYSTEM SZB,RSS PRE-RTE4B SYSTEM? JMP NOMSK YES, NO MASK ON MSTR SECU CODE XOR MASK NO, SECU CODE IS ENCRYPTED INA CONTINUE THE DECRYPTION NOMSK EQU * XIF * END RTE CODE * CPA MCODF USER'S AND MASTER MATCH? JMP SUB22 MATCH! ALLOW ACCESS. CLB NO SPECIAL ACCESS ALLOWED, SO STB MCODF CLEAR MCODF. SUB22 LDA CRLU DO THEY WANT A SPECIFIED LU? SZA,RSS LU SUPPLIED? JMP MCR NO LDB LUDSP GET DISPLACEMENT CMA,INA ASSUME LU SSA,RSS IS IT LABEL? JMP SUB23 NO...LU CMA,INA YES...LABEL...MAKE POS AGAIN ADB D2 AND GET TO LABEL WORD SUB23 CPA B,I IS LABEL OR LU MATCH? JMP MCR MATCH...PROCESS LU LDA LUDSP NO MATCH GO TO NEXT ONE ADA D4 STA LUDSP JMP SUB2B UNL IFN * START RTE CODE MASK DEC 31178 XIF * END RTE CODE LST SPC 5 * * ROUTINE TO PROCESS A MOUNTED CARTRIDGE * SPC 1 MCR LDA SUB5A SET UP FOR RETURN AFTER SENDING THE LINE STA BROUT LDA SECT2 GET # OF SECTORS IN TRACK STA SCTRK SAVE IN SECTORS/TRACK LDA LUDSP,I GET LU OF DISK STA WCLU SAVE AS WANTED CURRENT LU ISZ LUDSP GET TO FIRST DIRECTORY TRACK LDB LUDSP,I GET DIRECTORY TRACK ADDRESS STB WTRCK SAVE TRACK ADDRESS ISZ LUDSP  GET TO LOCK WORD ISZ LUDSP LDB LUDSP,I GET LOCK WORD ISZ LUDSP GET TO NEXT ENTRY SZB IS LU LOCKED JMP SUB2 YES * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB PRE-RTE4B SYSTEM? JMP MCR01 NO CPA D2 YES, IS IT SYSTEM DISC? LDB D14 YES RSS MCR01 CLB XIF * END RTE CODE * STB WSEC SAVE STARTING SECTOR ADDRESS LDA DBFA1 SET FOR ZERO DISPLACEMENT WITHIN BUFFER JSB SCFX GO GET SECTOR JMP SUB2 NO DIRECTORY? LDA DISP GET NAME OF CART. LDB CRNAA GET DESTINATION ADDRESS MVW D3 MOVE 3 WORDS LDA CRNA GET FIRST WORD OF CR NAME AND B7777 GET RID OF SIGN BIT STA CRNA RESTORE LDA DISP GET TO LABEL WORD ADA D3 LDA A,I CONVERT LABEL WORD TO ASC JSB BNDEC DEF LWA LABEL WORD ADDRESS LDB DISP GET TO # SEC/TRACK ADB D6 LDA B,I GET # OF SECTORS/TRACK STA SCTRK SAVE AS # OF SECTORS/TRACK ADB D2 GET TO # OF DIRECTORY TRACKS LDA B,I ADA WTRCK GET ENDING DIRECTORY TRACK STA NTRKS LDA B,I GET # OF DIRECTORY TRACKS CMA,INA MAKE # POS. JSB BNDEC CONVERT TO ASC DEF DTRKA LDA DTRKA+2 MOVE UP THE LEAST SIGNIFICANT DIGITS STA DTRKA THEY ARE THE ONLY ONES TO BE PRINTED LDA #NODE IDENTIFY THE JSB BNDEC NODE WHICH IS DEF NODE BEING LISTED. JSB WTLIN SEND LINE TO TERMINAL DEF HEAD1 FIRST HEADING LINE SPC 5 * * HERE AFTER FIRST HEADING LINE WRITTEN * SUB3 LDA SUB4A GET ADDRESS WHERE TO GO NEXT TIME STA BROUT LDB D17 NON-SECURITY HEADER LENGTH. LDA MCODF SZA SECURITY CODES BEING LISTED? LDB D20 &0 YES, ADD "SCODE" TO HEADER STB HEAD2 JSB WTLIN SEND OUT SEND HEADING LINE DEF HEAD2 SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE * SUB5 LDA SUB3A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN SEND OUT BLANK LINE DEF BLNKL SPC 5 * * HERE TO START OUTPUTING DIRECTORY * SUB4 LDA DISP GET FILE ENTRY ADA D16 JSB SCFX SEE IF WE NEED NEW SECTOR JMP SUB2 DONE...NO MORE DIRECTORY LDA DISP,I IS THIS FILE PURGED SSA JMP SUB4 YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU JSB MDLIN MOVE THE LINE JMP SUB4 ERROR CONDITION JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB6 LDA SUB7A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB7 LDA SUB2A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL * * HERE TO DO A CARTRIDGE LIST * SUB8 LDA SUB9A GET ADDRESS FOR NEXT TIME. STA BROUT LDA #NODE IDENTIFY THE NODE JSB BNDEC WHOSE CARTRIDGE LIST DEF CLNOD IS BEING PROCESSED. JSB WTLIN OUTPUT THE DEF CLHED CARTRIDGE-LIST HEADER. SPC 2 * * HERE TO OUTPUT A SEPARATING BLANK LINE. * SUB9 LDA SB10A GET ADDRESS FOR FIRST LINE STA BROUT SET COROUTINE POINTER. JSB WTLIN OUTPUT A DEF BLNKL BLANK LINE. SPC 2 * * PROCESS THE CARTRIDGE-LIST ENTRY. * SUB10 LDA LUDSP,I GET THE CARTRIDGE LOGICAL UNIT. ISZ LUDSP ADVANCE THE ENTRY-POINTER. JSB BNDEC CONVERT THE LU DEF DTYPA TO IT'S ASCII EQUIVALENT. > LDA DTYPA+2 GET THE TWO USEFUL ASCII DIGITS. STA LU CONFIGURE THE LINE. LDA LUDSP,I GET THE LAST TRACK FOR THE CARTRIDGE. ISZ LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT LAST TRACK TO ASCII, DEF LTRK AND CONFIGURE THE LINE. LDA LUDSP,I GET THE CARTRIDGE NUMBER. ISZ LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT CARTRIDGE NO. TO ASCII, DEF CART AND CONFIGURE INTO MESSAGE. LDB CLEN1 PREPARE FOR UNLOCKED LINE LENGTH. LDA LUDSP,I GET THE LOCK FLAG (I.D. SEG. ADDR.) ISZ LUDSP BUMP POINTER. SZA,RSS IF IT'S NOT LOCKED, JMP SNDLN THEN COMPLETE THE LINE; ADA D12 ELSE, POINT TO PROGRAM NAME, CLE,ELA AND FORM ITS BYTE ADDRESS. LDB CLKBA GET CONFIGURED MESSAGE BYTE ADDRESS. MBT D5 MOVE THE LOCKER'S NAME TO THE LINE. LDB CLEN2 GET LOCKED-CARTRIDGE LINE LENGTH. SNDLN STB CLINE CONFIGURE THE LINE LENGTH. LDB SUB2A SET FOR RETURN VIA RELOAD SECTION. LDA LUDSP,I IF THE NEXT ENTRY SZA,RSS IS NULL, THE LIST IS COMPLETE, SO LDB SB11A SET RETURN TO WRAP-UP SECTION; STB BROUT ESTABLISH THE COROUTINE POINTER. STB FLTR+1 SET FLAG FOR CLIST CONTINUATION. JSB WTLIN SEND THE CONFIGURED LINE DEF CLINE TO THE REMOTE NODE. * SUB11 LDA DON1A SEND A STA BROUT BLANK LINE, JSB WTLIN AND RETURN DEF BLNKL TO THE END PROCESSOR. * CLEN1 DEC 11 CLEN2 DEC 15 CLKBA DBL LOCK * CLHED DEC 24 ASC 14, LU LAST TRACK CR LOCK ASC 7, REMOTE NODE= CLNOD ASC 3, * CLINE NOP ASC 1, LU ASC 1, ASC 2, LTRK ASC 3, ASC 1, CART ASC 3, ASC 1, LOCK ASC 3, * HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1980 * * SUBROUTINE TO MOVE DETAIL LINE TO PRINT LINE * CALLING SEQUENCE * JSB MDLIN *  NO MATCH RETURN...IE..FILTER MIS-MATCH,TYPE NO MATCH * NORMAL RETURN * SPC 1 MDLIN NOP LDA FLTR IS FILTER SPECIFIED SZA NO CPA SPACA OR IS IT ALL SPACE? JMP NDLN2 NOT SUPPLIED OR SPACE LDA FLTRA GET ADDRESS WHERE FILTER LOCATED CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP SAVE FILTER BYTE ADDRESS LDA DISP GET ADDRESS OF NAME CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP1 SAVE IN BYTE ADD COUNTER LDA M6 # OF CHAR IN FILTER STA TEMP2 SAVE IN DOWN COUNTER MDN11 LDB TEMP GET BYTE ADD OF FILTER LBT GET BYTE SZA,RSS IF ZERO, CHANGE TO SPACE LDA C40 C40=SPACE CPA FLTRC IS IT A "-"? JMP MDN12 YES...DON'T CHECK STA TEMP3 SAVE IN TEMP LOCATION LDB TEMP1 GET BYTE ADDRESS OF NAME LBT GET BYTE CPA TEMP3 IS THERE A MATCH? RSS YES JMP MDLIN,I NO...IGNORE ENTRY MDN12 ISZ TEMP GET TO NEXT ENTRY ISZ TEMP1 ISZ TEMP2 DONE? JMP MDN11 NO SPC 1 * * AFTER CHECKING NAME, CHECK TYPE * NDLN2 LDB DISP GET TO FILE TYPE ADB D3 LDB B,I LDA FTYP CHECK WITH FILE TYPE PASSED RAL,CLE,ERA IS THERE A FILE TYPE? SEZ FILE TYPE SPECIFIED CPA B YES...DOES IT MATCH RSS MATCH...OR NO FILE TYPE SPECIFIED JMP MDLIN,I FILE TYPE NOT MATCHED ISZ MDLIN SET FOR NORMAL (P+2) RETURN. LDA DLLS ESTABLISH LINE LENGTH STA DLINA FOR LINE SANS SECURITY CODE. STB FTYPT SAVE FILE TYPE, TEMPORARILY. LDA B GET FILE TYPE FOR CONVERSION. JSB BNDEC CONVERT FILE TYPE TO ASC DEF DTYPA LDA DISP MOVE NAME TO OUTPUT LINE LDB ADNAM GET DESTINATION ADDRESS MVW D3 MOVE NAME LDA DISP GET # OF SECTORS OR LU ADA D4 ASSUME LU LDB FTYPT SEE IF TYPE=0 SZB YES? ADA D2 NO...GET # OF SECTORS LDA A,I GET VALUE SZB,RSS LU? JMP CNVRT YES, DON'T DIVIDE BY 2 SSA NEG BLOCK COUNT? CMA,INA,RSS YES, MAKE POS & SKIP DIV BY 2 CLE,ERA CONVERT TO # OF BLOCKS CNVRT JSB BNDEC CONVERT TO ASC DEF DBSLU LDA BLNK4 BLANK OUT THE LDB OPNAD 'OPEN TO' / EXTENT NO. MVW D4 INFORMATION FIELD. LDA FTYPT GET THE FILE TYPE. SZA,RSS IF THE TYPE IS ZERO, JMP OPNFL DON'T WORRY ABOUT EXTENTS. LDB DISP GET THE ADB D5 EXTENT WORD CLE,ELB FROM THE UPPER BYTE LBT OF THE DIRECTORY ENTRY. SZA,RSS IF NOT AN EXTENT, THEN JMP OPNFL CHECK THE OPEN FLAGS; JSB BNDEC ELSE, CONVERT EXTENT NO., OPNAD DEF DXOPN AND ADD IT TO THE LINE. LDA EXTBA GET BYTE ADDR. OF EXTENT DELIMITER. LDB EXNBA GET BYTE ADDR. OF DELIMITER BUFFER. MBT D3 MOVE ' +' TO CONFIGURED LINE. JMP SCODP IGNORE OPEN FLAGS FOR EXTENTS. OPNFL LDA DISP GET THE ADA D9 OPEN FLAG LDA A,I FROM THE ENTRY. * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB,RSS PRE-RTE4B SYSTEM? JMP OPNF1 NO LDB A YES, SAVE OPEN FLAG AND BT15 ISOLATE OPEN FLAG STA DTEMP SAVE EXCLUSIVE BIT LDA B RETRIEVE FLAG AND RTBYT ISOLATE ID SEG # SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. LDB KEYWD CALCULATE POINTER ADB M1 TO ID SEGMENT ADB A ADDRESS. LDA B,I GET ID SEG ADR IOR DTEMP INCLUDE EXCLUSIVE BIT XIF * END RTE CODE * OPNF1 SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. CLE,ELA SAVE EXCLUSIVE FLAG, ADA D24 AND FORM I.D. SEG WD#13 BYTE ADDRESS. LDB OPNBA GET BYTE ADDR. FOR CONFIGURED LINE. MBT D5 MOVE PROGRAM NAME INTO LINE. LDA C55 IF IT IS EXCLUSIVE, THEN SEZ USE ' -' AS A DELIMITER, AND SBT ADD THE DELIMITER TO THE LINE. SCODP LDB MCODF SUPPLY SECURITY CODE? SZB,RSS JMP MDLIN,I NO...RETURN. LDA DLLWS ESTABLISH LINE LENGTH STA DLINA FOR LINE WITH SECURITY CODE. LDA DISP GET THE ADA D8 SECURITY CODE LDA A,I FROM THE ENTRY. JSB BNDEC CONVERT TO ASCII, DEF DSECA AND CONFIGURE INTO LINE. JMP MDLIN,I RETURN. SPC 1 FTYPT NOP D5 DEC 5 D9 DEC 9 D12 DEC 12 D16 DEC 16 D20 DEC 20 DLLS EQU D16 DLLWS EQU D20 D24 DEC 24 BLNK4 DEF BLNKL+1 BLPLS ASC 2, + EXTBA DBL BLPLS EXNBA DBL DXOPN OPNBA DBL DXOPN+1 KEYWD EQU 1657B KEYWORD BLOCK ADR RTBYT OCT 377 BT15 OCT 100000 SPC 5 * * HERE WHEN WE ARE ALL DONE * DONE LDA BROUT SEE IF WE SENT THEM ANYTHING SZA JMP DONE1 YES...JUST TERMINATE LDA DON1A GET ADDRESS OF TERMINATION POINT STA BROUT JSB WTLIN SEND "DISK NOT MOUNTED" DEF NOCRM * DONE1 CLA STA LNGH SET FOR NO DATA LDA BIT14 TELL OTHER SIDE, ALL DONE JMP TERM SPC 5 * * SUBROUTINE TO SEND DATA TO REMOTE * CALLING SEQUENCE * JSB WTLIN * DEF BUFFER * * BUFFER FORMAT: * LENGTH WORD, DATA BUFFER * WTLIN NOP LDA WTLIN,I GET ADDRESS OF OUPUT LINE INA GET TO FIRST DATA WORD STA WTLNB LDB WTLIN,I GET LENGTH OF MESSAGE LDB B,I LDA LNGH GET AVAILABLE LENGTH CMA,INA ADA B SEE SIF THERE WAS TO MUCH ROOM SSA CHANGE LENGTH? STB LNGH YES...SET IN CORRECT LENGTH * CLA SET FOR MORE TO COME TERM STA STAT SAVE STATUS LDA STYP GET STREAM TYPE IOR BIT14 SET FOR REPLY STA STYP LDA #NODE STA IRBUF+6 SET STATUS LOCATION * JSB D65SV SEND REPLY DEF *+5 DEF IRBUF DEF D23 REPLY LENGTH WTLNB NOP DATA ADDRESS DEF LNGH DATA LENGTH * NOP IGNORE ERROR RETURN JMP DLST0 GO DO A GET CALL * SPC 5 * * SUBROUTINE TO KEEP DISPLACEMENT ON DISK OK * CALLING SEQUENCE * JSB SCFX * NO MORE DIRECTORY TRACK RETURN * NORMAL RETURN * A REG=DISPLACEMENT * UPON RETURN * WILL UPDATE WTRCK,WSEC,AND DISP AS REQUIRED * ASSUMES DISP STARTS WITH ADDRESS OF BUFFER * SCTRK MUST BE SET TO # OF SECTORS/TRACK * IF TRACK CHANGES, NTRCK=LAST DIRECTORY TRACK-1 * ALL SECTORS ARE ASSUMED TO BE 128 WORDS LONG * SPC 1 SCFX NOP CMA,INA NEGATE ADDRESS ADA DBFA1 GET DISPLACEMENT CMA,INA MAKE IT POSITIVE CLB CHECK IF OVERFLOW DIV D128 CROSS A SECTOR BOUNDRY ADB DBFA1 GET DISPLACEMENT AS AN ADDRESS STB DISP SAVE DISPLACEMENT ADDRESS SZA,RSS SECTOR CHANGE JMP SCFXA NO LDA D14 YES...GET TO NEXT SECTOR ADA WSEC GET TO NEXT SECTOR ADDRESS CLB DIV SCTRK SEE IF WE HAVE A HAVE LOOPED AROUND STB WSEC SAVE NEW SECTOR ADDRESS SZA IF NO ROLLOVER OR SZB NO NEW TRACK NEEDED JMP SCFXA DON'T UPDATE TRACK ADDRESS CCB UPDATE TRACK ADDRESS ADB WTRCK GET TO NEXT TRACK CPB NTRKS DONE? JMP SCFX,I YES STB WTRCK NO...SET IN NEW TRACK ADDRESS SCFXA LDA DBFA1 DO A 128 WORD READ JSB GETSC ISZ SCFX GET TO RETURN JMP SCFX,I RETURN SPC 5 * * SUBROUTINE TO READ A PHYSICAL SECTOR (128 WORDS) * * CALLING SEQUENCE: * * LDA * JSB GETSC * * THE FOLLOWING MUST BE SET UP: * * WTRCK,WSEC,WCLU * GETSC NOP STA BUFAD SAVE BUFFER ADR LDA FLTR IF A CARTRIDGE LISTING CPA M1 IS CURRENTLY IN PROGRESS, JMP GTSC1 FORCE A RELOAD OF THE SECTOR. LDA WTRCK GET CURRENT TRACK ADDRESS CPA CTRCK SAME AS ONE WE GOT NOW? RSS YES JMP GTSC1 NO...GO READ IT LDA WSEC IS IT THE SAME SECTOR CPA CSEC ? RSS YES JMP GTSC1 NO...GO READ IT LDA WCLU SAME LU? CPA CCLU JMP GETSC,I YES...DON'T READ SECTOR GTSC1 LDA WCLU SET UP AS CURRENT STA CCLU LDA WTRCK STA CTRCK LDA WSEC STA CSEC JSB EXEC GO READ A SECTOR DEF *+7 DEF D1 DEF WCLU BUFAD NOP DEF D128 DEF WTRCK DEF WSEC JMP GETSC,I GOT SECTOR, RETURN SPC 2 CTRCK OCT -1 CSEC OCT -1 CCLU OCT -1 BUFL NOP SPC 5 * * SUBROUTINE CONVERT BINARY TO ASCII DECIMAL * CALLING SEQUENCE * JSB BNDEC * DEF BUFFER WHERE TO ASC * A REG=BINARY # * BNDEC NOP STA DTEMP SAVE BINARY # LDB BNDEC,I GET ADDRESS WHERE TO ASC CLE,ELB CONVERT TO BYTE ADDRESS STB DTMP1 SAVE BYTE ADDRESS ISZ BNDEC GET TO RETURN ADDRESS LDA DNMA GET ADDRESS OF DIVISORS STA DTMP2 SAVE FOR DIVIDING LDA M5 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER LDA C40 GET A SPACE CHARACTERR LDB DTEMP GET BINARY VALUE SSB,RSS IF NEGATIVE...CONVERT JMP BNDCB NOT NEGATIVE CMB,INB NEGATIVE, MAKE POSITIVE STB DTEMP LD[NLHA C55 SET IN NEG SIGN BNDCB LDB DTMP1 GET BYTE ADDRESS SBT SAVE SIGN ISZ DTMP1 GET NEXT BYTE ADDRESS BNDCA LDA DTEMP GET BINARY # CLB GET A ZERO DIV DTMP2,I STB DTEMP SAVE REMAINDER ADA C60 CONVERT TO ASC LDB DTMP1 GET CURRENT BYTE ADDRESS SBT SAVE ASC BYTE ISZ DTMP2 GET NEXT DIVISOR ISZ DTMP1 GET NEXT BYTE ADDRESS ISZ DTMP3 DONE? JMP BNDCA NO JMP BNDEC,I RETURN SPC 1 C55 OCT 55 DTEMP NOP DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM DNM DEC 10000,1000,100,10,1 SPC 5 * * PARMB LAYOUT * IRBUF BSS 23 STYP EQU IRBUF STREAM TYPE STAT EQU IRBUF+7 STATUS LNGH EQU IRBUF+8 LENGTH WORD FLTR EQU IRBUF+10 NAME FILTER...0..NO FILTER MCODF EQU IRBUF+13 MASTER SECURITY CODE CRLU EQU IRBUF+14 LU OF CART. TO DO FTYP EQU IRBUF+15 FILE TYPE FILTER BROUT EQU IRBUF+9 ADR OF NEXT PROCESS ROUTINE. 0=START nNWCLU EQU IRBUF+16 CURRENT LU FOR DISK READ WTRCK EQU IRBUF+17 CURRETN TRACK TO READ WSEC EQU IRBUF+18 CURRENT SECTOR TO READ DISP EQU IRBUF+19 DISPLACEMENT IN BUFFER SCTRK EQU IRBUF+20 # OF SECTORS/TRACK LUDSP EQU IRBUF+21 DISPLACEMENT IN DIRECTORY LU NTRKS EQU IRBUF+22 # OF DIRECTORY TRACKS C40 OCT 40 C60 OCT 60 D3 DEC 3 D8 DEC 8 D14 DEC 14 D17 DEC 17 D23 DEC 23 D128 DEC 128 D4 DEC 4 D1 EQU DNM+4 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 M2 DEC -2 M5 DEC -5 M6 DEC -6 B7777 OCT 77777 BIT14 OCT 40000 FLTRA DEF FLTR FLTRC EQU C55 "DON'T-CARE" FILTER CHAR (MINUS SIGN) TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP * TATSD EQU 1756B SECT2 EQU 1757B DBFA1 DEF DBUF IFN * START RTE CODE DBFAD DEF DBUF MAY BE MODIFIED AT INIT D253 DEC 253 XIF * END RTE CODE MSCA DEF DBUF+126 @MSC. MAY BE MODIFIED AT INIT CLSSN NOP CRNAA DEF CRNA ADNAM DEF DNAMA SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 DEC 34 SPACA ASC 1, ASC 3,ILAB= CRNA ASC 3, ASC 1, ASC 10,REMOTE DLIST: NODE= NODE ASC 3, ASC 1, ASC 2,CR#= LWA ASC 3, ASC 1, ASC 5,DIR TRKS= DTRKA ASC 3, SPC 1 HEAD2 NOP ASC 20, NAME TYPE #BLKS/LU OPEN TO SCODE SPC 1 NOCRM DEC 9 ASC 9, DISK NOT MOUNTED DLINA NOP ASC 1, DNAMA ASC 3, ASC 1, DTYPA ASC 3, ASC 1 DBSLU ASC 3, DXOPN ASC 4, ASC 1, DSECA ASC 3, SPC 2 BLNKL DEC 1 OCT 20040,20040,20040,20040 * DBUF EQU * IFN * START RTE CODE BSS 256 XIF * END RTE CODE IFZ * START RTE-M FLOPPY CODE BSS 128 XIF * END RTE-M FLOPPY CODE SPC 3 END EQU * END DLIST V*    91740-18010 1913 S C0222 DS/1000 MODULE: DLIST              H0102 FASMB,R,L,C,Z IFN * START RTE CODE HED DLIST 91740-16009 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 XIF * END RTE CODE * IFZ * START RTE-M FLOPPY CODE HED DLIST 91740-16010 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 XIF * END RTE-M FLOPPY CODE * IFN * START RTE CODE NAM DLIST,19,30 91740-16009 REV 1913 790111 XIF * END RTE CODE * IFZ * START RTE-M FLOPPY CODE NAM DLIST,19,30 91740-16010 REV 1913 790111 XIF * END RTE-M FLOPPY CODE SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************* * *DLIST DIRECTORY LIST MONITOR FOR DS-1000 * IFN = RTE SYSTEMS * IFZ = RTE-M FLOPPY-BASED SYSTEMS * *SOURCE PART # IFN = 91740-18009 REV 1913 * IFZ = 91740-16010 REV 1913 * *REL PART # IFN = 91740-16009 REV 1913 * IFZ = 91740-16010 REV 1913 * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 9-18-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN (MAY 1976) * DAN GIBBONS (JANUARY 1979) * C.HAMILTON: ADD CART. LIST, 'OPEN TO', EXTENT NO.(10/78) * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * * ENT DLIST * EXT EXEC,D65SV,D65GT,#NODE * IFN * START RTE CODE EXT $CL1,$CL2,FSTAT,$BMON XIF VO * END RTE CODE IFZ * START RTE-M FLOPPY CODE EXT .DRCT,$CDIR,$XECM XIF * END RTE-M FLOPPY CODE * * A EQU 0 B EQU 1 SUP HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1977 * * MAIN ROUTINE STARTS HERE * DLIST NOP LDA B,I SEE IF THEY WANT DEBUG STA CLSSN SAVE CLASS NUMBER * IFN * START RTE CODE INIT LDA $BMON CHECK TYPE OF SYSTEM SZA PRE-RTE4B SYSTEM? JMP NEWSY NO, SETUP FOR NEW DRCTRY FRMT LDA TATSD YES, GET # TRKS IN SYS DISC ADA M1 GET TO LAST TRACK CLB SET FOR SECTOR ZERO JMP SETCD GO SET CARTRIDGE DRCTRY DISC ADR * CDTRK NOP CARTRIDGE DRCTRY TRACK # CDSEC NOP CARTRIDGE DRCTRY SECTR # * NEWSY LDA MSCA ADJUST MSTR SEC CODE ADR ADA D128 FOR NEW CARTRIDGE DRCTRY STA MSCA FORMAT. LDA DBFA1 ADJUST BUFR PTR TO ADA D128 2ND BLOCK OF CARTRIDGE STA DBFAD DIRECTORY BUFR. LDA $CL1 GET CARTRIDGE DRCTRY TRK ADR LDB $CL2 GET SECTR ADR OF 2ND BLOCK ADB D2 OF CARTRIDGE DRCTRY. * SETCD STA CDTRK SET DRCTRY TRK # STB CDSEC AND SECTOR #. XIF * END RTE CODE SPC 1 DLST0 JSB D65GT DO A GET CALL DEF *+6 DEF CLSSN DEF IRBUF DEF D23 DEF D0 NO DATA DEF D0 JMP DLST0 IGNORE ERROR CALL * LDA BROUT GET ADDRESS OF CURRENT COROUTINE SZA,RSS JMP SUB1 JMP A,I GO TO SPECIFIED SUBROUTINE SPC 2 SUB2A DEF SUB2 SUB3A DEF SUB3 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB7A DEF SUB7 SUB9A DEF SUB9 SB10A DEF SUB10 SB11A DEF SUB11 DON1A DEF DONE1 SPC 5 * * HERE ON NEW REQUEST * SUB1 EQU * IFN * START RTE CODE LDA DBFA1 GET DIRECTORY DATA BUFR ADR STA LUDSP SAVE FOR LU LOOP2ING SUB2 LDA D2 GET LU OF SYSTEM DISC STA WCLU SAVE AS WANTED LU LDA CDTRK GET CARTRIDGE DRCTRY TRACK # STA WTRCK SAVE IN WANTED TRACK LDB CDSEC GET CARTRIDGE DRCTRY SECTOR # STB WSEC SAVE IN WANTED SECTOR LDA DBFAD READ 128 WORDS CONTAINING MSTR JSB GETSC SECURITY CODE. * LDA $BMON CHECK SYSTEM TYPE SZA,RSS PRE-RTE4B SYSTEM? JMP SUB2B YES, DRCTRY & MSC ARE IN DBUF JSB FSTAT NO, READ IN 253 WORD DEF *+3 CARTRIDGE DIRECTORY DEF DBUF (IN OLD FORMAT). DEF D253 * SUB2B LDA LUDSP,I GET LU OF CARTRIDGE SZA,RSS DONE? XIF * END RTE CODE * IFZ * START RTE-M FLOPPY CODE * LDA M1 INITIALIZE VARIABLES TO ENSURE STA CTRCK FRESH FILE DIRECTORY COPY STA CSEC IS READ AT LEAST ONCE. STA CCLU * JSB .DRCT GET ADR OF FLOPPY DIRECTORY DEF $CDIR STA LUDSP SAVE FOR LU LOOPING SUB2B EQU * SUB2 JSB .DRCT GET ADR OF DIRECTORY DEF $CDIR ADA M1 GET TO END-OF-DIRECTORY ADR LDA A,I GET THE ADDRESS CPA LUDSP DONE? JMP DONE YES LDA LUDSP,I GET LU OF CARTRIDGE SZA DONE OR $CDIR CPA M2 NOT INITIALIZED? XIF * END RTE-M FLOPPY CODE * JMP DONE YES LDA FLTR IF FILTER-WORD #1 CPA M1 IS EQUAL TO A -1, THEN JMP *+2 THIS IS A CARTRIDGE LIST REQUEST; JMP SUB20 ELSE, PROCESS THE DIRECTORY LIST. LDA FLTR+1 IF FILTER-WORD #2 SZA,RSS IS EQUAL TO A 0, THEN JMP SUB8 BEGIN THE CARTRIDGE LIST; JMP SUB10 ELSE, CONTINUE LISTING. SUB20 LDA BROUT SEE IF FIRST TIME CLE,SZA JMP SUB22 NOT FIRST TIME IFZ * START RTE-M FLOPPY CODE LDB $XECM B GET RTE-M SECURITY CODE STB MSCA,I SAVE IT XIF * END RTE-M FLOPPY CODE CPA MCODF SEE IF THEY SUPPLIED A MASTER JMP SUB21 NONE--NO SPECIAL ACCESS. LDB MSCA,I GET MASTER SECURITY CODE. SZB IF NONE, ALLOW ACCESS. CPB MCODF USER'S AND MASTER MATCH? CCE MATCH! ALLOW ACCESS. SUB21 ELA STA MCODF SAVE MASTER SECURITY CODE MATCH SUB22 LDA CRLU DO THEY WANT A SPECIFIED LU? SZA,RSS LU SUPPLIED? JMP MCR NO LDB LUDSP GET DISPLACEMENT CMA,INA ASSUME LU SSA,RSS IS IT LABEL? JMP SUB23 NO...LU CMA,INA YES...LABEL...MAKE POS AGAIN ADB D2 AND GET TO LABEL WORD SUB23 CPA B,I IS LABEL OR LU MATCH? JMP MCR MATCH...PROCESS LU LDA LUDSP NO MATCH GO TO NEXT ONE ADA D4 STA LUDSP JMP SUB2B SPC 5 * * ROUTINE TO PROCESS A MOUNTED CARTRIDGE * SPC 1 MCR LDA SUB5A SET UP FOR RETURN AFTER SENDING THE LINE STA BROUT LDA SECT2 GET # OF SECTORS IN TRACK STA SCTRK SAVE IN SECTORS/TRACK LDA LUDSP,I GET LU OF DISK STA WCLU SAVE AS WANTED CURRENT LU ISZ LUDSP GET TO FIRST DIRECTORY TRACK LDB LUDSP,I GET DIRECTORY TRACK ADDRESS STB WTRCK SAVE TRACK ADDRESS ISZ LUDSP GET TO LOCK WORD ISZ LUDSP LDB LUDSP,I GET LOCK WORD ISZ LUDSP GET TO NEXT ENTRY SZB IS LU LOCKED JMP SUB2 YES * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB PRE-RTE4B SYSTEM? JMP MCR01 NO CPA D2 YES, IS IT SYSTEM DISC? LDB D14 YES RSS MCR01 CLB XIF * END RTE CODE * STB WSEC SAVE STARTING SECTOR ADDRESS LDA DBFA1 SET FOR ZERO DISPLACEMENT WITHIN BUFFER JSB SCFXV GO GET SECTOR JMP SUB2 NO DIRECTORY? LDA DISP GET NAME OF CART. LDB CRNAA GET DESTINATION ADDRESS MVW D3 MOVE 3 WORDS LDA CRNA GET FIRST WORD OF CR NAME AND B7777 GET RID OF SIGN BIT STA CRNA RESTORE LDA DISP GET TO LABEL WORD ADA D3 LDA A,I CONVERT LABEL WORD TO ASC JSB BNDEC DEF LWA LABEL WORD ADDRESS LDB DISP GET TO # SEC/TRACK ADB D6 LDA B,I GET # OF SECTORS/TRACK STA SCTRK SAVE AS # OF SECTORS/TRACK ADB D2 GET TO # OF DIRECTORY TRACKS LDA B,I ADA WTRCK GET ENDING DIRECTORY TRACK STA NTRKS LDA B,I GET # OF DIRECTORY TRACKS CMA,INA MAKE # POS. JSB BNDEC CONVERT TO ASC DEF DTRKA LDA DTRKA+2 MOVE UP THE LEAST SIGNIFICANT DIGITS STA DTRKA THEY ARE THE ONLY ONES TO BE PRINTED LDA #NODE IDENTIFY THE JSB BNDEC NODE WHICH IS DEF NODE BEING LISTED. JSB WTLIN SEND LINE TO TERMINAL DEF HEAD1 FIRST HEADING LINE SPC 5 * * HERE AFTER FIRST HEADING LINE WRITTEN * SUB3 LDA SUB4A GET ADDRESS WHERE TO GO NEXT TIME STA BROUT LDB D17 NON-SECURITY HEADER LENGTH. LDA MCODF SZA SECURITY CODES BEING LISTED? LDB D20 YES, ADD "SCODE" TO HEADER STB HEAD2 JSB WTLIN SEND OUT SEND HEADING LINE DEF HEAD2 SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE * SUB5 LDA SUB3A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN SEND OUT BLANK LINE DEF BLNKL SPC 5 * * HERE TO START OUTPUTING DIRECTORY * SUB4 LDA DISP GET FILE ENTRY ADA D16 JSB SCFX SEE IF WE NEED NEW SECTOR JMP SUB2 DONE...NO MORE DIRECTORY LDA DISP,I IS THIS FILE PURGEiD SSA JMP SUB4 YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU JSB MDLIN MOVE THE LINE JMP SUB4 ERROR CONDITION JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB6 LDA SUB7A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB7 LDA SUB2A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL * * HERE TO DO A CARTRIDGE LIST * SUB8 LDA SUB9A GET ADDRESS FOR NEXT TIME. STA BROUT LDA #NODE IDENTIFY THE NODE JSB BNDEC WHOSE CARTRIDGE LIST DEF CLNOD IS BEING PROCESSED. JSB WTLIN OUTPUT THE DEF CLHED CARTRIDGE-LIST HEADER. SPC 2 * * HERE TO OUTPUT A SEPARATING BLANK LINE. * SUB9 LDA SB10A GET ADDRESS FOR FIRST LINE STA BROUT SET COROUTINE POINTER. JSB WTLIN OUTPUT A DEF BLNKL BLANK LINE. SPC 2 * * PROCESS THE CARTRIDGE-LIST ENTRY. * SUB10 LDA LUDSP,I GET THE CARTRIDGE LOGICAL UNIT. ISZ LUDSP ADVANCE THE ENTRY-POINTER. JSB BNDEC CONVERT THE LU DEF DTYPA TO IT'S ASCII EQUIVALENT. LDA DTYPA+2 GET THE TWO USEFUL ASCII DIGITS. STA LU CONFIGURE THE LINE. LDA LUDSP,I GET THE LAST TRACK FOR THE CARTRIDGE. ISZ LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT LAST TRACK TO ASCII, DEF LTRK AND CONFIGURE THE LINE. LDA LUDSP,I GET THE CARTRIDGE NUMBER. ISZ LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT CARTRIDGE NO. TO ASCII, DEF CART AND CONFIGURE INTO MESSAGE. LDB CLEN1 PREPARE FOR UNLOCKED LINE LENGTH. LDA LUDSP,I GET THE LOCK FLAG (I.D. \SEG. ADDR.) ISZ LUDSP BUMP POINTER. SZA,RSS IF IT'S NOT LOCKED, JMP SNDLN THEN COMPLETE THE LINE; ADA D12 ELSE, POINT TO PROGRAM NAME, CLE,ELA AND FORM ITS BYTE ADDRESS. LDB CLKBA GET CONFIGURED MESSAGE BYTE ADDRESS. MBT D5 MOVE THE LOCKER'S NAME TO THE LINE. LDB CLEN2 GET LOCKED-CARTRIDGE LINE LENGTH. SNDLN STB CLINE CONFIGURE THE LINE LENGTH. LDB SUB2A SET FOR RETURN VIA RELOAD SECTION. LDA LUDSP,I IF THE NEXT ENTRY SZA,RSS IS NULL, THE LIST IS COMPLETE, SO LDB SB11A SET RETURN TO WRAP-UP SECTION; STB BROUT ESTABLISH THE COROUTINE POINTER. STB FLTR+1 SET FLAG FOR CLIST CONTINUATION. JSB WTLIN SEND THE CONFIGURED LINE DEF CLINE TO THE REMOTE NODE. * SUB11 LDA DON1A SEND A STA BROUT BLANK LINE, JSB WTLIN AND RETURN DEF BLNKL TO THE END PROCESSOR. * CLEN1 DEC 11 CLEN2 DEC 15 CLKBA DBL LOCK * CLHED DEC 24 ASC 14, LU LAST TRACK CR LOCK ASC 7, REMOTE NODE= CLNOD ASC 3, * CLINE NOP ASC 1, LU ASC 1, ASC 2, LTRK ASC 3, ASC 1, CART ASC 3, ASC 1, LOCK ASC 3, * HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1977 * * SUBROUTINE TO MOVE DETAIL LINE TO PRINT LINE * CALLING SEQUENCE * JSB MDLIN * NO MATCH RETURN...IE..FILTER MIS-MATCH,TYPE NO MATCH * NORMAL RETURN * SPC 1 MDLIN NOP LDA FLTR IS FILTER SPECIFIED SZA NO CPA SPACA OR IS IT ALL SPACE? JMP NDLN2 NOT SUPPLIED OR SPACE LDA FLTRA GET ADDRESS WHERE FILTER LOCATED CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP SAVE FILTER BYTE ADDRESS LDA DISP GET ADDRESS OF NAME CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP1 SAVE IN BYTE ADD COUNTER LDA M6 # OF CHAR IN FILTER ~ STA TEMP2 SAVE IN DOWN COUNTER MDN11 LDB TEMP GET BYTE ADD OF FILTER LBT GET BYTE SZA,RSS IF ZERO, CHANGE TO SPACE LDA C40 C40=SPACE CPA FLTRC IS IT A "-"? JMP MDN12 YES...DON'T CHECK STA TEMP3 SAVE IN TEMP LOCATION LDB TEMP1 GET BYTE ADDRESS OF NAME LBT GET BYTE CPA TEMP3 IS THERE A MATCH? RSS YES JMP MDLIN,I NO...IGNORE ENTRY MDN12 ISZ TEMP GET TO NEXT ENTRY ISZ TEMP1 ISZ TEMP2 DONE? JMP MDN11 NO SPC 1 * * AFTER CHECKING NAME, CHECK TYPE * NDLN2 LDB DISP GET TO FILE TYPE ADB D3 LDB B,I LDA FTYP CHECK WITH FILE TYPE PASSED RAL,CLE,ERA IS THERE A FILE TYPE? SEZ FILE TYPE SPECIFIED CPA B YES...DOES IT MATCH RSS MATCH...OR NO FILE TYPE SPECIFIED JMP MDLIN,I FILE TYPE NOT MATCHED ISZ MDLIN SET FOR NORMAL (P+2) RETURN. LDA DLLS ESTABLISH LINE LENGTH STA DLINA FOR LINE SANS SECURITY CODE. STB FTYPT SAVE FILE TYPE, TEMPORARILY. LDA B GET FILE TYPE FOR CONVERSION. JSB BNDEC CONVERT FILE TYPE TO ASC DEF DTYPA LDA DISP MOVE NAME TO OUTPUT LINE LDB ADNAM GET DESTINATION ADDRESS MVW D3 MOVE NAME LDA DISP GET # OF SECTORS OR LU ADA D4 ASSUME LU LDB FTYPT SEE IF TYPE=0 SZB YES? ADA D2 NO...GET # OF SECTORS LDA A,I GET VALUE SZB,RSS LU? JMP CNVRT YES, DON'T DIVIDE BY 2 SSA NEG BLOCK COUNT? CMA,INA,RSS YES, MAKE POS & SKIP DIV BY 2 CLE,ERA CONVERT TO # OF BLOCKS CNVRT JSB BNDEC CONVERT TO ASC DEF DBSLU LDA BLNK4 BLANK OUT THE LDB OPNAD 'OPEN TO' / EXTENT NO. MVW D4 INFORMATION FIELD. LDA FTYPT GET THE FILE TYPE. SZA,RSS IF THE TYPE IS ZERO, JMP OPNFL DON'T WORRY ABOUT EXTENTS. LDB DISP GET THE ADB D5 EXTENT WORD CLE,ELB FROM THE UPPER BYTE LBT OF THE DIRECTORY ENTRY. SZA,RSS IF NOT AN EXTENT, THEN JMP OPNFL CHECK THE OPEN FLAGS; JSB BNDEC ELSE, CONVERT EXTENT NO., OPNAD DEF DXOPN AND ADD IT TO THE LINE. LDA EXTBA GET BYTE ADDR. OF EXTENT DELIMITER. LDB EXNBA GET BYTE ADDR. OF DELIMITER BUFFER. MBT D3 MOVE ' +' TO CONFIGURED LINE. JMP SCODP IGNORE OPEN FLAGS FOR EXTENTS. OPNFL LDA DISP GET THE ADA D9 OPEN FLAG LDA A,I FROM THE ENTRY. * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB,RSS PRE-RTE4B SYSTEM? JMP OPNF1 NO LDB A YES, SAVE OPEN FLAG AND BT15 ISOLATE OPEN FLAG STA DTEMP SAVE EXCLUSIVE BIT LDA B RETRIEVE FLAG AND RTBYT ISOLATE ID SEG # SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. LDB KEYWD CALCULATE POINTER ADB M1 TO ID SEGMENT ADB A ADDRESS. LDA B,I GET ID SEG ADR IOR DTEMP INCLUDE EXCLUSIVE BIT XIF * END RTE CODE * OPNF1 SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. CLE,ELA SAVE EXCLUSIVE FLAG, ADA D24 AND FORM I.D. SEG WD#13 BYTE ADDRESS. LDB OPNBA GET BYTE ADDR. FOR CONFIGURED LINE. MBT D5 MOVE PROGRAM NAME INTO LINE. LDA C55 IF IT IS EXCLUSIVE, THEN SEZ USE ' -' AS A DELIMITER, AND SBT ADD THE DELIMITER TO THE LINE. SCODP LDB MCODF SUPPLY SECURITY CODE? SZB,RSS JMP MDLIN,I NO...RETURN. LDA DLLWS ESTABLISH LI(ONE LENGTH STA DLINA FOR LINE WITH SECURITY CODE. LDA DISP GET THE ADA D8 SECURITY CODE LDA A,I FROM THE ENTRY. JSB BNDEC CONVERT TO ASCII, DEF DSECA AND CONFIGURE INTO LINE. JMP MDLIN,I RETURN. SPC 1 FTYPT NOP D5 DEC 5 D9 DEC 9 D12 DEC 12 D16 DEC 16 D20 DEC 20 DLLS EQU D16 DLLWS EQU D20 D24 DEC 24 BLNK4 DEF BLNKL+1 BLPLS ASC 2, + EXTBA DBL BLPLS EXNBA DBL DXOPN OPNBA DBL DXOPN+1 KEYWD EQU 1657B KEYWORD BLOCK ADR RTBYT OCT 377 BT15 OCT 100000 SPC 5 * * HERE WHEN WE ARE ALL DONE * DONE LDA BROUT SEE IF WE SENT THEM ANYTHING SZA JMP DONE1 YES...JUST TERMINATE LDA DON1A GET ADDRESS OF TERMINATION POINT STA BROUT JSB WTLIN SEND "DISK NOT MOUNTED" DEF NOCRM * DONE1 CLA STA LNGH SET FOR NO DATA LDA BIT14 TELL OTHER SIDE, ALL DONE JMP TERM SPC 5 * * SUBROUTINE TO SEND DATA TO REMOTE * CALLING SEQUENCE * JSB WTLIN * DEF BUFFER * * BUFFER FORMAT: * LENGTH WORD, DATA BUFFER * WTLIN NOP LDA WTLIN,I GET ADDRESS OF OUPUT LINE INA GET TO FIRST DATA WORD STA WTLNB LDB WTLIN,I GET LENGTH OF MESSAGE LDB B,I LDA LNGH GET AVAILABLE LENGTH CMA,INA ADA B SEE IF THERE WAS TO MUCH ROOM SSA CHANGE LENGTH? STB LNGH YES...SET IN CORRECT LENGTH * CLA SET FOR MORE TO COME TERM STA STAT SAVE STATUS LDA STYP GET STREAM TYPE IOR BIT14 SET FOR REPLY STA STYP LDA #NODE STA IRBUF+6 SET STATUS LOCATION * JSB D65SV SEND REPLY DEF *+5 DEF IRBUF DEF D23 REPLY LENGTH WTLNB NOP DATA ADDRESS DEF LNGH DATA LENGTH * NOP IGNORE ERROR RETURN JMP DLST0 GOj DO A GET CALL * SPC 5 * * SUBROUTINE TO KEEP DISPLACEMENT ON DISK OK * CALLING SEQUENCE * JSB SCFX * NO MORE DIRECTORY TRACK RETURN * NORMAL RETURN * A REG=DISPLACEMENT * UPON RETURN * WILL UPDATE WTRCK,WSEC,AND DISP AS REQUIRED * ASSUMES DISP STARTS WITH ADDRESS OF BUFFER * SCTRK MUST BE SET TO # OF SECTORS/TRACK * IF TRACK CHANGES, NTRCK=LAST DIRECTORY TRACK-1 * ALL SECTORS ARE ASSUMED TO BE 128 WORDS LONG * SPC 1 SCFX NOP CMA,INA NEGATE ADDRESS ADA DBFA1 GET DISPLACEMENT CMA,INA MAKE IT POSITIVE CLB CHECK IF OVERFLOW DIV D128 CROSS A SECTOR BOUNDRY ADB DBFA1 GET DISPLACEMENT AS AN ADDRESS STB DISP SAVE DISPLACEMENT ADDRESS SZA,RSS SECTOR CHANGE JMP SCFXA NO LDA D14 YES...GET TO NEXT SECTOR ADA WSEC GET TO NEXT SECTOR ADDRESS CLB DIV SCTRK SEE IF WE HAVE A HAVE LOOPED AROUND STB WSEC SAVE NEW SECTOR ADDRESS SZA IF NO ROLLOVER OR SZB NO NEW TRACK NEEDED JMP SCFXA DON'T UPDATE TRACK ADDRESS CCB UPDATE TRACK ADDRESS ADB WTRCK GET TO NEXT TRACK CPB NTRKS DONE? JMP SCFX,I YES STB WTRCK NO...SET IN NEW TRACK ADDRESS SCFXA LDA DBFA1 DO A 128 WORD READ JSB GETSC ISZ SCFX GET TO RETURN JMP SCFX,I RETURN SPC 5 * * SUBROUTINE TO READ A PHYSICAL SECTOR (128 WORDS) * * CALLING SEQUENCE: * * LDA * JSB GETSC * * THE FOLLOWING MUST BE SET UP: * * WTRCK,WSEC,WCLU * GETSC NOP STA BUFAD SAVE BUFFER ADR LDA FLTR IF A CARTRIDGE LISTING CPA M1 IS CURRENTLY IN PROGRESS, JMP GTSC1 FORCE A RELOAD OF THE SECTOR. LDA WTRCK GET CURRENT TRACK ADDRESS CPA CTRCK SAME AS ONE WE GOT NOW2? RSS YES JMP GTSC1 NO...GO READ IT LDA WSEC IS IT THE SAME SECTOR CPA CSEC ? RSS YES JMP GTSC1 NO...GO READ IT LDA WCLU SAME LU? CPA CCLU JMP GETSC,I YES...DON'T READ SECTOR GTSC1 LDA WCLU SET UP AS CURRENT STA CCLU LDA WTRCK STA CTRCK LDA WSEC STA CSEC JSB EXEC GO READ A SECTOR DEF *+7 DEF D1 DEF WCLU BUFAD NOP DEF D128 DEF WTRCK DEF WSEC JMP GETSC,I GOT SECTOR, RETURN SPC 2 CTRCK OCT -1 CSEC OCT -1 CCLU OCT -1 BUFL NOP SPC 5 * * SUBROUTINE CONVERT BINARY TO ASCII DECIMAL * CALLING SEQUENCE * JSB BNDEC * DEF BUFFER WHERE TO ASC * A REG=BINARY # * BNDEC NOP STA DTEMP SAVE BINARY # LDB BNDEC,I GET ADDRESS WHERE TO ASC CLE,ELB CONVERT TO BYTE ADDRESS STB DTMP1 SAVE BYTE ADDRESS ISZ BNDEC GET TO RETURN ADDRESS LDA DNMA GET ADDRESS OF DIVISORS STA DTMP2 SAVE FOR DIVIDING LDA M5 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER LDA C40 GET A SPACE CHARACTERR LDB DTEMP GET BINARY VALUE SSB,RSS IF NEGATIVE...CONVERT JMP BNDCB NOT NEGATIVE CMB,INB NEGATIVE, MAKE POSITIVE STB DTEMP LDA C55 SET IN NEG SIGN BNDCB LDB DTMP1 GET BYTE ADDRESS SBT SAVE SIGN ISZ DTMP1 GET NEXT BYTE ADDRESS BNDCA LDA DTEMP GET BINARY # CLB GET A ZERO DIV DTMP2,I STB DTEMP SAVE REMAINDER ADA C60 CONVERT TO ASC LDB DTMP1 GET CURRENT BYTE ADDRESS SBT SAVE ASC BYTE ISZ DTMP2 GET NEXT DIVISOR ISZ DTMP1 GET NEXT BYTE ADDRESS ISZ DTMP3 DONE? JMP BNDCA NO JMP BNDEC,I RETURN SPC 1 C55 OCT 55 DTEMP NOP bNLH DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM DNM DEC 10000,1000,100,10,1 SPC 5 * * PARMB LAYOUT * IRBUF BSS 23 STYP EQU IRBUF STREAM TYPE STAT EQU IRBUF+7 STATUS LNGH EQU IRBUF+8 LENGTH WORD FLTR EQU IRBUF+10 NAME FILTER...0..NO FILTER MCODF EQU IRBUF+13 MASTER SECURITY CODE CRLU EQU IRBUF+14 LU OF CART. TO DO FTYP EQU IRBUF+15 FILE TYPE FILTER BROUT EQU IRBUF+9 ADR OF NEXT PROCESS ROUTINE. 0=START WCLU EQU IRBUF+16 CURRENT LU FOR DISK READ WTRCK EQU IRBUF+17 CURRETN TRACK TO READ WSEC EQU IRBUF+18 CURRENT SECTOR TO READ DISP EQU IRBUF+19 DISPLACEMENT IN BUFFER SCTRK EQU IRBUF+20 # OF SECTORS/TRACK LUDSP EQU IRBUF+21 DISPLACEMENT IN DIRECTORY LU NTRKS EQU IRBUF+22 # OF DIRECTORY TRACKS C40 OCT 40 C60 OCT 60 D3 DEC 3 D8 DEC 8 D14 DEC 14 D17 DEC 17 D23 DEC 23 D128 DEC 128 D4 DEC 4 D1 EQU DNM+4 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 M2 DEC -2 M5 DEC -5 M6 DEC -6 B7777 OCT 77777 BIT14 OCT 40000 FLTRA DEF FLTR GNFLTRC EQU C55 "DON'T-CARE" FILTER CHAR (MINUS SIGN) TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP * TATSD EQU 1756B SECT2 EQU 1757B DBFA1 DEF DBUF IFN * START RTE CODE DBFAD DEF DBUF MAY BE MODIFIED AT INIT D253 DEC 253 XIF * END RTE CODE MSCA DEF DBUF+126 @MSC. MAY BE MODIFIED AT INIT CLSSN NOP CRNAA DEF CRNA ADNAM DEF DNAMA SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 DEC 34 SPACA ASC 1, ASC 3,ILAB= CRNA ASC 3, ASC 1, ASC 10,REMOTE DLIST: NODE= NODE ASC 3, ASC 1, ASC 2,CR#= LWA ASC 3, ASC 1, ASC 5,DIR TRKS= DTRKA ASC 3, SPC 1 HEAD2 NOP ASC 20, NAME TYPE #BLKS/LU OPEN TO SCODE SPC 1 NOCRM DEC 9 ASC 9, DISK NOT MOUNTED DLINA NOP ASC 1, DNAMA ASC 3, ASC 1, DTYPA ASC 3, ASC 1 DBSLU ASC 3, DXOPN ASC 4, ASC 1, DSECA ASC 3, SPC 2 BLNKL DEC 1 OCT 20040,20040,20040,20040 * DBUF EQU * IFN * START RTE CODE BSS 256 XIF * END RTE CODE IFZ * START RTE-M FLOPPY CODE BSS 128 XIF * END RTE-M FLOPPY CODE SPC 3 END EQU * END DLIST !  91740-18011 1740 S C0122 DS/1000 MODULE: DLIST              H0101 @ASMB,R,L,C HED DLIST 91740-16011 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 NAM DLIST,19,30 91740-16011 REV 1740 770404 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ******************************************************* * *DLIST DIRECTORY LIST MONITOR FOR DS-1000 * CTU-BASED SYSTEMS. * *SOURCE PART # 91740-16011 REV 1740 * *REL PART # 91740-16011 REV 1740 * *WRITTEN BY: DAN GIBBONS * *DATE WRITTEN: JANUARY 1977 * *MODIFIED BY: * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * * ENT DLIST * EXT EXEC,D65SV,D65GT,#NODE EXT .DRCT,$CDIR IFZ EXT DBUG XIF * * A EQU 0 B EQU 1 HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1977 * * MAIN ROUTINE STARTS HERE * DLIST NOP LDA B,I SEE IF THEY WANT DEBUG STA CLSSN SAVE CLASS NUMBER IFZ SZA DO THEY WANT DEBUG JMP DLST0 NO JSB DBUG DEF *+1 JSB EXEC DEF *+4 DEF D6 DEF D0 DEF D1 JMP DLIST XIF SPC 1 DLST0 JSB D65GT DO A GET CALL DEF *+6 DEF CLSSN DEF IRBUF DEF D23 DEF D0 NO DATA DEF D0 JMP DLST0 IGNORE ERROR CALL * LDA BROUT GET ADDRESS OF CURRENT COROUTINE SZA,RSS JMP SUB1 JMP A,I GO TO SPECIFIED SUBROUTINE SPC 2 SUB2A DEF SUB2 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB7A DEF SUB7 DON1A DEF DONE1 SPC 5 * * HERE ON NEW REQUEST * SUB1 JSB .DRCT GET ADR OF CTU DIRECTORY DEF $CDIR STA LUDSP SAVE FOR LU LOOPING ADA M1 GET TO LAST TRACK LDA A,I GET LAST-ENTRY ADR STA ENDCD SAVE IT SUB2 LDA LUDSP GET DIRECTORY POINTER CPA ENDCD DONE? JMP DONE YES LDA A,I GET CARTRIDGE LU SZA,RSS DONE? JMP DONE YES SUB22 LDA CTULU DO THEY WANT A SPECIFIED LU? CPA DBLNK LU SUPPLIED? JMP MCR NO, DO ALL LU'S LDB LUDSP GET DISPLACEMENT SSA IF NEG, MAKE POS CMA,INA CPA B,I DOES LU MATCH? JMP MCR MATCH...PROCESS LU ADB D4 NO MATCH. GO TO NEXT ENTRY STB LUDSP JMP SUB2 SPC 5 * * ROUTINE TO PROCESS A MOUNTED CARTRIDGE * SPC 1 MCR LDA SUB5A SET UP FOR RETURN AFTER SENDING THE LINE STA BROUT * LDA LUDSP,I CONVERT LU TO TWO JSB BNDEC ASCII DIGITS & SET DEF LUXX INTO HEAD1 MSG. * ISZ LUDSP GET TO VALIDITY WORD ADR LDA LUDSP,I GET THE ADR LDA A,I GET THE VALIDITY WORD STA VAL SAVE IT LDB LHED1 GET HEAD1 MESSAGE LENGTH SZA IS DIRECTORY VALID? LDB LHED2 NO, ADJUST LENGTH OF MESSAGE STB HEAD1 SET MESSAGE LENGTH ISZ LUDSP GET TO FILE DIRECTORY ADR LDA LUDSP,I GET THE ADR STA DISP SAVE THE ADR ADA M1 GET TO LAST-ENTRY ADR LDA A,I GET THE ADR STA ENDFD SAVE IT ISZ LUDSP GET TO NEXT CTU ISZ LUDSP DIRECTORY ENTRY. JSB WTLIN SEND LINE BACK TO REMOTE DEF HEAD1 HEADING LINE ADR SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE IF DIRECTORY VALID. * SUB5 LDA VAL SZA DIRECTORY VALID? JMP SUB6 NO, GET NEXT ONE LDA SUB4A SET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN SEND OUT BLANK LINE DEF BLNKL SPC 5 * * HERE TO START OUTPUTTING DIRECTORY * SUB4 LDA DISP GET FILE ENTRY ADR CPA ENDFD END OF DIRECTORY? JMP SUB6 YES LDA A,I GET ENTRY SSA IS THE FILE PURGED? JMP NXT YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU LDA DISP MOVE THE LDB ADNAM DETAIL LINE MVW D4 TO PRINT LINE. LDA DISP GET TO NEXT ENTRY ADA D4 STA DISP JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE NXT LDA DISP GET TO NEXT ENTRY ADA D4 STA DISP JMP SUB4+1 SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB6 LDA SUB7A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB7 LDA SUB2A GET ADDRESS FOR NEXT TIME STA BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1977 * * HERE WHEN WE ARE ALL DONE * DONE LDA BROUT SEE IF WE SENT THEM ANYTHING SZA JMP DONE1 YES...JUST TERMINATE LDA DON1A GET ADDRESS OF TERMINATION POINT STA BROUT JSB WTLIN SEND "CTU NOT MOUNTED" DEF NOCRM * DONE1 CLA STA LNGH SET FOR NO DATA LDA BIT14 TELL OTHER SIDE, ALL DONE JMP TERM SPC 5 * * SUBROUTINE TO SEND DATA TO REMOTE * CALLING SEQUENCE * JSB WTLIN * DEF BUFFER * BUFFER FORMAT * LENGTH WORD, DATA BUFFER * WTLIN NOP LDA WTLIN,I GET ADDRESS OF OUPUT LINE INA GET TO FIRST DATA WORD STA WTLNB LDB WTLIN,I GET LENGTH OF MEeSSAGE LDB B,I LDA LNGH GET AVAILABLE LENGTH CMA,INA ADA B SEE IF THERE WAS TO MUCH ROOM SSA CHANGE LENGTH? STB LNGH YES...SET IN CORRECT LENGTH * CLA SET FOR MORE TO COME TERM STA STAT SAVE STATUS LDA STYP GET STREAM TYPE IOR BIT14 SET FOR REPLY STA STYP LDA #NODE STA IRBUF+6 SET STATUS LOCATION * JSB D65SV SEND REPLY DEF *+5 DEF IRBUF DEF D23 REPLY LENGTH WTLNB NOP DATA ADDRESS DEF LNGH DATA LENGTH * NOP IGNORE ERROR RETURN JMP DLST0 GO DO A GET CALL * SPC 5 * * SUBROUTINE TO CONVERT BINARY # TO 2 ASCII DECIMAL DIGITS * * CALLING SEQUENCE: * * JSB BNDEC * DEF BUFFER WHERE TO STORE ASCII DIGITS * A REG=BINARY # * BNDEC NOP STA DTEMP SAVE BINARY # LDB BNDEC,I GET ADDRESS WHERE TO ASC CLE,ELB CONVERT TO BYTE ADDRESS STB DTMP1 SAVE BYTE ADDRESS ISZ BNDEC GET TO RETURN ADDRESS LDA DNMA GET ADDRESS OF DIVISORS STA DTMP2 SAVE FOR DIVIDING LDA M2 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER BNDCA LDA DTEMP GET BINARY # CLB GET A ZERO DIV DTMP2,I STB DTEMP SAVE REMAINDER ADA C60 CONVERT TO ASC LDB DTMP1 GET CURRENT BYTE ADDRESS JSB SBYTE SAVE ASC BYTE ISZ DTMP2 GET NEXT DIVISOR ISZ DTMP1 GET NEXT BYTE ADDRESS ISZ DTMP3 DONE? JMP BNDCA NO JMP BNDEC,I RETURN SPC 1 DTEMP NOP DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM M2 DEC -2 C60 OCT 60 DNM DEC 10,1 SPC 3 * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS THE BYTE * B REG CONTAINS THE BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT/ LOWER 8 BITS STA STEMP SAVE IN TEMP LOCATION CLE,ERB CONVERT TO WORD ADDRESS LDA B,I GET WORD SEZ,RSS RIGHT OR LEFT HALF? ALF,ALF LEFT AND UB377 ISOLATE UPPER 8 BITS IOR STEMP OR IN NEW HALF SEZ,RSS LEFT OR RIGHT? ALF,ALF LEFT STA B,I SAVE WORD ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN SPC 1 STEMP NOP B377 OCT 377 UB377 OCT 177400 SPC 5 * * REQST/REPLY BUFR LAYOUT * IRBUF BSS 23 STYP EQU IRBUF STREAM TYPE STAT EQU IRBUF+7 STATUS LNGH EQU IRBUF+8 LENGTH WORD BROUT EQU IRBUF+9 ADR OF NEXT PROCESS ROUTINE. 0=START CTULU EQU IRBUF+10 CARTRIDGE TAPE UNIT LU # ENDCD EQU IRBUF+16 END-OF-CARTRIDGE-DIRECTORY ADR ENDFD EQU IRBUF+17 END-OF-FILE-DIRECTORY ADR VAL EQU IRBUF+18 DIRECTORY-VALID FLAG. 0=VALID DISP EQU IRBUF+19 DISPLACEMENT IN BUFFER LUDSP EQU IRBUF+21 DISPLACEMENT IN DIRECTORY LU D23 DEC 23 D4 DEC 4 D1 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 BIT14 OCT 40000 * CLSSN NOP ADNAM DEF DNAMA LHED1 ABS ENDM1-SPACA LHED2 ABS ENDM2-SPACA SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 BSS 1 HOLDS MESSAGE LENGTH SPACA ASC 2, ASC 9,REMOTE DLIST LU LUXX BSS 1 ASC 5, DIRECTORY ENDM1 EQU * ASC 4, INVALID ENDM2 EQU * NOCRM DEC 8 ASC 8, CTU NOT MOUNTED DLINA DEC 7 ASC 3, DNAMA ASC 4, SPC 2 BLNKL DEC 1 DBLNK OCT 20040 SPC 3 END EQU * END DLIST    91740-18012 1913 S C0222 DS/1000 MODULE: PROGL              H0102 @ASMB,R,L,C HED PROGL 91740-16012 REV 1913 * (C) HEWLETT-PACKARD CO 1979 NAM PROGL,19,30 91740-16012 REV 1913 790128 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * PROGL * * SOURCE PART # 91740-18012 * * REL PART # 91740-16012 * * WRITTEN BY CHUCK WHELAN * * DATE WRITTEN MAY 1976 * * MODIFIED BY DMT * * DATE MODIFIED 780117 * MODIFIED BY LYLE WEIMAN, JAN '78 * *************************************************************** SPC 3 * * * DS/1000 PROGL MODULE FOR CONCURRENT MULTI-TERMINAL DOWNLOADS * ENT PROGL * EXT EXEC,OPEN,READF,CLOSE,#REQU,$OPSY EXT #PRLU,CNUMD,KCVT,LOCF,DRTEQ * * * #ACTV EQU 4 NUMBER OF ACTIVE DOWNLOADS AT ONE TIME * #TERM EQU 32 NUMBER OF POSSIBLE COMM. LINES * SKP * * * "PROGL" IS A DISTRIBUTED SYSTEM COMMUNICATIONS MONITOR. IT * SERVICES ALL SYSTEM DOWNLOAD REQUESTS FROM "CBL" SOFTWARE AT * REMOTE SATELLITES. WHEN A NEW REQUEST IS RECEIVED, THE REQUESTED * ABSOLUTE FILE CONTAINING THE CORELOAD IS TRANSMITTED RECORD-BY- * RECORD USING CLASS I/O WRITE/READ OPERATIONS TO THE COMMUNICATIONS * DRIVER ("DVA65"). * * WHEN "PROGL" IS NOT EXECUTING IT IS IN A CLASS I/O GET * SUSPENSION WAITING FOR AN ENTRY TO BE PLACED ON THE CLASS QUEUE * FOR ITS CLASS NUMBER. ENTRIES ARE PLACED ON THIS QUEUE WHEN A * NEW DOWNLOAD REQUEST IS RECEIVED OR A PREVIOUS CLASS I/O WRITE * COMPLETES. * * THE REQUEST PASSED TO "PROGL" BY "QUEUE" HAS THE E QT ADDR IN THE * 1ST WORD, AND THE DOWNLOAD FILE NUMBER (BINARY) IN THE 2ND WORD. * THE DOWNLOAD FILE NUMBER IS CONVERTED TO AN ASCII FILE NAME CONSISTING * OF "P" FOLLOWED BY THE FIVE ASCII DIGIT OCTAL EQUIVALENT OF THE * NUMBER. * * THE NUMBER OF DOWNLOADS THAT CAN BE ACTIVE AT ANY ONE TIME * IS LIMITED ONLY BY SYSTEM AVAILABLE MEMORY AND THE SIZE OF THE * ACTIVE DOWNLOAD TABLE. IN-PROCESS DOWNLOADS HAVE AN ENTRY IN * THIS TABLE CONSISTING OF LU, SEQ #, THE 144 WORD DCB FOR THE DOWNLOAD * FILE, AND THE FILE NUMBER. IF A NEW REQUEST IS RECEIVED WHILE * THIS TABLE IS FULL, IT IS PLACED IN A TWO WORD (LU, & FILE #) * ENTRY IN A WAIT QUEUE. WHEN AN ENTRY BECOMES AVAILABLE * IN THE ACTIVE TABLE, AN ENTRY IN THE WAIT QUEUE CAN BE ACTIVATED. * THE NUMBER OF ENTRIES IN THE ACTIVE TABLE IS SET AT ASSEMBLY TIME * BY THE ITEM "#ACTV". * * THE LU AND SEQ # OF A DOWNLOAD REQUEST ARE PASSED IN THE * REQUEST BUFFER OF EACH CLASS I/O WRITE/READ. THE PROGRAM ENSURES * THAT ONLY ONE DOWNLOAD TO A LU IS IN PROCESS BY RE-USING THE SAME * TABLE ENTRY WITH A NEW SEQ # IF A DOWNLOAD IS RESTARTED, AND * IGNORING I/O COMPLETIONS (ERRORS OR NOT) WITH WRONG SEQ. NUMBERS. * * EACH TIME THAT "PROGL" IS ENTERED ON A CLASS WRITE * COMPLETION, IT CHECKS THE RETURNED ERROR STATUS FOR DRIVER * ERRORS AND IF NONE, READS THE NEXT RECORD FROM THE DOWNLOAD * FILE, WRITES IT TO THE DRIVER AND AGAIN SUSPENDS ON ITS CLASS. * * WHEN ALL RECORDS IN THE DOWNLOAD FILE HAVE BEEN SUCCESSFULLY * TRANSMITTED, "PROGL" SENDS A ONE-WORD REQUEST TO THE SATELLITE * TO INDICATE THE DOWNLOAD IS COMPLETE. AT THIS TIME, THE FILE IS * CLOSED (UNLESS IT IS OPEN MORE THAN ONCE), THE TABLE ENTRY IS CLEARED, * AND UNLESS A WAIT QUEUE ENTRY CAN BE ACTIVATED, "PROGL" AGAIN SUSPENDS * ON ITS CLASS. * * * OPTIONAL FEATURE: THE USER MAY ELECT TO HAVE 'PROGL' PRINT * A MESSAGE ON A SPECIFIED LU EACH TIME A DOWN-LOAD IS INITIATED, * AND ALSO AT TERMIN>ATION ( SUCCESS OR FAILURE). AN EXAMPLE * MESSAGE IS SHOWN BELOW: *INITIATING VIA LU 7 DOWNLOAD OF FILE:P00000 AT DAY 5, 9 :10AM *DOWNLOAD OF FILE:P00000 AT DAY 5, 9 :11AM WAS SUCCESSFUL * * THE TIME OF INITIATION AND TIME OF TERMINATION ARE PRINTED (NOT * NECESSARILY EQUAL). * * THERE ARE TWO WAYS TO SELECT THIS OPTION: * 1) PROGRAMMATICALLY--WRITE A PROGRAM TO DECLARE '#PRLU' AS AN * EXTERNAL SYMBOL (THIS SYMBOL IS IN SUBSYSTEM GLOBAL AREA, SO * THE PROGRAM MUST BE LOADED GIVING IT ACCESS TO SSGA). * IT SHOULD STORE THE LU ON WHICH YOU WANT THESE MESSAGES IN * * #PRLU. * 2) AT GENERATION TIME--IN THE SECTION WHERE ENTRY POINT REPLACEMENTS * ARE ACCEPTED BY THE RTE GENERATOR, ENTER THE FOLLOWING * LINE (THIS IS AN EXAMPLE, SHOWING HOW TO SPECIFY THAT THE * MESSAGES ARE TO BE PRINTED ON LU 1): * * #PRLX,ABS,1 * SKP * * PROGL IS ENTERED HERE INITIALLY PROGL BSS 0 ENTRY. LDA 1,I SZA,RSS JMP PGET NOT FIRST TIME STA ICLAS SAVE PROGL'S CLASS AND MSK14 RELEASE CLASS BUFFER STA CLAS2 SAVE CLASS # FOR PROGL CLA LDB $OPSY SYSTEM TYPE FLAG RBR,SLB SKIP IF NON-DMS SYSTEM STA MOD1 SET TO DO "XLA" * INITIALIZE FILE NUMBERS LDB NACTV SET UP LOOP STB CNTR COUNTER = - # ENTRIES LDB D12N LOAD CLOSED MARKER CCA POINT TO FIRST ADA TABAD FILE NUMBER ENTRY BUMP ADA TLENT STB 0,I STORE MARKER ISZ CNTR DONE? JMP BUMP NO. MARK NEXT ONE * * * SUSPEND UNTIL A NEW REQUEST IS WRITTEN TO MONITOR OR COMPLETION * ON A PREVIOUS DRIVER WRITE OCCURS * PGET JSB EXEC WAIT FOR NEXT REQST OR I/O COMPLETION DEF *+7 DEF D21 DEF ICLAS DEF BUFR DEF D2 DEF BFADR ADDRESS OF REQ.BUFR IN SAM DEF RQLEN |oLENGTH OF REQUEST * STA IERR SAVE STATUS LDA RQLEN CPA D3 IF REQ LEN IS 3, THIS IS I/O COMPLETION JMP IOCOM PROCESS I/O COMPLETION CPA D4 ONE OF OUR OWN PRINTOUTS? JMP IGNOR YES, RELEASE THE BUFFER & AWAIT NEXT ONE. JSB RLEAS RELEASE CLASS BUFFER * * PROCESS NEW DOWNLOAD REQUEST * CLB LDA EQTA FWA OF EQT AREA CMA,INA ADA BUFR ADD THE EQT ADDR PASSED IN BUFFER DIV D15 COMPUTE EQT # INA STA EQT# SAVE EQT # LDB LUMAX CBX X HAS NO OF LU'S ADB DRT POINT TO END OF DRT TABLE * NXTLU ADB M1 DECREMENT DRT POINTER LDA 1,I GET DRT ENTRY AND B77 ISOLATE EQT # CPA EQT# MATCH? JMP FOUND YES DSX COUNT JMP NXTLU DO NEXT JMP PGET LU NOT FOUND! IGNORE REQUEST * FOUND CXA STA LU SET LU OF NEW REQUEST JSB SRCH SEARCH FOR ENTRY IN DOWNLOAD TABLE CLB,RSS THIS LU WASN'T IN TABLE JMP RSTRT FOUND, CLEAR & RESTART * * NO PREVIOUS ACTIVE ENTRY FOR LU CPB CURAD WAS DOWNLOAD TABLE FULL? JMP FULL YES, QUEUE THIS ENTRY LDA LU LU STA CURAD,I STORE IN 1ST WORD OF DOWNLOAD ENTRY JMP RSTR1 * * SAME LU, USE SAME TABLE ENTRY WITH NEW SEQ # & TIME-TAGS RSTRT EQU * JSB PRFAL PRINT OLD FILE NAME & MSG THAT DEF .ABR1 DOWN-LOAD WAS ABORTED JSB CLSE CLOSE PREVIOUS DOWNLOAD FILE SPC 2 RSTR1 EQU * LDB BUFR+1 FILE # FROM PARMB * * CONVERT FILE # TO BE DOWNLOADED INTO FILE NAME. NEWLD EQU * * CONVERT FILE NUMBER TO ASCII FILE NAME, AND * ALSO CONVERT TIME-OF-DAY TO ASCII. LDA DCBAD GET ADDRESS IN TABLE WHERE ADA D144 FILE # IS TO BE STORED STB 0,I STORE FILE NUMBER THERE. JSB GFDNAM * ISZ POOLS UPDATE POOL SEQUENCE NUMBER ZERO NOP LDA POOLS GET SEQ # OF THIS DOWNLOAD FROM POOL STA SEQAD,I 2ND WORD OF DOWNLOAD ENTRY STA SEQ# PASS IN REQUEST * * OPEN FILE TO BE DOWNLOADED JSB OPEN DO FMGR OPEN DEF *+5 DEF DCBAD,I DCB ADDRESS DEF IERR DEF NAME DEF ZERO * LDA #PRLU DOES USER WISH AN ANNOUNCEMENT OF THIS? SZA,RSS JMP POPN1 NO, CONTINUE STA LUPRN YES, SAVE PRINT LU * JSB LOCF FIND FILE LU DEF *+9 DEF DCBAD,I DEF SRCH DON'T CARE ABOUT THIS ERROR DEF SRCH DON'T CARE ABOUT 'IREC' PARAMETER DEF SRCH DON'T CARE ABOUT 'IRB' PARAMETER DEF SRCH DON'T CARE ABOUT 'IOFF' PARAMETER DEF SRCH DON'T CARE ABOUT 'JSEC' PARAMETER DEF .DLU SAVE FILE LU HERE DEF .TYP SAVE FILE TYPE HERE JSB KCVT CONVERT FILE LU TO ASCII DEF *+2 DEF .DLU STA .DLU JSB KCVT CONVERT FILE TYPE DEF *+2 DEF .TYP STA .TYP * JSB CNUMD CONVERT LINE LU NUMBER TO ASCII DEF *+3 DEF LU DEF .LU. JSB EXEC PRINT IT DEF *+8 DEF D18N PROTECT OURSELVES AGAINST BOGUS LU DEF LUPRN DEF MSG1 DEF MSG1L DEF D0 DEF D4 DEF ICLAS USE OUR OWN CLASS NUMBER NOP * POPN1 EQU * * LDA IERR SSA,RSS FILE OPENED OK? JMP NEXT YES, SEND NEXT RECORD SPC 2 OPNER EQU * LDB #PRLU USER WANT MESSAGES? SZB,RSS JMP ERR1 NO, JUST CLEAR OUT ENTRY STB LUPRN CMA,INA MAKE ERROR NEGATIVE FOR "CNUMD" TO CONVERT STA IERR JSB CNUMD DEF *+3 DEF IERR DEF FILER JSB EXEC PRINT FILE-OPEN ERROR MESSAGE DEF *+8 DEF D18N DEF LUPRN DEF MSG3 DEF MSG3L DEF D0 DEF D4 DEF ICLAS NOP JSB PRFAL PRINT "DOWNLOAD FAILED" MESSAGE DEF .FAIL JMP ERR1 HED SEND NEXT DOWNLOAD RECORD * (C) HEWLETT-PACKARD CO 1979 * * * ENTER HERE WHEN COMPLETION OF PREVIOUS WRITE HAS OCCURRED * IOCOM LDB BFADR POINT TO REQUEST BUFFER INB POINT TO 2ND WORD (IN S.A.M.) JSB LODWD GET THE ASSOCIATED LU STA LU INB POINT TO 3RD WORD JSB LODWD GET THE ASSOCIATED PROGL SEQ # STA SEQ# JSB SRCH FIND DOWNLOAD TABLE ENTRY FOR LU JMP IGNOR LU NOT IN TABLE, IGNORE LDA SEQAD,I GET SEQ # OF TABLE ENTRY CPA SEQ# DOES IT MATCH? RSS YES JMP IGNOR NO, IGNORE THIS COMPLETION * CHECK DRIVER ERROR STATUS LDA IERR GET ERROR STATUS FROM DRIVER SLA LSB OF EQT5 JMP ACCPT NO ERRORS, DO NEXT * * DRIVER ERROR OCCURRED * AND B170 TEST FOR PRTY, TIME-OUT, REMOTE BUSY, STOP CLE,SZA,RSS ANY OF THESE? JMP FAIL NO, TREAT AS HARD FAILURE * LDA CURAD,I GET RETRY COUNT ADA RTBIT BUMP RETRY COUNT STA CURAD,I SEZ RETRIES EXHAUSTED? JMP FAIL YES * ISZ ERCNT KEEP RETRY COUNT NOP FOR THOSE INTERESTED JSB EXEC SUSPEND FOR 200 MILLISECS DEF *+6 DEF D12N DEF D0 DEF D1 DEF D0 DEF M20 D0 NOP LDA LU AND B77 STA LU JSB DRTEQ GET THE LOGICAL UNIT DEF *+2 SUBCHANNEL BITS DEF LU FROM THE DRT ALF,CLE,ELA POSITION SUBCHANNEL LSB TO LDA ICNWD REMOVE THE PREVIOUS SUBCHANNEL LSB AND M5 FROM THE CONTROL WORD SEZ IF THE OUTPUT LU SPECIFIES AN ODD SUBCHANNEL, IOR D4 THEN SET BIT # 2 STA ICNWD IN THE CONFIGURED CONTROL WORD JSB #REQU RETHREAD FOR ANOTHER OUTPUT DEF *+5 DEF ICLAS DEF ICLAS DEF LU DEF ICNWD SZA,RSS OK? JMP PGET YES * FAIL JSB RLEAS RELEASE CLASS BUFFER JSB PRFAL PRINT "DOWNLOAD FAILED..." MESSAGE DEF .FAL1 JMP ERR3 CLEAR OUT TABLE ENTRY * IGNOR JSB RLEAS RELEASE CLASS BUFFER JMP PGET BACK TO GET * ACCPT JSB RLEAS RELEASE CLASS BUFFER SKP * * THIS SECTION IS ENTERED TO GET NEXT RECORD FROM DOWNLOAD FILE. * NEXT JSB READF READ NEXT RECORD DEF *+6 DCBAD NOP DEF IERR DEF DBUF DEF MAXL MAX ALLOWED LENGTH DEF LENX ACTUAL LENGTH * LDA IERR CHECK FOR ERRORS SSA JMP ERR2 ERROR IN FILE READ * LDA LENX SSA CHECK FOR END-OF-FILE JMP EOFND FOUND, WRAP IT UP * * VERIFY CHECKSUM OF NEXT RECORD TO BE DOWNLOADED * LDA DBUF ALF,ALF AND B377 STA 1 SAVE BUFFER LENGTH IN B SZA,RSS IS THIS A ZERO LENGTH RECORD? JMP NEXT YES, IGNORE IT STA LENX SET DATA LENGTH FOR DVR CALL LDB DBUF+1 GET DATA ADDRESS STB ISTAT CBL GETS IT AS 1 WORD REQUEST INA CMA,INA STA CNTR WORD COUNTER. LDB DBFAD BUFFER ADDRESS. CLA CKSML ADA 1,I ADD UP THE WORDS. INB ISZ CNTR JMP CKSML CPA 1,I COMPARE CHECKSUMS. RSS JMP CKSME NOT EQUAL. * * CHECKSUM OK, SETUP TO WRITE THIS RECORD LDA LU GET LU IOR ZB300 SET 'PROGL' FLAG SO DVR SENDS 1 WRD STA CONWD ('Z' BIT SET ALSO) LDA CURAD,I AND MSKLU INITIALIZE RETRY COUNT STA CURAD,I * * NOW DO CLASS I/O WRITE/READ TO DRIVER * JSB EXEC DEF *+8 DEF D20N NO ABORT BIT IS SET DEF CONWD WRITE DATA DEF DBUF+2 DATA BUFFER ADDR  DEF LENX BUFFER LENGTH DEF RQBUF PROGL REQUEST BUFFER: ADDR/LU/SEQ# DEF D3 DEF ICLAS WRITE IT ON PROGL'S CLASS RSS ERROR * NOW GO INTO SUSPEND ON PROGL'S CLASS UNTIL A DRIVER WRITE COMPLETES * OR A NEW REQUEST IS RECEIVED. JMP PGET JSB PRFAL CLASS-IO ERROR DEF .CLSR JMP PGET GO GET NEW REQUEST * * * ENTER HERE WHEN END OF DOWNLOAD FILE IS DETECTED * RETURN GOOD STATUS FOR A SUCCESSFUL DOWNLOAD * EOFND EQU * LDA #PRLU DOES USER WISH SZA,RSS ANNOUNCEMENTS? JMP EOFN1 NO. STA LUPRN LDA DCBAD GET ADDRESS OF ADA D144 FILE # ENTRY LDB 0,I JSB GFNAM CONVERT FILE NUMBER TO FILE NAME LDA @SUC MOVE 'WAS SUCCESSFUL' TO PRINT BUFFER LDB @RSLT MVW D8 JSB EXEC DEF *+8 DEF D18N DEF LUPRN DEF MSG2 DEF MSG2L DEF D0 DEF D4 DEF ICLAS NOP EOFN1 EQU * JSB CLSE CLOSE DOWNLOAD FILE CLA 0= GOOD DOWNLOAD * TERM STA ISTAT SET STATUS FOR TRANSMISSION LDA LU IOR ZB300 STA CONWD SET DVA65 CONTROL WORD * JSB EXEC WRITE FINAL REQUEST DEF *+8 DEF D20N CLASS WRITE/READ TO COMM DRIVER DEF CONWD DEF DBUF DEF ZERO NO DATA DEF RQBUF DEF D3 DEF ICLAS PROGL CLASS NUMBER NOP * * THIS DOWNLOAD IS OVER * CLEAN OUT DOWNLOAD TABLE ENTRY AND GIVE SPACE TO * ANY ENTRY FOUND IN WAITING QUEUE * CLA STA CURAD,I SET DOWNLOAD ENTRY AS AVAILABLE LDB WAITA LDA NQUE STA CNTR COUNTER= -# OF WAITQ ENTRIES CKQUE LDA 1,I SZA SKIP IF SLOT EMPTY JMP ACTIV OTHERWISE, ACTIVATE IT ADB D2 ISZ CNTR JMP CKQUE JMP PGET NOTHING QUEUED, GO TO GET SUSPEND * * NOW ACTIVATE A WAITING DOWNLOAD REQUEST FROM THE WAIT QUEUE USING * THE ACTIVE DOWNLOAD TABLE SPACE WHICH WAS JUST MADE AVAILABLE * ACTIV STA CURAD,I MOVE LU TO TABLE ENTRY JUST CLEARED STA LU AND PUT IT IN "LU" TOO !!! CLA STA 1,I CLEAR WAIT QUEUE ENTRY INB LDB 1,I PICKUP FILE # AND START DOWNLOADING IT JMP NEWLD HED PROGL SUBROUTINES & DATA AREA * (C) HEWLETT-PACKARD CO 1979 * * THIS SUBROUTINE SEARCHES FOR A DOWNLOAD TABLE ENTRY FOR * THE PASSED LU. RETURNS TO P+1 IF NOT FOUND, OTHERWISE P+2 * SRCH NOP LDA NACTV STA CNTR - # OF ACTIVE ENTRIES ALLOWED CLA INITIALIZE ADDR OF EMPTY SLOT STA TPNT LDB TABAD ADDR OF DOWNLOAD TABLE SNXT LDA 1,I PICKUP LU OF THIS ENTRY AND MSKLU MASK POSSIBLE RETRY COUNT CPA LU DOES THIS ONE MATCH LU? JMP SRCHX YES, FOUND DOWNLOAD ENTRY IOR TPNT NO, IS THIS THE 1ST EMPTY SLOT? SZA,RSS SKIP IF EMPTY SLOT ALREADY FOUND STB TPNT STORE ADDR OF 1ST EMPTY SLOT ADB TLENT BUMP TABLE POINTER ISZ CNTR JMP SNXT TRY NEXT * LU NOT IN ACTIVE TABLE LDB TPNT RETURN 1ST EMPTY SLOT INSTEAD RSS RETURN +1 * * FOUND AN ENTRY IN THE ACTIVE DOWNLOAD TABLE FOR THIS LU SRCHX ISZ SRCH RETURN+2 STB CURAD SET ADDRESS OF ENTRY INB STB SEQAD & ADDRESS FOR SEQ # INB STB DCBAD & ADDRESS FOR DCB JMP SRCH,I RETURN * * SUBROUTINE TO GET A WORD FROM SYSTEM AVAILABLE MEMORY LODWD NOP MOD1 JMP LDA NOP HERE IF DMS XLA 1,I JMP LODWD,I LDA LDA 1,I JMP LODWD,I * * RELEASE CLASS BUFFER * RLEAS NOP JSB EXEC DO DUMMY CLASS GET DEF *+5 DEF D21 DEF CLAS2 DEF BUFR DEF ZERO JMP RLEAS,I * * CLOSE DOWNLOAD FILE, UNLESS IT IS OPEN FOR ANOTHER DOWNLOAD * CLSE NOP * SET FILE I# ENTRY TO INDICATE CLOSED FILE CCA ADA CURAD ADA TLENT LDB 0,I SAVE FILE STB FLNUM NUMBER LDB D12N CLEAR STB 0,I ENTRY * CHECK TO SEE IF THE FILE IS STILL OPEN LDA NACTV SET UP LOOP STA CNTR COUNTER = - # ENTRIES CCA POINT TO FIRST ADA TABAD FILE NUMBER ENTRY BUMP2 ADA TLENT LDB 0,I GET FILE NUMBER CPB FLNUM IF = CURRENT ONE, JMP CLR9 GO DUMMY UP DCB ISZ CNTR MORE TO SEARCH? JMP BUMP2 YES--STAY IN LOOP * CURRENT NUMBER NOT FOUND. CLOSE FILE FOR REAL JSB CLOSE DEF *+3 DEF DCBAD,I DEF IERR JMP CLSE,I * CLEAR WORD 9 OF DCB SO FMP THINKS IT'S CLOSED CLR9 CLA LDB DCBAD ADB D9 STA 1,I JMP CLSE,I * * DOWNLOAD TABLE IS FULL, PUT THIS REQUEST IN WAITING QUEUE * FULL LDA NQUE STA CNTR -QUEUE TABLE SIZE CLA STA TPNT LDB WAITA ADDR OF WAIT QUEUE CKQ LDA 1,I GET LU OF THIS ENTRY CPA LU DOES IT MATCH THIS REQUEST JMP BLDQ YES, THEN SET NEW FILE # IOR TPNT CHECK IF THIS IS 1ST EMPTY SLOT IN QUEUE SZA,RSS SKIP IF NOT STB TPNT SAVE ITS ADDRESS ADB D2 BUMP QUEUE POINTER ISZ CNTR JMP CKQ EXAMINE NEXT ENTRY * * WE NOW KNOW THAT THIS LU WASN'T ALREADY IN WAIT QUEUE LDB TPNT GET ADDRESS OF 1ST EMPTY SLOT SZB,RSS WERE THERE ANY EMPTIES? JMP PGET NO, WE'RE IN TROUBLE LDA LU LU STA 1,I INTO 1ST WORD OF WAIT QUEUE ENTRY * BLDQ INB LDA BUFR+1 FILE # STA 1,I GOES INTO 2ND WORD JMP PGET GO BACK TO SUSPEND ON GET * ERR1 CCA ERROR IN FILE OPEN JMP TERM * HERE WHEN FILE-READ ERROR OCCURS * ERR2 EQU * LDB #PRLU SHOULD WE BOTHER PRINTING ERROR MESSTAGE? SZB,RSS JMP ER.2 NO STB LUPRN CMA,INA MAKE ERROR CODE NEGATIVE SO CNUMD CAN CONVERT STA IERR JSB CNUMD DEF *+3 DEF IERR DEF .FILE JSB EXEC PRINT FILE-READ ERROR DEF *+8 DEF D18N DEF LUPRN DEF .RDER DEF D15 DEF D0 DEF D4 DEF ICLAS NOP JSB PRFAL DEF .FAIL ER.2 EQU * JSB CLSE ERROR IN FILE READ, DO CLOSE LDA M2 JMP TERM SPC 2 ERR3 JSB CLSE DRIVER ERROR, DO CLOSE LDA M3 JMP TERM SPC 2 * HERE ON CHECKSUM ERROR ON READ * CKSME EQU * JSB PRFAL DEF .CKER JMP ER.2 SPC 2 * SUBROUTINE TO CONVERT FILE NUMBER INTO ASCII FILE NAME. * * CALLING SEQUENCE: * LDB * JSB GFNAM * * * GFNAM NOP RRL 4 DUAL ROTATE LEFT 4 AND D7 IOR ASCP0 FORM ASCII OF 1ST 2 CHARS STA NAME CLA RRL 3 POSITION 3RD OCTAL DIGIT ALF,RAL MOVE TO LHW RRL 3 GET 4TH DIGIT IOR ASC00 ASCII FOR 3RD & 4TH DIGITS STA NAME+1 CLA RRL 3 5TH DIGIT ALF,RAL TO LHW RRL 3 GET 6TH & FINAL DIGIT IOR ASC00 CONVERT TO ASCII STA NAME+2 LDA #PRLU USER WISH ANNOUNCEMENT? SZA,RSS JMP GFNAM,I NO,RETURN STA LUPRN JSB EXEC YES, INCLUDE TIME-OF-DAY DEF *+3 DEF D11 DEF DBUF JSB CNUMD CONVERT DAY NUMBER DEF *+3 DEF DBUF+4 DEF .DAY LDB AM CONVERT 24-HR TIME TO 12-HR TIME LDA DBUF+3 ADA M12 PM? SSA JMP GFNM1 NO. SZA,RSS 12 NOON? LDA D12 YES STA DBUF+3 LDB PM GFNM1 EQU * STB AMPM LDA DBUF+3 GET HOUR AGAIN SZA,RSS ZERO? LDA =D12s YES STA DBUF+3 JSB KCVT CONVERT HOUR NUMBER DEF *+2 DEF DBUF+3 STA .HR JSB KCVT CONVERT MINUTES DEF *+2 DEF DBUF+2 STA .MIN JMP GFNAM,I RETURN TO CALLER SPC 2 * SUBROUTINE TO HANDLE THE REPETITIVE PARTS OF PRINTING * A "DOWN-LOAD FAILED" MESSAGE. * * CALLING SEQUENCE: * JSB PRFAL * DEF * * PRFAL NOP LDA PRFAL,I GET ADDRESS OF MESSAGE ISZ PRFAL BUMP RETURN LDB #PRLU ARE WE SUPPOSED TO SZB,RSS PRINT A MESSAGE? JMP PRFAL,I NO, RETURN TO CALLER STB LUPRN SAVE LU LDB @RSLT MOVE REASON FOR FAILURE INTO MVW D8 "DOWN LOAD OF..." MESSAGE AREA LDA DCBAD GET ADDRESS OF ADA D144 FILE NUMBER LDB 0,I GET FILE NUMBER JSB GFNAM CONVERT THIS TO ASCII & ALSO FORMAT TIME-OF-DAY JSB EXEC PRINT MESSAGE DEF *+8 DEF D18N USE CLASS-I/O DEF LUPRN DEF MSG2 DEF MSG2L DEF D0 DEF D4 LENGTH OF 4 SO WE CAN SEPARATE DEF ICLAS OUR OWN PRINTOUTS FROM NOP XMISSION LINE COMPLETIONS JMP PRFAL,I RETURN TO CALLER SPC 2 * * DATA AREA * SUP MSG1 ASC 9, INITIATING VIA LU .LU. BSS 3 MSG2 ASC 9, DOWNLOAD OF FILE: NAME BSS 3 ASC 2,::- .DLU ASC 1, STORAGE FOR FILE DISC LU HERE ASC 1,: .TYP ASC 1, STORAGE FOR FILE TYPE HERE OCT 6412 CARRIAGE RETURN-LINEFEED ASC 4, AT DAY .DAY BSS 3 ASC 1,, .HR NOP ASC 1, : .MIN NOP AMPM BSS 1 'AM' OR 'PM' * .RSLT BSS 8 MSG1L ABS *-MSG1-8 MSG2L ABS *-MSG2-1 * @RSLT DEF .RSLT @SUC DEF *+1 ASC 8, WAS SUCCESSFUL .FAIL ASC 8, HAS FAILED. .ABR1 ASC 8, WAS ABORTED .FAL1 ASC 8, FAILED:RE-Q ERR .CLSR ASC 8, FAILED:CLASS ER .RDER ASC 12,/PROGL:{NLHFILE READ ERROR- .FILE BSS 3 .CKER ASC 8, FAILED:CKSM ERR MSG3 ASC 11,/PROGL:FMP OPEN ERROR- FILER BSS 3 MSG3L ABS *-MSG3 LUPRN NOP AM ASC 1,AM PM ASC 1,PM BFADR NOP FLNUM NOP RQLEN NOP IERR NOP ICLAS NOP CLAS2 NOP EQT# NOP ERCNT NOP TPNT NOP CNTR NOP LENX NOP CONWD NOP POOLS NOP CURAD NOP SEQAD NOP * 3 WORD REQUEST AREA RQBUF EQU * ISTAT NOP LU NOP SEQ# NOP * D1 DEC 1 D2 DEC 2 D18N OCT 100022 NO-ABORT CLASS-I/O 'WRITE' REQUEST CODE D3 DEC 3 D4 DEC 4 D7 DEC 7 D8 DEC 8 D9 DEC 9 D11 DEC 11 D12 DEC 12 D15 DEC 15 D21 DEC 21 D144 DEC 144 M1 DEC -1 M2 DEC -2 M3 DEC -3 M5 DEC -5 M12 DEC -12 M20 DEC -20 B77 OCT 77 B170 OCT 170 ZB300 OCT 10300 'Z' BIT + 'PROGL' FLAG FOR "WRITE" OPERATION B377 OCT 377 D12N OCT 100014 D20N OCT 100024 RTBIT OCT 1000 INCREMENT FOR RETRY FIELD MSKLU OCT 777 MASK FOR LU WORD MSK14 OCT 137777 ICNWD OCT 150301 * TLENT DEC 147 SIZE OF DOWNLOAD TABLE ENTRY NACTV ABS -#ACTV NQUE ABS #ACTV-#TERM MAXL DEC 255 ASC00 ASC 1,00 ASCP0 ASC 1,P0 * DBFAD DEF DBUF+1 TABAD DEF DT ADDR OF DOWNLOAD TABLE NWAITA DEF WAITQ ADDR OF WAITING QUEUE * BUFR BSS 3 DBUF BSS 255 FILE INPUT BUFFER * * THE FOLLOWING RESERVES SPACE FOR THE ACTIVE DOWNLOAD TABLE. * * FORMAT: WORD 1 RETRY COUNT (BITS 15-8), LU (BITS 7-0) * 2 SEQUENCE NUMBER (NOT SAME AS SEQUENCE NUMBERS IN * TCBS) * 3-146 DATA CONTROL BLOCK * 147 FILE NUMBER DT REP #ACTV BSS 147 * * THE FOLLOWING RESERVES SPACE FOR THE WAIT QUEUE WAITQ REP #TERM-#ACTV WAITING QUEUE: LU & FILE # BSS 2 * EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B END PROGL yu  91740-18013 2026 S C0122 &QUEUE +              H0101 ASMB,R,L,C HED QUEUE 91740-16013 REV 2026 * (C) HEWLETT-PACKARD CO. 1980 NAM QUEUE,17,2 91740-16013 REV.2026 800421 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT QUEUE EXT EXEC,RNRQ,#QRN,#BUSY EXT #GRPM,#QCLM,#ST09 * * * QUEUE * SOURCE: 91740-18013 * BINARY: 91740-16013 * PRGMR: CHUCK WHELAN * DATE: DEC 1976 * * * * QUEUE IS THE DS/1000 PROGRAM SCHEDULED BY COMMUNICATIONS * DRIVER DVA65 WHEN A NEW REQUEST IS TO BE READ FROM A COMMUNICATIONS * LINE. THE REQUEST AND DATA BUFFER LENGTHS ARE PASSED TO QUEUE * IN THE EQT EXTENSION FOR THE CORRESPONDING LINE. QUEUE FIRST * CHECKS THE VALIDITY OF THE INTERRUPT. IF IT IS NOT FROM AN INITIALIZED * DVA65 CHANNEL OR IF IT IS A SPURIOUS INTERRUPT FROM ANOTHER * I/O SLOT, THE INTERRUPT WILL BE IGNORED. IF THE PASSED LENGTHS * ARE NOT WITHIN THE ALLOWABLE RANGE (6 63? JMP SSTOP YES, CAN'T ACCEPT IT INB EXT(3) HAS DATA LENGTH LDA 1,I GET IT SSA JMP SSTOP LENGTH ERROR STA DLEN SAVE IT ADA N4097 SSA,RSS DATA LENGTH > 4096? JMP SSTOP YES, CAN'T ACCEPT IT * LDA DLEN LDB RLEN CPA K2 IF DATA LENGTH=2, AND SZB REQUEST LENGTH=0, JMP GRPCL THIS IS A NON-CBL RQST, ELSE JSB RNRQ CHECK FOR QUIESCENT SYSTEM DEF *+4 DEF NWGLC LOCK WORD:NO-WAIT,NO-ABORT,GLOBAL LOCK & CLEAR DEF #QRN QUIESCENT SYSTEM RN DEF EQT4 RETURN STATUS HERE JSB ERR ERROR RETURN LDA EQT4 IS THIS SYSTEM CPA K7 QUIESCED? JMP SSTOP YES, SEND STOP LDA #ST09+1 THIS IS AN CBL DOWNLOAD REQUEST, JMP READ USE PROGL'S CLASS * * NON-CBL REQUEST. * CHECK REQUEST LENGTH >= 7 * GRPCL EQU * ADB N7 SSB JMP SSTOP ILLEGAL LENGTH: SEND 'STOP' * LDA #GRPM LENGTH OK: LOAD GRPM'S CLASS # READ EQU * CCE,SZA,RSS JMP SSTOP SEND STOP IF NO CLASS ALLOCATED RAL,ERA SET NO-WAIT BIT IN CLASS WORD. STA CLASS SAVE LOCALLY * JSB EXEC READ THE REQUEST TO GRPM'S CLASS DEF *+8 DEF K17N NO ABORT DEF CONWD DEF ZERO DEF DLEN RECEIVED DATA LENGTH DEF ZERO DEF RLEN RECEIVED REQUEST LENGTH DEF CLASS JSB ERR HERE IF CLASS READ FAILS * SZA SUCCESS? JMP SSTOP NO, PROBABLY NO SAM, SEND STOP VIA DRIVER CPA #BUSY ANY ACTIVE TCB'S? JMP HANG NO * EXIT JSB EXEC TERMINATE QUEUE DEF *+2 DEF K6 * HANG JSB RNRQ IF NONE, HANG ON #QRN - THIS IS DEF *+4 A QUIESCENT CONDITION DEF GLCW DEF #QRN DEF EQT4 JSB ERR ERROR RETURN JMP EXIT SKP * * ERROR PROCESSING SECTION * ERR NOP PASS ERROR INFO TO QCLM & GIVE UP DST AREG PASS REGS TO QCLM LDA ERR PICK UP ORIGINATION ADDRESS STA PREG PASS TO QCLM LDA #QCLM QCLM CLASS SZA,RSS IS CLASS NUMBER DEFINED? JMP ERR1 NO--SEND A 'STOP' STA CLASS SAVE LOCALLY * JSB EXEC MAILBOX CLASS WRITE/READ TO QCLM DEF *+8 DEF K20N DEF ZERO DEF QBUF DEF K9 DEF XEQT PASS ID SEG ADDR DEF ZERO DEF CLASS ZERO NOP ERROR RETURN ERR1 EQU * LDA LU SZA,RSS WAS LU DETERMINED? JMP EXIT NO, CAN'T SEND STOP * * CALL DRIVER TO SEND A STOP * SSTOP JSB EXEC DEF *+3 DEF K3 DEF LU JMP EXIT * SKP * * CONSTANTS AND STORAGE * * * FORMAT OF BUFFER PASSED TO QCLM: * -------------------------------- * * **************************************** * 1 * STREAM WORD * NOTE: ON 'READ' ERRORS, WORD * *--------------------------------------* 1 IS LINE EQT ADDRESS, WORD * 2 * SEQUENCE NUMBER * 2 CONTAINS I O STATUS. * *--------------------------------------* * 3 * SOURCE (ORIGINATING) NODE NUMBER * * *--------------------------------------* * 4 * DESTINATION NODE NUMBER * * *--------------------------------------* * 5 * P-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* NOTE: CERTAIN COMBINATIONS * 6 * A-REGISTER WHEN ERROR DETECTED * OF A- AND B-REGISTER VALUES * *--------------------------------------* ARE USED TO FLAG SUCH CONDI- * 7 * B-REGISTER WHEN ERROR DETECTED * TIONS AS "COMMUNICATIO?uNS * *--------------------------------------* READ ERROR", "TCB NOT FOUND, * 8 * TIME OF DAY WHEN ERROR DETECTED * ETC. * 9 * (2 WORDS) * * **************************************** * * FIRST OPTIONAL PARAMETER = ID SEGMENT ADDRESS OF SENDER * * **************************************** QBUF DEC 0,0,0,0,0,0,0,0,0 ERROR BUFFER TO QCLM * STREM EQU QBUF SEQ# EQU QBUF+1 SRC# EQU QBUF+2 DESTN EQU QBUF+3 PREG EQU QBUF+4 AREG EQU QBUF+5 BREG EQU QBUF+6 TOD EQU QBUF+7 * LUMAX EQU 1653B DRT EQU 1652B EQTA EQU 1650B XEQT EQU 1717B * EQT4 NOP RLEN NOP DLEN NOP CLASS NOP EQT# NOP CONWD NOP B77 OCT 77 B65 OCT 65 GLCW OCT 040006 NWGLC OCT 140006 GLOBAL LOCK & CLEAR, WITHOUT WAITING, NO ABORT K2 DEC 2 K3 DEC 3 K6 DEC 6 K7 DEC 7 K9 DEC 9 K15 DEC 15 N1 DEC -1 N7 DEC -7 N64 DEC -64 N4097 DEC -4097 K17N OCT 100021 K20N OCT 100024 LU NOP SCODE NOP ZBIT OCT 10000 * * SIZE BSS 0 * END QUEUE    91740-18014 2001 S C0122 &GRPM              H0101 UASMB,R,L,C HED GRPM 91740-16014 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 NAM GRPM,17,4 91740-16014 REV 2001 791024 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT GRPM EXT EXEC,#RSAX,#NCNT,#REQU,#RTRY,$OPSY EXT #NODE,#GRPM,$TIME,#PLOG EXT #NULL,#LDEF,#QCLM,#BREJ EXT #TBRN,#QRN,$RNTB EXT $LIBR,$LIBX,RNRQ,DRTEQ * SUP * * NAME: GRPM * SOURCE: 91740-18014 * RELOC: 91740-16014 * PGMR: CHUCK WHELAN * DATE: 17 DEC 76 * MODIFIED BY: LYLE WEIMAN, AUG. '78 * * * * GRPM IS THE GENERAL REQUEST PRE-PROCESS MODULE FOR DS/1000. * IT PROCESSES INCOMING REQUESTS AND OUTGOING COMPLETIONS. * * I INCOMING REQUESTS * * 1. HANGS ON A GET ON ITS CLASS NUMBER, AND WHEN * SATISFIED, MOVES THE REQUEST INTO ITS LOCAL BUFFER. * 2. IF THE REQUEST IS NOT DESTINED FOR THE LOCAL NODE, * THE REQ/DATA IS RETHREADED FOR OUTPUT TO THE * APPROPRIATE LU ON "GRPM"S CLASS NUMBER. * 3. IF LOCAL AND A NEW REQUEST, DOES THE FOLLOWING: * A) IF NO TCBS ARE AVAILABLE, SETS THE REPLY FLAG * AND REMOTE BUSY FLAG AND RETURNS THE REQUEST TO * THE ORIGINATOR BY RETHREADING THE REPLY FOR OUTPUT ON * "GRPM"S CLASS. * B) IF SYSTEM IS GOING QUIESCENT, OR THE MONITOR IS * IN AVAILABLE MEMORY SUSPEND (STATE 4), THE "BUSY" * FLAG IS SET IN THE REQUEST AND THE ENTIRE TRANSACTION * IS RETURNED TO THE ORIGINATOR. * C) OTHERWISE, CALLS "#RSAX" TO CREATE THE SLAVE TCB. * D) DETERMINES THE MONITORS CLASS NUMBhER FROM "RES" * TABLE AND RETHREADS THE REQ/DATA TO THAT CLASS. * IF THE MAXIMUM QUEUE DEPTH LIMIT FOR THAT MONITOR IS * EXCEEDED BY THIS RE-THREAD, THE ENTIRE REQUEST IS RETURNED * TO THE ORIGINATOR (AS DESCRIBED ABOVE), WITH A "DS08" * ERROR. * 4. IF LOCAL AND A REPLY, DOES THE FOLLOWING: * A) IF "BUSY" FLAG IS SET, CLEARS IT AND RETHREADS * THE REQUEST TO RTRY SO AFTER A DELAY IT CAN * BE REATTEMPTED. HOWEVER, IF IT IS A LOCAL * REQUEST, DS08 IS RETURNED IMMEDIATELY. * B) CALLS #RSAX TO SEARCH FOR THE MASTER TCB. * C) IF FOUND, RETHREADS THE REQ/DATA ON THE MASTER'S * CLASS #. * 5. IF #PLOG IS NON-ZERO, COMPLETED WRITE CLASS BUFFERS * ARE RETHREADED TO PLOG, OTHERWISE THEY ARE DEALLOCATED. * 6. WHEN DONE, "GRPM" RETURNS TO ITS GET. * * II OUTGOING LINE COMPLETIONS * * GRPM PROCESSES COMPLETION STATUS OF ALL COMMUNICATION REQUEST/DATA * WRITE OPERATIONS (EXCEPT PROGL). IF AN OPERATION IS SUCCESSFUL * AND PLOG IS ENABLED, THE REQUEST IS RETHREADED TO PLOG'S CLASS, * IF NOT, THE CLASS BUFFER IS DEALLOCATED. * ON REMOTE OR LOCAL BUSY ERRORS, GRPM CHECKS THE RETRY COUNT IN * THE STREAM WORD OF THE REQUEST. IF ALL RETRIES HAVE BEEN * EXHAUSTED, IT IS TREATED AS A LINE ERROR AND A DS08 IS RETURNED. * IF ANOTHER RETRY IS POSSIBLE, THE ABSOLUTE SYSTEM TIME AT WHICH * THE RETRY SHOULD BE ATTEMPTED IS COMPUTED AND STORED IN THE * EQT5 STATUS SAVE AREA IN THE CLASS HEADER. THE CLASS BUFFER IS * THEN RETHREADED ON "RTRY"S CLASS. * PARITY OR LINE TIMEOUT ERRORS ARE RETRIED 3 TIMES BY RETHREADING * TO "RTRY". IF ALL 4 TRIES FAIL, A DS02 ERROR IS RETURNED. IF * A "STOP RECEIVED" CONDITION IS DETECTED, A DS01 ERROR IS RETURNED. * ALL LINE ERRORS HAVE THE ERROR CODE AND THE LOCAL NODE NUMBER * STORED IN THE ERROR FIELD IN THDE REQUEST. * IF THE REQUEST WAS A REPLY, THE CLASS BUFFER IS SIMPLY * CLEARED OR THE REQUEST IS RETHREADED TO PLOG (IF ENABLED). * IF A NON-REPLY, AND THE ORIGINATOR IS NOT THE LOCAL NODE, THE * REPLY FLAG IS SET, AND THE REQUEST IS SENT BACK TO THE ORIGINATOR. * IF THE ORIGINATOR IS LOCAL, THE REPLY IS RETHREADED ON THE * MASTER REQUESTORS CLASS. SKP GRPM EQU * LDB $OPSY RBR,SLB SKIP IF NON-DMS CLA,RSS JMP GRGET STA MOD1 MODIFY FOR DMS STA LOOP STA LUFND STA MOD4 STA MOD5 * GRGET JSB EXEC HANG ON CLASS DEF *+6 DEF K21 DEF #GRPM RQADR DEF RQBUF REQUEST BUFFER DEF K0 ZERO LENGTH GET DEF BFADR ADDR OF SAM REQST BUFFER * STA TEMP SAVE ERROR STATUS ADB K8 CMB,INB ADB BFADR COMPUTE CLASS HEADER ADDRESS STB HEADR * LDA BFADR LDB RQADR SET TO MOVE 4 WORDS OF REQUEST MOD1 JMP RQLOC NOP HERE IF DMS LDX K4 MWF MOVE 4 WORDS FROM SYSTEM MAP JMP *+4 RQLOC MVW K4 MOVE 4 WORDS LDA TEMP SLA,RSS ANY DRIVER ERRORS JMP ERCHK YES ALF,ALF SSA WAS THIS A WRITE COMPLETION? JMP WASOK YES, PROCESS IT SPC 3 * * SUCCESSFUL READ COMPLETION LOGIC FOLLOWS * LDA RQBUF GET STREAM WORD CKNOD LDB RQBF3 ADDR OF SOURCE NODE RAL SSA,RSS REPLY? INB NO, POINT TO DESTINATION NODE LDB 1,I GET NODE # STB TEMP2 SAVE NODAL ADDRESS SSB,RSS SKIP IF ALWAYS LOCAL CPB #NODE IS IT US? JMP LOCAL YES SKP * * STORE & FORWARD OR BUSY/ERROR REPLY TO ANOTHER NODE * * INITIALIZE THE WRITE RETRY COUNTS * LDA RQBUF AND LEMSK CLEAR COMM LINE RETRY COUNT LDB BFADR JSB STUFF STORE MODIFIED STREAM WORD * `;* CONVERT DESTINATION NODE TO LU * DLD #NCNT GET ADDR & COUNT OF NRV TABLE STA TEMP SAVE COUNTER * LOOP JMP LOOP0 NOP'D IF DMS SYSTEM XLA 1,I CROSS-LOAD CPU # IF DMS SYSTEM RSS LOOP0 LDA 1,I LOAD CPU # IF NON-DMS INB POINT TO CORRESPONDING LU CPA TEMP2 IS IT THE GOOD ONE ? JMP LUFND YES INB BUMP ADDR TO NEXT NODE # ISZ TEMP END OF TABLE ? JMP LOOP NO, CONTINUE * * NODAL ADDRESS CAN'T BE CONVERTED TO OUTPUT LU LDA ASC04 GIVE A "DS04" JMP ERETN ERROR, NODE IS NON-ADDRESSABLE * LUFND JMP LUFN0 NOP'D IF DMS SYSTEM XLA 1,I CROSS-LOAD LU IF DMS SYSTEM RSS LUFN0 LDA 1,I LOAD LU IF NON-DMS AND B77 ISOLATE IT * * RETHREAD CLASS BUFFER FOR OUTPUT TO NODE * STA TEMP SAVE OUTPUT LU JSB DRTEQ GET THE LOGICAL UNIT DEF *+2 SUBCHANNEL BITS DEF TEMP FROM THE DRT ENTRY ALF,CLE,ELA POSITION SUBCHANNEL LSB TO LDA ICNWD REMOVE THE PREVIOUS SUBCHANNEL LSB AND N5 FROM THE CONTROL WORD SEZ IF THE OUTPUT LU SPECIFIES AN ODD SUBCHANNEL, IOR K4 THEN SET BIT # 2 STA ICNWD IN THE CONFIGURED CONTROL WORD JSB #REQU OUTPUT BUFFER DEF *+5 DEF #GRPM DEF #GRPM DEF TEMP OUTPUT LU DEF ICNWD NEW CONTROL WORD SZA JSB ERR1 CATASTROPHIC ERROR IF IT FAILED JMP GRGET BACK TO GET SKP * * WRITE WAS SUCCESSFUL * WASOK LDA #PLOG PLOG CLASS NUMBER SZA LOGGING? JMP THRED+1 YES, RETHREAD TO PLOG * JUST DEALLOCATE THIS CLASS BUFFER CLSAM LDA #GRPM ALR,RAR CLEAR "SAVE BUFFER" FLAG STA CLASS * JSB EXEC DO DUMMY GET TO CLEAR CLASS BUFFER DEF *+5 DEF K21 DEF CLASS DEF RQBUF DEF K0 *  JMP GRGET BACK TO GET SKP * * THIS REQ/DATA IS DESTINED LOCALLY LOCAL EQU * LDA RQBUF GET STREAM WORD AND B10K ISOLATE LEVEL FIELD SZA LEVEL PRESENT? JMP ERLVL .YES, ERROR LDA RQBUF RAL,RAL SLA TEST REPLY FLAG JMP REPLY IT'S A REPLY * LDB #NULL SZB,RSS ANY TCBS AVAILABLE? JMP QRJCT NO, SEND IT BACK FOR AWHILE * LDA RQBUF AND B77 ISOLATE STREAM ADA #LDEF ADA K2 POINT TO LIST HEADER PNTR LDB 0,I POINT TO LIST HEADER INB STB TEMP SAVE ADDRESS OF CLASS # INB LDB 1,I GET ID SEGMENT ADDR OF MONITOR RBL,CLE,ERB CLEAR "NO ABORT" FLAG SZB,RSS IS THIS MONITOR ENABLED? JMP ILLRQ NO, RETURN A "DS06" ADB K15 POINT TO STATUS LDA 1,I GET MONITOR'S STATUS AND K15 CPA K4 AVAILABLE MEMORY SUSPEND? JMP QRJCT YES, REJECT REQUEST * LDB $RNTA RSS LDB 1,I RBL,CLE,SLB,ERB RESOLVE INDIRECT JMP *-2 LDA #QRN GET QUIESCENT RN AND B377 ISOLATE TABLE INDEX ADB 0 COMPUTE POSITION IN RN TABLE LDA 1,I GET IT AND B377 SZA QUIESCING? JMP QRJCT YES, SEND IT BACK SKP * * THIS REQUEST CAN NOW BE PASSED TO THE REQUIRED MONITOR * JSB #RSAX BUILD TCB FOR THIS STREAM DEF *+5 DEF K3 DEF RQBUF+1 PASS ORIGINATORS SEQ # DEF RQBUF & STREAM DEF RQBUF+2 & ORIGIN NODE NO. * SSB OK? JMP ILLRQ NO, GIVE DS06 ERROR * LDB BFADR INB POINT TO SECOND REQUEST WORD JSB STUFF STORE LOCAL SEQUENCE # * LDB #NULL NUMBER OF TCB'S LEFT SZB DID WE USE THE LAST ONE? JMP MONIT NO * JSB RNRQ YES!K LOCK THE TABLE ACCESS RN DEF *+4 DEF LGNW GLOBAL LOCK, NO WAIT, NO ABORT DEF #TBRN DEF TEMP2 NOP MONIT LDA TEMP,I GET MONITOR'S CLASS SPC 2 SKP * * ENTER HERE TO RETHREAD THE CLASS BUFFER FROM #GRPM TO THE CLASS * NUMBER PASSED IN THE A REGISTER. * THRED RAL,CLE,ERA CLEAR SIGN STA CLASS * JSB #REQU RETHREAD TO DEF *+3 MONITOR/MASTER/RTRY/PLOG DEF #GRPM DEF CLASS * SZA,RSS OK? JMP GRGET YES,BACK TO GET CPA N10 MAXIMUM QUEUE DEPTH EXCEEDED? JMP BZYER YES, RETURN "DS08" ERROR. JMP ERR1 OTHER CATASTROPHIC ERROR. SPC 4 * * HERE WHEN LOCAL REPLY RECEIVED * REPLY SSA,RSS IS THIS A QUIESCENT/BUSY REJECT JMP REPOK NO LDA RQBUF YES AND B1174 CLEAR REPLY & BUSY FLAGS & LINE ERR CNTR STA RQBUF WORD GETS STORED IN SAM LATER LDB RQBUF+3 GET DESTINATION NODE CPB #NODE WAS THIS A LOCAL REQUEST? JMP BZYER YES! GIVE A DS08 NOW JMP RTRY2+1 RETHREAD TO RTRY * REPOK JSB #RSAX SEARCH FOR MASTER TCB DEF *+3 DEF K4 DEF RQBUF+1 SSB FOUND? JSB ERR1 NO, PURGE THE REQUEST JMP THRED RETHREAD IT (A REG = MASTER CLASS #) * QRJCT LDA RQBUF AND LEMSK CLEAR LINE ERROR COUNT IOR RPBZY SET "BUSY" & "REPLY" FLAGS JMP RPLYR SEND REPLY SKP * * ERROR OCCURRED * ERCHK LDB 0 GET EQT STATUS BLF,BLF SSB,RSS IS THIS AN OUTPUT COMPLETION? JMP EREAD NO, NOTE BUT IGNORE THE ERROR * LDB LBZY# DELAY FACTOR FOR LOCAL BUSY REJECTS RAR,SLA,RAR LOCAL BUSY REJECT? JMP DELAY YES, RETRY WITH DELAY SLA,RAR SIMULTANEOUS REQUEST? JMP SIMRQ LDB 0 RAR,SLA,RAR STOP RECEIVED? JMP LFAIL YES SLA REMOTE BUSY? JMP RTRY2 YES * * PARITY ERROR OR LINE TIMEOUT, CHECK RETRY COUNT LDA RQBUF STREAM WORD AND B300 ISOLATE RETRY COUNT CPA B300 ALL RETRIES EXHAUSTED? JMP LFAIL YES, GIVE LINE ERROR * LDB LERR# LINE ERROR DELAY FACTOR JSB SETDL SET DELAY LDA B100 BUMP BITS 7-6 JMP RBUMP * * REMOTE BUSY REJECT RTRY2 LDA RQBUF STREAM WORD AND .074 BITS 11-8 HAVE RETRY COUNT CPA .074 ALL RETRIES EXHAUSTED? JMP BZYER YES, GIVE ERROR LDA B400 BUMP BITS 11-8 LDB RBZY# DELAY FOR REMOTE BUSY (1 SEC) STB TEMP2 SAVE OFFSET (10'S OF MSECS) * RBUMP ADA RQBUF BUMP RETRY COUNT LDB BFADR ADDRESS OF REQUEST IN SAM JSB STUFF STORE MODIFIED STREAM WORD JMP DELA2 SKP * * SIMULTANEOUS REQUEST, DELAY REQUIRED SIMRQ LDB SIRQ# DELAY FACTOR FOR SIMULTANEOUS REQUEST * DELAY JSB SETDL COMPUTE REQUIRED DELAY * DELA2 CLE DLD $TIME CURRENT SYSTEM TIME ADA TEMP2 ADD DELAY TIME SEZ,RSS CARRY? JMP *+3 NO INB,SZB,RSS WILL DAY ROLL OVER? ADA B2500 YES, COMPENSATE FOR IT LDB HEADR POINT TO CLASS BUFFER HEADER ADB K2 BUMP TO 3RD WORD OF HEADER JSB STUFF PUT OFFSET THERE (A REG TO RTRY) * LDA #RTRY RTRY'S CLASS JMP THRED+1 NOW RETHREAD THIS CLASS BUFFER SKP * * IRRECOVERABLE LINE ERRORS * LFAIL LDA ASC01 GET A DS01 SLB WAS IT DRIVER TIMEOUT? INA YES, MAKE IT A DS02 RSS * * BUSY RETRY COUNT EXHAUSTED, GIVE A DS08 ERROR * BZYER LDA ASC08 RSS * * NO MONITOR FOR REQUESTED STREAM IS PRESENT, ILLEGAL REQUEST * ILLRQ LDA ASC06 * ERETN LDB RQBUF GET STREAM WORD RBL CCE,SSB REPLY? JMP ERRFL YES, NO RECOVERY POSSIBLE * LDB BFADR ADB K5  POINT TO REQUEST+5 JSB STUFF STORE ASCII CODE INB POINT TO REQUEST+6 LDA #NODE GET LOCAL NODAL ADDRESS RAL,ERA INDICATE THERE'S AN ASCII ERROR JSB STUFF STORE ERROR LOCATION WORD ADB N2 POINT TO REQUEST+4 LDA ASCDS GET "DS" JSB STUFF STORE IT LDB HEADR ADDRESS OF CLASS HEADER ADB K5 POINT TO XMISSION LOG (DATA LENGTH) CLA SET IT TO ZERO JSB STUFF SO NO DATA GETS SENT LDA RQBUF AND RTYCT IOR BIT14 SET REPLY FLAG IOR #BREJ INITIALIZE RETRY COUNTERS * RPLYR STA RQBUF LDB BFADR POINT TO 1ST REQUEST WORD IN SAM JSB STUFF STORE NEW VALUE JMP CKNOD NOW GO BACK TO SEND REPLY SKP * FORMAT OF BUFFER PASSED TO QCLM: * -------------------------------- * * **************************************** * 1 * STREAM WORD * NOTE: ON 'READ' ERRORS, WORD 1 * *--------------------------------------* IS LINE EQT ADDRESS. * 2 * SEQUENCE NUMBER * * *--------------------------------------* * 3 * SOURCE (ORIGINATING) NODE NUMBER * * *--------------------------------------* * 4 * DESTINATION NODE NUMBER * * *--------------------------------------* * 5 * P-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* NOTE: CERTAIN COMBINATIONS * 6 * A-REGISTER WHEN ERROR DETECTED * OF A- AND B-REGISTER VALUES * *--------------------------------------* ARE USED TO FLAG SUCH CONDI- * 7 * B-REGISTER WHEN ERROR DETECTED * TIONS AS "COMMUNICATIONS * *--------------------------------------* READ ERROR", "TCB NOT FOUND, * 8 * TIME OF DAY WHEN ERROR DETECTED * ETC. * 9 * (2 WORDS) * * **************************************** * * FIRST OPTIONAL PARAMETER = ID SEGMENT ADDRESS OF SENDER * (USUALLY 'GRPM'). * * **************************************** * ERRFL CLB ERROR SENDING REPLY, ENCODE STB ERR1 SO QCLM PRINTS "REPLY FLUSHED..." LDB ASCDS JMP ERR1+1 * EREAD EQU * LDA TEMP MOVE I/O COMPLETION STATUS TO STA RQBUF+1 REQUEST BUFFER LDA N5 ENCODE SO 'QCLM' PRINTS LDB 0 "COMMUNICATIONS READ ERROR" JMP ERR1+1 * ERLVL EQU * LDA N6 ENCODE FOR LEVEL ERROR LDB 0 RSS * * THIS REQUEST IS NON-RECOVERABLE, CLEAR, LOG, THEN IGNORE IT ERR1 NOP HERE TO REPORT IRRECOVERABLE ERROR DST AREG SAVE REGS FOR QCLM LDA ERR1 STA PREG PASS ERROR ADDR TO QCLM DLD $TIME RECORD TIME OF ERROR DST TOD LDA #QCLM STA CLASS SAVE QCLM CLASS LOCALLY * JSB EXEC MAILBOX WRITE/READ TO QCLM DEF *+8 DEF K20N DEF K0 DEF RQBUF DEF K9 DEF XEQT DEF K0 DEF CLASS NOP * JMP CLSAM GO DEALLOCATE CLASS BUFFER SKP * * MULTIPLY PASSED TIMING FACTOR BY THE LINE TIMEOUT VALUE SETDL NOP STB TEMP2 LDB HEADR INB POINT TO 2ND WORD OF CLASS HEADER MOD4 JMP SETD0 NOP'D IF DMS SYSTEM XLA 1,I X-LOAD LINE'S TIMEOUT VALUE (DMS) RSS SETD0 LDA 1,I LOAD LINE'S TIMEOUT VALUE (NON-DMS) RAR FORM EQT14'S VALUE MPY TEMP2 TIMING FACTOR * LINE TIMEOUT STA TEMP2 SAVE ABSOLUTE DELAY (10'S OF MSECS) JMP SETDL,I * * STORE A WORD IN SAM * STUFF NOP JSB $LIBR GO PRIVILEGED K0 NOP MOD5 JMP STUF2 NOP HERE IF DMS XSA 1,I STORE IN ALTERNATE MAP RSS STUF2 STA 1,I JSB $LIBX DEF STUFF SKP * * CONSTANTS AND STORAGE * B77 OCT 77 BFADR NOP HEADR NOP TEMP NOP CLASS NOP TEMP2 NOP RPBZY OCT 60000 BIT14 OCT 40000 RTYCl><:6T OCT 170077 STREAM WORD RETRY COUNT MASK LEMSK OCT 177477 MASK TO CLEAR LINE ERROR COUNT ICNWD OCT 150101 LGNW OCT 140002 K2 DEC 2 K3 DEC 3 K4 DEC 4 K5 DEC 5 K8 DEC 8 K9 DEC 9 K15 DEC 15 K21 DEC 21 N2 DEC -2 N5 DEC -5 N6 DEC -6 N10 DEC -10 K20N OCT 100024 B100 OCT 100 B300 OCT 300 B377 OCT 377 B400 OCT 400 B2500 OCT 25000 B1174 OCT 117477 B10K OCT 010000 .074 OCT 007400 $RNTA DEF $RNTB * * TIME DELAY CONSTANTS LBZY# DEC -5 LOCAL BUSY DELAY = 5 * LINE TIMEOUT RBZY# DEC 100 REMOTE BUSY DELAY = 1 SECOND LERR# DEC -10 LINE ERROR RETRY DELAY = 10 * LINE TO SIRQ# DEC -4 SIMULTANEOUS REQ DELAY = 4 * LINE TO * ASC01 ASC 1,01 ASC04 ASC 1,04 ASC06 ASC 1,06 ASC08 ASC 1,08 ASCDS ASC 1,DS * RQBF3 DEF RQBUF+2 RQBUF BSS 9 IBUF EQU RQBUF * STREM EQU IBUF SEQ# EQU IBUF+1 SRC# EQU IBUF+2 DESTN EQU IBUF+3 PREG EQU IBUF+4 AREG EQU IBUF+5 BREG EQU IBUF+6 TOD EQU IBUF+7 * XEQT EQU 1717B * SIZE BSS 0 * END GRPM ]<  91740-18015 2026 S C0122 &RTRY +              H0101 gASMB,R,Q,C HED RTRY 91740-16015 REV 2026 * (C) HEWLETT-PACKARD CO. 1980* NAM RTRY,17,20 91740-16015 REV 2026 800417 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * RTRY * * SOURCE PART # 91740-18015 * * REL PART # 91740-16015 * * WRITTEN BY: CHUCK WHELAN * * DATE WRITTEN DEC 1976 * * MODIFIED BY: LYLE WEIMAN, JAN. '78 * " " " " APR '80 *************************************************************** SPC 3 EXT EXEC,$TIME,$OPSY,DRTEQ EXT #RDLY EXT #REQU,#QCLM,#RTRY,#GRPM,#NCNT * * SPC 3 * RTRY PERFORMS WRITE RETRIES IN THE DS/1000 SYSTEM * * WHEN A WRITE OPERATION FAILS, "GRPM" RETHREADS THE CLASS BUFFER * ON "RTRY"S CLASS AND STORES THE ABSOLUTE TIME AT WHICH THE RETRY * IS TO OCCUR IN THE EQT5 STATUS SAVE WORD IN THE CLASS HEADER. * WHEN "RTRY"S GET IS SATISFIED, IF THE ABSOLUTE TIME HASN'T BEEN * REACHED, "RTRY" COMPUTES THE NECESSARY TIME OFFSET AND PUTS * ITSELF IN THE TIME-LIST. WHEN IT IS RESCHEDULED, IT OUTPUTS * THE CLASS BUFFER, RETHREADING IT ON "GRPM"S CLASS. IF AN * ERROR OCCURS, RTRY WRITES AN ERROR NOTIFICATION TO QCLM * AND DEALLOCATES THE CLASS BUFFER. * SKP * RTRY JSB EXEC DO GET, AWAITING WRITE RETRIES FROM GRPM DEF *+6 DEF K21 DEF #RTRY RTRY CLASS NUMBER DEF K0 DUMMY BUFFER DEF K0 ZERO LENGTH DEF RQADR REQ ADDRESS IN SAM * STA ABTIM SAVE ABSOLUTE RETRgY TIME * * A REG HAS ABSOLUTE START TIME CMA,INA ADA $TIME SUBTRACT START TIME FROM CURR. TIME SSA,RSS TIME REACHED? JMP THRED YES, RETHREAD NOW STA OFSET SET OFFSET UNTIL IT CAN GO DLD $TIME GET CURRENT SYSTEM TIME SSA INB,SZB DAY ABOUT TO ROLL OVER? JMP SUSPD NO LDA ABTIM YES SSA DID PASSED TIME ROLL OVER? JMP SUSPD NO LDA OFSET COMPENSATE FOR INITIAL TIME IN ADA B2500 $TIME FOR NEW DAY (25000B) STA OFSET * SUSPD EQU * LDA OFSET BE SURE OFFSET ISN'T TOO BIG CMA,INA MAKE IT POSITIVE ADA #RDLY SUBTRACT LARGEST OFFSET. SSA TOO BIG? JMP SUSP. NO, USE WHAT WE HAVE. LDA #RDLY YES, IT'S TOO BIG! STA OFSET USE SMALLER VALUE. SUSP. EQU * JSB EXEC PUT SELF IN TIME LIST DEF *+6 DEF D12N DEF K0 DEF K1 DEF K0 DEF OFSET JSB ERR1 ERROR * THRED LDB RQADR ADDR OF REQ BUFFER JSB LODWD GET STREAM WORD ADB K2 POINT TO ORIGIN NODE RAL SSA,RSS REPLY? INB NO, POINT TO DESTINATION NODE JSB LODWD GET NODAL ADDRESS STA VECTR SAVE NODE FOR LU CONVERSION * * CONVERT DESTINATION NODE TO LU * SSA ABSOLUTE DESTINATION CODE ? (NEIGHBOR) JMP ABS YES, GET LU AND RETURN DLD #NCNT NO, GET ADDR & SIZE OF TABLE CAX USE X AS COUNTER * LOOP JSB LODWD GET A CPU # INB POINT TO CORRESPONDING LU CPA VECTR IS IT THE GOOD ONE ? JMP LUFND YES INB POINT TO NEXT NODE # IN TABLE ISX END OF TABLE ? JMP LOOP NO, CONTINUE * JSB ERR1 NODAL ADDRESS NOT FOUND, ERROR * ABS CMA,INA MAKE IT >0 JMP LUOK * LUFND JSB LODWD FETCH LU  AND B77 ISOLATE IT * LUOK STA VECTR * JSB DRTEQ GET THE LOGICAL UNIT DEF *+2 SUBCHANNEL BITS DEF VECTR FROM THE DRT ALF,CLE,ELA POSITION SUBCHANNEL LSB TO LDA ICNWD REMOVE THE PREVIOUS SUBCHANNEL LSB AND N5 FROM THE CONTROL WORD SEZ IF THE OUTPUT LU SPECIFIES AN ODD SUBCHANNEL, IOR K4 THEN SET BIT # 2 STA ICNWD IN THE CONFIGURED CONTROL WORD JSB #REQU RETHREAD TO EQT ON GRPM CLASS DEF *+5 DEF #RTRY DEF #GRPM DEF VECTR DEF ICNWD NEW CONTROL WORD * SZA OK? JSB ERR1 NO JMP RTRY GO WAIT FOR MORE * * IRRECOVERABLE REQUEST ERROR OCCURRED, CLEAR CLASS BUFFER & LEAVE ERR1 NOP DST AREG SAVE REGS FOR QCLM LDA ERR1 STA PREG SAVE ERROR ADDR LDB RQADR INB B= ADDR OF SEQ # IN REQUEST JSB LODWD GET SEQ # STA SEQ# SAVE IT * LDA #RTRY CLEAR BUFFER-SAVE ALR,RAR FLAG STA VECTR * JSB EXEC DO DUMMY GET TO RETURN CLASS BUFFER DEF *+5 DEF K21 DEF VECTR DEF K0 DUMMY BUFFER DEF K0 ZERO LENGTH * JSB EXEC WRITE ERROR NOTICE TO QCLM DEF *+8 DEF K20N DEF K0 DEF QBUF DEF K9 DEF XEQT DEF K0 DEF #QCLM K0 NOP * JMP RTRY BACK TO GET SPC 3 * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE RAR,SLA,ERA SKIP IF NON-DMS JMP *+3 DMS. GO EXECUTE XLA LDA 1,I NON-DMS. PICK UP SAM WORD JMP LODWD,I RETURN XLA 1,I CROSS-LOAD SAM WORD JMP LODWD,I RETURN * * DATA AREA * RQADR NOP VECTR NOP OFSET NOP ABTIM NOP * * B77 OCT 77 K1 DEC 1 K2 DEC 2 K4 DEC 4 K9 DElxC 9 K21 DEC 21 K20N OCT 100024 B2500 OCT 2500 D12N OCT 100014 N5 DEC -5 ICNWD OCT 150101 * * * FORMAT OF BUFFER PASSED TO QCLM: * -------------------------------- * * **************************************** * 1 * STREAM WORD * NOTE: ON 'READ' ERRORS, WORD * *--------------------------------------* 1 IS LINE EQT ADDRESS, WORD * 2 * SEQUENCE NUMBER * 2 CONTAINS I O STATUS. * *--------------------------------------* * 3 * SOURCE (ORIGINATING) NODE NUMBER * * *--------------------------------------* * 4 * DESTINATION NODE NUMBER * * *--------------------------------------* * 5 * P-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* NOTE: CERTAIN COMBINATIONS * 6 * A-REGISTER WHEN ERROR DETECTED * OF A- AND B-REGISTER VALUES * *--------------------------------------* ARE USED TO FLAG SUCH CONDI- * 7 * B-REGISTER WHEN ERROR DETECTED * TIONS AS "COMMUNICATIONS * *--------------------------------------* READ ERROR", "TCB NOT FOUND, * 8 * TIME OF DAY WHEN ERROR DETECTED * ETC. * 9 * (2 WORDS) * * **************************************** * * FIRST OPTIONAL PARAMETER = ID SEGMENT ADDRESS OF SENDER * * **************************************** QBUF BSS 9 BUFFER TO SEND TO 'QCLM' * STREM EQU QBUF SEQ# EQU QBUF+1 SRC# EQU QBUF+2 DESTN EQU QBUF+3 PREG EQU QBUF+4 AREG EQU QBUF+5 BREG EQU QBUF+6 TOD EQU QBUF+7 * XEQT EQU 1717B * SIZE BSS 0 * END RTRY h  91740-18016 2001 S C0122 &QCLM              H0101 w[ASMB,R,L,C HED QCLM 91740-16016 REV 1913 * (C) HEWLETT-PACKARD CO. 1979 NAM QCLM,19,28 91740-16016 REV 2001 791024 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 **************************************************************** * * QCLM COMMUNICATION ERROR LOG * * NAME: QCLM * SOURCE: 91740-18016 * RELOC: 91740-16016 * PGMR: CHUCK WHELAN * * DATE WRITTEN DEC 1976 * * MODIFIED BY: LYLE WEIMAN, JAN. '78 *************************************************************** SPC 2 EXT EXEC,#QCLM EXT $TIME EXT CNUMO,CNUMD,KCVT,TMVAL SUP SPC 3 * QCLM EQU * LDA #QCLM GET QCLM CLASS NUMBER ALR,RAR AND REMOVE NO WAIT BIT STA QCLS QCLM2 JSB EXEC AWAIT WRITES TO QCLM CLASS DEF *+6 DEF K21 DEF QCLS CLASS WORD IN STORAGE DEF IBUF BUFFER ADDRESS DEF K9 DEF XEQT ADDRESS OF ID SEG OF CALLER * * * DETERMINE THE ERROR TYPE * LDA AREG CPA BREG A=B? RSS YES JMP REGLS NO, JUST GIVE REG CONTENTS CPA N4 A=B=-4? JMP MSGB YES, TCB NOT FOUND CPA N5 A=B=-5? JMP MSGC YES, COMM. READ ERROR CPA N6 JMP MSGD * REGLS LDB PREG P CONTENTS SZB,RSS ZERO? JMP MSGA YES, GIVE "REPLY FLUSHED" * * HERE FOR UNEXPECTED ERRORS (I.E., CATASTROPHIC) * LDA XEQT TRANSFER NAME OF PROGRAM WHICH ADA K12 SENT US THE MESSAGE RAL CONVERT TO BYTE ADDRESS LDB @ORGN MBT K5 * CONVERT REGISTER VALUES TO OCTAL JSB CNUMD DEF *+3 DEF SEQ# DEF .SEQ. JSB CNUMD DEF *+3 DEF STREM DEF .STR. LDA FLDAD GET THE ADDRESS OF THE 1ST WORD STA PNTR1 USE AS DESTINATION POINTER LDA @PREG GET ADDRESS WHERE P, A AND B REGISTER CONTENTS ARE STORED STA PNTR2 USE AS ORIGIN POINTER LDA N3 SET TO CONVERT 3 WORDS STA CNTR1 * OUTLP EQU * SET FOR OCTAL CONVERSION JSB CNUMO CONVERT TO OCTAL DEF *+3 PNTR2 NOP POINTER TO VALUE TO BE CONVERTED PNTR1 NOP STORE ASCII HERE. * LDA PNTR1 GET THE DESTINATION POINTER ADA K5 MOVE IT TO STA PNTR1 THE NEXT ENTRY. ISZ PNTR2 STEP TO NEXT QCB WORD ISZ CNTR1 ALL DONE ? JMP OUTLP NO, CONTINUE * JSB EXEC OUTPUT THE CATASTROPHIC ERROR MESSAGE DEF *+5 DEF K2 WRITE DEF K1 CRT DEF MSG MESSAGE ADDRESS DEF MSGL MESSAGE LENGTH * JMP QCLM2 GO, GET NEXT COMPLAINT SPC 3 * * HERE FOR "REPLY FLUSHED" ERROR. * * MSGA DLD AREG B&A HAVE ASCII ERROR CODE SWP REVERSE FOR PRINTING DST REGA JSB MSGX MOVE AND WRITE MESSAGE DEF MSA (RETURN MADE DIRECTLY TO 'QCLM2') * * HERE FOR "TCB NOT FOUND, POSSIBLE TIMEOUT" * MSGB JSB MSGX MOVE AND WRITE MESSAGE DEF MSB * * HERE FOR "COMMUNICATIONS READ ERROR" MSGC EQU * DLD $TIME GET CURRENT TIME-OF-DAY DST TOD SAVE FOR TIME CONVERSION JSB CVTIM CONVERT TIME-OF-DAY TO ASCII LDA EQTA CONVERT LINE EQT ADDRESS TO EQT # CMA,INA ADA STREM STA STREM CLB DIV K15 INA STA STREM JSB CNUMD CONVERT TO DECIMAL DE F *+3 DEF STREM DEF MSC. LDA SEQ# LOAD I/O STATUS AND =B377 MASK STATUS ALONE STA SEQ# JSB CNUMO CONVERT I/O STATUS TO OCTAL DEF *+3 DEF SEQ# DEF .STAT JSB EXEC DEF *+5 DEF K2 DEF K1 DEF MSC DEF MSCL JSB EXEC DEF *+5 DEF K2 DEF K1 DEF .TIME DEF TIMEL JMP QCLM2 BACK TO CLASS GET * * HERE FOR "MESSAGE LEVEL NOT CONVERTED" ERROR * MSGD EQU * JSB MSGX DEF MSD * MSGX NOP JSB CVTIM CONVERT TIME-OF-DAY TO ASCII JSB CNUMD CONVERT ORIGINATION NODE # DEF *+3 DEF SRC# DEF .ORGN JSB CNUMD CONVERT DESTINATION NODE # DEF *+3 DEF DESTN DEF .DEST LDA STREM GET STREAM TYPE RAL,ELA REPLY BIT TO (E) DLD REQST LOAD "RQST" SEZ,RSS REPLY? JMP ..1 NO, REQUEST DLD REPLY LOAD "RPLY" ..1 EQU * DST MSG4 STORE IN MESSAGE BUFFER LDA STREM GET STREAM WORD AGAIN LDB BLANK SSA 3000 MASTER? LDB "3K" YES. STB .3K LDA STREM CONVERT STREAM TYPE AND =B77 STA STREM JSB KCVT CONVERT TO ASCII DEF *+2 DEF STREM STA .STRM LDA MSGX,I FROM ADDR LDB MS2A TO ADDR MVW K16 MOVE MSG TO OUTPUT BUFFER * JSB EXEC OUTPUT ERROR MESSAGE DEF *+5 DEF K2 DEF K1 DEF MSG2 DEF M2LEN JSB EXEC PRINT MORE ABOUT IT DEF *+5 DEF K2 DEF K1 DEF MSG4 DEF MSG4L JMP QCLM2 GO BACK TO CLASS "GET" * SKP * * SUBROUTINE TO OBTAIN TIME-OF-DAY AND CONVERT IT TO * ASCII. RESULTS RETURNED IN BUFFER ".TIME" * CVTIM NOP JSB TMVAL CONVERT TIME-OF-DAY TO HOURS,MINUTES, SECONDS DEF *+3 DEF TO8D DEF TMAR JSB KCVT CONVERT HOUR NUMBER TO ASCII DEF *+2 DEF TMAR+3 STA .HR JSB KCVT CONVERT MINUTES TO ASCII DEF *+2 DEF TMAR+2 STA .MIN JSB KCVT CONVERT SECONDS DEF *+2 DEF TMAR+1 STA .SEC JSB EXEC GET ACTUAL DAY NUMBER DEF *+3 DEF K11 DEF TMAR JSB CNUMD CONVERT DAY NUMBER DEF *+3 DEF TMAR+4 DEF .DAY JMP CVTIM,I RETURN SKP * * DATA AREA * * FORMAT OF BUFFER PASSED TO QCLM: * -------------------------------- * * **************************************** * 1 * STREAM WORD * NOTE: ON 'READ' ERRORS, WORD * *--------------------------------------* 1 IS LINE EQT ADDRESS, WORD * 2 * SEQUENCE NUMBER * 2 CONTAINS I O STATUS. * *--------------------------------------* * 3 * SOURCE (ORIGINATING) NODE NUMBER * * *--------------------------------------* * 4 * DESTINATION NODE NUMBER * * *--------------------------------------* * 5 * P-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* NOTE: CERTAIN COMBINATIONS * 6 * A-REGISTER WHEN ERROR DETECTED * OF A- AND B-REGISTER VALUES * *--------------------------------------* ARE USED TO FLAG SUCH CONDI- * 7 * B-REGISTER WHEN ERROR DETECTED * TIONS AS "COMMUNICATIONS * *--------------------------------------* READ ERROR", "TCB NOT FOUND, * 8 * TIME OF DAY WHEN ERROR DETECTED * ETC. * 9 * (2 WORDS) * * **************************************** * * FIRST OPTIONAL PARAMETER = ID SEGMENT ADDRESS OF SENDER * (USUALLY 'GRPM'). * * **************************************** K1 DEC 1 K2 DEC 2 K5 DEC 5 K9 DEC 9 K11 DEC 11 K12 DEC 12 K14 DEC 14 K15 DEC 15 K16 DEC 16 K21 DEC 21 N3 DEC -3 N4 DEC -4 XN5 DEC -5 N6 DEC -6 @MSC DEF MSC @ORGN DBL ORIGN @PREG DEF PREG XEQT NOP FLDAD DEF CVFLD CNTR1 NOP QCLS NOP MS2A DEF MSFL2 * IBUF BSS 9 * STREM EQU IBUF SEQ# EQU IBUF+1 SRC# EQU IBUF+2 DESTN EQU IBUF+3 PREG EQU IBUF+4 AREG EQU IBUF+5 BREG EQU IBUF+6 TOD EQU IBUF+7 MSG OCT 6412 ASC 08, DS ERROR: PROG= ORIGN ASC 3, ASC 2,STRM .STR. ASC 3, ASC 3, SEQ#= .SEQ. ASC 3, OCT 6412 CARRIAGE-RETURN/LINE-FEED ASC 2, P= CVFLD ASC 3, ASC 2, A= ASC 3, ASC 2, B= ASC 3, MSGL ABS *-MSG * MSA EQU * REGA ASC 2, STORAGE FOR "DSXX" ERROR CODE ASC 16, REPLY FLUSHED MSB ASC 16, TCB NOT FOUND, POSSIBLE TIMEOUT MSC ASC 13, COMM. READ ERROR, EQT # MSC. ASC 3, ASC 6,,I/O STATUS= .STAT ASC 3, MSCL ABS *-MSC MSD ASC 16, MESSAGE LEVEL NOT CONVERTED * MSG2 EQU * ASC 05, DS ERROR: MSFL2 ASC 16, M2LEN ABS *-MSG2 REQST ASC 2,RQST REPLY ASC 2,RPLY MSG4 ASC 5,RPLY STRM .STRM ASC 1, STREAM TYPE CONVERTED TO ASCII BLANK ASC 1, .3K NOP "3K" IF RQST IS FROM 3000 ASC 5, ORG NODE= .ORGN ASC 3, ORIGINATION NODE #, CONVERTED TO ASCII ASC 5, DEST NODE= .DEST ASC 3, DESTINATION NODE #, CONVERTED TO ASCII OCT 6412 CR/LF .TIME ASC 5, TIME: DAY .DAY ASC 3, DAY NUMBER, CONVERTED TO ASCII ASC 1, .HR NOP HOUR, CONVERTED TO ASCII ASC 1,: .MIN ASC 1, MINUTE, CONVERTED TO ASCII ASC 1,: .SEC ASC 1, SECOND, CONVERTED TO ASCII MSG4L ABS *-MSG4 TIMEL ABS *-.TIME-1 "3K" ASC 1,3K TMAR BSS 5 * SIZE BSS 0 * EQTA EQU 1650B ADDRESS OF 1ST EQUIPMENT TABLE ENTRY END QCLM &   91740-18017 1840 S C0222 &2APLD              H0102 ylASMB,R,L,N,C *USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III) IFN * BEGIN NON-DMS CODE *************** NAM APLDR,1,40 91740-16017 REV 1840 780721 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM APLDR,1,40 91740-16018 REV 1840 780721 ******* END DMS CODE *************** XIF UNL IFN HED APLDR (M2) 91740-16017 REV 1840 780721 (C) HEWLETT-PACKARD CO. XIF IFZ HED APLDR (M3) 91740-16018 REV 1840 780721 (C) HEWLETT-PACKARD CO. XIF LST * * IFN OPTION * NAME: APLDR * SOURCE: 91740-18017 * RELOC: 91740-16017 * PROGMR: EJW,CHW * * IFZ OPTION * NAME : APLDR * SOURCE: 91740-18018 * RELOC: 91740-16018 * PROGMR: EJW,CHW * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * SPC 1 EXT $LIBR,$LIBX,EXEC EXT $CVT3,$CON,PRTN,IMESS EXT DOPEN,DREAD,DLOCF,DCLOS,DEXEC EXT #LNOD,#CNOD,#NCNT SPC 1 IFN * BEGIN NON-DMS CODE *************** EXT .MVW *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** EXT $MATA,$ENDS ******* END DMS CODE *************** XIF SPC 1 * A EQU 0 B EQU 1 KEYWD EQU 1657B BPA1 EQU 1742B BPA2 EQU 1743B RTORG EQU 1746B RTCOM EQU 1747B AVMEM EQU 1751B BKLWA EQU 1777B SUP * * * APLDR IS SCHEDULED BY THE SYSTEM WHEN OPERATOR INPUTS * ONE OF THE FOLLOWING: * PL,LU#,OPT * (1)(0) * LO,PNAME,SC,DRN-LU,PTTN#,SIZE *  LU# * (4) (0) (0) (0) (0) * * APLDR IS SCHEDULED WITH THE FOLLOWING PARAMETERS: * P1 - REMOTE SCHEDULE[15]/ LU[4:9]/ FUNC[0:3] * P2 - #PAGES[10:14] / PTTN#[0:5] OR LIST OPTION * P3 - CHAR1[8:15] / CHAR2[0:7] (OR LU) * P4 - CHAR3[8:15] / CHAR4[0:7] * P5 - CHAR5[8:15] / CHAR6[0:7] * * WHERE FUNCTION CODE IS: * 0 - PROGRAM LIST * 1 - LOAD PROGRAM INTO MEMORY RESIDENT AREA * 2 - LOAD PROGRAM INTO A PARTITION * 3 - SAME AS #1 FROM REMOTE CPU * 4 - SAME AS #2 FROM REMOTE CPU SKP APLDR NOP LDA DPARM GET ADDR OF BUFFER STA TEMP1 SAVE TEMPORARILY LDA MD5 STA TEMP2 RMPLP LDA B,I GET PARAM FROM ID SEG STA TEMP1,I SAVE IN BUFFER INB ISZ TEMP1 ISZ TEMP2 JMP RMPLP * ADB D20 INDEX TO WORD 27 STB DFSC SAVE ADDR OF SECURITY CODE INB LDB 1,I GET CART.REF./ NEG.LU STB ICR SAVE IN 2 WORD ICR PARAMETER CLA STA ERTYP INITIALIZE ERROR INDICATOR LDA $CON,I GET CONSOLE LU AND B77 STA 1 LDA ERLUF RAL,CLE,ERA E=1 IF REMOTE SCHEDULE ALF,ALF ALF AND B77 SZA,RSS LIST LU SPECIFIED? LDA 1 NO, USE CONSOLE STA LU SAVE LU FOR LISTING IOR B400 STA RDLU CCB,SEZ SKIP IF LOCALLY SCHEDULED LDB #CNOD GET ORIGIN NODE FOR LIST STB LNODE SAVE LIST NODE * * LDA ERLUF GET FUNCTION FROM BITS 0-3 AND B17 STA FUNC SZA,RSS IS IT LIST? 0 JMP LIST * LDB #LNOD SEZ JMP LODCK JUMP IF REMOTELY SCHEDULED * LDB #NCNT SZB ANY DS-1000 NODES INITIALIZED? JMP CVNOD YES, ASK FOR LOAD NODE CCB NO, INDICATE LOCAL NODE JMP LODCK * CVNOD JSB IMESS ASK "LOAD FILE'S NODE?" DEF *+4 DEF D2 DEF QUEST DEF D10 * JSB IMESS GET RESPONSE DEF *+4 DEF D1 DEF ABSBF DEF MD5 * CMB,INB,SZB,RSS JMP CVNOD UNKNOWN RESPONSE STB TEMP1 SAVE BYTE COUNT CLA STA NODE LDB DABS RBL BYTE POINTER LBT GET FIRST CHAR. STA TEMP2 SAVE IT CPA ASCNG ="-"? LDA D48 YES CVNO1 ADA N58 SSA,RSS VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA D10 A HAS NUMERIC VALUE OF CHARACTER SSA VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA NODE ACCUMULATE NODAL ADDRESS ISZ TEMP1 MORE CHARACTERS? RSS YES JMP CVNO2 NO STB TEMP3 SAVE BYTE ADDRESS MPY D10 ACCUMULATED VALUE * 10 STA NODE LDB TEMP3 GET BYTE ADDRESS LBT GET NEXT CHARACTER JMP CVNO1 CVNO2 LDB TEMP2 CPB ASCNG 1ST = "-"? CMA,INA YES, NEGATE VALUE LDB 0 LDA FUNC * ENTER FOLLOWING CODE WITH FILE'S NODE IN B REGISTER LODCK CPA D1 IS IT A MEMORY RESIDENT LOAD? JMP LOAD IFZ ***** BEGIN DMS CODE ************** CPA D2 IS IT PARTITION LOAD? JMP LOAD ***** END DMS CODE ************** XIF * UNL * EXT DBUG *** DEBUGGING *** * JSB DBUG *** DEBUGGING *** * DEF *+1 *** DEBUGGING *** * NOP *** DEBUGGING *** NOP *** DEBUGGING *** LST * LDB MD64 FUNCTION CODE ERROR JMP ERSET ERROR * DPARM DEF ERLUF MD5 DEC -5 B77 OCT 77 B2300 OCT 2300 OPT OCT 2310 B400 OCT 400 D3 OCT 3 D20 DEC 20 D48 DEC 48 AN ASCII "0" N58 DEC -58 ASCNG OCT 55 NEG SIGN RDLU NOP FUNC NOP FUNCTION CODE LNODE NOP NODE FOR LIST OUR\TPUT ICR BSS 2 CR/NODE ARRAY NODE EQU ICR+1 FLFLG NOP FILE FLAG HED LO: LOAD PROGRAM * LOAD EQU * STB NODE SAVE NODE OF LOAD FILE SPC 1 IFZ ***** BEGIN DMS CODE *************** CLA STA PT#PG STA PTTN# ******* END DMS CODE *************** XIF SPC 1 JSB IHILO INIT HI,LO ADDRS LDA DWRD1 INIT SPEC REC STA WORD1 DUMMY ID ADDR. LDA DWRD2 STA WORD2 LDA RSS INITIALIZE SWITCH STA AB12D FOR SPEC. REC. CLA STA ABS12 STA ABSCT INDICATE NO ABS YET. * JSB STRID LOAD2 JSB SRCID FIND A BLANK DEF ZERO ID SEG. JMP LOADD NO BLANK ID SEG. JMP LOAD2 KEEP LOOKING. STA CURID GOT IT, SAVE ADDR. * LDA NAM12 GET FILE NAME. SZA,RSS GIVEN? LDA D4 NO, USE DEFAULT STA NAM12 SAVE FOR COMPARE STA FLFLG SET FILE FLAG AND B77 CPA NAM12 LEGAL LU? JMP STCNW YES. SET UP CONTROL WORD. LDB #NCNT IS THIS NODE INITIALIZED SZB FOR DS/1000 COMMUNICATIONS? JMP OPENF YES--GO OPEN FILE. JMP ABORT NO--ABORT. * STCNW IOR B2300 SET UP CONTROL WORD FOR STA CONWD BINARY ABSOLUTE DEXEC READS. CLB STB NAM12 CLEAR TO FORCE USE OF NAM RECORD NAME STB FLFLG CLEAR FILE FLAG. JMP NOTIN GO READ FROM LOCAL LU * OPENF JSB DOPEN OPEN THE ABS INPUT FILE DEF *+7 DEF DCB DEF ERR DEF NAM12 FILE NAME ADDR DEF OPT OPT = 2300B FOR ABS DFSC DEF * SECURITY CODE DEF ICR CR/NODE ARRAY SSA ANY ERRORS? JMP NOFIL NO SUCH FILE * JSB DLOCF GET FILE INFO DEF *+9 DEF DCB DEF ERR DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP LDA TEMP SZA,RSS TYPE 0 FILE? STA NAM12 FORCE USE OF TRAILER RECORD SZA,RSS JMP ABS0 YES, SKIP DUP NAME CHECK NOW * JSB DUPID CHECK FOR DUPLICATE NAME DNM12 DEF NAM12 CHANGE TO ..NAME IF POSSIBLE * * READ AN ABSOLUTE RECORD * * ABS0 LDA FLFLG SZA IS INPUT FROM FILE? JMP READF YES, DO RFA READ * NOTIN JSB DEXEC NO--MAKE DEXEC CALLS. DEF *+6 DEF NODE DEF D1 DEF CONWD DEF ABSBF DEF D64 * AND B240 ISOLATE EOF/EOT BITS SZA EOF OR EOT? JMP LOAD5 YES JMP ABS0A NO, CONTINUE * READF JSB DREAD READ ABS RECORD DEF *+6 DEF DCB DEF ERR DABS DEF ABSBF DEF D64 DEF LEN LDB LEN CPB M1 EOF? JMP LOAD5 YES. SSA JMP ABSCK ANY ERROR, CHECKSUM ERROR * ABS0A LDA ABSCT GET WORD COUNT AND LHALF ALF,ALF SHIFT TO LOW BITS STA ABSSZ SAVE REC SIZE CMA,INA STA TEMP1 SAVE NEG COUNT LDA ABSAD GET ADDR, START CKSM. LDB DABSD ABS0B ADA 1,I ADD WORD TO RUNNING CKSUM INB ISZ TEMP1 BUMP COUNT JMP ABS0B REPEAT TIL DONE. * CPA 1,I COMPARE CKSMS JMP ABS1 MATCHES * ABSCK LDB ERR10 CHECKSUM ERROR- JMP ERPR4 ERR MSG THEN ABORT * NOFIL STA ERTYP RETURN ERROR CODE CMA,INA FMP ERROR CODE IN (A) LDB DABS GET DEF TO TEMP BUFFER JSB CVDEC CONVERT ERR CODE TO ASCII LDA LDASH IOR ABSAD FILL IN "- " STA ABSAD FOR " APLDR: -###" LDB DABS INB SET ADDR OF 4 CHARS LDA D2 JSB STUFP STUFF NAME & PRINT MESSAGE JMP ABORT ABORT APLDR * * FIND WHERE ABSOLUTE RECORD FITS IN CORE * * ABS1 \LDA ABSAD LDB ABSCT CPB HI2 ONLY 2 WORDS IN REC? RSS JMP ABS1A NO, CHECK NORMAL RECORD CPA D2 IS IT SPECIAL RECORD? JMP ABS12 YES ABS1A AND BPMSK IS IT BASE PAGE? CPA ABSAD JMP ABS2 YES, BASE PAGE. * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTMN YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA RTORG GET DEFAULT LOWEST ADDR STA TEMP LDA AVMEM GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DMAIN GET PTRS TO MAIN HI/LO LDB D22 SET OFFSET FOR MAIN JMP ABS3 ADDRS IN ID SEG. * ABS2 EQU * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTBP YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA BPA1 GET DEFAULT LOWEST ADDR STA TEMP LDA BPA2 GET DEFAULT HIGHEST ADDR INA STA TEMP1 LDA DBASE GET PTRS TO BASE HI/LO LDB D24 SET OFFSET FOR BASE PAGE * * * * FIND THE HI AND LO MEMORY BOUNDS OF FREE CORE * * ABS3 STB IDOFS SAVE OFFSET TO GET ADDRS STA TEMP4 SAVE ADDR OF LFREE ADA D2 STA TEMP5 SAVE ADDR OF HFREE LDA TEMP CMA,INA CHECK IF ABS REC < FWABP USER LINKS ADA ABSAD SSA JMP ABS14 ABS < FWABP, ERROR LDA ABSAD ADA ABSSZ CMA,INA CHECK IF ABS REC > LWAM USER SPACE ADA TEMP1 SSA JMP ABS14 ABS > LWAM, ERROR LDA TEMP4,I CPA TEMP RSS ADDRS ALREADY SET? JMP ABS6 YES, SKIP SEARCH FOR HI/LO * JSB STRID INIT ID SEARCH. ABS4 JSB SRCID SEARCH EACH ID DEF ZERO EXCEPT BLANK ONES, JMP AB4S6 FOR THE HI/LO RSS RSS ADDRS WHICH JMP ABS4 DEFINE FREE CORE. CPA CURID IS THIS ID FOR PRG? JMP ABS4 YES, IGNORE THIS ID BOUNDS ADA IDOFS STA TEMP SET ADDR OF ID ADDR. * LDA B (B) STILL HAS ADDR OF NAME ADA D2 BUMP TO TYPE LDA A,I AND B17 GET TYPE FROM ID SEG CPA D1 MEMORY RESIDENT TYPE? RSS YES, CHECK ADDRS JMP ABS4 NO, IGNORE ID * CLA STA TEMP1 CLEAR OVERLAP FLAG * LDA TEMP,I GET ID LOW CMA,INA ADA ABSAD IS ID LOW > ABS REC? SSA JMP ABS4B LOW>ABS, CHECK MORE ISZ TEMP1 LOW<=ABS, CHECK IF OVERLAP JMP ABS5 BY CHECKING IF HI>=ABS * ABS4B LDA TEMP,I GET ID LOW AGAIN CMA SUBTRACT IT ADA TEMP5,I FROM LAST HFREE SSA AND JMP ABS5 IF IT IS LDA TEMP,I LOWER THEN KEEP IT DST TEMP5,I AS NEW HFREE * ABS5 ISZ TEMP LDA TEMP,I GET ID HIGH ADDR CMA,INA ADA ABSAD SSA,RSS ID HIGH < ADDR OF REC? JMP ABS5B HI<=ABS, CHECK MORE CLA,INA HI>ABS, MIGHT OVERLAP CPA TEMP1 DOES ABS OVERLAP? JMP ABS13 YES, GIVE OF ERR JMP ABS4 NO, IGNORE * ABS5B LDA TEMP,I GET ID HI CMA,INA SUBTRACT IT ADA TEMP4,I FROM LAST LFREE SSA,RSS AND IF IT IS JMP ABS4 LDA TEMP,I HIGHER, WE KEEP IT DST TEMP4,I AS NEW LFREE JMP ABS4 REPEAT FOR EACH ID * * * * ALREADY GOT MEMORY BOUNDS; SEE IF ABS CAN FIT * * ABS6 LDA ABSAD GET ADDR OF ABS REC LDB ABSSZ ADB A GET ADDR OF END OF ABS REC JSB CKBND CHECK BOUNDS WITH LFREE,HFREE JMP ABS13 ERROR. * * * * COPY ABS RECORD TO CORE IF WITHIN BOUNDS SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D1 LOAD MEMORY RESIDENT? JMP LDMRP YES * LDA ABSAD NO, LOAD PARTITION RESIDENT JSB PGNO GET PAGE OF RECORD STA PAGE1 SZA,RSS RECORD FOR BASE PAGE? JMP BPMAP YES * LDA ABSAD ADA ABSSZ GET ADDR OF LAST WORD IN RECORD ADA M1 STA ABSEN SAVE ADDR OF LAST WORD IN REC JSB PGNO FIND PAGE OF THAT WORD STA B STB PAGE2 SAVE ENDING PAGE NUMBER CPB PAGE1 RECORD FITS WITHIN ONE PAGE? JMP SAMEP YES * BLF,BLF NO, CROSSES ONE PAGE RBL,RBL ASSUMING RECORD SIZE < 128 WORDS STB PADDR SAVE PAGE BOUNDARY ADDR LDA ABSAD CMA,INA ADA PADDR CALCULATE #WORDS ON THIS PAGE CAX STA WDS1 LDA PTFWA JSB PGNO STA B CMB,INB SUBTRACT PTTN PAGE# ADB PAGE1 TO GET #PAGES OFFSET ADB PTSPG AND OFFSET FROM FIRST PAGE OF PTTN INB (B) = PHYSICAL PAGE # AFTER COUNTING BP * LDA ABSAD CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD (A) = ADDR OF RECORD IN INPUT BUFFER JSB MAPMV PERFORM MAPPING WORD MOVE * LDA PAGE2 SET UP TO MOVE SECOND PART ALF,ALF RAL,RAL CONVERT PAGE# TO ADDR CMA,INA SUBTRACT FROM END ADDR ADA ABSEN TO GET # WORDS INA CAX (X) = # WORDS TO MOVE LDA PTFWA JSB PGNO STA B CMB,INB SUBTRACT FIRST PAGE OF PTTN ADB PAGE2 TO GET #PAGES OFFSET ADB PTSPG ADD TO PTTN FIRST PAGE INB (B) = PAGE # LDA PADDR CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD ADA WDS1 (A) = ADDR OF ABS REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * SAMEP LDA PTFWA JSB PGwNO STA B CMB,INB ADB PAGE1 INB ADB PTSPG SAMEM LDA ABSSZ CAX (X) = #WORDS LDA ABSAD CAY (Y) = LOGICAL ADDR IN PTTN LDA DABSD (A) = ADDR OF REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * BPMAP LDB PTSPG JMP SAMEM * * PGNO NOP CONVERT ADDR TO PAGE # AND B76K ALF,RAL RAL JMP PGNO,I RETURN (A)=PAGE # (B)=UNCHANGED * * (A) = ADDR OF ABS REC IN INPUT BUFFER * (B) = PAGE # OF PARTITION * (X) = # WORDS TO MOVE * (Y) = LOGICAL ADDR FOR ABS IN PTTN * MAPMV NOP MAPPED MOVE ROUTINE STA MAPFR TO MOVE ABS RECS TO PTTN CYA STA LOGSA SAVE LOGICAL ADDR CXA STA NWDS SAVE # WORDS * CLA,INA CAX (X) = 1 REGISTER TO SET UP LDA MAPPG (A) = MAP REGISTER # JSB $LIBR TURN OFF MEM PROT NOP SO WE CAN CHANGE MAP, ALSO MOVE TO BP XMS (B) = PTTN'S PAGE # LDA LOGSA CONVERT LOG ADDR TO PAGE# AND B76K CMA,INA ADA LOGSA OFFSET INTO PAGE ADA PAGBF MAKE LOGICAL ADDR FOR MAPPED MOVE STA B (B) = ADDR OF DUMMY BUFFER FOR MOVE LDA NWDS CAX (X) = #WORDS TO MOVE LDA MAPFR (A) = ADDR OF ABS REC IN BUFFER MWI MOVE WORDS VIA DUMMY BUFFER IN SYS MAP JSB $LIBX DEF MAPMV RETURN * MAPFR NOP ADDR OF ABS REC IN BUFFER LOGSA NOP LOGICAL ADDR OF ABS REC IN PTTN MAPPG DEC 31 LAST PAGE IN SYSTEM MAP PAGBF OCT 76000 ADDR OF DUMMY BUFFER FOR CROSS MAP STORE NWDS NOP #WORDS TO MOVE PADDR NOP PAGE BOUNDARY ADDR B1777 OCT 1777 B76K OCT 76000 C100K OCT 77777 CURPT NOP ADDR OF CURRENT PTTN OWNER PTR PAGE1 NOP PAGE # OF FIRST PART OF REC PAGE2 NOP PAGE # OF SECOND PAR1T OF REC ABSEN NOP ADDR OF LAST WORD IN REC PT#PG NOP #PAGES IN PTTN PTFWA NOP LOGICAL ADDR OF FIRST WORD IN MAIN OF PTTN PTLWA NOP LOGICAL ADDR OF LAST WORD IN MAIN OF PTTN PTSPG NOP PAGE # OF FIRST PAGE IN PTTN PTTN# NOP PTTN # WDS1 NOP # WORDS IN FIRST PAGE OF REC DCRID DEF CURID * * PTMN LDA DMAIN GET PTRS TO MAIN HI/LO RSS GO CHECK BOUNDS OF REC * PTBP LDA DBASE GET PTRS TO BP HI/LO STA TEMP4 JMP ABS6 GO CHECK BOUNDS OF REC * ******* END DMS CODE *************** XIF SPC 1 * * B240 OCT 240 CONWD NOP CONTROL WORD FOR EXEC CALL * * LDMRP LDA DABSD SET UP BUFFER LDB ABSAD SET UP CORE ADDR. JSB SYSET PUT INTO CORE. DEF ABSSZ JMP ABS0 GO GET ANOTHER RECORD * * * * PROCESS SPECIAL TRAILER RECORDS. * * ABS12 NOP RSS-ED AFTER SSGA SET UP. JMP AB12C AB12D RSS NOP-ED AFTER 1ST ENTRY.! JMP AB12B SO ONLY DO THIS ONCE. LDA MD28 STA TEMP1 SET COUNTER LDB DDMID TO CLEAR OUT CLA AB12A STA B,I SPECIAL RECORDS INB ISZ TEMP1 JMP AB12A STA AB12D NOP SWITCH * AB12B LDA WORD1 CPA DWRD2 ALL DONE ALREADY? JMP IDERR ERROR ON TRAILER RECORDS DLD ABSD1 PICK UP 2 DATA WORDS STA WORD1,I PUT 1ST INTO DUMMY ID. STB WORD2,I PUT 2ND INTO DUMMY ID. ISZ WORD1 BUMP DUMMY ID ISZ WORD2 LOCATIONS. JMP ABS0 * * MPFT# 0-PRP NO COM, 1-MRP NO COM, 2-RT COM, 3-XXX, 4-SSGA * AB12C LDA RSS STA ABS12 SET RSS IN THE SSGA SWITCH CLB,INB PREPARE FOR FUNC=1 FOR MRP LDA ABSD1 FIRST SPECIAL RECORD RAL,CLE,SLA,ERA SIGN BIT 0-MRP, 1-PRP INB NOT MEM RES, SET FUNC=2 FOR PTTN LOAD STA MPFT# HAS MPFT INDEX STB FUVNC OVERRIDE FUNC WITH ABS TYPE SEZ,RSS IS IT MEMORY RESIDENT? JMP ABS0 YES, READ NEXT RECORD SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP IDERR M1 OR M2 DOESN'T ALLOW PRP *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** LDA PGPT JSB PGNO CMA,INA INA STA PT#PG SAVE NEG #PAGES-1 CCB ADB $MATA (B) = ADDR OF #PTTNS LDA PGPT AND B77 GET PTTN # SZA,RSS SPECIFIC PTTN# WANTED? JMP PTFND NO, FIND A FREE ONE * ADA M1 SAVE PTTN# - 1 STA PTTN# CMA ADA B,I SUBTRACT FROM #PTTNS CMA SSA,RSS ANY ERROR? JMP ER.PT YES, NO SUCH PTTN * LDA PTTN# 6*(PTTN#-1)+$MATA MPY D6 IS ADDR OF ENTRY IN MAP TABLE ADA $MATA ADA D2 INDEX TO ID OF PTTN OWNER LDB A,I SZB IS PTTN FREE? JMP PTTNO NO, PTTN IS OCCUPIED * LDB A ADB D2 INDEX TO RESERVED FLAG LDB B,I AND PTTN SIZE WORD RBL,CLE,ERB KEEP RESERVE FLAG IN (E) ADB PT#PG CCE,SSB PTTN LARGE ENOUGH? JMP PT.SZ * PTFR LDB PTTN# RBL,ERB SET SIGN BIT FROM (E) STB PTTN# FOR PARTITION REQUESTED STA CURPT SAVE CURR PTTN OWNER PTR LDB A ADB M2 BACK UP TO LINK WORD LDB B,I SSB IS PTTN DEFINED? JMP ER.PT NO. GIVE 'PTN' ERROR * INA LDB A,I STB PTSPG SAVE PTTN START PAGE # INA LDB A,I STB PT#PG SAVE #PAGES IN PTTN JMP PTADR NOW FIND HI ADDR OF PTTN * PTTNO ADB D12 INDEX B TO ADDR OF NAME LDA ERR14 PTTN OCCUPIED JSB ERROR -PTN XXXXX- ERROR MESSAGE LDB MD62 ERROR CODE JMP ERSET * PTFND CLA STA PTTN# INIT PTTN# TO 0 LDA B,I GET #PTTNS CMA,INA STA TEMP NEGATE FOR PTTN SCAN LDA $MATA ADA D2 LOOK AT EACH PTTN OWNER ID * PTNX LDB A,I SZB IS PTTN FREE? JMP PTNFD NO, PTTN NOT FOUND * LDB A ADB D2 INDEX TO SIZE WORD IN MAT ENTRY LDB B,I RBL,CLE,SLB,ERB JMP PTNFD RESERVED, KEEP LOOKING ADB PT#PG CLE,SSB,RSS ENOUGH PAGES IN THIS PTTN? JMP PTFR YES, USE THIS (E=0 TOO) * PTNFD ADA D6 NO, TRY NEXT ONE ISZ PTTN# BUMP PTTN# ISZ TEMP LOOKED AT ALL OF THEM YET? JMP PTNX NO, KEEP LOOKING * ER.PT LDB ERR14 NO SUCH PTTN OR NONE FREE JMP ERPR4 -PTN- ERROR AND ABORT * PT.SZ LDB ERR15 NOT ENOUGH PAGES IN PTTN JMP ERPR4 -PTSZ- ERROR AND ABORT * * PTADR LDA MPFT# SZA IS COMMON OR SSGA NEEDED? JMP USECM YES * LDA $ENDS GET LAST PAGE OF SYSTEM ALF,ALF RAL,RAL JMP STFWA SET UP FWA FOR USER * USECM LDA RTORG ADA RTCOM ADA B1777 AND B76K * STFWA STA PAGE1 SAVE TEMPORARILY CMA,INA LOWEST POSSIBLE LOGICAL ADDR STA B LDA ABSD2 AND B76K GET START PAGE OF USER ABS ADB A SSB USER ADDR < LOWEST LOGICAL ADDR? JMP ABS14 YES "ERR MEM" * STA PTFWA SAVE FWA OF PARTITION USER STA LMAIN SAVE FOR BOUNDS CHECK LDB PT#PG #PAGES - 1 IN PARTITION BLF,BLF RBL,RBL ADB PAGE1 COMPUTE LWA PTTN OR 77777 CMA,INA ADA B JSB PGNO STA PT#PG SAVE ACTUAL #PAGES USED ADB M1 SSB ADDR > 77777? LDB C100K YES, SET LWA = 77777 STB PTLWA LWA OF PARTITION AREA STB HMAIN SAVE FOR BOUNDS CHECK LDA D2 STA LBASE SET LOW BASE ADDR FOR BOUNDS CHECK LDA ԖNLHBPA2 INA STA HBASE SET HI BASE ADDR FOR BOUNDS CHECK JMP ABS0 DONE WITH 1ST SPECIAL, GO READ ABS * ******* END DMS CODE *************** XIF SPC 1 * * * * * REACHED END-OF-FILE ON PROGRAM INPUT * * LOAD5 LDB ABSCT CHECK IF ANY ABS SZB,RSS WAS READ YET. JMP IDERR ERROR IF NONE. LDA WORD1 SPEC REC MUST BE AT END CPA DWRD2 WAS IT ALL THERE? JMP LOAD6 YES. IDERR LDB ERR13 NO SPECIAL RECORDS, JMP ERPR4 PRINT ERR MSG/ABORT * LOAD6 DLD NAM12 NAME GIVEN IN COMMAND? SZA,RSS JMP LOAD7 NO, USE NAME FROM SPEC REC DST PNM12 YES, USE NAME FROM COMMAND LDA NAM50 GET 5TH CHAR AND LHALF STA PNM50 JMP LOAD8 WE DID DUP.CHECK ALREADY. LOAD7 JSB DUPID NAME GIVEN IN SPECIAL RECORD, DEF PNM12 CHECK FOR DUPLICATE. * LOAD8 LDB SZCOM GET SIZE OF COMMON SZB,RSS JMP LOD8A SKIP CHECK IF NO COMMON LDA FWAC GET FWA COMMON CMA SUBTR FROM ADA RTORG FWA REAL-TIME COMMON SSA,RSS FWACAVMEM? JMP LOADE YES, ERROR. * * LOD8A LDA DMAIN GET FREE AREA POINTERS STA TEMP4 FOR THE MAIN AREA DLD PRGMN GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * LDA DBASE GET FREE AREA POINTERS STA TEMP4 FOR THE BASE PAGE AREA DLD PRGBP GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * * * * MOVE ID SEGMENT TO SYSTEM AREA * * LOD8B LDA PNM50 GET 5TH CHAR AND LHALF MASK OUT TYPE INA SET TO TYPE 1 IF MEM.RES. STA PNM50 SPC 1 IFN * BEGIN NON-DMS CODE *************** LDA MPFT# ALF,ALF PUT MPFT INDEX IN BITS 7-9 RAR FOR ID SEG WORD 22 STA MPFT *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** LDB FUNC CPB D1 JMP LOD8C ISZ PNM50 SET TYPE 2 IF PTTN.RES. * LDA DCRID LDB CURPT SET NEW PTTN OWNER ID JSB SYSET DEF D1 LOD8C LDA PT#PG GET #PAGES IN PTTN ALF,RAR IOR MPFT# SET MPFT INDEX IN BITS 7-9 ALF,ALF RAR IOR PTTN# SET PTTN# (BITS 0-5) AND RP (BIT 15) STA MPFT PUT WORD IN ID SEG WORD 22 ******* END DMS CODE *************** XIF SPC 1 LDB CURID INB SET UP ID SEG B-REG TO STB XB POINT TO PARAMS AREA * LDA DDMID SET UP ADDR INA FOR DATA WORDS. LDB CURID SET ADDR FOR CORE LOC. INB DON'T MOVE LINKAGE WORD JSB SYSET MOVE ID SEG DEF D27 * LDB BUFAD SET UP DONE MESSAGE LDA MSG1 WITH PROGRAM NAME MVW D3 LDA DWRD1+1 GET ADDR OF PROG NAME JSB MVNAM MOVE NAME TO MSG LDA D10 STA TEMP"3 JSB DSPLA DISPLAY MESSAGE JMP STOP END APLDR. * * * ERROR RETURNS FROM LOADING SECTION * ABS13 JSB REMER MEMORY ERROR JSB IHILO CLEAR HI,LO ADDR JMP ABS1 GO RE-ESTABLISH HI/LO. * ABS14 LDB ERR12 ABSLWAM JMP ERPR4 SO ABORT * LOADC LDA B,I GET NAM12 FROM ID SZA,RSS PROG REMOVED YET? JMP LOD8B YES. JSB REMER FINAL MEMORY ERROR JMP LOD8A CHECK AGAIN * LOADD LDA DBLNK NO BLANK STA MT.ID+1 ID SEG LDA A00 SET ZEROES IN MSG STA MT.ID+2 LDA D11 LDB MT.ID SET UP MESSAGE ERMPR JSB STUFP PRINT MESSAGE LDB TEMP,I GET ERROR CODE FOR ANY CALLER * ERSET STB ERTYP SAVE ERROR CODE FOR "PRTN" CALL JMP ABORT THEN ABORT. * LOADE LDB ERR11 ABS USED TOO MUCH COMMON ERPR4 LDA D2 GET COUNT TO JMP ERMPR PRINT ERR MSG, ABORT SKP * **************************** * SUBROUTINES USED IN LOAD AND ABSOLUTE RECORD PROCESSORS * **************************** * * DUPID CHECKS FOR DUPLICATE PROGRAM NAME, ISSUES ERROR * MESSAGE AND ATTEMPTS TO CHANGE PROGRAM NAME. ABORTS IF * STILL NOT UNIQUE. * JSB DUPID * DEF PNAME * * DUPID NOP SEARCH FOR DUPLICATE LDA DUPID,I ID NAME. STA DUPNM SAVE ID NAME. ISZ DUPID DUP1 JSB STRID INIT ID SCANNER. DUP2 JSB SRCID FIND ID SEG DUPNM NOP WITH SAME NAME JMP DUPID,I NO DUPLICATE. JMP DUP2 REPEAT TIL DONE. LDA ERR02 DUPLIC. PROG ERR LDB DUPNM JSB ERROR LDB MD61 * LDA C.. CHANGE NAME ONLY ONCE CPA DUPNM,I IF NAME ALREADY CHANGED, JMP ERSET THEN ABORT, ERROR -61 STA DUPNM,I ELSE SEARCH AGAIN. CLB,INB STB ERTYP RETURN A +1 FOR RENAME JMP DUP1 * * **\ ************************** * * SYSET SETS WORDS INTO CORE LOCATIONS * LDA ADDFR * LDB ADDTO * JSB SYSET * DEF COUNT * * SYSET NOP SYSTEM WORD SETTER. JSB $LIBR TURN OFF THE NOP INTER. SYS. STA IHILO SAVE (A) TEMPORARILY LDA SYSET,I GET ADDR OF COUNT STA SYSCT SET COUNT ADDR LDA IHILO RESTORE (A) SPC 1 IFN * BEGIN NON-DMS CODE *************** JSB .MVW STORE WORD INTO SYS. DEF SYSCT NOP *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** MVW SYSCT ******* END DMS CODE *************** XIF SPC 1 SYSCT EQU *-2 ISZ SYSET JSB $LIBX RESTORE INTER SYS DEF SYSET AND RETURN. * * *********************************** * * IHILO INITIALIZES DEFAULT HIGH AND LOW BOUNDS * OF FREE MEMORY. * JSB IHILO * * IHILO NOP INITIALIZE HI/LO ADDRS LDA BKLWA TO FIND HIGHEST STA HMAIN AND LOWEST LDA B1647 STA HBASE ADDRS OF UNUSED LDA RTORG CORE WHICH MAY BE STA LMAIN USED FOR LOADING LDA BPA1 STA LBASE ABS PROGRAMS CLA STA LMID STA HMID STA LBID STA HBID JMP IHILO,I RETURN * * ******************************* * * CKBND CHECKS PROGRAM BOUNDS AGAINST THAT OF FREE * CORE (TEMP4 POINTS TO FREE CORE POINTERS). * LDA PRGLO LOW ADDR OF CORE USED * LDB PRGHI HI ADDR * JSB CKBND * * * CKBND NOP CHECK BOUNDS OF PROG DST TEMP AGAINST BOUNDS OF FREE CORE DLD TEMP4,I GET LFREE CMA,INA SUBTR FROM ADA TEMP LOW ADDR SSA ADDR>=LFREE? JMP CKBND,I NO, ERROR * LDA TEMP4 ADA D2 DLD A,I GET HFREE CMA SUBTR FROM ADA TEMP1 HI ADDR. SZA ADDR <= SSA HFREE? ISZ CKBND RETURN TO P+2 IF NO ERROR JMP CKBND,I RETURN TO P+1 IF ERROR * * ************************** * * REMER ISSUES "REM XXX" ERROR MESSAGE IF NEED TO REMOVE * A PROGRAM TO GET SPACE IN CORE, THEN SUSPENDS APLDR. * IF SPACE BELONGS TO THE SYSTEM, APLDR IS ABORTED. * LDB PNAME PROG WHICH MUST BE REMOVED * JSB REMER * * REMER NOP -REM XXXXX- ERROR SZB,RSS MEMORY ERROR. JMP ABS14 OUTSIDE AVAILABLE MEM LDA ERR01 GIVE -REM XXXXX- MESSAGE JSB ERROR LDA ERLUF LDB MD60 SSA REMOTE SCHEDULE? JMP ERSET YES, RETURN ERROR = -60 * JSB EXEC CALL EXEC DEF *+2 TO SUSPEND DEF D7 THE APLDR. JMP REMER,I RETURN * * ****************************** * * MD28 DEC -28 * B17 OCT 17 B1647 OCT 1647 * * D24 DEC 24 D27 DEC 27 D64 DEC 64 * BPMSK OCT 1777 C.. ASC 1,.. NAME CHANGE CHAR. * HI2 OCT 1000 ABSSZ NOP CURID NOP IDOFS NOP WORD1 NOP WORD2 NOP * * DO NOT CHANGE ORDER OF FOLLOWING * LMAIN NOP LMID NOP HMAIN NOP HMID NOP LBASE NOP LBID NOP HBASE NOP HBID NOP DMAIN DEF LMAIN ADDR OF HI/LO ADDR FOR MAIN DBASE DEF LBASE ADDR OF HI/LO ADDR FOR BASE PAGE * * DWRD2 DEF DWR2,I DWRD1 DEF *+1,I DUMMY ID ADDRESSES DEF PNM12 NAM12 DEF PNM50 NAM50/TYPE DEF RESML RESOL/MULT DEF HTIME HIGH BITS OF TIME DEF SPAR2 - SPARE - DEF PRGMN LOW MAIN DEF PRGBP LOW BASE DEF FWAC FWA COMMON DEF JMPXF JMP XFER * DWR2 DEF PNM34 NAM34 DEF PRIOR PR DEF SPAR1 - SPARE - DEF LTIME LOW BITS OF TIME DEF SEGMX SEGMX DEF PRGM2 HMAIN DEF PRGD2 HBASE DEF SZCOM SIZE COMMON DEF XFER XFER ADDR * HED PL: PROGRAM LIST * LIST PROGRAMS. * LIST EQU * IFZ ***** BEGIN DMS CODE *************** LDA PGPT SZA LIST PARTITIONS OPTION CHOSEN? JMP PTLST YES ******* END DMS CODE *************** XIF SPC 1 JSB SPACE PRINT LDA D19 HEADING. LDB HEAD1 JSB PRINT JSB SPACE * LDA DBLNK SET UP OUTPUT BUFFER. STA BUF STA BUF+7 * CLA CLEAR OUT BLANK ID SEG. STA TEMP5 COUNTER. * JSB STRID INIT ID SCANNER. LIST2 JSB SRCID SEARCH ID SEGS DEF ZERO JMP LIST7 EOF JMP LIST3 NON BLANK ID SEG ISZ TEMP5 BLANK ID SEG JMP LIST2 GO SEE NEXT ONE. * LIST3 STB TEMP1 SAVE NAME ADDR STA TEMP SAVE ID ADDR LDA 1 LDB LINE PUT PROG NAME INB INTO LINE JSB MVNAM * LDB TEMP ADB D6 GET PRIORITY LDA B,I WORD LDB .PR JSB CVDEC CONVERT AND STUFF * LDB TEMP ADB D22 GET PROG ADDRS. STB TEMP LDA M2 SET -2 TO GET STA TEMP4 MAIN AND BASE PAGE. LDB LINE INITIALIZE ADDR ADB D7 FOR NUMBER STUFFING. LIST4 LDA TEMP,I GET LOW ADDR. JSB CVOCT CONVERT TO ASCII. ISZ TEMP LDA TEMP,I GET HIGH ADDR. ADA M1 -1 TO GET REAL HIGH ADDR JSB CVOCT CONVERT TO ASCII. * ISZ TEMP ISZ TEMP4 JMP LIST4 GO GET NEXT PAIR OF ADDRS. * LDA D19 LDB LINE JSB PRINT PRINT PROG INFO. * JMP LIST2 GO GET NEXT ID SEG. * LIST7 LDA TEMP5 GET # OF, BLANK ID SEGS LDB DNM12 JSB CVDEC CONVERT AND STUFF INTO DUMMY PLACE LDA NAM50 PICK UP JUST 2 DIGITS STA MT.ID+2 AND MOVE TO MESSAGE LDA D11 LDB MT.ID JSB PRINT PRINT "# BLANK ID SEGMENTS" * DONE LDA D2 PRINT "DONE" LDB MSG1 AFTER THE "APLDR:" JMP STOP1 * ABORT LDA D4 PRINT "ABORTED" LDB ERR99 AFTER THE "APLDR:" STOP1 JSB STUFP STOP JSB DCLOS CLOSE INPUT FILE IF ANY DEF *+3 DEF DCB DEF ERR * LDA ERTYP STA MSG+6 MOVE ERROR VALUE FOR PARAMETER RETURN * RTRNP JSB PRTN RETURN ERROR CODE(,PGM NAME) DEF *+2 TO "FATHER" PGM ("EXECW") DEF MSG+6 * JSB EXEC CALL EXEC DEF *+2 TO END DEF D6 APLDR. * SPC 1 IFZ ***** BEGIN DMS CODE *************** HED PL: PARTITION LIST PTLST JSB SPACE PRINT HEADING FOR PTTN LIST LDA D16 LDB PTHED JSB PRINT JSB SPACE LDA DBLNK STA BUF+12 * CLA,INA STA PTTN# INITIALIZE FOR PTTN SCAN LDA $MATA STA CURPT SAVE ADDR OF CURR MAT ENTRY ADA M1 GET # PTTNS LDA A,I SZA,RSS CHECK - JUST IN CASE ...! JMP DONE MPY D6 ADA $MATA STA PTLWA SAVE ADDR OF LAST ENTRY * PNXPT LDA PTTN# LDB BUFAD CONVERT PTTN# AND PUT IN BUFFER JSB CVDEC LDA CURPT,I GET LINK OF MAT ENTRY SSA,RSS IS PTTN DEFINED? JMP CKRES YES, CHECK RESERVE STATUS * LDA PUNDF LDB .PTNS MVW D6 MOVE 'NOT DEFINED' MESSAGE LDA D9 JMP PRPTL AND THEN GO ON TO NEXT * CKRES LDB CURPT ADB D4 CALC ADDR OF RESERVE/SIZE WORD LDA B,I CLE,ELA (E) = RESERVE STATUS RAR AND B1777 KEEP 10 BITS #PAGES STA PT#PG LDB DBLNK USE '  ' SEZ OR LDB ASCR ' R' IF RESERVED STB PADDR INA ADD 1 TO #PAGES FOR B.P. LDB .PTNS JSB CVDEC CONVERT PTTN SIZE * LDA PADDR STA BUF+3 SET RESERVE STATUS * LDB CURPT ADB D3 ADDR OF START PAGE LDA B,I AND B1777 PAGE # IN LOW 10 BITS STA PAGE1 LDB .PTNF CONVERT FIRST PAGE# JSB CVDEC AND PUT IN MESSAGE * LDA PAGE1 ADA PT#PG LDB .PTNL CONVERT LAST PAGE# JSB CVDEC LDA DASH STA BUF+9 * LDB CURPT ADB D2 INDEX TO OWNER ID SEG LDA 1,I SZA,RSS EMPTY? JMP PTEMT YES * ADA D12 NO, INDEX TO NAME LDB .PTNP JSB MVNAM MOVE PROGRAM NAME PRPTN LDA D16 PRPTL LDB LINE JSB PRINT PRINT THE INFO ABOUT THIS PTTN * ISZ PTTN# LDA CURPT ADA D6 INDEX TO NEXT MAT ENTRY STA CURPT CPA PTLWA LAST ONE? JMP DONE YES, DONE JMP PNXPT NO, DUMP INFO ON NEXT PTTN * PTEMT LDA PTNON LDB .PTNP NO PROGRAM IN PTTN MVW D3 JMP PRPTN * D16 DEC 16 DASH ASC 1, - ******* END DMS CODE *************** XIF SPC 1 * HED SUBROUTINES FOR APLDR. * * ***************************** * * SPACE PRINTS A BLANK LINE ON LIST DEVICE. * JSB SPACE * * SPACE NOP PRINT BLANK CLA,INA LINE. LDB DFBLK (B)=ADDR OF BLANK JSB PRINT JMP SPACE,I * * ***************************** * * PRINT PRINTS A LINE ON LIST DEVICE. * LDA WORDS NO. OF WORDS * LDB ADDR ADDR OF TEXT * JSB PRINT * * PRINT NOP STA TEMP1 STB MADDR JSB DEXEC CALL REMOTE EXEC DEF *+6 TO PRINT DEF LNODE ON LIST DEVICE DEF D2I WRITE, NO-ABORT DEF LU MADDR NOP DEF TEMP1 JMP IOERR ERROR RETURN JMP PRINT,I * IOERR DST MSG+7 SAVE ASCII ERROR CODE LDA ERLUF SSA REMOTE CALL? JMP REMOT YES LDA DBLNK NO, LOCAL STA MSG+4 CLEAR MSG BUFR STA MSG+5 LDA D9 PRINT ERROR STA TEMP3 MESSAGE LOCALLY JSB DSPLA AND JMP ABORT ABORT. * REMOT LDA BIT15 INDICATE I/O ERROR STA MSG+6 JMP RTRNP RETURN PARAMETERS TO CALLER * * ******************************** * * STUFP STUFFS A MESSAGE WITH THE IDENTIFIER "APLDR:" AND * PRINTS IT ON CONSOLE. * LDA WORDS * LDB ADDR * JSB STUFP * * STUFP NOP STUFF MESSAGE INTO STB TEMP SPECIAL IDENTIFIER LDB D4 ADD 4 TO ADB A MESSAGE LENGTH STB TEMP3 FOR TOTAL LENGTH CMA,INA STA TEMP2 NEGATIVE COUNT. LDB MSG0 STFLP LDA TEMP,I STA B,I INB ISZ TEMP ISZ TEMP2 JMP STFLP JSB DSPLA DISPLAY MESSAGE JMP STUFP,I RETURN * * ****************************** * * DSPLA PRINTS A MESSAGE ON THE CONSOLE. THE MESSAGE * ADDRESS IS IN MSG AND THE WORD LENGTH IS IN TEMP3. * JSB DSPLA * * DSPLA NOP LDA ERLUF AND MSKW1 ISOLATE REMOTE FLAG & LU CPA BIT15 REMOTE, AND LU=0? JMP DSPLA,I YES, DON'T LOG THE MESSAGE RAL,CLE,SLA,ERA REMOTE? JMP RMESG YES * JSB IMESS NO DEF *+4 DEF D2 WRITE DEF MSG MESSAGE ON DEF TEMP3 OPERATOR CONSOLE. JMP DSPLA,I RETURN * RMESG ALF,ALF ALF STA MVNAM * JSB DEXEC WRITE MESSAGE TO REMOTE INITIATOR DEF *+6 }DEF LNODE DEF D2I WRITE, NO-ABORT DEF MVNAM REMOTE CONSOLE'S LU DEF MSG DEF TEMP3 JMP IOERR ERROR RETURN JMP DSPLA,I * * ****************************** * * MVNAM MOVES A PROGRAM NAME (3 WORDS) AND FILLS AN * ASCII BLANK IN THE DESTINATION NAME. * LDB DEST ADDR OF DESTINATION FOR NAME * LDA SORC ADDR OF SOURCE NAME * JSB MVNAM * * MVNAM NOP MOVE PROG NAME MVW D2 MOVE FIRST 4 CHARACTERS LDA 0,I GET 5TH CHARACTER AND LHALF PUT ASCII BLANK IOR B40 IN CHAR6 STA 1,I THEN MOVE JMP MVNAM,I RETURN * * ******************************* * * ERROR PUTS A PROGRAM NAME INTO AN ERROR MESSAGE * THEN PRINTS IT ON THE CONSOLE. * LDA ERRAD ADDR OF ERROR MESSAGE * LDB PNAME ADDR OF PROGRAM NAME * JSB ERROR * * ERROR NOP PUT NAME INTO STB TEMP5 ERR MSG THEN DLD A,I PRINT IT BUFAD EQU *+1 DST BUF MOVE ERR MSG TO OUTPUT AREA LDA TEMP5 GET ADDR OF NAME LDB LINE2 TO PUT INTO MSG JSB MVNAM LDA D9 STA TEMP3 SET LENGTH FOR JSB DSPLA DISPLAY JMP ERROR,I RETURN * * ***************************** * * STRID INITIALIZES ID SEGMENT SEARCH ROUTINE. * * STRID NOP INITIALIZE ID SCANNER. LDA KEYWD GET KEYWORD ADDRESS STA ADRID STORE AS ID ADDRESS. JMP STRID,I RETURN * * ***************************** * * SRCID FETCHS AN ID SEGMENT AND SEES IF MATCH/NO MATCH/BLANK. * JSB SRCID * DEF PNAME ADDR OF NAME TO SEARCH FOR * * * * A CONTAINS ADDR OF ID SEGMENT I * B CONTAINS ADDR OF NAME IN ID SEGMENT * SRCID NOP SEARCH ID SEGMENTS LDA SRCID,I FOR A CERTAIN NAME. STA TEMP1 SAVE ADDR OF NAME ISZ SRCID SET RETURN AT P+2 LDB ADRID,I PICK UP AN ID ADDR SZB,RSS IS IT END OF ID SEGS? JMP EOFID YES ADB D12 BUMP TO NAME IN ID STB TEMP2 SAVE ADDR OF NAME LDA B,I CPA TEMP1,I CHECK NAME 1,2 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I CPA TEMP1,I CHECK NAME 3,4 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I AND LHALF STA STRID SAVE TEMPORARILY LDA TEMP1,I AND LHALF CPA STRID COMPARE NAME 5 ISZ SRCID MATCHES, SET RETURN P+4 * NOMAT ISZ SRCID NO MATCH, RETURN P+3 LDA ADRID,I READY FOR RETURN. ISZ ADRID LDB TEMP2 EOFID JMP SRCID,I RETURN. * * ***************************** * SUBROUTINE: CVOCT (CONVERT 15-BIT BINARY NUMBER * TO 6-CHAR (LEADING BLANK) ASCII FORM OF OCTAL NUMBER * CALLING SEQUENCE: * (A)-BINARY VALUE FOR CONVERSION * (B)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (P) JSB CVOCT * (P+1) (RETURN): * (A) DESTROYED. * (B) ADDRESS OF NEXT STORAGE * CVOCT NOP CLE (E) = 0 FOR OCTAL JSB CVT CALL CONVERSION AND STUFF ASCII JMP CVOCT,I RETURN * * SUBROUTINE: CVDEC CONVERTS BINARY TO DECIMAL ASCII * CALLING SEQUENCE: SAME AS CVOCT * * CVDEC NOP CCE (E) = 1 FOR DECIMAL CONVERSION JSB CVT CONVERT AND STUFF ASCII JMP CVDEC,I RETURN * * CVT NOP JSB $LIBR GO PRIVILEGED NOP STB ADDR SAVE ADDR JSB $CVT3 CALL SYSTEM'S ROUTINE LDB ADDR MVW D3 MOVE 3 ASCII WORDS JSB $LIBX RETURN DEF CVT * ADDR NOP SKP * CONSTANTS AND STORAGE. * UNS M1 DEC -1 M2 DEC -2 * D1 OCT 1 D2 OCT 2 D2I OCT 100002 D4 OCT 4 D6 OCT 6 D7 OCT 7 B40 OCT 40 * D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D19 DEC 19 D22 DEC 22 * A00 ASC 1,00 MSKW1 OCT 101760 BIT15 OCT 100000 LHALF OCT 177400 ZERO OCT 0,0,0 ADRID NOP LU NOP ERR NOP MPFT# NOP MEMORY PROTECT FENCE INDEX VALUE * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP LEN NOP ERTYP NOP * ERLUF NOP 5-WORD TABLE. PGPT NOP DO NOT RE-ARRANGE! NAM12 NOP NOP NAM50 NOP * DCB BSS 4 SKP * MESSAGES FROM APLDR WITH LOVE. * * ERR01 DEF *+1 REMOVE PROGRAM TO BE OVERLAYED ASC 2,REM MD60 DEC -60 * ERR02 DEF *+1 DUPLICATE PROGRAM NAME ASC 2,DUP MD61 DEC -61 * ERR10 DEF *+1 CHECKSUM ERROR ASC 2,CKSM DEC -66 * ERR11 DEF *+1 COMMON AREA OVERFLOW ASC 2,COM DEC -67 * ERR12 DEF *+1 MEMORY OVERFLOW ASC 2,MEM DEC -68 * ERR13 DEF *+1 IDENTIFICATION RECORDS MISSING OR WRONG ASC 2,ID? DEC -65 * ERR99 DEF *+1 APLDR IS ABORTED ASC 4,ABORTED * * QUEST ASC 10, LOAD FILE'S NODE? __ * MSG1 DEF *+1 ASC 3,DONE- LDASH EQU *-1 "- " * * MT.ID DEF *+1 ASC 11, 00 BLANK ID SEGMENTS MD64 DEC -64 DBLNK EQU MT.ID+1 DOUBLE BLANK WORD DFBLK DEF DBLNK * HEAD1 DEF *+1 ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE * SPC 1 IFZ ***** BEGIN DMS CODE *************** ERR14 DEF *+1 NO FREE PARTITION ASC 2,PTN MD62 DEC -62 * ERR15 DEF *+1 PARTITION NOT LARGE ENOUGH ASC 2,PTSZ DEC -63 * PUNDF DEF *+1 ASC 6, NOT DEFINED * PTNON DEF *+1 ASC 3, PTHED DEF *+1 ASHFBC 16, PTN# R SIZE PAGES PROGRAM ASCR EQU PTHED+4 .PTNS DEF BUF+3 .PTNF DEF BUF+6 .PTNL DEF BUF+9 .PTNP DEF BUF+13 ******* END DMS CODE *************** XIF SPC 1 .PR DEF BUF+4 * DABSD DEF ABSBF+2 DDMID DEF DMYID LINE DEF MSG+4 LINE2 DEF MSG+6 MSG0 EQU LINE * MSG ASC 9, APLDR: BUF EQU MSG+4 * ABSBF BSS 64 * ABSCT EQU ABSBF ABSAD EQU ABSBF+1 ABSD1 EQU ABSBF+2 ABSD2 EQU ABSBF+3 * DMYID EQU ABSBF+35 SPAR2 EQU DMYID-5 JMPXF EQU DMYID-4 SPAR1 EQU DMYID-3 FWAC EQU DMYID-2 SZCOM EQU DMYID-1 PRIOR EQU DMYID+6 XFER EQU DMYID+7 XB EQU DMYID+10 PNM12 EQU DMYID+12 PNM34 EQU DMYID+13 PNM50 EQU DMYID+14 RESML EQU DMYID+17 HTIME EQU DMYID+18 LTIME EQU DMYID+19 MPFT EQU DMYID+21 PRGMN EQU DMYID+22 PRGM2 EQU DMYID+23 PRGBP EQU DMYID+24 PRGD2 EQU DMYID+25 SEGMX EQU DMYID+26 * * BSS 0 SIZE OF APLDR * * END APLDR 'H  91740-18018 1840 S C0222 &3APLD              H0102 zmASMB,R,L,Z,C *USE 'ASMB,R,N' (RTE-M I/RTE-M II) OR 'ASMB,R,Z' (RTE-M III) IFN * BEGIN NON-DMS CODE *************** NAM APLDR,1,40 91740-16017 REV 1840 780721 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM APLDR,1,40 91740-16018 REV 1840 780721 ******* END DMS CODE *************** XIF UNL IFN HED APLDR (M2) 91740-16017 REV 1840 780721 (C) HEWLETT-PACKARD CO. XIF IFZ HED APLDR (M3) 91740-16018 REV 1840 780721 (C) HEWLETT-PACKARD CO. XIF LST * * IFN OPTION * NAME: APLDR * SOURCE: 91740-18017 * RELOC: 91740-16017 * PROGMR: EJW,CHW * * IFZ OPTION * NAME : APLDR * SOURCE: 91740-18018 * RELOC: 91740-16018 * PROGMR: EJW,CHW * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * SPC 1 EXT $LIBR,$LIBX,EXEC EXT $CVT3,$CON,PRTN,IMESS EXT DOPEN,DREAD,DLOCF,DCLOS,DEXEC EXT #LNOD,#CNOD,#NCNT SPC 1 IFN * BEGIN NON-DMS CODE *************** EXT .MVW *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** EXT $MATA,$ENDS ******* END DMS CODE *************** XIF SPC 1 * A EQU 0 B EQU 1 KEYWD EQU 1657B BPA1 EQU 1742B BPA2 EQU 1743B RTORG EQU 1746B RTCOM EQU 1747B AVMEM EQU 1751B BKLWA EQU 1777B SUP * * * APLDR IS SCHEDULED BY THE SYSTEM WHEN OPERATOR INPUTS * ONE OF THE FOLLOWING: * PL,LU#,OPT * (1)(0) * LO,PNAME,SC,DRN-LU,PTTN#,SIZE *  LU# * (4) (0) (0) (0) (0) * * APLDR IS SCHEDULED WITH THE FOLLOWING PARAMETERS: * P1 - REMOTE SCHEDULE[15]/ LU[4:9]/ FUNC[0:3] * P2 - #PAGES[10:14] / PTTN#[0:5] OR LIST OPTION * P3 - CHAR1[8:15] / CHAR2[0:7] (OR LU) * P4 - CHAR3[8:15] / CHAR4[0:7] * P5 - CHAR5[8:15] / CHAR6[0:7] * * WHERE FUNCTION CODE IS: * 0 - PROGRAM LIST * 1 - LOAD PROGRAM INTO MEMORY RESIDENT AREA * 2 - LOAD PROGRAM INTO A PARTITION * 3 - SAME AS #1 FROM REMOTE CPU * 4 - SAME AS #2 FROM REMOTE CPU SKP APLDR NOP LDA DPARM GET ADDR OF BUFFER STA TEMP1 SAVE TEMPORARILY LDA MD5 STA TEMP2 RMPLP LDA B,I GET PARAM FROM ID SEG STA TEMP1,I SAVE IN BUFFER INB ISZ TEMP1 ISZ TEMP2 JMP RMPLP * ADB D20 INDEX TO WORD 27 STB DFSC SAVE ADDR OF SECURITY CODE INB LDB 1,I GET CART.REF./ NEG.LU STB ICR SAVE IN 2 WORD ICR PARAMETER CLA STA ERTYP INITIALIZE ERROR INDICATOR LDA $CON,I GET CONSOLE LU AND B77 STA 1 LDA ERLUF RAL,CLE,ERA E=1 IF REMOTE SCHEDULE ALF,ALF ALF AND B77 SZA,RSS LIST LU SPECIFIED? LDA 1 NO, USE CONSOLE STA LU SAVE LU FOR LISTING IOR B400 STA RDLU CCB,SEZ SKIP IF LOCALLY SCHEDULED LDB #CNOD GET ORIGIN NODE FOR LIST STB LNODE SAVE LIST NODE * * LDA ERLUF GET FUNCTION FROM BITS 0-3 AND B17 STA FUNC SZA,RSS IS IT LIST? 0 JMP LIST * LDB #LNOD SEZ JMP LODCK JUMP IF REMOTELY SCHEDULED * LDB #NCNT SZB ANY DS-1000 NODES INITIALIZED? JMP CVNOD YES, ASK FOR LOAD NODE CCB NO, INDICATE LOCAL NODE JMP LODCK * CVNOD JSB IMESS ASK "LOAD FILE'S NODE?" DEF *+4 DEF D2 DEF QUEST DEF D10 * JSB IMESS GET RESPONSE DEF *+4 DEF D1 DEF ABSBF DEF MD5 * CMB,INB,SZB,RSS JMP CVNOD UNKNOWN RESPONSE STB TEMP1 SAVE BYTE COUNT CLA STA NODE LDB DABS RBL BYTE POINTER LBT GET FIRST CHAR. STA TEMP2 SAVE IT CPA ASCNG ="-"? LDA D48 YES CVNO1 ADA N58 SSA,RSS VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA D10 A HAS NUMERIC VALUE OF CHARACTER SSA VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA NODE ACCUMULATE NODAL ADDRESS ISZ TEMP1 MORE CHARACTERS? RSS YES JMP CVNO2 NO STB TEMP3 SAVE BYTE ADDRESS MPY D10 ACCUMULATED VALUE * 10 STA NODE LDB TEMP3 GET BYTE ADDRESS LBT GET NEXT CHARACTER JMP CVNO1 CVNO2 LDB TEMP2 CPB ASCNG 1ST = "-"? CMA,INA YES, NEGATE VALUE LDB 0 LDA FUNC * ENTER FOLLOWING CODE WITH FILE'S NODE IN B REGISTER LODCK CPA D1 IS IT A MEMORY RESIDENT LOAD? JMP LOAD IFZ ***** BEGIN DMS CODE ************** CPA D2 IS IT PARTITION LOAD? JMP LOAD ***** END DMS CODE ************** XIF * UNL * EXT DBUG *** DEBUGGING *** * JSB DBUG *** DEBUGGING *** * DEF *+1 *** DEBUGGING *** * NOP *** DEBUGGING *** NOP *** DEBUGGING *** LST * LDB MD64 FUNCTION CODE ERROR JMP ERSET ERROR * DPARM DEF ERLUF MD5 DEC -5 B77 OCT 77 B2300 OCT 2300 OPT OCT 2310 B400 OCT 400 D3 OCT 3 D20 DEC 20 D48 DEC 48 AN ASCII "0" N58 DEC -58 ASCNG OCT 55 NEG SIGN RDLU NOP FUNC NOP FUNCTION CODE LNODE NOP NODE FOR LIST OUR\TPUT ICR BSS 2 CR/NODE ARRAY NODE EQU ICR+1 FLFLG NOP FILE FLAG HED LO: LOAD PROGRAM * LOAD EQU * STB NODE SAVE NODE OF LOAD FILE SPC 1 IFZ ***** BEGIN DMS CODE *************** CLA STA PT#PG STA PTTN# ******* END DMS CODE *************** XIF SPC 1 JSB IHILO INIT HI,LO ADDRS LDA DWRD1 INIT SPEC REC STA WORD1 DUMMY ID ADDR. LDA DWRD2 STA WORD2 LDA RSS INITIALIZE SWITCH STA AB12D FOR SPEC. REC. CLA STA ABS12 STA ABSCT INDICATE NO ABS YET. * JSB STRID LOAD2 JSB SRCID FIND A BLANK DEF ZERO ID SEG. JMP LOADD NO BLANK ID SEG. JMP LOAD2 KEEP LOOKING. STA CURID GOT IT, SAVE ADDR. * LDA NAM12 GET FILE NAME. SZA,RSS GIVEN? LDA D4 NO, USE DEFAULT STA NAM12 SAVE FOR COMPARE STA FLFLG SET FILE FLAG AND B77 CPA NAM12 LEGAL LU? JMP STCNW YES. SET UP CONTROL WORD. LDB #NCNT IS THIS NODE INITIALIZED SZB FOR DS/1000 COMMUNICATIONS? JMP OPENF YES--GO OPEN FILE. JMP ABORT NO--ABORT. * STCNW IOR B2300 SET UP CONTROL WORD FOR STA CONWD BINARY ABSOLUTE DEXEC READS. CLB STB NAM12 CLEAR TO FORCE USE OF NAM RECORD NAME STB FLFLG CLEAR FILE FLAG. JMP NOTIN GO READ FROM LOCAL LU * OPENF JSB DOPEN OPEN THE ABS INPUT FILE DEF *+7 DEF DCB DEF ERR DEF NAM12 FILE NAME ADDR DEF OPT OPT = 2300B FOR ABS DFSC DEF * SECURITY CODE DEF ICR CR/NODE ARRAY SSA ANY ERRORS? JMP NOFIL NO SUCH FILE * JSB DLOCF GET FILE INFO DEF *+9 DEF DCB DEF ERR DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP1 DEF TEMP LDA TEMP SZA,RSS TYPE 0 FILE? STA NAM12 FORCE USE OF TRAILER RECORD SZA,RSS JMP ABS0 YES, SKIP DUP NAME CHECK NOW * JSB DUPID CHECK FOR DUPLICATE NAME DNM12 DEF NAM12 CHANGE TO ..NAME IF POSSIBLE * * READ AN ABSOLUTE RECORD * * ABS0 LDA FLFLG SZA IS INPUT FROM FILE? JMP READF YES, DO RFA READ * NOTIN JSB DEXEC NO--MAKE DEXEC CALLS. DEF *+6 DEF NODE DEF D1 DEF CONWD DEF ABSBF DEF D64 * AND B240 ISOLATE EOF/EOT BITS SZA EOF OR EOT? JMP LOAD5 YES JMP ABS0A NO, CONTINUE * READF JSB DREAD READ ABS RECORD DEF *+6 DEF DCB DEF ERR DABS DEF ABSBF DEF D64 DEF LEN LDB LEN CPB M1 EOF? JMP LOAD5 YES. SSA JMP ABSCK ANY ERROR, CHECKSUM ERROR * ABS0A LDA ABSCT GET WORD COUNT AND LHALF ALF,ALF SHIFT TO LOW BITS STA ABSSZ SAVE REC SIZE CMA,INA STA TEMP1 SAVE NEG COUNT LDA ABSAD GET ADDR, START CKSM. LDB DABSD ABS0B ADA 1,I ADD WORD TO RUNNING CKSUM INB ISZ TEMP1 BUMP COUNT JMP ABS0B REPEAT TIL DONE. * CPA 1,I COMPARE CKSMS JMP ABS1 MATCHES * ABSCK LDB ERR10 CHECKSUM ERROR- JMP ERPR4 ERR MSG THEN ABORT * NOFIL STA ERTYP RETURN ERROR CODE CMA,INA FMP ERROR CODE IN (A) LDB DABS GET DEF TO TEMP BUFFER JSB CVDEC CONVERT ERR CODE TO ASCII LDA LDASH IOR ABSAD FILL IN "- " STA ABSAD FOR " APLDR: -###" LDB DABS INB SET ADDR OF 4 CHARS LDA D2 JSB STUFP STUFF NAME & PRINT MESSAGE JMP ABORT ABORT APLDR * * FIND WHERE ABSOLUTE RECORD FITS IN CORE * * ABS1 \LDA ABSAD LDB ABSCT CPB HI2 ONLY 2 WORDS IN REC? RSS JMP ABS1A NO, CHECK NORMAL RECORD CPA D2 IS IT SPECIAL RECORD? JMP ABS12 YES ABS1A AND BPMSK IS IT BASE PAGE? CPA ABSAD JMP ABS2 YES, BASE PAGE. * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTMN YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA RTORG GET DEFAULT LOWEST ADDR STA TEMP LDA AVMEM GET DEFAULT HIGHEST ADDR STA TEMP1 LDA DMAIN GET PTRS TO MAIN HI/LO LDB D22 SET OFFSET FOR MAIN JMP ABS3 ADDRS IN ID SEG. * ABS2 EQU * SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D2 LOAD PTTN? JMP PTBP YES, SET BOUNDS FOR ADDR CHECKS * ******* END DMS CODE *************** XIF SPC 1 LDA BPA1 GET DEFAULT LOWEST ADDR STA TEMP LDA BPA2 GET DEFAULT HIGHEST ADDR INA STA TEMP1 LDA DBASE GET PTRS TO BASE HI/LO LDB D24 SET OFFSET FOR BASE PAGE * * * * FIND THE HI AND LO MEMORY BOUNDS OF FREE CORE * * ABS3 STB IDOFS SAVE OFFSET TO GET ADDRS STA TEMP4 SAVE ADDR OF LFREE ADA D2 STA TEMP5 SAVE ADDR OF HFREE LDA TEMP CMA,INA CHECK IF ABS REC < FWABP USER LINKS ADA ABSAD SSA JMP ABS14 ABS < FWABP, ERROR LDA ABSAD ADA ABSSZ CMA,INA CHECK IF ABS REC > LWAM USER SPACE ADA TEMP1 SSA JMP ABS14 ABS > LWAM, ERROR LDA TEMP4,I CPA TEMP RSS ADDRS ALREADY SET? JMP ABS6 YES, SKIP SEARCH FOR HI/LO * JSB STRID INIT ID SEARCH. ABS4 JSB SRCID SEARCH EACH ID DEF ZERO EXCEPT BLANK ONES, JMP AB4S6 FOR THE HI/LO RSS RSS ADDRS WHICH JMP ABS4 DEFINE FREE CORE. CPA CURID IS THIS ID FOR PRG? JMP ABS4 YES, IGNORE THIS ID BOUNDS ADA IDOFS STA TEMP SET ADDR OF ID ADDR. * LDA B (B) STILL HAS ADDR OF NAME ADA D2 BUMP TO TYPE LDA A,I AND B17 GET TYPE FROM ID SEG CPA D1 MEMORY RESIDENT TYPE? RSS YES, CHECK ADDRS JMP ABS4 NO, IGNORE ID * CLA STA TEMP1 CLEAR OVERLAP FLAG * LDA TEMP,I GET ID LOW CMA,INA ADA ABSAD IS ID LOW > ABS REC? SSA JMP ABS4B LOW>ABS, CHECK MORE ISZ TEMP1 LOW<=ABS, CHECK IF OVERLAP JMP ABS5 BY CHECKING IF HI>=ABS * ABS4B LDA TEMP,I GET ID LOW AGAIN CMA SUBTRACT IT ADA TEMP5,I FROM LAST HFREE SSA AND JMP ABS5 IF IT IS LDA TEMP,I LOWER THEN KEEP IT DST TEMP5,I AS NEW HFREE * ABS5 ISZ TEMP LDA TEMP,I GET ID HIGH ADDR CMA,INA ADA ABSAD SSA,RSS ID HIGH < ADDR OF REC? JMP ABS5B HI<=ABS, CHECK MORE CLA,INA HI>ABS, MIGHT OVERLAP CPA TEMP1 DOES ABS OVERLAP? JMP ABS13 YES, GIVE OF ERR JMP ABS4 NO, IGNORE * ABS5B LDA TEMP,I GET ID HI CMA,INA SUBTRACT IT ADA TEMP4,I FROM LAST LFREE SSA,RSS AND IF IT IS JMP ABS4 LDA TEMP,I HIGHER, WE KEEP IT DST TEMP4,I AS NEW LFREE JMP ABS4 REPEAT FOR EACH ID * * * * ALREADY GOT MEMORY BOUNDS; SEE IF ABS CAN FIT * * ABS6 LDA ABSAD GET ADDR OF ABS REC LDB ABSSZ ADB A GET ADDR OF END OF ABS REC JSB CKBND CHECK BOUNDS WITH LFREE,HFREE JMP ABS13 ERROR. * * * * COPY ABS RECORD TO CORE IF WITHIN BOUNDS SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D1 LOAD MEMORY RESIDENT? JMP LDMRP YES * LDA ABSAD NO, LOAD PARTITION RESIDENT JSB PGNO GET PAGE OF RECORD STA PAGE1 SZA,RSS RECORD FOR BASE PAGE? JMP BPMAP YES * LDA ABSAD ADA ABSSZ GET ADDR OF LAST WORD IN RECORD ADA M1 STA ABSEN SAVE ADDR OF LAST WORD IN REC JSB PGNO FIND PAGE OF THAT WORD STA B STB PAGE2 SAVE ENDING PAGE NUMBER CPB PAGE1 RECORD FITS WITHIN ONE PAGE? JMP SAMEP YES * BLF,BLF NO, CROSSES ONE PAGE RBL,RBL ASSUMING RECORD SIZE < 128 WORDS STB PADDR SAVE PAGE BOUNDARY ADDR LDA ABSAD CMA,INA ADA PADDR CALCULATE #WORDS ON THIS PAGE CAX STA WDS1 LDA PTFWA JSB PGNO STA B CMB,INB SUBTRACT PTTN PAGE# ADB PAGE1 TO GET #PAGES OFFSET ADB PTSPG AND OFFSET FROM FIRST PAGE OF PTTN INB (B) = PHYSICAL PAGE # AFTER COUNTING BP * LDA ABSAD CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD (A) = ADDR OF RECORD IN INPUT BUFFER JSB MAPMV PERFORM MAPPING WORD MOVE * LDA PAGE2 SET UP TO MOVE SECOND PART ALF,ALF RAL,RAL CONVERT PAGE# TO ADDR CMA,INA SUBTRACT FROM END ADDR ADA ABSEN TO GET # WORDS INA CAX (X) = # WORDS TO MOVE LDA PTFWA JSB PGNO STA B CMB,INB SUBTRACT FIRST PAGE OF PTTN ADB PAGE2 TO GET #PAGES OFFSET ADB PTSPG ADD TO PTTN FIRST PAGE INB (B) = PAGE # LDA PADDR CAY (Y) = LOGICAL ADDR FOR RECORD LDA DABSD ADA WDS1 (A) = ADDR OF ABS REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * SAMEP LDA PTFWA JSB PGwNO STA B CMB,INB ADB PAGE1 INB ADB PTSPG SAMEM LDA ABSSZ CAX (X) = #WORDS LDA ABSAD CAY (Y) = LOGICAL ADDR IN PTTN LDA DABSD (A) = ADDR OF REC IN INPUT BUFFER JSB MAPMV DO MAPPED MOVE JMP ABS0 GO READ MORE * BPMAP LDB PTSPG JMP SAMEM * * PGNO NOP CONVERT ADDR TO PAGE # AND B76K ALF,RAL RAL JMP PGNO,I RETURN (A)=PAGE # (B)=UNCHANGED * * (A) = ADDR OF ABS REC IN INPUT BUFFER * (B) = PAGE # OF PARTITION * (X) = # WORDS TO MOVE * (Y) = LOGICAL ADDR FOR ABS IN PTTN * MAPMV NOP MAPPED MOVE ROUTINE STA MAPFR TO MOVE ABS RECS TO PTTN CYA STA LOGSA SAVE LOGICAL ADDR CXA STA NWDS SAVE # WORDS * CLA,INA CAX (X) = 1 REGISTER TO SET UP LDA MAPPG (A) = MAP REGISTER # JSB $LIBR TURN OFF MEM PROT NOP SO WE CAN CHANGE MAP, ALSO MOVE TO BP XMS (B) = PTTN'S PAGE # LDA LOGSA CONVERT LOG ADDR TO PAGE# AND B76K CMA,INA ADA LOGSA OFFSET INTO PAGE ADA PAGBF MAKE LOGICAL ADDR FOR MAPPED MOVE STA B (B) = ADDR OF DUMMY BUFFER FOR MOVE LDA NWDS CAX (X) = #WORDS TO MOVE LDA MAPFR (A) = ADDR OF ABS REC IN BUFFER MWI MOVE WORDS VIA DUMMY BUFFER IN SYS MAP JSB $LIBX DEF MAPMV RETURN * MAPFR NOP ADDR OF ABS REC IN BUFFER LOGSA NOP LOGICAL ADDR OF ABS REC IN PTTN MAPPG DEC 31 LAST PAGE IN SYSTEM MAP PAGBF OCT 76000 ADDR OF DUMMY BUFFER FOR CROSS MAP STORE NWDS NOP #WORDS TO MOVE PADDR NOP PAGE BOUNDARY ADDR B1777 OCT 1777 B76K OCT 76000 C100K OCT 77777 CURPT NOP ADDR OF CURRENT PTTN OWNER PTR PAGE1 NOP PAGE # OF FIRST PART OF REC PAGE2 NOP PAGE # OF SECOND PAR1T OF REC ABSEN NOP ADDR OF LAST WORD IN REC PT#PG NOP #PAGES IN PTTN PTFWA NOP LOGICAL ADDR OF FIRST WORD IN MAIN OF PTTN PTLWA NOP LOGICAL ADDR OF LAST WORD IN MAIN OF PTTN PTSPG NOP PAGE # OF FIRST PAGE IN PTTN PTTN# NOP PTTN # WDS1 NOP # WORDS IN FIRST PAGE OF REC DCRID DEF CURID * * PTMN LDA DMAIN GET PTRS TO MAIN HI/LO RSS GO CHECK BOUNDS OF REC * PTBP LDA DBASE GET PTRS TO BP HI/LO STA TEMP4 JMP ABS6 GO CHECK BOUNDS OF REC * ******* END DMS CODE *************** XIF SPC 1 * * B240 OCT 240 CONWD NOP CONTROL WORD FOR EXEC CALL * * LDMRP LDA DABSD SET UP BUFFER LDB ABSAD SET UP CORE ADDR. JSB SYSET PUT INTO CORE. DEF ABSSZ JMP ABS0 GO GET ANOTHER RECORD * * * * PROCESS SPECIAL TRAILER RECORDS. * * ABS12 NOP RSS-ED AFTER SSGA SET UP. JMP AB12C AB12D RSS NOP-ED AFTER 1ST ENTRY.! JMP AB12B SO ONLY DO THIS ONCE. LDA MD28 STA TEMP1 SET COUNTER LDB DDMID TO CLEAR OUT CLA AB12A STA B,I SPECIAL RECORDS INB ISZ TEMP1 JMP AB12A STA AB12D NOP SWITCH * AB12B LDA WORD1 CPA DWRD2 ALL DONE ALREADY? JMP IDERR ERROR ON TRAILER RECORDS DLD ABSD1 PICK UP 2 DATA WORDS STA WORD1,I PUT 1ST INTO DUMMY ID. STB WORD2,I PUT 2ND INTO DUMMY ID. ISZ WORD1 BUMP DUMMY ID ISZ WORD2 LOCATIONS. JMP ABS0 * * MPFT# 0-PRP NO COM, 1-MRP NO COM, 2-RT COM, 3-XXX, 4-SSGA * AB12C LDA RSS STA ABS12 SET RSS IN THE SSGA SWITCH CLB,INB PREPARE FOR FUNC=1 FOR MRP LDA ABSD1 FIRST SPECIAL RECORD RAL,CLE,SLA,ERA SIGN BIT 0-MRP, 1-PRP INB NOT MEM RES, SET FUNC=2 FOR PTTN LOAD STA MPFT# HAS MPFT INDEX STB FUVNC OVERRIDE FUNC WITH ABS TYPE SEZ,RSS IS IT MEMORY RESIDENT? JMP ABS0 YES, READ NEXT RECORD SPC 1 IFN * BEGIN NON-DMS CODE *************** JMP IDERR M1 OR M2 DOESN'T ALLOW PRP *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** LDA PGPT JSB PGNO CMA,INA INA STA PT#PG SAVE NEG #PAGES-1 CCB ADB $MATA (B) = ADDR OF #PTTNS LDA PGPT AND B77 GET PTTN # SZA,RSS SPECIFIC PTTN# WANTED? JMP PTFND NO, FIND A FREE ONE * ADA M1 SAVE PTTN# - 1 STA PTTN# CMA ADA B,I SUBTRACT FROM #PTTNS CMA SSA,RSS ANY ERROR? JMP ER.PT YES, NO SUCH PTTN * LDA PTTN# 6*(PTTN#-1)+$MATA MPY D6 IS ADDR OF ENTRY IN MAP TABLE ADA $MATA ADA D2 INDEX TO ID OF PTTN OWNER LDB A,I SZB IS PTTN FREE? JMP PTTNO NO, PTTN IS OCCUPIED * LDB A ADB D2 INDEX TO RESERVED FLAG LDB B,I AND PTTN SIZE WORD RBL,CLE,ERB KEEP RESERVE FLAG IN (E) ADB PT#PG CCE,SSB PTTN LARGE ENOUGH? JMP PT.SZ * PTFR LDB PTTN# RBL,ERB SET SIGN BIT FROM (E) STB PTTN# FOR PARTITION REQUESTED STA CURPT SAVE CURR PTTN OWNER PTR LDB A ADB M2 BACK UP TO LINK WORD LDB B,I SSB IS PTTN DEFINED? JMP ER.PT NO. GIVE 'PTN' ERROR * INA LDB A,I STB PTSPG SAVE PTTN START PAGE # INA LDB A,I STB PT#PG SAVE #PAGES IN PTTN JMP PTADR NOW FIND HI ADDR OF PTTN * PTTNO ADB D12 INDEX B TO ADDR OF NAME LDA ERR14 PTTN OCCUPIED JSB ERROR -PTN XXXXX- ERROR MESSAGE LDB MD62 ERROR CODE JMP ERSET * PTFND CLA STA PTTN# INIT PTTN# TO 0 LDA B,I GET #PTTNS CMA,INA STA TEMP NEGATE FOR PTTN SCAN LDA $MATA ADA D2 LOOK AT EACH PTTN OWNER ID * PTNX LDB A,I SZB IS PTTN FREE? JMP PTNFD NO, PTTN NOT FOUND * LDB A ADB D2 INDEX TO SIZE WORD IN MAT ENTRY LDB B,I RBL,CLE,SLB,ERB JMP PTNFD RESERVED, KEEP LOOKING ADB PT#PG CLE,SSB,RSS ENOUGH PAGES IN THIS PTTN? JMP PTFR YES, USE THIS (E=0 TOO) * PTNFD ADA D6 NO, TRY NEXT ONE ISZ PTTN# BUMP PTTN# ISZ TEMP LOOKED AT ALL OF THEM YET? JMP PTNX NO, KEEP LOOKING * ER.PT LDB ERR14 NO SUCH PTTN OR NONE FREE JMP ERPR4 -PTN- ERROR AND ABORT * PT.SZ LDB ERR15 NOT ENOUGH PAGES IN PTTN JMP ERPR4 -PTSZ- ERROR AND ABORT * * PTADR LDA MPFT# SZA IS COMMON OR SSGA NEEDED? JMP USECM YES * LDA $ENDS GET LAST PAGE OF SYSTEM ALF,ALF RAL,RAL JMP STFWA SET UP FWA FOR USER * USECM LDA RTORG ADA RTCOM ADA B1777 AND B76K * STFWA STA PAGE1 SAVE TEMPORARILY CMA,INA LOWEST POSSIBLE LOGICAL ADDR STA B LDA ABSD2 AND B76K GET START PAGE OF USER ABS ADB A SSB USER ADDR < LOWEST LOGICAL ADDR? JMP ABS14 YES "ERR MEM" * STA PTFWA SAVE FWA OF PARTITION USER STA LMAIN SAVE FOR BOUNDS CHECK LDB PT#PG #PAGES - 1 IN PARTITION BLF,BLF RBL,RBL ADB PAGE1 COMPUTE LWA PTTN OR 77777 CMA,INA ADA B JSB PGNO STA PT#PG SAVE ACTUAL #PAGES USED ADB M1 SSB ADDR > 77777? LDB C100K YES, SET LWA = 77777 STB PTLWA LWA OF PARTITION AREA STB HMAIN SAVE FOR BOUNDS CHECK LDA D2 STA LBASE SET LOW BASE ADDR FOR BOUNDS CHECK LDA ԖNLHBPA2 INA STA HBASE SET HI BASE ADDR FOR BOUNDS CHECK JMP ABS0 DONE WITH 1ST SPECIAL, GO READ ABS * ******* END DMS CODE *************** XIF SPC 1 * * * * * REACHED END-OF-FILE ON PROGRAM INPUT * * LOAD5 LDB ABSCT CHECK IF ANY ABS SZB,RSS WAS READ YET. JMP IDERR ERROR IF NONE. LDA WORD1 SPEC REC MUST BE AT END CPA DWRD2 WAS IT ALL THERE? JMP LOAD6 YES. IDERR LDB ERR13 NO SPECIAL RECORDS, JMP ERPR4 PRINT ERR MSG/ABORT * LOAD6 DLD NAM12 NAME GIVEN IN COMMAND? SZA,RSS JMP LOAD7 NO, USE NAME FROM SPEC REC DST PNM12 YES, USE NAME FROM COMMAND LDA NAM50 GET 5TH CHAR AND LHALF STA PNM50 JMP LOAD8 WE DID DUP.CHECK ALREADY. LOAD7 JSB DUPID NAME GIVEN IN SPECIAL RECORD, DEF PNM12 CHECK FOR DUPLICATE. * LOAD8 LDB SZCOM GET SIZE OF COMMON SZB,RSS JMP LOD8A SKIP CHECK IF NO COMMON LDA FWAC GET FWA COMMON CMA SUBTR FROM ADA RTORG FWA REAL-TIME COMMON SSA,RSS FWACAVMEM? JMP LOADE YES, ERROR. * * LOD8A LDA DMAIN GET FREE AREA POINTERS STA TEMP4 FOR THE MAIN AREA DLD PRGMN GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * LDA DBASE GET FREE AREA POINTERS STA TEMP4 FOR THE BASE PAGE AREA DLD PRGBP GET FINAL BOUNDS OF PROG JSB CKBND SEE IF FIT. (IN CASE BSS USED) JMP LOADC ERROR. * * * * MOVE ID SEGMENT TO SYSTEM AREA * * LOD8B LDA PNM50 GET 5TH CHAR AND LHALF MASK OUT TYPE INA SET TO TYPE 1 IF MEM.RES. STA PNM50 SPC 1 IFN * BEGIN NON-DMS CODE *************** LDA MPFT# ALF,ALF PUT MPFT INDEX IN BITS 7-9 RAR FOR ID SEG WORD 22 STA MPFT *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** LDB FUNC CPB D1 JMP LOD8C ISZ PNM50 SET TYPE 2 IF PTTN.RES. * LDA DCRID LDB CURPT SET NEW PTTN OWNER ID JSB SYSET DEF D1 LOD8C LDA PT#PG GET #PAGES IN PTTN ALF,RAR IOR MPFT# SET MPFT INDEX IN BITS 7-9 ALF,ALF RAR IOR PTTN# SET PTTN# (BITS 0-5) AND RP (BIT 15) STA MPFT PUT WORD IN ID SEG WORD 22 ******* END DMS CODE *************** XIF SPC 1 LDB CURID INB SET UP ID SEG B-REG TO STB XB POINT TO PARAMS AREA * LDA DDMID SET UP ADDR INA FOR DATA WORDS. LDB CURID SET ADDR FOR CORE LOC. INB DON'T MOVE LINKAGE WORD JSB SYSET MOVE ID SEG DEF D27 * LDB BUFAD SET UP DONE MESSAGE LDA MSG1 WITH PROGRAM NAME MVW D3 LDA DWRD1+1 GET ADDR OF PROG NAME JSB MVNAM MOVE NAME TO MSG LDA D10 STA TEMP"3 JSB DSPLA DISPLAY MESSAGE JMP STOP END APLDR. * * * ERROR RETURNS FROM LOADING SECTION * ABS13 JSB REMER MEMORY ERROR JSB IHILO CLEAR HI,LO ADDR JMP ABS1 GO RE-ESTABLISH HI/LO. * ABS14 LDB ERR12 ABSLWAM JMP ERPR4 SO ABORT * LOADC LDA B,I GET NAM12 FROM ID SZA,RSS PROG REMOVED YET? JMP LOD8B YES. JSB REMER FINAL MEMORY ERROR JMP LOD8A CHECK AGAIN * LOADD LDA DBLNK NO BLANK STA MT.ID+1 ID SEG LDA A00 SET ZEROES IN MSG STA MT.ID+2 LDA D11 LDB MT.ID SET UP MESSAGE ERMPR JSB STUFP PRINT MESSAGE LDB TEMP,I GET ERROR CODE FOR ANY CALLER * ERSET STB ERTYP SAVE ERROR CODE FOR "PRTN" CALL JMP ABORT THEN ABORT. * LOADE LDB ERR11 ABS USED TOO MUCH COMMON ERPR4 LDA D2 GET COUNT TO JMP ERMPR PRINT ERR MSG, ABORT SKP * **************************** * SUBROUTINES USED IN LOAD AND ABSOLUTE RECORD PROCESSORS * **************************** * * DUPID CHECKS FOR DUPLICATE PROGRAM NAME, ISSUES ERROR * MESSAGE AND ATTEMPTS TO CHANGE PROGRAM NAME. ABORTS IF * STILL NOT UNIQUE. * JSB DUPID * DEF PNAME * * DUPID NOP SEARCH FOR DUPLICATE LDA DUPID,I ID NAME. STA DUPNM SAVE ID NAME. ISZ DUPID DUP1 JSB STRID INIT ID SCANNER. DUP2 JSB SRCID FIND ID SEG DUPNM NOP WITH SAME NAME JMP DUPID,I NO DUPLICATE. JMP DUP2 REPEAT TIL DONE. LDA ERR02 DUPLIC. PROG ERR LDB DUPNM JSB ERROR LDB MD61 * LDA C.. CHANGE NAME ONLY ONCE CPA DUPNM,I IF NAME ALREADY CHANGED, JMP ERSET THEN ABORT, ERROR -61 STA DUPNM,I ELSE SEARCH AGAIN. CLB,INB STB ERTYP RETURN A +1 FOR RENAME JMP DUP1 * * **\ ************************** * * SYSET SETS WORDS INTO CORE LOCATIONS * LDA ADDFR * LDB ADDTO * JSB SYSET * DEF COUNT * * SYSET NOP SYSTEM WORD SETTER. JSB $LIBR TURN OFF THE NOP INTER. SYS. STA IHILO SAVE (A) TEMPORARILY LDA SYSET,I GET ADDR OF COUNT STA SYSCT SET COUNT ADDR LDA IHILO RESTORE (A) SPC 1 IFN * BEGIN NON-DMS CODE *************** JSB .MVW STORE WORD INTO SYS. DEF SYSCT NOP *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** MVW SYSCT ******* END DMS CODE *************** XIF SPC 1 SYSCT EQU *-2 ISZ SYSET JSB $LIBX RESTORE INTER SYS DEF SYSET AND RETURN. * * *********************************** * * IHILO INITIALIZES DEFAULT HIGH AND LOW BOUNDS * OF FREE MEMORY. * JSB IHILO * * IHILO NOP INITIALIZE HI/LO ADDRS LDA BKLWA TO FIND HIGHEST STA HMAIN AND LOWEST LDA B1647 STA HBASE ADDRS OF UNUSED LDA RTORG CORE WHICH MAY BE STA LMAIN USED FOR LOADING LDA BPA1 STA LBASE ABS PROGRAMS CLA STA LMID STA HMID STA LBID STA HBID JMP IHILO,I RETURN * * ******************************* * * CKBND CHECKS PROGRAM BOUNDS AGAINST THAT OF FREE * CORE (TEMP4 POINTS TO FREE CORE POINTERS). * LDA PRGLO LOW ADDR OF CORE USED * LDB PRGHI HI ADDR * JSB CKBND * * * CKBND NOP CHECK BOUNDS OF PROG DST TEMP AGAINST BOUNDS OF FREE CORE DLD TEMP4,I GET LFREE CMA,INA SUBTR FROM ADA TEMP LOW ADDR SSA ADDR>=LFREE? JMP CKBND,I NO, ERROR * LDA TEMP4 ADA D2 DLD A,I GET HFREE CMA SUBTR FROM ADA TEMP1 HI ADDR. SZA ADDR <= SSA HFREE? ISZ CKBND RETURN TO P+2 IF NO ERROR JMP CKBND,I RETURN TO P+1 IF ERROR * * ************************** * * REMER ISSUES "REM XXX" ERROR MESSAGE IF NEED TO REMOVE * A PROGRAM TO GET SPACE IN CORE, THEN SUSPENDS APLDR. * IF SPACE BELONGS TO THE SYSTEM, APLDR IS ABORTED. * LDB PNAME PROG WHICH MUST BE REMOVED * JSB REMER * * REMER NOP -REM XXXXX- ERROR SZB,RSS MEMORY ERROR. JMP ABS14 OUTSIDE AVAILABLE MEM LDA ERR01 GIVE -REM XXXXX- MESSAGE JSB ERROR LDA ERLUF LDB MD60 SSA REMOTE SCHEDULE? JMP ERSET YES, RETURN ERROR = -60 * JSB EXEC CALL EXEC DEF *+2 TO SUSPEND DEF D7 THE APLDR. JMP REMER,I RETURN * * ****************************** * * MD28 DEC -28 * B17 OCT 17 B1647 OCT 1647 * * D24 DEC 24 D27 DEC 27 D64 DEC 64 * BPMSK OCT 1777 C.. ASC 1,.. NAME CHANGE CHAR. * HI2 OCT 1000 ABSSZ NOP CURID NOP IDOFS NOP WORD1 NOP WORD2 NOP * * DO NOT CHANGE ORDER OF FOLLOWING * LMAIN NOP LMID NOP HMAIN NOP HMID NOP LBASE NOP LBID NOP HBASE NOP HBID NOP DMAIN DEF LMAIN ADDR OF HI/LO ADDR FOR MAIN DBASE DEF LBASE ADDR OF HI/LO ADDR FOR BASE PAGE * * DWRD2 DEF DWR2,I DWRD1 DEF *+1,I DUMMY ID ADDRESSES DEF PNM12 NAM12 DEF PNM50 NAM50/TYPE DEF RESML RESOL/MULT DEF HTIME HIGH BITS OF TIME DEF SPAR2 - SPARE - DEF PRGMN LOW MAIN DEF PRGBP LOW BASE DEF FWAC FWA COMMON DEF JMPXF JMP XFER * DWR2 DEF PNM34 NAM34 DEF PRIOR PR DEF SPAR1 - SPARE - DEF LTIME LOW BITS OF TIME DEF SEGMX SEGMX DEF PRGM2 HMAIN DEF PRGD2 HBASE DEF SZCOM SIZE COMMON DEF XFER XFER ADDR * HED PL: PROGRAM LIST * LIST PROGRAMS. * LIST EQU * IFZ ***** BEGIN DMS CODE *************** LDA PGPT SZA LIST PARTITIONS OPTION CHOSEN? JMP PTLST YES ******* END DMS CODE *************** XIF SPC 1 JSB SPACE PRINT LDA D19 HEADING. LDB HEAD1 JSB PRINT JSB SPACE * LDA DBLNK SET UP OUTPUT BUFFER. STA BUF STA BUF+7 * CLA CLEAR OUT BLANK ID SEG. STA TEMP5 COUNTER. * JSB STRID INIT ID SCANNER. LIST2 JSB SRCID SEARCH ID SEGS DEF ZERO JMP LIST7 EOF JMP LIST3 NON BLANK ID SEG ISZ TEMP5 BLANK ID SEG JMP LIST2 GO SEE NEXT ONE. * LIST3 STB TEMP1 SAVE NAME ADDR STA TEMP SAVE ID ADDR LDA 1 LDB LINE PUT PROG NAME INB INTO LINE JSB MVNAM * LDB TEMP ADB D6 GET PRIORITY LDA B,I WORD LDB .PR JSB CVDEC CONVERT AND STUFF * LDB TEMP ADB D22 GET PROG ADDRS. STB TEMP LDA M2 SET -2 TO GET STA TEMP4 MAIN AND BASE PAGE. LDB LINE INITIALIZE ADDR ADB D7 FOR NUMBER STUFFING. LIST4 LDA TEMP,I GET LOW ADDR. JSB CVOCT CONVERT TO ASCII. ISZ TEMP LDA TEMP,I GET HIGH ADDR. ADA M1 -1 TO GET REAL HIGH ADDR JSB CVOCT CONVERT TO ASCII. * ISZ TEMP ISZ TEMP4 JMP LIST4 GO GET NEXT PAIR OF ADDRS. * LDA D19 LDB LINE JSB PRINT PRINT PROG INFO. * JMP LIST2 GO GET NEXT ID SEG. * LIST7 LDA TEMP5 GET # OF, BLANK ID SEGS LDB DNM12 JSB CVDEC CONVERT AND STUFF INTO DUMMY PLACE LDA NAM50 PICK UP JUST 2 DIGITS STA MT.ID+2 AND MOVE TO MESSAGE LDA D11 LDB MT.ID JSB PRINT PRINT "# BLANK ID SEGMENTS" * DONE LDA D2 PRINT "DONE" LDB MSG1 AFTER THE "APLDR:" JMP STOP1 * ABORT LDA D4 PRINT "ABORTED" LDB ERR99 AFTER THE "APLDR:" STOP1 JSB STUFP STOP JSB DCLOS CLOSE INPUT FILE IF ANY DEF *+3 DEF DCB DEF ERR * LDA ERTYP STA MSG+6 MOVE ERROR VALUE FOR PARAMETER RETURN * RTRNP JSB PRTN RETURN ERROR CODE(,PGM NAME) DEF *+2 TO "FATHER" PGM ("EXECW") DEF MSG+6 * JSB EXEC CALL EXEC DEF *+2 TO END DEF D6 APLDR. * SPC 1 IFZ ***** BEGIN DMS CODE *************** HED PL: PARTITION LIST PTLST JSB SPACE PRINT HEADING FOR PTTN LIST LDA D16 LDB PTHED JSB PRINT JSB SPACE LDA DBLNK STA BUF+12 * CLA,INA STA PTTN# INITIALIZE FOR PTTN SCAN LDA $MATA STA CURPT SAVE ADDR OF CURR MAT ENTRY ADA M1 GET # PTTNS LDA A,I SZA,RSS CHECK - JUST IN CASE ...! JMP DONE MPY D6 ADA $MATA STA PTLWA SAVE ADDR OF LAST ENTRY * PNXPT LDA PTTN# LDB BUFAD CONVERT PTTN# AND PUT IN BUFFER JSB CVDEC LDA CURPT,I GET LINK OF MAT ENTRY SSA,RSS IS PTTN DEFINED? JMP CKRES YES, CHECK RESERVE STATUS * LDA PUNDF LDB .PTNS MVW D6 MOVE 'NOT DEFINED' MESSAGE LDA D9 JMP PRPTL AND THEN GO ON TO NEXT * CKRES LDB CURPT ADB D4 CALC ADDR OF RESERVE/SIZE WORD LDA B,I CLE,ELA (E) = RESERVE STATUS RAR AND B1777 KEEP 10 BITS #PAGES STA PT#PG LDB DBLNK USE '  ' SEZ OR LDB ASCR ' R' IF RESERVED STB PADDR INA ADD 1 TO #PAGES FOR B.P. LDB .PTNS JSB CVDEC CONVERT PTTN SIZE * LDA PADDR STA BUF+3 SET RESERVE STATUS * LDB CURPT ADB D3 ADDR OF START PAGE LDA B,I AND B1777 PAGE # IN LOW 10 BITS STA PAGE1 LDB .PTNF CONVERT FIRST PAGE# JSB CVDEC AND PUT IN MESSAGE * LDA PAGE1 ADA PT#PG LDB .PTNL CONVERT LAST PAGE# JSB CVDEC LDA DASH STA BUF+9 * LDB CURPT ADB D2 INDEX TO OWNER ID SEG LDA 1,I SZA,RSS EMPTY? JMP PTEMT YES * ADA D12 NO, INDEX TO NAME LDB .PTNP JSB MVNAM MOVE PROGRAM NAME PRPTN LDA D16 PRPTL LDB LINE JSB PRINT PRINT THE INFO ABOUT THIS PTTN * ISZ PTTN# LDA CURPT ADA D6 INDEX TO NEXT MAT ENTRY STA CURPT CPA PTLWA LAST ONE? JMP DONE YES, DONE JMP PNXPT NO, DUMP INFO ON NEXT PTTN * PTEMT LDA PTNON LDB .PTNP NO PROGRAM IN PTTN MVW D3 JMP PRPTN * D16 DEC 16 DASH ASC 1, - ******* END DMS CODE *************** XIF SPC 1 * HED SUBROUTINES FOR APLDR. * * ***************************** * * SPACE PRINTS A BLANK LINE ON LIST DEVICE. * JSB SPACE * * SPACE NOP PRINT BLANK CLA,INA LINE. LDB DFBLK (B)=ADDR OF BLANK JSB PRINT JMP SPACE,I * * ***************************** * * PRINT PRINTS A LINE ON LIST DEVICE. * LDA WORDS NO. OF WORDS * LDB ADDR ADDR OF TEXT * JSB PRINT * * PRINT NOP STA TEMP1 STB MADDR JSB DEXEC CALL REMOTE EXEC DEF *+6 TO PRINT DEF LNODE ON LIST DEVICE DEF D2I WRITE, NO-ABORT DEF LU MADDR NOP DEF TEMP1 JMP IOERR ERROR RETURN JMP PRINT,I * IOERR DST MSG+7 SAVE ASCII ERROR CODE LDA ERLUF SSA REMOTE CALL? JMP REMOT YES LDA DBLNK NO, LOCAL STA MSG+4 CLEAR MSG BUFR STA MSG+5 LDA D9 PRINT ERROR STA TEMP3 MESSAGE LOCALLY JSB DSPLA AND JMP ABORT ABORT. * REMOT LDA BIT15 INDICATE I/O ERROR STA MSG+6 JMP RTRNP RETURN PARAMETERS TO CALLER * * ******************************** * * STUFP STUFFS A MESSAGE WITH THE IDENTIFIER "APLDR:" AND * PRINTS IT ON CONSOLE. * LDA WORDS * LDB ADDR * JSB STUFP * * STUFP NOP STUFF MESSAGE INTO STB TEMP SPECIAL IDENTIFIER LDB D4 ADD 4 TO ADB A MESSAGE LENGTH STB TEMP3 FOR TOTAL LENGTH CMA,INA STA TEMP2 NEGATIVE COUNT. LDB MSG0 STFLP LDA TEMP,I STA B,I INB ISZ TEMP ISZ TEMP2 JMP STFLP JSB DSPLA DISPLAY MESSAGE JMP STUFP,I RETURN * * ****************************** * * DSPLA PRINTS A MESSAGE ON THE CONSOLE. THE MESSAGE * ADDRESS IS IN MSG AND THE WORD LENGTH IS IN TEMP3. * JSB DSPLA * * DSPLA NOP LDA ERLUF AND MSKW1 ISOLATE REMOTE FLAG & LU CPA BIT15 REMOTE, AND LU=0? JMP DSPLA,I YES, DON'T LOG THE MESSAGE RAL,CLE,SLA,ERA REMOTE? JMP RMESG YES * JSB IMESS NO DEF *+4 DEF D2 WRITE DEF MSG MESSAGE ON DEF TEMP3 OPERATOR CONSOLE. JMP DSPLA,I RETURN * RMESG ALF,ALF ALF STA MVNAM * JSB DEXEC WRITE MESSAGE TO REMOTE INITIATOR DEF *+6 }DEF LNODE DEF D2I WRITE, NO-ABORT DEF MVNAM REMOTE CONSOLE'S LU DEF MSG DEF TEMP3 JMP IOERR ERROR RETURN JMP DSPLA,I * * ****************************** * * MVNAM MOVES A PROGRAM NAME (3 WORDS) AND FILLS AN * ASCII BLANK IN THE DESTINATION NAME. * LDB DEST ADDR OF DESTINATION FOR NAME * LDA SORC ADDR OF SOURCE NAME * JSB MVNAM * * MVNAM NOP MOVE PROG NAME MVW D2 MOVE FIRST 4 CHARACTERS LDA 0,I GET 5TH CHARACTER AND LHALF PUT ASCII BLANK IOR B40 IN CHAR6 STA 1,I THEN MOVE JMP MVNAM,I RETURN * * ******************************* * * ERROR PUTS A PROGRAM NAME INTO AN ERROR MESSAGE * THEN PRINTS IT ON THE CONSOLE. * LDA ERRAD ADDR OF ERROR MESSAGE * LDB PNAME ADDR OF PROGRAM NAME * JSB ERROR * * ERROR NOP PUT NAME INTO STB TEMP5 ERR MSG THEN DLD A,I PRINT IT BUFAD EQU *+1 DST BUF MOVE ERR MSG TO OUTPUT AREA LDA TEMP5 GET ADDR OF NAME LDB LINE2 TO PUT INTO MSG JSB MVNAM LDA D9 STA TEMP3 SET LENGTH FOR JSB DSPLA DISPLAY JMP ERROR,I RETURN * * ***************************** * * STRID INITIALIZES ID SEGMENT SEARCH ROUTINE. * * STRID NOP INITIALIZE ID SCANNER. LDA KEYWD GET KEYWORD ADDRESS STA ADRID STORE AS ID ADDRESS. JMP STRID,I RETURN * * ***************************** * * SRCID FETCHS AN ID SEGMENT AND SEES IF MATCH/NO MATCH/BLANK. * JSB SRCID * DEF PNAME ADDR OF NAME TO SEARCH FOR * * * * A CONTAINS ADDR OF ID SEGMENT I * B CONTAINS ADDR OF NAME IN ID SEGMENT * SRCID NOP SEARCH ID SEGMENTS LDA SRCID,I FOR A CERTAIN NAME. STA TEMP1 SAVE ADDR OF NAME ISZ SRCID SET RETURN AT P+2 LDB ADRID,I PICK UP AN ID ADDR SZB,RSS IS IT END OF ID SEGS? JMP EOFID YES ADB D12 BUMP TO NAME IN ID STB TEMP2 SAVE ADDR OF NAME LDA B,I CPA TEMP1,I CHECK NAME 1,2 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I CPA TEMP1,I CHECK NAME 3,4 INB,RSS MATCHES. JMP NOMAT NO MATCH. ISZ TEMP1 LDA B,I AND LHALF STA STRID SAVE TEMPORARILY LDA TEMP1,I AND LHALF CPA STRID COMPARE NAME 5 ISZ SRCID MATCHES, SET RETURN P+4 * NOMAT ISZ SRCID NO MATCH, RETURN P+3 LDA ADRID,I READY FOR RETURN. ISZ ADRID LDB TEMP2 EOFID JMP SRCID,I RETURN. * * ***************************** * SUBROUTINE: CVOCT (CONVERT 15-BIT BINARY NUMBER * TO 6-CHAR (LEADING BLANK) ASCII FORM OF OCTAL NUMBER * CALLING SEQUENCE: * (A)-BINARY VALUE FOR CONVERSION * (B)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (P) JSB CVOCT * (P+1) (RETURN): * (A) DESTROYED. * (B) ADDRESS OF NEXT STORAGE * CVOCT NOP CLE (E) = 0 FOR OCTAL JSB CVT CALL CONVERSION AND STUFF ASCII JMP CVOCT,I RETURN * * SUBROUTINE: CVDEC CONVERTS BINARY TO DECIMAL ASCII * CALLING SEQUENCE: SAME AS CVOCT * * CVDEC NOP CCE (E) = 1 FOR DECIMAL CONVERSION JSB CVT CONVERT AND STUFF ASCII JMP CVDEC,I RETURN * * CVT NOP JSB $LIBR GO PRIVILEGED NOP STB ADDR SAVE ADDR JSB $CVT3 CALL SYSTEM'S ROUTINE LDB ADDR MVW D3 MOVE 3 ASCII WORDS JSB $LIBX RETURN DEF CVT * ADDR NOP SKP * CONSTANTS AND STORAGE. * UNS M1 DEC -1 M2 DEC -2 * D1 OCT 1 D2 OCT 2 D2I OCT 100002 D4 OCT 4 D6 OCT 6 D7 OCT 7 B40 OCT 40 * D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D19 DEC 19 D22 DEC 22 * A00 ASC 1,00 MSKW1 OCT 101760 BIT15 OCT 100000 LHALF OCT 177400 ZERO OCT 0,0,0 ADRID NOP LU NOP ERR NOP MPFT# NOP MEMORY PROTECT FENCE INDEX VALUE * TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP TEMP5 NOP LEN NOP ERTYP NOP * ERLUF NOP 5-WORD TABLE. PGPT NOP DO NOT RE-ARRANGE! NAM12 NOP NOP NAM50 NOP * DCB BSS 4 SKP * MESSAGES FROM APLDR WITH LOVE. * * ERR01 DEF *+1 REMOVE PROGRAM TO BE OVERLAYED ASC 2,REM MD60 DEC -60 * ERR02 DEF *+1 DUPLICATE PROGRAM NAME ASC 2,DUP MD61 DEC -61 * ERR10 DEF *+1 CHECKSUM ERROR ASC 2,CKSM DEC -66 * ERR11 DEF *+1 COMMON AREA OVERFLOW ASC 2,COM DEC -67 * ERR12 DEF *+1 MEMORY OVERFLOW ASC 2,MEM DEC -68 * ERR13 DEF *+1 IDENTIFICATION RECORDS MISSING OR WRONG ASC 2,ID? DEC -65 * ERR99 DEF *+1 APLDR IS ABORTED ASC 4,ABORTED * * QUEST ASC 10, LOAD FILE'S NODE? __ * MSG1 DEF *+1 ASC 3,DONE- LDASH EQU *-1 "- " * * MT.ID DEF *+1 ASC 11, 00 BLANK ID SEGMENTS MD64 DEC -64 DBLNK EQU MT.ID+1 DOUBLE BLANK WORD DFBLK DEF DBLNK * HEAD1 DEF *+1 ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE * SPC 1 IFZ ***** BEGIN DMS CODE *************** ERR14 DEF *+1 NO FREE PARTITION ASC 2,PTN MD62 DEC -62 * ERR15 DEF *+1 PARTITION NOT LARGE ENOUGH ASC 2,PTSZ DEC -63 * PUNDF DEF *+1 ASC 6, NOT DEFINED * PTNON DEF *+1 ASC 3, PTHED DEF *+1 ASHFBC 16, PTN# R SIZE PAGES PROGRAM ASCR EQU PTHED+4 .PTNS DEF BUF+3 .PTNF DEF BUF+6 .PTNL DEF BUF+9 .PTNP DEF BUF+13 ******* END DMS CODE *************** XIF SPC 1 .PR DEF BUF+4 * DABSD DEF ABSBF+2 DDMID DEF DMYID LINE DEF MSG+4 LINE2 DEF MSG+6 MSG0 EQU LINE * MSG ASC 9, APLDR: BUF EQU MSG+4 * ABSBF BSS 64 * ABSCT EQU ABSBF ABSAD EQU ABSBF+1 ABSD1 EQU ABSBF+2 ABSD2 EQU ABSBF+3 * DMYID EQU ABSBF+35 SPAR2 EQU DMYID-5 JMPXF EQU DMYID-4 SPAR1 EQU DMYID-3 FWAC EQU DMYID-2 SZCOM EQU DMYID-1 PRIOR EQU DMYID+6 XFER EQU DMYID+7 XB EQU DMYID+10 PNM12 EQU DMYID+12 PNM34 EQU DMYID+13 PNM50 EQU DMYID+14 RESML EQU DMYID+17 HTIME EQU DMYID+18 LTIME EQU DMYID+19 MPFT EQU DMYID+21 PRGMN EQU DMYID+22 PRGM2 EQU DMYID+23 PRGBP EQU DMYID+24 PRGD2 EQU DMYID+25 SEGMX EQU DMYID+26 * * BSS 0 SIZE OF APLDR * * END APLDR 'H  91740-18019 1913 S C1022 DS/1000 MODULE: LOADR              H0110 beASMB,L,C,Z *LOADR USE 'ASMB,R,N' (RTE-II) OR 'ASMB,R,Z' (RTE-III) * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * HED RELOCATING LOADR FOR RTE-III <1913> NAM LOADR,3,90 91740-16019 REV 1913 780811 ENT LOADR EXT $ENDS,$MATA,NAMR,$SGAF EXT REIO,OPEN,CLOSE,READF,$CVT3 EXT LOCF,APOSN,WRITF,CREAT EXT IFBRK ******* END MEU CODE ********** XIF * UNL IFN ******* BEGIN NON-MEU CODE **** LST * NAME: RTE LOADER * SOURCE: 92001-18002 * RELOC: 92001-16002 * PGMR: P. KAPOOR, E. WONG, M. MANLEY(CMM) * UNL ******* END NON-MEU CODE ****** XIF IFZ ******* BEGIN MEU CODE ******** LST * NAME: RTE LOADER * SOURCE: 92001-18002 * RELOC: 92060-16004 * PGMR: M. MANLEY (CMM) * UNL ******* END MEU CODE ********** XIF LST SUP EXT EXEC,$LIBR,$LIBX,PRTN * SKP * LIST OF LOADR ERROR DIAGNOSTICS * * * = MODULE NAME PRINTED BEFORE DIAGNOSTIC * **= ENTRY POINT NAME PRINTED AFTER MODULE NAME * * 01 * - CHECKSUM ERROR * 02 * - ILLEGAL RECORD * 03 * - MEMORY OVERFLOW (YOUR PROGRAM IS TOO LARGE) * 04 * - BP LINKAGE OVERFLOW (TRY REARRANGING THE SUBROUTINES) * 05 * - SYMBOL TABLE OVERFLOW (GIVE THIS LOADR MORE ROOM) * 06 * - COMMON BLOCK ERROR (WAS THE 1ST COM DECL THE LARGEST ?) * 07 * ** - DUPLICATE ENTRY POINTS (YOU PUT THE SUBROUTINE IN TWICE) * 08 - NO TRANSFER ADDR (ONLY SUBROUTINES WERE LOADED WHERE'S THE MAIN?) * 09 * - RECORD OUT OF SEQUENCE (DID YOU POSITION THE TAPE CORRECTLY ?) * 10 - ILLEGAL KPARAMETER IN RU STATEMENT. * 11 - ATTEMPT TO REPLACE A CORE RESIDENT PROG (A MEM RES PROG W/SAME NAME) * 14 * - ASMB PRODUCED ILLEGAL RELOCATABLE . A DBL REC * WAS PRODUCED REFERING TO AN EXTERNAL WHICH WAS NOT DEFINED. * IE, I SHOULD HAVE FOUND IT IN MY SYMBOL TABLE BUT I DIDN'T * 16 - ILLEGAL PARTITION NUMBER OR CORRUPT MAP TABLE. * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. * 18 - TOTAL NUMBER OF PAGES REQUIRED EXCEEDS 32. * 23 - ATTEMPT TO PLACE A SEGMENTED PROGRAM IN A REAL TIME PARTITION. * 24 - ATTEMPT TO ACCESS AN SSGA ENTRY POINT BUT SSGA ACCESS * WAS NOT DECLARED AT THE BEGINING OF THE LOAD. * 25 - ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO * USE THE LI OR PU COMMANDS WITHIN A TRANSFER FILE. * LI & PU MAY BE USED IN THE INTERACTIVE MODE BUT * WILL NOT BE HONORED WHEN ENCOUNTERED WITHIN A FILE. * SKP * SPC 1 SKP * * LOADING OF PROGRAMS WITH THE RELOCATABLE LOADER CONSISTS OF * (1) LOADING PROGRAMS FROM THE INPUT UNIT * (2) LOADING PROGRAMS FROM THE PROG LIB * THE FIRST PROGRAM WITH A PRIMARY ENTRY POINT IS CONSIDERED * TO BE THE MAIN PROGRAM. AT LEAST ONE MAIN PROG MUST BE LOADED * BEFORE THE LIBRARY IS LOADED. LINKAGES FROM THE MAIN PROG * TO ALL USER AND LIB SUBROUTINES IS DETERMINED BY ENTRIES * IN THE LOADER SYMBOL TABLE (LST). * * EACH LST ENTRY CONSISTS OF 5 WORDS: * * ************************************************************* * * NAME - * NAME - * NAME - *ENT/EXT FLG* * * * CHARS 1,2 * CHARS 3,4 * CHAR 5/ * 'V' BIT * * * * * * ORDINAL * ENT TYPE * SYMB VALU * * ************************************************************* * * EACH WORD IN THE LST ENTRY CONSISTS OF THE FOLLOWING: * * WORD 1: SYMBOL NAME - ASCII CHARACTERS 1,2 * BIT 15 = 1 MEANS THE ENTRY HAS BEEN LISTED * BIT 15 = 0 MEANS THE ENTRY HAS NOT BEEN LISTED * WORD 2: SYMBOL NAME - ASCII CHARACTERS 3,4 * WORD 3: (8-15) SYMBOL NAME - ASCII CHARACTER 5 * (0-7) EXT ORDINAL * WORD 4: ORGANIZED INTO FOLLOWING THREE FIELDS - * STATUS FIELD (BITS 0 TO 6) - INDICATES STATUS * OF THE SYMBOL AS FOLLOWS: * 0 - ENT SYMBOL READ DURING LIB SCAN (COULD BE * FROM RES LIB, RELOC LIB ON DISC OR USER * GIVEN LIB). * 1 - ENT SYMBOL READ DURING FORCE LOADING OF USER * PROGRAM. * 2 - EXT ENTRY (UNDEFINED SYMBOL). * NOTE THAT STATUS OF A SYMBOL CHANGES FROM 2 TO * 0 OR 1 AS IT BECOMES DEFINED. * 'V' BIT (BIT 7) - WHEN SET THEN WORD 5 HAS THE * THE ADDRESS OF THE BASE PAGE LINK, ELSE WORD 5 * HAS SYMBOL VALUE (VALUE OF ENT AFTER RELOCATIONA). * ENT TYPE (BITS 8 TO 15) - IS 0 FOR EXT ENTRY AND * 0 TO 4 (RELOCATION INDICATOR) FOR ENT SYMBOL. * WORD 5: BASE PAGE LINKAGE ADDR IF 'V' BIT IS SET * ELSE SYMBOL VALUE . * * INITIALLY, THE LOADER SYMBOL TABLE CONSISTS OF THE ENTRY POINTS * FOR THE LIBRARY ROUTINES IN THE RESIDENT LIB AND THE * SYSTEM ENTRY POINTS (TYPE 1 ENT NOT PICKED UP). AS EACH * USER PROGRAM IS LOADED AND ENT/EXT RECS PROCESSED, SYMBOLS * ARE ADDED TO THE LIST. WHEN ALL USER PROGS HAVE * BEEN LOADED, AND LIB LOADING IS INITIATED, THE LOADER * SCANS LST FOR UNDEFINED SYMBOLS AND MATCHES THESE WITH THE * ENT SYMBOLS IN LIBRARY DIRECTORY. ON FINDING A MATCH, THE * LOADER LOADS THE CORRESPONDING LIB PROG AND ADDS ITS * ENT'S AND EXT'S TO THE LST. THIS PROCEDURE CONTINUES UNTIL ALL * UNDEFINED SYMBOLS HAVE BEEN DEFINED OR A COMPLETE PASS THROUGH * THE DIRECTORY FAILED TO RESOLVE ANY EXTERNAL . * FOR MAIN/SEGMENT LOAD, IF UNRESOLVED SYMBOLS STILL REMAIN * THEN THE ENTIRE LG AREA IS SCANNED FOLLOWING WHICH THE DISC * LIBRARY DIRECTORY IS AGAIN SCANNED - IF NEED BE. IF ANY * SYMBOL STILL REMAINS UNDEFINEڪD AFTER THIS THEN IT LISTED * - EXCEPT FOR UNDEFINED SYMBOLS IN MAIN - AND THE LOADER * SUSPENDS. * IF THE LOADER IS OPERATING UNDER BATCH, ALL OUTPUT * THAT NORMALLY COMES ON THE SYSTEM CONSOLE GETS LISTED * ON LU 6. * * THE LST IS ORIGINED AT THE UPPER END OF THE LOADER AND EXTENDS * TOWARD HIGH CORE. AN IRRECOVERABLE ERROR IS DETECTED IF LST * EXTENDS PAST THE LAST WORD OF AVAILABLE MEMORY. * IN CASE OF ERROR THE LOADER PRINTS THE NAME OF THE MODULE * IN WHICH THE ERROR OCCURED, FOLLOWED BY THE ERROR CODE. * IN CASE OF ERRORS 7 & 15 , NAME OF THE ENTRY POINT CAUSING * THE VIOLATION IS ALSO PRINTED FOLLOWING THE MODULE NAME. * SKP * IIILU DEC 19 DEBUG LU IPBUF BSS 10 OUTPUT PARSED BUFFER STRNG BSS 40 INPUT STRING BUFFER SLONG NOP STRING LENGTH IN CHARS DONE? NOP =1 WHEN INPUT PRAMS CHECKED OUT * F3 DEF FILE3 FILE3 OCT 206 NOP NOP TYPE3 NOP F3SC NOP F3DSC NOP * PLIST DEC 2 BATCH NOP BATCH FLAG 0=NO /-1 = YES SKP.1 NOP SKIP FLAG (SKIP IF WE REREAD LAST COMMAND) N80 DEC -80 P16 DEC 16 P23 DEC 23 * * MOVE OR REARRANGE THESE BUFFERS AT YOUR EVERLASTING PERIL !!!!! * IDCB3 BSS 144 NOP TEMP. LEAVE IN FRONT OF MBUF MBUF BSS 66 NAM REC BUFFER MBUF1 EQU MBUF+1 IDCB1 BSS 16 DCB HEADER FOR RELO FILE XBUF BSS 128 DCB & READ BUFFER FOR LU & SYS LIB READS SBUF BSS 128 DCB & DIRECTORY BLOCK READ BUFFER LBUF BSS 64 RELO RECORD PROCESS BUFFER DBUF BSS 128 ABSOLUTE OUTPUT BUFFER IDCB2 BSS 144 SGNAM BSS 60 SEGMENT NAM RECORD BUFFER MVBUF BSS 13 ID INFO TO BE MOVED INTO SYS ID AREA .BUF EQU * END OF BUFFERS IN OVERLAYED CODE SKP * * ORG IDCB3 * *IIILU DEC 28 * *THIS SECTION OF THE LOADR RETRIEVES THE RUN STRING AND PARSES THE *INPUT. ONLY MIMIMAL ERROR CHECKING IS DONE. THIS MEANS THAT *FINAL ERROR CHECKING OF ALL ERROR CONDITION3S IS DONE ONLY AFTER *THE INPUT FROM THE COMMAND FILE IS READ. THIS ALLOWS GROSS ERRORS *TO BE MADE ON THE RUN STATEMENT BUT CORRECTED IN THE COMMAND FILE. *IN ADDITION IT MEANS COMMAND FILES WILL HAVE THE LAST WORD ON *HOW A PROGRAM IS LOADED. THUS A COMMAND FILE COULD BE SET UP TO *KEEP INEXPERIENCED USERS FROM HURTING THEMSELVES, THE SYSTEM, OR *OTHER USERS. I HATE TO USE THE WORD BUT IT IS VERY (UGH) FRIENDLY. * * * CALCULATE THE BLOCK NUMBER WHERE THE LIB DIRECTORY STARTS * AND THE POSSIBLE OFFSET IN NUMBER OF ENTRYS TO ACCOUNT FOR * AN ODD STARTING SECTOR. * WE DO THIS HERE BECAUSE IT IS OVERLAYABLE SPC 1 LOADR LDA B,I GET THE DEFAULT LU SZA STA DFTLU AND SAVE * LDA DSCLB GET DISC ADDR OF LIB DIRECT. AND M177 GET SECTOR NUMBER STA BLOK# AND SAVE TEMP XOR DSCLB GET TRACK NUMBER ALF,ALF AND POSITION RAL RIGHT JUSTIFIED MPY SECT2 MULYPLY BY SECTORS/TRACK ADA BLOK# AND ADD INTO SECTOR NUMBER CLE,ERA PRODUCE BLOCK NUMBER STA BLOK# AND SAVE FOR "GTENT" CLA,SEZ NOW SET ENTRY OFFSET NUMBER ADA P16 EQUAL TO 0 OR 16 STA OEFL1 AND SET FOR "GTENT" * * * JSB EXEC GET THE RUN STRING DEF *+5 DEF P14 DEF P1 THIS IS A GET NOT A PUT DEF STRNG ADDRESS OF 40 WORD STRING BUFFER DEF N80 LENGTH OF STRING (NEG CHAR LENGTH) * STB SLONG SLONG = STRING LENGTH IN + CHARACTERS * JSB NAMRR PARSE TWICE TO GET RID OF THE RU AND JSB NAMRR THE LOADR. WE NOW HAVE PARAMETERS. * * JSB NAMRR NOW GET THE COMMAND FILE NAME SSA,RSS END OF STRING ? JMP GTCMD NO * LDA DFTLU YES, NO STRING. GET THE DEFAULT LU STA IPBUF PUT INTO PARSE BUFFER CLA,INA SET TYPE WORD TO LU (NOT A FILE) STA IPBUF+3 * GTCMD LDA N6 GET THE NEG COUNT AGAIN JSB MOVE AND MOVE THE NAME TO THE CMND NAME BUFFER DEF IPBUF SOURCE OF MOVE DEF FILE2 COMMAND FILE NAME ADDRESS LDA TYPE2 GET THE PARSE TYPE WORD AND P3 KEEP ONLY THE LEAST TWO BITS STA TYPE2 AND SAVE FOR LATER * ERA,SLA IS IT A FILE OR AN LU ? JMP GTREL FILE, SO GO GET THE REL FILE LDA FILE2 AN LU. JSB INTER SEE IF IT IS INTERACTIVE JMP GTREL NO IT NOT. * STA FILE3 IT IS, SO MAKE IT THE LIST LU IOR M200 USE COLUMN 1 STA LISTU * * GTREL JSB NAMRR NOW GET THE INPUT FILE NAME SSA END OF STRING ? JMP SEFIL YES LDA N6 NEG COUNT TO A REG FOR MOVE WORDS JSB MOVE DEF IPBUF ADDRESS OF SOURCE DEF FILE1 ADDRESS OF DESTINATION LDA TYPE1 GET TYPE OF INPUT THAT WAS PARSED AND P3 SAVE THE LEAST TWO BITS STA TYPE1 FOR A LU VERSES FILE TEST * * * LDA IPBUF+6 * SZA,RSS * JMP *+5 * STA IIILU * JSB DBUG * DEF *+2 * DEF IIILU * EXT DBUG * * * * GTLST JSB NAMRR NOW GO GET THE LIST LU SSA JMP SEFIL JMP GETOP * TRKYX EQU MBUF-* ORG MBUF LEAVE ROOM FOR IDCB3 * GETOP JSB DOLST SEE IF IT'S A FILE OR LU * JSB NAMRR NOW GO GET THE OPCODE INFO SSA JMP SEFIL LDB IPBUF GET THE 1ST OPCODE JSB TEST CHECK IT OUT LDB IPBUF+1 NOW THE NEXT ONE JSB TEST LDB IPBUF+2 AND THE LAST ONE JSB TEST * JSB NAMRR NO, GO GET FMT PARAMETERS SSA JMP SEFIL LDB IPBUF GET THE FIRST OP JSB TEST CHECK IT OUT LDB IPBUF+1 NOW DO THE JSB TEST 2ND ONE LDB IPBUF+2 AND NOW THE LAST JSB TEST ONE. * JSB NAMRR NO, GET THE PART'N NUMBER IF SUPPLIED. SSA JMP SEFIL p LDA IPBUF GET THE # STA #PTTN SAVE * JSB NAMRR NO, GET THE SIZE OF THE PROGRAM SSA JMP SEFIL LDA IPBUF STA #PGS AND SAVE * * * ******************CHECK OUT COMMAND FILE********************* * * SEFIL LDA TYPE2 GET THE TYPE WORD FOR THE COMMAND FILE SZA,RSS WAS A COMMAND FILE ENTERED ? JMP CNFLT NO, SO GO CHECK OUT THE INPUT STRING ERA,SLA YES, BUT IS IT A FILE OR A LU ? JMP FOPEN A FILE ! * LDA FILE2 AN LU. CHECK IT OUT & SEE IF INTERACTIVE JSB INTER RSS NOT INTERACTIVE ISZ DFLAG SET INTERACTIVE CMND LU FLAG IOR M400 AND SET THE ECHO BIT STA FILE2 AND SAVE FOR THE INPUT CALL THROUGH REIO * JMP *+1,I GO DO THE READ DEF LREAD (SAVE A BP LINK TOO ) * * M200 OCT 200 DFTLU DEC 1 DEFAULT LU B1777 OCT 1777 M400 OCT 400 SPC 1 * CHECK FOR ANY CONFLICT IN PARAMETERS AND THEN CHECK THE * PARAMETERS THEMSELVES. SPC 1 CNFLT ISZ DONE? MAKE SURE WE NEVER COME HERE AGAIN  LDB PTYPE GET THE PROGRAM TYPE LDA DBFLG AND THE DEBUG APPENDED FLAG SZA,RSS HAS DEBUG BEEN APPENDED JMP CHEKR TEST THE REST OF THE PARAMETERS LDA EDFLG YES, SO SEE WHAT TYPE LOAD IT IS CPA P1 IS IT A PERMANENT LOAD JMP LDI5 YES, SO DO ERROR THING CPA P2 NO, WELL IS IT A REPLACEMENT ? JMP LDI5 YES, THIS IS AN ERROR TOO. CPB P2 IS IT A REAL TIME PROGRAM ? JMP LDI5 YES, THIS IS AN ERROR(DEBUG NOT = RT PROG) * * CHEKR LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P20 (B)=ID SEG'S WORD 21 ADDR LDA B,I GET WORD 21 TO CHECK BIT 15 CCB GET A FLAG READY SSA IF LOADR RUNNING UNDER BATCH STB BATCH LDA PLIST GET THE LISTING PARAMETER SSA JMP LDI5 .m THEN INPUT ERROR ADA N4 SSA,RSS IF GREATER THAN 3 JMP LDI5 THEN INPUT ERROR. LDA FILE1 CHECK PRAM 1. CPA P1 IF INPUT IS SYS TTY, JMP LDI5 TREAT AS ERROR CPA P2 IS THIS TO THE DISK JMP LDI5 JUST WHO DO YOU THINK YOUR KIDDING?????? * LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P23 (B)=ADDR OF LOADR'S HIGH MAIN LDA B,I SET UP LOADR SYMBOL TABLE TO STA BLST START FROM LOADR'S HIGH STA PLST MAIN ADDR AND GROW UP STA TLST TOWARD HIGH CORE. STA SLST STA FLST ADB N9 (B)=ADDR OF LOADR ID'S WORD 15 LDA B,I GET LOADR'S PROG TYPE LDB RTLWA GET ADDR OF LOADR'S LAST WORD SPC 1 SLA SKIP IF LOADR IS FG LDB BKLWA ELSE GET LWA OF BG. STB BKLWR SET AS LWA AVAILABLE TO LOADR CLB .MBUF EQU *-MBUF OVERLAY PROBLEM ?? STB MBUF CLEAR "VALID MODULE NAME PRESENT" FLAG * LDA #PTTN GET THE PART'N SPECIFIED IF ANY CCB GET ADDR MAP TABLE - 1 ADB $MATA WHERE # OF PART. IS KEPT SZA,RSS WAS PTTN# SPECIFIED? JMP NOPTN NO, DO SIZE CHECK LATER SPC 2 * PARTITION WAS SPECIFIED FOR THIS PROG * LDA B,I YES, DO SIZE CHECK NOW * * CMA ADA #PTTN SSA,RSS ERR16 IF PTTN# > #PTTNS JMP ER.16 * CCA ADA #PTTN 6 * (PTTN# - 1) + $MATA MPY P6 IS ADDR OF ENTRY ADA $MATA IN MAP TABLE LDB A,I (A) IS ADDR MAP ENTRY SSB IF ENTRY NOT DEFINED, JMP ER.16 GIVE ERR16 * ADA P4 BUMP TO WORD 5 LDB A,I RBL,CLE,ERB REMOVE RESERVED FLAG STB #PGPT SAVE #PAGES IN PTTN CMB ADB #PGS ENOUGH PAGES IN SSB SPECIFIED PTTN? JMP PGSOK z YES SZB OK IF EQUAL LDB #PGS NO, BUT WAS SPECIFIC SZB SIZE REQUESTED? JMP ER.17 YES, CAN'T FIT! * PGSOK INA GET TO TYPE PARTITION LDA A,I PULL IT IN LDB P2 GET RT PROG TYPR SSA RT PROG STB PTYPE MAKE THE PROG RT . * CCA ADA #PGS SUBT 1 FROM #PGS REQUESTED SSA ANY REQUESTED? LDA #PGPT NO, USE SIZE OF PTTN STA #MXBG SET AS MAX SIZE STA #MXRT OF QUALIFIED AREAS JMP CMMST NOW SET UP COMMON STUFF * * * NO PARTITION WAS SPECIFIED FOR THIS PROG * NOPTN LDA B,I NO PTTN SPECIFIED CMA,INA,SZA,RSS FIND MAX OF EACH TYPE JMP ER.16 ERROR IF NO PTTNS DEFINED STA WDCNT SAVE NEG # PTTNS INB NXPTN STB TBUF SAVE CURR PTTN DEF ADDR LDA TBUF,I SSA IS PTTN DEFINED? JMP A6PTN NO, SKIP THIS ENTRY ADB P4 LDA B,I GET WORD 5 SSA IF RESERVED, SKIP IT JMP A6PTN CAUSE WE GOT NO RESERVATION * INB LDB B,I GET WORD 6 SSB,RSS FIND TYPE OF PTTN: JMP BGPTN LDB A RT PTTN CMB,INB ADB #MXRT RT PTTN SIZE SSB BIGGER THAN PREVIOUS MAX? STA #MXRT YES, SAVE NEW MAX JMP A6PTN CHECK NEXT PTTN DEFINITION * BGPTN LDB A BG PTTN CMB,INB ADB #MXBG BG PTTN SIZE SSB BIGGER THAN PREVIOUS MAX? STA #MXBG YES, SAVE NEW MAX * A6PTN LDB TBUF ADB P6 INCRE TO NEXT PTTN DEFINITION ISZ WDCNT SEARCH THROUGH UNTIL DONE JMP NXPTN * * CMMST LDA COMTP GET COMMON TYPE ADA #MPFT SZA ANY TYPE OF COMMON USED? JMP CMUSE YES LDA $ENDS NO COMMON USED ALF,ALF SHIFT #PAGES IN SYS RAL,RAL TO GET ADDR OF .5NEXT PAGE JMP CMNCM SET FWA USER CMUSE LDA BKORG SSGA OR COMMON ADA BKCOM WAS USED ADA B1777 USE ADDR OF NEXT PAGE AND M0760 AFTER COMMON FOR CMNCM STA URFWA SET FWA USER * RAL,RAL PUT PAGE # IN LOWER BITS ALF ADA #PGS ADD IN REQUESTED PAGE SIZE ADA N34 SUBTRACT MAX PROG SIZE SSA,RSS REQUESTED SIZE TOO LARGE ? JMP ER.18 YES, SO FLUSH THE TURKEY * LDA URFWA GET THE LOAD POINT AGAIN CCB SET PROPER LWA USER ADB #PGS #PAGES REQ'D LESS BASEPAGE SSB WAS ANY REQUESTED? JMP LEDT4 NO, DEFAULTS 77777 BLF,BLF SHIFT TO FORM PAGE ADDR RBL,RBL ADA N1 SUBT 1 AND ADD TO U.FWA ADA B FOR ADDR OF U.LWA SSA,RSS IF PAST 32K USE 77777 STA URLWA NO, SET URLWA,UBLWA ******* END MEU CODE ********** XIF SPC 1 LEDT4 LDB EDFLG GET EDIT FLAG LDA COMTP GET COMMON TYPE SZA,RSS COMMON SPECIFIED ? JMP DFLCM NO, SET DEFAULT TYPE. CPA P2 LOCAL COMMON ? JMP LCLCM YES, SET LOCAL COMMON. LDB P2 SET (B)=2 FOR SYSTEM COM CPA P3 REVERSE COMMON ? LDB P3 YES, SET REVERSE COMMON. LDA BKCOM (A) = LEN OF BG SYS COMM CPB PTYPE BG PROG ? LDA RTCOM YES, SET (A)=LEN OF FG COMM STA MXCOM SET MAXIMUM LEN OF COMMOM LDA BKORG ALSO SET ORIGIN CPB PTYPE OF THE RESPECTIVE LDA RTORG COMMON AREA. STA COMAD JMP CMEXI FINISH UP COMMON STUFF DFLCM EQU * SPC 1 SPC 1 LCLCM CCA SET LOCAL COMMON FLAG STA COMIN TO ALLOC AT NAM REC SPC 1 CLA (A)=0 IF LOCAL COMMON JMP CMLOC * SPC 1 IFZ ******* BEGIN MEU CODE ******** CMEXI LDA P3 (A)=3 IF BG COeMMON CPB PTYPE LDA P2 (A)=2 IF RT COMMON CMLOC LDB #MPFT (A)=0 IF LOCAL COMMON SZB LDA P4 (A)=4 IF SUBSYSTEM GLOBAL AREA STA #MPFT SET MPFT INDEX ******* END MEU CODE ********** XIF SPC 1 * * LDA UBFWA SET FWA USER BG DISC RES STA AFWA ORIGIN AS ABS FWA + LDA UBLWA SET UPPER STA LWA BOUND. LDA BPA3 GET FWA OF BKG BASE PAGE AREA STA BPREL SET BASE PAGE RELOCATION BASE STA BPFWA SAVE IT CMA,INA AND SUBTRACT FROM LWA OF ADA BKGBL LINK AREA. * CMA,INA CACULATE AREA SIZE IN UPPER MEMORY STA B SAVE COUNT FOR ZEROING ADA BKLWR SUBTRACT FROM END OF MEM STA FWABP SET BOUNDRY STA CWABP INITIALIZE ALLOCATION WORD STA SEGB AND SEGMENT BASE PAGE STA IDA ADDRESS OF BASE ID SEG (NONE EXIST YET) STA MBUF1 POINTER TO ZAP THE AREA WITH STA TFIX LOW END OF FIXUP TABLE (AGAIN NONE EXIST) LDA BKLWR SET LWA STA LWABP OF AREA CLA CLEAR LDI7 STA MBUF1,I DUMMY ISZ MBUF1 BASE INB,SZB PAGE JMP LDI7 AREA * LDA AFWA SET UP THE BASE LOAD ADDRESSES STA FWA FIRST WORD FOR LOAD ADA P2 ALLOCATE ROOM FOR X,Y REGS STA SEGM SEGMENT BASE STA TPREL HIGHEST USED MEMORY ADDRESS STA PPREL * LDB OPCOD GET THE LAST OPCODE CPB P4 WAS IT A 4 JMP PURGE YES SO GO PURGE THE PROGRAM * LDB EDFLG IF REPLACEMENT, CPB P2 DON'T REQUIRE A CLA,INA,RSS BLANK ID SEGMENT. CLA BLANK ID REQUIRED CLB INDICATE LONG ID JSB SETID BLANK ID SEGMENT * JSB ITRAK MAKE ALLOCATION. * CCB STB NUPLS SET NO. PROGS LOADED = -1 STB PLFLG SET `UHFBLOADING FLAG = LOADING LDA DBFLG GET DEBUG FLAG SZA,RSS SKIP - DEBUG OPTION SELECTED JMP NODBG OMIT ENTERING DEBUG INTO LST SKP * * ENTER 'DEBUG' INTO LST * JSB LSTX SET CURRENT LST ADDRES NOP LDA CHRDE GET CHARS D,E STA LST1,I SET NAME 1,2 INTO LST LDA CHRBU GET CHARS B,U STA LST2,I SET NAME 3,4 INTO LST LDA UCHRG GET UPPER CHAR G STA LST3,I SET NAME 5 INTO LST LDA P2 SET LST4 = UNDEF SYMBOL & STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. NODBG CLA STA DSECT SET CURRENT SECTOR = 0. LDA TRAKB SET CURRENT TRACK = STA DTRAK TRACK BASE. * * * LDA TYPE1 GET THE TYPE OF INPUT SZA,RSS ANY MAIN SPECIFIED ? JMP CDTST NO, GO SEE IF ANY CMND FILE LDB TYPE2 YES SZB,RSS IS THERE A CMND FILE ALSO ? JMP DMANE NO, SO JUST GO LOAD MAIN * CCB YES, SO SET A FLAG SO THAT WE KNOW STB SKP.1 TO REREAD THE LAST COMMAND JMP DMANE * N34 DEC -34 * ER.17 LDA ERR17 RSS ER.18 LDA ERR18 JMP ABOR * ERR17 ASC 1,17 ERR18 ASC 1,18 CDTST LDB TYPE2 GET CMND FILE TYPE SZB,RSS IS THERE A CMND FILE ? JMP LDI5 NO CMND FILE AND NO MAIN ???????? JMP *+1,I GO GET THE LAST COMMAND DEF SECK1 (SAVE A BP LINK TOO !) * SKP H SKP 2 *********************************************************************** * OVERLAYABLE SUBROUTINES *********************************************************************** SPC 2 * * THE TEST SUBROUTINE IS USED TO CHECK OUT AND PROCESS * ALL OPCODE AND FMT PARAMETERS. * FMT AND OPCODE MNEMONICS MAY BE INTERMIXED AND INTER- * MINGLED. ANY UNDEFINED MNEUMONIC WILL GENERATE AN * L-10 ERROR. TEST NOP SZB IF NOTHING ENTERED CPB ABLNK JMP TEST,I STB OPP SET THE ERROR RETURN CODE = INPUT CODE LDA LDOPC GET START OF OPCODE TABLE STA XTEMP AND SAVE FOR SEARCH LDA LDJMP GET JUMP ADDRESS TABLE STA YTEMP AND SAVE FOR JUMP TO APPROPRIATE PROCESSOR LOOPR CPB XTEMP,I IS THIS THE CODE JMP YTEMP,I YES, SO JUMP TO THE APPROPRIATE PROCESSOR ISZ XTEMP NO, SO BUMP THE ISZ YTEMP TWO POINTERS AND JMP LOOPR TRY AGAIN. * LDOPC DEF *+1 ADDRESS OF START OF TABLE ASC 15,LIPUBGRTSCRCNCSSDBPETERPRSLENL OPP NOP ERROR CODE LDJMP DEF *+1,I HEAD OF JUMP TABLE DEF DO3 LIST OPERATION DEF DO4 PURGE OPERATION DEF BG BG PROGRAM DEF RT RT PROGRAM DEF SC USES SYSTEM COMMON DEF RC USES REVERSE COMMON DEF NC NO COMMON (OR LOCAL COMMON- DEFAULT) DEF SS USES SSGA DEF DB APPEND THE DEBUG ROUTINE DEF PE PERMANENT PROGRAM (ADDITION) DEF TE TEMPORARY PROGRAM (DEFAULT) DEF RP REPLACEMENT OPERATION DEF RS RESCAN FILE FOR APPENDED SUBROUTINES DEF LE DEF NL DEF PRERR INPUT ERROR PROCESSING * * ABLNK ASC 1, * * ********************************************************************** *THIS SECTION SETS A FEW FLAGS FOR LATER USE IN LOADING THE PROGRAM *AS THE INFORMATION COMES IN THE FLAGS ARE SET. THE FLAGS ARE NOT Ͱ*CHECKED UNTIL ALL INFORMATION ABOUT THE PROGRAM FROM THE RUN STRING *OR THE COMMAND FILE HAS BEEN PROCESSED. * * BACKROUND PROGRAMS SET PTYPE = 3 * REAL TIME PROGRAMS SET PTYPE = 2 * TEMPORARY PROGRAMS SET EDFLG = 0 * PERMANENT PROGRAMS SET EDFLG = 1 IE PERMANENT ADDITION * REPLACED PROGRAMS SET EDFLG = 2 IE PERMANENT REPLACEMENT * #PAGES = # OF PAGES IN PROGRAM (INCLUDES BP) * #PTTN = PARTITION # (COUNTING FROM 1 ) * #MPFT = 0/1 DON'T USE / USE SSGA * COMTP = 0 ... NO COMMON ( OR LOCAL COMMON) * COMTP = 1 ... SYSTEM COMMON * COMTP = 3 ... REVERSE COMMON * OPCOD = 1 IF DBUG APPENDED * OPCOD = 3 IF PROGRAM LISTING DESIRED * OPCOD = 4 IF PROGRAM PURGE DESIRED * MSEG = 0/1 NOT SEGMENTED / SEGMENTED * DO3 LDA TYPE2 GET THE COMMAND TYPE ERA,SLA IS IT A FILE ? JMP LDI25 THEN ITS AN ERROR JMP LLIST DO THE LISTING DO4 LDB P4 GET THE PURGE CODE STB OPCOD AND SAVE FOR LATER LDB TYPE2 GET THE CMND TYPE ERB,SLB IF ITS A FILE FLUSH HIM JMP LDI25 AND TELL HIM THE COMMAND TOO JMP CHEKR INTERACTIVE CMND OK. BG LDA P3 BACKROUND PROGRAM BG2 STA PTYPE JMP TEST,I RT LDA P2 JMP BG2 NC CLA,RSS SC CLA,INA SC2 STA COMTP JMP TEST,I RC LDA P3 JMP SC2 SS CLA,INA STA #MPFT STA SSGA SSGA FLAG JMP TEST,I DB CLA,INA STA DBFLG STA OPCOD JMP TEST,I TE CLA,RSS PE CLA,INA PM2 STA EDFLG JMP TEST,I RP LDA P2 JMP PM2 RS CLA,INA STA RSCAN SET THE RESCAN FLAG STA MSEG SET SEGMENTED PROGRAM FLAG JMP TEST,I LE CLA,RSS NL LDA P3 STA PLIST JMP TEST,I * SKP * * THIS ROUTINE SETS UP THE LIST DEVĺICE AS AN LU OR FILE * DOLST NOP LDB IPBUF+3 GET THE TYPE WORD SZB,RSS IF NOTHING THERE JMP DOLST,I JUST RETURN JSB CLOS3 CLOSE ANY OLD FILE * LDA N6 GET THE NEG COUNT FOR THE MOVE JSB MOVE MOVE THE BUFFER TO FILE NAME AREA DEF IPBUF THE LIST DEVICE MAY BE A FILE DEF FILE3 LDA TYPE3 GET THE INPUT TYPE AND P3 AND KEEP ONLY STA TYPE3 THE LOWER BITS ERA,SLA IS IT A FILE OR AN LU ?? JMP OPNFL A FILE, SO OPEN IT. * LDA IPBUF GET THE LIST LU IOR M200 SET V BIT FOR COLUMN 1 STA LISTU AND SAVE JMP DOLST,I GET THE NEXT PARAMETER * OPNFL LDA FILE3 GET THE 1ST 2 CHARS OF FILE NAME AND M7400 KEEP ONLY UPPER BYTE CPA ACENT IS IT A ' JMP OPEN3 YES SO GO OPEN THE FILE * CRAT3 JSB CREAT NO, SO CREAT THE FILE DEF *+8 DEF IDCB3 DEF IERR3 DEF FILE3 DEF P12 SIZE = 12 BLOCKS DEF P4 DEF F3SC DEF F3DSC * F3ERR SSA,RSS ANY ERRORS ? JMP DOLST,I NO, FILE NOW OPEN. SO RETURN * JSB CLOS3 YES, SO CLOSE THE LIST FILE LDB F3 GET THE FILE NAME ADDRESS TO B LDA IERR3 ERROR CODE TO A JMP FLERR DO FILE ERROR THING * * OPEN3 JSB OPEN OPEN THE LIST FILE DEF *+7 DEF IDCB3 DEF IERR3 DEF FILE3 DEF IPTN3 DEF F3SC DEF F3DSC * CPA N6 DID WE FIND THE FILE ? JMP CRAT3 NO SO GO CREAT IT JMP F3ERR SEE IF ANY ERRORS * * ACENT OCT 23400 THIS IS A ' * * * * OVLY1 CPB AS ASSIGN PARTITION ? JMP DOAS CPB SZ SPECIFY PROGRAM SIZE JMP DOSZ CPB LL NEW LIST DEVICE ? JMP DOLL CPB OP NEW OPCODE PARAMETERS ? JMP DOOP CPB FM NEW FORMAT PARAMETERS JMP DOOP .JMP PRERR MUST BE AN ERROR * AS ASC 1,AS SZ ASC 1,SZ LL ASC 1,LL OP ASC 1,OP FM ASC 1,FM * * * DOAS JSB NAMRR GO PARSE THE INPUT LDA IPBUF GET THE PARTITION # STA #PTTN AND SAVE FOR LATER CHECK JMP NXTOP DOSZ JSB NAMRR GO PARSE LDA IPBUF GET THE # OF PAGES STA #PGS SAVE FOR LATER ERROR CHECKING JMP NXTOP DOLL JSB NAMRR PARSE TO GET THE LIST DEVICE JSB DOLST NOW CHECK IT OUT JMP NXTOP DOOP JSB NAMRR PARSE THE INPUT PARAMETER STRING LDB IPBUF GET THE 1ST PARAMETER JSB TEST AND CHECK IT OUT LDB IPBUF+1 JSB TEST NOW TEST THE SECOND PARAMETER LDB IPBUF+2 JSB TEST AND THE LAST PARAMETER JMP NXTOP GET THE NEXT OP CODE * * * FOPEN JSB OPEN OPEN THE COMMAND FILE DEF *+7 DEF IDCB2 DATA CONTROL BLOCK DEF IERR2 ERROR FLAG DEF FILE2 FILE NAMR DEF IPTN2 OPEN OPTION DEF F2SC SECURITY CODE DEF F2DSC CARTRIDGE REF # * SSA,RSS ANY ERRORS ? JMP FREAD NO LDB F2 GET THE FILE NAME ADDRESS JMP FLERR YES * * *LOCKR NOP * CLB,INB SPECIFY LOCK * ADB NOERR SET THE NO ABORT BIT * STB PTEMP * STA ANLU# SAVE THE LU # * JSB LURQ LOCK THE LU * DEF *+4 * DEF PTEMP LOCK OR UNLOCK WORD * DEF ANLU# THE LU TO BE LOCKED * DEF P1 THE LU TO BE LOCKED * NOP IGNOR ANY ERRORS * JMP LOCKR,I ********************************************************************** * TRKYY EQU IDCB2-* OVERLAY CHECK !! * * SKP * * SYSTEM PROGRAM LISTING OPTION * * THE SELECTION OF THIS OPTION GIVES A LISTING * (ON THE LIST UNIT) OF THE PRIMARY CONTENTS OF * EACH ID SEGMENT IN THE SYSTEM. * THE LISTING IS PRECEDED BY THE HEADING: * NAME TYPE PRIORITY HIGH MAIN LOW zWMAIN REQ'D SIZE EMA SIZE PTTN * * EACH LINE OF OUTPUT FOR A DEFINED ID SEGMENT IS: * AS SHOWN ABOVE. * * A BLANK ID SEGMENT (AVAILABLE FOR USE) IS * NOTED BY THE LINE OUTPUT: * "" OR "" * * * LLIST JSB SPACE LDB LLM1 PRINT LDA P72 SPC 1 JSB DRKEY JSB SPACE JSB SPACE * LDA KEYWD SAVE STARTING STA ABT1 KEYWORD ADDR. * ZAP36 LDB ABLNK GET AN ASCII BLANK READY LDA N36 # OF WORDS TO BLANK STA YTEMP SAVE TEMPORARIALLY LDA LLM1 GET THE BUFFER ADDRESS ZAPIT STB A,I BLANK IT OUT FOR REUSE INA BUMP POINTER ISZ YTEMP ARE WE DONE ? JMP ZAPIT NO * * JSB BREAK SEE IF BREAK BIT SET LDB ABT1,I GET ID SEGMENT ADDR. SZB,RSS IF END-OF-LIST, GO TO SINGLE JMP EXIT TERMINATION * ADB P12 SET TO NAME AREA. LDA B,I GET NAME 1,2, STA LLM1+2 SET IN MESSAGE. SZA,RSS IF NAME WORD = 0, THEN JMP LL3 BLANK ID SEGMENT. INB LDA B,I SET NAME 3,4 STA LLM1+3 IN MESSAGE. INB LDA B,I GET NAME 5, AND M7400 ISOLATE, IOR BLNK ADD BLANK STA LLM1+4 AND STORE. * JSB LIST? GO SEE IF WE SHOULD PRINT IT * * LDA B,I GET TYPE AND M7 CODE. STA ZTEMP SAVE PROG TYPE IOR M60 MAKE ASCII, IOR UBLNK ADD UPPER BLANK, STA LLM1+6 AND STORE. * LDA B,I GET THE WORD AGAIN AND M20 GET THE SS BIT STA YTEMP SAVE IT * CLB STB OPCOD INSURE AN OCTAL CONVERSION LDB ZTEMP GET THE PROGRAM TYPE CPB P1 IS IT MEMORY RESIDENT ? JMP PROR YES, THUS NO HIGH & LOW MAIN WORDS * JSB ADJST GET THE ID ADDRESS AGAIN ADA P23 INDEX TO HIGH MAIN LDA A,I GET IT LDB LLM18 GET THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION. * JSB ADJST GET THE ID ADDRESS AGAIN ADA D22 INDEX TO THE LOW MAIN WORD LDA A,I LDB LLM13 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P24 GET LOW BP LDA A,I GET THE WORD LDB LLM23 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P25 GET THE HI BP LDA A,I LDB LLM28 JSB CONVD * * LDB ZTEMP GET THE PROGRAM TYPE BACK AGAIN CPB P5 IS IT A SEGMENT ? JMP LL4 YES * PROR LDB ABT1,I GET THE ID ADDRESS AGAIN ADB P6 INDEX TO THE PRIORITY LDA B,I GET THE PRIORITY LDB P3 MAKE SURE THE CONVERSION IS DECIMAL STB OPCOD LDB LLM8 GE THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION * LDB ABT1,I GET THE ID ADDRESS AGAIN (TEDIOUS ISN'T IT ?) ADB D21 INDEX TO SIZE WORD LDA B,I GET THE SIZE STA XTEMP SAVE IT AND M0760 NOW GET THE SIZE INFO ALF,ALF PLAY A FEW GAMES WITH IT RAR,RAR INA ACCOUNT FOR BASE PAGE JSB CNV99 CONVERT TO ASCII STA LLM1+30 SOCK IT AWAY * LDA XTEMP GET THE SIZE WORD AGAIN SSA,RSS IS THIS PROG ASSIGNED TO A PARTITION ? JMP LL4 NO, SO GO DO OUTPUT * AND M77 SO GET THE PARTITION # INA MAKE IT COUBT FROM 1 (NOT 0 ) JSB CNV99 DO THE CONVERSION STA LLM1+35 SAVE IT * LL4 LDA P72 PRINT NAME LDB LLM1 LINE JSB DRKEY * LL2 ISZ ABT1 GET NEXT KEYWORD ADDR. JMP ZAP36 -REPEAT SCAN. * * OUTPUTB BLANK ID MESSAGE * LL3 LDA TYPE1 GET THE PROG NAME TYPE WORD SZA ANY PROG SPECIFIED JMP LL2 YES SO DONT PRINT THE BLANK ID MSG. ADB P2 (B)=ADDR OF NAM5 WORD LDA B,I GET NAM5 WORD AND M20 MASK IN 'SS' BIT LDB LLM3 (B)=ADDR OF LONG ID MESSAGE SZA 'SS' BIT SET ? LDB LLM4 YES-(B)=ADDR OF SHORT ID MESSAGE LDA P18 (A)=MESSAGE LENGTH JSB DRKEY JMP LL2 * PURGE CLA,INA GO SET CLB JSB SETID ID ADDRS FOR LONG ID LDB BATCH GET THE BATCH FLAG SSB UNDER BATCH ? JMP LDI25 YES , ITS AN ERROR * LDA PAM1 GET INPUT PARAMETER P1 * SZA INPUT SPECIFIED ? * JMP USEIM YES - GO USE IT. * LDB BATCH GET BATCH FLAG * INA SET FOR LU1 * SZB RUNNING UNDER BATCH ? * LDA P5 YES-THEN DEFAULT INPUT TO LU 5 * SZB,RSS RUNNING UNDER BATCH? *SEIM STA LIST1 NO, SET PROMPT LU LDA FILE2 GET THE CMND LU AND M77 KEEP ONLY LU BITS JSB INTER IS IT INTERACTIVE JMP TRLST NO, ITS NOT. TRY LIST LU * GOTIT IOR M400 SET UP ECHO BITS STA LISTU SET UP INPUT LU. JMP TRYAG NOW GO OUTPUT MESSAGE * TRLST LDA LISTU GET THE LIST LU AND M77 KEEP LU BITS JSB INTER SEE IF IT'S INTERACTIVE JMP LDI5 NO, FLUSH HIM JMP GOTIT YES, SO GO DO IT. * * TRYAG LDA P10 SEND THE MESSAGE LDB LLM2 LOADR: PNAME ? JSB SYOUT TO THE OUTPUT DEVICE * LDA LLM1+1 GET AN ASCII BLANK STA NAM12,I AND BLANK BUFFER STA NAM34,I STA NAM5,I * JSB EXEC READ THE REPLY DEF *+5 TO THE DEF P1 DEF LISTU DEF NAM12,I NAME AREA IN THE ID SEGMENT DEF P3 THREE WORDS LDA NAM12,I CHECK FOR /A (ABORT OPERATION) CPA /A JMP ABORT YES GO ABORT JSB MIDN GO SEE IF THE NAME IS DEFINED JMP LDI5 NO GO SEND MESSAGE JMP *+1,I GO PURGE THE PROG DEF ED0 (SAVE A BP LINK TOO !) SPC 1 * BLNK OCT 40 D21 DEC 21 D22 DEC 22 * * SPC 2 LLM1 DEF *+1 ASC 21, NAME TYPE PRIORITY LO MAIN HI MAIN ASC 15, LO BP HI BP SIZE PART'N SPC 1 /A ASC 1,/A * LLM4 DEF *+1 ASC 9, LLM3 DEF *+1 ASC 9, * LLM13 DEF LLM1+13 LLM18 DEF LLM1+18 LLM23 DEF LLM1+21 LLM28 DEF LLM1+26 LLM8 DEF LLM1+8 P24 DEC 24 P25 DEC 25 P72 DEC 72 N36 DEC -36 LLM2 DEF *+1 ASC 5, PNAME ? _ * * * ADJST NOP LDA ABT1,I GET THE ID ADDRESS AGAIN LDB YTEMP GET THE SHORT SEG FLAG CPB M20 IS THIS A SHORT SEG ? ADA N7 THEN ADJUST A REG JMP ADJST,I AND RETURN * * LIST? NOP LDA TYPE1 SZA,RSS ANY THING INPUT FOR PROG NAME ? JMP LIST?,I NO, SO CONTINUE LDA FILE1 GET 1ST CHAR CPA LLM1+2 IS IT THIS ONE ? RSS YES JMP LL2 NO LDA FILE1+1 GET 2ND CHAR CPA LLM1+3 RSS JMP LL2 LDA FILE1+2 GET THE LAST CHAR CPA LLM1+4 JMP LIST?,I SUCCESS !!! JMP LL2 * WE PUT A FEW OVERLAYABLE WORDS HERE * * UBLNK OCT 20000 COMTP NOP TYPE OF COMMON 0/1/3/ LOCAL/SYSTEM/REVERSE M60 OCT 60 ERR25 ASC 1,25 LDI25 LDA ERR25 JMP ABOR DBFLG NOP 0/1 NORMAL LOAD/APPEND DEBUG XTEMP NOP TEMP WORD YTEMP NOP TEMP WORD ZTEMP NOP TEMP WORD BKLWR NOP LAST WORD OF AVAILABLE MEMORY INDLU NOP TEMPORARY LU WORD #PGPT NOP #PAGES IN PARTITION * ****************************** SPC 1 NOVLY EQU * BEGIN NON-OVERLAYABE CODE .LBUF EQU *-LBUF-128 OVE9RLAY CHECK .DBUF EQU *-DBUF-128 OVERLAY CHECK .XBUF EQU *-XBUF-128 OVERLAY CHECK * BSS .BUF-* TURKY EQU *-.BUF OVERLAY CHECK NOP * * SKP *********************************************************************** * NON OVERLAY AREA *********************************************************************** * * * LSCAN SEARCHES FOR AN ENTRY IN LST IDENTICAL TO THE NAME IN TBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSCAN * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (N+1): END OF LST. CURRENT LST ADDRES POINT TO THE NEXT * AVAILABLE ENTRY IN LST. * (N+2): NAME FOUND IN LST. CURRENT LST ADDRES POINT * TO THIS ENTRY. * LSCAN NOP JSB INLST INITIALIZE LSTX LDB TLST ENTX1 CPB PLST END OF LST ? JMP SLSTS YES - GO MAKE NEW ENTRY LDA B,I RAL,CLE,ERA CPA TBUF NAME 1,2 EQUAL ? JMP *+3 YES ADB P5 JMP ENTX1 NO - CHECK NEXT ENTRY INB LDA B,I CPA TBUF+1 NAME 3,4 EQUAL ? JMP *+3 ADB P4 JMP ENTX1 NO - CHECK NEXT ENTRY INB LDA B,I AND M7400 MASK OFF ORDINAL STA TBUF+3 LDA TBUF+2 AND M7400 MASK IN NAME 5 CPA TBUF+3 NAME 5 EQUAL ? JMP *+3 YES - SET LST1-5 ADDRES ADB P3 JMP ENTX1 ADB N2 BACK UP TO LST1 STB TLST AND SET UP TO CALL LSTX JSB LSTX FAKE IT HLT 0 I ALREADY CHECKED!! ISZ LSCAN SET FOR (P+2) RETURN JMP LSCAN,I SLSTS STB TLST (FOR LSTX TO USE) JSB LSTX ** RETURN MUST ALWAYS BE (P+1) ** JMP LSCAN,I RETURN (P+1) HLT 0 SKP * * SET NAME INTO LST * * SELST SETS THE CURRENT NAME INTO LST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SELST * * RETURN: CwbONTENTS OF A AND B ARE DESTROYED. * SELST NOP LDA TBUF GET NAME 1,2 STA LST1,I SET NAME 1,2 INTO LST. LDA TBUF+1 GET NAME 3,4 STA LST2,I SET NAME 3,4 INTO LST LDA TBUF+2 GET NAME 5 AND M7400 ISOLATE UPPER CHAR STA LST3,I SET NAME 5 INTO LST LDA TLST GET NEXT LST ADDR STA PLST SET NEW END OF LST JMP SELST,I RETURN * * * COMMAND FILE PROCESSOR * * LREAD LDA DFLAG (ALL LU READS RETURN HERE) GET THE FLAG SZA ARE WE INTERACTIVE ?? JSB PRMTR YES, SO OUTPUT LOADR PROMPT JSB REIO NOW READ THE INPUT DEF *+5 DO IT IN A REENTRANT FASHION SO THAT DEF P1 WE ARE SWAPABLE DEF FILE2 DEF STRNG DEF N80 SZB,RSS WAS THE READ OF ZERO LENGTH ? JMP END?? YES, END OF INPUT, GO DO ERROR CHECKING CMND STB SLONG SAVE READ LENGTH FOR PARSING ROUTINE CLA,INA SET UP PARSING OFFSET TO START PARSING STA ISTRC AT THE FIRST CHARACTER JSB NAMRR PARSE THE OPCODE LDB IPBUF+1 GET 3RD & 4TH CHAR STB OP1? LDB IPBUF AND SAVE THE OPCODE STB OP? TEMPORARIALLY * * THESE COMMANDS MAY BE ENTERED ANY TIME * * CPB EN END OF COMMAND FILE ? JMP SECHK CPB SE A SEARCH COMMAND ? JMP SECHK CPB FO A FORCE COMMAND ? JMP FORCE CPB RE A RELOCATE COMMAND ? JMP SECHK CPB DS DISPLAY UNDEFS ? JMP DSPLY CPB EC ECHO COMMANDS ? JMP SUPRS CPB .A ABORT ? JMP ABORT LDA B AND M7400 CPA AS2RK JMP NXTOP * LDA DONE? GET THE MAIN LOADED FLAG SZA,RSS HAS THE MAIN BEEN LOADED ? JMP OVLY1 NO, GO TO OVERLAY AREA FOR REST OF COMNDS * PRERR LDA DFLAG GET THE INTERACTIVE FLAG ? SZA,RSS ARE WE IN THE INTERACTIVE MODE ? JMP DOERR GO DO THE INPUT ERROR THING JSB PRMTR JSB EXEC DEF *+5 DEF P2 DEF FILE2 DEF PROMT+6 DEF P1 * JMP NXTOP GO GET THE NEXT INPUT * DOERR LDA CLEN GET THE READ LENGTH SZA IF NON ZERO ECHO IT JSB IECHO JMP LDI5 ELSE JUST ABORT THYSELF OP? NOP LAST OPCODE ISTRC DEC 1 POINTER TO CURRENT CHAR TO BE PARSED * * PROCESS THE COMMAND. * DSPLY LDA DFLAG GET THE CMND INTERACTIVE FLAG SZA,RSS IS IT INTERACTIVE ?? JMP DSPL1 NO LDB LISTU YES SO GET THE LIST LU STB QTEMP AND SAVE LDB FILE2 GET THE CMND LU STB LISTU AND USE IT AS THE LIST DEVICE LDB TYPE3 GET TYPE STB PTEMP AND SAVE CLB,INB STB TYPE3 JSB PUDF REPORT UNDEFS LDB QTEMP GET THE LIST LU BACK AGAIN STB LISTU AND RESTORE IT LDB PTEMP GET TYPE STB TYPE3 AND SAVE IT TOO JMP NXTOP GET NEXT COMMAND DSPL1 JSB PUDF REPORT UNDEFS JMP NXTOP GET THE NEXT COMMAND SUPRS CCA STA ECHO? NXTOP LDA TYPE2 GET THE TYPE OF INPUT ERA,SLA WHERE ARE WE READING FROM ? JMP FREAD A FILE JMP LREAD AN LU FORCE CCA SET THE FORCE STA FORCD FLAG. JMP NXTOP RELOC CLA NOW SET A FEW FLAGS STA LIBFL NOT A LIBRARY SCAN JMP DOPRS NOW GO DO THE PARSE SERCH CCA NOW SET A FEW FLAGS STA LIBFL IS A LIBRARY SEARCH * DOPRS CLA SET A FEW FLAGS STA SCSEG CLEAR THE SCAN TILL SEG FOUND FLAG STA SLIBF NOT A SYS LIB SCAN STA LGOU NOT AN LG READ CMA STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST JSB NAMRR PARSE TH INPUT SSA WAS THERE ANYTHING TO PARSE ? JMP SE?? NO SEE IF LAST ONE WAS A SE,< > LDA IPBUF GET THE 1ST PARSED WORD. SZA IF = 0 CPA PROMT+4 OR A BLANK JMP SE?? BETTER BE AN SE,0, OR SE,, COMMAND LDA N6 GET THE WORD COUNT JSB MOVE MOVE THE NAMR TO THE DCB AREA DEF IPBUF SOURCE DEF FILE1 DESTINATION LDA TYPE1 GET THE TYPE WORD AND P3 KEEP ONLY THE LEAST 2 BITS STA TYPE1 JMP DMANE NOW GO DO THE READ * * SE?? LDA OP? GET THE LAST OPCODE ENTERED CPA SE WAS IT AN ' SE ' ? RSS YES JMP PRERR NO, WAS AN RE, < > = AN ERROR * JMP *+1,I NOW GO SCAN DEF LOADN (SAVE A BP LINK TOO !) * END?? LDA EN STA OP? SECHK LDB DONE? GET THE ERROR CHECKS DONE FLAG SZB,RSS HAVE WE DONE THE PARAMETER CONFLICT CHECK ? JMP CNFLT NO, SO DO IT (JMPS BACK TO OVERLAY AREA ) SECK1 LDA OP? GET THE OPCODE AGAIN * CPA FO WAS IT A FORCE ? JMP FORCE YES, SO DO THE FORCE LOAD CPA SE WAS IT A SEARCH ? JMP SERCH YES, SO SEARCH THE FILE CPA RE WAS IT A RELOCATE ? JMP RELOC YES, SO RELOCATE THE FILE JSB CLOS2 MUST HAVE BEEN AN END. SO CLOSE JSB CLOS1 COMMAND AND INPUT FILES. AND JMP CLFL1 FINISH THE LOAD. * * * * THE FOLLOWING ARE THE LEGAL COMMAND FILE COMMANDS * DS ASC 1,DI EC ASC 1,EC RE ASC 1,RE SE ASC 1,SE FO ASC 1,FO EN ASC 1,EN .A ASC 1,/A AS2RK OCT 25000 AN * ECHO? NOP SPC 1 * * * IERR2 NOP ERROR FLAG FOR COMMAND FILE IPTN2 NOP OPEN OPTION * IERR3 NOP ERROR FLAG FOR LIST DEVICE IPTN3 DEC 1 OPEN OPTION (NON EXCLUSIVE !!!!!) * * IERR1 NOP READ ERROR FLAG IPTN1 NOP OPEN OPTION IDCBS DEC 256 * * SPC 1 * OPEN, READ, AND ECHO T TNLHHE COMMAND. SPC 1 * FREAD JSB READF READ THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF STRNG DEF P40 DEF CLEN * LDA ECHO? ARE WE ECHOING COMMANDS ? SZA JSB IECHO YES, SO DO IT. * * * LDA IERR2 SSA,RSS ANY ERRORS ? JMP FLCHK NO LDB F2 JMP FLERR YES FLCHK LDB CLEN GET LENGTH OF COMMAND JUST READ SZB,RSS WAS IT ZERO ? JMP FREAD YES, SO DO IT AGAIN SSB WAS IT NEGATIVE (IE END OF FILE) JMP END?? YES, SO FINISH PROCESSING CLE,ELB CONVERT TO CHAR COUNT (MULT BY 2) JMP CMND GO DO COMMAND FILE PROCESSING * CLEN NOP RECORD READ LENGTH * * * P40 DEC 40 * ************************************************************************* * NON-OVERLAYABLE SUBROUTINES ************************************************************************* * THE NAMRR SUBROUTINE USES THE RELOCATABLE LIBRARY * PARSING ROUTINE NAMR. THE INPUT TO NAMR IS A STRING * OF ASCII CHARACTERS. * THE OUTPUT IS A 10 WORD BUFFER PARSED AS : D`N* PRAM1,PRAM2,PRAM3,TYPE,S1,S2,S3,S4,S5,S6 * PARAMETERS BETWEEN COMMAS ARE PARSED. SUBPARAMETERS ARE * DELINEATED BY COLONS. THE TYPE WORD DESCRIBES ALL * PARAMETERS AS ASCII, NUMERIC, OR NULL. * THE TYPE WORD IS BROKEN UP INTO 2 BIT FIELDS TO DESCRIBE * THE INPUT. *15,14 13,12 11,10 9,8 7,6 5,4 3,2 1,0 *----------------------------------------------- * S6 ! S5 ! S4 ! S3 ! S2 ! S1 ! PRAM ! *----------------------------------------------- * * PRAM = 0 ...NULL PRAM1 = PRAM2 = PRAM3 = 0 * PRAM = 1....NUMERIC (ONLY PRAM1 USED) PRAM1 = # * PRAM = 2 ...NOT USED * PRAM = 3 ... ASCII (USES PRAM1,PRAM2,PRAM3 ) * * S1 - S6 ARE DEFINED THE SAME EXCEPT THEY ARE ONE WORD ONLY * NAMRR NOP JSB NAMR THIS IS THE RELO LIBR PARSING ROUTINE DEF *+5 RETURN ADDR DEF IPBUF ADDRESS OF 10 WORD PARSED BUFFER DEF STRNG ADDRESS OF BUFFER TO BE PARSED DEF SLONG CHARACTER LENGTH DEF ISTRC CHAR OFFSET IN STRNG FOR NEXT PRAM JMP NAMRR,I RETURN TO CALLER * * * THIS SUBROUTINE IS USED IF THE COMMAND FILE FOR * INPUT IS AN INTERACTIVE LU. IT OUTPUTS A LOADR * PROMPT WHICH IS /LOADR: * PRMTR NOP JSB EXEC DEF *+5 DEF P2 DEF FILE2 DEF PROMT DEF P6 JMP PRMTR,I PROMT ASC 6, /LOADR: _ ASC 1,?? * * * THE IECHO ROUTINE ECHOS COMMAND FILE COMMANDS AND ECHOS * ANY BAD COMMANDS ENCOUNTERED IN THE COMMAND FILE * IT ASSUMES THE WORD COUNT IN ' CLEN ' AND THE BUFFER * TO BE OUTPUT IN ' DSTRG '. * IECHO NOP LDA CLEN RAL WORD COUNT IS NOW CHAR COUNT LDB DSTRG GET THE BUFFER ADDRESS JSB DRKEY OUTPUT IT JMP IECHO,I RETURN TO CALLER * * * *THE FLERR ROUTINE HANDLES ALL FILE ERRORS. CALLING SEQUENCE: * * LDA WITH ERROR CODE (NEGATIVE) * LDB WITH ADDRESS OF FILE * JMP FLERR * * *THIS ROUTINE WILL CLOSE ALL FILES FLERR STB EFILE  SAVE NAME OF FILE CMA,INA MAKE ERROR POSITIVE JSB CNV99 CONVERT TO ASCII STA EFBUF+4 PUT INTO ERROR MESSAGE LDA EFILE,I GET THE FILE NAME STA EFBUF+10 AND ISZ EFILE PUT LDA EFILE,I IT STA EFBUF+11 INTO ISZ EFILE THE LDA EFILE,I ERROR STA EFBUF+12 MESSAGE . * * LDA P26 GET THE CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY NOW PRINT THE ERROR MESSAGE * LDA DFLAG GET THE INTERACTIVE CMND FILE WORD SZA,RSS ARE WE INTERACTIVE ? JMP LDI5 NO, DO THE REST OF THE ERROR THING * JMP NXTOP GO GET NEXT COMMAND * * * EFILE NOP DSTRG DEF STRNG POINTER TO STRING BUFFER P26 DEC 26 *THE FCLOSE ROUTINE CLOSES ALL FILES OPEN TO THE *LOADR. * FCLOS NOP JSB CLOS1 JSB CLOS3 JSB CLOS2 JMP FCLOS,I * CLOS1 NOP LDA TYPE1 GET THE TYPE WORD FOR THE FILE CLB STB TYPE1 CLOSE OUT THE FILE TYPE WORD ERA,SLA IS IT A FILE ? RSS YES JMP CLOS1,I NO, LOOK AT THE NEXT ONE JSB CLOSE CLOSE THE FILE DEF *+2 DEF IDCB1 JMP CLOS1,I * CLOS2 NOP LDA TYPE2 CLB STB TYPE2 CLOSE OUT FILE TYPE WORD STB DFLAG AND INTERACTIVE LU WORD ERA,SLA IS IT A FILE RSS YES JMP CLOS2,I NO JSB CLOSE YES DEF *+2 DEF IDCB2 JMP CLOS2,I * CLOS3 NOP LDA TYPE3 ERA,SLA RSS JMP CLOS3,I JSB CLOSE DEF *+2 DEF IDCB3 * CLA,INA SET UP THE STA TYPE3 NUMERIC FIELD IN THE TYPE WORD LDB TYPE2 GET THE CMND TYPE SZB,RSS IF NO COMMAND MODE JMP USEL1 USE LU 1 ERB,SLB IS IT A FILE OR AN LU ? JMP USEL1 A FILE * q LDA FILE2 AN LU AND M77 KEEP ONLY LU BITS JSB INTER SEE IF IT IS INTERACTIVE USEL1 CLA,INA ITS NOT, SO USE LU1 STA LISTU AS THE LIST LU JMP CLOS3,I RETURN * * JMP CLOS3,I RETURN * DEBUF DEF EFBUF EFBUF ASC 13, FMGR -XX ON FILE * *THE INTER SUBROUTINE DETERMINES IF THE INPUT LU# IS AN *INTERACTIVE LU OR NOT. IN ADDITION, THE LU IS CHECKED TO SEE IF *IT IS IN RANGE. IF NOT IT IS ASSUMED TO BE AN INPUT ERROR AND THE *LOAD IS ABORTED. *LASTLY, IF THE DEVICE IS NOT INTERACTIVE IT IS LOCKED. * * * CALLING SEQUENCE : LDA LU# * JSB INTER * * RETURN P+1 IF NOT INTERACTIVE * P+2 IF INTERACTIVE * INTER NOP SZA,RSS IF BIT BUCKET JMP INTER,I ITS NOT INTERACTIVE STA ANLU# SAVE THE LU # FOR RETURN SSA IF NEG, FLUSH HIM JMP LDI5 CMA MAKE NEG ADA P64 ADD IN CORRECT RANGE SSA JMP LDI5 JSB EXEC GET THE EQT INFO ON THE LU# DEF *+6 DEF P13 DEF ANLU# DEF QTEMP EQT WORD 5 PLACED HERE DEF PTEMP EQT WORD 4 PLACED HERE DEF RTEMP SUBCHANNEL IN LOWER 5 BITS HERE * LDA QTEMP GET EQT WORD 5 AND MEQT GET THE EQT TYPE SZA,RSS IF DVR00 THEN JMP BUMPR BUMP RETURN ADDRESS * CPA M2400 IF DVR05 THEN CHECK THE SUBCHANNEL RSS CPA M3400 DO IT FOR DVR 07 ALSO RSS JMP NBUMP NOT INTER ACTIVE, SO RETURN LDA RTEMP GET THE SUBCHANNEL AND M37 KEEP ONLY SUBCHANNEL BITS SZA,RSS IF = 0, THEN ITS INTERACTIVE BUMPR ISZ INTER NBUMP LDA ANLU# JMP INTER,I * MEQT OCT 37400 ANLU# NOP M2400 OCT 2400 M3400 OCT 3400 * * * * THE BREAK ROUTINE CATCHES ANY PROGRAM BREAKS AND DOES * A CLEAN TERMINATION. * BREAK NOP JSB IFBRK DEF *+1 5SSA ANY BREAK INPUT ? JMP ABORT YES , SO ABORT THYSELF JMP BREAK,I NO SO JUST RETURN * PTEMP NOP QTEMP NOP RTEMP NOP SKP * * HERE WE DECIDE WHERE THE INPUT IS TO BE READ FROM. THE NEW * INPUT COULD BE FROM LU, OR A FILE. SPC 2 * DMANE LDA FILE1 GET THE READ LU OR FILE # LDB TYPE1 NO SO GET THE TYPE ERB,SLB IS IT A FILE OR AN LU ? JMP F1OPN A FILE. SO LETS OPEN IT. * JSB INTER AN LU SO CHECK IT OUT. IF P1=0, RSS JMP LDI5 IOR M300 SET THE BINARY AND V BITS STA PGMIN SET NEW INPUT LU IOR B400 SET EOT CONTROL WORD STA SEOT * JSB EXEC SET EOT ON INPUT UNIT DEF *+3 DEF P3 DEF SEOT * CLA SET FLAG FOR 'LG NOT BEING USED' STA LGOU * LDRIN LDA LGOU GET 'LG USE' FLAG SZA LG BEING USED FOR INPUT ? JMP LDRN2 YES, READ FROM LG AREA. LDA TYPE1 NO, SO GET THE READ TYPE WORD ERA,SLA IS THE READ FROM AN LU OR FILE JMP RREAD A FILE SO GO READ THE NEXT RECORD. * SKP * * LOAD FROM INPUT LU * JSB EXEC DEF *+5 DEF P1 1 = READ REQUEST DEF PGMIN PROG INPUT UNIT NO. DEF LBUF LBUF = INPUT BUFFER DEF P64 BUFFER LENGTH = 64 WORDS * AND M240 EOF OR EOT? SZA NO JMP RECLS YES, CLOSE OUT THE LU SZB WHAT ABOUT THE XMISSION LENGTH ? JMP TESTR NON ZERO SO GO PROCESS JMP RECLS ZERO, SO CLOSE OUT THE LU * * PGMIN OCT 305 SEOT OCT 705 B400 OCT 400 * * M240 OCT 240 * SPC 1 * F1OPN JSB OPEN OPEN THE FILE ! DEF *+8 DEF IDCB1 DCB DEF IERR1 ERROR FLAG DEF FILE1 ASCII FILE NAME DEF IPTN1 READ OPTION DEF F1SC SECURITY CODE DEF F1DSC CART REF #i$ DEF IDCBS # OF BUFFER WORDS * SSA,RSS ANY ERROR IN THE READ ? JMP FNXT1 NO LDB F1 YES , GET THE FILE NAME JMP FLERR AND REPORT FNXT1 CLA STA #SEGS CLEAR # OF SEGMENTS IN THIS FILE FLAG STA #NAMS CLEAR # OF NAMS FOUND WHILE SCAN FOR NEXT SEG * SPC 1 RREAD JSB READF READ THE NEXR RECORD DEF *+6 DEF IDCB1 DEF IERR1 DEF LBUF RELOCATABLE RECORD BUFFER ! DEF P64 DEF LEN ACTUAL RECORD LENGTH READ * SPC 1 SSA,RSS ANY ERRORS ? JMP FNXT2 NO LDB F1 YES, GET THE FILE NAME JMP FLERR AND REPORT SPC 1 FNXT2 LDA LEN GET THE RECORD LENGTH READ SZA,RSS ZERO RECORD LENGTH ? JMP RREAD YES, SO TRY AGAIN SSA,RSS NO, WAS IT A NEG LENGTH ( -1 ) JMP TESTR NO, SO GO PROCESS RECORD ! SPC 1 LDA RSCNX YES ! SZA WERE WE RESCANNING THE FILE ?? JMP NSCAN YES NOW GO RESET THE FILE BACK * LDA LIBFL IS THIS A LIBRARY SCAN ? ADA SCSEG AND ALSO NOT A SCAN TILL SEG FOUND ? SZA,RSS WELL? JMP CK#SG NO, CHECK IF ANY SEGMENTS IN THIS FILE LDA OP1? YES, BUT DID HE SAY SE, OR SEXXXX, ? CPA ASNUL WELL ? JMP RECLS SE, SO DON'T LOOK FOR BACKWARD REFS ISZ NUPLS SEXXX -- . SO WAS ANYTHING LOADED LAST PASS ? JMP DUMMY YES, SO DO IT AGAIN (BACKWARD REF FIX) JMP RECLS NO, SO JUST GO CLOSE THE FILE * CK#SG LDA #SEGS GET THE # OF SEGMENTS LOADED SZA,RSS ANY ? JMP RECLS NO, SO GO CLOSE FILE * LDA #NAMS GET THE # OF NAMS FOUND WHILE SCAN FOR SEG CMA,INA,SZA ANY NAMS AFTER THE SEG ? JMP SCANW YES. * RECLS JSB CLOS1 NO , EOF REACHED. CLOSE FILE * ISZ SKP.1 SKIP IF 1ST CMND NOT YET DONE RSS JMP SECK1 GO DO LAST COMMAND * LDA TYPE2 GET THE CMND FILE TYPE WORD. SZA IS THERE A CMND FILE ? JMP NXTOP YES, SO GO GET NEXT COMMAND * CLFL1 LDA P3 NO CNMD FILE & NO RELOC FILE. MUST BE LDB MSEG FINISHED WITH USER INPUT. SO IF SZB THE PROG IS SEGMENTED. SET LAST SEG STA MSEGF FLAG. JMP LOADX NOW GO FINISH THE LOAD. * * F1 DEF FILE1 POINTER TO RELOC FILE BUFFER LEN NOP LENGTH OF READ OF RELO FILE ASNUL ASC 1, A BLANK OP1? NOP 2ND WORD OF SEARCH COMMAND (SEXXCH) * * * ALL FORCE LOADS COME HERE TO CLEAN UP FIX UP TABLE * * FIXCL LDA MSEG GET THE SEGMENTED PROG FLAG SZA,RSS IS PROG SEGMENTED ? JMP NODEX NO, DON'T NEED TO CLEAN UP FIXUP TABLE. * JSB SILST SET TO SCAN THE SEGMENTS LDB TLST LST FIXC0 CPB PLST END? JMP NODEX YES GO FINISH * STB LST1 SET LST1 FOR FIXAL ADB P3 TO GET THE LDA B,I DEFINED FLAG AND P7 ISOLATE IT CPA P2 UNDEFINED? JMP FIXC1 YES GO DEFINE IT * FIXC2 ADB P2 NO INDEX TO THE NEXT ONE JMP FIXC0 AND GO LOOK AT IT * FIXC1 LDA M2000 SET TYPE TO 4 (IN HIGH BYTE) STA B,I DEFINE THE SYMBOL INB SET ITS VALUE CLA STA B,I TO ZERO JSB FIXAL GO DO ALL FIXUPS LDB LST4 RESTOR B JMP FIXC2 AND CONTINUE THE LOOP * ERR05 ASC 1,05 ERR10 ASC 1,10 P13 DEC 13 PLFLG NOP LDI5 LDA ERR10 JMP ABOR * * * * * SYMBOL TABLE OVERFLOW * LOVER EQU * JSB CPRNM PRINT MODULE NAME(IF PRSENT) LDA ERR05 SET CODE EQUAL LST OVERFLOW ABOR JSB ERROR ABORT CLA CLEAR PROG NAME STA PRAM IN NAME PASSED BACK STA PRAM+1 THRU PRTN ROUTINE STA PRAM+2 LDA MERR GET THE ERROR CODE STA PRAM+3 PUT INTO TO ERROR CODE LDA MERR+1 AND THE # OF THE ERROR CODE STA PRAM+4 STUFF IT IN RETURN MESSAGE FOR FATHER LDA P13 LDB MES10 MES10 = ADDR "LOADR ABORTED" JMP *+1,I TERMINATE LOADER(AND THIS PROGMER) DEF LTERM (SAVE A BP LINK TOO ) * MES10 DEF *+1 ASC 7,LOADR ABORTED SKP * * INPUT FROM SYSTEM LIBRARY SCAN. SPC 3 * LDRN2 LDB XCUR IF CURRENT ADDR. OF XBUF = CPB XBUFA FWA OF XBUF, RSS READ NEXT SECTOR JMP LDRN4 DON'T BOTHER ITS IN CORE * LDRN3 LDB LGSEC CHECK CURRENT SECTOR #. CPB SECT2 IF CURRENT = LAST SECTOR, CLB,RSS SKIP JMP LDRN6 GO TO INPUT SECTOR. STB LGSEC RESET SECTOR # TO ZERO ISZ LGTRK ADD 1 TO TRACK # * READ NEXT SECTOR FROM LG AREA OR SYS LIB * LDRN6 JSB EXEC DEF *+7 DEF P1 DEF P2 DEF XBUF DEF P128 READ 2 LOGICAL SECTORS (1 PHYSICAL 7900) DEF LGTRK DEF LGSEC * ISZ LGSEC -ADD 2 FOR NEXT SECTOR. ISZ LGSEC LDA XBUFA SET STARTING BUFFER STA XCUR ADDR LDA N128 AND STA LGT1 COUNTER = -128. LDB LBOEF IS THE LIB ODD/EVEN SSB,RSS FLAG SET??? JMP LDRN4 -NO- CLA CLEAR THE STA LBOEF FLAG LDA N64 RESET COUNT FOR HALF SECTOR ONLY STA LGT1 CLA STA XCNT SET REC COUNT TO ZERO LDA XBHLF SET THE BUF ADDR STA XCUR TO THE ODD SECTOR * LDRN4 CLA IF CURRENT CPA XCNT REC COUNT = 0, RSS THEN SET FOR NEW REC. JMP LDRN5 CONTINUE WITH CURRENT REC. LDA XCUR,I GET NEXT ALF,ALF REC LENGTH (UPPER CHAR.), AND M77 SET NEGATIVE CMA,INA,SZA,RSS JMP LDRNE YES, READ NEXT SECTOR STA XCNT NO, SAVE COUNT FOR MOVE LD?A ALBUF RESET ADDR OF STA LGT2 LBUF FOR MOVE. * LDRN5 LDA XCUR,I MOVE WORD FORM XBUF STA LGT2,I TO LBUF ISZ XCUR UPDATE BUFFER ISZ LGT2 ADDRES. ISZ XCNT INDEX NOP ISZ LGT1 COUNTERS. NOP CLA LDB XBUFA RESET ADDR OF CPA LGT1 'XBUF' IF STB XCUR END OF XBUF. CPA XCNT IF END OF REC, JMP TESTR GO TO PROCESS IT. CPA LGT1 IF END OF XBUF, JMP LDRN3 GO TO READ NEXT SECTOR. JMP LDRN5 CONTINUE WITH CURRENT REC. * N64 DEC -64 N128 DEC -128 P128 DEC 128 LDRNE LDA XBUFA WAS ZERO LENGTH REC AT CPA XCUR START OF A SECTOR? RSS JMP LDRN3 NO, READ NEW SECTOR. CCB YES, SUBTRACT 1 FROM CURR SECTOR ADB LGSEC IN CASE END OF LG ON ODD SECTOR JMP LDRN6 CHECK FOR END OF LG * SKP * * SUBROUTINES TO SAVE AND RESTORE DISC READ PARAMETERS. * * * * LGTRK NOP TRACK LGSEC NOP SECTOR LGS# NOP # SECS / TRK LGT1 NOP DOWN COUNTER IN XBUF LGT2 NOP CURRENT LBUF ADDR XCNT NOP REC LENGTH RIC NOP REC INDICATOR L6 OCT -6 XBHLF DEF XBUF+64 ADDR OF END OF XBUF XBUFA DEF XBUF DEFINE ADDR OF XBUF XCUR DEF XBUF * SKP * * THE SCANX ROUTINE SAVES OUR LOCATION IN THE FILE AND * THEN REWINDS THE FILE TO THE BEGINING SO THAT THE FILE * MAY BE SCANNED FOR UNDEFS. THIS ALLOWS A SUBROUTINE TO * PLACED IN THE FILE ONLY ONCE, BUT TO HAVE IT APPENDED TO * ANY SEGMENT OR MAIN THAT CALLS IT. SCANX IS CALLED WHENEVER * A SEGMENT NAM IS ENCOUNTERED IN THE FILE. WHEN THE END OF * FILE IS ENCOUNTERED THE FILE MUST ALSO BE SCANNED (IE MAY BE * THE LAST SEGMENT IN THE PROGRAM) IN THIS CASE EOF IS REACHED * INSTEAD OF THE NEXT SEGMENT. THIS IS DETECTED BY THE FILE * READ ROUTINE. IF ONE OXR MORE NAMS ARE ENCOUNTERED AFTER THE * SEGMENT BUT BEFORE THE NEXT SEGMENT OR EOF THEN * CONTROL IS TRANSFERED TO SCANW (A REG IS NEG). THEN #SEGS IS * MADE NEG AS A FLAG SO THAT THE NSCAN ROUTINE WILL CLOSE THE * FILE INSTEAD OF GOING OF TO DO A SYSTEM LIBRARY SEARCH. * * SCANW STA #SEGS SET FLAG. EOF REACHED & RESCANNING FILE CLA STA SCSEG CLEAR SCAN TILL SEG FOUND FLAG SCANX CCA SET THE RESCAN FLAG HERE.(NOT BELOW) STA RSCNX JSB LOCF SAVE OUR CURRENT POSITION DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA ANY ERRORS ? JMP DORWN YES ! LDA IREC GET THE RECORD # CPA P2 IF REC # IS 2, THEN DON'T SCAN FILE JMP NOSCN * DUMMY JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF P1 DEF ANOP DEF ANOP * SSA,RSS ANY ERRORS ? JMP SCFLG NO, SO GO SET THE FLAGS DORWN LDA F1 YES JMP FLERR SO REPORT THE ERROR * SCFLG CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA STA IDCB1+13 CMA STA LIBFL IS A SCAN OF LIBRARY STA NUPLS NO ROUTINES LOADED STA PLFLG NAM MUST BE FIRST JMP RREAD NOW GO SCAN THE FILE * ANOP NOP * * * THE NSCAN ROUTINE SETS THE FILE BACK TO THE ORGINAL * LOCATION BEFORE THE SCANX ROUTINE REWOUND IT. * * NSCAN ISZ NUPLS ANYTHING LOADED LAST SCAN ?? JMP DUMMY SO DO IT AGAIN * JSB APOSN SET THE FILE BACK UP DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA ANY ERRORS ? JMP DORWN YES NOSCN CLA WE NEED TO RESET A FEW FLAGS STA LIBFL NOT A LIBRARY SCAN STA RSCNX NO LONGER RESCANNING THE FILE * LDB #SEGS GET THE # OF SEGS LOADED FLA G SSB,RSS WAS THE RESCAN DUE TO EOF OR NEW SEGMENT JMP LOADX NEW SEGMENT. SCAN SYS LIB FOR OLD SEG JMP RECLS EOF. SO GO CLOSE THE FILE . * * IREC NOP IRB NOP RSCNX NOP 0/-1 NO RESCAN/ RESCAN OF FILE IN PROGRESS IOFF NOP LGOU NOP LG (SYS LIBRARY) IN USE FLAG #SEGS NOP #OF SEGMENTS IN THIS FILE FLAG * SKP * TEST FOR VALID REC * TESTR LDA LBUF+1 GET REC IDENTIFIER ALF,RAR AND M7 ISOLATE RIC STA RIC SAVE REC ID CODE SZA SKIP - ABSOLUTE REC ADA L6 SUBTRACT 6B SSA,RSS SKIP - VALID REC TYPE JMP RCERR INVALID REC TYPE * TEST FOR VALID CHECKSUM LDA LBUF GET REC LENGTH AND M7400 AND ZERO LOWER CHARACTER, STA B BLF,BLF ROTATE TO LOW B CMB,INB COMPLEMENT ADB P3 ADJUST FOR ADDR OF WORD 4 SSB,RSS SKIP - VALID REC LENGTH JMP RCERR INVALID (SHORT) REC STB WDCNT SET WORD COUNT FOR CHECKSUM LDA LBUF+1 GET WORD 2 - INITIALIZE CHECKSUM LDB ALBUF GET ADDR OF LBUF ADB P3 ADJUST ADDR FOR WORD 3 TEST1 ADA B,I ADD WORD TO CHECKSUM INB INCR CURRENT LBUF ADDR ISZ WDCNT SKIP - END OF REC JMP TEST1 CONTINUE CHECKSUM TEST CPA LBUF+2 EQUAL TO GIVEN CHECKSUM? JMP LDRC YES - PROCESS REC * * CHECKSUM ERROR. PRINT MODULE NAME * (MODULE NAME WILL BE IN MBUF IF A NAM REC * HAS ALREADY BEEN READ. OTHERWISE, IT WILL NOT * BE PRINTED SINCE IT MAY BE GARBAGED IN THE * THE NAM RECORD ITSELF. * JSB CPRNM PRINT NAME IF ANY LDA ERR01 CODE 01 = CHECKSUM ERROR LSUSP JSB ERROR PRINT DIAGNOSTIC ON SYSTEM TTY JMP ABORT GO ABORT THYSELF * ERR01 ASC 1,01 ERR02 ASC 1,02 * * * ILLEGAL RECORD TYPE * s> RCERR EQU * JSB CPRNM PRINT MODULE NAME,IF GOOD LDA ERR02 CODE 02 = ILLEGAL REC JMP LSUSP * * PRINT NAME OF MODULE(OR ENTRY POINT) * * CALLING SEQUENCE: * JSB PRNAM * DEF TO NAME TO BE PRINTED * * PRNAM NOP PRINT 5 CHARACTERS LDA P5 LDB PRNAM,I GET NAME ADDR ISZ PRNAM BUMP FOR RETURN JSB SYOUT PRINT MESSAGE JMP PRNAM,I RETURN * * CHECK IF GOOD REC HAS BEEN READ BEFORE * PRINT NAME. * CPRNM NOP LDA MBUF GET "VALID NAME" FLAG SZA,RSS NAME READ? JMP CPRNM,I NO, EXIT JSB PRNAM PRINT NAME DEF MBUF JMP CPRNM,I EXIT * * CLASSIFY RECS BY TYPE LDRC LDA RIC GET REC IDENTIFICATION CODE LDB PLFLG GET LOADING FLAG CPA P1 TYPE = NAM ? JMP NAMRX YES - PROCESS NAM REC SZB SKIP - NOT LOADING JMP NMERR REC OUT OF SEQUENCE CPA P2 TYPE = ENT? JMP ENTR YES - PROCESS ENT REC CPA P3 TYPE = DBL? JMP DBLR YES - PROCESS REC CPA P4 TYPE = EXT? JMP EXTR YES - PROCESS EXT REC * SKP * * *** PROCESS END RECORD *** * * * JSB BREAK SEE IF WE SHOULD BREAK LDA IGNOR SZA,RSS LATEST SUBROUTINE LOADED ? JMP RESET YES, PROCESS AS NORMAL. * LDA BID3 NO, THEN RESTORE CURRENT STA CWABP FW AVAILABLE ON BASE PAGE. LDA BID4 AND END OF LST. STA PLST JMP NOCLR SKIP CLEARING OF BIT15 IN LST1 * * TEST FOR OVERFLOW OF COMMON * RESET LDA MCOMX GET COMMON LENGTH OF LAST MODULE CMA,INA SUBTRACT FROM INITIAL SET LENGTH ADA MXCOM SSA,RSS IF SAME OR LESS JMP NOCLR THEN OK * * COMMON ALLOCATION ERROR * CMERR JSB CPRNM PRINT MODULE NAME LDA ERR0&6 ELSE ERROR 06 - COMMON BLOCK JMP ABOR ERROR. ERR06 ASC 1,06 MCOMX NOP LEN OF LAST MODULE SCANNED/LOADED * NOCLR LDA XBUFA RESET ADDR OF CPA XCUR IF ALREADY SET JMP NOUSE THEN NO USE CHECKING FURTHER LDB XBHLF GET THE ODD SEC BOUNDARY CMB,INB ADB XCUR IS CURRENT IN EVEN OR ODD SZB IF ZERO THEN IN LOWER HALF SSB LDA XBHLF SET FOR ODD SECTOR STA XCUR LGO BUFFER ON END REC. LDB N128 SET DOWN COUNTER TO PROPER VALUE CPA XBHLF LDB N64 STB LGT1 NOUSE CLA SET REC INDEX STA XCNT = 0 TO GET SECTOR. LDA ALBUF GET ADDR OF LBUF ADA P3 ADJUST FOR WORD 3 OF END REC STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET PRIMARY ENTRY POINT FLAG SLA,RSS SKIP - HAS PRIMARY ENTRY POINT JMP NOPRE OMIT PROCESSING NO ENTRY POINT SKP * * * PRINT MEMORY MAP ENDKY LDA PRENT,I GET PRIMARY ENTRY POINT. SZA SKIP - PRENT NOT SET JMP ENDK1 TEST FOR DEBUG LOADED LDA LBUF+3 GET WORD 3 OF END REC ADA PPREL ADD PROG RELOC BASE STA PRENT,I SET IN ID SEGMENT LDA MBUF GET PROG NAME 1,2 STA NAM12,I SET IN ID SEGMENT LDA MBUF+1 GET PROG NAME 3,4 STA NAM34,I SET IN ID SEGMENT LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR PTYPE SET PROG TYPE STA NAM5,I AND SET IN ID SEGMENT. AND P7 ISOLATE PROG TYPE CPA P5 IF PROCESSING SEGMENT JMP IDSN0 THEN FORGET REMAINING PARMS LDA NPAR STORE PRIORITY SZA FROM NAME REC STA PRIOR,I IF NON-ZERO. LDA NPAR+1 IF RESOLUTION SZA,RSS CODE = 0, SKIP SETTING OTHER JMP IDSN0 TIME PARAMETERS. tNLHAND P7 PUT ALF,ALF RESOLUTION ALF,RAL CODE (3 BITS) STA B IN 15-13 LDA NPAR+2 AND AND M7770 EXECUTION MULTIPLE IOR B IN 11-00 STA RESL,I LDA NPAR+5 GET SECONDS MPY P100 SCALE TO TMS ADA NPAR+6 TMS+SCALED SECONDS STA NPAR+5 SAVE LDA NPAR+3 GET HOURS MPY P60 SCALE TO MINUTES ADA NPAR+4 ADD MINUTES MPY P6K SCALE TO TMS CLE SET FOR DOUBLE ADD ADA NPAR+5 TMS+SCALED SECONDS SEZ WAS THERE A CARRY ? INB YES, BUMP (B) SET01 CLE,SSB JMP SET02 ADA NDAY+1 SEZ,CLE INB ADB NDAY JMP SET01 SET02 DST TMDY1,I SAVE FOR ID SEG * `N SKP * TEST FOR DUPLICATE PROG NAMES IDSN0 CCA STA NMFLG SET PROG NAME FLAG IDSN JSB MIDN FIND THE ID IF ONE JMP NOPRE NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG EDITING, IGNORE DUPLICATE, JMP NOPRE AND CONTINUE. * LDA MBUF GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA MBUF+1 NAME MESSAGE BUFFER STA MESS7+13 LDA MBUF+2 STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP ABORT INVALID RESET PROG NAME LDA RENAM GET ASCII '##' STA MBUF SET PROG NAME 1,2 = '..' STA NAM12,I IN BOTH COPIES. JMP IDSN REPEAT DUPLICATE PROG NAME SCAN SPC 1 P27 DEC 27 M7770 OCT 7777 NPAR BSS 7 NAME RECORD PARAMETERS RENAM ASC 1,.. MESS7 DEF *+1 ASC 14,DUPLICATE PROG NAME - * SPC 1 ENDK1 JSB DEBUG TEST FOR DEBUG LOADED NOPRE CCA STA PLFLG SET 'LOOK FOR NAM' FLAG LDA IGNOR SZA,RSS IF LAST SCAN USEFUL JSB MAPPR THEN PRINT MEM MAP & UPDAT BASE * JSB INLST INITIALIZE LSTX LDB TLST CPORD CPB PLST END OF LST ? JMP SLTST YES - SET UP NEXT OPERATION ADB P2 CLEAR POSSIBLE ORDINAL LDA B,I FROM LST 3. AND M7400 STA B,I ADB P3 JMP CPORD CONTINUE CLEARING PROG ORDINALS SPC 1 * SLTST CLA CLEAR "VALID NAME" FLAG STA MBUF LDA SLIBF GET DISC LIB LOAD FLAG SZA LOADING SYSTEM LIB ? JMP RSET? YES, CHECK ON NEXT OPERATION. * LDA MSEG THIS A SEGMENTED PROG ? CPA P2 WELL ? RSS YES JMP LDRIN * LDA PROGT GET THE PROG TYPE CPA P5 A SEGMENT ? RSS YES JMP LDRIN * LDA LIBFL THIS A SCAN OR A LOAD SZA WELL ? JMP LDRIN A SCAN * CCA A LOAD, SO CHANGE IT TO A SCAN STA LIBFL CLA,INA AND SET THE SCAN TILL SEGMENT FLAG STA SCSEG JMP LDRIN * NMFLG NOP PROG NAME FLAG COMIN NOP COMMON DECLARATION FLAG MESS9 DEF COM ACOM3 DEF COM+3 ACOM6 DEF COM+6 COM ASC 9,COM SEGM NOP SKP * MAPPR NOP LDB PLGTH GET LEN WORD SZB IF ZERO OR SSB COMPILER PRODUCED JMP MAPP1 FORGET THE BSS FILL * ADB N1 ELSE SET TO RELATIVE ADDR OF ADB PPREL GET REAL CORE ADDR STB A INA CPA TPREL WAS IT LOADED? JMP MAPP1 YES SKIP THE FILL * CLA NO FILL THE BSS WITH ZERO'S JSB OUTAB OUTPUT FILL WORDS MAPP1 JSB PRMAP PRINT MEM MAP & UPDATE BASES JMP MAPPR,I RETURN * * * * WHEN LOADING AND A TYPE 5 NAM IS ENCOUNTERED * THEN CONTROL TRANSFERS HERE. ALL RELOCATABLE READ * POINTERS ARE SAVED AND THE SYSTEM LIBRARY IS SCANNED * FOR THE LAST MAIN OR SEGMENT. * * SEOF LDA MSEG GET THE SEGMENT LOADING FLAG SZA,RSS IS IT SET ? ISZ MSEG NO, SO SET IT. CLA CLRAR THE SCAN TILL SEGMENT FLAG STA SCSEG LDB SEGM GET THE SEGMENT BASE ADDRESS CPB PPREL IF SAME AS CURRENT SEGMENT THEN JMP NAMR1 LAST SEGMENT LOADED. THIS IS NEW ONE * LDA PTYPE GET THE PROG TYPE CPA P2 IS IT RT JMP LL23 YES, SO ITS AN ERROR * ISZ #SEGS INCREMENT THE # OF SEGS IN THIS FILE FLAG LDA N60 GET NEG COUNT JSB MOVE DEF LBUF SOURCE OF MOVE DEF SGNAM DESTINATION (SEGMENT NAM BUFFER) * LDA TYPE1 GET THE INPUT TYPE WORD ERA,SLA WHERE OIS THE INPUT FROM ? RSS A FILE JMP LOADX SO FOR GET ABOUT ANY RESCAN * LDA RSCAN GET THE RESCAN FLAG SZA,RSS RESCAN THIS FILE BEFORE SYS LIB SEARCH ? JMP SCANX YES ! * CCA NO, SET A FLAG TO ALLOW THE RESCAN STA RRSCN ON UNDEFS ! (20% FASTER ON THIS PATH) JMP LOADX * * RRSCN NOP 0/-1 NO FILE RESCAN/ALLOW RESCAN ON UNDEFS RSCAN NOP 0/1 NO/YES VARY SYS LIB SCAN SEQUENCE SCSEG NOP 0/1 NO / YES SCAN TILL SEGMENT FOUND #NAMS NOP # OF NAMS FOUND AFTER SEG & BEFORE NEXT SEG * * LL23 LDA ERR23 GET THE ERROR FLAG JMP ABOR AND ABORT THYSELF ERR23 ASC 1,23 * SKP * PROCESS NAM REC NAMRX SZB,RSS SKIP - VALID REC SEQUENCE JMP NMERR REC OUT OF SEQUENCE LDA FWABP GET DUMMY BP BASE CMA,INA AND SUBTRACT FROM ADA CWABP CURRENT DUMMY BP LOCATION. ADA BPFWA ADD OFFSET TO REAL BP BASE STA BPREL AND SET AS NEW BP REL BASE CLA SET UP FLAG TO 'NOT IGNORE' STA IGNOR LDA LBUF+9 GET PGM TYPE STA PROGT AND SAVE IT. LDA LIBFL ADA SCSEG SZA IF SCANNING LIB JMP NAMR1 THEN AVOID SEGMENT LOOKUP. LDB LBUF+9 GET THE NAM TYPE CPB P5 IF SEGMENT JMP SEOF SEE IF THIS FIRST ONE & SAVE NAM BUFFER SPC 1 * NAMR1 LDA SCSEG IS THIS A SCAN TILL NEXT SEG FOUND ? SZA WELL ? ISZ #NAMS YES. * LDA LBUF+8 GET COMMON LENGTH STA MCOMX SET COMMON LENGTH SZA,RSS SKIP - HAS COMMON JMP COMOK NO COMMON, TEST B.P. LENGTH LDB LIBFL GET THE SCAN FLAG SZB IF A SCAN CHECK AT END RECORD JMP COMOK ISZ COMIN YES, HAS COMMON. SKIP IF FIRST & LOCAL. JMP CO*MOK ASSUME COMMON OK TILL 'END' IS READ * LDB URFWA GET THE BASE LOAD ADDRESS ADB P2 ACCOUNT FOR THE X&Y REGISTERS CPB TPREL COMPARE TO HIGH MAIN RSS = , SO COMMON DECLRATION OK JMP CMERR COMMON ERROR STA MXCOM FIRST COMMON, SET MAX LENGTH LDA FWA ADJUST RELOCATION BASES SPC 1 ADA P2 2 WORDS FOR X-Y REG SAVE SPC 1 STA COMAD SET FWA OF COMMON (LOCAL) LDB ACOM3 GET ADDR OF COMMON MSG (LOW) JSB CONVD CONVERT LOWER COMMON BOUND LDA COMAD ADA MXCOM COMPUTE COMMON UPPER BOUND + 1 SPC 1 IFN * BEGIN NON-DMS CODE *************** STA FWA DON'T ZERO LOCAL COMMON IN RTE-II STA TPREL *** END NON-DMS CODE *************** XIF SPC 1 STA PPREL SET AS LOW PROG BOUND ADA N1 ACTUAL LWA COMMON LDB ACOM6 GET ADDR OF COMMON MSG (HI) JSB CONVD CONVERT UPPER COMMON BOUND LDA PLIST GET LIST/NO LIST FLAG SLA SKIP TO LIST MEMORY BOUNDS JMP NAMR2 OMIT LISTING, TEST COM BOUNDS. LDA P18 LDB MESS9 ADDR OF COMM BUF JSB DRKEY LIST COMMON BOUNDS NAMR2 LDA LWA CMA,INA COMPUTE LENGTH LEFT OVER AFTER ADA PPREL COMMON ALLOCATION. SSA SKIP IF INVALID COMMON LENGTH JMP COMOK COMMON DECLARATION IS OK * * MEMORY OVERFLOW ERROR * LGERR JSB CPRNM PRINT MODULE NAME LDA ERR03 03 = MEMORY OVERFLOW JMP ABOR ERR03 ASC 1,03 ERR09 ASC 1,09 * * RECORD OUT OF SEQUENCE * NMERR JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR09 09 = REC OUT OF SEQUENCE JMP LSUSP SYMAD BSS 1 ADDR OF SYMBOL RELOCATION MXCOM NOP MAX COMMON LENGTH * * COMOK CLA SET UP FLAG TO STA PLFLG "NAM HAS BEEN READ" JSB SEMAP SET PROG NAME IN MEM MAP LDA LIBFL GET LIB SCAN FLAG SZA,RSS SCANNING LIB ? JMP PGOCK NO, CHECK FOR PROG LENGTH LDA PLST SAVE STA BID4 END OF LST ADDR LDA CWABP NEXT AVAILABLE WORD ADDR ON BP STA BID3 CCA STA IGNOR SET FLAG "TO IGNORE" PGOCK LDA LBUF+7 GET BP LENGTH SZA,RSS ANY BP RELOCATION ? JMP LDRIN NO, THEN GET NEXT REC. CMA,INA SET NEGATIVE LENGTH OF STA ABT1 BASE PAGE AREA NEEDED. BPCLR JSB ALLOC MOVE CWABP BY SAME ISZ ABT1 ZEROED AND MOVED ALL ? JMP BPCLR NO, THEN DO MORE. JMP LDRIN GET NEXT REC * PROGT NOP PROG TYPE BEING SCANNED P100 DEC 100 P60 DEC 60 P6K DEC 6000 M37 OCT 37 SKP * * THE INLST AND LSTX SUBROUTINES SET THE ADDRES FOR THE CURRENT * ENTRY IN THE LOADER SYMBOL TABLE (LST). * * INITIALIZE LSTX * * INLST SETS THE ADDRESS OF THE FIRST ENTRY IN LST IN TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INLST * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INLST NOP LDA BLST GET STARTING ADDR OF LST STA TLST SET CURRENT LST ADDR JMP INLST,I RETURN * * SPECIAL ROUTINE "SILST" * * THIS ROUTINE INITIALIZES THE LST FOR THE * BACKGROUND SEGMENT AREA ONLY, IF MAIN/SEGMENT * LOADING IS BEING DONE. IT USES THE CONTENTS * OF "SLST" - SLST IS INITIALIZED TO BE = TO * "BLST" BUT IS CHANGED AFTER THE "MAIN" PROG * IS LOADED TO BE THE ADDR OF THE ENTRY * FOLLOWING THE LAST ENTRY FOR THE MAIN. * * SAME CALLING SEQUENCE AS FOR "INLST". * SILST NOP LDA SLST SET SEGMENT LST ADDR STA TLST AS CURRENT ADDR. JMP SILST,I * * THIS ROUTINE INITIALIZES START OF LST TO BEGIN JUST * AFTER THE END OF RESIDENT LIB LST (START OF THE LST * BUILT FROM USER'S PROG) * FNLST NOP LDA FLST STA TLST JMP FNLST,I * * Oq* SET CURRENT LST ADDRES * * THE LSTX SUBROUTINE SETS THE CURRENT LST ADDRES FROM TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSTX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * LSTX NOP LDA TLST GET CURRENT LST ADDR CPA PLST END OF LST? RSS YES - CONTINUE ISZ LSTX NO - INCR RETURN ADDR STA LST1 SET WORD 1 ADDR INA STA LST2 SET WORD 2 ADDR INA STA LST3 SET WORD 3 ADDR INA STA LST4 SET WORD 4 ADDR INA STA LST5 SET WORD 5 ADDR INA STA TLST SET NEXT LST ADDR CMA,INA ADA TFIX ADD FWA OF DUMMY ID SEGMENT AREA SSA,RSS IF RESULT = 0 OR <0, SZA,RSS THEN ERROR JMP LOVER OVERFLOW. JMP LSTX,I -OK, RETURN. * * * * SCAN TO SEE IF ANY UNDEFINED * (REGS MEANINGLESS ON ENTRY AND RETURN) * JSB LSTX1 * (P+1) RETURN - NO UNDEFINED * (P+2) RETURN - UNDEFINED EXIST * LSTX1 NOP JSB FNLST START LST FROM USER MAIN LDA MSEG BUT IF CPA P2 LOADING A SEGMENT JSB SILST THEN START FRM SEGMENT'S LST. LDB TLST GET CURRENT LST ADDR LSTX2 CPB PLST END OF LST ? JMP LSTX1,I YES - RETURN (P+1) ADB P3 LDA B,I GET LST4 AND P7 MASK IN STATUS CPA P2 UNDEF EXT ? JMP YEXT YES ADB P2 POINT TO NEXT SYMBOL JMP LSTX2 SEE NEXT SYMBOL YEXT ISZ LSTX1 UNDEF FOUND - BUMP RETURN ADDR JMP LSTX1,I RETURN (P+2) SKP * * READ DISK REC TO DBUF * * THE DREAD SUBROUTINE READS A DISK REC (1 SECTOR) TO DBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DREAD * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DREAD NOP JSB EXEC REQUEST DISK REA\QD DEF *+7 DEF P1 READ REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. ADBUF DEF DBUF ADDR OF DISK I/O BUFFER DEF P128 NO. WORDS DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DREAD,I RETURN SPC 2 * * WRITE DBUF TO DISK * * THE DWRIT SUBROUTINE WRITES THE CURRENT REC ON THE DISK. * THE ADDRESS OF THE REC IS CONTAINED IN DISKO * AND THE LENGTH OF THE REC IN DLGTH. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DWRIT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DWRIT NOP JSB EXEC REQUEST DISK WRITE DEF *+7 DEF P2 WRITE REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. DEF DBUF ADDR OF OUTPUT BUFFER DEF P128 BUFFER LENGTH DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DWRIT,I RETURN * * * * * TEST AND SET FOR DEBUG CONTROL * * DEBUG TESTS IF THE CURRENT PROG LOADED WAS DEBUG. IF IT WAS, * THE PRIMARY ENTRY POINT OF THE PROG IS SET INTO * 'DEBUG', THE PRIMARY ENTRY POINT OF DEBUG IS SET INTO THE * ID SEGMENT, AND THE ADDR OF DEBUG IS SET TO BE INDIRECT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DEBUG * * RETURN: CONTENTS OF A AND B ARE DESTROYED,. * DEBUG NOP LDA IGNOR YES SO SEE IF THIS MODULE IS DEBUG SZA IF LAST SCAN WAS USELESS JMP DEBUG,I THEN DON'T LOOK FOR MATCH LDA MBUF GET PROG NAME 1,2 CPA CHRDE CHARS = D,E? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' LDA MBUF+1 GET PROG NAME 3,4 CPA CHRBU CHARS = B,U? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' LDA MBUF+2 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR CPA UCHRG CHAR = G? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' * JSB SILST INITIALIZE FOR SEGMENT DSCAN JSB LSTX SET LST ADDRES HLT 0 'DEBUG' NOT FOUND IN LST LDA LST1,I GET NAME 1,2 CPA CHRDE CHARS = D,E? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST2,I GET NAME 3,4 CPA CHRBU CHARS = B,U? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR CPA UCHRG CHAR = G? RSS YES - CONTINUE JMP DSCAN NO - TRY NEXT LST ENTRY * LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN STATUS CPA P2 UNDEFINED ? HLT 0 'DEBUG' IS UNDEFINED LDA PRENT,I THE PROG OR SEG PRIMARY ENT POINT LDB LST5,I AND PUT IT INTO ENTRY POINT JSB OUTAB 'DEBUG'(ON THE DISC) * LDA CURAL,I GET DEBUG TRANSFER ADDR ADA PPREL ADD CURRENT PROG RELOCATION ADDR STA PRENT,I SET 'DEBUG' TRANSFER IN ID SEG. * JMP DEBUG,I RETURN * * PROCESS ENT,EXT RECS * ENTR CCA,RSS ENT REC PROCESSOR EXTR CLA EXT REC PROCESSOR STA NXFLG SET ENT/EXT FLAG = -1/0 * LDA LIBFL GET THE LIBRARY SCAN FLAG SZA,RSS SCANNING LIBRARY JMP ADDON NO LDA PROGT YES, SO GET THE PROGRAM TYPE CPA P5 IS IT A SEGMENT ? JMP LDRIN YES, SO FORGET IT ADDON LDA LBUF+1 GET NO. SYMBOLS AND M37 ISOLATE SYMBOLS CMA,INA STA EXCNT SET ENT/EXT SYMBOL COUNT LDB ALBUF GET ADDR OF LBUF ADB P3 NEXSY LDA B,I GET SYMBOL 1,2 STA TBUF SAVE NAME 1,2 INB LDA B,I GET SYMBOL 3,4 STA TBUF+1 SAVE NAME 3,4 INB LDA B,I GET SYMBOL 5 STA TBUF+2 SAVE NAM<E 5 INB STB SYMAD SAVE SYMBOL ADDR (FOR ENT) * LDB NXFLG GET ENT/EXT FLAG SZB,RSS SKIP - SET ENT ABSOLUTE ADDR JMP NOTEN OMIT SETTING ABS. ADDR FOR EXT AND P7 MASK IN RELOCATION BASE TYPE STA ENTYP SAVE ENT TYPE CLB CPA P4 IF TYPE 4 ENT JMP TYP4 THEN GO SET IT UP. ADA ENTRL ADD RELOCATION BASE ADDR LDB A,I GET PROPER RELOCATION BASE TYP4 ADB SYMAD,I ADD TO GET ABSOLUTE ADDR STB OPRND AND SAVE IT NOTEN JSB LSCAN SCAN LST FOR NAME JMP ENTX3 END OF LST * LDA LST4,I SET UP STATUS OF AND P3 SYMBOL MATCHED WITH. STA ENTST LDA LIBFL SZA,RSS SCANNING LIB ? JMP NRML NO LDA NXFLG SZA,RSS PROCESSING ENT ? JMP NRML NO LDA ENTST GET SYMBOL STATUS CPA P2 ENT MATCHED WITH EXT ? RSS YES - THEN IT IS OK. JMP ENTX5 NO - THEN FORGET IT. NRML LDA NXFLG GET ENT/EXT FLAG SZA,RSS SKIP - PROCESS ENT JMP ENTX4 COMPLETE EXT PROCESSING * LDA ENTST GET STATUS OF SYMBOL CPA P2 IF STATUS = 2 (UNDEF SYMBOL) JMP ENT2X THEN SET ENT ABS VALUE FOR EXT * * DUPLICATE ENTRY POINT * JSB CPRNM PRINT MODULE NAME JSB PRNAM PRINT ENTRY POINT NAME DEF TBUF LDA ERR07 07 = DUPLICATE ENT JMP ABOR * ERR07 ASC 1,07 * ENT2X LDA ENTYP GET ENT TYPE ALF,ALF POSITION ENT TYPE LDB LIBFL GET LIB SCAN FLAG SZB,RSS IF SCANNING LIB INA THEN SKIP THIS INSTRUCTION STA LST4,I SET LST4 CLA STA IGNOR SET TO 'NOT IGNORE' FOR LIB INA STA NUPLS SET FLAG FOR 'SOME LIB LOADED' LDA OPRND OPERAND IN IT STA LST5,I SET VALUE INTO LST. JSB FIXAL FIX ALL REFERENCES JMP ENTX5 COMPLETE ENT PROCESSING * SKP * ENTX3 JSB SELST SET NAME INTO LST LDB NXFLG GET ENT/EXT FLAG SZB,RSS PROCESSING EXT ? JMP EXTNM YES LDA ENTYP ALF,ALF POSITION ENT TYPE LDB LIBFL SZB,RSS LIB SCAN ? INA NO, THEN SET STATUS = 1. STA LST4,I SET LST4 LDA OPRND SET SYMBOL VALUE STA LST5,I AND SET JMP ENTX5 IN LST5. COMPLETE ENT PROCESSING. * EXTNM LDA P2 STATUS = 2 FOR EXT STA LST4,I SET UP LST4 FOR EXT ENTX4 LDA TBUF+2 GET CHAR 5, ORDINAL STA LST3,I SET ORDINAL INTO LST ENTX5 LDB SYMAD GET SYMBOL ADDR LDA NXFLG GET ENT-EXT FLAG SZA SKIP - EXT INB INCR SYMBOL ADDR FOR ENT ISZ EXCNT SKIP - ALL SYMBOLS PROCESSED JMP NEXSY PROCESS NEXT SYMBOL JMP LDRIN READ NEXT REC * EXCNT BSS 1 EXT/ENT SYMBOL COUNT NXFLG BSS 1 EXT/ENT FLAG ENTYP BSS 1 ENT TYPE BEING PROCESSED ENTST BSS 1 STATUS OF LST SYMBOL MATCHED M100 OCT 100 N5 DEC -5 * * SKP * PROCESS DBL REC DBLR LDA IGNOR SZA REC TO BE IGNORED ? JMP LDRIN YES, GET NEXT REC. * LDA LBUF+1 GET INSTRUCTION COUNT AND M77 ISOLATE COUNT CMA,INA STA EXCNT SET INSTRUCTION COUNT LDA ALBUF GET ADDR OF LBUF ADA P4 ADJUST FOR FIRST RELOCATION BYTE STA CURAL SET CURRENT LBUF ADDR LDA LBUF+1 GET WORD 2 OF DBL REC AND M300 ISOLATE REL TYPE FOR LOAD ADDR STA DBLBS SAVE FOR LATER LDB LBUF+3 GET THE RELOCATION ADDRESS CPA M100 IF = 1 JMP MBASE THEN PROG RELOCATABLE. ADB BPREL RELOCATE THE LOAD ADDRESS FOR BP. SZA IF = 0 THEN BASE PAGE RELOCATABLE JMP RCERR ELSE ERROR 2 - ILLEGAL REC. [ JMP DBL0 FOR BP REL, AVOID FWA RESET. * MBASE ADB PPREL RELOCATE THE LOAD ADDRESS FOR MAIN MEM. ISZ DBLFL (SKIPS ONLY IF 1ST DBL OF NEW SEGMENT) JMP DBL0 * * ADJUST PROGRAM RELOCATION BASE TO LOAD ADDR IN * FIRST DBL RECORD IN EACH LOADING OPERATION TO * NOT ALLOCATE DISC SPACE FOR BSS AREAS AT THE * BEGINNING OF A PROGRAM. ALSO,THIS ALLOWS FOR * A PSEUDO COMMON REGION BETWEEN A "MAIN" PROG * AND ALL SEGMENTS IF THE SAME SIZE BSS AREA IS * DECLARED AT THE BEGINNING OF EACH SEGMENT. * LDA LBUF+3 ADJUST FWA TO BSS DISPLACEMENT ADA FWA ON DISC LOWER BOUND. STA FWA SET NEW FWA FOR LOAD OPERATION STA TPREL DBL0 STB DBLAD SET THE LOAD ADDRESS DBL1 LDB CURAL,I GET RELOCATION BYTE STB REKEY SAVE RELOCATION RYTE LDA N5 STA INSCN SET RELOCATION BYTE COUNT ISZ CURAL INCR CURRENT LBUF ADDR DBL2 LDA REKEY GET RELOCATION BYTE ALF,RAR ROTATE TO LOW A STA REKEY SET NEXT RELOCATION BYTE AND M7 ISOLATE CURRENT BYTE CPA P4 EXTERNAL REFERENCE? JMP DBL4 YES - GET LINK ADDR CPA P5 MEMORY REFERENCE? JMP DBL5 YES - CHECK FOR EXT WITH OFFSET CPA P6 BYTE ADDR ? JMP DBL6 YES ADA RBTAD ADD RELOCATION BASE TABLE ADDR LDA A,I SET RELOCATION BASE ADA CURAL,I ADD CURRENT INSTRUCTION WORD DBL3 LDB DBLAD GET LOAD ADDRESS TO B DABOT JSB OUTAB OUTPUT ABSOLUTE PROG WORD ON DISC DBL9 ISZ CURAL INCR CURRENT LBUF ADDR ISZ EXCNT SKIP - ALL INSTRUCTIONS OUT RSS NO - CONTINUE JMP LDRIN GET NEXT REC ISZ DBLAD INCR CURRENT DBL RELOCATION ADDR ISZ INSCN SKIP - GET NEW RELOCATION BYTE JMP DBL2 PROCESS NEXT INSTRUCTION JMP DBL1 GET NEXT RELOCATION BYTE DBL4 LDA CURAL,I GET CURRENT DBL WORD AND M377 ISOLATE ORDINAL )STA EXORD AND SAVE IT. CLA STA OFSET SET OFFSET = 0 JSB DBLEX SET BP LINK ADDR FOR EXT JMP DBL9 INSTRUCTION IS OUTPUT BY DBLEX * DBL5 LDA CURAL,I GET CURRENT WORD FROM LBUF RAR,RAR POSITION AND AND M377 MASK IN ORDINAL IF ANY SZA,RSS ANY ORDINAL ? JMP DBL5M NO - GO PROCESS MEM REF. * STA EXORD SET UP ORDINAL LDB CURAL GET LBUF ADDR INB BUMP TO WHERE OFFSET IS LDA B,I GET OFFSET STA OFSET AND SET OFFSET VALUE. JSB DBLEX SET BP LINK FOR EXT REF ISZ CURAL INCREMENT LBUF ADDR JMP DBL9 GO INDEX TO NEXT WORD DBL5M LDA CURAL,I GET NEXT WORD FROM LBUF ISZ CURAL INCR CURRENT LBUF ADDR JSB MREF SET ADDR FOR MEM REF INSTR JMP DBL3 OUTPUT ABSOLUTE PROG WORD DBL6 LDA CURAL,I GET WORD 1 OF THE GROUP ALF POSITION AND AND M17 MASK IN TYPE. SZA IF NON-ZERO JMP RCERR THEN ILLEGAL REC ERROR LDA CURAL,I ELSE GET WORD 1 AGAIN AND P3 MASK IN RELOCATION TYPE LDB ENTRL GET RELOCATION BASE ADB A LDB B,I FROM TABLE RBL AND COVERT TO BYTE ADDR ISZ CURAL LDA CURAL,I GET WORD 2 (BYTE ADDR) SSA IF SIGN BIT SET JMP RCERR THEN ILLEGAL REC. ADA B ADD BASE BYTE ADDR TO GET INSTRUCTION JMP DBL3 GO TO OUTPUT ON DISC OR BP * DBLBS NOP LOAD ADDR INDICATOR OFSET NOP OFFSET FOR AN EXT M17 OCT 17 * * * LOAD FROM PROG LIB * LOADX LDA PRENT,I GET PRIMARY ENTRY POINT SZA SKIP - NO PRIMARY ENTRY POINT JMP LOADN LOAD FROM PROG LIB LDA ERR08 CODE 08 = NO TRANSFER ADDR JSB ERROR PRINT DIAGNOSTIC ON SYSTEM TTY JMP ABORT AND ABORT THYSELF LOADN CCA SET NLHFLAG STA SLIBF FOR 'LOADING FROM SYS LIB' STA LIBFL 'SCANNING LIB' STA LGOU DUMMY UP 'LG BEING USED' FLAG STA LSTBK SET UP POINTERS TO DISC LIB SUCH CLA THAT A NEW PHYSICAL READ STA DCNT WILL OCCUR. LDA PLIST GET LIST/NO LIST FLAG SLA,RSS SKIP LISTING ? JSB SPACE NO, THEN SPACE OVER. JMP RSET? GO FIGURE OUT THE NEXT MOVE * * * COMMAND IS TRANSFERED HERE IF AFTER A SYS LIBRARY * SCAN NO MORE UNDEFINED EXTERNALS EXIST. SPC 1 * RNDEX LDA MSEG GET THE SEGMENTED PROG FLAG SZA ARE WE SEGMENTED ? JMP SEGT YES LDA TYPE2 NO, GET THE CMND FILE TYPE SZA IS THERE A COMMAND FILE ? JMP NXTOP YES SO GET THE NEXT COMMAND JMP NODEX NO, SO GO FINISH LOAD. * SEGT LDA TYPE2 GET THE CMND FILE FLAG WORD SZA,RSS IS THERE A COMMAND FILE !N JMP NODEX NO, MIGHT BE END OF LOAD LDA SKP.1 GET THE SE RE EXECUTED FLAG SSA HAVE WE DONE ANY OF THESE YET JMP NODEX NO, SO FINISH LOAD LDA OP? YES, GET THE LAST OPCODE CPA SE WAS IT AN SE ? JMP NXTOP YES, MUST HAVE BEEN AN SE,< > COMMAND JMP NODEX NO, WE NEED TO FINISH THE SEGMENT LOAD * * * SKP * * SCAN THE DIRECTORY OF ENTRY POINTS * SYLOK NOP LDA DCNT CPA DSCLN IF NO MORE SYMBOLS JMP EMPTY THEN RETURN WITH NO MATCH ISZ DCNT BUMP TO NEXT ENT JSB GTENT GET NEXT ENT JSB FNLST INITIALIZE TO START OF USER LST LDA MSEG IF SEG LOAD CPA P2 THEN JSB SILST INITIALIZE LST FOR SEG ONLY JSB MATCH SCAN LST FOR MATCHING NAME JMP SYLOK+1 NO MATCH - CHECK NEXT SYMBOL * GTSUB LDA TBUF+3 MATCH !(GET THIS SUB) GET SYMBOL TYPE. CPA P1 IF NOT FIXED JMP GTSU GO SET UP TO LOAD * ALF,ALF SET TYPE TO HIGH END STA B,I SET IN SYMBOL TABLE LST4 STA GTENT SAVE FOR ENT TYPE CHECK BELOW INB SET TO LST5 LDA TBUF+4 GET SYMBOL VALUE STA B,I SET IN LST5 ADB N4 SET TO LST1 STB LST1 SET FOR FIXUP * LDB GTENT GET THE SYMBOL TYPE SZB IS IT MEM RES ? JMP GTMEM NO, AN RP OR ABS LDB SSGA NOW SEE IF SSGA CPB P1 ACCESS IS ALLOWED. JMP GTMEM IT IS. CMA NO. SO IF THE ADDRESS ADA $SGAF IS ABOVE START OF SSGA SSA THEN ITS AN ERROR JMP LL24 * GTMEM JSB FIXAL FIX ALL REFERENCES JMP SYLOK+1 CONTINUE SCAN * GTSU LDA TBUF+4 GET DISC ADDR OF LIB SUB ALF,ALF RAL SET UP DISC ADDRES IN LG READ ROUTINE AND M377 STA LGTRK SET TRACK ADDR LDA TBUF+4 AND M177 SECTOR ADDR CLB,CLE ERA,RAL ERB STB LBOEF SET LIB ODD/EVEN FLAG STA LGSEC LDA XBUFA STA XCUR CLA STA LGT1 STA LGT2 STA XCNT RSS (P+1) RETURN FOR MATCH FOUND EMPTY ISZ SYLOK CCA STA IGNOR STA PLFLG STA NUPLS JMP SYLOK,I (P+2) RETURN FOR NO MATCH * * DCNT NOP CURRENT DBUF COUNT SSGA NOP 0/1 USE / DON'T USE SSGA * LL24 JSB PRNAM DEF TBUF LDA ERR24 JMP ABOR ERR24 ASC 1,24 * SKP * * * GTENT - ROUTINE TO GET AN "ENT" OFF THE DIRECTORY IN THE * SYSTEM LIBRARY. BEFORE IT IS CALLED, SECT# MUST BE SET TO * THE 15 BIT DISC ADDR IN BLOCKS. "OFLE1" MUST BE SET TO * 0 OR 16, DEPENDING IF THE DIRECTORY STARTS IN AN EVEN OR * ODD SECTOR. CALLED: * LDA ENT# THE ENTRY NUMBER ON LIB. * JSB GTENT 4 WORD ENT IN TBUF 1-4. * GTENT NOP ENTRY A-REG = ENT NUMBER ADA OEFL1 ADJUST FOR POSS. ODD SECTOR CLB DIV P32 DETERMINE THE RELETIVE BLOCK ADA BLOK# NOW THE ABS BLOCK # BLS,BLS BUMP TO REL WORD IN BLOCK ADB ETBFA BUFFER STB IOFFS SET PNTR CPA LSTBK HAS BLOCK NUMBER CHANGED? JMP GTNT1 NO, CONTINUE STA LSTBK YES, UPDATE BLOCK BUFFER JSB READD READ LU=2 OFF DISC LDB IOFFS GET INDEX INTO BUFFER GTNT1 LDA B,I GET 1ST WORD STA TBUF AND PUT IN TBUF 1- 5 INB LDA B,I GET 2DN WORD STA TBUF+1 INB LDA B,I GET 3RD WORD AND M7400 GET 5TH CHAR STA TBUF+2 XOR B,I GET LO BYTE STA TBUF+3 AND PUT IN 4TH WORD INB LDA B,I GET 4TH WORD STA TBUF+4 AND PUT IN 5TH WORD JMP GTENT,I RETURN DONE W SPC 1 P32 DEC 32 * * * SUBROUTINE TO READ A DIRECTORY BLOCK (128 WORDS) * SPC 1 READD NOP ENTRY B=BUFFER ADDR CLB A=ABS BLOCK NUMBER ALS MPY BY 2 FOR 64 WORD SECTS DIV SECT2 BY THE NUMB SECTS / TRACK STA GTNT2 SAVE TRACK # STB GTNT3 AND SECTOR NUMBER JSB EXEC READ DISC LU=2 DEF *+7 DEF P1 DEF P2 LU = 2 FOR SYSTEM DISC ETBFA DEF SBUF DEF P128 WORDS DEF GTNT2 DEF GTNT3 JMP READD,I SPC 1 LSTBK DEC -1 IOFFS NOP GTNT2 NOP GTNT3 NOP SPC 1 * * LIBFL NOP SLIBF NOP REKEY NOP INSCN NOP ERR08 ASC 1,08 * * * * SKP * * SET UP DISC ADDRESSES , SECTOR OFFSET AND SYMBOL * COUNT TO SCAN DIRECTORY FROM START. * CSUBR NOP JSB LSTX1 ANY UNDEFINED ? JMP RNDEX NO CLA SET UP FOR LIB SCAN STA DCNT JMP CSUBR,I YES - THEN RETURN * * SCAN OF THE SYSTEM LIBRARY STARTS HERE. ALL SYSTEM * ROUTINES LOADED RETURN HERE AFTER THE END RECORD IS * PROCESSED. * RSET? JSB LSTX1 INITIALIZE LST & ANY UNDEF ? JMP RNDEX NO EXIT LOOP * JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB * JSB CSUBR INITIALIZE LST & ANY UNDEF ? JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB JSB CSUBR TAKE ONE LAST LOOK AT THE SYM TABLE * * SPC 1 * CONTROL IS TRANSFERED HERE WHEN THE ENTIRE SYS LIB HAS BEEN * SCANNED AND UNDEFINED EXTERNALS REMAIN. WE NOW DECIDE WHAT * TO DO WITH THE UNDEFS. * CAN GET HERE UNDER THE FOLLOWING CONDITIONS : * 1. LOADING MAIN & SEG ENCOUNTERED. * 2. LOADING SEG & NEXT SEG ENCOUNTERED. * 3. SE,<> COMMAND * 4. END OF RELOC INPUT FROM LU OR FILE & NO COMMAND FILE. * * DNON1 LDA TYPE2 NO, IS THERE A COMMAND FILE OPEN? SZA IS THERE ? X JMP SE..? YES SEE WHAT LAST COMMAND WAS DNON2 LDA MSEG IS THE PROG SEGMENTED ? SZA,RSS WELL? JMP FLUSH NO, FLUSH THE TURKEY !!! ISZ RRSCN DO WE RESCAN THE ENTIRE FILE ? RSS NO JMP SCANX YES * CPA P1 IS THIS THE MAIN OF THE SEG JMP NODEX YES SO LOAD IT ANYWAY * FLUSH JSB PUDF MAIN OR SEG W/UNDEFS, SO LIST THEM LDA FORCD IS THE FORCE SSA FLAG SET? JMP FIXCL YES,GO FIX THE FIX UP TABLE JMP ABORT NO, SO ABORT THYSELF * * * LIST UNDEFINED EXTS * * PUDF NOP ENTRY POINT CLA SET UP FLAG FOR NO UNDEFS STA UN# LDA DONE? GET THE PARAMETER CHECK DONE FLAG SZA,RSS ANY PARAMETER CHECKS DONE ? JMP NPUDF NO, THUS NO UNDEFS LDA P14 LDB MESS3 MESS3 = ADDR: UNDEFINED EXTS JSB SYOUT PRINT: UNDEFINED EXTS JSB FNLST INITIALIZE LSTX * LDA MSEG IF LOADING CPA P2 A SEGMENT, INITIALIZE JSB SILST FOR IT IN LST. * XSCAN JSB LSTX SET LST ADDRES JMP PSUSP END OF EXTS LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED SYMBOL ? RSS YES - THEN SKIP JMP XSCAN TRY NEXT LST ENTRY ISZ UN# INCREMENT THE UNDEFS # LDA P5 LDB LST1 GET ADDR OF SYMBOL JSB SYOUT PRINT UNDEFINED EXT JMP XSCAN TRY NEXT LST ENTRY * PSUSP LDA UN# GET THE # OF UNDEFS SZA ARE THERE ANY UNDEFS ? JMP PUDF,I YES, LIST IS PRINTED * NPUDF LDA P12 LDB NMESS JSB SYOUT TELL THE FOLKS NO UNDEFS JMP PUDF,I RETURN TO CALLER * CONSTANTS * MESS3 DEF *+1 ASC 7,UNDEFINED EXTS NMESS DEF *+1 ASC 6, NO UNDEFS IGNOR NOP UN# NOP SKP p * SE..? LDA SKP.1 HAS ANY RE OR SE COMMAND BEEN EXECUTED ? SSA WELL JMP DNON2 NO, SO FORGET ABOUT THE SE COMMAND * LDA OP? GET THE LAST OPCODE CPA SE WAS IT A SEARCH (IE NO NAMR) JMP NXTOP YES SO GET THE NEXT OPCODE JMP DNON2 NO, GO SEE IF IT WAS A FORCED LOAD * * * JMP DEBUG,I RETURN * * * PRINT MESSAGE ON LIST DEVICE * * THE DRKEY SUBROUTINE PRINTS A MESSAGE ON THE LIST OUTPUT DEVICE. * * CALLING SEQUENCE: * A = NO. CHARACTERS (POS.) TO BE PRINTED. * B = ADDRESS OF MESSAGE * JSB DRKEY * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DRKEY NOP STA CHAR# SAVE THE # OF CHARACTERS * ADB N1 BACK THE ADDRESS UP BY ONE STB MADDR AND SAVE FOR LU WRITE STB MADDF OR FILE WRITE LDA B,I GET THE WORD PRIOR TO THE BUFFER STA LTEMP AND SAVE IT LDA BLNK2 GET A BLANK STA B,I AND PUT IT IN THE BUFFER * LDB CHAR# GET THE # OF CHARACTERS ADB P3 ALLIGN TO A WORD & ACCOUNT FOR THE BLANK CLE,ERB DIV BY 2 . NOW HAVE WORD COUNT STB COUNT SAVE FOR LU OR FILE WRITE * LDB CHAR# GET THE # OF CHARS SLB,RSS ODD # ? JMP GOWRT NO, SO WRITE THE BUFFER OUT CCB INDEX ADB MADDR THE THE LAST WORD LDA B,I GET IT & PUT A BLANK AND M7400 IN THE LOW END ADA D32 STA B,I * GOWRT LDA TYPE3 OK, SO NOW FIND OUT WHERE THE ERA,SLA WRITE GOES JMP WFILE A FILE * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE REQUEST CODE DEF LISTU ADDR OF LIST OUTPUT UNIT NO. MADDR DEF 0 BUFFER LOCATION DEF COUNT CURRENT WORD COUNT LDA LTEMP GET AND RESTORE STA MADDR,I THE ALTERED WORD JMP DRKEY,I * WFILE JSB WRITF A DO THE FILE WRITE DEF *+5 DEF IDCB3 DEF IERR3 MADDF NOP BUFFER ADDRESS DEF COUNT BUFFER LENGTH * LDB LTEMP GET THE ALTERED WORD STB MADDR,I AND RESTORE IT SSA,RSS ANY FILE ERRORS JMP DRKEY,I NO, SO RETURN * JSB FCLOS YES, SO ATTEMPT TO CLOSE ALL FILES LDB F3 GET THE FILE NAME LDA IERR3 AND THE ERROR TYPE JMP FLERR AND REPORT THE ERROR SPC 1 COUNT BSS 1 CURRENT MESSAGE LENGTH LTEMP NOP D32 DEC 32 BLNK2 ASC 1, DOUBLE BLANK CHAR# NOP INPUT # OF CHARACTERS * * PRINT DIAGNOSTIC ON SYS. TTY. * * ERROR IS USED TO PRINT ALL DIAGNOSTIC MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ERROR CODE (ASCII) * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP STA MERR+1 SET CODE INTO ERROR MESSAGE LDA P4 LDB MESS5 MESS5 = ADDR: L XX JSB SYOUT PRINT: L XX JMP ERROR,I RETURN SPC 1 MESS5 DEF *+1 MERR ASC 2,L 77 * * NEW LINE ON LIST OUTPUT DEVICE * * THE SPACE SUBROUTINE IS CALLED TO PAGE UP THE PRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA SET COUNT = 0. LDB ALBUF B = DUMMY ADDR. JSB DRKEY NEW LINE JMP SPACE,I RETURN * * OUTPUT MESSAGE TO SYS. TTY. * * THE SYOUT SUBROUTINE PRINTS ALL DIAGNOSTICS ON THE SYSTEM * TELETYPE. THESE INCLUDE ALL OPERATOR MESSAGES AND ALL * ERROR DIAGNOSTICS. EACH MESSAGE IS PRECEDED WITH THE * CHARACTERS: * * /LOADR: * * * CALLING SEQUENCE: * A = NO. OF CHARACTERS IN MESSAGE (POSITIVE) * B = MESSAGE ADDRESS * JSB SYOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SYS_OUT NOP STB TTYAD SET MESSAGE ADDR CMA,INA STA B ARS CHANGE NO. CHARS. TO NO. WORDS STA WDCNT SET MESSAGE LENGTH ADB N8 ADJUST FOR LENGTH OF /LOADR: STB TTYNO SET NO. OF CHARACTERS IN MESSAGE * LDB SYM4 GET ADDR OF MESSAGE BUFFER SYOU LDA TTYAD,I GET WORD FROM MESSAGE STA B,I SET WORD INTO MESSAGE BUFFER INB INCR BUFFER ADDR ISZ TTYAD INCR MESSAGE ADDR ISZ WDCNT SKIP - MESSAGE MOVED TO BUFFER JMP SYOU CONTINUE MOVING MESSAGE * LDA TTYNO GET THE # OF CHARS CMA,INA LDB DSYMS AND THE ADDRESS JSB DRKEY OUTPUT MESSAGE * JMP SYOUT,I RETURN * N8 DEC -8 TTYAD BSS 1 TTYNO BSS 1 SYM4 DEF SYMES+4 SYMES ASC 20, /LOADR: DSYMS DEF SYMES POINTER TO MESSAGE BUFFER * N2 DEC -2 P64 OCT 100 P1 OCT 1 P10 DEC 10 N13 DEC -13 MEM1 BSS 1 LOW MAIN ADDR OF DUMMY ID MEM2 BSS 1 HIGH MAIN MEM3 BSS 1 LOW BASE PAGE MEM4 BSS 1 HIGH BASE PAGE DMAIN BSS 1 DISC ADDR OF PROG SKP * * SUBROUTINE: "SETID" * * PURPOSE: THIS ROUTINE INSURES THAT A BLANK * ID SEGMENT IS AVAILABLE FOR A PROG * ADDITION OR NORMAL BG LOAD, * ALLOCATES SPACE FOR A DUMMY SEGMENT * IN UPPER MEMORY (BELOW THE DUMMY BASE * PAGE AREA), PRESETS SOME VALUES IN * THE DUMMY ID SEGMENT, AND SETS THE * ADDRESS OF EACH WORD IN A LINK WORD * IN THE DATA SECTION OF THE LOADER. * * IF A BLANK ID SEGMENT IS NOT AVAILABLE * OR THERE ARE INSUFFICIENT NUMBER OF * SEGMENTS FOR MAIN/SEGMENT LOADING, THE * MESSAGE: * "NO BLANK ID SEGMENTS" * IS PRINTED AND THE LOADER IS SUSPENDED. * THE OPEATOR MAY DELETE A PROG FROM * THE SYSTEM (OF COMMAND) OR TERMINATE * THE LOADER. * * * CALL: (A):= 0 FOR ADDITION (BLANK ID SEG. REQ) * = 1 FOR REPLACEMENT (BLANK IDS NOT REQ) * (B)= 0 FOR LONG ID SEG (13 WORDS) * = 1 FOR SHORT ID SEG (9 WORDS) * (P) JSB SETID * (P+1) -RETURN- REGISTERS MEANINGLESS * * THE ALLOCATION OF CORE IS AS FOLLOWS : * LONG DUMMY ID SHORT DUMMY ID * ------------- -------------- * * PRIOR PRENT(ENTRY POINT) * PRENT(ENTRY POINT) NAM12 * NAM12 NAM34 * NAM34 NAM5 * NAM5 MEM1 * RESL MEM2 * TMDY1 MEM3 * TMDY2 MEM4 * MEM1 DMAIN * MEM2 * MEM3 * MEM4 * DMAIN * * SKP * SETID NOP STB TYPID SAVE LONG/SHORT FLAG ISZ ID# SZA,RSS IF NOT ADDITION, SKIP JSB COIDS ELSE COUNT THE IDS * * ALLOCATE DUMMY ID SEGMENT IN UPPER CORE. * LDB TYPID GET LONG/SHORT FLAG LDA N13 SZB SHORT ID ? LDA N9 YES, SET (A)=-9. STA SET6 SET NEGATIVE LENGTH OF ID ADA TFIX THE FIXUP TABLE STA SET2 SET NEW END LDB TFIX CURRENT ADDRESS TO B STA TFIX SET NEW END OF FIXUP TBL. SETI0 CPB IDA END OF TABLE? JMP SETI1 YES * LDA B,I NO MOVE A WORD STA SET2,I MOVE IT INB STEP THE ADDRESSES ISZ SET2 JMP SETI0 AROUND WE GO * SETI1 LDA TFIX CMA,INA TEST FOR SYMBOL ADA PLST OVERFLOW SSA,RSS WELL JMP LOVER ALL OVER NOW * LDA IDA SUBTRACT PROPER LENTH FROM ADA SET6 CURRENT ID SEG ADDR. STA IDA FOR NEW ADDR. LDB IDA SET CLA DUMMY SETI STA B,I ID INB SEGMENT ISZ SET6 = TO JMP SETI ZERO. * LDA IDA LDB TYPID GET LONG/SHORT FLAG SZB SKIP ON LONG ID JMP SHID SET UP SHORT ID SEG. STA PRIOR SET ADDR OF PRIORITY INA STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5, TYPE INA STA RESL SET ADDR OF RESOLUTION CODE INA STA TMDY1 SET ADDR OF TIME OF DAY, LS INA STA TMDY2 SET ADDR OF TIME OF DAY , MS INA STA MEM1 SET ADDR OF LOW MEMORY BOUND INA STA MEM2 SET ADDR OF HIGH MEMORY BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISK ADDR OF MAIN PROG * LDA P9999 INITIALIZE STA PRIOR,I PRIORITY = 9999 CLA STA RESL,I AND DLD NDAY INITIALIZE STB TMDY1,I TIME OF DAY, LS HALF STA TMDY2,I TIME OF DAY, MS HALF JMP SETID,I RETURN * P9999 DEC 9999 * SHID STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5 & TYPE INA STA MEM1 SET ADDR OF LOW MAIN BOUND INA STA MEM2 SET ADDR OF HIGH MAIN BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISC ADDR OF SEGMENT JMP SETID,I RETURN * * SET6 NOP TMDY1 NOP ADDR OF TIME OF DAY TMDY2 NOP SETM DEF *+1 ASC 10,NO BLANK ID SEGMENTS * ID# NOP # OF DUMMY ID SEGMENTS ALLOCATED TYPID NOP LONG(0) / SHORT(1) ID FLAG IDA NOP FWA OF CURRENT DUMMY ID SEGMENT a5SKP COIDS NOP THIS ROUTINE COUNTS THE IDS JSB BLKID GO COUNT LDB ID# GET THE REQUIRED NUMPER CMB,INB SET NEGATIVE ADA B SUBTRACT FROM AVAILABLE SSA IF ENOUGH JMP NOIDS SKIP ELSE GO TELL HIM JMP COIDS,I RETURN SPC 1 * SEND NO ID MESSAGE NOIDS LDA P20 LDB SETM JSB SYOUT JMP ABORT SPC 1 SKP * * * SET BP LINK ADDR FOR EXT * * DBLEX HANDLES ALL DBL EXTERNAL REFERENECS. * BEFORE ENTRY INTO DBLEX, 'EXORD' MUST BE SET UP WITH * THE PROPER ORDINAL AND 'OFSET' SHOULD HAVE A FINITE VALUE. * (TYPE 4 DBL RECORD SETS OFSET=0 AND TYPE 5 GETS OFSET FROM * THE RECORD). * EXORD = EXT ORDINAL # * OFSET = OFFSET OF INSTRUCTION * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBLEX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (A) HAS INSTRUCTION TO BE OUTPUT * DBLEX NOP JSB INLST INITIALIZE LSTX LDB PLST ADB P2 SET END PNTR STB PRMAP LDB TLST ADB P2 DBLF CPB PRMAP END OF LST ? JMP ORD? ORDINAL NOT FOUND * LDA B,I GET LST3 AND M377 MASK IN ORDINAL ADB P5 POINT TO NEXT LST1 CPA EXORD ORDINALS EQUAL ? RSS YES - SKIP JMP DBLF NO - CHECK NEXT LST ENTRY * ADB N7 BACK UP TO CURRENT SYMBOL STB TLST AND SET UP FOR LSTX JSB LSTX HLT 0 I HAVE ALLREADY CHECKED!! LDA REKEY SET THE DBL AND M7 TYPE STA T1FIX FOR FIXIT OR... LDA CURAL,I GET THE INSTRUCTION AND M1740 ISOLATE IT STA T2FIX AND SAVE IT ALSO LDA LST4,I GET WORD 4 OF LST ENTRY AND P3 ISOLATE THE TYPE CPA P2 IS SYMBOL DEFINED? JMP DBLE0 NO GO BUILD A FIX UP * JSB FIXIT  YES FIX IT UP AND OUTPUT IT JMP DBLEX,I RETURN * DBLE0 LDB TFIX GET CURRENT END ADB N4 PUSH DOWN STB TFIX THE BOTTOM OF THE TABLE CMB,INB WAS THERE ROOM? ADB PLST SSB,RSS WELL?? JMP LOVER NOPE DID HIM IN * LDB TFIX YES JSB FIXX SET UP THIS ENTRY * LDA LST1 SET STA FIX2,I THE LST ENTRY LDA T2FIX COMBINE IOR T1FIX THE INSTRUCTION AND DBL TYPE STA FIX3,I AND SET IT LDA OFSET GET THE OFSET STA FIX4,I AND SET IT LDA DBLAD NOW FOR THE ADDRESS STA FIX1,I JMP DBLEX,I EXIT * ORD? JSB CPRNM PRINT MODULE NAME LDA ERR14 ASMB GAVE EXT REF IN DBL REC JMP ABOR BUT NO EXT REC. ASMB ERROR * ERR14 ASC 1,14 * * OUTAB NOP ROUTINE TO OUTPUT * * TEST FOR MAIN OR BASE PAGE FIXUP. * STA ABWRD ALL ABS CODE STB ABADD SAVE WORD (A) AND ADDRESS (B) CMB SET ADDRESS NEGATIVE STB A SAVE IT ADB FWA BELOW CURRENT MODULE? SSB,RSS WELL? JMP OUTA3 YES COULD BE BP OR MAIN FIXUP * ADA TPREL BEYOND LAST WORD PUT OUT? INA SSA,RSS WELL?? JMP OUTA2 NO JUST PUT THE WORD TO ABOUT * * ZERO ANY BSS 'S FOUND IN PROGRAM * OUTA1 CLA ZERO'S LDB TPREL NEXT ADDRESS CPB ABADD THIS THE ADDRESS TO WRITE? JMP OUTA2 YES GO DO IT * JSB ABOUT ELSE SEND A ZERO JMP OUTA1 CHECK IF ANOTHER NEEDED * * DO NORMAL OUTPUT OF A NORMAL INSTRUCTION * OUTA2 LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT AND SEND IT JMP OUTAB,I RETURN * OUTA3 STA B ADDRESS NOT IN CURRENT MAIN ADA M2000 IN BP? SSA,RSS WELL?? JMP OUTA6 YES GO DO BASE PAGE FIX * * FIXUP OF A MAIN ۊOF A SEGMENTED PROGRAM * STB A GET ANOTHER COPY ADB SEGM SEG-CURRENT ADDRESS ADA AFWA ABSOLUTE BASE-CURRENT ADDRESS SSB,RSS IF ABOVE SEGMENT BASE SSA,RSS OR BELOW MAIN JMP RCERR ERROR SHOULD NEVER GET HERE * LDA DMTBL SET ADDRESSES FOR ABOUT STA DTBL INA STA DTBL+1 INA STA DTBL+2 SO IT CAN GET BACK TO THE MAIN LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT PUT IT OUT LDA DSTBL RESTOR ADDRESSES STA DTBL INA STA DTBL+1 INA STA DTBL+2 JMP OUTAB,I RETURN * * BP FIXUP (NOTE WE DON'T GO TO THE DISC YET ) * OUTA6 ADB BPFWA GET OFFSET INTO PGM. CMB BASE PAGE (MAIN AND SEG ARE CONTIG.) ADB FWABP TRANSLATE TO MEM. RES. DUMMY LDA ABWRD GET THE WORD STA B,I STORE IT IN THE BP JMP OUTAB,I RETURN * ABADD NOP TEMP TO HOLD LOAD ADDRESS * DMTBL DEF *+1 ADDRESS OF MAIN TRIPLET AFWA OCT 0,0,0 ABSOLUTE BASE DSTBL DEF *+1 NORMAL LOADING BASE ADDRESSES FWA NOP BASE OF CURRENT PROGRAM OR SEGMENT STRAK NOP BASE TRACK(=0 IF PROG NOT SEGMENTED) SSECT NOP BASE SECTOR (BOTH ARE RELATIVE TO ZERO FOR MAIN) * DTBL DEF FWA NORMAL SET UP OF DEF STRAK ABOUT LOAD ADDRESSES DEF SSECT CHANGED ONLY TO FIX UP MAIN * * * FIXAL FIXES UP REFERENCES * TO ENTRY POINTS NOT DEFINED WHEN REFERENCED * BY TAKING THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND BUILDING AN APPROPIATE INSTRUCTION FROM IT. * * THE FIX UP TABLE HAS 4- WORDS PER ENTRY AS FOLLOWS: * * FIX1 MEMORY ADDRESS TO BE FIXED (-1 INDICATEDS AN EMPTY ENTRY) * FIX2 SYMBOL TABLE ADDRESS OF EXT FOR THIS INSTRUCTION * FIX3 INSTRUCTION FROM DBL RECORD BITS 01 =DBL TYP (3 OR 4) * FIX4 OFSET FROM DBL RECORD. * NLH * FIXAL EXTRACTS THE INFORMATION FROM THE CURRENT FIXUP TABLE ENTRY * AND LEAVES IT WHERE 'FIXIT' CAN FIND IT. THIS IS DONE TO ALLOW * 'FIXIT' CODE TO BE USED WITHOUT THE FIXUP TABLE OVER HEAD WHEN * DOING CODE THAT DOES NOT REQUIRE FIXUPS. * FIXAL NOP LDB IDA GET ORGION FIXA2 CPB TFIX END OF TABLE? JMP FIXA3 GO PACK THE TABLE * ADB N3 DOWN TO THE LDA B,I SYM. TBL. ENTRY ADB N1 SET B TO ORGION OF ENTRY CPA LST1 THIS ONE? JMP FIXA1 YES GO DO IT * JMP FIXA2 AROUND WE GO * FIXA1 JSB FIXX SET THE BASE ADDS IN FIX1-FIX4 LDA FIX2,I FIRST GET STA TLST THE RIGHT LST ENTRY JSB LSTX SET UP HLT 0 BETTER BE GOOD * LDA FIX3,I GET THE DBL CODE AND P7 AND STA T1FIX SET IT XOR FIX3,I GET THE MASKED INSTRUCTION STA T2FIX AND SET IT LDA FIX4,I GET THE OFFSET STA OFSET AND SET IT LDA FIX1,I GET THE MEMORY ADDRESS STA DBLAD SET IT JSB FIXIT DO THE FIXUP CCA N STA FIX1,I RELEASE THE FIXUP TABLE ENTRY STA FIX2,I * LDB FIX1 CONTINUE JMP FIXA2 SEARCH * FIXA3 LDB IDA TABLE GET THE BASE ADDRESS PKF00 CPB TFIX IF EMPTY JMP FIXAL,I JUST EXIT * ADB N4 INDEX TO FRONT OF ENTRY STB SET1 SET ADDRESS OF FIRST AVAILABLE ENTRY LDA B,I IS IT? SSA,RSS IT IS IF IT IS <0. JMP PKF00 NO AROUND WE GO * PKF01 LDA N4 SET UP A MOVE COUNTER STA SET2 TO MOVE THE NEXT ENTRY PKF02 CPB TFIX IS THERE ANOTHER ENTRY? JMP PKF05 NO GO PATCH UP TFIX * ADB N4 YES CHECK IT LDA B,I STILL IN USE? SSA WELL JMP PKF02 NO TRY NEXT ONE * PKF03 STA SET1,I YES MOVE IT DOWN INB ISZ SET1 STEP THE ADDRESSES LDA B,I GET THE NEXT WORD ISZ SET2 FOUR WORDS MOVED YET? JMP PKF03 NO * LDA SET1 YES SET UP FOR THE NEXT ADA N8 EMPTY SLOT STA SET1 ADB N4 ALSO B JMP PKF01 TRY THE NEXT ENTRY * PKF05 LDA SET1 END OF THE FIX UP LIST ADA P4 SET THE ADDRESS STA TFIX OF THE LAST VALID ENTRY IN TFIX JMP FIXAL,I RETURN * * FIXIT NOP THIS ROUTINE BUILD A INSTRUCTION AND PUTS IT OUT LDA LST4,I GET THE SYMBOL TYPE ALF,ALF AND P7 TO A CPA P4 IF REPLACE OP JMP FIX05 GO DO IT * LDA LST5,I GET THE SYMBOL VALUE ADA OFSET ADD THE OFFSET STA OPRND SET FOR SCANNERS AND M0760 ISOLATE PAGE BITS CMA,CLE,INA SET E IF PAGE ZERO LDA T2FIX GET THE OPCODE SEZ IF BASE PAGE REF JMP FIX04 USE DIRECT LINK * LDB T1FIX GET THE DBL TYPE CPB P4 IF TYPE 4 THEN JMP FIX01 ALWAYS USE LINK * SZA ELSE USE LINK CPA MSIGN ONLY IF NOT ͏A DEF JMP FIX04 A DEF DO DIRECT LINK * LDA OPRND CHECK IF A LINK NEEDED XOR DBLAD AND M0760 ISOLATE PAGE INFO SZA IN NOT SAME PAGE JMP FIX01 MUST USE LINK * LDA OPRND EXT REF WITH OFFSET TO SAME PAGE AND MPAG ISOLATE THE PAGE OFFSET IOR M2000 AND INDIRECT BIT ADD CURRENT PAGE ADA T2FIX BIT AND THE INSTRUCTION CODE JMP FIX03 GO SEND IT TO THE DISC * FIX01 LDB OPRND IF OPCODE LDA T2FIX SSA IS INDIRECT ADB MSIGN ADD A SIGN BIT STB OPRND JSB SCAN SCAN FOR A LINK JMP FIX02 SUCCESS * JSB ALLOC NO LINK FOUND ALLOCATE ONE STB T3FIX SAVE ACTUAL MEMORY ADDRESS OF IMAGE LDB OPRND AND STB T3FIX,I SET THE OPERAND INTO IT LDB A GET ACTUAL ADDRESS FIX02 LDA T2FIX INSTRUCTION TO A IOR MSIGN ADD THE INDIRECT IOR B AND THE BASE PAGE ADDRESS FIX03 LDB DBLAD GET THE ADDRESS TO B JSB OUTAB SEND THE WORD JMP FIXIT,I RETURN * FIX04 ADA OPRND DIRECT DEF ADD IN OPERAND JMP FIX03 GO PRODUCE IT * FIX05 LDA LST5,I REPLACE OP JMP FIX03 SEND IT * * * FIXX SETS UP FIX1-FIX4 * * ON ENTRY B=FIX1 ADDRESS * FIXX NOP STB FIX1 INB STB FIX2 INB STB FIX3 INB STB FIX4 JMP FIXX,I SO YOU EXPECTED COMMENTS YET! * * * FIX1 NOP FIX2 NOP FIX3 NOP FIX4 NOP T1FIX NOP T2FIX NOP T3FIX NOP TFIX NOP EXORD BSS 1 SET2 NOP SET1 NOP M1740 OCT 174000 MPAG OCT 101777 PAGE OFFSET AND INDIRECT BIT SKP * * READ UTILITY REC TO LBUF * * THE UREAD SUBROUTINE READS A UTILITY REC FROM THE DISK * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB UREAD * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * UREAD ȘNOP JSB EXEC REQUEST DISK READ DEF *+7 DEF P1 READ REQUEST CODE DEF P2 DISK LOGICAL UNIT NO. ALBUF DEF LBUF 64 - WORD INPUT BUFFER DEF P64 NO. WORDS DEF UTRAK TRACK NO. DEF USECT SECTOR NO. JMP UREAD,I RETURN USECT NOP UTRAK NOP * * * * CONVD CONVERTS THE CONTENTS OF A INTO ASCII (OCTAL) * AT THE LOCATION SPECIFIED BY THE ADDR IN B. * CALLING SEQUENCE: * A = NO. TO BE CONVERTED * B = ADDRESS OF CONVERTED NO. * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * * CONVD NOP STB ATEMP SAVE THE ADDRESS OF THE BUFFER CLE FORCE OCTAL CONVERSION LDB OPCOD GET THE OPCODE CPB P3 IF OPCODE = 3 CME THEN SET E FOR DECIMAL CONVERSION JSB CNVRT DO THE CONVERSION LDB A,I GET 1ST ASCII RETURN STB ATEMP,I AND PUT IT WHERE THE CALLER WANTS INA ISZ ATEMP LDB A,I GET THE NEXT ONE STB ATEMP,I INA ISZ ATEMP LDB A,I STB ATEMP,I NOW WERE DONE JMP CONVD,I * ATEMP NOP * * * CNVRT NOP JSB $LIBR NOP JSB $CVT3 JSB $LIBX DEF CNVRT * THE SEMAP SUBROUTINE SETS THE NAME OF THE CURRENT PROG * INTO THE MEMORY MAP AND SETS THE PROG LENGTH. * IT ALSO EXTRACTS THE PRIORITY AND TIME PARAMETERS * FROM THE NAME RECORD AND STORES THEM INTO 'NPAR'. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SEMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SEMAP NOP LDA LBUF+3 GET PROG NAME 1,2 STA MBUF SET NAME INTO MEMORY MAP LDA LBUF+4 GET PROG NAME 3,4 STA MBUF+1 SET NAME IN MEMORY MAP LDA LBUF+5 GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR B40 ADD BLANK CHAR STA MBUF+2 SET NAME IN MEMORY MAP LDA LBUF+6 GET PROG LENGTH VSTA PLGTH SAVE PROG LENGTH * LDA N7 MOVE PRIORITY,RESOLUTION CODE, JSB MOVE EX MUL,HRS,MINS,SECS, DEF LBUF+10 AND TENS OF MS TO DEF NPAR NPAR * LDA LBUF GET THE REC LENGTH ALF,ALF AND ADA N17 SUBTRACT 17 LDB P10 GET #WORDS IN MAP MESS. SSA,RSS IF NAM REC > 17 WORDS ADB A ADD DIFFERENCE TO MAP LENGTH BLS CONVERT TO WORDS STB NODE SAVE FOR MAP OUTPUT CPB P20 IF NO EXTRA WORDS JMP SEMAP,I EXIT * CMA,INA SET TO MOVE THE REST OF THE NAM JSB MOVE REC TO DEF LBUF+17 MBUF DEF MBUF+10 JMP SEMAP,I RETURN SPC 1 PLGTH BSS 1 PROG LENGTH B40 OCT 40 N17 DEC -17 N7 DEC -7 SKP MOVE NOP WORD MOVE SUBROUTINE STA PRMAP SAVE WORD COUNT LDA MOVE,I GET SOURCE STA LSCAN SET IN LSCAN ENTRY ISZ MOVE STEP TO DEST. ADDR LDA MOVE,I GET DEST. ISZ MOVE STEP TO RETURN ADDR MOV1 LDB LSCAN,I GET A WORD STB A,I PUT IT AWAY ISZ LSCAN STEP SOURCE INA AND DEST. ADDRES ISZ PRMAP DONE? JMP MOV1 NO - CONTINUE JMP MOVE,I YES - EXIT SPC 1 * PRINT MEMORY MAP * * PRMAP SETS THE CURRENT MEMORY BOUNDS INTO THE MEMORY MAP * AND PRINTS THE MAP IF THIS OPTION WAS SELECTED. FOLLOWING * THIS, THE MEMORY BOUNDS ARE UPDATED FOR THE NEXT PROG. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB PRMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED * PRMAP NOP LDA PPREL GET CURRENT PROG RELOC ADDR LDB AMEM3 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP CCA ADA TPREL GET LWA PROG LDB AMEM6 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP LDA PLIST GET LIST/NO LIST FLAG SLA SKIP - LIST MEMORY BOUNDS JMP PRMA1 OMIT LISTING LDA BLNK2 BLANK THE UNSET WORD STA MBUF+9 LDA NODE LDB MESS2 MESS2 = ADDR MEMORY MAP JSB DRKEY PRINT: XXXXX NNNNN NNNNN PRMA1 LDA TPREL GET NEXT AVAIL ADDR STA PPREL SET NEXT RELOCATION BASE JMP PRMAP,I RETURN * * NODE NOP MESS2 DEF MBUF SKP * SCAN LST FOR SAME ENT/EXT * SPC 2 * * MATCH DIRECTORY ENTRY WITH LST * * THIS ROUTINE DETERMINES IF ENT ENTRY FROM DIRECTORY * (IN TBUF) MATCHES ANY EXT IN THE LST . THE START OF * LST MUST BE SET BEFORE CALLING THIS SUBROUTINE. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB MATCH * (P+1) - MATCH NOT FOUND * (P+2) - MATCH FOUND * MATCH NOP LDB TLST MACH? CPB PLST END OF LST ? JMP MATCH,I YES - RETURN (P+1) LDA B,I GET LST1 RAL,CLE,ERA CLEAR BIT15 CPA TBUF NAME 1 , 2 EQUAL ? JMP *+3 YES ADB P5 NO - BUMP (B) BY 5 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST2 RAL,CLE,ERA CLEAR BIT 15 CPA TBUF+1 NAME 3, 4 EQUAL ? JMP *+3 YES ADB P4 NO - BUMP (B) BY 4 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST3 AND M7400 MASK IN NAME 5 CPA TBUF+2 NAME 5 EQUAL ? JMP *+3 YES ADB P3 POINT TO NEXT LST1 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST4 AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED ? JMP *+3 YES ADB P2 NO - FORGET ENT MATCHED TO ENT JMP MACH? GET NEXT LST1 ISZ MATCH BUMP TO (P+2) RETURN FOR MAT+xCH JMP MATCH,I RETURN (P+2) * * SKP * * SCAN LINKAGE AREAS FOR OPERAND * * * SCAN SETS UP AREA ADDRES FOR 'ARSCN' ROUTINE WHICH * ACTUALLY DOES THE SCAN. THE AREAS SCANNED ARE THE * SYSTEM/FG RES/RES LIB , BG RES AND THE DUMMY LINK AREAS. * CALLING PROGRAM MUST SET THE APPROPRIATE OPERAND VALUE * IN 'OPRND'. * ON RETURN: * (P+1) - MATCH FOUND AND REG-A = 0 * REG-E = 0 LINK FOUND IN BASE PAGE * REG-E = 1 LINK FOUND IN DUMMY BASE PAGE * AND REG-B = ABSOLUTE LINK ADDR * * (P+2) - NO MATCH - REGS ARE MEANINGLESS. * SCAN NOP SPC 1 IFN * BEGIN NON-MEU CODE **** LDA INTLG (A)=NUM OF INT TBL ENTRIESH ADA P8 (A)=FWA OF SYS/FG RES/RES LIB LINK AREA STA LOWER SET LOWER BOUND FOR AREA LDA BPA1 (A)=UPPER BOUND OF AREA STA UPPER SET UPPER BOUND JSB ARSCN SCAN SYSTEM LINKAGE AREA JMP SYSFD OPERAND FOUND LDA BPA2 SET BOUNDS FOR BG RES LINK AREA SURCH INA STA LOWER LDA BPA3 (A)= LWA OF BG RES LINK AREA STA UPPER JSB ARSCN SCAN BG RES LNK AREA FOR OPERAND JMP SYSFD OPERAND FOUND * END NON-MEU CODE ****** XIF SPC 1 SPC 1 IFZ * BEGIN MEU CODE ******** LDA BPA2 SET BOUNDS FOR RESIDENT INA LINKAGE AREA STA LOWER SEARCH LDA M1646 STA UPPER JSB ARSCN SCAN RES LINKS FOR OPERAND JMP SYSFD OPERAND FOUND * END MEU CODE ********** XIF SPC 1 LDA FWABP SET DUMMY LINKAGE AREA BOUNDS STA LOWER LDA CWABP STA UPPER JSB ARSCN SCAN DUMMY AREA FOR OPERAND JMP DMYFD OPERAND FOUND ISZ SCAN (P+2) RETURN FOR NO MATCH FOUND JMP SCAN,I (P+2) RETURN * DMYFD LDB FWABP GET REAL BASE PAGE LOCATION CMB,INB CORRESPONDING TO THE LOCATION ADB LOWER IN DUMMY LINK AREA. ADB BPFWA (B)=REAL BP LINK AREA CLA,CCE,RSS (A)=0, (E)=1 LINK FOUND IN DUMMY SYSFD CLA,CLE (A)=0, (E)=0 LINK FOUND IN BASE PAGE JMP SCAN,I (P+1) RETURN FOR MATCH FOUND. * M1646 OCT 1646 LWABP RES LINKS * * * SCAN SPECIFIED AREAS FOR THE OPERAND * * ARSCN SCANS THE SPECIFIED AREA FOR AN OPERAND IDENTICAL TO * THAT IN 'OPRND'. CALLING MODULE MUST SET: * OPRND = OPERAND TO BE SURCHED * LOWER = LOW ADDR OF AREA * UPPER = HIGH ADDR OF AREA (NOT INCLUDING LAST ADDR) * * RETURN IS: * (P+1) - MATCH FOUND AND REG-B = ABSOLUTE ADDR OF MATCHED * LOCATION IN THE AREA. * AND REG-A = OPERAND * * (P+2) - NO MATCH FOUND - REGS ARE MEANINGLESS. * * ARSCN NOP LDB UPPER SET NEGATIVE CMB,CLE,INB UPPER BOUND. ADB LOWER CHECK IF HIGHER SEZ EQUAL OF LOWER? JMP NOMAC YES,RETURN P+1 LDB LOWER GET LOWER BOUND LDA OPRND SET (A)=OPERAND SRC CPA B,I OPERAND IN AREA? JMP FOUND YES, RETURN INB NO, BUMP TO NEXT ONE CPB UPPER DONE? RSS YES, RETURN P+2 JMP SRC NO, TRY NEXT ONE NOMAC ISZ ARSCN BUMP TO (P+2) RETURN FOUND STB LOWER SET LOWER FOR PAST ROUTINES JMP ARSCN,I RETURN RETURN SPC 1 LOWER BSS 1 UPPER BSS 1 * * ALLOCATE NEXT BP LINK ADDR * * ALLOC ALLOCATES A WORD IN BASE PAGE TO BE USED FOR INDIRECT * LINKAGES. IF THE BASE PAGE AREA HAS BEEN EXHAUSTED, A * DIAGNOSTIC IS PRINTED AND LOADING IS ABORTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * * RETURN: * A = ABSOLUTE BASE PAGE ADDR * B = DUMMY AREA BASE PAGE ADDR * ALLOC NOP LDA CWABP GET NEXT A VAILABLE BP ADDR ISZ CWABP INCR CURRENT BP ADDR LDB A CMB,INB SET B = - CURRENT BP ADDR ADB LWABP GET LWA BP LINKAGE. SSB,RSS SKIP - BP OVERFLOW JMP ALLO1 JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR04 04 = BP LINKAGE OVERFLOW JMP ABOR ALLO1 CLB STB A,I ZERO THE LINK WORD LDB FWABP SUBTRACT FWA BP AREA CMB,INB FROM CURRENT ADDR, ADA B TO GET RELATIVE ADDR. ADA BPFWA ADD FWA OF ACTUAL AREA FOR LDB CWABP ABS ADDR, B=DUMMY AREA ADB N1 JMP ALLOC,I ADDR. -RETURN. * ERR04 ASC 1,04 BASE PAGE OVERFLOW * * * SET MEMORY REFERENCE ADDRES * * MREF RELOCATES THE MEMORY REFERENCE INSTRUCTIONS. IF THE CURRENT * REFERENCE IS OUTSIDE THE CURRENT PAGE, IT ESTABLISHES AN INDIRECT * LINK THROUGH BASE PAGE. * * CALLING SEQUENCE: * A = FIRST WORD OF MEMORY REFERENCE GROUP * B = IGNORED * JSB MREF * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * MREF NOP STA ABT4 SAVE (A) TEMPORARILY AND P3 ISOLATE RELOCATION BASE TYPE LDB ENTRL GET RELOCATION ADDR PNTR ADB A ADD OFFSET TO GET PROPER PNTR LDB B,I GET RELOCATION BASE ADDR LDA ABT4 RESTORE (A) ADB CURAL,I ADD CURRENT INSTRUCTION ADDR AND M1740 ISOLATE INSTRUCTION CODE SSA SKIP - DIRECT REFERENCE ADB MSIGN SET SIGN OF ADDR = 1 STA INSTR SAVE INSTRUCTION CODE LDA DBLAD GET CURRENT RELOCATION ADDR AND M0760 ISOLATE CURRENT PAGE NO. STA PAGNO SAVE CURRENT PAGE NO. LDA B GET CURRENT ADDR AND M0760 ISOLATE PAGE NO. OF ADDR SZA,RSS BASE PAGE REFERENCE? JMP DBL8 YES CPA PAGNO CURRENT PAGE REFERENCE? JMP DBL7 YES, NO LINK NEEDED STB OPRND SAVE ABSOLUTE OPER0AND LDA FWABP SET BOUNDS FOR DUMMY LINK AREA STA LOWER LDA CWABP STA UPPER JSB ARSCN SCAN DUMMY LINK AREA JMP LNFND LINK FOUND JSB ALLOC ALLOCATE LINK STA TBUF SAVE BP LINK ADDR LDA OPRND GET CURRENT OPERAND STA B,I SET OPERAND IN DUMMY BASE PAGE. LDA TBUF GET BP LINK ADDR SMLNK IOR MSIGN ADD INDIRECT BIT MREF0 IOR INSTR ADD INSTRUCTION CODE TO ADDR JMP MREF,I RETURN LNFND LDA FWABP CMA,INA GET ACTUAL BP LINK ADDR ADA LOWER ADA BPFWA (A)=ACTUAL BP LINK ADDR JMP SMLNK GO TO USE SAME LINK * DBL7 LDA B IT'S CURR PAGE AND M1777 SO REMOVE PAGE BITS FROM ADDR IOR M2000 AND SET CURR PAGE BIT JMP MREF0 ADD INSTR TO ADDR, RETURN * DBL8 LDA B IT'S BASE PAGE JMP MREF0 JUST ADD INSTR TO ADDR, RETURN * M1777 OCT 1777 INSTR BSS 1 PAGNO BSS 1 * * * SET VALUE INTO SYSTEM * * THE SYSET SUBROUTINE SET THE CURRENT WORD (IN THE A REG) * INTO THE SPECIFIED LOCATION OF THE SYSTEM. THIS IS REQUIRED * FOR BOTH THE BASE PAGE LINKAGES AND THE ID SEGMENT. * * CALLING SEQUENCE: * A = CURRENT VALUE * B = CURRENT LOCATION * JSB SYSET * * RETURN: CONTENTS OF A AND B ARE THE SAME AS AT CALL * SYSET NOP JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM STA B,I STORE WORD INTO SYSTEM JSB $LIBX RESTORE INTERRUPT DEF SYSET SYSTEM AND RETURN * EMES DEF *+1 ASC 1, * ENTRY POINT BSS 6 LIST BUFFER BLANK OCT 40 SKP * * NORMAL LOAD TERMINATION * NODEX LDA PLIST GET ENTRY POINT LIST FLAG ARS SZA SKIP - LIST ENTRY POINTS JMP NOLST OMIT ENT LISTING * * LIST LIB ENTRY POINTS * JSB SPACE NEW LINE LDA P12 LDB MESS8 MESS8 = ADDR: ENTRY POINTS JSB DRKEY PRINT : ENTRY POINTS JSB SPACE NEW LINE ON LIST OUTPUT DEVICE JSB INLST INITIALIZE LSTX ELIST JSB LSTX SET CURRENT LST ADDRES JMP NOLST END OF LST LDA LST4,I GET ENT/EXT FLAG AND P7 MASK IN SYMBOL STATUS CPA P2 IF STILL UNDEFINED JMP ELIST THEN DON'T LIST IT * LDA LST1,I GET NAME 1,2 CCE,SSA IF UN USED LIB ENTRY JMP ELIST DON'T LIST IT. * STA EMES+2 SET NAME 1,2 INTO BUFFER RAL,ERA SET THE SIGN BIT SO IT IS LISTED ONCE STA LST1,I RESET IN LST LDA LST2,I GET NAME 3,4 STA EMES+3 SET INTO BUFFER LDA LST3,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA EMES+4 SET NAME 5 INTO BUFFER LDA LST5,I A= SYMBOL VALUE LDB EMES GET ADDR OF 'NNNNN ' IN ADB P4 BUFFER. JSB CONVD CONVERT TO OCTAL IN MEMORY MAP LDA P14 LDB EMES ADDR OF ' *' BEFORE ENT BUFFER JSB DRKEY PRINT ENTRY POINT LISTING JMP ELIST CONTINUE ENTRY POINT SEARCH * NOLST JSB DWRIT WRITE LAST DISK SECTOR LDA FWA SET LOW MAIN STA MEM1,I ADDR LDA TPREL SET STA MEM2,I ADDR LDA FWABP CALCULATE RELATIVE CMA,INA CURRENT BP ADDR ADA CWABP AND ADD FWA OF REAL ADA BPFWA AREA FOR LAST ADDR AND STA MEM4,I SET IN ID SEGMENT LDA FWABP IF SEGMENT BEING LOADED, CMA,INA SUBTRACT FWABP FROM SEGB ADA SEGB (SEGMENT BASE) AND ADD ADA BPFWA TO REAL FWA OF BASE PAGE, STA MEM3,I SET AS LOW BOUND OF BP. LDA SEGB GET CURRENT LOWER BOUND OF BP, CMA,INA ADA CWABP ADD CURRENT BP LINK ADDR LDB MSEG (B) = M/SEG FLAG. CPB P1 IF LOADING MAIN, STA MTMP SAVE BP LENGTH SZA,RSS SKIP - SOME BP LINKAGES JMP NOBPL NO BP OUTPUT * * OUTPUT BASE PAGE LINKAGES * LDA FWA SET CMA,INA DBLAD ADA PPREL = TO DISPLACEMENT ADA M177 TO START OF AND M7600 NEXT SECTOR ADA FWA FOR STA DBLAD BP AREA. CLA,INA SET ABT12 = 1, STA ABT12 FOR WRITING BASE PAGE. LDA SEGB SET FWA OF CURRENT BASE PAGE STA ABT13 AREA IN ABT13. CPB P1 IF NOT LOADING RSS MAIN, JMP NOLS1 JUMP TO OUTPUT BASE PAGE. LDA FWA SAVE MAIN: STA MTMP+1 FWA LDA PPREL STA MTMP+2 PPREL LDA DBLAD STA MTMP+3 DBLAD LDA SEGB STA MTMP+4 FWABP LDA CWABP STA MTMP+5 CWABP. * NOLS1 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CWABP BASE PAGE ADDR, JMP NOBPL THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP NOLS1 AND CONTINUE. * NOBPL CLA RESET BASE PAGE OUTPUT STA ABT12 FLAG FOR "ABOUT". LDA MSEG SKIP NAME CPA P2 PROCESSING IF JMP MSGP1 SEGMENT LOAD LDB MESS4 GET ADDR OF TERM. MESSAGE LDA NAM12,I GET PROG NAME 1,2 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM34,I GET PROG NAME 3,4 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM5,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA B,I SET NAME INTO MESSAGE * JSB BREAK LAST CHANCE TO BREAK THE PROGRAM * LDA MSEG CHECK FOR SPECIAL SZA,sNRSS MAIN/SEGMENT PROCESSING JMP NTRM0 -NO, NORMAL TERMINATION * MSGP1 LDB PLST IF MAIN LOADED, SAVE END OF CPA P1 LST AS BEGINNING OF STB SLST SEGMENT AREA OF LST. * LDB SLST ERASE PREVIOUS STB PLST SEGMENT LST ENTRIES. STB TLST * LDB OPCOD CHECK OPERATION CODE. CPB P1 -IF DEBUG LOAD, RSS SKIP. JMP MSGP4 CONTINUE. CPA P2 CONTINUE IF JMP MSGP3 SEGMENT * * FIND AND CLEAR 'DEBUG' ENTRY POINTS * LDA MSGDC SET FWA OF STA ED20 ENT NAMES LDA N4 SET NEG STA ED21 INDEX OF -4. * MSGP2 LDA ED20,I SET STA TBUF ENTRY ISZ ED20 LDA ED20,I POINT STA TBUF+1 ISZ ED20 NAME LDA ED20,I STA TBUF+2 IN ISZ ED20 TBUF. * JSB LSCAN FIND MATCH JMP MSGP0 -NO MATCH- CHECK NEXT LDA BBLNK SET STA LST3,I NAME IOR BLANK FIELD STA LST1,I OF STA LST2,I ENTRY = BLANKS. MSGP0 ISZ ED21 END-OF-LIST? JMP MSGP2 NO JMP MSGP3 YES. * * BBLNK OCT 20000 MESS8 DEF *+1 ASC 6,ENTRY POINTS M7600 OCT 177600 MSGDC DEF *+1 ASC 3,DEBUG ASC 3,$DBP1 ASC 3,$DBP2 ASC 3,$MEMR * * MSGP3 LDA MSEGF SKIP DEBUG CHECK , ETC., CPA P3 IF FINAL JMP MSGP6 LOAD (=3). * JSB SILST INITIALIZE FOR SEGMENT AREA, JSB LSTX SET ADDRES FOR NEXT LST ENTRY NOP LDA CHRDE PUT STA LST1,I "DEBUG" LDA CHRBU IN STA LST2,I NEXT LDA UCHRG LST ENTRY STA LST3,I FOR SEGMENT. LDA P2 SET LST4 = UNDEF SYMBOL STA LST4,I LDA TLST SET NEW STA PLST END-OF-LIST ADDR. * * SAVE "MAIN" BOUNDS IF MAIN JUST LOADED * MSGP4 LDA MSEGNLH CONTINUE IF CPA P2 PROCESSING A SEGMENT. JMP MSGP5 ISZ MSEG SET 'MSEG' = 2. LDA PPREL SAVE SEGMENT STA SEGM BASE ADDR LDA CWABP SAVE BASE PAGE LOWER BOUND STA SEGB FOR LINK AREA FOR SEGMENTS. LDA P5 SET PTYPE = 5 IOR M20 MASK IN 'SS' BIT FOR SEG ID STA PTYPE FOR BKG SEGMENT. * * SET CONDITIONS FOR NEXT SEGMENT. * MSGP5 LDA MSEGF SKIP IF CPA P3 FINAL LOAD. JMP MSGP6 LDA SEGM RESET LOWER STA PPREL BOUNDS VALUES FOR STA FWA PPREL , FWA STA TPREL LDA SEGB STA CWABP CCA SET LAST ACCESS PNTR STA LELAD USED BY OUTAB ROUTINE STA DBLFL SET 1ST DBL FLAG = -1 STA PLFLG NAM MUST BE 1ST. CLA STA LGOU STA SLIBF STA LIBFL * * LDA IDA (A) = ID SEGMENT ADDR(DUMMY) ADA P4 (A)= ADDR OF MEM1 OF SHORT ID LDB TYPID GET LONG/SHORT ID FLAG SZB,RSS LONG ID ? ADA P4 YES, (A)=ADDR OF LONG ID'S MEM1 wN JSB C#S CALCULATE # SECTORS. * ADA SSECT ADD IN STARTING SECTOR. CLB DIVIDE BY DIV TRKS# # SECTORS PER TRACK. STB SSECT SET REMAINDER AS NEW SSECT. ADA STRAK ADD IN STARTING TRACK TO STA STRAK QUOTIENT AND SET NEW STRAK. ALF,RAL ROTATE TRACK # TO RAL,RAL 14-07, ADD IN IOR SSECT SECTOR # AND STA ALLOC SAVE TEMPORARILY IN SUB HEAD * * ALLOCATE NEW ID SEGMENT. * LDB EDFLG SET CLA (A) = 1 IF CPB P2 A REPLACEMENT, INA OTHERWISE (A)=0, CLB,INB INDICATE SHORT ID JSB SETID ALLOCATE SHORT ID SEG * LDA ALLOC STORE NEW STARTING TRACK STA DMAIN,I AND SECTOR IN "DMAIN" * LDA PLIST CHECK LIST FLAG SLA SKIP IF NOT SUPPRESSED. JMP MSG10 GO TO LOAD NEXT * JSB SPACE TRIPLE JSB SPACE SPACE FOR JSB SPACE CLARITY ON LISTING. * MSG10 LDA N60 GET THE COUNT JSB MOVE MOVE SEGMENT NAM BUFFER BACK DEF SGNAM SOURCE DEF LBUF DESTINATION * CLA FUDGE DCB TO SAY DATA NOT IN CORE AND STA IDCB1+13 EOF HAS NOT BEEN READ * JMP *+1,I REPROCESS THE SEGMENT NAM RECORD DEF TESTR (SAVE A BP LINK TOO !) * IDC13 DEF IDCB1+13 * MESS4 DEF *+1 PRAM ASC 6, READY SKP * * RE-OUTPUT "MAIN" BASE PAGE LINKAGES * MSGP6 LDA SLST SAVE SLST VALUE TEMPORARILY STA LSTX AND SET IT EQUAL TO FLST LDB FLST TO FOOL LSTX1 TO INITIALIZE STB SLST LST FROM START. JSB LSTX1 ANY UNDEFINED ? JMP MSGP9 NO - THEN DON'T OUTPUT MESSAGE LDA LSTX SET ACTUAL VALUE OF SLST BACK STA SLST ISZ MSEG SET MSEG FOR INLST LIUND LDA P6 LDB MESSM PRINT "MAIN'S" JSB SYOU)T JSB PUDF GO REPORT THE UNDEFINEDS LDA FORCD WERE UNDEFINED EXT'S ALLOWED ? SSA,RSS WELL ? JMP ABORT NO ! SO ABORT THYSELF. MSGP9 LDA LSTX RESET ORIGNAL VALUE OF SLST STA SLST LDA MTMP SZA,RSS TRANSFER IF NO JMP NTRM0 BASE PAGE. * LDA MTMP+1 RESET "MAIN" WORDS. STA FWA FWA LDA MTMP+2 STA PPREL PPREL LDA MTMP+3 STA DBLAD DBLAD LDA MTMP+4 STA ABT13 FWABP LDA MTMP+5 STA CWABP CWABP CLA SET STARTING TRACK STA STRAK AND SECTOR FOR STA SSECT PROG = 0. CLA,INA SET BP OUTPUT STA ABT12 FLAG. MSGP7 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CWABP BASE PAGE ADDR, JMP NTRM0 THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP MSGP7 AND CONTINUE MTMP OCT 0,0,0,0,0,0 TEMP STORAGE FOR "MAIN" P17 DEC 17 P9 DEC 9 MESSM DEF *+1 ASC 3,MAIN'S SKP * * CHECK FOR AND DO NORMAL ON-LINE LOAD TERMINATION * FOR A MAIN OR SEGMENT , OR FOR MAIN AND SEGMENTS * IF NO EDITING. * NTRM0 JSB DWRIT DUMP LAST OF BASE PAGE LDA FWABP SET UP ADDR ADA N13 OF DUMMY STA IDA ID SEGMENT. LDA ID# SET NEGATIVE CMA,INA INDEX FOR NUMBER OF STA ID## DUMMY ID SEGMENTS. LDA EDFLG CHECK FOR SZA LOADING OPERATION JMP ED00 -EDITING * NTRM7 LDA IDA ADA P4 GET ADDR OF MEM1 LDB ID## CMB,INB CPB ID# ADA P4 STA ED61 AND SAVE IT. JSB C#S COMPUTE # OF SECTORS NEEDED STA ABT13 AND SAVE FOR LATER. LDB ED61 GET ADDR OF MEM1 ADB P4 AND SET (B)=DMAIN'S ADDR +c LDA B,I GET DMAN AND M177 ISOLATE SECTOR STA ED62 ADDR AND SAVE. LDA B,I GET DMAN AGAIN ALF,ALF ISOLATE RELATIVE STARTING RAL TRACK NUMBER AND AND M377 ADD BASE TRACK NUMBER. ADA TRAKB STA TRAKP SAVE ABSOLUTE TRACK ADDR ALF,RAL RAL,RAL STA ABT11 SAVE POSITIONED TRACK # LDA TRKLU GET LU OF USER TRACKS CLE,ERA PUT 0 OR 1 FOR LU2 OR CLA LU3 RESPECTIVLY ERA PUT BIT IN (A) IOR ABT11 MERGE IN TRACK IOR ED62 AND SECTOR ADDRES. STA B,I STORE REAL ADDR IN DMAN LDA EDFLG GET EDIT FLAG SZA EDIT OPERATION ? JMP NOSET YES LDB IDA NO, THEN SET BIT7 OF ADB P3 NAM5 WORD OF ID SEG LDA ID## CMA,INA TO INDICATE THAT CPA ID# 'PROG IN CORE ONLY'. INB LDA B,I GET NAM5 WORD IOR B200 MERGE IN BIT7 STA B,I STORE BACK IN NAM5 * NOSET LDA ABT13 GET # OF SECTORS REQD CLB DIVIDE BY # OF SEC/TRK DIV TRKS# TO FIND # OF TRKS REQD. SZB IF REMAINDER INA THEN BUMP TO WHOLE TRK. STA #TRAK SET AS NUMBER OF TRACKS LDA EDFLG GET EDIT FLAG SZA,RSS IF NOT DOING EDIT OPERATION JMP NTRM5 THEN DO NOT COMPRESS TRACKS. * * DETERMINED FOR MAIN/SEGMENT LOAD IF SEMENTS * HAVE TO BE COMPRESSED (MOVED UP ON USER * TRACKS IF PREVIOUS SEGMENTS OR MAIN HAVE * BEEN STUFFED IN SYSTEM AVAILABLE AREA). * LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN JMP NTRM5 THEN DO NOT MOVE. LDB IDA GET CURRENT DUMMY ID SEG ADDR ADB P17 (B)=DMAN ADDR OF PREVIOUS ID LDA ID## ADA ID# CPA P1 PROCESSING FIRST SEG ? ADB P4 YES, ADJUST DMAN'S ADDR.  LDA B,I GET DMAN SSA IF PREVIOUS SEG/MAIN ON LU3 JMP NTRM5 THEN TOO DO NOT MOVE CMA,INA MAKE DMAN NEGATIVE AND ADA DSCLB ADD TO DISC LIB ADDR SSA DMAN POINT TO SYSTEM AREA ? JMP NTRM5 NO, THEN TOO DO NOT MOVE. LDA ID## ADA ID# CPA P1 IF PROCESSING FIRST SEGMENT JMP MOVEB THEN MOVE TO START OF USER TRKS CMA,INA SET NEG INDEX FOR NUMBER OF STA ED61 DUMMY IDS TO BE UPDATED. UPID ISZ ED61 REACHED MAIN'S ID ? RSS NO, THEN SKIP. ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IS THIS SEG ON LU 3 ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. CMA,INA NO, THEN SUBTRACT FROM ADA DSCLB LIB ADDR SSA THIS SEG ON USER TRAKS ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. LDA ED61 SZA,RSS EXAMINED MAIN'S ID ? JMP MOVEB YES, MOVE TO START OF USER TRKS. ADB P9 (B)=DMAIN ADDR OF PREVIOUS ID JMP UPID EXAMINE NEXT ID SKP * DETERMINE WHERE LAST SEGMENT OR MAIN LEFT OFF * ON USER TRACKS. * B200 OCT 200 * MOVER LDA B,I SAVE DMAN OF LAST ID STA BID2 POINTING TO USER TRACKS. LDA B ADA N4 (A)=ADDR OF MEM1 JSB C#S DETERMINE NUMBER OF SECTORS STA BID1 AND SAVE THE NUMBER LDA BID2 GET DMAN AND M177 GET SECTOR ADDR ADA BID1 ADD TO TOTAL REQUIRED CLB DTERMINE TRACK OFFSET BY DIV TRKS# DIVIDING BY SECS/TRK STA BID1 SAVE NUMBER OF TRACKS LDA BID2 GET DMAN AGAIN ALF,ALF MASK IN RAL TRACK AND M377 ADDR (RELATIVE) ADA BID1 ADD TRK OFFSET FOR MOVE STA ED66 SET AS DESTINATION TRACK STB ED67 AND SET DESTINATION SECTOR  JMP SHIFT GO DO MOVE * DESLU NOP IDCNT NOP * * MOVE TO BEGINNING OF USER TRACKS * MOVEB LDA TRAKB GET BASE TRACK ADDR STA ED66 SET DESTINATION TRACK CLB AND SECTOR TO VERY STB ED67 BEGINNING. * * * MOVE CURRENT AND REMAINING SEGMENTS * UPWARD ON USER TRACKS. * SHIFT LDB ID## SET # OF SEGS TO BE MOVED STB IDCNT INCLUDING CURRENT LDA DSKUN SET DESTINATION LU STA DESLU OF USER TRACKS LDB IDA SET ADDR OF ID SEG STB BID2 BEING PROCESSED. LDA ED66 GET TARGET TRACK NUMBER CPA TRAKP SAME AS SOURCE TRACK # ? CLA,RSS YES, THEN SKIP. JMP DIFTR NO (ATLEAST 1 TRK DIFFERENCE) LDB ED67 GET TARGET SECTOR ADDR CMB,INB MAKE NEGATIVE TO GET REMAINDER JMP SAMTR GO FIND REMAINING SECS ON TRK DIFTR INA GET NUMBER OF TRACKS CMA,INA TO BE ADA TRAKP SHIFTED THROUGH MPY TRKS# CONVER TO NUMBER OF SECTORS LDB ED67 GET DESTINATION SEC ADDR CMB,INB SUBTRACT FROM SECS/TRK ADB TRKS# TO NUM LEFT ON TRACK. SAMTR ADB ED62 ADD TO OFFSET FROM SOURCE ADB A ADD FOR TRACK OFFSET CMB,INB MAKE NEGATIVE STB BID1 SAVE NEGATIVE SEC OFFSET CLA CLEAR NUMBER STA ED21 OF SECS TO BE MOVED. * * UPDATE DMAN OF CURRENT AND REMAINING * ID SEGMENTS AND DETERMINE TOTAL NUMBER * OF SECTORS TO BE MOVED. * LDA BID2 GET ID SEG ADDR OF CURRENT ID MORID ADA P4 (A)=ADDR OF MEM1 JSB C#S FIND # OF SECS FOR THIS ID ADA ED21 ADD TO TOTAL NUMBER OF STA ED21 SECTORS TO BE MOVED. LDB BID2 ADB P8 (B)=DMAN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR ADDR STA BID4 SAVE SECTOR ADDR TEMPORARILY LDA B,I GET DMAIN AGAIN ALF,ALF  POSITION RAL AND AND M377 MASK IN RELATIVE TRK ADDR MPY TRKS# GET EQUIVALENT SEC COUNT ADA BID4 ADD SECTOR OFFSET (ADDR IN SECS) ADA BID1 DECREMENT BY SEC OFFSET CLB,CCE (A)=NEW ADDR IN SECS (SET E FOR LU 3) DIV TRKS# GET RELATIVE TRK & SEC ADDR ALF,RAL POSITION REL TRK ADDR RAL,RAL IOR B MERGE IN SECTOR ADDR LDB DSKUN GET THE DISC LU OF MOVE CPB P3 IS IT LU 3 ? RAL,ERA YES, SET SIGN BIT ON TRK-SECT WORD LDB BID2 ADB P8 (B)=ADDR OF DMAIN STA B,I UPDATE DMAIN ISZ IDCNT ALL IDS UPDATED ? RSS NO JMP FSHFT YES, GO MOVE USER TRACKS. LDA BID2 SET ADDR OF NEXT ADA N9 ID SEGMENT (EXTENDING STA BID2 DOWNWARD IN CORE) JMP MORID UPDATE NEXT ID * * MOVE USER TRACKS FSHFT LDA ED21 SET NEGATIVE NUMBER CMA,INA NUMBER OF TRACKS TO STA ED21 BE MOVED. JSB ED15 MOVE USER TRACKS * * NTRM5 LDB IDA GET CURRENT ID SEG ADDR ADB P8 (B)=ADDR OF DMAN LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN'S ADB P4 THEN ADJUST ADDR OF DMAN LDA B,I GET DMAN ALF,ALF POSITION AND RAL ISOLATE ACTUAL AND M377 STARTING TRACK NUMBER STA BID2 SAVE IT LDA B,I GET DMAIN AGAIN AND M177 GET SECTOR OFFSET CMA,INA,SZA,RSS IF NO OFFSET JMP TRBDY THEN NO SPECIAL FIX ADA TRKS# GET SEC LEN - OFFSET CMA,INA TO GET # OF SECS USED IN 1ST TRK ADA ABT13 SUBRTRACT FROM TOTAL SECS NEEDED SSA CROSSED TRACK BOUNDARY ? JMP NTRM9 NO - THEN TAT OK. CLB YES - THEN FIND TRACKS REQD. DIV TRKS# (EXCLUDING OFFSET) SZB IF REMAINDLER INA THEN BUMP TO WHOLE TRACK STA #TRAK SET NEW TRACK LENGTH ISZ BID2 ALSO FORGET ABOUT FIRST TRACK TRBDY LDA #TRAK SET NUMBER OF CMA,INA,SZA,RSS TRKS AS NEGATIVE COUNT. JMP NTRM9 TAT OK IF ON TRK BOUNDARY STA ABT1 COUNT. LDA TRKLU SET (B) = FWA OF LDB TATSD SYSTEM CPA P2 OR AUXILIARY CLB DISC'S TRACK BASE ADB TAT ADB BID2 (B)=ADDR IN TAT STB ABT2 SAVE TAT'S ADDR * NTRM2 LDA MSIGN (A)=100000 FOR SYSTEM ASSIGNED. LDB ABT2 (B)= TAT ADDR JSB SYSET SET VALUE IN TAT CLA CHECK CPA EDFLG OPERATION JMP NTRM8 -NORMAL LDA MSIGN -EDITING- CHANGE LDB ABT2 WORD IN JSB SYRUW TAT ON DISC NTRM8 ISZ ABT2 ADD 1 TO TAT ADDR. ISZ ABT1 INDEX TRACK # COUNTER. JMP NTRM2 -DO NEXT TRACK. * * * DO FINAL ID SEGMENT PROCESSING * NTRM9 CLB CLA,INA (A)=1 FOR ADDITION CPB EDFLG IF NOT EDITING CLA THEN (A)=0 FOR NORMAL LOAD LDB ED25 (B)=ADDR OF TARGET ID IF ANY JSB MVIDS MOVE DUMMY TO REAL ID JSB FIX FIX FOR TRYING LONG TO SHORT MOVE CLA CPA MSEG DOING MAIN/SEGMENT LOAD JMP NTRM4 NO, THEN TERMINATE. JMP *+1,I YES, SET UP FOR NEXT SEG. DEF ED183 (SAVE A BP LINK TOO !) * NTRM4 EQU * SPC 1 IFZ ******* BEGIN MEU CODE ******** LDA #MNPG CALCULATE CMA,INA NUMBER OF PAGES ADA #MXPG USED BY CODE ADA P2 +1 CURR PAGE, +1 BASE PAGE LDB #PGS # PAGES REQUESTED SZB,RSS BY USER? STA #PGS NO, USE PROG SIZE * LDA PLIST SLA LOADR LISTING SUPPRESSED? JMP PTNCK YES, SKIP #PAGES MESS. JSB SPACE LDA #PGS GET PROG SIZ4`E + BASE PAGE JSB CNV99 CONVERT TO ASCII STA MS11# FILL INTO MESSAGE LDA P18 LDB MES11 PRINT MESSAGE JSB DRKEY '00 PAGES REQUIRED' * PTNCK CCA CHECK #PAGES REQ'D DOESN'T LDB PTYPE EXCEED MAX OF QUALIFIED PTTN CPB P2 RT? LDA #MXRT YES SSA (IF NO RT PTTNS, LDA #MXBG USE BG PTTN MAX) SSA (IF NO BG PTTNS, LDA #MXRT USE RT PTTN MAX) SSA SUPER-DUPER ERROR CHECK JMP ER.16 IF NONE, OH-OOH! INA ADD 1 FOR BASE PAGE LDB #PGS CMB,INB ADB A #PAGES REQ'D SSB > MAX ? JSB WN.17 YES, GIVE WARNING * CCB BUILD ID SEG WORD 22 ADB #PTTN PUT PTTN NUMBER CCE,SSB IN BITS 0-5 CLB,RSS SET BIT 15 IF PTTN RBL,ERB REQUESTED, ELSE 0 * CCA ADA #PGS PUT NUMBER OF PAGES ALF,RAR FOR PROG'S PTTN IOR #MPFT IN BITS 10-14 ALF,ALF & MEM PROT FENCE TABLE RAR INDEX INTO IOR B BITS 7-9 LDB #IDAD KEEP IT IN (A) ADB P21 GET ADDR WORD 22 OF STB SYR1 ID SEG FOR PROG JSB SYSET SET ID SEG IN MEMORY LDB EDFLG SZB,RSS PERMANENT PROG? JMP *+3 NO LDB SYR1 YES, FIX DISC ID SEG JSB SYRUW * JMP DONE FINISHED * * * ISSUE WARNING FOR CODE EXCEEDING PTTN SIZE * CALL SEQUENCE: JSB WN.17 * WN.17 NOP LDA P4 (A)=CHAR COUNT LDB WNG17 (B)=MESSAGE ADDR JSB SYOUT PRINT: 'W 17' JMP WN.17,I RETURN * WNG17 DEF *+1 ASC 2,W 17 CODE > PTTN SIZE * MES11 DEF *+1 ASC 9,00 PAGES REQUIRED MS11# EQU MES11+1 * ******* END MEU CODE ********** XIF SPC 1 DONE LDA #IDAD INA GET ADDR OF ID TEM5P AREA LDB #IDAD ADB P10 GET ADDR OF B-REG SAVE WORD STB SYR1 WITHIN THE ID SEG JSB SYSET SET TEMP ADDR IN B LDB EDFLG SZB,RSS JMP *+3 LDB SYR1 IF PERMANENT, UPDATE JSB SYRUW ID SEG ON DISC TOO * LDA P12 LDB MESS4 MESS4 = ADDR: XXXXX READY ETC. JSB SYOUT PRINT: XXXXX READY - LOADING ETC * * * EXIT JSB SPACE DO A LINE FEED LDA P4 SET UP TO LDB ENDMS SEND END MESSAGE. * LTERM JSB SYOUT SEND TERMINATE MESSAGE * * LDB BATCH GET BATCH FLAG * LDA OPCOD GET OP CODE * CPA P4 IS IT DELETE ? * SZB YES - NON-BATCH OPERATION ? * JMP DLEN NO - THEN GO THROUGH PAGE-EJECT * JMP EXIT1 AVOID PAGE EJECT FOR NON-BATCH DELETE DLEN LDA PLIST GET LIST/NO LIST FLAG CPA P3 SKIP PAGE EJECT IF JMP EXIT1 NOT LISTING ANYTHING AT ALL * LDA TYPE3 GET THE LIST TYPE ERA,SLA FILE OR LU ? JMP EXIT1 FILE. PAGE EJECT NOT NECESSARY * LDA LISTU GET THE LIST LU AND M77 TO A IOR M1100 SET THE PAGING BITS STA RELAD SET FOR EXEC CALL JSB EXEC DEF *+4 CALL TO EJECT A PAGE ON A DEF P3 PRINTER OR DEF RELAD SPACE 2 LINES ON DEF N2 A TTY * * EXIT1 JSB EXEC RELEASE DEF *+3 ANY TRACKS DEF P5 NOT DEF N1 ACCOUNTED FOR. * * JSB FCLOS CLOSE ALL OPEN FILES * * * PASS BACK PROG NAME TO BATCH MONITOR * JSB PRTN CALL ROUTINE DEF *+2 DEF PRAM ADDR OF NAME BUF * SPC 1 JSB EXEC REQUEST PROG COMPLETION DEF *+2 DEF P6 6 = PROG COMPLETION CODE SPC 1 $END ASC 2,$END M1100 OCT 1100 SPC 1 RELAD BSS 1 RELATIVE BG ADDR M40 OCT 40 TEMPP BSS 1 A|BSOLUTE PROG WORD LELAD DEC -1 OFFSET INTO CURRENT LOAD MODULE ABWRD NOP SAVED ABSOLUTE PROG WORD ENDMS DEF $END SKP * P21 DEC 21 * SUBROUTINE: "MEM?" IDENTIFY LONG/SHORT ID SEGMENT * * THIS SUBROUTINE IDENTIFIES WHETHER THE ID SEGMENT * UNDER CONSIDERATION IS LONG OR SHORT. * * (NOTE: THIS ROUTINE NOT USED FOR DUMMY ID SEGMENTS * SET UP BY THE LOADER) * * CALL: (B)=ADDRESS OF NAM5 WORD IN ID SEGMENT * (P) JSB MEM? * * RETURN (P+1) FOR SHORT ID SEGMENT * (P+2) FOR LONG ID SEGMENT * REG-B = ADDRESS OF MEM1 IN ID SEGMENT. * REG-A = OCT 20 IF (P+1) RETURN * = 0 IF (P+2) RETURN * * MEM? NOP LDA B,I GET NAM5 WORD FROM ID SEG AND M20 MASK IN 'SS' BIT INB (B)=MEM1 ADDR OF SHORT ID SZA LONG ID ? ('SS' BIT = 0) JMP MEM?,I NO, SHORT ID RETURN. ADB P7 (B)=MEM1 ADDR OF LONG ID ISZ MEM? BUMP TO (P+2) RETURN JMP MEM?,I LONG ID RETURN * SKP * SUBROUTINE: "MIDN" MATCH ID SEGMENT NAME * * THIS ROUTINE SEARCHES THE SYSTEM ID SEGMENTS * TO FIND A MATCH WITH THE NAME IN THE CURRENT * DUMMY ID SEGMENT. * * CALL: (P) JSB MIDN * (P+1) -NO MATCH RETURN- * (P+2) -MATCH RETURN, ID SEG ADDR IN ABT1 AND (B) * MIDN NOP LDA KEYWD INITIALIZE STA ABT1 KEYWORD LIST ADDR. * MIDN1 LDB ABT1,I IF END-OF-LIST, SZB,RSS RETURN TO JMP MIDN,I NO MATCH RETURN, P+1. * ADB P12 COMPARE LDA B,I NAME CPA NAM12,I AREAS INB,RSS OF JMP MIDN2 DUMMY ID SEG. LDA B,I AND CPA NAM34,I CURRENT INB,RSS SYSTEM ID SEG. JMP MIDN2 LDA B,I STA BLKID SAVE THE TYPE WORD AND M7400 STA B LDA NAM5,I AND M7400 CPA B JMP MIDN3 MATCH - MIDN2 ISZ AB$T1 INDEX FOR NEXT ID SEGMENT- JMP MIDN1 CONTINUE SCAN. * MIDN3 ISZ MIDN MATCH - ADJUST RETURN TO (P+2) LDB ABT1,I (B) = ADDR OF MATCH ID SEG. LDA BLKID GET THE ID WORD AND P7 STRIP TO TYPE CPA P4 IF CORE RSS CPA P1 RESIDENT JMP ERL11 ERROR GO SEND MESSAGE AND ABORT JMP MIDN,I RETURN. SPC 1 ERL11 LDA ASL11 SEND L11 MESSAGE JMP ABOR AND ABORT SPC 2 ASL11 ASC 1,11 * * CONVERT TO DECIMAL ASCII (MAX VALUE = 99) * CALL SEQUENCE: LDA VALUE * JSB CNV99 * STA ASCII * CNV99 NOP QUICK CONVERSION CLB BINARY TO DECIMAL ASCII DIV P10 MAX VALUE = 99 SZA ADA M20 FORCE LEADING BLANK IF ZERO ADA M40 ALF,ALF PUT IN LEFT HALF IOR B FILL UNITS IN RIGHT IOR B60 JMP CNV99,I RETURN ASCII IN (A) B60 OCT 60 SKP * * SUBROUTINE: 'SYRUW' SYSTEM DISC READ/UPDATE/WRITE * * THIS ROUTINE PROVIDES FOR UPDATING A WORD IN * THE ID SEGMENT OR 'TAT' AREA OF THE SYSTEM DISC. * * CALL: (A) = VALUE TO BE STORED IN WORD * (B) = ADDR OF WORD IN ID SEG AREA OR TAT * * (P) JSB SYRUW * (P+1) -RETURN- * * SYRUW NOP STA SYR1 SAVE VALUE LDA KEYWD,I SUB. FWA OF 1ST ID SEGMENT CMA,INA AND ADD IN ADA B POSITION OF 1ST ADA IDSDP ID SEG TO GET RELATIVE ADDR. CLB DIVIDE DIV P64 BY 64 ADB ALBUF SET ADDR STB SYR2 WITHIN LBUF STA B SAVE REL SECTOR # LDA IDSDA GET DISC ADDR OF 1ST ID SEG, AND M177 ISOLATE SECTOR # AND ADB A ADD TO REL SECTOR # LDA IDSDA GET AND ALF,ALF SAVE STARTING RAL TRACK #. AND M377 STA UTRAK LDA B @HFB DIVIDE REL SECTOR CLB # BY # SECTORS/ DIV SECT2 TRACK STB USECT AND SET SECTOR # ADA UTRAK SET ABS. STA UTRAK TRACK #. * JSB UREAD READ IN SECTOR * LDA SYR1 UPDATE STA SYR2,I WORD ISZ P1 CHANGE 1 TO 2 (FOR UPDATE) JSB UREAD RE-WRITE SECTOR CLA,INA RESET 1 STA P1 IN 'P1'. * JMP SYRUW,I RETURN. * SYR1 NOP SYR2 NOP H SKP * OUTPUT ABSOLUTE PROG WORD * * ABOUT PUTS OUT THE CURRENT ABSOLUTE PROG WORD. * * IF THE CURRENT PROGRAM WORD IS TO BE LOCATED IN A DIFFERENT * SECTOR FROM THE CURRENT SECTOR, THE CURRENT SECTOR IS WRITTEN ON * THE DISK AND THE APPROPRIATE SECTOR READ. * * * CALLING SEQUENCE: * A = CURRENT PROGRAM WORD * B = ADDRESS * DTBL SET UP AS FOLLOWS: *DTBL DEF BASE MEMORY ADDRESS * DEF BASE TRACK OFSET -STRAK * DEF BASE SECTOR OFSET -SSECT * * JSB ABOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED * ABOUT NOP STB TEMPQ SAVE THE ADDRESS STA TEMPP SAVE ABSOLUTE PROG WORD LDA DTBL,I SUBTRACT FWA OF CMA,INA AREA FROM CURRENT ADA B ADD CURRENT RELOCATION ADDR. STA RELAD SAVE RELATIVE ADDR. LDA MSIGN SET ABT14 TO INA BE 100001 FOR NO SUSPENSION, STA ABT14 1 TRACK ALLOCATION. * CLA,INA IF FLAG SAYS DUMMY BASE PAGE CPA ABT12 AREA IS BEING OUTPUT, JMP AB0 SKIP OVERFLOW CHECK. * CMB,INB FROM LWA OF AREA. ADB LWA -ERROR SSB IF AREA IS JMP LGERR EXCEEDED. * AB0 CLB DIVIDE RELATIVE ADDR LDA RELAD BY 64 (SECTOR SIZE). DIV P64 STB SPOS SAVE REMAINDER (POSITION) ADA DTBL+2,I ADD STARTING SECTOR OF PROG.=0 IF MAIN CLB DIVIDE BY # OF DIV TRKS# SECTORS PER TRACK. CLE SET FOR ERB,RBL EVEN SECTOR BOUNDARIES STB TSECT SAVE SECTOR # IN TRACK. LDB P64 SEZ,RSS IF SECTOR WAS ODD JMP *+3 * ADB SPOS OFFSET POSITION TBY 64 STB SPOS ADA DTBL+1,I ADD THE PGRM BASE TRACK AND(=0 IF MAIN) STA B SAVE FOR TEST OF OVERFLOW ADA TRAKB ADD IN TRACK BASE ADDR. STA TTRAK SAVE AS ABSOLUTE TRACK |U# LDA #TRAK SUBTRACT # OF TRACKS ALLOCATED CMA,INA FROM RELATIVE TRACK #, ADA B A POSITIVE RESULT MEANS TRACK SSA,RSS OVERFLOW, GO TO JMP AB3 OVERFLOW SECTION. * * TRACK/SECTOR OF CURRENT WORD IS DETERMINED. * LDA TTRAK CHECK FOR CURRENT TRACK/SECTOR CPA DTRAK = TRACK/SECTOR IN CORE. RSS TRACKS =. JMP AB1 LDA TSECT CHECK FOR SECTOR CPA DSECT # NEEDED. JMP AB2 -CURRENTLY IN CORE. * * WRITE OUT SECTOR IN CORE, READ IN NEW SECTOR * AB1 JSB DWRIT WRITE CURRENT SECTOR. LDA TTRAK SET STA DTRAK NEW LDA TSECT TRACK/SECTOR #'S. STA DSECT JSB DREAD READ IN DESIRED SECTOR. * AB2 LDB ADBUF ADD POSITION IN SECTOR OF NEW ADB SPOS WORD TO ADDR OF DBUF. LDA TEMPP STORE ABSOLUTE WORD INTO STA B,I DBUF CLA,INA RETURN IMMEDIATELY IF DUMMY CPA ABT12 BASE PAGE AREA IS JMP ABOUT,I BEING OUTPUT * * CHECK FOR NEW UPPER BOUND * LDA TEMPQ ABSOLUTE LOAD ADDR, INA ADD 1, STA B SAVE. CMA,INA -SUBTRACT THIS ADDR ADA TPREL FROM CURRENT UPPER BOUND, SSA IF CURRENT IS LARGER, * * SET UP TPREL HIGH LOAD +1 !!!!!!!!!!!!! * STB TPREL SET NEW ADDR. JMP ABOUT,I RETURN * TEMPQ NOP * * * OVERFLOW OF TRACK ALLOCATION * AB3 JSB EXEC ASK FOR 1 TRACK DEF *+6 DEF P4 DEF ABT14 1 TRACK. DEF ABT1 -STARTING TRACK # - DEF ABT2 -LOGICAL UNIT # - DEF ABT3 -# SECTORS PER TRACK- * CCA CPA ABT1 IF NO TRACK AVAILABLE, JMP AB4 GO TO PRINT WAITING MESSAGE. * LDA ABT2 CHECK IF NEW TRACK ON SAME CPA TRKLU DISC (LOGICAL UNITS =) RSS -YES JMP AB10 h -NO, LDA TRAKB CHECK FOR NEW TRACK TO ADA #TRAK BE NEXT CONTIGOUS TO CMA,INA SUBTRACT FROM ADA ABT1 NEW ALLOCATION SZA IF CONTIGOUS SKIP JMP AB5 ELSE GO TEST FURTHER JSB RELLO RELEASE ANY TRACKS BELOW THE NEEDED ISZ #TRAK ADD 1 TO # OF TRACKS JMP AB0 CONTINUE. * * PRINT WAITING MESSAGE AND REPEAT 1 TRACK CALL * AB4 LDA P22 PRINT: LDB ITRKM "WAITING FOR DISC SPACE" JSB SYOUT CLA,INA RESET FOR SUSPENSION, STA ABT14 1 TRACK, JMP AB3 REPEAT CALL. SPC 1 AB5 SSA,RSS IF NEW TRACK BELOW CURRENT AREA JMP AB10 SKIP, ELSE GO SET TO MOVE JMP AB3 GO TRY ANOTHER ALLOCATION SPC 1 * * NOT CONTIGUOUS, RELEASE LATEST AND ALLOCATE * COMPLETE NEW SET OF TRACKS. * AB10 JSB EXEC RELEASE ONE DEF *+5 TRACK DEF P5 JUST DEF P1 ALLOCATED DEF ABT1 DEF ABT2 * JSB RELLO RELEASE ALL TRACK BLOW CURRENT LDA #TRAK SAVE STA ABT1 CURRENT LDA TRAKB VARIBLES STA ABT2 ASSOCIATED STA ABT9 LDA TRKLU WITH STA ABT3 TRACK LDA TRKS# ALLOCATION STA ABT4 LDA SSECT STA ABT5 LDA STRAK STA ABT6 * JSB DWRIT WRITE OUT CURRENT SECTOR. ISZ #TRAK JSB ITRAK LARGER THAN PREVIOUS. * LDA ABT2 OLD TRAKB + OLD #TRAK ADA ABT1 TO ABT7 FOR LIMIT STA ABT7 ON MOVE. LDA TRAKB STA ABT8 CLA SET STARTING STA ABT10 SECTOR # = 0 FOR BOTH STA ABT11 SOURCE AND DESTINATION TRACKS. * * MOVE PREVIOUS INFORMATION TO NEW SET OF TRACKS * AB11 JSB EXEC READ SECTOR DEF *+7 DEF P1 DEF ABT3 SOURCE LOGICAL UNIT DEF DBUF DBUF INPUT =) DEF P128 DEF ABT9 CURRENT TRACK DEF ABT10 CURRENT SECTOR * JSB EXEC WRITE SECTOR DEF *+7 DEF P2 DEF TRKLU DESTINATION LOGICAL UNIT DEF DBUF DEF P128 DEF ABT8 CURRENT TRACK DEF ABT11 CURRENT SECTOR * LDA ABT10 UPDATE SOURCE ADA P2 SECTOR #. CPA ABT4 IF = TO # SECTORS PER TRACK, CLA RESET TO ZERO STA ABT10 AND RESTORE. SZA,RSS IF RESET ISZ ABT9 ADD 1 TO CURRENT TRACK #. LDA ABT9 CHECK FOR TERMINATION CPA ABT7 TRACK #. JMP AB12 -YES. * LDA ABT11 UPDATE DESTINATION ADA P2 SECTOR #. CPA TRKS# IF = TO # SECTORS PER TRACK CLA RESET TO ZERO STA ABT11 AND RESTORE. SZA,RSS IF RESET, ISZ ABT8 ADD 1 TO CURRENT TRACK #. LDA TRAKB CHECK FOR POSSIBLE ADA #TRAK OVERFLOW OF NEW CPA ABT8 ALLOCATION. HLT 0 ?????????????????????????????????????? JMP AB11 -NO, CONTINUE COPY * AB12 LDA TRAKB SET UP "DREAD" STA DTRAK AND CLA READ IN SECTOR 0 STA DSECT OF FIRST TRACK JSB DREAD TO INITIALIZE. * * RELEASE OLD SET OF TRACKS * JSB EXEC DEF *+5 DEF P5 DEF ABT1 DEF ABT2 DEF ABT3 * LDA ABT5 RESET RELATIVE STA SSECT STARTING TRACK AND SECTOR LDA ABT6 FOR CURRENT STA STRAK LOAD. * * ADJUST RELATIVE DMAN IN SEGMENTS' IDS IF * PROCESSING SEGMENTS (MAIN'S RELATIVE * DMAN IS ALREADY SET UP - ZERO). * CLA,INA CPA ID# IF PROCESSING SEGMENTS RSS JMP AJST THEN ADJUST THEIR DMAN * * CHECK FOR DIFFERENT SIZE DISCS * LDA ABT4 IF # OF SECTORS IS THE SAME CPA TRKS# ON BOTH ALLOCATIONS, JMP AB0 T-WHEN CONTINUE TO LOAD. * CLA IF NOT DOING MAIN/SEGMENT CPA MSEG LOADING, THEN ALSO JMP AB0 CONTINUE TO LOAD. * * NEED TO ADJUST BASE TRACK/SECTOR BASES FOR * MAIN AND SEGMENTS. * * AJST LDA ID# SET INDEX AS # OF DEFINED CMA,INA DUMMY ID SEGMENTS STA ABT1 FOR MAIN/SEGMENT. CCB SET 'STRAK' & 'SSECT' TO STB ABT7 BE SET ONLY ONCE. LDA IDA (A)= STARTING ADDR. * AB14 ADA P8 SET (ABT2) = ADDR OF ID STA ABT2 SEGMENT WORD (DISC ADDR) ISZ ABT1 IF ABOUT TO UPDATE MAIN'S ID RSS JMP AB0 THEN AVOID - DMAN ALREADY ZERO. LDA ABT2,I GET DISC ADDR AND M177 ISOLATE AND SAVE STA ABT5 SECTOR #. LDA ABT2,I GET AGAIN ALF,ALF FOR RAL ISOLATING AND M377 TRACK #. MPY ABT4 MULTIPLY BY PREVIOUS # SECT/TRAK ADA ABT5 ADD SECTOR BASE, CLB DIVIDE BY NEW TRKS# TO GET NEW DIV TRKS# TRACK/SECTOR BASE. ISZ ABT7 IF 'STRAK' & 'SSECT' SET ONCE JMP *+3 THEN DO NOT MODIFY AGAIN. STA STRAK SET RELATIVE TRACK & SECTOR STB SSECT ADDR FOR NEXT ID SEGMENT. ALF,ALF ROTATE TRACK TO 14-07, RAR AND -OR- SECTOR # IOR B INTO 06-00, STA ABT2,I RESTORE WORD IN ID SEGMENT. LDA ABT2 (A)= ID SEGMENT (DUMMY) ADDR. INA JMP AB14 -CONTINUE TO PROCESS. * P22 DEC 22 ABT1 NOP TEMPORARY ABT2 NOP ABT3 NOP STORAGE ABT4 NOP ABT5 NOP FOR ABT6 NOP ABT7 NOP "ABOUT" ABT8 NOP ABT9 NOP ROUTINE. ABT10 NOP ABT11 NOP ABT12 NOP ABT13 NOP ABT14 NOP SPC 1 RELLO NOP RELEASE ALL OWNED TRACKS BELOW CLA THE CURRENT TRAKB STA ABT2 CLEAR THE TRACK COUNT LDA TA/T SET THE ATAT ADDR STA ABT3 FOR INDEXING LDB TATSD SET UP THE TRAKB STOP LDA TRKLU IF ON LU 3 SLA,RSS THEN CLB ADD TATSD ADB TRAKB ADD THE CURRENT BASE STB ABT5 SET AS THE LIMIT SPC 1 GA0 LDA ABT2 GET CURRENT TRACK CPA ABT5 END? JMP RELLO,I YES RETURN LDA ABT3,I NO IS THE TRACK CPA XEQT ASSIGNED TO ME? RSS IF SO SKIP JMP GA1 ELSE GO STEP THE PNTRS LDA P2 SET UP TO REALSE THE TRACK LDB TATSD IF ON CMB,INB LU 3 ADB ABT2 THE SSB,RSS TRACK AND LU INA MUST BE ADDJUSTED SSB FOR THE AUX DISC LDB ABT2 DST ABT6 SET FOR THE CALL JSB EXEC GIV THE TRACK BACK DEF *+5 DEF P5 DEF P1 DEF ABT7 DEF ABT6 SPC 1 GA1 ISZ ABT2 ISZ ABT3 STEP THE PNTRS JMP GA0 AND CONTINUE SKP * * SUBROUTINE: "MVIDS" MOVE ID SEGMENT * * PURPOSE: THIS IS A GENERAL ROUTINE TO PROCESS * THE DUMMY ID SEGMENTS GENERATED DURING * BOTH A NORMAL LOAD AND AN EDITING * OPERATION. IT PERFORMS THE FOLLOWING * FUNCTIONS ACCORDING TO THE TYPE OF * LOAD OPERATION: * * 1) NORMAL BG LOAD: * * -FIND BLANK ID SEGMENT * -MOVE DUMMY ID SPECIFIED BY * THE CONTENTS OF "IDA" TO * THE POSITION OF THE BLANK * ID SEGMENT IN THE SYSTEM AREA. * * 2) EDITING OPERATION: * * ADDITION: SAME AS FOR A NORMAL * LOAD EXCEPT THAT THE NEW * ID SEGMENT IS WRITTEN IN THE * APPROPRIATE AREA ON THE SYSTEM * DISC TO MAKE THIS A PERMANENT * ADDITION. * * * * CALLING SEQUENCE: (IDA) = ADDR. OF DUMMY RB* ID SEGMENT * * (A):= 0 FOR NORMAL LOAD * * = 1 FOR EDITING ADDITION * * (B) = ID SEGMENT ADDR IF A * PARTICULAR ONE IS TO * BE USED FOR ADDITION. * * (P) JSB MVIDS * (P+1) -ERROR - NO BLANK ID'S- * (P+2) - NORMAL RETURN- * SKP * MVIDS NOP JSB $LIBR GO PRIVILEDGED !!!!!!!!!!!!!!! NOP STA ABT10 SAVE EDIT NO-EDIT FLAG STB ABT11 SAVE DESTINATION ID ADDR * LDA DESA INITIALIZE DESTINATION STA DESAM ADDR ARRAY PNTR. LDA RTORG SUBTRACT FWA OF R/T AREA CMA,INA FROM SOURCE ID ADDR TO ADA IDA CHECK IF SOURCE IS IN DUMMY. SSA,RSS SOURCE ID IN SYSTEM AREA ? JMP DMYMV NO, THEN IT IS IN DUMMY. * * SOURCE ID IS IN SYSTEM AREA AND SO DESTINATION * MUST BE SPECIFIED. ONLY MEM1 TO DMAN NEED TO * BE MOVED FROM SOURCE TO DESTINATION. * LDB IDA ADB P14 (B) = NAM5 ADDR OF SOURCE ID JSB MEM? GET ADDR OF MEM1 NOP STB SRADR SET FWA OF SOURCE LDB ABT11 GET DESTINATION ID ADDR ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? GET ADDR OF MEM1 NOP LDA N5 SET MOVE COUNT = 5 WORDS STA NUMWD FOR MEM1 TO DMAN. JSB STRFR TRANSFER ADDRES INTO ARRAY JMP MOVID MOVE TO SYSTEM AREA * * SET ADDRESS ARRAY FOR CONSEQUETIVE MOVE. * (A) = NUMBER OF WORDS TO BE MOVED * (B) = FIRST WORD DESTINATION ADDR * STRFR NOP SADRS STB DESAM,I SET DESTINATION ID WORD ADDR ISZ DESAM MOVE UP TO NEXT ARRAY STORAGE INB BUMP ID WORD ADDR INA,SZA ALL ADDRES STORED ? JMP SADRS NO, THEN CONTINUE. JMP STRFR,I RETURN * * SOURCE ID IS IN DUMMY AREA. SET SOURCE * ADDRESS AND CO8UNT AND ALSO CHECK IF * DESTINATION ID HAS BEEN SPECIFIED. * DMYMV LDB IDA SET ADDR STB SRADR OF SOURCE ID. LDA ID# CHECK IF SOURCE CMA,INA ID IS FOR CPA ID## MAIN (LONG ID) ? CLA,RSS SET FLAG FOR LONG ID = 0 CCA SET FLAG FOR SHORT ID = -1 STA SSFLG SOURCE ID TYPE FLAG LDB N9 SET MOVE COUNT=-9 (SHRT ID) SZA,RSS IF LONG ID LDB N13 THEN SET MOVE COUNT=-13. STB NUMWD LDB ABT11 GET DESTINATION ID ADDR SZB,RSS DESTINATION SPECIFIED ? JMP FBLNK NO, THEN FIND BLANK ID. * * DESTINATION ID HAS BEEN SPECIFIED * ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? FIND IF ID LONG OR SHORT. CCB,RSS SHORT ID, SET (B)=-1. CLB LONG ID, SET (B)=0. SZB DESTINATION ID LONG ? JMP SCHK NO, GO CHECK SOURCE ID. CPB SSFLG YES. IS SOURCE ID ALSO LONG. JMP DB13B YES, THEN SET 13 WORD TRANSFER. JMP SDS9B NO, SET 9 TO 13 WORD TRANSFER. SCHK CPB SSFLG IS SOURCE ID SHORT TOO ? JMP DS9S YES, SET 9 TO 9 WORD TRANSFER. MBACK JSB $LIBX ERROR RETURN (LONG TO SHORT ILLEGAL). DEF MVIDS * * FIND BLANK ID OF APPROPRIATE LENGTH * FBLNK JSB BLKID FIND BLANK ID ASSIGNMENTS LDB SSFLG GET SOURCE ID FLAG SZB,RSS SOURCE ID SMALL ? JMP SLNG NO, ANALYZE FOR LONG ID. LDA BID4 SET ADDR OF SMALL ID STA ABT11 W/O DISC ALLOCATION. LDB BID8 GET # OF SMALL IDS W/O DISC ALLOC SZB ANY SMALL IDS W/O DISC ALLOCATION ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR LDA BID3 SET ADDR OF SMALL ID STA ABT11 WITH LEAST DISC ALLOCATION. LDB BID6 (B)=3 SMALL IDS WITH & W/O DSC ALLOC SZB ANY AVAILABLE ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALLX TRFR * SLNG LDB BID7 GET # OF LONG IDS W/O DISC ALLOC LDA BID2 (A)=LONG ID ADDR W/O DISC ALLOC SZB ANY LONG ID W/O DISC ALLOCATION ? JMP SSCHK YES LDA BID1 (A)=LONG ID ADDR WITH LEAST DSC ALLOC LDB BID5 (B)=# OF LONG IDS WITH & W/O DSC ALLC SZB,RSS ANY LONG ID WITH DISC ALLOCATION ? JMP OSHIT NO, DO ERROR RETURN. * SSCHK STA ABT11 SET DESTINATION ID ADDR LDA SSFLG GET SOURCE ID FLAG SZA,RSS SOURCE ID LONG ? JMP DB13B YES, SET 13 WORD BIG-TO-BIG TRANSFER SKP SDS9B LDB IDA ADB P3 (B)=NAM5 ADDR IN SHORT ID LDA B,I GET NAM5 WORD CONTAINING 'SS' BIT XOR M20 MASK OFF 'SS' BIT STA B,I AND STORE BACK NAM5 * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * BIG ID IN SYSTEM AREA. * LDB ABT11 GET DESTINATION ID ADDR ADB P7 (B)=ADDR OF PRIM ENTRY POINT STB DESAM,I SET ADDR IN ARRAY ISZ DESAM ADB P5 (B)=ADDR OF NAM12 LDA N3 (A)=-3 FOR TRFR OF NAM12 TO NAM5 JSB STRFR TRANSFER ADDR PNTRS ADB P7 (B)=ADDR OF MEM1 LDA N5 (A)=-5 TO TRFR MEM1 TO DMAN PNTRS JSB STRFR TRANSFER MEM1 TO DMAN ADDRES JMP MOVID DO MOVE TO SYSTEM AREA * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * SMALL ID IN SYSTEM AREA. * DS9S LDB ABT11 (B)=DESTINATION ID ADDR ADB P11 POSITION TO PRENT OF ID SEG LDA N9 (A)=-9 TO TRANSFER 9 WORDS JSB STRFR TRANSFER ADDR PNTRS JMP MOVID DO MOVE TO SYSTEM AREA * N3 DEC -3 P11 DEC 11 * * TRANSFER FROM BIG ID IN DUMMY AREA * TO BIG ID IN SYSTEM AREA. * DB13B LDB ABT11 GET DESTINATION ID ADDR ADB P6 (B)=ADDR OF PRIORITY WORD LDA N2 (A)=-2 TO TRFR PRIOTY & PRM EN PNT JSB STRFR TRANSFER ADDR PNTRS ADB P4 (B)=ADDR OF NAM12 LDIA N3 (A)=-3 TO TRFR NAM12 TO NAM5 PNTRS JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF RESL WORD LDA N3 (A)=-3 FOR RESL TO TMDY2 ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF MEM1 LDA N5 (A)=-5 FOR MEM1 TO DMAN ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS * AND DO MOVE TO SYSTEM AREA. SKP * * * MOVE INTO SYSTEM ID AREA TAKES PLACE FROM * SOURCE (FIRST WORD ADDR IN 'SRADR' AND * AND BUMPED CONSEQUETIVELY) TO DESTINATION * (ADDRESS POINTERS SET UP IN 'DESAM' ARRAY). * NUMBER OF WORDS TO BE MOVED IS IN 'NUMWD'. * MOVID LDB DESA INITIALIZE DESTINATION STB DESAM ADDR ARRAY PNTR. LDB SRADR SAVE SOURCE AS WELL. STB SRAD2 LDB NUMWD STB NUMW2 KEPON LDA SRADR,I GET WORD FROM SOURCE ID LDB DESAM,I (B)=ADDR OF DESTINATION ID WORD STA B,I STORE IN SYSTEM ID ISZ DESAM BUMP DESTINATION ARRAY ADDR ISZ SRADR BUMP SOURCE ADDR OF ID WORD ISZ NUMWD ALL WORDS MOVED ? JMP KEPON NO, DO MORE. * JSB $LIBX RESTORE INTERUPT PROCESSING DEF *+1 DEF *+1 * LDB ABT10 GET EDITING FLAG SZB,RSS ARE WE EDITING ? JMP NODSK NO. DON'T UPDATE THE DISC * LDB DESA GET THE SOURCE AGAIN STB DESAM DODSK LDA SRAD2,I LDB DESAM,I JSB SYRUW UPDATE THE DISC ISZ DESAM ISZ SRAD2 ISZ NUMW2 FINISHED ? JMP DODSK NO . * NODSK LDB ABT11 GET DEST ADDR ADB P14 BUMP TO NAM5 ADDR LDA B,I GET TYYPE AND P7 CPA P5 IS IT A SEGMENT? CLA,RSS YES, SET SSFLG=0 CCA NO, SET SSFLG=-1 STA SSFLG SPC 1 IFZ ******* BEGIN MEU CODE ******** JSB MEM? USE MEM? TO GET ADDR OF MEM1 NOP k IGNORE SHORT RETURN ******* END MEU CODE ********** XIF SPC 1 ISZ SSFLG SKIP IF NOT SEGMENT JMP MOVI2 BUT IF SEGMENT TRY FIND HIGH LDA ABT11 FIND LOW SINCE THIS IS MAIN STA #IDAD SAVE ADDR OF THIS ID SPC 1 IFZ ******* BEGIN MEU CODE ******** LDA B,I (B) STILL IS ADDR OF MEM1 ALF,RAL SHIFT PAGE NUMBER RAL TO BITS 0-4 AND M37 STA #MNPG SAVE LOWEST PAGE # ******* END MEU CODE ********** XIF SPC 1 * MOVI2 EQU * SPC 1 IFZ ******* BEGIN MEU CODE ******** INB INCRE TO MEM2 CCA SUBT 1 FROM MEM2 FOR ACTUAL LAST WORD ADA B,I ALF,RAL SHIFT PAGE NUMBER RAL TO BITS 0-4 AND M37 LDB A CMB,INB IS THIS PAGE # ADB #MXPG HIGHER THAN PREVIOUS SSB HIGHEST PAGE #? STA #MXPG YES, SET NEW HIGH ******* END MEU CODE ********** XIF SPC 1 ISZ MVIDS BUMP TO SUCCESSFUL RETURN JMP MVIDS,I **RETURN** * * 'MVIDS' CONSTANTS * NUMWD NOP NUMBER OF WORDS TO BE MOVED SRADR NOP FWA OF SOURCE ID MOVE DESA DEF MVBUF ARRAY CONTAINING ADDRES * IN DESTINATION ID AREA DESAM NOP CURRENT PNTR TO ARRAY SSFLG NOP 0 FOR LONG, -1 FOR SHORT SOURCE ID NUMW2 NOP SRAD2 NOP * OSHIT JSB $LIBX RETURN TO INTERUPT PROCESSING DEF *+1 DEF *+1 LDA SSFLG LONG OR SHORT ID PROCESSING ? JMP NOIDS LONG. LDA ERR26 JMP ABOR SHORT, ABORT THE LOAD ERR26 ASC 1,26 * SKP * * SUBROUTINE: "C#S" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * HFB* (P) JSB C#S * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#S NOP STA ABT4 INA SET STA ABT5 ADDRES INA OF STA ABT6 BOUNDS INA WORDS. STA ABT7 * LDA ABT4,I DETERMINE CMA,INA # OF ADA ABT5,I MAIN WORDS STA ABT1 LDA ABT6,I DETERMINE CMA,INA # OF ADA ABT7,I BASE PAGE WORDS CLB DIV P64 DIVIDE BP BY SZB 64 AND INA ROUND AND SLA SKIP IF EVEN SECTOR COUNT INA ELSE BUMP TO EVEN SECTOR COUNT STA ABT2 SAVE. CLB DIVIDE MAIN # WORDS LDA ABT1 BY 64, DIV P64 ROUND TO WHOLE SECTOR SZB INA SLA IF ODD SECTOR COUNT INA THEN MAKE EVEN. ADA ABT2 ADD TO BASE PAGE COUNT FOR TOTAL JMP C#S,I RETURN. 6H SKP * * * * * * * * SUBROUTINE: "BLKID" * * THIS ROUTINE SCANS THE SYSTEM ID SEGMENTS AND * AND RECORDS THE FOLLOWING : * * BID1 = ADDRESS OF BIG ID WITH LEAST DISC ALLOC. * BID2 = ADDRESS OF BIG ID WITHOUT DISC ALLOCATION * BID3 = ADDRS OF SMALL ID WITH LEAST DISC ALLOC. * BID4 = ADDRS OF SMALL ID WITHOUT DISC ALLOCATION * BID5 = # OF BIG IDS WITH & WITHOUT DISC ALLOC. * BID6 = # OF SMALL IDS WITH & WITHOUT DISC ALLOC. * BID7 = # OF BIG IDS WITHOUT DISC ALLOCATION * BID8 = # OF SMALL IDS WITHOUT DISC ALLOCATION * * (NOTE: ABOVE PARAMETERS ARE ZERO IF NOT SET) * * * CALL: (P) JSB BLKID * (P+1) -RETURN- * (A) = # AVAIL (SMALL+BIG) OR 0 * IF NO BIG AVAILABLE (TOTAL * INCLUDES WITH AND W/O DISC * ALLOCATION). * (B) = MEANINGLESS * BLKID NOP CLA CLEAR STA BID1 ADDR OF BIG WITH LEAST DISC ALLOC STA BID2 ADDR OF BIG WITHOUT DISC ALLOCATION STA BID3 ADDR OF SMALL WITH LEAST DISC ALLOC STA BID4 ADDR OF SMALL WITHOUT DISC ALLOC STA BID5 # OF BIG IDS WITH & WITHOUT DISC ALOC STA BID6 # OF SMALL IDS WITH & W/O DISC ALLOC STA BID7 # OF BIG IDS WITHOUT DISC ALLOCATION STA BID8 # OF SMALL IDS W/O DISC ALLOCATION STA DISPS CLEAR DISC ALLOC FOR SHORT ID STA DISPL AND FOR LONG ID LDA KEYWD INITIALIZE ADDR OF STA KEYPT KEYWORD LIST. RSS SKIP ADDR BUMP FOR FIRST TIME BLK1 ISZ KEYPT BUMP KEYWORD ADDR LDB KEYPT,I GET KEYWORD SZB,RSS IF END OF LIST JMP BLK3 THEN GO TO SET COUNTS. ADB P12 (B)=ADDR OF NAM12 CLA STA FLGSS CLEAR ID TYPE FLAG CPA B,I IF NAM12=0 JMP BLK2 THEN BLANK ID. JMP BLK1 ELSE CONTINUE SCAN * * ANALYZE BLANK ID * BLK2 ADB P2 H (B)=ADDR OF NAM5 JSB MEM? FIND IF ID LONG OR SHORT CCA,RSS SHORT ID, SET (A)=-1. CLA LONG ID, SET (A)=0. STA FLGSS SET ID TYPE FLAG ADB P4 (B)=ADDR OF DMAIN LDA B,I GET DMAN SZA ANY DISC ALLOCATION ? JMP DSCAL YES * LDA FLGSS GET SHORT/LONG ID FLAG SZA,RSS LONG ID ? JMP LGND YES ISZ BID8 BUMP COUNT FOR SHORT ID W/O DSC CLA LDB KEYPT,I GET ID SEG ADDR CPA BID4 ADDR OF 1ST SMALL W/O DSC SET ? STB BID4 NO, SET ADDR OF SMALL ID. JMP BLK1 YES, CONTINUE SCAN. LGND ISZ BID7 COUNT LONG ID W/O DSC ALOC. LDB KEYPT,I GET ID SEG ADDR CPA BID2 ADDR OF 1ST BIG W/O DSC SET ? STB BID2 NO, SET ADDR OF LONG ID. JMP BLK1 YES, CONTINUE SCAN. * * P15 DEC 15 * DSCAL LDA KEYPT,I GET ID SEG ADDR ADA P15 (A)=ADDR OF MEM1 OF SHORT ID LDB FLGSS GET ID TYPE FLAG SZB,RSS LONG ID ? JMP DLGND YES,ADJUST (A) FOR MEM1 OF BIG ID. JSB C#S DETERMINE # OF SECTORS LDB DISPS GET DISC ALLOC COMPARATOR SZB,RSS ANY DISC ALLOC SET UP YET ? JMP SHNEW NO, THEN SET THIS ONE. STA B SAVE SEC COUNT TEMPORARILY CMA,INA SUBTRACT THIS SPACE FROM PREVIOUS ADA DISPS SSA IS THIS DISC SPACE < PREVIOUS ? JMP SHCNT NO, LET PREVIOUS BE THERE. LDA B RESTORE SECTOR COUNT SHNEW STA DISPS SET DISC SPACE ALLOCATION LDB KEYPT,I SET ADDR OF SMALL ID WITH STB BID3 LEAST DISC ALLOCATION. SHCNT ISZ BID6 COUNT SHORT IDS WITH DISC ALLOC JMP BLK1 CONTINUE SCAN * DLGND ADA P7 (A)=MEM1 ADDR OF LONG ID JSB C#S DETERMINE NUMBER OF SECTORS LDB DISPL GET DISC ALLOC COMPARATOR SZB,RSS ANY ALLOC SET UP YET ? JMP LGNEW NO, THEN SET THIS ONE IN. STA B SAVE SECTOR COUNT TEMPORARILY CMA,INA SUBTRACT THIS ALLOC ADA DISPL FROM PREVIOUS. SSA IS THIS ALLOC LESS ? JMP LGCNT NO LDA B RESTORE SECTOR COUNT LGNEW STA DISPL SET ALLOCATION LDB KEYPT,I SET ADDR OF LONG ID STB BID1 WITH LEAST ALLOCATION. LGCNT ISZ BID5 COUNT LONG IDS WITH JMP BLK1 DISC ALLOCATION & CONTINUE SCAN. * BLK3 LDA BID8 SET BID8= # OF SMALL IDS ADA BID6 WITH AND WITHOUT STA BID6 DISC ALLOCATION. LDA BID7 SET BID5= # OF LONG IDS ADA BID5 WITH AND WITHOUT STA BID5 DISC ALLOCATION. SZA,RSS ANY BIG IDS AVAILABLE ? JMP BLKID,I NO, RETURN WITH (A)=0. ADA BID6 YES, RETURN WITH (A) = TOTAL JMP BLKID,I NUMBER OF IDS. * * * CONSTANTS * BID1 NOP BID2 NOP BID3 NOP BID4 NOP BID5 NOP BID6 NOP BID7 NOP BID8 NOP FLGSS NOP =0 FOR LONG ID, NON-ZERO FOR SHORT DISPL NOP LONG ID SECTOR COUNT DISPS NOP SHORT ID SECTOR COUNT KEYPT NOP KEYWORD * SKP * * SKP * * SUBROUTINE: "ITRAK" -INTIIALIZE TRACK ALLOCATION * * CALL: "#TRAK" CONTAINS # OF TRACKS * TO BE ALLOCATED * * A AND B MEANINGLESS * (P) JSB ITRAK * (P+1) -RETURN- A AND B MEANINGLESS * * THE FOLLOWING WORDS OF STORAGE ARE SET * AND ALL TRACKS HAVE BEEN SET TO ZERO: * * #TRAK - # OF TRACKS ALLOCATED * TRAKB - STARTING TRACK # (BASE TRACK) * TRKLU - LOGICAL UNIT OF DISC * TRKS# - # OF SECTORS PER TRACK * * IF THE TRACK ALLOCATION CANNOT BE MADE, THE * LOADER PRINTS THE MESSAGE * "/LOADR: WAITING FOR DISC SPACE" * AND REPEATS THE REQUEST WITH THE SUSPENSION * OPTION. THE LOADR CONTINUES WHEN TRACKS BECp OME * AVAILABLE. THE LOADR MAY BE ABNORMALLY * TERMINATED BY THE OPERATOR IN THIS STATE. * * ITRAK NOP ITRK9 LDA #TRAK SET SIGN BIT OF #TRAK WORD IOR MSIGN FOR NO SUSPENSION IF TRACKS STA #TRAK NOT AVAILABLE. * ITRK1 JSB EXEC REQUEST DEF *+6 DISC DEF P4 SPACE DEF #TRAK DEF TRAKB DEF TRKLU DEF TRKS# * LDA #TRAK REMOVE RAL,CLE,ERA SIGN BIT FROM STA #TRAK # TRACKS WORD. CCA IF STARTING TRACK # = -1, CPA TRAKB THEN NO TRACKS AVAILABLE, JMP ITRK3 PRINT MESSAGE(WILL RETRY FOR 1ST ALLOC) * * LDA TRKLU DSKUN = DISC'S STA DSKUN LU # LDA TRAKB ITRKB = STARTING TRACK # ADA #TRAK ITRK6 = ENDING TRACK STA ITRK6 # +1. * ISZ TKTRY NO MORE RETRYS ALLOWED JMP ITRAK,I RETURN * * PRINT WAITING MESSAGE * ITRK3 LDA TKTRY GET THE RETRY FLAG SZA,RSS CAN WE RETRY ? JMP ITRK4 YES * * ITRK8 LDA P22 GET THE BUFFER LENGTH LDB ITRKM JSB SYOUT JMP ITRK1 * * ITRK4 LDA #TRAK GET THE # WE ASKED FOR LAST TIME ADA N2 SUBTRACT 2 SZA,RSS DID WE ASK FOR 2 LAST TIME ? JMP ITRK5 YES ,SO FORGET IT CCA NO SO SUBTRACT ONE AND TRY AGAIN ADA #TRAK STA #TRAK JMP ITRK9 DO IT AGAIN * ITRK5 ISZ #TRAK BUMP REQUEST BACK TO 4 ISZ #TRAK JMP ITRK8 AND SUSPEND THYSELF * ITRKM DEF *+1 ASC 11,WAITING FOR DISC SPACE * ITRK6 NOP * * #TRAK DEC 4 # OF TRACKS ALLOCATED TRAKB NOP STARTING TRACK # (BASE TRACK) TRKLU NOP LOGICAL UNIT OF DISC TRKS# NOP # OF SECTORS PER TRACK SPOS NOP RELATIVE SECTOR POSITION TSECT NOP TEMPORARY SECTOR AND TTRAK NOP TRACK #. TKTRY NOP RETRY.e FLAG FOR TRACKS SKP * * 'EDIT' COMPLETION * ED00 LDA MSEG GET MAIN/SEG FLAG SZA PROCESSING MAIN/SEG ? JMP ED18 YES * * SINGLE PROGRAM OPERATION * CLA,INA CHECK CPA EDFLG TYPE JMP ED10 ADDITION * * PROGRAM REPLACEMENT * E0D JSB MIDN FIND MATCHING ID SEGMENT JMP ED10 -NO, TREAT AS ADDITION. * ED0 STB ED25 SAVE MATCH ID ADDR. ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB A CALCULATE JSB C#S # SECTORS STA ED60 AND SAVE * ED001 LDB TAT SET SIGN BIT LDA B,I ON SYS DISC TO TEST JSB SYRUW WRITE PROTECT BEFORE DAMAGE IS DONE * LDB ED25 ADB P12 SET ADDR OF NAM12 STB LH1 OF ID SEG. JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM ADB P2 (B)=NAM5 ADDR OF MATCHED ID LDA B,I GET NAM5 AND AND P7 MASK IN PROG TYPE. CPA P5 IS THIS A SEGMENT ? JMP ED004 YES, FORGET DORMANY CHECK. ADB N6 (B)=ADDR OF SUSPEND WORD LDA B,I POINT OF SUSPENSION? SZA ZERO - CONTINUE JMP ED003 SUSPEND ADB P7 GET LDA B,I STATUS: SZA DORMANT? JMP ED003 NO - SUSPEND ADB P2 GET LDA B,I TIME LIST: AND BIT12 IN LIST? SZA WELL ? JMP ED003 NO. YOU LOSE. ADB P4 NOW SEE IF THE PROGRAM LDA B,I TERMINATED SERIALLY AND M77 MPY P6 BECAUSE IF HE DID HE STILL ADA $MATA ADA P2 OWNS THE PARTITION LDA A,I AND THE OP SYSTEM WILL GET REALLY CPA ED25 PISSED OFF IF WE REPLACE HIM. RSS JMP ED004 ALLS WELL... LETS DO IT ! * SKP ED003 JSB $LIBX  RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM LDA P18 PRINT MESSAGE LDB MES70 JSB SYOUT PROG IS NON-DORMANT JMP ABORT AND ABORT THYSELFZERO * MES70 DEF *+1 ASC 9,SET PRGM INACTIVE BIT12 OCT 10000 LH1 NOP * ED004 CLB STB LH1,I ZERO ISZ LH1 NAME STB LH1,I IN ISZ LH1 CORE LDA LH1,I ID AND M20 SEGMENT (LEAVE 'SS' BIT) STA LH1,I JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM * * RELEASE "OLD" TRACKS * LDB ED25 GET MATCHED ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN LDA B,I GET DISC WORD AND SAVE STA ED63 TEMPORARILY. SSA TRACKS ON LU3 ? JMP CLEAR YES, THEN RELEASE TRKS. CMA,INA SUBTRACK FROM DISC LIB ADDR ADA DSCLB AND IF SSA,RSS IN SYSTEM AREA JMP ED01 THEN DON'T RELEASE TRKS CLEAR CLA CLEAR JSB SYSET DISC WORD. JSB SYRUW DISC TOO LDB ED63 RESTORE DISC WORD TO B. LDA ED60 JSB DREL GO RELEASE TRACKS UNLESS GLOBAL * SKP ED01 LDB ED25 GET ID SEGMENT ADDR TO B JSB TATCL GO CLEAR ANY TRACKS ASSIGNED TO PGM LDB ED25 CLEAR ADB P12 NAME STB ED63 WORDS (3) LDB N3 STB ED60 ED02 CLA CCB CPB ED60 IF CLEARING NAM5 LDA LH1,I THEN GET SAME VALUE AS IN CORE LDB ED63 JSB SYRUW ISZ ED63 ISZ ED60 JMP ED02 LDA OPCOD CPA P4 IF PURGE OPERATION JMP EXIT THEN DONE SO GO TERMINATE JMP PADD GO TO TREAT AS ADDITION * * * PROGRAM ADDITION * ED10 CLA CLEAR MATCHED STA ED25 ID SEG ADDR STORAGE. RSS SKIP MESSAGE OUTPUT FOR NOW ED03 JMP NOIDS GO TELL THER ARE NO ID SEGMENTS PADD JSB BLKID DETERMINE # BLANK ID'S. LDB ID## CMB,INB CPB ID# IF LOOKING FOR MAIN'S ID JMP BIGID THEN SKIP SETTING UP FOR SMALL LDA BID6 (A)=TOTAL # OF SMALL IDS LDB BID8 (B)=# OF SMALL IDS WITHOUT DISC ALOC SZA SETTLE FOR LONG IF SMALL UNAVAILABLE JMP *+3 SKIP SETTING FOR LONG IDS BIGID LDA BID5 (A)=TOTAL # OF LONG IDS LDB BID7 (B)=# OF LONG IDS WITHOUT DISC ALLOC SZA,RSS IF NONE, JMP ED03 PRINT MESSAGE CPA B IF NONE WITH DISC ALLOC, JMP NTRM7 GO TO USE FIRST BLANK. * LDA IDA GET ID SEGMENT ADDR ADA P4 (A)=MEM1 ADDR OF SHORT ID LDB ID## CMB,INB CPB ID# IF PROCESSING MAIN ADA P4 THEN (A)=MEM1 ADDR OF LONG ID JSB C#S CALCULATE # OF SECS REQUIRED STA ED20 SAVE # OF SECTORS CMA,INA SAVE STA ED21 NEGATIVE # OF SECTORS LDA KEYWD SAVE STARTING KEYWORD STA ED22 LIST ADDR. CLA CLEAR STA ED23 ACCUMULATOR * ED11 LDB ED22,I GET NEXT ID SEGMENT ADDR. SZB,RSS JMP ED14 -END OF LIST * ADB P12 CHECK NAME(1) CLA IF CPA B,I = JMP ED17 0, CHECK FURTHER. ED12 ISZ ED22 CHECK JMP ED11 NEXT SEGMENT. * ED17 ADB P2 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 CLA (REG-A NOT 0 FOR SHORT ID RETURN) ADB P4 (B)=ADDR OF DMAIN CPA B,I IF NO DISC ALLOC TO THIS SEG JMP ED12 THEN CONTINUE SCAN. * LDA B ADA N4 (A)=MEM1 ADDR JSB C#S GET SECTOR COUNT STA B SAVE ADA ED21 SUBTRACT DUMMY FROM THIS SSA  # OF SECTORS. JMP ED12 IF DUMMY >, CONTINUE SCAN. * LDA ED23 GET PREVIOUS MIN # SECTORS SZA,RSS IF 0, JMP ED13 GO TO USE THIS ALLOCATION. CMA,INA SUBTRACT ADA B PREVIOUS FROM NEW, SSA,RSS USE NEW # IF < OLD. JMP ED12 NO, KEEP CHECKING ED13 STB ED23 SET ALLOCATION #. LDA ED22,I ALSO, SET STA ED24 ID SEGMENT ADDR. JMP ED12 GO TO CHECK NEXT. * * * MODIFY WORD IN ID IN SYSTEM AREA * MODID NOP JSB SYSET STORE IN CORE JSB SYRUW STORE ON DISC JMP MODID,I RETURN * * ED14 LDA ED23 IF SPACE NOT FOUND IN SYSTEM SZA,RSS AREA, GO TO USE A BLANK ID SEG JMP NTRM7 AND KEEP PROG ON USER TRACKS * SKP * * * MOVE PROGRAM INTO SYSTEM AREA * LDB IDA GET DUMMY ID ADDR ADB P8 (B)=DMAN ADDR OF SHORT ID LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN ADB P4 THEN (B)=DMAN ADDR OF LONG ID LDA B,I GET RELATIVE STARTING ALF,ALF TRACK # RAL AND AND M377 ADD ADA TRAKB BASE TRACK. STA TRAKP SET ABSOLUTE TRACK ADDR LDA B,I GET DMAN AGAIN AND M177 MASK IN SEC ADDR STA ED62 SET SECTOR ADDR * LDB ED24 GET DESTINATION ID ADDR ADB P14 (B)=ADDR OF NAM5 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN LDA B,I GET DESTINATION AREA ON SYS DSC ALF,ALF SET STARTING RAL TRACK AND M377 NUMBER. STA ED66 LDA B,I AND M177 SET STARTING STA ED67 SECTOR NUMBER. LDA P2 SET STA DESLU DESTINATION LU. LDA ED23 GET NUMBER OF ADA ED21 SECTORS LEFT OVER. `'SZA,RSS IF NO SECTORS LEFT JMP MPRG THEN ONLY MOVE THE PROG. SKP * * ALLOCATE LEFTOVER SPACE TO A BLANK * ID SEGMENT WITHOUT DISC ALLOCATION. * MPY P64 FIND # OF WORDS LEFT OVER STA ED23 AND SAVE FOR LATER. JSB BLKID FIND BLANK ID ALLOCATION LDB BID7 (B)=# OF IDS W/O DISC ALLOC SZB ANY BIG ID W/O DISC AVAIL ? JMP LFND YES, SET IT UP FOR ALLOC. LDB BID8 (B)=# OF SMALL IDS W/O DSC ALOC SZB,RSS ANY SMALL ONES AVAILABLE ? JMP MPRG NO, THEN GO TO MOVE PROG. LDB BID4 (B)=ADDR OF SHORT ID W/O DSC ALOC ADB P15 (B)=MEM1 ADDR OF SHORT ID JMP SBND SKIP OVER LONG ID'S SET UP LFND LDB BID2 (B)=ADDR OF LONG ID W/O DISC ALOC ADB P22 (B)=MEM1 ADDR OF LONG ID SBND STB BID2 SET ADDR OF MEM1 CLA JSB MODID SET LOW MAIN = 0 ISZ BID2 SET ADDR OF MEM2 LDA ED23 GET NUMBER OF WORDS LEFT OVER LDB BID2 GET ADDR OF MEM3 JSB MODID SET HIGH MAIN=WORDS LEFT OVER ISZ BID2 SET ADDR OF MEM3 LDB BID2 SET LOW BASE =0 CLA JSB MODID ISZ BID2 SET ADDR OF MEM4 LDB BID2 GET MEM4 ADDR CLA JSB MODID SET HIGH BASE =0 ISZ BID2 SET ADDR OF DMAN LDA ED67 GET STARTING SECTOR ADDR ADA ED20 MOVE UP TO END OF USED AREA CLB GET DISC ADDR OF AREA LEFT DIV SECT2 FIND # OF TRKS ADA ED66 GET ACTUAL DISC ADDR ALF,RAL POSITION TRACK RAL,RAL ADDR. IOR B MERGE IN SECTOR ADDR LDB BID2 GET DMAN ADDR JSB MODID SET DISC ADDR IN DMAN * SKP * MPRG JSB ED15 MOVE PROG TO SYSTEM AREA JMP ED16 SET UP IDS * ED15 NOP BGN JSB EXEC READ 1 SECTOR FROM DEF *+7 SOURCE ARwnEA DEF P1 DEF DSKUN DEF LBUF DEF P64 DEF TRAKP DEF ED62 * JSB EXEC WRITE SAME SECTOR DEF *+7 INTO DESTINATION DEF P2 DEF DESLU DEF LBUF DEF P64 DEF ED66 DEF ED67 * ISZ ED21 INDEX SECTOR MOVE COUNT RSS -NOT FINISHED. JMP ED15,I -FINISHED. * LDA ED62 INDEX INA SOURCE SECTOR #. CPA TRKS# IF = # SECTORS/TRACK, CLA SET = 0, STA ED62 RESTORE. SZA,RSS IF = 0 ISZ TRAKP ADD 1 TO TRACK #. * LDA ED67 INDEX INA DESTINATION SECTOR #. CPA SECT2 IF = # SECTORS/TRACK, CLA SET = 0, STA ED67 RESTORE. SZA,RSS IF = 0, ISZ ED66 ADD 1 TO TRACK #. JMP BGN SKP * * COMPLETE ID SEGMENT PROCESSING * ED16 LDB ED24 GET OLD ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN LDA B,I GET DISC ADDR STA ED63 SAVE TEMPORARILY LDB IDA STORE IT ADB P8 IN LDA ID## DMAN CMA,INA OF CPA ID# NEW ADB P4 ID LDA ED63 SEGMENT STA B,I * LDB ED24 IF SAME ID-SEGMENT CPB ED25 THEN RSS SKIP JSB SWPID ELSE SWAP THE ID-SEGMENTS ON THE DISC JSB FIX24 IDS NOT SWAPPED - CLEAN ED24'S. CLA,INA (A) = 1 FOR ADDITION JSB MVIDS JSB FIX FIX FOR TRYING LONG TO SHORT MOVE LDA MSEG PROCESSING MAIN/SEG ? SZA,RSS THEN SKIP. JMP NTRM4 ELSE TERMINATE * * MAIN/SEGMENT REPLACEMENT OR ADDITION * ED183 LDA IDA SET ADDR OF ADA N9 NEXT SHORT DUMMY STA IDA ID SEGMENT. ISZ ID## END OF SEGMENTS ? CLB,RSS NO, THEN SKIP JMP NTRM4 TERMINATE, ALL MAIN/SEGS DONE. CPB EDFLG EDIT OPERATION ? JMP NTRM7 NO, GO BACK TO TEMP LOAD. JMP ED181 YES, SET UP FOR NEXT SEG. * ED18 LDA IDA INA * ED181 CLB,INB CPB EDFLG ADDITION ? JMP ED10 YES, ATTEMPT TO USE SYSTEM AREA. INA IT IS REPLACEMENT SO STA NAM12 SET UP INA ADDRES STA NAM34 OF NAM12, NAM34 INA AND NAM5. STA NAM5 JMP E0D GO LOOK FOR MATCHING ID SEG. SKP * SAVE MEM BOUNDS AND DISC ADDR OF MATCHED ID INTO * ID SEG WHOSE DISC SPACE WE USED. * SWPID NOP ROUTINE TO SWAP SYS ID-SEG TACKS LDA IDA SAVE THE DUMMY ID ADDR STA DREL IN DREL ENTRY LDA ED25 GET THE ID-SEGMENT TO MOVE SZA,RSS IF NO OLD ID-SEGMENT JUST JMP SWPID,I RETURN, ELSE STA IDA SET IT IN IDA FOR MVIDS AND STA MIDN SAVE FOR LATER CLA,INA SET EDIT FLAG JSB MVIDS AND CALL MVIDS TO SET UP NOP IGNOR ERROR RETURN LDB DREL RESTORE STB IDA THE DUMMY ID-ADDR LDB MIDN AND THE MOVED (AND NOW FREE) STB ED25 ID-SEGMENT ADDR ISZ SWPID BUMP RETURN ADDR FOR SWAP DONE JMP SWPID,I RETURN * * * THIS ROUTINE IS EXECUTED WHEN "MVIDS" DOES AN ERROR * RETURN FOR ATTEMPTING TO MOVE A LONG ID INTO A SHORT * ONE. "FIX" ROUTINE BLANKS OUT MEM BOUNDS AND DMAIN * OF THE SHORT ID AND THEN GOES TO "MVIDS" WITHOUT * SPECIFYING A TARGET ID. "MVIDS" SHOULD NEVER RUN * INTO THE PROBLEM OF RUNNING OUT OF LONG ID SEGS. * FIX NOP LDA N5 SET UP TO BLANK OUT STA SWPID MEM1 TO DMAIN OF SHORT ID. LDA ABT11 SET UP ADDR OF MEM1 OF ADA P11 SHORT ID SEGMENT. STA DREL WIPE CLA WRITE 0 IN MEM1 TO DMAIN LDB DREL #HFBJSB MODID ISZ DREL ISZ SWPID DONE ? JMP WIPE NO CLB CLA,INA CPB EDFLG SKIP IF EDITING CLA JSB MVIDS SET UP ID IN SYSTEM JMP NOIDS ** SHOULD NEVER HAPPEN ** JMP FIX,I RETURN * SKP * * DISC TRACK RELEASE ROUTINE * DREL NOP STA ED63 LDA TAT STARTING SSB BASE ADA TATSD ADDR STA ED64 FOR DISC UNIT. LDA SECT2 SET APPROPRIATE SSB # SECTORS/TRACK LDA SECT3 FOR STA ED62 DISC LDA B GET AND M177 MASK THE TRACK SWP SWAP ALF,ALF STARTING RAL TRACK AND M377 #. ADA ED64 ADD TO STA ED64 BASE ADDR. LDA B SET STARTING SECTOR CMA,INA,SZA,RSS IF ZERO JMP DREL1 JUMP ISZ ED64 ELSE DO NOT RELEASE FIRST TRACK ADA ED62 COMPUTE NUMBER LEFT ON TRACK CMA,INA AND DREL1 ADA ED63 SUBTRAC FROM NUMBER TO RELEASE SSA IF NEGATIVE JMP DREL,I RETURN NO TRACKS START WITH THIS ID SEGMENT CLB TOTAL # OF DIV ED62 SECTORS BY # SECTORS/TRACK. SZB ROUND INA TO # OF TRACKS INVOLVED, CMA,INA,SZA,RSS SET NEG. IF ZERO JMP DREL,I EXIT DONE STA ED62 FOR INDEX. * DR LDB ED64 CLEAR LDA B,I DO NOT SSA,RSS RELEASE JMP DR2 GLOBAL TRACKS LDA XEQT ASSIGN TRACK TO SELF JSB SYSET IN TRACK CLA JSB SYRUW DR2 ISZ ED64 TABLE. ISZ ED62 JMP DR JMP DREL,I cH SKP * * CLEAR ENTRY IN TAT * TATCL NOP SUBROUTINE TO RELEASE ALL TRACKS STB DREL CURRENTLY ASSIGNED TO PROG ID ADDR IN B LDB TATLG SET TAT LENGTH STB FIX24 FOR COUNT LDB TAT SET INITIAL ADDR NXTRK LDA DREL GET ID SEGMENT ADDR TO A CPA B,I THIS TRACK BELONG?? RSS YES SKIP JMP NXTR1 NO STEP TO NEXT ONE LDA XEQT ASSIGN JSB SYSET TRACK TO SELF NXTR1 INB STEP TRACK ADDR ISZ FIX24 DONE?? JMP NXTRK NO TRY NEXT TRACK JMP TATCL,I YES REETURN * * ROUTINE TO CLEAN OUT THE ID SEG (MEM1 TO DMAIN) * WHOSE DISC SPACE WE UTILIZED BUT 'SWAPID' * DID NOT SAVE ANYTHING IN IT. USEFUL IF THIS * ID HAPPENS TO BE A LONG ONE BUT THE DUMMY IS SHORT. * ALSO EXECUTED WHEN ED24 AND ED25 HAVE SAME ID ADDR. * FIX24 NOP LDB ED24 ADB P14 (B)= NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB DREL SET UP MEM1 ADDR LDB N5 SET COUNT TO BLANK STB SWPID TO BLANK OUT MEM1-DMAIN. WIPE1 CLA (A)=0 LDB DREL (B)=ADDR OF WORD IN ID SEG JSB MODID MODIFY THE ID SEG ISZ DREL BUMP ADDR ISZ SWPID DONE ? JMP WIPE1 NO LDB ED25 (B)=0 FOR NO PARTICULAR ID JMP FIX24,I RETURN * SKP * * TRAKP NOP ID## NOP ED20 NOP ED21 NOP ED22 NOP ED23 NOP ED24 NOP ED25 NOP ED60 NOP ED61 NOP ED62 NOP ED63 NOP ED64 NOP ED66 NOP ED67 NOP * PTYPE DEC 3 PROGRAM DEFAULT = 3 = PRIVLEGED EDFLG NOP EDIT FLAG: 1 = ADDITION, 2 = REPLACEMENT, 0 = TEMP #PTTN NOP SPECIFIED PARTITION # #PGS NOP SPECIFIED # OF PAGES IN PROGRAM (INCLUDES BP) #MPFT NOP INDEX TO MEMORY PROTECT FENCE TABLE MSEG NOP 0/1 NOT SEGMENTED SEGMENTED FLAG OPCOD NOP 1ST WORD OF OPCODE FIELD LISTU OC,T 206 LIST OUTPUT UNIT # DFLAG NOP 0/1 NON INTERACTIVE / INTERACTIVE LU # FILE1 BSS 3 NAME OF INPUT FILE TYPE1 NOP PARSED TYPE WORD FOR FILE OR LU # F1SC NOP AND SECURITY CODE F1DSC NOP AND DISC LU OR CARTRIDGE # F2 DEF FILE2 FILE2 BSS 3 NAME OF COMMAND FILE TYPE2 NOP TYPE WORD FOR COMMAND FILE OR LU F2SC NOP AND ITS SECURITY CODE F2DSC NOP AND ITS LU OR CART REF CWABP NOP CURRENT BASE PAGE ADDR LST1 NOP LST WORD 1 ADDR LST2 NOP LST WORD 2 ADDR LST3 NOP LST WORD 3 ADDR LST4 NOP LST WORD 4 ADDR LST5 NOP LST WORD 5 ADDR PRIOR NOP ADDR OF PRIORITY IN ID SEG PRENT NOP ADDR OF PRIMARY ENTRY POINT NAM12 NOP ADDR OF NAME 1,2 NAM34 NOP ADDR OF NAME 3,4 NAM5 NOP ADDR OF NAME 5, TYPE RESL NOP ADDR OF 10'S MILLS. IN ID SEG NUPLS NOP NO. UTILITY PROGS LOADED TPREL NOP CURRENT MAX PROG RELOC ADDR DBLAD NOP DATA BLOCK RELOCATION ADDR OPRND NOP ABSOLUTE MEMORY ADDR WDCNT NOP TEMPORARY COUNTER DSKUN NOP CURRENT DISK LOGICAL UNIT NO. DTRAK NOP CURRENT DBUF TRACK DSECT NOP CURRENT DBUF SECTOR CURAL NOP CURRENT LBUF ADDR TBUF BSS 5 TEMPORARY BUFFER MSEGF NOP MAIN/SEGMENT FINAL LOAD FLAG LWA NOP LOADING AREA, BPFWA NOP FWA OF ACTUAL BP LINK AREA FWABP NOP FWA AND LWA OF DUMMY LWABP NOP BASE PAGE AREA. SEGB NOP SEGMENT BASE PAGE LOWER BOUND DBLFL NOP FIRST DBL REC: -1,YES; 0,NO. FORCD NOP FORCE FLAG 0/-1 NO FORCE /FORCE LOAD N1 DEC -1 N6 DEC -6 N9 DEC -9 N60 DEC -60 N4 DEC -4 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P14 DEC 14 P18 DEC 18 P20 DEC 20 M7 EQU P7 M20 OCT 20 M77 OCT 77 M177 OCT 177 M300 OCT 300 M377 OCT 377 M2000 OCT 2000 M0760 OCT 76000 M7400 OCT 177400 NDAY OCT 177574,025000 ENTRL DEF *+3 RELOCATION BASE TABLE RBTAD DEF *+1 RELOCATION BASE TABLE NOP PPREL NOP CURRENT PROG BASE BPREL NOP BASE PAGE BASE COMAD NOP COMMON BASE NOP ABSOLUTE BASE BLOK# NOP UCHRG OCT 43400 MSIGN OCT 100000 CHRDE ASC 1,DE CHRBU ASC 1,BU AMEM3 DEF MBUF+3 AMEM6 DEF MBUF+6 BLST NOP BEGINNING OF LOADER SYMBOL TABLE PLST NOP END OF LST TLST NOP CURRENT LST ADDR. SLST NOP INITIALIZE FOR SEGMENT AREA. FLST NOP FWA OF LST SET FOR USER'S PROG OEFL1 NOP ODD/EVEN SECTOR FLAG LBOEF NOP LIB ODD/EVEN SECOR FLAG #IDAD NOP ADDR OF LONG ID SEGMENT * SPC 1 #MNPG NOP LOWEST PAGE NO. USED BY PROG #MXPG NOP HIGHEST PAGE NO. USED BY PROG #MXRT DEC -1 #PAGES IN LARGEST RT PTTN #MXBG DEC -1 #PAGES IN LARGEST BG PTTN ER.16 LDA ERR16 ILLEGAL PTTN # JMP ABOR ERR16 ASC 1,16 ******* END MEU CODE ********** SPC 1 SKP * BASE PAGE COMMUNICATION VALUES * A EQU 0 B EQU 1 * . EQU 1650B ESTABLISH ORIGIN OF AREA * INTLG EQU .+5 NUMBER OF INTERRUPT TBL ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK XEQT EQU .+39 ID SEGMENT ADDR OF LOADR IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR BPA2 EQU .+59 LWA RT DISC RES. BP LINK AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTLWA EQU .+65 LWA OF RT DISC RESIDENT AREA BKORG EQU .+66 FWA OF BG AREA BKCOM EQU .+67 LENGTH OF BG COMMON AREA TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTwORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS DSCUN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDR BKLWA EQU .+87 LWA OF MEMORY IN BG SPC 1 IFN ******* BEGIN NON-MEU CODE **** BPA1 EQU .+58 FWABP RT DISC RES BPA3 EQU .+60 FWABP BG DISC RES BKGBL OCT 1646 LWABP BG DISC RES URFWA EQU .+64 FWA OF USER RT DISC RES AREA URLWA NOP LWA OF USER RT DISC RES AREA UBFWA EQU .+68 FWA OF USER BG DISC RES AREA UBLWA EQU BKLWA LWA OF USER BG DISC RES AREA ******* END NON-MEU CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN MEU CODE ******** BPA1 EQU P2 FWABP USER RT DISC RES BPA3 EQU BPA1 FWABP USER BG DISC RES BKGBL EQU BPA2 LWABP USER BG DISC RES URFWA NOP FWA USE RT DISC RES AREA URLWA OCT 77777 LWA USER RT DISC RES AREA UBFWA EQU URFWA FWA USER BG DISC RES AREA UBLWA EQU URLWA LWA USER BG DISC RES AREA ******* END MEU CODE ********** * BSS 0 SIZE OF LOADR SPC 3 END LOADR x  91740-18020 2026 S C0122 &DVA65              H0101 o^ASMB,Q,N,C IFZ HED DVA65 24999-16205 REV.2026 * (C) HEWLETT-PACKARD CO. 1980 NAM DVA65 24999-16205 REV.2026 800527 W/ TRACE # XIF IFN HED DVA65 91740-16071 REV.2026 * (C) HEWLETT-PACKARD CO. 1980 NAM DVA65 91740-16071 REV.2026 800527 XIF SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 *************************************************************** * *DVA65 COMMUNICATIONS DRIVER FOR DS/1000 * ALL LINE INTERRUPTS HANDLED BY MICROCODE * EXCEPT PROTOCOL FOR LINES ABOVE PRIVILEGED SLOT * *SOURCE PART # 91740-18071 * *REL PART # 91740-16020 * *WRITTEN BY: L. SCHOOF, L. POMATTO, R. SHATZER, C. WHELAN * *DATE WRITTEN: DEC 1976 *MODIFIED BY: LYLE WEIMAN, AUG. '78, TO ADD TRACE CAPABILITY * (# IN RIGHT-HAND COLUMN MARKS CHANGES) *MODIFIED BY: CRAIG HAMILTON 01/27/80 TO IMPROVE ERROR RECOVERY. * * USE "Z" OPTION TO INCLUDE "TRACE" OPERATION # * USE "N" OPTION TO EXCLUDE "TRACE" OPERATION # * *************************************************************** SPC 3 * * DEFINE ENTRY POINTS * ENT IA65,CA65 ENT MIC$X SPC 1 * * DEFINE EXTERNALS * EXT $LIST,$OPSY IFZ EXT $TIME,$CGRN # XIF SKP * * CALLING SEQUENCES * SPC 2 * TRANSMIT OR RECEIVE REQUEST AND DATA SPC 1 * JSB EXEC * DEF *+7 * DEF RCODE OCT 1 * DEF CONWD LU (BIT 6= 1 IF WRITE, BIT 7= 1 I}F PROGL) * DEF DBUF DATA BUFFER ADDRESS * DEF DBUFL DATA BUFFER LENGTH * DEF RBUF REQUEST BUFFER ADDRESS * DEF RBUFL REQUEST BUFFER LENGTH * SPC 2 * ENABLE LISTEN MODE SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 100B+LU * SPC 2 * SEND STOP SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 0 + LU * SPC 2 * CLEAR REQUEST SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 200B + LU * SPC 2 * SKP * *##################################################################### * * SET UP TRACE BUFFER AND ENABLE TRACE MODE REQUEST # * # * JSB EXEC # * DEF *+5 # * DEF RCODE OCT 20 (CLASS WRITE-READ) # * DEF CONWD OCT 700B + LU # * DEF BUFR TRACE BUFFER # * DEF TRBFL TRACE BUFFER LENGTH-- MUST BE 4N + 3 # * WHERE N = # ENTRIES DESIRED IN TABLE. # * DEF RN# RN# = SYNCHRONIZING RESOURCE NUMBER # * (MUST BE ALLOCATED GLOBALLY AND LOCKED PRIOR TO # * CALL). THIS RN IS CLEARED EACH TIME DRIVER FILLS# * BUFFER, THUS PROVIDING SYNCHRONIZATION WITH TRACE# * PRINTOUT PROGRAM. # * DEF OPTN TRACE SELECTION OPTION # * DEF CLASS CLASS NUMBER (SET TO ZERO BEFORE CALL). # * # * THEREAFTER, WHENEVER A COPY OF THE CURRENT CONTENTS OF THE # * TRACE TABLE AR'E DESIRED, THEY MAY BE OBTAINED WITH A CLASS I/O # * "GET" CALL, USING THE CLASS NUMBER RETURNED FROM THE PREVIOUS # * SET-UP CALL. BE SURE TO SET THE "DO NOT DE-ALLOCATE BUFFER" # * BIT, OR DISASTROUS THINGS WILL HAPPEN!!!!!!!!!!! # * # * TRACE SELECTION SPECIFIER: # * 0 = TRACE ALL DVA65 ACTIVITY # * #0 = TRACE ONLY ACTIVITY FOR LU USED IN SET-UP CALL. # * # * "TRACE" BUFFER FORMAT: # * # * WORD 1 -- CONTAINS PASS NUMBER (INCREMENTED EACH TIME THE # * TRACE BUFFER IS RESET). USEFUL IN DETERMINING IF # * TRACE DATA HAS BEEN MISSED. # * WORD 2 -- CONTAINS ADDRESS OF NEXT ENTRY TO BE MADE IN TABLE # * ("OLDEST" ENTRY IN TABLE). # * WORD 3 -- BEGINS TRACE ENTRIES, FOUR WORDS PER ENTRY. # * ENTRY WORD 1 -- DATA WORD AS READ OR WRITTEN # * 2 -- R/X(BIT 15), STATE/EVENT, TIME-OUT INDICATION # * (BIT 0). BIT 15 IS SET IF WORD WAS RECEIVED, # * ELSE 0. BIT 0 IS SET IF A TIME-OUT OCCURRED,# * ELSE 0. # * DATA WORD NOT VALID IF TIME-OUT OCCURRED. # * 3 -- EQT ADDRESS # * 4 -- TIME-OF-DAY (LOW 16 BITS OF SYSTEM TIME WORD) # * # * # SPC 1 * ENABLE TRACE MODE REQUEST # * NOTE: YOU MUST HAVE MADE A SET-UP CALL PREVIOUSLY)# * # * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 1700B+ANY COMMUNICATION LU LINKED TO DVA65 # * # * DISABLE TRACE MODE REQUEST # * # * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 700B+ANY COMMUNICATION LU LINKED TO DVA65 # * # *##################################################################### SKP * * ERROR CODES (IN EQT 5 STATUS) * * BIT MEANING * 0 REQUEST COMPLETED...NO ERRORS * 1 REQUEST PENDING ON A WRITE, OR NOT PENDING ON A READ * 2 SIMULTANEOUS REQUEST REJECT * 3 TIME OUT * 4 STOP RECEIVED * 5 REMOTE BUSY * 6 PARITY ERROR OR PROTOCOL FAILURE * 7 WRITE FLAG (FOR "GRPM" AT CCE) * * * EQT WORD USAGE BREAKDOWN * * EQT # USE * 1 DEFINED * 2 DEFINED * 3 DEFINED * 4 DEFINED * 5 DEFINED * 6 DEFINED * 7 ADDRESS OF DATA BUFFER * 8 LENGTH OF DATA BUFFER * 9 ADDRESS OF REQUEST BUFFER * 10 LENGTH OF REQUEST BUFFER * 11 COROUTINE ADDRESS * 12 CURRENT STATUS TABLE (SEE BREAKDOWN) * 13 ADDRESS OF EQT EXTENSION * 14 DEFINED...USED FOR SINGLE WORD TURN- AROUND TIMEOUT * 15 DEFINED...MICROCODE ALSO SETS TIME-OUTS * EXT(0) COUNTER FOR DATA TRANSFER * EXT(1) LAST WORD RECEIVED OVER COMM LINE * EXT(2) VERTICAL PARITY WORD / RP REQ LENGTH * EXT(3) DIAGONAL PARITY WORD / RP DATA LENGTH * EXT(4) COUNT OF TOTAL # BLOCKS TRANSMITTED * EXT(5) COUNT OF TOTAL NUMBER OF TRANSMIT-RETRIES * EXT(6) ID SEQ ADDRESS FOR SCHEDULE ON NEW REQUEST * * BREAKDOWN OF EQT WORD 12 * * BIT USAGE * 0-2 RETRY COUNTER OR * 0-5 BROKEN LINE COUNTER * 6 BROKEN LINE FLAG * 7-8 NOT USED * 9 REQUEST PENDING * 10 LISTEN MODE ENABLED * 11 RESERVED (USED BY SPECIAL FORCED-COLD-LOAD # * DRIVER, NOT PART OF DS/1000) # * 12 LAST SUCCESSFUL OPERATION (1=WRITE) * 13 FLAG FOR WRITE RETRY IN PROGRESS * 14 MICROCODE READ/WRITE FLAG * 15 POWER-FAIL RECOVERY IN PROGRESS # SKP * * DRIVER INITIALIZATION SECTION * IA65 NOP LDA EQT14 INA STA EQT15 REESTABLISH EQT15 ADDR JSB SETIO CONFIGURE I/O INSTRUCTIONS SERET LDB EQT13,I EXTENSION ADDRESS ADB B6 LDA B,I GET 7TH EXT. WORD SZA IS THIS THE FIRST ENTRY FOR EQT? JMP NFIR NO * * THIS CODE IS EXECUTED ONLY ON FIRST TIME THROUGH FOR EQT * STA EQT12,I YES, INITIALIZE EQT12 STATUS STB TEMP 7TH WORD OF EXT. AREA * MODIFY INTERRUPT TABLE LDA CELL GET SELECT CODE ADA N6 SUBTRACT 6 TO FIND ADA INTBA ENTRY IN INTERRUPT TABLE LDB A,I FETCH USER INTERRUPT LINK CMB,INB GET INTERRUPT LINK STB TEMP,I AND SAVE LDB EQT1 SET DRIVER STB A,I INTERRUPT LINK } JSB RDD.C CLEAR CARD * MODIFY CODE IF A DMS SYSTEM LDB $OPSY SYSTEM TYPE CLA,CCE RBR,SLB DMS SYSTEM? STA MOD1 YES, MODIFY INSTRUCTIONS ERA CCB SET REGISTERS FOR CPU TYPE CHECK OCT 100060 THIS SETS B TO 0 IFF XE NOP LDA XEMIC MICROCODE CALL FOR XE SZB SKIP IF XE LDA MXMIC ELSE USE 21MX MICROCODE CALL STA MIC$X SAVE LOCALLY * LDA EQT4,I TELL RTE TO RETURN CONTROL ON TIME OUT, IOR .300 AND FOR POWER-FAIL RECOVERY. # STA EQT4,I SKP * NFIR LDB EQT5,I LDA EQT6,I GET REQUEST CODE AND B3703 ISOLATE IT CCE,SSB IS THIS A POWER-RECOVERY ENTRY? # JMP PFAIL YES, GO TO ABORT CURRENT OPERATION. # CPA B3 IS IT A STOP REQUEST? JMP STPRQ YES, SEND A "STOP". * DETERMINE OPERATION TYPE LDB A AND B3 MASK OFF CODE CPA B1 IS IT A READ? JMP REQ YES...READ OR WRITE/READ CPB B203 IS IT A CLEAR REQ? JMP CLREQ YES...CLEAR REQ. CPB B103 IS IT AN ENABLE LISTEN MODE JMP LCREQ YES IFZ CPB B703 DISABLE TRACE MODE? # JMP DTRAC YES. # CPB B1703 RE-ENABLE TRACE MODE? # JMP ETRAC # XIF * ERROR IN REQUEST HAS OCCURRED CLB,INB CODE FOR REQUEST ERROR SZA WAS IT A CONTROL CODE? REJCT INB YES, RETURN A 2 (CONTROL REQ. ERROR) JMP IDON * * B3 OCT 3 B6 OCT 6 B103 OCT 103 B203 OCT 203 B3703 OCT 3703 .300 OCT 30000 # MXMIC OCT 105520 XEMIC OCT 105300 IFZ B700 OCT 700 # B1700 OCT 1700 B703 OCT 703 # B170b\3 OCT 1703 # XIF SKP * * SET UP ENABLE LISTEN MODE LCREQ LDA MIC$X INITIALIZE TO USE OPEN LOOP MICROCODE MOD1 JMP LCR2 NOP IF DMS SYSTEM CELL EQU *+1 XSA * DO CROSS-MAP STORE RSS LCR2 STA CELL,I NON-DMS, MODIFY TRAP CELL JSB RDD.C READ CARD TO CLEAR IT LISTI STC 0,C SET RECEIVE INTERRUPT MODE LDA .020 SET LISTEN ENABLED STATUS RSS CLREQ JSB RDD.C READ DATA AND STATUS FROM CARD TO CLEAR STA EQT12,I UPDATE EQT STATUS CLB,INB GOOD STATUS BIT JSB STAT PUT NEW STATUS IN EQT 5 LDB B4 SET FOR IMMEDIATE COMPLETION * * HERE FOR COMPLETION RETURN * EQT 12 WILL BE SET DEPENDING UPON LISTEN MODE * STATUS IDON STB TEMP SAVE COMPLETION STATUS LDA EQT12,I GET CURRENT DRIVER STATUS AND .020 MASK OFF ALL BUT LISTEN ENABLE LDB LSTNI GET ADDRESS OF LISTEN ENABLED ROUTINE SZA LISTEN MODE ENABLED? CLA,INA,RSS YES, ENABLE MICROCODE READ CLB NO STA EQTX,I SET TRANSFER COUNT LDA TEMP GET STATUS AGAIN STB EQT11,I SAVE COROUTINE ADDRESS JMP IA65,I RETURN TO RTE SYSTEM SKP * * COME HERE ON A READ OR WRITE * REQ EQU * IFZ LDA EQT6,I GET REQUEST # AND B1700 MASK SUBFUNCTION # CPA B700 ENABLE TRACE MODE CALL? # JMP TRAC. YES # XIF LDB EQT7,I GET ADDRESS OF DATA ADB N7 POINT TO 2ND WORD OF CLASS HDR LDA EQT14,I GET THIS EQT'S TIMEOUT IOR TBITS ENSURE BITS 15, 14, AND RAL 0 ARE SET FOR SYSTEM USE STA B,I PASS TIMEOUT TO GRPM LDA EQT8,I DATA LENGTH CMA,INA ADA EQT9,I COMPUTE (REQ ADDR - DATA LEN) STA EQT7,I USE IT AS ACTUAL> BUFFER ADDR * LDA EQT12,I AND NMSK CLEAR UNNECESSARY FLAGS STA EQT12,I * LDB EQT6,I GET REQUEST CODE BLF,BLF RBL SIGN =BIT#6, LSB =BIT#7. ALF,RAR ALF,ERA E = REQUEST PENDING FLAG LDA EQT8,I STA EQT6,I SET XMISSION LOG INTO EQT6 ADA EQT10,I COMBINE BOTH LENGTHS SLB,RSS IS THIS A WRITE TO CBL? STA EQT8,I NO, SAVE COMBINED LENGTHS LDA EQT5,I EQT STATUS WORD AND B1774 CLEAR BITS 7-0 SSB,RSS IS THIS A WRITE? CME,RSS NO, REVERSE RP FLAG IOR B200 YES, SET BIT 7 STA EQT5,I CLA,SEZ,INA SKIP IF (WRITE&NOT RP) OR (READ&RP) JMP BUSY OTHERWISE BUSY OR INVALID REQUEST SSB SKIP IF A READ JMP WREQ DO A WRITE SKP * * READ REQUEST * LDA EQT12,I AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I * REQ1 LDB EQT10,I GET RECEIVED RQST LENGTH LDA EQT4,I ALF,ALF GET LSB OF SUBCHANNEL RAL,ELA AND STORE IT IN E REG RBL,ERB ECHO WD WITH BIT15=1 IF CLOSED LOOP REQ2 EQU * IFZ LDA B23 STATE 19: READ RQST, ECHOING RQST LNTH# XIF JSB TALK READ RESPONSE IFZ LDA B24 STATE 20: READ RQST, CHECKING RESPONSE# XIF JSB CHECK CHECK RCVD WORD JMP REQ3 MUST RETRY ON TIMEOUT JMP ERR.7 STOP RECEIVED # JMP ERR.8 RC RCVD, PROTOCOL FAILURE CPB TNW JMP RDREQ "TNW" RCVD, OK TO READ-IN REQUEST CPB RLW RLW RECEIVED? JMP REQ1 YES, RE-ECHO REQUEST LENGTH * REQ3 JSB RETRY UNRECOGNIZED WORD RECEIVED LDB RLW SEND RLW AND JMP REQ2 TRY AGAIN SPC 2 * * SET-UP TO READ DATA BLOCK * RDREQ LDA EQT8,I DATA LENGTH CPA B2 IS THIS A CBL REQUEST? CLA,INA,RSS ~YES JMP RDBLK NO, INITIATE READ STA EQT8,I SET READ LENGTH TO 1 LDB EQT7,I BUFFER ADDRESS LDA EQT1 ADDR OF THIS EQT STA B,I PASS IT TO PROGL IN 1ST WORD ISZ EQT7,I BUMP ADDR FOR BUFFER * * THIS SECTION INITIATES ALL MICROCODE BLOCK READS * RDBLK LDB EQT4,I LSL 9 SIGN = SUBCHANNEL LSB LDA MIC$X GET MICROCODE MACRO INSTRUCTION SSB SKIP IF SUBCHANNEL EVEN (XMIT MODE) INA ODD SUBCHANNEL, RUN CARD IN RCV MODE STA CELL,I STORE COMM.LINES TRAP CELL LDB TNW SEND TNW IFZ CLA STATE 0: INITIATING READ, SENDING TNW# XIF JSB OUTPB LDB EQT14,I & SET COMM LINE TIMEOUT STB EQT15,I LDA EQT8,I GET SUM OF DATA & REQ LENGTHS CMA -# OF WORDS -1 STA EQTX,I SET MICROCODE'S COUNTER JSB CEXIT NOW DO IT! * * BLOCK HAS BEEN READ, CHECK TRANSMISSION LDA COUNT MICROCODE COUNT ADA EQT8,I SSA SKIP IF XFER GOT STARTED JMP RDB4 ELSE RETRY, TNW MAY HAVE BEEN LOST # IFZ LDA B25 STATE 21: BLOCK HAS BEEN READ, # * WAITING FOR TNW# XIF JSB CHECK CHECK XMISSION JMP RDTO TIMEOUT, EXAMINE THE REASON. # JMP ERR.7 STOP RECEIVED # JMP ERR.8 REQUEST COMING: PROTOCOL FAILURE! # RDB2 CPB TNW WAS LAST A "TNW"? # JMP ENDIT YES, SUCCESSFUL READ. # RDTO CPB RLM REQUEST TO TRY AGAIN? # JMP RDB4 YES, SEE IF ALLOWED. # LDB COUNT IF THE MICROCODE COUNT HAS # CPB B100 BEEN SET =100B, THEN # JMP ER6WT A PROTOCOL FAILURE HAS BEEN DETECTED!# CPA .040 ACTUAL TIMEOUT? # JMP u{ERR.3 YES, PROCESS THE ERROR. # * * LAST CONTROL UNRECOGNIZED RDB3 EQU * # IFZ LDA B26 STATE 22:BLOCK READ BUT LAST CTRL UNREC# XIF LDB RLW SEND "RETRANSMIT LAST WORD # JSB TALK & READ RESPONSE IFZ LDA B27 STATE 23:CHECKING RESPONSE TO RLW # XIF JSB CHECK SEE WHAT WE GOT JMP RDB5 NO RESPONSE, TRY AGAIN, IF ALLOWED. # JMP ERR.7 STOP RECEIVED # JMP ERR.8 REQUEST COMING: PROTOCOL FAILURE! # JSB RETRY RETRY OUR RETRY JMP RDB2 * RDB4 JSB RETRY GIVE IT 8 TRIES JMP RDBLK * RDB5 JSB RETRY IF RETRIES ARE ALLOWABLE, # JMP RDB3 SEND RLW, AND AWAIT ACKNOWLEDGMENT. # SPC 2 * HERE WHEN 'STOP' RECEIVED ON "READ" * ERR.7 EQU * # JSB RTEQT RETURN EQT NUMBER # JMP ERR.4 AND TAKE 'STOP' EXIT # * RTEQT NOP SUBROUTINE TO RETURN EQT NUMBER # LDB EQT9,I # LDA EQT1 # STA B,I # JMP RTEQT,I RETURN TO CALLER # * * HERE ON RECEIVE PROTOCOL ERRORS--DELAY TO FORCE XMIT TIMEOUT # * ER6WT EQU * # JSB RTEQT RETURN EQT ADDRESS SO QCLM CAN PRINT EQT # LDA DM100 ALLOW A 1 SECOND DELAY # STA EQT15,I TO FORCE A TRANSMITTER TIMEOUT. # CLA DISABLE # STA EQTX,I MICROCODE. # JSB CEXIT AWAIT THE TIMEOUT RETURN. # LDB B100 INDICATE PROTOCOL FAILURE IN EQT5. # JMP CEND GO TO TERMINATE THE CURRENT OPERATION. # * DM100 DEC -100 # * SKP * * WRITE REQUEST * WREQ LDA EQT9,I LDA A,I GET 1ST WORD OF REQUEST SLB IS THIS A PROGL DOWNLOAD? STA EQT10,I YES, USE IT INSTEAD OF BUFFER LEN * WRTRY EQU * # IFZ CLA,INA STATE 1:WRITING, SENDING RC # XIF LDB RC # JSB TALK SEND RC & READ RESPONSE IFZ LDA B2 STATE 2:WRITING, SENT RC, EXPECT TNW# XIF JSB CHECK CHECK WHAT WE GOT JMP WRTR1 TRY AGAIN IF TIMEOUT JMP WRTRY STOP, RETRY IMMEDIATELY JMP SIMRQ RC, SIMULTANEOUS REQUEST CPB RLW RLW RECEIVED? JMP WRTRY YES, OTHER SIDE SAYS RETRY CPB TNW RSS SKIP IF "TNW" RECEIVED JMP WRTR1 UNRECOGNIZED, RETRY * SEND DATA LENGTH LDB EQT6,I IFZ LDA B3 STATE 3:WRITING, SENDING DATA LENGTH# XIF JSB TALK SEND DATA LENGTH, GET ECHO IFZ LDA B4 STATE 4:WRITING, SENT DATA LNTH, # * EXPECT ECHO # XIF JSB CHECK CHECK RESPONSE JMP ERR.3 TIMEOUT JMP TSDLN 'STOP' CODE MAY BE A VALID DATA LENGTH # JMP SIMRQ SIMULTANEOUS REQUEST TSDLN CPB EQT6,I ECHO OK? # JMP SRQLN YES # CPB STOP LEGITIMATE 'STOP'? # JMP ERR.4 YES, PROCESS IT. # JMP WRTR1 NO, RETRY * SEND REQUEST LENGTH SRQLN LDB EQT10,I REQUEST LENGTH # IFZ LDA B5 STATE 5:WRITING, SENDING REQUEST LENGTH# XIF JSB OUTPB SEND IT LDA B1776 STA EQT15,I APPROXIMATELY 1 SEC TIMEOUT JSB TRAPR w SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT READ NEXT WORD WREQ2 EQU * IFZ LDA B6 STATE 6:WRITING, SENT REQ. LNTH, EXPECT ECHO# XIF JSB CHECK CHECK RESPONSE JMP WRTR1 TIMEOUT, RETRY JMP ERR.5 REMOTE IS BUSY JMP SIMRQ RC * CONFIGURE FOR EITHER CLOSED OR OPEN LOOP MICROCODE PROCESSING LDA EQT10,I ELA SAVE EQT10 SIGN LDA MIC$X MICROCODE CALL RBL,SLB,ERB IF BIT 15=1, RCVR WANTS CLOSED LOOP INA SET TO CALL CLOSED LOOP PROCESSOR STA CELL,I SET TRAP CELL CPB EQT10,I CHECK ECHOED RQST LENGTH JMP WRBLK LENGTH ECHO IS OK SKP * JSB RETRY NOT VALID ECHO, BUMP RETRY COUNT CPB RLW WAS IT AN RLW? (CBL RETRY) JMP WRTRY YES, DO IMMEDIATE RC RETRY LDB RLW IFZ LDA B7 STATE 7:WRITE RETRY # XIF JSB TALK SEND RLW JMP WREQ2 * * REQUEST PREAMBLE WRITE FAILURE - WAIT 1 I/O T.O. AND RETRY THE RC# * WRTR1 JSB RETRY CHECK RETRY COUNT LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT DO READ IFZ LDA B10 STATE 8: REQUEST PREAMBLE WRITE FAILURE--RETRY# XIF JSB CHECK SEE WHAT WE GOT JMP WRTRY TIMED-OUT, RESEND RC JMP ERR.4 STOP RCVD, EXIT JMP SIMRQ RC, SIMULTANEOUS REQUEST # JMP WRTRY UNRECOGNIZED, DO RC ANYWAY * * SIMULTANEOUS REQUEST OCCURRED, RESOLVE BASED ON LAST OPERATION * SIMRQ JSB RETRY DON'T TRY FOREVER LDA EQT12,I ALF,SLA TEST LAST SUCCESSFUL OPERATION RSS LAST WAS WRITE, WE MUST WAIT JMP WRTR1+1 LAST WAS READ, WE GET PRIORITY * LDB RLW IFZ LDA B11 STATE 9: YIELD FOR SIMULTANEOUS REQUEST# XIF JSB XMITX SEXND RLW IN XMIT MODE LDA EQT12,I SET THE 'REQUEST PENDING' BIT(#9) # IOR .010 IN THE EXTENDED STATUS WORD # STA EQT12,I TO PREVENT ACCEPTANCE OF NEW REQUEST.# LDA EQT14,I SET A PROTECTIVE TIMEOUT # STA EQT15,I IN CASE THE REMOTE EXPIRES. # LDB B4 JMP CEND GIVE SIMULTANEOUS REQUEST STATUS SKP * ENTER HERE TO DO ALL BLOCK WRITES WRBLK LDB TNW THIS TNW WILL INITIATE MICROCODE IFZ LDA B12 STATE 10:WRITING, SENDING TNW, EXPECT TNW# XIF WXFER EQU * JSB OUTPB SEND IT LDB EQT14,I STB EQT15,I SET LINE TIMEOUT LDA EQT12,I IOR .400 SET MICROCODE WRITE BIT STA EQT12,I UPDATE EQT STATUS LDA EQT8,I LENGTH FOR XFER SZA,RSS JMP ENDIT ZERO LENGTH DATA, GET OUT NOW CMA -LENGTH-1 STA EQTX,I SET MICROCODE COUNTER JSB CEXIT LET MICROCODE DO ITS THING * * BLOCK HAS BEEN WRITTEN, CHECK TRANSMISSION LDA COUNT GET MICROCODE XFER COUNT, # LDB EQTX AND EQT EXTENSION ADDRESS. # SZA,RSS IF THE TRANSFER WAS SUCCESSFUL, THEN # JMP WRTOK COMPLETE THE HOUSEKEEPING. # * # CPA B77 IF PARITY FAILED # JMP WRTR2 GO TO RETRY THE TRANSFER. # CPA B100 IF PROTOCOL FAILED, # INB,RSS THEN SKIP TO DETERMINE THE REASON; # JMP ERR.3 ELSE, GIVE A TIMEOUT ERROR. # LDA B,I GET THE RECEIVED WORD. # CPA STOP IF A "STOP" WAS RECEIVED, # JMP ERRW4 THEN ABORT, AND INFORM THE CALLER. # CPA RC IF AN "RC" WAS RECEIVED, THEN THE RCVR # JMP SIMRQ IS OUT OF SYNC--RESOLVE THE CONFLICT. # JMP ERR.9 UN-RECOGNIZEABLE: PROTOCOL FAILURE! # * # WRTOK ADB B4 POINT TO DATA BLOCK XFER COUNTER. # ISZ B,I BUMP THE TOTAL SUCCESSFUL BLOCK COUNT. # NOP # JMP ENDIT COMPLETE THIS OPERATION. # * * PARITY FAILURE: PERFORM A WRITE RETRY # WRTR2 JSB RETRY CHECK RETRY COUNT # ADB B5 POINT TO THE BLOCK RETRY COUNTER # ISZ B,I BUMP WRITE RETRY COUNTER NOP LDA EQT12,I IOR .200 SET "WRITE RETRY" FLAG STA EQT12,I LDB RLM "RETRANSMIT LAST MESSAGE" IFZ LDA B13 STATE 11: PERFORMING WRITE RETRY # XIF JMP WXFER PERFORM RE-WRITE SKP * LOCAL BUSY OR READ REJECT FOR NO R.P. BUSY CCB LDA EQT15,I IS THERE A TIMEOUT PENDING IOR EQTX,I OR IS MICROCODE ENABLED? SZA,RSS SKIP IF YES TO EITHER STB EQT15,I ELSE SYSTEM WIPED OUR TIMEOUT LDB B2 JSB STAT SET LOCAL BUSY FLAG AND B200 ISOLATE THE WRITE FLAG (BIT#7) # SZA,RSS IF THIS IS A READ OPERATION, THEN # JSB RTEQT GO SAVE EQT ADDRESS FOR ERROR MESSAGE.# LDA B4 IMMEDIATE COMPLETION LDB EQT6,I RETURN DATA LENGTH IN B JMP IA65,I RETURN * * HERE FOR REMOTE BUSY ERR.5 LDB B40 JMP CEND * # * HERE FOR PROTOCOL FAILURES ON 'READ' * STORE EQT ADDRESS IN 2ND BUFFER ERR.8 EQU * JSB RTEQT STORE EQT # JMP ERR.9 AND EXIT W/ PROTOCOL FAILURE STATUS # * * POWER FAIL: SEND 'STOP' & REPORT PROTOCOL ERROR; HIGHER LEVELS MAY RETRY # * # PFAIL LDwA EQT12,I SET POWER-FAIL RECOVERY IN PROGRESS # RAL,ERA (EQT12: BIT#15) # STA EQT12,I INTO THE EXTENDED STATUS WORD. # IFZ LDA B34 STATE 28: POWER FAILURE JMP PSTAT GO TO SET PARITY/PROTOCOL STATUS # XIF * * HERE FOR PARITY ERROR ERR.6 EQU * # IFZ LDA B31 STATE 25: PARITY ERROR # JMP PSTAT GO TO SET PARITY ERROR STATUS. # XIF * * HERE ON ALL PROTOCOL FAILURES (WRITING & READING) * ERR.9 EQU * IFZ LDA B32 STATE 26:PROTOCOL FAILURE # XIF PSTAT LDB B100 GET PARITY/PROTOCOL ERROR BIT#6. # * * HERE TO SET ERROR, SEND STOP, & TERMINATE ERSET EQU * IFZ STA STATE SAVE DRIVER STATE # XIF JSB STAT PUT STATUS INTO EQT 5 AND B200 ISOLATE THE WRITE FLAG (EQT5 BIT#7) # SZA,RSS IF THIS IS A READ OPERATION, THEN # JSB RTEQT GO SAVE EQT ADDRESS FOR ERROR MESSAGE.# LDB STOP IFZ LDA STATE LOAD STATE #(DEPENDS ON ERROR) # XIF JSB XMITX SEND STOP & AWAIT INTERRUPT JSB RDD.C CLEAR CARD BY READING IT JMP CEND+1 AND RETURN ERROR CODE. # * LSTNI DEF ILSTN B1 OCT 1 .020 OCT 2000 .010 OCT 1000 * B40 OCT 40 B77 OCT 77 B100 OCT 100 .100 OCT 10000 .200 OCT 20000 .400 OCT 40000 NMSK OCT 13100 TBITS OCT 160000 CLR9 OCT 176777 CLR11 OCT 173777 SKP * * THIS SUBROUTINE INITIALIZES THE EQT TIMEOUT FLAG, SETS THE * COMM LINE TRAP CELL TO A "JSB CIC" IF IT IS ABOVE THE * PRIVILEGED CARD AND SETS THE MICROCODE COUNTER TO 1. * TRAPR NOP LDA EQT4,I AND CLR11 CLEAR THE EQT4 TIMEOUT FLAG STA EQT4,I LDB CELL THIS LINE'S SELECT CODE CMB,INB ADB DUMMY TEST AGA/INST PRIVILEGED CARD'S SC LDA MIC$X MICROCODE CALL MACRO SSB ARE WE ABOVE THE PRIVILEGED CARD? LDA TBG,I YES, GET A "JSB CIC" STA CELL,I SETUP TRAP CELL CLA,INA STA EQTX,I SET MICROCODE COUNT = 1 JMP TRAPR,I RETURN SPC 1 * * SEND WORD, SET TIMEOUT, & AWAIT RESPONSE * TALK NOP JSB OUTPB SEND WORD IN B REG LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAPCELL FOR 1 WORD READ LDA TALK COROUTINE RETURN ADDRESS JMP CEXT1 SPC 1 * * IF ALREADY 7 RETRIES, GIVE PARITY ERROR ELSE BUMP COUNT & RETURN * RETRY NOP LDA EQT12,I AND B7 ISOLATE RETRY COUNTER CPA B7 IS THIS THE 8TH RETRY? JMP FAIL YES, RETURN ERROR ISZ EQT12,I BUMP COUNT JMP RETRY,I & TRY AGAIN * FAIL LDB COUNT SZB WAS WORD COUNT ZERO? CPB B77 NO, WAS IT BLOCK PARITY? JMP ERR.6 RETURN A PARITY ERROR * * HERE FOR TIMEOUT ERR.3 LDB B10 TIMEOUT BIT FOR EQT5 IFZ LDA B33 XIF JMP ERSET EXIT WITH LINE T.O. ERROR # SKP * * CONTINUATION SECTION * CA65 NOP JSB SETIO CONFIGURE I/O INSTRUCTIONS LDB EQT11,I GET COROUTINE ADDR SZB,RSS IT IT SET-UP? JMP IUNKN GO TO UNKNOWN INTERRUPT PROCESSOR LDA EQTX,I STA COUNT SAVE MICROCODE COUNT CLA STA EQTX,I DISABLE MICROCODE LDA EQT12,I AND .020 ISOLATE "LISTEN ENABLED" BIT IOR EQT1,I ALSO TEST FOR DRIVER BUSY SZA EITHER CONDITION TRUE? JMP B,I YES, GO TO COROUTINE ADDR ISZ CA65 NO, IGNORE THE INTERRUPT. * CLCRD JSB RDD.C CLEAR THE CARD JMP CEXT3 & GET OUT * * * * UNKNOWN INTERRUPTS COME HERE * WE'RE IN TROUBLE IF WE EVER GET HERE!!!!! * IUNKN STiB EQT12,I CLEAR ALL CARD STATI LDB B77 SET ALL STATUS ERROR BITS JMP CEND GET OUT...NOW!!! * SKP * * HERE FOR FIRST INTERRUPT WHEN CARD IN LISTEN MODE * ILSTN LDA EQT12,I AND B1776 INITIALIZE BROKEN LINE COUNT STA EQT12,I * ILSN0 EQU * IFZ LDA B14 STATE 12: FIRST INTERRUPT IN LSTEN MODE, EXP.RC # XIF JSB CHECK FIND OUT WHAT THEY SENT US JMP ILSN3 TIME OUT...IGNORE # JMP ILSN3 STOP...IGNORE # JMP ILSN1 REQUEST COMING (ONLY 'RC' IS ACCEPTABLE) * * ENTER HERE WHEN UNRECOGNIZED WORD RECEIVED WHILE "LISTENING" * JSB RDD.C CLEAR COMMUNICATIONS CARD LDA EQT12,I ISZ EQT12,I BUMP BROKEN LINE COUNT AND B77 CPA B77 64 ZEROES IN A ROW = BROKEN LINE! JMP DEXIT IT IS, LEAVE CARD DISABLED & EXIT JSB TRAPR SETUP FOR 1 WORD READ JSB CEXIT EXIT IN RCV MODE JMP ILSN0 GOT ANOTHER WORD, GO CHECK IT * ILSN1 LDA EQT12,I EQT STATUS IOR .010 SET REQUEST PENDING FLAG STA EQT12,I SAVE IT * ILSN2 EQU * # IFZ LDA B15 STATE 13: GOT RC, SENDING TNW, EXP.DATA LNTH # XIF LDB TNW SEND A TNW. # JSB TALK & WAIT FOR DATA LENGTH IFZ LDA B16 STATE 14: RECEIVING, EXPECTING DATA LENGTH # XIF JSB PRECK DO PREAMBLE CHECKING ADA B3 POINT TO EXT(3) STB A,I SAVE DATA LENGTH FOR PROGRAM IFZ LDA B17 STATE 15: ECHOING DATA LENGTH, EXPECT REQ. LNTH # XIF JSB TALK ECHO IT & GET REQUEST LENGTH IFZ LDA B20 STATE 16: RECEIVING, EXPECTING REQ. LNTH # XIF JSB PRECK DO PREAMBLE CHECKING ADA B2 POINT TO EXT(2) STB A,I SAVET RQST LENGTH FOR PROGRAM ADA B4 POINT TO EXT(6) LDB A,I GET I/O ADDRESS OF PROGRAM STB PROG SAVE ADDRESS ADB B17 GET TO STATUS LDA B,I GET STATUS AND B17 MASK OFF ALL BUT STATUS SZA BUSY? JMP ILSN4 YES...TELL OTHER SIDE TO RETRY # ADB N5 ID SEG B REG SAVE AREA LDA EQT4 GET ADDRESS OF LU STA B,I PASS IT IN B REG JSB $LIST SCHEDULE PROGRAM OCT 101 PROG NOP ILSN3 JSB RDD.C CLEAR CARD BY READING IT # JSB TRAPR SETUP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI SET FOR LISTEN MODE INTERRUPT JMP CEXT1 AND EXIT * * HERE IF WE GOT A "BUSY" CONDITION * ILSN4 EQU * # IFZ LDA B21 STATE 17: QUEUE BUSY, SENDING 'STOP' # XIF LDB STOP GET THE 'STOP' # JSB OUTPB SEND IT * * HERE ON STOP...CLEAR REQUEST PENDING STATUS * ILSN5 LDA EQT12,I AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I JMP ILSN3 TERMINATE # * * SUBROUTINE TO CHECK RCVD PREAMBLE WORD & RETRY IF RC * PRECK NOP JSB CHECK CHECK RCVD WORD JMP ILSN5 TIME-OUT, CLEAR RP CONDITION RSS 7760B IS POSSIBLE DATA LEN JMP ILSN2 RC, RESTART PREAMBLE LDA EQTX PASS EXT AREA ADDR BACK JMP PRECK,I * SKP * * HERE FOR SEND STOP REQUEST * STPRQ LDB STOP SEND STOP CLA DON'T ALTER STA CELL TRAP CELL. IFZ LDA B22 STATE 18: REQUEST TO SEND 'STOP' # # XIF JSB XMITX IN XMIT MODE JSB RDD.C READ CARD TO CLEAR IT STA CELL LDA EQT12,I AND BSTMK SAVE LISTEN, BROKEN LINE, & LAST OP.BITS JMP ENDOK * * NOW SET FLAG TO SHOW WHETHER THE LAST SUCCESSFUL OPERATION WAS A * READ OR WRITE. THIS IS USED TO RESOLVE SIMULTANEOUS LINE CONTENTION. ENDIT LDA EQT12,I AND .020 SAVE "LISTEN ENABLED" FLAG LDB EQT5,I BLF,BLF SSB SKIP IF READ IOR .100 SET LAST OPERATION AS WRITE * ENDOK STA EQT12,I SET STATUS CLB,INB SET GOOD STATUS # JMP CEND # * * 'STOP' RECEIVED SOMETIME DURING TRANSMISSION ERRW4 EQU * IFZ CH.01 NOP 'RSS' HERE WHEN TRACE MODE ENABLED # JMP ERR.4 SKIP 'TRACE' STUFF WHEN DISABLED # JSB CKTRC CHECK IF WE'RE TO TRACE THIS ONE # JMP ERR.4 NO, CONTINUE LDB B30 STATE 24:'STOP' RC'D DURING XMIT-ABORT# JSB TRACE # LDB STOP # IOR SBIT SET 'RECEIVE' INDICATOR JSB TRACE # LDB EQT1 # JSB TRACE # LDB $TIME # JSB TRACE # XIF # * * 'STOP' RECEIVED EXIT * ERR.4 EQU * LDB B20 SKP * * HERE TO TERMINATE * CEND JSB STAT UPDATE EQT 5 STATUS LDA EQT12,I GET CARD STATUS WORD AND .020 IS IT LISTEN MODE? SZA,RSS JMP CLCRD NO, CLEAR CARD & EXIT JSB TRAPR SET UP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI GET LISTEN INTERRUPT JMP CEXT2 AND LEAVE * * HERE TO DO CONTINUATION RETURN * CEXIT NOP LDA CEXIT GET NEXT INTERRUPT ADDRESS CEXT1 ISZ CA65 BUMP CONTINUATOR RETURN CEXT2 STC 0,C SET FOR RECEIVE MODE CEXT3 STA EQT11,I SAVE NEW INTERRUPT LOCATION CEXT4 CLA LDB SETIO  CPB I65AD WAS THIS ENTRY VIA INITIATOR? JMP IA65,I YES, THEN RETURN THE SAME WAY LDB EQT6,I GET EQT6 IN CASE IT'S COMPLETION JMP CA65,I RETURN * I65AD DEF SERET SPC 3 * * SUBROUTINE TO PUT NEW STATUS INTO EQT WORD 5 * STAT NOP LDA EQT10 STA EQT15 FOOL RTE SO IT LEAVES TIMEOUT ALONE LDA EQT5,I GET WORD 5 AND B1776 MASK OFF OLD STATUS IOR B STUFF IN NEW STATUS STA EQT5,I AND PUT IT AWAY JMP STAT,I RETURN * SKP * * ROUTINE TO DO CHECKING OF INPUT DATA * * CALLING SEQUENCE: * IF 'TRACE' MODE, LOAD (A) WITH DRIVER STATE NUMBER * JSB CHECK * WILL RETURN P+1 TIME OUT * P+2 STOP RECEIVED * P+3 REQUEST COMING RECEIVED * P+4 NORMAL RETURN...B REG= LAST DATA WORD * CHECK NOP LDB EQTX EQT EXTENSION ADDRESS INB LDB B,I LOAD LAST WORD RECEIVED IFZ STA STATE SAVE (TRACE VERSION ONLY) # XIF LDA EQT4,I WAS THIS ENTRY # AND .040 VIA # SZA TIME-OUT? # JMP LIAC1 YES, DATA IN (B) # * * THERE WAS NO TIMEOUT. CLEAR 'COUNT' WORD * SO WE DON'T THINK THERE WAS A TIME-OUT, * DISABLE CARD, AND PICK UP DATA DIRECTLY FROM * INTERFACE CARD. STA COUNT CLCC1 CLC 0,C LIB1 LIB 0 LIAC1 LIA 0,C CLEAR CARD STATUS. # IFZ # CH.00 NOP CHANGED TO 'RSS' WHEN TRACING IS ENABLED # JMP CHEC0 SKIP OVER 'TRACE' CODE WHEN NOT ENABLED # STB RDD.C SAVE FOR JUST A SECOND # JSB CKTRC SHOULD WE TRACE THIS ONE? # JMP CHEC. NO, DON'T TRACE THIS ONE. # LDB RDD.C RECOVER RECEIVED WORD I # JSB TRACE STORE IN TRACE TABLE # LDB STATE RECOVER DRIVER STATE # RBL MOVE TO 'STATE' FIELD # LDA COUNT WAS THERE A # CCE,SZA A TIME-OUT? # INB # RBL,ERB AND SET 'RECEIVE' INDICATOR BIT # JSB TRACE STORE TRACE/EVENT # LDB EQT1 STORE EQT ADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # * # CHEC. LDB RDD.C RECOVER RECEIVED DATA WORD # CHEC0 EQU * # XIF LDA COUNT MICROCODE COUNT # SZA,RSS DID MICROCODE FINISH? # JMP CHEC1 YES. # LDA EQT4,I NO. CHECK FOR POSSIBLE RTE TIME-OUT # AND .040 ISOLATE T.O. BIT # SZA TIME-OUT? # JMP CHECK,I YES, TAKE TIME-OUT RETURN # SPC 2 * * CHEC1 ISZ CHECK SET FOR 'STOP' RETURN # CPB STOP 'STOP'? # JMP CHECK,I YES...TAKE 'STOP' RETURN # ISZ CHECK # CPB RC REQUEST COMING? # JMP CHECK,I YES # ISZ CHECK SET "NONE OF THE ABOVE" RETURN # JMP CHECK,I RETURN # * * * B10 OCT 10 B20 OCT 20 B17 OCT 17 .040 OCT 4000 BSTMK OCT 12100 B1774 OCT 177400 B1776 OCT 177600 TEMP NOP MIC$X NOP OPEN LOOP MICROPROGRAM CALL COUNT NOP EQTX NOP SKP * ROUTINE TO CLEAR CARD * RDD.C NOP CLCC2 CLC 0,C LIAC2 LIA 0,C CLEAR STATUS LIA2 LIA 0 READ DATA WORD CLA JMP RDD.C,I * * HERE TO SEND WORD AND EXIT IN TRANSMIT MODE XMITX NOP JSB OUTPB SEND WORD JSB TRAPR SETUP TRAP CELL STC0 STC 0 SET TRANSMIT MODE LDA XMITX COROUTINE UPON RETURN STA EQT11,I DEXIT ISZ CA65 BUMP CONTINUATION RETURN JMP CEXT4 * OUTPB NOP IFZ OTB2 NOP 'RSS' WHEN TRACE MODE IS ENABLED # JMP OTB1 RETURN IMMEDIATELY IF TRACE DISABLED. # STB RDD.C SAVE (B) FOR A FEW LINES.... # JSB CKTRC SHOULD WE BE TRACING THIS ONE? # JMP OTB3 NO, DON'T TRACE THIS ONE. # LDB RDD.C RECOVER (B) REGISTER # JSB TRACE STORE OUTPUT WORD # RAL MOVE TO 'STATE' FIELD # LDB A LOAD EVENT # JSB TRACE STORE EVENT IN TRACE TABLE # LDB EQT1 STORE EQT ADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # OTB3 EQU * # LDB RDD.C RECOVER DATA TO BE TRANSMITTED # XIF OTB1 OTB 0 JMP OUTPB,I RETURN * RC OCT 170017 REQUEST COMING WORD TNW OCT 170360 TRANSMIT NEXT WORD STOP OCT 7760 SEND STOP RLW OCT 7417 RETRANSMIT LAST WORD RLM OCT 170377 RETRANSMIT LAST MESSAGE B2 OCT 2 B4 OCT 4 B7 OCT 7 N5 DEC -5 N6 DEC -6 N7 DEC -7 SKP *############################################################################ * * TRACE SECTION * * TRAC.-- SECTION TO SET UP TRACE BUFFER. * IFZ TRAC. EQU * LDA EQT7,I GET TRACE BUFFER ADDRESS STA NPASS SAVE ADDRESS OWF PASS COUNT STA B COMPUTE ADDRESS ADB EQT8,I OF END OF BUFFER + 1 STB TRACL SAVE ADDRESS OF END OF BUFFER INA GET ADDRESS OF 2ND WORD OF TRACE BUFFER STA TRPTR STORE POINTER TO NEXT AVAILABLE LOCN INA BUMP TO START OF TRACE BUFFER STA TRACB SAVE TRACE BUFFER LDB EQT9,I GET TRACE SELECTION SZB TRACE ALL? LDB EQT1 NO, TRACE ONLY THIS LU STB TREQT SAVE TRACE EQT, OR ZERO FOR ALL LDB EQT10,I LOAD RESOURCE NUMBER STB RN# SAVE IT. SPC 2 * ENABLE TRACE MODE. * ETRAC EQU * CHECK THAT BUFFER HAS BEEN DEFINED CLB,INB LDA TRACB LOAD BUFFER ADDRESS SZA,RSS WAS ONE DEFINED? JMP REJCT NO, THIS IS AN ERROR STA TRACN YES, INITIALIZE "NEXT" TRACE ENTRY PNTR LDA RSS STORE 'RSS' INSTRUCTION IN ALL TRA.3 EQU * "BYPASS TRACE CODE" PLACES. STA OTB2 STA CH.00 STA CH.01 * * "IMMEDIATE COMPLETION" RETURN TO RTIOC * LDA B4 CLB JMP IA65,I RETURN TO RTE SPC 2 * DISABLE TRACE MODE * DTRAC EQU * CLA STORE 'NOP' INSTRUCTION IN ALL "BYPASS TRACE JMP TRA.3 CODE" PLACES. * * SUBROUTINE TO CHECK WHETHER WE SHOULD BE * TRACING THIS ENTRY OR NOT. * CKTRC NOP LDB TREQT LOAD THE 'TRACE' EQT SZB TRACE ALL? CPB EQT1 NO, COMPARE TO THIS EQT ISZ CKTRC WE'RE TRACING THIS ONE! JMP CKTRC,I RETURN TO CALLER SKP * * TRACE -- SUBROUTINE TO MAKE AN ENTRY IN THE TRACE TABLE * * CALLING SEQUENCE: * LDB * JSB TRACE * * TRACE NOP ENTRY/EXIT STB TRACN,I STORE DATA IN TRACE BUFFER LDB TRACN ADVANCE TO NEXT ENTRY, OR INB CPB TRACL END? JMP TRAND YES, RESET TO START & UNLOCK RN ZM TRA.1 EQU * STB TRACN STORE "NEXT" ENTRY POINTER CMB,INB COMPUTE RELATIVE OFFSET ADB TRACB SO BACKGROUND PROGRAM CMB,INB STB TRPTR,I KNOWS WHERE WE ARE. JMP TRACE,I RETURN TO CALLER SPC 2 TRAND EQU * LDA RN# LOAD RESOURCE NUMBER JSB $CGRN UNLOCK RESOURCE NUMBER ISZ NPASS,I BUMP PASS NUMBER NOP PROTECT AGAINST ROLLOVER. LDB TRACB JMP TRA.1 RETURN TO MAIN FLOW * * STORAGE FOR 'TRACE' * STATE NOP STORAGE FOR DRIVER STATE TREQT NOP EQT ADDRESS TO BE TRACED, OR 0 FOR ALL OF THEM TRPTR NOP STORAGE FOR ADDRESS OF "NEXT" ENTRY IN BUFFER NPASS NOP ADDRESS OF NUMBER OF PASSES COUNTER RN# NOP RESOURCE NUMBER TRACB NOP POINTER TO START OF TRACE BUFFER TRACN NOP POINTER TO NEXT TRACE TABLE ENTRY TRACL NOP POINTER TO END OF TABLE + 1 B11 OCT 11 B12 OCT 12 B13 OCT 13 B14 OCT 14 B15 OCT 15 B16 OCT 16 B21 OCT 21 B22 OCT 22 B23 OCT 23 B24 OCT 24 B25 OCT 25 B26 OCT 26 B27 OCT 27 B30 OCT 30 B31 OCT 31 B32 OCT 32 B33 OCT 33 B34 OCT 34 RSS RSS 'RSS' INSTRUCTION SBIT OCT 100000 SIGN BIT XIF B5 OCT 5 *######################################################################## SKP SETIO NOP LDA EQT12,I EQT STATUS AND MICFG CLEAR MICROCODE R/W & RETRY FLAGS STA EQT12,I UPDATED EQT LDB EQT2,I CLA SSB SYSTEM TRYING TO INITIATE NEW REQUEST? CCA YES, SET A TICK STA EQT15,I SET TIMEOUT LDB EQT13,I STB EQTX SAVE ADDRESS OF EQT EXTENSION LDA EQT4,I AND B77 ISOLATE SELECT CODE STA CELL SAVE FOR TRAP CELL ADDR IOR CLCC CLC0,C COMMAND STA CLCC1 STA CLCC2 XOR .040 CONVERT TO STC 0,C COMMAND STA LISTFI STA CEXT2 XOR .010 CONVERT TO STC 0 COMMAND STA STC0 XOR B200 CONVERT TO LIA COMMAND STA LIA2 XOR .010 CONVERT TO LIA 0,C COMMAND STA LIAC1 # STA LIAC2 XOR .050 CONVERT TO LIB COMMAND STA LIB1 XOR B300 CONVERT TO OTB 0 COMMAND STA OTB1 JMP SETIO,I RETURN * * MICFG OCT 117777 CLCC CLC 0,C B200 OCT 200 B300 OCT 300 .050 OCT 5000 * BSS 0 SEE HOW BIG IT IS SKP * * DEFINE BASE PAGE LOCATIONS NEEDED * * * . EQU 1650B EQT1 EQU .+8 EQT2 EQU .+9 EQT4 EQU .+11 EQT5 EQU .+12 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 DUMMY EQU 1737B INTBA EQU 1654B TBG EQU 1674B * A EQU 0 B EQU 1 END [  91740-18021 1805 S C0122 DS/1000 MODULE: NDTGN              H0101 QxASMB,L,R,C HED NDTGN 91740-16021 REV 1805 (C) HEWLETT-PACKARD CO. 1978 NAM NDTGN,3 91740-16021 REV 1805 771123 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * NDTGN, ROUTINE TO ALLOW THE OPERATOR TO ENTER AND FORMAT * THE NDT IN A FILE * * SOURCE PART # 91805-18021 REV 1805 * * REL PART # 91805-16021 REV 1805 * * WRITTEN BY JEAN-PIERRE BAUDOUIN * * DATE WRITTEN MARCH 1976 * * MODIFIED BY CHW & CCH * * DATE MODIFIED JULY 1976, MARCH 1977 * *************************************************************** * * MODIFIED TO HANDLE DVR07 ** NOV 1977 ** DMT * *************************************************************** SPC 1 NODES EQU 512 MAXIMUM NODES IN NDT TABLE SPC 2 * THIS ROUTINE IS AN INTERACTIVE TABLE GENERATOR. * THE TABLE GENERATED IS THE NETWORK DESCRIPTION * TABLE (NDT). THIS TABLE IS STORED IN A FILE BY * THE GENERATOR AND IT WILL BE USED AT SYSON TIME * BY LSTEN. THE NAME OF THE TABLE IS SPECIFIED BY * THE OPERATOR (AS THE ANSWER TO THE FIRST QUESTION) * THIS NAME MUST BE REMEMBERED SINCE IT WILL BE * ASKED FOR BY LSTEN. * THE FORMAT OF THE NDT IS: * * RECORD #1: * W0 : NEGATIVE NUMBER OF NODES IN THE NETWORK * W1 : NODE NUMBER OF THE FIRST NODE * : * : * WN : NODE NUMBER OF NODE N * * RECORD #N (WHERE 1 1275? JMP INERX YES, ERROR LDA PARSB+5 NO, GET TIMEOUT AGAIN CLB DIV B5 CONVERT TO 5 SEC INTERVALS ADB N3 SSB,RSS REMAINDER > 2? INA YES, ROUND UP CMA,INA MAKE NEGATIVE SSA,RSS USE 5 SECONDS CCA IF TOO LOW. ADA D256 RAL,ALF RAL TIMEOUT IN BITS 13-6 IOR PARSB+1 INCLUDE LU LDB 0 STOLU LDA PNTR2,I GET THIS NODE # DST PNTR3,I SAVE NODE/TIMEOUT/LU WORD PAIR ISZ CNTR3 BUMP ADDRESSABLE NODES COUNT ISZ PNTR3 ISZ PNTR3 * NXTLU ISZ PNTR2 ISZ CNTR2 END OF THIS VECTOR ? JMP LOOP3 NO, CONTINUE * LDA CNTR3 YES, GET ADDRESSABLE NODES COUNT CMA,INA NEGATE ALS DOUBLE IT STA BUF2 STORE IN 1ST WORD OF NRV RECORD * JSB WRITF WRITE THIS RECORD DEF *+5 DEF IDCB DEF IERR DEF BUF2 DEF NRLEN ISZ PNTR1 ISZ CNTR1 END OF TABLE ? JMP LOOP2 NO, GET ANOTHER VECTOR JSB CLOSE YES, CLOSE THE FILE DEF *+3 DEF IDCB DEF IERR * JSB CHCKN WAS THERE A FILE RSS YES JMP MSOK NO JSB CLOSE CLOSE FILE DEF *+3 DEF INDCB DEF TEMP1 CLA STA FILFG ISZ ERFLG TERM MESSAGE TO ERROR LU MSOK JSB PRINT PRINT " END NDTGN" DEF OKMSG DEC 5 JMP EXIT SPC 3 * ABORT JSB PURGE PURGE NDT FILE DEF *+4 DEF IDCB DEF IERR DEF NAME HED NDTGN: SUBROUTINES SECTION (C) HEWLE9TT-PACKARD CO, 1977 * HERE TO TERMINATE * TERM JSB CHCKN WAS THERE A FILE RSS YES...FILE JMP TERM1 NO...DON'T CLOSE IT JSB CLOSE DEF *+3 DEF INDCB DEF TEMP1 CLA STA FILFG ISZ ERFLG ENSURE ABORT MSG GOES TO ERRLU TERM1 JSB PRINT DISPLAY ABORT MESSAGE DEF TERMM DEC 7 EXIT JSB EXEC DEF *+2 DEF D6 SKP * SUBROUTINE TO PRINT MESSAGES * IF WE ARE IN AN INTRACTIVE TERMINAL * CALLING SEQUENCE * JSB PRINT * DEF MESSAGE * DEC MESSAGE LENGTH * PRINT NOP LDB PRINT,I GET ADDRESS OF BUFFER TO BE PRINTED STB PRNT1 ISZ PRINT GET TO LENGTH WORD JSB CHCKN FILE OR LU ? JMP PRNTA FILE, FORGET IT LDA TTYF GET TTY FLAG LDB ERFLG GET ERROR FLAG SZB,RSS ERROR OR SZA,RSS OR INTERACTIVE RSS YES...PRINT MESSAGE JMP PRNTA NO ERROR AND NOT INTERACTIVE LDA RLU GET INTERACTIVE LU SZB ERROR? LDA ERLU YES...ERROR LU STA PRTLU SAVE AS PRINT LU JSB REIO PRINT MESSAGE DEF *+5 DEF B2 DEF PRTLU PRINT LU PRNT1 NOP DEF PRINT,I LENGTH PRNTA ISZ PRINT GET TO RETURN ADDRESS JMP PRINT,I RETURN SPC 1 B2 OCT 2 PRTLU NOP SPC 2 * * ROUTINE TO DECIDE WHICH TYPE OF INPUT DEVICE * EITHER FILE OR LU * IF LU, A REG WILL CONTAIN LU TYPE * CALLING SEQUENCE * JSB CHCKN * FILE RETURN * LU RETURN * CHCKN NOP LDB FILFG GET FILE FLAG LDA TTYF GET TTY FLAG SZB,RSS LU OR FILE ISZ CHCKN LU JMP CHCKN,I AND RETURN SKP * SUBROUTINE TO CHECK DRIVER TYPE * CALLING SEQUENCE: JSB TTY? * DEF * UPON RETURN, A-REG=LU NUMBER, B-REG=0 IF INTERACTIVE * TTY? NOP LDA TTY?,I 6 STORE ADDRESS OF STA CHKLU LU IN EXEC CALL. ISZ TTY? SET RETURN ADDRESS. * JSB EXEC MAKE STATUS CALL. DEF *+6 DEF D13 CHKLU DEF *-* DEF TEMP1 DEF TEMP DEF SBCNL * LDA TEMP1 GET EQT WORD 5. ALF,ALF ISOLATE AND B77 DRIVER TYPE. LDB A CPA B5 IF DVR05 JMP SBCH? OR CPA B7 DVR07. JMP SBCH? CHECK SUBCHANNEL. JMP LSN1A SBCH? LDA SBCNL ISOLATE AND SUBMK SUBCHANNEL. SZA,RSS IF ZERO, CLB IT'S INTERACTIVE. LSN1A LDA CHKLU,I A-REG := LU NUMBER. JMP TTY?,I RETURN. SKP * * SUBROUTINE TO READ FROM A SELECTED INPUT DEVICE * WILL PARSE THE INPUT AND PLACE RESULT IN A BUFFER * CALLED PARSB. * CALLING SEQUENCE * JSB READ * UPON RETURN A REG=PARB, B REG=PASB+1 * READ NOP JSB CHCKN FILE OR LU JMP READB FILE READA LDA RLU GET READ LU LDB ERFLG IS THIS AN ERROR READ? SZB LDA ERLU YES...READ FOR ERRORDEVICE STA REDLU SAVE READ LU JSB REIO ISSUE THE READ DEF *+5 DEF B1 DEF REDLU DEF INBUF DEF INBFS SZB EOF HIT? JMP READC NO JSB ERROR DEF EOFM "EOF...INPUT NEEDED" DEC 9 JMP READA TRY AGAIN SPC 1 READB JSB READF READ FROM A FILE DEF *+6 DEF INDCB DEF RSTAT DEF INBUF DEF INBFS DEF ILEN LDB ILEN GET LENGTH SSB,RSS SZB,RSS ZERO OR - ERROR JMP TERM ABORT READC CLE,ELB CONVERT TO BYTE LENGTH STB ILEN SAVE LENGTH JSB PARSE GO PARSE INPUT DEF *+4 DEF INBUF DEF ILEN DEF PARSB CLA CLEAR OUT ERROR FLAG STA ERFLG DLD PARSB LOAD A AND B REG JM P READ,I AND RETURN SPC 2 REDLU NOP ILEN NOP RSTAT NOP SKP * * ROUTINE TO PRINT ERROR MESSAGE IF WORKING FROM * AN LU, OTHERWISE ABORT PROGRAM * CALLING SEQUENCE * JSB ERROR * DEF ERMESAGE * DEC LENGTH OF MESSAGE * WILL SET ERROR FLAG FOR RETRY * ERROR NOP JSB CHCKN CHECK IF FILE JMP TERM FILE...ABORT LDA ERROR,I GET MESSAGE ADDRESS STA ERR1 SAVE ADDRESS ISZ ERROR GET TO LENGTH JSB EXEC DEF *+5 DEF B2 DEF ERLU ERR1 NOP DEF ERROR,I ISZ ERROR ISZ ERFLG SET ERROR FLAG JMP ERROR,I AND RETURN SPC 2 ERFLG NOP SKP * SUBROUTINE TO PRINT SYSTEM ERROR MESSAGES AND * ABORT * CALLING SEQUENCE * JSB SYSER * DEF ERR MESSAGE * DEC LENGTH * SYSER NOP LDA SYSER,I GET MESSAGE ADDRESS STA SYSR1 ISZ SYSER JSB EXEC DEF *+5 DEF B2 DEF B1 SYSR1 NOP DEF SYSER,I JMP TERM AFTER MESSAGE...ABORT SKP HED NDTGN: CONSTANTS * (C) HEWLETT-PACKARD CO. 1977 DRT EQU 1652B NAME? OCT 6412 ASC 12, FILE NAME FOR NDT ? _ INV#M ASC 7, INVALID CPU # CPU#? ASC 6, CPU # ? _ CPUTL OCT 6412 ASC 11,CPU-NUMBER INPUT PHASE FERM ASC 5,FILE ERROR RTM OCT 6412 ASC 13,ROUTE VECTORS INPUT PHASE CPUM ASC 3, CPU # CPU# BSS 3 ASC 3, ? _ BLNKS EQU CPU#+4 DUP# ASC 8, DUPLICATE CPU # VECTM OCT 6412 ASC 23,ENTER COMMUNICATIONS LU'S AND TIMEOUTS FOR CPU VECT# BSS 3 TRFM ASC 7, TR FILE ERROR INERR ASC 6, INPUT ERROR EOFM ASC 9,EOF..INPUT MORE TITLE OCT 6412 ASC 22,GENERAL-NETWORK-DESCRIPTION-TABLE GENERATOR TERMM ASC 7, NDTGN ABORTED MAX# ASC 13, MAX # OF NODES ALLOWABLE OKMSG ASC 5, END NDTGN /E ASC 1,/E /A ASC 1,/A KMAX ABS NODES CNTR1 NOP CNTR2 NOP CNTR3 NOP PNTR1 NOP PNTR2 NOP PNTR3 NOP BUF1A DEF BUF1+1 BUF2A DEF BUF2mj<:6+1 ISIZE NOP NOP ITYPE DEC 9 IERR NOP ISEC NOP ICR NOP NAME REP 3 NOP IL NOP NRLEN NOP FILFG NOP BUFS EQU 20 INBFS ABS BUFS INBUF BSS BUFS RLU NOP SBCNL NOP TEMP NOP TEMP1 NOP TTYF NOP ERLU NOP D0 DEC 0 D2 DEC 2 D6 DEC 6 D13 DEC 13 D256 DEC 256 N1 DEC -1 N3 DEC -3 N6 DEC -6 N1276 DEC -1276 BM100 OCT -100 B1 OCT 1 B5 OCT 5 B7 OCT 7 B77 OCT 77 B400 OCT 400 SUBMK OCT 37 * PARSB BSS 34 IDCB BSS 144 INDCB BSS 144 BUF1 BSS NODES+1 BUF2 BSS NODES+NODES+1 SPC 3 END NDTGN <  91740-18022 2026 S C0422 &EDITD DS/1000 EDITR              H0104 -LASMB,R,Q,C,Z ** ASSEMBLE DS/1000 VERSION ** HED RTE INTERACTIVE EDITOR * (C) HEWLETT-PACKARD CO. 1979 * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME : EDITR * * SOURCE: 92002-18010 'N' ASSEMBLY OPTION: STANDARD RTE * RELOC : 92002-16010 'N' ASSEMBLY OPTION: STANDARD RTE * * SOURCE: 91740-18022 'Z' ASSEMBLY OPTION: DS/1000 LOCAL & REMOTE USE. * RELOC : 91740-16022 'Z' ASSEMBLY OPTION: DS/1000 LOCAL & REMOTE USE. * * PGMR : TAS,GAA,RMC,EJW,CHW,CCH,GWJ,HLC * IFN NAM EDITR,3,50 92002-16010 REV 2026 800501 XIF IFZ NAM EDITR,19,50 91740-16022 REV 2026 800501 EXT DEXEC,#NODE XIF EXT EXEC,$LIBR,$LIBX,OPEN,CLOSE,READF,WRITF EXT CREAT,PRTN,PNAME EXT LOGLU,REIO,LURQ,NAMR,.MVW,RMPAR IFN DEXEC EQU EXEC XIF SUP PRESS EXTRANEOUS LISTING SPC 1 MAXIN DEC -150 MAXOP DEC 150 MAX DEC 150 "B" OCT 102 "W" OCT 127 "Y" OCT 131 "J" OCT 112 "Z" OCT 132 "P" OCT 120 "R" OCT 122 "S" OCT 123 "T" OCT 124 "^" OCT 136 "#" OCT 43 M16 DEC -16 DCBSZ NOP M91 DEC -91 M10 DEC -10 .2.I DEF 2,I WRITE CODE WITH ERROR-RETURN. .1.I DEF 1,I READ CODE WITH ERROR-RETURN. .10 DEC 10 .12 DEC 12 .23 DEC 23 COMND NOP ALSO TEMP TO STORE NAME TRFLG NOP EXFLG DEC -1 TTYLU NOP LOGICAL UNIT NUMBER OF TELETYPE OCCNT NOP LSTFG NOP "A" OCT 101 "I" OCT 111 "L" OCT 114 PLUSS OCT 53 MINUS OCT 55 SLASH OCT 57 ALTERNATIVE FOR + COMMAND. "E" OCT 105 "D" OCT 104 "H" OCT 110 "M" OCeHT 115 "N" OCT 116 "O" OCT 117 LINES OCT 1 LINE COUNTER LINEM NOP LINE CTR MOST SIG BITS LSLUT NOP CURRENT SOURCE LU/TRACK PBFLG NOP PARTIAL BUFFER FLAG SCT NOP # OF SECTORS PER SORC, DEST BUFR DBUF$ NOP PERMANENT POINTER TO DEST BUFFER SBUF$ NOP PERMANENT POINTER TO SORC BUFFER LWA NOP PERMANENT POINTER TO LWA EDITR ECCNT NOP ALSO MXSEC B600 OCT 600 "F" OCT 106 ERAB? DEC -1 IF NON-ZERO, ABORT EDIT ON ANY ERROR RBUF BSS 5 RMPAR PARAMETER BUFFER SPC 1 EDITR JSB RMPAR GET START-UP PARAMETERS DEF *+2 DEF RBUF LDA RBUF FETCH TTY LU AND B77 CPA RBUF MUST BE LESS THAN 64 RSS JMP EXIT ILLEGAL LU IOR B600 SET ECHO BIT OF TELETYPE LU CPA B600 IF NO LU INA SPECIFIED USE STA TTYLU LU = 1 IFZ IOR BIT11 SET INTERACTIVE READ BIT STA INLU JSB PNAME MOVE PROGRAM NAME TO BUFFER DEF *+2 DEF ENAME+4 XIF JSB PNAME DEF *+2 DEF NAME JSB PNAME LIST DEVICE WAIT MESSAGE DEF *+2 DEF NAME1 JSB PNAME TRACK WAIT MESSAGE DEF *+2 DEF NAME2 * LDA RBUF+1 FETCH MAX RECRD SSA,RSS NEW MAX OUTPUT RECORD SZA,RSS WHICH IS >0 ? JMP RCHK NO, USE DEFAULT MAXOP ADA MAXIN USE THE SMALLER SSA,RSS OF THE NEW CLA LIMIT OR ADA MAXOP THE DEFAULT STA MAXOP LIMIT RCHK EQU * IFZ DLD RBUF+2 GET SCHEDULING & SOURCE NODE NO'S. CPA #NODE OUR NODE NUMBER? JMP SVNOD YES, GO TO SAVE SOURCE NODE NO. CPA M1 MINUS ONE ALSO JMP LOCAL ADDRESSES THIS NODE. CPA B LOCAL DEFAULT-SCHEDULE (P3,P4=0)? JMP LOCAL YES. GO TO SET LOCAL NODEW PARAMETER. * STA NODE NO. SAVE NODE AT WHICH TO SCHEDULE SSA,RSS IF NODE IS POSITIVE, JMP SCHED GO TO SCHEDULE REMOTE ; ELSE, SZB IF NEG.(NEIGHBOR), ARE WE SCHEDULING? JMP SVNOD NO, WE'VE BEEN SCHEDULED. LDA RBUF+4 CHECK SPECIAL CASE: SCHED. FROM NODE #0. CPA .1 WERE WE SCHEDULED FROM NODE #0? JMP SVNOD YES, ACCOMMODATE THE REMOTE REQUEST. * SCHED LDA RBUF+4 GET THE FIFTH SCHEDULING PARAMETER. SZA,RSS OPTIONAL NAME CHARACTERS SUPPLIED? JMP DOSCH NO. GO TO DO THE SCHEDULING. STA TBUFF,I YES. SAVE THE NAME CHARACTERS. ADA M.100 SUBTRACT 100 FOR ASCII CHECK. SSA,RSS ARE THEY ASCII CHARACTERS? JMP CONFG YES, GO CONFIGURE THE NAME. LDA TBUFF,I NO. GET THE NUMERIC VALUE. CLB JSB DEC CONVERT TO ASCII. CONFG LDA TBUFF GET THE ADDRESS OF THE CHARACTERS. RAL FORM A BYTE ADDRESS. LDB NAMBA GET PROGRAM-NAME BYTE ADDRESS. MBT .2 CHANGE NAME TO SUIT USER. * DOSCH LDA TTYLU JSB TYPEQ CHECK FOR INTERACTIVE DEVICE STA ERAB? ABORT ON ERROR IF NON-ZERO * JSB DEXEC DO REMOTE SCHEDULE OF EDITR DEF *+9 DEF NODE DEF .10.I DEF ENAME+4 DEF TTYLU DEF MAXOP DEF NODE DEF #NODE PASS OUR NODE # DEF .1 NON-ZERO: DETECTION OF DESTINATION =0. JMP NOTAV SCHEDULING ERROR--INFORM USER. SZA,RSS IS THE REMOTE EDITR AVAILABLE? JMP EXIT YES NOTAV CCA NO. INFORM THE USER. STA NODE GIVE LOCAL MESSAGE JSB ERROR DEF EXIT DEC 13 ENAME ASC 13,REMOTE EDITR UNAVAILABLE! NAMBA DBR ENAME+5 M.100 DEC -100 .10.I DEF 10,I * LOCAL LDB M1 GET LOCAL NODE DESIGNATION: -1. SVNOD STB NODE ESTABLISH OPERATOR'S NODAL ADDRESS. SZB IF DESTINATION NODE nIS NON-ZERO, JMP INT1 THEN NO FURTHER CHECKING IS NEEDED; LDB RBUF+4 ELSE, GET THE FIFTH SCHEDULING PARAM. SZB,RSS IF P5 =0, THEN JMP LOCAL THIS IS A LOCAL-OPERATION REQUEST. XIF INT1 LDB SECT2 ASSUME LU2 IS SMALLER LDA SECT3 IF #SECTORS ON CMA,INA,SZA,RSS LU 3 = 0 THEN JMP .MXSC USE LU 2 ADA SECT2 IF LU 2 IS SSA,RSS LARGER THAN LU 3 LDB SECT3 USE LU 3 AS THE LIMIT .MXSC BRS CONVERT TO 128 WORD STB MXSEC SECTORS AND SAVE SPC 1 JSB EXEC SET ALL CORE BIT DEF *+3 IN CASE WE ARE IN DEF .22 FOREGROUND DEF .3 SPC 1 LDA XIDT GET ID-SEG ADDRESS ADA .23 STEP TO HIGH MAIN LDA A,I GET 1ST WORD OF AVAIL. MEMORY SKP SPC 1 * SET UP BUFFER AREA TO FILL CORE SPC 1 * **************************************** * * LAST WORD AVAILABLE MEMORY* ^ * * * ^ * * * ^ * * SOURCE BUFFER * ^ SBUFP RANGE * * * ^ * * * ^ * * COMPUTED FIRST WORD* SBUF$ ^ * **************************************** ^ * * * ^ * * >= 75 WORDS FOR PARTIAL RECORD * ^ * * * ^ * **************************************** * * COMPUTED LAST WORD* ^ * * * ^ * * * ^ * * DESTINATION BUFFER * ^ DBUFP RANGE * * * ^ * * * ^ * Y * FIRST WORD AFTER EDITR CODE* DBUF$ ^ * **************************************** * * * * * EDITR CODE * * * * * * * STA DBUF$ STA DBUFP CMA,INA LDB BKLWA ADA AVMEM IF PROGRAM IS IN FOREGROUND, SSA JMP STAD LDB AVMEM SET END OF FOREGROUND ADB M1 AS LAST WORD AVAILABLE STAD ADB M16 DCB HEADER SPACE STB LWA LDA DBUFP CMA,INA FOR BUFFERS ADA LWA ADA M91 2 16-WORD DCB HEADERS + 75 WORDS BETWEEN DCB'S SSA HLT 0 NOT ENOUGH MEMORY CLB ASR 8 DIVIDE BY 256 SZA,RSS HLT 0 NOT ENOUGH MEMORY LDB MXSEC LIMIT BUFFERS CMB,INB ADB A TO MIN(SECT2,SECT3,FREE MEMORY SIZE) SSB,RSS 128 WORD LDA MXSEC SECTORS (DO NOT EXCEED SMALLEST TRACK) STA SCT NUMBER OF INPUT/OUTPUT SECTORS ASL 7 CONVERT SECTORS TO WORDS STA DCBSZ ADA DBUF$ STA DBEND END OF OUTPUT BUFFER POINTER * LDB DCBSZ CMB,INB ADB LWA STB SBUF$ START OF INPUT BUFFER. * LDA TTYLU GET INPUT DEVICE LU. JSB TYPEQ OBTAIN DEVICE'S EQUIPMENT TYPE. STA NOPRN IF #0(NOT INTERACTIVE) SET NO-PRINT FLAG. STA ERAB? ABORT ON ERROR IF NON-INTERACTIVE SZA INTERACTIVE DEVICE ? JMP SRCIN NO. BYPASS MESSAGES. IFZ JSB REMCK IF THIS IS A REMOTE OPERATION, JMP TELND THEN IDENTIFY THE LOCAL NODE NO.; JMP PSF ELSE, SIMPLY ASK FOR THE FILE ID. * TELND LDA #NODE GET THE LOCAL NODE NUMBER. CLB JSB DEC CONVERT THE NODE NO. TO ASCII. LDA TBUFF GET THE ASCII BUFFER ADDRESS. RAL = S;OURCE BYTE ADDRESS. LDB NUMBA = MESSAGE BYTE ADDRESS. MBT OCCNT MOVE NODE NUMBER(ASCII) TO MESSAGE. LDA MINCT GET MINIMUM MESSAGE LENGTH (CHARS.) ADA OCCNT ADD THE NODE NUMBER CHAR. LENGTH, CMA,INA AND CONVERT TO NEG. CHAR. COUNT. STA TELCN SET THE MESSAGE LENGTH FOR 'PRINT'. JSB PRINT PRINT: "EDITING AT NODE XXXXX" DEF PSF TELCN NOP CONFIGURED NEG. MESSAGE LENGTH. TEMSG ASC 11,EDITING AT NODE 0 MINCT DEC 18 NUMBA DBL TEMSG+8 XIF PSF LDA DVTY CHECK FOR DRIVER 07B CPA DVR07 RSS JMP PSFC NO, SKIP NEXT CODE STA DVTYX SAVE CONS. DVR. TYPE. JSB PRINT SET TABS AT COLUMN'S 8 AND 23. DEF PSFC DEC -17 ASC 9,3&a8C1&a22C1 PSFC JSB PRINT PRINT "SOURCE FILE" DEF SRCIN DEC 6 ASC 6,SOURCE FILE? SRCIN JSB TTYIP INPUT RESPONSE CPB .1 ONE WORD RESPONSE? JMP FTST YES, CHECK FOR "0", OR ":". FPARS JSB SC.CR PARSE FILE NAME JMP LSFIL USE LS AREA DLD FSECR SAVE SC AND CR FOR A DST FSECW POSSIBLE ER. JSB INSRC FETCH FILE JMP PSF NOT FOUND TRY AGAIN * LDA FCARW GET USER'S CART. SPECIFICATION. SZA WAS IT SUPPLIED? JMP STEOF YES--NO NEED TO FAKE IT. LDA SBUF$,I NO. GET FIRST WORD OF DCB. AND B77 ISOLATE THE FILE'S LOCATION LU. CMA,INA NEGATE, AND SAVE FOR STA FCARW POSSIBLE USE IN FILE REPLACEMENT. * STEOF CCA SET EOF FLAG STA SLNG IN SOURCE LENGTH JSB ./B1 TRANSFER PARTIAL BUFFER JMP STBUF SET TBUFF. SPC 1 FTST LDA EBUFF,I GET SINGLE INPUT CHARACTER ALF,ALF ISOLATE THE AND LBYTE FIRST-AND 0NLY-INPUT CHARACTER. CPA ":" =":"? JMP ./A1 YES, QUIT NOW CPA B60 ="0"? CLA,RSS &YES, SIMULATE NULL LS JMP FPARS GO PARSE FILE NAME JMP LSNUL SPC 1 LSFIL EQU * IFZ JSB REMCK TALKING REMOTE? CLA,RSS YES,TREAT LS AS UNDEFINED XIF LDA SFCUN SAVE SYSTEM LS POINTER, LSNUL CCB UNLESS LS UNDEFINED. SZA,RSS STB NOLSF STA LSLUT IN SOURCE FILE POINTER AND STA LSTRK SET UP RELEASE TRACK PNTR JSB ALCAT GET LS FILE AND DEST. TRACK CCA IF THE LOGICAL SOURCE AREA CPA NOLSF IS UNDEFINED, THEN JMP STEOF+1 BYPASS SOURCE INPUTS, AT PRESENT. JSB SQ FILL INPUT BUFFER STBUF LDA TBUFP POINT TBUFF TO TBUF0 STA TBUFF FOR ALL OTHER EDIT USES. JMP DISPL PRINT FIRST LINE SPC 1 .22 DEC 22 TBUFP DEF TBUF0 MBUF0 EQU EDITR OVERLAY ONE-TIME CODE. LERR EQU *-EDITR-75 CHECK ENOUGH ONE-TIME CODE FOR * 75 WORDS OF MBUF0. SPC 1 * MBUF0 OVERLAYS CODE AT THE START ('EDITR') WHICH IS * NOT NEEDED ONCE SOURCE FILE INFORMATION IS COMPLETE. * IT IS ONE OF THE DYNAMICALLY ASSIGNED BUFFERS. SEE * COMMENTS FOR EBUF0,ETC. NEAR END OF LISTING. SPC 1 NOLSF OCT 0 SET TO -1 IF LS UNDEFINED. N141 OCT -141 N32 OCT -32 * ********* * READ IN EDIT COMMAND AND ACT ON IT. ********* * NODE1 CLA RESET CHARACTER STA EXFLG EXCHANGE FLAG LDA LUCMD GET THE LAST LU-LOCK COMMAND. SLA IF THE LIST LU WAS LOCKED, JSB LULOK THEN GO TO UNLOCK IT. LDA TTYLU RESET THE STA LSTLU LIST LU IFZ CLB LDA INTFL GET THE INTERACTIVE FLAG. STB INTFL CLEAR THE INTERACTIVE FLAG. SZA,RSS IF FLAG WAS SET, SKIP--COMMAND WAS READ. XIF NODE2 JSB TTYIP INPUT COMMAND JSB ECH JMP ERR JSB LCASE CONVERT LOWER CASE CHAR.--IF REQUIRED. ( STA COMND SAVE TEMPORARILY * CPA "A" JMP ./A LDB ./EFL IF END ENTERED ANY OTHER COMMAND SZB,RSS IS DISALLOWED JMP NOTEN OK ALLOW ANY COMMAND CPA "E" END AGAIN? JMP ./E2 YES GO TRY THE NEW FILE NAME JMP ERR NO ERROR NOTEN LDB B40 RESET TAB FILL STB TBFIL TO SPACE CPA B40 COMMAND? JMP O/PEB NO, OUTPUT LINE CPA "=" JMP ./= CPA %G JMP ./CG MUTE BELL WITH PROMPT. CPA "P" JMP ./P DISPLAY CURRENT LINE CCB STB TRFLG STB LSTFG CPA "C" IF CHARACTER JMP ./C GO DO IT CPA "L" JMP NUMBR CLB STB LSTFG RESET LIST FLAG CPA "K" JMP ./K CPA "#" SEQUENCE NUMBER? JMP ./# CPA "O" JMP ./O CPA "M" MERGE NEW SOURCE? JMP ./M YES GO DO IT CPA SLASH SLASH AND "+" MEAN THE SAME RSS CPA PLUSS JMP NUMBR CPA "E" JMP ./E CPA "N" JMP ./N CPA "H" JMP ./H CPA "S" JMP ./S CPA "T" JMP ./T CPA "U" JMP ./U UNCOND. REPLACE W/O LIST. CPA "V" JMP ./V THIS WITH LIST. CPA "W" SPECIFY A NEW WINDOW? JMP ./W CPA "G" JMP ./Z CPA "X" JMP ./X CPA "Y" JMP ./X CPA "Z" DEFINE XCHANGE PATRN W/O LIST JMP ./Z CPA "^" JMP ./^ STB TRFLG RESET TRANSFER FLAG CPA MINUS JMP NUMBR JSB ASCII COMMAND CHARACTER RSS NUMERIC? JMP FNUM YES, GO TO FIND LINE NUMBER JSB TAB TAB THE COMMAND LINE LDA COMND RESTORE COMMAND CHARACTER CPA "Q" TERMINAL INTRINSIC EDIT? JMP ./Q YES, GO TO PROCESS. CPA "R" JMP ./R CPA D+"I" JMP ./I JSB SWPET LDA COMND CPA "D" JMP COMPR CPA "J" JUMP TO NEW LINE W/O TRANSFER JMP ./J CCB STB TRFLG SET TRANSFER FLAG CPA "F" JMP COMPR CPA "B" COMPLETE TRANSFER AND START SEARCH JMP ./B FROM THE BEGINNING ERR JSB ERROR ERROR DEF NODE1 IN INPUT DEC 1 COMMAND ASC 1,?? PRINT "??" *** %G OCT 7 BELL (CONTROL G) "=" OCT 75 "G" OCT 107 "K" OCT 113 "Q" OCT 121 "U" OCT 125 "V" OCT 126 "X" OCT 000130 B37 OCT 37 B77 OCT 77 DVR12 OCT 5000 LINE PRINTER TYPE CODE. DVR23 OCT 11400 MAG. TAPE TYPE CODE. DVRTY OCT 37400 DRIVER TYPE MASK N.13I OCT 100015 STATUS REQUEST CODE LSTLU OCT 606 LIST LU * NUMBR JSB NUMIN CMA,INA COMPLEMENT NUMBER SZA,RSS AND STORE IN COUNT CCA IF NUMBER IS ZERO SET STA COUNT TO -1 JSB NLSLU SET UP NEW LU IF GIVEN ./CC JSB TR SSB EOF FOUND? JMP EOFPR YES, PRINT "EOF" FNUM2 ISZ COUNT FOUND LINE NUMBER? JMP ./CC NO, FETCH NEXT LINE JMP DISPL YES, DISPLAY IT SPC 1 NLSLU NOP JSB NUMIN GET OPTIONAL NEW LIST LU AND B77 SAVE JUST THE LU LDB 0 SZA,RSS IF NOT SUPPLIED LDA TTYLU USE TTY LU IOR B600 SET ECHO AND V-BITS STA LSTLU SAVE THE LU SZB,RSS SKIP UNLESS NOT SPECIFIED JMP NLSLU,I * JSB TYPEQ GET LIST DEVICE TYPE CODE. SZA,RSS IF IT'S INTERACTIVE, JMP NLSLU,I THEN SIMPLY RETURN; ELSE, CHECK: LDA LSTLU CPA TTYLU MUST NOT BE SAME AS COMMAND INPUT DEVICE JMP ERR JSB LULOK GO TO LOCK THE LIST DEVICE. JMP NLSLU,I RETURN. SPC 1 LULOK NOP LIST LU LOCKING/UNLOCKING ROUTINE. LDA LUCMD GET UTHE CURRENT COMMAND. XOR .1 CONVERT TO OPPOSITE ACTION. STA LUCMD SAVE FOR NEXT PASS. STA IOPT CONFIGURE THE CALL. IFZ JSB REMCK IF THE LIST DEVICE IS REMOTE, JMP LULOK,I THEN LOCKING IS NOT REQUIRED. XIF LOKIT JSB LURQ REQUEST DEF *+4 LOCK OR DEF IOPT UNLOCK DEF LSTLU FOR THE SPECIFIED DEF .1 LIST LOGICAL UNIT. JMP LUERR REPORT THE ERROR. * CPA M1 IF NO RN'S AVAILABLE, NOW, CLA,INA,RSS THEN GO BACK AND WAIT. CPA .1 IF LOCKED BY ANOTHER, THEN JMP WAITL GO BACK TO WAIT FOR IT. JMP LULOK,I LOCK/UNLOCK SUCCESSFUL--RETURN. * WAITL IOR BIT14 INCLUDE NO-ABORT BIT, STA IOPT AND SET COMMAND: WAIT FOR LU/RN. JSB PRINT INFORM DEF LOKIT THE USER DEC 15 THAT WE MUST WAIT. NAME1 ASC 15,EDITR WAITING FOR LIST DEVICE. * LUERR DST LUMSG+7 CONFIGURE ERROR MESSAGE. LDA TTYLU REPORT TO THE CONSOLE, INSTEAD, STA LSTLU DUE TO LIST-DEVICE PROBLEM. JSB ERROR PRINT THE ERROR MESSAGE, DEF LULOK,I AND DO THE REQUESTED LISTING. DEC 9 LUMSG ASC 9,LU LOCK ERROR XXXX LUCMD OCT 140001 NO WAIT/NO ABORT/LOCK IOPT OCT 140000 FIRST TIME: UNLOCKS ANY LU'S. BIT14 OCT 40000 DVTY NOP DVTYX NOP * TYPEQ NOP EQUIPMENT TYPE CODE DETERMINATION. STA LULOK SAVE LOGICAL UNIT, TEMPORARILY. JSB DEXEC GO TO GET I/O STATUS FOR THE DEVICE. DEF TYRTN IFZ DEF NODE XIF DEF N.13I NO-ABORT STATUS REQUEST DEF LULOK FOR THE SPECIFIED LOGICAL UNIT NO. DEF TAB EQT5 RETURNED TO 'TAB'. DEF SWPET EQT4 RETURNED, BUT NOT USED. DEF CHKN SUBCHANNEL RETURNED TO 'CHKN'. TYRTN JMP ERR ** ERROR: ISSUE "??" ** LDA TAB ISOLATE THE DEVICE TYPE CODE AND DVRTY FROM EQUI\PMENT-TABLE WORD #5. STA DVTY SAVE IT SZA,RSS IF IT'S TYPE <00> (INTERACTIVE), JMP TYPEQ,I THEN RETURN IMMEDIATELY: =0. * CPA DVR05 IF IT'S A 264X TERMINAL, THEN JMP TYPE5 GO TO EXAMINE THE LU SUBCHANNEL; CPA DVR07 2645 MP TERMINAL? DVR05 CLA YES, CLEAR "A" JMP TYPEQ,I ELSE RETURN: #0 (NON-INTERACTIVE). * TYPE5 LDA CHKN GET SUBCHANNEL FOR DEVICE. AND B37 ISOLATE SUBCHANNEL BITS(#4-0). STA B SAVE IT TEMPORARILY. SZA,RSS IF THE SUBCHANNEL IS ZERO, THEN RETURN JMP TYPEQ,I WITH SIMULATED TYPE <00> CODE IN . LDA DVR23 PREPARE TO SIMULATE MAG. TAPE TYPE<23>. CPB .4 IF THE SUBCHANNEL IS FOUR, THEN LDA DVR12 SIMULATE TYPE <12> LINEPRINTER. JMP TYPEQ,I RETURN--DEVICE TYPE: <12>,LP OR <23>,MT. SPC 1 COMPR JSB TR TRANSFER PENDING LINE COMP1 JSB ECH MATCH FIELD SUPPLIED? JMP EOFTS NO USE OLD ONE COMP2 LDA EBUFF YES SWAP EBUFF LDB MBUFF AND MBUFF STA MBUFF SET UP THE STB EBUFF NEW MATCH FIELD LDA ELNG SET THE NEW MATCH LENGTH STA MLNG FOR MBUFF EOFTS LDA SLNG IF AT SSA END OF FILE JMP EOFPR PRINT "EOF" JMP COMP4 START SEARCH COMP3 JSB TR SSB EOF FOUND? JMP EOFPR YES, PRINT "EOF" COMP4 CLA CLEAR STA WINDF WINDOW FLAG STA MCCNT STA JDEF$ ZERO THE INDEFINITE STA IDEF$ FLAGS. CMPR1 JSB MCH JMP DISPL CPA INDEF INDEFINITE CHARACTER? JMP CMPR2 YES - GO SET UP. CPA DLMTR WINDOW SPECIFIED JMP CMPR5 ON SEARCH CMPR7 STA NUM1 NO - SAVE THE CHARACTER CMPR6 LDA WIND2 PAST ADA SCCNT WINDOW AND LDB WINDF WINDOW SLB FLAG SSA SET? RSS NO -- YCONTINUE SCAN JMP COMP3 YES -- PATTERN NOT FOUND SPC 1 JSB SCH GET SOURCE CHARACTER. JMP EOL END OF INPUT CPA NUM1 COMPARE WITH PATTERN JMP CMPR3 COMPARES SO JUMP TO INDEF TEST LDB IDEF$ INB,SZB,RSS IF FIRST CHARACTER SEARCH JMP CMPR6 TRY THE NEXT CHARACTER. ISZ JDEF$ END OF INDEF MATCH? JMP COMP3 NO - SO NO MATCH. SPC 1 LDA SCCN$ RESET SOURCE POINTER STA SCCNT AND LDA MCCN$ PATTERN STA MCCNT LOCATION THEN LDB WINDF RESET THE WINDOW FLAG BRS IF TWO SET TO 1 ELSE 0. RSS SKIP THE CLEAR. SPC 1 CMPR2 CLB CLEAR CMPR8 STB WINDF WINDOW FLAG LDA MCCNT SET UP FOR INDEFINITE STA MCCN$ CHARACTER DVR07 CCA SAVE THE PATTERN LOCATION AND STA IDEF$ SET THE FIRST CHAR. FLAG STA JDEF$ AND THE INDEF FLAG JMP CMPR1 GO GET THE FIRST PATTERN CHARACTER. SPC 1 CMPR3 ISZ IDEF$ FIRST CHAR FOUND AFTER INDEF CHAR? JMP CMPR1 NO CONTINUE LDB WINDF GET WINDOW FLAG AND CPB .1 IF ONE SET TO ISZ WINDF SET TO TWO LDA SCCNT YES - SET STA SCCN$ CURRENT SOURCE POSITION. JMP CMPR1 CONTINUE MATCH SPC 1 CMPR5 CLB,INB IS WINDOW CHARACTER CPB MCCNT THE FIRST CHAR. OF COMMAND? RSS YES -- CONTINUE JMP CMPR7 NO, IGNORE LDA WIND1 START SEARCH AT STA SCCNT BEGINNING OF WINDOW CMA,INA IF WINDOW ADA SLNG STARTS BEYOND SSA END OF LINE JMP COMP3 DO NOT SEARCH JMP CMPR8 CONTINUE SEARCH WITH INDEF. 1ST SPC 1 * EOL CCA ADA MLNG IF THE ONLY CHARACTER IN THE MATCH FIELD IOR NUM1 IS ZERO (CNTR-@) IOR SLNG AND THE CURRENT LINE IS LENGTH ZERO, PNLH SZA,RSS JMP DISPL THEN DISPLAY IT. JMP COMP3 ELSE, NOT FOUND * * FNUM CLA RESET COMMAND STA ECCNT CHARACTER POINTER JSB NUMIN COMPUTE LINE NUMBER CMA,INA,SZA,RSS COMPLEMENT AND IF ZERO CCA SET TO -1 STA COUNT AND SAVE STA TRFLG SET TRANSFER FLAG JSB NLSLU SET UP NEW LU IF GIVEN LDA COUNT LOAD -(LINE NUMBER DESIRED) ADA LINES ADD CURRENT POSITION SSA,RSS IF POSITIVE JMP FNUM3 GO TO BEGINNING OF FILE STA COUNT ELSE USE DIFFERENCE AS LOOP CNTR JMP ./CC GO FIND LINE SPC 1 FNUM3 JSB ./B1 COMPLETE TRANSFER JMP FNUM2 SPACE FORWARD TO DESIRED LINE SPC 1 ./# LDA M3 SKIP OVER STA COUNT ALPHA COMMENT. ./#0 JSB ECH NOP ISZ COUNT JMP ./#0 JSB NUMIN FETCH START NUMBER N STA BASE AND SAVE AS BASE JSB NUMIN FETCH 2ND NUMBER SZA,RSS IF ZERO SET LDA .10 TO 10 AND STA INCR SAVE AS INCREMENT JSB ./B1 GO TO BEGINNING OF FILE SPC 1 ./#1 CLA RESET CHARACTER OUTPUT STA OCCNT COUNTER LDA M72 MOVE STA COUNT FIRST 72 ./#2 JSB SCH CHARACTERS JMP SPC OF SOURCE JSB OUTCR TO OUTPUT ISZ COUNT BUFFER JMP ./#2 JMP ./#3 SPC 1 SPC LDA B40 BLANK JSB OUTCR FILL TO ISZ COUNT COLUMN 72 JMP SPC ./#3 CLA,INA SET UP COMMAND STA ECCNT BUFFER COUNTER LDA M3 SET UP LOOP STA COUNT COUNTER FOR 3 CHARACTERS ./#4 JSB ECH FETCH NEXT ALPHA COMMENT LDA B40 LOAD BLANKS IF NO COMMENT JSB OUTCR OUTPUT CHARACTER ISZ COUNT THIRD CHARACTER? JMP ./#4 NO, FETCH NEXT CHARACTER SPC 1 LDA BASE OUTPUT LINE NUMBER CLB JSB DEC IN ASCII LDA BASE UPDATE ADA INCR LINE STA BASE NUMBER LDA OCCNT OUTPUT CHARACTER LDB TBUFF TO DISC BUFFER JSB DOUTP JSB I/PSB INPUT NEXT RECORD SSB AT EOF? JMP EOFPR YES, PRINT "EOF" JMP ./#1 NO, CONTINUE SPC 1 ./= JSB NUMIN GET REQUESTED LENGTH SZA,RSS JMP ERR ADA MAXIN IF LONGER THAN ALLOWABLE SSA,RSS MAX, USE ALLOWABLE MAX CLA AND CONTINUE. ADA MAX STA MAXOP JMP NODE1 SPC 2 TBFIL OCT 40 WINDF NOP M72 DEC -72 MLNG NOP MCCNT NOP MBUFF DEF MBUF0 CHANGES POINTS TO CURRENT MATCH BUFFER JDEF$ NOP INDEFINITE PROCESSING FLAG * ALSO USED FOR IDEF$ NOP FIRST CHAR AFTER INDEF FLAG * ALSO USED FOR INDEF OCT 33 INDEFINITE CHAR. IS ESCAPE. INDE2 OCT 176 ALTERNATE ESCAPE CHAR. MCCN$ NOP INPUT PATTERN LOCATION FOR INDEF SEARCH * * TAB PERFORMS THE TAB OPERATION TAB NOP CLA RESET OUTPUT STA OCCNT CHARACTER COUNTER AND STA CNTRL NON-CONTROL CHARACTER COUNTER LDA TABUF RESET STA TBPNT TAB POINTER TAB1 JSB ECH GET NEXT COMMAND CHARACTER JMP TAB,I END OF COMMAND CPA TABCR TAB CHARACTER ? JMP TBFND YES, GO TO TAB FOUND CPA INDE2 ALTERNATE ESCAPE? LDA INDEF YES REPLACE WITH STD. ASCII. LDB A IS CHARACTER CMB CONTROL ADB B40 CHARACTER SSB IF YES DO NOT INCREMENT ISZ CNTRL NON-CONTROL CHARACTER COUNTER JSB OUTCR NO, OUTPUT CHARACTER JMP TAB1 TBFND CCB SET SPACE COUNTER STB CNT1 TO -1 LDB TBPNT,I TAB POINTER SZB,RSS ZERO? JMP SPACE YES, OUTPUT SPACE ISZ TBPNT BUMP TAB POINTER ADDRESS ADB CNTRL PAST SSB,RSS TAB? JMP TBFND+2 YES, GET NEXT TAB STB CNT1 STORE SPACE COUNTER SPACE LDA TBFIL LOAD SPACE JSB OUTCR OUTPUT SPACE ISZ CNTRL BUMP NON-CONTROL CHAR. CNTR. ISZ CNT1 LAST SPACE? JMP SPACE NO, CONTINUE SPACING JMP TAB1 GET NEXT CHARACTER * * SWPET SWAPS EBUFF AND TBUFF SWPET NOP USED AS TEMP LDA TBUFF SWAP LDB EBUFF EBUFF STA EBUFF AND STB TBUFF TBUFF LDA OCCNT STORE OUTPUT CHARACTER STA ELNG LENGTH IN COMMAND LENGTH CLB RESET COMMAND STB ECCNT AND OUTPUT STB OCCNT CHARACTER POINTERS JMP SWPET,I SPC 1 ./W JSB CHKN CHECK PARAMETERS JSB NUMIN FETCH SZA START OF ADA FM1 WINDOW STA WIND1 POINTER JSB NUMIN FETCH CMA,INA,SZA,RSS END OF LDA MAXIN WINDOW STA WIND2 POINTER JMP NODE1 GET NEXT COMMAND SPC 1 WIND1 NOP WIND2 DEC -150 SPC 1 CHKN NOP NPARA JSB NUMIN FETCH NEXT PARAM LDA ELNG IF END OF COMMAND CPA ECCNT THEN, ALL PARAMETERS CLA,INA,RSS WERE NUMERIC JMP NPARA ELSE, FETCH NEXT PARAM STA ECCNT RESET COUNT AND RETURN JMP CHKN,I * ./T JSB ECH STEP PAST TAB CHAR. JMP ./T1 NONE, SO DISABLE TAB JSB CHKN OTHERWISE CHECK PARAMETERS JSB ECH GET TAB CHARACTER ./T1 CCA SET TAB CHARATER TO -1 TO DISABLE STA TABCR STORE TAB CHARACTER LDA TABUF RESET TAB ADDRESS STA TBPNT POINTER LDA M10 SET COUNTER STA CNT1 TO -10 LDA ECCNT IF ONLY TAB CHARACTER CPA ELNG GIVEN, THEN RETURN JMP NODE1 WITH TABS UNCHANGED NXTNM JSB NUMIN GET NEXT NUMBER CMA,INA,SZA FIRST NUMBER ZERO? INA NO, INCREMENT IT STA TBPNT,I STORE TAB NUMBER ISZ TBPNT BUMP POINTER ISZ CNT1 LAST TAB? JMP NXTNM NO, CONTINUE JMP NODE1 YES, GET NEXT COMMAND TABUF DEF TAB0 TABCR OCT 73 DEFAULT TAB CHARACTER = ";" TBPNT NOP B54 OCT 54 "," * * TR TRANSFERS CURRENT SOURCE LINE TO DEST. AND GETS NEXT LINE TR NOP LDB SLNG IF AT SSB EOF, JMP TR,I RETURN LDB XIDT CHECK FOR A BREAK ADB .20 REQUEST BY EXAMINING BIT 12 LDA B,I OF ID SEGMENT WORD 21. AND BIT12 IF BREAK REQUEST IS PRESENT, SZA STOP WHAT IS GOING ON. JMP BREAK LDB TRFLG TRANSFER RECORD TO SZB DESTINATION FILE? JSB O/PSB YES, OUTPUT RECORD LDB LSTFlG LIST CURRENT SZB RECORD? JSB LSTSB YES, PERFORM LIST JSB I/PSB GET NEXT RECORD JMP TR,I SPC 1 .20 DEC 20 BIT12 OCT 10000 SPC 1 BREAK JSB $LIBR NOP LDA B,I GET ID SEGMENT WORD 21 AGAIN XOR BIT12 ZERO ONLY BIT 12 STA B,I JSB $LIBX RESTORE INTERRUPT NOW THAT ID DEF *+1 WORD IS SAFE. DEF DISPL DISPLAY PENDING LINE. SPC 1 ./^ JSB NUMIN GET LINES TO SUBTRACT. LDB T#REM CHECK # DEST REC >65K SZB AND IGNORE COMMAND JMP ERR IF SO. LDB T#REC CURRENT DESTINATION LINE CMB,SSB,RSS IF > 32K,IGNORE JMP ERR COMMAND. SZA,RSS NULL _ 1 INA ADA B SSA,RSS IF OFF THE TOP END, JMP ERR IGNORE COMMAND. STA COUNT JMP FNUM3 GO TO NEW LINE. SPC 1 NUMIN NOP ISZ ECCNT * JSB NAMR PARSE THE INPUT DEF *+5 DEF BUF10 PARSE BUFFER DEF EBUFF,I COMMAND STRING DEF ELNG COMMAND LENGTH DEF ECCNT CURRENT POSITION CCB ADB ECCNT STB ECCNT RESET CURRENT POSITION LDA BUF10 LDB BUF10+3 DATA TYPE SSA,RSS RBR,SLB JMP ERR NEGATIVE OR ASCII NOT ALLOWED JMP NUMIN,I * BUF10 BSS 10 * SKP SPC 1 ASCII NOP STA COMND SAVE CHARACTER ADA M58 GREATER THAN SSA,RSS "9" ? JMP ASCII,I YES, RETURN ADA .10 LESS THAN SSA,RSS "0" ? ISZ ASCII NO, BUMP RETURN ADDRESS JMP ASCII,I SPC 1 NXCHR NOP FCR1 JSB ECH FETCH NEXT COMMAND CHAR. JMP NXCHR,I NO MORE CHARS.? RETURN CPA B40 IGNORE ALL JMP FCR1 SPACES CPA B54 IF EITHER A JMP NXCHR,I COMMA OR CPA ":" A COLON IS JMP NXCHR,I v FOUND, RETURN ISZ NXCHR BUMP RETURN ADDRESS JMP NXCHR,I SPC 1 ":" OCT 72 COUNT NOP MATCH NOP ALSO NUM1 NOP ALSO NUM10 NOP ALSO UNCON NOP * * * CXT NOP THIS ROUTINE DOES ALL THE CLA MATCHING IN THE SOURCE BUFFER STA OCCNT AND REPLACEMENT IN THE STA XCCNT DESTINATION BUFFER FOR STA YCCNT EXCHANGE OPERATIONS. STA SCCNT LDB UNCON SZB JMP CXTUC STA BWIND RESET WINDOW BIAS STA MATCH AND MATCH FLAG. LDA WIND1 START SEARCH AT CXT1 STA SCCNT BEGINNING OF WINDOW CMA,INA IF BEYOND ADA SLNG END OF SSA RECORD JMP CXT,I RETURN CP1 JSB SCH FETCH NEXT SOURCE CHAR. JMP CXT,I END OF SOURCE, RETURN CPA FCHAR EQUAL TO 1ST CHAR. OF PATTERN? RSS JMP CP1 NO, GO LOOK AT NEXT CHAR. LDA SCCNT YES, SAVE PRESENT STA SCCN$ SOURCE POSITION ADA BWIND BEYOND ADA WIND2 UPPER BOUND CMA,SSA,INA,SZA OF WINDOW? JMP CXT,I YES, PATTERN NOT FOUND CLA,INA STA XCCNT START XCH WITH 2ND CHAR. SPC 1 CPNXT JSB XCH FETCH NEXT PATTERN CHAR. JMP XFND END OF PATTERN - MATCH!!! STA T1 SAVE PATTERN CHAR. JSB SCH FETCH NEXT SOURCE CHAR. JMP CXT,I END OF SOURCE, NO MATCH CPA T1 CHARACTER MATCH? JMP CPNXT YES, CONTINUE COMPARE LDA SCCN$ NO, BACK UP AND JMP CXT1 CONTINUE SEARCH SPC 1 XFND LDA XLIST SET LIST STA MATCH FLAG LDA SCCNT SAVE CURRENT STA T1 POSITION IN SOURCE CLA RESET STA SCCNT SOURCE CHARACTER COUNTER STA OCCNT OUTPUT CHARACTER COUNTER STA YCCNT REPLACE CHARACTER COUNTER k SPC 1 LDA SCCN$ MOVE CMA,INA CHARACTERS INA,SZA,RSS PRECEEDING JMP RPC2 STA T2 MATCH RPC1 JSB SCH CHARACTERS HLT 77B IN JSB OUTCR SOURCE ISZ T2 LINE JMP RPC1 TO OUTPUT SPC 1 RPC2 JSB YCH MOVE JMP RPC3 REPLACEMENT CHARACTERS JSB OUTCR TO OUTPUT JMP RPC2 SPC 1 RPC3 LDA OCCNT SAVE POSITION STA T2 FOR CONTINUATION OF SEARCH SPC 1 LDA T1 RESET SOURCE CHAR. POINTER STA SCCNT TO REMAINDER OF SOURCE RECORD CPA SLNG IF AT END OF JMP ENDCX RECORD, SEARCH FINISHED RPC4 JSB SCH MOVE REMAINDER JMP ENDRP OF SOURCE LINE JSB OUTCR TO OUTPUT JMP RPC4 SPC 1 ENDRP JSB ./R$ REPLACE OLD SOURCE LINE LDA YLNG COMPUTE CMA,INA BIAS FOR ADA XLNG UPPER BOUND ADA BWIND OF WINDOW STA BWIND LDA T2 RESTORE POSITION AND JMP CXT1 CONTINUE SEARCH SPC 1 ENDCX JSB ./R$ REPLACE LINE JMP CXT,I AND RETURN SPC 1 * CODE FOR UNCONDITIONAL REPLACE. SPC 1 CXTUC LDA XLIST TO LIST OR NOT STA MATCH TO LIST? LDA WIND1 CMA,INA,SZA,RSS JMP CXTU2 STA ASCII CXTU1 JSB SCH MOVE SOURCE CHARACTERS LDA B40 PRECEEDING WINDOW JSB OUTCR TO OUTPUT. ISZ ASCII JMP CXTU1 CXTU2 JSB XCH PASS OVER DUMMY SEARCH JMP CXTU3 PATTERN. JSB SCH NOP JMP CXTU2 SPC 1 CXTU3 JSB YCH MOVE REPLACEMENT CHARACTERS JMP CXTU4 TO OUTPUT. JSB OUTCR JMP CXTU3 SPC 1 CXTU4 JSB SCH MOVE REMAINDER OF RECORD JMP ENDCX TO OUTPUT JSB OUTCR JMP CXTU4 SPC 1 SCCN$ NOP BWIND NOP FCc(HAR NOP XCCNT NOP YCCNT NOP XLNG NOP YLNG NOP YOFFS NOP * * "XCH" FETCHES NEXT CHARACTER FROM SEARCH PATTERN XCH NOP LDA XCCNT CPA XLNG JMP XCH,I ISZ XCCNT ISZ XCH INA WATCH OUT FOR THIS ONE CLE,ERA ADA XYBUF LDA A,I SEZ,RSS ALF,ALF AND LBYTE JMP XCH,I * * "YCH" FETCHES NEXT CHARACTER FROM REPLACEMENT PATTERN YCH NOP LDA YCCNT CPA YLNG JMP YCH,I ISZ YCCNT ISZ YCH ADA YOFFS CLE,ERA ADA XYBUF LDA A,I SEZ,RSS ALF,ALF AND LBYTE JMP YCH,I * * "OUTCR" OUTPUTS ONE CHARACTER TO TBUFF OUTCR NOP LDB OCCNT CPB MAXOP JMP OUTCR,I CLE,ERB ADB TBUFF SEZ,RSS ALF,SLA,ALF XOR B,I XOR B40 STA B,I ISZ OCCNT JMP OUTCR,I * DLMTR OCT 57 DEFAULT DELIMITER IS "/" .6400 OCT 6400 * DLMST STA DLMTR IOR .6400 SET UP PROMPT STA / CHARACTER JMP NODE1 * * ./U CLA ./V CCB,RSS ./Z CLA IF "Z" RESET LIST FLAG ./X STA XLIST IF "X" OR "Y" SET FLAG STB UNCON JSB ECH FETCH 1ST PATTERN CHARACTER JMP XSET1 NO MORE CHARACTERS SO SET EXFLG LDB ECCNT LAST CHARACTER CPB ELNG IN COMMAND? JMP DLMST YES, GO CHANGE DELIMITER CLB STB XLNG INITIALIZE PATTERN LENGTH CNTR CPA DLMTR IF NULL PATTERN CHARACTER JMP ERX CHECK FOR ERROR STA FCHAR SAVE 1ST CHAR. IN PATTERN XSET2 JSB ECH FETCH NEXT CHARACTER JMP ERR NO DELIMITERS FOUND, SO ERROR ISZ XLNG INCREMENT PATTERN LENGTH CPA DLMTR DELIMITER? CLA,RSS JMP XSET2 NO, CONTINUE TO SEARCH XSET4 LDA XLNG STORE POSITION ADA .2 OF REPLACEMENT STA YOFFS PATTERN CMA,INA COMPUTE AND ADA ELNG STORE REPLACEMENT STA YLNG PATTERN LENGTH LDA EBUFF SWAP LDB XYBUF EBUFF STB EBUFF AND STA XYBUF XYBUF XSET1 CLA,INA SET EXCHANGE FLAG STA EXFLG LDB COMND LOAD COMMAND CHARACTER CPB "G" PENDING LINE EXCHANGE? JMP ./G YES - GO DO IT CPB "Y" IF "Y" COMMAND RSS PERFORM SEARCH JMP NODE2 ELSE, FETCH NEXT COMMAND JSB TR MOVE PENDING LINE SPC 1 * PRECEDE "X" PATTERN BY INDEFINITE CHARACTER AND USE AS "F" * PATTERN CLA RESET STA XCCNT XCH AND STA OCCNT OUTCR CHARACTER COUNTERS STA EXFLG AND EXCHANGE FLAG LDA DLMTR MAKE INDEFINITE CHAR. 1ST IN PATTERN XSET3 JSB OUTCR OUTPUT CHARACTER JSB XCH FETCH NEXT PATTERN CHARACTER RSS NO MORE CHARACTERS JMP XSET3 GO TO ADD CHAR. TO PATTERN JSB SWPET SWAP OUTPUT BUFF WITH COMND BUFF JMP COMP2 GO TO SEARCH ROUTINE SPC 1 ERX LDB UNCON NULL PATTERN IS OK FOR A U SZB,RSS OR V OPERATION. JMP ERR BUT AN INPUT ERROR FOR X,Y,Z. JMP XSET4 * ./G JSB CXT PERFORM EXCHANGE JMP DISPL THEN DISPLAY LINE XYBUF DEF XYBF0 CHANGES. POINTS TO CURRENT EXCHANGE * BUFFER. TBUFF DEF NBUF0 CHANGES POINTS TO CURRENT CONSOLE * OUTPUT BUFFER. XLIST NOP * SKP O/PSB NOP LDA EXFLG PATTERN REPLACEMENT SZA,RSS FLAG SET? JMP OPSB2 NO, MOVE CURRENT SOURCE LINE JSB CXT YES, PERFORM REPLACEMENT LDA MATCH LIST PATTERN SZA,RSS MATCH? JMP OPSB1 NO LDA LSTFG THIS PREVENTS DOUBLE LIST SZA,RSS WHEN PATTERN MATCH OCCURS JSB LSTSB LIST NEW LINE OPSB1 LDA SL NG IF RECORD HAS BEEN REDUCED SZA,RSS TO ZERO LENGTH, DON'T JMP O/PSB,I OUTPUT TO DEST. OPSB2 LDA SLNG GET CURRENT # OF CHARS. LDB SBUFP AND LOCATION OF SOURCE LINE JSB DOUTP CALL OUTPUT ROUTINE JMP O/PSB,I * * O/PEB LDA SLNG IF NOT AT SSA,RSS EOF THEN JSB O/PSB OUTPUT CURRENT LINE JSB TAB TAB COMMAND LINE ./R JSB ./R$ PERFORM REPLACEMENT ISZ COMND IF P COMMAND SKIP JMP NODE1 GET NEXT COMMAND ISZ CFLG IF C COMMAND SKIP JMP DISPL GO DISPLAY THE NEW LINE CCA SET LIST COUNT TO STA COUNT ONE LINE. JMP ./CC GO FINISH THE C COMMAND * * ./R$ REPLACES CURRENT LINE ON INPUT BUFFER WITH LINE IN COMMAND BUFFER ./R$ NOP LDA SLNG IF AT EOF SSA INSERT NEW LINE BEFORE LDA M2 EOF AND MAKE IT PENDING SLA,ARS COMPUTE ADDRESS INA OF NEXT ADA SBUFP SOURCE RECORD LDB OCCNT REPLACE CURRENT RECORD LENGTH STB SLNG WITH COMMAND RECORD LENGTH CMB,INB CONVERT # CHARS TO BRS MINUS # OF WORDS STB CNT1 STORE COMPLEMENT IN COUNTER ADA B ADD -(# OF WORDS) TO NEXT RECORD ADRS STA SBUFP TO GET NEW SOURCE FILE POINTER SZB,RSS ZERO LENGTH RECORD? JMP ./R$,I RETURN STA P1 LDB TBUFF STARTING ADDRESS OF COMMAND RECORD CTOS LDA B,I MOVE STA P1,I COMMAND INB RECORD ISZ P1 TO ISZ CNT1 SOURCE JMP CTOS FILE JMP ./R$,I SPC 1 ./I LDA OCCNT LOAD RECORD LENGTH LDB TBUFF LOAD RECORD LOCATION JSB DOUTP OUTPUT RECORD JMP NODE1 * * * ./Q ALLOWS USE OF 264X TERMINAL EDIT INTRINSICS TO REPLACE PENDING * LINE. * ./Q LDA DVTYX TEST FORg DRIVER TYPE 07B CPA DVR07 RSS YES, GO ON JMP ERR NO, ERROR JSB LSTSB LIST THE PENDING LINE LDA SLNG CHECK FOR LINE>77 CH. CMA,INA ADA .77 SSA JMP ./Q1 YES, MOVE CURSOR UP TWO LINES JSB PRINT POSITION CURSOR DEF ./Q2 AND SET LEFT DEC -9 DELIMITER FOR INTRINSIC EDITING. OCT 015520 < P > OCT 015501 < A > OCT 020033 < > OCT 057435 <137> OCT 057400 <137> * ./Q1 JSB PRINT SAME AS ABOVE BUT UP TWO DEF ./Q2 DEC -11 OCT 015520 < P > OCT 015501 < A > OCT 015501 < A > OCT 020033 < > OCT 057435 <137> OCT 057400 <137> * ./Q2 LDA NOPRN SAVE NON-PRINTING FLAG STA SCH TEMORARALY CCA SET CONDITIONS FOR INPUT ONLY, STA NOPRN OF THE MODIFIED LINE. STA COMND SET FOR DISPLAY OF THE MODIFIED LINE. JSB TTYIP REQUEST INPUT SZB,RSS JMP ZER ZERO LTH. READ JSB TAB LDA SCH RESTORE NON-PRINTING FLAG. STA NOPRN JSB PRINT MAKE SURE INSERT IS OFF. DEF ./Q3 DEC -3 ASC 2,R_ ./Q3 JMP ./R COMPLETE THE REPLACEMENT OPERATION. ZER CLA RESET COMMAND STA COMND LDA SCH RESTORE NON-PRINTING FLAG STA NOPRN JMP NODE1 * .77 DEC 77 * * * * SCH FETCHES NEXT SOURCE CHARACTER * SCH NOP ENTER WITH CHARACTER COUNT LDA SCCNT SCCNT AND SOURCE BUFFER START CPA SLNG ADDRESS IN SBUFP. JMP SCH,I ISZ SCCNT IF AT END OF SOURCE RECORD, ISZ SCH EXIT TO P+1. CLE,ERA ADA SBUFP IF NOT AT END OF SOURCE RECORD, LDA A,I EXIT TO P+2 WITH ASCII OF NEXT SEZ,RSS CHARACTER IN LOW BB@. STA MCH SAVE, TEMPORARILY. ADA N141 CHECK FOR LOWER-CASE ASCII. SSA JMP LCXIT NO. NOT LOWER-CASE. ADA N32 SSA,RSS JMP LCXIT NO. RETURN. LDA B40 YES. CONVERT TO XOR MCH UPPER-CASE ALPHA ASCII, JMP LCASE,I AND RETURN WITH =CHARACTER. LCXIT LDA MCH RETRIEVE THE ORIGINAL CHARACTER, JMP LCASE,I AND RETURN. * * / OCT 6457,3537 "CR / BELL _" SPC 1 ./CG EQU * IFZ JSB REMCK IF COMMUNICATING REMOTELY, THEN JMP NODE1 PROMPT CHANGE IS INAPPROPRIATE. XIF LDA /+1 ALF,ALF STA /+1 REVERSE ORDER OF _ AND BELL. CLA,INA XOR LN SHORTEN OR LENGTHEN STA LN MESSAGE LENGTH. JMP NODE1 TB SKP TTYIP NOP IFZ JSB REMCK TALKING REMOTELY? JMP DOCOM YES! XIF LDA NOPRN IF INPUT IS SZA NON-INTERACTIVE, THEN JMP TTYIN IGNORE THE PROMPT. JSB EXEC PRINT DEF *+5 PROMPT DEF .2.I CHARACTER DEF TTYLU DEF / DEF LN ALTERNATE -4 & -3. JMP EXIT SPC 1 TTYIN JSB REIO INPUT DEF *+5 COMMAND DEF .1.I FROM DEF TTYLU TELETYPE EBUFF DEF EBUF0 CHANGES, POINTS TO CURRENT COMMAND DEF MAXIN JMP EXIT ILLEGAL DEVICE, QUIT * EBRET STB ELNG CLA RESET STA ECCNT ALL STA SCCNT CHARACTER STA OCCNT COUNTERS JMP TTYIP,I IFZ DOCOM CLA PREPARE FOR NON-INTERACTIVE INPUT. CPA NOPRN IF DEVICE IS INTERACTIVE, THEN LDA LN GET THE PROMPT LENGTH. STA PRMTL INITIALIZE PROMPT LENGTH. SZA CHECK FOR A ZERO LTH. JMP INWR NO, GO ON LDA INLU YES, REMOVE INTERACTIVE BIT XOR BIT11 STA INLU INWR JSB DEXEC DO INTERACTIVE REMOTE READ DEF *+8 DEF NODE DEF RCODE DEF INLU DEF EBUFF,I DEF MAXIN DEF / OPT.PARAMS=PROMPT CHARS DEF PRMTL AND PROMPT LENGTH. JMP ./A0 ABORTIVE COMM. ERROR LDA INLU MAKE SURE INTERATIVE BIT IS SET IOR BIT11 STA INLU JMP EBRET * * RETURN+1 IF CRT IS REMOTE, RETURN+2 IF NOT REMCK NOP LDB NODE CPB M1 ISZ REMCK JMP REMCK,I XIF CFLG NOP ALSO SBUFP NOP POINT TO CURRENT LOC IN SORC BUFFER SLNG NOP LENGTH OF SOURCE RECORD (EVEN) ELNG NOP LBYTE OCT 377 LOWER BYTE MASK LN OCT -4 ALTERN. WITH -3 AFTER CONTROL G. NOPRN NOP SUPPRESS PRINTING IF #0. SCCNkT NOP .10K DEC 10000 .1000 DEC 1000 .100 DEC 100 IFZ PRMTL NOP INTERACTIVE PROMPT LENGTH. RPRMT OCT 6412,27537 REMOTE PROMPT: "CR LF / _" BIT11 OCT 4000 INLU NOP NODE NOP INTFL NOP INTERACTIVE WRITE-READ FLAG. WRLEN NOP WRITE LENGTH (-CHARS) FOR WRITE-READ. TEMPZ EQU REMCK TEMPORARY. SVTMP NOP TEMPORARY STORAGE FOR NOP OVERLAYED WORDS. * * INTERACTIVE REMOTE WRITE-READ ROUTINE: DISPLAY LINE & READ COMMAND. * INTER NOP STA BUFAD CONFIGURE WRITE-BUFFER ADDRESS IN CALL. STB WRLEN SAVE NEG. CHAR. COUNT, TEMPORARILY. BRS COMPUTE BUFFER LENGTH CMB,INB IN WORDS. ADA B FORM ADDRESS OF NEXT WORD, STA TEMPZ IMMEDIATELY FOLLOWING WRITE BUFFER. DLD TEMPZ,I GET NEXT TWO WORDS-AFTER BUFFER- DST SVTMP AND SAVE, TEMPORARILY. DLD RPRMT OVERLAY TWO WORDS FOLLOWING WRITE BUFFER DST TEMPZ,I WITH THE COMMAND-INPUT PROMPT CHARS. LDB WRLEN GET THE ORIGINAL NEG. CHARACTER COUNT. SLB IF THE COUNT WAS ODD, ADB M1 ADD ONE FOR THE WORD BOUNDRY. ADB LN ADD THE LENGTH OF PROMPT (-CHARS), STB WRLEN AND CONFIGURE CALL WITH TOTAL LENGTH. * JSB DEXEC CALL REMOTE 'EXEC' ROUTINE. DEF ERABT ERROR-RETURN ADDRESS. DEF NODE DESTINATION NODE. DEF RCODE READ REQUEST--NO ABORT. DEF INLU REMOTE TTY LU W/INTERACTIVE BIT(#11). DEF EBUFF,I INPUT BUFFER ADDRESS. DEF MAXIN MAXIMUM NO. OF INPUT CHARACTERS. BUFAD DEF * CONFIGURED WRITE BUFFER ADDRESS. DEF WRLEN CONFIGURED WRITE BUFFER LENGTH. ERABT JMP ./A0 ** COMMUNICATION ERROR: ABORT!! * STB ELNG SAVE READ LENGTH (+CHARS). DLD SVTMP RESTORE THE DST TEMPZ,I OVERLAYED BUFFER CHARACTERS. CLA RESET STA ECCNT ALL STA SCCNT  CHARACTER STA OCCNT COUNTERS. LDB ELNG RESTORE = TRANSMISSION LOG. JMP INTER,I RETURN. XIF SKP ./N JSB ECH ANY OTHER CHARACTER? JMP NP NO. PRINT SOURCE LINE. JSB LCASE CONVERT LOWER CASE CHAR.--IF NECESSARY. CPA "D" IF N IS FOLLOWED BY D, RSS PRINT DESTINATION LINE. JMP ERR ELSE ASK AGAIN. DLD T#REC JMP CVX NP DLD LINES FETCH CURRENT LINE NUMBER CVX JSB DEC CONVERT NUMBER TO ASCII IFZ JSB REMCK IF COMMUNICATING REMOTELY, ISZ INTFL SET THE INTERACTIVE FLAG. XIF LDB OCCNT CALL LDA TBUFF PRINT JSB LST ROUTINE JMP NODE1 PROCESS THE NEXT COMMAND SPC 1 ./H JSB ECH JMP HP JSB LCASE CPA "L" RSS JMP ERR JSB PRINT DEF NODE1 DEC 41 ASC 21, ''''/''''1''''/''''2''''/''''3''''/''''4 ASC 20,''''/''''5''''/''''6''''/''''7''''/''''8 HP LDA SLNG CLB JMP CVX SPC 1 ./S CLB LDA T#SEC COMPUTE NUMBER OF WORDS ASL 7 ALREADY STORED ON DISC, STA DEC SAVE, THEN COMPUTE LDA DBUF$ # OF WORDS IN DEST CMA,INA BUFFER. ADA DBUFP CLE ADA DEC ADD BACK LSB'S OF MPY SEZ AND BUMP B IF E SET. INB JMP CVX SPC 1 DEC NOP CLE,SZB,RSS >65K? JMP SNGLP DIV .10K WORK ON EXCESS FIRST STB I/PSB SAVE REMAINDER FOR NEXT PASS. CLB JSB DEC4 LDA I/PSB CCE SKIP DIV .10K THIS TIME SNGLP JSB DEC4 JMP DEC,I SPC 1 DEC4 NOP SEZ IF NUMBER >65K, SKIP JMP THOU FIRST DIVIDE, PASS 2. DIV .10K OUTPUT TEN THOUSANDS JSB CONVT DIGIT THOU DIV .1000 OUTPUT THOUSANDS JSB COiNVT DIGIT DIV .100 OUTPUT HUNDREDS JSB CONVT DIGIT DIV .10 OUTPUT TENS JSB CONVT DIGIT AND JSB CONVT ONES DIGIT JMP DEC4,I SPC 1 CONVT NOP STB NT SAVE REMAINDER SZA IF JMP CONV1 LEADING CPA OCCNT ZERO JMP CONV2 DO NOT OUTPUT IT CONV1 IOR B60 CONVERT NUMBER TO ASCII JSB OUTCR MOVE CHARACTER TO BUFFER CONV2 CLB SET REGISTERS UP LDA NT FOR NEXT DIVIDE JMP CONVT,I * * I/PSB FETCHES NEXT RECORD FROM SOURCE BUFFER * RETURNS WITH AN EOF FLAG, I.E. B=-1 EOF FOUND, B=0 NO EOF I/PSB NOP JSB DINP CLB STB NOLSF RESET LS FLAG. LDB SLNG LOAD RECORD LENGTH SSB IF LENGTH < 0, RETURN WITH JMP I/PSB,I EOF FLAG SET IN REGISTER CLB CLEAR EOF FLAG STB SCCNT RESET SOURCE CHARACTER CNTR JMP I/PSB,I * DISPL CLB RESET STB EXFLG EXCHANGE FLAG LDA TTYLU AND THE STA LSTLU LIST LU IFZ JSB REMCK IF COMMUNICATING REMOTELY, ISZ INTFL SET THE INTERACTIVE FLAG. XIF JSB LSTSB LIST CURRENT LINE JMP NODE1 PROCESS THE NEXT COMMAND. SPC 1 ./O LDA SLNG SSA JMP ERR END OF FILE JSB O/PSB OUTPUT PENDING LINE, THEN LDA DVTYX IF DRIVER TYPE IS 07B GO TO "Q". CPA DVR07 COMMAND. JMP ./Q RSS OTHERWISE USE THE P COMMAND. SPC 2 ./C STB CFLG SET THE "C"FLAG TO -1. * ./P LDA DLMTR USE DLMTR FOR TAB STA TBFIL JSB TAB TAB THE LINE LDA SLNG IF AT EOF SSA PRINT EOF AND GET JMP ERR NEXT COMMAND. JSB SWPET SET UP INPUT BUFFER CCA SET LIST FLAG STA COMND FOR ./R MODE STB PMODE INITIAL MODE IS REPL~ACE PNXT JSB ECH GET A CHARACTER JMP PFIN IF EOL THEN EXIT CLB SET B FOR MODE CHECK CPA %R CONTROL R? JMP MODE YES GO RESET MODE INB INSERT MODE? CPA %I JMP MODE YES GO RESET CPA %S ALTERNATE COMMAND JMP MODE INB SET FOR DELETE MODE CPA %C DELETE MODE? JMP MODE YES GO RESET CPA %T TRUNCATE LINE MODE? JMP ./R YES GO WRAP UP LDB PMODE GET THE CURRENT MODE CPB ZERO IF REPLACE JMP PRPL GO REPLACE CPB .1 IF INSERT JMP PINS GO INSERT CPB .2 IF DELETE JMP PDLS GO DELETE SPC 2 PRPL CPA DLMTR IS IT REALLY COPY JMP PCOPY YES GO COPY JSB OUTCR OUTPUT THE NEW CHARACTER SPC 1 PDLS JSB SCH GET THE OLD CHARACTER NOP IGNOR EOL JMP PNXT BURN THE OLD AND GO GET THE NEXT SPC 1 PCOPY JSB SCH GET THE CURRENT CHARACTER LDA B40 USE BLANK IF UNDEFINED JMP PINS2 SPC 1 PINS CPA DLMTR INSERT SPACES FOR LDA B40 DELIMITER PINS2 JSB OUTCR SEND IT OUT JMP PNXT GO PROCESS THE NEXT CHAR. SPC 1 PFIN JSB SCH MOVE THE REST JMP ./R OF THE LINE JSB OUTCR TO THE OUTPUT JMP PFIN BUFFER SPC 1 %R OCT 22 CONTROL R %I OCT 11 CONTROL I %C OCT 3 CONTROL C %S OCT 23 CONTROL S %T OCT 24 CONTROL T PMODE NOP * * SPSP ASC 1, MSPSP DEF SPSP * LST NOP STA CONVT SAVE TEMPORARILY. CLA PREPARE FOR NON-INTERACTIVE DEVICE. CPA NOPRN IF DEVICE IS INTERACTIVE, JMP LST0 THEN PROCEED TO LIST THE LINE. IFZ STA INTFL CLEAR COMMAND-READ INDICATOR. XIF JMP LST,I NON-INTERACTIVE: RETURN IMFMEDIATELY. * LST0 LDA CONVT RETRIEVE . CMB,INB,SZB COMPLEMENT CHARACTER COUNT JMP LST1 CONTINUE IF NOT ZERO LDA MSPSP OTHERWISE OUTPUT SPACES LDB M2 LST1 ADB M2 ADD TWO TO THE CHAR. COUNT STB LSTB2 AND SET IT CCB SUBTRACT ONE ADB A FROM THE BUFFER ADDRESS STB LSTB1 AND SET IT LDA B,I GET THE CURRENT CHAR. STA LSTB3 SAVE IT LDA SPSP NOW SET STA B,I THE FIRST CHARS. TO BLANKS IFZ LDA INTFL IF THE INTERACTIVE SZA FLAG IS SET, JMP LSINT GO SET UP FOR WRITE-READ. XIF SPC 1 JSB DEXEC ***************** DEF LSRTN IFZ DEF NODE XIF DEF .2.I LIST DEF LSTLU RECORD LSTB1 NOP DEF LSTB2 LSRTN JMP ERR LIST ABORT RETURN, GIVE "??" IFZ JMP LSTEX BYPASS WRITE-READ SET UP. SPC 1 LSINT LDA LSTB1 GET BUFFER ADDRESS. LDB LSTB2 GET BUFFER CHARACTER COUNT. JSB INTER WRITE BUFFER & READ COMMAND. XIF LSTEX LDA LSTB3 RESTORE THE STA LSTB1,I OLD WORD. JMP LST,I SPC 1 LSTB2 NOP LSTB3 NOP SPC 1 LSTSB NOP USED AS TEMP LDA SBUFP FETCH RECORD LENGTH LDB SLNG AND LOCATION SSB IF AT EOF JMP EOFPR GO PRINT "EOF" JSB LST PERFORM LIST JMP LSTSB,I * STRK# NOP SOURCE TRACK # SRCLU NOP SOURCE DISK LU NWTRK NOP RETURN OF TRACK FROM DISC ALLOC REQ. DTRK# NOP DESTINATION TRACK # NEWLU NOP RETURN OF LU FROM DISK ALLOC REQ. DSTLU NOP DESTINATION LU DSEC# NOP DESTINATION SECTOR # SSEC# NOP SOURCE SECTOR # .4 OCT 4 RCODE OCT 100001 * * RQST REQUESTS A TRACK FROM SYSTEM RQST NOP LDA RCODE ONE TRACK REQUEST STA RQST!C CODE WITH UNAVAIL. RETURN SPC 1 RQ.TR JSB EXEC ********************************* DEF *+6 DEF .4 REQUEST DEF RQSTC TRACK DEF NWTRK FROM DEF NEWLU SYSTEM DEF DSCTR ************************************ SPC 1 LDA DSCTR RAR CONVERT TO 128 WORD SECTORS STA DSCTR LDA NWTRK WAS THE REQUEST SSA,RSS HONORED? ISZ #TCNT YES, ADD 1 TO OUTSTANDING TRACK COUNT. SSA,RSS WAS A TRACK ALLOCATED? JMP RQST,I YES - RETURN CLA,INA NO - PRINT MESSAGE STA RQSTC AND REQUEST JSB PRINT TRACK WITH DEF RQ.TR SUSPENSION IF DEC 12 UNAVAILABLE. NAME2 ASC 12,EDITR WAITING FOR TRACKS * #TCNT NOP CURRENT # TRACKS OBTAINED FROM SYSTEM. * SETSO NOP SET UP THE SOURCE ROUTINE LDA LSLUT LOAD LS LU AND TRACK LDB .2 ASSUME LU 2 CLE,ELA SHIFT LU FLAG INTO E ALF,ALF MOVE TRACK TO LOWER BYTE STA STRK# STORE SOURCE TRACK # CLA,SEZ LU = 3 ? INB YES, INCREMENT LU STB SRCLU STORE SOURCE LU # STA #TRAK ZERO THE TRACK-RELEASE COUNT. STA SSEC# RESET SOURCE SECTOR NUMBER CCA INITIALIZE THE STA SNTRF NEW-TRACK FLAG =-1 JMP SETSO,I RETURN SPC 1 * ALCAT SETS SOURCE TRACK AND LU AND REQUESTS A DESTINATION * TRACK FROM SYSTEM. * ALCAT NOP JSB SETSO SET UP THE SOURCE JSB RQST REQUEST TRACK FROM SYSTEM LDA NWTRK STORE NEW STA DTRK# TRACK NUMBER LDB NEWLU STORE STB DSTLU NEW LU ALF,CLE,ALF MOVE TRACK # TO UPPER BYTE SLB LU = 3 ? CCE YES, SET E BIT ERA SHIFT E INTO DESTINATION FILE STA DSTRT LU AND TRACK WORD "t CLA RESET STA DSEC# DEST. SECTOR POINTER AND STA T#SEC TOTAL # OF DEST. SECTORS AND STA T#REC TOTAL # OF DEST. RECORDS JMP ALCAT,I * P1 NOP P2 NOP DSTRT NOP * EOFND STB SLNG JMP DINP,I * DINP NOP LDA SLNG FETCH RECORD LENGTH SSA,INA AT EOF? JMP DINP,I YES, RETURN ISZ LINES BUMP SOURCE LINE COUNTER JMP *+2 ALLOWING HUGE NUMBER ISZ LINEM (DOUBLE WORD). ARS COMPUTE ADDRESS ADA SBUFP OF NEXT RECORD CPA SBEND IF AT END OF BUFFER JMP DINP3 GO TO INPUT FROM DISC LDB A,I LOAD RECORD LENGTH OF NEXT RECORD INA STORE ADDRESS OF NEXT STA SBUFP RECORD IN INPUT BUFFER SSB IF RECORD LENGTH < 0, JMP EOFND THEN GO TO EOF FOUND BLF,BLF CONVERT BLR TO # OF STB SLNG CHARACTERS AND SAVE ADB MAXIN IF RECORD GREATER CMB,SSB,INB,SZB THAN MAX. LENGTH JMP $$$ER GIVE CORRUPT FILE ERROR LDB SLNG FETCH RECORD BRS LENGTH IN WORDS ADB A IF RECORD IS CMB,INB CONTAINED IN ADB SBEND INPUT BUFFER SSB,RSS THEN JMP DINP,I RETURN LDB SLNG FETCH RECORD LENGTH BRS IN WORDS CMB,INB COMPLEMENT FOR LOOP COUNTER STA P1 SET UP ADA MWDC1 POINTERS STA P2 FOR STA SBUFP RECORD MOVE LDA P1 GET SOURCE BEGIN ADDR CMA,INA NEGATE WITH REC SIZE ADA B TO COMPUTE NUMBER INA OF WORDS WHICH ARE ADA LWA PAST LWA SSA,RSS JMP DINP0 NONE, SO (B) IS SIZE CMA,INA ADB A NEG WDS PAST, SUBTR FROM (B) DINP0 SZB,RSS JMP DINP2 GO READ DISC IF 0 TO MOVE SPC 1 U DINP1 LDA P1,I MOVE STA P2,I RECORD ISZ P1 RESIDUE ISZ P2 IN FRONT OF INB,SZB INPUT BUFFER JMP DINP1 DINP2 JSB MIN READ BUFFER FROM DISC JMP DINP,I DINP3 JSB SQ JMP DINP,I * SQ NOP JSB MIN FILL INPUT BUFFER FROM DISC LDA SBUF$,I FETCH RECORD LENGTH LDB SBUF$ COMPUTE START OF INB RECORD ADDRESS STB SBUFP AND SAVE ALF,ALF CONVERT RECORD LENGTH SSA,RSS ALS WORD TO NUMBER STA SLNG OF CHARACTERS AND SAVE SSA,RSS IF EOF SKIP ADA MAXIN IF RECORD LENGTH GREATER CMA,SSA,INA,SZA THAN MAX ALLOWED JMP $$$ER GIVE CORRUPT FILE ERROR JMP SQ,I * DSCTR NOP DESTINATION SECTORS PER TRACK DNTRF NOP DEST. FILE NEW TRACK FLAG SNTRF NOP SOURCE FILE NEW TRACK FLAG .5 OCT 5 SEC# NOP WDCNT NOP * * * MIN MOVES SOURCE FILE INTO CORE MIN NOP LDA SNTRF READ FROM NEW SSA SOURCE TRACK? ISZ #TRAK YES, BUMP RELEASE TRACK COUNT CLA RESET STA SNTRF NEW TRACK FLAG LDA SSEC# GET NEXT SECTOR POINTER ADA SCT ADD BUFFER SECTOR SIZE RAL CONVERT TO 64 WORD SECTORS CMA LDB SRCLU GET READ LU STB SVSLU SAVE SOURCE LU FOR MERGES. SLB,RSS IF LU = 2 ADA SECT2 USE #SEC FOR LU2 SLB ELSE LU 3 ADA SECT3 WOULD READ CROSS SSA,RSS TRACK BOUNDARY? JMP RDISC NO, GO TO READ RAR CONVERT BACK TO 128 WORD SECTORS CCB SET STB SNTRF NEW TRACK FLAG ADA SCT READ TO END OF CURRENT INA,RSS TRACK, SKIP NEXT INSTRUCTION SPC 1 RDISC LDA SCT LOAD NUMBER OF SECTORS ASL 7 CONVERT SECTORS TO WORDS STA WDYCNT STA SVSWC SAVE THE WORD COUNT CMA,INA STORE STA MWDC1 -(WORD COUNT) LDA STRK# STA SVSTR SAVE SOURCE TRACK FOR MERGES. LDA SSEC# RAL CONVERT TO 64 WORD SECTORS STA SVSSC AND SAVE SPC 1 JSB EXEC ************************** DEF *+7 DEF .1 READ DEF SRCLU THE DEF SBUF$,I DISC DEF WDCNT DEF STRK# DEF SVSSC *************************** SPC 1 LDA WDCNT STORE END ADA SBUF$ OF DATA ADDRESS STA SBEND IN SBEND LDA SNTRF SSA NEW TRACK? JMP NTRAK YES, GO TO NEW TRACK PROCESSING LDA SSEC# MOVE ADA SCT SOURCE SECTOR STA SSEC# POINTER JMP MIN,I NTRAK CLA RESET SOURCE STA SSEC# SECTOR POINTER CPA RELS IF RELEASE FLAG IS ZERO JSB RELSR RELEASE SOURCE TRACK CCA MOVE BUFFER END POINTER ADA SBEND SO CODE WORD IS NOT STA SBEND INCLUDED IN SOURCE ISZ MWDC1 INCREMENT -(WORD COUNT) LDA SBEND,I GET CODE WORD AND LBYTE (LAST WORD ON TRACK) STA STRK# AND SET TRACK XOR SBEND,I AND LU POINTERS ALF,ALF TO NEXT TRACK STA SRCLU IN SOURCE JMP MIN,I * * RELSR RELEASES SOURCE TRACK RELSR NOP LDB SRCLU LDA TAT GET TRACK ASSIGNMENT TABLE ADRS CPB .3 LU = 3? ADA TATSD YES, ADD SYSTEM TRACKS TO ADRS ADA STRK# ADD TRACK TO BE RELEASED LDA A,I DOES THIS CPA XIDT "EDITR" RSS OWN TRACK JMP RELSR,I NO, RETURN JSB EXEC YES, RELEASE TRACK DEF *+5 DEF .5 DEF .1 DEF STRK# DEF SRCLU * LDA #TCNT GET OUTSTANDING TRACK COUNT. SZA IF NON-ZERO,  ADA M1 SUBTRACT THE ONE JUST RELEASED, STA #TCNT AND UPDATE THE COUNT. JMP RELSR,I RETURN. * .3 OCT 3 SVSSC NOP SVSLU NOP SVSWC NOP SVSTR NOP SKP DOUTP NOP CMA TRUNCATE STA ODDF (ALWAYS -VE) ADA MAXOP OUTPUT CMA,SSA,RSS LENGTH CLA TO MAXOP. ADA MAXOP CPA MAXOP IF RECORD LENGTH=MAXOP JMP ODD? TEST FOR ODD # CHARACTERS. DOUP1 STB P1 SAVE BUFFER ADDRESS SLA,ARS CONVERT # CHARS. TO # WORDS INA ADD ONE WHEN ODD ISZ T#REC BUMP NUMBER OF RECORDS CNTR. JMP *+2 ALLOWING HUGE NUMBER ISZ T#REM (DOUBLE INTEGER) ALF,ALF MOVE WORD COUNT TO STA DBUFP,I UPPER BYTE AND STORE ALF,ALF COMPUTE LOOP CMA,INA,SZA,RSS COUNTER FOR MOVE. IF = 0 JMP DOUP5 GO TO END BUFR. TEST STA CNT1 ELSE SAVE IT. DOUP2 ISZ DBUFP BUMP DEST. BUFFER POINTER LDB DBUFP CPB DBEND END OF BUFFER? JSB DOUT YES, OUTPUT IT LDA P1,I MOVE NEXT WORD STA DBUFP,I TO OUTPUT BUFFER ISZ P1 BUMP SOURCE ADDRESS ISZ CNT1 LAST WORD IN RECORD? JMP DOUP2 NO, CONTINUE MOVE LDA ODDF IF RECORD LENGTH NOT ODD, SZA JMP DOUP5 GO AWAY NORMALLY. LDA DBUFP,I BUT WITH RECORD LENGTH ODD, AND HBYTE REPLACE THE EVEN CHARACTER IOR TBFIL BEYOND DESIRED LENGTH WITH STA DBUFP,I A BLANK. DOUP5 ISZ DBUFP BUMP DEST. BUFR PNTR. LDB DBUFP CPB DBEND IF AT END OF DEST. BUFFER JSB DOUT OUTPUT BUFFER TO DISC, JMP DOUTP,I ELSE RETURN SPC 1 ODD? SLA,RSS JMP DOUP1 EVEN. NO FIXUP NEEDED. CLA STA ODDF SET TO SHOW ODD. LDA MAXOP RESTORE FOR MORE PROCESSING. JMP DOUP1 SPC 1 HBYTHFBE OCT 177400 MASK FOR HIGH BYTE. ODDF OCT -1 0 MEANS ODD, -VE MEANS EVEN. QH SKP * DOUT WRITES THE DESTINATION BUFFER ON A SYSTEM-ASSIGNED TRACK. * WHEN THE TRACK WILL BE FILLED BY A WRITE, DOUT REQUESTS A * NEW TRACK, MERGES THE RETURNED LU AND TRACK, AND STORES THE * RESULTING CODE WORD INTO THE LAST WORD OF THE CURRENT TRACK. * THE REST OF THE DESTINATION BUFFER (IF ANY) IS THEN WRITTEN * ON THE NEW DESTINATION TRACK. SPC 2 DOUT NOP CLA RESET NEW STA DNTRF DEST. TRACK FLAG LDA SCT LOAD OF SECTRS TO BE WRITTEN LDB PBFLG PARTIAL BUFFER TO SZB BE WRITTEN? LDA B YES, A_# OF SECTORS PBTRB STA SEC# STORE NUMBER OF SECTORS OF WRITE ADA DSEC# TRACK CMA BOUNDARY ADA DSCTR CROSSED? SSA,RSS JMP WDISK NO, PERFORM WRITE STA DNTRF SET NEW TRACK FLAG ADA SEC# INA,RSS WDISK LDA SEC# LDB T#SEC ADD NUMBER ADB A OF SECTORS TO STB T#SEC TOTAL NUMBER OF SECTORS ASL 7 CONVERT SECTORS TO WORDS STA WDCNT LDA DNTRF SSA,RSS NEW TRACK? JMP ECALL NO, GO TO EXEC CALL JSB RQST REQUEST NEW TRACK FROM SYSTEM CCB GET ADDRESS ADB DBUF$ OF LAST WORD ADB WDCNT ON TRACK LDA B,I SAVE DISPLACED WORD STA TEMP IN TEMP LDA NEWLU SET UP ALF,ALF AND IOR NWTRK STORE STA B,I CODE WORD INB STORE ADDRESS OF STB RESDU BUFFER RESIDUE SPC 1 ECALL LDA DSEC# RAL CONVERT TO 64 WORD SECTORS STA T3 JSB EXEC **************************** DEF *+7 DEF .2 WRITE DESTINATION DEF DSTLU FILE BUFFER DEF DBUF$,I ON DISC DEF WDCNT DEF DTRK# DEF T3 ************************ SPC 1 LDB DBUF$ RESET DESTINATION STB DBUFP BUFFER POINTER LDA DNTRF SSA NEW TRACK? JMP NTRK LDA DSEC# COMPUTE ADA SEC# NEXT SECTOR STA DSEC# POINTER JMP DOUT,I SPC 1 NTRK LDB NEWLU STORE STB DSTLU NEW LU LDB NWTRK STORE NEW STB DTRK# TRACK NUMBER CLA RESET NEXT STA DSEC# SECTOR POINTER LDB TEMP MOVE WORD DISPLACED BY CODE STB DBUFP,I WORD TO START OF BUFFER ISZ DBUFP LDA DNTRF CMA,SZA,RSS JMP PBCHK BUFR ENDED ON TRK BOUDARY, CHECK PBFLG ASL 7 CMA,INA MVR LDB RESDU,I MOVE RESIDUE TO START OF BUFFER STB DBUFP,I ISZ RESDU ISZ DBUFP INA,SZA JMP MVR PBCHK LDA PBFLG SZA,RSS PARTIAL BUFFER? JMP DOUT,I NO,RETURN LDA DNTRF YES, OUTPUT BUFFER RESIDUE CMA,SZA,RSS COMPL. TO GET SECTR RESID., IF 0 INA INCREMENT FOR WRITE OF CODE WORD CLB STB DNTRF RESET NEW TRACK FLAG JMP PBTRB * T3 NOP RESDU NOP MWDC1 NOP DBUFP NOP POINT TO CURRENT LOC IN DEST BUFFER CNT1 NOP ALSO , T#REC NOP CURRENT # OF REC IN DEST FILE T#REM NOP MOST SIG BITS FOR >65K T#SEC NOP CURRENT # OF SCTRS IN DEST FILE B60 OCT 60 TEMP NOP #TRAK NOP TRACK-RELEASE COUNT. RELS DEC -1 ./EFL NOP PASS1 DEC -1 FIRST PASS FLAG LSTRK NOP LS#TR NOP SKP ./K JSB ./B1 RESET TO START OF FILE. ./K0 LDA SLNG RECORD LENGTH, CHARS. LDB MAXOP REQUESTED FIELD WIDTH. CMB,INB ADB A IF > OR = SPECIFIED MAX., SSB,RSS LDA MAXOP SET TO REQUEST MAX. SSA IF EOF, PRINT EOF JMP EOFPR AND GET NEXT COMMAND. SLA DON'T THROW AWAY ODD CHARACTER, INA BUMP COUNT TO EVEN. ARS ./K1 ADA M1 SZA,RSS JMP ./K2 PROCESS THIS RECORD. LDB SBUFP ADB A POINT TO NEXT CHAR. PAIR LDB B,I CPB SPSP IF THEY ARE BOTH BLANKS, JMP ./K1 CONTINUE TO SHORTEN RECORD. ./K2 INA CORRECT TO NEW # OF WORDS. ALS CONVERT TO CHARACTER COUNT. LDB SBUFP JSB DOUTP SEND RECORD TO DEST. FILE JSB DINP GET NEXT RECORD. JMP ./K0 * ./M JSB SC.CR GET THE FILE NAME JMP ERR ERROR IF NO FILE NAME JSB TR SEND THE PENDING LINE JSB INSRC FETCH THE FILE NOP IGNOR NOT FOUND ERROR SPC 1 JSB EXEC NOW GET DEF *+7 THE OLD SOURCE DEF .1 BACK IN DEF SVSLU CORE DEF SBUF$,I DEF SVSWC DEF SVSTR DEF SVSSC SPC 1 JMP DISPL * SPC 1 ./J LDA SLNG IF NOT SSA,RSS AT EOF JSB O/PSB OUTPUT PENDING LINE CLA RESET THE EXCHANGE STA EXFLG FLAG AND CLA,INA THE CURRENT STA LINES LINE NUMBER JSB SETSO SET UP THE INPUT JSB SQ READ THE FIRST BLOCK JMP COMP1 START SEARCH SPC 1 * ./B RESETS SOURCE POINTER TO BEGINNING OF FILE BY * COMPLETION OF TRANSFER OF SOURCE FILE TO DESTINATION * FILE THEN DEFINING THE DEST. FILE AS THE SOURCE FILE * ./B JSB ./B1 PERFORM TRANSFER JMP COMP1 START SEARCH SPC 1 ./B1 NOP JSB ./B$ COMPLETE TRANSFER. CLA STA EXFLG RESET EXCHANGE FLAG STA PBFLG RESET PARTIAL BUFFER FLAG CLA,INA STA LINES RESET LINE COUNTER JSB ALCAT GET NEW SOUCE AND DEST. FILE JSB SQ READ IN FIRST BLOCK JMP ./B1,I FILL INPUT BUFFER * *./B$ COMPLETES TRANSFER OF SOURCE TO DESTINATION. ./B$ NOP JSB TR TRANSFER SOURCE SS3bB,RSS TO DESTINATION JMP *-2 FILE CCA PUT END OF STA DBUFP,I FILE RECORD IN ISZ DBUFP OUTPUT BUFFER LDA DBUF$ DETERMINE CMA,INA SIZE ADA DBUFP OF BUFFER CLB CONVERT SIZE ASR 7 TO SECTORS INA ROUNDING UP FOR ANY FRACTION STA PBFLG STORE IN PARTIAL BUFR FLAG JSB DOUT OUTPUT BUFFER TO DISC LDA #TRAK GET THE # OF TRACKS LDB LSLUT AND FIRST SOURCE TRACK ISZ PASS1 FIRST PASS AT SOURCE? JMP ./B2 NO - GO RELEASE TRACKS STA LS#TR YES - SAVE TRACK COUNT RSS BUT SKIP RELEASE ./B2 JSB RELTR RELEASE OLD SOURCE TRACKS LDA DSTRT SET SOURCE FILE POINTER TO STA LSLUT START OF DEST. FILE JMP ./B$,I SPC 1 RELTR NOP CMA,INA FORM A NEGATIVE TRACK COUNT STA TEMP AND SAVE STB LSLUT STORE START TRACK CLA RELEASE THE TRACKS CPB SFCUN CCA UNLESS 'LS' TRACKS STA RELS JSB SETSO SET UP TO READ THE SOURCE TRK2 LDA SRCLU GET THE LU LDB SECT2 GET SECTOR COUNT FOR LU 2 SLA IF LU 3 LDB SECT3 USE LU 3 COUNT RBR CONVERT TO 128 WORD SECTORS ADB M1 SUBTRACT ONE SECTOR STB SSEC# SET DISC ADDRESS FOR MIN READT JSB MIN GO READ TRACK AND RELEASE IT LDA SNTRF GET THE NEW TRACK FLAG. SSA,RSS WAS A TRACK RELEASED? JMP READT NO. CONTINUE READING. ISZ TEMP DONE? JMP TRK2 NO - DO NEXT ONE CCA YES - CLEAR THE FLAG STA RELS SO NO MORE ARE RELEASED. JMP RELTR,I *EOFPR PRINTS "EOF THEN RETURNS FOR NEXT COMMAND * EOFPR CLA PREPARE FOR NON-INTERACTIVE DEVICE. CPA NOPRN IF IT'S INTERACTIVE, JMP EOFPN PROCEED TO PRINT THE MESS 5AGE. IFZ STA INTFL CLEAR REMOTE COMMAND READ INDICATOR. XIF JMP NODE1 GO TO READ THE NEXT COMMAND. EOFPN EQU * IFZ JSB REMCK IF COMMUNICATING REMOTELY, JMP REMEO PERFORM WRITE-READ. XIF JSB PRINT DEF NODE1 EOFLN DEC -4 EOFMS ASC 4,EOF IFZ EOFAD DEF EOFMS * REMEO LDA EOFAD GET BUFFER ADDRESS. LDB EOFLN GET MESSAGE LENGTH. ISZ INTFL SET THE INTERACTIVE FLAG. JSB INTER WRITE EOF MESSAGE/READ NEXT COMMAND. JMP NODE1 GO TO PROCESS THE COMMAND. XIF SPC 1 * ./A TERMINATES EXECUTION LEAVING ORIGINAL LS AREA UNTOUCHED * ./A JSB ECH IF ANY CHARACTERS RSS FOLLOWING THE "A" JMP ERR GIVE AN ERROR INSTEAD OF ABORT ./A0 CLA STA LSTFG PREVENT LISTING. STA TRFLG 'DELETE' REMAINDER OF SOURCE LDA NOPRN GET INTERACTIVE FLAG. STA TYPEQ SAVE, TEMPORARILY. CCA STA NOPRN PREVENT REPETITIOUS ERROR MESSAGES. JSB ./B$ COMPLETE TRANSFER TO DESTINATION. LDA #TCNT GET NO. OF DEST. TRACKS, LDB LSLUT AND FIRST TRACK SPEC. SZA ANY DESTINATION TRACKS? JSB RELTR YES, GO TO RELEASE DEST. TRACKS. LDA TYPEQ RESET THE INTERACTIVE FLAG STA NOPRN FOR THE FINAL MESSAGE. ./A1 JSB PRINT DEF EXIT DEC 7 NAME ASC 7,EDITR ABORTED * * ./E COMPLETES TRANSFER OF SOURCE TO DESTINATION THEN * TERMINATES IF THERE IS NO INPUT ERROR. SPC 1 ./E STA ./EFL SHOW WE'VE BEEN HERE. JSB ./B$ COMPLETE XFER OF SOURCE TO DEST. ./E2 JSB ECH JMP ERR JSB LCASE CONVERT LOWER CASE CHAR.--IF NECESSARY. STA SAVL FOR RETURN TO SCHEDULER. CPA "L" SET SYSTEM LS POINTER? RSS JMP ./E3 IFZ JSB REMCK REMOTE CRT? JMP ERR YES, CAN'T ACCESS LS XIF }v SPC 1 JSB $LIBR ******************************* NOP TURN OFF MEMORY PROTECT AND LDA LSLUT SET SYSTEM LS AREA POINTER STA SFCUN TO FINAL FILE ADDRESS JSB $LIBX THEN TURN MEMORY PROTECT DEF *+1 BACK ON DEF LSTLS ****************************** SPC 1 DLU. DEF LU. DTRK. DEF TRK. DLSB DEF LSBUF DTBF0 DEF TBUF0 PERMANENT SAVE. LSLU NOP RETURN TO SCHEDULER LTRAK NOP RETURN TO SCHEDULER LSBUF ASC 4,LS FILE X, LU. ASC 1,2, TRK. ASC 2,XXX SPC 1 LSTLS LDA TBUFF STA DTBF0 LDA DLU. STA TBUFF LDB SFCUN LDA .2 SSB INA STA LSLU CLB JSB DEC CONVERT LU TO ASCII CLA STA OCCNT RESET CHAR COUNTER LDA DTRK. POINT TO TRACK ASCII STA TBUFF LDA SFCUN GET LS TRACK CLE,ELA SHUNT OUT LU ALF,ALF STA LTRAK B ALREADY CLEAR FROM ABOVE JSB DEC LDB OCCNT ACTUAL # OF DIGITS. ADB .10 INCREASE BY PREL CHARS LDA DLSB POINT TO MESSAGE, JSB LST AND SEND IT OUT. LDA DTBF0 RESTORE PRIMARY OUTPUT STA TBUFF POINTER AND RESET CLA CHARACTER COUNTER. STA OCCNT SPC 1 JSB ECH FETCH C OR R JMP ENDMS NONE, GO TO END MESSAGE JSB LCASE CONVERT LOWER CASE CHAR. IF NECESSARY. ./E3 STA ./EFL SAVE COMMAND MODE JSB SC.CR PARSE FILE NAME JMP CHEKR /R IS VALID TO REPLACE SOURCE. LDA ./EFL FETCH COMMAND MODE CPA "C" IF C JMP CRFIL GO TO CREATE FILE CPA "R" IF R JMP RPFIL GO TO REPLACE FILE JMP ERR OTHERWISE GO TO ERROR SPC 1 CHEKR LDA ./EFL GET COMND CPA "R" IF IT'S R, PICK UP TURN-ON RSS FILE NAME:SC:CR. JMP ERR NOT R - ERROR. LDA NBUFF LDB TBUFF JSB .MVW COPY THE ORIGINAL NAME DEF .3 NOP DLD FSECW PICK UP TURN-ON SC DST FSECR AND CR. JMP RPFIL TRY TO REPLACE. SPC 1 NBUFF DEF NBUF0 SPC 1 CRFIL DLD T#REC COMPUTE FILE SIZE NEEDED ASR 7 IN 128 WORD BLOCKS ADA T#SEC FSIZE = INA ( T#REC/128 + T#SEC ) + 1 STA FSIZE SPC 1 JSB CREAT CREATE OUTPUT FILE DEF *+9 DEF DBUF$,I DCB DEF RUBSH ERROR BUCKET DEF TBUFF,I FILE NAME DEF FSIZE # OF BLOCKS DEF .4 TYPE 4 DEF FSECR SECURITY CODE DEF FCART CARTRIDGE ID DEF DCBSZ DCB SIZE SPC 1 SSA ERROR FROM CREATE? JMP FMPC YES, PRINT MESSAGE JMP WRITR GO TO OUTPUT FILE SPC 1 RPFIL JSB OPEN OPEN OUTPUT FILE DEF *+8 DEF DBUF$,I DEF RUBSH DEF TBUFF,I DEF ZERO DEF FSECR DEF FCART DEF DCBSZ SPC 1 SSA ERROR FROM OPEN? JMP FMPC YES, PRINT ERROR MESSAGE SPC 1 WRITR JSB SETSO SET UP TO READ SOURCE. JSB SQ READ IN FIRST BLOCK NXREC LDB SLNG CONVERT # CHARS. TO BRS # OF WORDS STB RCLNG SPC 1 JSB WRITF WRITE DEF *+5 RECORD DEF DBUF$,I ON DEF RUBSH OUTPUT DEF SBUFP,I FILE DEF RCLNG SSA IF ERROR, PRINT MESSAGE AND JMP FMPC TRY TO RECOVER LDA RCLNG IF EOF WRITTEN SSA GO TO JMP CLSFL CLOSE FILE JSB I/PSB READ NEXT RECORD JMP NXREC CONTINUE SPC 1 CLSFL JSB CLOSE CLOSE DEF *+2 OUTPUT DEF DBUF$,I FILE SPC 1 SSA IF ERROR PRINT MESSAGE JSB FMPER AND END SPC 1 ENDMS LDA LS\K#TR FETCH OLD SOURCE TRACK LDB LSTRK COUNT AND POINTER SZB IF POINTER IS NON-ZERO JMP RELT RELEASE TRACKS. LDA #TRAK IF ZERO RELEASE ANY WORK TRACKS. LDB LSLUT SZB IF ZERO--DONE. RELT JSB RELTR RELEASE TRACKS SPC 1 JSB PRINT END OF EDIT MESSAGE DEF PRETN DEC 6 ASC 6,END OF EDIT * PRETN LDA SAVL IF E COMMAND INCLUDED L, CPA "L" REPORT THE LS LU AND RSS TRACK BACK TO THE JMP EXIT SCHEDULER. JSB PRTN DEF EXIT DEF LSLU SPC 1 ****** TERMINATION HERE ******** EXIT JSB EXEC DEF *+2 DEF .6 *** * SPC 1 SAVL OCT 0 SAVE PARAMETER FOLLOWING /E .6 DEC 6 B40 OCT 40 M58 DEC -58 M2 DEC -2 "C" OCT 103 M1 DEC -1 .1 OCT 1 .2 OCT 2 M3 DEC -3 DBEND NOP SBEND NOP SPC 1 $$$ER CCA STA SLNG SIMULATE END OF FILE JSB ERROR DEF ./A0 DEC 6 ASC 6,CORRUPT FILE SPC 1 PRINT NOP LDA NOPRN GET THE INTERACTIVE DEVICE FLAG. SZA IF IT'S NON-INTERACTIVE JMP PRNTX THEN, FORGET THE MESSAGE. LDA PRINT INA STA ERMEC INA STA ERMEP JSB DEXEC DEF PRNER IFZ DEF NODE XIF DEF .2.I DEF TTYLU ERMEP NOP ERMEC NOP PRNER CCB,RSS CLB PRNTX LDA PRINT,I JMP A,I * * * * ERROR NOP JSB LOGLU GET THE TERMINAL LU DEF *+2 DEF DUMMY LDB ERAB? SZB,RSS LDA TTYLU USE THE INTERACTIVE COMMAND DEVICE INSTEAD STA DUMMY * LDA ERROR INA STA ERREC INA STA ERREP JSB DEXEC PRINT THE ERROR MESSAGE DEF ERRER IFZ DEF NODE XIF DEF .2.I DEF DUMMY ERREP NOP ERREC NOP ERRER JMP EXIT ERROR MESSAGE FAILED, GIVE UP LDA ERAB? SZA JMP *+3 NON-INTERACTIVE, ABORT EDIT LDA ERROR,I JMP A,I * CCA STA SLNG JMP ./A0 * * * FSECR NOP FILE SECURITY CODE FCART NOP FILE CARTRIDGE REFERENCE NUMBER FSECW NOP SAVE SC DURING TURN-ON. FCARW NOP DITTO CR .75 DEC 75 ZERO NOP DBFP1 NOP DUMMY NOP * SC.CR NOP ISZ ECCNT * JSB NAMR PARSE INPUT DEF *+5 DEF TBUFF,I PARSE BUFFER DEF EBUFF,I COMMAND STRING DEF ELNG COMMAND LENGTH DEF ECCNT CURRENT POSITION * CCB ADB ECCNT STB ECCNT RESET CURRENT POSITION LDA TBUFF,I SZA,RSS JMP SC.CR,I NULL FILE NAME * LDB TBUFF ADB .4 DLD B,I DST FSECR SAVE SECURITY CODE & CART. REF. ISZ SC.CR JMP SC.CR,I * SPC 1 RLSAL JSB EXEC RELEASE ALL TRACKS DEF *+3 OWNED BY EDITR. DEF .5 DEF M1 JMP IN2 SKP * INSRC FINDS AND LOADS NEW SOURCE FILE. * * - CONDITIONALLY RELEASES ALL THIS EDITR'S TRACKS. * - READS SOURCE (FMGR) FILE INTO DESTINATION BUFFER, ONE RECORD * AT A TIME. * - WHEN DESTINATION BUFFER IS FULL, CALLS TO WRITE THE * BUFFER IN SYSTEM-ASSIGNED TRACK IN LS FORMAT. * INSRC NOP JSB OPEN OPEN INPUT FILE DEF *+8 DEF SBUF$,I DEF RUBSH DEF TBUFF,I DEF ZERO DEF FSECR DEF FCART DEF DCBSZ SSA,RSS ERROR ON OPEN? JMP IN1 NO, READ IN FILE JSB FMPER YES, PRINT ERROR JMP INSRC,I ERROR RETURN IN1 ISZ INSRC STEP TO OK RETURN LDA EXFLG ORIGINAL INPUT SSA,RSS FILE OR MERGE FILE? JMP NXTRC MERGE FILE! LDA SFCUN LDB TAT IF THIS EDITR DOES NOT SSA ADB TATSD OWN THE TRACKS CLE,ELA ALF,ALF POINTED TO BY LS POINTER. ADB A LDA B,I THEN IT IS SAFE TO CPA XIDT RSS JMP RLSAL RELEASE ALL TRACKS. IN2 JSB ALCAT GET FIRST DEST. TRACK SPC 1 NXTRC LDA DBUFP SET DBFP1 INA TO STA DBFP1 DBUFP+1 SPC 1 JSB READF READ DEF *+6 SOURCE DEF SBUF$,I FILE DEF RUBSH DEF DBFP1,I DEF .75 DEF DBUFP,I SPC 1 SSA ERROR FROM READF? JMP FMPA YES, GO TO FILE MANAGER ABORT LDA DBUFP,I FETCH RECORD LENGTH SSA END OF FILE? JMP ENDFL YES, GO TO END PROCESS LDB EXFLG MERGE OR ORIGINAL? SSB JMP NOBMP ORIGINAL ISZ T#REC INCREMENT DEST RECORD COUNT JMP *+2 DURING READ FOR A MERGE, ISZ T#REM IN DOUBLE-WORD INTEGER. * NOBMP ALF,ALF MOVE RECORD LENGTH TO STA DBUFP,I UPPER BYTE ALF,ALF ADA DBFP1 ADD PREVIOUS POINTER STA DBUFP TO GET NEW POINTER CMA CHECK FOR AVAILABLE ROOM ADA DBEND TO END OF BUFFER. SSA,INA,RSS END OF OUTPUT BUFFER? JMP NXTRC NO, READ NEXT RECORD STA DBFP1 STORE NUMBER OF WORDS OF OVERFLOW JSB DOUT OUTPUT BUFFER LDA DBFP1 NO OVERFLOW SZA,RSS SO CONTINUE JMP NXTRC WITH READ LDB DBEND OTHERWISE FETCH OVERFLOW ADDRESS OVMVR LDA B,I MOVE STA DBUFP,I BUFFER INB OVERFLOW ISZ DBUFP INTO ISZ DBFP1 BEGINNING OF BUFFER JMP OVMVR JMP NXTRC READ NEXT RECORD ENDFL JSB CLOSE CLOSE DEF *+2 SOURCE DEF SBUF$,I FILE SSA ERROR FROM CLOSE? JSB FMPER YES, GO TO FILE MANAGER ERROR JMP INSRC,I RETURN * RUBSH NOP ANYTHING I DON'T WANT GORES HERE SPC 1 * FMPER PRINTS FILE MANAGER ERROR * FMPER NOP CMA,INA COMPLEMENT ERROR NUMBER CLB DIV .10 GENERATE ADA B60 ASCII FROM ADB B60 OCTAL ERROR NUMBER ALF,ALF IOR B STA MSGP+10 STORE IN MESSAGE JSB ERROR DEF FMPER,I DEC 11 MSGP ASC 11,FILE MANAGER ERROR -XX SPC 1 SPC 1 FMPA JSB FMPER PRINT FILE MANAGER ERROR JMP ENDFL THEN ABORT THE READ SPC 1 FMPC JSB FMPER PRINT FILE MANAGER ERROR JMP NODE1 THEN GET NEXT COMMAND SPC 1 NBUF0 ASC 10, FOR NAME:SC:CR SPC 1 * RECORD BUFFERS - THESE BUFFERS ARE DYNAMICALLY ASSIGNED * FOR INSTANCE, DURING EDITING BUFFERS ARE * SWITCHED BY CHANGING POINTERS SO THAT * THE COMMAND BUFFER (INPUT FROM CONSOLE) * IS USED AS AN EXCHANGE FIELD OR MATCH FIELD * BUFFER. * TBUF0 BSS 75 XYBF0 BSS 75 EBUF0 BSS 75 * MBUF0 IS A SIMILAR BUFFER WHICH OVERLAYS ONE-TIME CODE * STARTING AT 'EDITR'. SPC 2 * DEFAULT TABS ARE COLUMNS 7 AND 21 SPC 1 TAB0 DEC -6,-20,0,0,0,0,0,0,0,0,0 * * SKP A EQU 0 B EQU 1 AVMEM EQU 1751B END OF FOREGROUND+1 BKLWA EQU 1777B LAST WORD OF AVAILABLE MEMORY TAT EQU 1656B TRACK ASSGNMNT TABLE ADDRESS XIDT EQU 1717B EDITR ID TABLE ENTRY ADDRESS TATSD EQU 1756B # OF TRACKS ON SYSTEM DISC SFCUN EQU 1767B SYSTEM LS AREA (LU/TRACK) * BIT 15=LU SECT2 EQU 1757B # SECTORS PER TRACK LU 2 SECT3 EQU 1760B # SECTORS PER TRACK LU 3 MXSEC EQU ECCNT CNTRL EQU SWPET USE ENTRY POINT AS TEMP NEGFL EQU MATCH T1 EQU NUM1 T2 EQU NUM10 NT EQU CFLG RQSTC EQU LSTSB ENTRY POINT USED AS TEMP FSIZE EQU CNT1 RCLNG EQU CNT1 BASE EQU JDEF$ INCR EQU IDEF$ END EDITR * SKP IFN REIO .HFBEQU EXEC .2.I EQU .2 XIF A EQU 0 B EQU 1 AVMEM EQU 1751B END OF FOREGROUND+1 BKLWA EQU 1777B LAST WORD OF AVAILABLE MEMORY TAT EQU 1656B TRACK ASSGNMNT TABLE ADDRESS DRT EQU 1652B DEVICE REF. TABLE ADDRESS LUMAX EQU 1653B MAX LU ON SYSTEM XIDT EQU 1717B EDITR ID TABLE ENTRY ADDRESS TATSD EQU 1756B # OF TRACKS ON SYSTEM DISC SFCUN EQU 1767B SYSTEM LS AREA (LU/TRACK) * BIT 15=LU BITS 14-7=TRACK SECT2 EQU 1757B # SECTORS PER TRACK LU 2 SECT3 EQU 1760B # SECTORS PER TRACK LU 3 MXSEC EQU ECCNT CNTRL EQU SWPET USE ENTRY POINT AS TEMP NEGFL EQU MATCH T1 EQU NUM1 T2 EQU NUM10 NT EQU CFLG RQSTC EQU LSTSB ENTRY POINT USED AS TEMP FSIZE EQU CNT1 RCLNG EQU CNT1 BASE EQU JDEF$ INCR EQU IDEF$ END EDITR |H 7> 91740-18023 1740 S C0122 DS/1000 MODULE: REDIT              H0101 0ASMB,R,L,C HED REDIT 91740-16023 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 * NAM REDIT,19,50 91740-16023 REV 1740 770518 SPC 3 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SUP SPC 2 * NAME: REDIT * SOURCE: 91740-18023 * RELOC.: 91740-16023 * PGMR.: C.C.H. SPC 2 * ENT REDIT * EXT DEXEC,EXEC,#NODE,$LIBR,$LIBX,$CVT1 SPC 2 * * THIS IS A DS/1000 PROGRAM USED TO SCHEDULE "EDITR" AT A * REMOTE DISC-BASED NODE OF THE DS/1000 NETWORK. * * CALLING SEQUENCE: * * *ON,REDIT,TTYLU,RECSZ,NODE,,CHARS SCHEDULE EDITR AT ANY NODE IN NETWORK * * WHERE: * * TTYLU = INTERACTIVE TERMINAL LU NO. (LOCAL NODE) [DEFAULT =1] * * RECSZ = + MAXIMUM CHARACTERS PER LINE [DEFAULT =150] * * NODE = NODE AT WHICH IS TO BE SCHEDULED. * * CHARS = OPTIONAL NAME CHARACTERS, FOR ALTERNATE PROGRAM NAME: "EDIXX". * [THE SUPPLIED CHARACTERS MODIFY THE SCHEDULED-PROGRAM NAME IF * NOT SUPPLIED, "EDITR" WILL BE SCHEDULED.] * SKP * REDIT STB P1 SAVE TTYLU ADDRESS IN CALLING SEQUENCE INB STB P2 & RECORD SIZE ADDRESS INB STB P3 & OPERATING NODE ADDRESS STB DNODE DEFINE RECIPIENT OF REQUEST. * ADB K2 POINT TO P5. LDA B,I GET OPTIONAL-NAME CHARS.--IF ANY. STA TEMP SAVE TEMPORARILY. SZA ALTERNATE NAME SPECIFIED? JMP CKASC YES. CHECK TYPE OF PARAMETER. * DLD ASCTR NO. RESTORE DEFAULT CHARACTERS "TR". DST EMSG+5 JMP SCHED GO TO SCHEDULE "EDITR". * CKASC AD  A M.100 SUBTRACT 100 FOR ASCII CHECK. CCE,SSA,RSS ASCII PARAMETER SUPPLIED? JMP CONFG YES--NO NEED FOR CONVERSION. * LDA TEMP GET THE PARAMETER. JSB $LIBR NOP JSB $CVT1 CONVERT DECIMAL TO ASCII. STA TEMP SAVE THE RESULT. JSB $LIBX DEF *+1 DEF CONFG * CONFG LDA TMPBA GET BYTE ADDRESS OF CHARACTERS. LDB NAMBA GET BYTE ADDRESS OF PROG. NAME. MBT K2 MOVE THE CHARACTERS TO THE NAME. * SCHED JSB DEXEC DEF *+9 DNODE NOP LOCATION NODAL ADDRESS. DEF K10 SCHEDULE W/O WAIT. DEF EMSG+4 PROGRAM NAME: "EDI??". P1 NOP LOCAL INTERACTIVE LOGICAL UNIT NO. P2 NOP NUMBER OF CHARACTERS PER LINE. P3 NOP REMOTE NODAL ADDRESS OF . DEF #NODE DEFINE (LOCAL) OPERATOR'S NODAL ADDRESS. DEF K1 NON-ZER0: DETECTION OF DESTINATION =0. * SZA,RSS JMP TERM SCHEDULED OK * JSB EXEC GIVE FAILURE MESSAGE DEF *+5 DEF K2 DEF K1 DEF EMSG DEF ELENG * TERM JSB EXEC TERMINATE DEF *+2 DEF K6 * * A EQU 0 B EQU 1 K1 DEC 1 K2 DEC 2 K6 DEC 6 K10 DEC 10 M.100 DEC -100 ASCTR ASC 2,ITR TEMP NOP TMPBA DBL TEMP NAMBA DBR EMSG+5 * ELENG DEC 13 EMSG ASC 13,REMOTE EDITR UNAVAILABLE! * END REDIT |   91740-18024 2026 S C0122 &REMAT +              H0101 mASMB,R,Q,C HED REMAT 91740-16024 REV 2001 * (C) HEWLETT-PACKARD CO. 1980 NAM REMAT,19,80 91740-16024 REV 2026 800418 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ************************************************ * * NAME: REMAT * SOURCE: 91740-18024 * RELOC: 91740-16024 * PGMR: JIM HARTSELL, ET AL * * MODIFIED BY DMT FOR DVR07 11-77 * MODIFIED BY LAW TO PROVIDE BROADCAST CAPABILITY 6-28-78 * MODIFIED BY CCH TO PROVIDE CARTRIDGE LIST CAPABILITY 10-26-78 * MODIFIED BY JDH FOR 21LC-REMAT-APLDR COMPATABILITY 10-7-79 * ************************************************** * * OPERATOR INTERFACE PROGRAM FOR DS/1000 * * RTE PROGRAM TO PROVIDE VARIOUS OPERATOR ACCESS AND CONTROL * FUNCTIONS BOTH LOCALLY AND AT REMOTE NODES. * * CPU'S ARE ADDRESSED BY USING THE SW(ITCH) COMMAND TO SPECIFY * VALUES FOR NODE1 AND NODE2 TO BE USED IN SUBSEQUENT * OPERATOR COMMANDS. * **************************************************************** * * REMAT IS TURNED ON WITH THE FOLLOWING OPERATOR COMMAND: * * *ON,REMAT [,INPUTLU [,LOGLU [,LISTLU [,SEVERITY CODE]]]] * OR * *ON,REMAT,FI,LE,NM [,LISTLU [,SEVERITY CODE]] * * WHERE: * * INPUTLU = LU OF SYSTEM INPUT DEVICE. (DEFAULT = 1) * * LOGLU = LU OF INTERACTIVE ERROR LOGGING DEVICE. (DEFAULT = * INPUTLU IF INPUTLU IS A CRT OR TTY, ELSE = 1) * * LISTLU = LU OF LIST DEVICE. (DEFAULT = LOGLU) * * SEVERITY CODE = ERROR REPORTING CODE. (DEFAULT = 0) * 0 = ECHO ALL COMMANDS * 1 = INHIBIT COMMAND ECHO * * FILENM = FILE WHICH MAY OPTIONALLY BE SPECIFIED TO PROVIDE * ALL INPUT COMMANDS * ***************************************************************** SPC 2 * SUP ENT REMAT * EXT EXEC,#NODE,$OPSY EXT #NCNT EXT DPOSN EXT DWRIT,DOPEN,DREAD,DLOCF EXT DCLOS,DCRET,DNAME,DPURG EXT DMESS,DMESG,IFBRK EXT D65MS,FCOPY EXT DEXEC,CNUMD,#SWRD EXT REIO,RMPAR,.DFER * IFZ EXT DBUG XIF * * A EQU 0 B EQU 1 * * INITIALIZE TRANSFER STACK. * REMAT JSB RMPAR GET PRAMS DEF *+2 DEF P1 SAVE IN TEMP AREA * SPC 1 IFZ LDA P1 SEE IF THEY WANT DBUG INA CPA D100 RSS JMP REMC1 JSB DBUG DEF *+1 JSB EXEC DEF *+4 DEF B6 DEF B0 DEF B1 JMP REMAT XIF SPC 1 REMC1 JSB EXEC SET SWAP ONLY WHAT IS NEEDED DEF *+3 DEF D22 DEF B2 LDA $OPSY CONFIGURE DMS INSTRUCTIONS RAR SLA,RSS DMS? JMP REMC2 NO. DLD XLA1 DST DMS1 STORE XLA XPNTR,I REMC2 EQU * LDA STKHD RESET STACK POINTER. STA P.STK CLA,INA SET FIRST STACK ENTRY STA P.STK,I FOR LOGICAL UNIT 1 (DEFAULT). * LDA #NODE GET LOCAL NODE # STA NODE2 DEFAULT NODE2 IS LOCAL STA NODE1 DEFAULT NODE1 IS LOCAL STA DESTX STA TRNOD INIT XFR FILE NODE CLA DEFAULT LU STA TRSEC INIT XFR FILE SECURITY CODE STA TRCRN AND CARTRIDGE REF #. * LDA P1 CHECK IF P1 = ASCII PARAM. AND HB377 SZA,RSS JMP STR NO. MUST BE INPUT LU. * * FETCH SCHEDULE PARAMETERS (FL,NA,ME,LIST,SEVERITY). * DLD P1+1 PROTECTION FOR THE FILE SZA,RSS NAME IN THE SCHEDULE PARAMETERS LDA DBBLK SZB,RSS LDB DBBLK DST P1+1 * LDA A.$TR GENERATE "$TR,FLNAME" IN BUFFER. STA INBUF LDA A.TR1 STA INBUF+1 JSB .DFER DEF INBUF+2 DEF P1 * LDA B5 SET COUNT. STA INCNT * CLA SET UP DUMMY SCHEDULE PARAMS STA P1 FOR INPUTLU STA P1+1 AND LOGLU. LDA P1+3 ADJUST POSITION OF LISTLU STA P1+2 AND SEVERITY CODE IN LDA P1+4 SCHEDULE PARAM BUFR. STA P1+3 CCA PREPARE TO SET TRFLG * STR STA TRFLG SET/CLEAR FLAG FOR QUERY SECTION. * * FETCH SCHEDULE PARAMETERS (LU,LOG,LIST,SEVERITY CODE). * LDA P1 GET LU OF INPUT DEVICE. SZA IF NONE OR 1, LEAVE DEFAULT (=1) CPA B1 IN STACK. JMP STAT * STA P.STK,I OVERRIDE DEFAULT INPUT LU * STAT LDA P.STK,I JSB EQTYP CHECK EQ. TYPE OF INPUT LU. STA LUTYP * LDA P1+1 GET LU OF LOG DEVICE. SZA GIVEN? JMP SVLOG YES, USE IT * LDB LUTYP NO, USE INPUTLU CLA,INA IF INTERACTIVE, SZB,RSS ELSE USE 1. LDA P.STK,I GET INPUTLU SVLOG IOR VBIT IN CASE IT'S A PRINTER STA LOGLU SAVE LOGLU * LDA P1+2 GET LU OF LIST DEVICE, SZA,RSS LDA LOGLU OR USE DEFAULT = LOG LU. STA LSTLU * LDA P1+3 SAVE SEVERITY CODE. STA SEVER * LDA TRFLG IF SCHEDULED WITH FILE NAME, SZA ALREADY HAVE TR SIMULATED. JMP CHK$ * * DISPLAY PROMPT CHARACTER (IF TTY DEVICE). * CONTROL RETURNS HERE WHEN REQUEST PROCESSING COMPLETES. * QUERY LDA P.STK,I CHECK WHETHER CURRENT INPUT STA LUTYP IS FROM A TTY TYPE DEVICE. AND HB377 NON ZERO IF FILE NAME, ELSE LU. SZA JMP REMRD REMOTE FILE. STA BRFLG CLEAR BREAK-FLAG * JSB LCALS SET FOR LOCAL ONLY LDA P.STK,I JSB EQTYP LOCAL LU: CHECK TYPE. JSB LCALC RESET NODE2 PARAMETER STA LUTYP SZA JMP LOCRD LOCAL INPUT LU NOT TTY DEVICE. * LDB "$" SET LOCAL PROMPT ($) LDA #NODE IF BOTH NODE1 AND NODE2 CPA NODE1 ARE LOCAL, ELSE SET RSS REMOTE PROMPT (#). LDB "#" CPA NODE2 RSS LDB "#" STB PRMPT * JSB REIO DISPLAY PROMPT ON TTY DEVICE. DEF *+5 DEF ICOD2 DEF P.STK,I DEF PRMPT PROMPT CHAR DEF B1 JMP ABORT ERROR RETURN * LDA P.STK,I SET ECHO BIT. IOR B400 RSS * * INPUT OPERATOR REQUEST FROM CURRENT DEVICE OR FILE. * LOCRD LDA P.STK,I SET INPUT LU INTO STA TEMP REIO CALLING SEQ. * JSB REIO LOCAL LU. DEF *+5 DEF ICOD1 DEF TEMP DEF INBUF DEF D40 JMP ABORT ERROR RETURN * STA TEMPM SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. JSB LCALS SET FOR LOCAL JSB EOFCK CHECK FOR END OF FILE. JMP TRANS GOT IT. JMP ECHO GO ECHO IF NECESSARY. * REMRD JSB IFBRK IF BRFLG IS SET AT DEF *+1 THIS OR ANY PREVIOUS SZA CALL TO IFBRK, THEN STA BRFLG CLEAR IT AND RESET STACK. LDA BRFLG CLB STB BRFLG SZA JMP RESET * JSB DREAD READ RECORD FROM FILE DEF *+6 (OPENED WHEN FIRST TRANSFER DEF TRDCB WAS PERFORMED) DEF IERRR DEF INBUF DEF D40 DEF INCNT ACTUAL WORD COUNT. * JSB ERCHK CHECK FOR ERRORS. * LDA INCNT IF EOF, GENERATE TR REQUEST. INA,SZA JMP BUMP TRANS LDA A.$TR STA INBUF LDA A.$TR+1 STA INBUF+1 LDA B2 STA INCNT JMP ECHO * BUMP LDA P.STK ADA B3 ISZ A,I BUMP RECORD COUNT. * * ECHO THE REQUEv ST IF NOT INPUT FROM TTY DEVICE. * ECHO LDA LUTYP SZA,RSS JMP CKCNT IT IS A TTY DEVICE. * LDA SEVER INHIBIT ECHO IF CPA B1 SEVERITY CODE = 1. JMP CHK$ * JSB REIO NOT TTY: ECHO. DEF *+5 DEF ICOD2 DEF LOGLU DEF INBUF DEF INCNT JMP ABORT ERROR RETURN * CHK$ LDA INBUF FIRST CHARACTER MUST AND HB377 BE A "$". CPA AS.$ RSS JMP OPER * LDA INBUF BLANK OUT THE "$" SIGN. AND B377 IOR BLANK STA INBUF * CKCNT LDB INCNT IGNORE REQUEST IF NULL. RBL MAKE CHARACTER COUNT. SZB,RSS JMP QUERY * * PARSE THE OPERATOR REQUEST. * JSB $PARS * JMP M0000 CHECK IF PROCESSING NEEDED * * * SEND RTE COMMANDS. * OTHER LDA INCNT CONVERT LENGTH TO BYTES RAL STA INCNT * * HERE FOR SENDING SYSTEM COMMANDS TO THE * CPU AT NODE1. * JSB DMESS SEND COMMAND. DEF *+4 DEF NODE1 DEF INBUF ASCII COMMAND. DEF INCNT COUNT (+POSITIVE BYTES) * SZA ANY RESPONSE MESSAGE? JMP DSPLY YES, DISPLAY IT CPB MD1 NO. ERROR? JMP OPER YES JMP QUERY NO * DSPLY STA TEMP SAVE COUNT * JSB REIO DISPLAY REPLY MESSAGE. DEF *+5 DEF ICOD2 DEF LOGLU DEF INBUF DEF TEMP JMP ABORT ERROR RETURN * JMP QUERY * * CHECK THE OPERATOR REQUEST CODE AGAINST THE LEGAL * REQUEST CODES AND JUMP TO THE PROPER PROCESSOR. * * TO ADD NEW REQUEST ONE MERELY: * A. ADDS ASCII OPERATION CODE TO TABLE "LDOPC". * B. ADDS PROCESSOR START ADDRESS TO TABLE "LDJMP". * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. * M0000 LDB OP FETCH OPERATION CODE. M0001 STB OPP SET STOP FLAG. LDA LDOPC SET OPERATION TABLE POINTER. STA TEMPw1 LDA LDJMP SET PROCESSOR JUMP ADDRESS. * M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE. JMP A,I COMPARES. GO DO IT. * ISZ TEMP1 KEEP LOOKING. INA JMP M0030 * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS. * ASC 1,DL ASC 1,DU EX ASC 1,EX ASC 1,ST ASC 1,SW ASC 1,TE ASC 1,TR ASC 1,LO ASC 1,IO ASC 1,PL ASC 1,LL ASC 1,SL ASC 1,SO ASC 1,RW ASC 1,LC ASC 1,FL ASC 1,PU ASC 1,RN ASC 1,CR ASC 1,LI ASC 1,BC "BROADCAST" ASC 1,CL CARTRIDGE LIST. OPP NOP OP CODE FOR CURRENT REQ. * LDJMP DEF *+1,I JMP ADDRESS FOR EACH OP CODE. * DEF M0300 ADR FOR DL REQUEST DEF M0400 DU REQUEST. DEF M0500 EX REQUEST. DEF M0900 ST REQUEST. DEF M0990 SW REQUEST. DEF M1000 TE REQUEST. DEF M1200 TR REQUEST DEF M1400 LO REQUEST DEF M1450 IO REQUEST DEF M1500 PL REQUEST DEF M1600 LL REQUEST DEF M1700 SL...SLAVE LIST ROUTINE DEF M1800 SO...SLAVE OFF ROUTINE DEF M2001 RW REQUEST DEF M2100 LC REQUEST DEF M2401 FL REQUEST DEF M2501 PU REQUEST DEF M2550 RN REQUEST DEF M2701 CR REQUEST DEF M2801 LI REQUEST DEF BRCST BR REQUEST DEF M3000 CL REQUEST DEF OTHER MUST BE A SYSTEM COMMAND SPC 1 * ERR55 LDA D55 MISSING PARAMETER JMP OPERS * ERR56 LDA D56 ILLEGAL PARAMETER TYPE JMP OPERS * OPER LDA D10 INPUT ERROR: 010 OPERS STA IERRR JSB ERCHK WON'T RETURN. * HED REMAT: TR REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * TR,NAMR [,NODE #] * * TRANSFER CONTROL TO LOCAL LU OR FILE AT NODE #. DEFAULT NODE# * IS LOCAL. NODE # AND NAMR SUBPARAMS CRN & SECURITY CODE MAY BE * SET ONLY ON THE FIRST $TR OF A NESTED GROUP OF $TR COMMANDS. * M1200 LDA P.STK,I IF CURRENT INPUT IS FROM A AND HB377 FILE, CLOSE IT. SZA,RSS JMP M1210 * JSB DCLOS DEF *+3 DEF TRDCB DEF IERRR * CLA STA TOPNF CLEAR TRDCB OPEN FLAG. * M1210 LDA P.STK IF THIS IS THE FIRST $TR CPA STKHD OF A NESTED GROUP, SET FILE RSS NODE, SECURITY CODE AND CRN. JMP IGNOR IF NOT, LEAVE THEM AS THEY ARE. LDA SECU1 STA TRSEC LDA CRN1 STA TRCRN LDB CP2 GET 2ND PARAM FLAG SZB MISSING? JSB INTCK NO. MUST BE NUMERIC LDA #NODE GET DEFAULT NODE (LOCAL) SZB P2 MISSING? LDA P2 NO, USE IT. STA TRNOD SET NODE # * IGNOR EQU * LDA P1 GET PARAM 1. SZA,RSS IF NOT SPECIFIED, CCA SIMULATE "TR,-1". * SSA,RSS NEGATIVE INTEGER? JMP M1220 NO. * * BACK UP THROUGH TRANSFER STACK. * LDB STKHD STB TEMP TEMP = TOP-OF-STACK ADR LDB TRFLG RUNNING FROM SCHEDULE SZB,RSS PARAM FILE? JMP M1215 NO LDB STKHD YES, ADJUST TOS ADR ADB B4 STB TEMP M1215 LDB P.STK TOP OF STACK? BKUP CPB TEMP JMP M1217 YES. SIMULATE "EX" REQUEST. ADB MD4 NO. BACK UP 1 ENTRY. INA,SZA JMP BKUP LOOP TILL DONE. STB P.STK SET NEW STACK ADDRESS. JMP M1250 GO CHECK FOR FILE. * M1217 LDB EX GO SIMULATE "EX" REQUEST JMP M0001 * * ADD NEW CONTROL TO THE TRANSFER STACK. * M1220 LDA P.STK BUMP TO NEXT ENTRY. ADA B4 STA P.STK CPA STKEN RSS JMP M1230 * LDA D13 STACK OVERFLOW. ERROR 013. JMP OPERS * M1230 EQU * LDB P1 STORE LU OR FILE NAME. STB A,I INA LDSB P1+1 STB A,I INA LDB P1+2 STB A,I INA CLB,INB SET RECORD NUMBER TO 1. STB A,I * * IF FILE, OPEN AND OPTIONALLY POSITION. * M1250 LDA P.STK,I AND HB377 SZA,RSS JMP QUERY LOCAL LU. GO GET NEXT REQUEST. * JSB DOPEN OPEN THE FILE. DEF *+7 DEF TRDCB DEF IERRR DEF P.STK,I DEF B0 IOPTN DEF TRSEC SECURITY CODE DEF TRCRN ICR ARRAY * LDA IERRR PROCESS ERRORS ONLY IF SSA IERRR IS NEGATIVE. JSB ERCHK ISZ TOPNF SET TRDCB OPEN FLAG. * LDA P.STK POSITIONING REQUIRED? ADA B3 LDB A,I CPB B1 (REC. CNT MORE THAN 1?) JMP QUERY NO. STB TEMP YES. * JSB DPOSN POSITION TO NEXT RECORD. DEF *+5 DEF TRDCB DEF IERRR DEF TEMP NUR GREATER THAN ZERO. DEF TEMP ABSOLUTE RECORD NUMBER. * JSB ERCHK CHECK FOR ERRORS. JMP QUERY * * TRANSFER STACK. * * FOR EACH ENTRY, WORD 1 = INTEGER LU OR * FIRST 2 FNAME CHAR. * WORD 2,3 = REST OF FNAME. * WORD 4 = NEXT RECORD NUMBER. * P.STK NOP STACK POINTER. STKHD DEF *+1 * BSS 32 8 ENTRIES. * STKEN DEF * STACK LWA+1 * TRSEC NOP XFR FILE SECURITY CODE TRCRN BSS 2 XFR FILE ICR ARRAY TRNOD EQU TRCRN+1 HED REMAT: DU REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * DU,NAMR1,LU [,FORMAT] * * DUMP FROM NAMR1 FILE OR LU AT NODE1 TO LU AT NODE2 * M0400 JSB CKFMT SET UP SUBF, ETC LDB CP1 CPB B1 1ST PARAM NUMERIC? JMP M0450 YES, MUST BE LU * JSB ASCHK NO,MUST BE FILE NAME. LDB CP2 JSB INTCK ERROR IF NO LU2 JSB PTCHK SEE IF LEADER GENERATION NECESSARY LDA NODE1 STA CRN1+1 BUILD ICR ARRAY FOR DOPEN * * OPEN THE FILE AT NODE1 * JSB DOPEN OPEN THE FILE. DEF *+7 DEF UDCB DEF IERRR DEF P1 FILE NAME. DEF B0 OPEN OPTIONS. DEF SECU1 SECURITY CODE. DEF CRN1 ICR ARRAY * LDA IERRR CHECK FOR ERRORS IF IERRR NEG. SSA JSB ERCHK ISZ UOPNF SET UDCB OPEN FLAG. * LDA CP3 GET FORMAT PARAM FLAG SZA GIVEN? JMP M0410 YES, OVERRIDES FILE TYPE * JSB DLOCF NO, GET FILE TYPE INFO DEF *+9 DEF UDCB DEF IERRR DEF TEMP DEF TEMP DEF TEMP DEF TEMP DEF TEMP DEF TYPE1 * LDA IERRR CHECK FOR ERRORS IF IERRR NEG. SSA JSB ERCHK * LDA B100 LDB TYPE1 CPB B5 TYPE 5? STA SUBF YES, SET BINARY BIT CPB B7 TYPE 7? STA SUBF YES, SET BINARY BIT * CLB IF FORMAT IS LDA P3 ASCII, RESET CPA "AS" ASCII/BINARY STB SUBF BIT IN SUBF. * * READ A RECORD FROM NODE1 FILE. * M0410 JSB DREAD READ. DEF *+6 DEF UDCB DEF IERRR DEF INBUF DEF D128 DEF INCNT XMSN LOG. * LDA TYPE1 IF ERROR -12 (EOF) CPA B1 RSS JMP M0411 LDA IERRR ON TYPE 1 FILE, CPA MD12 JMP M0415 GO PROCESS EOF. * M0411 JSB ERCHK CHECK FOR ERRORS. * LDA INCNT SZA,RSS SKIP CHECKSUM FOR JMP M0412 ZERO-LENGTH RECORDS. INA,SZA,RSS CHECK FOR EOF (INCNT=-1) JMP M0415 GOT IT. GO PROCESS. JSB CKSUM DO CHECKSUM IF NECESSARY JMP ERR07 CHECKSUM ERROR RETURN M0412 JSB LUOUT GO OUTPUT THE RECORD RSS BREAK REC'D. TREAT AS EOF JMP M0410 GO READ NEXT RECORD M0415 JSB EOFPR PROCESS EOF JMP M0950 GO CLOSE NODE1 FILE *  * DUMP LU1 TO LU2 * M0450 LDB CP2 JSB INTCK ERROR IF NO LU2 JSB PTCHK SEE IF LEADER GENERATION NECESSARY JSB CKTTY SET ECHO BIT IF LU = TTY OR CRT M0460 JSB LUIN INPUT RECORD FROM LU1 JMP M0470 EOF FOUND JSB LUOUT OUTPUT RECORD TO LU2 RSS BREAK FLAG SET. TREAT AS EOF JMP M0460 GO READ NEXT RECORD M0470 JSB EOFPR PROCESS END-OF-FILE JMP QUERY * * SUBROUTINE TO GENERATE LEADER IF LU2 = PAPER TAPE PUNCH * PTCHK NOP LDA P2 GET LU2 JSB EQTYP CPA B2 PAPER TAPE PUNCH? RSS JMP PTCHK,I NO, RETURN LDA B1000 YES, GENERATE LEADER IOR P2 STA TEMP * JSB DEXEC CONTROL DEF *+4 DEF NODE2 DEF ICOD3 CONTROL, NO-ABORT DEF TEMP JMP ASCER ERROR RETURN * JMP PTCHK,I RETURN * * SUBROUTINE TO OUTPUT THE RECORD ON NODE2 LU * * LUOUT NOP LDA SUBF GET SUBFUNCTION AND B100 ISOLATE BINARY/ASCII BIT IOR P2 INCLUDE OUTPUT LU STA TEMP SET UP DEXEC CONWD * JSB DEXEC WRITE. DEF *+6 DEF NODE2 DEF ICOD2 WRITE, NO-ABORT DEF TEMP CONWD DEF INBUF DEF INCNT JMP ASCER ERROR RETURN * JSB IFBRK FIND IF DEF *+1 THE BREAK FLAG SZA,RSS IS SET ISZ LUOUT NO, BUMP RETURN ADR STA BRFLG SAVE BREAK INDICATION JMP LUOUT,I YES. RETURN * * PROCESS END OF FILE CONDITION. * EOFPR NOP LDA P2 GET NODE2 LOGICAL UNIT. JSB EQTYP STA B EQUIPMENT TYPE. * LDA B100 SET DEFAULT TO M.T. DEVICE. CPB B2 XOR B1100 PUNCHED TAPE - TRAILER. CPB D10 IOR B1100 LINE PRINTER - PAGE EJECT. IOR P2 INSERT LOGICAL UNIT. STA TEMP * JSB DEXEC PERFORM I/O CONTROL. DEF *+5 DEF NODE2 DEF ICOD3 CONTROL, NO-ABORT DEF TEMP FORMATTED CONTROL WORD. DEF MD1 USED ONLY FOR LP. JMP ASCER ERROR RETURN * JMP EOFPR,I RETURN HED REMAT: ST REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * ST,NAMR1,NAMR2 [,FORMAT [,MODE]] * * STORE FROM NAMR1 LU OR FILE AT NODE1 INTO * NAMR2 FILE AT NODE2. MODE = TRANSFER MODE PARAMETER * IN FCOPY CALL (IF NON-ZERO, FILES ARE OPENED AS  * TYPE 1). * M0900 LDA NPRMS # OF PARAMS (INCLUDING CPA B2 COMMAND) = 2? JMP OTHER YES, MUST BE STATUS COMMAND LDA CP1 IOR B1 CPA B3 1ST PARAM ASCII (FILE NAME)? JMP M0960 YES, STORE FILE TO FILE * LDB CP2 NO, STORE LU TO FILE JSB ASCHK ERROR IF NOT A FILE NAME * JSB CKFMT * LDA D10 DEFAULT # BLOCKS TO 10. LDB SIZE2 SZB,RSS STA SIZE2 * LDB CP1 ERROR IF NO LU. JSB INTCK * LDA CRN2 LDB NODE2 DST TEMP BUILD ICR ARRAY FOR DCRET * * * * CREATE THE DISC FILE AT NODE2. * JSB DCRET CREATE FILE. DEF *+8 DEF UDCB DEF IERRR DEF P2 FILE NAME. DEF SIZE2 FILE-SIZE/REC-SIZE (2 WORDS) DEF TYPE2 FILE TYPE DEF SECU2 SECURITY CODE DEF TEMP ICR ARRAY (2 WORDS) * LDA IERRR CHECK FOR ERRORS IF IERRR NEG. SSA JSB ERCHK ISZ UOPNF SET UDCB OPEN FLAG. * JSB CKTTY SET ECHO BIT IF LU = TTY OR CRT M0905 JSB LUIN INPUT RECORD FROM LU JMP M0950 EOF FOUND IN INPUT * * WRITE THE RECORD ON NODE2 DISC FILE. * JSB DWRIT DEF *+5 DEF UDCB DEF IERRR DEF INBUF DEF INCNT * LDA IERRR CHECK FOR ERRORS. SSA JMP ST1 JSB IFBRK NO ERROR, IS BREAK FLAG DEF *+1 SET ? SZA,RSS JMP M0905 NO, GO READ NEXT RECORD. STA BRFLG YES, SAVE BREAK INDICATION * ST1 JSB DPURG ERROR. PURGE FILE. DEF *+6 DEF UDCB DEF TEMP DEF P2 FILE NAME. DEF P3 SECURITY. DEF P4 LABEL. * CLA CLEAR UDCB OPEN FLAG STA UOPNF JSB ERCHK DOES NOT RETURN * * END OF FILE ON INPUT. * M0950 JSB DCLOS CLOSE THE FILE DEF *+3 DEF UDCB DEF IERRR * CLA CLEAR UDCB OPEN FLAG. STA UOPNF * JMP QUERY * * STORE FROM FNAM1 AT NODE1 TO FNAM2 AT NODE2 * M0960 LDA CRN1 BUILD ICR LDB NODE1 ARRAYS FOR DST TEMP1 FCOPY CALL. LDA CRN2 LDB NODE2 DST TEMP2 * SPC 2 CALL JSB FCOPY DEF *+12 DEF P1 NODE1 FILE NAME DEF TEMP1 NODE1 CRN ARRAY DEF P2 NODE2 FILE NAME DEF TEMP2 NODE2 CRN ARRAY DEF IERRR DEF SECU1 DEF TYPE2 DEF SIZE2 DEF RSIZ2 DEF P4 XFER MODE DEF SECU2 SPC 3 * * ERROR PROCESSING * LDA IERRR GET ERROR CODE SZA,RSS ANY THING ? JMP QUERY NO, GO BACK * SSA ERROR OR WARNING ? JMP SER2 SOLID ERROR * JSB REIO TELL THE OPERATOR DEF *+5 THAT IT IS ONLY DEF ICOD2 A WARNING DEF LOGLU DEF WRNG DEF B6 JMP ABORT ERROR RETURN * JSB ERCHK THIS WILL DO THE REST * SER2 LDB A ADA D100 IS ERROR CODE IN ]-100,0[ ? SSA JMP ORER2 NO, IT MUST BE A NODE1 ERROR STB IERRR FOR ERCHK * JSB REIO TELL THE OPERATOR DEF *+5 THAT THE ERROR DEF ICOD2 WAS @ NODE2 DEF LOGLU DEF DSTER DEF B6 JMP ABORT ERROR RETURN * JSB ERCHK THIS WILL DO THE REST * ORER2 STA IERRR qW PREPARE IERRR FOR ERCHK * JSB REIO TELL THE OPERATOR THIS DEF *+5 IS A NODE1 ERROR DEF ICOD2 DEF LOGLU DEF ORGER DEF B6 JMP ABORT ERROR RETURN * JSB ERCHK GO AWAY * * SUBROUTINE TO SET LUTYP OF INPUT DEVICE * CKTTY NOP LDA NODE2 CHANGE NODE2 TO NODE1 STA TEMP TEMPORARILY FOR CALL LDA NODE1 TO EQTYP. STA NODE2 LDA P1 DETERMINE DEVICE TYPE JSB EQTYP OF NODE1 LU. LDB TEMP RESET NODE2 STB NODE2 STA LUTYP SAVE DEVICE TYPE OF NODE1 LU JMP CKTTY,I * * SUBROUTINE TO READ INPUT RECORD FROM NODE1 LU * LUIN NOP M0910 LDA LUTYP IF NODE1 DEVICE IS A TTY, SZA DISPLAY INPUT PROMPT CHAR. JMP M0920 * JSB DEXEC IT IS. DISPLAY PROMPT, BECAUSE DEF *+6 OF PERCEPTIBLE DELAY BETWEEN DEF NODE1 RECORDS DEF ICOD2 WRITE, NO-ABORT DEF P1 NODE1 INPUT DEVICE DEF IPRMP ASCII SLASH, SPACE. DEF MD3 JMP ASCER ERROR RETURN * M0920 LDA SUBF GET SUBFUNCTION IOR P1 INCLUDE INPUT LU STA TEMP SET UP CONWD FOR DEXEC * JSB DEXEC READ THE INPUT RECORD. DEF *+6 DEF NODE1 DEF ICOD1 READ, NO-ABORT DEF TEMP CONWD DEF INBUF DEF D128 JMP ASCER ERROR RETURN * STA TEMPM SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. * * CHECK FOR INPUT END OF FILE AT NODE1 LU * JSB EOFCK EOF? JMP LUIN,I YES, RETURN *+1 LDA INCNT CHECK FOR NULL NON-CARD INPUT. SZA,RSS JMP M0910 NO INPUT (TLOG=0), SO IGNORE JSB CKSUM DO CHECKSUM IF REQ'D JMP ERR07 CHECKSUM ERROR ISZ LUIN JMP LUIN,I RETURN *+2 SPC 2 ERR07 LDA B7 REPORT CHECKSUM ERROR JMP OPERS SPC 2 WRNG ASC 6,WARNING : sa DSTER ASC 6,NODE2 ERROR ORGER ASC 6,NODE1 ERROR HED REMAT: LL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * LL [,LISTLU [,LOGLU]] * * CHANGE THE CURRENT LIST DEVICE AND/OR LOG DEVICE TO THE * PARAMETER VALUES GIVEN. IF NEITHER PARAMETER IS GIVEN, * THE CURRENT LIST AND LOG LU'S ARE DISPLAYED ON THE LOGLU. * M1600 LDA CP1 SZA,RSS PARAM 1 PRESENT? JMP M1650 NO LDA P1 YES, CHANGE LISTLU STA LSTLU LDA CP2 SZA,RSS PARAM 2 PRESENT? JMP QUERY NO M1625 LDA P2 YES, CHANGE CURRENT LOGLU SZA,RSS CHECK FOR JMP OPER LOGLU IN AND LUMSK 1-77B RANGE. SZA JMP OPER LDA P2 GET 2ND PARAM AGAIN IOR VBIT IN CASE IT'S A PRINTER STA LOGLU SAVE LOGLU JMP QUERY * M1650 LDA CP2 SZA PARAM 2 PRESENT? JMP M1625 YES * LDA LSTLU NO. ISOLATE LIST LU. AND B77 STA TEMP * JSB CNUMD CONVERT CURRENT DEF *+3 LISTLU TO ASCII. DEF TEMP DEF LLMSG+4 * LDA LOGLU GET LOGLU AND B77 STRIP V-BIT STA TEMP SET UP CNUMD CALL JSB CNUMD CONVERT CURRENT DEF *+3 LOGLU TO ASCII. DEF TEMP DEF LLMSG+16 * JSB REIO DISPLAY CURRENT VALUES DEF *+5 OF LISTLU AND LOGLU. DEF ICOD2 DEF LOGLU DEF LLMSG DEF D19 JMP ABORT ERROR RETURN * JMP QUERY SPC 2 LLMSG ASC 19,LISTLU =XXXXXX LOGLU = XXXXXX LUMSK OCT 177700 HED REMAT: RW REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * RW PROCESSOR * * RW,PNAME [,P1 [,P2 [,P3 [,P4 [,P5]]]]] * OR * RW,PNAME [, ] * * SCHEDULE PROGRAM (PNAME) TO RUN AT NODE1 WITH WAIT. * PASSES UP TO 5 OPTIONAL SCHEDULE PARAMETERS * OR A STRING OF UP TO 70 ASCII CHARACTERS * TO THE SCHEDULED PROGRAM. * * M2001 LDB CP1 FIRST PARAM MUST JSB ASCHK BE ASCII. * LDA "R" GET TERM/TEST WORD LDB BUFAD GET INBUF ADR CLE,ELB MAKE IT A BYTE ADR SFB LOOK FOR "R" IN "RW" INB,RSS FOUND IT. MOVE TO NEXT BYTE JMP OPER NOT FOUND LDA "U" REPLACE "RW" WITH "RU" SBT * CCB PRE-SET B TO KNOWN VALUE JSB DEXEC REMOTE SCHED-WITH-WAIT DEF *+11 DEF NODE1 DEF ICOD9 DEF P1 PROG NAME DEF P2 UP TO 5 OPTIONAL SCHED-PARAMS DEF P3 DEF P4 DEF P5 DEF P6 DEF INBUF STRING BUFFER ADR DEF INCNT BUFR COUNT * JMP ASCER ERROR RETURN SZA STATUS = 0? JMP ILSTA NO, ILLEGAL STATUS CPB MD1 ANY RETURN PARAMS? JMP QUERY NO, B HAS NOT CHANGED * STB TEMP YES, SAVE 1ST RETURN PARAM ADR LDA BUFAD ADA D23 STA TEMP1 ADR FOR ASCII PARAMS LDA MD5 SET LOOP COUNT STA TEMP2 * RW01 LDA B,I GET RETURN PARAM STA TEMP1,I SET INTO PRINT BUFR INB BUMP PARAM POINTER ISZ TEMP1 & PRINTBUF POINTER. ISZ TEMP2 BUMP COUNT JMP RW01 LOOP UNTIL DONE * LDB BUFAD GET PRINTBUF POINTER LDA MD5 SET COUNTER TO STORE STA TEMP2 PARAMS IN OCTAL FORMAT JSB OCT6 CONVERT & STORE 1 PARAM ISZ TEMP2 BUMP COUNTER JMP *-2 LOOP UNTIL DONE * JSB STBLK STORE JSB STBLK THREE JSB STBLK DOUBLE BLANKS. * JSB REIO DISPLAY LINE ON LOGLU DEF *+5 DEF ICOD2 DEF LOGLU DEF INBUF DEF D28 JMP ABORT ERROR RETURN * JMP QUERY * ILSTA JSB REIO PRINT "ILLEGAL STATUS" MSG DEF *+5 DEF ICOD2 DEF LOGLU DEF ILMSG m DEF B7 JMP ABORT ERROR RETURN * JMP RESET SPC 2 * * SUBROUTINE TO CONVERT TO ASCII & STORE ONE WORD * OCT6 NOP JSB STBLK STORE DOUBLE BLANK LDA TEMP,I GET PARAM ALF AND B17 ISOLATE HIGH 2 DIGITS JSB CVOCT CONVERT 1ST & 2ND DIGITS ALF,ALF RAL,RAL JSB CVOCT CONVERT 2ND & 3RD DIGITS JSB CVOCT CONVERT 4TH & 5TH DIGITS ISZ TEMP BUMP PARAM POINTER JMP OCT6,I SPC 2 CVOCT NOP STA TEMP1 AND B70 ISOLATE LEFT DIGIT ALF,RAL IOR HZERO FORM ASCII DIGIT STA TEMPM SAVE IT LDA TEMP1 GET 2 DIGITS BACK AND B7 ISOLATE RIGHT DIGIT IOR LZERO IOR TEMPM STA B,I INB LDA TEMP,I JMP CVOCT,I SPC 2 STBLK NOP LDA DBBLK STA B,I INB JMP STBLK,I SPC 2 ILMSG ASC 7,ILLEGAL STATUS HED REMAT: LI REQUEST * (C) HEWLETT-PACKARD CO. 1979 SPC 3 * * LI PROCESSOR * * LI,NAMR,LU * * LIST CONTENTS OF NODE1 FILE 'NAMR' * TO A NODE2 LU (DEFAULT = LSTLU). * M2801 LDB CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDB CP2 GET 2ND PARAM FLAG SZB LU GIVEN? JSB INTCK YES, MUST BE NUMERIC LDA LSTLU GET DEFAULT LIST LU SZB,RSS LU GIVEN? STA P2 NO, USE DEFAULT * LDA NODE1 STA CRN1+1 FORMAT THE ICR ARRAY * JSB DOPEN OPEN THE FILE AT NODE1 DEF *+7 DEF UDCB DEF IERRR DEF P1 NAME DEF B0 OPTION DEF SECU1 SECURITY DEF CRN1 ICR ARRAY * SSA JSB ERCHK OPEN ERROR * ISZ UOPNF SET UDCB OPEN FLAG LDA B1 STA REC# RESET THE RECORD NUMBER * JSB .DFER STORE THE FILE NAME IN THE TITLE DEF TITL+1 DEF P1 B* JSB DLOCF GET THE FILE TYPE AND SIZE TO DEF *+9 INCLUDE IN THE TITLE DEF UDCB DEF IERRR DEF TEMP DEF TEMP DEF TEMP DEF SIZ DEF TEMP DEF TYP * LDA SIZ CONVERT THE NUMBER OF SECTORS INTO CLE,ERA THE NUMBER OF BLOCKS. SEZ INA STA SIZ * LDA AS.M1 GET ASCII "-1" LDB TYP GET FILE TYPE INB,SZB,RSS TYPE = -1 (CTU FILE)? JMP M2805 YES, GO SET "-1" INTO TYP JSB CNUMD NO, CONVERT TYPE DEF *+3 AND NODE TO ASCII DEF TYP AND STUFF INTO TITLE. DEF P3 USE P3 AS TEMP BUFR LDA P3+2 M2805 STA TYP * JSB CNUMD CONVERT SIZE DEF *+3 DEF SIZ DEF P3 DLD P3+1 DST SIZ * JSB CNUMD DEF *+3 DEF NODE1 DEF NOD * JSB DEXEC NOW THE TITLE IS READY, PRINT IT DEF *+6 DEF NODE2 DEF ICOD2 WRITE, NO-ABORT DEF P2 LU DEF TITL DEF D36 LENGTH JMP ASCER ERROR RETURN * LDA P2 PREPARE CONTROL WORD FOR LINE SKIP ADA B1100 STA TEMP * JSB DEXEC DEF *+5 DEF NODE2 DEF ICOD3 CONTROL, NO-ABORT DEF TEMP CONWD DEF B1 SKIP ONE LINE JMP ASCER ERROR RETURN * LOOP JSB DREAD READ A RECORD DEF *+6 DEF UDCB DEF IERRR DEF RECRD BUFFER DEF D128 REQUESTED LENGTH DEF LEN ACTUAL READ LENGTH * LDB LEN CPB MD1 LENGTH = -1 (I.E. EOF) ? JMP DONE YES, OUT CPA MD12 EOF ? (IERR=-12) JMP DONE YES SSA JSB ERCHK READ ERROR * JSB CNUMD CONVERT RECORD NUMBER DEF *+3 TO ASCII AND STUFF DEF REC# INTO PRINT LINE. DEF P3 USE P3 AS TEMP BUFR DLD P3+1  DST HEDR2 * SPC 2 * * THIS ROUTINE WILL SHIFT TO THE RIGHT THE LINE NUMBER * AND REPLACE THE LEADING BLANKS BY ZEROS. * LDA HEDR2+1 GET LAST 2 DIGITS AND B377 ISOLATE LOW DIGIT STA TEMP SAVE FOR LATER LDA HEDR2+1 GET LAST 2 DIGITS AGAIN AND HB377 KEEP UPPER BYTE CPA BLANK IS IT A BLANK? LDA HZERO YES REPLACE BY A HIGH 0 IOR TEMP MERGE WITH LAST DIGIT STA HEDR2+1 SAVE IN HEADER LDA HEDR2 GET FIRST 2 DIGITS AND B377 KEEP LOWER BYTE CPA LOBLK IS IT A BLANK? LDA LZERO YES, REPLACE BY A LOW ZERO STA TEMP SAVE LDA HEDR2 GET FIRST DIGITS AGAIN AND HB377 KEEP UPPER BYTE CPA BLANK IS IT A BLANK? LDA HZERO YES, REPLACE BY A HIGH ZERO IOR TEMP MERGE WITH SECOND DIGIT STA HEDR2 SAVE * LDA LEN ADD 4 TO THE BUFFER ADA B4 LENGTH FOR THE HEADER WORDS STA LEN * JSB DEXEC DEF *+6 DEF NODE2 DEF ICOD2 WRITE, NO-ABORT DEF P2 LU DEF HEDR1 BUFFER DEF LEN LENGTH JMP ASCER ERROR RETURN * ISZ REC# UPDATE THE RECORD NUMBER * JSB IFBRK DO THEY WANT TO STOP ? DEF *+1 SZA,RSS JMP LOOP NO,CONTINUE STA BRFLG YES, SAVE BREAK INDICATOR * DONE JSB DCLOS CLOSE THE FILE DEF *+3 DEF UDCB DEF IERRR * SSA ERROR? JSB ERCHK YES, REPORT IT (WON'T RETURN) * CLA CLEAR UDCB OPEN FLAG STA UOPNF JSB EOFPR PAGE-EJECT IF LP JMP QUERY * * LOCAL STORAGE AND CONSTANTS * AS.M1 ASC 1,-1 LEN NOP HEDR1 OCT 20040 HEDR2 NOP NOP OCT 20040 DOUBLE BLANK * * RECRD BSS 128 * * REC# NOP TITL OCT 20040 REP 3 NOP ASC 5, TYPE: TYP NOP [ ASC 11, NUMBER OF BLOCKS: SIZ NOP NOP ASC 10, LOCATED AT NODE: NOD NOP NOP NOP * * HED REMAT: DL REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * DL [,NAMR [,MSECU [,LISTLU]]] * * LIST NODE1 FILE DIRECTORY AT LOCAL LISTLU. * NAMR = NAME, CRN & TYPE FILTER FOR REMOTE DISC * OR FLOPPY BASED SYSTEM, OR LU OF CTU FOR CTU BASED SYSTEM. * M0300 LDB CP1 CHECK P1 TYPE CPB B1 NUMERIC? RSS YES, P1 = CRN OR -LU JMP M0302 NO, MAY BE NAME FILTER JSB .DFER MOVE DASHES TO REQST DEF DLSN1 DEF DASHS LDA P1 MOVE CRN OR -LU JMP M0310 TO REQST. * M0302 SZB FILTER SPECIFIED? JMP M0305 YES LDA DBBLK NO. SET FIRST WORD TO BLANKS STA P1 M0305 JSB .DFER MOVE NAME TO REQST DEF DLSN1 DEF P1 * LDA TYPE1 TYPE FILTER SPECIFIED? SZA IOR HIBIT YES,SET SIGN BIT STA DTYP MOVE TYPE FILTER TO REQST * LDA CRN1 MOVE LABEL TO REQST M0310 STA MDCR * LDA P2 MOVE MASTER SECURITY CODE TO REQST STA DMCOD * LDA LSTLU GET DEFAULT LISTLU LDB CP3 LISTLU PARAM PRESENT? SZB,RSS NO, USE DEFAULT STA P3 * CLA INDICATE NEW REQUEST IN REQST STA NEWRQ * M0315 CLA,INA SET IN STREAM TYPE STA DSTRM * LDA D34 INDICATE 68 CHAR LINE IN REQST STA DLEN LDA NODE1 SET NODE IN REQST (REQST IS BEING STA DDEST SENT TO NODE1) * * SEND REQST & PRINT DIRECTORY ON LIST LU * JSB D65MS SEND REQUEST TO NODE1 DEF *+8 DEF CNWD1 NO ABORT. DATA ASSOC WITH REPLY DEF DSTRM REQST DEF D23 REQST LENGTH DEF DLDAT DATA BUFR DEF B0 NO DATA ASSOCIATED WITH REQST DEF D34 INCOMING DATA BUFR LENGTH DEF D23 MAX REPLY LENGTH  JMP ASCER ERROR RETURN * LDA DLST NORMAL RETURN. CHECK STATUS SZA,RSS DONE? JMP M0320 NO JSB LCALS FORCE LOCAL NODE FOR EQTYP CALL LDA P3 GET LOCAL LISTLU JSB EQTYP CHECK ITS EQUIPMENT TYPE JSB LCALC RESET NODE CPA D10 IS IT A LINE PRINTER? RSS JMP QUERY NO LDA P3 YES, SET UP EXEC CALL TO IOR B1100 DO A PAGE EJECT. STA TEMP * JSB EXEC LP PAGE EJECT DEF *+4 DEF B3 DEF TEMP DEF MD1 * JMP QUERY * M0320 JSB REIO PRINT A LINE ON LISTLU DEF *+5 DEF ICOD2 WRITE DEF P3 LISTLU DEF DLDAT DEF DLEN JMP ABORT ERROR RETURN * JSB IFBRK CHECK BREAK FLAG DEF *+1 SZA,RSS IS IT SET? JMP M0315 NO, GET ANOTHER LINE STA BRFLG YES, SAVE BREAK INDICATOR JMP QUERY AND GET NEXT COMMAND. * DLDAT BSS 34 DLIST DATA BUFR DASHS ASC 3,------ SKP HED REMAT: CL REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * CL [,LISTLU] * * LIST NODE1 CARTRIDGE DIRECTORY AT LOCAL LIST LU * M3000 LDA CP1 CHECK P1 TYPE. SZA CPA B1 NUMERIC LU? RSS JMP ERR56 NO. ERROR. * DLD CP1 MOVE LIST LU DST CP3 FOR 'DL' PROCESSOR. DLD CLFLG SET FILTER =-1; FILTER+1 =0 DST P1 TO INDICATE A CARTRIDGE LIST REQUEST. CLA SEND A CLEAN STA P2 REQUEST BUFFER. JMP M0305 USE THE 'DL' PROCESSOR. * CLFLG OCT -1,0 * HED REMAT: EX REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * EX PROCESSOR * * TERMINATE THE OPERATOR INTERFACE PROGRAM. * M0500 JSB REIO DISPLAY TERMINATION MESSAGE DEF *+5 ON LOG DEVICE. DEF ICOD2 DEF LOGLU DEF TRMSG DEF B6 JMP ABORT ERROR RETURN * JSB CLSFL CLOSE OPEN FILES. * JSB EXEC EXIT. DEF *+2 DEF B6 * TRMSG ASC 6, $END REMAT * HED REMAT: SW REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * SW [,NODE1 [,NODE2 [,SECURITY CODE]]] * OR * SW,LOCAL * * SELECT NODE1 AND/OR NODE2 FOR SUBSEQUENT OPERATOR * REQUESTS. IF NO PARAMETERS ARE GIVEN, DISPLAYS THE * CURRENT VALUES OF NODE1 AND NODE2. 'SW,LOCAL' SETS BOTH * NODES TO THE LOCAL NODE #. THE SECURITY CODE * SET IN 'LSTEN' MUST BE ENTERED IN ORDER TO SWITCH * FROM A LOCAL NODE TO A REMOTE NODE. * M0990 LDA CP1 SEE IF VALUE SUPPLIED SZA IF NOT SUPPLIED, PRINT CURRENT VALUE JMP M0991 SUPPLIED LDA CP2 IS PARAM 2 HERE ? SZA JMP M0991 YES SW MOD * LDA NODE1 NO, CHECK FOR NEG. LU SSA CMA,INA MAKE POSITIVE FOR CNUMD CALL STA TEMP JSB CNUMD SW DISPLAY FUNCTION DEF *+3 DEF TEMP DEF ORNM LDB MSIGN IF NODE1 IS LDA NODE1 NEGATIVE, THEN SSA INSERT MINUS SIGN STB ORNM+1 INTO DISPLAY BUFR. * LDA NODE2 REPEAT FOR NODE2 SSA CMA,INA STA TEMP JSB CNUMD DEF *+3 DEF TEMP DEF DSTNM LDB MSIGN LDA NODE2 SSA STB DSTNM+1 * JSB REIO DISPLAY MESSAGE DEF *+5 DEF ICOD2 DEF LOGLU DEF SWBUF DEF D15 MESSAGE LENGTH JMP ABORT ERROR RETURN * JMP QUERY GET ANOTHER REQUEST * M0991 LDB CP1 CPB B2 1ST PARAM ASCII? JMP SWALF YES, CHECK FOR "LOCAL" SZB,RSS NO, IS IT MISSING? JMP SW1 YES, GO CHECK 2ND PARAM LDA P1 NO, GET IT CPA #NODE DOES HE WANT NODE1 LOCAL? RSS YES, GO CHECK 2ND PARAM JMP SW2 NO, WANTS REMOTE. CHECK HIM OUT * SW1 LDB CP2 SZB,RSS  2ND PARAM MISSING? JMP M0992 YES, LET HIM DO IT LDA P2 NO, GET IT CPA #NODE DOES HE WANT NODE2 LOCAL? JMP M0992 YES, ALLOW SWITCH SW2 LDA PRMPT NO, CHECK HIM OUT CPA "#" IS HE ALREADY REMOTE? JMP M0992 YES, LET HIM DO WHAT HE WANTS LDB CP3 GET 3RD PARAM FLAG JSB ASCHK IF NOT ASCII, WON'T RETURN LDB P3 GET 3RD PARAM UNL OCT 60001,2011,23,2011 JMP *-2 AND *+7 IOR *+7 STA *+1 OCT 0,7000,60001 JMP *+5 OCT 17,100020,2003,5477 LST CPB #SWRD SAME AS SECURITY CODE? RSS YES, ALLOW SWITCH JMP OPER NO, SWITCH NOT ALLOWED M0992 LDA NODE1 DEFAULT LDB CP1 CPB B1 PARAM NUMERIC ? LDA P1 YES, GET IT STA NODE1 SAVE IT LDB NODE2 DEFAULT LDA CP2 GET 2ND PARAM FLG CPA B2 2ND PARAMETER ALPHAMERIC? JMP OPER YES, ERROR CPA B1 NUMERIC? LDB P2 OK GET 2ND PARAM STB NODE2 SAVE IT JMP QUERY GO BACK FOR NEXT COMMAND * SWALF DLD P1 GET THE FIRST 2 WORDS OF THE ALFAMERIC PARAMETER CPA ALO FIND IF THIS IS A "LOCAL" SWITCH. RSS THAT'S CLOSE ENOUGH JMP OPER FORGET IT LDA #NODE GET THE LOCAL NODE NUMBER AGAIN STA NODE1 SAVE IT IN NODE1 STA NODE2 AND IN NODE2 JMP QUERY GO BACK FOR NEXT COMMAND. * SWBUF ASC 4,NODE1 = ORNM BSS 3 ASC 5, NODE2 = DSTNM BSS 3 ALO ASC 1,LO MSIGN ASC 1, - HED REMAT: TE REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * TE,-ASCII MESSAGE- PROCESSOR. * * SEND A MESSAGE TO THE NODE1 STATION OPERATOR. * M1000 EQU * JSB TELL1 CALCULATE BUFFER LNTH & ADD LOCAL NODE # JSB DMES1 SEND TO LOCAL NODE DEF NODE1 JMP ASCER REPORT ERROR JMP QUERY > RETURN TO CALLER SPC 1 XLA1 XLA XPNTR,I DMS INSTRUCTION FOR SCANNING NRV SPC 2 * "BROADCAST" REQUEST * BRCST NOP REPORT ERROR BUT CONTINUE JSB TELL1 CALCULATE BUFFER LNTH & MOVE LOCAL NODE # DLD #NCNT SET UP BROADCAST LOOP DST XCNTR BRLUP EQU * DMS1 LDA XPNTR,I GET NODE # (XLA XPNTR,I IF DMS) NOP (STORAGE RESERVED FOR XLA IF DMS) CPA #NODE SAME AS LOCAL? JMP BRLED YES, NO NEED TO BROADCAST TO OURSELVES STA XNODE SAVE NODE NUMBER JSB CNUMD CONVERT NODE # TO ASCII DEF *+3 DEF XNODE NODE # DEF BRCM1 MESSAGE JSB EXEC PRINT "BROADCASTING TO " DEF *+5 DEF B2 DEF LOGLU DEF BRCMS DEF BRCML JSB DMES1 SEND TELLOP DEF XNODE JSB BRCER LOG ERRORS BRLED EQU * SPC 1 LDA XPNTR ADVANCE ADA NRVSZ NRV STA XPNTR POINTER ISZ XCNTR END OF LOOP? JMP BRLUP NO, CONTINUE IN LOOP JMP QUERY YES, EXIT LOOP. SPC 2 BRCMS ASC 11,BROADCASTING TO NODE# BRCM1 BSS 3 STORAGE FOR NODE # BRCML ABS *-BRCMS SPC 2 BRCER NOP DST ASERM+4 SAVE RETURNED ASCII ERR MSG JSB EXEC DEF *+5 DEF ICOD2 WRITE DEF LOGLU DEF ASERM DEF B6 NOP IGNORE ERRORS JMP BRCER,I SPC 1 XNODE NOP XCNTR NOP BROADCAST LOOP COUNTER XPNTR NOP BROADCAST LOOP POINTER TELL1 NOP LDB CP1 SZB,RSS JMP OPER ERROR 10 IF NO MESSAGE. * CLB FIND THE COMMA IN INBUF. LDA BUFAD STA TEMP * M1010 LDA TEMP,I GET NEXT WORD. AND HB377 ALF,ALF CPA COM JMP M1020 COMMA IN LEFT BYTE. * LDA TEMP,I AND B377 CPA COM JMP M1030 COMMA IN RIGHT BYTE. * ISZ TEMP BU_ MP TO NEXT WORD. INB COUNT WORDS SKIPPED. JMP M1010 LOOP. * M1020 LDA TEMP,I LEFT. CLEAR COMMA AND B377 STA TEMP,I CMB,INB ADJUST WORD COUNT ADB INCNT STB INCNT CPB D37 IF EXACTLY 72 CHAR MESG, RSS ALLIGN MESSAGE TO WORD JMP M1040 BOUNDARY AND DECREMENT INCNT. LDA TEMP ADA D36 LDA A,I AND B377 CPA LOBLK RSS JMP M1040 LDB TEMP FORM DEST BYTE ADR CLE,ELB LDA B FORM SOURCE BYTE ADR INA MBT D72 ALLIGN TO WORD BOUNDARY LDA INCNT DECREMENT INCNT ADA MD1 STA INCNT JMP M1040 * M1030 ISZ TEMP RIGHT. BUMP TO NEXT WORD. INB * CMB,INB ADJUST WORD COUNT. ADB INCNT STB INCNT * M1040 EQU * JMP TELL1,I RETURN TO CALLER SPC 2 * SUBROUTINE TO SEND DMESG * JSB DMES1 * DEF * * * DMES1 NOP SUBROUTINE TO SEND DMESG LDA DMES1,I GET DEF TO NODE # STA DMES2 ISZ DMES1 JSB DMESG SEND MESSAGE TO NODE1 DEF *+4 DMES2 NOP ADDRESS OF NODE # DEF TEMP,I BUFFER DEF INCNT LENGTH. SZA,RSS ERROR? TAKE ERROR EXIT ISZ DMES1 NO ERROR, TAKE "GOOD" EXIT JMP DMES1,I RETURN TO CALLER HED REMAT: LO REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * LO PROCESSOR * * LO [,NAMR [,PARTITION # [,# PAGES]]] M-SYSTEMS * LO,NAMR L-SYSTEMS * * LOAD AN ABSOLUTE PROGRAM FROM A NODE1 FILE OR * LOCAL 'LU' (NAMR) TO AN RTE-M SYSTEM AT NODE2. * DEFAULT FOR NAMR IS LU 4 IN M-SYSTEMS. * * IN RTE-L SYSTEMS NAMR IS NOT OPTIONAL AND * LOADING FROM AN LU IS ILLEGAL. * M1400 LDB CP1 GET 1ST PARAM FLAG LDA B4 GET DEFAULT LOCAL LU (=4) SZB,RSS MISS!MING? STA P1 YES, USE DEFAULT LDA P1 NO, GET THE PARAM SZA,RSS IF ZERO, JMP OPER GIVE ERROR. * JSB .DFER SAVE FILE NAME DEF PB+10 OR LU IN DEF P1 REQUEST BUFFER. * * FORMAT 1ST APLDR SCHED-PARAM & SET INTO REQST BUFR * LDA LOGLU AND B77 SET FUNCTION CODE TO 1 IF BOTH ALF P2 & P3 ARE MISSING OR 0, ELSE TO IOR ICOD1 2. INCLUDE REMOTE BIT & LOGLU. SET LDB P2 INTO REQST BUFR. SZB,RSS LDB P3 SZB INA STA PB+8 * * FORMAT 2ND APLDR SCHED-PARAM & SET INTO REQST BUFR * LDB CP2 GET 2ND PARAM FLAG SZB MISSING? JSB INTCK NO, MUST BE NUMERIC LDA P2 GET PARTITION # PARAM AND B77 ISOLATE LOWER 6 BITS STA TEMP SAVE LDB CP3 GET 3RD PARAM FLAG? SZB MISSING? JSB INTCK NO, MUST BE NUMERIC LDA P3 GET # PAGES PARAM AND B37 ISOLATE LOWER 5 BITS ALF,ALF POSITION TO BITS 10:14 ALS,ALS IOR TEMP INCLUDE PARTITION # STA PB+9 SET INTO REQST BUFR * DLD SECU1 SET SECU CODE & CRN DST PB+13 INTO REQST BUFR. LDA NODE1 SET FILE NODE INTO STA PB+15 REQST BUFR. * LDA NODE2 SET REMOTE RTE-M STA PB+3 NODE # INTO REQST BUFR. * JMP M1505 GO FINISH UP & SEND REQST HED REMAT: FL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * FL(USH) PROCESSOR * * FL,NAMR,NODE # * * CLOSE FILE1 AT NODE1 (PREVIOUSLY SELECTED BY SW * COMMAND) TO ANY USER AT THE GIVEN NODE #. IF * NODE # = -1, CLOSE FILE1 TO USERS AT ALL NODES. * NOTE THAT ALL MAIN PARAMETERS ARE REQUIRED, * PLUS THE NAMR SUBPARAMETER 'CRN'. * THIS COMMAND IS ONLY ALLOWED FROM A TTY-TYPE * INPUT DEVICE. * * M2401 LDA LUTYP INPUT VLU MUST BE TTY SZA JMP ERR45 IT IS NOT * LDB CP1 GET 1ST PARAMETER FLAG JSB ASCHK MUST BE ASCII JSB .DFER SET FILE NAME DEF PB+5 INTO REQST BUFR DEF P1 AND INTO MESG JSB .DFER DEF FMSG1+3 DEF P1 * LDA CRN1 GET CRN SUBPARAMETER SZA,RSS GIVEN AND NON-ZERO? JMP OPER NO, GIVE INPUT ERROR STA PB+8 YES, SET INTO REQST BUFR * LDB CP2 GET 2ND PARAM FLAG JSB INTCK MUST BE NUMERIC LDA P2 GET 2ND PARAMETER SSA IS IT POSITIVE? CPA MD1 NO, THEN IT BETTER BE -1 RSS IT IS. OK JMP OPER IT ISN'T. ERROR * STA PB+9 SET P2 INTO REQST BUFR SSA NODE # POSITIVE? JMP M2410 NO JSB CNUMD YES, CONVERT NODE # DEF *+3 DEF P2 NODE # DEF FMSGA+3 LDA .FMGA MOVE NODE # LDB .FMG2 MVW D8 LDA D27 SET MSG LENGTH STA TEMP FOR REIO CALL JMP M2415 * M2410 LDA .FMGB MOVE "ALL NODES" TO LDB .FMG2 OUTPUT MSG MVW B7 LDA D26 SET MSG LENGTH STA TEMP FOR REIO CALL * M2415 JSB CNUMD CONVERT NODE1 DEF *+3 DEF NODE1 DEF FMSG1+10 * JSB REIO OUTPUT MESSAGE TO LOGLU DEF *+5 DEF ICOD2 DEF LOGLU DEF FMSG1 DEF TEMP MSG LENGTH JMP ABORT ERROR RETURN * LDA P.STK,I GET INPUT LU IOR B400 INCLUDE ECHO BIT STA TEMP SET CONWD FOR REIO * JSB REIO DEF *+5 DEF ICOD1 DEF TEMP CONWD DEF TEMP+1 INPUT BUFR DEF B1 MAX INPUT LENGTH JMP ABORT ERROR RETURN * LDA TEMP+1 GET INPUT CPA "NO" WAS ANSWER "NO"? JMP QUERY YES, SO GET NEXT COMMAND CPA "YE" WAS ANSWER "YES"? + RSS YES, CONTINUE JMP OPER MUST BE "YES" OR "NO". ERROR * LDA B6 SET STREAM, STA PB DEST, AND LDA NODE1 FCODE INTO STA PB+3 REQST BUFR LDA D13 STA PB+4 * JSB D65MS SEND REQST BUFR TO NODE1 DEF *+8 DEF CNWD1 NO ABORT DEF PB REQST BUFR DEF D10 REQST BUFR LENGTH DEF * DUMMY DATA BUFR DEF B0 NO DATA ASSOCIATED WITH REQST DEF B0 NO DATA ASSOCIATED WITH REPLY DEF D10 MAX REQST/REPLY LENGTH * JMP ASCER PROCESS ASCII ERROR CODE LDA PB+5 CHECK NUMERIC CODE STA IERRR IN THE REPLY SSA IF NEGATIVE. JSB ERCHK JSB CNUMD CONVERT # ENTRIES DEF *+3 DEF PB+5 FLUSHED TO ASCII AND DEF FMSG3+12 SET INTO MESSAGE. * JSB REIO OUTPUT MESSAGE TO LOGLU DEF *+5 DEF ICOD2 DEF LOGLU DEF FMSG3 DEF D15 JMP ABORT ERROR RETURN * JMP QUERY GET NEXT COMMAND * ERR45 LDA D45 REPORT ERROR JMP OPERS SPC 1 FMSG1 ASC 19,CLOSE AT NODE TO USERS AT FMSG2 BSS 8 .FMG2 DEF FMSG2 .FMGA DEF *+1 FMSGA ASC 8, NODE ? _ * .FMGB DEF *+1 FMSGB ASC 7, ALL NODES? _ * FMSG3 ASC 15,# RFAM ENTRIES FLUSHED = XXXXX "YE" ASC 1,YE "NO" EQU SWBUF ASCII "NO" HED REMAT: PU REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * PU PROCESSOR * * PU,NAMR * * PURGE A FILE 'NAMR' AT NODE1. * * M2501 LDA CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDA NODE1 STA CRN1+1 FORMAT THE CRN ARRAY * JSB DPURG PURGE THE FILE DEF *+6 DEF UDCB DEF IERRR DEF P1 FILE NAME DEF SECU1 SECURITY CODE DEF CRN1 CRN ARRAY * SSA JSB ERCHK ANY ERROR ?o JMQP QUERY GET NEXT REQUEST HED REMAT: RN REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * RN PROCESSOR * * RN,NAMR,NEW NAME * * RENAME A FILE AT NODE1. * * M2550 LDB CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDB CP2 GET 2ND PARAM FLAG JSB ASCHK NEW NAME MUST BE ASCII * LDA NODE1 STA CRN1+1 FORMAT CRN ARRAY * JSB DNAME RENAME THE FILE DEF *+7 DEF UDCB DEF IERRR DEF P1 OLD NAME DEF P2 NEW NAME DEF SECU1 SECURITY CODE DEF CRN1 CRN ARRAY * SSA JSB ERCHK ANY ERROR ? JMP QUERY GET NEXT HED REMAT: CR REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * CR PROCESSOR * * CR,NAMR * * CREATE A FILE AT NODE1. * * M2701 LDB CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDA SIZE1 GET # BLOCKS PARAM ADA MD1 ERROR IF <= 0 SSA JMP OPER * LDA CRN1 FORMAT THE LDB NODE1 CRN ARRAY DST TEMP * JSB DCRET CREATE THE FILE DEF *+8 DEF UDCB DEF IERRR DEF P1 NAME DEF SIZE1 # BLOCKS/REC-SIZE (2-WORD ARRAY) DEF TYPE1 TYPE DEF SECU1 ISECU DEF TEMP CRN ARRAY (2 WORDS) * SSA JSB ERCHK * JSB DCLOS CLOSE THIS NEW FILE DEF *+3 DEF UDCB DEF IERRR * SSA JSB ERCHK ERROR JMP QUERY GET NEXT HED REMAT: IO REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * IO REQUEST (L-SERIES ONLY) * * IO (ANY PARAMETERS IGNORED) * * LIST THE SYSTEM I/O CONFIGURATION FROM NODE1 TO THE LIST LU * AT THE LOCAL NODE. * * M1450 LDA LSTLU OUTPUT TO LIST LU. AND B77 ALF POSITION FOR REQUEST. IOR HIBIT REMOTE BIT. IOR B5 I/O FCN CODE FOR APLDR-L. fSTA PB+8 SET IN REQUEST BUFFER. JMP M1504 SET REMOTE NODE & SCHED APLDR. HED REMAT: PL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * PL REQUEST * * PL [,LIST LU [,OPT]] M-SYSTEMS (OPT IS INTEGER) * PL [,OPT] L-SYSTEMS (OPT IS ASCII) * * LIST PROGRAM INFO FROM NODE1 TO THE LISTLU (DEFAULT IS LOGLU) * AT THE LOCAL NODE. IF OPT=0, LIST ALL PROGRAMS, * PRIORITIES, & BOUNDS. IF OPT=1, LIST PARTITIONS & * THEIR PROGRAMS, PARTITION SIZE, AND PAGE #. * * IN L-SYSTEMS, OPT CAN BE ONE OF THE PROGRAM STATUS CODES * DESCRIBED IN THE RTE-L DOCUMENTATION WHICH WILL CAUSE A * SELECTIVE LIST OF ONLY THOSE PROGRAMS WITH THAT STATUS. * THERE ARE 2 ADDITIONAL OPTIONS: 'IT' (LIST TIME-LISTED * PROGRAMS) AND 'MB' (LIST MEMORY BOUNDS OF EACH PROGRAM). * IF NO OPTION IS SPECIFIED, ALL PROGRAMS, THEIR STATUS, * PRIORITY, AND POINT OF SUSPENSION ARE LISTED. * M1500 CLA STA PB+10 LDB CP1 GET TYPE FLAG PRAM #1. CPB B1 NUMERIC? JMP M1502 YES. LDA P1 GET 1ST PARAM. CPB B2 ASCII? STA PB+10 YES. STORE IN REQUEST. JMP M1503 * M1502 LDA P1 GET 1ST PARAM SZA,RSS ZERO OR MISSING? M1503 LDA LSTLU YES, USE DEFAULT LIST LU AND B77 ALF POSITION LIST LU IOR HIBIT INCLUDE REMOTE-BIT STA PB+8 SET INTO REQST BUFR * LDB CP2 GET 2ND PARAM FLAG SZB MISSING? JSB INTCK NO, MUST BE NUMERIC LDA P2 GET 2ND PARAM STA PB+9 SET INTO REQST BUFR * M1504 LDA NODE1 SET REMOTE NODE # STA PB+3 INTO REQST BUFR. * M1505 LDA B3 SET STREAM TYPE STA PB INTO REQST BUFR. * LDA D9 SET ICODE TO SCHED- STA PB+4 WITH-WAIT. * JSB .DFER SET "APLDR"  DEF PB+5 INTO REQST BUFR. DEF APNAM SPC 2 * * HERE WE SEND REQST TO SCHEDULE A PLDR WITH WAIT * TO DO A DOWN LOAD, PROGRAM LIST, OR IO (L-SERIES). * CONTROL WILL BE RETURN WHEN APLDR IS COMPLETE * LOPL1 JSB D65MS SEND REQUEST TO SPECIFIED NODE DEF *+8 DEF CNWD2 NO ABORT, LONG TIMEOUT DEF PB REQST BUFR DEF D16 REQST LENGTH DEF * DUMMY DATA BUFR DEF B0 NO DATA ASSOCIATED WITH REQST DEF B0 NO DATA ASSOCIATED WITH REPLY DEF D16 MAX REQST/REPLY LENGTH JMP ASCER ERROR RETURN * LDB ECOD2 GET B-REG VALUE FROM REPLY SZB,RSS ANY RETURN PARAMETERS? JMP QUERY NO * LDA PB+7 YES, GET 1ST PARAM CPA HIBIT SPECIAL I/O ERROR INDICATOR? RSS YES, APLDR UNABLE TO PRINT MESSAGE JMP QUERY NO, APLDR PRINTED ALL MESSAGES DLD PB+8 GET 2ND TWO RETURN PARAMS (ASCII JMP ASCER ERROR CODE) AND DISPLAY. SPC 2 PB BSS 31 COMMON BUFFER FOR REQST'S SPC 1 * * DLIST REQST/REPLY BUFFER * DSTRM EQU PB STREAM TYPE DDEST EQU PB+3 REQST DESTINATION NODE # DLST EQU PB+7 STATUS DLEN EQU PB+8 PRINT LINE LENGTH NEWRQ EQU PB+9 NEW REQ FLAG (0=NEW REQ) DLSN1 EQU PB+10 FILE NAME FILTER (3 WORDS) DLSN3 EQU PB+12 DMCOD EQU PB+13 SECURITY CODE MDCR EQU PB+14 LABEL DTYP EQU PB+15 FILE TYPE * ECOD1 EQU PB+4 ERROR CODES ECOD2 EQU PB+5 IN REPLY ECOD3 EQU PB+6 BUFR. SPC 2 APNAM ASC 3,APLDR HED REMAT: SL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * SLAVE PROGRAM LIST REQUEST * SLIST (,LIST LU) * * LIST ALL PTOP SLAVE PROGRAMS AT NODE1 * ON THE LOCAL LIST LU * * * M1700 LDA CP1 SEE IF LIST LU SUPPLIED LDB LSTLU GET DEFAULT CPA B1 IF TYPE=1 USE SUPPLIED RSS YES...DON'T USE DEFAULT STB P1 SAVE FOR PRINTING LDA DBBLK GET SPACE WORD STA CP3 SAVE FOR NAME MOVE * LDA B7 "SL" FUNCTION CODE JSB PTPSB GO FORMAT REQUEST AND CALL D65MS DEC 128 DATA BUFFER SIZE * JSB REIO PRINT HEADER MESSAGE DEF *+5 DEF ICOD2 DEF P1 DEF HDMSG DEF D10 JMP ABORT ERROR RETURN * LDA BUFAD GET READ BUFFER ADDRESS LDB 0,I 1ST WORD HAS # OF ENTRIES CMB,INB,SZB,RSS JMP LPFOR NO ENTRIES STB COUNT SET LOOP COUNTER INA POINT TO 1ST NAME * RDLOP STA RTEMP SET NAME BUFFER POINTER * JSB .DFER MOVE NAME TO PRINT AREA DEF P3 RTEMP NOP * JSB REIO WRITE OUT LINE DEF *+5 DEF ICOD2 DEF P1 WRITE LU DEF CP3 DEF MD7 7 CHARACTERS JMP ABORT ERROR RETURN * LDA RTEMP ADA B3 GET TO NEXT ENTRY ISZ COUNT BUMP COUNTER JMP RDLOP GET NEXT ENTRY * LPFOR JSB LCALS SEE IF IT IS THE LINE-PRINTER LDA P1 GET LU JSB EQTYP GET EQT TYPE JSB LCALC CPA D10 LP? RSS YES JMP QUERY NO LDA P1 IOR B1100 OR IN CONTROL WORD STA P1 * JSB EXEC DO A PAGE EJECT DEF *+4 DEF B3 DEF P1 DEF MD1 * JMP QUERY AND RETURN FOR NEXT ENTRY SPC 1 COUNT NOP HDMSG ASC 10, ACTIVE SLAVE PROGS HED REMAT: SO REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * SO REQUEST * SO [,PNAME] * * TERMINATES A PTOP SLAVE PROGRAM AT NODE1. IF NO * PROGRAM IS SPECIFIED, TERMINATES ALL CURRENT * PTOP SLAVES AT THE NODE1 CPU. * M1800 JSB .DFER MOVE NAME INTO REQUEST DEF PB+8 DEF P1 * LDA B6 "SO" IS PTOP FUNCTION 6 JSB PTPSB FORMAT REQUEST AND CALL D65MS DEC 0 NO DATA BUFFER * JMP QUERY RETURN SPC 4 * * THIS SUBROUTINE IS USED IN COMMON FOR "SO" AND "SL". IT * FORMATS THE PTOP REQUEST AND CALLS D65MS TO SEND THE * REQUEST AND GET THE REPLY (AND DATA). * PTPSB NOP STA $FUNC SAVE PTOP FUNCTION CODE LDA B4 STA PB SET STREAM TYPE (4) LDA NODE1 STA PB+3 SET REQST DESTINATION NODE CLA STA ECOD1 INITIALIZE ERROR FIELDS STA ECOD3 * JSB D65MS SEND REQ (& RCV DATA IF SL) DEF *+8 DEF CNWD1 NO ABORT DEF PB DEF D11 11 WORD REQUEST DEF INBUF DEF B0 NO DATA ASSOCIATED WITH REQST DEF PTPSB,I INCOMING DATA BUFR LENGTH DEF D11 JMP ASCER D65MS DETECTED ERROR * ISZ PTPSB JMP PTPSB,I RETURN * $FUNC EQU PB+7 * * HED REMAT: LC REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * $LC * * DISPLAY LOCAL NODE # ON LOGLU. * * M2100 LDA #NODE GET LOCAL NODE # STA P3 SAVE IT TEMPORARILY JSB CNUMD CONVERT TO ASCII DEF *+3 DEF P3 DEF PRMG1 * JSB REIO SEND MESSAGE DEF *+5 DEF ICOD2 DEF LOGLU DEF PRBUF DEF D10 JMP ABORT ERROR RETURN * JMP QUERY GO BACK FOR MORE INPUT SPC 2 * * PRBUF ASC 7,LOCAL NODE = PRMG1 ASC 3, XXXXX HED REMAT: SUBROUTINES * (C) HEWLETT-PACKARD CO. 1979 * * SUBROUTINE TO CALCULATE ACTUAL CHECKSUM AND COMPARE * IT TO THE CHECKSUM IN THE INPUT RECORD. RETURNS *+1 * IF ERROR DETECTED, ELSE *+2. EXPECTS RECORD TO BE IN * 'INBUF', AND 'CSFLG' TO BE SET AS FOLLOWS: 0=NO CHECKSUM, * "BR"=BINARY RELOCATABLE RECORD, "AB"=ABSOLUTE RECORD. * CKSUM NOP LDA CSFLG SZA,RSS CHECKSUM REQUIRED? JMP CK4 NO * LDA INBUF CHECK RECORD LENGTH ALF,ALF IN WORD 1. STA RLEN CMA,INA ADA B377 SSA OK? JMP CKSUM,I NO, TAKE ERROR RETURN (*+1) * LDA INBUF+1 START CALCULATED CKSUM STA CSCAL WITH WORD 2. * LDA MD1 CALCULATE OFFSET OF -1 LDB CSFLG FOR BR, +1 FOR BA CPB "BR" BR? JMP CK1 NO LDA B1 YES, SET OFFSET TO +1 LDB CSCAL AND ADD WORD 3 TO CKSUM ADB INBUF+2 STB CSCAL * CK1 ADA RLEN COMPUTE LAST WORD ADR = ADA BUFAD RECORD LENGTH + BUFR ADR STA BPLST + OFFSET. * INA SAVE CHECKSUM FROM INPUT LDA A,I RECORD (LAST WORD IF BA, LDB CSFLG WORD 3 IF BR) IN CPB "BR" 'CSINP'. LDA INBUF+2 STA CSINP * * CALCULATED CHECKSUM 'CSCAL' SO FAR CONTAINS THE SUM * OF WORD 2 AND, IF BR FORMAT, WORD 3. NOW ADD WORDS * 4 THRU THE LAST DATA WORD (ADR=BPLST) AND COMPARE * WITH CHECKSUM FROM INPUT RECORD, 'CSINP'. * LDB BUFAD INITIALIZE B = WORD 4 ADR ADB B3 * CK2 LDA B DOES BUFR POINTER EXCEED CMA,INA ADR OF LAST WORD? ADA BPLST SSA JMP CK3 YES, CHECKSUM COMPLETE LDA CSCAL NO, ADD THE ADA B,I CURRENT WORD, STA CSCAL BUMP POINTER INB AND LOOP. JMP CK2 * CK3 LDA CSCAL IF CALCULATED CHECKSUM CPA CSINP = INPUT RECORD CHECKSUM, CK4 ISZ CKSUM RETURN *+2, JMP CKSUM,I ELSE *+1. * * RLEN NOP RECORD LENGTH CSCAL NOP CALCULATED CHECKSUM CSINP NOP INPUT CHECKSUM BPLST NOP PNTR TO LAST DATA WORD SPC 2 * * SUBROUTINE TO CHECK FORMAT PARAMETER OF $DU AND * $ST COMMANDS TO SEE IF CHECKSUM IS REQUIRED, AND * TO SET THE PROPER FILE TYPE PARAMS FOR THE FILE * TO BE CREATED IN $ST. * CKFMT NOP LDA B400 SET ECHO BIT STA SUBF CLA CLEAR THE STA CSFLG CHECKSUM FLAG. LDA CP3 GET FORMAT PARAM FLAG SZA,RSS s PRESENT? JMP CKF01 NO * TRYAS LDB P3 YES, GET FORMAT PARAM CPB "AS" ASCII? JMP CKF01 YES LDA B300 NO, SET CONTROL BITS STA SUBF V AND M. * TRYBR CPB "BR" BR FORMAT? RSS YES JMP TRYBN NO STB CSFLG SET CHECKSUM FLAG LDA TYPE2 GET PARAM 2 FILE TYPE SZA,RSS GIVEN? LDA B5 NO, DEFAULT TO TYPE 5 STA TYPE2 JMP CKF01 * TRYBN CPB "BN" BN FORMAT? JMP CKF01 YES, V & M BITS ALREADY SET * TRYBA CPB "BA" BA FORMAT? RSS YES JMP OPER NO, ILLEGAL FORMAT PARAM STA CSFLG SET CHECKSUM FLAG LDA TYPE2 SZA,RSS TYPE GIVEN? LDA B7 NO, DEFAULT TO TYPE 7 STA TYPE2 LDA B2300 STA SUBF * CKF01 LDA TYPE2 IF TYPE NOT GIVEN, SZA,RSS DEFAULT TO TYPE 3. LDA B3 STA TYPE2 JMP CKFMT,I SPC 2 * * SUBROUTINE TO TEST FOR END OF FILE ON LOCAL DEVICES. * * TEMPM = EQT STATUS WORD. * INCNT = EQT WORD COUNT. * LUTYP = EQUIPMENT TYPE. * JSB EOFCK * EOF RETURN * NORMAL RETURN * EOFCK NOP CLE LDA LUTYP EOF DEPENDS ON DEVICE. SZA,RSS JMP EOF1 TTY. CPA B1 JMP EOF1 PHOTOREADER. CPA D9 JMP EOF4 CARD READER. CPA D13 JMP EOF4 MARK SENSE. CCE DEFAULT TO MAG TAPE. * EOF1 LDA TEMPM GET STATUS WORD. ALF,ALF SEZ,RSS IF E=1, CHECK BIT 7. JMP EOF2 SSA JMP EOF3 EOF2 RAL,RAL CHECK BIT 5. SSA,RSS JMP EOF5 NO EOF. * EOF3 LDA LUTYP END OF FILE. SZA IF TTY, OUTPUT CAR. RET. JMP EOFND * JSB DEXEC DEF *+6 DEF #NODE LOCAL NODE DEF ICOD2 WRITE, NO-ABORT DEF P.STK,I LU DEF CR DEF B1 JMP ASCER ERROR RETURN * JMP EOFND * EOF4 LDA INCNT CHECK FOR BLANK CARD. SZA EOF5 ISZ EOFCK EOFND JSB LCALC CLEAR IF LOCAL JMP EOFCK,I * * SUBROUTINE TO CHECK FOR ASCII OR NAMR PARAMETER. ENTER * WITH (B) = PARAM FLAG. IF PARAM OK, RETURNS WITH * REGISTERS UNCHANGED. WILL NOT RETURN IF ERROR FOUND. * ASCHK NOP (B) = PRAMS FLAG WORD SZB,RSS JMP ERR55 IF NOT THERE OR CPB B1 IF NUMERIC, JMP ERR56 GIVE ERROR. JMP ASCHK,I * * SUBROUTINE TO CHECK INTEGER PARAMS. ENTER WITH (B) = PARAM * FLAG. IF PARAM NUMERIC, RETURNS WITH REGISTERS UNCHANGED. * WILL NOT RETURN IF ERROR FOUND. * INTCK NOP SZB,RSS JMP ERR55 ERROR 55 IF MISSING. CPB B1 PARAM NUMERIC? JMP INTCK,I YES, RETURN JMP ERR56 ERROR 56 IF NOT NUMERIC. * * SUBROUTINE TO FIND EQUIPMENT TYPE OF AN LU AT NODE2 * EQTYP NOP (A) = LU. STA TEMP1 ADA MD1 IF LU=1 (SYSTEM CONSOLE), SZA,RSS THEN EQUIP-TYPE CODE MUST JMP EQTYP,I BE 0, SO RETURN WITH A=0. * JSB DEXEC REMOTE STATUS CALL DEF *+7 DEF NODE2 DEF ICD13 STATUS, NO-ABORT DEF TEMP1 ICNWD DEF TEMP2 EQT5 RETURNED HERE DEF TEMP2+1 EQT4 RETURNED HERE DEF SUBCH SUBCHANNEL INFO RETURNED HERE JMP ASCER ERROR RETURN * LDA TEMP2 ALF,ALF AND B77 STA TEMP2 CPA B5 DVR05? JMP SUBC? YES CPA B7 DVR07? JMP SUBC? YES JMP EQTYP,I NO, RETURN. A = EQUIP-TYPE * SUBC? LDA SUBCH GET 3RD STATUS WORD AND B17 ISOLATE SUBCHAN # SZA IF SUBCHAN=0, RETURN LDA TEMP2 WITH A=0, ELSE A=DVR TYPE. JMP EQTYP,I * SUBCH NOP SUBCHANNEL # SPC 1 * * SUBROUTINE TO FORCE NODE2 LU TO LOCAL * CALLING SEQUENCE * JSB LCALS * NORMAL RĿETURN * LCALS NOP LDA #NODE GET LOCAL NODE # LDB NODE2 STA NODE2 STORE LOCAL # STB DESTX SAVE THE REAL ONE JMP LCALS,I AND RETURN SPC 1 DESTX NOP SPC 1 * * SUBROUTINE TO RESET NODE2 LU * CALLING SEQUENCE * JSB LCALC * NORMAL RETURN * LCALC NOP LDB DESTX FETCH THE OLD ONE STB NODE2 RESTORE NODE2 JMP LCALC,I AND RETURN SPC 1 * * SUBROUTINE TO PROCESS ERRORS IN RFA CALLS. * ERCHK NOP LDA IERRR CAN BE POS. OR NEG. SZA,RSS JMP ERCHK,I NO ERROR. * LDB BLANK MAKE POSITIVE, SET SIGN WORD. SSA,RSS JMP ERCK1 LDB MINUS CMA,INA ERCK1 STB EMSG+3 * STA TEMP CONVERT TO ASCII JSB CNUMD DEF *+3 DEF TEMP DEF INBUF USE AS RESULT BUFR * LDA INBUF+2 STUFF LAST 2 DIGITS INTO MSG IOR HB20 LEADING BLANK TO ASCII 0. STA EMSG+4 LDA INBUF+1 SET UP SIGN AND AND B377 FIRST DIGIT. IOR EMSG+3 IOR B20 LEADING BLANK TO ASCII 0. STA EMSG+3 STORE IN MESSAGE BUFFER. * JSB REIO DISPLAY ERROR MESSAGE. DEF *+5 DEF ICOD2 DEF LOGLU DEF EMSG DEF B5 JMP ABORT ERROR RETURN * RESET LDA STKHD RESET STACK POINTER STA P.STK CLA RESET XFR FILE STA TRCRN VARIABLES TO STA TRSEC DEFAULTS. LDA #NODE STA TRNOD * JSB CLSFL CLOSE FILES CURRENTLY OPEN. * LDA TRFLG IF RUNNING FROM SCHEDULE- SZA PARAM COMMAND FILE, JMP ABORT PRINT MESSAGE AND EXIT. * JSB LCALS SET FOR LOCAL EQT CHECK LDA P.STK,I GET INPUT LU JSB EQTYP GET IT'S EQUIP-TYPE CODE JSB LCALC RESET NODE2 SZA,RSS TTY DEVICE? JMP QUERY YES * ABORT JSB CLSFL CLOSE FILES CURRENTLzMY OPEN * JSB EXEC TERMINATE SELF DEF *+4 DEF B6 DEF B0 DEF B3 * * EMSG ASC 5,REMAT * * SUBROUTINE TO CLOSE THE COMMAND FILE OPEN TO TRDCB, * OR USER FILE OPEN TO UDCB IF EITHER OR BOTH ARE OPEN. * CLSFL NOP LDA TOPNF SZA,RSS TRANSFER FILE OPEN? JMP CLOS2 NO * JSB DCLOS YES, CLOSE IT DEF *+3 DEF TRDCB DEF IERRR * CLOS2 LDA UOPNF SZA,RSS USER FILE OPEN? JMP CLOS3 NO * JSB DCLOS YES, CLOSE IT DEF *+3 DEF UDCB DEF IERRR * CLOS3 CLA STA TOPNF CLEAR OPEN FLAGS. STA UOPNF JMP CLSFL,I RETURN. SPC 2 ASCER DST ASERM+4 SAVE RETURNED ASCII ERR MSG * JSB REIO REPORT IT DEF *+5 DEF ICOD2 WRITE DEF LOGLU DEF ASERM DEF B6 JMP ABORT ERROR RETURN * JMP RESET * ASERM ASC 6,REMAT: XXXX SKP * * BELOW SUBROUTINE IS SPECIAL VERSION OF "$PARS". IS IS UNPRIVILEGED * AND WILL ALSO HANDLE UP TO 2 "NAMR" FILE FORMATS. * $PARS NOP LDB INCNT BLS CMB,SSB,RSS JMP $PARS,I GET OUT IF NEGATIVE COUNT STB ICNT SAVE NEG. CHARACTER COUNT LDA BUFAD RAL STA IBPNT SAVE BUFFER BYTE ADDRESS LDA SUBLA STA NAMRP INITIALIZE SUBPARAMETER ADDR LDB PBUFA GET PARSING BUFFER ADDRESS STB PARSA LDA MD39 STA TEMP CLA STA 1,I INITIALIZE PARSING BUFFER TO ZEROES INB ISZ TEMP JMP *-3 * * PROCESS A NEW FIELD NXFLD LDB NPOSA SAVE INITIAL BYTE ADDR OF FIELD CLA NXFL2 STA NMSET MODIFY INSTRUCTION STB TEMP CLA STA OVAL INITIALIZE OCTAL ACCUMULATION STA FCNT INITIALIZE COUNT OF BYTES/FIELD STA VAL SET CURRENT RUNNING NUMERIC VALUE * JSB GETC GET 1ST CHARACTER IN FIELD Ӥ JMP NULL NULL FIELD DETECTED STA FIRST SAVE IT CCB ADB IBPNT STB TEMP,I CPA NEG "-"? JMP NXTPN * NXTN ADA N60 SUBTRACT "0" SSA JMP ASCII TOO LOW TO BE NUMERIC STA TEMP ADA MD10 SSA,RSS JMP ASCII TOO HIGH TO BE NUMERIC LDA OVAL ALF,RAR OCTAL VALUE * 8 IOR TEMP + NEW CHARACTER STA OVAL LDA VAL MPY D10 DECIMAL VALUE * 10 ADA TEMP + NEW DIGIT STA VAL * NXTPN JSB GETC GET ANOTHER DIGIT JMP NMDON END OF FIELD CPA COLON COLON FOUND? RSS YES JMP NXTP1 NO LDB FIRST GET FIRST CHAR IN FIELD CPB NEG NEGATIVE SIGN? RSS YES JMP NXTP1 NO LDB VAL IS VALUE SZB,RSS ZERO? JMP NXTA1 YES, TREAT AS ASCII * NXTP1 CPA ASCB ="B"? RSSI RSS YES JMP NXTN PROCESS CHARACTER * JSB GETC GOT A "B", SEE IF END OF FIELD RSS IT IS, SKIP JMP ASCII TREAT AS ASCII LDB FIRST CPB NEG NEGATIVE SIGN? JMP *+3 YES, TREAT AS ASCII LDB OVAL USE OCTAL VALUE JMP NMSET * LDB NMSET SZB DOING A NAMR SUBPARAMETER? JMP SUBA2 YES JMP ENDA NO, WRAP-UP ASCII FIELD * NULL LDA DLIMF NAMR DELIMITER? SZA JMP ENDS1 YES, NULL NAMR FILED JMP ENDCK NO, NULL PARAMETER FIELD * NMDON LDA FIRST GET FIRST CHAR IN FIELD LDB VAL GET VALUE OF FIELD CPA NEG FIRST CHAR = NEGATIVE SIGN? RSS YES JMP NMSET NO SZB,RSS IS THE VALUE ZERO? JMP ENDA YES, TREAT AS ASCII CMB,INB NO, NEGATE VALUE * NMSET NOP THIS HAS RSS IF A NAMR PARAMETER JMP NONSB STORE PARAMETER * DONE PROCESSING THINS NAMR SUBPARAMETER STB SUBAD,I SAVE SUBPARAMETER IN NAMR BUFFER * ENDS1 ISZ SUBAD UPDATE NAMR PARAMETER POINTER LDA B3 STA PARSA,I SET TYPE TO 3 ENDS2 LDB XCNT GET SIZE OF FILE NAME LDA DLIMF NAMR DELIMITER FOUND? SZA,RSS JMP ENDAS NO, WRAP UP PARAMETER LDA SUBAD CPA NAMRP ROOM FOR MORE? RSS NO JMP DOSUB YES, SET-UP FOR NAMR PROCESSING JSB GETC GET ANOTHER CHARACTER JMP ENDS2 CHECK DELIMITER JMP *-2 KEEP LOOKING FOR A DELIMITER * NONSB CLA,INA SET TYPE TO NUMERIC PARSA EQU *+1 DST * SET TYPE AND VALUE * ENDCK ISZ CNTAD,I BUMP PARAMETER COUNT LDB CNTAD,I CPB B7 COMMAND + 6 PARAMETERS PARSED? JMP $PARS,I YES, EXIT LDA SUBPA CPB B1 HAS COMMAND BEEN PARSED? STA NAMRP YES, SET ADR OF 1ST NAMR BUFR ADA B5 CPB B2 HAS 1ST PARAM BEEN PARSED? STA NAMRP YES, SET ADR OF 2ND NAMR BUFR LDA PARSA ADA B4 POINT TO NEXT PARSING FIELD STA PARSA JMP NXFLD PARSE NEXT FIELD * ASCII LDA NMSET SZA DOING NAMR PARAMETERS? JMP SUBAS YES * NXTAS JSB GETC KEEP LOOKING FOR END OF FIELD JMP ENDA JUMP WHEN FOUND NXTA1 LDB NAMRP CPA COLON COLON FOUND? CPB SUBLA YES, MORE NAMR'S ALLOWED? JMP NXTAS NO, DON'T PROCESS NAMR'S * STB SUBAD SET RUNNING POINTER CCB ADB FCNT COMPUTE SIZE OF FILE NAME STB XCNT AND SAVE FOR LATER * DOSUB EQU * GET CURRENT BYTE POSITION LDB MPOSA AND SAVE IT LDA RSSI MODIFY INSTUCTION TO "RSS" JMP NXFL2 PROCESS SUBPARAMETER FIELD * ENDA LDA B2 STA PARSA,I SET TYPE TO ASCII LDB FCNT FIELD CHAR COUNT * ENDAS ADB MD6 STB FCNT SAVE COUNT FOR POSSIBLE FILLER BLANKS > CCE,SSB,RSS SKIP IF ASCII FIELD < 6 CHARS CLB,CLE SET FOR MOVE 6 CHARACTERS ADB B6 STB TEMP LDA NPOS "FROM" BYTE POINTER LDB PARSA INB RBL "TO" BYTE POINTER MBT TEMP MOVE UP TO 6 CHARACTERS TO PARSE BUFFER SEZ,RSS AT LEAST 6? JMP ENDCK YES LDA LOBLK NO, FILL WITH BLANKS SBT ISZ FCNT JMP *-2 DO ANOTHER JMP ENDCK ALL PADDED * * PROCESS AN ASCII NAMR PARAMETER SUBAS JSB GETC RSS SKIP IF DELIMITER FOUND JMP *-2 IGNORE THE REST SUBA2 LDB MPOS ADDR OF 1ST CHAR LBT GET IT ALF,ALF PUT IN LHW STA SUBAD,I LBT GET 2ND CHARACTER ADB MD1 POINT TO CHAR JUST FETCHED. CPB IBPNT IS IT PAST END OF STRING? LDA LOBLK YES, RHW = BLANK IOR SUBAD,I STA SUBAD,I SAVE ASCII NAMR PARAMETER JMP ENDS1 NOW SEE IF MORE NAMR PARAMETERS * * SUBROUTINE TO GET NEXT CHARACTER FROM BUFFER TO BE PARSED * GETC NOP LDA ICNT CLE,SSA,RSS ENTIRE INPUT BUFFER PARSED? JMP $PARS,I YES, RETURN TO CALLER LDB IBPNT GET BYTE ADDR OF INPUT BUFFER RSS GETC2 ISZ FCNT BUMP BYTE/FIELD COUNT ISZ ICNT BUMP TOTAL COUNT RSS JMP GETEX RETURN IF END OF BUFFER LBT GET NEXT BYTE CPA LOBLK BLANK? JMP GETC2 YES, IGNORE STB IBPNT LDB NMSET CPA COLON NAMR DELIMITER? SZB,RSS YES, SKIP IF DOING NAMR PARAMETERS CLE,RSS NO CCE,RSS E REG = 1 WHEN ":" FOUND (AFTER 1ST ONE) CPA COM COMMA FOUND? JMP GETEX YES, END OF FIELD ISZ FCNT BUMP BYTE/FIELD COUNT ISZ GETC GETEX CLB PUT E-REG INTO A FLAG WORD. ELB STB DLIMF JMP GETC,I RETURN WITH CHARACTER IN A REG * DLIMF NOP  HED REMAT: DATA AREA * (C) HEWLETT-PACKARD CO. 1979 * * PARAMETER STORAGE AREA. DO NOT CHANGE ORDER OF * LABELS FROM 'PRAMS' THRU 'NAMR2'. * PRAMS NOP FLAG WORD. OP BSS 3 OPERATION CODE. CP1 NOP PARAM FLAG (0=NO, 1=#, 2=ASC, 3=NAMR) P1 REP 3 PARAM 1 (UP TO 6 CHARACTERS). NOP CP2 NOP P2 REP 3 NOP CP3 NOP P3 REP 3 NOP CP4 NOP P4 REP 3 NOP CP5 NOP P5 REP 3 NOP CP6 NOP P6 REP 3 NOP NPRMS BSS 1 # OF PRAMS NAMR1 BSS 5 PARAM1 SUBPARAMS NAMR2 BSS 5 PARAM2 SUBPARAMS * SECU1 EQU NAMR1+0 CRN1 EQU NAMR1+1 TYPE1 EQU NAMR1+2 SIZE1 EQU NAMR1+3 RSIZ1 EQU NAMR1+4 SECU2 EQU NAMR2+0 CRN2 EQU NAMR2+1 TYPE2 EQU NAMR2+2 SIZE2 EQU NAMR2+3 RSIZ2 EQU NAMR2+4 * N60 OCT -60 B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B17 OCT 17 B20 OCT 20 B37 OCT 37 B70 OCT 70 B77 OCT 77 B100 OCT 100 B300 OCT 300 B377 OCT 377 B400 OCT 400 B1000 OCT 1000 B1100 OCT 1100 B2300 OCT 2300 LZERO OCT 60 LOW ZERO HZERO OCT 30000 HIGH ZERO HB20 OCT 10000 HB377 OCT 177400 HIBIT OCT 100000 MD1 DEC -1 MD3 DEC -3 MD4 DEC -4 MD5 DEC -5 MD6 DEC -6 MD7 DEC -7 MD10 DEC -10 MD12 DEC -12 MD39 DEC -39 D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D13 DEC 13 D15 DEC 15 D16 DEC 16 D19 DEC 19 D22 DEC 22 D23 DEC 23 D26 DEC 26 D27 DEC 27 D28 DEC 28 D34 DEC 34 D36 DEC 36 D37 DEC 37 D40 DEC 40 D45 DEC 45 D55 DEC 55 D56 DEC 56 D72 DEC 72 D100 DEC 100 D128 DEC 128 VBIT EQU D128 V-BIT (BIT 7) FOR CONWD NPOSA DEF NPOS MPOSA DEF MPOS SUBF NOP IBPNT NOP FCNT NOP ICNT NOP XCNT NOP MPOS NOP NPOS NOP SUBAD NOP NAMRP NOP FIRST NOP VAL NOP OVAL NOP LOBLK OCT 40 CNTAD DEF NPRMS SUBPA DEF NAMR1 SUBLA DEF NAMR2+5 NEG  OCT 55 COLON OCT 72 ASCB OCT 102 TOPNF NOP TRDCB OPEN FLAG UOPNF NOP UDCB OPEN FLAG TEMPM NOP TEMP BSS 2 TEMP1 BSS 2 TEMP2 BSS 2 INCNT NOP # WORDS IN INPUT REQUEST. LUTYP NOP EQ. TYPE OF INPUT DEVICE. LOGLU NOP LU OF LOG DEVICE. LSTLU NOP LU OF LIST DEVICE. SEVER NOP SEVERITY CODE. NODE2 NOP NODE1 NOP PRMPT NOP LOCAL/REMOTE PROMPT CHAR CSFLG NOP CHECKSUM FLAG BRFLG NOP BREAK FLAG A.$TR ASC 2,$TR A.TR1 ASC 2,R,1 AS.$ OCT 022000 IERRR BSS 2 "$" ASC 1,$_ LOCAL PROMPT CHARACTER "#" ASC 1,#_ REMOTE PROMPT CHARACTER "AS" ASC 1,AS "R" OCT 122 "U" OCT 125 "BR" ASC 1,BR "BN" ASC 1,BN "BA" ASC 1,BA IPRMP ASC 2,/ _ PROMPT FOR $ST AND $DU BLANK OCT 020000 DBBLK OCT 20040 CR OCT 6400 COM OCT 54 ASCII COMMA ICOD1 OCT 100001 ICOD2 OCT 100002 ICOD3 OCT 100003 ICOD9 OCT 100011 ICD13 OCT 100015 CNWD1 EQU HIBIT D65MS CONWD. NO ABORT CNWD2 OCT 140000 D65MS CONWD (NO ABORT, LONG TIMEOUT) MINUS OCT 026400 TRFLG NOP PBUFA DEF PRAMS BUFAD DEF INBUF INBUF EQU RECRD INPUT BUFFER (128 WORDS) UDCB BSS 4 USER DATA CONTROL BLOCK TRDCB BSS 4 TR FILE DATA CONTROL BLOCK * * DEFINE NRV * * NRVSZ EQU B2 BSS 0 * END REMAT 2 .7 91740-18025 1913 S C0122 DS/1000 MODULE: D65GT              H0101 HTASMB,R,L,C HED DS GET SUBROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM D65GT,7 91740-16025 REV 1913 781027 SPC 1 ENT D65GT SPC 1 EXT .ENTR,EXEC,#PLOG EXT $OPSY,#REQU * * NAME: D65GT * SOURCE: 91740-18025 * RELOC: 91740-16025 * PGMR: CHUCK WHELAN DEC 1976 ** ** ALTERED TO RETURN AT LEAST THE FIRST SEVEN WORDS OF ANY REQUEST ** TO CALLER [10-27-78] CEJ. * * MODIFIED BY: LYLE WEIMAN, AUG '78 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * D65GT CALLING SEQUENCE: * * JSB D65GT * DEF *+6 * DEF CLASS CLASS FOR GET SUSPEND * DEF RQBUF REQUEST BUFFER ADDRESS. * DEF RQLEN MAX REQUEST LENGTH * DEF DABUF DATA BUFFER ADDRESS * DEF DALEN MAX DATA BUFFER LENGTH (0 IF NO DATA). * A & B HAVE ASCII ERROR CODE * A= RCVD REQUEST LEN, B= RCVD DATA LEN * * * * * D65GT OPERATION: * D65GT IS CALLED BY ROUTINES WAITING TO RECEIVE REQUESTS ( & POSSIBLY * DATA) ON THEIR CLASS NUMBERS. D65GT DOES THE FOLLOWING: * 1. PERFORMS A ZERO-LENGTH "GET" ON THE PASSED CLASS NUMBER * 2. MOVES DATA TO USER BUFFER USING LENGTH= MIN(USER LEN,RCVD LEN) * 3. IF SPECIFIED REQUEST LENGTH EXCEEDED, RETURNS A "DS03" * 4. MOVES THE REQUEST INTO THE USERS BUFFER (UP TO THE * # OF WORDS SPECIFIED IN CALL. * 5. IF SPECIFIED DATA LENGTH EXCEEDED, RETURNS A "DS03" * 6. IF PLOG IS ENABLED, RETHREADS THE REQUEST TO PLOG'S CLASS * OTHERWISE, DEALLOCATES THE BUFFER IN SAM * 7. RETURNS THE RECEIVED REQUEST AND DATA SI?ZES IN THE B AND A REGS * * * D65GT ERROR RETURNS: * * "DS03" - ILLEGAL RECORD SIZE - REQ OR DATA EXCEEDS BUFFER * SKP CLASS NOP RQBUF NOP RQLEN NOP DABUF NOP DALEN NOP * D65GT NOP JSB .ENTR GET PARAMETER ADDRESSES DEF CLASS * CLB LDA $OPSY GET OP SYSTEM TYPE RAR,SLA STB MOD1 IT'S A MAPPED SYSTEM, MODIFY PGM * LDA CLASS,I IOR B6000 BUFR SAVE, NO DEALLOCATE STA CLASS * JSB EXEC DO "GET" ON PASSED CLASS # DEF *+7 DEF D21 DEF CLASS DEF DABUF,I DATA BUFR ADDR DEF K0 DATA LENGTH DEF PARAM REQUEST BUFR ADDR IN SAM RETURNED DEF LENGT RCVD REQUEST BUFFER LENGTH * STB BRTN SAVE RECEIVED DATA LENGTH LDA 1 CMB,INB ADB DALEN,I USER LENGTH - RETURNED LENGTH SSB LDA DALEN,I USER'S LENGTH LESS, USE IT STA ARTN SZA,RSS SHOULD WE MOVE ANY? JMP DOREQ NO! LDB DABUF ADDR OF USER'S DATA BUFFER LDA BRTN CMA,INA REQ ADDR (SAM) - DATA LENGTH = ADA PARAM DATA ADDR (SAM) JSB MOVER DO THE DATA MOVE FROM S.A.M. * DOREQ CLA SET LENGTH ERROR FLAG TO FALSE (0). STA FLAG * LDB LENGT RCVD REQUEST BUFFER LENGTH STB ARTN CMB,INB,SZB,RSS JMP ZRET ZERO LENGTH REQUEST, RETURN NOW ADB RQLEN,I CHECK VS REQUESTED LENGTH SSB,RSS WAS IT LARGER? JMP OKAY NO, CONTINUE WITH NORMAL MOVE. * STB FLAG YES, SET LENGTH ERROR FLAG TO TRUE (<0) LDA D7 AND LENGTH OF REQUEST TO MOVE TO SEVEN. STA ARTN * * MOVE REQUEST BUFFER FROM SAM TO USER AREA OKAY LDB RQBUF USER REQUEST BUFFER ADDRESS LDA PARAM SAM BUFFER ADDRESS JSB MOVER NOW MOVE THE REQUEST * LDA FLAG WAS THERE A REQUEST LENGTH ERROR? SSA JMP ERR03  YES - GIVE "DS03" ERROR. * LDB BRTN DATA LENGTH CMB,INB ADB DALEN,I SSB DATA TOO LARGE? JMP ERR03 YES, GIVE "DS03" * ISZ D65GT BUMP TO SUCCESSFUL RETURN * * RETHREAD TO PLOG'S CLASS IF IT'S ENABLED * LOGIT LDA #PLOG SZA,RSS PLOG ENABLED? JMP CLSAM NO STA PARAM * JSB #REQU RETHREAD TO PLOG DEF *+3 DEF CLASS DEF PARAM * SSA,RSS ANY ERROR? JMP RETRN NO, RETURN JMP CLSAM YES, RELEASE BUFFER * ZRET ISZ D65GT DO NORMAL RETURN FOR ZERO LENGTH REQ * * DEALLOCATE THE BUFFER IN SAM * CLSAM LDA CLASS ALR,RAR CLEAR "SAVE BUFFER" FLAG STA CLASS * JSB EXEC DO DUMMY GET TO RELEASE BUFFER DEF *+5 DEF D21 DEF CLASS DEF DABUF,I DEF K0 * * RETURN TO USER RETRN LDB BRTN LDA ARTN JMP D65GT,I * * * ERROR ROUTINES * ERR03 DLD DS03 ILLEGAL RECORD SIZE DST ARTN ERROR CODE RETURNED IN A & B JMP LOGIT FIRST DEALLOCATE BUFFER * * SUBROUTINE TO MOVE BLOCK OF WORDS FROM S.A.M. TO USER BUFFER * MOVER NOP MOD1 JMP NODMS "NOP" HERE IF DMS SYSTEM LDX ARTN PUT LENGTH IN X REG MWF MOVE WORDS FROM ALTERNATE (SYSTEM) MAP JMP MOVER,I RETURN * NODMS MVW ARTN DO "MVW" FROM S.A.M. JMP MOVER,I RETURN * * DATA AREA * ARTN NOP BRTN NOP PARAM NOP LENGT NOP FLAG NOP K0 OCT 0 D7 DEC 7 D21 DEC 21 B6000 OCT 060000 DS03 ASC 2,DS03 * SIZE BSS 0 * END    91740-18026 2026 S C0122 &GET +              H0101 NjASMB,R,Q,C HED GET 91700-16126 * (C) HEWLETT-PACKARD CO 1977 NAM GET,7 91740-16026 REV 2026 800418 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT GET,ACEPT,REJCT,FINIS EXT EXEC,$OPSY EXT .ENTR,CNUMO EXT D65SV,#LDEF,#REQU,#PLOG SUP SPC 5 * * GETS * SOURCE:91740-18026 * BINARY:91740-16026 * PGMR :CHUCK WHELAN * DATE :DEC 22,1976 * SPC 5 * THESE LIBRARY SUBROUTINES ARE USED IN CONJUNCTION * WITH THE PROGRAM TO PROGRAM COMMUNICATION MONITOR * PTOPM TO AFFECT COMMUNICATION WITH SATELLITE PROGRAMS * THEY CONTAIN THE FOUR SLAVE ENTRY POINTS (GET * ACCEPT,AND REJECT AND FINIS) THAT MAY BE ENTERED * BY A PROGRAM IN SLAVE MODE WHICH IS COMMUNICATING * WITH A PROGRAM IN MASTER MODE. HED "GET" PROCESSING * (C) HEWLETT-PACKARD CO 1977 ICLAS NOP IERR NOP IFUN NOP ITAG NOP IL NOP SPC 3 * ENTRY HERE SIGNIFIES THAT THE USER SUBROUTINE HAS COMPLETED THE * PROCESSING OF THE LAST CALL AND WISHES TO INTERROGATE HIS I/O * CLASS TO DETERMINE IF THERE ARE ANY MORE REQUESTS * TO BE PROCESSED. IF MORE REQUESTS HAVE BEEN QUEUED ON THE * CLASS THE ONE ON THE TOP OF THE STACK WILL BE PASSED TO THE * USER.IF THERE ARE NO OUTSTANDING REQUESTS THE USER * WILL BE I/O SUSPENDED UNTIL A REQUEST IS RECEIVED * BY THE MONITOR AND PLACED IN THE USER'S I/O CLASS. * GET NOP * SAVE INPUT PARAMETERS JSB .ENTR PICK UP THE PARAMETERS PASSED DEF ICLAS LDA $OPSY CLB RAR,SLA SKIP IF NON-DMS STB MODX INITIALIZE FOR DMS SYSTEM LDB GET RETURN ADDR STB EXIT LDB IERR SET UP ERROR PRAM ADDR STB ERRM1 LDA IL ADDRESS SZA,RSS LAST ONE REQ. THERE? JMP ERPAR NO-ERROR CLA,INA LDB ERCOM CPB M47 COMM ERROR OCCURRED LAST XACTION? STA NEXT YES, RESET SEQ INDICATOR CPA NEXT CHECK FOR LEGAL SEQUENCE RSS JMP ERSEQ TAKE ERROR EXIT IF SEQUENCE ERR STA ERCOM * LDA ICLAS,I SET UP THIS USER'S I/O CLASS STA CLASX IOR B6000 SAVE BUFFER STA CLASS * JSB EXEC ISSUE GET ON I/O CLASS DEF *+7 DEF K21N DEF CLASS IRBFA DEF IRBUF DEF ZERO ZERO LENGTH GET DEF BFADR ADDR OF REQUEST IN SAM DEF RQLEN REQUEST LENGTH JMP ERRAC - ERROR: BAD CLASS NUMBER * STB DLEN SAVE DATA LENGTH CMB,INB ADB BFADR COMPUTE DATA ADDR IN SAM STB DSAMA LDA BFADR LDB IRBFA JSB MOVER MOVE REQUEST INTO LOCAL BUFFER RQLEN NOP * LDA RTAGA ADDR OF TAGS IN REQUEST LDB ITAG ADDR OF USER TAG AREA MVW K20 MOVE TAG FIELD TO USER AREA * * PASS FUNCTION CODE BACK TO "GET" CALLER LDA $FUNC GET FUNCTION CODE STA IFUN,I RETURN RECEIVED FUNCTION CODE * LDB $DLEN DATA BUFFER LENGTH RAR,SLA,RAL SKIP UNLESS READ OR WRITE STB IL,I RETURN LENGTH TO CALLER * CPA K3 IS THIS A "PWRIT"? RSS YES JSB CLSAM NO, CLEAR CLASS BUFFER * ISZ NEXT SET SEQ INDICATOR CLB RETURN "NO ERROR" FLAG STB IERR,I TO THE USER JMP DONE RETURN TO USER HED "ACCEPT" PROCESSING * (C) HEWLETT-PACKARD CO 1977 AITAG NOP AIERR NOP AIBUF NOP * * ENTRY HERE SIGNIFIES THAT THE LAST REQUEST EXAMINED * WAS AN ACCEPTABLE ONE AND THE REQUEST WAS TO BE HONORED * * THE ACTION TO BE ACCOMqPLISHED FOR AN ACCEPT REQUEST * VARIES AS TO THE TYPE OF REQUEST WHICH WAS LAST RECEIVED * ACCEPT REQUESTS ARE PERFORMED FOR ALL FOUR MASTER REQUESTS * EXIT EQU * ACEPT NOP JSB .ENTR PICK UP CALLING PARAMETERS FROM DEF AITAG THE USER * * * CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB * LDA AITAG LDB AIERR JSB PUTAG * LDA $FUNC FUNCTION CODE FROM REQUEST RAR,SLA,RAL SKIP IF OPEN OR CONTROL(DO REQ ONLY) RSS JMP ACPFG LDB AIBUF SZB,RSS WAS DATA BUFFER SPECIFIED JMP ERPAR NO, INSUFFICIENT PARAMS STB DATAD SET DATA ADDRESS IN SV CALL CPA K2 IS THIS A "PREAD" JMP AREAD YES, JUMP * * REQUEST IS A "PWRIT", DATA IS ALREADY IN SYSTEM AVAILABLE MEMORY, * SIMPLY MOVE DATA TO USERS BUFFER & CLEAR CLASS BUFFER LDA $DLEN STA *+3 SET DATA LENGTH FOR MOVE LDA DSAMA ADDR OF DATA IN SAM JSB MOVER MOVE IT NOP JMP ACPFG * AREAD LDA $DLEN DOING "PREAD", SEND STA DLEN DATA WITH THE REPLY. * ACPFG LDA BIT14 SET ACCEPT FLAG IN PARMB DVR IOR $FUNC STA $FUNC SAVE FUNC CODE WITH ACEPT OR REJCT SET AND K7 ISOLATE FUNCTION CODE CPA K3 WAS IT A "PWRIT" JSB CLSAM YES, CLASS BUFFER STILL MUST BE CLEARED * LDA $STRM REQUEST STREAM WORD IOR BIT14 SET REPLY BIT STA $STRM * CLA STA $ERR+1 STA $ERR+2 * JSB D65SV DO CALL TO DRIVER THRU D65SV DEF *+5 DEF IRBUF DEF K31 DATAD DEF DUMMY DEF DLEN JMP ERRAC COMMUNICATION ERROR * LDA ERRM1,I RETRN STA ERCOM SAVE RETURN STATUS CLB,INB STB NEXT SET SEQUENCE IND. FOR "GET" NEXT * DONE CLB STB IL INITIALIZE FOR PARAM CK NEXT TIME STB AIERR STB JIERR JMP EXIT,I RETURN FROM ACEPT/REJCT TO CALLEDR * ERRAC LDA M47 ERROR STATUS= -47 STA ERRM1,I JMP RETRN HED "REJECT" PROCESSING * (C) HEWLETT-PACKARD CO 1977P JITAG NOP JIERR NOP * * ENTRY HERE IS SIMILAR TO THAT FOR THE ACCEPT OPTION * EXCEPT THE REQUEST HAS BEEN DETERMINED NOT TO BE FROM A VALID * SATELLITE AND MUST BE REJECTED. AGAIN THE LOGIC * IS BROKEN UP INTO FOUR SUBCLASSES ACCORDING TO THE TYPE * OF REQUEST BEING REJECTED * REJCT NOP JSB .ENTR PICK UP USER PARAMETERS DEF JITAG LDB REJCT PICK UP RETURN ADDR STB EXIT * * CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB * LDA JITAG LDB JIERR JSB PUTAG * LDA BIT15 GET "REJCT" BIT JMP DVR NOW SEND REPLY & EXIT HED "FINISH" PROCESSING * (C) HEWLETT-PACKARD CO 1977 FINIS NOP LDA XEQT GET THIS PGMS ID SEGMENT ADDR STA $PCB & STORE IN REQUEST * CLA,INA STA NEXT RESET SEQUENCE INDICATOR * * SET FUNCTION CODE REPLY FLAG & ACCEPT/REJECT FLAG LDA HCODE STA $FUNC SET "PCLOS" FUNCTION CODE * * SEND IT TO THE MONITOR * SO THIS PROGRAM CAN BE REMOVED FROM THE ACTIVE LIST * LDB #LDEF ADB K6 POINT TO P TO P HEADER ADDR LDB 1,I GET HEADER ADDR INB POINT TO CLASS WORD LDA 1,I GET "PTOPM" CLASS RAL,CLE,ERA CLEAR OFF SIGN BIT STA PTOP * JSB EXEC SEND THE REQUEST TO PTOPM DEF *+8 DEF K20 DEF CONWD Z BIT, LU=0 DEF DUMMY DEF ZERO NO DATA DEF IRBUF DEF K11 11 WORD "FINIS" REQUEST DEF PTOP * ISZ FINIS JMP FINIS,I RETURN HED UTILITY SUBROUTINES/DATA AREA * (C) HEWLETT-PACKARD CO 1977 * * THIS SUBROUTINE CHECKS FOR CALL ERRORS & RETURNS A MODIFIED * REQUEST TO THE SATELLITE MASTER PROGRAM * PUTAG NOP STB ERRM1 SAVE ERROR FLAG ADDR SZB,RSS  SKIP IF ERROR DEF WAS PASSED JMP ERPAR OTHERWISE ERROR IN CALL LDB NEXT CHECK SEQUENCE CPB K2 CLB,RSS OK JMP ERSEQ ERROR, NOT TIME FOR ACEPT/REJCT STB ERRM1,I CLEAR ERROR FLAG LDB RTAGA ADDR OF TAG FIELD IN REQUEST MVW K20 MOVE TAG FIELD INTO REQUEST LDA XEQT SET ID SEGMENT ADDR OF SLAVE PGM STA $PCB INTO 1ST WORD OF PCB LDA CLASX SET SLAVE PGMS CLASS # STA $PCB+1 INTO 2ND WORD OF PCB CLB STB DLEN SET D65SV CALL FOR "NO DATA" JMP PUTAG,I RETURN SPC 3 * * SUBROUTINE TO MOVE BLOCK FROM SAM MOVER NOP MODX JMP NODMS "NOP" HERE IF DMS SYSTEM LDX MOVER,I GET # TO MOVE MWF MOVE WORDS FROM ALTERNATE MAP JMP MEXIT * NODMS MVW MOVER,I MOVE WORDS MEXIT ISZ MOVER JMP MOVER,I RETURN SPC 3 * * SUBROUTINE TO DO A DUMMY GET TO CLEAR THE CLASS BUFFER CLSAM NOP LDA #PLOG SZA DOING REQUEST LOGGING? JMP LOGIT YES, PASS BUFFER ALONG TO "PLOG" * LDA CLASS GET SLAVE PGMS CLASS NO ALR,RAR CLEAR "SAVE BUFFER" FLAG STA CLASS * JSB EXEC DO DUMMY GET TO CLEAR THE BUFFER DEF *+5 DEF K21 DEF CLASS DEF DUMMY DEF ZERO JMP CLSAM,I RETURN * LOGIT STA CLAS2 SAVE "PLOG"S CLASS JSB #REQU DO RETHREAD TO PLOG DEF *+3 DEF CLASS FROM SLAVE PGM'S CLASS DEF CLAS2 TO PLOG'S CLASS JMP CLSAM,I * SPC 3 ERSEQ LDA M46 -46 = SEQUENCE ERROR RSS ERPAR LDA M40 -40 = INSUFFICIENT PARAMETERS STA ERRM1,I RETURN ERROR TO USER JMP DONE SPC 4 ERR1 NOP STA SSA SAVE DRIVER STATUS LDA XEQT GET THE NAME OF THE PROGRAM ADA K12 THIS S/R IS APPENDED TO LDB 0,I FROM THE ID SEGMENT STB COMER+6 & SAVE IN THE OUTPu$"UT * INA BUFFER LDB 0,I STB COMER+7 * INA LDB 0,I LDA 1 AND MSK1 STRIP OFF STATUS BITS STA COMER+8 * JSB CNUMO CONVERT STATUS WORD TO ASCII DEF *+3 DEF SSA DEF CNBUF RESULTING ASCII * JSB EXEC OUTPUT DRIVER ERROR DEF *+5 MESSAGE DEF K2 DEF K1 DEF COMER DEF COMEL JMP ERR1,I & RETURN * * DATA AREA * CLASS NOP CLASX NOP CLAS2 NOP DSAMA NOP BFADR NOP DLEN NOP NEXT DEC 1 ERCOM NOP ERRM1 NOP CONWD OCT 10000 BIT14 OCT 40000 BIT15 OCT 100000 B6000 OCT 60000 K21N DEF 21,I CLASS "GET" CODE, "NO-ABORT" BIT SET ZERO OCT 0 K1 DEC 1 K2 DEC 2 K3 DEC 3 K6 DEC 6 K7 DEC 7 K11 DEC 11 K12 DEC 12 K20 DEC 20 K21 DEC 21 K31 DEC 31 MAX REQUEST LENGTH MSK1 OCT 177400 HCODE OCT 205 "FINIS" GENERATES A "PCLOS" PTOP OCT 100004 M46 DEC -46 M47 DEC -47 M40 DEC -40 RTAGA DEF $TAG CNBUF BSS 3 COMER ASC 7,COMM ERROR - SSA NOP COMEL DEC -16 * DUMMY NOP * * DEFINE REQUEST BUFFER IRBUF BSS 31 $STRM EQU IRBUF $ERR EQU IRBUF+4 $FUNC EQU IRBUF+7 $PCB EQU IRBUF+8 $DLEN EQU IRBUF+10 $TAG EQU IRBUF+11 * XEQT EQU 1717B * END J$   91740-18027 1740 S C0122 DS/1000 MODULE: PGMAD              H0101 *ASMB,R,L,C,Z HED I.D. SEG. ADDRESS ROUTINE *(C) HEWLETT-PACKARD CO. 1977* IFN NAM PGMAD,7 91740-16027 REV 1740 770208 EXT .ENTR XIF IFZ NAM PGMAD,30 91740-16027 REV 1740 770329 EXT .ENTP,$LIBR,$LIBX XIF ENT PGMAD SPC 1 * NAME: PGMAD * SOURCE: 91740-18027 * RELOC: 91740-16027 * PGMR: C.C.H. [ 02/08/77 ] [LIBERALLY EXTRACTED FROM 'SCHED'] SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * PGMAD ACCEPTS A USER-SUPPLIED ADDRESS OF A 3-WORD ARRAY WHICH * CONTAINS THE ASCII CODE FOR THE NAME OF A PARTICULAR PROGRAM. * PGMAD RETURNS THE I.D. SEGMENT ADDRESS OF THE PROGRAM, IT'S STATUS, * AND AN INDICATION OF THE TYPE OF I.D. SEGMENT; I.E.,LONG/SHORT. * * PGMAD CALLING SEQUENCE: * * JSB PGMAD * DEF *+2 [ OR *+2+N WHERE N= NUMBER OF OPTIONAL PARAMETERS ] * DEF NAME ADDRESS OF 3-WORD ASCII PROGRAM NAME ARRAY. * [DEF IDAD] [OPTIONAL ADDRESS FOR RETURN OF I.D. SEG. ADDRESS] * [DEF ISTAT] [OPTIONAL ADDRESS FOR RETURN OF PROGRAM STATUS] * [DEF IDTYP] [OPTIONAL ADDRESS FOR RETURN OF I.D.SEGMENT TYPE] * = I.D. SEGMENT ADDRESS. * = PROGRAM STATUS. * = 0: STANDARD 28-WORD I.D. SEGMENT. * = 1: SHORT(PROGRAM SEGMENT) 9-WORD I.D. SEGMENT. * * FORTRAN CALLING SEQUENCE: CALL PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * OR * REG=PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * * PGMAD ERROR DETECTION: * * A. ADDRESS OF NAME-ARRAY NOT SUPPLIED. * B. CHARACTER #5 OF USER-SUPPLIED PROGRAM NAME IS NULL. * C. I.D. SEGMENT WITH EQUIVALENT PROGRAM NAME CANNOT BE FOUND. * * -- RETURN TO WITH: * * 1. & AND 'IDAD' & 'ISTAT' ALL SET = 0. * 2. AND 'IDTYP' ARE SET =1. * NAME NOP ADDRESS OF ASCII NAME ARRAY. P1 DEF A ADDRESS FOR RETURN OF PARAMETER #1. P2 DEF B ADDRESS FOR RETURN OF PARAMETER #2. P3 DEF PTEM ADDRESS FOR RETURN OF PARAMETER #3. SUP [SUPPRESS EXTENDED LISTING] PGMAD NOP ENTRY/EXIT: I.D.SEG. ADDRESS ROUTINE. IFN JSB .ENTR OBTAIN DIRECT ADDRESSES. XIF IFZ JSB $LIBR DEFINE THIS SUBROUTINE NOP TO BE PRIVILEGED. JSB .ENTP GET DIRECT ADDRESSES--PRIVILEGED MODE. XIF DEF NAME DEFINE PARAMETER STORAGE AREA. SPC 1 LDA NAME GET THE ADDRESS OF THE ASCII ARRAY. SZA,RSS DID THE CALLER SUPPLY AN ADDRESS? JMP ERREX NO--ERROR! SPC 1 * RESET POINTERS TO ALLOW USER TO CALL WITHOUT RETURN-DATA PARAMETERS. SPC 1 DLD P1 GET PARAMETER ADDRESSES-IF ANY. DST IDAD SAVE FOR DATA RETURN. DLD REGDF GET INITIAL PARAMETER DEFINITION DST P1 AND RE-INITIALIZE FOR NO PARAMETERS. LDA P3 GET 'IDTYP' PARAMETER ADDRESS--IF ANY. LDB DPTEM GET DEF TO DUMMY PARAMETER STORAGE. STA IDTYP SAVE PARAMETER ADDRESS. STB P3 RE-INITIALIZE FOR NO 'IDTYP' PARAMETER. * LDB NAME GET ADDRESS OF NAME ARRAY. STB PTEM SAVE ADDRESS OF 1RST & 2ND CHARACTERS. INB POINT TO 2ND TWO CHARS. OF NAME ARRAY. STB PTEM+1 SAVE ADDRESS OF 3RD & 4TH CHARS. INB POINT TO LAST CHARACTER'S ADDRESS. LDA B,I GET THE WORD FROM THE NAME ARRAY. AND UBYTE ISOLATE CHAR.#5 FROM UPPER BYTE. % STA PTEM+2 SAVE CHAR.#5 LOCALLY. SZA FORCE ERROR-RETURN FOR A NULL CHARACTER. LDA KEYWD GET ADDRESS OF KEYWORD TABLE. STA KEYPT SET POINTER TO TOP OF TABLE. PLOOP LDA KEYPT,I GET THE KEYWORD-TABLE ENTRY. CCE,SZA,RSS IF THIS IS THE END-OF-LIST (0), JMP ERREX THEN GO TO RETURN AN ERROR INDICATION. * ADA P12 POINT TO NAME-CHARS.1 & 2 IN I.D. SEG. LDB A,I GET CHARS. 1 & 2 FROM I.D. SEGMENT. CPB PTEM,I IF THEY ARE THE SAME AS USER'S CHARS., INA,RSS THEN PROCEED WITH COMPARISON; ELSE, JMP PNEXT GO TO GET NEXT KEYWORD ENTRY. * LDB A,I GET CHARS. 3 & 4 FROM THE I.D. SEGMENT. CPB PTEM+1,I IF THESE TWO COMPARE TO USER'S CHARS, INA,RSS THEN CONTINUE CHECKING; ELSE, JMP PNEXT GO TO GET NEXT KEYWORD ENTRY. * STA PSTAT SAVE ADDRESS TO GET STATUS--LATER. LDA A,I GET THE LAST CHAR. FROM I.D. SEGMENT. STA B SAVE THE WORD FOR SHORT I.D. TESTING. AND UBYTE ISOLATE CHARACTER #5 FROM I.D. SEG. CPA PTEM+2 IF THIS IS A FINAL MATCH, THEN JMP PFOUN GO TO GATHER DATA FOR THE RETURN. * PNEXT ISZ KEYPT POINT TO NEXT KEYWORD ENTRY. JMP PLOOP GO TO CHECK NEXT KEYWORD ENTRY. * ERREX CLA,CCE,INA SET 'IDTYP' & STA IDTYP,I TO 1--FOR ERROR-RETURN. CLA RETURN WITH & AND 'IDAD' & CLB 'ISTAT' ALL SET TO ZERO! JMP EROUT GO TO RETURN THE BAD NEWS. * PFOUN LSR 4 MOVE THE SHORT I.D. BIT TO . CLE,ERB SET TO: 0-LONG/1-SHORT ID.SEG. TYPE. CLA,SEZ IF STANDARD I.D. SEG.: =0; ELSE, INA SET =1 FOR SHORT I.D. SEGMENT. STA IDTYP,I RETURN THE I.D. SEGMENT TYPE. LDA KEYPT,I = I.D. SEGMENT ADDRESS. ISZ PSTAT POINT TO I.D. SEGMENT STATUS WORD. LDB PSTAT,I = PROGRAM'S CURRENT STATUS. EROUT STA IDAD,I RETURN DATA TO STB ISTAT,I USER'S PARAMETERS--IF ANY. IFN JMP PGMAD,I RETURN TO CALLER. XIF IFZ JSB $LIBX RETURN TO CALLER DEF PGMAD VIA PRIVILEGED PROCESSOR. XIF * A EQU 0 B EQU 1 DPTEM DEF PTEM DUMMY POINTER: PARAMETER #3. IDAD NOP ADDRESS FOR RETURN OF I.D. SEG. ADDRESS. ISTAT NOP ADDRESS FOR RETURN OF PROGRAM STATUS. IDTYP NOP ADDRESS FOR RETURN OF I.D. SEGMENT TYPE. KEYPT NOP POINTER TO CURRENT I.D. SEGMENT ADDRESS. KEYWD EQU 1657B BASE PAGE ADDRESS OF KEYWORD TABLE. P12 DEC 12 OFFSET TO I.D. SEGMENT NAME-ENTRY. PSTAT NOP TEMPORARY STORAGE. PTEM OCT 0,0,0 TEMPORARY STORAGE. REGDF DEF A DUMMY POINTER: PARAMETER #1. DEF B DUMMY POINTER: PARAMETER #2. UBYTE OCT 177400 UPPER-BYTE ISOLATION MASK. SPC 1 END (   91740-18028 1913 S C0222 &#REQU              H0102 hASMB,R,L,C HED * <#REQU> - CLASS REQUEUEING * (C) HEWLETT-PACKARD CO. 1979 * NAM #REQU,30 91740-16028 REV 1913 790131 SPC 1 ENT #REQU,#QCNT,#PRLX EXT $CLAS,$DLAY,$LIBR,$LIBX,$OPSY,$SCD3,.ENTP,DRTEQ * NAME: #REQU * SOURCE: 91740-18028 * RELOC: 91740-16028 * PGMR: C. HAMILTON [ 1/31/79 ] * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * #REQU IS A CORE-RESIDENT SYSTEM LIBRARY MODULE, USED BY THE * DISTRIBUTED SYSTEMS SOFTWARE PACKAGE IN THE RTE-M DISC-BASED * RTE OPERATING SYSTEMS ENVIRONMENTS. ITS PURPOSE IS TO PROVIDE A FAST, * CORE-SAVING METHOD FOR TRANSFERRING PREVIOUSLY-QUEUED CLASS I/O * BUFFERS FROM ONE CLASS TO ANOTHER CLASS. ALTERNATELY, IT CAN BE * USED TO RE-QUEUE THE COMPLETED CLASS-TRANSACTION ONTO AN EQUIPMENT * TABLE ENTRY. * * THE ADVANTAGES GAINED THROUGH THE USE OF <#REQU> INCLUDE: * 1. ONCE GRANTED ADEQUATE SYSTEM AVAILABLE MEMORY(SAM) FOR THE INITIAL * CLASS READ OPERATION, INCOMING TRANSACTIONS WILL NOT BE IMPEDED * IN THEIR PROGRESSION THROUGH THE VARIOUS NETWORK-PROCESSING * MODULES, DUE TO INABILITY TO ALLOCATE SUFFICIENT S.A.M. FOR USE * IN THE EXCHANGE OF DATA BETWEEN THE NETWORK PROGRAMS. THE INITIALLY * ALLOCATED S.A.M. BUFFER IS RETAINED FOR THE LIFE OF THE * TRANSACTION, AND IS SIMPLY EXCHANGED AMONGST THE VARIOUS MODULES. * 2. INTERMEDIATE PROCESSORS REQUIRE ONLY MINIMUM SIZE LOCAL BUFFERS. * THE QUEUEING ROUTINES NEED NOT ALLOCATE BUFFER SPACE FOR THE * ENTIRE TRANSACTION, PRIOR TO PASSING IT ON TO THE NEXT * PROCESSOR'S CLASS. * 3. SYSTEM OVERHEAD IS MINIMIZED, DUE TO THE AVOIDANCE OF INTER- * MEDIATE ALLOCATION/DE-ALLOCATION OF S.A.M., AND ALSO, BY * AVOIDING WORD-MOVE TRANSFERS BETWEEN USER'S BUFFERS AND S.A.M. * * #REQU OPERATION: * * 1. ON FIRST ENTRY, CONFIGURE THE MODULE. * A. OBTAIN A DIRECT ADDRESS FOR THE CLASS TABLE. * B. IF BIT #1 OF $OPSY =1, THEN OP-SYSTEM USES DMS HARDWARE, * REQUIRING THE USE OF DMS FIRMWARE MACRO INSTRUCTIONS. * C. IF DMS, THEN CLEAR THE DMS-BYPASSING 'JMP' INSTRUCTIONS. * D. IF NON-DMS, ALLOW 'JMP' INSTRUCTIONS TO REMAIN. * E. CLEAR THE PATH TO THE INITIALIZATION ROUTINE. * * 2. GET PARAMETERS & SAVE LOCALLY, IN PREPARATION FOR DMS MAP SWITCH. * A. IF PRIORITY PARAMETER NEGATIVE, REJECT; IF MISSING, USE 32767. * B. IF DMS SYSTEM, SAVE MAP STATUS & SWITCH TO SYSTEM MAP. * * 3. GET THE SOURCE-CLASS PARAMETER & CHECK ITS VALIDITY. * A. IF 0, OR GREATER THAN MAX. CLASS NO., THEN--ERROR -1! * B. COMPUTE & SAVE CLASS-TABLE ENTRY ADDRESS. * C. IF ENTRY =0, THEN NOT ASSIGNED--ERROR -2! * D. IF SOURCE-CLASS, VERIFY THAT SOMETHING IS QUEUED; ELSE--ERROR -2! * E. SAVE ADDRESS OF QUEUED ENTRY (ADDRESS POINTS TO S.A.M.) * F. TRACK DOWN & SAVE CLASS-HEADER ADDRESS; IF LINK WORD=0: ERROR -9! * G. COMPARE SECURITY CODES; IF MIS-MATCH--ERROR -3! * H. ENSURE THAT NO ONE IS WAITING ON SOURCE-CLASS; ELSE--ERROR -4! * I. RETURN TO MAINLINE PROCESSING. * * 4. SAVE SOURCE-CLASS ADDRESS POINTERS. * * 5. CHECK VALIDITY OF DESTINATION-CLASS PARAMETER (VIA 3.A.). * A. IF -1, RESET NEG. BLOCK SIZE VALUE TO POS.; IGNORE OTHER PARAMS. * B. IF NEW BLOCK COUNT > MAX. NO. OF BLOCKS ALLOWED: ERROR -10! * * 6. CHECK FOR 'LU' SPECIFICATION. * A. IF NOT SUPPLIED, GO TO 10. TO DE-QUEUE THE COMPLETED REQUEST. * B. IF SPECIFIED, CHECK FOR VALID LU (NON-ZERO EQT,DEVICE NOT DOWN, * & NOT LINKED TO A DISC FILE); ELSE--ERROR -5! * C. SAVE THE ESQT ADDRESS. * * 7. CHECK FOR 'CONWD' SPECIFICATION. * A. IF NOT SUPPLIED, GO TO 10. TO DE-QUEUE THE COMPLETED REQUEST. * B. IF SPECIFIED,VERIFY THAT REQUEST CODE(BITS#1-0) #0--ELSE ERROR -6. * C. IF CONTROL REQUEST, SKIP LENGTH CHECKS. GO TO 10. * * 8. CHECK FOR-AND VERIFY-USER BUFFER LENGTH/CONTROL PARAMETER SPEC. * A. IF NOT SUPPLIED(OR =100000B),GO TO 10.TO DE-QUEUE CURRENT REQUEST. * B. VERIFY THAT USER'S LENGTH < = AVAILABLE BUFFER IN S.A.M. BLOCK. * C. IF SIZE EXCEEDED: ERROR -8! * * 9. CHECK FOR REQUEST TO OVERLAY THE OPTIONAL PARAMETERS. * A. IF NOT SPECIFIED(OR =100000B), GO TO 10. TO DE-QUEUE THE REQUEST; * * 10. DE-QUEUE COMPLETED CLASS REQUEST FROM SOURCE-CLASS QUEUE. * A. RE-LINK REMAINING ENTRIES BACK INTO SOURCE-CLASS QUEUE. * * 11. CHECK (AGAIN) FOR 'LU' SPECIFICATION. * A. IF NOT SUPPLIED, GO TO 13. TO RE-QUEUE THE REQUEST. * B. IF LU & CONWORD WERE SUPPLIED, REPLACE CONWORD IN COMPLETED * REQUEST WITH USER-SUPPLIED PARAMETER. * C. ENSURE 'T'-FIELD OF CONWORD =3, AND THAT BIT #11 =0 (FOR RTIOC). * D. OVERLAY WORD #3 OF COMPLETED REQUEST WITH THE USER'S PRIORITY. * --IF NONE, USE LOWEST PRIORITY VALUE: 32767. NEGATIVE: ERROR -7! * E. IF WRITE-REQUE, NEGATE BLOCK SIZE(WORD #4) TO PREVENT RTIOC'S * ARBITRARY RELEASE OF THE DATA BUFFER. IF ALREADY NEG. MAKE POS. * F. REPLACE WORD #5 OF COMPLETED REQUEST WITH THE DESTINATION- * CLASS PARAMETER. * G. IF BL/CP SUPPLIED, REPLACE WORD#6 WITH USER'S PARAMETER. * H. IF OPTIONAL PARAMETERS SUPPLIED, REPLACE WORDS#7,8 WITH USER'S. * I. ADD 1 TO THE DESTINATION-CLASS PENDING REQUEST COUNT, IF < 255. * * SKP * 12. LINK THE NEW REQUEST (ACCORDING TO PRIORITY) INTO THE EQT QUEUE. * A. IF THE EQT IS CURRENTLY ACTIVE, THE DEED IS DONE--RETURN. * B. IF INACTIVE, INITIATE I/O OPERATION VIA $DLAY IN RTIOC & RETURN. * * 13. RE-QUEUE THE COMPLETED REQUEST ONTO THE DESTINATION-CLASS. * A. LINK NEW REQUEST TO END OF DESTINATION-CLASS QUEUE. * B. SET CONWD REQ. CODE(BITS#1,0)=0 TO INDICATE CLASS-TO-CLASS REQUE. * C. IF NEG. BLOCK LENGTH IN WORD#4 OF CLASS HEADER, MAKE IT POSITIVE. * D. OVERLAY WORD #5 OF COMPLETED REQUEST WITH DESTINATION-CLASS NO. * E. IF NEWLY-ADDED REQUEST IS ONLY ENTRY IN QUEUE, THEN GO TO 13.G * TO CHECK FOR A WAITING PROGRAM. * F. IF OTHER ENTRIES ARE PRESENT, THEN RETURN TO THE CALLER. * G. CHECK CLASS-HEADER FOR PROGRAM-WAITING BIT(#14); IF NONE, RETURN. * H. IF A PROGRAM IS WAITING, SCHEDULE IT AND RETURN TO THE CALLER. SKP * JSB #REQU * * * #REQU CALLING SEQUENCE * * * * DEF *+3 [OR *+3+N (N=1,TO 6 OPTIONAL PARAMETERS)] * DEF SORCE SOURCE-CLASS NUMBER * DEF DESTN DESTINATION-CLASS NUMBER * [DEF LU ] OPTIONAL LOGICAL UNIT NUMBER * [DEF CONWD] OPTIONAL DRIVER CONTROL WORD * [DEF PRIOR] OPTIONAL PRIORITY VALUE * [DEF BL/CP] OPTIONAL BUFFER LENGTH OR CONTROL PARAMETER * [DEF IRTN1] OPTIONAL FIRST GET-RETURN-PARAMETER * [DEF IRTN2] OPTIONAL SECOND GET-RETURN-PARAMETER * < RETURN > RETURN--NORMAL: =0 ERROR: =-N, =0 * * WHERE: * SORCE = CLASS NUMBER, FROM WHICH THE FIRST-QUEUED COMPLETED REQUEST * IS TO BE REMOVED. * * DESTN = CLASS NUMBER, ONTO WHICH THE COMPLETED REQUEST IS TO BE * RE-QUEUED OR, THE CLASS WHICH IS TO RECEIVE I/O COMPLETION * INFORMATION, WHEN THE REQUEST HAS BEEN RE-QUEUED ONTO * AN EQUIPMENT TABLE ENTRY. IF -1, OTHER PARAMETERS ARE IGNORED * AND THE CURRENTLY-QUEUED SOURCE-CLASS BLOCK SIZE IS MADE POS. * * LU = OPTIONAL LOGICAL UNIT NUMBER, ONTO WHOSE ASSOCIATED EQT * ENTRY, THE COMPLETED SOURCE-CLASS REQUEST IS TO BE RE- * QUEUED FOR INITIATION OF A NEW CLASS I/O OPERATION, * UTILIZING THE EXISTING DATA OR BUFFER SPACE. * * * NOTE: IF LU NOT SUPPLIED, CLASS TO CLASS RE-QUEUEING WILL * BE PERFORMED. * * CONWD = OPTIONAL DRIVER CONTROL WORD, WHICH MAY BE SUPPLIED AS * THE NEW OPERATIONAL SPECIFICATION, FOR RE-QUEUEING THE * REQUEST ONTO AN EQT. [ LU MUST BE SPECIFIED ]. * * BITS #15,14 = DON'T CARE (#REQU SETS EACH =1). * BIT #13 = MSB OF SUBCHANNEL NUMBER. * BIT #12 = 'Z'-BIT (OPTIONAL BUFFER SPECIFICATION). * BIT #11 = NOT USED (FORCED TO 0, FOR RTIOC). * BITS #10-6 = DRIVER SUB-FUNCTION SPECIFICATION. * BITS #5-2 = REMAINDER OF SUBCHANNEL NUMBER. * BITS #1-0 = REQUEST CODE: 1,2,3. * * PRIOR = OPTIONAL PRIORITY (0-32767), USED TO ESTABLISH RELATIVE * POSITION OF NEWLY-LINKED REQUEST IN THE EQT QUEUE. * IF NOT SUPPLIED, LOWEST PRIORITY (32767) IS USED. * [ IGNORED, IF LU & CONWD PARAMETERS NOT SPECIFIED ] * * * NOTE: FOR THE FOLLOWING OPTIONAL PARAMETERS, A VALUE =100000B * MAY BE SUPPLIED-AS A PLACE HOLDER-TO SPECIFY THAT THE * CORRESPONDING CLASS-HEADER ELEMENT IS NOT TO BE CHANGED. * * BL/CP = OPTIONAL BUFFER LENGTH/CONTROL PARAMETER FOR A DRIVER. * * IRTN1 = OPTIONAL PARAMETER WHICH MAY BE RETURNED ON NEXT CLASS-GET. * IRTN2 = OPTIONAL PARAMETER WHICH MAY BE RETURNED ON NEXT CLASS-GET. SKP * * #REQU ERROR INDICATIONS: * * ERROR DETECTION WILL RESULT IN A RETURN TO THE CALLER, WITH THE * REQUESTED ACTION NOT PERFORMED. * * THE -REGISTER WILL ALWAYS =0. IS NEGATIVE, AS FOLLOWS: * * = -1: CLASS NUMBER =0, OR IS GREATER THAN THE MAXIMUM NUMBER * OF CLASSES AVAILABLE. * * = -2: CLASS NOT ASSIGNED, OR NOTHING IS QUEUED ON THE SOURCE-CLASS. * * = -3: INVALID CLASS SECURITY CODE; OR PENDING REQUESTS = 255 (MAX). * * = -h4: PROGRAM IS WAITING FOR SOURCE CLASS ENTRY (CANNOT DE-QUEUE * THE ENTRY). * * = -5: LOGICAL UNIT NUMBER INVALID, OR THE DEVICE IS DOWN. * * = -6: CONWD REQUEST CODE (BITS#1-0) =0. * * = -7: NEGATIVE PRIORITY CODE. * * = -8: BUFFER LENGTH(BL/CP) EXCEEDS CLASS BUFFER SIZE. * * = -9: CLASS QUEUE IMPROPERLY LINKED (LINK WORD =0). * * =-10: NEW BLOCK WILL EXCEED MAX. BLOCKS ALLOWED FOR DEST. CLASS. * SKP SORCE NOP SOURCE CLASS NUMBER. DESTN NOP DESTINATION CLASS NUMBER. LU NOP OPTIONAL LOGICAL UNIT NUMBER. CONWD NOP OPTIONAL DRIVER CONTROL WORD. PRIOR NOP OPTIONAL PRIORITY CODE. BL/CP NOP OPTIONAL BUFFER LENGTH/CONTROL PARAMETER. IRTN1 NOP OPTIONAL GET-RETURN-PARAMETER #1. IRTN2 NOP OPTIONAL GET-RETURN-PARAMETER #2. SUP SUPPRESS EXTRANEOUS LISTING. #REQU NOP ENTRY/EXIT. JSB $LIBR DECLARE THIS TO BE NOP A PRIVILEGED ROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES PRPTR DEF SORCE FOR ALL PARAMETERS. CLA =0 FOR 'CONFG' & 'ERR' INITIALIZATION INIT JMP CONFG CONFIGURE: RTE-II/III; NOP,THEREAFTER. STA ERR INITIALIZE THE ERROR COUNT =0. LDB DM8 INITIALIZE A STB TEMP COUNTER FOR PARAMETER PROCESSING. LDB PRPTR GET POINTER TO PARAMETER ADDRESSES. * PLOOP LDA B,I GET THE PARAMETER ADDRESS (OR ZERO). CCE,SZA,RSS PREPARE TO IGNORE PARAMETER. SUPPLIED? SLA,ERA NO. SET IGNORE-FLAG(100000B) & SKIP. LDA A,I YES. GET THE USER-SUPPLIED PARAMETER. STA B,I SAVE PARAMETER (OR 100000B), LOCALLY. INB ADVVANCE PARAMETER ADDRESS POINTER. ISZ TEMP ALL PARAMETERS PROCESSED? JMP PLOOP NO. CONTINUE PROCESSING. * LDA PRIOR GET THE CALLER-SPECIFIED PRIORITY. CPA BIT15 NOT SUPPLIED/IGNORE Ot? LDA LOWPR YES. USE DEFAULT VALUE: 32767 (LOWEST). SSA IF PRIORITY PARAMETER IS NEGATIVE, JMP ERR7 THEN THE REQUEST CANNOT BE HONORED. STA PRIOR ESTABLISH USER'S OR DEFAULT PRIORITY. * MAPSW JMP BYDMS BYPASS MAP CODE:NON-DMS / NOP:DMS RSA GET CURRENT MAP STATUS. RAL,RAL POSITION CURRENT STATUS FOR RESTORATION. STA DMSTS SAVE FOR RESTORATION, UPON EXIT. SJP BYDMS ENABLE SYSTEM MAP, AND CONTINUE. * BYDMS LDA SORCE GET THE SOURCE CLASS-WORD. JSB CLCHK GO TO DETERMINE ITS VALIDITY. DLD BLKAD SAVE THE SOURCE-CLASS DST SBLK ADDRESS POINTERS. * LDA DESTN GET THE DESTINATION CLASS-WORD. CPA DM1 IF THE PARAMETER IS =-1, THEN JMP RESET GO TO RESET POSSIBLE NEG. BLOCK SIZE; JSB CLCHK ELSE, GO TO VERIFY ITS VALIDITY. * SKP * LDB QCNT GET BLOCK COUNT FOR DESTINATION CLASS. ADB #QCNT SUBTRACT MAXIMUM ALLOWABLE COUNT. CLE,SSB,RSS IF MAXIMUM EXCEEDED, REJECT THE REQUEST. JMP ERR10 THEN ANOTHER BLOCK IS NOT ACCEPTABLE. * LDA LU GET THE USER-SPECIFIED LU, IF ANY. CPA BIT15 IF NONE WAS SUPPLIED, THEN JMP DEQUE BYPASS LU VERIFICATION. JSB DRTEQ GO TO CHECK THE LU'S VALIDITY, DEF *+4 AND TO OBTAIN THE EQT ADDRESS DEF LU FOR ITS ASSOCIATED EQT ENTRY. DEF TEMP IGNORE THE DRT CONTENTS, DEF EQTAD AND RETAIN THE EQT ADDRESS. SSB,RSS IF INVALID, SKIP TO REPORT THE ERROR. SZB,RSS RE-QUEUEING ON EQT#0 IS ALSO INVALID! JMP ERR5 * INFORM THE CALLER OF THE ERROR! * ADB D4 POINT TO WORD #5 OF THE EQT ENTRY. LDA B,I GET THE CONTENTS. RAL,SLA IF THE DEVICE IS BUSY, OR IT IS JMP *+3 WAITING FOR DMA--CONTINUE; SSA ELSE, IF IT IS DOWN, JMP ERR5 0 THEN REJECT THE REQUEST! * AND B74K ISOLATE THE EQUIPMENT TYPE CODE. CPA B30K IF THE EQT IS LINKED TO A DISC FILE, JMP ERR5 * ERROR: INVALID LU! * LDA HEDAD,I GET THE DESTINATION-CLASS HEADER. AND B377 ISOLATE THE PENDING REQUEST COUNT. CPA B377 IF IT HAS ALREADY REACHED MAXIMUM (255), JMP ERR3 THEN REJECT THE NEW REQUEST! * LDA CONWD GET THE CONTROL WORD--IF ANY. CPA BIT15 WAS IT SPECIFIED? JMP DEQUE NO. IGNORE BUFFER CHECKS. * AND D3 ISOLATE THE REQUEST CODE(BITS#1-0). SZA,RSS IF NOT SPECIFIED, JMP ERR6 THEN REJECT THE REQUEST! * CPA D3 IF THIS IS A CONTROL REQUEST, JMP DEQUE THEN LENGTH CHECKING IS NOT NEEDED. * LDA BL/CP GET THE USER'S SPECIFIED LENGTH. CPA BIT15 IGNORE THE PARAMETER? JMP DEQUE YES. GO TO DE-QUEUE THE REQUEST. * SSA,RSS IF CHARACTERS WERE SPECIFIED, SKIP; CMA,INA,RSS ELSE, FORM NEGATIVE WORD COUNT & SKIP; ARS CONVERT CHARACTERS TO NEGATIVE WORDS, SZA,RSS AND IF THE LENGTH =0, JMP DEQUE NO LENGTH CHECKING IS REQUIRED. * LDB SBLK GET THE CONTROL-BLOCK ADDRESS. ADB D3 POINT TO THE BLOCK-SIZE WORD(#4). LDB B,I GET THE TOTAL BLOCK SIZE. SSB IF THE BLOCK SIZE IS ALREADY NEGATIVE, CMB,INB MAKE IT POSITIVE, FOR THE LENGTH CHECK. ADB DM8 SUBTRACT HEADER: REMAINDER= BUFFER SIZE. ADA B ADD USER'S SIZE TO ACTUAL BUFFER SIZE. SSA USER'S REQUEST > ACTUAL BUFFER SIZE? JMP ERR8 YES! REJECT THE REQUEST: ERROR -8. * SKP DEQUE LDA SCLAS IF THE REQUEST IS TO LDB SBLK RE-QUEUE ONTO THE SAME CLASS, CPB HEDAD AND ONLY ONE ENTRY IS PRESENT, STA HEDAD THEN POINT TO CORRECT HEADER ADDRESS. LDA B,I DE5-QUEUE THE COMPLETED CLASS REQUEST STA SCLAS,I FROM THE SOURCE-CLASS QUEUE. LDA LU GET THE USER-SPECIFIED LU, IF ANY. CPA BIT15 IF NONE WAS SUPPLIED, THEN JMP REQUE RE-QUEUE REQUEST ON DESTINATION CLASS. * CLE,INB POINT TO CONWORD IN COMPLETED REQUEST. LDA CONWD GET THE OPTIONAL CONTROL WORD. CPA BIT15 IF NONE WAS SUPPLIED, JMP GETPR THEN IGNORE IT; AND CLR11 ELSE, ENSURE THAT BIT #11 IS CLEAR, IOR CLAST THAT T-FIELD =3, STA B,I AND USE THE SUPPLIED PARAMETER. CCE,SLA SET =1 FOR WRITE REQUEST. CLA,CLE SET =0 FOR READ/CONTROL. * GETPR LDA PRIOR GET THE EQT QUEUEING PRIORITY NUMBER. INB POINT TO WORD #3 OF COMPLETED REQUEST. STA B,I STORE THE PRIORITY INTO THE ENTRY. INB POINT TO THE BLOCK SIZE (WORD#4). LDA B,I GET THE BLOCK LENGTH, AND MAKE IT CMA,SSA,INA NEGATIVE -OR POSITIVE, IF ALREADY NEG. SEZ IF IT'S A WRITE REQUEST, SAVE NEG. SIZE STA B,I TO PREVENT 'RTIOC' FROM RELEASING S.A.M. * LDA DESTN STORE THE CLASS-WORD FOR THE PROGRAM CLE,INB TO BE SCHEDULED ON COMPLETION, INTO STA B,I THE 5TH WORD OF THE CLASS REQUEST. INB POINT TO WORD#6 OF COMPLETED REQUEST. LDA BL/CP GET THE BUFFER LENGTH/CONTROL PARAMETER. CPA BIT15 IGNORE THE PARAMETER? JMP *+2 YES. GO TO CHECK NEXT PARAMETER. STA B,I NO. OVERLAY WORD#6 WITH CALLER'S VALUE. INB POINT TO WORD #7 OF COMPLETED REQUEST. LDA IRTN1 GET OPTIONAL GET-RETURN-PARAMETER #1. CPA BIT15 IGNORE IT? JMP *+2 YES. GO TO CHECK FOR FINAL PARAMETER. STA B,I NO. OVERLAY WORD#7 OF COMPLETED REQUEST. INB POINT TO LAST WORD OF COMPLETED REQUEST. LDA IRTN2 GET THE OPTIONAL GET-RETURN-PARAMETER. CPA BIT15 IGNORE IT? JMP *+2 YES. GO ADVANCE PENDING-REQUEST COUNT. STA B,I NO. OVERLAY WORD#8 OF COMPLETED REQUEST. * ISZ HEDAD,I ADD 1 TO THE PENDING-REQUEST COUNT. JSB LINK LINK INTO EQT QUEUE BY PRIORITY. SEZ IF THE EQT WAS ACTIVE, JMP EXIT RETURN TO THE CALLER; ELSE, LDA EQTAD GET THE EQT ADDRESS, AND JSB $DLAY GO TO INITIATE THE I/O OPERATION. JMP EXIT RETURN--OPERATION COMPLETE. * REQUE LDA HEDAD,I GET DESTINATION CLASS-HEADER. STA B,I END-OF-QUEUE = 1RST WORD OF NEW ENTRY. STB HEDAD,I LINK THE NEW ENTRY AT END-OF-QUEUE. * INB POINT TO THE CONWORD. LDA B,I GET THE CONWORD. AND D3 SET THE XOR B,I REQUEST CODE =0, STA B,I TO INDICATE CLASS-TO-CLASS REQUE. * ADB D2 POINT TO THE BLOCK SIZE(WORD#4). LDA B,I GET THE BLOCK LENGTH. IF IT IS CMA,SSA,INA,RSS NEGATIVE, MAKE IT POSITIVE, AND STA B,I RESTORE THE BLOCK SIZE VALUE. INB POINT TO THE CLASS-WORD IN THE NEW ENTRY. LDA DESTN GET THE DESTINATION CLASS-WORD, STA B,I AND REPLACE THE OLD WITH THE NEW. * LDA CLTBA IF THE CLASS-HEADER IS THE ONLY THING CPA HEDAD IN THE CLASS-TABLE ENTRY, THEN RSS ANY WAITING PROGRAM MUST BE SCHEDULED; JMP EXIT ELSE: OPERATION COMPLETE--RETURN. * LDB SBLK,I GET THE CLASS-HEADER FROM ITS NEW LOCN. RBL,CLE,ELB POSITION WAIT-BIT(#14) TO . SEZ,RSS IF SOMEONE IS WAITING, SKIP TO SCHEDULE; JMP EXIT ELSE: OPERATION COMPLETE--RETURN. * RBR,RBR REPOSITION CLASS-HEADER (LESS BIT#14), STB SBLK,I AND RESTORE IT TO ITS RIGHTFUL PLACE. * JSB $SCD3 SCHEDULE WAITER(=CLASS-TABLE ADDRESS) * EXIT CLA NORMAL EXIT: =0, =0 ERREX =CLB ERROR EXIT: =-N, =0 STB SORCE CLEAR ALL OF STB DESTN THE PARAMETERS, STB LU IN PREPARATION STB CONWD FOR NEXT ENTRY STB PRIOR TO THE ROUTINE. STB BL/CP STB IRTN1 STB IRTN2 * EXIT2 JMP LBEX BYPASS MAP CODE: NON-DMS / NOP: DMS JRS DMSTS LBEX *** RESTORE THE APPROPRIATE MAPS. *** * LBEX JSB $LIBX RETURN TO THE CALLER, VIA THE DEF #REQU RTE PRIVILEGED ROUTINE PROCESSOR. * SKP * ERROR PROCESSING SECTION. SPC 1 ERR10 ISZ ERR -10: NEW BLOCK WIL EXCEED #QLIM WD. CNT. ERR9 ISZ ERR -9: CLASS QUEUE IMPROPERLY LINKED. ERR8 ISZ ERR -8: BUFFER LENGTH > CLASS BUFFER SIZE. ERR7 ISZ ERR -7: NEGATIVE PRIORITY CODE. ERR6 ISZ ERR -6: CONWD REQUEST CODE =0 (BITS#1-0). ERR5 ISZ ERR -5: INVALID LU OR DOWN DEVICE. ERR4 ISZ ERR -4: PGM. WAITING ON SOURCE--CAN'T DEQUE! ERR3 ISZ ERR -3: INVALID CLASS SECURITY CODE. ERR2 ISZ ERR -2: CLASS NOT ASSIGNED, OR NO Q (SOURCE) ERR1 ISZ ERR -1: CLASS =0, OR > MAX. NO. ALLOCATED. LDA ERR GET THE ERROR NUMBER, CMA,INA AND MAKE IT NEGATIVE. JMP ERREX GO TO RETURN THE ERROR-REPORT. * SPC 3 * RESET CURRENTLY-QUEUED SOURCE-CLASS BLOCK SIZE WORD TO A POSITIVE VALUE. * *[RE-QUEUED CLASS WRITES HAVE NEGATIVE BLOCK SIZE TO PREVENT BUFFER RELEASE] * RESET LDB SBLK GET THE BLOCK ADDRESS. ADB D3 POINT TO THE BLOCK SIZE (WORD#4). LDA B,I GET THE BLOCK SIZE VALUE. CMA,SSA,INA,RSS IF IT'S NEGATIVE, MAKE IT POSITIVE, STA B,I AND RESTORE THE CORRECT VALUE. JMP EXIT RETURN. * SKP * CLCHK NOP ENTRY/EXIT: CLASS VALIDITY CHECKING STA TEMP SAVE THE CLASS-WORD FOR LATER USE. AND B377 ISOLATE THE CLASS NUMBER STA B SAVE IT FOR A TABLE INDEX. CMA,CLE,INA,SZA,RSS IF THE NUMBER IS ZERO, CLE,RSS PREPARE FOR AN ERROR-EXIT. ADA $CLAS IF IT IS GREATER THAN MAXIMUM, CLA,SEZ,RSS THEN TAKE THE JMP ERR1 ERROR EXIT. * STA QCNT INITIALIZE CLASS QUEUE BLK CNT. =0. ADB DFCLS COMPUTE, AND SAVE, STB CLTBA THE CLASS-TABLE ENTRY ADDRESS. * LDA TEMP GET THE CLASS WORD. LDB B,I GET THE CLASS-TABLE ENTRY. CPA SORCE IF THE SOURCE-CLASS IS BEING CHECKED, SSB,RSS THEN CONFIRM THAT SOMETHING IS QUEUED. SZB,RSS ALSO VERIFY THAT THE CLASS IS ASSIGNED. JMP ERR2 * ERROR: NOT ASSIGNED OR NO QUEUE. * SSB IF THIS IS THE CLASS-HEADER, THEN LDB CLTBA GET THE CORRECT ADDRESS. STB BLKAD SAVE THE CLASS-QUEUE POINTER, IF ANY. * LOOP ISZ QCNT COUNT NUMBER OF QUEUED BLOCKS. NOP LDA B,I TRACK DOWN SSA DOWN THE JMP SAVAD CLASS HEADER. SZA,RSS IF THE LINK WORD IS ZERO, JMP ERR9 THEN THE CLASS QUEUE IS CORRUPT! * LDB B,I LAST QUEUE NOT YET LOCATED, JMP LOOP SO CONTINUE THE SEARCH. * SAVAD STB HEDAD SAVE THE CLASS-HEADER ADDRESS. CPB CLTBA IF NOTHING IS QUEUED, THEN JMP GETSC THE WORD COUNT REMAINS =0; * GETSC LDA TEMP ISOLATE THE AND SCMSK USER-SPECIFIED SECURITY CODE, STA B AND SAVE IT FOR COMPARISON. LDA HEDAD,I GET THE CLASS-HEADER. AND SCMSK ISOLATE ITS SECURITY CODE. CPA B IF THEY COMPARE, THEN RSS ALL'S WELL--PROCEDE; JMP ERR3 ELSE, REPORT THE ERROR! * LDA TEMP GET THE CLASS-WORD, AGAIN. CPA SORCE IF IT'S THE SOURCE-CLASS, THEN RSS SKIP TO CHECK FOR WAITERS; JMP CLCHK,I ELSE, RETURN TO THE CALLER. * LDB HEDAD,I GET THE CLASS-HEADER. RBL POSITION THE WAIT-BI+jNLHT(#14) FOR TEST. SSB IF SOMEONE IS WAITING, JMP ERR4 THEN RE-QUEUEING IS IMPROPER! * JMP CLCHK,I VALID CLASS: RETURN--POINTERS SET. * QCNT NOP CLASS QUEUE BLOCK COUNT ACCUMULATION. #PRLX EQU 0 LU FOR PROGL MESSAGES: DEFAULT = NONE. #QCNT DEC -11 -[(MAX. ALLOWABLE QUEUED BLOCKS)+1] xN SKP * LINK CLASS REQUEST INTO EQT QUEUE, ACCORDING TO PRIORITY. * * [ CODE SIMULATES RTIOC, SINCE ENTRY INTO RTIOC'S 'LINK' NOT PROVIDED. ] * LINK NOP LDB EQTAD GET EQT QUEUE-HEAD ADDRESS. CLE,RSS SET FIRST-FLAG AND SKIP TO START SCAN. * LINK1 SEZ,CCE,RSS IF FIRST, RESET FLAG & SKIP FIRST ENTRY. JMP LINK4 GO TO START THE SCAN. STB TEMP SAVE ADDRESS OF ENTRY UNDER EXAMINATION. INB POINT TO SECOND WORD OF THE ENTRY. LDA B,I GET THE CONTROL WORD. INB ADVANCE POINTER TO ENTRY'S THIRD WORD. AND CLAST ISOLATE THE REQUEST TYPE ('T'BITS#15,14). RAL,RAL POSITION TO BITS#1,0 TO TEST & CLEAR. SLA,ARS TEST FOR BUFFERED REQUEST & CLEAR BIT. JMP LINK2 BUFFERED: POINTS TO PRIORITY. SLA,ARS TEST FOR SYSTEM REQUEST & CLEAR BIT. JMP LINK3 SYSTEM: USE PRIORITY =0; =0. ADB D4 NORMAL USER REQ.: PRIOR. IN ID WORD#7. LINK2 LDA B,I GET PRIORITY OF ENTRY UNDER EXAMINATION. LINK3 LDB TEMP GET THE ENTRY'S ADDRESS. CMA,INA SUBTRACT THE ENTRY'S PRIORITY FROM ADA PRIOR THE PRIORITY OF THE NEW REQUEST. SSA IF CURRENT ENTRY'S PRIORITY IS LOWER JMP LINK5 THAN NEW ONE, GO LINK-IN NEW REQUEST. * LINK4 STB TEMP+1 SAVE ADDRESS OF PREVIOUS ENTRY. LDB B,I GET ADDRESS OF NEXT ENTRY IN QUEUE. ELB,CLE,ERB CLEAR POSSIBLE SIGN AND SAVE . SZB IF END-OF-LIST: SKIP TO ADD NEW ENTRY; JMP LINK1 ELSE, CONTINUE THE SCAN. * LINK5 LDA SBLK GET THE ADDRESS OF THE NEW ENTRY. STB SBLK,I LINK LOWER PRIORITY ENTRIES OR 0 (EOL). XOR TEMP+1,I KEEP THE SIGN AND C100K OF THE OLD WORD XOR TEMP+1,I IF IT WAS SET. STA TEMP+1,I LINK NEW REQ. AFTER HIGHER PRIOR. ENTS. JMP LINK,I RETURN:=0 START I/O;=1 I/O ACTIVE. * SKP * A EQU 0 B    EQU 1 B377 OCT 377 CLASS NUMBER MASK. B30K OCT 30000 B74K OCT 74000 BIT15 OCT 100000 CLAST OCT 140000 T-FIELD FOR CLASS REQUESTS CLR11 OCT 173777 BIT #11 MASK FOR RTIOC COMPATABILITY. D2 DEC 2 D3 DEC 3 D4 DEC 4 DM1 DEC -1 DM8 DEC -8 DFCLS DEF $CLAS CLASS TABLE ADDRESS. LOWPR DEC 32767 LOWEST PRIORITY FOR END-OF-QUEUE. C100K EQU LOWPR SCMSK OCT 17400 CLASS SECURITY-CODE MASK. * BLKAD NOP DESTINATION: SAM-BLOCK ADDRESS CLTBA NOP DESTINATION: CLASS-TABLE ADDRESS DMSTS NOP DMS MAP STATUS EQTAD NOP EQT ADDRESS ERR NOP ERROR NUMBER HEDAD NOP DESTINATION: CLASS-HEADER ADDRESS SBLK NOP SOURCE: SAM-BLOCK ADDRESS SCLAS NOP SOURCE: CLASS-TABLE ADDRESS TEMP BSS 2 TEMPORARY STORAGE * ORG BLKAD ONE-TIME CONFIGURATION IN STORAGE AREA. * CONFG LDB DFCLS GET A RSS DIRECT ADDRESS LDB B,I FOR THE RBL,CLE,SLB,ERB BEGINNING JMP *-2 OF THE STB DFCLS CLASS TABLE. LDB $OPSY GET THE OP-SYSTEM IDENTIFIER. RBR,CLE,ERB POSITION DMS BIT(#1) TO . CLB,SEZ,CLE,RSS IF DMS SYSTEM, SKIP TO ENABLE DMS JMP NODMS CODE; ELSE JUST CLEAR CONFG. CALL. STA MAPSW ALLOW SWITCHING TO THE SYSTEM MAP. STA EXIT2 PROVIDE FOR MAP RESTORATION, UPON EXIT. NODMS STA INIT NO FURTHER NEED FOR CONFIGURATION. JMP INIT+1 RETURN TO NORMAL PROCESSING. * ORR < SIZE OF #REQU > * END W   " 91740-18029 1740 S C0122 DS/1000 MODULE: D65SV              H0101 [QASMB,L,R,C HED D65SV 91740-16029 REV 1740 HEWLETT-PACKARD CO. 1977 NAM D65SV,7 91740-16029 REV 1740 771018 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 **************************************************************** * * D65SV * * SOURCE PART # 91740-18029 * * REL PART # 91740-16029 * * WRITTEN BY CHUCK WHELAN * * DATE WRITTEN NOV 1976 * * MODIFIED BY C.C.H. # * * DATE MODIFIED 10/18/77 # * *************************************************************** SPC 2 * THIS ROUTINE SENDS SLAVE REQUESTS * CALLING SEQUENCE: * JSB D65SV * DEF *+5 * DEF RQBUF REQUEST BUFFER * DEF RQLEN REQUEST LENGTH * DEF DABUF DATA BUFFER * DEF DATAL DATA LENGTH * * * * * D65SV IS CALLED BY DS/1000 MONITORS TO SEND A REPLY AND * POSSIBLY DATA BACK TO THE ORIGINATING NODE. IT PERFORMS THE * FOLLOWING STEPS: * 1. DEALLOCATES THE SLAVE TCB, IF THIS FAILS TAKES THE * ERROR RETURN. * 2. VERIFIES THAT 7<=REPLY LENGTH<=31 AND IF NOT RETURNS * A DS03 ERROR. * 3. CONVERTS THE NODAL ADDRESS OF THE ORIGINATING CPU * TO AN OUTPUT LU. IF LU CONVERSION FAILS, A DS04 ERROR * IS RETURNED. * 4. DOES A CLASS I/O WRITE/READ OF THE REPLY(/DATA) TO * GRP3HM'S CLASS NUMBER (OR RPCNV'S CLASS IF A 3000 WAS * WAS THE REQUEST ORIGINATOR. * 5. RETURNS * SPC 2 ENT D65SV EXT EXEC,.ENTR,$OPSY EXT #RSAX,#NCNT,#GRPM,#BREJ,#RPCV SPC 2 RQBUF NOP RQLEN NOP DABUF NOP DATAL NOP * D65SV NOP JSB .ENTR GET CALLER'S PARAMETERS DEF RQBUF * LDA RQBUF INA STA TEMP1 ADDR OF SEQ.# INA STA TEMP2 ADDR OF ORIGINATORS NODE * JSB #RSAX DELETE SLAVE TCB DEF *+4 DEF K7 TEMP1 NOP DEF RQBUF,I STREAM SSB JMP D65SV,I TCB SEARCH FAILED, ERROR RETURN STA TEMP1,I RESTORE OLD SEQ # IN REQUEST * * VERIFY THAT 6 < REQUEST LENGTH < 32 * LDB "03" LDA RQLEN,I GET REQUEST LENGTH ADA N7 MUST BE AT LEAST 7 SSA JMP GETDS GIVE DS03 IF <7 ADA N25 SSA,RSS JMP GETDS GIVE DS03 IF > 31 * * CHECK FOR REPLY TO DS/3000 REPLY CONVERTER. * LDB #RPCV PRESET = "RPCNV'S" CLASS NO. # LDA RQBUF,I GET THE STREAM WORD OF THE REPLY. # AND RTYCT CLEAR THE OLD RETRY COUNTER. # IOR #BREJ INITIALIZE NEW RETRY COUNT. # STA RQBUF,I RESTORE MODIFIED STREAM WORD. # * # CLE,ELA POSITION DS/3000 BIT#15 TO . # CLA,SEZ,CLE IF THIS IS A DS/3000 REPLY, SET LU=0, # JMP RPL3K THEN BYPASS DS/1000 PROCESSING. # * SKP * * CONVERT DESTINATION NODE TO LU * LDA TEMP2,I GET THE ORIGINATOR'S NODAL ADDRESS SSA ABSOLUTE DESTINATION CODE ? (NEIGHBOR) JMP ABS YES, GET LU AND RETURN DLD #NCNT NO, GET ADDR & SIZE OF THE TABLE STA TEMP1 SAVE COUNTER * LOOP JSB LODWD GET A CPU # INB POINT TO CORRESPONDING LU CPA TEMP2,I IS IT THE GOOD  ONE ? JMP LUFND YES INB BUMP POINTER TO NEXT NODE # ISZ TEMP1 NO, END OF TABLE ? JMP LOOP NO, CONTINUE * LDB "04" YES, CPU # ERROR * GETDS LDA "DS" JMP D65SV,I RETURN WITH ERROR CODE * ABS CMA,INA MAKE IT >0 JMP LUOK * LUFND JSB LODWD FETCH LU AND B77 ISOLATE IT * * NOW SEND THE REQUEST(/DATA) * LUOK LDB #GRPM GET "GRPM'S" CLASS NUMBER. # RPL3K IOR CONWX SET "Z" BIT AND "WRITE" INDICATOR # STA TEMP1 SAVE CONFIGURED CONWD. # STB TEMP2 SAVE CLASS NUMBER (#GRPM OR #RPCV). # * JSB EXEC DO CLASS WRITE/READ DEF *+8 DEF CLS20 NO ABORT DEF TEMP1 CONTROL WORD DEF DABUF,I DATA BUFFER ADDRESS DEF DATAL,I DATA LENGTH DEF RQBUF,I REQUEST BUFFER ADDRESS DEF RQLEN,I REQUEST LENGTH DEF TEMP2 * JMP D65SV,I ISZ D65SV JMP D65SV,I SKP * * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM * LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE RAR,SLA BIT#1=0 IF NON-DMS # JMP XLOAD DMS: USE CROSS LOAD. # * # LDA B,I NON-DMS: GET THE WORD FROM S.A.M. # JMP LODWD,I RETURN WITH = WORD, UNCHANGED. # * # XLOAD XLA B,I GET THE WORD FROM THE SYSTEM MAP. # JMP LODWD,I RETURN: =WORD, UNCHANGED. # * * DATA AREA * B EQU 1 # TEMP2 NOP B77 OCT 77 CONWX OCT 10100 RTYCT OCT 170077 CLS20 OCT 100024 CLASS WRITE/READ--NO ABORT K7 DEC 7 N7 DEC -7 N25 DEC -25 "03" ASC 1,03 "04" ASC 1,04 "DS" ASC 1,DS END   91740-18030 1740 S C0122 DS/1000 MODULE: DRTEQ              H0101 :ASMB,R,L,Z,C HED DRT/EQT ADDRESS ROUTINE * (C) HEWLETT-PACKARD CO. 1977 * IFN NAM DRTEQ,7 91740-16030 REV 1740 770314 XIF IFZ NAM DRTEQ,30 91740-16030 REV 1740 770330 XIF ENT DRTEQ IFN EXT .ENTR XIF IFZ EXT .ENTP,$LIBR,$LIBX XIF * NAME: DRTEQ * SOURCE: 91740-18030 * RELOC: 91740-16030 * PGMR: C.C.H. [ 01/17/76 ] * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * DRTEQ ACCEPTS A USER-SUPPLIED LOGICAL UNIT NUMBER, AND RETURNS * TO THE CALLER, BOTH THE CONTENTS OF THE DEVICE REFERENCE TABLE * ENTRY FOR THAT LOGICAL UNIT, AND THE ADDRESS OF THE FIRST WORD * OF THE EQT ENTRY WHICH IS LINKED TO THE SPECIFIED LOGICAL UNIT. * * DRTEQ CALLING SEQUENCE: * * JSB DRTEQ * DEF *+2 [ OR *+2+N WHERE N= NUMBER OF OPTIONAL PARAMETERS <=2 ] * DEF LU ADDRESS OF LOGICAL UNIT NO. IN QUESTION. * [DEF DRTEN] [OPTIONAL ADDRESS FOR RETURN OF DRT ENTRY CONTENTS.] * [DEF EQTAD] [OPTIONAL ADDRESS FOR RETURN OF EQT ENTRY LOCATION.] * =DRT ENTRY CONTENTS; =EQT ADDRESS. * * FORTRAN CALLING SEQUENCE: CALL DRTEQ(LU,IDRT,IEQAD) OR REG=DRTEQ(LU) * * NOTE: IN THE SPECIAL CASE OF LOGICAL UNIT NUMBERS WHICH ARE * LINKED TO EQT #0 ("BIT BUCKET"), THE DRT ENTRY RETURNED * TO 'DRTEN' & WILL REFLECT THE ACTUAL CONTENTS; I.E., * ANY SUBCHANNEL OR LU-LOCK BITS WILL BE PASSED TO THE CALLER. * SINCE THERE IS NO EQT ENTRY ASSOCIATED WITH THE LU, * 'EQTAD' & WILL BOTH BE SET =0. * * DRTEQ ERROR PROCEOSSING: * * INVALID LOGICAL UNIT NUMBERS WILL BE INDICATED BY SETTING -1 * INTO THE RETURNED PARAMETERS-IF ANY, AND INTO BOTH &, UPON * RETURN TO THE CALLER. * * SUP [SUPPRESS EXTENDED LISTING] * LU NOP LOGICAL UNIT ADDRESS. P1 DEF A OPTIONAL DRT ENTRY RETURN ADDRESS. P2 DEF B OPTIONAL EQT ADDRESS RETURN LOCATION. SPC 1 DRTEQ NOP ENTRY/EXIT. IFN JSB .ENTR OBTAIN DIRECT ADDRESSES XIF IFZ JSB $LIBR DEFINE THIS SUBROUTINE NOP TO BE PRIVILEGED. JSB .ENTP PRIVILEGED: GET DIRECT ADDRESSES. XIF DEF LU DEFINE PARAMETER STORAGE AREA. SPC 1 * RE-INITIALIZE CALLING-PARAMETER ADDRESSES TO POINT TO & , * IN ORDER TO ALLOW USER TO CALL WITHOUT RETURN-DATA PARAMETERS. SPC 1 DLD P1 GET PARAMETER ADDRESSES-IF ANY. DST DRT SAVE FOR DATA RETURN. DLD REGDF GET INITIAL PARAMETER DEFINITION. DST P1 RE-INITIALIZE FOR NO PARAMETERS. SPC 1 * VERIFY THAT CALLER HAS REQUESTED DATA FOR A VALID LOGICAL UNIT NO. SPC 1 LDA LU,I GET THE USER SUPPLIED LU NUMBER. AND B77 ISOLATE THE PERTINENT BITS. ADA M1 SUBTRACT ONE, FOR VALIDITY CHECKING. STA B SAVE FOR DRT INDEXING. CMA,CLE IF THE SPECIFIED LU NUMBER ADA LUMAX IS NOT IN THE RANGE: SEZ,RSS 1<=LU<=LUMAX, THEN JMP ERROR THE LU IS INVALID! SPC 1 * RETRIEVE THE CONTENTS OF THE DEVICE REFERENCE TABLE ENTRY. SPC 1 ADB DRTA FIND THE DEVICE REFERENCE TABLE ENTRY LDA B,I FOR A VALID LOGICAL UNIT NUMBER. STA AREG SAVE THE DRT ENTRY FOR THE CALLER. STA LU SAVE IT FOR RETURN IN . AND B77 ISOLATE THE EQT ORDINAL. CLB PREPARE TO RETURN EQT ADDRESS =0. SZA,RSS IF THE ORDINAL IS ZERO, JMP ZERO RETURN WITH EQT ADDRESS =0. SPC 1 * CALCULATE THE ADDRESS OF THE EQUIPMENT TABLE ENTRY LINKED TO THE LU. SPC 1 ADA M1 ORDINAL-1 =RELATIVE EQT ENTRY ORDINAL. MPY D15 RELATIVE ENTRY*WORDS/ENTRY =OFFSET. LDB A GET EQT-ENTRY OFFSET IN . ADB EQTA FORM ABSOLUTE EQT-ENTRY ADDRESS IN . ZERO STB BREG SAVE THE EQT ADDRESS FOR THE CALLER. JMP EXIT GO TO RETURN THE REQUESTED INFORMATION. * SKP * PROCESS INVALID LOGICAL UNIT NUMBER ERRORS. SPC 1 ERROR CCA INVALID LOGICAL UNIT NUMBER. STA AREG RETURN TO USER WITH BOTH PARAMETERS STA BREG AND & SET TO -1. SPC 1 * PASS DATA BACK TO THE CALLER AND THEN RETURN. SPC 1 EXIT LDA AREG = DRT ENTRY OR -1, IF ERROR. STA DRT,I PASS DRT ENTRY TO CALLER, IF REQUESTED. LDB BREG = EQT ADDRESS OR -1, IF ERROR. STB EQTAD,I PASS EQT ADDRESS TO CALLER, IF REQUESTED. IFN JMP DRTEQ,I RETURN:=DRT OR -1;=EQT ADD. OR -1. XIF IFZ JSB $LIBX RETURN TO CALLER DEF DRTEQ VIA PRIVILEGED PROCESSOR. XIF SPC 1 * CONSTANTS, POINTERS, AND STORAGE. SPC 1 A EQU 0 B EQU 1 B77 OCT 77 EQTA EQU 1650B ADDRESS OF 1RST WORD OF EQUIPMENT TABLE. DRTA EQU 1652B ADDRESS OF DEVICE REFERENCE TABLE. LUMAX EQU 1653B NUMBER OF VALID DRT ENTRIES. M1 DEC -1 D15 DEC 15 AREG NOP TEMPORARY STORAGE: DRT ENTRY OR ERROR. BREG NOP TEMPORARY STORAGE: EQT ADDR. OR ERROR. DRT NOP DRT RETURN-PARAMETER ADDRESS. EQTAD NOP EQT ADDR. RETURN-PARAMETER ADDRESS. REGDF OCT 0,1 REGISTER ADDRESSES FOR INITIALIZATION. SPC 1 END U  91740-18031 2026 S C0122 &RES +              H0101 IuASMB,R,L,C HED DS/1000 RESIDENT STORAGE * (C) HEWLETT-PACKARD CO. 1979 * NAM RES,30 91740-16031 REV.2026 800429 SPC 1 ENT #BUSY,#FWAM,#GRPM,#BREJ,#LDEF,#MNUM,#MRTH ENT #PNLH,#TRCL,#TRCN,#CL3K ENT #RDLY,#PRLU ENT #MSTO,#NODE,#NCNT, #NRV,#NULL, #QRN,#RSAX,#RTRY ENT #ST00,#ST01,#ST02,#ST03,#ST04,#ST05,#ST06,#ST07 ENT #ST08,#ST09,#ST10,#SVTO,#TBRN,#WAIT,#CNOD,#LNOD ENT #QCLM,#NCLR,#SCLR,#SWRD,#PLOG,#RFSZ,#SAVM ENT #RPCV,#RQCV,#LU3K,#QZRN,#QXCL,#TST ENT D$LID,D$RID SPC 1 EXT #PRLX EXT $ALC,$CGRN,$LIBR,$LIBX,$OPSY,$RTN,.ENTP * * NAME: RES * SOURCE: 91740-18031 * RELOC: 91740-16031 * PGMR: C. HAMILTON [ 03/02/77 ] * D. TRIBBY [ 03/17/77 ] * HP3000 MODIFICATIONS * * LYLE WEIMAN [ 08/05/78 ] * TOM MILNER [ 04/29/80 ] * REMOVED 'LSTEN' CHECKS * * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * SPC 5 * RES IS A MEMORY-RESIDENT SYSTEM LIBRARY MODULE USED BY THE * DS/1000 (DISTRIBUTED SYSTEMS) SOFTWARE PACKAGE TO PROVIDE * CONTROLLED-ACCESS COMMON STORAGE. ITEMS STORED IN ARE NETWORK * GLOBAL CONSTANTS & VARIOUS LISTS WHICH CONTAIN THE TRANSACTION-BLOCK * RECORDS OF CURRENT TRANSACTIONS-IN-PROCESS ON THE NETWORK. * SPC 5 * #RSAX IS A PRIVILEGED LIBRARY ROUTINE EMBEDDED IN RES * WHICH CONTROLS ACCESS TO, AND ALLOWS MAINTENANCE OF, THE * NETWORK'S TRANSACTION-CONTROL-BLOCKS (TCB'S) FOR CURRENT REQUESTS. * SKP * #RSAX OPERATION: SPC 1 * 1. ON FIRST ENTRY, VERIFY THAT CALLER IS ELSE, ERROR #1! * A. SAVE I.D. SEGMENT ADDRESS FOR S.A.M. VALIDITY CHECKS. * B. IF BIT #1 OF $OPSY =1, THEN OP-SYSTEM USES DMS HARDWARE, * REQUIRING THE USE OF OF DMS FIRMWARE MACRO INSTRUCTIONS. * C. IF DMS, THEN CLEAR THE DMS-BYPASSING JUMP INSTRUCTIONS. * D. IF NON-DMS, ALLOW BYPASS INSTRUCTIONS TO REMAIN. * E. CLEAR THE 'JSB' TO THE INITIALIZATION ROUTINE. SPC 1 * 2. GET PARAMETERS & SAVE LOCALLY, IN PREPARATION FOR DMS MAP SWITCHING. * A. IF DMS SYSTEM, THEN SAVE MAP STATUS AND SWITCH TO SYSTEM MAP. SPC 1 * 3. CHECK MODE OF OPERATION: * A. IF =0, GO TO 7. TO ALLOCATE SYSTEM MEMORY. * B. IF =1, GO TO 7. TO DE-ALLOCATE SYSTEM MEMORY. * C. IF =2, GO TO 4. TO ADD NEW ENTRY TO MASTER-REQUEST LIST. * D. IF =3, GO TO 5. TO ADD NEW ENTRY TO A SLAVE-STREAM LIST. * E. IF =4, GO TO 6. TO SEARCH FOR A MASTER TCB ENTRY. * F. IF =5, GO TO 6. TO SEARCH FOR A SLAVE TCB ENTRY. * G. IF =6, GO TO 6. TO REMOVE A MASTER ENTRY & RETURN IT TO THE POOL. * H. IF =7, GO TO 6. TO REMOVE A SLAVE ENTRY & RETURN IT TO THE POOL. * I. IF =8, GO TO 4. TO ADD AN HP3000 PROCESS. * J. IF=10, GO TO 6. TO REMOVE AN HP3000 PROCESS. * K. IF NONE OF THE ABOVE - ERROR #2 --- REJECT! SPC 1 * 4. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE MASTER LIST. * A. IF NONE AVAILABLE, CALLER HAS NOT CHECKED AVAILABILITY OF * TABLE-ACCESS RN (#TBRN) BEFORE ENTRY - ERROR #3 --- REJECT! * B. IF ENTRY AVAILABLE, SEARCH BY ID SEG. ADDR. FOR OBSOLETE * ENTRIES IN THE MASTER REQUEST LIST. * C. FLAG ALL OBSOLETE MASTER-REQUEST ENTRIES AS BAD, IF THEY * ORIGINATED WITH SAME REQUESTOR (BIT#15 =1 OF WORD#5). * D. LINK THE NEW ENTRY INTO THE MASTER REQUEST LIST. * E. USE TIMEOUT FROM NRV--IF SPECIFIED; ELSE USE DEFAULT: #MSTO. * F. TRANSFER THE CALLER'S DATA INTO THE NEW ENTRY. * G. IF ENTRY POOL NOT DEPLETED, CLEAR TABLE-ACCESS RN & RETURN. SPC 1 * 5. CHECKW FOR AVAILABLE ENTRY, BEFORE ADDING TO THE SLAVE-STREAM LIST. * A. IF NONE, #TBRN NOT CHECKED BEFORE ENTRY - ERROR #3 --- REJECT! * B. CHECK STREAM PARAMETER FOR ACCEPTABLE TYPE--ERROR #1, IF INVALID. * C. LINK THE NEW ENTRY INTO THE SPECIFIED SLAVE-STREAM LIST. * D. TRANSFER CALLER'S DATA INTO THE NEW ENTRY. * E. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 6. INITIALIZE LIST POINTERS, BEFORE SEARCHING FOR/CLEARING AN ENTRY. * A. IF IMPROPER LIST SPECIFIED - ERROR #1 --- REJECT! * B. SEARCH FOR ENTRY. IF ENTRY NOT LOCATED, REJECT---ERROR #4! * C. IF MODE=4/5, GET CONTENTS OF ENTRY WORD#4 & RETURN TO CALLER. * D. IF MODE=6/7, GET CONTENTS OF WD#4 & RE-LINK ENTRY IN NULL LIST. * E. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 7. VERIFY CALLER TO BE BEFORE ALLOCATION/DE-ALLOCATION OF S.A.M. * A. IF MODE & #FWAM =0, GO TO ALLOCATE SYSTEM AVAILABLE MEMORY. * B. IF REQUEST GRANTED, STORE BLOCK ADDRESS IN #FWAM, SIZE IN #SAVM. * D. IF REQUEST DENIED, RETURN REASON IN , FOR FURTHER ANALYSIS. * E. IF MODE=1 & PRAM1=#FWAM, RETURN MEMORY TO THE SYSTEM. * F. CLEAR #FWAM & #SAVM, BEFORE RETURNING TO . SKP * #RSAX CALLING SEQUENCE: * * JSB #RSAX * DEF *+3 [ OR *+4 OR *+5 ] * DEF MODE MODE OF OPERATION (0 THRU 7) * DEF PRAM1 REQUIRED PARAMETER (SEE TABLE, BELOW) * DEF PRAM2 REQUIRED FOR MODES: 2,3,5,7 [OPTIONAL MODES: 0,1,4,6] * DEF PRAM3 REQUIRED FOR MODES 2 & 3 ONLY (NODAL ADDRESS) * : NORMAL-(SEE TABLE); ERROR-(SEE LATER DESCRIPTION) * * WHERE: * * +----+------------+--------------+------------+---------+-------+-------+ * !MODE! ACTION ! PRAM1 ! PRAM2 ! PRAM3 ! RTN! RTN! * !====+============+==============+============+=========+=======+=======+ * ! 0 ! GET MEMORY !#WORDS TO GET ! NOT USED ! NOT USED!FWA SAM! #WORDS! * +----+------!_------+--------------+------------+---------+-------+-------+ * ! 1 ! RTN MEMORY !FWA SAM BLOCK ! NOT USED ! NOT USED! 0 ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 2 ! ADD MASTER !MASTER CLASS# !ID SEG.ADDR.!DEST.NODE!LOC SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 3 ! ADD SLAVE !ORIG. SEQ. NO.!SLAVE STREAM!ORIG.NODE!LOC SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 4 ! FIND MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# !TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 5 ! FIND SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 6 !CLEAR MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 7 !CLEAR SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 8 ! ADD PNL ! LOGGING LU # !ID SEG.ADDR.!PROCESS #!LOC.SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 10 ! CLEAR PNL !PROCESS NUMBER! NOT USED ! NOT USED! LOG LU! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * * #RSAX ERROR INDICATIONS: * * ERROR DETECTION WILL RESULT IN A RETURN TO THE CALLER WITH THE * REQUESTED ACTION NOT PERFORMED. * * = -1: AN INVALID LIST HAS BEEN SPECIFIED; FIRST CALLER * IS NOT ; MEMORY ALLOCATION/DE-ALLOCATION IMPROPER. * * = -2: THE SPECIFIED MODE OF OPERATION IS UN-DEFINED. * * = -3: NO SPACE FOR A NEW ENTRY. THE CALLER DID NOT WAIT FOR * THE TABLE-ACCESS RESOURCE NUMBER (#TBRN) TO BE CLEARED, * PRIOR TO CALLING #RSAX. (THIS?Z SHOULD NOT OCCUR IF ALL * CALLERS ADHERE TO THE RN CONVENTION, PRIOR TO CALLING.) * * = -4: ENTRY CANNOT BE LOCATED; ACCESSING AN EMPTY LIST. * * MODE 0 ( ALLOCATION ): =-1,=MAXIMUM POSSIBLE NO. OF WORDS. * = 0,=MAXIMUM WORDS AVAILABLE NOW. * 1 (DE-ALLOCATION): NO ERRORS INDICATED. SKP * LIST FORMATS: * * 'RES' SYSTEM AVAILABLE MEMORY * ------------------------------- ------------------------- * * #PNLH < ADDR 1ST PROCESS# LIST ENTRY>... * < ---------------------- > * < PROCESS NUMBER > * < LOGGING LU NUMBER > * * * #MRTH < ADDR.=1RST MASTER-LIST ENTRY>... * < UD------*TIMEOUT CNTR. > * < LOCAL SEQUENCE NUMBER > * * * * #ST00 ... * . <- * MONITOR'S CLASS NUMBER > < UD------*TIMEOUT CNTR. > * . < LOCAL SEQUENCE NUMBER > * . < ORIGIN SEQUENCE NUMBER > * . < ORIGIN NODAL ADDRESS > * . * . * #STXX < ******* FORMAT SAME ******* >...< **** FORMAT SAME ***** > * < ********* FOR ALL ********* > < ******** FOR ********* > * < ****** SLAVE STREAMS ****** > < ******** ALL ********* > * < ******* SLAVE ******** > * < ****** STREAMS ******* > * * WHERE: - = RESERVED FOR FUTURE USE. A(#15) = ABORT OK. * B(#15) = BAD ENTRY. * C(#15) = LONG MASTER TIMEOUT (APPROXIMATELY 20 MIN.) * U(#15) = UPLIN TEMPORARY BIT. D(#14) = HP3000 REQUEST. * * *NOTE: 0 IN LIST HEAD OR FIRST WORD OF ENTRY SIGNALS END OF LIST. * * * NETWORK ROUTE VECTOR TABLE: * * #NCNT < NEGATIVE NUMBER OF NRV PAIRS> * #NRV < ADDRESS OF NRV TABLE >...< NODAL ADDRESS (0-32767)> * * < *** NODAL ADDRESS *** > * < *** LOGICAL UNIT *** > * . * : * SKP MODE NOP MODE OF OPERATION. PRAM1 NOP USER PRAM2 NOP SPECIFIED PRAM3 NOP PARAMETERS. SUP [SUPPRESS EXTENDED LISTING] #RSAX NOP ENTRY/EXIT: TCB MANAGEMENT. JSB $LIBR DECLARE THIS TO BE NOP A PRIVILEGED ROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES DEF MODE FOR PARAMETERS & RETURN POINT. * INIT JSB CONFG 1RST ENTRY: CONFIGURE; 'NOP' THEREAFTER. * CLA [PROTECT AGAINST MISSING PARAMETER] LDA PRAM1,I OBTAIN STA PRAM1 PARAMETERS CLA FOR LDA PRAM2,I LOCAL USE, STA PRAM2 IN PREPARATION CLA FOR A LDA PRAM3,I POSSIBLE STA PRAM3 DMS MAP-SWITCH. CLA LDB MODE,I GET THE MODE OF OPERATION, STB MODE AND SAVE IT LOCALLY, ALSO. LDA PRAMA INITIALIZE THE KEYWORD ADDRESS POINTER STA KEYAD TO REFERENCE FIRST CALLER PARAMETER. * DMS1 JMP MODCK BYPASS MAP CyODE: RTE-II / 'NOP': RTE-III * RSA GET CURRENT MAP STATUS. RAL,RAL POSITION CURRENT STATUS FOR RESTORATION. STA DMSTS SAVE FOR RESTORATION BEFORE EXIT. SJP MODCK ENABLE SYSTEM MAP AND CONTINUE. * DMSTS NOP DMS MAP-STATUS STORAGE. * MODCK SZB,RSS MODE =0? JMP SAM YES, GO TO ALLOCATE MEMORY. CPB P1 MODE =1? JMP SAM RETURN MEMORY TO RTE. CPB P2 MODE =2? JMP ADENT GO TO CREATE A MASTER TCB ENTRY. CPB P3 MODE =3? JMP ADENT GO TO CREATE A SLAVE TCB ENTRY. CPB P4 MODE =4? JMP FIND SEARCH FOR A MASTER TCB ENTRY. CPB P5 MODE =5? JMP FIND SEARCH FOR A SLAVE TCB ENTRY. CPB P6 MODE =6? JMP FIND SEARCH FOR/CLEAR A MASTER TCB ENTRY. CPB P7 MODE =7? JMP FIND SEARCH FOR/CLEAR A SLAVE TCB ENTRY. CPB P8 MODE =8? JMP ADENT GO TO CREATE A PROCESS # ENTRY. CPB P10 MODE =10? (LAST CHANCE!) JMP FIND SEARCH FOR/CLEAR A PROCESS # ENTRY. * JMP ERR02 * ERROR #2: INVALID MODE! * * SPC 10 * ADD A NEW ENTRY TO THE MASTER OR SLAVE-STREAM LIST. SPC 1 ADENT LDA #NULL GET THE NULL LIST LINK-WORD. SZA,RSS IS AN ENTRY AVAILABLE FROM THE POOL? JMP ERR03 * NO. ERROR #3: NO ENTRY AVAILABLE! STA ENTAD YES. SAVE ADDRESS OF NEW ENTRY. * INA POINT TO THE SECOND WORD OF THE ENTRY. STA ENPNT SAVE THE POINTER FOR ENTRY BUILDING. CLE,SLB IF THIS IS TO BE A SLAVE ENTRY, JMP SLVAD THEN SKIP THE SEARCH FOR MASTER ENTRIES. * LDA MDEF INITIALIZE THE LIST CPB P8 POINTER TO REFERENCE LDA PDEF THE PNL OR THE STA LSTAD MASTER LIST. * ISZ KEYAD SEARCH KEYWORD IS PRAM2 (ID SEG ADDR). LDA P4 EXAMINE FIFTH WORD OF EACH MASTER TCB. MLOOK JSB SERCH FIND ENTRIES WITH SAME CLASS OR PROCESS #. JMP MSTAD END-OF-LIST: GO TO ADD NEW ENTRY. ADB P4 GET THE 5TH WORD (ID SEGMENT ADDRESS) LDA B,I FROM ENTRY WITH SAME NUMBER. IOR SIGN ADD BAD-ENTRY FLAG (BIT#15). STA B,I RETURN MODIFIED WORD.(UPLIN CLEARS TCB). JMP MLOOK SEARCH FOR MORE OBSOLETE ENTRIES.[E=1]. * MSTAD CCB CHECK FOR LDA MODE NEW PROCESS CPA P8 NUMBER MODE. JMP SETIM+1 YES--GO SET TIMEOUT * DLD #NCNT # OF NRV ENTRY PAIRS & NRV ADDRESS CAX COUNT WITH X REG MST1 LDA B,I GET NODE # FROM TABLE INB CPA PRAM3 MATCH? JMP MST2 YES! INB ISX INCREMENT NRV COUNT JMP MST1 TRY MORE MST2 LDA B,I GET TIMEOUT / LU LDB B100 ASR 6 A=TIMEOUT, B=1 (MASTER LIST CODE) SZA,RSS DEFAULT REQUESTED? LDA #MSTO YES, GET IT JMP SETIM * SLVAD JSB LSTCK PREPARE REFERENCES FOR THE SLAVE LIST. ADA P2 POINT TO WORD #3 OF SLAVE-STREAM HEAD. LDA A,I GET THE MONITOR I.D. SEGMENT ADDRESS. SZA,RSS IF THE MONITOR HAS NOT BEEN INITIALIZED, JMP ERR01 THEN NOTHING MAY BE ADDED TO THIS LIST! LDA #SVTO VALID LIST: GET SLAVE TIMEOUT VALUE. * SETIM STA ENPNT,I SET TIMEOUT INTO ENTRY WORD #2 ISZ ENPNT POINT TO NEXT WORD OF ENTRY CLA OBTAIN AN ENTRY FROM THE NULL LIST. JSB LNK GO PROCESS LIST CHANGES.[B=LIST CODE] SZA LIST-PROCESSING ERROR? JMP ERR04 YES--INFORM THE CALLER! * LDA PRAM3 USE THIRD PARAMETER LDB MODE INSTREAD OF SEQUENCE CPB P8 NUMBER FOR MODE 8. JMP STOR3 STORE IN THIRD TCB WORD. * SKP SPC 3 LDA SEQN GET THE LAST SEQUENCE NUMBER. INA,SZA,RSS ADVANCE THE CO#UNT & TEST FOR ZERO. CLE,INA ROLL-OVER: RESET TO ONE. STA SEQN SAVE THE CURRENT SEQUENCE NUMBER. STOR3 STA ENPNT,I INSERT IT INTO THE THIRD ENTRY WORD. ISZ ENPNT ADVANCE THE ENTRY POINTER. LDA MODE IF A SLAVE-ENTRY IS TO BE CLE,ERA ADDED, SET =1. PRAMA EQU *+1 [INITIAL KEYWORD POINTER TO 'PRAM1'] DLD PRAM1 GET THE CALLER'S PARAMETERS. SEZ SLAVE-LIST ADDITION? LDB PRAM3 YES, GET THE ORIGIN NODAL ADDRESS. DST ENPNT,I ADD PARAMETERS TO ENTRY WORDS #4,#5. * LDA SEQN RETURN WITH: =CURRENT SEQUENCE NO. LDB ENTAD =ENTRY ADDRESS. JMP EXIT GO TO PREPARE FOR RETURN TO CALLER. * SEQN NOP TRANSACTION SEQUENCE NUMBER. * SPC 3 * ERROR PROCESSING AND EXIT SECTION. SPC 1 ERR04 LDA P4 =4: ENTRY CANNOT BE LOCATED. JMP ERR01+1 ERR03 LDA P3 =3: NEW ENTRY NOT AVAILABLE. JMP ERR01+1 ERR02 LDA P2 =2: INVALID MODE PARAMETER. JMP ERR01+1 ERR01 CLA,INA =1: INVALID LIST PARAMETER. CMA,INA NEGATE THE ERROR CODE. STA B ARE THE SAME FOR ERROR RETURN. * EXIT DST TEMP SAVE TEMPORARILY. CLA CLEAR PARAMETER ADDRESSES STA MODE TO FACILITATE CHECKING STA PRAM1 FOR MISSING PARAMETERS STA PRAM2 UPON NEXT ENTRY OF <#RSAX>. STA PRAM3 LDA #NULL IF NO TCB ENTRIES REMAIN AVAILABLE SZA,RSS IN THE ENTRY POOL, THEN DO NOT JMP RETRN CLEAR THE TABLE-ACCESS RN; ELSE, LDA #TBRN GET THE TABLE-ACCESS RN AND GO TO RTE JSB $CGRN TO MAKE IT AVAILABLE FOR NEXT ACCESS. RETRN DLD TEMP RESTORE THE RETURN-DATA TO & . * DMS2 JMP LBEX BYPASS MAP CODE: RTE-II / 'NOP': RTE-III JRS DMSTS LBEX *** RESTORE THE APPROPRIATE MAPS *** * LBEX JSB $LIBX RETURN TO THE ,CALLER, VIA THE RTE DEF #RSAX PRIVILEGED ROUTINE PROCESSOR. * SKP * SEARCH FOR ENTRIES. CLEAR AND RETURN TO POOL, IF REQUESTED. SPC 1 FIND LDA MDEF INITIALIZE CPB P10 POINTERS LDA PDEF TO REFER STA LSTAD TO THE CLA,INA MASTER LIST CPB P10 OR THE CCA PROCESS NUMBER STA LSTCD LIST. * CLE,SLB IF THIS IS A SLAVE REQUEST, THEN JSB LSTCK ESTABLISH REFERENCES TO THE SLAVE LIST. * LDA P2 THIRD WORD OF TCB IS THE SEARCH KEY. JSB SERCH GO TO LOCATE THE TCB ENTRY [E=0]. JMP ERR04 * ERROR #4: ENTRY CANNOT BE LOCATED! * * STB ENTAD SAVE THE ENTRY ADDRESS FOR LATER USE. ADB P3 POINT TO THIRD WORD, FOR LATER USE, STB ENPNT IN RETURNING THE CONTENTS TO CALLER. * LDA MODE GET THE MODE OF OPERATION. ADA M6 IF THE MODE CLE,SSA IS LESS THAN 6, JMP FOUND DO NOT CLEAR THE ENTRY. * LDA LSTCD REMOVE ENTRY FROM THE SPECIFIED LIST. CLB RETURN IT TO THE NULL LIST. JSB LNK GO TO PROCESS THE LIST CHANGES. CCE,SZA LIST PROCESSING ERROR? JMP ERR04 YES! GO TO INFORM THE CALLER. * FOUND LDA ENPNT,I GET WORD #4 FOR RETURN TO CALLER. CLB,SEZ,RSS IF THIS IS A SEARCH, ONLY, LDB ENTAD THEN GET THE TCB ADDRESS; JMP EXIT ELSE, RETURN WITH =0. * ENPNT NOP POINTER INTO TCB ENTRY. ENTAD NOP TCB ADDRESS STORAGE. * SKP * SYSTEM AVAILABLE MEMORY ALLOCATION/DE-ALLOCATION PROCESSOR. SPC 1 SAM LDA PRAM1 GET THE CALLER'S PARAMETER. SLB IF THE REQUEST IS FOR DE-ALLOCATION, JMP RTSAM GO TO RETURN THE MEMORY TO THE SYSTEM. * STA SZMEM ALLOCATE: SAVE NO. OF WORDS REQUESTED. LDA #FWAM IF SYSTEM-AVAILABLE-MEMORY w, SZA HAS ALREADY BEEN ALLOCATED, JMP ERR01 THEN REJECT THE REQUEST! * JSB $ALC REQUEST SYSTEM AVAILABLE MEMORY (S.A.M.) SZMEM DEC 128 IN THE AMOUNT SPECIFIED BY THE CALLER. JMP DMS2 * NEVER AVAILABLE: =-1,=MAX EVER JMP DMS2 * NOT AVAILABLE NOW: =0,=MAX NOW STA #FWAM O.K. SAVE THE ADDRESS OF MEMORY BLOCK. STB #SAVM SAVE THE SIZE OF THE MEMORY BLOCK. JMP DMS2 RETURN WITH S.A.M. SPECIFICATIONS. * RTSAM CPA #FWAM IS CALLER SPECIFYING CORRECT BLOCK? RSS YES. PROCESS THE DE-ALLOCATION. JMP ERR01 NO. ** IGNORE THE REQUEST! ** * LDB #SAVM GET THE BLOCK-SIZE SPECIFICATION. DST RTN CONFIGURE THE DE-ALLOCATION REQUEST. * JSB $RTN RETURN A SYSTEM-AVAILABLE-MEMORY BLOCK; RTN NOP BEGINNING AT SPECIFIED ADDRESS, AND NOP CONTAINING SPECIFIED NO. OF WORDS. CLA CLEAR THE STORAGE LOCATIONS FOR: STA #FWAM MEMORY BLOCK ADDRESS. STA #SAVM MEMORY BLOCK SIZE. JMP DMS2 RETURN TO THE CALLER. * SKP * SUBROUTINE TO CHECK LIST PARAMETER & SET LIST CODE & LIST ADDRESS. SPC 1 * ENTER: = DON'T CARE. * RETURN: =LIST ADDRESS; =LIST CODE. * ERROR - RETURN VIA ERROR EXIT WITH ERROR #1. * LSTCK NOP ENTRY/EXIT: LIST ID ROUTINE. LDA PRAM2 GET THE STREAM PARAMETER. AND B77 ISOLATE THE STREAM NUMBER. ADA P2 ADD OFFSET FOR NULL & MASTER LISTS. STA LSTCD SAVE FOR USE ELSEWHERE. STA B SAVE FOR RETURN TO CALLER. ADA NMAX CHECK FOR SPECIFICATION CLE,SSA,RSS OF AN UN-DEFINED LIST. JMP ERR01 * ERROR #1: INVALID LIST! LDA #LDEF GET THE LIST-TABLE ADDRESS. ADA B INDEX TO THE PROPER ENTRY. LDA A,I GET THE LIST ADDRESS. STA LSTAD SAVE THE ADDRESS FOR LATER USE. JMP LSTCK,I RETURN TO THE CALLER. * B77 OCT 77 LSTAD NOP ADDRESS OF LIST HEADER. LSTCD NOP LIST IDENTIFICATION CODE. * SKP * SUBROUTINE TO SEARCH FOR A SPECIFIC LIST ENTRY. SPC 1 * ENTER: = OFFSET INTO TCB ENTRY; = DON'T CARE. * =0: SEARCH FROM TOP; =1: CONTINUE SEARCH. * 'LSTAD' SET TO ADDRESS OF LIST TO BE SEARCHED. * * RETURN: P+1 -- ENTRY NOT LOCATED; MEANINGLESS, =0. * P+2 -- ENTRY WAS LOCATED; MEANINGLESS, = ENTRY ADDRESS. * SERCH NOP ENTRY/EXIT:LIST SEARCH ROUTINE. LDB TEMP+1 GET NEXT-ENTRY ADDRESS TO CONTINUE. SEZ IS THIS A REQUEST TO CONTINUE? JMP SLOOP YES. GO TO CONTINUE THE SEARCH. STA OFSET SAVE OFFSET INTO TCB ENTRY. LDB LSTAD GET TOP-OF-LIST ADDRESS. * SLOOP LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB,RSS IS THIS THE END OF THE LIST? JMP SERCH,I YES. TAKE "NOT FOUND" EXIT (P+1). * STB TEMP+1 SAVE POINTER TO NEXT ENTRY. ADB OFSET POINT TO KEYWORD LOCATION. LDA B,I GET THE KEYWORD. LDB TEMP+1 PREPARE TO RETURN WITH ENTRY ADDRESS. CPA KEYAD,I DOES IT MATCH THE CALLER'S KEYWORD? CCE,RSS YES. SET FOR CONTINUATION--SKIP. JMP SLOOP NO. CONTINUE SEARCHING. * ISZ SERCH ENTRY FOUND: SET RETURN TO P+2. JMP SERCH,I RETURN TO THE CALLER. * OFSET NOP KEYWORD OFFSET INTO TCB ENTRY. KEYAD NOP KEYWORD POINTER * SKP * SUBROUTINE TO PROCESS LIST LINKAGE. SPC 1 * ENTER: = CODE OF REMOVAL LIST; = CODE OF ADDITION LIST. * 'ENTAD' SET TO ADDRESS OF ENTRY TO BE REMOVED. * * RETURN: & =0: NORMAL; =-1, =UNCHANGED: ERROR. * LNK NOP ENTRY/EXIT: LIST LINK ROUTINE. STA TEMP SAVE REMOVAL-LIST CODE, TEMPORARILY. ADA #LDEF FIND THE TABLEG ADDRESS. LDA A,I GET ADDRESS: TOP-OF-REMOVAL-LIST. LNK1 STA PNTR SAVE LIST POINTER. LDA A,I GET THE LINK TO THE NEXT ENTRY. SZA,RSS IF THIS IS THE END OF THE LIST, JMP LNKER THEN INFORM THE CALLER OF THE ERROR. CPA ENTAD IS THIS THE ENTRY TO BE REMOVED? RSS YES. SKIP TO REMOVE IT. JMP LNK1 NO. TRY THE NEXT ONE. LDA ENTAD,I GET THE LINK TO THE FOLLOWING ENTRY, STA PNTR,I AND MOVE IT TO THE PREVIOUS ENTRY. * ADB #LDEF FIND THE TABLE ADDRESS. LDB B,I GET ADDRESS: TOP-OF-ADDITION-LIST. LNK2 STB PNTR SAVE LIST POINTER. LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB IS THIS THE END OF THE LIST? JMP LNK2 NO. CONTINUE SEARCHING FOR THE END. STB ENTAD,I YES. MAKE NEW ENTRY = END-OF-LIST. LDA ENTAD GET THE ADDRESS OF THE NEW ENTRY. STA PNTR,I SAVE IN LINK-WORD OF PREVIOUS ENTRY. * LDA MODE IF MODE IS ADA M8 >= 8 THEN SSA,RSS PROCESSING JMP LNKER-1 IS ALL DONE. * CPB TEMP REMOVING ENTRY FROM NULL LIST? [=0] CLA,INA,RSS YES. PREPARE TO ADD TO ACTIVE COUNT. CCA NO. PREPARE TO DECREMENT ACTIVE COUNT. ADA #BUSY COMPUTE THE NEW 'ACTIVE-ENTRY' COUNT, STA #BUSY AND UPDATE THE INDICATOR. CLA,RSS INDICATE NORMAL RETURN, AND SKIP. LNKER CCA =-1: NO ENTRIES IN REMOVAL LIST. JMP LNK,I RETURN IS MADE TO THE CALLER. * PNTR NOP LIST POINTER STORAGE. * SKP * TABLE OF LIST-HEADER ADDRESSES. LIST CODES: SPC 1 #LDEF DEF SOT START-OF-TABLE DEFINITION. PDEF DEF #PNLH HP3000 PROCESS NUMBER HEADER -01 SOT DEF #NULL ENTRY-POOL HEADER 00 MDEF DEF #MRTH MASTER-REQUEST HEADER 01 SDEF DEF #ST00 SLAVE-STREAM 00 HEADER 02  DEF #ST01 SLAVE-STREAM 01 HEADER 03 DEF #ST02 SLAVE-STREAM 02 HEADER 04 DEF #ST03 SLAVE-STREAM 03 HEADER 05 DEF #ST04 SLAVE-STREAM 04 HEADER 06 DEF #ST05 SLAVE-STREAM 05 HEADER 07 DEF #ST06 SLAVE-STREAM 06 HEADER 10 DEF #ST07 SLAVE-STREAM 07 HEADER 11 DEF #ST08 SLAVE-STREAM 08 HEADER 12 DEF #ST09 SLAVE-STREAM 09 HEADER 13 DEF #ST10 SLAVE-STREAM 10 HEADER 14 * NEW ENTRY: .........DEF #STXX.....SLAVE-STREAM XX HEADER........15 * NMAX ABS #LDEF+1-* LIST CODE VALIDITY-CHECKING CONSTANT. * #MNUM ABS NMAX-SDEF NUMBER OF SLAVE-STREAM TYPES. SPC 1 * CONSTANTS AND STORAGE. SPC 1 M6 DEC -6 M8 DEC -8 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P10 DEC 10 B100 OCT 100 SIGN OCT 100000 TEMP OCT 0,0 TEMPORARY STORAGE LOCATIONS. SPC 1 * HP3000 ID SEQUENCE SPECIFICATIONS * D$LID DEF LOC LOCAL ID SEQUENCE ADDRESS D$RID DEF REM REMOTE ID SEQUENCE ADDRESS SPC 1 #RDLY DEC -200 MAXIMUM RTRY DELAY: 200 CENTOSECONDS (2 SEC.) #PRLU DEF #PRLX DEFAULT LU FOR PROGL MESSAGES: NO MESSAGES * (NOTE: #PRLX IS IN #REQU. IT MUST BE SEPARATED * IN ORDER TO ALLOW 'ABS' AT GEN-TIME TO WORK, AS WELL * AS ON-LINE PATCHES TO #PRLU) * * GENERAL SYSTEM DATA [ INITIALIZED BY 'LSTEN' ]. SPC 1 #SCLR DEF #TBRN START OF AREA CLEARED BY 'LSTEN'. #FWAM NOP ADDRESS OF SYSTEM AVAIL. MEMORY BLOCK. #SAVM NOP SIZE OF SYSTEM AVAIL. MEMORY BLOCK. #TBRN NOP TABLE-ACCESS RESOURCE NUMBER. #QRN NOP QUIESCENT(RN) OR SHUT-DOWN(0). #GRPM NOP GENERAL PRE-PROCESS MODULE CLASS NO. #QCLM NOP QUEUE CLEAN-UP MONITOR CLASS NUMBER. #BUSY NOP NUMBER OF ACTIVE TCB ENTRIES. #MSTO NOP R MASTER REQUEST TIMEOUT VALUE. #SVTO NOP SLAVE REQUEST TIMEOUT VALUE. #RTRY NOP RETRY-PROCESSOR'S CLASS NUMBER. #WAIT NOP D65MS QUIESCENT WAIT INTERVAL. #SWRD NOP NETWORK-NODE SECURITY CODE. #BREJ NOP D65MS RETRY COUNT FOR BUSY REJECT. #RPCV NOP HP3000 REPLY CONVERTER CLASS NO. #RQCV NOP HP3000 REQUEST CONVERTER CLASS NO. #LU3K NOP LU NUMBER OF HP3000 #QZRN NOP QUEZ RN FOR "LISTEN MODE" #QXCL NOP QUEX CLASS NO. #TST NOP HP3000 TRANS. STATUS TABLE ADDRESS NOP HP3000 TRANS. STATUS TABLE SIZE,IN ENTRIES * SKP SKP * LIST HEADERS (REMAINDER OF LISTS LOCATED IN SYSTEM AVAILABLE MEMORY). SPC 3 #PNLH NOP HP3000 PROCESS # LIST SPC 1 #NULL NOP LIST HEADER: ENTRY POOL. SPC 1 #MRTH NOP MASTER REQUEST LIST. SPC 1 #ST00 OCT 0,0,0 SLAVE-STREAM 00 LIST. SPC 1 #ST01 OCT 0,0,0 SLAVE-STREAM 01 LIST. SPC 1 #ST02 OCT 0,0,0 SLAVE-STREAM 02 LIST. SPC 1 #ST03 OCT 0,0,0 SLAVE-STREAM 03 LIST. SPC 1 #ST04 OCT 0,0,0 SLAVE-STREAM 04 LIST. SPC 1 #ST05 OCT 0,0,0 SLAVE-STREAM 05 LIST. SPC 1 #ST06 OCT 0,0,0 SLAVE-STREAM 06 LIST. SPC 1 #ST07 OCT 0,0,0 SLAVE-STREAM 07 LIST. SPC 1 #ST08 OCT 0,0,0 SLAVE-STREAM 08 LIST. SPC 1 #ST09 OCT 0,0,0 SLAVE-STREAM 09 LIST. SPC 1 #ST10 OCT 0,0,0 SLAVE-STREAM 10 LIST. SPC 1 * NEW ENTRY: ...#STXX OCT 0,0,0..................SLAVE-STREAM XX LIST. SKP #RFSZ NOP MAXIMUM NUMBER OF 'OPEN' RFA FILES. SPC 3 #PLOG BSS 7 1000 LOGGING PROGRAM'S CLASS NO. #CL3K BSS 7 3000 LOGGING PROGRAM'S CLASS NO. SPC 3 * NODAL ADDRESSING `^ZSPECIFICATIONS. * #CNOD NOP CURRENT-USER-NODE; -1: INACTIVE. * #LNOD NOP DOWN-LOAD NODE (RTE-M, ONLY). * #NODE NOP LOCAL NODE NUMBER. * #NCNT NOP NEG. NUMBER OF NRV TABLE ENTRIES (PAIRS) #NRV NOP S.A.M. ADDRESS OF NRV TABLE. #TRCL NOP 'TRACE' CLASS NUMBER #TRCN NOP 'TRACE' RESOURCE NUMBER SPC 2 #NCLR ABS #TBRN-* NEGATIVE NO: LOCATIONS LSTEN CLEARS SPC 3 * HP3000 ID SEQUENCE SPECIFICATIONS * LOC NOP LOCAL ID SEQUENCE: BYTE COUNT BSS 8 CHARACTERS * REM NOP REMOTE ID SEQUENCE: RESERVED WORD NOP BYTE COUNT BSS 8 CHARACTERS SKP * INITIALIZATION SECTION: DMS SETUP & VALIDITY CHECKING. * * NOTE: THIS CODE IS USED ONLY UPON INITIAL ENTRY. * IT IS OVERLAYED BY THE SYSTEM SPECIFICATIONS. * ORG #GRPM CODE RESIDES IN SYSTEM DATA AREA. * CONFG NOP ENTRY/EXIT: INITIALIZATION ROUTINE. LDA $OPSY GET THE OP-SYSTEM IDENTIFIER. AND P2 ISOLATE THE DMS BIT(#1). RAR,CLE,ERA =0 AND = DMS BIT. SEZ,CLE,RSS IF DMS SYSTEM, SKIP & ENABLE DMS CODE; JMP NODMS ELSE, MERELY DISABLE CONFIGURATION CALL. * STA DMS1 CLEAR THE BYPASS-SWITCHES STA DMS2 TO ENABLE DMS PROCESSING. * NODMS STA INIT CLEAR ACCESS TO THE CONFIGURATOR. JMP CONFG,I RETURN TO NORMAL PROCESSING. * A EQU 0 B EQU 1 SPC 1 ORR [ INDICATES SIZE OF ] SPC 1 END N` % 91740-18032 1840 S C0122 &DMESG              H0101 wASMB,R,L,C HED DMESG 91740-16032 REV 1840 * (C) HEWLETT PACKARD CO. 1978 NAM DMESG,7 91740-16032 REV 1840 780628 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ****************************************************** * *DMESG TELLOP MESSAGE SUBROUTINE * *SOURCE PART # 91740-18032 * *REL PART # 91740-16032 * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 7-30-74 * *MODIFIED BY: JEAN-PIERRE BAUDOUIN * *DATE MODIFIED: MAY 1976 * ********************************************************* * * MODIFIED BY DMT ON 6/28/78 TO CHANGE ERROR RETURN * ********************************************************* SPC 1 * * LIBRARY SUBROUTINE APPENDED TO RTE USER PROGRAM THAT SENDS * MESSAGES TO THE SYSTEM CONSOLE AT THE GIVEN DESTINATION NODE. * * CALLING SEQUENCE: * JSB DMESG * DEF *+4 * DEF DESTINATION * DEF BUFFER * DEF BUFFER LENGTH * RETURN--A&B CONTAIN ASCII ERROR CODE IF ANY; * OTHERWISE A & B ARE BOTH ZERO. * SPC 3 ENT DMESG * EXT DEXEC,.ENTR,#NODE,$LIBR,$LIBX,$CVT3 * SUP * * GET MESSAGE ADDRESS AND LENGTH. * DEST NOP BUFAD NOP BUFL NOP DMESG NOP JSB .ENTR GET PRAM ADDRESS DEF DEST CLA LDB BUFL,I GET LENGTH SSB POSITIVE WORD COUNT? JMP *+4 NO, TREAT AS BYTE COUNT BLS CONVERT LNGT IN WORDS TO CMB,INB,SZB,RSS LNGT IN (-) BYTES    JMP LENER ERROR IF ZERO OR NOT PASSED STA BUFL INITIALIZE FOR NEXT TIME STB 0 ADA N10 ADJUST ACTUAL BUFFER LENGTH STA LNGT SAVE FOR THE "DEXEC" CALL ADA K82 NOW MAKE SURE ORIGINAL LNGT SSA WASN'T > 72 CHARACTERS JMP LENER IT WAS! ERROR CMB,INB INB CONVERT TO WORD COUNT BRS FOR THE "MVW" STB MVLEN * * MOVE MESSAGE TO INTERNAL BUFFER. * LDA BUFAD GET ORIGIN ADDRESS LDB DFOUT GET DESTINATION ADDRESS MVW MVLEN MOVE THE BUFFER * CCE SET FOR DECIMAL CONVERSION LDA #NODE GET LOCAL NODE # JSB $LIBR FENCE OFF NOP JSB $CVT3 CONVERT TO ASCII LDB NUMA GT BUFFER ADDRESS MVW B3 MOVE 6 CHARACTERS JSB $LIBX DEF *+1 DEF *+1 FENCE BACK ON * SEND THE MESSAGE WITH ID PREFIX. * JSB DEXEC DEF *+6 DEF DEST,I DEF D2I WRITE-NO ABORT DEF B1 DEF OUTBF DEF LNGT * JMP DMESG,I RETURN TO CALLER WITH ERROR IN A & B. CLA NO ERROR--CLEAR CLB REGISTERS. JMP DMESG,I RETURN SPC 2 LENER DLD DS03 RETURN WITH ASCII ERROR JMP DMESG,I CODE IN A & B REG. * * * CONSTANTS AND WORKING STORAGE. * MVLEN NOP LNGT NOP B1 OCT 1 D2I OCT 100002 B3 OCT 3 K82 DEC 82 N10 DEC -10 DS03 ASC 2,DS03 DFOUT DEF OUTBF+5 NUMA DEF OUTBF+1 OUTBF ASC 5,=N000000: BSS 37 * SIZE EQU * * END   91740-18033 1740 S C0122 DS/1000 MODULE: DMESS              H0101 CASMB,L,R,C HED DMESS 91740-16033 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 NAM DMESS,7 91740-16033 REV 1740 771003 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT DMESS EXT MESSS,#NODE EXT D65MS,.ENTR * * * DMESS * SOURCE: 91740-18033 * BINARY: 91740-16033 * PRGMR: BOB SHATZER * DATE: 09 DEC 75 * * MODIFIED BY: C.C.H. 02-16-76 * MODIFIED BY: J.P.B. JUNE 1976 * MODIFIED BY: C.H.W. FEB. 1977 * * DMESS IS A UTILITY SUBROUTINE WHICH IS USED TO SEND OPERATOR * COMMANDS TO A REMOTE CPU. * * CALLING SEQUENCE: * * JSB DMESS * DEF *+4 * DEF * DEF * DEF (IN + BYTES) * * * ON RETURN, THE REGISTERS HAVE THE FOLLOWING MEANING: * * = 0 NO RESPONSE FROM REMOTE * < 0 NEGATIVE OF NUMBER OF BYTES IN RESPONSE * = -1 INDICATES AN ERROR * * NODE NOP DESTINATION BUFAA NOP MESSAGE BUFFER BUFLA NOP MESSAGE LENGTH DMESS NOP START OF ROUTINE JSB .ENTR DEF NODE GET PRAMS * LDA D7 REMOTE - GET STREAM TYPE STA PARMB AND PUT IT INTO PARMB LDA BUFLA,I GET REQUEST LENGTH STA LNGH SAVE IN PARMB ADA DM41 SSA,RSS CHECK FOR ILLEGAL MESSAGE LENGTH JMP SZERR TOO LONG LDA LNGH SSA NEGATIVE ? JMP SZERR YES, ILLEGAL CLB NO ERROR INDICATION FOR IMMEDIATE RETURN SZA,RSS NOTHING ? JMP DMESS,I IMMEZDIATE RETURN CLE,ERA TRANSFORM INTO NUMBER SEZ OF WORDS INA TO COMPUTE REQUEST LENGTH STA LNG1 SAVE FOR REQUEST MOVE ADA D5 ADD STANDARD PARMB LENGTH CPA D6 LESS THAN MIN ? INA YES STA LEN LDA BUFAA GET BUFFER ADDRESS LDB MESSA GET DESTINATION ADDRESS MVW LNG1 MOVE REQUEST INTO PARMB * LDA NODE,I GET DESTINATION STA PARMB+3 SET IN PARMB * CPA DM1 LOCAL ? JMP LOCAL YUP CPA #NODE FOR US ? JMP LOCAL YES * JSB D65MS WRITE REQUEST TO REMOTE DEF *+8 DEF CONWD CONTROL WORD DEF PARMB DEF LEN DEF D0 DEF D0 NO DATA ASSOCIATED DEF D0 NO DATA ASSOCIATED DEF D27 MAX REPLY LENGTH * JMP MSERR ERROR RETURN POINT CLB NO ERROR INDICATION LDA PARMB+7 ANY RETURN MESSAGE? SZA,RSS JMP DMESS,I NO RETURN MESSAGE LDA MESSB GET ADDRESS OF MESSAGE TO BE RETURNED LDB BUFAA GET ADDRESS OF USER'S BUFFER. MVW PARMB+7 MOVE THE REPLY TO THE USER'S BUFFER LDA PARMB+7 GET LENGTH OF MESSAGE CLE,ELA MAKE THAT # OF BYTES CMA,INA NEGATE JMP DMESS,I AND RETURN SPC 3 LOCAL JSB MESSS DEF *+3 DEF BUFAA,I MESSAGE DEF BUFLA,I LENGTH * JMP DMESS,I RETURN SPC 2 * MSERR DST BUFAA,I SAVE ERROR CODES FOR USER'S ANALYSIS. LDA D4 RETURN WITH = -4, AND = -1, CMA,INA,RSS TO INDICATE 4-BYTE ERROR-CODE MESSAGE. * SZERR CLA BUFFER SIZE ERROR - CLEAR A CCB AND SET B TO -1 JMP DMESS,I AND RETURN SPC 2 * B EQU 1 MESSA DEF PARMB+5 MESSB DEF PARMB+8 DM41 DEC -41 D0 DEC 0 D7 DEC 7 D4 DEC 4 D5 DEC 5 D6 DEC 6 D27 DEC 27 PARMB L BSS 27 LNGH EQU PARMB+4 LNG1 NOP LEN NOP CONWD OCT 100000 DM1 DEC -1 * END   91740-18034 2001 S C0122 &FCOPY              H0101 xASMB,C,Q HED FCOPY: 91740-16034 REV 2001 (C) HEWLETT-PACKARD CO. 1980 NAM FCOPY,7 91740-16034 REV 2001 791024 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * NAME: FCOPY * SOURCE: 91740-18034 * RELOC: 91740-16034 * PGMR: DAN GIBBONS * * * MODIFIED BY: D.GIBBONS: ADD OPT. DEST SECU. CODE PARAM (10/79) * * *************************************************************** SPC 3 * FCOPY IS THE GENERAL FILE TRANSFER UTILITY. * IT WILL TRANSFER ANY FILE WITH RECORD LENGTHS <= 128 WORDS * FROM ANY DISK IN THE NETWORK TO ANY OTHER DISK IN THE NETWORK. * * THE CALLING SEQUENCE IS : * JSB FCOPY * DEF *+6 TO *+12 * DEF ORIGIN FILE NAME * DEF ORIGIN CRN VECTOR * DEF DESTINATION FILE NAME * DEF DESTINATION CRN VECTOR * DEF IERR * DEF ORIGIN FILE SECU (OPTIONAL) * DEF DEST FILE TYPE (OPTIONAL) * DEF DEST FILE SIZE (OPTIONAL) * DEF DEST FILE REC-SIZE (OPTIONAL) * DEF TRANSFER MODE (OPTIONAL) * DEF DEST FILE SECU (OPTIONAL) * * IN CASE OF DUPLICATE DESTINATION FILE NAME, * THE FIRST 2 CHARACTERS OF THE NAME WILL BE CHANGED * TO "..". IF THIS NAME IS ALSO EXISTING THERE WILL BE * AN ERROR RETURN. * * NEGATIVE VALUES FOR DESTINATION FILE SIZE PARAMETER * ARE NOT ALLOWED SINCE A LINE FAILURE BEFORE * TRUNCATION AT 'DCLOS' TIME WOULD RESULT IN GOBBLING * ALL THE REMAINING SPACE ON THE REMOTE DISC. A -6 * ERROR CODE (NO ROOM) IS RETURNED IF THIS IS ATTEMPTED. * * IF TRANSFER MODE PARAMETER IS GIVEN AND IS NON- * ZERO, THE DESTINATION FILE WILL BE CREATED AS USUAL * BUT BOTH FILES WILL BE OPENED AS TYPE 1'S. THIS WILL * NORMALLY RESULT IN INCREASED LINE EFFICIENCY SINCE * VARIABLE RECORD LENGTH FILES WILL THEN BE TRANSFERRED * IN 128 WORD DATA BLOCKS RATHER THAN RECORD BY RECORD. * !!!CAUTION!!! * THIS METHOD SHOULD BE USED ONLY IF THE SOURCE FILE * HAS NO EXTENTS. EXTENTS ARE NOT COPIED TO * THE DESTINATION FILE WHEN FILES ARE OPENED AS TYPE 1 * FILES. FAILURE TO OBSERVE THIS WARNING WILL NOT CAUSE * A RETURNED ERROR CODE, BUT WILL NEVERTHELESS RESULT * IN A CORRUPT DESTINATION FILE. * * * ERROR CODES : * IERR > 0 :WARNING * IERR = 0 :NO ERROR * -100 < IERR >0 : DESTINATION ERROR * IERR < -100 : ORIGIN ERROR * * WARNINGS : * IERR = 1 DUPLICATE FILE NAME, CORRECTED * SPC 3 ENT FCOPY EXT .ENTR EXT DCRET,DOPEN,DREAD,DWRIT,DCLOS EXT DPURG EXT DLOCF EXT IFBRK IFZ EXT DBUG XIF SPC 3 SUP * SRCFL NOP SOURCE FILE NAME SRCCR NOP SOURCE CRN VECTOR DSTFL NOP DESTINATION FILE NAME DSTCR NOP DESTINATION CRN VECTOR IERR NOP ERROR PARAMETER ISEC1 NOP ORIGIN FILE SECU ITYP2 NOP DEST FILE TYPE ISIZ2 NOP DEST FILE SIZE IREC2 NOP DEST FILE REC-SIZE IMODE NOP TRANSFER MODE ISEC2 NOP DESTINATION FILE SECU SPC 2 FCOPY NOP ENTRY POINT JSB .ENTR DEF SRCFL * IFZ JSB DBUG CALL DBUG IF ASKED FOR DEF *+1 XIF SPC 2 CLA STA IERR,I CLEAR THE ERROR CODE LDA DSTFL,I TRANSFER THE DESTINATION STA DSTFN FILE NAME  ISZ DSTFL (WE DONT WANT TO CHANGE DLD DSTFL,I THE USER'S CODE EVEN IF WE DST DSTFN+1 HAVE TO CHANGE THE DEST FILE NAME) LDA ISEC1 SET ISEC1 TO SZA VALUE IF GIVEN, LDA A,I ELSE TO STA ISEC1 ZERO. * LDB D1 GET OPEN OPTION JSB OPENO OPEN ORIGIN FILE * LOOK JSB DLOCF USE THIS TO FIND THE TYPE, DEF *+10 SIZE & RECORD SIZE OF THE FILE DEF ODCB TO BE TRANSFERED DEF YERR DEF NOP DEF NOP DEF NOP DEF ISIZE # OF SECTORS OF THE FILE RETURNED HERE DEF NOP DEF FLTYP FILE TYPE DEF ISIZE+1 RECORD SIZE * LDA ISIZ2 SZA,RSS DEST SIZE GIVEN? JMP FC01 NO LDA A,I YES, GET IT SSA NEGATIVE VALUES JMP M6ERR NOT ALLOWED. ALS CONVERT TO SECTORS SZA IF NOT ZERO, OVERRIDE STA ISIZE ORIG FILE SIZE. * FC01 LDA IREC2 SZA,RSS DEST REC-SIZE GIVEN? JMP FC02 NO LDA A,I YES, GET IT SZA IF NOT ZERO, OVERRIDE STA ISIZE+1 ORIG REC-SIZE. * FC02 LDB FLTYP IF ITYP2 IS NOT CLA GIVEN OR IS ZERO, LDA ITYP2,I DEFAULT TO ORIGIN TYPE. SZA LDB A STB ITYP2 * LDA ISIZE DCRET NEEDS # OF BLOCS, SO WE HAVE CLE,ERA TO DIVIDE ISIZE BY 2 SEZ INCREMENT A IF ISIZE WAS ODD INA STA ISIZE SAVE THE # OF BLOCS * CLA (IN CASE ISEC2 NOT SPECIFIED) LDA ISEC2,I SET ISEC2 TO SPECIFIED VALUE STA ISEC2 OR TO 0. * JSB DCRET CREATE THE DESTINATION FILE DEF *+8 DEF DDCB DESTINATION DCB DEF YERR DEF DSTFN DEST. FLAME DEF ISIZE DEF ITYP2 FILE TYPE DEF ISEC2 DEST SECURITY CODE DEF DSTCR,I DEST. CRN * SSA,RSS HOW WAS IT ? JMP CLOSE OK, GO CLOSE BOTH FILES CPA MD2 DUPLICATE FILE NAME ? JMP RETRY YES, TRY WITH ANOTHER NAME LDB D1 FILE CLOSE OPTION JMP ERROR GET OUT * CLOSE JSB CLOSO CLOSE BOTH ORIG JSB CLOSD AND DEST FILES. * * NOW OPEN BOTH FILES * LDB D1 GET DEFAULT OPEN OPTION CLA PROTECT AGAINST IMODE = 0 LDA IMODE,I SZA IMODE GIVEN AND NON-ZERO? LDB D5 YES, USE TYPE 1 OPEN OPTION STB IMODE SAVE OPEN OPTION JSB OPENO OPEN ORIGIN FILE * LDB IMODE GET OPEN OPTION BACK JSB OPEND OPEN DEST FILE * * IF ORIG IS TYPE 1, OR IF WE HAVE OPENED IT AS A TYPE 1, WE * WANT A 128 WORD BUFFER. OTHERWISE, WE WANT A 129 WORD BUFFER * SO WE CAN CHECK FOR BUFFER OVERFLOW. * LDA D129 LDB FLTYP GET ORIG TYPE CPB D1 TYPE 1? JMP DECR YES LDB IMODE GET OPEN OPTION CPB D5 TYPE 1 OPEN OPTION? DECR ADA MD1 YES, USE 128 WORD BUFR LENGTH STA BUFL SET BUFL FOR DREAD CALL SPC 3 * FILES SET UP, TRANSFER DATA * MOVE JSB DREAD READ FROM ORIGIN DEF *+6 DEF ODCB DEF YERR DEF BUF DATA BUFFER DEF BUFL DATA BUFFER LENGTH DEF LEN * SSA,RSS HOW WAS IT ? JMP WRT OK CPA MD12 NOT TOO GOOD. EOF ? JMP EOF YES LDB D2 THIS MUST BE AN ERROR, CLOSE OPTION ADA MD100 ORIGIN ERROR JMP ERROR GET OFF * EOF LDA MD1 FAKE LEN=-1 WITH NO ERROR STA LEN * WRT LDA LEN CPA D129 BUFFER OVERFLOW? RSS YES, ERROR JMP WRT1 NO, CONTINUE LDA MD104 SET ILLEGAL RECORD SIZE ERROR CODE LDB D2 JMP ERROR REPORT ERROR * WRT1 JSB DWRIT WRITE THE BUFFER INTO THE FILE DEF *+ 5 DEF DDCB DEF YERR DEF BUF DEF LEN BUFFER LENGTH * SZA,RSS HOW WAS IT ? JMP TST OK ERR LDB D2 CLOSE OPTION JMP ERROR * TST JSB IFBRK DOES THE DEF *+1 OPERATOR SSA WANT OUT? JMP BREAK YES LDA LEN DID WE REACH INA THE END SZA OF FILE JMP MOVE NO SPC 3 * * TRANSFER ALL DONE, CLOSE THE FILES AND GO BACK TO CLASS * JSB CLOSD FIRST CLOSE THE DEST FILE JSB CLOSO NOW CLOSE THE ORIG FILE JMP EXIT RETURN TO USER SPC 2 M6ERR CLB INDICATE THAT NO FILES ARE OPEN LDA MD6 GIVE -6 ERROR JMP ERROR SPC 3 * BREAK SET. CLOSE ORIGIN FILE, PURGE DESTINATION. * BREAK LDA MD100 SET "BREAK" ERROR CODE LDB D2 SPC 3 * ERROR PROCESSING * ERROR STB STATS SAVE STATUS STA IERR,I SAVE ERROR VALUE SZB,RSS JMP EXIT NOTHING IS OPEN JSB DCLOS CLOSE ORIGIN DEF *+3 DEF ODCB DEF YERR * * ISZ STATS RSS JMP EXIT ONLY THE ORIGIN WAS OPEN * JSB DPURG DEST. ALSO CREATED, GET RID OF IT DEF *+6 DEF DDCB DEF YERR DEF DSTFN DEST FILE NAME DEF ISEC2 DEST FILE ISECU DEF DSTCR,I DEST CRN * EXIT CLB CLEAR OPTIONAL STB ISEC1 PARAM ADR LOCS STB ITYP2 FOR NEXT CALL STB ISIZ2 AND EXIT. STB IREC2 STB IMODE STB ISEC2 JMP FCOPY,I SPC 3 * WE COME HERE IF THE DESTINATION FILE NAME IS A * DUPLICATE NAME. WE WILL TRY THE CREATION AGAIN * AFTER REPLACING THE FIRST TWO CHARACTERS OF THE * REQUESTED FILE NAME BY "..". IF THIS NAME IS ALSO * DUPLICATE, WE WILL QUIT. * RETRY LDA .. STA DSTFN BUILD THE NEW FILE NAME * JSB DCRET _y DEF *+8 DEF DDCB DEF YERR DEF DSTFN NEW FILE NAME DEF ISIZE DEF ITYP2 FILE TYPE DEF ISEC2 DEST ISECU DEF DSTCR,I DEST ICR * SSA,RSS HOW WAS IT ? JMP TELIT THIS TIME IT'S OK LDA MD2 STILL BAD, GIVE A DUPLICATE DESTINATION LDB MD1 CLOSE OPTION JMP ERROR FILE NAME ERROR RETURN * TELIT LDA D1 WRNG CODE FOR DUPLICATE FILE NAME STA IERR,I SPC 3 * ALL OK GO BACK TO WORK * JMP CLOSE SPC 2 * * OPEN ORIGIN FILE. ENTER WITH B = OPEN OPTION. * NO RETURN IF ERROR. * OPENO NOP STB TEMP SET OPEN OPTION * JSB DOPEN OPEN ORIGIN FILE DEF *+7 DEF ODCB ORIGIN DCB DEF YERR DEF SRCFL,I SOURCE FILE NAME DEF TEMP OPEN OPTION DEF ISEC1 ISECU FOR ORIGIN DEF SRCCR,I SOURCE CRN * SSA,RSS HOW WAS IT ? JMP OPENO,I ALL OK ADA MD100 ORIGIN ERROR CLB FILE CLOSE OPTION JMP ERROR GET OUT SPC 2 * * OPEN DESTINATION FILE. ENTER WITH B = OPEN OPTION. * NO RETURN IF ERROR. * OPEND NOP STB TEMP SET OPEN OPTION * JSB DOPEN OPEN DEST FILE DEF *+7 DEF DDCB DEF YERR DEF DSTFN DEST FILE NAME DEF TEMP OPEN OPTION DEF ISEC2 SECURITY CODE DEF DSTCR,I DEST CRN ARRAY * SSA OK? JMP ERR NO, ERROR JMP OPEND,I YES, RETURN SPC 2 * * CLOSE DESTINATION FILE. NO RETURN IF ERROR. * CLOSD NOP * JSB DCLOS CLOSE THE DESTINATION FILE DEF *+3 DEF DDCB DEF YERR * SSA,RSS HOW WAS IT ? JMP CLOSD,I OK, CONTINUE LDB D2 CLOSE OPTION JMP ERROR SPC 2 * * CLOSE ORIGIN FILE. NO RETURN IF ERROR. * CLOSO NOP * JSB DCLOS NOW CLOSE THE ORIGIN FILE DEF *($*+3 DEF ODCB DEF YERR * SSA,RSS HOW WAS IT ? JMP CLOSO,I OK, RETURN LDB D1 CLOSE OPTION ADA MD100 ORIGIN ERROR JMP ERROR SPC 2 SPC 3 * CONSTANTS AND BUFFERS * A EQU 0 B EQU 1 D1 DEC 1 D2 DEC 2 D5 DEC 5 D129 DEC 129 MD1 DEC -1 MD2 DEC -2 MD6 DEC -6 MD12 DEC -12 MD100 DEC -100 MD104 DEC -104 ISIZE BSS 2 FILE-SIZE/RECORD-SIZE FLTYP NOP NOP NOP LEN NOP STATS NOP ODCB BSS 4 DDCB BSS 4 BUF BSS 129 BUFL NOP .. ASC 1,.. YERR NOP DSTFN REP 3 NOP TEMP NOP SPC 3 END 7M*   91740-18035 1740 S C0122 DS/1000 MODULE: FLOAD              H0101 0ASMB,L,R,C HED FLOAD 91740-16135 REV 1740 * (C) HEWLETT-PACKARD CO. 1977 NAM FLOAD,7 91740-16035 REV 1740 770602 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 1 ********************************************** * *FLOAD SUBROUTINE TO DO FORCED DOWN LOAD OF * ABSOLUTE PROGRAM TO RTE-M SYSTEM. * *SOURCE PART #: 91740-18035 REV 1740 * *REL PART # 91740-16035 REV 1740 * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 8-23-74 * *MODIFIED BY: JEAN-PIERRE D. BAUDOUIN * DAN GIBBONS * *DATE MODIFIED: JULY 1976 * FEBRUARY 1977 * *********************************************** SPC 1 SUP * EXT D65MS,.ENTR,D65AB SPC 1 ENT FLOAD SPC 1 A EQU 0 B EQU 1 SPC 1 * * CALLING SEQUENCE * JSB FLOAD * DEF *+6 TO *+10 * DEF PROGRAM FILE NAME * DEF CRN * DEF FILE NODE # (=>0) * DEF DESTINATION NODE * DEF ERROR CODE * DEF FILE SECURITY CODE (OPTIONAL) * DEF PARTITION # (OPTIONAL) * DEF PARTITION SIZE IN PAGES (OPTIONAL) * DEF 3 WORD ERROR MESSAGE BUFR (OPTIONAL) SKP FNAM NOP CRN NOP FNOD NOP FLU NOP FERCD NOP ISECU NOP PNUM NOP PSIZE NOP FERMG NOP SPC 2 ENTRY POINT FLOAD NOP JSB .ENTR PRMSA DEF FNAM * LDA FERCD ERROR RETURN SPECIFIED? SZA,RSS JMP EXIT NO, GET OUT QUICK * LDA FLU,I GET DESTINATION STA RQBUF+3 * * LDA D3 SET STRE#AM TYPE STA RQBUF LDA D9 SET ICODE FOR STA RQBUF+4 SCHED-WITH-WAIT. * LDA APNAM MOVE "APLDR" NAME LDB PNAMA MVW D3 * LDA FNAM MOVE THE FILE NAME LDB NAMA MVW D3 * LDA CRN,I STA RQBUF+14 * LDA FNOD,I STA RQBUF+15 * CLA (IN CASE ISECU MISSING) LDB ISECU,I SET ISECU OR 0 STB RQBUF+13 INTO REQST BUFR. * * FORMAT 1ST APLDR SCHED PARAM * LDB PNUM,I SET FUNCTION CODE TO 1 IF BOTH CLE,SZB,RSS PNUM & PSIZE ARE MISSING OR 0, LDB PSIZE,I ELSE 2. INCLUDE REMOTE BIT & LDA REM1 SET INTO REQST BUFR. SZB CCE,INA STA RQBUF+8 * * FORMAT 2ND APLDR SCHED PARAM * CLA,SEZ,RSS WERE PNUM & PSIZE MISSING? JMP SETP2 YES, SET SCHED PARAM TO ZERO LDA PSIZE,I NO, SET PNUM INTO BITS 0-5, ALF,ALF PSIZE INTO BITS 10-14. ALS,ALS IOR PNUM,I SETP2 STA RQBUF+9 * JSB D65MS CALL MSTER TO SEND REQ DEF *+8 DEF CNWD DEF RQBUF DEF D16 LENGTH OF RQBUF DEF * DUMMY DATA BUFR ADR DEF D0 NO DATA ASSOCIATED WITH REQST DEF D0 OR REPLY. DEF D16 MAX REQST-REPLY LENGTH JMP LNERR LINE ERROR SPC 2 LDA RQBUF+7 GET APLDR ERROR CODE STA FERCD,I PASS IT TO USER LDA FERMG SEE IF WE MOVE OPTIONAL NAME SZA,RSS JMP EXIT NO LDA ERRA LDB FERMG PASS THE ERROR MESSAGE BACK TO THE USER MVW D3 JMP EXIT RETURN SPC 3 LNERR DST ERMS SAVE ERROR MESSAGE FROM A & B REG. CPA ASDS IS IT A "DSXX"ERROR ? JMP DSER YES JSB CLR NO, SYSTEM ERROR. CLEAR PARAM AREA LDB MSER FOR NEXT TIME & ABORT USER. LDA ERADD GET MESSAGE @ AND ERROR @ JSB D65AB WE DO NOT RETURN FROM THIS JSB * * WE WILL DECODE THE XX PART OF THE ERROR MESSAGE * AND MAP IT AS A NEGATIVE ERROR CODE FOR THE USER * & PASS THE ASCII ERROR MESSAGE TO USER IF WANTED. * DSER LDA ERMS+1 GET THE XX PART AND B17 GET VALUE OF THE LS DIGIT STA LCHAR SAVE LDA ERMS+1 GET VALUE AGAIN ALF,ALF SWAP CHARACTERS AND B17 GET UPPER CHARACTER'S VALUE MPY D10 WEIGHT IT ADA LCHAR WE NOW HAVE THE ERROR # CMA,INA MAKE IT <0 ADA DM50 MAP IT STA FERCD,I PASS IT TO THE USER * LDA FERMG IF THE USER WANTS IT WE WILL PASS HIM SZA,RSS THE ERROR MESSAGE JMP EXIT HE DOES NOT WANT IT, RETURN DLD ERMS GET THE MESSAGE DST FERMG,I PASS IT ISZ FERMG ISZ FERMG STEP TO LAST WORD LDA BLNK GET AN ASCII DOUBLE BLANK STA FERMG,I PASS IT * EXIT JSB CLR CLEAR PARAM AREA FOR NEXT TIME JMP FLOAD,I RETURN TO USER CLR NOP SUBR TO CLEAR PARAM AREA LDA DM9 CLEAR THE PARAMETER STA CNTR AREA BEFORE RETURNING. CLA LDB PRMSA CLR1 STA B,I INB ISZ CNTR JMP CLR1 JMP CLR,I RETURN SPC 3 D9 DEC 9 D11 DEC 11 D10 DEC 10 D16 DEC 16 D0 DEC 0 D3 DEC 3 DM9 DEC -9 DM50 DEC -50 B17 OCT 17 REM1 OCT 100001 REMOTE BIT / FUNC = 1 LCHAR NOP MSER DEF ERMS ERMS BSS 2 PNAMA DEF RQBUF+5 NAMA DEF RQBUF+10 ERRA DEF RQBUF+8 APNAM DEF *+1 ASC 3,APLDR BLNK ASC 1, ASDS ASC 1,DS ERADD NOP CNWD OCT 140000 D65MS CONWD (NO ABORT, LONG TIMEOUT) CNTR EQU ERMS USE AS COUNTER BEFORE EXIT SPC 1 RQBUF BSS 16 REQUEST-REPLY BUFR END #  91740-18036 1740 S C0122 DS/1000 MODULE: GNODE              H0101 5ASMB,R,L,C NAM GNODE,7 91740-16036 REV 1740 770425 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * GNODE * SOURCE: 91740-18036 REV 1740 * BINARY: 91740-16036 REV 1740 * CHUCK WHELAN * APRIL 25,1977 * * RETURN LOCAL NODAL ADDRESS TO CALLER * ENT GNODE * EXT #NODE * GNODE NOP LDB GNODE INB LDB 1,I GET PARAMETER ADDRESS LDA #NODE STA 1,I RETURN NODE # TO CALLER LDB GNODE,I JMP 1,I * END '  91740-18037 1913 S C0222 DS/1000 MODULE: RMTIO              H0102 ?ASMB,R,L,C,Z ** ASSEMBLE FOR DS/1000 USAGE ** IFN # HED FMTIO NAM FMTIO,7 24998-16002 REV.1913 790129 XIF # IFZ # HED DS/1000 I/O AND CONTROL FOR FRMTR *(C) HEWLETT-PACKARD CO. 1979* NAM RMTIO,7 91740-16037 REV 1913 790129 XIF # UNL # IFZ # LST # * *************************************************************** # * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * # * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * # * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* # * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * # * *************************************************************** # * # * NAME: FMTIO ('N' ASSEMBLY OPTION) RMTIO ('Z' ASSEMBLY OPTION) # * SOURCE: 24998-18002 24998-18002 # * RELOC: 24998-16002 91740-16037 # * PGMR: D.L.B./E.A.S./B.G. C.C.H. (01-29-79) # * # * ** SEE ENTRY POINT 'DNODE' FOR DS/1000 MODIFICATIONS 1-16-79 (CH) ** # UNL # XIF # LST # * * THE FOLLOWING MODIFICATIONS HAVE BEEN MADE AS OF 042277: * THE CARD READER BUG (REPORT 3668) HAS BEEN CORRECTED. * ADDITIONS WERE INCLUDED TO ALLOW THE USER TO$ DECLARE HIS OWN * LARGE BUFFERS FOR USE BY THE FORMATTER. * THIS IS DONE BY CALLING LGBUF(ARRAY,LENGTH). (EAS) * BUG FIX 092677: FAILURE TO RESTORE B AFTER EXEC CALL IN .DIO. * CAUSED "SZB,RSS / JSB WAITO" TO FAIL (EXEC CALL IN SETLU). * THIS CAUSED FAILURE ON DOS AND WOULD HAVE FOR RTE-LC. (EAS). * THE FOLLOWING MODIFICATION WAS MADE AS OF 022778: * THE PROGRAM NAME IS FETCHED VIA "PNAME" SO THAT RTE-IV * TYPE 4 PROGRAMS WORK. (BG) SPC 2 IFZ # ENT DNODE # EXT D65MS,#NODE # XIF # ENT .IOI.,.IOJ.,.IOR. ENT .IIO.,.JIO.,.RIO.,.XIO.,.TIO. ENT .IAR.,.JAR.,.RAR.,.XAR.,.TAR. ENT .IAY.,.JAY.,.RAY.,.XAY.,.TAY. ENT .DIO.,.BIO.,.DTA. ENT NEWIO,OLDIO,CODE,ACODE,ITLOG,ISTAT,LGBUF EXT .FRMN,.LS2F,.INPN,.DTAN,FMT.E EXT PNAME,REIO,EXEC,.SBT * A EQU 0 B EQU 1 SKP * SPECIAL ENTRY POINTS: * ************************************************************************ * ASSEMBLY FORTRAN (IV) * * JSB CODE CALL CODE(ICHRS) * DEF *+2 READ (IBUF,*) A,B,C * DEF ICHRS * LDA IBUFR(,I) * CLB(,INB) * JSB .DIO. * DEF FORMT * DEF ENDLS * * WHERE: * IBUFR = THE IN MEMORY BUFFER TO CONVERT TO BINARY * ICHRS = THE NUMBER OF ASCII CHARACTERS IN " IBUFR " * * NOTES: * THE ENTRY POINT " CODE " IS NOW IN THE FORMATTER WHICH * ALLOWS THE OPTIONAL PARAMETTER " ICHRS " TO BE PASSED * TO LIMIT THE SIZE OF THE BUFFER THAT THE FORMATTER WILL * READ. IF " IBUFR " IS NOT PASSED, THEN THE FORMATTER WILL * SEARCH ALL OF MEMORY, IF NECESSARY, TO SATISFY THE VARIABLE * LIST. (A,B,C) SKP * JSB ITLOG ICHRS = ITLOG(IXXXX) * ; DEF *+1 * STA ICHRS * WHERE: * ICHRS = THE NUMBER OF CHARACTORS READ OR WRITTEN BY THE FORMATTER * BY ITS LAST INPUT/OUTPUT REQUEST TO THE SYSTEM. " ICHRS " VALUE * WILL BE 0 TO 134 (120 OF BINARY) REGARDLESS OF THE SPECIFIED * BUFFER SIZE IN THE READ OR WRITE STATEMENT. * IXXXX = THE SAME AS " ICHRS " *********************************************************************** * JSB ISTAT ISTUS = ISTAT(IXXXX) * DEF *+1 * STA ISTUS * WHERE: * ISTUS = THE STATUS WORD RETURNED FROM THE EXEC IN THE LAST * INPUT/OUTPUT CALL THE FORMATTER DID. * IXXXX = SAME AS " ISTUS " ************************************************************************ * JSB LGBUF CALL LGBUF(IBUFF,LENTH) * DEF *+3 * DEF IBUFF * DEF LENTH * WHERE: * IBUFF = ADDRESS OF A USER BUFFER. * LENTH = LENGTH OF BUFFER, IN WORDS. THIS BECOMES THE NEW MAXIMUM * RECORD LENGTH. *********************************************************************** * FORTRAN EXAMPLES. *** * CALL EXEC (1,401B,IBUFR,-80) * CALL ABREG(IA,ICHRS) * CALL CODE(ICHRS) * READ(IBUFR,*) A,B,C,D *** * 5 READ (1,10) (IBUF(I),I=1,36) * 10 FORMAT (36A2) * IF (ITLOG(ICHRS)) 20,5,20 * 20 ISTRC = 1 * CALL NAMR(IPBUF,IBUF,ICHRS,ISTRC) * * NOTE: ICHRS CAN BE AS LARGE AS 134 IF 134 CHARACTERS ARE INPUT. *** * READ (8,10) (IBUF(I),I=1,80) * 10 FORMAT (40A2) * IF (IAND(ISTAT(ISTUS),240B)) 99,20,99 * 20 CONTINUE * --- * 99 CONTINUE (END OF FILE OR END TAPE DETECTED) *** * DIMENSION IBUFF(1000) * --- * CALL LGBUF(IBUFF,1000) * READ(8,10) (ARRAY(I),I=1,2000) * 10 FORMAT(2000A1) HED COMMUNICATION WITH FRMTR. * FOLLOWING LOCATIONS REFERENCED IN FRMTR: * ADX BSS 1 ADDRESS VARIABLE. TYPE BSS 1 TYPE LENTH BSS 1 LENGTH (IN WORDS) SKIP BSS 1 FLAG TO SKIP STORE IN .IOI./.IOJ./.IOR. FCR BSS 1 POINTS TO CHARACTER IN FORMAT CCNT BSS 1 COUNTS WORDS/CHARS IN BUFFER CMAX BSS 1 MAX VALUE OF CCNT AT TAB LEFT. BCR BSS 1 IO BSS 1 FLAG...=0 FOR OUTPUT, 1 FOR IN SKIPL BSS 1 FLAG TO AVOID SPURIOUS RTN TO LIST. TSCAL BSS 1 SCALE BSS 1 SCALE FACTOR NEST BSS 1 PAREN LVLS. INIT -6, -5 IN FMT, * -4 TO -1 FOR NESTING. CFLAG BSS 1 BCRS BSS 1 USED FOR REMEMBERING BCR F2LSI BSS 1 SWITH BSS 1 RNEST BSS 1 NEST VALUE OF UNLIMITED GROUPS. ADRFD DEF RFSV USED FOR INDEXING IN RFLD. RF BSS 1 FORMAT REPEAT FIELD COUNTER WSAVE BSS 1 HOLDS INITIAL W FOR REPEATS DSAVE BSS 1 HOLDS INITIAL D FOR REPEATS GFLAG BSS 1 = -1 IF G FIELD, +1 OTHERWISE. .OBUF DEF BUFO EORD BSS 1 ALSO DTAI & ATMP. OFLAG DEC 0 =0,-1 FOR ASA/OLD FORMATS. HED CONSTANTS & LOCALS. * CONSTANTS. * CNTRL BSS 1 MIN6 DEC -6 MIN2 DEC -2 MIN1 DEC -1 ....1 DEC 1 ....2 DEC 2 ....3 DEC 3 ....7 DEC 7 ...13 DEC 13 PAPER OCT 34000 TEST FOR PAPER TAPE. O76K OCT 76000 O2000 OCT 2000 PBIT OCT 200 SET BIT FOR IOC. BASIC OCT 400 .4000 OCT 4000 CHECK FOR TYPE CODE = 1X ASC2B OCT 500 SPCOL ABS 72B-40B ":" - " " "B" OCT 102 "^0" BYT 40,60 " 0" "0" OCT 60 BLANK OCT 40 MXPS OCT 77777 MAX POS # DMXPS DEF MXPS * * LOCALS. * FMTAD BSS 1 ADDR FORMAT TEMP1 BSS 2 TEMPORARY TEMP2 BSS 1 STORAGE RFLD BSS 5 REPEAT FIELD FOR GROUPS. RFSV BSS 5 INITIAL VALUE OF R-FIELD. LPRN BSS 5 ADDRESS OF LEFT PAREN'S IN GROUP UNIT OCT 1 INPUT/OUTPUT UNIT ENDLS BSS 1 POINTS TO ENDOF CALLING SEQUENCE ALNTH BSS 1 AND .IAR. BFLAG BSS 1 =1 FOR BINARY I/O, 0 FOR DECIMAL STXXX NOP BUFBN EQU 60 BUFLN EQU 67 BUFI BSS BUFLN BUFO EQU BUFI BINRY ABS -BUFBN-BUFBN BINARY RECORD LENGTH ASCRY ABS -BUFLN-BUFLN FORMATTED RECORD LENGTH CLEN ABS -BUFLN-BUFLN HED ROUTINES TO PASS LIST ITEMS. ******************************************************************** * THIS SET OF ROUTINES IS USED TO PASS THE ADDRESS, TYPE AND * * LENGTH (IF ARRAY). FOR EACH VARIABLE OR ARRAY OF TYPE: * * INTEGER (I), DOUBLE INTEGER (J), REAL/2-WD FLOATING (R), * * EXTENDED PRECISION/3-WD FLOATING (X) OR DOUBLE PRECISION/4-WD * * FLOATING (T), THERE IS A SINGLE CALL TO ONE OF THE FOLLOWING: * * .IOZ., Z=I,J,R; .ZIO./.ZAR./.ZAY., Z=I,J,R,X,T. * * THERE IS INITIALLY A SINGLE CALL TO EITHER .DIO. OR .BIO. . * ******************************************************************** SPC 3 IOCHK NOP A SWITCH ON THE VALUE OF IO. RE- STB TEMP2 SAVE B LDB IO TURN TO P+1 FOR OUTPUT, P+2 FOR SZB INPUT. ISZ IOCHK LDB TEMP2 RESTORE B JMP IOCHK,I SPC 3 BCHEK NOP RETURNS TO P+1 IF BINARY, ELSE 2 STB TEMP2 LDB BFLAG SZB,RSS ISZ BCHEK LDB TEMP2 JMP BCHEK,I SPC 2 * ROUTINE TO INITIALIZE .ZIO. / .ZAR. / .ZAY. * CTYPE NOP ADB MIN2 ACTUAL ENTRY POINT ADDR. LDA B,I COPY ENTRY POINT. STA .TIO. CMB COMPUTE OFFSET FROM FIRST ONE. ADB CTYPE,I CMB BRS TYPE = OFFSET / 2 STB TYPE SZB TYPE = 0 CPB ....1 OR 1 ? INB YES, LENTH IS ONE LARGER (ELSE EQUAL) STB LENTH ISZ CTYPE EXIT JMP CTYPE,I SKP * .IOI. / .IOJ. / .IOR. * * CALLING SEQUENCE: * * * JSB ROUTINE * SPC 2 .IOI. NOP STORE ARG & CALLL .IIO. STA TEMP1 JSB .IIO. DEF TEMP1 LDA TEMP1 LDB SKIP IF FREE-FIELD & NULL, SKIP STORE. SZB ISZ .IOI. JMP .IOI.,I * .IOJ. NOP STORE ARG & CALL .JIO. STA TEMP1 STB TEMP1+1 JSB .JIO. DEF TEMP1 LDA .IOJ. SAVE A LITTLE SPACE HERE. STA .IOR. JMP IOR1 * .IOR. NOP STORE ARG & CALL .RIO. STA TEMP1 STB TEMP1+1 JSB .RIO. DEF TEMP1 IOR1 LDA TEMP1 LDB TEMP1+1 ISZ SKIP IF FREE-FIELD & NULL, SKIP STORE. JMP .IOR.,I ISZ .IOR. ISZ .IOR. JMP .IOR.,I SKP * .IIO. / .JIO. / .RIO. / .XIO. / .TIO. * * CALLING SEQUENCE: * * JSB ROUTINE * DEF SPC 2 .IIO. NOP JSB TIO .JIO. NOP JSB TIO .RIO. NOP JSB TIO .XIO. NOP JSB TIO .TIO. NOP JSB TIO SPC 1 TIO NOP LDB TIO COMPUTE TYPE, LENTH. JSB CTYPE DEF .IIO. LDB A,I B = BASE ADDR. ISZ .TIO. CLA,INA A = # ELEMENTS = 1. JMP TAY1 SKP * .IAR./.JAR./.RAR./.XAR./.TAR. .IAY./.JAY./.RAY./.XAY./.TAY. * * CALLING SEQUENCES: * * LDA <# ELEMENTS> JSB ROUTINE * LDB DEF * JSB ROUTINE DEC <# ELEMENTS> * * INDIRECTION IS ALLOWED ON BOTH VALUES (THE # OF ELEMENTS * IS TREATED AS AN ADDRESS). SPC 3 .IAR. NOP JSB TAR .JAR. NOP JSB TAR .RAR. NOP JSB TAR .XAR. NOP JSB TAR .TAR. NOP JSB TAR * TAR NOP STB ADX SAVE A,B. STA ALNTH LDB TAR SET TYPE, LENTH. JSB CTYPE DEF .IAR. LDB ADX B = BASE ADDR. LDA ALNTH A = # ELEMENTS. JMP TAY1 SPC 2 .IAY. NOP JSB TA׶Y .JAY. NOP JSB TAY .RAY. NOP JSB TAY .XAY. NOP JSB TAY .TAY. NOP JSB TAY * TAY NOP LDB TAY SET TYPE, LENTH. JSB CTYPE DEF .IAY. LDB A,I B = BASE ADDR. ISZ .TIO. LDA .TIO.,I A = # ELEMENTS. ISZ .TIO. JMP TAY1 SKP * AT THIS POINT: TYPE, LENTH & RETURN ADDR ARE * SET UP, AND: B=BASE ADDR, A=# ELEMENTS. SPC 2 LDB B,I REMOVE INDIRECTS FROM BASE ADDR. TAY1 RBL,CLE,SLB,ERB JMP *-2 STB ADX JMP *+2 REMOVE "INDIRECTS" ON LENGTH LDA A,I RAL,CLE,SLA,ERA JMP *-2 JSB BCHEK BINARY ? JMP TAY3 YES. CMA,INA,SZA,RSS - # ELEMENTS. JMP .TIO.,I IF NONE. STA ALNTH TAY2 JSB LST2J GO CONVERT. LDA ADX BUMP TO NEXT ELEMENT. ADA LENTH STA ADX ISZ ALNTH DONE ? JMP TAY2 NO, DO ANOTHER. JMP .TIO.,I YES, EXIT. * * BINARY ARRAY I/O. * TAY3 MPY LENTH A = TOTAL LENGTH. CMA,INA,SZA,RSS SET UP COUNT. JMP .TIO.,I IF ZERO. STA ALNTH TAY4 ISZ CCNT TEST FOR END OF BUFFER. JMP TAY5 NO. JSB DTA YES, DO I/O. JMP TAY4 AND TRY AGAIN. TAY5 ISZ BCR BUMP BUFFER POINTER. LDA ADX,I FOR OUTPUT. JSB IOCHK WHICH ? STA BCR,I OUTPUT. LDA BCR,I INPUT. JSB IOCHK WHICH ? JMP *+2 OUTPUT - DONE. STA ADX,I INPUT - STORE IN VARIABLE. ISZ ADX TO NEXT ELEMENT. ISZ ALNTH DONE ? JMP TAY4 NO, DO AGAIN. JMP .TIO.,I EXIT. HED CODE - ENCODE/DECODE. * THE FOLLOWING CODE WAS ADDED FOR THE "CALL CODE" PROBLEM * CALLING: * JSB CODE JSB CODE * DEF *+1 DEF *+2 * LDA IBUFR(,I) DEF TLOG +CHARS -* CLB(,INB) - OR - LDA IBUFR(,I) * JSB .DIO. CLB(,INB) * DEF FORMT JSB .DIO. * DEF ENDLS DEF FORMT * ETC. DEF ENDLS * ETC. ****************************************** CODE NOP SPECIAL ENTRY FOR INTERNAL CONVERSION ACODE EQU CODE DO THE ALGOL THING ******************************************* LDB CODE,I GET RETURN ADDRESS + LDA BUFFR(,I) ISZ CODE BUMP TO FIND OUT IF TLOG LDA CODE,I GET POSSIBLE PRAM ADDRESS CPB CODE CHECK IF PASSED PARM LDA DMXPS NO, GET DEF MAX POS #. LDA A,I GET TLOG IN CHARS OR MAX POS #. CMA MAKE -TLOG-1 OR MAX NEG #. STA CCNT SAVE AS BUFFER LEN STA CMAX STB BFLAG SAVE RETURN ADDRESS LDA B,I LOAD: "LDA IBUFR(,I)". AND O2000 MASK TO FIND IF CLE,SZA CURRENT OF BASE PAGE? LDA B CURRENT, GET PAGE BITS XOR B,I LOAD IF BASE, MIRGE IF CURRENT AND O76K MASK OFF PAGE IF BASE, XOR B,I MIRGE IN IF CURRENT RSS NOW TRACK DOWN ANY LDA A,I INDIRECT ADDRESSES RAL,CLE,SLA,ERA INDIRECT? JMP *-2 YES, DO IT AGAIN RAL DOUBLE IT AND ADA MIN1 SUBTRACT ONE STA BCR SAVE THE BUFFER ADDRESS ADB ....3 POINT TO THE P+1 OF JSB .DIO. STB CODE SAVE IN CONVENENT PLACE JMP BFLAG,I RETURN TO EXECUTE LDA IBUFF,CLB,JSB .DIO. HED .DIO. & .BIO. - INITIALIZATION. *************************** .DIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR FORMATTED INPUT/ *************************** OUTPUT. STA UNIT STB IO LDA .DIO. CHECK IF CALL CODE BEFORE CPA CODE MUST BE SAME JMP INTCN YES, CALCL CODE CONVERSION LDA UNIT SET FUNCTION BITS JSB SETLU STA CNTRL LDA UNIT NO, PROCESS AS BEFORE CCE,SZA CHECK FOR UNIT=0. (E=1) JMP DIO1 NO-IO TRANSFER. ERA INTERNAL CONVERSION. (A=MAX NEG #) STA CCNT SET CCNT = MAX NEG #. STA CMAX LDB .DIO.,I B = BUFFER ADDR. LDA B,I VERIFY ABOVE FENCE. STA B,I RBL FORM BYTE ADDR - 1: BCR. ADB MIN1 STB BCR ISZ .DIO. INTCN CLA,RSS CALL CODE INTERNAL CONVERSION DIO1 CLA,RSS STA UNIT STA BFLAG STA SKIP STA SKIPL STA TSCAL INITIAL SCALE FACTOR = 0 STA SCALE CLEAR SCALE FACTOR FOR FREE INPT STA SWITH LDA ASCRY STA CLEN RECORD SIZE LDA MIN6 STA NEST OUTSIDE LEVEL 0 PARENS. CCA STA CFLAG FREE-FIELD COMMAS. SKP * COPY FORMAT AND END-OF-LIST ADDRESSES. * LDA .DIO. GET FORMAT ADDRESS LDA A,I GET DOWN TO NEXT LEVEL RAL,CLE,SLA,ERA TEST FOR INDIRECT (1 LEVEL) JMP *-2 SEARCH FOR EVER IF NEED BE STA FMTAD SAVE FORMAT ADDRESS LDB A,I VERIFY ABOVE FENCE. STB A,I RAL CONVERT TO A CHARACTER CMA,INA,SZA ADDRESS CMA STA FCR ISZ .DIO. GET THE END-OF LIST LDA .DIO.,I ADDRESS STA ENDLS LDB A,I VERIFY ABOVE FENCE. STB A,I * * IF FORMATTED OUTPUT, WAIT FOR PREV. OUTPUT & GO. * IF INPUT, READ RECORD. IF FORMATTED, GO. * ISZ .DIO. SET UP LDA .DIO. THE RETURN STA LST2J ADDRESS JSB IOCHK IF OUTPUT, JSB WAITO WAIT. JSB IOCHK JMP FORMT GO. JSB DTA INPUT. READ A RECORD. LDA FCR FORMATTED ? SZA JMP FORMT YES, GO. * * ^* FREE-FIELD INPUT. * NXTON JSB F2LST LIST DEFINITION IOTST LDB UNIT CHECK IF INTERNAL CONVERSION LDA CCNT IF CCNT = 0, SZA CHECK IF SLASH WAS ENCOUNTERED JMP NSLSH NO SZB,RSS SLASH, BUT INTERNAL CONVERSION? JMP ENDLS,I YES RETURN, UNSATISFYING LIST JSB DTA SO READ NEXT RECORD NSLSH JSB .INPN ENTER FRMTR TO CONVERT DATA DEF ADX LDA SWITH CPA ....7 IF SWITH = 7, GO TO END OF LIST JMP ENDLS,I SZA JMP NXTON STORE ELEMENT JMP IOTST MUST BE SLASH SKP *************************** .BIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR NON-FORMATTED *************************** INPUT/OUTPUT STA UNIT STB IO JSB SETLU CONFIGURE THE LU CONTROL WORD XOR ASC2B MAKE IT BINARY STA CNTRL AND PUT IT AWAY CLA,INA STA BFLAG LDA BINRY STA CLEN RECORD SIZE LDB IO TEST FOR I/O DIRECTION SZB JMP BIO1 IF INPUT. JSB WAITO OUTPUT, WAIT. JMP .BIO.,I BIO1 JSB DTA INPUT, READ. JMP .BIO.,I SPC 3 *************************** SET NEW FORMAT DEFS. NEWIO NOP * CALLING SEQUENCE: * JSB NEWIO *************************** DEF *+1 CLA STA OFLAG ISZ NEWIO JMP NEWIO,I SPC 3 *************************** SET OLD FORMAT DEFS. OLDIO NOP * CALLING SEQUENCE: * JSB OLDIO *************************** DEF *+1 CCA STA OFLAG ISZ OLDIO JMP OLDIO,I HED LINKAGE TO "FRMTR". * MAIN LOOP. CALL FRMTR & ACCEPT REQUESTS: * SWITH<6: PRODUCE ERROR MSG & QUIT. * SWITH=6: GET A LIST ITEM. * SWITH=8: DO I/O. * FORMT JSB .FRMN ENTER FRMTR TO PROCESS LIST DEF ADX TSTSW LDA MIN6 ADA SWITH SSA JMP ERROR SWITCH < 6 = ERROR. SZA,RSS JMP NRML SWITCH=6=F2LST JSB DTA SWITCH=8 JSB .DTAN ENTER FRMTR AFTER DATA I/O DEF ADX JMP TSTSW NRML JSB F2LST JSB .LS2F CONTINUE LIST PROCESS DEF ADX JMP TSTSW SPC 3 * COROUTINE MECHANISM FOR LIST ITEMS: * THE CONVERSION ROUTINES IN FRMTR AND THE LIST-ITEM * HANDLERS IN FMTIO ACT AS COROUTINES. THE LINKAGE IS * PERFORMED BY LST2J AND F2LST. WHEN FRMTR IS READY * FOR A LIST ITEM, IT RETURNS TO THE FREE-FIELD OR * FORMATTED LOOP IN FMTIO, WHICH CALLS F2LST. * F2LST RETURNS THRU LST2J TO THE PREVIOUSLY CALLED * ITEM HANDLER, WHICH RETURNS TO THE CALLER. THE * CALLER CALLS ANOTHER ITEM HANDLER, WHICH CALLS LST2J * (SAVING ITS RETURN POINT). LST2J RETURNS THRU F2LST * TO THE CONVERSION LOOP, WHICH "RETURNS" TO FRMTR BY * CALLING THE APPROPRIATE ENTRY POINT. * SINCE FORMATTED I/O CALLS FRMTR FIRST, FORMATTED * I/O IS DRIVEN BY THE FORMAT. SINCE FREE-FIELD * I/O RETURNS FOR A LIST ITEM FIRST, FREE-FIELD * INPUT IS DRIVEN THE THE LIST. SPC 1 LST2J NOP LDA ADX,I VERIFY DATA ABOVE FENCE. STA ADX,I JMP F2LST,I SPC 1 F2LST NOP LDA BCR STA BCRS ISZ SKIPL PROCESSING FINAL RIGHT PAREN ? JMP LST2J,I NO, RETURN TO .IOI. & FRIENDS. JMP F2LST,I YES, RETURN TO FORMAT PROCESSOR. HED I/O ROUTINES. DTA NOP PERFORMS A COMPLETE I/O OPERA- JSB .DTA. TION. JSB IOCHK JMP *+3 JSwHFBB WAITI INPUT WAIT JMP DTA,I JSB WAITO OUTPUT WAIT JMP DTA,I SPC 2 .DTA. NOP LDA UNIT SET UP STATUS CONTROL SZA,RSS IF UNIT=0, JMP .DTA.,I IGNORE CALL. JSB IOCHK NOW TEST FOR INPUT OR OUTPUT. JMP DTAO * INPUT SECTION * JSB IOCIN PERFORM IOC CALL. JMP .DTA.,I RETURN * OUTPUT SECTION * DTAO LDB CCNT GET NUMBER OF CHARACTERS/WORDS. JSB BCHEK BINARY ? JMP DTAO2 YES. CMB,CLE,INB -CCNT ADB CMAX CMAX-CCNT (E=0 IFF B<0) LDB CCNT NORMALLY USE CCNT. SEZ CMAX > CCNT ? LDB CMAX YES, USE IT. CMB # CHARS UNUSED. ADB CLEN CHAR COUNT. STB OUTBL STORE AS # OF CHARS. OUTPUT. CMB,SLB,INB B=# CHARS. EVEN ? JMP DTAO1 YES, IS O.K. ADB BUFOA NO. FORM ADDR CHAR AFTER LAST. ADB BUFOA LDA BLANK STORE A BLANK AFTER LAST CHAR. JSB .SBT DTAO1 JSB IOCOU PERFORM IOC CALL JMP .DTA.,I RETURN DTAO2 SZB BINARY RECORD CONTINUATION ? CMB NO. B = # WORDS NOT USED. BLS B = # CHARS NOT USED. ADB CLEN B = -(# CHARS USED) STB OUTBL CMB,INB B = REC LENGTH BLF,BLF POSITION AS HIGH CHARACTER RBR IN WORDS. LDA CNTRL ALF,ALF ROTATE P-BIT TO SIGN SSA IF NOT ZERO, STORE AS STB .IBUF,I FIRST CHARACTER IN BUFFER. JMP DTAO1 rH SKP WAITI NOP WAITS FOR INPUT LDB UNIT IGNORE SZB,RSS CALL IF JMP WAITI,I UNIT=0. JSB BCHEK BINARY OR ASCII? ARS BINARY--CONVERT TO WORD COUNT. CMA STORE AS NEGATIVE IN STA CCNT COUNTER. STA CMAX LDB .IBUF GET BUFFER ADDRESS JSB BCHEK BINARY ? JMP WTI3 YES RBL FOR ASCII SET BCR TO POINT TO WTI2 ADB MIN1 THE FIRST CHARACTER PRECEDING WTI4 STB BCR THE BUFFER. JMP WAITI,I WTI3 LDA CNTRL ALF,ALF SSA,RSS PAPER TAPE ? JMP WTI2 NO ISZ CCNT YES JMP WTI4 * INPUT ERROR * * WAITO NOP WAITS FOR OUTPUT TO BE COMPLETED LDA UNIT IGNORE CALL IF SZA,RSS UNIT=0. JMP WAITO,I LDA .OBUF SET UP BUFFER ADDRESS AND CCB LENGTH. ADB CLEN JSB BCHEK BINARY. JMP WTO6 RAL ADJUST BUFFER ADDRESS FOR ADA MIN1 CHARACTERS STA BCR STB CCNT STB CMAX JMP WAITO,I WTO6 BRS ADJUST LENGTH FOR WORDS. ADA MIN1 STA BCR STB CCNT (DON'T NEED CMAX FOR BINARY) LDA CNTRL ALF,ALF SSA,RSS TEST FOR PAPER TAPE. JMP WAITO,I NOT PAPER TAPE. ISZ CCNT IF PAPER TAPE, BUMP BUFFER ISZ BCR ADDRESS AND COUNTER. JMP WAITO,I RETURN SKP SETLU BSS 1 SZA,RSS IF LU = 0 THEN JMP SETLU,I RETURN IFZ # LDB ...13 GET THE 'STATUS' REQUEST CODE, AND GO # JSB REMOT TO SEE IF A REMOTE OPERATION IS NEEDED# DEF SRTRN TO GET THE STATUS FOR A REMOTE DEVICE# XIF # JSB EXEC ELSE DEF *+3+1 TEST FOR PAPER TAPE AND CONFIGURE DEF ...13 THE CONTROL WORD DEF UNIT DEF STXXX LDA STXXX IFZ # SRTRN EQU * REMOTE STATUS REQUEST RETURNS HERE. # XIF # AND PAPER CPA .4000 CLA SZA CLA,RSS LDA PBIT IOR UNIT IOR BASIC JMP SETLU,I SKP IOCIN NOP INPUT CALL TO IOC INAGN EQU * # IFZ # LDB ....1 GET THE READ REQUEST CODE, AND GO TO # JSB REMOT SEE IF A REMOTE OPERATION IS NEEDED # DEF INRTN TO READ ON THE SPECIFIED DEVICE. # XIF # JSB REIO # DEF *+5 DEF ....1 DEF CNTRL .IBUF DEF BUFI DEF CLEN IFZ # INRTN EQU * REMOTE READ RETURNS HERE. # XIF # STA STATS SAVE STATUS FOR LATER STB TLOG SAVE TRANSMISSION LOG FOR LATER RAL TEST DOWN BIT SSA ARE WE OK? JMP INAGN NO GO TRY AGAIN AND O500 IS EOT OR EOF BITS SET? SZA,RSS JMP IOCI1 NO, CONTINUE JSB BCHEK CHECK IF BINARY OR ASCII RSS BINARY JMP ENDLS,I ASCII, EXIT LDB CLEN YES, DUMMY THE TLOG SSB -? CMB,INB YES, MAKE POSITIVE IOCI1 LDA B JMP IOCIN,I SKP IOCOU NOP OUTPUT CALL TO IOC LDA CNTRL CLEAR BIT 7 AND =B177577 FOR OUTPUT REQUESTS STA CNTRO IFZ # LDB ....2 GET THE WRITE REQUEST CODE, AND GO TO # JSB REMOT SEE IF A REMOTE OPERATION IS NEEDED # DEF OTRTN C TO PERFORM THE REQUESTED WRITE. # XIF # JSB REIO DEF *+5 DEF ....2 DEF CNTRO BUFOA DEF BUFO DEF OUTBL IFZ # OTRTN EQU * REMOTE WRITE RETURNS HERE. # XIF # STA STATS STB TLOG SAVE STATUS AND TLOG JMP IOCOU,I OUTBL BSS 1 CNTRO BSS 1 SKP * ITLOG - GET LAST TRANSMISSION LOG. * ITLOG NOP ENTRY TO GET LAST TRANSMISSION LOG LDA TLOG GET LAST TRANSMITTION LOG LDB ITLOG GET RETURN ADDRESS STB ISTAT DUMMY UP ENTRY JMP ISTAT+2 SPC 4 * ISTAT - GET LAST STATUS WORD. * ISTAT NOP ENTRY TO GET LAST STATUS WORD LDA STATS GET LAST STATUS LDB ISTAT,I GET RETURN ADDRESS STB ITLOG SAVE TEMP ISZ ISTAT CHECK IF PARAMETER PASSED CPB ISTAT CLB,RSS SET DUMMY ADDRESS IN B-REG LDB ISTAT,I GET PARAMETER ADDRESS STA B,I RETURN PARAMETER JMP ITLOG,I RETURN SPC 1 STATS NOP LAST I/O STATUS WORD TLOG NOP LAST I/O TRANSMITTION LOG O500 EQU ASC2B SPC 4 * LGBUF - SUBSTITUTE USER BUFFER FOR FMTIO BUFFER. * LGBUF BSS 1 ISZ LGBUF LDA LGBUF FETCH THE BUFFER ADDRESS LGLP1 LDA A,I RAL,CLE,SLA,ERA TEST AND CLEAR INDIRECT BIT JMP LGLP1 TRY AGAIN STA BUFOA FIX THE ADDRESS POINTERS STA .IBUF STA .OBUF ISZ LGBUF LDA LGBUF,I FETCH THE BUFFER LENGTH LDA A,I ALS MAKE IT INTO A BYTE COUNT CMA,INA STA ASCRY STA BINRY ISZ LGBUF JMP LGBUF,I HED ERROR PROCESSING. * PRINT ON LU "FMT.E" THE FORMAT ERROR IN THE FORM: UNL  # IFN # LST # * " /PROGM: FMT ERR 3 @12345B" UNL # XIF # IFZ # LST # * " /PROGM: FMT ERR# 4 @12345B" # UNL # XIF # * (WITHOUT QUOTES) THIS EXAMPLE HAS ERROR #3 FROM THE FORMAT AT * ADDRESS 12345 OCTAL, AND THE CALLING PROGRAM IS NAMED "PROGM". UNL # IFZ # LST # * # * DS/1000 ERRORS WILL BE PRINTED ON LU#1, USING THE SAME FORMAT. # UNL # XIF # LST # SPC 1 ERROR LDA UNIT INHIBIT ERRORS WHEN SZA,RSS INTERNAL CONVERSION JMP ENDLS,I IFZ # LDA BLNS INITIALIZE PART OF # STA MESSS+10 THE MESSAGE WITH BLANKS. # XIF # LDA SWITH GET ERROR NUMBER ADA "^0" CONVERT TO ASCII " 0" IFN # STA MESSS+8 FIRST WORD OF ERROR CODE XIF # IFZ # &k STA MESSS+9 OR 1RST WORD OF REMOTE ERROR CODE. # LDA FMT.E INITIALIZE FOR MESSAGE REPORTING # RMTER STA ERLU VIA 'FMT.E' OR CONSOLE LOGICAL UNIT. # XIF # LDA FMTAD GET FORMAT ADDRESS LDB DFADS GET ADDRESS OF MEM BUFFER RAL,CLE,SLA POSITION MEM ADDRESS & SKIP AGAIN LDA IOCOU GET NEXT OCT DIGIT ALF,RAR ROTATE LEFT 3 STA IOCOU SAVE FOR NEXT PASS AND ....7 MASK DOWN TO DIGIT IOR "0" MIRGE IN TO ASCII SEZ,RSS SKIP IF LO-CHAR IN WORD ALF,SLA,ALF POSITION TO HI-HALF IOR B,I MIRGE IN HI-HALF STA B,I AND PUT IN WORD SEZ,CME BUMP WORD TO NEXT WORD? INB YES, DONE WITH BOTH CHARS CPB DFEND DONE WITH 5 CHARS? SEZ,RSS YES JMP AGAIN NO, FINISH CONVERSION IOR "B" LAST CHAR IS "B" STA B,I AND PUT IN LAST WORD JSB PNAME COPY PROGRAM NAME DEF *+2 DEF MESSS+1 LDA MESSS+3 CHANGE 6TH CHAR TO ":" ADA SPCOL STA MESSS+3 3RD WORD OF NAME JSB REIO DEF *+5 DEF ....2 IFN # DEF FMT.E XIF # IFZ # DEF ERLU # XIF # DEF MESSS IFN # DEF ...13 XIF # IFZ # DEF D15 # XIF # JMP ENDLS,I SUP IFN # DFADS DEF MESSS+210 DFEND DEF MESSS+12 MESSS ASC 13, /PROGS: FMT ERR 4 @12345B XIF # IFZ # MESSS ASC 15, /PROGM: FMT ERR# 4 @12345B # * # DFADS DEF MESSS+12 # DFEND DEF MESSS+14 # BLNS ASC 1, D15 DEC 15 ERLU NOP XIF IFN # SKP # XIF # IFZ # HED DS/1000 REMOTE SECTION * (C) HEWLETT-PACKARD CO. 1979 * * REMOTE-PROCESSING INVOCATION REQUEST: * * CALL DNODE (NODAD) -OR- REG = DNODE (NODAD) * * WHERE: 'NODAD' IS THE NODAL ADDRESS OF THE REMOTE CPU * * IF 'NODAD' = -1, THEN THE LOCAL NODE IS SPECIFIED (DEFAULT). * * WITH = OLD DESTINATION NODE, = NEW DESTINATION NODE. * * NEED ONLY BE CALLED, ONCE, BEFORE EXECUTION OF THE * FIRST READ/WRITE OPERATION. IT WILL REMAIN SET FOR THE * SPECIFIED NODE, DURING THE REMAINDER OF THE PROGRAM'S EXECUTION. * THE USER MAY RESET THE NODAL ADDRESS, AT ANY TIME. * DNODE NOP LDA DNODE,I GET THE RETURN ADDRESS. ISZ DNODE ADVANCE TO PARAMETER ADDRESS. LDB DNODE GET ADDRESS OF PARAMETER POINTER. STA DNODE SAVE THE RETURN ADDRESS. * LDB B,I GET THE PARAMETER ADDRESS. RBL,CLE,SLB,ERB TRACK DOWN JMP *-2 INDIRECTS. LDB B,I GET THE DESTINATION NODAL ADDRESS. CPB #NODE IF CALLER HAS SPECIFIED THE LOCAL NODE,# CCB THEN SET DESTINATION ADDRESS = -1. # LDA DESTN = OLD DESTINATION NODE. STB DESTN ESTABLISH NODAL ADDRESS ]OF REMOTE CPU. JMP DNODE,I RETURN. * DESTN DEC -1 DESTINATION NODAL ADDRESS. * SKP * * REMOTE REQUEST PROCESSING. * * CALLING SEQUENCE: * * LDB RQCOD EXEC REQUEST CODE: 1(READ)/2(WRITE)/13(STATUS) * JSB REMOT * DEF RMRTN RETURN ADDRESS, FOLLOWING REMOTE PROCESSING. * CONTINUE LOCAL EXECUTION IF 'DESTN' =-1. * REMOT NOP CCA IF THE DESTINATION NODAL ADDRESS CPA DESTN SPECIFIES LOCAL EXECUTION, JMP *+2 THEN SKIP TO RETURN, IMMEDIATELY; JMP REMO1 ELSE, PROCEED WITH REMOTE PROCESSING. ISZ REMOT SET RETURN POINTER FOR LOCAL RETURN(P+2) JMP REMOT,I CONTINUE LOCAL PROCESSING. * REMO1 LDA REMOT,I REMOTE: GET THE RETURN ADDRESS. STA REMOT ESTABLISH RETURN POINTER. STB RCODE ESTABLISH REQUEST CODE IN RQBUF+4. STB CODSV SAVE RCODE FOR ERROR PROCESSING. # * LDA CNTRL GET THE READ CONTROL WORD. CPB ...13 IF THIS IS A REMOTE 'STATUS' REQUEST, LDA UNIT USE THE DEVICE LOGICAL UNIT NO. CPB ....2 IF THIS IS A REMOTE 'WRITE' REQUEST, LDA CNTRO USE THE 'WRITE' CONTROL WORD. STA CONWD PLACE CONWD INTO REQUEST BUFFER+5. * CLA CPB ....1 IF THIS IS A 'READ' REQUEST, LDA CLEN THEN GET THE READ-BUFFER LENGTH. SSA,RSS IF WORDS WERE SPECIFIED, JMP STRLN GO TO INITIALIZE 'RDLEN' FOR . ARS CONVERT CHARACTERS TO WORDS, CMA,INA AND MAKE IT A POSITIVE VALUE. STRLN STA RDLEN CONFIGURE THE READ LENGTH. * SKP CLA CPB ....2 IF THIS IS A 'WRITE' REQUEST, LDA OUTBL THEN GET THE WRITE-BUFFER LENGTH. SSA,RSS IF WORDS WERE SPECIFIED, JMP STWLN GO TO INITIALIZE 'WRLEN' FOR . ARS CONVERT CHARACTERS TO WORDS, CMA,INA AND MAKE IT A POSITIVE VALUE. STWLN STA WR.LEN CONFIGURE THE WRITE LENGTH. * CLA PREPARE FOR A 'STATUS' REQUEST. CPB ....1 IF THIS IS A 'READ' REQUEST, LDA CLEN GET THE ORIGINAL READ LENGTH. CPB ....2 IF IT'S A 'WRITE' REQUEST, LDA OUTBL GET THE ORIGINAL WRITE LENGTH. STA IBUFL SAVE BUFFER LENGTH IN RQBUF+6. * LDA D5 CONFIGURE THE STREAM-WORD STA RQBUF FOR A REMOTE 'EXEC' REQUEST. LDA DESTN GET THE DESTINATION NODAL ADDRESS, STA RQBUF+3 AND DEFINE DESTINATION OF THIS REQUEST. * JSB D65MS CALL DEF *+8 TO TRANSMIT DEF NABRT THE REMOTE-EXEC DEF RQBUF REQUEST TO DEF D10 THE USER-SPECIFIED DEF BUFI REMOTE NODE, DEF WRLEN FOR EXECUTION OF DEF RDLEN THE READ/WRITE/STATUS DEF D10 REQUEST. JMP DSERR REPORT THE ERROR! * LDB RQBUF+6 GET THE ERROR-FLAG--IF ANY, CLE,ELB AND POSITION IT TO . LDB RQ7AD GET ADDRESS FOR RETURNED 'STATUS'. CPA ....7 IF THE REPLY LENGTH IS =7, LDB RQ4AD THEN RETURN-DATA IS IN WORDS #5,6. DLD B,I GET THE RETURN-DATA. SEZ,RSS IF NO ERRORS WERE DETECTED, JMP REMOT,I THEN RETURN WITH THE REQUIRED DATA; * DSERR DST MESSS+9 ELSE, CONFIGURE THE ERROR MESSAGE. LDB REMOT GET THE REMOTE-CALL RETURN ADDRESS. # LDA CODSV IF THE REMOTE-CALL FAILED WHILE DOING # CPA ...13 A STATUS REQUEST, THEN THE ERROR # STB ENDLS PROCESSOR MUST RETURN TO IN-LINE CODE# LDA ....1 PRINT COMM. LINE ERRORS ON LU #1. # JMP RMTER GO TO REPORT THE ERROR! * SKP * * CONFIGURED REMOTE-REQUEST BUFFER. * RQBUF NOP STREAM WORD. NOP SEQUENCE NUMBER (ADDED BY ). NOP SOURCE NODE (THIS) (ADDED BY ). DEC -1d640 DESTINATION NODE (DEFINED BY 'DNODE'). RCODE NOP REQUEST CODE (13:STATUS/1:READ/2:WRITE). CONWD NOP I/O CONTROL WORD (LU, ETC.). IBUFL NOP REQUEST LENGTH: READ/WRITE, =0: STATUS. EQTST NOP RETURNED EQT WORD #5. NOP EQT WORD #4. (NOT USED). NOP LU STATUS (NOT USED). * * CODSV NOP REQUEST CODE TEMPORARY STORAGE. # D5 DEC 5 D10 DEC 10 NABRT OCT 100000 NO-ABORT FLAG FOR . RQ4AD DEF RCODE REGISTER-RETURN POINTER. RQ7AD DEF EQTST STATUS-RETURN POINTER. RDLEN NOP READ RETURNED-DATA LENGTH FOR . WRLEN NOP WRITE RETURNED-DATA LENGTH FOR . XIF UNS LITERALS, IF ANY: END l6 2 91740-18038 2001 S C0122 &DEXEC              H0101 sASMB,L,R,C HED DEXEC: DS/1000 REMOTE EXEC ROUTINE *(C) HEWLETT-PACKARD CO.1980* NAM DEXEC,7 91740-16038 REV 2001 790405 SPC 1 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 1 * NAME: DEXEC * SOURCE: 91740-18038 * RELOC: 91740-16038 * PGMR: C. HAMILTON [ 04/05/79 ] SPC 1 * (DISTRIBUTED EXECUTIVE) IS THE DS/1000 USER INTERFACE FOR * 'TRANSPORTABLE' CALLS TO EITHER THE LOCAL, OR REMOTE-NODE RTE SYSTEM. * * WILL ACCEPT ALL VALID REQUEST CODES FOR 'LOCAL' EXECUTION. * * FOR EXECUTION AT A REMOTE NODE, WILL ACCEPT REQUEST CODES: * 1, 2, 3, 6, 9, 10, 11, 12, 13, 23, 24, 25, <99> * ONLY * * * ** UNACCEPTABLE REQUESTS WILL BE REJECTED WITH A "DS06" ERROR! * * ** "IO01" IS RETURNED UPON DETECTION OF INCORRECT, MISSING, OR * TOO MANY (>9) PARAMETERS. * * ** "IO04" WILL BE RETURNED FOR BUFFER-ERROR SPECIFICATIONS: * 'Z-BIT(#12)' SET IN CONWD, REMOTE READ/WRITE BUFFER LENGTH * GREATER THAN 512 WORDS, INTERACTIVE WRITE LENGTH > READ LENGTH. * * ** "SC01" INDICATES A MISSING SCHEDULING PARAMETER. * * ** "SC05" INDICATES AN IMPROPER PROGRAM NAME SPECIFICATION. * * REQUEST CODES: 1,2,3,6,10,11,12,13,25,99 WILL BE TRANSMITTED TO THE REMOTE * NODE, VIA STREAM #5, TO BE PROCESSED BY . MASTER (THIS NODE), * AND SLAVE (REMOTE NODE) TIMEOUTS, ESTABLISHED WITH , WILL BE * USED TO PROCESS THESE REQUESTS. REQUEST CODES: 9,23,24 WILL BE * TRANSMITTED TO THE REMOTE NODE, VIA STREAM #3, TO BE PROCESSED BY * . A LONG MASTER TIMEOUT (APPROX. 20 MIN.) WILL BE ALLOWED, * IN ORDER TO PROVIDE SUjFFICIENT TIME FOR SCHEDULE-WITH-WAIT REQUESTS. * * CALLING SEQUENCE: CALL DEXEC(NODE,P1,P2,P3,P4,P5,P6,P7,P8,P9) * * RETURN (X&Y INTACT) : - NORMAL COMPLETION, IF REQUEST CODE SIGN =0 * CONTAIN 'EXEC' RETURN INFORMATION * * : ERROR DETECTED: ABORT & PRINT MESSAGE, IF RC#15 =0 * * : - FOR DETECTED ERRORS, IF RC#15 =1 * CONTAIN ASCII ERROR CODES * * : - FOR NORMAL COMPLETION, IF RC#15 =1 * CONTAIN 'EXEC' RETURN INFORMATION * * NODE - SPECIFIES CALL-EXECUTION LOCATION: LOCAL=-1, REMOTE= 0 TO 32767 * [ CALL WILL ALSO EXECUTE, LOCALLY, IF THE 'LOCAL' NODE IS USED ] * * P1 TO P9 - NORMAL 'EXEC' CALLING PARAMETERS (P1 = REQUEST CODE, ETC.) * * WILL ALLOW THE USER TO PERFORM A COMBINED, INTERACTIVE, * WRITE-READ OPERATION IN A SINGLE CALLING SEQUENCE. SUCH A REQUEST * WILL BE MOST USEFUL FOR EFFICIENTLY COMMUNICATING WITH A REMOTE * OPERATOR. TO SPECIFY AN INTERACTIVE WRITE-READ: REQUEST CODE =1, * CONWORD BIT#11 =1, P8 = WRITE BUFFER ADDRESS, AND P9 = WRITE * BUFFER LENGTH (<=READ BUFFER LENGTH). * * * * RCODE=99: PROGRAM STATUS; P2:PGM.NAME ADDR; P3: OPTIONAL STATUS ADDR. * RTN: #15=1: SHORT I.D.,#3-0: STATUS; =-1:ERROR; ALWAYS=0. SKP ENT DEXEC EXT .ENTR,$LIBR,$LIBX,EXEC,REIO EXT #NODE,D65AB,D65MS,PGMAD SUP DEXEC NOP DST SAVEA SAVE FOR RETURN-PARAMETER CHECKS. STX SAVEX SAVE REGISTER. STY SAVEY SAVE REGISTER. ERA,ALS MOVE TO SIGN BIT. SOC IF THE OVERFLOW BIT IS SET, INA THEN SET BIT #0, ALSO. STA SAVEO SAVE THE STATES OF & . LDA DEXEC GET THE RETURN POINTER. STA EXIT SAVE FOR '.ENTR' PROCESSING. LDX D12 CLA  SAX PRAMS-1 INITIALIZE PARAMETER AREA DSX JMP *-3 JMP GETPR GO TO OBTAIN PARAMETER ADDRESSES. SPC 1 CALEX JSB RQLEN,I LOCAL-EXECUTION CALL TO 'EXEC'/'REIO' PRAMS REP 10 PARAMETER ADDRESSES/LOCAL EXECUTION AREA NOP NOP NOP SEZ,RSS LOCAL EXECUTION: ANY ERRORS DETECTED? ISZ EXIT NO. ESTABLISH RETURN TO . STA IRBUF+4 SAVE , TEMPORARILY. JMP RSTEO GO TO RESTORE REGISTERS AND RETURN. SPC 1 EXIT NOP GETPR JSB .ENTR GET DIRECT ADDRESSES DEF PRAMS FOR THE USER-SPECIFIED PARAMETERS. LDA PRAMS+1 GET THE ADDRESS OF THE REQUEST CODE. SZA,RSS WAS THE PARAMETER PROVIDED? JMP ERR NOT PROVIDED, ERROR! LDB PRAMS+1,I GET THE REQUEST CODE. RBL,CLE,ERB REMOVE THE NO-ABORT BIT, AND SAVE IN STB ICODE & ICODE FOR MAPPING & POST PROCESSING. * LDA PRAMS,I GET THE DESTINATION CPA #NODE FOR US ? JMP LOCAL YES. GO TO LOCAL PROCESSING. INA,SZA,RSS IS IT AN ABSOLUTE LOCAL REFERENCE? JMP LOCAL YES. GO TO LOCAL PROCESSING. SKP * SPLOC LDX D15 NOT LOCAL--SET COUNT FOR REQUEST BUFFER. CLA,CCE =0: BUFFER INIT; =1: CONWORD PREP. SAX IRBUF-1 INITIALIZE REQUEST BUFFER DSX JMP *-3 * STA WRLEN SET THE 'NO DATA' STA RDLEN DEFAULT CONDITIONS. * ERA SET THE 'ERROR-RETURN' FLAG FOR STA CONWD THE CALLING SEQUENCE. * LDA PRAMS,I GET THE DESTINATION STA IRBUF+3 SAVE IT IN THE REQUEST * LDA D5 GET THE STREAM TYPE STA IRBUF SET IT IN THE REQUEST * LDA ICODE GET THE REQUEST CODE STA IRBUF+4 INITIALIZE WORD #5 OF REQUEST BUFFER. CPA D99 IF THE REQUEST IS FOR PROGRAM STATUS, JMP PGMST THEN PROCESS IT INDEPENDENTLY. SZA REQUEST CODE =0? ADA UPLIM NO. SEE IF IT'S WITHIN SSA,RSS THE RANGE: 0 < RC < 27 ? JMP ERR ERROR, OUT OF RANGE: RC=0, OR RC>26! LDA PRAMS+2 SZA,RSS WAS A THIRD PARAMETER SPECIFIED? JMP ERIO1 NO, ERROR! * * SELECT THE PRE-PROCESSOR ROUTINE, VIA MAPPED REQUEST CODE. * ADB SUBAD MAP ICODE IN PRE-PROCESS MENU JMP B,I GO DO IT [= THIRD PARAMETER ADDRESS] * SKP * PRE-PROCESSOR JUMP TABLE * SUBAD DEF SUBS-1,I SUBS DEF IC1/2 READ RC=01 DEF IC1/2 WRITE RC=02 DEF ICOD3 CONTROL RC=03 DEF ERR * TRACK ALLOCATION RC=04 DEF ERR * TRACK RELEASE RC=05 DEF ICOD6 PROGRAM TERMINATION RC=06 DEF ERR * PROGRAM SUSPEND RC=07 DEF ERR * SEGMENT LOAD RC=08 DEF SCHW SCHEDULE W/WAIT RC=09 DEF ICD10 SCHEDULE W/O WAIT RC=10 DEF ICD11 TIME RC=11 DEF ICD12 TIME SCHEDULE RC=12 DEF ICD13 I/O STATUS RC=13 DEF ERR * GET STRING RC=14 DEF ERR * GLOBAL TRACK ALLOCATE RC=15 DEF ERR * GLOBAL TRACK RELEASE RC=16 DEF ERR * CLASS READ RC=17 DEF ERR * CLASS WRITE RC=18 DEF ERR * CLASS CONTROL RC=19 DEF ERR * CLASS WRITE/READ RC=20 DEF ERR * CLASS GET RC=21 DEF ERR * SWAP CONTROL RC=22 DEF SCHW QUEUE-SCHEDULE W/WAIT RC=23 DEF SCHW QUEUE-SCHEDULE W/O WAIT RC=24 DEF PARST PARTITION STATUS RC=25 DEF ERR * MEMORY STATUS (RTE-IV) RC=26 * UPLIM ABS SUBAD-* REQUEST CODE LIMIT-VALUE:-(MAX.RCODE +1) HED DEXEC: PRE-PROCESSORS * (C) HEWLETT-PACKARD CO. 1980 * IC1/2 LDA PRAMS+2,I GET CONTROL WORD RC=1,2 STA IRBUF+5 SET IN REQUEST ALF,SLA DOUBLE-BUFFER REQUEST (BIT#12 =1)? JMP ERIO4 YES--ERROR FOR REMOTE REQUESTS! * LDA PRAMS+3 GET BUFFER ADDRESS SZA,RSS WAS IT SUPPLIED? JMP ERIO1 NO BUFFER, ERROR! STA BUFA SET IT IN CALL TO D65MS * LDB PRAMS+4 GET THE BUFFER-LENGTH ADDRESS. SZB,RSS WAS IT SUPPLIED? JMP ERIO1 NO BUFFER LENGTH PROVIDED, ERROR! JSB LENCK GO VERIFY & GET BUFFER WORD COUNT. LDB ICODE GET THE REQUEST CODE. SLB IF THIS IS A READ(1) REQUEST, STA RDLEN THEN CONFIGURE READ LENGTH FOR ; SLB,RSS ELSE, IF THIS IS A WRITE(2) REQUEST, STA WRLEN THEN CONFIGURE 'WRLEN' FOR . * LDA PRAMS+4,I GET LENGTH AGAIN STA IRBUF+6 SAVE IN REQUEST * LDB PRAMS+5 GET ADDR OF 1ST OPT. PARAM SZB,RSS SPECIFIED ? JMP SRQLN NO, SHORT REQUEST * LDA PRAMS+5,I GET FIRST OPTIONAL PARAMETER STA IRBUF+7 CLA PREPARE FOR MISSING PARAMETER. LDA PRAMS+6,I GET SECOND OPTIONAL PARAMETER STA IRBUF+8 * LDB IRBUF+5 GET THE USER'S CONTROL WORD. BLF POSITION WRITE-READ BIT(#11) TO SIGN. SSB,RSS IF THIS IS A WRITE-READ REQUEST: SKIP; JMP NOMOV ELSE, NO ADDITIONAL PROCESSING NEEDED. * LDA RDLEN FORCE ADEQUATE S.A.M TO BE # STA WRLEN ALLOCATED AT RECEIVING NODE. # * LDB PRAMS+6 GET ADDRESS FOR WRITE-BUFFER LENGTH. JSB LENCK GO VERIFY & GET 'WRITE' WORD COUNT. STA LENCK SAVE THE WORD-MOVE LENGTH, TEMPORARILY.  CMA,INA,SZA,RSS NEGATE THE COUNT, & IF =0, JMP NOMOV NO NEED TO MOVE THE 'WRITE' BUFFER. * ADA RDLEN IF THE WRITE LENGTH SSA IS GREATER THAN THE 'READ' LENGTH, JMP ERIO4 THEN THE REQUEST IS INVALID! * LDA PRAMS+5 GET THE 'WRITE' BUFFER ADDRESS LDB PRAMS+3 AND THE 'READ' BUFFER ADDRESS. CPA B IF THEY ARE THE SAME, THEN THE JMP NOMOV 'WRITE' DATA NEED NOT BE MOVED; ELSE, MVW LENCK MOVE 'WRITE' DATA TO 'READ' BUFFER. * LDA CONWD GET THE CONTROL WORD. ARS SET THE LONG TIMEOUT BIT(#14). STA CONWD RESTORE CONWD [140000B]. * NOMOV LDA D9 SET REQUEST LENGTH JMP SETLN WE ARE ALL SET SPC 3 ICOD3 LDA A,I GET THE CONTROL WORD RC=03 STA IRBUF+5 SET IT IN THE REQUEST CLA LDA PRAMS+3,I GET OPTIONAL PARAMETER STA IRBUF+6 SET IT IN THE REQUEST SRQLN LDA D7 GO TO ESTABLISH A JMP SETLN REQUEST LENGTH = 7 WORDS. SPC 3 ICOD6 LDB PRAMS+9 IF MORE THAN EIGHT PARAMETERS RC=06 SZB,RSS WERE PASSED, OR IF THE CPB PRAMS+3 'INUM' PARAMETER WAS NOT PASSED, JMP ERIO1 THEN THE CALL IS INCORRECT! * SPC 3 PGMST LDA PRAMS+2 PROGRAM STATUS SHARES SCHED CODE. RC=99 * ICD10 JSB NAMP GO TO PROCESS THE PROGRAM NAME. RC=10 * LDX DM7 BUILD LOOP COUNTER LOOP3 LAX PRAMS+10 GET PARAMETER ADDRESS SZA,RSS IS IT THERE? JMP DON10 NO-EXIT LDA A,I YES, GET ITS VALUE SAX IRBUF+15 STORE INTO REQUEST ISY ADVANCE THE PARAMETER COUNT. ISX PROCESSING STRING-LENGTH PARAMETER? JMP LOOP3 NO, CONTINUE LDB PRAMS+9 YES. GET THE STRING-LENGTH ADDRESS. JSB LENCK GO TO CHECK THE STRING-BUFFER LENGTH. STA WRLEN CONFIGURE WRITE LENGTH FOR . LDB PRAMS+8 w GET THE STRING BUFFER ADDRESS. STB BUFA CONFIGURE 'D65MS' TO PASS DATA. * DON10 CYA GET THE PARAMETER COUNT JMP SETLN GO TO ESTABLISH REQUEST LENGTH. SPC 2 ICD11 LDA D13 GO TO ESTABLISH A RC=11 JMP SETLN REQUEST/REPLY LENGTH =13 WORDS. * SKP SPC 2 ICD12 JSB NAMP GO TO PROCESS THE PROGRAM NAME. RC=12 * LDX D3 SET A LOOP COUNTER CLA LDA PRAMS+5,I GET 6TH PARAMETER SSA JMP LOOP1 ADX D3 ABSOLUTE TIME, MORE PARAMETERS * LOOP1 LAX PRAMS+2 GET A PARAMETER ADDRESS SZA,RSS JMP ERSC1 ABSENT, ERROR LDA A,I GET THE PARAMETER SAX IRBUF+7 SET IT IN THE REQUEST IRBF7 EQU *-1 [ DEF IRBUF+7 ] ISY ADVANCE THE PARAMETER COUNT DSX ALL DONE ? JMP LOOP1 NO, CONTINUE * CYA GET THE PARAMETER COUNT. JMP SETLN READY TO SEND * SPC 2 PARST EQU * PARTITION STATUS RC=25 * ICD13 LDA A,I GET CONTROL WORD/PARTITION NUMBER. RC=13 STA IRBUF+5 SET IT IN THE REQUEST * LDA PRAMS+3 DO THEY HAVE ANY ROOM ? SZA,RSS JMP ERIO1 NO, GET OUT! * LDB ICODE GET THE REQUEST CODE. CPB D25 IF THIS IS A PARTITION-STATUS REQUEST, CLB,RSS THEN SKIP TO CHECK FOR ENOUGH PRAMS; JMP IC13X ELSE, OTHER PARAMETERS ARE OPTIONAL. * CPB PRAMS+5 USER PREPARED TO ACCEPT 3 PARAMETERS? JMP ERIO1 NO. THE CALL IS INCORRECT! * IC13X LDA D10 SET THE LENGTH OF THE REQUEST/REPLY. JMP SETLN * SPC 2 SCHW LDB D3 SET THE STREAM-TYPE RC=9/23/24 STB IRBUF FOR THE SCHEDULE-WITH-WAIT MONITOR. RBR,RBR MODIFY THE CONTROL WORD FOR STB CONWD WRITE & LONG TIMEOUT (140000B). JMP ICD10 PROCESS ALL PARAMETERS. SKP * CfOMMON PRE-PROCESSING SUBROUTINES * LENCK NOP BUFFER LENGTH PROCESSING. LDB B,I GET THE BUFFER LENGTH. SSB,RSS WORDS OR -BYTES? JMP WORDS POSITIVE WORDS. BRS NEGATIVE BYTES--CONVERT TO -WORDS. CMB,INB MAKE THAT +WORDS WORDS LDA B SAVE +WORDS IN FOR RETURN. ADB DM513 CHECK FOR VALIDITY OF LENGTH SSB,RSS JMP ERIO4 >512, TOO MUCH * JMP LENCK,I RETURN. * SPC 1 NAMP NOP CHECK AND MOVE PROGRAM NAME. LDB A,I IF THE FIRST TWO CHARACTERS SZB,RSS ARE NULLS, THEN JMP ERSC5 THE CALL IS INCORRECT! * LDB NAMA GET POINTER TO NAME, IN REQUEST MVW D3 MOVE THE NAME TO THE REQUEST LDY D8 INITIALIZE THE PARAMETER COUNTER. JMP NAMP,I RETURN * SKP * SEND THE REMOTE EXEC REQUEST VIA "D65MS" AND AWAIT REPLY * SETLN STA RQLEN ESTABLISH REQUEST LENGTH FOR . * JSB D65MS CALL MASTER REQUEST INTERFACE ROUTINE DEF *+8 DEF CONWD CONTROL WORD DEF IRBUF REQUEST BUFFER DEF RQLEN REQUEST LENGTH BUFA DEF * CONFIGURED DATA BUFFER ADDRESS--IF ANY. DEF WRLEN WRITE DATA LENGTH -- IF ANY DEF RDLEN READ DATA LENGTH -- IF ANY DEF D15 MAXIMUM REPLY LENGTH EXPECTED =15 WORDS. JMP ERROR * ERROR DETECTED BY "D65MS"--REPORT IT * LDB ICODE IF THE REQUEST CODE WAS FOR A: CPB D11 - TIME REQUEST, THEN THE JMP IPD11 TIME VALUES MUST BE POST-PROCESSED; CPB D13 - DEVICE-STATUS REQUEST, THEN THE DEVICE JMP IPD13 PARAMETERS NEED POST-PROCESSING; CPB D25 - PARTITION-STATUS REQUEST, THEN THE JMP IPD13 PARTITION PARAMETERS NEED PROCESSING; CPB D99 - PROGRAM-STATUS REQUEST, THEN CHECK THE JMP IPD13 STATUS PARAMETER FOR POST-PROCESSING. * SKP * DyDEXEC POST-PROCESSING: MOVE DATA TO REPLY BUFFER & CHECK FOR ERRORS. * IPOST LDA IRBUF+6 SSA ANY ERROR ? JMP ERROR YES LDA PRAMS+1,I GET ICODE SSA WAS THE NO ABORT BIT SET ? ISZ EXIT YES PUSH RETURN ADDRESS * LDB ICODE GET THE REQUEST CODE. CPB D9 SCHEDULE WITH WAIT? CCA,RSS YES. SET VALUE FOR PARAMETER CHECK. CPB D23 QUEUE SCHEDULE WITH WAIT? CCA,RSS YES. SET VALUE FOR PARAMETER CHECK. JMP ATEND NO. PARAMETER PROCESSING NOT REQUIRED. * LDB SAVEB GET CALLER'S ORIGINAL CONTENTS. CPA IRBUF+5 IF RETURNED PARAMETERS, THEN JMP MVPRM GO TO MOVE PARAMETERS TO I.D. SEGMENT. JMP ATEND+1 IGNORE FROM REPLY BUFFER. * MVPRM LDA IRBF7 GET ADDRESS OF RETURNED PARAMETERS. LDB XTEMP GET ADDRESS OF I.D. SEG. TEMP AREA. JSB $LIBR GAIN ACCESS TO SYSTEM AREA. NOP MVW D5 MOVE PARAMETERS TO CALLER'S I.D. SEG. LDB XTEMP POINT CALLER'S TO PARAMETERS. JSB $LIBX RESTORE PROTECTION DEF *+1 AND RETURN TO DEF ATEND+1 COMPLETE THE PROCESSING. * ATEND LDB IRBUF+5 GET FROM THE REPLY BUFFER. LDX SAVEX RESTORE THE ORIGINAL CONTENTS LDY SAVEY OF BOTH THE & REGISTERS. RSTEO LDA SAVEO GET ORIGINAL STATES FOR & . CLO INITIALIZE OVERFLOW TO CLEAR STATE. SLA,ELA RESTORE , AND IF WAS SET, STO THEN RESTORE IT, ALSO. LDA IRBUF+4 SET FOR RETURN TO CALLER. JMP EXIT,I RETURN TO CALLER SKP IPD11 LDA IRBF7 GET ADDRESS OF THE TIME VALUES. LDB PRAMS+2 GET USER'S BUFFER ADDRESS MVW D5 PASS 5 WORDS TO THE USER LDB IRBUF+12 GET THE CURRENT 'YEAR'. STB PRAMS+3,I PASS THE YEAR (OPTIONALLY) JMP IPOST FINISH THE JOB SPC 1 IPD13 LDA IRBUF+7 GET THE FIRST RETURN-PARAMETER. STA PRAMS+3,I PASS: EQT5/STARTING PAGE/PROG. STATUS CPB D99 IF THE REQUEST WAS FOR PROGRAM STATUS, JMP IPOST THE POST-PROCESSING IS COMPLETE; * LDB IRBUF+8 ELSE, GET THE NEXT RETURN-PARAMETER. STB PRAMS+4,I RC=13: OPTIONAL EQT4; RC=25: NO. PAGES. LDB IRBUF+9 RC=13: OPTIONAL LU STATUS & SUB. CHAN; STB PRAMS+5,I ELSE, IF RC=25: PARTITION STATUS. JMP IPOST GO FINISH SPC 2 * DEXEC ERROR ROUTINES. * ERIO1 LDB "01" INCORRECT,MISSING,OR TOO MANY PARAMETERS JMP GETIO ERIO4 LDB "04" IMPROPER BUFFER SPECIFICATION. GETIO LDA "IO" JMP ERRS ERROR: "IO0X". ERSC1 LDB "01" MISSING SCHEDULEING PARAMETER. JMP GETSC ERSC5 LDB "05" INCORRECT PROGRAM NAME. GETSC LDA "SC" JMP ERRS ERROR: "SC0X" SPC 2 ERR DLD DS06 IMPROPER REQUEST: "DS06". ERRS DST IRBUF+4 ERROR CODE INTO REQ.BUFR ERRA EQU *-1 ERROR MESAGE ADDRESS [DEF IRBUF+4]. SPC 2 ERROR LDA PRAMS+1,I GET ICODE SSA NO ABORT BIT SET ? JMP ATEND YES, IT IS * CCA ADA DEXEC WE HAVE THE ADDRESS OF THE JSB LDB ERRA GET ADDRESS OF THE ERROR MESSAGE JSB D65AB WE DO NOT COME BACK FROM THIS CALL * * "01" ASC 1,01 "04" ASC 1,04 "05" ASC 1,05 "IO" ASC 1,IO "SC" ASC 1,SC DS06 ASC 1,DS06 * HED DEXEC: LOCAL PROCESSING * (C) HEWLETT-PACKARD CO. 1980 LOCAL CPB D99 IF THIS IS A PROGRAM STATUS REQUEST, JMP LOCST THEN PROCESS IT INDEPENDENTLY. CPB D1 IF THIS IS A READ REQUEST, JMP *+2 THEN SKIP FOR FURTHER CHECKING; JMP LCHEK ELSE, CONTINUE LOCAL PROCESSING. LDA PRAMS+2,I GET THE CONWORD. ALF IF THE INTERACTIVE BIT(#11) SSA IS SET, THEN THE REQUEST MUST BE JMP SPLOC PASSED TO FOR PROCESSING. * LCHEK LDB GETPR+1 GET ADDRESS OF DoEF'S FOR CALL. LDX DM10 UP TO 9 PARAMETERS; MORE = ERROR; LOCL INB ADVANCE THE RETURN POINTER. LAX PRAMS+11 GET A PARAMETER ADDRESS SZA,RSS PRESENT ? JMP LOC1 NO ISX MORE THAN 10 PARAMETERS PASSED? JMP LOCL NO. CONTINUE CHECKING. JMP ERIO1 YES. TOO MANY--BUFFER MAY BE DESTROYED! * LOC1 STB PRAMS SET THE "DEF RETURN" DLD CCERS GET ERROR-DETECTION INSTRUCTIONS. DST PRAMS,I INSERT AT RETURN LOCATIONS. LDB ICODE GET REQUEST CODE. LDA EXECX GET "EXEC" ADDRESS ADB DM3 SSB,RSS IS IT READ OR WRITE? JMP LOCLN NO, DO "EXEC" CALL LDB PRAMS+5 SZB,RSS OPT.PARAMETERS SPECIFIED? LDA REIOX NO, OK TO USE REIO! LOCLN STA RQLEN SAVE ADDR FOR MP CHECK LDX SAVEX RESTORE THE REGISTER, DLD SAVEA AND THE REGISTERS, JMP CALEX AND GO EXECUTE THE CALL. * LOCST JSB PGMAD GET THE CURRENT STATUS DEF *+2 FOR THE USER-SPECIFIED DEF PRAMS+2,I PROGRAM NAME. SZA DOES THE PROGRAM EXIST? JMP GETST YES. GO TO PROCESS THE STATUS. CCA NO. SET =-1 FOR ERROR INDICATION. STA PRAMS+3,I RETURN ERROR TO USER'S PARAM.--IF ANY. JMP ERXIT TAKE THE ERROR EXIT. * GETST LDA B GET THE PROGRAM'S STATUS WORD. AND D15 ISOLATE THE STATUS BITS(#3-0), AND RAL,ERA SET SHORT I.D. BIT(#15)--IF TRUE. STA PRAMS+3,I RETURN IT TO CALLER'S PARAMETER--IF ANY. LDB PRAMS+1,I GET THE CALLER'S REQUEST CODE. CLE,SSB IF THE NO-ABORT BIT(#15) IS SET, ISZ EXIT THEN SET RETURN POINTER TO , ERXIT CLB CLEAR --IT CONTAINS NO DATA, LDX SAVEX RESTORE THE REGISTER, & RETURN JMP EXIT,I STATUS IN (OR -1:ERROR); =0. HED DEXEC: CONSTANTS AND STORAGE * (C) HEWLETT-PACKARD CO.HFB 1980 * * A EQU 0 B EQU 1 XTEMP EQU 1721B ADDRESS OF I.D. SEGMENT TEMP AREA. * SAVEA NOP SAVEB NOP SAVEO NOP SAVEX NOP SAVEY NOP * * * * MAINTAIN ORDER OF NEXT TWO INSTRUCTIONS * * * * CCERS CCE,RSS CLE * IRBUF BSS 15 DM513 DEC -513 DM10 DEC -10 DM7 DEC -7 DM3 DEC -3 D1 DEC 1 D3 DEC 3 D5 DEC 5 D7 DEC 7 D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D15 DEC 15 D23 DEC 23 D25 DEC 25 D99 DEC 99 RQLEN NOP ICODE NOP WRLEN NOP RDLEN NOP NAMA DEF IRBUF+5 EXECX DEF EXEC REIOX DEF REIO CONWD NOP * END GH ) 91740-18039 2001 S C0122 &RFMST              H0101 ASMB,C,Q HED RFMST: 91740-16039 REV 2001 (C) HEWLETT-PACKARD C0. 1980 NAM RFMST,7 91740-16039 REV 2001 791024 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * NAME: RFMST * SOURCE: 91740-18039 * RELOC: 91740-16039 * PGMR: DAN GIBBONS * * * MODIFIED BY: * *************************************************************** SPC 3 ENT DAPOS,DCLOS,DCONT,DCRET,DLOCF ENT DNAME,DOPEN,DPOSN,DPURG,DREAD ENT DSTAT,DWIND,DWRIT EXT .ENTR,D65MS * SUP SKP * * THIS PROGRAM SUPPORTS ALL REMOTE FILE ACCESS (RFA) MASTER CALLS * IN THE DS/1000 SYSTEM. BELOW ARE THE VALID CALLING SEQUENCES, WITH * OPTIONAL PARAMETERS INDICATED BY PARENTHESES: []. OPTIONAL PARAMETER * "ERLOC" WHEN SPECIFIED WILL CONTAIN THE NODAL ADDRESS AT WHICH AN * ERROR OCCURRED (IF ANY). THE PARAMETER "ICR" IN THE "DCRET","DNAME", * "DOPEN", AND "DPURG" CALLS IS A 2 WORD ARRAY WITH THE FIRST WORD EQUAL * TO THE REQUIRED CARTRIDGE LABEL AND THE SECOND WORD HAVING THE FILE'S * NODAL ADDRESS (DEFAULT IS 0,-1). ALL OTHER PARAMETERS HAVE THE * CONVENTIONAL FMP MEANINGS. * * * 1. CALL DAPOS(IDCB,IERR,IREC[,IRB,IOFF,ERLOC]) * SETS ABSOLUTE RECORD POSITION OF FILE TO VALUE OF "IREC" * * 2. CALL DCLOS(IDCB,IERR[,ITRUN,ERLOC]) * CLOSES DCB AND OPTIONALLY TRUNCATES BASED ON "ITRUN". * * 3. CALL DCONT(IDCB,IERR,ICON1[,ICON2,ERLOC]) * PERFORMS RTE I/O CONTROL REQUEST FOR TYPE 0 (NON-DISC) FILES. d * * 4. CALL DCRET(IDCB,IERR,NAME,ISIZE,ITYPE[,ISECU,ICR,ERLOC]) * CREATES THE NAMED FILE WITH THE SPEDIFIED NUMBER OF BLOCKS. * THE FILE IS LEFT OPEN EXCLUSIVELY TO THE CALLER. * * 5. CALL DLOCF(IDCB,IERR,IREC[,IRB,IOFF,JSEC,JLU,JTY,JREC,ERLOC]) * FORMATS AND RETURNS LOCATION AND STATUS INFORMATION FOR * THE DCB. * * 6. CALL DNAME(IDCB,IERR,NAME,NNAME[,ISECU,ICR,ERLOC]) * RENAMES THE SPECIFIED FILE * * 7. CALL DOPEN(IDCB,IERR,NAME[,IOPTN,ISECU,ICR,ERLOC]) * OPENS THE NAMED FILE * * 8. CALL DPOSN(IDCB,IERR,NUR[,IR,ERLOC]) * REPOSITIONS FILE * * 9. CALL DPURG(IDCB,IERR,NAME[,ISECU,ICR,ERLOC]) * CLOSES THE DCB AND PURGES THE FILE AND ALL ITS EXTENTS * * 10. CALL DREAD(IDCB,IERR,IBUF,IL[,LEN,NUM,ERLOC]) * READS THE NEXT RECORD INTO THE USER'S BUFFER * * 11. CALL DSTAT(ISTAT,IERR,IDEST[,ERLOC]) * RETURNS INFORMATION ON ALL MOUNTED CARTRIDGE LABELS * AT THE NODE SPECIFIED BY "IDEST" * * 12. CALL DWIND(IDCB,IERR[,ERLOC]) * REWINDS TYPE 0 FILES, OR SETS DISC FILE POSITION TO THE * FIRST RECORD * * 13. CALL DWRIT(IDCB,IERR,IBUF,IL[,NUM,ERLOC]) * WRITES THE SPECIFIED BUFFER TO THE FILE * SKP SPC 3 * * DAPOS PERFORMS A REMOTE FMGR "APOSN" CALL * DAPOS NOP JSB $PREP DO REQUEST SET-UP CONWD OCT 100000 FUNCTION CODE = 0 * JSB $VER3 GET & VERIFY 3RD PARAMETER * STB REQST+8 SAVE IREC IN THE REQST * LDB PRAMS+4,I GET OPTIONAL IOFF LDA PRAMS+3,I GET THE OPTIONAL IRB * DAPUR DST REQST+9 STORE INTO REQUEST BUFFER * JSB $MS65 DO D65MS CALL DEC 11 REQUEST LENGTH * LDA PRAMS+5 JMP $POST DO REQUEST WRAP-UP SKP * * DCLOS PERFORMS A REMOTE FMGR "CLOSE" CALL * DCLOS NOP JSB $PREP PERFORM PRE-PROCESSING OCT 100001 FUNCTION COD;E = 1 * LDA PRAMS+2,I GET THE OPTIONAL ITRUN STA REQST+8 * JSB $MS65 DO D65MS CALL DEC 9 REQUEST LENGTH * JMP DSX WRAP-UP AND EXIT SKP * * DCONT PERFORMS A REMOTE FMGR "FCONT" CALL * DCONT NOP JSB $PREP DO REQUEST PRE-PROCESSING OCT 100002 FUNCTION CODE= 2 * * BELOW CODE IS COMMON TO DCONT AND DPOSN DCOPS JSB $VER3 GET & VERIFY 3RD PARAMETER ADDR STB REQST+8 SAVE ICON1 (OR NUR) IN REQUEST * LDB PRAMS+3,I GET OPTIONAL ICON2/ IR STB REQST+9 * JSB $MS65 DO D65MS CALL DEC 10 REQUEST LENGTH * LDA PRAMS+4 JMP $POST WRAP-UP AND EXIT SKP * * DCRET PERFORMS A REMOTE FMGR "CREAT" CALL * DCRET NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING K3 DEC 3 FUNCTION CODE = 3 * STB REQST+9 SET THE ID SEGMENT ADDRESS STB PRAMS,I IN THE REQST AND IN THE DCB * CPA PRAMS+4 TYPE ADDRESS PROVIDED? JMP PRERR NO, PARAMETER ERROR LDB PRAMS+4,I GET TYPE STB REQST+13 SAVE IN REQST * LDA PRAMS+5,I GET OPTIONAL ISECU STA REQST+10 * DLD PRAMS+3,I GET ISIZE (2 WORD PARAMETER) NNAMA EQU *+1 DST REQST+11 SAVE IN REQUEST * LDA PRAMS+6 GET ADDRESS OF ICR JSB $ICR SET-UP CR/NODE & MOVE FILE NAME * LDA PRAMS FINISH ADA K3 BUILDING STB 0,I THE DCB (STORE NODE) * JSB $MS65 DO D65MS CALL K14 DEC 14 REQUEST LENGTH = 14 * LDA PRAMS+7 JMP DOPNX WRAP-UP AND EXIT SKP * * DLOCF PERFORMS A REMOTE FMGR "LOCF" CALL * DLOCF NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100004 FUNCTION CODE = 4 * JSB $VER3 GET & VERIFY 3RD PARAMETER ADDRESS * JSB $MS65 DO D65MS CALL DEC 8 REQUEST LENGTH * LDX N7 SET A COUNTER LOOP1 LBX REQST+14 GET !A RETURNED VALUE LAX PRAMS+9 GET RETURN ADDRESS STB 0,I PASS VALUE BACK ISX ALL DONE ? JMP LOOP1 NO, CONTINUE. * LDA PRAMS+9 JMP $POST WRAP-UP AND EXIT SKP * * DNAME PERFORMS A REMOTE FMGR "NAMF" CALL * DNAME NOP JSB $PREP PERFORM PRE-PROCESSING K5 DEC 5 FUNCTION CODE = 5 * JMP DNOPN DO LOGIC COMMON TO DOPEN * DNNAM LDA PRAMS+3 GET ADDRESS OF NNAME SZA,RSS JMP PRERR NOT PROVIDED LDB NNAMA MVW K3 MOVE NEW NAME TO REQST * JSB $MS65 DO D65MS CALL DEC 14 REQUEST LENGTH * JMP DRX WRAP-UP AND EXIT SKP * * DOPEN PERFORMS A REMOTE FMGR "OPEN" CALL * DOPEN NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING K6 DEC 6 FUNCTION CODE = 6 * STB PRAMS,I SET ID SEG ADDR IN DCB * DNOPN STB REQST+9 SET ID SEG ADDR IN REQUEST * LDB PRAMS+4,I GET OPTIONAL ISECU STB REQST+10 SAVE IN REQST * LDB PRAMS+3,I GET OPTIONAL ITRUN STB REQST+11 * LDA PRAMS+5 GET ADDRESS OF ICR JSB $ICR SET-UP CR/NODE & MOVE FILE NAME * LDA REQST+4 CPA K5 DOING "DNAME"? JMP DNNAM YES * LDA PRAMS FINISH ADA K3 BUILDING STB 0,I THE DCB. * JSB $MS65 DO D65MS CALL DEC 12 REQUEST LENGTH * LDA PRAMS+6 * DOPNX LDX PRAMS X= ADDR OF USERS 4 WORD DCB LDB REQST+7 GET RFAMD ENTRY # SBX 1 STORE IN 2ND WORD OF DCB JMP $POST WRAP-UP AND EXIT SKP * * DPOSN PERFORMS A REMOTE FMGR "POSNT" CALL * DPOSN NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100007 FUNCTION CODE = 7 * JMP DCOPS REST IS IN COMMON WITH DCONT SKP * * DPURG PERFORMS A REMOTE FMGR "PURGE" CALL * DPURG NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING Ń DEC 8 FUNCTION CODE = 8 * LDA PRAMS+4 GET ADDRESS OF ICR JSB $ICR SET-UP CR/NODE & MOVE FILE NAME * CLA LDB PRAMS+3,I GET OPTIONAL ISECU LDA XEQT GET ID SEGMENT ADDRESS * JMP DAPUR REST IS IN COMMON WITH DAPOS SKP * * DREAD PERFORMS A REMOTE FMGR "READF" CALL * DREAD NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100011 FUNCTION CODE = 9 * LDB PRAMS+5,I GET THE OPTIONAL NUM * LDA PRAMS+3,I GET IL STA REQST+8 SAVE IT IN THE REQST STA RDLEN AND FOR THE "MS" CALL * JSB XDATA DO COMMON DREAD/DWRIT LOGIC * LDA PRAMS+4 LDB REQST+7 PASS OPTIONAL LEN STB 0,I IF REQUIRED BY THE USER * DRX LDA PRAMS+6 JMP $POST WRAP-UP AND EXIT SKP * * DSTAT PERFORMS A REMOTE FMGR "FSTAT" CALL * DSTAT NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING K10 DEC 10 FUNCTION CODE = 10 * JSB $VER3 GET & VERIFY THE 3RD PARAMETER ADDRESS STB REQST+3 STORE "IDEST" IN REQUEST LDA K125 STA RDLEN SET DATA READ LENGTH = 125 * JSB $MS65 DO D65MS CALL DEC 7 * DSX LDA PRAMS+3 JMP $POST WRAP-UP AND EXIT SKP * * DWIND PERFORMS A REMOTE FMGR "RWNDF" CALL * DWIND NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100013 FUNCTION CODE = 11 * JSB $MS65 DO D65MS CALL DEC 8 * LDA PRAMS+2 JMP $POST WRAP-UP AND EXIT SKP * * DWRIT PERFORMS A REMOTE FMGR "WRITF" CALL * DWRIT NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100014 FUNCTION CODE = 12 * LDB PRAMS+4,I GET THE OPTIONAL NUM LDA PRAMS+3,I GET IL STA REQST+8 STORE IN REQUEST INA,SZA SKIP IF WRITE EOF LDA REQST+8 STA WRLEN SAVE WRITE LENGTH FOR MS CALL * JSB XDATA PERFORM COMMON DREAD/DWRIT LOGIC * LDA PRAMS+5 SKP * * COMMON REQUEST POST-PROCESSING LOGIC * $POST LDB REQST+6 GET THE ERROR LOCATION STB 0,I RETURN IT (OPTIONALLY) LDA REQST+5 ERROR CODE * $PST2 STA PRAMS+1,I RETURN ERROR CODE JMP CALL,I RETURN FROM MASTER RFA CALL SPC 4 * * THIS SUBROUTINE IS COMMON TO DREAD AND DWRIT * XDATA NOP STB REQST+9 SAVE THE OPTIONAL NUM SSA LENGTH NEGATIVE ? JMP PRERR YES, ILLEGAL ADA N513 IL > 512 ? SSA,RSS JMP PRERR YES, TOO MUCH * CLA CPA PRAMS+3 WAS "IL" SPECIFIED? JMP PRERR NO, PARAMETER ERROR * LDA PRAMS+2 GET BUFFER ADDRESS STA PRAMS SAVE FOR MS CALL SUBROUTINE * JSB $MS65 CALL D65MS DEC 10 * JMP XDATA,I RETURN SKP * * COMMON REQUEST PRE-PROCESSING ROUTINE FOR ALL MASTER RFA CALLS * $PREP NOP * CLB CLEAN OUT PARAMETER AREA LDX K10 LOOP SBX PRAMS-1 DSX JMP LOOP * LDB $PREP ADB N2 LDB 1,I GET RETURN POINT STB CALL SAVE JMP CALL+1 * PRAMS REP 10 NOP CALL NOP JSB .ENTR GET ADDRESSES OF PARAMETERS DEF PRAMS LDA K6 STA REQST SET RFA STREAM LDA PRAMS+1 SZA,RSS AT LEAST 2 PARAMETERS SPECIFIED? JMP CALL,I NO, RETURN NOW! LDA $PREP,I GET FUNCTION CODE/ MOVE DCB FLAG ISZ $PREP RAL,CLE,ERA CLEAR SIGN BIT STA REQST+4 SET FUNCTION CODE IN REQUEST SEZ,RSS DCB MOVE REQUIRED? JMP $PREX NO * * MOVE DCB TO THE REQUEST BUFFER * LDA PRAMS GET ADDR OF DCB LDB NAMA ADDR OF NAME FIELD IN REQUEST MVW K3 MOVE IT LDA 0,I GET DESTINATION FROM 4TH DCB WORD STA REQST+3 SET INTO REQUEST * RETURN WITH B= XEQT, A= 0 $PREX LDB XEQT CLA STA WRLEN INITIALI^NZE DATA STA RDLEN BUFFER LENGTHS FOR MS CALL JMP $PREP,I RETURN SKP 4 * * SUBROUTINE TO PERFORM D65MS CALL * $MS65 NOP JSB D65MS DEF *+8 DEF CONWD DEF REQST REQUEST BUFFER DEF $MS65,I DEF PRAMS,I DATA ADDRESS (IF ANY) DEF WRLEN DEF RDLEN DEF K14 MAX ALLOWED REPLY LENGTH * JMP COMER ERROR RETURN * $MSEX ISZ $MS65 JMP $MS65,I RETURN * * SUBROUTINE TO SET-UP CARTRIDGE REFERENCE AND NODAL ADDRESS * TO EITHER THE PASSED VALUES OR DEFAULTS * $ICR NOP STA $MS65 JSB $VER3 GET & VERIFY THE 3RD PARAMETER ADDRESS LDA PRAMS+2 GET ADDRESS OF NAME FIELD LDB NAMA GET ADDRESS OF NAME FIELD IN REQUEST MVW K3 MOVE IT LDA $MS65 RELOAD ICR ADDRESS CCB LOCAL NODE DESIGNATOR (DEFAULT) SZA,RSS **** TEMPORARY INSTRUCTIONS UNTIL **** JMP *+3 **** THE 21MX-XE IS FIXED! **** DLD 0,I GET ICR & NODE STA REQST+8 SAVE THE CARTRIDGE # STB REQST+3 SAVE THE DESTINATION NODE JMP $ICR,I RETURN SKP COMER LDA REQST+4 GET ALPHABETIC PART OF THE ERROR CPA "DS" IS IT "DS"? JMP DSERR YES LDA N999 NO, REPORT IT AS A -999 ERROR JMP NOTDS * DSERR LDA REQST+5 GET THE NUMERICAL PART OF THE ERROR AND B17 CODE AND DECODE IT CMA,INA NEGATE IT ADA N50 NOTDS LDB REQST+6 GET ERROR LOCATION ELB,CLE,ERB STRIP THE SIGN BIT NAMA EQU *+1 DST REQST+5 RESTORE THE ERROR LOCATION JMP $MSEX RETURN * "DS" ASC 1,DS N999 DEC -999 SPC 3 * * SUBROUTINE TO GET & VERIFY THE 3RD PARAMETER ADDRESS * $VER3 NOP CLA ALWAYS RETURN A=0 CPA PRAMS+2 3RD PARAMETER ADDRESS JMP PRERR NOT SPECIFIED, GIVE ERROR LDB PRAMS+2,I GET 3RD PARAMETER JMP $VER3,I & RETURN0.* SPC 2 * PRERR LDA N10 INSUFFICIENT PAAMETERS, GIVE -10 ERROR JMP $PST2 SKP * * CONSTANTS & VARIABLES * XEQT EQU 1717B * WRLEN NOP RDLEN NOP B17 OCT 17 K125 DEC 125 N2 DEC -2 N7 DEC -7 N10 DEC -10 N50 DEC -50 N513 DEC -513 * REQST REP 14 NOP SPC 3 END 0  & 91740-18040 1913 S C0122 DS/1000 MODULE: D65MS              H0101 IUASMB,R,L,C HED MASTER REQUEST INTERFACE * (C) HEWLETT-PACKARD CO. 1977* NAM D65MS,7 91740-16040 REV 1913 790104 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * ENT D65MS * * EXT .ENTR,#RSAX,#QRN,#WAIT,#NODE EXT EXEC,D65AB,D65GT,RNRQ,#TBRN EXT #GRPM,#BREJ,#NCNT,$OPSY * * NAME: D65MS * SOURCE: 91740-18040 * RELOC: 91740-16040 * PGMR: CHUCK WHELAN NOV 1976 ** ** HANDLING OF AN ILLEGAL REQUEST ERROR ALTERED [1-4-79] CEJ ** ALTERED TO ACCEPT TWO DATA BUFFER ADDRESSES [10-27-78] CEJ ** * * * D65MS CALLING SEQUENCE: * * JSB D65MS * DEF *+8 * DEF CONWD CONTROL WORD/ERROR-RETURN FLAG (BIT#15). * DEF RQBUF REQUEST BUFFER ADDRESS. * DEF RQLEN REQUEST LENGTH. * DEF DABUF OUTGOING DATA BUFFER ADDRESS * DEF DLWRT OUTGOING BUFFER LENGTH (OR ZERO) * DEF DLRED INCOMING BUFFER LENGTH (OR ZERO) * DEF RPLEN MAX REPLY LENGTH * DEF INBUF INCOMING DATA BUFFER ADDRESS * A & B HAVE ASCII ERROR CODE (ALSO IN REPLY 5 & 6) * A= RCVD REQ LEN, B= RCVD DATA LEN (OR 0) * * CONWD DESCRIPTION: * * BIT#15 - ERROR-RETURN FLAG * BIT#14 - NO TIMEOUT * SKP * * * D65MS PERFORMS THE FOLLOWING FUNCTIONS: * 1. RETURNS DS00 TO CALLER IF SYSTEM IS QUIESCENT. * 2. ALLOCATES A CLASS NUMBER FOR THE REQUEST. * 3. DOES A LOCK/WAIT ON THE "RES" TABLE ACCESS RN. * 4. CREATES A MASTER TCB * 5. CONVERTS DESTINATION NODE TO LU * 6. SENDS THE REQUEST(/DATA) * 6. CALLS "D65GT" TO AWAIT THE REPLY(/DATA) * 8. IF REPLY WAS A "QUIESCENT-REJECT", PUTS SELF IN TIME-LIST. * 9. IF ERROR FLAG IN 7TH REPLY WORD = 1, DOES ERROR RETURN. * 10. CLEARS THE MASTER CLASS # AND TCB. * 11. IF REPLY OK, GIVES RETURN WITH RCVD LENGTHS IN A & B. * * D65MS ERROR PROCESSING: * * 1. IF SIGN BIT(#15) OF CONWD PARAMETER IS SET, ASCII ERROR CODES * ARE SUPPLIED TO THE CALLER IN THE & REGISTERS, UPON * RETURN TO THE POINT IN THE CALLING SEQUENCE. * 2. IF THE SIGN BIT IS NOT SET, THEN THE ROUTINE 'D65AB' IS * CALLED TO ABORT THE CALLER'S PROGRAM, AFTER PRINTING AN * ERROR MESSAGE ON THE SYSTEM CONSOLE. THE MESSAGE PRINTED * WILL CONTAIN EITHER THE USER-SUPPLIED ERROR ADDRESS (ERRAD), * OR THE ADDRESS OF THE USER'S CALL TO 'D65MS'. * * D65MS ERROR MESSAGES: * * "DS00" - DS1 IS SHUT-DOWN! * "DS02" - DVA65 DETECTED ERROR (PARITY, ETC.) * "DS03" - ILLEGAL REPLY - SHORT PARMB. * "DS04" - LOGICAL UNIT INVALID OR NO CLCT ENTRY. * "DS05" - MASTER REQUEST TIMEOUT (COURTESY OF 'UPLIN'). * "DS06" - ILLEGAL REQUEST. * "DS07" - 'RES' TABLE-ACCESS ERROR. * "DS08" - REMOTE BUSY FAILURE - NO SAM, ETC * "IOXX" - \ * - RTE SYSTEM DETECTED ERRORS. * "RNXX" - / * SKP CONWD NOP CONTROL WORD ADDRESS. RQBUF NOP REQUEST BUFFER ADDRESS. RQLEN NOP REQUEST BUFFER LENGTH. DABUF NOP OUTGOING DATA BUFFER ADDRESS OR DUMMY PARAMETER. DLWRT NOP WRITE DATA LENGTH (OR ZERO) DLRED NOP READ DATA LENGTH (OR ZERO) RPLEN NOP MAX EXPECTED REPLY LENGTH INBUF NOP INCOMING DATA BUFFER ADDRESS OR DUMMY PARAMETER. SPC 2 D65MS NOP ENTRY/EXIT JSB .ENTR OBTAIN DIRECT ADDRESSES DEF CONWD FOR PARAMETERS & RETURN POINT. LDA RPLEN SZA,RSS FIRST 7 PARAMETERS PASSED? JMP ILRQ NO, GIVE ILLEGAL REQUEST * LDA INBUF YES, IF 8TH PARAMETER NOT GIVEN, LDB DABUF SET IT TO THE 4TH PARAMETER. SZA,RSS STB INBUF * LDB RQBUF ADB K4 ADDR OF REPLIES ERROR FIELD STB ERRAD SAVE FOR LATER RETRY CLA STA CLASN CLEAR CLASS # FOR ERROR CK * * CHECK FOR LOCAL SYSTEM SHUT-DOWN OR QUIESCENT STATUS. * CPA #GRPM IS THE DS/1000 SYSTEM SHUT-DOWN? JMP DOWN YES. GO TELL CALLER THE SAD NEWS. * * REQUESTS WILL BE FORCED TO WAIT HERE, IF LOCAL SYSTEM HAS BEEN QUIESCED. * JSB RNRQ GO TO RTE TO CHECK FOR SYSTEM QUIESCENCE. DEF *+4 DEF LCGW LOCK/CLEAR/WAIT/NO-ABORT DEF #QRN CHECK SYSTEM-QUIESCENCE RESOURCE NUMBER. DEF TEMP DUMMY PARAMETER. JMP PASER * RTE ERROR - PASS CODE TO CALLER * * LDA #QRN IF QUIESCENT STATE HAS BEEN CHANGED SZA,RSS TO SYSTEM SHUT-DOWN STATE, JMP DOWN THEN TELL THE CALLER THE SAD NEWS. * * REQUEST A CLASS NUMBER ALLOCATION FROM RTE. * LDA BIT13 INITIALIZE CLASS NUMBER STA CLASN FOR NON-RELEASE USAGE. JSB EXEC GO TO RTE FOR A CLASS NO.--WAIT FOR IT. DEF *+5 DEF CLS19 CLASS CONTROL(QUICK ALLOCATE)-NO ABORT. DEF ZERO LU ='BIT BUCKET' FOR ALLOCATION. DEF ZERO DUMMY PARAMETER FOR ALLOCATION. DEF CLASN CLASS NUMBER STORAGE ADDRESS. JMP PASER * RTE ERROR: MESSAGE IN & * * JSB EXEC GO TO RTE TO COMPLETE DEF *+5 PREVIOUS ALLOCATION REQUEST. DEF CLS21 CLASS GET--NO ABORT. DEF CLASN CLASS NUMBER STORAGE ADDRESS. DEF ZERO DUMMY PARAMETER. DEF ZERO DUMMY PARAMETER. JMP PASER * RTE ERROR: MESSAGE IN & * * * WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE IN 'RES'; ADD NEW ENTRY. * JSB RNRQ GO TO RTE TO CHECK THE TABLE-ACCESS RN. DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT FOR IT/NO ABORT. DEF #T8BRN TABLE-ACCESS SPACE-AVAILABLE RN. DEF TEMP DUMMY PARAMETER. JMP PASER * RTE ERROR - PASS ERROR CODE TO USER * * LDA CONWD,I RAL,ELA BIT 14 HAD TIMEOUT SUPPRESS FLAG LDA CLASN RAL,ERA MOVE FLAG TO BIT15 OF CLASS WORD STA TEMP * LDB RQBUF REQUEST BUFFER ADDR ADB K2 POINT TO 3RD REQUEST WORD LDA #NODE LOCAL NODE NUMBER STA 1,I SET ORIGINATOR NODE (US) INB LDA 1,I GET DESTINATION NODE CPA N1 ALWAYS LOCAL? LDA #NODE YES! GET LOCAL NODE # STA 1,I SET DESTINATION FIELD STB NODAD SAVE ADDR OF DESTINATION NODE * JSB #RSAX GO TO "RES" ACCESS ROUTINE DEF *+5 DEF K2 ADD MASTER TCB DEF TEMP PASS CLASS # & TIMEOUT FLAG DEF XEQT PASS ID SEG ADDR NODAD NOP PASS DESTINATION NODE SSB ANY ERRORS? JMP RESER * ERROR: "DS07" (NOT LIKELY) LDB RQBUF INB POINT TO 2ND WORD OF REQUEST BUFFER STA 1,I STORE SEQ # IN 2ND WORD STA SEQ# SAVE LOCALLY * * VERIFY THAT 6 < REQUEST LENGTH < 32 * LDB "03" LDA RQLEN,I GET REQUEST LENGTH ADA N7 MUST BE AT LEAST 7 SSA JMP GETDS GIVE DS03 IF <7 ADA N25 SSA,RSS JMP GETDS GIVE DS03 IF > 31 * * CONVERT DESTINATION NODE TO LU * LDA NODAD,I SSA ABSOLUTE DESTINATION CODE ? (NEIGHBOR) JMP ABS YES, GET LU AND RETURN DLD #NCNT NO, GET ADDR & SIZE OF NRV TABLE STA TEMP SAVE COUNTER * LOOP JSB LODWD GET A CPU # INB POINT TO CORRESPONDING LU CPA NODAD,I IS IT THE GOOD ONE ? JMP LUFND YES INB POINT TO NEXT NODE IN TABLE ISZ TEMP END OF TABLE ? JMP LOOP NO, CONTINUE * LDB "04" YES, CPU # ERROR JMNP GETDS * ABS CMA,INA MAKE IT >0 JMP LUOK * LUFND JSB LODWD FETCH LU AND B77 ISOLATE IT * * NOW SEND THE REQUEST(/DATA) * LUOK LDB #GRPM GRPM'S CLASS NUMBER STB CLASS IOR CONWX SET "Z" BIT AND "WRITE" INDICATOR STA TEMP * LDA RQBUF,I GET STREAM WORD AND B77 CLEAR THE RETRY COUNTERS IOR #BREJ INITIALIZE TO REQUIRED VALUE STA RQBUF,I * JSB EXEC DO CLASS WRITE/READ DEF *+8 DEF CLS20 NO ABORT DEF TEMP CONTROL WORD DEF DABUF,I DEF DLWRT,I DATA BUFFER LENGTH OR ZERO DEF RQBUF,I REQUEST ADDRESS DEF RQLEN,I REQUEST LENGTH DEF CLASS JMP PASER DO ERROR RETURN SKP * * DO A CLASS GET TO WAIT FOR A REPLY FOR THIS TRANSACTION. * JSB D65GT GET REPLY DEF *+6 DEF CLASN SPECIFY MASTER CLASS NO.--NO RELEASE. DEF RQBUF,I SPECIFY REPLY ADDRESS. DEF RPLEN,I SPECIFY MAXIMUM REPLY LENGTH. DEF INBUF,I DATA BUFFER ADDR DEF DLRED,I DATA LENGTH OR ZERO JMP PASER * GET ERROR: GO TO PROCESS * DST REG SAVE REGS FOR RETURN * * CHECK FOR PROPER REPLY. * SZA,RSS CHECK FOR ZERO REPLY LENGTH. JMP MTOER * ZERO LENGTH: GO PROCESS TIMEOUT ERROR * LDB RQBUF GET REPLY BUFFER ADDRESS. ADB K5 POINT TO 6TH/7TH WORDS OF REPLY DLD 1,I GET THEM * * CHECK THAT REPLY DOESN'T CONTAIN ERROR SSB,RSS IS SIGN BIT SET? JMP GOODX NO, NO ERROR CPA "08" YES, WAS IT REMOTE BUSY? JMP SUSPD YES, GO SUSPEND AWHILE JMP ERPLY ELSE DO ERROR EXIT * GOODX JSB CLNUP GO TO CLEAN UP BEFORE EXITING. STA RPLEN CLEAR PARAMETERS FOR CHECK STA INBUF ON NEXT ENTRY. * * RETURN TO USER AT NORMAL RETURN POINT. * DLD REG = RCVD REQUEST & DATA LENGTHS ISZ D65MS )? SET EXIT POINTER FOR NORMAL RETURN. JMP D65MS,I RETURN TO THE CALLER. SKP * SUSPD CLB CPB #WAIT DO WE DELAY OR RETURN ERROR DS08? JMP ERPLY NO WAIT SPEC'D, GIVE DS08 TO CALLER * DELAY AWHILE THAN TRY AGAIN JSB CLNUP RETURN MASTER CLASS # & TCB * JSB EXEC GO TO THE RTE 'EXEC' DEF *+6 IN ORDER TO PLACE DEF K12 INTO THE TIME-LIST, DEF ZERO THIS PROGRAM, FOR A PERIOD DEF K2 OF DELAY IN SECONDS, DEF ZERO (ONCE-ONLY) AS DETERMINED BY A DEF #WAIT NEGATIVE VALUE <#WAIT> IN 'RES'. * JMP RETRY NOW, RE-SUBMIT THE REQUEST. SKP * * SUBROUTINE TO RELEASE THE MASTER CLASS & CLEAR THE MASTER TCB * CLNUP NOP ENTRY/EXIT LDA CLASN GET THE CLASS NUMBER. CCE,SZA,RSS IF CLASS NEVER ASSIGNED, JMP CLNUP,I RETURN NOW. * RAL,ERA INCLUDE THE NO-WAIT BIT(#15), STA CLASN AND SAVE FOR RELEASE. CREPT CCA SET THE RELEASE RE-TRY SWITCH STA TEMP TO =-1. * CLRTN JSB EXEC GO TO RTE TO RELEASE CLASS NUMBER. DEF *+5 DEF CLS21 SPECIFY CLASS GET/NO ABORT DEF CLASN SPECIFY MASTER CLASS/RELEASE/NO WAIT. DEF ZERO DUMMY BUFFER ADDRESS. DEF ZERO DUMMY BUFFER LENGTH. RSS IGNORE ERRORS. * ISZ TEMP RELEASE PROCESSING COMPLETED? JMP CLRES YES. GO TO CLEAR THE 'RES' ENTRY. INA,SZA NO, ALL PENDING REQS CLEARED? JMP CREPT NO. CONTINUE TO CLEAR REQUESTS. * LDA CLASN GET THE CLASS NUMBER AGAIN. AND CLMSK EXCLUDE THE NO-DE-ALLOCATION BIT(#13). STA CLASN RESTORE THE MODIFIED CLASS WORD. JMP CLRTN RETURN FOR FINAL DE-ALLOCATION. * CLRES JSB #RSAX GO TO 'RES' ACCESS ROUTINE. DEF *+3 DEF K6 CLEAR MASTER TCB DEF SEQ# PASS SEQ # CLA a JMP CLNUP,I RETURN. SPC 2 * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE RAR,SLA,ERA SKIP IF NON-DMS JMP *+3 DMS. GO EXECUTE XLA LDA 1,I NON-DMS. PICK UP SAM WORD JMP LODWD,I RETURN XLA 1,I CROSS-LOAD SAM WORD JMP LODWD,I RETURN SKP * * ERROR PROCESSING SECTION. * DOWN LDB "00" SYSTEM IS SHUT-DOWN: "DS00". JMP GETDS MTOER LDB "05" MASTER REQUEST TIMEOUT: "DS05". JMP GETDS ILRQ LDB "06" ILLEGAL REQUEST: "DS06". JMP GETDS RESER LDB "07" 'RES' LIST-ACCESS ERROR: "DS07". * GETDS LDA "DS" GET FIRST HALF OF ERROR MESSAGE "DS". * PASER DST ERRAD,I SAVE ERROR MESSAGE IN REPLY * ERPLY JSB CLNUP GO TO CLEAN UP BEFORE EXITING. STA RPLEN CLEAR FOR NEXT PARAM CHECK STA INBUF * LDA D65MS ADA N8 COMPUTE THE ERROR ADDRESS LDB CONWD,I GET ERROR-RETURN FLAG. ELB POSITION TO FOR TESTING. LDB ERRAD POINTS TO ERROR MESSAGE SEZ,RSS ABORT OR RETURN TO CALLER? JSB D65AB ABORT! -- NO RETURN. ERRAD EQU *+1 DLD TEMP GET ERROR CODES AND RETURN TO JMP D65MS,I THE CALLER AT ERROR-RETURN POINT. * SKP * * CONSTANTS AND STORAGE. * BIT13 OCT 20000 TEMP NOP TEMPORARY STORAGE. CLASN NOP CLASS NUMBER STORAGE. CLASS NOP SEQ# NOP B77 OCT 77 CLMSK OCT 117777 CLASS NUMBER MASK. CONWX OCT 10100 CLS19 OCT 100023 CLASS CONTROL--NO ABORT. CLS20 OCT 100024 CLASS WRITE/READ--NO ABORT CLS21 OCT 100025 CLASS GET--NO ABORT. LCGW OCT 40006 GLOBAL RN LOCK/CLEAR/WAIT/NO-ABORT. LGW OCT 40002 GLOBAL RN LOCK/WAIT/NO ABORT. K2 DEC 2 K4 DEC 4 K5 DEC 5 K6 DEC 6 K12 DEC 12 N1 DEC -1 N7 DEC -7 N8 DEC -8 N25 DEC -25 REG OCT 0,0 RETURN REGISTER INFORMATION. E0.*XEQT EQU 1717B USER'S I.D. SEGMENT ADDRESS. ZERO OCT 0 "00" ASC 1,00 "03" ASC 1,03 "04" ASC 1,04 "05" ASC 1,05 "06" ASC 1,06 "07" ASC 1,07 "08" ASC 1,08 "DS" ASC 1,DS * SIZE BSS 0 * END P0  ' 91740-18041 1740 S C0122 DS/1000 MODULE: D65AB              H0101 eASMB,R,L,C HED * ABORT MESSAGE ROUTINE * (C) HEWLETT-PACKARD CO. 1977 * NAM D65AB,7 91740-16041 REV 1740 761220 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ******************************************************* * *D65AB SUBROUTINE TO HANDLE ABORT MESSAGES. * *SOURCE PART # 91740-18041 REV.A * *REL PART # 91740-16041 REV.A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 8-22-74 * *MODIFIED BY: CHUCK WHELAN * *DATE MODIFIED: DEC 1976 * ********************************************************* * * DEFINE A AND B REG * A EQU 0 B EQU 1 SPC 1 * * DEFINE EXTERNALS * EXT EXEC,CNUMO SPC 1 * * DEFINE ENTRY POINT * ENT D65AB SPC 1 SUP SUPPRESS EXTENDED LISTING. SPC 1 * * SUBROUTINE TO HANDLE ABORT MESSAGES. * * B REG= ADDRESS OF 4 CHARACTER (ASCII) ERROR MESSAGE * A REG= ADDRESS TO BE INCORPORATED INTO ERROR MESSAGE * * CALLING SEQUENCE * JSB D65AB ABORT MESSAGE...DVR ERROR * D65AB WILL NOT RETURN CONTROL TO USER * * D65AB NOP STA ERCD SAVE ABORT ADDRESS DLD B,I GET ERROR MESSAGE DST MSG SAVE ERROR MESSAGE * JSB CNUMO CONVERT ERROR ADDRESS TO OCTAL DEF *+3 DEF ERCD DEF ERCD * LDB XEQT GET ADDRESS OF ID SEGMENT ADB D12 POINT TO NAME ADDRESS (WORD #13). LDA B,I GET THE FIRST TWO NAME CHARACTERS. STA PNAM SAVE IN ERROR MESSAGE, STA AMSG "   AND IN ABORT MESSAGE. INB POINT TO I.D. SEGMENT WORD #14. LDA B,I GET CHARACTERS THREE AND FOUR. STA PNAM+1 SAVE IN ERROR MESSAGE, STA AMSG+1 AND IN ABORT MESSAGE. INB POINT TO I.D. SEGMENT WORD #15. LDA B,I GET CHARACTER FIVE & PROGRAM TYPE. AND UBYTE RETAIN ONLY THE NAME-CHARACTER, IOR B40 AND INSERT A FOLLOWING BLANK. STA PNAM+2 SAVE IN ERROR MESSAGE, STA AMSG+2 AND IN ABORT MESSAGE. * JSB EXEC SEND 2-LINE ERROR/ABORT MESSAGE DEF *+5 DEF B2 DEF B1 TO SYSTEM CONSOLE (LU #1) DEF MSG DEF D19 * JSB EXEC TERMINATION REQUEST DEF *+2 NO RETURN DEF B6 FROM TERMINATION CALL. SPC 1 MSG ASC 3,XXXX: PNAM ASC 3, ERCD ASC 3, OCT 6412 CR/LF ASC 1,* AMSG ASC 8,XXXXX ABORTED! * B1 OCT 1 B2 OCT 2 B6 OCT 6 B40 OCT 40 D12 DEC 12 D19 DEC 19 UBYTE OCT 177400 XEQT EQU 1717B CURRENT I.D. SEGMENT ADDRESS. SPC 1 END uo  " 91740-18042 1740 S C0222 DS/1000 MODULE: POPEN              H0102 9ASMB,R,L,C,N *USE 'ASMB,R,N' FOR DS/1000 ONLY, AND 'ASMB,R,Z' FOR DS/1000 & DS/3000 IFN NAM POPEN,7 91740-16042 REV 1740 770714 XIF IFZ NAM POPEN,7 91741-16016 REV 1740 770714 XIF UNL IFN HED POPEN (DS/1000) 91740-16042 * (C) HEWLETT-PACKARD CO 1977 XIF IFZ HED POPEN (DS/1000 & DS/3000) 91741-16016 * (C) HEWLETT-PACKARD CO 1977 XIF LST * * IFN OPTION * NAME: POPEN * SOURCE: 91740-18042 * RELOC: 91740-16042 * PRGMR: CHUCK WHELAN * * IFZ OPTION * NAME: POPEN * SOURCE: 91741-18016 * RELOC: 91741-16016 * PRGMR: CHUCK WHELAN & JIM HARTSELL * SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT POPEN,PREAD,PWRIT,PCONT,PCLOS EXT D65MS EXT .ENTR IFZ EXT #LU3K EXT D3KMS,D$INI,D$STW,D$ASC EXT D$RQB,D$NWD,D$ZRO,D$WDC,D$SMP * D EQU 256 MAX # DATA WORDS/BLOCK (DS/3000). XIF SUP * SPC 3 * THIS PROGRAM PERFORMS ALL MASTER PROGRAM TO PROGRAM FUNCTOIONS * IN THE DISTRIBUTED SYSTEM. ON EACH REQUEST IT DOES THE FOLLOWING: * * 1. MOVES PCB FROM USER AREA TO REQUEST (EXCEPT POPEN) * 2. VERIFIES SUFFICIENT PARAMETERS PASSED IN CALL * 3. MOVES 20 WORD TAG FIELD INTO REQUEST (EXCEPT PCLOS) * 4. SETS STREAM, FUNCTION, AND ORIGINATOR NODE INTO REQUEST * 5. CALLS "D65MS" TO SEND REQUEST (& DATA) AND GET REPLY * 6. IF NO SYSTEM ERROR, MOVES TAG FIELD INTO USER AREA (EXCEPT PCLOS) * 7. EXAMINES STATUS & GIVES "ACEPT", "REJCT", OR ERROR CODE BACK TO CALLER SKP IPCB NOP IERR NOP INAM NOP INODE NOP ITAG NOP IFZ ENAM NOP DS/3000: ENTRY NAME NOP CONTROL INFORMATION. NOP LOADING OPTIONS. BUFSZ NOP MAX DATA RECORD LENGTH XIF SPC 3 POPEN NOP * * MASTER REQUESTS FOR POPEN COME HERE * JSB .ENTR PICK UP THE USER PARAMETERS DEF IPCB * LDB IPCB USER'S PCB ADDRESS LDA INODE,I DESTINATION NODE ADB K3 4TH WORD OF PCB HAS NODE STA 1,I PUT IT THERE STA $DEST SAVE IT * LDB POPEN SET UP ERROR RETURN LDA IERR JSB BLDRQ SET UP BASIC REQST DEF ITAG DEC 1 FCN = 1 IFZ JMP QOPEN DO POPEN TO 3000 XIF * LDA INAM ADDR OF NAME FIELD LDB RPCBA ADDR OF PCB IN REQ BUFFER MVW K3 MOVE NAME INTO PCB FIELD * LDA IPCB * NODAT LDB DUMAD USE DUMMY AS DATA POINTER STB DBUF CLB STB WRLEN SET WRITE DATA LENGTH = 0 * * * THIS CODE IS USED IN COMMON BY ALL P TO P CALLS * MAIN STB RDLEN SET READ DATA LENGTH STA PCBAD SAVE PCB ADDRESS * LDA K4 STA $STRM SET P TO P STREAM IN REQ * * THE CALL TO D65MS WILL: * 1) GET AN I/O CLASS * 2) INSERT SEQ # & ORIGIN NODE * 3) BUILD MASTER TCB * 4) SEND REQUEST (& DATA) * 5) CALL "D65GT" TO AWAIT AND GET REPLY * 6) RETURN REPLY (& DATA) * 7) RETURN CONTROL JSB D65MS ISSUE REQUEST CALL DEF *+8 DEF CONWD DEF IRBUF REQUEST BUFFER DEF IRBFL REQUEST LENGTH DBUF NOP DATA BUFFER ADDRESS DEF WRLEN DATA WRITE LENGTH DEF RDLEN DATA READ LENGTH DEF IRBFL MAX EXPECTED REPLY LENGTH * JMP ERR ERROR DETECTED LDA $FUNC FUNCTION CODE CPA K5 IS THIS A PCLOS? JMP NOMOV YES, WE'RE DONE * RPCBA EQU *+1 DLD $PCB GET PCB PCBAD EQU *+1 DST * SAVE 1ST 2 PCB WORDS IN USER AREA * LDA RTAGA ADDR OF TAG FIELD IN REQUEST LDB TAGAD ADDR OF TAG FIELD IN USER AREA MVW K20 MOVE 20 WORDS TO USER TAG FIELD * NOMOV LDA $ERR SZA WAS ERROR DETECTED? JMP EXIT YES, IERR SET LDB $FUNC SSB WAS REQUEST REJECTED? CLA,INA YES, SET REJECT IERR EXIT STA ERRAD,I RETURN IT TO CALLER CLB STB CLEAR,I CLEAR PARAM CHECK LOC JMP RTRN,I RETURN SKP * * MOVE PCB INTO REQUEST BUFFER MVPCB NOP LDB N2 ADB MVPCB POINT TO ADDR OF PCB ADDR LDB 1,I GET ADDR OF PCB ADDR LDA 1,I GET PCB ADDR LDB RPCBA GET ADDR OF PCB IN BUFFER MVW K2 MOVE 1ST TWO WORDS TO REQUEST INA POINT TO 4TH DCB WORD LDB 0,I GET DESTINATION NODE STB $DEST SAVE IT JMP MVPCB,I RETURN SPC 2 * * COMMON PARAMETER SET-UP AND TAG FIELD MOVE FOR ALL BUT "PCLOS" BLDRQ NOP STB RTRN RETURN ADDRESS FOR ALL STA ERRAD ADDR OF ERROR PARAMETER * DLD BLDRQ,I GET TAG ADDR ADDR, AND FUNC CODE STA CLEAR SAVE LAST PARAM ADDR LDA 0,I GET ADDR OF USER'S TAG FIELD SZA,RSS WAS LAST PARAM SPECIFIED JMP ERR2 TOO FEW PARAMETERS IN CALL STB $FUNC SET FUNCTION CODE IFZ LDB #LU3K GET DS/3000 LU CMB,INB,SZB,RSS NEGATE JMP *+3 NO 3000 CPB $DEST IS IT NEGATIVE LU OF 3000? JMP RQEX YES, PERFORM DS/3000 P-TO-P XIF LDB K31 REQUEST LENGTH STB IRBFL * STA TAGAD LDB RTAGA ADDR OF TAG FIELD IN REQUEST MVW K20 MOVE TAG FIELD INTO REQ IFZ ISZ BLDRQ XIF RQEX ISZ BLDRQ ISZ BLDRQ JMP BLDRQ,I ORETURN SPC 3 * ERROR PROCESSING SECTION ERR ADB NEG00 SUBTRACT ASCII "00" CPA "DS" IS IT A "DSXX" ERROR? SSB AND >= "00"? JMP ERR47 NO, GIVE -47 LDA 1 ADA N9 NUMERIC PART - 9 CMA,SSA SKIP IF DS00 - DS08 ERR47 LDA K11 MAKE A -47 ERROR ADA N58 A = -47 OR -50 THRU -58 JMP EXIT ERR2 LDA N40 JMP EXIT RETURN WITH IERR SKP * * READ REQUESTS * RIPCB NOP RIERR NOP RIBUF NOP RIL NOP RITAG NOP * PREAD NOP JSB .ENTR GET USER PARAMETERS DEF RIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST * LDB PREAD RETURN ADDRESS LDA RIERR JSB BLDRQ BASIC REQUEST PROCESSING DEF RITAG K2 DEC 2 IFZ JMP QREAD PERFORM PREAD TO 3000 XIF * LDA RIBUF SAVE BUFFER ADDRESS STA DBUF LDB RIL,I SAVE DATA LENGTH STB $DLEN * CLA STA WRLEN CLEAR WRITE DATA LENGTH LDA RIPCB PCB ADDRESS JMP MAIN NOW DO LINE COMM & RETURN SKP * * WRITE REQUESTS * PIPCB NOP PIERR NOP PIBUF NOP PIL NOP PITAG NOP * * PWRIT NOP PWRITE REQUESTS HERE JSB .ENTR PICK UP PARAMETERS DEF PIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDB PWRIT SET UP ERROR RETURN LDA PIERR JSB BLDRQ BUILD BASIC REQST DEF PITAG K3 DEC 3 IFZ JMP QWRIT PERFORM PWRIT TO 3000 XIF * LDA PIBUF GET DATA ADDRESS STA DBUF LDA PIL,I GET DATA LENGTH STA $DLEN STA WRLEN * LDA PIPCB CLB JMP MAIN NOW DO LINE COMM & RETURN SKP * * CONTROL REQUESTS * CIPCB NOP CIERR NOP CITAG NOP * * PCONT NOP JSB .ENTR GET PARAMETERS DEF CIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * i LDB PCONT SET UP RETURN ADDR LDA CIERR JSB BLDRQ BUILD BASIC REQST DEF CITAG K4 DEC 4 IFZ JMP QCONT PERFORM PCONT TO 3000 XIF * LDA CIPCB PCB ADDRESS JMP NODAT DO LINE COMM & RETURN SKP * * CLOSE REQUESTS * FIPCB NOP FIERR NOP * * RTRN EQU * PCLOS NOP JSB .ENTR GET PARAMETERS DEF FIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDA DFIEA STA CLEAR SAVE LAST PARAM ADDR LDA FIERR SZA,RSS ERROR ADDR SPECIFIED? JMP ERR2 NO, GIVE ERROR STA ERRAD SET ERROR ADDRESS IFZ LDA #LU3K GET 3000 LU CMA,INA,SZA,RSS NEGATE IT JMP *+3 JUMP IF NO 3000 LINK CPA $DEST WAS NEGATIVE LU OF 3000 SPECIFIED? JMP QCLOS YES, DO PCLOS TO 3000 XIF * LDA K11 STA IRBFL 11 WORD REQUEST LDA K5 STA $FUNC FUNCTION CODE = 5 * LDA FIPCB PCB ADDRESS JMP NODAT DO COMMUNICATION & RETURN SKP * * DATA AREA * IRBFL NOP WRLEN NOP RDLEN NOP K5 DEC 5 K11 DEC 11 K20 DEC 20 K31 DEC 31 N2 DEC -2 N9 DEC -9 N40 DEC -40 N58 DEC -58 NEG00 OCT 147720 "DS" ASC 1,DS CONWD OCT 100000 ERRAD NOP TAGAD NOP CLEAR NOP DFIEA DEF FIERR RTAGA DEF $TAG ADDR OF REQ TAG FIELD DUMAD DEF * * * DEFINE REQUEST IRBUF BSS 31 IFZ BSS 4 XIF $STRM EQU IRBUF $DEST EQU IRBUF+3 $ERR EQU IRBUF+5 $FUNC EQU IRBUF+7 $PCB EQU IRBUF+8 $DLEN EQU IRBUF+10 $TAG EQU IRBUF+11 IFN UNL XIF IFZ SKP * * GENERATE POPEN REQUEST FOR REMOTE DS/3000 COMPUTER. * QOPEN LDA ITAG STA TAGAD * LDA ITAG SZA,RSS JMP ERR2 ILLEGAL NUMBER OF PARAMETERS. * * BEGIN THE REQUEST BUFFER WITH SETUP OF 8-WORD FIXED * FORMAT FOR PTOPC, THEN "RFA " IN NEXT 2 WORDS. * 2 LDA IPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B21 POPEN STREAM = 21 OCTAL. JSB D$PTP SET UP 8 WORD FIXED FORMAT AREA. LDB D$RQB LDA B7 CHANGE POPEN MSG CLASS TO 7. STA B,I * LDA "RF" JSB D$STW STORE "RFA ". LDA "A" JSB D$STW * LDA B25 JSB D$STW FUNCTION CODE = 25 OCTAL. * LDA INAM MOVE PROGRAM NAME (UP TO 28 BYTES). LDB N14 (DELIMITER = BLANK) JSB D$ASC * INA (A) = TOTAL BYTES IN REQUEST. ARS NEED TO INSERT TRAILING BLANKS ADA N17 IN PROGRAM NAME FIELD? STA TEMP SSA,RSS JMP MVENT NO. * LOOP2 LDA BLNKS YES. ADD TRAILING BLANKS JSB D$STW TO FILL OUT 14-WORD FIELD. ISZ TEMP JMP LOOP2 * MVENT LDA ENAM MOVE ENTRY NAME (UP TO 8 BYTES). LDB N4 DELIMITER = BLANK. JSB D$ASC * INA (A) = TOTAL BYTES IN REQUEST. ARS ADA N21 NEED TO INSERT TRAILING BLANKS STA TEMP IN ENTRY NAME FIELD? SSA,RSS JMP MVTAG NO. * LOOP3 LDA BLNKS YES. ADD TRAILING BLANKS TO FILL JSB D$STW OUT 4-WORD FIELD. ISZ TEMP JMP LOOP3 * MVTAG LDA N20 MOVE TAG FIELD. JSB D$NWD * CLA MOVE 2 PARAMETERS. LDA ENAM+1,I JSB D$STW CLA LDA ENAM+2,I JSB D$STW CLA ZERO 3 WORDS. JSB D$STW CLA JSB D$STW CLA JSB D$STW LDA MAXSZ STORE MAX BLOCK SIZE (+WORDS). LDB BUFSZ GET USER'S VALUE IF SZB IT WAS SPECIFIED. LDA BUFSZ,I SZA SSA LDA MAXSZ JSB D$STW * * SET UP PARAMETER MASK AS FOLLOWS: * BIT 9 = PROGRAM NAME * BIT 8 = ENTRY NAME * BIT 7 = 0 * BIT 6 = CONTROL INFO * BIT 5 = LOADING OPTIONS * BIT 4 = 0 * BIT 3 = 0 * BIT 2 = 0 * BIT 1 = 0 * BIT 0 = 0 * LDA DPARM FWA PARAM ADDR LIST. STA TEMP LDA N5 COUNTER. STA CONTR CLA INITIALIZE PARAMETER MASK. * LOOP4 LDB TEMP,I GET ADDR OF NEXT PARAM. LDB B,I SZB IOR B1 SET BIT IF PARAM SPECIFIED. RAL MOVE IT OVER. ISZ TEMP ISZ CONTR JMP LOOP4 LOOP TILL DONE. ALF BITS 0-4 = 0. JSB D$STW * * REQUEST BUFFER READY. D3KMS WILL WRITE IT TO QUEX'S I/O * CLASS. USER WILL BE SUSPENDED UNTIL D3KMS'S CLASS GET * IS COMPLETED WHEN THE REPLY ARRIVES. * JSB D$WDC STORE WORD COUNT. CLA POPEN HAS A SINGLE REPLY. LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND WAIT FOR REPLY. * JSB PASSP RETURN ERROR CODE AND TAG FIELD. * LDA D$RQB RETURN PCB FROM REPLY. ADA K10 (CURRENTLY NOT USED - ALL ZEROES) STA TAGPR LDA N3 LDB IPCB JSB MOVE * LDA ERRAD,I JMP RTRN,I RETURN TO CALLER. * * DPARM DEF *+1 TABLE OF POPEN PARAMETER DEF INAM ADDRESSES FOR BIT MASK. DEF ENAM DEF B0 DEF ENAM+1 DEF ENAM+2 * SKP * * SUBROUTINE TO SEND AND/OR RECEIVE BUFFERS TO/FROM THE HP3000. * REMIO NOP IOR 1 STA CNWRD * JSB D3KMS DEF *+2 DEF CNWRD JMP ERR ERROR RETURN. * LDA D$RQB SAVE "FROM PROCESS #" AS ADA K4 "TO PROCESS #" FOR NEXT REQUEST. LDA A,I ALF,ALF AND B377 STA D$SMP * ISZ BLKCT BUMP PREAD/PWRIT BLOCK COUNTER. JMP REMIO,I EXIT. * * SUBROUTINE TO BUILD 8-WORD FIXED FORMAT AREA OF REQUEST. * * (A) = 1ST BYTE RIGHT JUSTIFED * (B) = STREAM TYPE. * D$PTP NOP STB TE.MP SAVE STREAM TYPE. LDA K4 STORE MESSAGE CLASS = 4. JSB D$STW STORE 1ST WORD IN REQUEST BUFFER. CLA CLEAR COMPUTER ID. JSB D$STW LDA TEMP STORE STREAM TYPE. JSB D$STW LDA N4 CLEAR NEXT 4 WORDS. JSB D$ZRO LDA N2 FORCE BYTE COUNTER TO CLEAR. JSB D$STW JMP D$PTP,I * * SUBROUTINE TO PASS RETURNED ERROR CODE AND TAG * FIELD TO THE USER PROGRAM. * PASSP NOP LDB D$RQB RETURN ERROR CODE. ADB K8 LDB B,I CLA MAP DS/3000 TO DS/1 ERROR CODES. CPB CG211 INA CCG & 211 = 1 (REJECT). CPB CL209 LDA N41 CCL & 209 = -41. CPB CL205 LDA N42 CCL & 205 = -42. CPB CG210 LDA N44 CCG & 210 = -44. CPB CL213 LDA N44 CCL & 213 = -44. STA ERRAD,I * LDB D$RQB ADB K13 RETURN TAG FIELD. STB TAGPR LDA N20 20 WORDS. LDB TAGAD JSB MOVE JMP PASSP,I SKP * * GENERATE PREAD REQUEST FOR REMOTE DS/3000 COMPUTER. * QREAD CLA CLEAR BLOCK COUNTER. STA BLKCT LDA RITAG STA TAGAD SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA RPRAM POINT TO ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B22 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP * CLA JSB D$STW * LDA RIL,I GET USER BUFFER LENGTH. SSA,RSS JMP *+4 CMA,INA INA CLE,ERA JSB D$STW STORE IN REQUEST BUFFER. * LDA RIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * JSB D$WDC SET WORD COUNT. * * SEND REQUEST TO THE 3000 AND WAIT FOR REPLIES. * LDA RIBUF SET ADDR OF USER DATA BUFFER. STA TBUF CLA z STA TCNT CLEAR RECEIVED BYTE COUNTER. INA SIGNAL FOR MULTIPLE REPLIES. * SN/RC LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND GET REPLIES. * LDA CNWRD WAS LAST CALL TO RELEASE CLASS ONLY? AND B377 CPA K4 JMP DONE YES. * LDA BLKCT IF FIRST REPLY, PASS ERROR CPA B1 CODE AND TAG TO USER. JSB PASSP * LDA D$RQB CHECK IF ANY DATA WAS RECEIVED. ADA B7 LDA A,I (A) = + BYTES. ADA N10 ADJUST FOR IERR & PCB. LDB BLKCT CPB B1 IF FIRST REPLY, ADJUST FOR TAG. ADA N40 SZA,RSS JMP DEALC NO DATA (COULD BE REJECT). * JSB RDMOV MOVE DATA TO USER BUFFER. * LDA D$RQB IS CONTINUATION BIT SET? ADA K2 LDA A,I RAL,RAL SSA JMP DMREP YES. DEALC LDA K4 NO. DE-ALLOCATE CLASS. JMP SN/RC * DMREP LDB D$RQB NO. SET UP "REPLY". LDA B,I STORE COUNT AND MSG CLASS. AND B377 IOR LB10 STA B,I ADB K2 LDA B,I CLEAR REPLY BIT. ELA,CLE,ERA STA B,I ADB K2 LDA B,I REVERSE PROCESS NUMBERS. ALF,ALF STA B,I ADB K3 CLA CLEAR BYTE COUNT. STA B,I * LDA K2 TELL D3KMS TO LOOK FOR MORE. JMP SN/RC GO GET NEXT DATA BLOCK. * DONE LDA ERRAD,I JMP RTRN,I RETURN TO USER. SPC 2 * * MOVE SUBROUTINE * MOVE NOP STA CONTR MOVE1 LDA TAGPR,I PICK UP NEXT WORD STA 1,I AND PUT IT AWAY INB ISZ TAGPR INCREMENT POINTERS ISZ CONTR JMP MOVE1 UNTIL DONE JMP MOVE,I SKP * * SUBROUTINE TO MOVE A BLOCK OF DATA FROM REPLY * BUFFER TO USER BUFFER (REMAINING BYTES UP TO MAX LEN). * EXIT WITH TCNT = TOTAL BYTES REMAINING. * RDMOV NOP (A) = + BYTES. SZA,RSS EXIT FOR JMP RDMOV,I 0-LEN DATA. LDB A ACCUMULATE LOG. ADB TCNT STB TCNT INA CLE,ERA (A) = + WORDS. CMA,INA STA TEMP NEG. # WORDS TO MOVE. LDB D$RQB ADB K13 GET PAST 3-WORD "PCB" AREA. LDA BLKCT IF THIS IS FIRST REPLY, CPA B1 ADB K20 ADJUST FOR TAG FIELD. STB RQPTR ADDR OF REPLY DATA. * LOOP LDA RQPTR,I MOVE WORD FROM REPLY STA TBUF,I TO USER BUFFER. ISZ RQPTR BUMP POINTERS. ISZ TBUF * ISZ TEMP JMP LOOP ELSE LOOP TILL DONE. JMP RDMOV,I REACHED LIMIT OF MAX WORDS. SKP * * GENERATE PWRIT REQUEST FOR REMOTE DS/3000 COMPUTER. * QWRIT CLA CLEAR BLOCK COUNTER. STA BLKCT LDA PITAG STA TAGAD * SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA PPRAM POINT TO ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B23 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP * CLA JSB D$STW * LDA PIBUF SET POINTER TO USER DATA. STA TBUF * LDA PIL,I GET USER BUFFER LENGTH. SSA,RSS JMP *+5 CMA,INA SLA INA RSS CLE,ELA BYTES (POSITIVE). STA TCNT TOTAL DATA BYTES TO SEND. CLE,ERA JSB D$STW STORE IN REQUEST BUFFER (TCOUNT). * LDA PIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * JSB D$WDC SET WORD COUNT. * JSB WRMOV MOVE 1ST BLOCK TO REQUEST BUFFER. LDA TCNT SZA,RSS IF ALL DATA MOVED, JMP SEND TELL D3KMS THERE IS A SINGLE REPLY. * LDB D$RQB CONTINUATION BLOCKS REQUIRED. ADB K2 LDA B,I IOR BIT13 SET CONTINUATION BIT IN STREAM WORD. STA B,I  CLA,INA TELL D3KMS THERE ARE MULT. BLOCKS. * * SEND REQUESTS TO THE 3000 AND GET THE REPLY. * SEND LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUESTS AND/OR GET REPLY. * LDB TCNT IF ALL DATA OUT, WE HAVE RECEIVED SZB THE REPLY. JMP MORE JSB PASSP RETURN ERROR CODE & TAG TO USER. LDA ERRAD,I JMP RTRN,I RETURN TO CALLER. * * MORE DATA... SHIP OUT THE NEXT BLOCK. * MORE LDB D$RQB CLEAR REPLY BIT. ADB K2 LDA B,I ELA,CLE,ERA STA B,I * JSB WRMOV MOVE NEXT CHUNK OF DATA. LDA K2 LDB TCNT SZB IF MORE DATA, KEEP CONT. BIT. JMP SEND CALL D3KMS WITH RCODE = 2. * LDB D$RQB THIS IS LAST BLOCK. ADB K2 LDA B,I AND NOT13 CLEAR CONTINUATION BIT. STA B,I LDA K3 TELL K3KMS THIS IS LAST BLOCK. JMP SEND SKP * SUBROUTINE TO STORE # BYTES LEFT TO SEND IN REQ * BUFFER AND MOVE NEXT BLOCK OF USER DATA (REMAINING * BYTES UP TO MAX). STORE ADJUSTED BYTE COUNTER (N) * IN REQUEST. ON EXIT, TCNT IS REMAINING # DATA * BYTES OR ZERO. * WRMOV NOP LDB D$RQB ADB B7 LDA B,I INITIALIZE BYTE COUNTER (N). STA BYTCT LDA TCNT # REMAINING DATA BYTES. SZA,RSS EXIT FOR JMP WRMOV,I 0-LEN DATA. LDB D$RQB * ADB K13 SET ADDR OF DATA IN RQBUF. LDA BLKCT SZA,RSS ADJUST FOR TAG FIELD ADB K20 IN FIRST REQUEST. STB RQPTR LDA RLSIZ STA TEMP SET MAX # DATA WORDS (NEG). * LOOP1 LDA TBUF,I MOVE DATA FROM USER TO REQUEST. STA RQPTR,I ISZ TBUF ISZ RQPTR ISZ BYTCT ADD 2 TO BYTE COUNTER (N). ISZ BYTCT LDA TCNT DECREMENT TOTAL DATA BYTES LEFT. ADA N2 STA TCNT CMA,INA NEGATE. SSA,RSS IF 0 OR 1, JMP AD2 J1 ALL USER DATA MOVED, ISZ TEMP JMP LOOP1 ELSE LOOP TILL DONE. JMP STBYT REACHED LIMIT OF MAX WORDS. * ADJ1 CMA,INA ADJUST BYTE COUNTER (N) ADA BYTCT STA BYTCT * STBYT LDA D$RQB STORE BYTE COUNT (N). ADA B7 LDB BYTCT STB A,I LDA TCNT IF TCNT = -1, MAKE IT 0. CPA N1 CLA STA TCNT JMP WRMOV,I RETURN. SKP * * GENERATE PCONT REQUEST FOR REMOTE DS/3000 COMPUTER. * QCONT LDA CITAG STA TAGAD * SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA CPRAM ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B24 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP LDA N2 CLEAR NEXT 2 WORDS. JSB D$ZRO * LDA CIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * JSB D$WDC SET WORD COUNT. * * SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY. * CLA SINGLE BLOCK. LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND GET REPLY. * JSB PASSP RETURN ERROR CODE & TAG FIELD. * LDA ERRAD,I JMP RTRN,I RETURN. SKP * * GENERATE PCLOS REQUEST FOR REMOTE DS/3000 COMPUTER. * QCLOS LDB D$RQB MOVE REQUEST TO D3KMS BUFFER. LDA BRKBF MVW K8 MOVE 8 WORDS * JSB D3KMS SEND BREAK REQ TO 3000, DEF *+2 AND GET THE REPLY. DEF BIT15 NOP * LDA FIERR ADDR OF 1ST PARAM (DUMMY). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B21 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP * LDB D$RQB CHANGE PCLOS MSG CLASS TO 7. LDA B7 STA B,I * LDA "RF" STORE "RFA ". JSB D$STW LDA "A" JSB D$STW LDA B26 STORE FCN CODE)NLH = 26 OCTAL. JSB D$STW * LDA FIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) * JSB D$WDC SET WORD COUNT. * * SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY. * CLA SINGLE BLOCK. LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND GET REPLY. * JSB PASSP RETURN ERROR CODE & TAG FIELD. * LDA ERRAD,I JMP RTRN,I RETURN. SKP * * MOVE PCB FROM USER ARRAY TO REQUEST BUFFER. * MVPC NOP STA TAGPR POINTER TO PCB. LDA N3 STA CONTR MVP1 LDA TAGPR,I JSB D$STW ISZ TAGPR ISZ CONTR JMP MVP1 JMP MVPC,I * * TEST WHETHER REQUEST FOR 3000 OR REMOTE RTE. * DS3K NOP (A) = ADDR OF USER PCB. ADA K3 BUMP TO LU WORD. STA TEMP LDA #LU3K GET LU OF 3000. INA LDB A,I CPB TEMP,I SAME AS LU IN USER PCB? RSS YES. EXIT VIA P+1. ISZ DS3K NO. EXIT VIA P+2. JMP DS3K,I SKP N* * CONSTANTS AND WORKING STORAGE. * B0 OCT 0 B1 OCT 1 B7 OCT 7 B21 OCT 21 B22 OCT 22 B23 OCT 23 B24 OCT 24 B25 OCT 25 B26 OCT 26 B377 OCT 377 LB10 OCT 4000 K8 DEC 8 K10 DEC 10 K13 DEC 13 N1 DEC -1 N3 DEC -3 N4 DEC -4 N5 DEC -5 N10 DEC -10 N14 DEC -14 N17 DEC -17 N20 DEC -20 N21 DEC -21 N41 DEC -41 N42 DEC -42 N44 DEC -44 CL205 OCT 040315 CL209 OCT 040321 CG210 OCT 000322 CG211 OCT 000323 CL213 OCT 040325 MAXSZ DEC 4096 MAXIMUM USER BUFFER SIZE. RLSIZ ABS -D MAXIMUM # DATA WORDS PER REQUEST. "RF" ASC 1,RF "A" ASC 1,A BIT13 OCT 20000 NOT13 OCT 157777 BLNKS ASC 1, RQPTR NOP BYTCT NOP IPRAM DEF ITAG RPRAM DEF RITAG PPRAM DEF PITAG CPRAM DEF CITAG CNWRD NOP BLKCT NOP TEMP BSS 2 TCNT NOP TBUF NOP * BRKBF DEF *+1 OCT 4006 OCT 0 OCT 22 OCT 0,0,0,0,0 A EQU 0 B EQU 1 TAGPR NOP CONTR NOP BIT15 EQU CONWD XIF * LST * SIZE EQU * * END S6 1 91740-18043 1740 S C0122 DS/1000 MODULE: MSTAT              H0101 8ASMB,L,R,C HED MSTAT: 91740-16043 REV 1740 (C) HEWLETT-PACKARD CO. 1977 NAM MSTAT,7 91740-16043 REV 1740 770425 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * MSTAT * * SOURCE PART # 91740-18043 * * REL PART # 91740-16043 * * WRITTEN BY CHUCK WHELAN * * DATE WRITTEN FEB 1977 * * MODIFIED BY * * DATE MODIFIED * *************************************************************** SPC 3 ENT FSTAT * EXT .ENTR,$CDIR * PRAM NOP FSTAT NOP JSB .ENTR DEF PRAM LDA $ADR GET ADDRESS OF RTE-M FILE DIRECTORY RSS LDA 0,I RAL,CLE,SLA,ERA RESOLVE INDIRECT JMP *-2 ADA N1 STA ENTAD SAVE ADDR OF ADDR OF DIR. END INA LDB PRAM GET ADDRESS OF CALLERS BUFFER MVNXT MVW K4 MOVE 4 WORD DIRECTORY ENTRY TO USERS BUFR CPA ENTAD,I END OF CARTRIDGE DIRECTORY? CLA,RSS YES JMP MVNXT NO, MOVE ANOTHER ENTRY STA 1,I SET NEXT BUF WORD = 0 FOR END JMP FSTAT,I RETURN * ENTAD NOP K4 DEC 4 N1 DEC -1 $ADR DEF $CDIR * * SIZE EQU * * END G $ 91740-18044 1740 S C0122 DS/1000 MODULE: DUMFM              H0101 ?ASMB,L,R,C HED DUMFM: 91740-16044 (C) HEWLETT-PACKARD CO. 1977 NAM DUMFM,7 91740-16044 REV 1740 770425 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * DUMFM * * SOURCE PART # 91740-18044 * * REL PART # 91740-16044 * * WRITTEN BY CHUCK WHELAN * * DATE WRITTEN FEB 1977 * * MODIFIED BY * * DATE MODIFIED * *************************************************************** SPC 3 ENT APOSN,CLOSE,CREAT,FCONT,LOCF,NAMF ENT OPEN,POSNT,POST,PURGE,READF,RWNDF,WRITF * EXT .ENTR * PRAMS REP 8 PARAMETER ADDRESSES NOP * DUMFM NOP JSB .ENTR PICK-UP PARAMETERS DEF PRAMS CCA INDICATE A DISC ERROR STA PRAMS+1,I SINCE NO FMP PRESENT JMP DUMFM,I RETURN * APOSN EQU DUMFM CLOSE EQU DUMFM CREAT EQU DUMFM FCONT EQU DUMFM LOCF EQU DUMFM NAMF EQU DUMFM OPEN EQU DUMFM POSNT EQU DUMFM POST EQU DUMFM PURGE EQU DUMFM READF EQU DUMFM RWNDF EQU DUMFM WRITF EQU DUMFM * SIZE EQU * * END j % 91740-18045 1740 S C0122 DS/1000 MODULE: RTMLG              H0101 njASMB,R,L,C * NAME: RTMLG * SOURCE: 91740-18045 * RELOC: 91740-16045 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM RTMLG,3,90 91740-16045 REV 1740 770912 * * * THIS IS THE MAIN OF THE SEGMENTED GENERATOR-LOADER. * ITS PURPOSE IS TO CLEAR SOME FLAGS, TO DETERMINE LAST * WORD OF AVAILABLE MEMORY (NEEDED FOR BUILDING LOADER * SYMBOL TABLE), AND TO LOAD IN SEGMENT 1 (INITIALIZATION * SEGMENT). * * EXTERNALS * * EXT FUT4,GENRT,GLWAM,GNFLG,GNSG1 EXT LDSEG,LDSG3,LWAMG,OPT.3,SEGFL * * DUMMY EXTERNALS TO FORCE LOAD LIBRARY MODULES * EXT RTMLC,$CON,DO#ON,RT.G1 * ENT DU#MY * * * RTMLG CLA STA GNSG1 WHERE RETURN FLAG STA LDSG3 WHICH ENTRY IN SEGMENT 3 STA GENRT INITIATOR FLAG STA GNFLG CONTINUATOR FLAG STA SEGFL LAST SEGMENT FLAG CLA,INA JSB GLWAM GET LAST WORD OF AVAILABLE MEMORY STA OPT.3 SAVE FOR FIXUP TABLE STA LWAMG ADA N3 STA FUT4 CLA STA OPT.3,I SET NUMBER OF FIXUPS TO ZERO LDA P12 JMP LDSEG LOAD IN SEGMENT 1 * N3 DEC -3 P12 DEC 12 * DU#MY NOP DUMMY ENTRY FOR SYS GEN END RTMLG i  & 91740-18046 1926 S C0122 RTML1 DS/1000 MODULE             H0101 cLASMB,R,L,C RTML1 * NAME: RTML1 RTE-M SEGMENTED GEN.-LOADER (SEGMENT 1) * SOURCE: 91740-18046 * RELOC: 91740-16046 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * * HED RTE-M SYSTEM GENERATOR-LOADER NAM RTML1,5 91740-16046 REV 1926 790426 * * * * EXTERNAL REFERENCE NAMES * EXT ABL1,ABL2,.ABR,ABREC,ABRT1,AFILE,AL EXT ATBUF,BPAG4,BPLOC,BU#ER EXT CFILE,CKS,CLBPL,CMDLU,COML,CONSL,CONSO EXT DCB1,DCB2,DCB3,DCB4,DCB5,DCB6,DCB7 EXT ECFIL,ECHO1,ECHOS,EFILE,EMSAM,ERACT EXT ERDVC,ER#OR,FL1OP,FRTRU,FT#ME,FUTA,FWABP EXT FWAC,FWAM,GE#NA,GREAD,ICR,IDCB,IERR# EXT INACT,IN#CK,IN#RR,INTER,IOPTN,ISECU,JLU,KONSO EXT LBF10,LBUF5,LBUFA,LDGEN,LFILE,LGER2,LINTP EXT LISTO,LNKDR,LOCFS EXT LST,LSTA,LWABP,LWAC EXT MAPON,MEMRY,MLOCC,NAMR.,NBUF6,NBUFA EXT NBUFT,NXTC2,OFILE,OPEN1,OPFLA EXT OPFLB,OPFLC,OPFLD,OPFLE,OPFLF,OPFLG,OPFLH EXT OPNLU,OTFIL,OUTON,PNAMA,QBUFA EXT QQCNT,QQPTR,RBTA,RBTO,RT.G1,RTLG1,SCP EXT SERFG,SNAPS,SP#CE,STFER,TRUNC,TYPRO EXT UEXFL,UNDEF,WERR1,WRTBT,?XFER,XNAMA * EXT $CON,DTTY,$OPSY EXT DU#MY * EXT CREAT,OPEN * EXT PNZQZ * * BUFER EQU BU#ER ERROR EQU ER#OR FTIME EQU FT#ME GETNA EQU GE#NA IERR EQU IERR# INDCK EQU IN#CK INERR EQU IN#RR SPACE EQU SP#CE LOCC EQU MLOCC * SUP ************************************************************************ * * THIS SEGMENT OF THE RTE-M SEGMENTED LOADER AND * GENERATOR INITIALIZES ALL NECESSARY LOCATIONS, * REMGOVES INDIRECT ADDRESS FOR DEFS AND PROCESSES * THE LOADER AND GENERATOR ON PARAMETERS. CONTROL * IS RETURNED TO EITHER THE LOADER OR GENERATOR MAIN. * * ******************************************************************** HED RTM LOADER UTILITY SUBROUTINES SKP RTML1 NOP NOP JSB LGUNT INITIALIZE LOADER OR GEN JSB SPACE GEN? JSB INTER LDA P14 LDB MES09 JSB GREAD LDA N2 JSB GETNA CCB CPA GE CLB CPA LO CLB,INB SSB,RSS JMP GEN1 JSB INERR JMP GEN? GEN1 STB LDGEN SZB,RSS JMP RTLG1 STB LNKDR JMP RT.G1 * GE ASC 1,GE LO ASC 1,LO * MES09 DEF *+1 ASC 7,* GEN OR LOAD? * N2 DEC -2 P14 DEC 14 * * * SUBROUTINE TO INITIALIZE LOADER SUBCONTROL * * INIT NOP LDA ABL2 REMOVE JSB INDCK STA ABL2 LDA .ABR JSB INDCK STA .ABR LDA ATBUF JSB INDCK STA ATBUF LDA BPAG4 JSB INDCK INDIRECT STA BPAG4 LDA BUFER JSB INDCK STA BUFER LDA DCB1 JSB INDCK STA DCB1 LDA DCB2 JSB INDCK STA DCB2 ADDRESSES LDA DCB3 JSB INDCK STA DCB3 LDA DCB4 JSB INDCK STA DCB4 LDA DCB5 JSB INDCK STA DCB5 LDA DCB6 FOR JSB INDCK STA DCB6 LDA DCB7 JSB INDCK STA DCB7 LDA FUTA JSB INDCK STA FUTA LDA LBF10 JSB INDCK DEFS STA LBF10 LDA LBUF5 JSB INDCK STA LBUF5 LDA LBUFA JSB INDCK STA LBUFA LDA LSTA JSB INDCK STA LSTA LDA MEMRY JSB INDCK STA MEMRY LDA NBUF6 JSB INDCK STA NBUF6 LDA NBUFA JSB INDCK STA NBUFA LDA NBUFT  JSB INDCK STA NBUFT LDA PNAMA JSB INDCK STA PNAMA LDA QBUFA JSB INDCK STA QBUFA LDA RBTA JSB INDCK STA RBTA LDA RBTO JSB INDCK STA RBTO LDA XNAMA JSB INDCK STA XNAMA LDB BUFER STB PRMAD LDA B4 INITIALIZE TO INPUT/DEVICE FILE MODE STA CMDLU LDA B100 STA FWABP FIRST WORD OF AVAILABLE BASE PAGE LDA B1646 STA LWABP LAST WORD OF AVAILABLE BASE PAGE LDA B2000 STA FWAM FIRST WORD OF AVAILABLE MEMORY JSB CLBPL CLEAR BASE PAGE LINKS LDA OPFLA SET FOR NO PAUSE AND UDFE JSB PAUSE LDA ABL2 STA ABL1 CLA STA LISTO INITIALIZE MAP OUTPUT STA UNDEF START SEARCH AT BEGINING OF LST STA LINTP LINKS IN FLAG (SET TO BASE) STA FWAC FIRST WORD OF COMMON STA LWAC LAST WORD OF COMMON STA FRTRU FIRST TIME THRU FLAG STA ?XFER "HAVE MAIN FLAG" STA LOCC PROGRAM RELOCATION BASE STA BPLOC BASE PAGE RELOCATION BASE STA COML "COMMON USED" FLAG STA LST,I LOADER SYMBOL TABLE LENGTH STA ECHO1 ECHO OFF STA NAMR. ALLOW A NAM RECORD STA MAPON MAP OFF STA AL CLEAR MAP FILE NAME STA ECFIL CLEAR ECHO FILE NAME STA EMSAM MAP/ECHO FILE OFF STA OUTON ABSOLUTE OUTPUT FILE CLOSED STA INACT SET INPUT TO NON-INTERACTIVE STA FL1OP CLEAR COMMAND FILE OPEN BIT STA ERDVC CLEAR ERROR LOG DEVICE STA OPEN1 CLEAR COMMAND FILE OPEN BIT STA FTIME OUTPUT TYOFF REC ONLY AT START STA ISECU SECURITY CODE STA ICR LABEL STA WRTBT NO RELOCATION YET STA TRUNC DON'T TRUNCATE ON ABORT STA ABREC CLEAR RECORD LENGTH STA CKS CLEAR CHECK SUM STA TY}&PRO SET TO ANY TYPE MODULE ALLOWED STA CONSO GET INPUT FROM SESSION CONSOLE STA SERFG LIBRARY LOAD FLAG STA UEXFL UNDEFINED EXTERNALS STA PNZQZ PROGRAM NAME STA KONSO END OF INPUT FILE FLAG JMP INIT,I * B4 OCT 4 B100 OCT 100 B1646 OCT 1646 B2000 OCT 2000 UDFE OCT 77777 * PRMAD NOP SKP * * * STORE NOP LDB LU ASCII LU STB OTFIL,I ISZ OTFIL LDB .. ASCII .. STB OTFIL,I ISZ OTFIL STA OTFIL,I LU JMP STORE,I * LU ASC 1,LU .. ASC 1,.. SKP * * * SUBROUTINES TO OPEN FILES * * OPFL1 NOP CLA,INA STA OPEN1 COMMAND INPUT CALLING LDA OPFLA STA OPFLM LDA CFILE OPEN COMMAND FILE LDB DCB1 JSB OPNFL OPFLM OCT 410 KEYBOARD ECHO CLA,INA SET COMMAND FILE TO OPEN STA FL1OP CLA STA OPEN1 CLEAR COMMAND INPUT CALLING JMP OPFL1,I * * * * OPFL8 NOP LDA OPFLH STA OPFLT LDA EFILE OPEN ERROR/PROMPT FILE LDB DCB7 JSB OPNFL OPFLT OCT 610 PRINT 1ST COLUMN KEYBOARD ECHO JMP OPFL8,I SKP SKP * * * OPEN FILES * * A REG = ADDRESS OF FILE NAME ARRAY * B REG = ADDRESS OF DATA CONTROL BLOCK * * OPNFL NOP STA AFILE SAVE ADDRESS OF FILE STB IDCB SAVE ADDRESS OF DCB LDA OPNFL,I STA IOPTN OPEN OPTION ISZ OPNFL JSB OPEN OPEN FILE DEF *+7 RETURN ADDRESS DEF IDCB,I DCB DEF IERR ERROR CODE DEF AFILE,I ADDRESS OF FILE DEF IOPTN OPEN OPTION DEF ISECU SECURITY CODE DEF ICR LABEL SSA JMP OPN1 OPEN ERROR LDA OPFLA AND UDFE CLEAR PAUSE BIT JSB PAUSE JMP OPNFL,I * OPN1 CPA M100 JMP OPN7 JSB OPNLU CHECK IF LU  JMP OPN8 NOT LUUU JMP OPNFL,I LU, EXIT OPN8 LDB OPEN1 COMMAND INPUT CALLING? CPB B1 JMP ABRT0 YES, ABORT LDB OPFLA SSB BEEN HERE ALREADY? JMP OPN2 YES, FILE NOT FOUND CPA MD6 OPEN ERROR (6)? RSS JMP ERROE NO, OPEN ERROR LDA OPFLA SET PAUSE BIT IOR C1000 JSB PAUSE OPN4 CLA STA QQCNT RESET INPUT BUFFER LDA QBUFA STA QQPTR LDA QBUFA,I GET FIRST CHARACTER ALF,ALF AND B177 CPA B55 IS COMMAND ID SUPPLIED? ISZ QQCNT YES--BUMP CHAR. POINTER JMP NXTC2 * OPN2 LDA OPFLA CLEAR PAUSE BIT AND UDFE JSB PAUSE LDA AFILE CPA OFILE OPENING OUTPUT FILE? JMP OPN3 YES LDB B4 CPA SNAPS OPENING SNAP FILE? JMP OPN6 YES CPA LFILE OPENING MAP FILE? JMP OPN6 CPA ECHOS OPENING ECHO FILE? JMP OPN6 YES OPN5 LDA FN FILE NOT FOUND LDB IERR ERROR CODE JSB ERROR JMP CONSL TRY AGAIN * OPN3 LDA D300 LDB LDGEN LOADER CALLING? SZB LDA D30 YES LDB B7 RSS OPN6 LDA D15 JSB CRETE GO TRY TO CREATE FILE JMP OPN4 * OPN7 LDA DI LDB IERR ERROR CODE JSB ERROR JMP CONSL DISK INITIALIZATION ERROR * ERROE LDA OE LDB IERR ERROR CODE JMP WERR1 * ABRT0 LDA OE OPEN FILE ERROR LDB IERR ERROR CODE JSB ERROR JMP ABRT1 * MD6 DEC -6 B1 OCT 1 B7 OCT 7 B55 OCT 55 B177 OCT 177 * D15 DEC 15 D30 DEC 30 C1000 OCT 100000 * * CREATE OUTPUT FILE IF IN FLOPPY ENVIRONMENT * CRETE NOP STA DSIZE FILE SIZE STB ITYPE TYPE OF FILE 4=ASCII 7=ABS JSB CREAT CREATE FILE DEF *+8 DEF IDCB,I DCB DEF IERR DEF AFIL|E,I ADDRESS OF FILE DEF DSIZE FILE SIZE DEF ITYPE TPE OF FILE DEF ISECU SECURITY CODE DEF ICR LABEL CPA MD200 JMP OPN5 CAN'T CREATE FILE ON NON-FLOPPY SSA,RSS JMP CRETE,I * LDA CR CREATE ERROR LDB IERR ERROR CODE JSB ERROR JMP CONSL * CR ASC 1,CR DI ASC 1,DI * MD200 DEC -200 M100 DEC -100 D300 DEC 300 * DSIZE NOP ITYPE NOP SKP * OE ASC 1,OE OPEN FILE ERROR FN ASC 1,FN FILE NOT FOUND ERROR * * * SUBROUTINE TO ADD/DELETE PAUSE BIT FROM CONTROL WORDS * PAUSE NOP STA OPFLA STA OPFLF XOR B500 STA OPFLB IOR B200 STA OPFLC XOR B100 STA OPFLD STA OPFLE STA OPFLG IOR B400 STA OPFLH JMP PAUSE,I * B200 OCT 200 B400 OCT 400 B500 OCT 500 HED *** FILE PROCESSORS *** * * SUBROUTINE TO GET INPUT COMMAND DEVICE AND ERROR-PROMPT * DEVICE.LAST PARAMETER DETERMINES IF PROGRAM IS IN A * PARTITION AND IF SSGA AND SYSTEM COMMON NEEDED. * * LGUNT NOP JSB INIT INITIALIZE LOADER SUBCONTROL LDA PRMAD,I SZA,RSS IF NO INPUT DEVICE/FILE USE JMP LGUNA SESSION CONSOLE FOR INPUT LGUNB STA INDVC SZA SSA JMP LGER1 NOT VALID LU OR FILE NAME CMA,INA ADA BLANK SSA LU OR FILE NAME? JMP LGUN1 MUST BE FILE NAME LDA INDVC JSB INTR1 DETERMINE IF INTERACTIVE INPUT LDA INDVC INPUT COMMAND LU LDB $OPSY GET TYPE OF OPERATING SYSTEM CPB M7 RTE-MI? JMP LGUN9 YES CPB M15 RTE-MII? JMP LGUN9 YES CPB M5 RTE-MIII? JMP LGUN9 YES LDB INACT INTERACTIVE INPUT? SZB STA $CON,I YES, SAVE LU FOR MESSAGES LGUN9 LDB CFILE ADDRESS OF INPUT COMMAND FILE NAME JSB FILNM  GET DEFAULT FILE NAME ISZ PRMAD ISZ PRMAD ISZ PRMAD INCREMENT PARAMETER ADDRESS TO 4TH PARAM. LGUN2 JSB OPFL1 OPEN COMMAND INPUT FILE JSB GETVL GET ERROR LOG DEVICE LU STA ERDVC SZA,RSS ANY ERROR/PROMPT LOG DEVICE? JMP LGUN4 NO, USE INPUT COM. DEV. IF POSSIBLE LDA ERDVC ERROR-PROMPT LOG DEVICE LU LDB EFILE ADDRESS OF ERROR LOG FILE NAME JSB FILNM GET DEFAULT FILE NAME JSB OPFL8 OPEN ERROR/PROMPT FILE LDA ERDVC GET ERROR LOG LU JSB DTTY CHECK IF INTERACTIVE CLB,INB INTERACTIVE SZA,RSS CLB NON-INTERACTIVE STB ERACT LGUN7 JSB GETVL LDB 0 CLA 0 = MEMORY RESIDENT SLB INA 1 = PROGRAM IN PARTITION RBR,SLB IOR B2 2 = USES SYSTEM COMMON RBR,SLB IOR B4 4 = USES SSGA RBR,SLB IOR B10 8 = LOAD WITH DEBUG STA SCP AND B10 JMP LGUNT,I LGUNA LDA $CON,I SESSION CONSOLE AND B77 JMP LGUNB * LGUN1 LDA CFILE STA FILEI LDA M3 STA COUNT LGUN3 LDB PRMAD GET PARAMETER ADDRESS LDA 1,I GET NEXT TWO CHARACTERS OF INPUT SZA,RSS COMMAND FILE LDA BLANK NO MORE CHARACTERS IN FILE NAME STA FILEI,I SAVE FILE NAME FOR OPEN CALL ISZ FILEI ISZ PRMAD ISZ COUNT JMP LGUN3 PROCESS NEXT TWO CHARACTERS CLA STA INDVC SET TO FILE FOR INPUT JMP LGUN2 * * LGUN4 STA ERACT NON-INTERACTIVE ERROR LOG LDA INDVC GET INPUT LU SZA,RSS JMP LGUN5 NO LU, INPUT MUST BE FILE LGUN8 JSB INTR1 IS DEVICE INTERACTIVE? JMP LGUN7 LGUN5 LDA DCB1 INA LDA 0,I GET FILE TYPE SZA JMP LGUN7 NOT TYPE 0, NOT INTERACTIVE LDA DCB1 JSB LOCFS SSA JMP LGER2 A0.*LDA JLU GET LU OF FILE NAME JMP LGUN8 * * M5 DEC -5 M7 DEC -7 M15 DEC -15 SPC 5 SKP * * LGER1 LDA ON CLB NO FMP ERROR JSB STFER OUTPUT ERROR TO SYSTEM CONSOLE JMP ABRT1 TERMINATE LOADER EXECUTION * ON ASC 1,ON * BLANK ASC 1, * B2 OCT 2 B10 OCT 10 B77 OCT 77 M3 DEC -3 * COUNT NOP INDVC NOP FILEI NOP * * SUBROUTINE TO GET VALUES FROM ON COMMMAND * * B REGISTER CONTAINS ADDRESS OF NEXT PARAMETER * GETVL NOP LDB PRMAD ADDRESS OF NEXT PARAMETER LDA 1,I PARAMETER VALUE ISZ PRMAD JMP GETVL,I * * * SUBROUTINE TO DETERMINE IF INPUT DEVICE IS INTERACTIVE * * INTR1 NOP JSB DTTY CLB,INB INTERACTIVE SZA,RSS CLB NON-INTERACTIVE STB INACT JMP INTR1,I SKP * * * SUBROUTINE TO GET FILE NAMES * * FILNM NOP STB OTFIL SET DESTINATION ADDRESS CLB STB HDGIT FIL01 ADA M10 CONVERT LU TO ASCII TWO DIGITS SSA JMP FIL02 ISZ HDGIT JMP FIL01 FIL02 ADA D10 IOR B60 MAKE ASCII STA LDGIT LDA HDGIT IOR B60 ALF,ALF IOR LDGIT JSB STORE SAVE LU IN ARRAY JMP FILNM,I * HDGIT NOP HIGH ASCII CHARACTER LDGIT NOP LOW ASCII CHARACTER * M10 DEC -10 B60 OCT 60 D10 DEC 10 * END RTML1 ]0 ! . 91740-18047 2013 S C0122 &RTML2              H0101 tASMB,R,L,C RTML2 * NAME: RTML2 RTE-M SEGMENTED GEN.-LOADER (SEGMENT 2) * SOURCE: 91740-18047 * RELOC: 91740-16047 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * * * HED RTE-M SYSTEM GENERATOR-LOADER NAM RTML2,5 91740-16047 REV 2013 800121 * ENT RTML2 * * EXTERNAL REFERENCE NAMES EXT ABRT1,ADTRP,AFILE,AL EXT ATTBL,BAKUP,BLINE,BPAGA,BPLOC EXT CLFL4,CLFL5,CLFL6 EXT CMDLU,CMER,CONSL EXT DCB2,DCB3,DCB4,DCB5,DCB6,DIAG2 EXT ECFIL,ECHO1,ECHOS,EMSAM,ERREX,ER#OR,FRTRU,FUT4 EXT FWABP,FWAC,FWAM,ICR,IDCB,IERR#,IFILE EXT IOPTN,ISECU,JLU,JMPNO,KTABL EXT LBUFA,LDGEN,LDSEG,LDSG3,LER3,LER5 EXT LFILE,LIBFL,LINTP,LISTO,LITBL,LNKDR EXT LOCFS,LST,LST1,LST2,LST3 EXT LST4,LST5 EXT LSTUL,LTABL EXT LWABP,LWAC,LWAM,MAPON,MAPS EXT MEMRY,MLOCC,MTABL EXT NBUF,NBUFA,NCHAR EXT NSCAN,NXTC,NXTC2,NXTCM EXT OFILE,ONTBL,OPEN1 EXT OPFLA,OPFLB,OPFLC,OPFLD,OPFLE EXT OPFLF,OPNLU EXT OTFIL,OUTON EXT QBUFA,QGETC,QQCNT EXT QQPTR,RBTA,RIC EXT SCAN,SCP,SEGFL,SERNM EXT SNAPS,SSTBL,STABL,TOTBL EXT TRANS,WERR1 EXT XNAM,XNAMA * EXT CREAT,OPEN,PARSE EXT DU#MY * * B EQU 1 ERROR EQU ER#OR IERR EQU IERR# LOCC EQU MLOCC SUP ************************************************************************ * * THIS SEGMENT OF THE RTE-M SEGEMNTED LOADER AND GENERATOR * PROCESSES ALL LOADER COMMANDS (SET, REL, TR, ETC.). * HOWEVER THIS SEGMENT DOES NOT PERFORM RELOCATION. * CONTROL IS RETURNED TO EITHER THE LOADER OR GENERATOR * MAIN IF NO RELOCATION OCCURS. IF RELOCATION (REL OR * SEARCH COMMAND) IS NEEDED, THIS SEGMENT WILL CALL * FOR LOADER SEGMENT 3 (RTML3) TO BE LOADED IN TO * PERFORM THE RELOCATION. * ******************************************************************** HED RTM LOADER UTILITY SUBROUTINES SPC 5 SKP RTML2 NOP NOP CLA,INA STA SEGFL SET LAST SEGMENT FLAG LDA JMPNO ADA PTABL LDA 0,I JMP 0,I * LDRIN CLA STA LDSG3 SET FOR RELOCATION ENTRY STA SEGFL LAST SEGMENT FLAG LDA B3 LOAD IN LOADER SEGMENT 3 JMP LDSEG * B3 OCT 3 SKP ***** * * BRANCH TABLE FOR COMMAND PROCESSORS. * ORDER OF THIS TABLE MUST CONFORM TO ORDER OF FIRST ENTRIES IN * COMMAND MNEMONIC TABLE. * ***** PTABL DEF * DEF BNDST BOUNDS STATEMENT DEF MAPST MAP STATEMENT DEF RELST RELOCATE STATEMENT DEF RELST RELOCATE STATEMENT DEF SERST SEARCH STATEMENT DEF OUTST OUTPUT STATEMENT DEF TR TRANSFER STATEMENT DEF TR TRANSFER STATEMENT DEF SETST SET STATEMENT DEF LINST LINKS IN STATEMENT DEF LNKST LINKS STATEMENT DEF EXIT EXIT STATEMENT DEF ECHO ECHO STATEMENT SKP ***** * ** MOVE. ** MOVE BLOCK OF CHARS FROM INPUT BUFFER (QIBUF) TO A * SPECIFIED LOCATION. STOP AT FIRST DELIMITER. * CALLING SEQUENCE: * * LDA ADDRESS OF DESTINATION * JSB MOVE. * RETURN * ***** MOVE. NOP STA MOVE3 SAVE DESTINATION ADDRESS JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NONE FOUND MOV01 ALF,ALF POSITION CHAR TO LEFT, STA MOVE3,I AND STORE IN OUTPUT BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOϑV02 CPA B51 RIGHT PAREN? JMP MOV02 CPA B50 LEFT PAREN? JMP MOV02 YES CPA B72 COLON? JMP MOV02 YES IOR MOVE3,I PUT LOWER HALF STA MOVE3,I IN BUFFER JSB QGETC GET NEXT CHAR JMP MOV03 END OF LINE CPA B40 BLANK? JMP MOV02 CPA B54 COMMA? JMP MOV02 CPA B51 RIGHT PAREN? JMP MOV02 CPA B50 LEFT PAREN? JMP MOV02 YES CPA B72 COLON? JMP MOV02 YES ISZ MOVE3 BUMP OUTPUT POINTER JMP MOV01 KEEP GOING MOV02 JSB BAKUP BACK UP OVER LAST CHAR MOV03 LDA MOVE3,I WAS LAST CHAR AND UPCM CPA MOVE3,I AN EVEN NUMBERED CHAR? RSS JMP MOVE.,I YES, BUFFER IS OK IOR B40 NO, APPEND A BLANK STA MOVE3,I AND STORE IT AWAY JMP MOVE.,I * MOVE3 NOP DESTINATION ADDRESS * B40 OCT 40 B50 OCT 50 B51 OCT 51 B54 OCT 54 B72 OCT 72 SPC 1 SKP * * * SUBROUTINE TO DETERMINE IF INPUT IS OCTAL OR ASCII * * OCTAS NOP STA 1 AND B377 ADA M60 SSA JMP OCTAS,I ASCII ADA M10 SSA,RSS JMP OCTAS,I MUST BE ASCII, EXIT ISZ OCTAS OCTAL JMP OCTAS,I * B377 OCT 377 M10 DEC -10 M60 OCT -60 * * * STORE NOP LDB LU ASCII LU STB OTFIL,I ISZ OTFIL LDB .. ASCII .. STB OTFIL,I ISZ OTFIL STA OTFIL,I LU JMP STORE,I * LU ASC 1,LU .. ASC 1,.. SKP * * * SUBROUTINES TO OPEN FILES * * * * * OPFL2 NOP LDA OPFLB STA OPFLN LDA OFILE OPEN ABSOLUTE OUTPUT FILE LDB DCB2 JSB OPNFL OPFLN OCT 110 BINARY OUTPUT JMP OPFL2,I * * * OPFL3 NOP LDA OPFLC STA OPFLO LDA IFILE OPEN INPUT (REL/SEARCH) FILE LDB DCB3 JS)B OPNFL OPFLO OCT 310 BINARY INPUT JMP OPFL3,I * * * OPFL4 NOP LDA OPFLD STA OPFLP LDA LFILE OPEN LIST (MAP) - PROMPT FILE LDB DCB4 JSB OPNFL OPFLP OCT 210 PRINT 1ST COLUMN CLA,INA SET FOR MAP JMP OPFL4,I * * * OPFL5 NOP LDA OPFLE STA OPFLQ LDA ECHOS OPEN ECHO FILE LDB DCB5 JSB OPNFL OPFLQ OCT 210 PRINT 1ST COLUMN CLA,INA SET FOR ECHO JMP OPFL5,I * * * OPFL6 NOP LDA OPFLF STA OPFLR LDA TRANS OPEN TRANSFER FILE LDB DCB6 JSB OPNFL OPFLR OCT 410 KEYBOARD ECHO JMP OPFL6,I * * * * SKP SKP * * * OPEN FILES * * A REG = ADDRESS OF FILE NAME ARRAY * B REG = ADDRESS OF DATA CONTROL BLOCK * * OPNFL NOP STA AFILE SAVE ADDRESS OF FILE STB IDCB SAVE ADDRESS OF DCB LDA OPNFL,I STA IOPTN OPEN OPTION ISZ OPNFL JSB OPEN OPEN FILE DEF *+7 RETURN ADDRESS DEF IDCB,I DCB DEF IERR ERROR CODE DEF AFILE,I ADDRESS OF FILE DEF IOPTN OPEN OPTION DEF ISECU SECURITY CODE DEF ICR LABEL SSA JMP OPN1 OPEN ERROR LDA OPFLA AND UDFE CLEAR PAUSE BIT JSB PAUSE JMP OPNFL,I * OPN1 CPA M100 JMP OPN7 LDB OPEN1 COMMAND INPUT CALLING? CPB B1 JMP ABRT0 YES, ABORT LDB OPFLA SSB BEEN HERE ALREADY? JMP OPN2 YES, FILE NOT FOUND CPA MD6 OPEN ERROR (6)? RSS JMP ERROE NO, OPEN ERROR LDA OPFLA SET PAUSE BIT IOR C1000 JSB PAUSE OPN4 CLA STA QQCNT RESET INPUT BUFFER LDA QBUFA STA QQPTR LDA QBUFA,I GET FIRST CHARACTER ALF,ALF AND B177 CPA B55 IS COMMAND ID SUPPLIED?  ISZ QQCNT YES--BUMP CHAR. POINTER JMP NXTC2 * OPN2 LDA OPFLA CLEAR PAUSE BIT AND UDFE JSB PAUSE JSB OPNLU CHECK IF LU JMP OPN8 NOT LU JMP OPNFL,I LU,EXIT OPN8 LDA AFILE CPA OFILE OPENING OUTPUT FILE? JMP OPN3 YES LDB B4 CPA SNAPS OPENING SNAP FILE? JMP OPN6 YES CPA LFILE OPENING MAP FILE? JMP OPN6 CPA ECHOS OPENING ECHO FILE? JMP OPN6 YES OPN5 LDA FN FILE NOT FOUND LDB IERR ERROR CODE JSB ERROR JMP CONSL TRY AGAIN * OPN3 LDA D300 LDB LDGEN LOADER CALLING? SZB LDA D30 YES LDB B7 RSS OPN6 LDA D15 JSB CRETE GO TRY TO CREATE FILE JMP OPN4 * OPN7 LDA DI LDB IERR ERROR CODE JSB ERROR JMP CONSL DISK INITIALIZATION ERROR * ERROE LDA OE LDB IERR ERROR CODE JMP WERR1 * ABRT0 LDA OE OPEN FILE ERROR LDB IERR ERROR CODE JSB ERROR JMP ABRT1 * MD6 DEC -6 B1 OCT 1 B7 OCT 7 B55 OCT 55 B177 OCT 177 * D15 DEC 15 D30 DEC 30 C1000 OCT 100000 UDFE OCT 77777 * * CREATE OUTPUT FILE IF IN FLOPPY ENVIRONMENT * CRETE NOP STA DSIZE FILE SIZE STB ITYPE TYPE OF FILE 4=ASCII 7=ABS JSB CREAT CREATE FILE DEF *+8 DEF IDCB,I DCB DEF IERR DEF AFILE,I ADDRESS OF FILE DEF DSIZE FILE SIZE DEF ITYPE TPE OF FILE DEF ISECU SECURITY CODE DEF ICR LABEL CPA MD200 JMP OPN5 CAN'T CREATE FILE ON NON-FLOPPY SSA,RSS JMP CRETE,I * LDA CR CREATE ERROR LDB IERR ERROR CODE JSB ERROR JMP CONSL * CR ASC 1,CR DI ASC 1,DI * MD200 DEC -200 M100 DEC -100 D300 DEC 300 * DSIZE NOP ITYPE NOP SKP * OE ASC 1,OE OPEN FILE ERROR FN ASC 1,FN FILE NOT FOUND ERROR * * * SUBROUTINE TO ADD/DELETE PAUSE BIT FROM CONTROL WORDS * PAUSE NOP STA OPFLA STA OPFLF XOR B500 STA OPFLB IOR B200 STA OPFLC XOR B100 STA OPFLD STA OPFLE JMP PAUSE,I * B100 OCT 100 B200 OCT 200 B500 OCT 500 SKP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMITER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA EMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RETURN1 NOTHING BUT BLANKS TO END OF LINE * RETURN2 DELIMITER FOUND * * NOTE: IF NO VALID DELIMITER IS FOUND (OR COMMA WITH NOTHING BUT * BLANKS TO THE END OF LINE) A DIRECT JUMP TO THE COMMAND * ERROR ROUTINE WILL RESULT. THUS CONTROL MAY NOT BE RETURNED ***** DELIM NOP JSB QGETC GET THE NEXT CHAR JMP DELIM,I END OF LINE , RETURN (P+1) LDB M2 INITIALIZE STB STMP1 COMMA COUNTER CPA B40 IS THIS A BLANK? JMP DEL01 YES CPA B54 NO, IS IT A COMMA? RSS JMP CMER NO, ERROR ISZ STMP1 DEL01 JSB NXTC GET NEXT NON BLANK CHAR JMP DEL02 END OF LINE CPA B54 GOT ONE, IS IT A COMMA? RSS JMP DEL03 NO ISZ STMP1 YES, IS IT THE SECOND ONE? JMP DEL01 NO, GET NEXT NON BLANK CHARACTER DEL03 JSB BAKUP YES, BACK UP BUFFER POINTERS ISZ DELIM AND EXIT (P+2) JMP DELIM,I DEL02 ISZ STMP1 WAS THERE A COMMA? JMP DELIM,I NO, EXIT (P+1) JMP CMER YES, ERROR * STMP1 NOP COMMA COUNTER * M2 DEC -2 SKP * * * SUBROUTINE TO PARSE COMMAND * * CALLING SEQUENCE * * A REG = DEFAULT LU OR 0 IF DEFAULT NOT ALLOWED * B REG = ADDRESS OF FILE NAME ARRAY * * JSB FILE * (P+1) = GTFIL IOPTN PARAMETER (WHICH FILE) * RETURN 1 = COMMAND (LU) - GET FILE NAME * RETURN 2 = OPEN FILE * * FILE NOP STA OUTFL SAVE DEFAULT LU STB OTFIL SAVE ADDRESS OF FILE NAME ARRAY JSB NXTC GET NEXT NON-BLANK CHARACTER JMP FILE4 NO MORE LDB OTFIL CPB TRANS TRANSFER COMMAND? JMP FILE2 YES JSB BAKUP BACKUP INPUT BUF TO PREV. CHAR. LDB OTFIL CPB IFILE RELOCATE/SEARCH COMMAND? JMP FILE1 YES CPB LFILE MAP? JMP FILE1 YES CCA OUTPUT, SNAP, OR DISPLAY COMMAND CPB ECHOS ECHO COMMAND? LDA M2 YES LDB ONTBL SEARCH FOR ON OR OFF JSB SCAN JMP CMER ERROR EXIT CPA B2 OFF? JMP FILE3 YES FILE1 JSB ASOCT ASCII OR OCTAL? JMP ASKEY ASCII LDA TCHAR LU JSB STORE JMP FILE,I ASKEY JSB ASCII MOVE FILE NAME TO JMP FILE,I FILE NAME ARRAY AND EXIT FILE2 CPA B54 COMMA? JMP FILE1 YES FILE3 LDB FILE ADB B4 SET RETURN ADDRESS CLA ECHO OFF JMP B,I EXIT FILE4 LDA OUTFL USE DEFAULT LU JSB STORE JMP FILE,I * OUTFL NOP LOGICAL UNIT NUMBER TCHAR NOP * B2 OCT 2 B4 OCT 4 SKP * * * SUBROUTINE TO GET NEXT OCTAL OR ASCII CHARACTER * * ASOCT NOP JSB NXTC GET NEXT CHARACTER JMP CMER NO MORE, ERROR EXIT JSB OCTAS JMP ASOCT,I ASCII INPUT STB TCHAR SAVE FIRST DIGIT JSB NXTC GET NEXT CHARACTER JMP ASOC1 NO MORE, ONE DIGIT LU JSB OCTAS JMP CMER ASCII, ERROR EXIT LDA TCHAR COMBINE WITH PREVIOUS DIGIT ALF,ALF IOR 1 ODGIT STA TCHAR ISZ ASOCT JMP ASOCT,I * ASOC1 LDA TCHAR IOR B30K JMP ODGIT * B30K OCT 30000 * * * * * SUBROUTINE TO MOVE FILE NAME FROM INPUT BUFFER 9 * TO FILE NAME ARRAY * * ASCII NOP JSB BAKUP BACKUP INPUT BUFFER TO PREVIOUS CHARACTER LDA OTFIL LDB BLANK SET FILE NAME TO BLANKS INA STB 0,I INA STB 0,I LDA OTFIL MOVE FILE NAME FROM INPUT BUFFER JSB MOVE. TO FILE NAME ARRAY JMP ASCII,I NO MORE CHARACTERS * BLANK ASC 1, SKP * * * SUBROUTINE TO ADJUST CORE BOUNDS TO NEXT PAGE FOR * USER PROGRAM IF IT DOESN'T START ON PAGE BOUNDARY. * * PAGE NOP STA 1 AND C076 GET PAGE BITS CPA 1 STARTS AT PAGE BOUNDARY? JMP PAGE,I YES, EXIT CPA C076 STARTS SOMEWHERE ON LAST PAGE? JMP LER3 MEMORY OVERFLOW ADA B2000 BEGIN ON NEXT PAGE JMP PAGE,I * B2000 OCT 2000 C076 OCT 76000 SKP * * SUBROUTINES TO PARSE FILE NAMES FOR SECURITY CODE * AND LABEL. * PNMRC NOP CLA STA ISECU INITIALIZE SECURITY CODE AND STA ICR LABEL JSB PNMRA GET 1ST OPTIONAL NAME PARAMETER JMP PNMRC,I NONE, EXIT STA ISECU SAVE SECUITY CODE JSB PNMRA GET 2ND OPTIONAL NAME PARAMETER JMP PNMRC,I NONE, EXIT STA ICR SAVE LABEL JMP PNMRC,I * * * PNMRA NOP JSB NXTC GET NEXT CHARACTER JMP PNMRA,I NO MORE CPA B72 COLON? JMP PNMR1 YES JSB BAKUP NO, BACKUP JMP PNMRA,I PNMR1 JSB NXTC GET NEXT CHARACTER JMP PNMRA,I NO MORE CPA B72 COLON? JMP PNMR2 YES, NO FIRST PARAMETER JSB BAKUP BACKUP LDA BLANK STA BUFA1+1 STA BUFA1+2 LDA BUFAD JSB MOVE. PUT ASCII CHARS IN BUFFER JSB PARSE PARSE INPUT DEF *+4 DEF BUFA1 DEF B6 DEF RBUF LDA RBUF+1 ISZ PNMRA JMP PNMRA,I * PNMR2 JSB BAKUP BACKUP CLA SET FOR NO PARAMETER ISZ PNMRA @ SET FOR NEXT PARAMETER JMP PNMRA,I * B6 OCT 6 * BUFAD DEF *+1 BUFA1 BSS 3 RBUF BSS 33 * SKP ***** * ** TRANSFER COMMAND PROCESSOR * ***** TR LDA CMDLU TRANSFER FILE OPEN? CPA B1 JSB CLFL6 YES, CLOSE IT LDA ASC01 - DEFAULT LU FOR TRANSFER FILE LDB TRANS TRANSFER FILE NAME ARRAY JSB FILE PARSE REQUEST JSB PNMRC GET OPTIONAL PARAMETERS JSB OPFL6 OPEN TRANSFER FILE CLA,INA STA CMDLU SET INPUT TO TRANSFER FILE JMP NXTCM GET NEXT COMMAND * ASC01 ASC 1,01 * * * * ***** * ** EXIT COMMAND PROCESSOR * ***** EXIT JMP ABRT1 * * * * ***** * ** OUTPUT COMMAND PROCESSOR * ***** OUTST LDA ASC04 - DEFAULT LU FOR OUTPUT FILE LDB OFILE OUTPUT FILE NAME ARRAY JSB FILE PARSE REQUEST JSB PNMRC GET OPTIONAL PARAMETERS JSB OPFL2 OPEN OUTPUT FILE CLA,INA STA OUTON JMP NXTCM GET NEXT COMMAND * ASC04 ASC 1,04 SKP ***** * ** RELOCATE ** SEARCH COMMAND PROCESSORS * ***** RELST CLA,RSS SET SEARCH FLAG OFF. SPC 1 SERST CLA,INA SET SEARCH FLAG ON. SPC 1 STA LIBFL STORE FLAG LDA OUTON OUTPUT OPEN? SZA,RSS JMP REL8 NO CLA STA RIC STA XNAM STA SERNM STA ADTRP TRAP ADDRESS LDA LDGEN GENERATOR OR LOADER? SZA,RSS JMP GENER GENERATOR LDA FRTRU FIRST TIME THRU? SZA JMP LOCST NO, DON'T SET CORE BOUNDS ISZ FRTRU SET FIRST TIME THRU FLAG LDA SCP GET SSGA, COMMON, PARTITION FLAG AND B7 SZA JMP REL1 REL2 STA FWAC MEM RES. (NO COMMON OR SSGA) STA LWAC REL1 SLA JMP REL3 LDA LOCC SZA,RSS LDA FWAM MEM RES. (COMMON AND OR SSGA) REL4 STA LOCC LDA BPLOC SZA,RSS LDA FWABP JMP REL5 REL3 LDB B2 START LINKS AT 2 STB BPLOC STB FWABP LDB UDFE SET LWAM = 77777 STB LWAM CPA B1 PARTITION (NO COMMON OR SSGA) JMP REL6 YES LDA LWAC PARTITION (COMMON AND OR SSGA) INA JSB PAGE ADJUST PAGE STA FWAM JMP REL4 REL6 LDB $SSGA IS $SSGA IN LST? JSB SSTBL GO SEARCH JMP REL7 NO, ERROR EXIT LDA LST4,I GET VALUE OF $SSGA JSB PAGE ADJUST PAGE STA FWAM LDB LOCC SZB,RSS STA LOCC CLA JMP REL2 REL7 LDB SSGA ERROR, $SSGA UNDEF JMP ERREX GENER LDA LOCC HAS LOCC BEEN SET YET? SZA JMP LOCXX YES LDA FWAM NO--SET TO FWAM STA LOCC LOCXX LDA BPLOC HAS BPLOC BEEN SET YET? SZA NO JMP LOCST YES , BPLOC SET LDA FWABP ALSO SET BASE PAGE LDB LNKDR GET LINK DIRECTION FLAG CPB M1 SYSTEM OR USER LINKS? LDA LWABP SYSTEM LINKS REL5 STA BPLOC LOCST LDA ASC05 - DEFAULT LU FOR REL-SEARCH FILE LDB IFILE REL/SEARCH FILE NAME ARRAY JSB FILE PARSE REQUEST JSB PNMRC GET OPTIONAL PARAMETERS JSB OPFL3 OPEN REL/SEARCH FILE JSB NXTC GET NEXT NON-BLANK CHAR JMP LDRIN NO MORE CPA B50 LEFT PAREND? RSS YES JMP CMER NO--COMMAND ERROR LDA BLANK BLANK OUT XNAM STA XNAM+1 STA XNAM+2 LDA XNAMA JSB MOVE. * JSB NXTC GET NEXT NON BLANK CHAR JMP CMER NO MORE CPA B51 RIGHT PAREN? JMP LDRIN YES JMP CMER NO, ERROR * REL8 LDA OO CLB NO FMP ERROR JMP WERR1 OUTPUT NOT OPEN ERROR * OO ASC 1,OO * SSGA DEF *+2 $SSGA DEF *+2 OCT 13 ASC 6,$SSGA UNDEF * * * ASC05 ASC 1,05 * M1 DEC -1 SK_P ***** * ** ECHO COMMAND PROCESSOR * ***** ECHO JSB ECHOO JMP NXTCM GET NEXT COMMAND * * ECHOO NOP LDA ASC06 - DEFAULT LU FOR ECHO FILE LDB ECHOS ECHO FILE NAME ARRAY JSB FILE PARSE REQUEST JSB PNMRC GET OPTIONAL PARAMETERS CLB,INB JSB CKEMP CHECK IF MAP OPENED SAME FILE JSB OPFL5 OPEN ECHO FILE STA ECHO1 CLEAR IF ECHO OFF LDB EMSAM FILE SHARED BETWEEN MAP AND ECHO? SZB JMP ECHOO,I YES, DON'T CLOSE ECHO FILE SZA ECHO ON? JMP ECHOO,I YES, EXIT STA ECFIL CLEAR ECHO FILE NAME JSB CLFL5 CLOSE ECHO FILE JMP ECHOO,I * ASC06 ASC 1,06 * * SUBROUTINE TO CHECK IF ECHO AND MAP ARE THE SAME FILE. * IF YES, USE FIRST DCB OPENED FOR WRITING. * * CKEMP NOP JSB ECMA1 CHECK IF ECHO AND MAP ARE SAME FILE LDA EMSAM =1 IF MAP FILE AND ECHO FILE SZA,RSS ARE TO SAME FILE AND MAP FILE'S STB EMSAM DCB IS USED. =-1 IF ECHO'S DCB IS SZB,RSS USED. =0 IF FILE NAMES NOT SAME. JMP CKEMP,I CLA,INA ISZ CKEMP SET TO NOT OPEN FILE JMP CKEMP,I * SKP * * * SUBROUTINE TO DETERMINE IF MAP AND ECHO ARE THE SAME FILE * * ECMA1 NOP LDA AL DETERMINE IF ECHO AND MAP CPA ECFIL RSS JMP ECMA2 ARE THE SAME FILE LDA AL+1 CPA ECFIL+1 RSS JMP ECMA2 LDA AL+2 CPA ECFIL+2 JMP ECMA3 SAME ECMA2 CLB JMP ECMA1,I ECMA3 STB MPECS =1 IF MAP, =-1 IF ECHO CONTROL LDA DCB4 CPB M1 LDA DCB5 JSB LOCFS CHECK IF CARTRIDGE OR DISK FILE CLB LDA JLU SZA DEVICE FILE? LDB MPECS NO JMP ECMA1,I * MPECS NOP SKP ***** * ** MAP COMMAND PROCESSOR * * LISTO--CORE MAP LISTING FLAG * BIT 0 GLOBAL VARIABLES * 1 MODULES * 2 LINKS ***** MAPST CLA STA LISTO MAP1 LDA MD5 LDB MTABL JSB SCAN JMP CMER NO MORE KEY WORDS STA B LDA LISTO CPB B1 MODULES? IOR B2 CPB B2 GLOBALS? IOR B1 CPB B3 LINKS? IOR B4 CPB B4 OFF? CLA RESET POINTER STA LISTO CPB B5 ON? JMP MAP2 YES JSB DELIM ADVANCE PAST DELIMITERS RSS JMP MAP1 MAP2 LDA LISTO ANY OPTION ON? SZA,RSS JMP NXTC1 NO, GET NEXT COMMAND LDA ASC06 - DEFAULT LU LDB LFILE MAP FILE NAME ARRAY JSB FILE PARSE REQUEST JSB PNMRC GET OPTIONAL PARAMETERS CCB JSB CKEMP JSB OPFL4 OPEN MAP FILE STA MAPON SET MAP ON LDA D15 LDB HEAD1+1 JSB MAPS LDA HEAD1 LDB HEAD2 JSB MAPS LDA HEAD1 LDB HEAD3 JSB MAPS LDA HEAD1 LDB HEAD4 JSB MAPS JMP NXTCM GET NEXT COMMAND NXTC1 LDA EMSAM MAP AND ECHO SAME FILE? SZA JMP NXTCM YES, GET NEXT COMMAND LDA MAPON MAP PREVIOUSLY ON? CPA B1 JSB CLFL4 YES, CLOSE MAP FILE CLA STA MAPON MAP OFF STA AL CLEAR MAP FILE NAME JMP NXTCM GET NEXT COMMAND SPC 1 HEAD1 DEC 63 # CHARS. IN EACH PRINT LINE. DEF *+1 ASC 8, PROGRAM MODULE HEAD2 DEF *+1 ASC 24, ENTRY LOW HIGH LOW HIGH ASC 8, CP LINKS HEAD3 DEF *+1 ASC 24, POINT MAIN MAIN BASE BASE ASC 8, LOW HIGH HEAD4 DEF *+1 ASC 24, ---------------------------------------------- ASC 8,--------------- * B5 OCT 5 MD5 DEC -5 SKP * * ***** * ** BOUNDS COMMAND PROCESSOR * ***** BNDST LDA MD6 LDB KTABL JSB SCAN JMP CMER NO MORE KEYWORD!S ADA M1 ADA MEMRY COMPUTE ADDRESS STA NCHAR SAVE ADDRESS TEMPORARILY JSB NXTC GET NEXT NON BLANK CHAR JMP CMER CPA B75 EQUAL SIGN? RSS JMP CMER NO,ERROR JSB NSCAN GET OCTAL NUMBER JMP CMER NO MORE CHARS. OR NOT NUMERIC SSA IS IT POSITIVE OR ZERO? JMP BER1 NO. ISSUE ERROR AND IGNORE. STA NCHAR,I LEGAL ADDRESS, POST VALUE AND JSB DELIM JMP NXTCM JMP BNDST LOOK FOR NEW PARAMETERS SPC 1 BER1 LDB ILBND ISSUE "IL BND" ERROR JSB DIAG2 JMP NXTCM AND GET NEXT COMMAND * ILBND DEF *+1 DEC 6 ASC 3,IL BND * B75 OCT 75 SKP ***** * ** SET COMMAND PROCESSOR * ***** SETST CLA STA STMP LDA M2 LDB LTABL LOCC OR BPLOCC? JSB SCAN JMP SET01 NO, MUST BE SYM TAB ENTRY ADA RBTA YES, SAVE ADDRESS TO STA STMP PUT VALUE INTO JMP SET02 SET01 JSB BLINE BLANK OUT THE BUFFER LDA LBUFA THEN MOVE NAME TO BUF JSB MOVE. FOR LATER CHECKING SET02 CCA LDB TOTBL LOOK FOR "TO" JSB SCAN JMP CMER NOT FOUND, ERROR EXIT JSB NXTC GET NEXT CHARACTER JMP CMER NO MORE, ERROR EXIT JSB OCTAS DETERMINE IF ASCII OR OCTAL JMP SET05 ASCII JSB BAKUP BACKUP JSB NSCAN GET LINK VALUE JMP CMER SET06 STA SVAL SAVE VALUE LDB STMP IF SYM TAB ENTRY, SZB,RSS JMP SET03 THEN JUMP TO SET03 STA STMP,I ELSE SET VALUE INTO LOCC JMP NXTCM OR BPLOCC AND GET NEXT COMMAND SET05 JSB BAKUP BACKUP LDA NBUFA JSB MOVE. MOVE NAME TO BUFFER LDB NDEF GET CHARS "UN" CPB NBUF =? RSS JMP CMER NO, ERROR EXIT LDB NDEF+1 GET CHARS "DE" CPB NBUF+1 =? RSS JMP CMER NO, ERROR EXIT LDB NDEF+2 GET CHARs "F" XOR NBUF+2 AND UPCM SZA JMP CMER LDA UDFE JMP SET06 SET LINK VALUE TO UNDEF SET03 CLA SET FOR SET PROCESSOR JSB LNSET JMP NXTCM GET NEXT COMMAND * UPCM OCT 77400 * NDEF ASC 3,UNDEF SKP LNSET NOP STA LKOST 1=LINK, 0=SET PROCESSOR LDB LBUFA LOOK FOR SYMBOL IN JSB SSTBL SYMBOL TABLE JMP SET04 NOT FOUND LDA LST4 LDB LKOST LINK OR SET? SZB LDA LST5 LINK LDB SVAL GET LINK ADDRESS OR VALUE STB 0,I SAVE IN LST JMP NXTCM AND GET NEXT COMMAND SET04 LDA LSTUL CHECK CMA FOR ADA FUT4 SYMBOL SSA TABLE JMP LER5 OVERFLOW LDA SVAL GET LINK ADDRESS OR VALUE LDB LKOST LINK OR SET? SZB JMP SET07 LINK STA LST4,I SET LINK VALUE STB LST5,I CLEAR LINK ADDRESS SET08 ISZ LST,I BUMP ENTRIES COUNTER LDB LBUFA LDA B,I STA LST1,I STORE FIRST 2 CHARS INB LDA B,I STA LST2,I STORE SECOND TWO CHARS INB LDA B,I AND UPCM ZERO OUT EXT ID NUMBER STA LST3,I AND STORE FIFTH CHAR JMP LNSET,I SET07 STA LST5,I SET LINK ADDRESS LDA UDFE SET LINK VALUE TO UNDEF STA LST4,I JMP SET08 * LKOST NOP 1 = LINK, 0 = SET STMP NOP SVAL NOP * SKP ***** * ** LINKS IN ** COMMAND PROCESSOR * ***** LINST LDA M2 LDB LITBL JSB SCAN LOOK FOR BASE OR CURRENT JMP CMER ADA M1 STA LINTP 0 = BASE, 1 = CURRENT JMP NXTCM GET NEXT COMMAND ***** * ** LINKS START AT ** COMMAND PROCESSOR * ***** LNKST CCA LDB STABL JSB SCAN LOOK FOR "START" JMP CMER CCA LDB ATTBL JSB SCAN LOOK FOR "AT" JMP CMER JSB NSCAN GET LINK ADDRESS JMP TZXTCMER STA SVAL AND SAVE IT JSB NXTC GET NEXT NON-BLANK CHAR JMP CMER CPA B54 IS IT A COMMA? RSS YES, GOOD JMP CMER NO, ERROR JSB NXTC GET NEXT CHARACTER JMP CMER NO MORE, ERROR EXIT JSB OCTAS DETERMINE IF OCTAL OR ASCII JMP ASSCI ASCII JSB BAKUP BACKUP JSB NSCAN GET LINK VALUE JMP CMER LDB SVAL GET LINK ADDRESS ADB BPAGA STA 1,I STORE VALUE IN LINK TABLE JMP NXTCM GET NEXT COMMAND ASSCI JSB BAKUP BACKUP JSB BLINE BLANK BUFFER LDA LBUFA JSB MOVE. MOVE NAME TO BUFFER CLA,INA SET FOR LINKS START AT JSB LNSET COMMAND PROCESSOR JMP NXTCM GET NEXT COMMAND SKP END RTML2 /&Z "6 91740-18048 1926 S C0322 RTML3 DS/1000 MODULE             H0103 iNASMB,R,L,C RTML3 * NAME: RTML3 RTE-M SEGMENTED GENERATOR-LOADER (SEGMENT 3) * SOURCE: 91740-18048 * RELOC: 91740-16048 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * * HED RTE-M SYSTEM GENERATOR-LOADER NAM RTML3,5 91740-16048 REV 1926 790426 * * ENTRY POINT NAMES ENT ENTPT,FIXUP * * EXTERNAL REFERENCE NAMES EXT AB#RT,ABRC1,ABREC,ADDRS,ADTRP EXT ATABL,BLINE,BPAGA,BPLOC EXT CLFL3,COML,COMOR,CONSL EXT CONV,CPAGE,DBTAD,DCB3 EXT DIAG2,ERREX,ER#OR EXT EXEC0,FFLAG,FT#ME EXT FUT1,FUT2,FUT3,FUT4 EXT FUTI,FUTP,FWABP,FWAC EXT FWAM,IDCB,IERR#,IN#CK EXT JLU,LBF10,LBUF5,LBUF#,LBUFA EXT LDGEN,LDSG3,LENGT,LER3 EXT LER5,LIBFL,LINTP,LISTO,LNKDR EXT LOCFS,LST,LST1,LST2 EXT LST3,LST4,LST5,LSTA EXT LSTI,LSTP,LSTPX,LSTUL,LWABP EXT LWAC,LWAM,MAPS,.MEM6 EXT MLOCC,MOVEX,NAMR.,NBUF,NBUFT,NSCAN EXT NXTCM,OPT.3,OTMES,PACK#,PLK,PLKS,PLK4 EXT PRINT,PUNCH,QGETC,RBTA EXT RBTO,READ#,RIC,RT.LC,RTMLC,SCAN EXT SCP,SERFG,SERNM,SSTBL,SYMOV EXT TYOFF,TYPRO,UEXFL,WRTBT,?XFER EXT XNAM,XNAMA,ZPRIV,ZRENT * EXT PNAMA,PNZQZ,PRAMS * EXT EXEC,POSNT EXT DU#MY * * * A EQU 0 B EQU 1 ERROR EQU ER#OR FTIME EQU FT#ME INDCK EQU IN#CK ABORT EQU AB#RT IERR EQU IERR# LBUF EQU LBUF# LOCC EQU MLOCC PACK EQU PACK# READ EQU READ# SUP ************************************************************************ * * THIS SEGMENT OF THE RTE-M SEGMENTED LOADER AND GENERATOR * PERFORMS ALL MODULE RELOCATION. CONTROL IS RETURNED TO * LOADER SEGMENT 2 FOR PROCESSING NEXT COMMAND. * ******************************************************************** SKP RTML3 NOP NOP LDA LBUF2 REMOVE JSB INDCK INDIRECT STA LBUF2 ADDRESSES LDA LBUF7 FOR JSB INDCK DEFS STA LBUF7 LDA NBUF6 JSB INDCK STA NBUF6 LDA LDSG3 WHERE GO FLAG SZA,RSS JMP LDRIN GO RELOCATE MODULE LDA LDGEN SZA,RSS JMP RTMLC GO PUT ENTRY IN LST JMP RT.LC * HED *** ROUTINES FOR PROCESSING RECORDS ****** SKP ***** * ** NAM RECORD PROCESSOR *** RIC = 1 * * THIS ROUTINE IS CALLED TO ASSIGN SPACE FOR A PROGRAM * TO BE LOADED. THE NAM RECORD IS MOVED FROM LBUF TO * NBUF BEFORE THIS ROUTINE IS CALLED. * SPECIAL CONVENTIONS APPLY TO FORTRAN AND ALGOL * PROGRAMS. IN A FORTRAN PROGRAM (IDENTIFIED BY 1 IN * SIGN POSITION OF WORD 7 OF NAM RECORD) THE PROGRAM * LENGTH IN WORD 7 MAY BE GREATER THAN THE ACTUAL LENGTH. * THEREFORE THE UPPER BOUND IS NOT SET UNTIL LOADING * OF DATA BLOCKS. ***** NAMR NOP LDA NBUF+10 CHECK BASE PAGE LENGTH SSA JMP ILBP ILLEGAL BASE PAGE LENGTH(<0) CLA STA CPLIN CURRENT PAGE LINK POINTER (NEXT LINK) STA CPSTR CURRENT PAGE LINK POINTER (FIRST LINK) LDA LDGEN LOADER OR GENERATOR CALLING SZA,RSS JMP NM5 GENERATOR CALLING LDA FTIME FIRST TIME THRU? SZA JMP NM5 NO, DON'T OUTPUT TYOFF RECORD LDA B2 SET ADDRESS OF TIE-OFF RECORD STA ABRC1 * OUTPUT 2 WORD TIE-OFF RECORD FOR USER PROGRAMS ONLY. * THE FIRST WORD OF THE TIE-OFF RECORD IS DEPENDENT * ON WHERE THE PROGRAM RESIDES (MEMORY RESIDENT OR IN * A PARTITION AND IF EITHER SYSTEM COMMON OR SSGA IS * MAPPED INTO THE S,YSTEM. LDA SCP SSGA/SYSTEM COMMON/PARTITION AND B7 LDB 0 LDA B4 SZB,RSS CLA,INA MEM RES/NO SSGA/NO SYS COMMON CPB B1 CLA PARTITION/NO SSGA/NO COMMON CPB B2 LDA B2 MEM RES/SYS COMMON/NO SSGA CPB B3 LDA B2 PARTITION/SYS COMMON/NO SSGA STA 1 LDA SCP AND B1 RAR SET BIT 15 IF PARTITION LOAD IOR 1 LDB FWAM JSB TYOFF OUTPUT 2 WORD RECORD FOR PROGRAM ISZ FTIME SET FOR NO MORE TYOFFS FOR NOW NM5 LDB NBUF+11 GET COMMON LENGTH. SZB,RSS JMP NM1 NO COMMON LDA FWAC SZA,RSS JMP NM6 ALLOCATE 1ST COMMON CMA,INA ADA LWAC INA STA COML CMB,INB ADB A CHECK FOR COMMON LENGTH OVERFLOW SSB,RSS JMP NM1 LENGTH GOOD LDB COMOV COMMON BLOCK ERROR JMP ERREX SPC 2 NM6 STB COML ALLOCATE 1ST COMMON LDA LOCC MOVE PROGRAM RELOCATION BASE UP. STA FWAC ADA COML STA LWAC INA STA LOCC RESET LOCATION COUNTER NM1 LDA BPLOC SET LOWER BOUND OF BASE PAGE AREA STA HLINK SAVE UPPER BOUND OF BPA FOR SYS MODS STA BPPTR INITIALIZE BASE PAGE POINTER LDA LOCC SET LOWER BOUND OF PROGRAM AREA STA PAPTR INITIALIZE PROGRAM AREA POINTER LDA FWAC STA COMOR LDA NBUF+9 GET PROGRAM LENGTH STA FTNFL SET FORTRAN LOADING FLAG - BIT 15 CPA M1 ALGOL PROGRAM? JMP NAMR,I YES. LIMITS SET DURING LOADING. * * ALLOCATE BASE PAGE STORAGE * LDA NBUF+10 GET BASE PAGE AGAIN SZA,RSS IF NO BP ALLOCATION, JMP NM2 CHECK FOR PROGRAM ALLOCATION LDB LNKDR GET LINK DIRECTION FLAG CPB M1 SYSTEM OR USER LINKS JMP NM3 SYSTEM LINKS ADA BPLOC COMPUTE LAST LOCATION & STA r B CHECK FOR OVERFLOW ADA M1 CMA,INA ADA LWABP SSA NEGATIVE MEANS OVERFLOW JMP LER4 OF BASE PAGE AREA STB BPPTR SET UPPER LIMIT B. P. JSB MLINK SET LINKS TO 100000 * * ALLOCATE PROGRAM AREA STORAGE * NM2 LDA NBUF+9 GET PROGRAM LENGTH SZA,RSS IF PROGRAM LENGTH = 0, JMP NAMR,I LDA LOCC GET LOCATION COUNTER AND M2000 ON BASE PAGE? SZA JMP NM4 NO LDA LOCC GET LOCATION COUNTER ADA NBUF+9 ADD PROGRAM LENGTH AND B1777 ONLY INTERESTED IN THAT ON BASE PAGE CMA,INA ADA LOCC STA BLINK COUNTER FOR PUTTING 100000 IN LINK TABLE LDA C1000 LDB LOCC ADB BPAGA GET ADDRESS OF 1ST WORD IN LINK TABLE STA 1,I INB GET ADDRESS OF NEXT WORD IN LINK TABLE ISZ BLINK DONE? JMP *-3 NO NM4 LDA LINTP GET LINKS IN CURRENT PAGE FLAG SZA,RSS JMP NCPLN NO CURRENT PAGE LINKS LDA NBUF+9 GET PROGRAM LENGTH AND UDFE CLEAR FORTRAN BIT STA MIN1 LDA LOCC GET PROGRAM RELOCATION BASE AND B1777 CLEAR PAGE BITS ADA MIN1 ADA M2000 SSA DOES PROGRAM CROSS PAGE BOUNDARY? JMP NCPLN NO, CURRENT PAGE LINKS ARE NOT NEEDED STA 1 CMA,INA DETERMINE NUMBER OF CURRENT ADA MIN1 PAGE LINKS NEEDED INA MIN(A:2,B):4, WHERE A = LENGTH ARS OF PROGRAM ON CURRENT PAGE AND STA MIN1 B = REST OF PROGRAM CMA,INA ADA 1 SSA,RSS LDB MIN1 ADB B3 BRS,BRS LDA LOCC GET PROGRAM RELOCATION BASE STA CPLIN STA CPSTR ADA B ADD CURENT PAGE LINK LENGTH STA LOCC SET NEW PROGRAM RELOCATION BASE STA LLINK LAST LINK NCPLN LDB FTNFL COMPILER-GENERATED? SSB JMP NAMR߈,I YES,LIMITS SET DURING DBL PROCESSING LDA NBUF+9 GET PROGRAM LENGTH ADA LOCC COMPUTE HIGH ADDRESS & STA B CHECK FOR OVERFLOW CMA,INA INA ADA LWAM SSA NEGATIVE RESULT MEANS OVERFLOW JMP LER3 MEMORY OVERFLOW ERROR STB PAPTR SET UPPER BOUND JMP NAMR,I SPC 1 NM3 ADA FWABP COMPUTE LAST CMA,INA LOCATION AND INA CHECK FOR ADA BPLOC OVERFLOW SSA NEGATIVE MEANS OVERFLOW JMP LER4 OF BASE PAGE AREA ADA M1 SET UPPER LIMIT ADA FWABP STA BPPTR JSB MLINK SET LINKS TO 100000 LDA BPPTR INA SAVE BASE PAGE RELOCATION BASE FOR STA BPLOC SYSTEM MODULES JMP NM2 * * ILBP LDB ILBPL ILLEGAL BASE PAGE LENGTH (<0) JMP ERREX * * LER4 LDB BPGOV LINKAGE AREA OVERFLOW JMP ERREX * * SPC 1 CPLIN NOP CPSTR NOP BLINK NOP FTNFL NOP 2^15 = 1 IF FORTRAN/ALGOL LLINK NOP MIN1 NOP * B1 OCT 1 B2 OCT 2 B3 OCT 3 B1777 OCT 1777 C1000 OCT 100000 M2000 OCT -2000 UDFE OCT 77777 * BPGOV DEF *+1 OCT 6 ASC 3,BPG OV * COMOV DEF *+1 OCT 6 ASC 3,COM OV * DEBUG DEF *+1 ASC 3,DEBUG * ILBPL DEF *+1 OCT 6 ASC 3,IL BPL SKP * * SUBROUTINE TO PUT ENTRY POINT IN LST * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF ENTRY POINT + 3 * JSB ENTPT * * RETURN: CONTENTS OF A AND B DESTROYED. * ENTPT NOP ADB M3 ADJUST ADDRESS OF ENTRY POINT CLA STA PTYPE STA ENTS SET FOR SUBROUTINE CALL JSB ENTI JMP ENT01 LDB SYMOV SYSTEM OVERFLOW JMP ERREX EXIT * ENT01 LDA LST3,I AND UPCM ZERO OUT EXT ID NO. IF ANY STA LST3,I JMP ENTPT,I * M3 DEC -3 * * SUBROUTINE TO PUT 100000 IN LINK TABLE. THIS PREVENTS * THIS AREA FROM BEING USED AS LINKS. * MLINK NOP LDA NBUF+10 GET BASE PAGE LENGTH CMA,INA STA BLINK COUNTER FOR PUTTING 100000 IN LINK TABLE LDA C1000 LDB BPAGA GET ADDRESS OF 1ST WORD IN LINK TABLE ADB BPLOC STA 1,I ADB LNKDR GET ADDRESS OF NEXT WORD IN LINK TABLE ISZ BLINK DONE ? JMP *-3 NO JMP MLINK,I YES, EXIT * SKP SPC 2 ***** * ** ENT ** EXT RECORD PROCESSORS * * ENT RECORD PROCESSOR (RIC = 2) * EXT RECORD PROCESSOR (RIC = 4) * * PURPOSE OF THIS SECTION IS TO PROCESS ENTRY POINTS * AND EXTERNAL SYMBOLS, ADD SYMBOLS TO THE * LOADER SYMBOL TABLE, AND * SET A FLAG IF AN ENTRY POINT FROM A LIBRARY * LOAD MATCHES AN UNDEFINED EXTERNAL SYMBOL. * CONTROL RETURNED FROM THIS SECTION TO -LDRIN-. * * WORDS USED FOR TEMPORARY STORAGE: * * LBUF - RECORD TYPE FLAG: 1 = ENT, 0 = EXT * LBUF+1 - NEGATIVE COUNT OF ENT/EXT ENTRIES IN RECORD. * LBUF+2 - FIRST WORD ADDRESS OF CURRENT ENTRY. ***** ENTI NOP ENTR CLA,INA,RSS ENT: FLAG=1 EXTR CLA EXT: FLAG=0 STA LBUF SAVE RECORD TYPE LDA LBUF+1 GET AND ISOLATE AND B77 RECORD ITEM COUNT. CMA,INA SET NEGATIVE FOR STA LBUF+1 COUNTER IN PROCESSING LDA ENTS =0 IF CALLED AS A SUBROUTINE SZA LDB LBUFA SET LBUF+2 = ADDRESS OF ADB B3 FIRST ENTRY STB LBUF+2 IN RECORD ENTX1 JSB SSTBL SEARCH SYMBOL TABLE JMP ENTX6 END OF LST - MAKE NEW ENTRY LDA LBUF IF RECORD TYPE SZA,RSS JMP EXT0 IS EXT, GO POST ORDINAL. * * SYMBOL MATCH IN ENT RECORD * LDA UDFE IS ENT DEFINED? CPA LST4,I JMP ENT21 NO. SET VALUE FROM RECORD. LDB SERFG YES, LOADING FROM LIBRARY SZB JMP ENTX5 IGNORE DUPLICATE FROM LIBRARY. LDB DUENT JSB DIAG2 COMPLAIN ABOUT DUPLICATE LDB LBUF+2 ADB B2 LDA 1,I AND UPCM IOR B40 STA 1,I LDB LBUF+2 LDA B5 PRINT "OFFENDING" ENT SYMBOL JSB PRINT LDA LENGT LDB ADDRS JSB MAPS JMP ENTX5 * DUENT DEF *+1 OCT 6 ASC 3,DU ENT * * ADD ENTRY POINT ADDRESS TO LST ENTRY. * ENT21 JSB CKTYM CHECK IF MODULE TYPE ALLOWED CLA CLEAR "LIBRARY LOAD" FLAG. STA SERFG ENT22 LDA B,I GET WORD 3 OF RECORD ENTRY STA LST3,I AND STORE IN LST WORD 3. INB GET WORD 4 OF RECORD ENTRY LDB B,I (ENTRY VALUE). AND B7 ISOLATE RELOCATION INDICATOR CPA B3 ABSOLUTE? JMP ENT24 YES CPA B4 MICROCODE REPLACEMENT? JMP ENT24 YES CMB NEGATE TO INDICATE NEW ENTRY ENT23 STB LST4,I SAVE IN LST FOR LATER ACTION. LDB PTYPE SZB,RSS TYPE 7 OR 8 MODULE? JMP ENTX5 NO LDA D8 ADA LST3,I FLAG TYPE 7 OR 8 MODULES IN LST STA LST3,I * * ENTRY FROM INPUT LOADING * * * ADVANCE TO NEXT RECORD ITEM * ENTX5 LDA ENTS =0 IF CALLED AS A SUBROUTINE SZA,RSS JMP ENTI,I LDB LBUF+2 GET OLD RECORD ENTRY ADDRESS ADB B3 ADD 3 FOR NEXT EXT ENTRY. ADB LBUF ADD ONE MORE FOR ENT RECORD. STB LBUF+2 SET ADDRESS OF NEXT ENTRY. ISZ LBUF+1 INDEX ENTRY COUNT - JMP ENTX1 MORE TO PROCESS. JMP LDRIN FINISHED- GET NEXT RECORD. * ENT24 CMA,INA STA LST5,I SAVE -TYPE IN LST5 LDA LST3,I ZERO OUT RP AND AB INDICATORS AND UPCM STA LST3,I JMP ENT23 * * NO MATCH IN LST FOR RECORD ENTRY SYMBOL - ADD * NEW ENTRY - CHECK FIRST FOR MEMORY CONFLICT. * * ENTX6 LDA LST5 SAVE UPPER LIMIT OF LST STA LSTUL LDB FFLAG SZB,RSS ANY 0 ENTRIES IN LST? JMP ENTX7 NO LDA TYPRO  USER PROGRAM? SZA,RSS JMP ENTX7 YES LDA LIBFL SEARCHING? CPA B1 JMP ENTX7 YES STB LST5 CCA STA LSTPX JSB LSTP SET LST ENTRY ADDRESSES NOP JMP ENTX9 ENTX7 ISZ LSTA,I ADD 1 TO LST ENTRY COUNT ENTX9 LDB ENTS =0 IF CALLED AS SUBROUTINE LDA LST5 CMA ADA FUT4 SSA JMP ENTX2 OVERFLOW LDB LBUF+2 (B) = RECORD ENTRY ADDR. LDA B,I MOVE WORDS 1 AND 2 OF RECORD STA LST1,I ENTRY TO WORDS INB 1 AND 2 NEW LST ENTRY LDA B,I (WORD 3 WILL BE SET LATER) STA LST2,I INB (B) = ADDR. OF WORD 3, REC. ENTRY LDA UDFE STA LST4,I DENOTE UNDEFINED. CLA STA LST5,I DENOTE NO LINK ASSIGNED LDA LBUF GET RECORD TYPE FLAG SZA JMP ENT22 ENT; GO POST VALUE. EXT0 JSB CKTYM CHECK IF MODULE TYPE ALLOWED LDA B,I GET WORD 3 OF RECORD ENTRY, STA LST3,I STORE TO POST EXT ORDINAL. LDA LST5,I SSA ABSOLUTE OR MICROCODE REPLACEMENT JMP ENTX5 YES LDA LST5,I HAS A LINK ALREADY BEEN ASSIGNED? SZA JMP ENTX5 YES, CONTINUE PROCESSING LDA LST4,I NO, ALLOCATE ONE CPA UDFE LINK ROUTINE RECOGNIZES UNDEFINED AS CLA 0 IN .A.(VALUE OF SYMBOL PARAM) JSB LINK ALLOCATE THE LINK STB LST5,I AND UPDATE SYMBOL TABLE JSB ENTCK CHECK TO MARK LINK FOR DELETION JMP ENTX5 DON'T DELETE LDB LST5,I GET LINK CCE ELB,RBR SET BIT 15 STB LST5,I JMP ENTX5 THEN CONTINUE ENTX2 SZB JMP LER5 OVERFLOW, LOADER SUBCONTROL ISZ ENTI JMP ENTI,I ERROR EXIT * * B40 OCT 40 B77 OCT 77 D8 DEC 8 * ENTS NOP =0 IF SUBROUTINE SKP ***** * ** RELEN ** RELOCATE ENTRY POINT ADDRESS * CALLING SEQUENCE: (B) = UNRELOCATED ENT VALUE * (A)=CONTENTS OF LST3(RELOCATION BASE) * JSB RELEN * RETURN: (A) = LINK ADDRESS, IF ANY * (B) = RELOCATED ENT ADDRESS * * PURPOSE: RELOCATES ENT ADDRESS AS DESIGNATED * BY THE RELOCATION FIELD (R) IN BITS * 00-01 OF (LST3). 0 = PROGRAM, 1 = BASE * PAGE, 2 = COMMON, 3 = ABSOLUTE. * ALSO POSTS VALUE IN LINK TABLE. * BITS 07-00 OF (LST3) ARE CLEARED. ***** RELEN NOP ENTRY/EXIT POINT STB SAVE1 LDB LST5,I MICROCODE REPLACEMENT OR ABSOLUTE? SSB JMP RE3 LDB SAVE1 AND B7 GET R-FIELD ADA RBTO ADB A,I RELOCATE SYMBOL VALUE STB LST4,I POST ENTRY VALUE IN LST. LDA LST5,I SZA,RSS JMP RE3 ADA BPAGA C174 STB A,I POST VALUE IN LINK TABLE LDA FWABP IF LINK IS LESS THAN FWABP CMA,INA GO OUTPUT IT NOW ADA LST5,I SSA JMP RE7 YES, GO OUTPUT RE3 JSB FIXUP DO FIXUP JMP RELEN,I FIXUP NOP LDB LINTP STB SAVE1 SAVE LINKING TYPE CLB STB LINTP SET LINKING TO BASE PAGE JSB FUTI INITIALIZE FIXUP PROCESSOR RE2 JSB FUTP SET FIXUP ENTRY ADDRESS JMP RE1 EXIT, NO MORE FIXUPS SATISFIED LDA FUT4,I DOES FIXUP ADDRESS = CPA LST1 ANY LST ADDRESS? RSS JMP RE2 NO, GET NEXT ONE LDB FUT1,I GET LOAD ADDRESS STB ABRC1 STORE FOR OUTPUTTING STB LBUF CPA M1 .ZRNT FIXUP? JMP RE6 YES LDA LST4,I GET ENTRY VALUE LDB LST5,I CPB MD4 MICROCODE REPLACEMENT? JMP RE5 YES CPB M3 ABSOLUTE? JMP RE8 YES LDB FUT2,I SZB,RSS JMP RE8 DEF SSB JMP RE8 INDIRECT LDB FUT3,I ANY OFFSET? SZB JMP RE8 YES JMP RE9 NO, DON'T OUTPUT FIXUP RE8 CCA SET TO EXTERNAL STA NBUF+1 LDB FUT2,I GET INSTRUCTION STB NBUF+2 LDB LST4,I GET VALUE OF ENTRY POINT ADB FUT3,I ADD OFFSET JSB SPLIC BUILD INSTRUCTION, ALLOC. LINK IF NEC. RE5 JSB PACK STORE INSTRUCTION FOR OUTPUTTING JSB PUNCH OUTPUT THE ABSOLUTE RECORD RE9 CLA CLEAR THE FIXUP TABLE ENTRY SO THAT STA FUT1,I IT CAN BE REUSED STA FUT2,I STA FUT3,I STA FUT4,I JMP RE2 RE1 LDA BLANK PUT BLANK BACK IN BUFFER STA LBUF LDA SAVE1 RESTORE LINK TYPE STA LINTP JMP FIXUP,I EXIT * RE6 LDA FUT2,I GET INSTRUCTION JMP RE5 GO STORE * RE7 LDA BPAGA STORE OFFSET FOR OUTPUTTING STA PLKS LDA LST5,I SAVE LOAD ADDRESS STA PLK4 LDB 0 UPPER ADDRESS JSB PLK GO OUTPUT LINK JMP RE3 GO DO FIXUP * SAVE1 NOP * M1 DEC -1 MD4 DEC -4 * BLANK ASC 1, SKP HED DBL RECORD PROCESSING * DATA BLOCK RECORD PROCESSOR (RIC = 3) SPC 2 * THIS SECTION RELOCATES THE LOAD ADDRESS OF A DATA * BLOCK AND RELOCATES AND STORES THE WORDS IN IT. * * A RELOCATION BYTE IS ASSOCIATED WITH EACH * INSTRUCTION OR DATA WORD IN A DBL RECORD. * THIS 3-BIT BYTE CONTAINS ONE OF THE * FOLLOWING RELOCATION INDICATORS: SPC 1 * 000 - ABSOLUTE * 001 - PROGRAM RELOCATABLE * 010 - BASE PAGE RELOCATABLE * 011 - COMMON RELOCATABLE * 100 - EXTERNAL SYMBOL REFERENCE (NO OFFSET) * 101 - TWO-WORD GROUP. WORD 1 CONTAINS OPCODE, * RELOCATION BYTE FOR OFFSET, AND AN OPTIONAL * EXTERNAL SYMBOL ORDINAL. WORD 2 CONTAINS THE * OFFSET (ADDRESS). THE RELOCATION BYTE CAN BE: * 00 - PROGRAM * 01 - BASE PAGE * 10 - COMMON * 11 - ABSO\[B@<,B><,T=><,X=> * * N1 = CHANNEL NO. (2 OCTAL DIGITS) * N2 = DRIVER CLASS_. CODE (2 OCTAL DIGITS) * D = DMA FLAG (OPTIONAL) * B = BUFFERING FLAG (OPTIONAL) * T = TIME-OUT VALUE TO BE ENTERED * X = # WORDS OF EQT EXTENSION * * IF T= IS ENTERED, A VALUE FOR THE DEVICE'S TIME-OUT * CLOCK MUST NEXT BE ENTERED. * THE OPERATOR MUST ENTER A POSITIVE DECIMAL NUMBER * OF UP TO FIVE DIGITS. THIS IS THEN THE NUMBER OF * TIME BASE GENERATOR INTERRUPTS (10 MSEC INTERVALS) * BETWEEN THE TIME IO IS INITIATED ON THE DEVICE AND * THE TIME AFTER WHICH THE DEVICE SHOULD HAVE INTERRUPTED. * IF THE DEVICE HAS NOT INTERRUPTED BY THIS TIME, IT * IS CONSIDERED TO HAVE TIMED-OUT. * * * EACH DRT RECORD CONSISTS OF A 2-DIGIT NO. SPECIFYING THE * CORRESPONDING ENTRY IN THE EQUIPMENT TABLE * AND AN OPTIONAL 1-DIGIT NO. SPECIFYING A * SUBCHANNEL WITHIN THAT ENTRY. FOR EXAMPLE, IN * RESPONSE TO THE MESSAGE: 5 = ?, THE RESPONSE 6 INDICATES THAT * THE LOGICAL UNIT NO. 5 IS TO USE DEVICE 6 IN EQT. * WHEREAS THE RESPONSE 6,2 INDICATES THAT THE * LOGICAL UNIT NO. 5 IS TO USE SUBCHANNEL 2 OF * DEVICE 6 IN EQT. * * * THE INT RECORDS HAVE ONE OF THE FOLLOWING FORMATS: * * N1,EQT,N2 * N1,PRG,NAME * N1,ENT,ENTRY * N1,ABS,N3 * * N1 = CHANNEL NO. (2 OCTAL DIGITS - MUST BE IN INCREASING ORDER) * EXCEPTION: IF N1 = 04 (POWER - FAIL), * THIS ENTRY DOES NOT HAVE TO BE IN ORDER. ALSO, * ONLY AN ENT OR AN ABS TYPE ENTRY IS ACCEPTED * FOR N1 = 04. * N2 = EQT NO. * NAME = PROGRAM NAME TO BE SCHEDULED * ENTRY = ENTRY POINT TO WHICH TRANSFER IS TO BE MADE * N3 = ABSOLUTE VALUE (6 OCTAL DIGITS) * * # OF I/O CLASSES * TBGEN LDA .MEM3 SET PROGRAM COUNTER TO FWAM STA PPREL LDA SYSTM GET SYSTEM TYPE CPA P1 TYPE 1? JMP BLMT YES, GET BUFFER LIMITS LDA .MEM3 SET PROGRAM COUNTER TO FWAM STA PPREL LDA .MEM2 RESET LWABP LDB BPFIX STA BPFIX STB .MEM2 JSB BUFC = JSB SPACE NEW LINE IOCLS JSB INTER INTERACTIVE INPUT LDA P19 LDB MES20 # OF I/O CLASSES? JSB TABLE PRINT MESSAGE, ANALYZE REPLY JMP IOCLS ERROR, REPEAT INPUT LDB D$CLS ADDRESS OF ENT NAME JSB ENPNT FIND ENTRY IN LST * * # OF RESOURCE NUMBERS * JSB SPACE NEW LINE RNUMB JSB INTER INTERACTIVE INPUT LDA P24 LDB MES21 # OF RESOURCE NUMBERS? JSB TABLE PRINT MESSAGE, ANALYZE REPLY JMP RNUMB ERROR, REPEAT INPUT LDB D$RNT ADDRESS OF ENTRY NAME JSB ENPNT FIND ENTRY IN LST LDA BPFIX RESET LWABP STA .MEM2 BLMT LDA P3 STA GNFLG LDA P3 STA GENRT * * BUFFER LIMITS (LOW,HIGH) * JSB SPACE NEW LINE BLMTS JSB INTER INTERACTIVE INPUT LDA P27 LDB MES22 BUFFER LIMITS (LOW,HIGH)? JSB READ PRINT MESSAGE, GET REPLY JSB BLSET SET UP DEF $BLLO LOWER LIMIT JMP BLMT0 ERROR JSB BLSET NOW SET UP THE UPPER LIMIT DEF $BLHI JMP BLMT0 ERROR JMP GEN00 * BLMT0 JSB INERR ERROR JMP BLMTS REPEAT INPUT SKP * * GENERATE I/O TABLES * GEN00 LDA PPREL STA .MEM3 SET FWAM JSB SPACE NEW LINE GENIO JSB INTER INTERACTIVE INPUT CLA STA UNDEF SET TO PRINT ALL UNDEFS STA OPT.3,I ZERO FIXUP COUNTER STA IDNOS ID'S MADE STA STRPN START UP PROGRAM FLAG STA CEQT NOS OF EQT'S STA PROCT NOS OF INT PROG ENTRIES STA START START UP PROGRAM USED * * EQT TABLE * JSB SPACE NEW LINE JSB FUTI INITIALIZE FIXUP TABLE LDA .MEM3 FWAM STA AEQT EQT STARTING ADDRESS STA PPREL LDA P9 PRINT: LDB MES25 "EQT TBL" JSB PRIN1 JSB SPACE NEW LINE * SEQT JSB INTER INTERACTIVE INPUT ?NLHJSB SPACE NEW LINE SEQT1 JSB INTER INTERACTIVE INPUT LDA CEQT EQT COUNT INA LDB MES6A STUFF INTO PRINT BUFFER JSB STFNM LDA P11 LDB MES06 EQT XX =? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA EN CHARS= END ? JMP SSQTI YES, TRY TO END CPA RE REPEAT? JMP GENIO YES * JSB GINIT INITIALIZE BUFFER SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP IOERR INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP CLDBU YES - SET CHNL NO., CLEAR D,B,T,X IOERR LDA CH SET CODE = INVALID CHNL IN EQT JSB ERRER ERROR JMP SEQT1 REPEAT INPUT SKP N* CLDBU LDB OCTNO GET I/O CHANNEL NO. STB IOADD SET I/O ADDRESS ADB N8 IS CHAN EQ. LESS THAN 10? SSB,RSS JMP GOOD ADB P4 SZB JMP IOERR YES, CHANNEL ERROR GOOD CLA STA TIMWD CLEAR TIME WORD STA IODMA CLEAR DMA FLAG STA IOBUF CLEAR AUTOMATIC BUFFERING FLAG STA EXTWD CLEAR EQT EXTENSION WORD CCA STA TFLAG CLEAR TIME-OUT FLAG STA XFLAG SET EQT EXTENSION FLAG STA DFLAG SET DMA-IN FLAG STA BFLAG SET BUFFERING-IN FLAG LDA CDEC RESTORE C. STA ASCDR+1 ADA B3000 AND I. STA ASIDR+1 LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA DV CHAR = DV? RSS JMP DVERR NO CLA,INA GET NEXT CHARACTER JSB GETNA CPA CHARR CHARACTER = R? JMP STYPE YES IOR C0 NO STA ASCDR+1 PUT IN PLACE OF "." ADA B3000 IN C. AND I. STA ASIDR+1 JMP STYPE DVERR LDA DR SET CODE = INVALID DRIVER NAME JSB ERRER PRINT DIAGNOSTIC JMP SEQT1 GET NEXT EQT RECORD STYPE LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF STA ASTYP SAVE 2 ASCII CHARS FOR I.XX,C.XX STA ASCYP SAVE FOR C.XX COMPARE CCA ADA CURAL ADJUST CURRENT LBUF ADDR STA CURAL RESET CURAL TO CONVERT TYPE LDA P2 JSB GETOC GET 2 OCTAL CHARS, CONVERT JMP DVERR INVALID DRIVER NAME ALF,ALF ROTATE TO UPPER 8 STA IOTYP SET DRIVER TYPE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? RSS YES - CONTINUE JMP DVERR NO - INVALID DRIVER NAME * * INDBU CCA STA CMFLG SET COMMA FLAG = NO COMMA IN JSB GETAL GET NEXT CHAR FROM LBUF CPA CHARD CHAR = D? rP JMP SEDMA YES - SET DMA CODE CPA CHARB CHAR = B? JMP SETBU YES - SET BUFFERING CODE CPA CHART CHAR = T? JMP SETIM YES - SET TIME-OUT FLAG CPA CHARX CHAR = X? JMP SEEXT YES - SET EXTENSION LENGTH UNERR JSB INERR SET CODE = INVALID D,B,T JMP SEQT1 GET NEXT EQT RECORD SETIM ISZ TFLAG SKIP - FIRST T ENTERED JMP UNERR DUPLICATE T'S ENTERED JSB GETAL GET NEXT CHAR CPA AEQUL IS IT "=" ? RSS YES ACCEPT TIME VALUE JMP UNERR NO, ITS AN ERROR LDA N5 5 CHAR VALUE JSB GETOC FETCH TIME OUT TIME JMP UNERR NUMBER IS NO GOOD SZA WAS ZERO INPUT? CMA ONE'S COMPLEMENT FOR THAT RTM STA TIMWD SAVE FOR OUTPUT EQTST JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? JMP LISCN SCAN FOR I.XX, C.XX CPA BLANK CHAR = COMMA? JMP INDBU YES - GET NEXT D,B,U, ENTRY JMP UNERR NO - INVALID D,B,U CHARACTER * SEDMA ISZ DFLAG SKIP - FIRST D ENTERED JMP UNERR DUPLICATE D'S ENTERED LDA MSIGN SET BIT 15 = 1 FOR DMA FLAG STA IODMA SET DMA CODE JMP EQTST TEST FOR NEXT OPERAND * SETBU ISZ BFLAG SKIP - FIRST B ENTERED JMP UNERR DUPLICATE B'S ENTERED LDA B40K SET BIT14 = 1 STA IOBUF SET AUTOMATIC BUFFERING CODE JMP EQTST TEST FOR NEXT OPERAND * SEEXT ISZ XFLAG SKIP - FIRST X ENTERED JMP UNERR DUPLICATE X'S ENTERED JSB GETAL CPA AEQUL IS IT "=" ? RSS YES ACCEPT EXTENSION VALUE JMP UNERR NO, ITS AN ERROR LDA N3 JSB GETOC GET EXTENSION JMP UNERR NUMBER IS NO GOOD STA EXTWD SAVE LENGTH OF EXTENSION SSA,RSS JMP EQTST JMP UNERR * LISCN LDB ASIDR ADDRESS OF I.XX BUFFER JSB SSTBL IS IcT IN THE SYMBOL TABLE? JMP DVERR NO LDA LST4,I YES, GET THE ADDRESS STA I.XX SAVE FOR OUTPUT LDB ASCDR ADDRESS OF C.XX BUFFER JSB SSTBL IS IT IN SYMBOL TABLE? JMP NOCXX NO, USE ADDRESS OF I.XX LDA LST4,I YES, GET ADDRESS STCXX STA C.XX SAVE DRIVER EXIT POINT * JSB BUFC LDA IODMA GET DMA CODE IOR IOBUF ADD BUFFERING CODE IOR IOADD ADD CHANNEL NO. STA LBUF+3 OUTPUT BUFFER LDA I.XX STA LBUF+1 INT. ADDRESS LDA C.XX STA LBUF+2 COMPLETE ADDRESS * LDA IOTYP GET EQUIPMENT TYPE CODE AND M1000 ISOLATE UPPER 7 BITS SZA SKIP - TYPE = 0,I CLA,RSS SET STATUS = 0, SKIP LDA BLANK SET STATUS = 40(8) IOR IOTYP ADD EQUIPMENT TYPE CODE STA LBUF+4 LDA TIMWD WAS A TIME INPUT ? SZA STA LBUF+13 YES, SAVE IT IN EQT LDA EXTWD GET EXTENSION LENGTH SZA,RSS JMP NOEXT NO EXTENSION JSB FUTS GET FIXUP FOR EQT EXTENSION NOP LDA EXTWD STA LBUF+11 SAVE EXTENSION LENGTH STA FUT1,I SAVE FOR FIXUP LDA PPREL SAVE CURRENT EQT ADDRESS ADA P12 STA FUT4,I SAVE FOR FIXUP ISZ OPT.3,I INCREMENT NO. OF FIXUP ENTRIES LDA LSTUL CMA ADA FUT4 SSA CHECK FOR MEMORY OVERFLOW JMP LER5 NOEXT LDA PPREL GET CURRENT EQT ADDRESS LDB A ADB P14 ADDRESS OF END OF EQT STB PPREL JSB SETCR OUTPUT IN ABS ISZ PPREL BUMP TO NEXT EQT ENTRY ISZ CEQT INCR EQT ENTRY COUNT CLA STA FTIME JMP SEQT PROCESS NEXT EQT RECORD * SPC 1 NOCXX LDA I.XX C.XX NOT FOUND SO USE JMP STCXX I.XX ADDRESS * SSQTI LDA CEQT ANY EQT'S BEEN LOADED? SZA JMP SSQT YES, CAN END JSB INERR NO, AT LEAST} ONE REQUIRED JMP SEQT1 START OVER LER5 LDA SO SYSTEM OVERFLOW JSB ERRER JMP GENIO START OVER * * DO FIXUPS FOR EQT EXTENSIONS * SSQT JSB FUTI INITIALIZE FIXUP FOR EQT EXTENSION FUTNT JSB FUTS GET NEXT FIXUP JMP FUTED JSB BUFC CLEAR BUFFER LDA PPREL GET NEXT ADDRESS FOR EQT EXTENSION STA LBUF LDB FUT1,I GET EQT EXTENSION LENGTH STB COUNT LDB FUT4,I START ADDRESS LDA FUT4,I END ADDRESS JSB OUTCR OUTPUT ADDRESS AND LENGTH JMP FUTNT SKP * ZERO DEC 0 N5 DEC -5 N8 DEC -8 P14 DEC 14 P19 DEC 19 M1000 OCT -1000 B3000 OCT 3000 B40K OCT 40000 C0 OCT 41400 MSIGN OCT 100000 * AEQUL OCT 75 CHARB OCT 102 CHARD OCT 104 CHARR OCT 122 CHART OCT 124 CHARX OCT 130 * CDEC ASC 1,C. DV ASC 1,DV CH ASC 1,CH INVALID CHANNEL NO. IN EQT REC DR ASC 1,DR INVALID DRIVER NAME RE ASC 1,RE SO ASC 1,SO SYSTEM OVERFLOW * ASCDR DEF *+1 ASC 1,C. ASCYP NOP OCT 20000 ASIDR DEF *+1 ASC 1,I. ASTYP NOP OCT 20000 * MES6A DEF MES6I MES06 DEF *+1 ASC 3,* EQT MES6I NOP ASC 2, =? MES25 DEF *+1 ASC 5,* EQT TBL * AEQT NOP ADDRESS OF EQUIPMENT TABLE BFLAG NOP BUFFERING-IN FLAG FOR EQT CEQT NOP NO. ENTRIES IN EQUIPMENT TABLE C.XX NOP DRIVER EXIT POINT DFLAG NOP DMA-IN FLAG FOR EQT EXTWD NOP EQT EXTENSION LENGTH IOADD NOP I/O ADDR (CHANNEL NO.) IN EQT IOBUF NOP I/O BUFFERINF FLAG IN EQT IODMA NOP I/O DMA FLAG IN EQT I.XX NOP DRIVER ENTRY OINT IOTYP NOP I/O DRIVER TYPE IN EQT (OCTAL) TFLAG NOP TIME-OUT ENTRY FLAG FOR EQT TIMWD NOP TIME WORD XFLAG NOP EQT EXTENSION FLAG SKP * * SET DEVICE REFERENCE TABLE (SQT) * FUTED JSB SPACE NEW LINE FUTE JSB INTER R INTERACTIVE INPUT LDA PPREL UPDATE REL ADDRESS STA ASQT SAVE SQT ADDRESS CLA,INA STA CSQT SET SQT COUNT = 1 LDA P9 LDB MES26 DRT TBL JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE LDA P6 LDB MS26A LU #: JSB PRIN1 PRINT MESSAGE * DEVRE JSB INTER INTERACTIVE INPUT LDA CSQT GET CURRENT DEV REF NO. LDB MS28I JSB STFNM STUFF NUM IN BUFFER JSB SPACE NEW LINE DEVER JSB INTER INTERACTIVE INPUT LDA P13 LDB MES28 XX = EQT #? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA EN CHARS = EN? JMP SINTI YES - SET INTERRUPT TABLE CPA RD REPEAT DRT? JMP DRT01 YES, START OVER CPA RE REPEAT EQT? JMP GENIO YES, GO BACK JSB GINIT RE-INITIALIZE LBUF SCAN LDA N3 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP DRERR INVALID DIGIT ENTERED STA TEMPL SAVE DEV. REF. NO. SZA,RSS IF NO CHANNEL JMP NOSUB IGNOR SUBCHANNEL LDA CMFLG COMMA ENCOUNTERED? SZA YES - GO GET SUBCHANNEL JMP NOSUB NO - DEFAULT IT TO ZERO LDA N2 JSB GETOC GET TWO DECIMAL DIGITS JMP DRERR JSB GETAL GET NEXT CHAR CPA ZERO END OF BUFFER? RSS YES JMP DRERR NO, SHOULD BE BUT ISN'T LDA OCTNO GET SUB CHANNEL RSS SKIP OVER DEFAULT NOSUB CLA DEFAULT TO ZERO ALF,ALF SET SUBCHANNEL NO. ALF,RAR INTO BITS 13 - 11 STA TEMPH SAVE SUBCHANNEL NO. LDA TEMPL GET DEV. REF. NO. CMA,INA COMPLEMENT ADA CEQT ADD NO. EQT ENTRIES SSA SKIP IF VALID DEV. REF NO. JMP DRERR INVALID DEV. REF. NO. (NO EQT) LDA TEMPL GET DEV.. REF NO. LDB CSQT GET CURRENT SQT NO. CPB P1 FIRST ENTRY? RSS YES - CONTINUE JMP SETQT PUT OUT DEV REF NO. TO SQT SZA,RSS SKIP IF DEV REF IS NOT ZERO JMP DRERR INVALID DEV. REF. NO. ADA N1 LDB 0 CMA,INA BLF MULTIPLY BY ADB 0 15 ADB AEQT ADD ADDRESS OF EQT STB LBUF+1 SET EQT ADDR IN TTY CHANNEL LDA TBCHN TBG CHANNEL STA LBUF PUT IN OUT PUT BUFFER LDA TBG ADDRESS WHERE TO GO LDB SYSTY JSB SETCR OUTPUT IN ABSOLUTE * SETQT LDA TEMPL GET DEV. REF. NO. IOR TEMPH SET IN SUBCHANNEL NO. LDB PPREL ABS ADDRESS JSB STCR1 GO BUILD ABS DATA ISZ PPREL INCR CURRENT RELOC ADDRESS ISZ CSQT INCR CURRENT SQT COUNT CLA STA FTIME JMP DEVRE GET NEXT SQT ENTRY * DRERR LDA LU SET CODE = INVALID DEV. REF. NO. JSB ERRER ERROR JMP DEVER REPEAT INPUT SKP * SINTI LDA CSQT HAVE ANY DRT'S BEEN ENTERED? ADA N1 STA CSQT SZA SSA JMP DRERR NO, ERROR, START OVER JSB BUFC LDA PPREL CCB ADB 0 ADB CSQT STB PPREL JSB SETCR ISZ PPREL JMP SINTT YES, GO TO INT PROCESSING * DRT01 JSB SPACE NEW LINE JSB INTER INTERACTIVE INPUT JMP FUTE SPC 3 * ASQT NOP ADDRESS OF DRT COUNT NOP CSQT NOP NO. OF ENTRIES IN DRT TEMPH NOP SUBCHANNEL NO. (BITS 11-13) TEMPL NOP DEV. REF. NO. EN ASC 1,EN LU ASC 1,LU INVALID DEV. REF. NO. RD ASC 1,RD * P11 DEC 11 P13 DEC 13 * MES26 DEF *+1 ASC 5,* DRT TBL MS26A DEF *+1 ASC 3,* LU#: MS28I DEF MS28A MES28 DEF *+1 ASC 1,* MS28A ASC 6, = EQT #? SKP * * SUBROUTINE TO ANALYZE INPUT * TABLE NOP JS-B READ PRINT MESSAGE, GET REPLY LDA N3 SET FOR 3 DECIMAL DIGITS JSB DOCON JMP TABLE,I ERROR EXIT, REPEAT INPUT STA LBUF STA COUNT AND M400 CHECK FOR VALUE >=0 AND <=255 SZA,RSS ISZ TABLE OK SZA JSB INERR ERROR JMP TABLE,I SPC 5 * * SUBROUTINE TO FIND ENTRY POINT IN LST * ENPNT NOP JSB SSTBL FIND ENTRY POINT JMP RELSE NOT THERE, START OVER LDB PPREL GET CURRENT ADDRESS STB LST4,I SAVE IN LST LDA LST5,I POST VALUE IN LINKS TABLE SZA,RSS JMP ENP1 ONLY IF LINK EXISTS ADA BPAGA STB 0,I ENP1 LDA 1 ISZ PPREL JSB OUTCR OUTPUT LDA ENPNT STA SAVE1 JMP RTMLI RTMG6 LDA SAVE1 STA ENPNT JSB BUFC LDA LST4,I LINK VALUE LDB LST5,I LINK ADDRESS SZB,RSS JMP ENPNT,I NO LINK JSB STCR1 OUTPUT LINK JMP ENPNT,I SKP * * SUBROUTINE TO OUTPUT ABSOLUTE CODE * OUTCR NOP JSB SETCR OUTPUT IN ABS JSB BUFC CLEAR OUTPUT BUFFER NEXT LDB COUNT BUFFER LENGTH SZB,RSS 0 LENGTH JMP OUTCR,I LDA PPREL NEXT OUPUT ADDRESS ADB N64 SZB SSB JMP LAST LAST OUTPUT STB COUNT LDB 0 ADB P63 STB PPREL JSB SETCR OUTPUT IN ABS ISZ PPREL JMP NEXT LAST CCB ADB 0 ADB COUNT STB PPREL NEW OUTPUT ADDRESS JSB SETCR OUTPUT IN ABS ISZ PPREL JMP OUTCR,I * P63 DEC 63 * * THE BLSET SUBROUTINE SETS UP THE BUFFER LIMITS. * * CALLING SEQUENCE: * * JSB BLSET * DEF ENT NAME ENTRY POINT NAME ADDRESS * JMP RETRY ERROR RETURN * * --- NORMAL RETURN * BLSET NOP LDB BLSET,I GET THE ENTRY POINT ISZ BLSET STEP RETURN ADDRESS JSB SSTBL SEARCH FBOR THE ENTRY JMP FGET IF NOT FOUND JUST EXIT LDA N5 CONVERT A FIVE DIGIT DECIMAL JSB GETOC JMP BLSET,I LDB LST4,I GET THE LIST ADDRESS CMA,INA SET THE LIMIT NEGATIVE JSB STCR1 GO OUTPUT THE LIMIT FGET ISZ BLSET STEP TO OK RETURN JMP BLSET,I SKP SKP * * ROUTINE TO CONVERT THE OCTAL NUMBER IN A TO * ASCII AND STUFF THE 2 LOW ORDER DIGITS INTO A BUFFER * ADDRESSED BY B. LEADING ZEROS ARE SUPPRESED * * CALLING SEQUENCE: * * A = OCTAL NUMBER * B = BUFFER ADDRESS * * RETURN: A AND B ARE DESTROYED * STFNM NOP STB STFAD SAVE FINAL ADDRESS LDB ATBUF TEMP BUFFER ADDRESS CMA,INA NEG FOR DECIMAL CONVERT JSB CONVD LDA TBUF+2 LEAST 2 DIGITS AND M400 ISOLATE UPPER CHAR CPA B30K CHAR = ASCII ZERO? LDA B20K YES, REPLACE WITH BLANK STA B SAVE UPPER CHAR LDA TBUF+2 GET ORIG DIGITS AND B177 ISOLATE LOWER CHAR IOR B MERGE STA STFAD,I STORE IN BUFFER JMP STFNM,I * STFAD NOP B177 OCT 177 B30K OCT 30000 M400 OCT -400 * SKP HED RTMGN INTERRUPT TABLE PROCESSOR SKP * * INTERRUPT TABLE PROCESSOR * SINTT JSB SPACE NEW LINE SINT JSB INTER INTERACTIVE INPUT LDA PPREL GET CURRENT RELOCATION ADDR STA AINT SAVE INTERRUPT TABLE ADDRESS LDA P9 LDB MES29 MES29 = ADDR. * INT TABLE JSB PRIN1 PRINT: INT TBL LDA A$CIA $CIC ADDRESS IOR IJSB ADD JSB 0,I CODE STA JSCIC SET JSB CIC,I CODE JSB BUFCL JSCIC OCT 0 STUFF DATA CLA STA PROCT LDB LWGBP LDA 1 CMA,INA ADA P58 SSA LDB P58 LDA P5 JSB SETCR OUTPUT JSB $CIC,I * LDA HLTB4 SET HLT 4 INTO LOC 4 LDB P4 ADDRESS JSB STCR1 OUTPUT HLT 4 LDB P6 GET ADDR OF FIRST INT LOCATION STB TBREL SET CURRENT BP ADDRESS JSB SPACE NEW LINE * SETIN JSB INTER INTERACTIVE INPUT LDA P3 LDB QUEST ? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA EN CHARS = EN? JMP ENDIO YES - I/O TABLES COMPLETE CPA RI REPEAT INTERRUPT? JMP SINT YES CPA RE GO BACK TO EQT? JMP GENIO YES CPA RD REPEAT DRT? JMP DRT01 YES JSB GINIT RE-INITIALIZE LBUF SCAN LDA P2 JSB GETOC GET 2 OCTAL DIGITS, CONVERT JMP CHERR INVALID INT CHANNEL NO. DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = COMMA? JMP SETCH SAVE INT CHANNEL NO. CHERR JSB INERR ERROR JMP SETIN REPEAT INPUT * SETCH LDA OCTNO GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. ADA N4 CHAN L.T. 4? SSA JMP CHERR YES, CHANNEL ERROR * LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA EQ CHARS = EQ? JMP INTEQ YES - PROCESS INT EQT RECORD CPA PR CHARS = PR? JMP INTPR YES - PROCESS INT PRG RECORD CPA EN CHARS = EN? JMP INTEN YES - PROCESS INT ENT RECORD CPA AB CHARS = AB? JMP INTAB YES - PROCESS INT ABS RECORD IMNEM LDA NA SET CODE = INVALID INT MNEMONIC JSB ERRER ERROR JMP SETIN REPEAT INPUT * INTEQ LDA N2 JSB GETNA MOVE NEXT 2 CHARS TO TBUF CPA T CHARS = T,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA N2 JSB GETOC GET 2 DECIMAL DIGITS, CONVERT JMP EQUER INVALID EQT NO. IN INT REC LDA OCTNO GET EQT TABLE ENTRY NO. CMA,INA,SZA,RSS SKIP - VALID LOWER LIMIT JMP EQUER IN$BVALID EQT REFERENCE STA 1 SAVE EQT NO. ADA CEQT ADD UPPER EQT REF. NO. SSA,RSS SKIP - INVALID UPPER LIMIT JMP TSTIQ TEST FOR FIRST EQT REFERENCE EQUER LDA EQ SET CODE = INVALID EQT NO. JSB ERRER ERROR JMP SETIN REPEAT INPUT * TSTIQ LDA OCTNO GET EQT ENTRY NO. ADA N1 ALF MULTIPLY BY ADA 1 15 INA ADA AEQT ADD ADDRESS OF EQT TABLE LDB JSCIC GET JSB CIC CODE JMP COMIN SET INTERRUPT TABLE, LOCATION * INTPR LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA G CHARS = G,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA TBREL FETCH CHANNEL CMA,INA ADA INTCH ASSENDING ORDER? SSA,SZA JMP IMNEM NO, ERROR LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF LDA TBUF+2 NAME: 5 AND M400 MASK OUT LOWER HALF IOR INTCH PUT IN CHN(SELECT CODE) STA TBUF+2 SAVE IN TABLE LDA ATBUF ADDRESS OF NAME JSB LDIPX PUT IN TABLE CLA LDB JSCIC JMP COMIN * INTEN LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA T CHARS = T, BLANK RSS YES - CONTINUE JMP IMNEM INVALID INT MNEMONIC LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF LDB ATBUF ADDR OF NAME JSB SSTBL SEARCH SYMBOL TABLE RSS NOT FOUND, ERROR JMP SETE1 SET ENTRY POINT ADDRESS ENERR LDA AD SET CODE = INVALID ENTRY POINT JSB ERRER ERROR JMP SETIN REPEAT INPUT * SETE1 LDA LST5,I HAS LINK BEEN MADE? SZA,RSS JMP SETEN NO, GO MAKE ONE IOR IJSB YES, FORM THE JSB FOR BP STA B CLA JMP COMIN SETEN LDA LST4,I GET BP LINK ADDRESS LDB .MEM2 MAKE A BP LINK JSB STCR1 LDA .MEM2 STA LST5,I IOR IJSB ADD JSB 0,I CODE STA 1 CCA ADJUST LWABP ADA .MEM2 STA .MEM2 CLA SET INT ENTRY = ZERO JMP COMIN SET INTERRUPT TABLE, LOCATION * INTAB LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA S CHARS = S,BLANK RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA P6 JSB GETOC GET 6 OCTAL DIGITS, CONVERT JMP IMNEM INVALID ABS DIGIT CLA LDB OCTNO GET ABSOLUTE VALUE * COMIN STA TBUF SAVE INT TABLE CODE STB TBUF+1 SAVE INT LOCATION CODE JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO END OF BUFFER? RSS YES, CONTINUE JMP ENERR NO, BUT SHOULD BE LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR CMA,INA ADA TBREL ADD CURRENT ADDRESS SZA,RSS SKIP - NOT NEXT LOCATION JMP STINT SET INTERRUPT TABLES, LOCATION SSA SKIP - INVALID CHANNEL NO. ORDER JMP FILLI FILL IN SKIPPED VALUES EQERR LDA CH SET CODE = INVALID INT CHNL ORDR JSB ERRER ERROR JMP SETIN REPEAT INPUT * PFINT LDA TBUF IF TRAP CELL FOUR, SZA ENTRY MUST BE AN JMP CHERR 'ABS' OR AN 'ENT' LDB P4 LDA TBUF+1 STORE INTO JSB STCR1 CLA STA FTIME JMP SETIN GET NEXT INTERRUPT RECORD * * FILLI STA TCNT SET NO. OF FILL-INS REQUIRED CLA SET INTERRUPT TABLE ENTRY = ZERO LDB PPREL ADDRESS JSB STCR1 ISZ PPREL INCR CURRENT INT TABLE ADDRESS ISZ TBREL INCR CURRENT INT LOCATION ADDR ISZ TCNT SKIP - ALL FILL-INS COMPLETE JMP FILLI+1 CONTINUE INT FILL-IN * STINT ISZ TBREL INCR CURRENT BP LOCATION ADDR LDB TBREL GET INT LOCATION ADDR CMB,INB  ADB P64 ADD ADDR OF FIRST SYS LINK SSB SKIP - INT LOCATION OVERFLOW JMP EQERR * LDA TBUF+1 GET INT LOCATION CODE LDB TBREL INT. ADDRESS PLUS ONE ADB N1 ADJUST JSB STCR1 SET CORE LDA TBUF GET INT TABLE CODE LDB PPREL ADDRESS JSB STCR1 OUTPUT IT ISZ PPREL INCR CURRENT RELOCATION ADDR CLA STA FTIME JMP SETIN GET NEXT INT TABLE RECORD ENDIO LDA AINT GET ADDRESS OF INT CMA,INA ADA PPREL ADD CURRENT RELOCATION ADDR STA CINT SAVE NO. INT ENTRIES JSB SPACE NEW LINE JSB SPACE NEW LINE * * OUTPUT EQTA THRU INTLG * LDA AEQT EQT START ADDRESS STA LBUF LDA CEQT NUMBER OF EQTS STA LBUF+1 LDA ASQT DRT START ADDRESS STA LBUF+2 LDA CSQT NUMBER OF DRT'S STA LBUF+3 LDA AINT INTERRUPT TABLE ADDRESS STA LBUF+4 LDA CINT NUMBER OF INTERRUPT ENTRIES STA LBUF+5 LDA EQTA START ADDRESS-ABS LDB INTLG END ADDRESS JSB SETCR GO BUILD ABS JMP JMPFT * N4 DEC -4 P58 DEC 58 P64 DEC 64 * EQ ASC 1,EQ INVALID EQT NO. IN INT RECORD G ASC 1,G NA ASC 1,NA PARAMETER NAME ERROR PR ASC 1,PR PARAMETER PRIORITY ERROR QUEST DEF *+1 ASC 2,* ? RI ASC 1,RI S ASC 1,S T ASC 1,T * HLTB4 OCT 103004 TRAP CELL DEFAULT VALUE IJSB JSB 0,I I-JSB CODE FOR INTERRUPT LOCS * CINT NOP NO. ENTRIES IN INTERRUPT TABLE INTCH NOP INT RECORD CHANNEL NO. TBREL NOP * MES29 DEF *+1 ASC 5,* INT TBL SKP * * ALLOCATE SPACE FOR MEMORY PROTECT FENCE TABLE * JMPFT LDB $MPFT NAME OF TABLE LDA PPREL CURRENT ADDRESS JSB STUFF PUT IN $MPFT LDA PPREL STA MPFT ADA P5 STA PPREL UPDATE CURRENT ADDRESS * * AALLOCATE SPACE FOR MEMORY RESIDENT MAP * LDA SYSTM GET SYSTEM TYPE CPA P3 TYPE = 3? RSS JMP ID NO, GET NO. OF ID SEGMENTS LDB $MRMP NAME OF TABLE LDA PPREL CURRENT ADDRESS JSB STUFF PUT IN $MRMP LDA PPREL SAVE ADDRESS OF TABLE STA MRMP ADA P32 STA PPREL UPDATE CURRENT CORE ADDRESS HED PARTITION DEFINITION SKP * * SET MAXIMUM NUMBER OF PARTITIONS AND CREATE MAT TABLES * LDB $MATA NAME OF TABLE LDA PPREL CURRENT ADDRESS STA MATA ADDRESS OF MEMORY ALLOCATION TABLE -1 INA JSB STUFF PUT IN $MATA JSB SPACE NEW LINE PARTN JSB INTER INTERACTIVE INPUT LDA P27 LDB MES18 MAX NUMBER OF PARTITIONS? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB DOCON JMP PARTN REPEAT INPUT STA LBUF SAVE MAXIMUM NUMBER OF PARTITIONS STA MAXPT SZA,RSS JMP PTERR NO. OF PARTITIONS MUST BE > 0 CMA,INA STA NMAX ADA P64 SSA,RSS JMP PAROK NUMBER OF PARTITIONS >=1 AND <=64 PTERR JSB INERR JMP PARTN REPEAT INPUT PAROK LDA PPREL OUTPUT FOR HEADER OF LDB 0 MEMORY ALLOCATION TABLE JSB SETCR ISZ PPREL JSB BUFC CCA STA LBUF SET FIRST WORD TO -1 NXMAT LDA PPREL LEAVE ROOM FOR PARTITION DEFINITIONS LDB 0 IN MAT. 6 WORD ENTRIES FOR EACH ADB P5 STB PPREL JSB SETCR ISZ PPREL ISZ NMAX JMP NXMAT JSB SPACE JMP ID * MES18 DEF *+1 ASC 14,* MAX NUMBER OF PARTITIONS? * * $MATA DEF *+1 ASC 3,$MATA $MPFT DEF *+1 ASC 3,$MPFT $MRMP DEF *+1 ASC 3,$MRMP END RTMG1 @{TRNNT ) J 91740-18051 2013 S C0122 &RTMG2              H0101 ~uASMB,R,L,C RTMG2 * NAME: RTMG2 RTE-M SEGMENTED GEN.-LOADER (SEGMENT 6) * SOURCE: 91740-18051 * RELOC: 91740-16051 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * HED RTE-M SYSTEM GENERATOR-LOADER NAM RTMG2,5 91740-16051 REV 2013 800129 * * A EQU 0 ***************** - HIGH CORE - ****************** * * * - IDENTS - * * * ************************************************** * - FIXUP TABLES - * * ---------- * * * * * * ------- * * - LST - * ************************************************** * * * * * PROGRAM LOADING CONTROL * * * * * ************************************************** * * * * I/O TABLE GENERATION * * * * ************************************************** * * * * * PARAMETER INPUT * * id * * * ************************************************** * * * SKP * * * * * * RTMGN PROGRAM TABLE FORMAT (IDENTS) * * WORD 1: IP1 - NAME 1,2 * WORD 2: IP2 - NAME 3,4 * WORD 3: IP3 - NAME 5,SC * * SC = 0 PROGRAM HAS BEEN LOADED * = XX (OCTAL) INT PRG * * * LST FORMAT * * WORD 1: LST1 - NAME 1,2 * WORD 2: LST2 - NAME 3,4 * WORD 3: LST3 - NAME 5, ORDINAL * WORD 4: LST4 - IDENT ADDRESS * WORD 5: LST5 - BP LINK ADDRESS * * * * ENTERNS AND EXTERNS * * * EXT ADDRS,ABRT1,BPLOC,CLFL2,CONSO EXT DCB2,ER#OR,EXEC6,IN#CK,KONSO EXT LENGT,LNKDR,LST4,LSTUL EXT MAPS,.MEM1,.MEM2 EXT .MEM3,.MEM4,.MEM5,.MEM6,MLOCC,OPT.3 EXT PLK4,PLK,PLKS,PRINT EXT SSTBL,TIMES EXT ?XFER * EXT AINT#,ALBUF,BIDNT,CURAT EXT DO#ON,ELIB,GBUF,GE#AL,GE#NA EXT GE#OC,GI#IT,GNSG2,GREAD,GTIME EXT IDNOS,IDS,IDSAD,IN#RR EXT INTER,IP1,IP2,IP3 EXT KEYCN,LWACG,LWAMG,LWSA1 EXT MATA,MAXPT,MPFT EXT MRMP,MSIZE,OC#NO EXT PARNO,PCOM,PGLIB,PLIB,PNAMA,PNZQZ,PP#EL EXT PRIN1,PRIN2,PROCT,RANAD,REL06,RELOC EXT RTMLI,SAVE2,SG1AD,SP#CE,SSGAP,START EXT STRAD,STRPN,SYSAD,SYSTM,TBUF#,TCNT,WDCNT * EXT $OPSY EXT DU#MY * * * ERROR EQU ER#OR INDCK EQU IN#CK AINT EQU AINT# DOCON EQU DO#ON GETAL EQU GE#AL GETNA EQU GE#NA GETOC EQU GE#OC GINIT EQU GI#IT INERR EQU IN#RR LOCC EQU MLOCC OCTNO EQU OC#NO PPREL EQU PP#EL SPACE EQU SP#CE TBUF EQU TBUF# FTIME EQU GTIME LBUF EQU GBUF READ EQU GREAD * * * * * .MEM. TABLE DEFINITIONS * * .MEM1 = FWABP * .MEM2 = LWABP * .MEM3 = FWAM * .MEM4 = LWAM * .MEM5 = FWAC * .MEM6 = LWAC * * * * ERROR CODES * * AD: INVALID ENTRY POINT * CH: INVALID CHANNEL NUMBER * DR: INVALID DRIVER NAME * DU:]R DUPLICATE PROGRAM NAME * EQ: INVALID EQT. NO. IN INT. RECORD * IN: PARAMETER INTERVAL EXECUTION ERROR * LU: INVALID DEVICE REFERENCE NUMBER * ON: INVALID ON PARAMETER * NA: PARAMETER NAME ERROR * PA: PARAMETER ERROR * PD: PARTITION ALREADY DEFINED * PR: PARAMETER PRIORITY ERROR * PS: NOT ENOUGH MEMORY LEFT FOR PARTITION * PT: PARTITION DEFINITION ERROR * SO: SYSTEM OVERFLOW * TB: SYMBOL TABLE/ID SEGMENT OVERFLOW * * SUP SKP RTMG2 NOP NOP LDA IDAA REMOVE JSB INDCK STA IDAA INDIRECT LDA STRPA JSB INDCK ADDRESSES STA STRPA LDA PATBL FOR JSB INDCK STA PATBL DEFS LDA APNAM JSB INDCK STA APNAM LDA GNSG2 WHERE GO FLAG SZA,RSS JMP REL06 RET TO SEG. THAT CALLED LDR. SUBCONTROL CPA P1 JMP RTMG4 FIRST ENTRY IN GEN SEG 2 CPA P2 JMP RTMG7 RELOCATE RESIDENT LIBRARY JMP RTMGS RETURN FROM SNAP OUTPUT * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * * SYSTEM TABLE DEFINITION * * . EQU 1650B KEYWD DEF .+7 FWA OF KEYWORD BLOCK * * DEFINITION OF SYSTEM LISTS (QUEUES) * * SKEDD DEF .+33 'SCHEDULE' LIST, * * DEFINITION OF MEMORY ALLOCATION BASES * * BPA1 DEF .+58 FWA USER BP LINK AREA LBORG DEF .+61 FWA OF RESIDENT LIBRARY AREA RTORG DEF .+62 FWA OF REAL-TIME COMMON RTCOM DEF .+63 LENGTH OF REAL TIME COMMON AREA AVMEM DEF .+65 LWA+1 MEMORY REAL TIME PARTITION BGORG DEF .+66 FWA OF BACKGROUND COMMON * * UTILITY PARAMETERS * BGLWA DEF .+87 LWA MEMORY BACKGROUND PARTITION SKP * * ROUTINE TO RESERVE AND SET CORE ON THE * LOADER PRODUCED ABSOLUTE OUTPUT. * * CALLING SEQUENCE: * A = FINAL STARTING ADDRES * B = FINAL ENDING ADDRESS * * SETAD = ADDRESS OF JTHE OUTPUT DATA BUFFER * * JSB SETCR * * RETURN: A AND B ARE DESTROYED * SETCR NOP STA TEMP1 CMA,INA ADA ALBUF BUFFER ADDRESS STA PLKS OFFSET ADDRESS LDA TEMP1 STARTING ADDRESS STA PLK4 JSB PLK OUTPUT ROUTINE IN THE LOADER JMP SETCR,I * * * * SUBROUTINE TO DETERMINE IF ANSWER IS YES OR NO * MAYBE NOP JSB READ PRINT MESSAGE, GET REPLY LDA N2 GET FIRST TWO ASCII CHARACTERS JSB GETNA CCB CPA NO NO? CLB YES CPA YE YES? CLB,INB YES SSB,RSS ISZ MAYBE SSB JSB INERR PARMETER ERROR JMP MAYBE,I * NO ASC 1,NO YE ASC 1,YE * N2 DEC -2 SKP * * * * THE BUFCL SUBROUTINE STUFFS A 64 WORD BUFFER WITH CALL+1 * * CALLING SEQUENCE: * A = IGNORED * B = ADDRESS OF BUFFER * JSB BUFCL * CALL+1 = DATA TO BE STUFFED * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * BUFCL NOP LDB ALBUF LDA N64 STA WDCNT SET BUFFER LENGTH = 64 LDA BUFCL,I GET STUFF DATA STA 1,I CLEAR BUFFER WORD INB ISZ WDCNT ALL WORDS CLEAR? JMP *-3 NO - CONTINUE CLEARING ISZ BUFCL JMP BUFCL,I RETURN * N64 DEC -64 SPC 5 * * SUBROUTINE TO CLEAR THE OUTPUT BUFFER * BUFC NOP JSB BUFCL OCT 0 JMP BUFC,I SKP * * ROUTINE TO COMPARE TWO NAME BUFFERS * * * CALLING SEQUENCE: * A = ADDRESS OF SOURCE NAME- 3 ENTRIES * B = ADDRESS OF TABLE 3 ENTRIES * JSB NACMP * * RETURN: A AND B ARE DESTROYED * (N+1) NAMES DO NOT COMPARE * (N+2) NAMES COMPARE * NACMP NOP STA TEMP1 SAVE SOURCE ADDRESS STB TEMP2 SAVE TABLE ADDRESS LDA N2 LOOP COUNT STA TEMP3 NACM1 LDA TEMP1,I SOURCE ENTRY CPA TEMP2,I TABLE COMPARE RSS YES,COMPARE, LOOK NEXT JMP NACMP,I NO IT DOESN'T RETURN ISZ TEMP1 BUMP SOURCE ISZ TEMP2 BUMP TABLE ISZ TEMP3 JMP NACM1 TRY AGAIN LDA TEMP2,I FIRST TWO COMPARE, LOOK LAST AND M400 LOOK UPPER ONLY STA 1 LDA TEMP1,I AND M400 CPA 1 ISZ NACMP BUMP RETURN FOR COMPARE! JMP NACMP,I * M400 OCT -400 TEMP1 NOP TEMP2 NOP TEMP3 NOP SKP * * * * SUBROUTINE TO RESERVE AND SET CORE * * CALLING SEQUENCE: * A = DATA TO BE OUTPUT * B = ADDRESS OF DATA * JSB STCR1 * * RETURN: * A = DATA WORD OUTPUTTED * STCR1 NOP STA LBUF SAVE DATA TO BE OUTPUT LDA 1 SET A REG TO ADDRESS JSB SETCR GO OUTPUT IT LDA LBUF GET DATA JMP STCR1,I SPC 5 SKP * * SUBROUTINE TO GET THE ADDRESS OF THE FOLLOWING ENTRIES * IN THE LST, TO SET THEM TO THEIR PROPER VALUE, AND TO * OUTPUT THEM. * STUFF NOP STA LBUF SAVE VALUE OF ENTRY JSB SSTBL FIND IN LST JMP ABRT1 ISN'T THERE, START OVER LDA LST4,I GET ADDRESS LDB 0 JSB SETCR GO OUTPUT VALUE JMP STUFF,I * * THE 3 WORD PROGRAM NAME IS PUT INTO THE RTMGN PROG * TABLE. THE NAMES ARE LOADED FROM THE TOP DOWN. * * CALLING SEQUENCE: * A = ADDRESS OF PROGRAM NAME * B = IGNORED * JSB LDIPX * * RETURN: A AND B ARE DESTROYED * LDIPX NOP STA IPXSV SAVE PROG NAME ADDRESS JSB INIPX INITIALIZE TO START OF TABLE LDA PROCT NUMBER OF ENTRIES ALS MULT X2 ADA PROCT PLUS ONE TO MAKE IT X3 CMA,INA ADA BIDNT BUILD NEXT NAME ADDRESS STA BIDNT FOR SAVE JSB IPX INITIALIZE IP POINTERS LDA IPXSV,I GET N1-N2 STA IP1,I PUT IN TABLE ISZ IPXSV BUMP POINTER LDA IPXSV,I GET N3-N4 STA IP2,I SAVE ISZ IPXSV ]LDA IPXSV,I GET N5-XX STA IP3,I SAVE ISZ PROCT BUMP NUMBER OF NAMES JMP LDIPX,I RETURN * IPXSV NOP PROGRAM NAME ADDRESS * SKP * * INIPX SETS THE ADDRESS OF THE FIRST ENTRY IN THE * PROGRAM IDENT TABLE AS THE CURRENT ADDRESS. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * * RETURN: A AND B DESTROYED * INIPX NOP LDA LWAMG ADA N2 STA BIDNT JMP INIPX,I * * * * THE IPX ROUTINE ADDRESSES THE CURRENT 3 WORD ENTRY * IN THE INTERRUPT PROGRAM TABLE FROM THE ADDRESS OF * THE CURRENT ENTRY (BIDNT). THE TABLE START ADDRESS * IS LWAM. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IPX * * RETURN, CONTENTS OF A AND B ARE DESTROYED * IPX NOP LDA BIDNT BUILD POINTERS STA IP1 INA STA IP2 INA STA IP3 ADA N5 STA BIDNT JMP IPX,I * * N5 DEC -5 SKP * SKP * CONVERT A TO ASCII AT B * * THE CONVD SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT THE LOCATION SPECIFIED * BY B. THE CONVERTED RESULT REQUIRES 3 WORDS, AND IS * IN THE FORMAT: XXXXX, WITH A SPACE IN THE FIRST POSITION. * * CALLING SEQUENCE: * A = NO. TO BE CONVERTED. IF THE SIGN OF A IS POS., * THE CONVERSION IS TO BE IN OCTAL; IF NEGATIVE, * IN DECIMAL. * B = ADDRESS OF CORE LOCATION FOR CONVERTED RESULT * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * CONVD NOP STB CURAT SET MESSAGE ADDRESS LDB OPWRS GET ADDR OF OCTAL POWERS SSA SKIP IF OCTAL CONV REQUIRED LDB DPWRS GET ADDRESS OF DECIMAL POWERS STB RANAD SET POWER RANGE ADDRESS SSA,RSS SKIP IF NEGATIVE (DECIMAL) CMA,INA CONVERT NUMBER TO NEGATIVE STA 1 PUT NUMBER IN B (REMAINDER) LDA N2 STA TCNT SET CONVERSION COUNTER JSB GETD GET FIRST DIGIT IOR B20K ADD BLANK TO FIRST CHAR STA CURAT,I SAVE FIRST BLANK, CHARACTER ISZ CURAT INCR MESSAGE ADDRESS NEXTD JSB GETD GET NEXT DIGIT ALF,ALF ROTATE TO UPPER STA CURAT,I SAVE UPPER CHARACTER JSB GETD GET NEXT DIGIT IOR CURAT,I ADD UPPER CHAR STA CURAT,I SAVE NEXT 2 CHARACTERS ISZ CURAT INCR MESSAGE ADDRESS ISZ TCNT SKIP - 5 DIGITS IN JMP NEXTD NO - CONTINUE WITH NEXT DIGIT JMP CONVD,I YES - RETURN * B20K OCT 20000 SKP * * DPWRS DEF *+1 DEC 10000 DEC 1000 DEC 100 DEC 10 P1 DEC 1 OPWRS DEF *+1 OCT 10000 OCT 1000 OCT 100 OCT 10 OCT 1 * SKP SKP * * GETD PROVIDES THE ASCII CHARACTERS FOR CONVD. * * CALLING SEQUENCE: * A = IGNORED * B = REMAINDER * JSB GETD * * RETURN: * A = ASCII DIGIT * B = IGNORED * GETD NOP CLA INCRA ADB RANAD,I ADD POWER CMB,SSB,INB,SZB SKIP - TRY NEXT HIGHER DIGIT JMP *+4 DIGIT FOUND INA INCR DIGIT CMB,INB RESTORE REMAINDER TO NEGATIVE JMP INCRA TRY HIGHER DIGIT ADB RANAD,I ADD POWER CMB,INB RESTORE REMAINDER ISZ RANAD INCR POWER LIST ADDRESS IOR B60 CONVERT TO ASCII JMP GETD,I RETURN WITH DIGIT IN A * B60 OCT 60 * SKP * * GET PAGE NUMBER * PAGE NOP AND B76K GET PAGE BITS ALF SHIFT TO BITS 0 - 5 RAL,RAL JMP PAGE,I * B76K OCT 76000 SPC 5 * * THIS ROUTINE WILL OUTPUT A 31 WORD BLOCK FROM THE * I/O BUFFER AREA. * * CALLING SEQUENCE: * A = ABS STARTING ADDR * B = IGNORED * JSB GENID * * RETURN: A AND B ARE DESTROYED * OUTID NOP LDB A ADB P30 SET LAST ADDRESS JSB SETCR GO SET CORE  JMP OUTID,I RETURN * SKP * THIS ROUTINE WILL BUILD AN ID SEGMENT IN THE OUTPUT * BUFFER (LBUF) AREA. THE BUFFER IS CLEARED AND STUFFED * WITH DATA (FROM THE PNAME TABLE) BEFORE BEING OUTPUT * BY THE OUTID ROUTINE. * * CALLING SEQUENCE: * A = ABSOLUTE ADDRESS OF SEGMENT * B = LIST LINK ADDREESS TO NEXT SEGMENT * JSB GENID * * * RETURN: A AND B ARE DESTROYED * GENID NOP STA IDSAV STB LNKSV JSB BUFC CLEAR BUFFER LDA LNKSV GET LINK ADDRESS STA LBUF PUT IN BUFFER LDA PNZQZ+7 GET PRIORITY SZA,RSS LDA P9999 DEFAULT TO 9999 STA LBUF+6 LDA ?XFER ENTRY POINT STA LBUF+7 LDA IDSAV ADDRESS OF WORD 2 OF INA ID SEGMENT STA LBUF+10 LDA PNZQZ NAME 1,2 STA LBUF+12 LDA PNZQZ+1 NAME 3,4 STA LBUF+13 LDA PNZQZ+2 NAME 5, BLNK AND M400 MASK OUT BLANK INA MAKE TYPE 1 STA LBUF+14 LDA PNZQZ+8 RESOLUTION ALF,ALF ALF,RAL SHIFT INTO PLACE IOR PNZQZ+9 MERGE EXEC MULT STA LBUF+17 PUT IN BUFFER JSB TIMES PROCESS TIME PARAMETERS STA LBUF+18 STB LBUF+19 LDA .MEM3 LOW MAIN STA LBUF+22 LDA LOCC HIGH MAIN STA LBUF+23 LDA .MEM1 LOW BASE STA LBUF+24 LDA BPLOC HIGH BASE STA LBUF+25 LDA LOCC UPDATE FWAM STA .MEM3 FWAM LDA BPLOC UPDATE FWABP STA .MEM1 FWABP LDA IDSAV ABS ADDRESS JSB OUTID GO OUTPUT ID SEGMEMT JMP GENID,I RETURN * IDSAV NOP ABSOLUTE ADDRESS OF SEGMENT LNKSV NOP LINK ADDRESS TO NEXT SEGMENT * P9999 DEC 9999 * SKP * * SEARCH RTMGN PROG TABLE * * THIS IS A MULTIPLE ENTRY ROUTINE WHICH WILL EITHER * SEARCH FOR A NAME OR CONTINUE FROM THE LAST FIND. * * CALLING SEQUENCE: * $ A = ADDRESS OF NAME (3WORD) * B = IGNORED * JSB SRIPX * * RETURN: * (N+1) PROGRAM NAME WAS FOUND IN TABLE, IN IP1-3 * (N+2) REACHED THE END OF THE PROGRAM TABLE * SRIPX NOP LDB WDCNT SEARCH OR CONTINUE? SZB JMP SRIP1 CONTINUE STA SRISV INIT SEARCH JSB INIPX SET UP IP POINTERS LDA PROCT NUMBER OF ENTRIES CMA STA WDCNT SAVE FOR LOOPING SRIP1 ISZ WDCNT ALL DONE? JMP *+3 NO, GO COMPARE NAMES ISZ SRIPX YES, BUMP RETURN JMP SRIPX,I JSB IPX SET POINTERS LDB IP1 NAME IN TABLE LDA SRISV,I LOOK FOR NAME JSB NACMP GO COMPARE JMP SRIP1 DOSN'T COMPARE, LOOK NEXT JMP SRIPX,I DOES COMPARE, RETURN * SRISV NOP IDAA DEF *+1 ID5 NOP PRIORTY ID6 NOP RESOLUTION CODE ID7 NOP EXEC. MULTIPLE ID8 NOP HOURS ID9 NOP MINUTES ID10 NOP SECONDS ID11 NOP TENS OF MILLISECONDS * M20K OCT -20000 * SET PARAMETERS SKP * * THE PARAMETER INPUT SECTION PERMITS ALTERATION (OR INTRODUCTION) * OF THE NAME, PRIORITY, AND EXECUTION INTERVAL FOR EACH PROGRAM. * EACH PARAMETER RECORD HAS ONE OF THE FOLLOWING FORMATS: * * NAME * NAME,PRIORITY * NAME,PRIORITY,EXECUTION INTERVAL * * PRIORITY = 5 DECIMAL DIGITS (1-32767) * EXECUTION INTERVAL = 6 OPERANDS * 1 - RESOLUTION CODE (2 DECIMAL DIGITS) * 2 - EXECUTION MULTIPLE (5 DECIMAL DIGITS) * 3 - HOURS (2 DECIMAL DIGITS) * 4 - MINUTES (2 DECIMAL DIGITS) * 5 - SECONDS (2 DECIMAL DIGITS) * 6 - 10'S MULLISECONDS (2 DECIMAL DIGITS) * * * RETURN: A AND B ARE DESTROYED * (N+1): SOME PARAMETERS WERE ENTERED * (N+2): NO PARAMETERS WERE ENTERED * * TBUF CONTAINS THE ENTERED NAME * * PARAM NOP PAR00 JSB READ GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHAR7S INPUT JMP PAR01 REPEAT PARAMETER INPUT STA PARNO SAVE PARAMETER RECORD LENGTH CLA STA ID5 STA ID6 STA ID7 STA ID8 STA ID9 STA ID10 STA ID11 JSB GETAL CPA B60 JMP PARAM,I STA 1 CMA,INA CHECK TO SEE IF ASCII ADA B132 IS < = TO OCT 132 SSA JMP PAR05 NO CMA,INA ADA B71 AND > = TO OCT 41 SSA JMP PAR05 NO ADB M56 OCT 47 TO OCT 55 SSB,RSS NOT ALLOWED JMP PAR02 > = OCT 56 CMB,INB ADB N8 SSB JMP PAR05 > = OCT 47 AND < = OCT 55 PAR02 ISZ PARAM JSB GINIT INITIALIZE BUFFER SCAN LDA N5 JSB GETNA MOVE CHARS FROM LBUF TO TBUF JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = BLANK?(DELIMITER = COMMA) JMP SETYP YES - CONTINUE CPA ZERO JMP PARAM,I * PAR05 LDA PA PARAMETER NAME ERROR JMP PARER PAR01 JSB INTER JSB SPACE LDA LENGT LDB ADDRS JMP PAR00 * * SET NEW PROGRAM PRIORITY SETYP LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAPER PRIORITY ERROR JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) RSS YES - CONTINUE CPA BLANK CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY PAPER LDA PR PARAMETER PRIORITY ERROR JMP PARER * SETNR LDB OCTNO GET PRIORITY STB ID5 SET NEW PRIORITY JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO ? (END OF BUFFER) JMP PARAM,I YES,RETURN * * GET RESOLUTION CODE LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA ID6 SET IN IDENT 6 * * k GET EXECUTION MULTIPLE LDA N5 SET COUNT FOR DECIMAL CONVERSION JSB EXINT GET DIGITS FROM LBUF AND M20K ISOLATE UPPER 3 BITS IN A SZA SKIP IF VALID MULTIPLE JMP PAIER INVALID EXECUTION INTERV FORMAT LDA OCTNO GET CONVERTED NUMBER STA ID7 * * GET HOURS LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N24 STA ID8 * * GET MINUTES LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N60 STA ID9 * * GET SECONDS LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF ADA N60 STA ID10 * * GET TENS OF MILLISECONDS LDA N2 SET FOR DECIMAL CONVERSION JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = 0? (END OF BUFFER) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA OCTNO ADA N100 STA ID11 JMP PARAM,I * * EXECUTION INTERVAL INPUT CONTROL EXINT NOP JSB GETOC CONVERT TO OCTAL JMP PAIER INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK CHAR = BLANK? (DELIMITER=COMMA) RSS YES - CONTINUE JMP PAIER NO - INVALID DELIMITER LDA OCTNO GET CONVERTED NUMBER JMP EXINT,I RETURN WITH NUMBER IN A PAIER LDA IN PARAMETER INTERVAL ERROR * PARER CLB NO FMP ERROR JSB ERROR ERROR JMP PAR01 REPEAT INPUT * IN ASC 1,IN PARAMETER INTERVAL ERROR PA ASC 1,PA PARAMETER ERROR PR ASC 1,PR PARAMETER PRIORITY ERROR * M56 OCT -56 N8 DEC -8 N24 DEC -24 N60 DEC -60 N100 DEC -100 B71 OCT 71 B132 OCT 132 ZERO DEC 0 BLANK OCT 40 * SKP SKP * THIS ROUTINE WILL UPDATE THE PARAMETERS IN THE * PNAME TABEL. THE SOURCE WILL BE FROM THE * "ENTR PRAMS" TABLE * * CALLING SEQUENCE: * A = SOURCE ADDRESS * B = IGNORED * JSB UPNAM * * RETURN: A AND B ARE DESTROYED * UPNAM NOP STA TEMP1 SAVE SOURCE ADDRESS LDA TEMP1,I GET PRIORITY STA PNZQZ+7 YES ISZ TEMP1 LDA TEMP1,I GET RESOLUTION SZA STA PNZQZ+8 UPDATE ISZ TEMP1 LDA TEMP1,I EXEC MULT. SZA STA PNZQZ+9 ISZ TEMP1 LDA TEMP1,I HOURS SZA STA PNZQZ+10 ISZ TEMP1 LDA TEMP1,I MINUTES SZA STA PNZQZ+11 ISZ TEMP1 LDA TEMP1,I SECONDS SZA STA PNZQZ+12 ISZ TEMP1 LDA TEMP1,I TENS OF MILLISECONDS SZA STA PNZQZ+13 JMP UPNAM,I RETURN * HED BUILD ID'S AND KEY WORD TABLE * * GET ID'S AND BUILD KEY WORD TABLE * RTMG4 JSB BUFC LDA PPREL KEY WORD TABLE ADDRESS LDB KEYWD ABS ADDRESS JSB STCR1 LDA PPREL STA KEYAD KEY WORD ADDRESS KEYID JSB INTER LDA P10 LDB MES42 # ID SEGS? JSB READ PRINT MESSAGE, GET REPLY LDA N2 GET TWO DECIMAL JSB GETOC JMP IDWER BAD NUMBER STA KEYCN # OF ID SEGS TO KEY COUNT SZA,RSS JMP IDWER DO NOT ACCEPT ID COUNT OF ZERO! CMA,INA ADA P99 OR > 99 SSA JMP IDWER LDA KEYCN RESTORE A ADA PPREL ADD TO PRESENT LOCATION ADA P3 FOR ZERO END STA PPREL UPDATE PPREL STA SYSAD INITIAL ID SEG ADDRESS STA IDSAD FIRST ID SEG ADDRESS JMP *+3 IDWER JSB INERR ERROR JMP KEYID REPEAT INPUT JSB GETAL SZA JMP IDWER NO, ERROR LDA KEYCN NO. OF KEY WORDS CMA,INA STA WDCNT LDA SYSAD STA TEMP2 LDA KEYAD STA TEMP3 KYBLD LDA TEMP2 ADDRESS OF NEXT ID LDB TEMP3 KEY WORD ADDRESS ISZ TEMP3 BUMP TO NEXT KEY WORD ADDR JSB STCR1 OUTPUT TO ABS LDA TEMP2 UPDATE ID ADDRESS ADA P31 SEG SIZE STA TEMP2 ISZ WDCNT ALL DONE? JMP KYBLD NOT DONE YET STA PPREL NEW RELOCATE ADDRESS JSB BUFC CLA ZERO LDB TEMP3 LAST KEYWORD ADDRESS JSB STCR1 LDA KEYCN GET ID SEG COUNT CMA,INA STA WDCNT SAVE NEG LDA SYSAD ADDRESS OF FIRST ID SEG STA TEMP3 ADA N2 LDB 0 INB CLEAR 1ST TWO WORDS OF ID SEGMENT JSB SETCR CLOOP LDA TEMP3 STARTING ADDRESS LDB A ADB P30 BUMP TO LAST ADDR STB TEMP3 UPDATE STB LBUF ISZ LBUF POINT TO NEXT ID SEG ISZ TEMP3 TO NEXT ADDR JSB SETCR CLEAR ID SEGMENT ISZ WDCNT ALL DONE? JMP CLOOP NO, DO MORE LDB TEMP3 CLEAR LAST LINK POINTER ADB N31 CLA JSB STCR1 * * RESERVE SPACE FOR IDENTS * LDA KEYCN # OF ID SEGMENTS ALS ADA KEYCN MULTIPLY BY 3 CMA,INA ADA OPT.3 STA OPT.3 SET FOR START OF FIXUP TABLE LDB LSTUL HIGHEST LST ENTRY CMB ADA 1 SSA,RSS JMP STUPG GET START UP PROGRAM LSERR LDA TB IDENTOLST OVERFLOW CLB NO FMP ERROR JSB ERROR IRRECOVERABLE ERROR JMP ABRT1 EXIT TO SYSTEM SKP * N31 DEC -31 P3 DEC 3 P10 DEC 10 P30 DEC 30 P99 DEC 99 * KEYAD NOP ADDRESS OF KEYWORD TABLE * MES42 DEF *+1 ASC 5,* #ID SEG? * TB ASC 1,TB IDENT/LST OVERFLOW HED GET START-UP PROGRAM * * GET START-UP PROGRAM * STUPG JSB SPACE NEW LINE JSB INTER LDA P16 LDB MES05 START-UP PROG JSB PARAM GO GET PARAMETERS JMP RTMLI NO PARAMS WERE INPUT LDA TBUF MOVE NAME 1,2 STA STRPN STA START START-UP PROGRAM USED LDA TBUF+1 NAME 3,4 STA STRPN+1 LDA TBUF+2 NAME 5 AND UPCR IOR BLANK STA STRPN+2 LDA SYSAD SEG ONE ADDRESS LDB SKEDD ADDRESS IN BASE PAGE JSB STCR1 TO ABSOLUTE LDA SYSAD SEG ONE ADDRESS STA SG1AD ADA P31 UPDATE TO NEXT STA SYSAD ISZ IDNOS BUMP NOS OF ID'S * JMP RTMLI SKP HED RELOCATE RESIDENT LIBRARY * * RELOCATE RESIDENT LIBRARY * RTMG7 JSB SPACE NEW LINE RESL1 JSB INTER INTERACTIVE INPUT LDA PPREL UP LOCC FOR RELOCATE STA .MEM3 LDB LBORG JSB STCR1 LDA P13 PRINT: LDB MES04 REL RES LIB JSB RELOC RELOCATE MODULE DEC 2 JMP RESL1 LOADER ERROR, TRY AGAIN LDA .MEM3 STA SAVE2,I STA PLIB SAVE ADD JUST PAST RES LIB STA SSGAP ADA N1 STA ELIB ADDRESS AT END OF RES LIB JSB PAGE GET PAGE NO. STA PGLIB PAGE NO. AT END OF RES LIB SPC 5 * * RELOCATE SSGA MODULES * JSB SPACE NEW LINE RSSGA JSB INTER INTERACTIVE INPUT LDA P10 LDB MES19 REL SSGA JSB RELOC RELOCATE MODULE DEC 3 JMP RSSGA LOADER ERROR, TRY AGAIN LDA .MEM3 LDB RTORG BASE PAGE LOCATION JSB STCR1 OUTPUT TO ABS JSB BUFC LDA .MEM1 SET BASE PAGE LOWER LIMIT STA LBUF LDA .MEM2 SET BASE PAGE UPPER LIMIT STA LBUF+1 LDA BPA1 FIRST BP ADDRESS LDB A INB LAST BP ADDRESS JSB SETCR SET TO BP COMMON AREA SKP * * t SET UP COMMON AREA * JSB SPACE NEW LINE WDSCM JSB INTER INTERACTIVE INPUT LDA P16 LDB MES07 # WDS IN COMM? JSB READ PRINT MESSAGE, GET REPLY LDA N5 JSB DOCON GET 5 DIGITS JMP WDSCM ERROR, REPEAT INPUT LDA .MEM3 UPDATE FWAC STA .MEM5 ADA OCTNO UPDATE LWAC * * ADJUST COMMON AREA TO PAGE BOUNDARY * JSB SIZE PRINT LAST WORD OF COMMON JSB SPACE NEW LINE ALIGN JSB INTER INTERACTIVE INPUT LDA P21 LDB MES23 ALIGN AT NEXT PAGE? JSB MAYBE PRINT MESSAGE, GET REPLY JMP ALIGN ERROR, REPEAT INPUT SZB,RSS JMP MPFTI NO LDA .MEM6 YES, ADJUST LWAC TO END OF PAGE AND M2000 ADA B2000 JSB SIZE PRINT LAST WORD OF COMMON MPFTI LDA .MEM6 SAVE LWAC STA LWACG LDA .MEM5 GET FWAC CMA,INA ADA .MEM6 DETERMINE COMMON LENGTH INA LDB RTCOM COMMON SIZE TO BASE PAGE JSB STCR1 * * STUFF MEMORY PROTECT FENCE TABLE AND OUTPUT IT * JSB BUFC CLEAR OUTPUT BUFFER LDA PLIB 1ST ENTRY IN MPFT STA LBUF ADD JUST PAST RES LIB STA LBUF+3 STA LBUF+4 LDA .MEM3 ADDRESS JUST PAST COMMON STA LBUF+1 LDA .MEM5 ADDRESS AT START OF COMMON STA LBUF+2 LDA MPFT LDB 0 ADB P4 JSB SETCR OUTPUT TABLE JMP REL00 SKP * APNAM DEF PNAMA * M2000 OCT -2000 N4 DEC -4 B1001 OCT 100001 B2000 OCT 2000 P4 DEC 4 P13 DEC 13 P15 DEC 15 P16 DEC 16 P19 DEC 19 P21 DEC 21 P28 DEC 28 * DU ASC 1,DU DUPLICATE ENTRY * MES3I DEF MES3A MES03 DEF *+1 ASC 9,* LWA OF COMMON = MES3A BSS 3 MES04 DEF *+1 ASC 7,* REL RES LIB MES05 DEF *+1 ASC 8,* START-UP PROG? MES07 DEF *+1 ASC 8,* # WDS IN COMM? MES19 DEF *+1 ASC 5,* REL SSGA MES23 DEF *+u1 ASC 11,* ALIGN AT NEXT PAGE? * * * * DISPLAY LWA OF COMMON * * SIZE NOP STA .MEM3 SET FWAM ADA N1 STA .MEM6 LDB MES3I JSB CONVD STUFF LWAC TO OUTPUT BUFFER LDA P24 LDB MES03 LWA OF COMMON = JSB PRIN1 JMP SIZE,I * N1 DEC -1 P24 DEC 24 HED RELOCATE CORE RESIDENT PROGRAMS * * RELOCATE CORE RESIDENT PROGRAMS * REL00 CLA,INA SET LINK DIRECTION FLAG STA LNKDR TO USER LINKS REL01 JSB SPACE NEW LINE RELRS JSB INTER INTERACTIVE INPUT LDA IDNOS GET # OF ID SEGMENTS LEFT CMA,INA ADA KEYCN LDB STRPN START-UP PROGRAM REQUESTED? SZB INA YES STA IDS SZA,RSS ANY ID SEGMENTS LEFT? JMP IDZER NO LDA P16 LDB MES08 REL USER PROGS JSB RELOC DEC 0 JMP RELRS LOADER ERROR, TRY AGAIN LDA ?XFER WAS ZERO INPUT? SZA,RSS JMP SNAPO YES, GO DO SNAPSHOT * * CHANGE PARAMETERS * JSB SPACE NEW LINE SRFIN JSB INTER INTERACTIVE INPUT LDA P13 LDB MES10 ENTER PRAMS JSB PARAM GO GET PARAMS JMP SRFI5 NO PARAMS INPUT, NO CHANGE LDA TBUF NAME 1,2 STA PNZQZ LDA TBUF+1 NAME 3,4 STA PNZQZ+1 LDA TBUF+2 NAME 5 STA PNZQZ+2 LDA IDAA ADDRESS OF PARAMETERS JSB UPNAM UPDATE PARAMETERS SRFI5 CLA STA WDCNT CLEAR FOR FIRST TIME LDA APNAM JSB SRIPX SEARCH FOR DUPS JMP *+7 FOUND ONE LDA PNZQZ+2 MASK OUT LOWER BLANK AND M400 STA PNZQZ+2 AND RESTORE LDA PNAMA THIS NAME NOT IN TABLE JSB LDIPX SO, PUT IT THERE JMP SRFI6 CONTINUE PROCESSING LDA IP3,I IS THIS AN INT PRG? AND B77 SZA JMP SRFI6 YES, ITS OK LDA DU NO, LOOKS LIKE A DUP ENTRYxA CLB NO FMP ERROR JSB ERROR JMP SRFIN ERROR, REPEAT INPUT * SRFI6 LDA STRPA ADDRESS OF START UP NAME LDB PNAMA JUST LOADED NAME JSB NACMP COMPARE NAMES JMP SRFI2 NO COMPARE CLA DOES COMPARE STA STRPN CLR STRT FLAG LDA IDSAD SEGMENT ADDRESS CLB POINTS TO ADDRESS JSB GENID GO BUILD ID SEGMENT LDA IDSAD GET ID SEG ADDRESS INA POINT TO TEMPORARY STORAGE LDB 0 ADB P9 WORD 11 IN SEG JSB STCR1 ADD WORD TO SEG CLA,INA STA LBUF LDA IDSAD ADA P15 PUT A 1 INTO WORD 16 OF THE SEG LDB A JSB SETCR LDA IDSAD GET CORRECT ID SEG ADDRESS JSB SRFI3 "PROGS" WERE ENTERED, GO LOOK FOR IT JMP REL01 GO RELOCATE NEXT * SRFI2 ISZ IDNOS ENTERED PROGS EXCEEDED ID SEGS? LDA IDNOS CMA,INA ADA KEYCN SSA JMP LSERR IRRECOVERABLE ERROR YES!! LDA SYSAD GET CORRECT ID SEG ADDRESS JSB SRFI3 GO CHECK FOR INT-PRGS LDA SYSAD BUILD SEG IN THIS ADDRESS LDB A ADB P31 LOOK TO NEXT SEGMENT STB SYSAD DYNAMIC SEG POINTER JSB GENID BUILD ID SEG LDA IDNOS NO. OF ID SEGMENTS USED CPA KEYCN ON LAST ONE? RSS JMP REL01 NO, GO GET NEXT LDB SYSAD DON'T LINK TO NEXT ID SEGMENT ADB N31 CLA JSB STCR1 JMP REL01 GO GET NEXT * SRFI3 NOP STA PPREL SAVE ID SEG ADDRESS CLA STA WDCNT CLEAR FOR INITIAL ENTRY LDA APNAM ADDRESS OF INPUTTED PROG NAME SRFI4 JSB SRIPX GO SEARCH RSS FOUND NAME JMP SRFI3,I END OF TABLE LDA IP3,I COMPARES,GET SC AND B77 SZA,RSS JMP SRFI4 ADA AINT ADDRESS OF INTERRUPT TABLE ADA N6 LDB A LDA "PPREL SET NEG OF ID ADDRESS CMA,INA INTO THE INTERRUPT TABLE JSB STCR1 LDA IP3,I AND M400 STA IP3,I SHOW ENTRY AS USED JMP SRFI4 LOOK AGAIN SKP * N3 DEC -3 N6 DEC -6 N30 DEC -30 P5 DEC 5 P9 DEC 9 P22 DEC 22 P36 DEC 36 P38 DEC 38 B77 OCT 77 * ESAM NOP END OF SAM FPSAM NOP FIRST PAGE OF SAM LPMRP NOP LAST PAGE OF MEMORY RESIDENT PROGRAMS LWAMR NOP LWA OF MEM RES PROG AREA NOSAM NOP SAM NOP * STRPA DEF STRPN * MES08 DEF *+1 ASC 8,* REL USER PROGS MES10 DEF *+1 ASC 7,* ENTER PRAMS ME35I DEF ME35A MES35 DEF *+1 ASC 10,* LWA MEM RES PROG = ME35A BSS 3 OCT 20040 ASC 4,CHANGE? ME36I DEF ME36A MES36 DEF *+1 ASC 4,* SAM = ME36A BSS 3 OCT 20040 ASC 3,WORDS ME37I DEF ME37A MES37 DEF *+1 ASC 16,* NO. ADD. PAGES FOR SAM? MAX = ME37A BSS 3 SKP HED CHANGE CORE BOUNDARIES * * START-UP PROGRAM REQUESTED? * IDZER LDA P21 LDB MES48 NO ID SEGMENTS LEFT JSB PRIN1 PRINT MESSAGE SNAPO LDA STRPN WAS START-UP PRG REQUESTED? SZA,RSS BUT NOT LOADED JMP MRPA NO LDA IDS SZA,RSS ANY ID SEGMENTS LEFT? JMP LSERR NO, IRRECOVERABLE ERROR JSB SPACE NEW LINE LDA P16 LDB MES05 START-UP PROG? JSB PRIN2 PRINT MESSAGE JSB INTER INTERACTIVE INPUT JSB SPACE NEW LINE LDA P5 LDB STRPA START-UP PROG NAME JSB PRINT PRINT MESSAGE LDA P5 LDB STRPA JSB MAPS JSB SPACE NEW LINE JSB INTER INTERACTIVE INPUT CLA STA FTIME CLA,INA STA CONSO INPUT TO SESSION CONSOLE JMP RELRS RELOCATE START-UP PROGRAM * MRPA LDA KONSO STA CONSO CLA STA PPREL HEADER FLAG STA WDCNT LDA P1 NAME ADDRESS SNAP6 JSB SRIPX GO SEARCH RSS FOUND SOMETHING JMP SNAP7 END OF TABLE LDA IP3,I IS IT AN INT PRG NAME? AND B77 SZA,RSS JMP SNAP6 NO, LOOK NEXT LDA PPREL HEADER BEEN PRINTED? SZA JMP *+7 YES JSB SPACE NO, PRINT IT LDA P10 LDB MES12 INT PRGS STA PPREL SET HEADER FLAG JSB PRIN2 JSB SPACE NEW LINE LDA IP3,I PUT BLANK IN LAST CHARACTER AND UPCR IOR P32 STA IP3,I LDA P5 LDB IP1 PRG NAME JSB PRINT LDA LENGT LDB ADDRS JSB MAPS JMP SNAP6 LOOK NEXT * SNAP7 JSB SPACE NEW LINE SNAP9 JSB INTER INTERACTIVE INPUT LDA PPREL ANY INT PRGS PRINTED? SZA,RSS JMP MRPA4 NO, CONTINUE CLA,INA STA CONSO LDA P9 LDB MES13 IGNORE? JSB MAYBE PRINT MESSAGE, GET REPLY JMP SNAP9 ERROR, REPEAT INPUT SZB,RSS JMP RELRS MRPA4 LDA KONSO STA CONSO LDA START SZA,RSS ANY START-UP PROGRAM? JMP MRPA0 NO JSB BUFC LDB SG1AD ADB P28 LDA B1001 JSB STCR1 MRPA0 JSB SPACE NEW LINE MRPA1 JSB INTER INTERACTIVE INPUT CCA ADA .MEM3 GET LWA MEM RES PROG STA LWAMR LDB ME35I JSB CONVD PUT IN OUTPUT BUFFER LDA P36 LDB MES35 LWA MEM RES PROG = XXXXX CHANGE? JSB READ PRINT MESSAGE, GET REPLY LDA P5 JSB DOCON GET NEW LWA MEM RES PROG JMP MRPA1 REPEAT INPUT SZA,RSS LDA LWAMR NO CHANGE STA LWMRP CMA,INA CHECK IF LWAMR IS SMALLER THAN BEFORE ADA LWAMR CMA,INA SSA,RSS JMP MRPA3 NEW LWAMR IS > OR = OLD LWAMR JSB INERR ERROR, TRY AGAIN JMP MRPA1 MRPA3 LDA LWMRP STA LWAMR A JSB SPACE NEW LINE ALSAM JSB INTER INTERACTIVE INPUT LDA P21 LDB MES23 ALIGN AT NEXT PAGE? JSB MAYBE PRINT MESSAGE, GET REPLY JMP ALSAM ERROR, REPEAT INPUT SZB,RSS JMP MRPA2 NO LDA LWAMR YES, ADJUST LWAMR TO END OF PAGE AND M2000 ADA B1777 STA LWAMR MRPA2 LDA LWAMR STA .MEM4 NO, RESET LWAM AND M2000 ADJUST SYS AV. MEM. TO END ADA B1777 OF PAGE CLB CPA LWAMR CLB,INB MEM RES PROGS EXTEND TO END OF PAGE STA ESAM END OF SAM JSB PAGE GET PAGE NO. STA LPMRP LAST PAGE OF MEM RES PROGS ADA 1 STA FPSAM FIRST PAGE OF SAM CMB,INB STB NOSAM LDA LWSA1 LDB SYSTM CPB P3 LDA ESAM LDB LWAMR CMB,INB ADA 1 SSA JMP MRERR SAM NEGATIVE, ERROR EXIT STA SAMSZ CMA,INA LDB ME36I JSB CONVD PUT SAM SIZE IN OUTPUT BUFFER LDA P22 LDB MES36 SAM = JSB PRIN1 PRINT MESSAGE LDB SYSTM GET SYSTEM TYPE CPB P3 TYPE 3 SYSTEM? RSS JMP SNAP5 NO LDA ELIB ADDRESS AT END OF LIB LDB PCOM PRIV. DRIVERS ACCESS COMMON? SZB LDA .MEM6 YES, USE LAST WORD OF COMMON JSB PAGE GET PAGE NUMBER STA ECLIB SAVE PAGE AT END OF COMMON/LIB ADA N30 # PAGES FOR SAM = 31 - # OF STA SAM PAGES THRU COMMON OR LIBRARY LDB ME37I JSB CONVD PUT IN OUTPUT BUFFER JSB SPACE NEW LINE PSYM JSB INTER INTERACTIVE INPUT LDA P38 LDB MES37 NO. ADD. PAGES FOR SAM? JSB READ PRINT MESSAGE, GET REPLY LDA N3 JSB DOCON JMP PSYM ERROR, REPEAT INPUT STA 1 MAX. ADD. PAGES ADA SAM CMA,INA SSA JMP MRERR MORE PAGES THAN ALLOWED STB SAM SAVE ADD. PAGES LDB FPSAM 1ST PAGE OF SAM ADB NOSAM ADB SAM ADDITIONAL PAGES STB LPSAM LAST PAGE OF SAM CMB ADB MSIZE MEMORY SIZE STB PAGES NO. OF PAGES REMAINING HED DEFINE PARTITIONS * * * PARTITION DEFINITION * * CLA STA FTIME PAR0A JSB INTER INTERACTIVE INPUT? LDA N4 CLEAR PARTITION DEFINITION TABLE STA KOUNT CLA PARCL LDB PATBL 4 WORDS = MAXIMUM 64 PARTITIONS STA 1,I WORD 1 BIT 0 = PARTITION 1, ETC. INB IF BIT = 1 PARTITION DEFINED ISZ KOUNT JMP PARCL LDA PAGES NO. OF PAGES REMAINING STA PAGE0 SAVE FOR RESTORE JSB SPACE NEW LINE LDA P31 LDB MES45 LARGEST ADDRESSABLE PARTITION JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE CCA ADA SSGAP GET NUMBER OF PAGES USED W/O JSB PAGE COMMON CMA,INA FIND NUMBER OF PAGES LEFT ADA P32 STA MXPTL MAXIMUM PARTITION LENGTH LDB ME46I CMA,INA SET FOR DECIMAL JSB CONVD PUT IN MESSAGE LDA P22 LDB MES46 W/O COMMON XX PAGES JSB PRIN1 PRINT MESSAGE LDA LWACG LAST WORD OF AVAILABLE COMMON JSB PAGE GET NO. OF PAGES USED WITH COMMON CMA,INA FIND NO. OF PAGES LEFT ADA P32 CMA,INA SET FOR DECIMAL LDB ME47I JSB CONVD PUT IN MESSAGE LDA P22 LDB MES47 W/ COMMON XX PAGES JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE JSB PTPAG OUTPUT NO. OF PAGES REMAINING JSB INTER INTERACTIVE INPUT LDA P19 LDB MES43 DEFINE PARTITIONS JSB PRIN1 PRINT MESSAGE JSB SPACE NEW LINE PAR04 JSB INTER INTERACTIVE INPUT LDA P3 LDB QUEST ? JSB READ PRINT MESSAGE, GET REPLY LDA N2 9 JSB GETNA GET FIRST 2 CHARACTERS CPA EN END? JMP PAREN YES, PARTITIONS ALL DEFINED CPA RE REPEAT ALL DEFINITIONS? JMP PAR0A YES JSB GINIT REINITIALIZE INPUT LDA N2 GET PARTITION NO. JSB GETOC JMP PARE4 ERROR STA PANUM SAVE PARTITION NO. CMA,INA ADA MAXPT EXCEEDS MAXIMUM PARTITION NO.? SSA,RSS NO JMP PAR03 PARE1 LDA PT PARTITION DEFINITION ERROR RSS PARE2 LDA PD PARTITION ALREADY DEFINED RSS PARE3 LDA PS NOT ENOUGH MEMORY LEFT CLB NO FMP ERROR JSB ERROR ERROR RSS PARE4 JSB INERR ERROR JMP PAR04 REPEAT INPUT PAR03 JSB GETAL CHECK FOR COMMA CPA BLANK RSS YES, COMMA JMP PARE4 NO, ERROR LDA N2 GET PARTITION SIZE JSB GETOC JMP PARE4 INPUT ERROR, TRY AGAIN STA PARSZ SAVE PARTITION SIZE CMA,INA STA 1 CHECK IF GREATER THAN MAXIMUM ADA MXPTL ALLOWED SSA JMP PARE1 YES LDA 1 CHECK IF GREATER THAN NUMBER OF ADA PAGE0 PAGES REMAINING SSA JMP PARE3 YES, ERROR STA PAGE1 SAVE NO. OF PAGES REMAINING LDA PARSZ ADA N2 SSA JMP PARE4 MUST BE AT LEAST 2 PAGES JSB BUFC CLEAR OUTPUT BUFFER LDA PANUM GET PARTITION NO. RAR,RAR CHECK TABLE TO SEE IF RAR,RAR ALREADY DEFINED AND P15 ADA PATBL STA KOUNT LDA 0,I STA TEMP1 LDA PANUM AND P15 CMA,INA LDB MNEG RBL ISZ 0 JMP *-2 LDA 1 IOR TEMP1 CPA TEMP1 JMP PARE2 PARTITION ALREADY DEFINED STA KOUNT,I UPDATE TABLE LDA PAGE0 FIND BEGINNING PAGE ADDRESS CMA,INA ADA MSIZE STA LBUF+3 aLDA PAGE1 STA PAGE0 UPDATE NO. OF PAGE REMAINING CCA ADA PARSZ PARTITION SIZE STA LBUF+4 CCA ADA PANUM OUTPUT SIZE AND RAL BEGINNING PAGE STA 1 ADDRESS OF RAL PARTITION ADA 1 TO CORRECT INA ADA MATA ENTRY IN LDB 0 MEMORY ADB P5 ALLOCATION JSB SETCR TABLE JSB PTPAG OUTPUT NO. OF PAGES LEFT CLA STA FTIME JMP PAR04 GET NEXT PARTITION DEFINITION HED OUTPUT MRMP AND STUFF ENTRIES * * STUFF MEMORY RESIDENT PROG. MAP AND OUTPUT IT * PAREN JSB BUFC LDA LPMRP GET LAST PAGE OF MEM RES PROGS CMA STA MRMPG ADA P32 CMA STA WRPOT LDA ALBUF SET 0,1,2.....N IN OUTPUT CLB BUFFER, WHERE N = PAGE # STB 0,I OF ADJUSTED END OF MEM RES PROGS INB INA ISZ MRMPG JMP *-4 CCB ISZ WRPOT RSS JMP *+4 STB 0,I SET REMAINING PAGES TO -1 INA FOR WRITE PROTECT JMP *-5 LDA MRMP GET ADDRESS OF TABLE LDB 0 ADB P31 JSB SETCR GO OUTPUT VALUES * *STUFF $ENDS, $LPSA, $MPSA * LDA PGLIB PAGE # AT END OF RES LIB INA # OF PAGES SYS + LIB LDB $ENDS JSB STUFF PUT IN $ENDS LDB $LPSA LDA LPSAM LAST PAGE OF SAM JSB STUFF PUT IN $LPSA LDA SAM GET # OF ADD PAGES OF SAM INA ADD 1 FOR 1ST PAGE ADA NOSAM ADJUST IF SAM DOESN'T SHARE PAGE ALF,ALF WITH MEM RES PROGS RAL,RAL SHIFT TO BITS 10 - 15 IOR FPSAM MERGE WITH 1ST PAGE OF SAM LDB $MPSA JSB STUFF PUT IN $MPSA SNAP5 LDB $EMRP LDA LWAMR LAST WORD OF MEM RES PROGS JSB STUFF PUT IN $EMRP JMP *+3 MRERR JSB INERR ERROR JMP MRPA1 / REPEAT INPUT * LDA JMP3I SET STARTING JMP STA LBUF LDA STRAD SET STARTING ADDRESS STA LBUF+1 LDA P2 LDB P3 JSB SETCR HED SNAPSHOT OUTPUT FOR LOADER RELOCATION LDB SYSTM CPB P3 RTE-M-3? JMP SNAP1 YES LDA LWAMR SET AVMEM TO NEXT WORD PAST INA MEM RES PROGS. (SAM) SNAP0 LDB AVMEM BP ADDRESS JSB STCR1 SET FWA SYS MEM INTO RTM BP LDA SAM ALF,ALF RAL,RAL ADA SAMSZ ADA SAMST LDB SYSTM CPB P1 LDA LWSA1 CPB P2 LDA LWSA1 LDB BGORG FWA OF BACKGROUND COMMON JSB STCR1 LDB BGLWA LWA MEMORY BACKGROUND PARTITION JSB STCR1 CLB,INB JSB CLFL2 JSB SPACE NEW LINE JMP RTMLI RTMGS JSB SPACE NEW LINE LDA $OPSY TYPE OF OPERATING SYSTEM CPA N7 RTE-M-I? JMP SNAPA YES CPA N15 RTE-M-II? JMP SNAPA YES CPA N5 RTE-M-III? JMP SNAPA YES JMP SNAP3 NONE OF THE ABOVE SNAPA LDA DCB2 IS OUTPUT A TYPE 0 FILE? SSA,RSS JMP SNAPX AND UDFE LDA 0,I JMP *-4 SNAPX ADA P2 LDB 0,I SZB,RSS JMP SNAP3 YES INA LDB 0,I GET TRACK NUMBER CMB,INB STB TRACK INA LDB 0,I GET SECTOR NUMBER CMB,INB STB SECTR LDA TRACK PUT TRACK # IN MESSAGE LDB ME49I JSB CONVD LDA SECTR PUT SECTOR # IN MESSAGE LDB ME50I JSB CONVD LDA P46 MESSAGE LENGTH LDB MES49 MESSAGE ADDRESS JSB PRIN1 JSB SPACE SNAP3 LDA P16 LDB MES11 RTMLG FINISHED JSB PRIN2 JMP EXEC6 SNAP1 LDB ECLIB LIBRARY ON SAME PAGE AS SAM? CPB FPSAM JMP SNAP0 YES BLF,BLF SET AVMEM TO NEXT PAGE WITH SAME RBL,RBL OFFSET THAT SAM HAS WHERE IT STARTS LDA LWAMR AND B1777 CPA B1777 RSS ADB B2000 ADA 1 STA SAMST INA JMP SNAP0 * * * SUBROUTINE TO OUTPUT NO. OF PAGES REMAINING * * PTPAG NOP LDA PAGE0 NO. OF PAGES REMAINING LDB ME44I CMA,INA SET FOR DECIMAL JSB CONVD PUT IN MESSAGE LDA P26 LDB MES44 PAGES REMAINING = JSB PRIN1 PRINT MESSAGE JMP PTPAG,I * * EN ASC 1,EN RE ASC 1,RE * QUEST DEF *+1 ASC 2,* ? * B1777 OCT 1777 UPCR OCT 77400 UDFE OCT 77777 MNEG OCT 100000 N7 DEC -7 N15 DEC -15 P2 DEC 2 P32 DEC 32 P26 DEC 26 P31 DEC 31 P46 DEC 46 * ECLIB NOP KOUNT NOP TEMP STORE LPSAM NOP LAST PAGE OF SAM LWMRP NOP LAST WORD OF MEM RES PROGS. MRMPG NOP MXPTL NOP MAXIMUM PARTITION LENGTH PAGE0 NOP TEMP STORE FOR NO. OF PAGES LEFT PAGE1 NOP " " " " PAGES NOP # PAGES AFT REL CORE RES PROG PANUM NOP PARTITION NO. PARSZ NOP PARTITION SIZE SAMST NOP SAMSZ NOP SECTR NOP SECTOR NUMBER TRACK NOP TRACK NUMBER WRPOT NOP * PATBL DEF *+1 REP 4 OCT 0 $EMRP DEF *+1 ASC 3,$EMRP $ENDS DEF *+1 ASC 3,$ENDS $LPSA DEF *+1 ASC 3,$LPSA $MPSA DEF *+1 ASC 3,$MPSA * PT ASC 1,PT PARTITION DEFINITION ERROR PD ASC 1,PD PARTITION ALRADY DEFINED ERROR PS ASC 1,PS PARTITION SIZE ERROR * JMP3I JMP 3,I * MES11 DEF *+1 ASC 8,* RTMLG FINISHED MES12 DEF *+1 ASC 5,* INT PRGS MES13 DEF *+1 ASC 5,* IGNORE? MES43 DEF *+1 ASC 10,* DEFINE PARTITIONS ME44I DEF ME44A MES44 DEF *+1 ASC 10,* PAGES REMAINING = ME44A BSS 3 MES45 DEF *+1 ASC 16,* LARGEST ADDRESSABLE PARTITION ME46I DEF ME46A MES46 DEF *+1 ASC 5,* W/O COM ME46A BSS 3 ASC 3, PAGES ME47I DEF ME47A MES47 DEF *+1 ASC 5,* W/ COM ME47A BSS 3 ASC 3, PAGES MES48 DEF *+1 ASC 11,* NO ID SEGMENTS LEFT ME49I DEF ME49A ME50I DEF ME50A MES49 DEF *+1 ASC 13,* SYSTEM STARTS AT TRACK ME49A BSS 3 ASC 4, SECTOR ME50A BSS 3 END RTMG2 * , *I 91740-18052 1740 S C0122 DS/1000 MODULE: DCMCC              H0101 QYASMB,R,L,C * NAME: DCMCC * SOURCE: 91740-18052 * RELOC: 91740-16052 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DCMCC,8 91740-16052 REV 1740 770310 * * ENT DCMC * * DUMMY MOUNT/DISMOUNT SUBROUTINE * * CALLING SEQUENCE: JSB DCMC * DEF RTN * DEF WHICH * DEF LUDRN * DEF LSTRK (OPTIONAL) * RTN SZA * * ON RETURN A=-200 (ATTEMPT TO USE FLOPPY SUBROUTINE) * DCMC NOP LDA =D-200 LDB DCMC,I JMP 1,I END Sv +1 91740-18053 1926 S C0122 RTMLM DS/1000 MODULE             H0101 |MASMB,R,L,C RTMLM * NAME: RTMLM * SOURCE: 91740-18053 * RELOC: 91740-16053 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * HED RTE-M SYSTEM GENERATOR-LOADER * * * NAM RTMLM,8 91740-16053 REV 1926 790426 * * ENTRY POINT NAMES * ENT RT.G1,RT.LC * * EXTERNAL REFERENCE NAMES * EXT ABL1,ABL2,ABRC1,ABREC,ABRT1,BPLOC,CKS EXT CLBPL,CLFL2,COML,CONSO,DBTAD,DIAG,DIAG2 EXT ENTPT,EXEC6,FRTRU,FT#ME,FWABP,FWAC,FWAM EXT ICR,ISECU,LDSEG,LDSG3 EXT LST,LST4,MAPS,.MEM4,MLOCC EXT NAMR.,OUTON,PRCMD EXT PRINT,SCP,SEGFL,SERFG,TIMES EXT TRUNC,TYOFF,UNDEF,WRTBT,?XFER * EXT KCVT * EXT PNZQZ,PRAMS * * LOCC EQU MLOCC FTIME EQU FT#ME SUP ********************************************************** * THE FUNCTION OF THIS LOADER IS TO RELOCATE AND LINK * RELOCATABLE BINARY MODULES TOGETHER, AND PREPARE * THEM FOR EXECUTION ON AN RTM SYSTEM. AFTER * STARTING THIS LOADER WITH A ON LOADR COMMAND * A SNAPSHOT CAN BE READ IN. * THIS SNAPSHOT CONTAINS THE DEFAULT * MEMORY BOUNDS, SYSTEM COMMON, AND DEFINES THE * CORE-RESIDENT LIBRARY ROUTINES FOR THE TARGET RTM * SYSTEM. * SYMBOL TABLE ENTRY FORMAT: * * WORD 5 - OCT 0 (LINK OR FIXUP TABLE ADDRESS) * 4 - DEF SYMBOL (HOLDS SYMBOL VALUE) * 3 - OCT XX000 CHAR 5 AND FLAGS * 2 - ASC 1, CHARS 3,4 OF NAME * 1 - ASC 1, CHARS 1,2 OF NAME * SHOULD ONLY BE REFERENCED VIA POINTERS LST1 THRU LST5, * USING SUBROUTINES LSTI AND LST%P. * ************************************************************************ * RT.G1 LDA SCP AND B10 SZA PUT DEBUG IN LST? JMP RTMLP YES, FORCE LOAD DEBUG RTMLA CLA,INA STA LDSG3 USE LDRIN ENTRY IN SEG 3 LDB ONMSG PRINT MESSAGE JSB DIAG2 LOADER STARTED JSB PRCMD PROCESS LOADER COMMANDS JMP ABRT1 PROGRAM TERMINATION RTML2 LDA LOCC SZA,RSS IF NO MODULES RELOCATED, JMP RTMLT PROGRAM TERMINATION LDA B2 STA ABRC1 STORE ADDRESS OF TIE-OFF RECORDS DLD PNZQZ GET PROGRAM NAME JSB TYOFF OUTPUT CHARS 1,2,3,4 OF NAME LDA PNZQZ+2 AND UPCM IOR PRAMS CHAR 5,TYPE LDB PRAMS+1 GET PRIORITY JSB TYOFF LDA PRAMS+2 RAR,RAR RES. CODE RAR IOR PRAMS+3 CLB SPARE JSB TYOFF JSB TIMES PROCESS TIME PARAMETERS JSB TYOFF OUTPUT TIME PARAMETERS CLA SPARE LDB .MEM4 LWAM JSB TYOFF OUTPUT SPARES LDA FWAM GET LOW MAIN LDB LOCC GET HIGH MAIN JSB TYOFF OUTPUT LDA FWABP GET LOW BASE PAGE LDB BPLOC GET HIGH BASE PAGE JSB TYOFF OUTPUT LOW & HIGH BASE PAGE LDA FWAC LDB COML JSB TYOFF LDB DBTAD GET DEBUG TRANSFER ADDRESS LDA SCP LOAD WITH DEBUG? AND B10 SZA,RSS LDB ?XFER NO, USE PROGRAM XFER ADDRESS LDA JMP3 JSB TYOFF CLB,INB JSB CLFL2 CLOSE ABSOLUTE OUTPUT FILE LDB EDREL PRINT MESSAGE JSB DIAG "RELOCATION FINISHED" LDA FWAM GET # OF PAGES USED FOR RELOCATION CMA ADA LOCC AND B76K ALF RAL,RAL ADA B2 STA NUMB JSB KCVT DEF *+2 DEF NUMB STA PAGES,I LDA CONSO INTERACTIVE INPUT? SZA,RSS JMP RTMLB NO S LDA P19 LDB PAGE JSB PRINT RTMLB LDA P19 LDB PAGE JSB MAPS LDB SNAP PRINT MESSAGE JSB DIAG "INPUT SNAP REQUEST" JSB PRCMD PROCESS SNAP REQUEST JMP ABRT1 PROGRAM TERMINATION LDA B2 SET TO SEGMENT LOAD STA SCP LDB SEGRL * REL SEGMENT JSB DIAG JSB INIT2 REINITIALIZE POINTERS JSB PRCMD PROCESS LOADER COMMANDS JMP ABRT1 PROGRAM TERMINATION LDA LOCC IF NO MODULES RELOCATED SZA PROGRAM TERMINATION JMP RTML2 RTMLT LDB OFMSG PRINT MESSAGE JSB DIAG2 RTMLG FINISHED JMP EXEC6 PROGRAM TERMINATION * RTMLP CLA STA SEGFL LAST SEGMENT FLAG LDA B3 STA LDSG3 SET FOR RETURN TO MAIN JMP LDSEG LOAD IN LOADER SEGMENT 3 * * RT.LC LDB DEBUG PUT DEBUG IN LST JSB ENTPT LDA UDFE SET TO UNDEF STA LST4,I JMP RTMLA SPC 1 JMP3 JMP 3,I * INIT2 NOP JSB CLBPL CLEAR BASE PAGE LINKS LDA ABL2 STA ABL1 CLA STA UNDEF START SEARCH AT BEGINNING OF LST STA FRTRU FIRST TIME THRU FLAG STA ?XFER "HAVE MAIN FLAG" STA LOCC PROGRAM RELOCATION BASE STA BPLOC BASE PAGE RELOCATION BASE STA COML "COMMON USED" FLAG STA LST,I LOADER SYMBOL TABLE LENGTH STA NAMR. ALLOW A NAM RECORD STA OUTON ABSOLUTE OUTPUT FILE CLOSED STA FTIME OUTPUT TYOFF RECORD ONLY AT START STA ISECU SECURITY CODE STA ICR LABEL STA WRTBT NO RELOCATION YET STA TRUNC DON'T TRUNCATE ON ABORT STA ABREC CLEAR RECORD LENGTH STA CKS CLEAR CHECKSUM STA SERFG LIBRARY LOAD FLAG JMP INIT2,I * SPC 2 * NUMB NOP SEGRL DEF *+1 DEC 13 ASC 7,* REL SEGMENT ONMSG DEF *+1 DEC 16 ASC 8,* LOADER S?TARTED EDREL DEF *+1 DEC 21 ASC 11,* RELOCATION FINISHED OFMSG DEF *+1 DEC 16 ASC 9,* RTMLG FINISHED PAGE DEF *+2 PAGES DEF *+2 ASC 1,* BSS 1 ASC 8, PAGES REQUIRED SNAP DEF *+1 DEC 11 ASC 6,* SNAPSHOT? B2 OCT 2 B3 OCT 3 B10 OCT 10 B76K OCT 76000 P19 DEC 19 UPCM OCT 77400 UDFE OCT 77777 * DEBUG DEF *+1 ASC 3,DEBUG * SPC 2 END c ,5 91740-18054 1826 S 0322 SOURCE RTRLC              H0103 ASMB,R,L,C RTRLC * NAME: RTRLC * SOURCE: 91740-18054 * RELOC: 91740-16054 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * * * HED RTE-M SYSTEM GENERATOR-LOADER NAM RTRLC,8 91740-16054 REV 1826 780421 * * ENTRY POINT NAMES * ENT ABL1,ABL2,.ABR,AB#RT,ABRC1,ABREC ENT ABRT1,ADDRS,ADTRP,AFILE,AL,ATABL,ATBUF,ATTBL ENT BAKUP,BLINE,BPAG4,BPAGA,BPLOC,BU#ER ENT CFILE,CKS ENT CLBPL,CLFL2,CLFL3,CLFL4 ENT CLFL5,CLFL6 ENT CMDLU,CMER,CNT,COML,COMOR ENT CONSL,CONSO,CONV,CPAGE ENT CRTIN,DBTAD,DCB1 ENT DCB2,DCB3,DCB4,DCB5,DCB6,DCB7 ENT DIAG,DIAG2,ECFIL,ECHO1,ECHOS,EFILE,EKHOS ENT EMSAM,ERACT,ERDVC,ERREX,ER#OR,EXEC0,EXEC6 ENT FFLAG,FL1OP,FRTRU,FT#ME ENT FUT1,FUT2,FUT3,FUT4,FUTA,FUTI ENT FUTP,FUTS,FWABP,FWAC,FWAM,GLWAM ENT ICR,IDCB,IERR#,IFILE,IL,INACT,IN#CK,IOPTN ENT ISECU,JLU,JMPNO ENT KONSO,KTABL,LBF10,LBUF5,LBUF#,LBUFA ENT LDGEN,LDSEG,LDSG3,LENGT,LER3,LER5 ENT LFILE,LGER2,LIBFL,LINTP ENT LIST,LISTO,LITBL,LNKDR,LOCFS ENT LST1,LST2,LST3,LST4,LST5 ENT LST,LSTA,LSTI,LSTM,LSTP ENT LSTPX,LSTUL,LTABL,LWABP,LWAC,LWAM ENT MAPON,MAPS,.MEM.,.MEM1 ENT .MEM2,.MEM3,.MEM4,.MEM5,.MEM6 ENT MEMRY,MESSI,MLOCC,MOVEX,MTABL ENT NAMR.,NBUF,NBUF6,NBUFA,NBUFT ENT NCHAR,NSCAN,NXTC,NXTC2,NXTCM ENT OFILE,ONTBL,OPEN1 ENT OPFLA,OPFLB,OPFLC,OPFLD ENT OPFLE,OPFLF,OPFLG,OPFLH ENT OPNLU,OPT.3,OTFIL,OTMES ENT OUTON,PACK#,PLK ENT PLK1,PLK4,PLBKS,PRCMD ENT PRINT,PUNCH,QBUFA,QGETC,QQCNT ENT QQPTR,RBTA,RBTO,RDFL1,READ#,RIC ENT SCAN,SCP,SEGFL,SERFG,SERNM ENT SNAPS,SSTBL,STABL ENT STFER,SYMOV,TBUF#,TIMES,TOTBL,TRANS,TRUNC ENT TYOFF,TYPRO,UEXFL,UNDEF,WERR1 ENT WRTBT,WRTFL,?XFER,XNAM,XNAMA ENT ZPRIV,ZRENT * * EXTERNAL REFERENCE NAMES EXT PNAMA * EXT RTML2,RTML4 * EXT CLOSE,DTTY,EXEC,FCONT,IMESS EXT LIMEM,LOCF,READF,SG#LD,WRITF EXT IDCB1,IDCB2,IDCB3,IDCB4,IDCB5,IDCB6,IDCB7 * EXT $OPSY,PARSE EXT CNUMD,LURQ * A EQU 0 B EQU 1 SUP ************************************************************************ * * THIS MODULE CONTAINS ALL THE COMMON ROUTINES AND * STORAGE NEEDED BY THE LOADER MAIN AND/OR ANY 2 * OF THE LOADER SEGMENTS. IT CONTAINS THE MAIN ENTRY * POINT FOR PROCESSING ALL LOADER COMMANDS (PRCMD). * THIS MODULE IS CALLED AS IF IT WERE A SUBROUTINE * WITH NO PARAMETERS AND TWO RETURNS. THE (P+1) * RETURN IS USED FOR ABNORMAL TERMINATION CONDITIONS, * WHILE THE (P+2) RETURN IS USED FOR NORMAL RETURNS * VIA THE END COMMAND. THE CALLING SEQUENCE IS AS FOLLOWS: * * JSB PRCMD * RETURN1 RELOCATION ABORTED RETURN * RETURN2 NORMAL RETURN * ******************************************************************** HED RTM LOADER UTILITY SUBROUTINES ***** ***** * ** PRCMD ** MAIN ENTRY POINT FOR THE SUBORDINATE CONTROL MODULE. * CONTROL IS PASSED TO TYMOD OR NXTCM TO GET THE NEXT * COMMAND. THAT COMMAND IS PARSED, AND CONTROL IS PASSED * TO ITS ASSOCIATED PROCESSING ROUTINE. IF A FATAL ERROR * IS DETECTED, CONTROL IS RETURNED TO THE ROUTINE CALLING * PRCMD AT (P+1). THE ONLY OTHER EXIT IS VIA THE END * COMMAND (P+2). AFTER PROCESSING ANY OTHER COMMAND, * CONTROL RETURNS TO NXTCM TO PROCESS THE NEXT COMMAND. * ***** PRCMD NOP PROCESS RTM LOADER6 COMMANDS NXTCM JSB CMDIN GET NEXT COMMAND LINE NXTC2 LDA CTACN LDB CTABL JSB SCAN SCAN 1ST ELEMENT FOR MATCH JMP CMER COMMAND ERROR. STA JMPNO SAVE WHERE TO JMP TO ADA M14 SSA,RSS JMP LOAD4 CLA,INA JSB SGLD1 DETERMINE IF SEG IS RELOADED CLA JMP LDSEG LOAD IN LOADER SEGMENT 2 * LOAD4 LDA B2 JSB SGLD1 DETERMINE IF SEGMENT IS RELOADED LDA D15 JMP LDSEG ***** * CONTROL COMES HERE ON DETECTING A COMMAND ERROR. THE MESSAGE * 'CMND?' IS OUTPUT. ***** CMER LDB CMND? OUTPUT CMND? MESSAGE JSB DIAG2 JMP EXEC0 * CMND? DEF *+1 OCT 5 ASC 3,CMND? * JMPNO NOP WHERE GO FLAG * D15 DEC 15 M14 DEC -14 * SGLD1 NOP LDB SEGFL SZB,RSS JMP SGLD1,I GO LOAD SEGMENT CPB 0 RSS JMP SGLD1,I NEED OTHER SEGMENT CPB B1 JMP RTML2 NEED SEGMENT 2 JMP RTML4 NEED SEGMENT 4 * SEGFL NOP LAST SEGMENT FLAG HED RTM LOADER TABLES ***** * * COMMAND MNEMONIC TABLE * * BITS 15-8 # CHARS IN ASCII KEYWORD TABLE * BITS 7-0 OFFSET IN THAT TABLE (TO LOCATE ASCII WORDS) * * THE ORDER OF ENTRIES IN THIS TABLE IS USED IN DETERMINING THE * OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS TABLE IS * OF PARAMOUNT IMPORTANCE. IF ANY KEYWORD IS EXACTLY THE SAME * AS THE BEGINNING OF A LONGER KEYWORD, THE LONGER KEYWORD MUST * APPEAR FIRST. (FOR EXAMPLE TRANSFER APPEARS BEFORE TR) * ***** CTACN ABS CTABS-CTABN NEG NBR ENTRIES IN TABLE CTABL DEF CTABS CTABS ABS 3000B+ABOUD-CMTBL BOUNDS ABS 1400B+AMAP-CMTBL MAP ABS 4000B+ARELC-CMTBL RELOCATE ABS 1400B+AREL-CMTBL ABBR. OF RELOCATE ABS 3000B+ASEAR-CMTBL SEARCH ABS 3000B+AOTPU-CMTBL OUTPUT ABS 4000B+ATRAN-CMTBL TRANSFER ABS 1000B+ATR..-CMTBL ABBR. OF TRANSFER  ABS 1400B+ASET.-CMTBL SET ABS 4000B+ALKIN-CMTBL LINKS IN ABS 2400B+ALINK-CMTBL LINKS ABS 1000B+AEXIT-CMTBL EXIT ABS 2000B+AECHO-CMTBL ECHO ABS 3400B+ADISP-CMTBL DISPLAY ABS 2000B+ASNAP-CMTBL SNAP ABS 1400B+AEND.-CMTBL END ABS 1000B+AMONT-CMTBL MOUNT ABS 1000B+ADMNT-CMTBL DISMOUNT CTABN EQU * KTABS ABS 2400B+AFWAB-CMTBL FWABP ABS 2400B+ALWAB-CMTBL LWABP ABS 2000B+AFWAM-CMTBL FWAM ABS 2000B+ALWAM-CMTBL LWAM ABS 2000B+AFWAC-CMTBL FWAC ABS 2000B+ALWAC-CMTBL LWAC LTABS ABS 2000B+ALOCC-CMTBL LOCC ABS 3000B+ABPLC-CMTBL BPLOCC ABS 2400B+AXFER-CMTBL .XFER ABS 2400B+ATBLE-CMTBL TABLE ABS 3000B+AUNDE-CMTBL UNDEFS MTABS ABS 3400B+AMODS-CMTBL MODULES ABS 3400B+AGLOS-CMTBL GLOBALS ABS 2400B+ALINK-CMTBL LINKS ABS 1400B+AOFF.-CMTBL OFF ABS 1000B+AON..-CMTBL ON ATABS ABS 1400B+AYES.-CMTBL YES ABS 1000B+ANO..-CMTBL NO TSTRT ABS 2400B+ASTRT-CMTBL START TAT ABS 1000B+AAT..-CMTBL AT TTO ABS 1000B+ATO..-CMTBL TO LIABS ABS 2000B+ABASE-CMTBL BASE ABS 3400B+ACURT-CMTBL CURRENT ONABS ABS 1000B+AON..-CMTBL ON ABS 1400B+AOFF.-CMTBL OFF STABL DEF TSTRT ATTBL DEF TAT TOTBL DEF TTO LTABL DEF LTABS KTABL DEF KTABS MTABL DEF MTABS ATABL DEF ATABS LITBL DEF LIABS ONTBL DEF ONABS AMONT ASC 1,MC ADMNT ASC 1,DC SKP ***** * ASCII KEYWORD TABLE * ORDER OF ENTRIES IN THIS TABLE IS ON NO IMPORTANCE ***** CMTBL DEF * ABOUD ASC 3,BOUNDS AMAP ASC 2,MAP ARELC ASC 4,RELOCATE AREL ASC 2,REL ASEAR ASC 3,SEARCH AOTPU ASC 3,OUTPUT ADISP ASC 4,DISPLAY ATBLE ASC 3,TABLE AUNDE ASC 3,UNDEFS AMODS ASC 4,MODULES AGLOS ASC 4,GLOBALS ALKIN ASC 4,LINKS IN ALINK ASC 3,LINKS ASNAP ASC 2,SNAP AEXIT ASC 1,EX AECHO ASC 2,ECHO AON.. ASC 1,ON AOFF. ASC 2,OFF ATRAN ASC 4,TRANSFER ATR.. ASC 1,TR AEND. ASC 2,END AFWAM ASC 2,FWAM ALWAM ASC 2,LWAM AFWAB ASC 3,FWABP ALWAB ASC 3,LWABP AFWAC ASC 2,FWAC ALWAC ASC 2,LWAC ALOCC ASC 2,LOCC ABPLC ASC 3,BPLOCC AXFER ASC 3,?XFER AYES. ASC 2,YES ANO.. ASC 1,NO ASTRT ASC 3,START AAT.. ASC 1,AT ASET. ASC 2,SET ATO.. ASC 1,TO ABASE ASC 2,BASE ACURT ASC 4,CURRENT * SKP HED INPUT COMMAND LINE ***** * ** CMDIN ** INPUT NEXT COMMAND LINE * CALLING SEQUENCE: * * JSB CMDIN * RETURN * * NOTE: CMDIN SKIPS COMMENTS AND ADVANCES INPUT BUFFER * POINTERS PAST THE '-' IF IT APPEARS IN THE INPUT BUFFER. * * THE IDENTIFIER CMDLU IS USED TO DETERMINE IF THE INPUT IS * COMING FROM THE SESSION CONSOLE (=4) OR TRANSFER FILE (=1). * THE IDENTIFIER ECHO1 IS USED TO DETERMINE IF THE INPUT * SHOULD BE ECHO'ED TO THE LIST DEVICE (0=NO ECHO, 1=ECHO). * * * RETURN: QQCHC= POSITIVE # CHARS TRANSMITTED * ***** CMDIN NOP CLA RESET INCOMING CHARACTER STA QQCNT POINTERS LDA QBUFA STA QQPTR LDA CMDLU INPUT COMMAND DEVICE-FILE? CPA B4 RSS JMP CMD5 NO, MUST BE TRANSFER FILE LDA CONSO GET INPUT FROM SESSION CONSOLE? SZA JMP CMD3 YES CMD1 LDB PRPTA JSB DIAG SEND PROMPT TO ERROR-PROMPT LOG CMD6 LDB QBUFA INPUT BUFFER LDA CMDLU CPA B1 TRANSFER FILE? JMP RDRIN YES, READ IT LDA DCB1 DATA CONTROL BLOCK JSB RDFL1 READ FROM INPUT DEVICE-FILE CPA M1 END OF FILE? JMP CMD4 YES, GET INPUT FROM SESSION CONSOLE CMD2 STA QQCHC SAVE # OF CHARACTERS READ LDB QBUFA AND BUFFER ADDRESS JSB EKHOS TRY WRITING ON MAP OR ECHO FILE LDA QBUFA,I GET 1ST CHARACTER. ALF,ALF AND B177 CPA B52 COMMENT? JMP CMDIN+1 YES, GET NEXT COMMAND CPA B55 IS COMMAND ID SUPPLIED? ISZ QQCNT YES--BUMP CHAR. POINTER JMP CMDIN,I RDRIN LDA DCB6 DATA CONTROL BLOCK ADDRESS JSB RDFL6 GO READ FILE CPA M1 FINISHED? RSS JMP CMD2 NO LDA B4 YES, TRANSFER INPUT TO COMMAND STA CMDLU DEVICE-FILE JSB CLFL6 CLOSE TRANSFER FILE JMP CMDIN+1 * CMD4 CLA,INA STA CONSO STA KONSO CMD3 LDB PRPTA PROMPT JSB OTMES GET RESPONSE JMP CMDIN,I * CMD5 LDA DCB6 GET TRANSFER FILE DCB JSB INDCK ADA B2 LDA 0,I TYPE 0 FILE? SZA JMP CMD6 NO, DON'T ISSUE PROMPT LDA DCB6 JSB INDCK JSB LOCFS GET LOGICAL UNIT OF FILE SSA JMP LGER2 LU ERROR LDA JLU GET LOGICAL UNIT JSB DTTY SEE IF INTERACTIVE SZA JMP CMD7 YES LDA CONSO SWITCH TO SESSION CONSOLE? SZA JMP CMD7 YES LDA INACT INTERACTIVE INPUT? SZA,RSS JMP CMD6 NO CMD7 LDB PRPTA YES JSB DIAG2 JMP CMD6 * LGER2 LDA LU CLB NO FMP ERROR JSB STFER OUTPUT ERROR TO SYSTEM CONSOLE JMP ABRT1 TERMINATE LOADER EXECUTION * LU ASC 1,LU * CONSO NOP * B1 OCT 1 B4 OCT 4 B52 OCT 52 COMMENT CHARACTER B55 OCT 55 CMDLU OCT 4 M1 DEC -1 SKP ADTRP NOP TRAP ADDRESS AFILE NOP ADDRESS OF FILE NAME ARRAY COML NOP HOLDS INITIAL COMMON LENGTH DBTAD NOP DEBUG TRANSFER ADDRESS ERACT NOP ERROR LOG INTERACTIVE FLAG FTIME NOP OUTPUT TYOFF RECORD ONLY AT START IDCB NOP DATA CONTROL BLOCK KONSO NOP END OF INPUT FILE FLAG LDSG3 NOP WHICH ENTRY IN SEGMENT 3 LIBFL NOP SEARCH FLAG LINTP NOP LINKS IN FLAG (SET TO BASE) LISTO NOP INITIALIZE MAP OUTPUT LSTUL NOP UPPER LIMIT OF LST OPEN1 NOP COMMAND FILE OPEN BIT OPFLA OCT 410 OPTION WORD FOR COMMAND INPUT OPFLB OCT 110 OPTION WORD FOR ABSOLUTE OUTPUT OPFLC OCT 310 OPTION WORD FOR REL/SEARCH OPFLD OCT 210 OPTION WORD FOR MAP OPFLE OCT 210 OPTION WORD FOR ECHO OPFLF OCT 410 OPTION WORD FOR TRANSFER OPFLG OCT 210 OPTION WORD FOR SNAP/DISPLAY OPFLH OCT 210 OPTION WORD FOR ERROR/PROMPT OTFIL NOP ADDRESS OF FILE NAME ARRAY RIC NOP HOLDS RECORD IDENTIFICATION CODE SCP NOP SSGA/SYSTEM COMMON/PARTITION SERFG NOP LIBRARY LOAD FLAG SERNM NOP THIS IS THE MOD IN SEARCH (NAME) (FLAG) TYPRO NOP PROGRAM TYPE FLAG WRTBT NOP NO RELOCATION YET ?XFER NOP "HAVE MAIN FLAG" XNAM BSS 3 MODULE NAME ZPRIV NOP LST ADDRESS OF .ZPRV ZRENT NOP LST ADDRESS OF .ZRNT * ATBUF DEF TBUF TBUF BSS 5 NBUF6 DEF NBUF+6 NBUFT DEF NBUF+20 XNAMA DEF XNAM * TBUF# EQU TBUF FT#ME EQU FTIME SKP * * SUBROUTINE TO PROCESS TIME PARAMETERS FOR ID SEGMENT * TIMES NOP LDA D12 GET THE SECONDS JSB ADRES MPY P100 CONVERT TO 10'S OF MS STA TEMP1 LDA D13 JSB ADRES ADA TEMP1 ADD 10'S OF MS STA OCTNO SAVE TEMP LDA D10 GET THE HOURS JSB ADRES MPY P60 CONVERT TO MINUTES STA TEMP1 LDA D11 JSB ADRES ADA TEMP1 ADD MINUTES MPY P6000 CONVERT TO 10'S OF MS CLE PREPARE FOR ADD ADA OCTNO ADD 10'S OF MS SEZ,CLE IF OVERFLOW INB STEP HIGH ORDER PART ADA NDAY+1 SUBTRACT ONE DAY OF 10'S OF MS SEZ,CLE IF OVERFLOW INB STEP HIGH ORDER DIGIT ADB NDAY JMP TIMES,I * D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 P60 DEC 60 P100 DEC 100 P6000 DEC 6000 NDAY OCT 177574,025000 * OCTNO NOP TEMP1 NOP SKP * * SUBROUTINE TO GET VALUES FROM PNAMA TABLE * ADRES 0NOP ADA PNAMA LDA 0,I JMP ADRES,I SPC 5 * * SUBROUTINE TO OUTPUT 2-WORD TIE-OFF RECORDS * TYOFF NOP JSB PACK WORD 1 FROM (A) LDA B WORD 2 FROM (B) JSB PACK JSB PUNCH JMP TYOFF,I * * * * * * LDSEG ADA LIST1 GET ADDRESS OF SEGMENT NAME STA NAME JSB SG#LD LOAD IN SEGMENT DEF *+3 RETURN ADDRESS (ONLY FOR ERROR) DEF NAME,I SEGMENT NAME DEF IERR ERROR CODE LDA SG LDB IERR ERROR CODE JSB ERROR SEGMENTATION ERROR JMP ABRT1 ABORT * NAME NOP * SG ASC 1,SG * LIST1 DEF *+2 LIST DEC 6 ASC 3,RTML2 ASC 3,RTML3 ASC 3,RTMG1 ASC 3,RTMG2 ASC 3,RTML1 ASC 3,RTML4 SKP * * SUBROUTINE TO DETERMINE IF INPUT IS LU AND SETUP DCB IF IT IS. * OPNLU NOP LDB $OPSY GET TYPE OF OPERATING SYSTEM CPB M7 RTE-MI? JMP OPNLU,I YES CPB M15 RTE-MII JMP OPNLU,I CPB M5 RTE-MIII JMP OPNLU,I YES LDA AFILE DETERMINE IF OUTPUT IS TO LU LDB 0,I CPB LU RSS JMP OPNLU,I INA LDB 0,I CPB .. RSS JMP OPNLU,I ISZ OPNLU INA MUST BE LU, GO GET IT LDB 0,I STB BUFA1 LDB BLANK STB BUFA1+1 STB BUFA1+2 JSB PARSE DEF *+4 DEF BUFA1 DEF B6 DEF RBUF LDA RBUF+1 GET LU STA LU# JSB DTTY LU INTERACTIVE ? SZA NO , LOCK IT JMP OPNL5 YES , DON'T LOCK IT JSB LURQ LOCK LU DEF *+4 DEF B1401 DEF LU# DEF B1 JMP LUERR OPNL5 LDA IOPTN OPEN OPTION AND B3700 STA 1 LDA IDCB GET ADDRESS OF DCB JSB INDCK JSB TYP0 OPEN DCB JMP OPNLU,I * LUERR LDB 0 LDA LU 1 JSB ERROR JMP CONSL TRY AGAIN * LU# NOP .. ASC 1,.. B1401 OCT 140001 B3700 OCT 3700 M5 DEC -5 M7 DEC -7 M15 DEC -15 * BUFA1 BSS 3 RBUF BSS 33 * * * SUBROUTINE TO CREATE A DUMMY TYPE 0 FILE * CALLING SEQUENCE * * LDA DCB ADDRESS * LDB SUBFUNCTION * JSB TYP0 * RETURN * * TYP0 NOP STA T0DCB LDA LU# GET LU SZA,RSS IF NOT DEFINED INA DEFINE AS LU = 1 STA LU# CLA JSB SET SET DIRECTORY JSB SET ADDRESS TO ZERO JSB SET ALSO SET TYPE TO 0 LDA LU# GET LOGICAL UNIT IOR 1 MERGE IN SUBFUNCTION JSB SET AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+4 DEF D13 DEF LU# DEF EQT5 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND B77 AND MASK CPA B5 IF MASK TYPE-CODE IS <05>, JSB TYPE5 THEN GO EXAMINE THE SUBCHANNEL. STA EQT5 SAVE THE EQUIPMENT TYPE-CODE. LDB B100 GET EOF CONTROL SUBFUNCTION ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE LDB B1000 LDA EQT5 CPA B2 IS DRIVER A PUNCH? JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE = 0 DON'T DO PAGE EJECT JMP SEOF LDB B1100 LINE SPACE OPTION SEOF LDA LU# GET LU IOR 1 MERGE EOF CONTROL SUBFUNCTION JSB SET SET IN DCB CLA JSB SET SET NO SPACING LEGAL LDA B1001 SET READ & WRITE LEGAL JSB SET AND SECURITY CODES AGREE JSB SET AND UPDATE MODES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SET SET OPEN FLAG LDA T0DCB ADA B3 STA T0DCB SET TO WORD 13 CLA SET IN MEMORY BUFFER FLAG JSB SET TO ZERO INA # JSB SET SET RECORD COUNT LDA EQT5 GET TYPE CODE LDB T0DCB GET DCB ADDRESS ADB MD11 GET TO CONTROL FUNCTION LOCATION LDB 1,I GET CONTROL WORD STB SET ADA MD17 IF THE EQUIPMENT TYPE-CODE SSA,RSS IS > 16 (MAG. TAPE, ETC.), JMP TYP0,I THEN AVOID WRITING AN END OF FILE JSB EXEC DO A PAGE EJECT, OR GENERATE LEADER DEF *+4 DEF B3 DEF SET DEF M1 FORCE A PAGE EJECT JMP TYP0,I * SET NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SET,I * * T0DCB NOP EQT5 NOP MD11 DEC -11 MD17 DEC -17 B5 OCT 5 B77 OCT 77 B1000 OCT 1000 B1001 OCT 100001 B1100 OCT 1100 DRT EQU 1652B ADDRESS OF DEVICE REFERENCE TABLE * * * TYPE-CODE CONVERSION FOR DVR05 (26440 44) SUBCHANNEL SPECIFICATIONS. * * TYPE5 NOP LDA LU# GET THE LOGICAL UNIT ADA M1 SUBTRACT 1 FOR THE DRT INDEXING. ADA DRT CALCULATE THE POSITION IN THE DRT. LDA 0,I GET THE DRT ENTRY. ALF,RAL POSITION THEW SUBCHANNEL TO BITS #4-0. AND B37 ISOLATE THE SUBCHANNEL. STA 1 SZA,RSS IF THE SUBCHANNEL IS ZERO, THEN RETURN JMP TYPE5,I TO SIMULATE A TYPE <00> DEVICE. LDA B23 PREPARE TO SIMULATE A TYPE <23> DEVICE. CPB B4 IF THE SUBCHANNEL IS FOUR, THEN LDA B12 SIMULATE A TYPE <12> DEVICE. JMP TYPE5,I RETURN--DEVICE TYPE: <12>,LP OR <23>,MT * B12 OCT 12 B23 OCT 23 B37 OCT 37 * * SUBROUTINE TO CLEAR BASE PAGE LINKS. * * CLBPL NOP LDA M1020 CLEAR STA COUNT BASE CLA LINKS LDB BPAG4 AREA STA 1,I FOR INB LOADER ISZ COUNT JMP *-3 AND JMP CLBPL,I GENERATOR * M1020 DEC -1020 BPAG4 DEF BPAGE ADD OF 1ST WORD OF BP LINKS TBL COUNT NOP * PRPTA DEF *+1 OCT 1 ASC 1,- SPC 1 * * * SUBROUTINE TO GET LAST WORD OF AVAILABLE MEMORY * * GLWAM NOP STA IWHCH SSA RELEASE? JMP GLWAM,I YES LDA 1,I STA BUFST ISZ 1 LDA 1,I STA BUFST+1 ISZ 1 LDA 1,I STA BUFST+2 ISZ 1 LDA 1,I STA BUFST+3 ISZ 1 LDA 1,I STA BUFST+4 NOP NOP JSB LIMEM DEF *+4 DEF IWHCH GET-RELEASE AVAILABLE MEMORY DEF LST FIRST WORD OF AVAILABLE MEMORY DEF IWRDS # WORDS AVAILABLE MEMORY LDA IWRDS SZA,RSS JMP LGER3 NO MEMORY AVAILABLE LDA LST STA LSTUL CCA ADA LST ADA IWRDS JMP GLWAM,I * IWHCH NOP IWRDS NOP LST NOP * BUFER DEF *+1 BUFST BSS 5 * BU#ER EQU BUFER * LGER3 LDA NM CLB NO FMP ERROR JSB STFER OUTPUT ERROR TO SYSTEM CONSOLE JSB ABRT JMP EXEC7 * NM ASC 1,NM * * SUBROUTINE TO ECHO ON ECHO FILE * * EKHOS NOP STA LENGT SAVE LENGTH OF MESSAGE STB ADDRS SAVE ADDRESS OF MESSAGE LDA ECHO1 IS ECHO ON? SZA,RSS JMP EKHOS,I NO, EXIT LDA EMSAM MAP AND ECHO FILE SAME? CPA B1 JMP EKHOB YES, OUTPUT TO MAP FILE LDA LENGT GET MESSAGE LENGTH LDB ADDRS GET MESSAGE ADDRESS JSB WRFL5 OUTPUT TO ECHO FILE JMP EKHOS,I EKHOB LDA LENGT GET MESSAGE LENGTH LDB ADDRS GET MESSAGE ADDRESS JSB WRFL4 OUTPUT TO MAP FILE JMP EKHOS,I * ECHO1 NOP EMSAM NOP HED RTM LOADER UTILITY SUBROUTINES ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BLINE NOP LDA LBUFA STA BELIN LDA MD60 LDB BLANK STB BELIN,I #, ISZ BELIN INA,SZA JMP *-3 JMP BLINE,I * BELIN NOP MD60 DEC -60 * LBUFA DEF LBUF SPC 5 SKP * ***** * ** BAKUP ** BACK UP INPUT BUFFER (QIBUF) POINTERS BY ONE CHARACTER * CALLING SEQUENCE: * * JSB BAKUP * RETURN * ***** BAKUP NOP LDA QQCNT DECREMENT CHAR COUNT ADA M1 STA QQCNT LDB QQPTR SLA AND IF NECESSARY, ADB M1 DECREMENT POINTER STB QQPTR JMP BAKUP,I ***** * THE ABSOLUTE RECORD BUFFER * .ABR DEF ABREC ABREC OCT 0 ABRC1 BSS 49 BUFFER FOR ABSOLUTE RECORD ABL1 DEF ABREC+2 HOLDS CURRENT BUFFER ADDRESS ABL2 DEF ABREC+2 SPC 5 ***** * ** PACK ** INSERT A WORD INTO THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * LDA WORD TO BE PLACED IN RECORD * JSB PACK * RETURN * * NOTE: .B. IS NOT ALTERED BY THIS SUBROUTINE ***** PACK NOP STA ABL1,I STORE WORD AT NEXT LOCATION ISZ ABL1 IN BUFFER, INCREASE ADDRESS. ADA CKS ADD WORD TO CHECKSUM STA CKS AND RESTORE WORD ISZ ABREC COUNT WORD JMP PACK,I AND EXIT. * PACK# EQU PACK SKP ***** * ** PUNCH ** OUTPUT THE RECORD IN THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * JSB PUNCH * RETURN * * NOTE: THIS SUBROUTINE INSERTS CHECKSUM AND WORDCOUNT BEFORE OUTPUT ***** PUNCH NOP ENTRY/EXIT LDA OUTON OUTPUT FILE OPEN? SZA,RSS JMP ERROO NO, ERROR EXIT LDA CKS ADD LOAD ADDRESS TO CHECK-SUM ADA ABREC+1 AND SET RECORD SUM STA ABL1,I IN LAST WORD OF RECORD. LDA ABREC ADD 2 TO RECORD WORDCOUNT ALF,ALF POSITION AS FIRST CHAR. AND STA ABREC SET. ALF,ALF REPOSITION, ADD 3 FOR TOTAL ADA B3 LENGTH AND SET FOR CMA,INA LDB .ABR JSB WRFL2 WRITE RECORD TO ABS OUTPUT FILE CLA ScNLH ZERO OUT STA ABREC WORD COUNT STA CKS AND CHECKSUM LDA ABL2 INITIALIZE STA ABL1 NEXT WORD POINTER JMP PUNCH,I EXIT- * ERROO CLB JSB CLFL3 CLOSE REL FILE LDA OO CLB ERROR CODE JMP WERR1 * OO ASC 1,OO * CKS NOP CHECKSUM OUTON NOP * B3 OCT 3 JN HED SCANNER ROUTINE ***** * ** SCAN ** SCAN INPUT BUFFER (QIBUF) FOR KEYWORD * CALLING SEQUENCE: * * LDA NUMBER OF ENTRIES TO SEARCH * LDB ADDRESS OF PNEUMONIC TABLE ENTRY ASSOC WITH FIRST CHOICE * JSB SCAN * RETURN1 NOT FOUND * RETURN2 FOUND, OFFSET FROM FIRST ENTRY SEARCHED IN .A. * * NOTE: THIS ROUTINE WILL SKIP LEADING BLANKS IN ATTEMPTING A MATCH. * FURTHER,BUFFER POINTERS ARE ADVANCED PAST THE KEYWORD * MATCHED OR RESET IF NO MATCH OCCURRED. ***** SCAN NOP ENTRY/EXIT STB PTR INITIALIZE SCANNER STA CNTR CLA STA CNT INITIALIZE OFFSET COUNTER SCAN1 LDA PTR,I GET COMMAND POINTER WORD AND B377 MASK COMMAND TABLE OFFSET ADA CMTBL STA PTR2 STORE POINTER TO ASCII COMMAND LDA PTR,I ALF,ALF AND B377 GET # CHARS. STA NCHAR ISZ CNT BUMP OFFSET COUNTER CLA STA CCNT LDA QQCNT SAVE CHARACTER STREAM STA QQCN1 LDA QQPTR STA QQPT. POINTERS. JSB NXTC GET THE FIRST NON-BLANK CHAR CLA END OF LINE JMP SCAN5 GET REST OF CHARS IN LOOP SCAN2 JSB QGETC GET NEXT CHARACTER. CLA NO MORE CHARS. SCAN5 STA TEMP LDA PTR2,I LDB CCNT ISZ CCNT CPB NCHAR ALL CHARS. MATCH? JMP SCAN4 YES-CHECK END OF INPUT ELEMENT. SLB,RSS IS CHAR IN HIGH-ORDER BYTE? ALF,ALF YES--ROTATE TO LOW AND B177 MASK SLB BUMP ASCII COMMAND TABLE POINTER ON ISZ PTR2 EVEN-NUMBERED CHARACTERS. CPA TEMP DO CHARS. MATCH? JMP SCAN2 YES--SO FAR. LDA QQPT. NO--BACKUP POINTERS STA QQPTR LDA QQCN1 STA QQCNT SPC 1 * NOW BUMP COMMAND TABLE POINTER, OR TAKE ERROR EXIT * IF NO MORE LEFT SPC 1 ISZ PTR ISZ CNTR END OF TABLE? JMP SCAN1 NO JMdUP SCAN,I SPC 1 SCAN4 LDA TEMP IS NEXT SOURCE CHAR A DELIMITER? SZA END OF LINE? JSB BAKUP LDA CNT ISZ SCAN JMP SCAN,I * CCNT NOP COUNTER CNT NOP OFFSET COUNTER CNTR NOP NUMBER OF ENTRIES TO SEARCH NCHAR NOP NUMBER OF CHARACTERS PTR NOP MNEMONIC TABLE ADDRESS PTR2 NOP POINTER TO ASCII COMMAND QQCN1 NOP CHARACTER STREAM QQPT. NOP POINTERS TEMP NOP TEMP STORAGE * B377 OCT 377 HED INPUT COMMAND LINE HED SEARCH SYMBOL TABLE FOR MATCH ROUTINE ***** * ** SSTBL ** SEARCH SYMBOL TABLE * CALLING SEQUENCE * * LDB ADDRESS OF 5 CHAR NAME TO MATCH * JSB SSTBL * RETURN1 SYMBOL NOT FOUND * RETURN2 FOUND, LST1-LST5 POINT TO MATCHED ENTRY * * NOTE: THE NAME INPUT FOR MATCH MUST START ON A WORD BOUNDARY ***** SPC 1 SSTBL NOP CLA FLAG FOR 0 ENTRY IN LST TABLE STA FFLAG STB CMDIN SAVE TEMPORARILY JSB LSTI INITIALIZE SYMBOL TABLE SSTB1 JSB LSTP SET LST ENTRY ADDRESSES JMP SSTBL,I END OF TABLE LDA LST1,I GET WORD 1 OF LST ENTRY SZA USED ENTRY? JMP SSTB2 YES LDA LST1 ADA M1 STA FFLAG SAVE ADDRESS OF LAST 0 ENTRY SSTB2 LDB CMDIN RETRIEVE ADDRESS OF TARGET MATCH LDA B,I CPA LST1,I CHARS. 1&2 MATCH? INB,RSS JMP SSTB1 NO--GET NEXT ENTRY LDA B,I CPA LST2,I INB,RSS JMP SSTB1 LDA B,I XOR LST3,I AND UPCM CHECK CHAR. 5 SZA JMP SSTB1 * MATCH FOUND -- MAKE SUCCESS RETURN ISZ SSTBL JMP SSTBL,I * FFLAG NOP FLAG FOR 0 ENTRY IN LST * UPCM OCT 77400 SKP SKP * * * SUBROUTINE TO GET LOGICAL UNIT NUMBER OF FILE * LOCFS NOP STA IDCB JSB LOCF DEF *+9 DEF IDCB,I DCB BUFFER DEo3F IERR ERROR CODE DEF IREC NEXT RECORD NUMBER DEF IRB RELATIVE BLOCK OF NEXT READ DEF IOFF BLOCK OFFSET OF NEXT READ DEF JSEC NUMBER OF SECTORS IN THE FILE DEF JLU FILE LOGICAL UNIT DEF JTY FILE TYPE JMP LOCFS,I * IOFF NOP IRB NOP IREC NOP JLU NOP JTY NOP JSEC NOP SKP * * LOADER-GENERATOR EXITS * EXEC0 LDB LDGEN GENERATOR CALLING? SZB,RSS JMP CONSL YES, TRY SYSTEM CONSOLE LDB INACT INTERACTIVE INPUT? SZB,RSS JMP CONSL NO, TRY SYSTEM CONSOLE LDA B4 STA CMDLU JMP NXTCM * EXEC6 CCA JSB GLWAM RELEASE MEMORY EXEC7 JSB CLFL1 PROGRAM TERMINATION, CLB JSB CLFL2 CLOSE ALL FILES OPEN OR NOT CLB JSB CLFL3 JSB CLFL4 JSB CLFL5 JSB CLFL6 JSB CLFL7 JSB EXEC TERMINATE PROGRAM DEF *+2 DEF B6 * CONSL LDB PRPTA JSB OTMES JMP NXTC2 * B2 OCT 2 B6 OCT 6 * INACT NOP SKP * * * CFILE DEF *+1 COMMAND INPUT ASC 3,LU.. * OFILE DEF *+1 ABSOLUTE OUTPUT ASC 3,LU.. * LFILE DEF *+1 MAP/LIST AL ASC 3,LU.. * EFILE DEF *+1 PROMPT/ERROR ASC 3,LU.. * IFILE DEF *+1 RELOCATE-SEARCH ASC 3,LU.. * TRANS DEF *+1 TRANSFER ASC 3,LU.. * SNAPS DEF *+1 SNAP/DISPLAY ASC 3,LU.. * ECHOS DEF *+1 ECHO ECFIL ASC 3,LU.. SKP * * SUBROUTINE TO STUFF MESSAGE IN OUTPUT BUFFER AND TO SEND * IT TO THE SYSTEM CONSOLE * STFER NOP STA AMERR+3 STORE MESSAGE IN OUTPUT BUFFER JSB ERRPR PROCESS ANY FMP ERROR CODE LDA B6 MESSAGE LENGTH LDB AMERR MESSAGE ADDRESS JSB MESSI OUTPUT MESSAGE OCT 2 ON SYSTEM CONSOLE JMP STFER,I * BUFAD DEF *+8 AMERR DEF *+1 ASC 3,ERR ERROR MESSAGE 9= ERROR + CODE MERR ASC 3, FMP BSS 3 SKP * * * THIS SUBROUTINE WILL MERGE THE FMP ERROR CODE * WITH A MNEMONIC TYPE AND REPORT IT TO EITHER THE * SESSION CONSOLE OR ERROR LOG DEVICE. * * ERRPR NOP STB 0 SZA,RSS ANY FMP ERROR CODE? JMP ERRPR,I NO, RETURN STA NUMB1 SSA CMA,INA SAVE NO. TO BE CONVERTED STA NUMB JSB CNUMD CONVERT TO ASCII DEF *+3 DEF NUMB DEF BUFAD,I LDA M3 STA KOUNT LDB BUFAD STB BUFF1 ERRP2 LDA 1,I DELETE BLANKS CPA BLANK JMP ERRP1 STA BUFF1,I ISZ BUFF1 ERRP1 INB ISZ KOUNT JMP ERRP2 LDB BLANK LDA NUMB1 SSA LDB BB55 STB MERR+2 LDA BUFAD CMA,INA ADA BUFF1 RAL ADA D12 MESSAGE LENGTH ISZ ERRPR JMP ERRPR,I * BUFF1 NOP KOUNT NOP NUMB NOP NUMB1 NOP * BB55 OCT 20055 * * SKP * * * SUBROUTINE TO SEND-GET MESSAGE TO-FROM SYSTEM CONSOLE * * MESSI NOP CMA,INA STA IL MESSAGE LENGTH STB IBUF MESSAGE ADDRESS LDA MESSI,I STA INOUT INPUT OR OUTPUT ISZ MESSI JSB IMESS DEF *+4 DEF INOUT INPUT/OUTPUT MESSAGE DEF IBUF,I MESSAGE ADDRESS DEF IL CHARACTER COUNT JMP MESSI,I * INOUT NOP * * ADDRESSES OF DATA CONTROL BLOCKS * DCB1 DEF IDCB1 DCB2 DEF IDCB2 DCB3 DEF IDCB3 DCB4 DEF IDCB4 DCB5 DEF IDCB5 DCB6 DEF IDCB6 DCB7 DEF IDCB7 SKP WERR1 JSB ERROR JMP EXEC0 * ABRT1 JSB ABRT JMP EXEC6 EXIT * * * ABRT NOP LDB RTMLG LDA D16 JSB MESSI OCT 2 CLA,INA STA TRUNC DON'T TRUNCATE ON ABORT JMP ABRT,I * TRUNC NOP * * RTMLG DEF *+1 ASC 8,RTMLG TERMINATED * D16 DEC 16 SKP * * * SUBROUTINE p#TO WRITE ON FILES * * WRFL1 NOP JSB WRTFL COMMAND/PROMPT/ERROR DEF DCB1 JMP WRFL1,I * * * WRFL2 NOP JSB WRTFL OUTPUT DEF DCB2 JMP WRFL2,I * * * WRFL4 NOP JSB WRTFL LIST (MAP) DEF DCB4 JMP WRFL4,I * * * WRFL5 NOP JSB WRTFL ECHO DEF DCB5 JMP WRFL5,I * * * WRFL7 NOP JSB WRTFL ERROR/PROMPT DEF DCB7 JMP WRFL7,I * SKP * * * WRITE ON FILES * * A REG = LENGTH OF WRITE REQUEST * B REG = ADDRESS OF BUFFER * * (P+1) = ADDRESS OF DCB * * WRTFL NOP SSA JMP WRT1 INA ARS WRT2 STA IL SAVE BUFFER LENGTH STB IBUF SAVE BUFFER ADDRESS LDA WRTFL,I GET ADDRESS OF DCB AND SAVE JSB INDCK INDIRECT CHECK LDA 0,I STA IDCB ISZ WRTFL INC. RET. ADDRESS JSB WRITF WRITE FILE DEF *+5 RETURN ADDRESS DEF IDCB,I DATA CONTROL BLOCK DEF IERR ERROR CODE DEF IBUF,I DATA BUFFER ADDRESS DEF IL DATA BUFFER LENGTH SZA JMP ERRWE ERROR EXIT JMP WRTFL,I WRT1 CMA,INA JMP WRT2 * ERRWE LDA WE LDB IERR ERROR CODE STA AMERR+3 WRITE ERROR JSB ERRPR PROCESS ANY FMP ERROR CODE LDA B6 LDB AMERR JSB MESSI OCT 2 JMP ABRT1 ABORT * WE ASC 1,WE SKP * * * SUBROUTINES TO READ FILES * * A REG = DATA CONTROL BLOCK ADDRESS * B REG = DATA BUFFER ADDRESS * * RDFL1 NOP JSB READ INPUT COMMANDS DEC 80 READ REQUEST LENGTH JMP RDFL1,I * * * RDFL6 NOP JSB READ TRANSFER DEC 80 READ REQUEST LENGTH JMP RDFL6,I * * * RDFL7 NOP JSB READ ERROR-PROMPT DEC 80 READ REQUEST LENGTH JMP RDFL7,I SKP * * * READ FILE * * A REG =o DATA CONTROL BLOCK ADDRESS * B REG = DATA BUFFER ADDRESS * (P+1) = DATA BLOCK MAXIMUM LENGTH * * ON RETURN A REG = ACTUAL LENGTH READ * * READ NOP STA IDCB DATA CONTROL BLOCK ADDRESS STB IBUF DATA BUFFER ADDRESS LDA READ,I GET MAXIMUM LENGTH OF DATA BLOCK ARS STA IL ISZ READ INC. RET. ADDRESS READ1 JSB READF READ FILE DEF *+6 RETURN ADDRESS DEF IDCB,I DATA CONTROL BLOCK DEF IERR ERROR CODE DEF IBUF,I DATA BUFFER DEF IL READ REQUEST LENGTH DEF LEN ACTUAL READ LENGTH SZA JMP ERRRE ERROR EXIT LDA LEN ACTUAL READ LENGTH SZA,RSS JMP READ1 0 RECORD RAL GET NUMBER OF CHARACTERS JMP READ,I * ERRRE LDA RE LDB IERR ERROR CODE JMP WERR1 READ ERROR * RE ASC 1,RE LEN NOP ACTUAL READ LENGTH, RETURNED * READ# EQU READ SKP * * * SUBROUTINES TO CLOSE FILES * * CLFL1 NOP LDA DCB1 CLOSE COMMAND/PROMPT/ERROR FILE CLB JSB CLSFL JMP CLFL1,I * * * CLFL2 NOP STB EOF LDA DCB2 CLOSE ABSOLUTE OUTPUT FILE JSB INDCK JSB LOCFS GET FILE TYPE CPA M11 DCB NOT OPEN? JMP CLF2A YES SSA JMP CLF2B LOCF ERROR LDA JTY SZA,RSS TYPE 0? JMP CLF2A YES, DON'T TRUNCATE FILE LDA JSEC # SECTORS INA ARS LDB IRB RELATIVE BLOCK OF NEXT READ CMB ADA 1 STA ITRUN # OF BLOCKS TO BE TRUNCATED CLF2A LDB EOF LDA DCB2 JSB CLSFL JMP CLFL2,I * EOF NOP CLF2B LDA CE LDB IERR ERROR CODE JSB STFER JMP CLF2A * * * CLFL3 NOP LDA DCB3 CLOSE REL/SNAP/DISPLAY FILE JSB CLSFL JMP CLFL3,I * * * CLFL4 NOP LDA DCB4 CLOSE LIST (MAP)' FILE CLB,INB JSB CLSFL JMP CLFL4,I * * * CLFL5 NOP LDA DCB5 CLOSE ECHO FILE CLB,INB JSB CLSFL JMP CLFL5,I * * * CLFL6 NOP LDA DCB6 CLOSE TRANSFER FILE CLB JSB CLSFL JMP CLFL6,I * * * CLFL7 NOP LDA DCB7 CLOSE ERROR/PROMPT FILE CLB,INB JSB CLSFL JMP CLFL7,I SKP * * * SUBROUTINE TO CLOSE THE DATA CONTROL BLOCK AND MAKE * THE FILE AVAILABLE TO OTHER CALLERS * * A REG = ADDRESS OF DATA CONTROL BLOCK * * CLSFL NOP STA IDCB SAVE ADDRESS OF DATA CONTROL BLOCK CPA DCB2 ABSOLUTE OUTPUT FILE? JMP CLSF1 YES CLA STA ITRUN CLSF1 LDA B100 GO WRITE END OF FILE SZB WRITE EOF? JSB CNTRL YES LDA TRUNC TRUNCATE? SZA,RSS JMP CLSF2 SET TO TRUNCATE CLA STA ITRUN DON'T TRUNCATE CLSF2 JSB CLOSE CLOSE FILE DEF *+4 RETURN ADDRESS DEF IDCB,I ADDRESS OF DATA CONTROL BLOCK DEF IERR ERROR CODE DEF ITRUN # OF BLOCKS TO BE TRUNCATED SSA,RSS JMP CLSFL,I CPA M11 DCB NOT OPEN JMP CLSFL,I LDA CE ERROR EXIT LDB IERR ERROR CODE JSB STFER CLOSE ERROR JMP CLSFL,I * CE ASC 1,CE * B100 OCT 100 M11 DEC -11 * IERR NOP ITRUN NOP * IERR# EQU IERR SPC 5 * * * SUBROUTINE TO CONTROL A PERIPHERAL DEVICE * * A REG = CONTROL CODE * * CNTRL NOP STA ICNTL SAVE CONTROL CODE JSB FCONT DEF *+4 RETURN ADDRESS DEF IDCB,I DATA CONTROL BLOCK DEF IERR ERROR CODE DEF ICNTL CONTROL CODE JMP CNTRL,I * * ICNTL NOP CONTROL CODE SKP * * * SUBROUTINE TO GET INPUT FROM SYSTEM CONSOLE * OR INTERACTIVE INPUT * * CRTIN NOP STA IL SAVE LENGTH Ʃ LDA ERACT SZA JMP CRT2 ERROR LOG INTERACTIVE LDA INACT INTERACTIVE INPUT? SZA JMP CRT1 YES LDA IL NO, READ FROM SYSTEM CONSOLE JSB MESSI OCT 1 LDA 1 JMP CRTIN,I CRT1 LDA DCB1 DCB JSB RDFL1 READ FROM INTERACTIVE INPUT JMP CRTIN,I CRT2 LDA DCB7 DCB JSB RDFL7 READ FROM ERROR LOG JMP CRTIN,I * * * SUBROUTINE TO CHECK FOR INDIRECTS AND REMOVE THEM * * INDCK NOP SSA,RSS JMP INDCK,I AND UDFE LDA 0,I JMP *-4 * IN#CK EQU INDCK * * IBUF NOP ADDRESS OF BUFFER ICR NOP LABEL IL NOP BUFFER LENGTH IOPTN NOP OPEN OPTION ISECU NOP SECURITY CODE FRTRU NOP FIRST TIME THRU FLAG LDGEN NOP LOADER = 1 OR GENERATOR = 0 CALLING * UDFE OCT 77777 SKP SKP ** NXTC ** GET NEXT NON-BLANK CHAR FROM INPUT BUFFER (QIBUF) *CALLING SEQUENCE: * * JSB NXTC * RETURN1 NO MORE NON-BLANK CHARS * RETURN2 GOT ONE, AND IT IS RETURNED IN .A. * ***** NXTC NOP GET NEXT NONN-BLANK CHARACTER. JSB QGETC JMP NXTC,I ERROR RETURN CPA B40 BLANK? JMP *-3 YES ISZ NXTC TAKE NORMAL EXIT JMP NXTC,I * B40 OCT 40 * * * SUBROUTINE TO OUTPUT MESSAGE ON ERROR/PROMPT LOG DEVICE. * IF NO ERROR DEVICE THEN OUTPUT WILL BE MADE TO THE * INPUT DEVICE IF IT IS INTERACTIVE. IF INPUT IS NOT * INTERACTIVE THEN OUTPUT WILL BE ON LU 1 WHICH SHOULD * BE THE SESSION CONSOLE. * * PRINT NOP STA LENGT SAVE LENGTH OF MESSAGE STB ADDRS SAVE ADDRESS OF MESSAGE LDA ERDVC ERROR/PROMPT DEVICE GIVEN? SZA,RSS JMP DIAG1 NO LDA LENGT GET MESSAGE LENGTH JSB WRFL7 YES, WRITE MESSAGE ON ERROR LOG DEVICE LDA ERACT ERROR LOG INTERACTIVE? SZA JMP PRINT,I YES, EXI='T LDB ADDRS DIAG1 LDA INACT IS INPUT DEVICE INTERACTIVE? SZA,RSS JMP DIAG3 NO OUTPUT TO SESSION CONSOLE LDA FL1OP IS INPUT OPEN? SZA,RSS JMP DIAG3 NO, USE SESSION CONSOLE LDA LENGT GET MESSAGE LENGTH JSB WRFL1 OUTPUT MESSAGE JMP PRINT,I DIAG3 LDA LENGT GET MESSAGE LENGTH JSB MESSI OUTPUT MESSAGE TO SYSTEM CONSOLE OCT 2 JMP PRINT,I * ADDRS NOP MESSAGE ADDRESS ERDVC NOP ERROR/PROMPT DEVICE GIVEN? FL1OP NOP INPUT OPEN? LENGT NOP MESSAGE LENGTH SKP * * * SUBROUTINE TO OUTPUT MESSAGE TO MAP FILE * * MAPS NOP STA LENGT SAVE LENGTH OF MESSAGE STB ADDRS SAVE ADDRESS OF MESSAGE LDA MAPON IS MAP FILE OPEN? SZA,RSS JMP MAPS,I NO, EXIT LDA EMSAM MAP AND ECHO FILE SAME? CPA M1 JMP DIAG4 YES, OUTPUT TO ECHO FILE LDA LENGT GET MESSAGE LENGTH LDB ADDRS GET MESSAGE ADDRESS JSB WRFL4 OUTPUT TO LIST DEVICE JMP MAPS,I DIAG4 LDA LENGT MESSAGE LENGTH LDB ADDRS MESSAGE ADDRESS JSB WRFL5 OUTPUT TO ECHO DEVICE JMP MAPS,I * MAPON NOP SKP SKP ***** * ** DIAG2 ** OUTPUT MESSAGES THAT ARE STORED WITH THE CHAR COUNT * IMMEDIATELY PRECEEDING THE BUFFER. * CALLING SEQUENCE: * * LDB ADDRESS OF BUFFER MINUS 1, WHICH CONTAIN BUFFER LENGTH * JSB DIAG2 * RETURN * ***** DIAG2 NOP ENTRY: LDB,JSB LDA B,I INB JSB PRINT GO OUTPUT MESSAGE LDA LENGT LDB ADDRS JSB MAPS JMP DIAG2,I RETURN. * * ** DIAG ** SAME AS DIAG2 BUT MESSAGE OUTPUT ONLY TO CONSOLE * ONLY IF INPUT IS INTERACTIVE. * * DIAG NOP LDA B,I INB STA LENGT LDA CONSO SWITCH TO SESSION CONSOLE? SZA JMP DIAGA YES, OUTPUT MESSAGE ( LDA INACT INTERACTIVE INPUT? SZA,RSS JMP DIAGB NO DIAGA LDA LENGT JSB PRINT GO OUTPUT MESSAGE LDB ADDRS DIAGB LDA LENGT JSB MAPS GO MAP OR ECHO IF NEEDED JMP DIAG,I * * DIAGNOSTIC OUTPUT SECTION * LER3 LDB MEMOV MEMORY OVERFLOW JMP ERREX * LER5 LDB SYMOV SYMBOL TABLE OVERFLOW ERREX JSB DIAG2 PRINT DIAGNOSTIC ABORT LDB RELAB RELAB JSB DIAG2 PRINT MESSAGE CLA STA UEXFL CLEAR UNDEF EXTERNS FLAG STA NAMR. ALLOW A NAM RECORD JSB LSTI INITIALIZE SYM TAB POINTERS LOOP1 JSB LSTP GO TO NEXT SYM TAB ENTRY JMP ABRT1 NO MORE, ERROR EXIT LDA LST3,I CLEAR AND UPCM EXTERNAL STA LST3,I ID NUMBER JMP LOOP1 DO FOR ALL SYM TAB ENTRIES * NAMR. NOP ALLOW A NAM RECORD UEXFL NOP UNDEF EXTERNALS FLAG * AB#RT EQU ABORT SKP * RELAB DEF *+1 OCT 6 ASC 3,REL AB * MEMOV DEF *+1 OCT 6 ASC 3,MEM OV * SYMOV DEF *+1 OCT 6 ASC 3,SYM OV * * * SUBROUTINE TO OUTPUT ERROR MESSAGES * * ERROR NOP STA AMERR+3 STORE ERROR MESSAGE IN OUTPUT BUFFER JSB ERRPR PROCESS ANY FMP ERROR CODE LDA B6 MESSAGE LENGTH LDB AMERR MESSAGE ADDRESS JSB PRINT GO OUTPUT MESSAGE LDA LENGT LDB ADDRS JSB MAPS JMP ERROR,I * ER#OR EQU ERROR SKP * LNKDR NOP LINK DIRECTION * * THE FOLLOWING CORE IS THE USER'S MEMORY TABLE. * .MEM. DEF *+1 USER'S MEMORY TABLE .MEM1 OCT 100 SET DEFAULT FWABP .MEM2 OCT 1646 SET DEFAULT LWABP .MEM3 OCT 2000 SET DEFAULT FWAM .MEM4 OCT 77777 SET DEFAULT LWAM .MEM5 NOP SET DEFAULT FWAC .MEM6 NOP SET DEFAULT LWAC FWABP EQU .MEM1 LWABP EQU .MEM2 FWAM EQU .MEM3 LWAM EQU .MEM4 FWAC EQU .MEM5 LWAC EQU .MEM6 * MEMRY DEF FWABP SKP p SKP ***** * ** LSTI / LSTP ** SYMBOL TABLE ACCESSING SUBROUTINES * * PURPOSE: TO SET IN WORDS LST1 - LST5 THE * ADDRESSES OF THE FIVE WORDS IN AN * ENTRY IN THE LST (LOADER SYMBOL TABLE) * * INITIAL SETUP IS MADE BY THE ROUTINE * -LSTI- THIS SECTION INITIALIZES * THE NEGATIVE COUNT OF THE NUMBER * OF ENTRIES IN THE LST AND SETS LST5 POINTING TO * THE "-1"TH ENTRY. SPC 1 * THE SECTION -LSTP- SETS THE FIVE * ADDRESSES OF THE NEXT LST ENTRY * IN LST1-LST5. IT ALSO INDEXES THE * ENTRY COUNTER. WHEN THE COUNTER = ZERO * EXIT FROM LSTP IS TO P+1 OF THE CALL * AND LST1-LST5 CONTAIN THE ADDRESSES * FOR A NEW ENTRY. IF THE COUNT AFTER * INDEXING IS NOT ZERO, EXIT IS TO * P+2 OF THE CALL. SPC 1 * CALLING SEQUENCE: (P-1) JSB LSTI * (P) JSB LSTP * (P+1) (END OF LST RETURN) * (P+2) (NEXT ENTRY ADDRESSES * SET RETURN) SPC 2 * - INITIALIZER- SPC 1 LSTI NOP LDA LSTA,I GET NUMBER OF LST ENTRIES - SET CMA NEGATIVE THE VALUE + 1. STA LSTPX STORE LDA LSTA SET ADDRESS+1 OF WORD 1 OF FIRST STA LST5 JMP LSTI,I EXIT SPC 2 * - PROCESSOR - SPC 1 LSTP NOP LDA LST5 INA STA LST1 INA STA LST2 INA STA LST3 INA STA LST4 INA STA LST5 ISZ LSTPX INDEX ENTRY COUNTER. ISZ LSTP NOT END OF LST - SET P+2 EXIT JMP LSTP,I -EXIT- TO P+1 IF END OF LST. * * SUBROUTINE TO INITIALIZE LST PAST KNOWN UNDEFS * LSTM NOP JSB LSTI INITIALIZE LST LDA LSTPX ADD UNDEFS TO ENTRY COUNTER ADA UNDEF STA LSTPX LDA UNDEF SET BHFBLST START ADDRESS PAST UNDEFS RAL,RAL ADA UNDEF ADA LST5 STA LST5 JMP LSTM,I SPC 2 * LSTA DEF LST,I DEFINE STARTING ADDRESS OF LST LSTPX OCT 0 HOLDS ENTRY COUNTER(NEG. #+1). LST1 OCT 0 LST2 OCT 0 LST3 OCT 0 LST4 OCT 0 LST5 NOP UNDEF NOP ******************************************************************** * THE BASE PAGE LINKS TABLE (STORED IN BPAGE) * HAS ROOM FOR 1020 WORDS, CORRESPONDING * TO CORE ADDRESSES(OCTAL) 4-1777. * LOCATIONS 0-1 ARE INACCESSIBLE ANYWAY, AND LOCATIONS * 2,3 ARE RESERVED FOR RTM PROGRAM DESCRIPTION RECORDS. * BSS 4 PROTECT AGAINST FWABP<4 * BPAGE BSS 1020 BASE PAGE LINKS TABLE BPAGA DEF BPAGE-4 OFFSET * **************************************************************** * THE CURRENT PAGE LINKS TABLE HAS ROOM FOR 128 * WORDS. THIS IS THE MAXIMUM NUMBER OF LINKS * THAT CAN BE ASSIGNED ON THE CURRENT PAGE. * CPAGE DEF *+1 BSS 128 SKP * * RELOCATION BASE TABLE ( RBT ) * * THE ORDER OF THESE ENTRIES MUST BE MAINTAINED RBTO DEF LOCC RBTA DEF B0 B0 NOP ABSOLUTE RELOCATION BASE LOCC NOP PROGRAM RELOCATION BASE BPLOC NOP BASE PAGE RELOCATION BASE COMOR OCT 0 COMMON RELOCATION OCT 0 ABSOLUTE * MLOCC EQU LOCC SKP H***** * ** FUTI / FUTP **FIXUP TABLE ACCESSING SUBROUTINES * * * - INITIALIZER- SPC 1 FUTI NOP LDA OPT.3,I GET NO. OF FIXUP ENTRIES CMA SET NEGATIVE + 1 STA FUTPX LDA FUTA,I SET ADDRESS OF FIRST STA FUT4 FIXUP TABLE ENTRY JMP FUTI,I SPC 1 * - PROCESSOR - SPC 1 FUTP NOP LDA FUT4 ADA M1 STA FUT1 ADA M1 STA FUT2 ADA M1 STA FUT3 ADA M1 STA FUT4 ISZ FUTPX INDEX ENTRY COUNTER ISZ FUTP NOT END OF FIXUP TABLE, SET P+2 EXIT JMP FUTP,I EXIT-TO P+1 IF END OF FIXUP TABLE FUTA DEF OPT.3 FUT1 NOP FUT2 NOP FUT3 NOP FUT4 NOP FUTPX NOP * OPT.3 NOP END OF MEMORY POINTER * SPC 1 * - SHORT FIXUP - SPC 1 FUTS NOP LDA FUT4 ADA M1 STA FUT1 EQT EXTENSION ADDRESS ADA M1 STA FUT4 EQT EXTENSION LENGTH ISZ FUTPX ISZ FUTS JMP FUTS,I SKP * * SUBROUTINE TO GET INPUT FROM INPUT DEVICE IF IT IS * INTERACTIVE ELSE SYSTEM CONSOLE. * * OTMES NOP JSB DIAG2 OUTPUT MESSAGE LDB QBUFA INPUT BUFFER LDA D72 MAXIMUM INPUT LENGTH JSB CRTIN GO GET INPUT STA QQCHC DATA LENGTH CLA STA QQCNT RESET COUNTER LDA QBUFA AND STA QQPTR BUFFER POINTER LDA QQCHC MAP/ECHO INPUT LDB QBUFA JSB EKHOS JMP OTMES,I * D72 DEC 72 * * BSS 2 MOVEX NOP MOVE A BLOCK OF DATA STA MOVEX-1 STORE NEG. # WORDS. LDA MOVEX,I ISZ MOVEX STA MOVEX-2 STORE TO POINTER LDA 1 TRACK DOWN JSB INDCK A DIRECT STA 1 'FROM' ADDRESS. LDA B,I GET WORD STA MOVEX-2,I STORE INB ISZ MOVEX-2 ISZ MOVEX-1 DONE? JMP *-5 JMP MOVEX,I YEЋS SKP HED *** MORE UTILITY SUBROUTINES ****** ***** * * SUBROUTINE: CONV (CONVERT 16-BIT BINARY NUMBER * TO 6-CHARACTER * ASCII FORM OF THE OCTAL * REPRESENTATION.) * * CALLING SEQUENCE: * * (A)-ADDRESS OF 3-WORD AREA FOR * STORING ASCII/OCTAL CHARACTERS * (B)-BINARY VALUE FOR CONVERSION * * (P) JSB CONV * (P+1) (RETURN)-(A)=NEXT ADDRESS OF STORAGE * AREA,(B)-DESTROYED. ***** CONV NOP STA NBUF+3 SAVE STORAGE AREA ADDRESS RBL POSITION FIRST DIGIT TO B(15-13). LDA M3 LET CONVERT COUNTER STA NBUF+4 = -3. LDA B40 MAKE FIRST CHARACTER A SPACE. SLB NEGATIVE NUMBER? LDA B61 YES CONV1 ALF,ALF ROTATE CHAR. TO UPPER POSITION STA NBUF+5 AND SAVE. BLF,RBR POSITION NEXT DIGIT TO B(02-00), LDA B AND B7 ISOLATE DIGIT. IOR B60 MAKE AN ASCII CHAR. (60 - 67). IOR NBUF+5 PACK IN UPPER CHARACTER STA NBUF+3,I AND STORE IN STORAGE AREA. ISZ NBUF+3 ADD 1 TO STORAGE AREA ADDRESS. BLF,RBR ROTATE NEXT DIGIT TO LOW B, LDA B ISOLATE CHAR AND B7 IN LOW A, IOR B60 MAKE AN ASCII CHAR. ISZ NBUF+4 INDEX CONVERT COUNTER JMP CONV1 NOT FINISHED. LDA NBUF+3 FINISHED, SET (A)= NEXT STORAGE JMP CONV,I AREA WORD ADDRESS AND EXIT. * LBUF5 DEF LBUF+4 LBF10 DEF LBUF+9 M3 DEC -3 B7 OCT 7 B60 OCT 60 B61 OCT 61 BLANK ASC 1, (ORG LBUF-1 FOR EPL SUBROUTINE) LBUF OCT 0 OCT 0 BSS 58 NBUFA DEF NBUF NBUF BSS 67 HOLDS PROGRAM NAME AND PARAMETERS * LBUF# EQU LBUF SKP ***** * ** PLK ** * * PLK PUNCHES CORE FROM A TO B IN ABS FORMAT. * IT ALSO LISTS THE PUNCH BOUNDS. A, B SPECIFY THE * FINAL LOAD ADDRESS OyF THE DATA. OFFSET IS ADDED TO * GET THE CURRENT CORE LOCATION. * ***** PLKS NOP FOR OFFSET PLK NOP ENTRY: LDA,LDB,JSB. STA PLK1 INB STB PLK3 PL2 LDA MD45 INITIALIZE COUNTER STA PLK2 FOR MAX. BLOCK SIZE OF 45 WORDS. LDA PLK4 STORE LOAD ADDR. OF BLOCK STA ABRC1 IN WORD 2 OF PUNCH BUFFER PL3 LDA PLK1 ADA PLKS ADD OFFSET TO GET ACTUAL ADDRESS IN CORE LDA A,I GET WORD TO PUNCH JSB PACK PUT INTO BUFFER ISZ PLK1 ADD 1 TO CURRENT BLOCK ADDR. ISZ PLK4 LDA PLK1 IF CURRENT BLOCK CPA PLK3 TERMINATED, GO TO JMP PL4 PUNCH LAST BLOCK. ISZ PLK2 INDEX COUNTER. JMP PL3 BUFFER NOT FILLED. JSB PUNCH BUFFER FILLED - PUNCH JMP PL2 FILL NEXT BUFFER. * PL4 JSB PUNCH PUNCH LAST BUFFER - JMP PLK,I EXIT. * PLK1 NOP HOLDS FWA PUNCH AREA PLK2 NOP HOLDS BUFFER INDEX PLK3 NOP HOLDS LWA+1 PUNCH AREA PLK4 NOP MD45 DEC -45 * SKP ***** * ** QGETC ** GET NEXT CHAR FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB * RETURN1 NO MORE CHARS IN BUFFER * RETURN2 GOT ONE, RETURN IT IN .A. * ***** QGETC NOP GET A CHARACTER LDB QQCNT CPB QQCHC END OF INPUT? JMP QGETC,I YES. ISZ QQCNT COUNT CHARS READ LDA QQPTR,I SLB,RSS LEFT CHAR? ALF,ALF YES, MOVE RIGHT AND B177 SLB IF THIS CHAR IS RIGHT, ... ISZ QQPTR NEXT ONE IS LEFT OF NEXT WORD. ISZ QGETC SKIP EXIT JMP QGETC,I * B177 OCT 177 M60 OCT -60 QBUFA DEF QIBUF QIBUF BSS 40 QQCHC NOP QQCNT NOP QQPTR NOP T1 NOP T3 NOP SKP ***** * ** NSCAN ** GET NUMBER FROM INPUT BUFFER (QIBUF) * CALLING SEQUENCE: * * JSB NSCAN * RETURN1 NO MORE CHARACTERS OR ILLEGAL NUMBER * RETURN2 GOT ONE, VALUE IN .A. * ***** NSCAN NOP CLA INITIALIZE VALUE STA T3 JSB NXTC JMP NSCAN,I NO MORE NON BLANK CHARS JMP NSC2 * NSC1 STA T3 JSB QGETC GET A CHARACTER JMP NSCX+1 DONE RETURN NUMBER NSC2 CPA B54 COMMA? JMP NSCX YES. END OF FIELD. CPA B40 BLANK? JMP NSCX YES-END OF FIELD ADA M60 CONVERT TO DIGIT SSA IS IT A DIGIT? JMP NSCAN,I NO, ERROR STA T1 SAVE DIGIT ADA MD8 LEGAL DIGIT? SSA,RSS JMP NSCAN,I LDA T3 ALF,RAR MULTIPLY RADIX ADA T1 JMP NSC1 * NSCX JSB BAKUP BACK UP OVER LAST CHAR LDA T3 PICK UP VALUE ISZ NSCAN RETURN (P+2) JMP NSCAN,I * MD8 DEC -8 B54 OCT 54 SKP END  /#S 91740-18055 1740 S C0122 DS/1000 MODULE: LIMEM              H0101 \kASMB,R,L,C * NAME: LIMEM * SOURCE: 91740-18055 * RELOC: 91740-16055 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM LIMEM,8 91740-16055 REV 1740 770912 * * * ENTRY POINT NAMES * ENT LIMEM * * * EXTERNAL REFERENCE NAMES * EXT DB#PC,LIST * * * THIS SUBROUTINE GETS AND RETURNS THE LAST AVAILABLE * WORD OF USER MEMORY AND THE NUMBER OF WORDS OF * AVAILABLE MEMORY. * * SKP LIMEM NOP LDA LIMEM,I GET RETURN ADDRESS ISZ LIMEM STA LIM2 LDB LIMEM,I ISZ LIMEM LDB 1,I GET AVAILABLE MEMORY? SSB JMP LIM2,I NO, RELEASE MEMORY JSB DB#PC FIND LONGEST SEGMENT DEF *+4 RETURN ADDRESS DEF LIST # OF NAMES IN LIST DEF FWAMM FWAM THAT MAY BE USED BY PROGRAM DEF LWAMM LWA OF USER MEMORY LDA FWAMM GET FWAM SZA,RSS =0? JMP ERRLM YES, ERROR LDB LIMEM,I ISZ LIMEM STA 1,I RETURN FWAM CMA,INA ADA LWAMM INA ERRLM LDB LIMEM,I STA 1,I RETURN # WORDS OF AVAILABLE MEMORY JMP LIM2,I * B6 OCT 6 * FWAMM NOP LIM2 NOP LWAMM NOP END I 06 91740-18056 1740 S C0122 DS/1000 MODULE: DB#PC              H0101 a/ASMB,R,L,C * NAME: DB#PC * SOURCE: 91740-18056 * RELOC: 91740-16056 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAM DB#PC,8 91740-16056 REV 1740 770920 * * * ************************************************************* * * * * THIS ROUTINE DETERMINES THE BOUNDARIES OF MEMORY THAT IS * AVAILABLE FOR USE BY PROGRAMS FOR BUFFERS, TEMPORARY STORAGE * ETC. * * THE CALLING SEQUENCE IS: * * CALL DB#PC(LIST,FWAM,LWAM) * * WHERE: * * LIST = A COUNT OF NAMES OF SEGMENTS OR PROGRAMS * FOLLOWED BY THE NAMES IN ASCII WITH THREE * 16 BIT WORDS FOR EACH NAME. * * FWAM = THIS IS THE FIRST AVAILABLE WORD OF MEMORY * THAT MAY BE USED BY A PROGRAM. IF THE LIST * IS SEGMENT NAMES THEN IT IS FIRST AVAIL- * ABLE WORD PAST THE LONGEST SEGMENT. * * LWAM = THE LAST AVAILABLE WORD OF USER MEMORY. * * NOTE: IF ANY OF THE NAMES IN THE LIST ARE NOT FOUND * THIS ROUTINE WILL EXIT AND INDICATE AN ERROR BY SETTING * FWAM = 0. * * * EXAMPLE OF 'LIST' * * LIST DEC 3 * ASC 3,SEGM1 * ASC 3,SEGM2 * ASC 3,SEGM3 * * * ENT DB#PC * EXT .ENTR * * * LIST NOP FWAM NOP LWAM NOP * DB#PC NOP JSB .ENTR DEF LIST * * CLA INITIALIZE STA FWAM,I FWAM TO ZERO LDA LIST,I SET UP CMA,INA STA TEMP1 SEGMENT COUNTER LDA LIST SET UP INA ADDRESS STA SGTBA NAME ADDRESS NXTSG CLA INITIALIZE KEYWORD PNTR STA TEMP2 TO START OF KEYWORD TABLE CKSEG LDA TEMP1 GET SEGMENT COUNT ADA LIST,I FORM POINTER MPY .3 TO SEGMENT'S ASCII ADA SGTBA NAME AND SAVE IT STA TEMP3 LDB 1657B GET START OF KEYWORD TABLE ADB TEMP2 FORM PTR TO I.D. ENTRY LDB 1,I GET ADDRESS OF I.D. ENTRY SZB,RSS END OF TABLE? JMP ERROR YES - ERROR - EXIT ADB .12 FORM PNTR TO NAME(1) LDA 1,I GET NAME(1) CPA TEMP3,I SAME AS SEGMENT? INB,RSS YES, MOVE PNTR TO NAME(2) JMP NXTEN NO, INDEX TO NEXT ENTRY LDA 1,I GET NAME(2) ISZ TEMP3 MOVE NAME POINTER CPA TEMP3,I SAME AS SEGMENT? INB,RSS YES, MOVE PNTR TO NAME(3) JMP NXTEN NO, INDEX TO NEXT ENTRY LDA 1,I GET NAME(3) AND M256 ISOLATE UPPER CHAR IOR B40 MERGE IN ASCII BLANK ISZ TEMP3 MOVE NAME POINTER CPA TEMP3,I SAME AS SEGMENT? JMP *+3 YES, GO CHECK ADDRESSES NXTEN ISZ TEMP2 MOVE PNTR TO NEXT I.D. ENTRY JMP CKSEG -GO CHECK I.D. ENTRY * LDA 1,I TEST FOR SHORT ID SEGMENT STA TYPE AND B20 ADB .2 SZA,RSS SHORT ID SEGMENT? ADB .7 NO! LDA 1,I GET ADDRESS OF LAST WORD INA INCREMENT TO GET NEW FWAM LDB FWAM,I GET CURRENT FWAM CMB,INB ADB 0 IS IT GREATER THAN SSB,RSS NEW FWAM? STA FWAM,I ISZ TEMP1 INDEX SEGMENT CNTR, IS IT = 0? JMP NXTSG NO, LOCATE NEXT SEGMENT * EXIT LDA TYPE GET WHERE PROGRAM RESIDES AND B17 CPA .2 FOREGROUND? JM9t P FG YES LDA 1777B BACKGROUND (LWA MEMORY) JMP BLEN FG LDA 1751B LWA+1 MEMORY ADA N1 BLEN STA LWAM,I LAST AVAILABLE WORD JMP DB#PC,I RETURN * ERROR CLA SET FWAM = 0 STA FWAM,I FOR ERROR JMP EXIT * * N1 DEC -1 .2 DEC 2 .3 DEC 3 .7 DEC 7 .12 DEC 12 B17 OCT 17 B20 OCT 20 B40 OCT 40 M256 OCT 177400 TEMP1 BSS 1 TEMP2 BSS 1 TEMP3 BSS 1 TYPE NOP SGTBA BSS 1 * END  19 91740-18057 1740 S C0122 DS/1000 MODULE: RTMGM              H0101 kqASMB,R,L,C RTMGM * NAME: RTMGM GEN. MAIN CONTROL FOR SEGMENTED GEN.-LOADER * SOURCE: 91740-18057 * RELOC: 91740-16057 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * HED RTE-M SYSTEM GENERATOR-LOADER * NAM RTMGM,8 91740-16057 REV 1740 770912 ***************** - HIGH CORE - ****************** * * * - IDENTS - * * * ************************************************** * - FIXUP TABLES - * * ---------- * * * * * * ------- * * - LST - * ************************************************** * * * * * PROGRAM LOADING CONTROL * * * * * ************************************************** * * * * I/O TABLE GENERATION * * * * ************************************************** * * * * * PARAMETER INPUT * * ,v * * * ************************************************** * * * SKP * * * LST FORMAT * * WORD 1: LST1 - NAME 1,2 * WORD 2: LST2 - NAME 3,4 * WORD 3: LST3 - NAME 5, ORDINAL * WORD 4: LST4 - IDENT ADDRESS * WORD 5: LST5 - BP LINK ADDRESS * * * * ENTERNS AND EXTERNS * EXT ATBUF,CM#LG,DO#ON,ENTPT,ER#OR,FIXUP EXT GENRT,GE#AL,GE#NA,GI#IT,GNFLG EXT GNSG1,GNSG2,GREAD,GTIME,IN#RR,INTER,LDSEG EXT LDSG3,LST1,LST4,LST5 EXT OUTON,PRCMD,PRIN1 EXT SAVE2,SEGFL,SP#CE,SYSTM,TBUF# EXT UNDEF,ZPRIV,ZRENT * * ENT RTLG1,RTMLC,RTMLI * CMFLG EQU CM#LG DOCON EQU DO#ON GETAL EQU GE#AL GETNA EQU GE#NA GINIT EQU GI#IT INERR EQU IN#RR READ EQU GREAD SPACE EQU SP#CE TBUF EQU TBUF# * * .MEM. TABLE DEFINITIONS * * .MEM1 = FWABP * .MEM2 = LWABP * .MEM3 = FWAM * .MEM4 = LWAM * .MEM5 = FWAC * .MEM6 = LWAC * SKP * * * ERROR CODES * * AD: INVALID ENTRY POINT * CH: INVALID CHANNEL NUMBER * DR: INVALID DRIVER NAME * DU: DUPLICATE PROGRAM NAME * EQ: INVALID EQT. NO. IN INT. RECORD * IN: PARAMETER INTERVAL EXECUTION ERROR * LU: INVALID DEVICE REFERENCE NUMBER * ON: INVALID ON PARAMETER * NA: PARAMETER NAME ERROR * PA: PARAMETER ERROR * PD: PARTITION ALREADY DEFINED * PR: PARAMETER PRIORITY ERROR * PS: NOT ENOUGH MEMORY LEFT FOR PARTITION * PT: PARTITION DEFINITION ERROR * SO: SYSTEM OVERFLOW * TB: SYMBOL TABLE/ID SEGMENT OVERFLOW * * SUP * SKP RTLG1 LDA P6 LOAD IN GENERATOR SEGMENT 1 LDSGA CLB STB SEGFL LAST SEGMENT FLAG JMP LDSEG LOAD IN SEGMENT * SKP * * * RTMLI CONTROLS THE LOADING OF THE SEGMENT WHILE * RTMLC CONTROLS THE EXECUTION OF THAT SEGMENT. * RTMLI LDA GNFLG WHERE GO FLAG (INITIALIZATION) SZA,RSS JMP DEDEV DEFINE OUTPUT DEVICES CPA RP1 JMP CENTS CHANGE ENTRIES CPA P2 JMP FIXI DO FIXUP CPA P3 JMP RESLB PUT IN ZPRIV ZRENT JMP SNAP2 PROCESS SNAP REQUEST SPC 5 RTMLC LDA GENRT WHERE GO FLAG CPA P1 JMP ENTRA CHANGE ENTRIES CPA P2 JMP FIXC DO FIXUP JMP RTMGR PUT IN ZPRIV ZRENT SKP * * DEFINE OUTPUT DEVICES * DEDEV CLA,INA STA GNFLG SET FOR CHANGE ENTRIES CLA,INA STA GENRT SET FOR CHANGE ENTS JSB SPACE OTPUT JSB INTER LDA P23 LDB MES31 *DEFINE OUTPUT DEVICES JSB PRIN1 JSB PRCMD CALL LOADER SUBCONTROL JMP OTPUT ERROR, REPEAT INPUT LDA OUTON ANY OUTPUT DEVICE DECLARED? SZA,RSS JMP ERROO NO, OUTPUT ERROR CLA,INA STA GNSG1 LDA P6 LOAD IN GEN SEGMENT 1 AND START JMP LDSGA EXECUTION AT SET TYPE OF SYSTEM * ERROO LDA OO ERROR MESSAGE CLB ERROR CODE JSB ER#OR JMP OTPUT * OO ASC 1,OO SKP * * CENTS LDA P2 STA GNFLG SET FOR FIXUP STA LDSG3 SET FOR PUTTING ENTRY IN LST LDA P3 JMP LDSGA LOAD IN LOADER SEGMENT 3 ENTRA LDA P2 STA GENRT SET FOR FIXUP LDA SYSTM RTE-M-I SYSTEM? CPA P1 JMP ENTRX YES LDB D$CLS ADDRESS OF ENTRY JSB ENTPT PUT IN LST LDA UDFE STA LST4,I SET TO UNDEFINED ISZ UNDEF DON'T OUTPUT AS UNDEF LDB D$RNT ADDRESS OF ENTRY JSB ENTPT PUT IN LST LDA UDFE STA LST4,I SET TO UNDEFINED ISZ UNDEF DON'T OUTPUT AS UNDEF * * CHANGE ENTRY POINTS * ENTRX JSB SPACE NEW LINE ENTRY JSB INTER INTERACTIVE INPUT LDA P14 LDB MES17 CHANGE ENTS? JSB READ PRINT MESSAGE, GET REPLY CLA STA CHRCT LDA N2 JSB GETNA GET FIRST 2 CHARACTERS CPA EN END? JMP END? YES,CHECK TO SEE IF NOT ENTRY ENTRI JSB GINIT REINITIALIZE INPUT CCA STA CMFLG ENTLN JSB GETAL GET NEXT CHARACTER CPA BLANK REACHED COMMA YET? JMP ENTFN YES ISZ CHRCT CHARACTER COUNTER JMP ENTLN ENTFN LDA N2 MOVE 2 CHARACTERS TO TBUF JSB GETNA CLB CPA RP MICROCODE REPLACEMENT? JMP RP1 YES CPA AB ABSOLUTE? JMP AB1 YES ENTER JSB INERR NEITHER MICROCODE RELACEMENT NOR ABSOLUTE JMP ENTRY ERROR, REPEAT INPUT RP1 INB AB1 ADB P3 STB TBUF+4 CCA STA CMFLG JSB GETAL GET NEXT CHAR. IN RESPONSE CPA BLANK REACHED COMMA YET? RSS JMP ENTER ERROR LDA BBLNK INITIALIZE TBUF STA TBUF WITH BLANKS STA TBUF+1 STA TBUF+2 LDA P6 SET FOR 6 OCTAL DIGITS INPUT JSB DOCON GET VALUE OF RP OR AB JMP ENTRY REPEAT INPUT STA TBUF+3 JSB GINIT BUFFER INITIALIZE LDA CHRCT GET NO. OF CHAR. IN ENTRY POINT CMA,INA JSB GETNA PUT ENTRY POINT IN TBUF LDA TBUF+2 IOR TBUF+4 STA TBUF+2 LDB ATBUF JSB ENTPT CLA STA GTIME JMP ENTRY GET NEXT CHANGE END? LDA N2 JSB GETNA GET NEXT 2 CHARACTERS CPA D D? RSS YES, DONE JMP ENTRI NO, MUST BE ENTRY POINT LDA P3 STA GNSG1 LDA P6 JMP LDSGA LOAD IN GEN SEG 1 SKP FIXI LDA P3 STA LDSG3 SET FOR PUTTING ENTRY IN LST JMP LDSGA LOAD IN LOADER SEGMENT 3 FIXC JSB FIXUP DO FIXUP FOR CLASS I O AND RESOURCE LDA P6 NUMBERS STA GNSG1 LOAD IN LOADER SEGMENT 2 JMP LDSGA SKP RESLB LDA P4 STA GNFLG SET FOR SNAP STA LDSG3 SET FOR PUTTING ENTRY IN LST LDA P3 JMP LDSGA LOAD IN LOADER SEGMENT 3 RTMGR LDA P4 STA GENRT SET FOR SNAP LDB .ZPRV PUT .ZPRV IN LST JSB ENTPT LDA LST1 SAVE LST ADDRESS STA ZPRIV LDA N4 STA LST5,I SET .ZPRV FOR MICROCODE LDA B2001 REPLACEMNT "RSS" STA LST4,I LDB .ZRNT PUT .ZRNT IN LST JSB ENTPT LDA LST1 SAVE LST ADDRESS STA ZRENT LDA N4 STA LST5,I SET .ZRNT FOR MICROCODE LDA B2001 REPLACEMENT "RSS" STA LST4,I LDB $SSGA JSB ENTPT PUT $SSGA IN LST CLA STA LST4,I SET ITS ADDRESS TO 0 LDA LST4 SAVE LST ADDRESS FOR FIXUP STA SAVE2 LDA P2 STA GNSG2 SET TO RELOCATE RESIDENT LIBRARY NEXT LDA P9 JMP LDSGA LOAD IN GEN SEG 2 SKP SNAP2 JSB INTER LDA P11 LDB MES09 * SNAPSHOT? JSB PRIN1 JSB PRCMD GO PROCESS SNAP REQUEST JMP SNAP2 ERROR, TRY AGAIN LDA P9 STA GNSG2 SET FOR SNAP RETURN JMP LDSGA LOAD IN GENERATOR SEGMENT 2 SKP * AB ASC 1,AB D ASC 1,D EN ASC 1,EN RP ASC 1,RP * B2001 OCT 2001 P1 DEC 1 P2 DEC 2 P3 DEC 3 P4 DEC 4 P6 DEC 6 P9 DEC 9 P11 DEC 11 P14 DEC 14 P23 DEC 23 N2 DEC -2 N4 DEC -4 * BBLNK OCT 20040 BLANK OCT 40 UDFE OCT 77777 * CHRCT NOP * D$CLS DEF $CLS $CLS ASC 3,$CLAS D$RNT DEF $RNTB $RNTB ASC 3,$RNTB $SSGA DEF *+1 ASC 3,$SSGA .ZPRV DEF *+1 ASC 3,.ZPRV .ZRNT DEF *+1 ASC 3,.ZRNT * MES09 DEF *+1 ASC 6,* SNAPSHOT? MES17 DEF *+1 ASC 7,* CHANGE ENTS? MES31 DEF *+1 ASC 12,* DEFINE OUTPUT DEVICES END SKP  2 < 91740-18058 1926 S C0122 RTMGC DS/1000 MODULE             H0101 wHASMB,R,L,C RTMGC * NAME: RTMGC GENERATOR SUBROUTINES * SOURCE: 91740-18058 * RELOC: 91740-16058 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * HED RTE-M SYSTEM GENERATOR-LOADER NAM RTMGC,8 91740-16058 REV 1926 790426 * * A EQU 0 ***************** - HIGH CORE - ****************** * * * - IDENTS - * * * ************************************************** * - FIXUP TABLES - * * ---------- * * * * * * ------- * * - LST - * ************************************************** * * * * * PROGRAM LOADING CONTROL * * * * * ************************************************** * * * * I/O TABLE GENERATION * * * * ************************************************** * * * * * PARAMETER INPUT * *  * * * ************************************************** * * * SKP * * * LST FORMAT * * WORD 1: LST1 - NAME 1,2 * WORD 2: LST2 - NAME 3,4 * WORD 3: LST3 - NAME 5, ORDINAL * WORD 4: LST4 - IDENT ADDRESS * WORD 5: LST5 - BP LINK ADDRESS * * * * ENTERNS AND EXTERNS * * * * EXT ADDRS,ABRT1,ATBUF,BPLOC,CLBPL,CONSO,CRTIN EXT EKHOS,ER#OR,IDCB1,INACT,KONSO EXT LDSEG,LENGT,LNKDR,LST,.MEM2 EXT .MEM3,MLOCC,OPT.3 EXT PRCMD,PRINT,RDFL1,SEGFL EXT TBUF#,TYPRO,?XFER * ENT PNAMA,PNZQZ,PRAMS * ENT A$CIA,AINT#,ALBUF,BIDNT,BPFIX ENT CM#LG,CU#AL,CURAT ENT DO#ON,ELIB,GBUF,GENRT,GE#AL,GE#NA ENT GE#OC,GI#IT,GNFLG,GNSG1,GNSG2,GREAD ENT GTIME,IDNOS,IDS,IDSAD,IN#RR,INTER ENT IP1,IP2,IP3 ENT KEYCN,LSTSV,LWACG,LWAMG,LWGBP,LWSA1 ENT MATA,MAXPT,MPFT,MRMP ENT MSIZE,NMAX,OC#NO ENT PARNO,PCOM,PGLIB,PLIB,PP#EL,PRIN1,PRIN2,PROCT ENT RANAD,REL06 ENT RELOC,SAVE1,SAVE2,SG1AD ENT SP#CE,SSGAP,START,STRAD ENT STRPN,SYSAD,SYSTM,TB#HN,TCNT,WDCNT * LOCC EQU MLOCC TBUF EQU TBUF# * * * * .MEM. TABLE DEFINITIONS * * .MEM1 = FWABP * .MEM2 = LWABP * .MEM3 = FWAM * .MEM4 = LWAM * .MEM5 = FWAC * .MEM6 = LWAC * * * * ERROR CODES * * AD: INVALID ENTRY POINT * CH: INVALID CHANNEL NUMBER * DR: INVALID DRIVER NAME * DU: DUPLICATE PROGRAM NAME * EQ: INVALID EQT. NO. IN INT. RECORD * IN: PARAMETER INTERVAL EXECUTION ERROR * LU: INVALID DEVICE REFERENCE NUMBER * ON: INVALID ON PARAMETER * NA: PARAMETER NAME ERROR * PA: PARAMETER ERROR * PD: PARTITION ALREADY DEFINED * PR: PARAMETER PRIORITY ERROR * PS: NOT ENOUGH MEMORY LEFT FOR PARTITION * PT: PARTITION DEFINITION ERROR * SO: SYSTEM OVERFLOW * TB: SYMBOL TABLE/ID SEGMENT OVERFLOW * * SUP SKP * * THE SPACE SUB-gROUTINE IS USED TO SPACE UP THE TELEPRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA STA FTIME CLEAR FIRST TIME THRU FLAG LDB ZBUFF OUTPUT BLANK LINE CLA,INA JSB PRIN1 JMP SPACE,I RETURN * SP#CE EQU SPACE * ZBUFF DEF *+1 ASC 1,* * FTIME NOP FIRST TIME THRU FLAG GTIME EQU FTIME * * * A$CIA NOP ADDRESS OF $CIC ROUTINE AINT NOP ADDRESS OF INTERRUPT TABLE ELIB NOP ADDRESS AT END OF LIBRARY GENRT NOP INITIATOR FLAG GNFLG NOP CONTINUATOR FLAG GNSG1 NOP WHERE RETURN FLAG GNSG2 NOP WHERE RETURN FLAG IDNOS NOP ACTUAL IDS FILLED IDS NOP # OF ID SEGMENTS LEFT IDSAD NOP SEGMENT ADDRESS KEYCN NOP ADDRESS OF KEYWORD TABLE LWACG NOP LAST WORD OF AVAILABLE COMMON LWGBP NOP LAST WORD BP FOR JSB $CIC,I LWSA1 NOP LAST WORD SAM MATA NOP ADDRESS OF $MATA MAXPT NOP MAXIMUM NUMBER OF PARTITIONS MPFT NOP ADDRESS OF $MPFT MRMP NOP ADDRESS OF $MRMP MSIZE NOP MEMORY SIZE NMAX NOP - MAXIMUM NUMBER OF PARTITIONS PCOM NOP PRIV. DRIVERS ACCESS COMMON PGLIB NOP PAGE # AT END OF RES. LIB. PLIB NOP ADD. JUST PAST END OF LIB. PPREL NOP REL ADDRESS SAVE1 NOP ENPNT RETURN ADDRESS SAVE2 NOP ADDRESS OF LST4 FOR $SSGA SG1AD NOP SEGMENT 1 ADDRESS SSGAP NOP FWAM(START OF MEM RES PROG AREA) START NOP START-UP PROGRAM USED STRAD NOP $STRT START ADDRESS STRPN BSS 3 START-UP PROGRAM NAME SYSAD NOP ID SEGMENT ADDRESS SYSTM NOP SYSTEM TYPE TBCHN NOP TIME BASE GENERATOR CHANNEL * AINT# EQU AINT PP#EL EQU PPREL TB#HN EQU TBCHN SKP * ALBUF DEF LBEUF LBUF BSS 64 GBUF EQU LBUF * WDCNT NOP TEMPORARY WORD COUNTER * * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** * THE DOCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., TBG CHANNEL NO., AND LAST * WORD OF AVAILABLE MEMORY. * * CALLING SEQUENCE: * A = MAX NO. OF CHARACTERS PERMITTED IN RESPONSE. * THE SIGN OF A DETERMINES THE CONVERSION FROM * ASCII TO OCTAL (POS.) OR DECIMAL (NEG.). * B = IGNORED * JSB DOCON * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. AN INVALID * CHARACTER HAS BEEN DETECTED IN THE RESPONSE, OR * THE RESPONSE CONTAINS AN INVALID NO. CHARACTERS. * THE MESSAGE IS TO BE REPEATED ON RETURN. * (N+2): A = CONVERTED RESULT * DOCON NOP JSB GETOC GET OCTAL/DECIMAL, RETURN OCTAL JMP *+4 INVALID DIGIT JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE JSB INERR INVALID DIGIT ENTRY JMP DOCON,I RETURN ISZ DOCON INCR RETURN ADDRESS LDA OCTNO GET CONVERTED NUMBER JMP DOCON,I RETURN * DO#ON EQU DOCON * ZERO DEC 0 * OCTNO NOP * OC#NO EQU OCTNO SKP * * SUBROUTINE TO RELOCATE ALL MODULES (SYSTEM AND USER PROGRAMS). * * CALLING SEQUENCE: * * A = MESSAGE LENGTH * B = MESSAGE ADDRESS * JSB RELOC * * RETURN: * (N+1): CONTENTS OF A AND B ARE DESTROYED. LOADER * WAS NOT ABLE TO RELOCATE MODULE (ERROR EXIT). * (N+2): CONTENTS OF A AND B DESTROYED. LOADER RELOCATION * WORKED. * * RELOC NOP JSB PRIN1 PRINT MESSAGE LDA P2 STA ?XFER NON-ZERO TO LOAD MODULES STA GNSG1 JSB CLBPL CLEAR BASE PAGE LINKS STA GNSG2 STA PNZQZ CLEAR NAME FLAG STA LOCC CLEAR LOCC IN LOADER STA BPLOC SAME FOR BPLOC STA OPT.3,I CLEAR FIXUP TABLE LENGTH XLDA LST,I SAVE LST LENGTH STA LSTCT LDA LSTSV RESTORE SYMBOL TABLE COUNT STA LST IN THE LOADER LDA RELOC,I GET MODULE TYPE STA TYPRO SAVE FOR LOADER SUB CONTROL SZA,RSS STA ?XFER ISZ RELOC SET RETURN ADDRESS JSB PRCMD GO RELOCATE MODULES JMP REL05 ERROR EXIT LDA .MEM2 SAVE LWABP STA BPFIX LDB LNKDR GET LINK DIRECTION FLAG CPB P1 USER LINKS ? JMP REL02 YES LDA LOCC UPDATE FWAM SZA,RSS LDA .MEM3 STA .MEM3 LDA BPLOC UPDATE FWABP SZA STA .MEM2 SYSTEM LINKS, UPDATE LWABP LDA LST STA LSTSV SAVE FOR RELOCATION ERROR REL03 ISZ RELOC REL05 CLA STA SEGFL LAST SEGMENT FLAG LDA B6 LDB TYPRO CPB B1 RSS ADA B3 JMP LDSEG REL06 JMP RELOC,I * REL02 LDA LSTCT RESTORE LST LENGTH STA LST,I JMP REL03 * BPFIX NOP LWABP TEMP STORE LSTCT NOP LST LENGTH LSTSV NOP * B1 OCT 1 B3 OCT 3 B6 OCT 6 P1 DEC 1 P2 DEC 2 SKP * SUBROUTINE TO OUTPUT MESSAGE * PRIN2 NOP JSB PRINT GO OUTPUT MESSAGE LDA LENGT LDB ADDRS JSB EKHOS GO ECHO IF NEEDED JMP PRIN2,I * * SUBROUTINE TO OUTPUT MESSAGE ONLY IF ECHO, INTERACTIVE * INPUT, OR SESSION CONSOLE NEEDED OR USED. * PRIN1 NOP STA LENGT MESSAGE LENGTH LDA CONSO OUTPUT TO SESSION CONSOLE? SZA JMP PRINA YES LDA INACT INTERACTIVE INPUT? SZA JMP PRINA YES LDA READX OUTPUT TO SESSION CONSOLE? SZA,RSS JMP PRINB NO, JUST ECHO IF NEEDED PRINA LDA LENGT JSB PRINT GO OUUTPUT MESSAGE LDB ADDRS PRINB LDA LENGT JSB EKHOS GO ECHO IF NEEDED JMP PRIN1,I * * THE INERR SUBROUTINE PRINTS THE DIAGNOSTIC FOR INVALID #* RESPONSES DURING THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INERR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * INERR NOP LDA PA SET INVALID DEVICE ERROR CODE CLB NO FMP ERROR JSB ER#OR PRINT ERROR MESSAGE JMP INERR,I RETURN * PA ASC 1,PA PARAMETER ERROR * IN#RR EQU INERR SKP HED READ INPUT FILES * * * SUBROUTINE TO READ INPUT FILES * * CALLING SEQUENCE * * A = MESSAGE LENGTH * B = MESSAGE ADDRESS * JSB READ * * RETURN: * A = DATA LENGTH * B = DESTROYED * * * READ NOP JSB PRIN1 PRINT MESSAGE READ2 LDB ALBUF DATA INPUT ADDRESS LDA CONSO GET INPUT FROM SESSION CONSOLE? SZA JMP READ1 YES LDA READX INTERACTIVE INPUT? SZA JMP READ1 NO, GET INPUT FROM SYSTEM CONSOLE LDA DCB1 DCB BUFFER ADDRESS JSB RDFL1 READ FROM INPUT FILE CPA N1 END OF FILE? JMP READA YES, GET NEXT INPUT FROM CONSOLE READ3 STA PARNO SAVE DATA LENGTH INA PUT ZERO AT END OF CLE,ERA DATA BUFFER ADA ALBUF CLB STB A,I JSB GINIT INITIALIZE INPUT LDA ALBUF,I CHECK IF FIRST CHARACTER CPA EX EXIT? JMP ABRT1 YES ALF,ALF IS AN ASTERISK AND B177 CPA B52 JMP READ2 YES, READ NEXT RECORD LDB ALBUF DATA ADDRESS LDA PARNO DATA BUFFER JSB EKHOS CHECK IF ECHO NEEDED LDA PARNO RETURN WITH DATA LENGTH IN A REG. JMP READ,I * READ1 CLA,INA LDB PRPTA JSB PRIN2 LDA P72 LDB ALBUF JSB CRTIN JMP READ3 * READA CLA,INA STA CONSO STA KONSO JMP READ1 * DCB1 DEF IDCB1 * PARNO NOP PARAMETER RECORD LENGTH READX NOP INTERACTIVE INPUT 0=YES, 1=NO * B52 OCT 52 B177 OCT 177 N1 DEC -1 P72 DEC 72 * EX ASC 1,EX * GREAD EQU READ * PRPTA DEF *+1 ASC 1,- HED RTMGN I/O TABLE GENERATION SUBROUTINES * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * GETNA AND GETOC. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GETAL * * RETURN: * A = CURRENT CHARACTER * B = DESTROYED * GETAL NOP LDA CMFLG CMFLG = COMMA-IN FLAG SZA,RSS SKIP IF NO COMMA IN JMP BLRET RETURN BLANK LDB BUFUL GET U/L FLAG IGNOR LDA CURAL,I GET CHAR FROM LBUF SZB SKIP IF LOWER CHAR ALF,ALF ROTATE TO LOWER AND B377 ISOLATE LOWER CHAR CPA ZERO END OF BUFFER? JMP GETAL,I YES - RETURN WITH ZERO CMB,SZB RESET U/L, SKIP IF UPPER CHAR ISZ CURAL INCR LBUF ADDRESS CPA BLANK CHAR = BLANK? JMP IGNOR IGNORE BLANKS STB BUFUL SAVE U/L FLAG CPA B54 CHAR = COMMA? ISZ CMFLG RESET FLAG TO SHOW COMMA IN JMP GETAL,I RETURN WITH NON-BLANK CHAR BLRET LDA BLANK REPLACE WITH BLANK CHAR JMP GETAL,I RETURN WITH BLANK * BLANK OCT 40 B54 OCT 54 B377 OCT 377 BUFUL NOP BUFFER U/L FLAG CMFLG NOP COMMA-IN FLAG CURAL NOP * CM#LG EQU CMFLG CU#AL EQU CURAL GE#AL EQU GETAL SKP * * THE FOLLOWING SUBROUTINE MOVES THE CHARACTERS FROM LBUF * TO TBUF. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARACTERS TO BE MOVED. THE SIGN OF A * DESIGNATES THE POSITION OF THE FIRST CHARACTER. * IF THE SIGN OF A IS POSITIVE, THE FIRST CHAR. IS TO * BE MOVED TO THE LOW CHAR IN TBUF. IF A IS NEGATIVE, THE * FIRST CHARACTER IS TO BE MOVED TO THE UPPER CHAR IN TBUF. * B = IGNORED * JSB GETNA * * RETURN: * A = FIRST CHARACTER (IF ONLY 1 CHARACTER) OR FIRST 2 CHARS * MOVED. * B = DESTROYED * GETNA NOP cM CCE,SSA,RSS SET E = 1 (EVEN) POSITION CMA,CLE,INA SET E = 0 (ODD) POSITION - COMP STA MAXC MAXC = MAXIMUM NO. OF CHARACTERS LDA ATBUF ATBUF = ADDR OF TBUF STA CURAT SET CURRENT TBUF ADDRESS CLB STB TBUF CLEAR WORD 1 OF TBUF CCA STA CMFLG SET COMMA-IN FLAG SEZ,RSS SKIP - ODD POSITION JMP OCHAR BEGIN WITH ODD CHARACTER NEXTC JSB GETAL GET CHAR FROM LBUF CPA ZERO END OF BUFFER? LDA BLANK YES - REPLACE CHAR WITH BLANK ALF,ALF ROTATE TO UPPER A STA CURAT,I SET CHARACTER IN TBUF ISZ MAXC CHECK FOR ALL CHARS IN JMP OCHAR GET ODD CHAR FROM LBUF LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I YES - RETURN OCHAR JSB GETAL GET CHAR FROM LBUF CPA ZERO END OF BUFFER? LDA BLANK REPLACE ZERO CHAR WITH BLANK IOR CURAT,I ADD TO UPPER CHAR IN TBUF STA CURAT,I SET CHARS IN TBUF ISZ CURAT INCR TBUF ADDRESS ISZ MAXC CHECK FOR ALL CHARS IN JMP NEXTC NO - TRY NEXT UPPER CHAR LDA TBUF GET FIRST 2 TRANSFERRED CHARS JMP GETNA,I RETURN * GE#NA EQU GETNA * CURAT NOP CURRENT TBUF ADDRESS MAXC NOP MAX CHARACTER COUNT SKP PNAMA DEF PNZQZ PNZQZ NOP REP 5 NOP PRAMS DEC 3 DEC 9999 REP 6 NOP SKP SKP * * THE GETOC SUBROUTINE CONVERTS THE NEXT CHARACTERS IN LBUF FROM * ASCII (DECIMAL OR OCTAL) TO THEIR BINARY VALUE. * * CALLING SEQUENCE: * A = MAX. NO. OF CHARS IN CONVERSION REQUEST. IF A IS * POSITIVE, THE REQUEST IS FOR OCTAL; IF A IS NEGATIVE, * THE REQUEST IS FOR DECIMAL. * B = IGNORED * JSB GETOC * * RETURN: * (N+1): INVALID DIGIT OR OVERFLOW IN CONVERSION * (N+2): A = CONVERTED NO. * B = DESTROYED * GETOC NOP LDB N8 GET OCTAL RANGE SSA K SKIP IF OCTAL REQUEST LDB N10 GET DECIMAL RANGE STB DRANG SET DIGIT RANGE SSA,RSS SKIP IF DECIMAL REQUEST CMA,INA SET REQUEST COUNT TO NEGATIVE STA MAXC SET MAX NO. OF DIGITS CCA STA DIFLG SET DATA-IN FLAG = NO DATA IN STA CMFLG SET COMMA-IN FLAG CLA STA OCTNO OCTNO = OCTAL NUMBER GETNX JSB GETAL GET CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP ENDOC YES - RETURN CPA BLANK CHAR = BLANK? (COMMA IN) JMP ENDOC YES - RETURN ADA M60 SUBTRACT 60B FROM CHAR STA TCHAR SAVE CHAR SSA SKIP IF VALID LOWER LIMIT JMP DGERR INVALID DIGIT ADA DRANG ADD DIGIT RANGE CLE,SSA,RSS CLEAR E - SKIP IF VALID DIGIT JMP DGERR INVALID DIGIT ISZ DIFLG INCR DATA-IN FLAG, SKIP NOP LDA OCTNO GET PREVIOUS OCTAL NO. ADA A SET A = OCTNO X 2 ADA A SET A = OCTNO X 4 LDB DRANG GET DIGIT RANGE CPB N10 RANGE = DECIMAL? ADA OCTNO SET A = OCTNO X 5 ADA A SET A = OCTNO X 10/8 ADA TCHAR SET A = NEW OCTAL NO. STA OCTNO SAVE NEW OCTAL NO. SEZ TEST FOR OVERFLOW JMP DGERR INVALID NO. ISZ MAXC SKIP IF ALL DIGITS PROCESSED JMP GETNX GET NEXT DECIMAL DIGIT ISZ GETOC INCR RETURN ADDRESS LDA OCTNO GET OCTAL EQUIVALENT DGERR JMP GETOC,I RETURN ENDOC ISZ DIFLG SKIP - NO DATA IN JMP *-4 DATA IN - NORMAL RETURN JMP GETOC,I RETURN - ERROR * GE#OC EQU GETOC * DIFLG NOP DATA IN FLAG = -1/0 = NOT IN/IN DRANG NOP DIGIT RANGE TCHAR NOP TEMPORARY CHARACTER SAVE AREA * M60 OCT -60 N8 DEC -8 N10 DEC -10 PROCT NOP NO. OF INTERRUPT ENTRIES * LWAMG NOP BIDNT NOP ADDRESS OF FIRSTK <:6 IDENT IP1 NOP IP2 NOP IP3 NOP * * * INITIALIZE CHAR TRANSFER * * THE GINIT SUBROUTINE SETS THE CURRENT ADDRESS AND UPPER/LOWER * FLAG FOR SCANNING LBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB GINIT * * RETURN : CONTENTS OF A AND B ARE DESTROYED * GINIT NOP LDA ALBUF ALBUF = ADDR OF LBUF STA CURAL SET CURRENT LBUF ADDRESS CCB STB BUFUL BUFUL = BUFFER U/L FLAG JMP GINIT,I RETURN * GI#IT EQU GINIT * SKP * RANAD NOP POWER RANGE ADDRESS TCNT NOP CURRENT TBUF COUNT * * * SUBRROUTINE TO DETERMINE IF INPUT DEVICE IS INTERACTIVE * * INTER NOP CLA STA READX SET FOR INTERACTIVE INPUT LDA FTIME FIRST TIME FLAG SZA JMP INT1 NOT FIRST TIME CLA,INA FIRST TIME, SET FLAG STA FTIME JMP INTER,I INT1 LDA INACT INPUT INTERACTIVE? CPA P1 JMP INTER,I YES, RETURN ISZ READX JMP INTER,I * SKP END < 3B 91740-18059 1740 S C0122 DS/1000 MODULE: IDCBO              H0101 X`ASMB,R,L,C * NAME: IDCB0 * SOURCE: 91740-18059 * RELOC: 91740-16059 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IDCB0,8 91740-16059 REV 1740 770727 * * * THE FOLLOWING ARE SEVEN DATA CONTROL BLOCKS(DCBS). * * THE DCB IS AN ARRAY PROVIDED BY THE USER PROGRAM WITH ONE * DCB REQUIRED FOR EACH FILE OPENED. ONCE A FILE IS OPEN, THE * DCB IS USED TO REFERENCE THE FILE, THE NAME NO LONGER BEING * NEEDED, OR USED. THE DCB INCLUDES A 16-WORD DIRECTORY * AREA AND A BUFFER AREA THAT IS USED FOR DATA TRANSFERS. THE * DCB BUFFER CONTAINS A MULTIPLE OF 128 WORDS. * * * ENT IDCB1,IDCB2,IDCB3,IDCB4,IDCB5,IDCB6,IDCB7 IDCB1 BSS 144 IDCB2 BSS 144 IDCB3 BSS 144 IDCB4 BSS 144 IDCB5 BSS 144 IDCB6 BSS 144 IDCB7 BSS 144 END W 4: 91740-18060 1740 S C0122 DS/1000 MODULE: IMESS              H0101 igASMB,R,L,C * NAME: IMESS * SOURCE: 91740-18060 * RELOC: 91740-16060 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM IMESS,8 91740-16060 REV 1740 760628 * * IMESS READS/WRITES TO THE CONSOLE FROM WHICH THE PROGRAM * WAS SCHEDULED. IF NOT SCHEDULED BY OPERATOR, LU 1 IS USED. * AFTER DETERMINING THE CORRECT LU (FROM $CON) THIS CALL MAPS * DIRECTLY INTO AN EXEC READ/WRITE CALL. * * * CALLING SEQUENCE: * JSB IMESS * DEF RETURN * DEF IO 1=READ/2=WRITE * DEF BUFAD BUFFER ADDRESS * DEF COUNT BUFFER LENGTH * * ON RETURN A AND B ARE AS EXEC LEFT THEM * EXT .ENTR,EXEC,$CON * ENT IMESS * IO NOP BUFAD NOP CCNT NOP * * IMESS NOP JSB .ENTR DEF IO * LDA $CON,I AND B77 ISOLATE LU IOR ECHO STA LU * * JSB EXEC DEF MESSR DEF IO,I DEF LU DEF BUFAD,I DEF CCNT,I * MESSR JMP IMESS,I * ECHO OCT 400 LU NOP B77 OCT 77 END * < 5; 91740-18061 1740 S C0122 DS/1000 MODULE: $CON              H0101 [ASMB,R,L,C * NAME: $CON * SOURCE: 91740-18061 * RELOC: 91740-16061 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM $CON,8 91740-16061 REV 1740 770310 ENT $CON $CON DEF .1 .1 DEC 1 DEFAULT SESSION CONSOLE END  6< 91740-18062 1805 S C0122 DS/1000 MODULE: DTTY              H0101 tDASMB,R,L,C * NAME: DTTY * SOURCE: 91740-18062 * RELOC: 91740-16062 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM DTTY,8 91740-16062 REV 1805 771118 * * DTTY DETERMINE IF THE REFERENCED LU IS ASSOCIATED * WITH AN INTERACTIVE DEVICE (DVR00 OR DVR05 SUB 0). * [MODIFIED NOV 18, 1977, TO CHECK FOR DVR07 SUB 0. DMT] * * DTTY CALLING SEQUENCE: * * LDA LU OF DEVICE TO BE CHECKED * JSB DTTY * * * RETURN * * A=0 IF NOT INTERACTIVE * A#0 IF INTERACTIVE * * * EXT EXEC ENT DTTY * * * DTTY NOP SSA CMA,INA STA LU * JSB EXEC REQUEST STATUS DEF RT1 DEF .13 DEF LU DEF EQ5 DEF EQ4 DEF SPC * * RT1 LDA EQ5 CHECK FOR DVR00 AND TYPE SZA,RSS JMP GOOD YEP--TAKE GOOD EXIT * CPA B2400 CHECK FOR DVR05 JMP SBCNL YEP--GO CHECK FOR SUB CHNL 0 CPA B3400 CHECK FOR DVR07 JMP SBCNL YEP--GO CHECK FOR SUB CHNL 0 * BAD CLA TAKE FALSE EXIT JMP DTTY,I * SBCNL LDA SPC FETCH SUB CHNL AND B77 SZA JMP BAD NOT ZERO GOOD CLA,INA ALL RIGHT--TAKE INTERACTIVE EXIT JMP DTTY,I * * * * SPC NOP .13 DEC 13 EQ5 NOP EQ4 NOP LU NOP TYPE OCT 37400 B2400 OCT 2400 B3400 OCT 3400 B77 OCT 77 * END * "C   7> 91740-18063 1740 S C0122 DS/1000 MODULE: SG#LD              H0101 f9ASMB,R,L,C SG#LD * NAME: SG#LD * SOURCE: 91740-18063 * RELOC: 91740-16063 * PGMR: MIKE SCHOENDORF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM SG#LD,8 91740-16063 REV 1740 770911 * * * * ENTRY POINT NAMES * ENT SG#LD * * * EXTERNAL REFERENCE NAMES * EXT .ENTR,EXEC * * * THIS SUBROUTINE LOADS A SEGMENT OF A PROGRAM * AND TRANSFERS EXECUTION CONTROL TO THE SEGMENT'S * ENTRY POINT. * * SKP SG#LD NOP LDA DZERO STA NAMR STA IERR LDA SG#LD STA DEGLD JMP ENTD * NAMR DEF ZERO IERR DEF ZERO * DEGLD NOP ENTD JSB .ENTR DEF NAMR JSB EXEC MAKE EXEC CALL TO LOAD SEGMENT DEF *+3 RETURN ADDRESS (DOES NOT RETURN HERE) DEF D8 REQUEST CODE DEF NAMR,I SEGMENT'S NAME * * D8 DEC 8 DZERO DEF ZERO ZERO NOP END k 8> 91740-18068 1740 S C0122 DS/1000 MODULE: D$EQT              H0101 ASMB,R,L NAM D$EQT,30 91740-16068 REV 1740 770623 SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ******************************************************************* SPC 2 ENT D$EQT,D$XS5 * * D$EQT * SOURCE: 91740-18068 * BINARY: 91740-16068 * D$EQT NOP D$XS5 EQU D$EQT END  9? 91740-18069 1740 S C0122 DS/1000 MODULE: SEGLD              H0101 7ASMB,R,L,C,Z * NAME: SEGLD * SOURCE: 92064-18175 * RELOC: 92064-16058 'N' ASSEMBLY OPTION: STANDARD RTE * RELOC: 91740-16069 'Z' ASSEMBLY OPTION: DS/1000 * PGMR: G.L.M.,C.E.J. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * IFN NAM SEGLD,7 92064-16058 REV 1740 770912 XIF IFZ NAM SEGLD,7 91740-16069 REV 1740 770912 XIF * * ENT SEGLD * EXT .ENTR,.MVW,$LIBR,$LIBX IFZ EXT DOPEN,DREAD,DCLOS XIF IFN EXT OPEN,READF,CLOSE DOPEN EQU OPEN DREAD EQU READF DCLOS EQU CLOSE XIF SUP * * SEGLD NOP STB XB SAVE B REGISTER IN CASE NO PARMS PASSED LDA WD5A RESET TRAILER RECORDS STA SPCAD POINTER. * LDA DZERO STA NAMR RESET PARMS STA IERR STA XT1 STA XT2 STA XT3 STA XT4 STA XT5 IFZ STA NODE XIF CLA STA SPCNT ZERO SPECIAL RECORD COUNT IFZ CMA STA DNODE RESET LOCAL DEFAULT FOR DS NODE XIF LDA SEGLD STA DEGLD SET PARM ADDR FOR .ENTR JMP ENTD GO GET PARMS * * NAMR DEF ZERO IERR DEF ZERO XT1 DEF ZERO XT2 DEF ZERO XT3 DEF ZERO XT4 DEF ZERO XT5 DEF ZERO IFZ NODE DEF ZERO XIF * DEGLD NOP DUMMY ENTRY POINT ENTD JSB .ENTR FETCH DEF NAMR CALL PARMS * LDA NAMR MUST HAVE CPA DZERO NAME PARM. JMP PERR ELSE--EXIT -10 IFZ * * SET UP DESTINATION NODE PARAMETER FO9R DS CALLS * LDA NODE DESTINATION NODE CPA DZERO GIVEN? JMP L.0 NO--DEFAULT IS LOCAL NODE LDA A,I YES--FETCH PARAMETER STA DNODE AND SAVE IT IN TWO WORD CRN XIF * * * IF NO TEMPS -- MOVE ID TMPS TO LOCAL BUFFER * ELSE MOVE TEMPS INTO LOCAL BUFFER * * * L.0 LDA XT1 FETCH 1ST PARAMETER ADDRESS CPA DZERO ANYTHING PASSED? JMP NOPAR NOPE--NOTHING PASSED * LDA N5 SETUP TO STA LMAIN MOVE 5 PARMS INTO LDA XDEF LOCAL BUFFER STA HMAIN * L.1 LDA HMAIN,I FETCH PARAMETER ADDRESS LDA A,I FETCH PARAMETER STA HMAIN,I SAVE IT LOCALLY * * ISZ HMAIN BUMP PARAMETER ADDRESS POINTER ISZ LMAIN ALL FIVE DONE? JMP L.1 NOPE CONTINUE * LDA XEQT FETCH ID ADDRESS INA ADVANCE TO TEMP ADDRESS STA XB SET AS B FOR SEGMENT ENTRY * * * * * * FETCH PROGRAM LIMITS * PLIM LDA XEQT FETCH ADA .22 HIGH-LOW LDB DHILO VALUES FOR JSB .MVW MAIN AND DEF .4 BASE PAGE * NOP * STA W27 SAVE FOR HIGH SEG ADDR * * OPEN FILE CONTAINING * REQUESTED SEGMENT * JSB DOPEN DEF RTO DEF SGDCB DEF ERRS DEF NAMR,I DEF OPENO FORCE TO BINARY IFZ DEF ZERO DEF CRN 2ND WORD IS DESTINATION NODE XIF * RTO LDA ERRS FETCH ERROR RETURN SSA JMP SGERR OPEN ERROR * SPC 5 * * READ ABSOLUTE RECORD * RDF0 JSB DREAD READ DEF RTR DEF SGDCB THRU SEGLD'S DCB DEF ERRS DEF IBUF INTO IBUF DEF .64 MAX RECORD LEGNTH DEF LEN ACTUAL READ LEGNTH RETURNED HERE * RTR SSA ERROR CODE RETURNEeD IN (A) JMP SGERR GOT AN ERROR --EXIT * * CHECK FOR EOF * LDA LEN FETCH LEGNTH WORD SSA SEE IF NEG (EOF?) JMP EOF GOT EOF-GO DO EOF THING * * DO CHECKSUM * LDA IBUF FETCH 1ST WORD AND LHALF ISOLATE ABS SIZE ALF,ALF GET TO LOW END STA ABSSZ SAVE ABS SIZE * * * CALCULATE AND SAVE RECORD HIGH ADDRESS * * CCB REC SIZE ADB A MINUS 1 ADB WD2 PLUS LOAD ADDRESS STB RECSZ EQUALS HIGH ADDRESS. * * CMA,INA NEGATE STA MTMP1 SAVE FOR CHECKSUM LDB WD2 FETCH WD2 AND ADDR LDA WD3A OF WORD 3 STA TMP2 * CKSM1 LDA TMP2,I FETCH NEXT WORD ADB A ADD TO CHECKSUM ISZ TMP2 BUMP WORD POINTER ISZ MTMP1 BUMP COUNT--DONE? JMP CKSM1 NO--CONTINUE * * LDA TMP2,I FETCH CHECKSUM WORD CPA B COMPARE TO CALCULATED VALUE JMP CKOK IT'S OK * SPC 3 * LDA N28 CKSUM ERROR CODE RSS BNDER LDA N27 BOUNDS ERROR RSS PERR LDA N10 PARAMETER ERROR SGERR STA IERR,I SET ERROR CODE * JSB DCLOS GO CLOSE IF OPEN DEF CEX DEF SGDCB DEF ERRS * CEX LDA IERR,I SET A= ERROR CODE FOR RETURN JMP DEGLD,I EXIT SPC 2 N27 DEC -27 N28 DEC -28 * * SEE WHERE RECORD GOES * CKOK LDA WD2 FETCH ADDR OF RECORD CPA .2 JMP SPC MIGHT BE SPEC REC * BPLNK AND BPMSK CHECK FOR BASE PAGE CPA WD2 JMP BPR YEP- IT'S A BASE PAGE RECORD * DLD LMAIN --MAIN MEMORY RECORD-FETCH JMP CKB BOUNDS * BPR DLD LBASE FETCH BP BOUNDS * CKB JSB CKBND GO SEE IF RECORD IS WITHIN BOUNDS JMP BNDER BOUNDS ERROR * * * * COPY ABS TO MEMORY * * LDA WD3A  FETCH ADDR OF WD3(FW OF CODE) LDB WD2 ACTUAL LOAD ADDR JSB PMOVE GO PRIV AND MOVE CODE IN ABSSZ NOP JMP RDF0 GO GET NEXT RECORD * * SPC 3 * * MOVE THE ID TEMPS INTO LOCAL BUFFER * * NOPAR LDA XEQT ID SEG ADDRESS INA ADVANCE TO TEMP AREA LDB XDEF LOCAL BUFFER ADDRESS JSB .MVW MOVE THEM IN DEF .5 ALL FIVE OF THEM NOP JMP PLIM CONTINE WITH PROGRAM LIMITS * * SPC CPA ABSSZ IF LEN=2 RSS THEN ITS A SPECIAL JMP BPR ---NO, MUST BE A LINK * DLD WD3 FETCH TRAILER RECORDS DST SPCAD,I SAVE IN INPUT BUFFER ISZ SPCAD ISZ SPCAD BUMP POINTER FOR NEXT SPEC REC ISZ SPCNT AND SPECIAL RECORD COUNT JMP RDF0 FETCH NEXT RECORD SPC 3 * * GOT AN EOF * EOF LDA N39 RELOCATABLE INPUT ERROR LDB SPCNT CPB .10 RSS JMP SGERR MUST HAVE SEEN 10 SPECIAL RECORDS * * * LDA ID27 LOCATION OF SEG HIGH ADDR(SPC REC) LDB W27 ID SEGMENT WD 27 ADDRESS JSB PMOVE GO SETIT .1 OCT 1 * JSB DCLOS DEF CRTN DEF SGDCB CLOSE SEG FILE BEFORE ENTERING THE UNKNOWN! DEF ERRS * * * * MOVE THE PARAMETERS INTO THE ID SEGMENT * * THE PARAMETERS ARE: 1) FIVE TEMPS PASSED IN CALL (B=ID TEMP AREA) * OR 2) FIVE TEMPS FROM ID IF NOTHING PASSED * B IS NOT CHANGED. * * * CRTN LDA XDEF ADDRESS OF PARAMETERS LDB XEQT IDSEG ADDRESS INB ADVANCE TO TEMP AREA * * GO PRIV AND MOVE THEM IN * JSB PMOVE .5 OCT 5 * * LDB XB IF NO PARMS B=ORIG VALUE * ELSE B=ID TEMP ADDRESS * LDA XEQT SET A=ID SEG ADDRESS JMP WD4,I ENTER SEGMENT SPC 3 * * CKBND NOP CMA,INA ADA WD2 7 SSA JMP CKBND,I * CMB,INB ADB RECSZ SSB ISZ CKBND JMP CKBND,I * * * ROUTINE TO MOVE WORDS IN PRIVELEDGED MODE * PMOVE NOP JSB $LIBR NOP JSB .MVW DEF PMOVE,I NOP ISZ PMOVE JSB $LIBX DEF PMOVE * * * SKP * .2 DEC 2 .4 DEC 4 .10 DEC 10 .22 DEC 22 .64 DEC 64 N5 DEC -5 N10 DEC -10 N39 DEC -39 IBUF BSS 64 * ZERO NOP IFZ DNODE DEC -1 CRN EQU ZERO XIF DZERO DEF ZERO XDEF DEF XT1 XB NOP * DHILO DEF LMAIN LMAIN NOP HMAIN NOP LBASE NOP HBASE NOP DON'T CHANGE ABOVE ORDER * SPCAD NOP MTMP1 EQU SEGLD W27 NOP ERRS NOP OPENO OCT 110 FORCE TO BINARY LEN NOP LHALF OCT 177400 WD2 EQU IBUF+1 WD3 EQU IBUF+2 WD4 EQU IBUF+3 WD3A DEF IBUF+2 WD5A DEF IBUF+4 TMP2 NOP BPMSK OCT 1777 ID27 DEF IBUF+17 NEED ADDRESS TO SET SEG HIGH RECSZ NOP SPCNT NOP * IFN SGDCB BSS 144 XIF IFZ SGDCB BSS 4 XIF * * XEQT EQU 1717B A EQU 0 B EQU 1 PLEN EQU * END u : D 91740-18070 1805 S C0122 DS/1000 MODULE: SGPRP              H0101 ^ASMB,L,C,R RTE-M SEGMENTED PROGRAM PREPARATION PROGRAM * * NAME: RTE-M SGPRP * SOURCE: 91740-18070 * RELOC: 91740-16070 * PROGMR: E.J.W.,C.E.J. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * * TO INITIATE SGPRP: * *RU,SGPRP,FI,LN,MN * OR * *RU,SGPRP,LU * WHERE: * FILNMN IS AN ASCII ANSWER FILE CONTAINING THE NAMR OF THE MAIN * PROGRAM'S FILE AS THE FIRST RECORD, FOLLOWED BY THE * SEGMENT(S)' NAMR(S) IN CONSECUTIVE RECORDS, ENDING WITH * AN "/E". * * LU IS THE LOGICAL UNIT NUMBER OF THE DEVICE FROM WHICH SGPRP * IS TO TAKE DATA. * * THE DEFAULT VALUE FOR THE PARAMETER IS LU # 1 (SYSTEM CONSOLE). * * NAM SGPRP,3,90 91740-16070 REV 1805 771118 EXT $LIBR,$LIBX,EXEC,$CVT1,$CVT3,$PARS EXT OPEN,READF,WRITF,CLOSE,POSNT * A EQU 0 B EQU 1 * * SGPRP NOP CLA STA PRMPT STA INLU LDA B,I GET INPUT PARAMETER CMA,INA LU OR FILE NAME? ADA B77 SSA JMP FILE FILE--GO MOVE NAME INTO STORAGE * LDA B,I LU--RESET A REG. SZA,RSS DEFAULTED? LDA D1 YES--GET DEFAULT LU STA INLU AND SAVE FOR INPUT RETRIEVAL * JSB EXEC SEE IF DEVICE IS INTERACTIVE DEF *+1+6 DEF D13 DEF INLU DEF DVR DEF TEMP DEF SUB LDA DVR DVR00, DVR05 SUB. 0, AND DVR07 SUB. 0 ALF,ALF ARE DRIVERS FOR INTERACTIVE DEVICES AND B77 SZA,RSS JMP SETPM I- CPA D5 JMP SUB? CPA D7 JMP SUB? JMP BEGIN SUB? LDA SUB AND B37 SZA JMP BEGIN SETPM ISZ PRMPT IF INTERACTIVE--SET PROMPT FLAG LDA INLU IOR B400 AND ECHO BIT IN LU STA INLU JMP BEGIN * FILE LDA .FLNM MOVE FILE NAME INTO LOCAL STORAGE SWP MVW D3 * JSB OPEN OPEN THE FILE DEF *+1+3 DEF IDCB1 DEF ERR .FLNM DEF FILNM IGNORE ERRORS ON THIS FILE * JSB READF READ FILE NAME OF MAIN DEF *+1+5 AND SAVE FOR MUCH LATER. DEF IDCB1 DEF ERR DEF MBUF DEF D10 DEF MLEN JMP SEGMT * BEGIN LDA PRMPT SEE IF LU INTERACTIVE SZA,RSS JMP RMAIN JSB EXEC IF SO--WRITE "SGPRP STARTED" DEF *+1+4 DEF D2 DEF INLU DEF MESS1 DEF D7 JSB EXEC AND PROMPT "MAIN PROGRAM NAME?" DEF *+1+4 DEF D2 DEF INLU DEF ASKMP DEF D10 * RMAIN JSB EXEC READ FILE NAME OF MAIN DEF *+1+4 AND SAVE FOR MUCH LATER. DEF D1 DEF INLU DEF MBUF DEF D10 STB MLEN * SEGMT CLA CLEAR OUT WORDS TO SAVE STA HMAIN HIGHEST MAIN AND HIGHEST BASE PAGE STA HBASE LOCATIONS USED BY ANY SEGMENT * NXSEG LDA INLU INPUT FROM FILE OR LU? SZA JMP NXLU LU--BRANCH AROUND * JSB READF FILE--READ SEGMENT NAME DEF *+1+5 DEF IDCB1 DEF ERR DEF IBUF DEF D10 DEF LEN JMP OPSEG * NXLU LDA PRMPT LU INTERACTIVE? SZA,RSS JMP NXLU2 NO--BRANCH AROUND WRITE JSB EXEC YES--PROMPT "/E OR SEGMENT NAME?" DEF *+1+4 DEF D2 DEF INLU DEF ASKSG DEF MD21 * NXLU2 JSB EXEC READ SEGMENT NAME DEF *+1+4 DEF D1 DEF INLU DEF IBUF DEF D10 STB LEN * OPSEG LDA DIBUF (A)=INPUT STRING ADDR LDB LEN (B)=WORD LENGTH OF INPUT STRING JSB PARSE PARSE INTO FNAME, SC, AND CR COMPONENTS LDA FNAME CPA /E NO MORE SEGMENTS? JMP UPDAT RIGHT, GO UPDATE MAIN'S BOUNDS * JSB OPEN OPEN SEGMENT FILE (ABSOLUTE) DEF *+7 DEF IDCB2 DEF ERR DEF FNAME DEF ABS DEF SC DEF CR SSA JMP FMPER * CLA INITIALIZE SPECIAL RECORD COUNT STA SRECN TO COUNT TIE-OFF RECORDS * NXREC JSB READF READ AN ABSOLUTE RECORD DEF *+6 INTO ABUF DEF IDCB2 DEF ERR DEF ABUF DEF D128 DEF LEN SSA JMP FMPER * CCA END-OF-FILE? CPA LEN JMP SGEOF YES, * JSB ABSCK PERFORM CHECKSUM CHECK LDA ABSAD COULD IT BE SPECIAL RECORD? CPA D2 IE., ADDR=2? RSS JMP NXREC NO, TRY NEXT RECORD * LDA LEN IT MIGHT BE SPECIAL RECORD CPA D5 SO CHECK ABSOLUTE RECORD LENGTH RSS JMP NXREC NOT SPECIAL RECORD. * ISZ SRECN IT IS A SPECIAL RECORD. LDA SRECN CPA D7 IS IT PROG'S MAIN ADDR BOUNDS? JMP SGMAN YES, SEE IF THESE ARE THE HIGHEST. * CPA D8 IS IT PROG'S BASE PAGE ADDR BOUNDS? JMP SGBAS YES, SEE IF THESE ARE THE HIGHEST. JMP NXREC * SGMAN LDA WORD2 GET HIGH ADDR BOUND STA B CMA,INA ADA HMAIN IS CURRENT SEGMENT HIGH ADDR SSA HIGHER THAN PREVIOUS HIGH? STB HMAIN YES, SAVE NEW HIGH JMP NXREC * SGBAS LDA WORD2 GET HIGH BASE PAGE BOUND STA B CMA,INA ADA HBASE IS CURRENT SEGMENT HIGH BASE ADDR SSA HIGHER THAN PREVIOUS HIGH? STB HBASE YES, SAVE NEW HIGH BASE * SGEOF JSͯB CLOSE DONE NOW. SO, CLOSE FILE DEF *+3 DEF IDCB2 DEF ERR JMP NXSEG DONE WITH THIS SEGMENT, MORE SEGMENTS? * UPDAT LDA DMBUF GET ORIGINAL INPUT STRING LDB MLEN FOR MAIN PROGRAM FILE NAME JSB PARSE AND PARSE INTO FNAME,SC,CR COMPONENTS * JSB OPEN OPEN THE MAIN PROGRAM FILE DEF *+7 DEF IDCB2 DEF ERR DEF FNAME DEF UPDTA UPDATE ABSOLUTE DEF SC DEF CR SSA JMP FMPER * CLA STA SRECN INIT SPECIAL RECORD COUNT * NXMRC JSB READF DEF *+6 DEF IDCB2 DEF ERR DEF ABUF DEF D128 DEF LEN SSA JMP FMPER * CCA CPA LEN END-OF-FILE? JMP MNEOF YES * JSB ABSCK PERFORM CHECKSUM CHECK LDA ABSAD IS IT SPECIAL RECORD CPA D2 ORIGINED AT 2? RSS MAYBE JMP NXMRC DEFINITELY NO. * LDA LEN CPA D5 IS IT THE RIGHT SIZE (5 WORDS)? RSS YES JMP NXMRC NO * ISZ SRECN LDA SRECN CPA D7 IS IT MAIN'S MAIN ADDR BOUNDS? JMP MNMAN YES * CPA D8 IS IT MAIN'S BASE PAGE ADDR BOUNDS? JMP MNBAS YES JMP NXMRC * MNMAN LDA HMAIN SET UP NEW HIGH MAIN SZA,RSS ANY CHANGE? JMP NXMRC NO, IGNORE STA WORD2 ADA WORD1 AND COMPUTE NEW CHECKSUM ADA ABSAD STA CKSUM * JSB POSNT BACK UP ONE RECORD DEF *+4 DEF IDCB2 DEF ERR DEF MD1 SSA JMP FMPER * JSB WRITF REWRITE RECORD DEF *+5 DEF IDCB2 DEF ERR DEF ABUF DEF LEN SSA JMP FMPER JMP NXMRC * MNBAS LDA HBASE FIX UP HIGH BASE PAGE WORD SZA,RSS ANY CHANGE? JMP MNEOF NO, IGNORE STA WORD2 AND R6ECOMPUTE THE CHECKSUM ADA WORD1 ADA ABSAD STA CKSUM * JSB POSNT BACK UP ONE RECORD DEF *+4 DEF IDCB2 DEF ERR DEF MD1 * JSB WRITF REWRITE RECORD IN MAIN FILE DEF *+5 DEF IDCB2 DEF ERR DEF ABUF DEF LEN SSA JMP FMPER * MNEOF LDA PRMPT IS INPUT DEVICE INTERACTIVE? SZA,RSS JMP EXIT JSB EXEC YES--WRITE "SGPRP DONE" DEF *+1+4 DEF D2 DEF INLU DEF MESS2 DEF D5 * EXIT JSB CLOSE CLOSE MAIN PROGRAM'S FILE DEF *+1+2 DEF IDCB2 DEF ERR IGNORE ERROR RETURNS * LDA INLU INPUT FROM FILE? SZA JMP TERM JSB CLOSE YES--CLOSE IT ALSO DEF *+1+2 DEF IDCB1 DEF ERR IGNORE ERROR RETURN * TERM JSB EXEC ALL DONE! DEF *+2 DEF D6 * * PARSE NOP BLS CONVERT B TO CHARACTER COUNT JSB $LIBR NOP JSB $PARS DEF PBUF JSB $LIBX DEF PARSE * ABSCK NOP ROUTINE FOR CHECKSUM VERIFY LDA ABSCT IF BAD CHECKSUM THEN AND LHALF EXIT VIA 'FMP ERROR' ALF,ALF SHIFT WORD COUNT TO LOW BITS CMA,INA STA ERR SAVE NEGATIVE COUNT LDB ABSAD GET ADDR, START CKSM LDA DABSD STA TEMP2 SET DATA ADDR * ABSC2 LDA TEMP2,I GET A WORD ADB A AND ADD TO CKSM ISZ TEMP2 BUMP TO NEXT WORD ISZ ERR BUMP COUNT JMP ABSC2 REPEAT TILL DONE * LDA TEMP2,I CPA B COMPARE CHECKSUMS JMP ABSCK,I MATCH, SO RETURN. * LDA D7 ERROR, SO FALL THROUGH 'FMP ERROR 007' * FMPER LDB PLUS SSA IF NEGATIVE NUMBER LDB MINUS GET ASCII "-" STB SIGN SSA CMA,INA MAKE ERROR CODE POSITIVE JSB $LIBR BEFORE CONVERTING TJO ASCII NOP FOR ERROR MESSAGE CCE (E)=1 FOR DECIMAL CONVERSION JSB $CVT3 JSB $LIBX DEF *+1 DEF *+1 INA DLD A,I GET LAST 4 DIGITS OF ERROR CODE DST ERMNO INTO ERROR MESSAGE DLD FNAME MOVE CURRENT FILENAME DST ERMNM INTO ERROR MESSAGE LDA FNAME+2 STA ERMNM+2 LDA PRMPT GET INITIATING TERMINAL'S LU SZA,RSS OR, IF NON-INTERACTIVE, LU # 1 LDB D1 SZA LDB INLU STB LU2 AND STORE IN EXEC CALL JSB EXEC WRITE ERROR MESSAGE DEF *+1+4 DEF D2 DEF LU2 DEF ERMSG DEF D12 JMP EXIT * * * * MESS1 ASC 7,SGPRP STARTED MESS2 ASC 5,SGPRP DONE ASKMP ASC 10,MAIN PROGRAM NAME? _ ASKSG ASC 11,/E OR SEGMENT NAME? __ ERMSG ASC 12, FMP ERROR -#### FNAMEX SIGN EQU ERMSG+5 ERMNO EQU ERMSG+6 ERMNM EQU ERMSG+9 MINUS ASC 1, - PLUS ASC 1, DMBUF DEF MBUF DIBUF DEF IBUF DABSD DEF WORD1 LHALF OCT 177400 FILNM BSS 3 /E ASC 1,/E ABS OCT 2310 UPDTA OCT 2312 LEN NOP ERR NOP TEMP EQU ERR SRECN NOP DVR EQU SRECN TEMP2 NOP LU2 EQU TEMP2 SUB EQU TEMP2 INLU NOP PRMPT NOP * B37 OCT 37 B77 OCT 77 B400 OCT 400 D1 DEC 1 D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D10 DEC 10 D12 DEC 12 D13 DEC 13 D128 DEC 128 MD1 DEC -1 MD21 DEC -21 * HMAIN NOP HBASE NOP MLEN NOP MBUF BSS 10 IBUF BSS 10 ABUF BSS 128 ABSCT EQU ABUF ABSAD EQU ABUF+1 WORD1 EQU ABUF+2 WORD2 EQU ABUF+3 CKSUM EQU ABUF+4 PBUF BSS 33 FNAME EQU PBUF+1 SC EQU PBUF+5 CR EQU PBUF+9 IDCB1 BSS 144 IDCB2 BSS 144 * * BSS 0 SIZE OF MODULE END SGPRP *($$* ; G 91740-18071 2013 S C0222 &DVA65              H0102 paASMB,Q,N,C IFZ HED DVA65 24999-16205 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM DVA65 24999-16205 REV.2013 800115 W/ TRACE # XIF IFN HED DVA65 91740-16071 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM DVA65 91740-16071 REV.2013 800115 XIF SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 *************************************************************** * *DVA65 COMMUNICATIONS DRIVER FOR DS/1000 * ALL LINE INTERRUPTS HANDLED BY MICROCODE * EXCEPT PROTOCOL FOR LINES ABOVE PRIVILEGED SLOT * *SOURCE PART # 91740-18071 * *REL PART # 91740-16020 * *WRITTEN BY: L. SCHOOF, L. POMATTO, R. SHATZER, C. WHELAN * *DATE WRITTEN: DEC 1976 *MODIFIED BY: LYLE WEIMAN, AUG. '78, TO ADD TRACE CAPABILITY * (# IN RIGHT-HAND COLUMN MARKS CHANGES) *MODIFIED BY: CRAIG HAMILTON 01/15/80 TO IMPROVE ERROR RECOVERY. * * USE "Z" OPTION TO INCLUDE "TRACE" OPERATION # * USE "N" OPTION TO EXCLUDE "TRACE" OPERATION # * *************************************************************** SPC 3 * * DEFINE ENTRY POINTS * ENT IA65,CA65 ENT MIC$X SPC 1 * * DEFINE EXTERNALS * EXT $LIST,$OPSY IFZ EXT $TIME,$CGRN # XIF SKP * * CALLING SEQUENCES * SPC 2 * TRANSMIT OR RECEIVE REQUEST AND DATA SPC 1 * JSB EXEC * DEF *+7 * DEF RCODE OCT 1 * DEF CONWD LU (BIT 6= 1 IF WRITE, BIT 7=3 1 IF PROGL) * DEF DBUF DATA BUFFER ADDRESS * DEF DBUFL DATA BUFFER LENGTH * DEF RBUF REQUEST BUFFER ADDRESS * DEF RBUFL REQUEST BUFFER LENGTH * SPC 2 * ENABLE LISTEN MODE SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 100B+LU * SPC 2 * SEND STOP SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 0 + LU * SPC 2 * CLEAR REQUEST SPC 1 * JSB EXEC * DEF *+3 * DEF RCODE OCT 3 * DEF CONWD 200B + LU * SPC 2 * SKP * *##################################################################### * * SET UP TRACE BUFFER AND ENABLE TRACE MODE REQUEST # * # * JSB EXEC # * DEF *+5 # * DEF RCODE OCT 20 (CLASS WRITE-READ) # * DEF CONWD OCT 700B + LU # * DEF BUFR TRACE BUFFER # * DEF TRBFL TRACE BUFFER LENGTH-- MUST BE 4N + 3 # * WHERE N = # ENTRIES DESIRED IN TABLE. # * DEF RN# RN# = SYNCHRONIZING RESOURCE NUMBER # * (MUST BE ALLOCATED GLOBALLY AND LOCKED PRIOR TO # * CALL). THIS RN IS CLEARED EACH TIME DRIVER FILLS# * BUFFER, THUS PROVIDING SYNCHRONIZATION WITH TRACE# * PRINTOUT PROGRAM. # * DEF OPTN TRACE SELECTION OPTION # * DEF CLASS CLASS NUMBER (SET TO ZERO BEFORE CALL). # * # * THEREAFTER, WHENEVER A COPY OF THE CURRENT CONTENTS OF THE # * TRACE TABLG/E ARE DESIRED, THEY MAY BE OBTAINED WITH A CLASS I/O # * "GET" CALL, USING THE CLASS NUMBER RETURNED FROM THE PREVIOUS # * SET-UP CALL. BE SURE TO SET THE "DO NOT DE-ALLOCATE BUFFER" # * BIT, OR DISASTROUS THINGS WILL HAPPEN!!!!!!!!!!! # * # * TRACE SELECTION SPECIFIER: # * 0 = TRACE ALL DVA65 ACTIVITY # * #0 = TRACE ONLY ACTIVITY FOR LU USED IN SET-UP CALL. # * # * "TRACE" BUFFER FORMAT: # * # * WORD 1 -- CONTAINS PASS NUMBER (INCREMENTED EACH TIME THE # * TRACE BUFFER IS RESET). USEFUL IN DETERMINING IF # * TRACE DATA HAS BEEN MISSED. # * WORD 2 -- CONTAINS ADDRESS OF NEXT ENTRY TO BE MADE IN TABLE # * ("OLDEST" ENTRY IN TABLE). # * WORD 3 -- BEGINS TRACE ENTRIES, FOUR WORDS PER ENTRY. # * ENTRY WORD 1 -- DATA WORD AS READ OR WRITTEN # * 2 -- R/X(BIT 15), STATE/EVENT, TIME-OUT INDICATION # * (BIT 0). BIT 15 IS SET IF WORD WAS RECEIVED, # * ELSE 0. BIT 0 IS SET IF A TIME-OUT OCCURRED,# * ELSE 0. # * DATA WORD NOT VALID IF TIME-OUT OCCURRED. # * 3 -- EQT ADDRESS # * 4 -- TIME-OF-DAY (LOW 16 BITS OF SYSTEM TIME WORD) # * # * # SPC 1 * ENABLE TRACE MODE REQUEST # * NOTE: YOUu MUST HAVE MADE A SET-UP CALL PREVIOUSLY)# * # * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 1700B+ANY COMMUNICATION LU LINKED TO DVA65 # * # * DISABLE TRACE MODE REQUEST # * # * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 700B+ANY COMMUNICATION LU LINKED TO DVA65 # * # *##################################################################### SKP * * ERROR CODES (IN EQT 5 STATUS) * * BIT MEANING * 0 REQUEST COMPLETED...NO ERRORS * 1 REQUEST PENDING ON A WRITE, OR NOT PENDING ON A READ * 2 SIMULTANEOUS REQUEST REJECT * 3 TIME OUT * 4 STOP RECEIVED * 5 REMOTE BUSY * 6 PARITY ERROR OR PROTOCOL FAILURE * 7 WRITE FLAG (FOR "GRPM" AT CCE) * * * EQT WORD USAGE BREAKDOWN * * EQT # USE * 1 DEFINED * 2 DEFINED * 3 DEFINED * 4 DEFINED * 5 DEFINED * 6 DEFINED * 7 ADDRESS OF DATA BUFFER * 8 LENGTH OF DATA BUFFER * 9 ADDRESS OF REQUEST BUFFER * 10 LENGTH OF REQUEST BUFFER * 11 COROUTINE ADDRESS * 12 CURRENT STATUS TABLE (SEE BREAKDOWN) * 13 ADDRESS OF EQT EXTENSION * 14 DEFINED...USED FOR SINGLE WORD T޷URN-AROUND TIMEOUT * 15 DEFINED...MICROCODE ALSO SETS TIME-OUTS * EXT(0) COUNTER FOR DATA TRANSFER * EXT(1) LAST WORD RECEIVED OVER COMM LINE * EXT(2) VERTICAL PARITY WORD / RP REQ LENGTH * EXT(3) DIAGONAL PARITY WORD / RP DATA LENGTH * EXT(4) COUNT OF TOTAL # BLOCKS TRANSMITTED * EXT(5) COUNT OF TOTAL NUMBER OF TRANSMIT-RETRIES * EXT(6) ID SEQ ADDRESS FOR SCHEDULE ON NEW REQUEST * * BREAKDOWN OF EQT WORD 12 * * BIT USAGE * 0-2 RETRY COUNTER OR * 0-5 BROKEN LINE COUNTER * 6 BROKEN LINE FLAG * 7-8 NOT USED * 9 REQUEST PENDING * 10 LISTEN MODE ENABLED * 11 RESERVED (USED BY SPECIAL FORCED-COLD-LOAD # * DRIVER, NOT PART OF DS/1000) # * 12 LAST SUCCESSFUL OPERATION (1=WRITE) * 13 FLAG FOR WRITE RETRY IN PROGRESS * 14 MICROCODE READ/WRITE FLAG * 15 POWER-FAIL RECOVERY IN PROGRESS # SKP * * DRIVER INITIALIZATION SECTION * IA65 NOP LDA EQT14 INA STA EQT15 REESTABLISH EQT15 ADDR JSB SETIO CONFIGURE I/O INSTRUCTIONS SERET LDB EQT13,I EXTENSION ADDRESS ADB B6 LDA 1,I GET 7TH EXT. WORD SZA IS THIS THE FIRST ENTRY FOR EQT? JMP NFIR NO * * THIS CODE IS EXECUTED ONLY ON FIRST TIME THROUGH FOR EQT * STA EQT12,I YES, INITIALIZE EQT12 STATUS STB TEMP 7TH WORD OF EXT. AREA * MODIFY INTERRUPT TABLE LDA CELL GET SELECT CODE ADA N6 SUBTRACT 6 TO FIND ADA INTBA ENTRY IN INTERRUPT TABLE LDB 0,I FETCH USER INTERRUPT LINK CMB,INB GET INTERRUPT LINK STB TEMP,I AND SAVE LDB EQT1 SET DRIVER STB 0,I INTERRUPT LINK ? JSB RDD.C CLEAR CARD * MODIFY CODE IF A DMS SYSTEM LDB $OPSY SYSTEM TYPE CLA,CCE RBR,SLB DMS SYSTEM? STA MOD1 YES, MODIFY INSTRUCTIONS ERA CCB SET REGISTERS FOR CPU TYPE CHECK OCT 100060 THIS SETS B TO 0 IFF XE NOP LDA XEMIC MICROCODE CALL FOR XE SZB SKIP IF XE LDA MXMIC ELSE USE 21MX MICROCODE CALL STA MIC$X SAVE LOCALLY * LDA EQT4,I TELL RTE TO RETURN CONTROL ON TIME OUT, IOR .300 AND FOR POWER-FAIL RECOVERY. # STA EQT4,I SKP * NFIR LDB EQT5,I LDA EQT6,I GET REQUEST CODE AND B3703 ISOLATE IT CCE,SSB IS THIS A POWER-RECOVERY ENTRY? # JMP PFAIL YES, GO TO ABORT CURRENT OPERATION. # CPA B3 IS IT A STOP REQUEST? JMP STPRQ YES, SEND A "STOP". * DETERMINE OPERATION TYPE LDB 0 AND B3 MASK OFF CODE CPA B1 IS IT A READ? JMP REQ YES...READ OR WRITE/READ CPB B203 IS IT A CLEAR REQ? JMP CLREQ YES...CLEAR REQ. CPB B103 IS IT AN ENABLE LISTEN MODE JMP LCREQ YES IFZ CPB B703 DISABLE TRACE MODE? # JMP DTRAC YES. # CPB B1703 RE-ENABLE TRACE MODE? # JMP ETRAC # XIF * ERROR IN REQUEST HAS OCCURRED CLB,INB CODE FOR REQUEST ERROR SZA WAS IT A CONTROL CODE? REJCT INB YES, RETURN A 2 (CONTROL REQ. ERROR) JMP IDON * * B3 OCT 3 B6 OCT 6 B103 OCT 103 B203 OCT 203 B3703 OCT 3703 .300 OCT 30000 # MXMIC OCT 105520 XEMIC OCT 105300 IFZ B700 OCT 700 # B1700 OCT 1700 B703 OCT 703 # ;B1703 OCT 1703 # XIF SKP * * SET UP ENABLE LISTEN MODE LCREQ LDA MIC$X INITIALIZE TO USE OPEN LOOP MICROCODE MOD1 JMP LCR2 NOP IF DMS SYSTEM CELL EQU *+1 XSA * DO CROSS-MAP STORE RSS LCR2 STA CELL,I NON-DMS, MODIFY TRAP CELL JSB RDD.C READ CARD TO CLEAR IT LISTI STC 0,C SET RECEIVE INTERRUPT MODE LDA .020 SET LISTEN ENABLED STATUS RSS CLREQ JSB RDD.C READ DATA AND STATUS FROM CARD TO CLEAR STA EQT12,I UPDATE EQT STATUS CLB,INB GOOD STATUS BIT JSB STAT PUT NEW STATUS IN EQT 5 LDB B4 SET FOR IMMEDIATE COMPLETION * * HERE FOR COMPLETION RETURN * EQT 12 WILL BE SET DEPENDING UPON LISTEN MODE * STATUS IDON STB TEMP SAVE COMPLETION STATUS LDA EQT12,I GET CURRENT DRIVER STATUS AND .020 MASK OFF ALL BUT LISTEN ENABLE LDB LSTNI GET ADDRESS OF LISTEN ENABLED ROUTINE SZA LISTEN MODE ENABLED? CLA,INA,RSS YES, ENABLE MICROCODE READ CLB NO STA EQTX,I SET TRANSFER COUNT LDA TEMP GET STATUS AGAIN STB EQT11,I SAVE COROUTINE ADDRESS JMP IA65,I RETURN TO RTE SYSTEM SKP * * COME HERE ON A READ OR WRITE * REQ EQU * IFZ LDA EQT6,I GET REQUEST # AND B1700 MASK SUBFUNCTION # CPA B700 ENABLE TRACE MODE CALL? # JMP TRAC. YES # XIF LDB EQT7,I GET ADDRESS OF DATA ADB N7 POINT TO 2ND WORD OF CLASS HDR LDA EQT14,I GET THIS EQT'S TIMEOUT IOR TBITS ENSURE BITS 15, 14, AND RAL 0 ARE SET FOR SYSTEM USE STA 1,I PASS TIMEOUT TO GRPM LDA EQT8,I DATA LENGTH CMA,INA ADA EQT9,I COMPUTE (REQ ADDR - DATA LEN) STA EQT7,I USE IT AS ACTUAL BUFFER ADDR * LDA EQT12,I AND NMSK CLEAR UNNECESSARY FLAGS STA EQT12,I * LDB EQT6,I GET REQUEST CODE BLF,BLF RBL ALF,RAR ALF,ERA E = REQUEST PENDING FLAG LDA EQT8,I STA EQT6,I SET XMISSION LOG INTO EQT6 ADA EQT10,I COMBINE BOTH LENGTHS SLB,RSS IS THIS A WRITE TO SCE-1? STA EQT8,I NO, SAVE COMBINED LENGTHS LDA EQT5,I EQT STATUS WORD AND B1774 CLEAR BITS 7-0 SSB,RSS IS THIS A WRITE? CME,RSS NO, REVERSE RP FLAG IOR B200 YES, SET BIT 7 STA EQT5,I CLA,SEZ,INA SKIP IF (WRITE&NOT RP) OR (READ&RP) JMP BUSY OTHERWISE BUSY OR INVALID REQUEST SSB SKIP IF A READ JMP WREQ DO A WRITE SKP * * READ REQUEST * LDA EQT12,I AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I * REQ1 LDB EQT10,I GET RECEIVED RQST LENGTH LDA EQT4,I ALF,ALF GET LSB OF SUBCHANNEL RAL,ELA AND STORE IT IN E REG RBL,ERB ECHO WD WITH BIT15=1 IF CLOSED LOOP REQ2 EQU * IFZ LDA B23 STATE 19: READ RQST, ECHOING RQST LNTH# XIF JSB TALK READ RESPONSE IFZ LDA B24 STATE 20: READ RQST, CHECKING RESPONSE# XIF JSB CHECK CHECK RCVD WORD JMP REQ3 MUST RETRY ON TIMEOUT JMP ERR.7 STOP RECEIVED # JMP ERR.8 RC RCVD, PROTOCOL FAILURE CPB TNW JMP RDREQ "TNW" RCVD, OK TO READ-IN REQUEST CPB RLW RLW RECEIVED? JMP REQ1 YES, RE-ECHO REQUEST LENGTH * REQ3 JSB RETRY UNRECOGNIZED WORD RECEIVED LDB RLW SEND RLW AND JMP REQ2 TRY AGAIN SPC 2 * * SET-UP TO READ DATA BLOCK * RDREQ LDA EQT8,I DATA LENGTH CPA B2 IS THIS AN SCE-1 REQUEST? CLA,INA,RSS YES JMP RDBLK  NO, INITIATE READ STA EQT8,I SET READ LENGTH TO 1 LDB EQT7,I BUFFER ADDRESS LDA EQT1 ADDR OF THIS EQT STA 1,I PASS IT TO PROGL IN 1ST WORD ISZ EQT7,I BUMP ADDR FOR BUFFER * * THIS SECTION INITIATES ALL MICROCODE BLOCK READS * RDBLK LDB EQT4,I LSL 9 SIGN = SUBCHANNEL LSB LDA MIC$X GET MICROCODE MACRO INSTRUCTION SSB SKIP IF SUBCHANNEL EVEN (XMIT MODE) INA ODD SUBCHANNEL, RUN CARD IN RCV MODE STA CELL,I STORE COMM.LINES TRAP CELL LDB TNW SEND TNW IFZ CLA STATE 0: INITIATING READ, SENDING TNW# XIF JSB OUTPB LDB EQT14,I & SET COMM LINE TIMEOUT STB EQT15,I LDA EQT8,I GET SUM OF DATA & REQ LENGTHS CMA -# OF WORDS -1 STA EQTX,I SET MICROCODE'S COUNTER JSB CEXIT NOW DO IT! * * BLOCK HAS BEEN READ, CHECK TRANSMISSION LDA COUNT MICROCODE COUNT ADA EQT8,I SSA SKIP IF XFER GOT STARTED JMP RDB4 ELSE RETRY, TNW MAY HAVE BEEN LOST # IFZ LDA B25 STATE 21: BLOCK HAS BEEN READ, # * WAITING FOR TNW# XIF JSB CHECK CHECK XMISSION JMP RDTO TIMEOUT, EXAMINE THE REASON. # JMP ERR.7 STOP RECEIVED # JMP ERR.8 REQUEST COMING: PROTOCOL FAILURE! # RDB2 CPB TNW WAS LAST A "TNW"? # JMP ENDIT YES, SUCCESSFUL READ. # RDTO CPB RLM REQUEST TO TRY AGAIN? # JMP RDB4 YES, SEE IF ALLOWED. # LDB COUNT IF THE MICROCODE COUNT HAS # CPB B100 BEEN SET =100B, THEN # JMP ER6WT A PROTOCOL FAILURE HAS BEEN DETECTED!# SZA ACTUAL TIMEOUT? # JMP ERR.3 YES, PROCESS s THE ERROR. # * * LAST CONTROL UNRECOGNIZED IFZ LDA B26 STATE 22:BLOCK READ BUT LAST CTRL UNREC# XIF RDB3 LDB RLW SEND "RETRANSMIT LAST WORD # JSB TALK & READ RESPONSE IFZ LDA B27 STATE 23:CHECKING RESPONSE TO RLW # XIF JSB CHECK SEE WHAT WE GOT JMP RDB5 NO RESPONSE, TRY AGAIN, IF ALLOWED. # JMP ERR.7 STOP RECEIVED # JMP ERR.8 REQUEST COMING: PROTOCOL FAILURE! # JSB RETRY RETRY OUR RETRY JMP RDB2 * RDB4 JSB RETRY GIVE IT 8 TRIES JMP RDBLK * RDB5 JSB RETRY IF RETRIES ARE ALLOWABLE, # JMP RDB3 SEND RLW, AND AWAIT ACKNOWLEDGMENT. # SPC 2 * HERE WHEN 'STOP' RECEIVED ON "READ" * ERR.7 EQU * # JSB RTEQT RETURN EQT NUMBER # JMP ERR.4 AND TAKE 'STOP' EXIT # * RTEQT NOP SUBROUTINE TO RETURN EQT NUMBER # LDB EQT9,I # LDA EQT1 # STA B,I # JMP RTEQT,I RETURN TO CALLER # * * HERE ON RECEIVE PROTOCOL ERRORS--DELAY TO FORCE XMIT TIMEOUT # * ER6WT EQU * # JSB RTEQT RETURN EQT ADDRESS SO QCLM CAN PRINT EQT # LDA DM100 ALLOW A 1 SECOND DELAY # STA EQT15,I TO FORCE A TRANSMITTER TIMEOUT. # CLA DISABLE # STA EQTX,I MICROCODE. # JSB CEXIT AWAIT THE TIMEOUT RETURN. # LDB B100 INDICATE PROTOCOL FAILURE IN EQT5. # JMP CEND GO TO TERMINATE THE CURRENT OPERATION. # * DM100 DEC -100 # * |` SKP * * WRITE REQUEST * WREQ LDA EQT9,I LDA 0,I GET 1ST WORD OF REQUEST SLB IS THIS A PROGL DOWNLOAD? STA EQT10,I YES, USE IT INSTEAD OF BUFFER LEN * WRTRY LDB RC IFZ CLA,INA STATE 1:WRITING, SENDING RC # XIF JSB TALK SEND RC & READ RESPONSE IFZ LDA B2 STATE 2:WRITING, SENT RC, EXPECT TNW# XIF JSB CHECK CHECK WHAT WE GOT JMP WRTR1 TRY AGAIN IF TIMEOUT JMP WRTRY STOP, RETRY IMMEDIATELY JMP SIMRQ RC, SIMULTANEOUS REQUEST CPB RLW RLW RECEIVED? JMP WRTRY YES, OTHER SIDE SAYS RETRY CPB TNW RSS SKIP IF "TNW" RECEIVED JMP WRTR1 UNRECOGNIZED, RETRY * SEND DATA LENGTH LDB EQT6,I IFZ LDA B3 STATE 3:WRITING, SENDING DATA LENGTH# XIF JSB TALK SEND DATA LENGTH, GET ECHO IFZ LDA B4 STATE 4:WRITING, SENT DATA LNTH, # * EXPECT ECHO # XIF JSB CHECK CHECK RESPONSE JMP ERR.3 TIMEOUT JMP TSDLN 'STOP' CODE MAY BE A VALID DATA LENGTH # JMP SIMRQ SIMULTANEOUS REQUEST TSDLN CPB EQT6,I ECHO OK? # JMP SRQLN YES # CPB STOP LEGITIMATE 'STOP'? # JMP ERR.4 YES, PROCESS IT. # JMP WRTR1 NO, RETRY * SEND REQUEST LENGTH SRQLN LDB EQT10,I REQUEST LENGTH # IFZ LDA B5 STATE 5:WRITING, SENDING REQUEST LENGTH# XIF JSB OUTPB SEND IT LDA B1776 STA EQT15,I APPROXIMATELY 1 SEC TIMEOUT JSB TRAPR SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT READ NEXT WORD WREQ2 EQU * IFZ LDA B6 STATE 6:WRITING, SENT REQ. LNTH, EXPECT ECHO# XIF JSB CHECK  CHECK RESPONSE JMP WRTR1 TIMEOUT, RETRY JMP ERR.5 REMOTE IS BUSY JMP SIMRQ RC * CONFIGURE FOR EITHER CLOSED OR OPEN LOOP MICROCODE PROCESSING LDA EQT10,I ELA SAVE EQT10 SIGN LDA MIC$X MICROCODE CALL RBL,SLB,ERB IF BIT 15=1, RCVR WANTS CLOSED LOOP INA SET TO CALL CLOSED LOOP PROCESSOR STA CELL,I SET TRAP CELL CPB EQT10,I CHECK ECHOED RQST LENGTH JMP WRBLK LENGTH ECHO IS OK SKP * JSB RETRY NOT VALID ECHO, BUMP RETRY COUNT CPB RLW WAS IT AN RLW? (SCE-1 RETRY) JMP WRTRY YES, DO IMMEDIATE RC RETRY LDB RLW IFZ LDA B7 STATE 7:WRITE RETRY # XIF JSB TALK SEND RLW JMP WREQ2 * * REQUEST PREAMBLE WRITE FAILURE - WAIT 1 I/O T.O. AND RETRY THE RC# * WRTR1 JSB RETRY CHECK RETRY COUNT LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT DO READ IFZ LDA B10 STATE 8: REQUEST PREAMBLE WRITE FAILURE--RETRY# XIF JSB CHECK SEE WHAT WE GOT JMP WRTRY TIMED-OUT, RESEND RC JMP ERR.4 STOP RCVD, EXIT RSS RC, SIMULTANEOUS REQUEST JMP WRTRY UNRECOGNIZED, DO RC ANYWAY * * SIMULTANEOUS REQUEST OCCURRED, RESOLVE BASED ON LAST OPERATION * SIMRQ JSB RETRY DON'T TRY FOREVER LDA EQT12,I ALF,SLA TEST LAST SUCCESSFUL OPERATION RSS LAST WAS WRITE, WE MUST WAIT JMP WRTR1+1 LAST WAS READ, WE GET PRIORITY * LDB RLW IFZ LDA B11 STATE 9: WRITING, SIMULT.RQST, # * AM BACKING DOWN # XIF JSB XMITX SEND RLW IN XMIT MODE LDB B4 JMP CEND GIVE SIMULTANEOUS REQUEST STATUS +NLHHN SKP * ENTER HERE TO DO ALL BLOCK WRITES WRBLK LDB TNW THIS TNW WILL INITIATE MICROCODE IFZ LDA B12 STATE 10:WRITING, SENDING TNW, EXPECT TNW# XIF WXFER EQU * JSB OUTPB SEND IT LDB EQT14,I STB EQT15,I SET LINE TIMEOUT LDA EQT12,I IOR .400 SET MICROCODE WRITE BIT STA EQT12,I UPDATE EQT STATUS LDA EQT8,I LENGTH FOR XFER SZA,RSS JMP ENDIT ZERO LENGTH DATA, GET OUT NOW CMA -LENGTH-1 STA EQTX,I SET MICROCODE COUNTER JSB CEXIT LET MICROCODE DO ITS THING * * BLOCK HAS BEEN WRITTEN, CHECK TRANSMISSION LDA COUNT GET MICROCODE XFER COUNT, # LDB EQTX AND EQT EXTENSION ADDRESS. # SZA,RSS IF THE TRANSFER WAS SUCCESSFUL, THEN # JMP WRTOK COMPLETE THE HOUSEKEEPING. # * # CPA B77 IF PARITY FAILED # JMP WRTR2 GO TO RETRY THE TRANSFER. # CPA B100 IF PROTOCOL FAILED, # INB,RSS THEN SKIP TO DETERMINE THE REASON; # JMP ERR.3 ELSE, GIVE A TIMEOUT ERROR. # LDA B,I GET THE RECEIVED WORD. # CPA STOP IF A "STOP" WAS RECEIVED, # JMP ERRW4 THEN ABORT, AND INFORM THE CALLER. # CPA RC IF AN "RC" WAS RECEIVED, THEN THE RCVR # JMP SIMRQ IS OUT OF SYNC--RESOLVE THE CONFLICT. # JMP ERR.9 UN-RECOGNIZEABLE: PROTOCOL FAILURE! # * # WRTOK ADB B4 POINT TO DATA BLOCK XFER COUNTER. # ISZ B,I BUMP THE TOTAL SUCCESSFUL BLOCK COUNT. # NOP # JMP ENDIT COMPLETE THIS OPERATION. # * * PARITY FAILURE: PERFORM A WRITE RETRY # WRTR2 JSB RETRY CHECK RETRY COUNT # ADB B5 POINT TO THE BLOCK RETRY COUNTER # ISZ B,I BUMP WRITE RETRY COUNTER NOP LDA EQT12,I IOR .200 SET "WRITE RETRY" FLAG STA EQT12,I LDB RLM "RETRANSMIT LAST MESSAGE" IFZ LDA B13 STATE 11: PERFORMING WRITE RETRY # XIF JMP WXFER PERFORM RE-WRITE SKP * LOCAL BUSY OR READ REJECT FOR NO R.P. BUSY CCB LDA EQT15,I IS THERE A TIMEOUT PENDING IOR EQTX,I OR IS MICROCODE ENABLED? SZA,RSS SKIP IF YES TO EITHER STB EQT15,I ELSE SYSTEM WIPED OUR TIMEOUT LDB B2 JSB STAT SET LOCAL BUSY FLAG LDA B4 IMMEDIATE COMPLETION LDB EQT6,I RETURN DATA LENGTH IN B JMP IA65,I RETURN * * HERE FOR REMOTE BUSY ERR.5 LDB B40 JMP CEND * # * HERE FOR PROTOCOL FAILURES ON 'READ' * STORE EQT ADDRESS IN 2ND BUFFER ERR.8 EQU * JSB RTEQT STORE EQT # JMP ERR.9 AND EXIT W/ PROTOCOL FAILURE STATUS # * * POWER FAIL: SEND 'STOP' & REPORT PROTOCOL ERROR; HIGHER LEVELS MAY RETRY # * # PFAIL LDA EQT12,I SET POWER-FAIL RECOVERY IN PROGRESS # RAL,ERA (EQT12: BIT#15) # STA EQT12,I INTO THE EXTENDED STATUS WORD. # IFZ LDA B34 STATE 28: POWER FAILURE RSS XIF * * HERE FOR PARITY ERROR ERR.6 EQU * # IFZ LDA B31 STATE 25: PARITY ERROR # RSS # XIF * * HERE ON ALL PROTOCOL FAILURES (WRITING & READING) * ERR.9 EQU *  IFZ LDA B32 STATE 26:PROTOCOL FAILURE # XIF * * HERE TO SET ERROR, SEND STOP, & TERMINATE ERSET EQU * LDB B100 LOAD PARITY ERROR STATUS IFZ STA STATE SAVE DRIVER STATE # XIF JSB STAT PUT STATUS INTO EQT 5 LDB STOP IFZ LDA STATE LOAD STATE #(DEPENDS ON ERROR) # XIF JSB XMITX SEND STOP & AWAIT INTERRUPT JSB RDD.C CLEAR CARD BY READING IT LDA EQT5,I WAS THIS # ALF,ALF REQUEST # SSA A 'READ'? # JMP CEND+1 NO. # JSB RTEQT RETURN ADDRESS OF EQT IN 2ND BUFFER# JMP CEND+1 AND RETURN ERROR CODE. # * LSTNI DEF ILSTN B1 OCT 1 .020 OCT 2000 .010 OCT 1000 * B40 OCT 40 B77 OCT 77 B100 OCT 100 .100 OCT 10000 .200 OCT 20000 .400 OCT 40000 NMSK OCT 13100 TBITS OCT 160000 CLR9 OCT 176777 CLR11 OCT 173777 SKP * * THIS SUBROUTINE INITIALIZES THE EQT TIMEOUT FLAG, SETS THE * COMM LINE TRAP CELL TO A "JSB CIC" IF IT IS ABOVE THE * PRIVILEGED CARD AND SETS THE MICROCODE COUNTER TO 1. * TRAPR NOP LDA EQT4,I AND CLR11 CLEAR THE EQT4 TIMEOUT FLAG STA EQT4,I LDB CELL THIS LINE'S SELECT CODE CMB,INB ADB DUMMY TEST AGAINST PRIVILEGED CARD'S SC LDA MIC$X MICROCODE CALL MACRO SSB ARE WE ABOVE THE PRIVILEGED CARD? LDA TBG,I YES, GET A "JSB CIC" STA CELL,I SETUP TRAP CELL CLA,INA STA EQTX,I SET MICROCODE COUNT = 1 JMP TRAPR,I RETURN SPC 1 * * SEND WORD, SET TIMEOUT, & AWAIT RESPONSE * TALK NOP JSB OUTPB SEND WORD IN B REG LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAPCELL FOR 1 WORD READ LD׫A TALK COROUTINE RETURN ADDRESS JMP CEXT1 SPC 1 * * IF ALREADY 7 RETRIES, GIVE PARITY ERROR ELSE BUMP COUNT & RETURN * RETRY NOP LDA EQT12,I AND B7 ISOLATE RETRY COUNTER CPA B7 IS THIS THE 8TH RETRY? JMP FAIL YES, RETURN ERROR ISZ EQT12,I BUMP COUNT JMP RETRY,I & TRY AGAIN * FAIL LDB COUNT SZB WAS WORD COUNT ZERO? CPB B77 NO, WAS IT BLOCK PARITY? JMP ERR.6 RETURN A PARITY ERROR * * HERE FOR TIMEOUT ERR.3 LDB B10 TIMEOUT BIT FOR EQT5 IFZ LDA B33 XIF JMP ERSET+1 EXIT WITH LINE T.O. ERROR SKP * * CONTINUATION SECTION * CA65 NOP JSB SETIO CONFIGURE I/O INSTRUCTIONS LDB EQT11,I GET COROUTINE ADDR SZB,RSS IT IT SET-UP? JMP IUNKN GO TO UNKNOWN INTERRUPT PROCESSOR LDA EQTX,I STA COUNT SAVE MICROCODE COUNT CLA STA EQTX,I DISABLE MICROCODE LDA EQT12,I AND .020 ISOLATE "LISTEN ENABLED" BIT IOR EQT1,I ALSO TEST FOR DRIVER BUSY SZA EITHER CONDITION TRUE? JMP 1,I YES, GO TO COROUTINE ADDR ISZ CA65 NO, IGNORE THE INTERRUPT. * CLCRD JSB RDD.C CLEAR THE CARD JMP CEXT3 & GET OUT * * * * UNKNOWN INTERRUPTS COME HERE * WE'RE IN TROUBLE IF WE EVER GET HERE!!!!! * IUNKN STB EQT12,I CLEAR ALL CARD STATI LDB B77 SET ALL STATUS ERROR BITS JMP CEND GET OUT...NOW!!! * SKP * * HERE FOR FIRST INTERRUPT WHEN CARD IN LISTEN MODE * ILSTN LDA EQT12,I AND B1776 INITIALIZE BROKEN LINE COUNT STA EQT12,I * ILSN0 EQU * IFZ LDA B14 STATE 12: FIRST INTERRUPT IN LSTEN MODE, EXP.RC # XIF JSB CHECK FIND OUT WHAT THEY SENT US JMP ILSN4 TIME OUT...IGNORE JMP ILSN4 STOP...IGNORE JMP ILSN1 REQUEST COMING * * ENTER HERE WHEN UNRECOGNIZED WORD RECEIVED WHILE "LISTENING" * JSB RDD.C CLEAR COMMUNICATIONS CARD LDA EQT12,I ISZ EQT12,I BUMP BROKEN LINE COUNT AND B77 CPA B77 64 ZEROES IN A ROW = BROKEN LINE! JMP DEXIT IT IS, LEAVE CARD DISABLED & EXIT JSB TRAPR SETUP FOR 1 WORD READ JSB CEXIT EXIT IN RCV MODE JMP ILSN0 GOT ANOTHER WORD, GO CHECK IT * ILSN1 LDA EQT12,I EQT STATUS IOR .010 SET REQUEST PENDING FLAG STA EQT12,I SAVE IT * ILSN2 LDB TNW SEND A TNW IFZ LDA B15 STATE 13: GOT RC, SENDING TNW, EXP.DATA LNTH # XIF JSB TALK & WAIT FOR DATA LENGTH IFZ LDA B16 STATE 14: RECEIVING, EXPECTING DATA LENGTH # XIF JSB PRECK DO PREAMBLE CHECKING ADA B3 POINT TO EXT(3) STB 0,I SAVE DATA LENGTH FOR PROGRAM IFZ LDA B17 STATE 15: ECHOING DATA LENGTH, EXPECT REQ. LNTH # XIF JSB TALK ECHO IT & GET REQUEST LENGTH IFZ LDA B20 STATE 16: RECEIVING, EXPECTING REQ. LNTH # XIF JSB PRECK DO PREAMBLE CHECKING ADA B2 POINT TO EXT(2) STB 0,I SAVE RQST LENGTH FOR PROGRAM ADA B4 POINT TO EXT(6) LDB 0,I GET I/O ADDRESS OF PROGRAM STB PROG SAVE ADDRESS ADB B17 GET TO STATUS LDA 1,I GET STATUS AND B17 MASK OFF ALL BUT STATUS SZA BUSY? JMP ILSN3 YES...TELL OTHER SIDE TO RETRY ADB N5 ID SEG B REG SAVE AREA LDA EQT4 GET ADDRESS OF LU STA 1,I PASS IT IN B REG JSB $LIST SCHEDULE PROGRAM OCT 101 PROG NOP ILSN4 JSB RDD.C CLEAR CARD BY READING IT JSB TRAPR SETUP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI SET FOR LISTEN MODE INTERRUPT JMP CEXT1 AND EXIT * * HERE޼ IF WE GOT A "BUSY" CONDITION * ILSN3 LDB STOP SEND STOP TO INDICATE "REMOTE BUSY" IFZ LDA B21 STATE 17: QUEUE BUSY, SENDING 'STOP' # XIF JSB OUTPB SEND IT * * HERE ON STOP...CLEAR REQUEST PENDING STATUS * ILSN5 LDA EQT12,I AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I JMP ILSN4 TERMINATE * * SUBROUTINE TO CHECK RCVD PREAMBLE WORD & RETRY IF RC * PRECK NOP JSB CHECK CHECK RCVD WORD JMP ILSN5 TIME-OUT, CLEAR RP CONDITION RSS 7760B IS POSSIBLE DATA LEN JMP ILSN2 RC, RESTART PREAMBLE LDA EQTX PASS EXT AREA ADDR BACK JMP PRECK,I * SKP * * HERE FOR SEND STOP REQUEST * STPRQ LDB STOP SEND STOP CLA DON'T ALTER STA CELL TRAP CELL. IFZ LDA B22 STATE 18: REQUEST TO SEND 'STOP' # # XIF JSB XMITX IN XMIT MODE JSB RDD.C READ CARD TO CLEAR IT STA CELL LDA EQT12,I AND BSTMK SAVE LISTEN, BROKEN LINE, & LAST OP.BITS JMP ENDOK * * NOW SET FLAG TO SHOW WHETHER THE LAST SUCCESSFUL OPERATION WAS A * READ OR WRITE. THIS IS USED TO RESOLVE SIMULTANEOUS LINE CONTENTION. ENDIT LDA EQT12,I AND .020 SAVE "LISTEN ENABLED" FLAG LDB EQT5,I BLF,BLF SSB SKIP IF READ IOR .100 SET LAST OPERATION AS WRITE * ENDOK STA EQT12,I SET STATUS CLB,INB SET GOOD STATUS # JMP CEND # * * 'STOP' RECEIVED SOMETIME DURING TRANSMISSION ERRW4 EQU * IFZ CH.01 NOP 'RSS' HERE WHEN TRACE MODE ENABLED # JMP ERR.4 SKIP 'TRACE' STUFF WHEN DISABLED # JSB CKTRC CHECK IF WE'RE TO TRACE THIS ONE # JMP ERR.4 NO, CONTINUE LDB B30 STATE 24:'STOP' RC'D DURING XMIT-ABORT# JSB TRACE E # LDB STOP # IOR SBIT SET 'RECEIVE' INDICATOR JSB TRACE # LDB EQT1 # JSB TRACE # LDB $TIME # JSB TRACE # XIF # * * 'STOP' RECEIVED EXIT * ERR.4 EQU * LDB B20 SKP * * HERE TO TERMINATE * CEND JSB STAT UPDATE EQT 5 STATUS LDA EQT12,I GET CARD STATUS WORD AND .020 IS IT LISTEN MODE? SZA,RSS JMP CLCRD NO, CLEAR CARD & EXIT JSB TRAPR SET UP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI GET LISTEN INTERRUPT JMP CEXT2 AND LEAVE * * HERE TO DO CONTINUATION RETURN * CEXIT NOP LDA CEXIT GET NEXT INTERRUPT ADDRESS CEXT1 ISZ CA65 BUMP CONTINUATOR RETURN CEXT2 STC 0,C SET FOR RECEIVE MODE CEXT3 STA EQT11,I SAVE NEW INTERRUPT LOCATION CEXT4 CLA LDB SETIO CPB I65AD WAS THIS ENTRY VIA INITIATOR? JMP IA65,I YES, THEN RETURN THE SAME WAY LDB EQT6,I GET EQT6 IN CASE IT'S COMPLETION JMP CA65,I RETURN * I65AD DEF SERET SPC 3 * * SUBROUTINE TO PUT NEW STATUS INTO EQT WORD 5 * STAT NOP LDA EQT10 STA EQT15 FOOL RTE SO IT LEAVES TIMEOUT ALONE LDA EQT5,I GET WORD 5 AND B1776 MASK OFF OLD STATUS IOR 1 STUFF IN NEW STATUS STA EQT5,I AND PUT IT AWAY JMP STAT,I RETURN * SKP * * ROUTINE TO DO CHECKING OF INPUT DATA * * CALLING SEQUENCE: * IF 'TRACE' MODE, LOAD (A) WITH DRIVER STATE NUMBER * JSB CHECK * WILL RETURN P+1 TIME OUT * P+2 STOP RECEIVED * P+3 REQUEST COMING RECEIVED * X P+4 NORMAL RETURN...B REG= LAST DATA WORD * CHECK NOP LDB EQTX EQT EXTENSION ADDRESS INB LDB 1,I LOAD LAST WORD RECEIVED IFZ STA STATE SAVE (TRACE VERSION ONLY) # XIF LDA EQT4,I WAS THIS ENTRY # AND .040 VIA # SZA TIME-OUT? # JMP CHCK1 YES, DATA IN (B) # * * THERE WAS NO TIMEOUT. CLEAR 'COUNT' WORD * SO WE DON'T THINK THERE WAS A TIME-OUT, * DISABLE CARD, AND PICK UP DATA DIRECTLY FROM * INTERFACE CARD. STA COUNT CLCC1 CLC 0,C LIB1 LIB 0 CHCK1 EQU * # IFZ # CH.00 NOP CHANGED TO 'RSS' WHEN TRACING IS ENABLED # JMP CHEC0 SKIP OVER 'TRACE' CODE WHEN NOT ENABLED # STB RDD.C SAVE FOR JUST A SECOND # JSB CKTRC SHOULD WE TRACE THIS ONE? # JMP CHEC. NO, DON'T TRACE THIS ONE. # LDB RDD.C RECOVER RECEIVED WORD # JSB TRACE STORE IN TRACE TABLE # LDB STATE RECOVER DRIVER STATE # RBL MOVE TO 'STATE' FIELD # LDA COUNT WAS THERE A # CCE,SZA A TIME-OUT? # INB # RBL,ERB AND SET 'RECEIVE' INDICATOR BIT # JSB TRACE STORE TRACE/EVENT # LDB EQT1 STORE EQT ADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # * # CHEC. LDB RDD.C RECOVER RECEIVED DATA WORD # CHEC0 EQU * : # XIF LDA COUNT MICROCODE COUNT # SZA,RSS DID MICROCODE FINISH? # JMP CHEC1 YES. # LDA EQT4,I NO. CHECK FOR POSSIBLE RTE TIME-OUT # AND .040 ISOLATE T.O. BIT # SZA TIME-OUT? # JMP CHECK,I YES, TAKE TIME-OUT RETURN # SPC 2 * * CHEC1 ISZ CHECK SET FOR 'STOP' RETURN # CPB STOP 'STOP'? # JMP CHECK,I YES...TAKE 'STOP' RETURN # ISZ CHECK # CPB RC REQUEST COMING? # JMP CHECK,I YES # ISZ CHECK SET "NONE OF THE ABOVE" RETURN # JMP CHECK,I RETURN # * * * B10 OCT 10 B20 OCT 20 B17 OCT 17 .040 OCT 4000 BSTMK OCT 12100 B1774 OCT 177400 B1776 OCT 177600 TEMP NOP MIC$X NOP OPEN LOOP MICROPROGRAM CALL COUNT NOP EQTX NOP SKP * ROUTINE TO CLEAR CARD * RDD.C NOP CLCC2 CLC 0,C LIAC2 LIA 0,C CLEAR STATUS LIA2 LIA 0 READ DATA WORD CLA JMP RDD.C,I * * HERE TO SEND WORD AND EXIT IN TRANSMIT MODE XMITX NOP JSB OUTPB SEND WORD JSB TRAPR SETUP TRAP CELL STC0 STC 0 SET TRANSMIT MODE LDA XMITX COROUTINE UPON RETURN STA EQT11,I DEXIT ISZ CA65 BUMP CONTINUATION RETURN JMP CEXT4 * OUTPB NOP IFZ OTB2 NOP 'RSS' WHEN TRACE MODE IS ENABLED # JMP OTB1 RETURN IMMEDIATELY IF TRACE DISABLED. # STB RDD.C SAVE (B) FOR A FEW LINES.... # JSB CKTRC SHOULD WE BE TRACING THIS ONE? # JMP OTB3 NO, DON'T TRACE THIS ONE. # LDB RDD.C RECOVER (B) REGISTER # JSB TRACE STORq]E OUTPUT WORD # RAL MOVE TO 'STATE' FIELD # LDB A LOAD EVENT # JSB TRACE STORE EVENT IN TRACE TABLE # LDB EQT1 STORE EQT ADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # OTB3 EQU * # LDB RDD.C RECOVER DATA TO BE TRANSMITTED # XIF OTB1 OTB 0 JMP OUTPB,I RETURN * RC OCT 170017 REQUEST COMING WORD TNW OCT 170360 TRANSMIT NEXT WORD STOP OCT 7760 SEND STOP RLW OCT 7417 RETRANSMIT LAST WORD RLM OCT 170377 RETRANSMIT LAST MESSAGE B2 OCT 2 B4 OCT 4 B7 OCT 7 N5 DEC -5 N6 DEC -6 N7 DEC -7 SKP *############################################################################ * * TRACE SECTION * * TRAC.-- SECTION TO SET UP TRACE BUFFER. * IFZ TRAC. EQU * LDA EQT7,I GET TRACE BUFFER ADDRESS STA NPASS SAVE ADDRESS OF PASS COUNT STA B COMPUTE ADDRESS ADB EQT8,I OF END OF BUFFER + 1 STB TRACL SAVE ADDRESS OF END OF BUFFER INA GET ADDRESS OF 2ND WORD OF TRACE BUFFER STA TRPTR STORE POINTER TO NEXT AVAILABLE LOCN INA BUMP TO START OF TRACE BUFFER STA TRACB SAVE TRACE BUFFER LDB EQT9,I GET TRACE SELECTION SZB TRACE ALL? LDB EQT1 NO, TRACE ONLY THIS LU STB TREQT SAVE TRACE EQT, OR ZERO FOR ALL LDB EQT10,I LOAD RESOURCE NUMBER STB RN# SAVE IT. SPC 2 * ENABLE TRACE MODE. * ETRAC EQU * CHECK THAT BUFFER HAS BEEN DEFINED CLB,INB LDA TRACB LOAD BUFFER ADDRESS SZA,RSS WAS ONE DEFINED? JMP REJCT NO, THIS IS AN ERROR STA TRACN  YES, INITIALIZE "NEXT" TRACE ENTRY PNTR LDA RSS STORE 'RSS' INSTRUCTION IN ALL TRA.3 EQU * "BYPASS TRACE CODE" PLACES. STA OTB2 STA CH.00 STA CH.01 * * "IMMEDIATE COMPLETION" RETURN TO RTIOC * LDA B4 JMP IA65,I RETURN TO RTE SPC 2 * DISABLE TRACE MODE * DTRAC EQU * CLA STORE 'NOP' INSTRUCTION IN ALL "BYPASS TRACE JMP TRA.3 CODE" PLACES. * * SUBROUTINE TO CHECK WHETHER WE SHOULD BE * TRACING THIS ENTRY OR NOT. * CKTRC NOP LDB TREQT LOAD THE 'TRACE' EQT SZB TRACE ALL? CPB EQT1 NO, COMPARE TO THIS EQT ISZ CKTRC WE'RE TRACING THIS ONE! JMP CKTRC,I RETURN TO CALLER SKP * * TRACE -- SUBROUTINE TO MAKE AN ENTRY IN THE TRACE TABLE * * CALLING SEQUENCE: * LDB * JSB TRACE * * TRACE NOP ENTRY/EXIT STB TRACN,I STORE DATA IN TRACE BUFFER LDB TRACN ADVANCE TO NEXT ENTRY, OR INB CPB TRACL END? JMP TRAND YES, RESET TO START & UNLOCK RN TRA.1 EQU * STB TRACN STORE "NEXT" ENTRY POINTER CMB,INB COMPUTE RELATIVE OFFSET ADB TRACB SO BACKGROUND PROGRAM CMB,INB STB TRPTR,I KNOWS WHERE WE ARE. JMP TRACE,I RETURN TO CALLER SPC 2 TRAND EQU * LDA RN# LOAD RESOURCE NUMBER JSB $CGRN UNLOCK RESOURCE NUMBER ISZ NPASS,I BUMP PASS NUMBER NOP PROTECT AGAINST ROLLOVER. LDB TRACB JMP TRA.1 RETURN TO MAIN FLOW * * STORAGE FOR 'TRACE' * STATE NOP STORAGE FOR DRIVER STATE TREQT NOP EQT ADDRESS TO BE TRACED, OR 0 FOR ALL OF THEM TRPTR NOP STORAGE FOR ADDRESS OF "NEXT" ENTRY IN BUFFER NPASS NOP ADDRESS OF NUMBER OF PASSES COUNTER RN# NOP RESOURCE NUMBER TRACB NOP POINTER TO START Ot7F TRACE BUFFER TRACN NOP POINTER TO NEXT TRACE TABLE ENTRY TRACL NOP POINTER TO END OF TABLE + 1 B11 OCT 11 B12 OCT 12 B13 OCT 13 B14 OCT 14 B15 OCT 15 B16 OCT 16 B21 OCT 21 B22 OCT 22 B23 OCT 23 B24 OCT 24 B25 OCT 25 B26 OCT 26 B27 OCT 27 B30 OCT 30 B31 OCT 31 B32 OCT 32 B33 OCT 33 B34 OCT 34 RSS RSS 'RSS' INSTRUCTION SBIT OCT 100000 SIGN BIT XIF B5 OCT 5 *######################################################################## SKP SETIO NOP LDA EQT12,I EQT STATUS AND MICFG CLEAR MICROCODE R/W & RETRY FLAGS STA EQT12,I UPDATED EQT LDB EQT2,I CLA SSB SYSTEM TRYING TO INITIATE NEW REQUEST? CCA YES, SET A TICK STA EQT15,I SET TIMEOUT LDB EQT13,I STB EQTX SAVE ADDRESS OF EQT EXTENSION LDA EQT4,I AND B77 ISOLATE SELECT CODE STA CELL SAVE FOR TRAP CELL ADDR IOR CLCC CLC0,C COMMAND STA CLCC1 STA CLCC2 XOR .040 CONVERT TO STC 0,C COMMAND STA LISTI STA CEXT2 XOR .010 CONVERT TO STC 0 COMMAND STA STC0 XOR B200 CONVERT TO LIA COMMAND STA LIA2 XOR .010 CONVERT TO LIA 0,C COMMAND STA LIAC2 XOR .050 CONVERT TO LIB COMMAND STA LIB1 XOR B300 CONVERT TO OTB 0 COMMAND STA OTB1 JMP SETIO,I RETURN * * MICFG OCT 117777 CLCC CLC 0,C B200 OCT 200 B300 OCT 300 .050 OCT 5000 * BSS 0 SEE HOW BIG IT IS SKP * * DEFINE BASE PAGE LOCATIONS NEEDED * * * . EQU 1650B EQT1 EQU .+8 EQT2 EQU .+9 EQT4 EQU .+11 EQT5 EQU .+12 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 DUMMY EQU 1737B INTBA EQU 1654B TBG EQU 1674B * A EQU JNLH0 B EQU 1 END EN =] 91741-18001 2013 S C0222 &DVG67              H0102 qbASMB,Q,C HED DVG67 RTE 12889 PHYSICAL LEVEL DRIVER * (C) HEWLETT-PACKARD NAM DVG67,0,0 91741-16001 REV 2013 791026 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT IG67,CG67,EQTAD,HREC,HSND,HCONT EXT $CGRN SPC 1 ************************** DVG67 ************************** * * * SOURCE: 91741-18001 * * * * BINARY: 91741-16001 * * * * TOM KEANE * * * * JUNE 24, 1976 * * * *********************************************************** * * * MODIFIED BY DMT BEGINNING 5/29/79 TO REMOVE UNUSED CODE * * AND MAKE THE COMMENTS READABLE. * * * *********************************************************** SPC 2 A EQU 0 B EQU 1 SC EQU 0 CHAN EQU 1673B SPC 1 * * * THE FOLLOWING DRIVER WAS WRITTEN FOR A DOS III * * PHYSICAL LEVEL DRIVER. * * * * RTE EQT TABLE AND INTERNAL STORAGE NAME EQT01 EQU 1660B EQT04 EQU 1663B STAT1 EQT05 EQU 16C64B STAT2 EQT06 EQU 1665B CONWD EQT07 EQU 1666B PARM1 EQT08 EQU 1667B PARM2 EQT09 EQU 1670B EQT13 EQU 1772B TRLOG EQT15 EQU 1774B SKP **************************************************** * * * CONTINUATOR SECTION * * * **************************************************** * MODIFIED TO CHECK FOR SPURIOUS INTERRUPT BY DMT (7/11/78) CG67 NOP LDB EQT01,I SPURIOUS SZB,RSS INTERRUPT? JMP SPURI YES--IGNORE. SPRTN CLB ZERO RETURN STB SAVA CODE. STA SCODE SAVE SELECT CODE. JSB INTON TEST INTERRUPT SYSTEM. CLA,INA SET RETURN STA RTX FLAG. LDA EQT04,I WAS IT ALF TIMER SSA,RSS INTERRUPT? JMP WEND NO. LDA EQT04,I YES. RESET AND PAROF TIMER STA EQT04,I BIT. JMP LTIM JUMP TO TIMER ROUTINE. * WEND LDB LSIT GET TABLE BASE. JMP LSWCH GO PROCESS. SPC 2 * SPURIOUS INTERRUPT-- SPURI LDB SWORD IF WE'RE EXPECTING SZB AN ENQ, JMP SPRTN NOT SPURIOUS. SPUR2 STB EQT15,I ZERO TIME-OUT CLOCK WORD. * * KEEP LONG-TERM COUNT FOR # OF SPURIOUS INTERRUPTS * IN UNUSED "# ERROR-FREE MSGS RECEIVED" EQT EXTENSION WORD. * LDB P65$ BUMP JSB BUMP STATISTIC. ISZ CG67 MAKE A JMP CG67,I CONTINUATION RETURN. SKP **************************************************** * * * INITIATOR SECTION * * * **************************************************** IG67 NOP CLB STB RTX CLEAR RETURN FLAG. STB SAVA ZERO RETURN CODE. STA SCODE SAVE SELECT CODE. JSB INTON TEST INTERRUPT SYSTEM. LDA EQT09,I GET REQUEST. AND MASK1 ISOLATE FUNCTION AND REQUEST. CPA INCD INITIALIZE REQUEST? JMP I.67B YES. AND MASK2 CPA B4400 CLEAR REQUEST? JMP I.67A YES. LDB EXTSN SZB LOGICAL LINKAGE PRESENT? JMP I.67A YES. CLA,INA NO. INVALID REQUEST. STA SAVA RETURN TO JMP RTRN SYSTEM. * * HANDLE INITIALIZE REQUEST I.67B LDB EQT07,I GET EXTENSION ADDRESS. STB EXTSN LINK WITH LOGICAL. CLA STA STAT2 CLEAR LINE STATE STA CONWD AND TEST BITS. * I.67A LDB EQT05,I SET UP STB STAT1 INTERNAL LDB EQT07,I EQT STB PARM1 VALUES. LDB EQT08,I STB PARM2 LDB EQT13,I STB TRLOG LDA EXTSN SET UP INA EQT STA TSBTS EXTENSION ADA P03$ TOO. LDB A,I STB DEQ22 INA LDB A,I STB DEQ23 INA LDB A,I STB DEQ24 LDA CONWD GET DMA AND DMAMF CHANNEL IOR DMAA AND LDB CHAN SET SLB ALLOCATED IOR DMAM FLAG. STA CONWD LDA STAT1 SET AND LBYT$ STATUS STA STAT1 TO ZERO. LDA SCODE GET SELECT CODE. JSB SETIO SET I/O INSTRUCTIONS. LDA EQT09,I GET CONTROL WORD. AND MASK2 ISOLATE FUNCTION CODE. CPA B4400 CLEAR REQUEST? JMP C0 YES. LDA EQT06,I GET CURRENT I/O WORD. AND B17$ ISOLATE BITS 0-3. CPA P02$ WRITE OR CONTROL REQUEST? JMP TWOPR YES. CHECK OPTIONAL PARAM. * CPA P01$ READ REQUEST? JMP READR YES. ISZ SAVA INDICATE ERROR JMP RTRN AND RETURN TO SYSTEM. * * BECAUSE RTE CONTROL REQUESTS CANNOT PASS ENOUGH PARAMETERS, * SOME WRITE REQUESTS MAY ACTUALLY BE CONTROL. REQUESTS. * TWOPR LDA EQT09,I GET OPTIONAL PARAMETER. AND N64$ REMOVE LOGICAL UNIT. IOR P02$ INSERT REQUEST CODE. STA EQT06,I STORE IN CONTROL WORD. AND BIT14 IF BIT 14 IS SET, SZA IT'S A CONTROL JMP CONTL REQUEST. SPC 2 **************************************************** * * * WRITE REQUEST INITIATION * * * **************************************************** STA SWORD CLEAR "WAITING FOR ENQ" FLAG. CCB INDICATE INITIATION CALL. JSB DEQ23,I CALL LOGICAL WRITE (HSLC). JMP DONE COMPLETION RETURN. JSB SETMR CONTINUATION RETURN. JMP RTRN RETURN TO SYSTEM. SKP **************************************************** * * * READ REQUEST INITIATION * * * **************************************************** READR LDA EQT09,I GET CONTROL WORD. AND N64$ REMOVE LOGICAL UNIT. IOR P01$ INSERT REQUEST CODE. STA EQT06,I STORE CONROL WORD TO SYSTEM. AND MASK2 IS IT THE CPA B4500 SPECIAL READ? JMP SPECR YES. * CCB INDICATE INITIATION CALL. CLA,INA JSB DEQ22,I CALL LOGICAL READ (HSLC). JMP DONE COMPLETION RETURN. JSB SETMR CONTINUATION RETURN. JMP RTRN RETURN TO SYSTEM. * SPECR STA SWORD SET SPECIAL CASE. LDA PARM1,I GET RN PARAMETER. STA RNUMB STORE. JSB RDMA INHIBIT DMA INTERRUPTS. LDA IO05A START STA STDMA INSTRUCTION. LDA RECV LINE STATE STA STAT2 EQUALS RECEIVE. JSB READP ENABLE INTERFACE. JMP DONE1 IMMEDIATE COMPLETION. SKP ************************************************C**** * * * CONTROL REQUEST INITIATION * * * **************************************************** CONTL LDA EQT06,I CURRENT I/O WORD. XOR CONOF SET BIT 14 OFF, 1 ON. STA EQT06,I RESTORE SYSTEM CONTROL WORD. CLA CCB INDICATE INITIATION CALL. JSB DEQ24,I CALL LOGICAL CONTROL (HSLC). JMP DONE1 COMPLETION RETURN. LDA EQT06,I GET CONTROL WORD. ALF,ALF ISOLATE RAL,RAL FUNCTION AND B77$ CODE. ADA N04$ FUNCTION LESS SSA,RSS THAN FIVE? JMP CNTL1 NO. INVALID. ADA CNTLT YES. CALCULATE LDA A,I TABLE ADDRESS. JMP A,I PROCESS BY FUNCTION CODE. SPC 1 * INVALID REQUEST CNTL1 ISZ STAT1 INDICATE INVALID JMP DONE1 REQUEST AND RETURN. SPC 3 *--------------------------------------------------+ * CONTROL TRANSFER TABLE ! *--------------------------------------------------+ DEF C0 CLEAR DEF DONE1 INITIALIZE(NO ADDITIONAL PROCESS) DEF C2 LINE OPEN DEF C3 LINE CLOSE CNTLT DEF * SPC 1 *--------------------------------------------------+ * CLEAR REQUEST ! *--------------------------------------------------+ C0 JSB CLC.C CLEAR INTERFACE. JSB RDMA RELEASE DMA. CLA BREAK STA EXTSN LINKAGE. LDA IDLE LINE STATE STA STAT2 EQUALS IDLE. JMP DONE1 RETURN. SPC 1 *--------------------------------------------------+ * LINE OPEN REQUEST ! *--------------------------------------------------+ C2 LDA TSBTS,I GET TEST BITS. RAL PRIMARY SSA STATION? JSB SETBT YES. SET INDICATOR. LDA AOPEN LINE STATE STA STAT2 EQUALS OPEN. JMP DONE1 RETURN. * SETBT NOP LDA CONWD GET TEST BITS. IOR BIT10 SET PRIMARY STATION. STA CONWD STORE WORD. JMP SETBT,I SPC 1 *--------------------------------------------------+ * LINE CLOSE REQUEST ! *--------------------------------------------------+ C3 JSB CLC.C CLEAR INTERFACE. JSB RDMA RELEASE DMA. LDA CLOSE LINE STATE STA STAT2 EQUALS CLOSED. JMP DONE1 RETURN. SPC 3 ******************************************************** * * * ENTER HERE IF HSLC INDICATED COMPLETION FROM READ, * * WRITE, OR CONTROL INITIATION. (P+1 RETURN) * * * ******************************************************** * DONE LDA IDLE SET LINE STATE STA STAT2 TO IDLE. LDA RTX IF FROM INITIATOR, SZA DO IMMEDIATE COMPLETION. JMP RTRN * DONE1 LDA P04$ INDICATE IMMEDIATE STA SAVA COMPLETION. JMP RTRN RETURN TO SYSTEM. SKP ************************************************ * * * LOGICAL TIMER * * * ************************************************ LTIM LDB LSTT GET TABLE BASE. * LSWCH ADB STAT2 PROCESS LDB B,I BY LINE JMP B,I STATE. SPC 2 *--------------------------------------------------+ * LOGICAL STATE TABLE FOR TIMER ! *--------------------------------------------------+ LSTT DEF *+1 DEF RTRN 0-CLOSED DEF RTRN 1-AWAITING OPEN DEF RTRN 2-IDLE DEF LSTC 3-RECEIVE DEF LSTD 4-CONTROL DEF LSTE 5-SEND DEF LSTE 6-SEND TO RECEIVE SPC 2 *--------------------------------------------------+ * LOGICAL STATE TABLE FOR CONTINUATION ! *--------------------------------------------------+ LSIT DEF *+1 DEF RTRN 0-CLOSED DEF RTRN 1-AWAITING OPEN DEF RTRN 2-IDLE DEF LSIC 3-RECEIVE DEF LSID 4-CONTROL DEF LSIE 5-SEND DEF LSIF 6-SEND TO RECEIVE SKP **************************************************** * * * SET UP I/O INSTRUCTIONS * * * **************************************************** SETIO NOP ADA ISTCC FORM STC INSTRUCTION STA IO07 STA IO08 STA IO09 STA IO10 ADA ICLCC FORM CLC INSTRUCTION STA XIO02 ADA IOTA FORM OTA INSTRUCTION STA XIO03 ADA ILIA FORM LIA INSTRUCTION STA XIO05 ADA ISTF FORM STF INSTRUCTION STA IO06 * * CONFIGURE DMA LOW SC INSTRUCTIONS * LDB P02$ LDA CONWD AND DMAM SZA INB ADB ISTCC STB IO02 ADB ICLCC STB IO00 ADB IOTA STB IO01 STB IO03 ADB ILIA STB IO15 * * CONFIGURE DMA HI SC INSTRUCTIONS * ADB .ISTC STB IO05 ADB ICLCC STB IO05A STB IO05B ADB IOTA STB IO04 ADB ISTF0 STB IO13 STB IO14 JMP SETIO,I SKP **************************************************** * * * SET RTE TIMER * * * * B=TIME (CENTISECONDS) * * <0-INITIATE/UPDATE VALUE * * =0-NO REQUEST * * >0-CANCEL REQUEST * * * **************************************************** SETMR NOP STB EQT15,I STORE TIMER COUNT. LDA EQT04,I TELL SYSTEM IOR BIT12 WE WILL SERVICE STA EQT04,I TIMER INTERRUPTS. JMP SETMR,I RETURN. SPC 2 **************************************************** * * * START READ * * * * A-REG = ADDRESS, B-REG = BYTE COUNT * * * **************************************************** HREC NOP STA ADDR STORE OFF STB LNGTH PARAMETERS. LDB HREC,I GET TIMER PARAMETER. ISZ HREC IF TIMER REQUESTED, SZB JSB SETMR GO SET IT. LDA RECV LINE STATE STA STAT2 EQUALS RECEIVE. JSB RDMA RELEASE DMA. LDA ADDR GET BOTH LDB LNGTH PARAMETERS. BRS CHANGE BYTES TO WORDS. IOR BIT15 SET INPUT. JSB INDMA SET UP DMA. SZB,RSS DO NOT START JMP NONDM IF LENGTH = 0. LDA IO05 FOR DMA STA STDMA TRANSFER LDA CONWD SET BIT INDICATING IOR DMAA WE ARE USING STA CONWD DMA. LDA IO05A STA STDMA+1 JMP DMARD * NONDM JSB RDMA INHIBIT DMA INTERRUPTS. LDA IO05A START INSTRUCTION. STA STDMA * DMARD JSB READP LDA SWORD SPECIAL SZA,RSS CASE? JMP CRTN CONTINUATION RETURN TO SYSTEM. CLA RESET STA SWORD SPECIAL CASE FLAG. LDA EBIT EOT SZA,RSS RECEIVED? JMP ENQR NO. FAKE ENQ. CLA YES. CLEAR STA EBIT TEST WORD. JMP EOTR FAKE EOT. SPC 1 INDMA NOP IO00 CLC DMAL,C INITIALIZE DMA ROUTINE. IO01 OTA DMAL SET ADDRESS. IO02 STC DMAL,C LDA B SET COUNT. IOB03 OTA DMAL LDA SCODE SET SELECT CODE. IO04 OTA DMAH JMP INDMA,I RETURN. SPC 2 **************************************************** * * * START WRITE * * * * A-REG = ADDRESS, B-REG = BYTE COUNT * * * **************************************************** HSND NOP STA ADDR STORE STB LNGTH PARAMETERS. LDB HSND,I TIMER ISZ HSND PARAMETER? SZB JSB SETMR YES. SET TIME. LDA SEND LINE STATE STA STAT2 EQUALS SEND. IO07 STC SC,C SET INTERFACE CONTROL WORD. LDA TCWD1 JSB OTA JSB RDMA RELEASE DMA. LDA ADDR INITIALIZE DMA LDB LNGTH AND SET STB TRLOG XLOG. BRS CHANGE BYTES TO WORDS. JSB INDMA INITIALIZE DMA. SZB,RSS DO NOT START JMP NODMW IF LENGTH = 0. LDA CONWD SET BIT INDICATING IOR DMAA WE ARE USING STA CONWD DMA. IO05 STC DMAH,C START DMA. IO05A CLC DMAH,C IO06 STF SC START TRANSFER. JMP CRTN CONTINUATION RETURN TO SYSTEM. * NODMW JSB RDMA INHIBIT DMA INTERRUPTS. JMP IO05A RETURN. SPC 3 **************************************************** * * * WRITE ONE WORD OUT * * CONTROL REQUEST * * * **************************************************** HCONT NOP STA ADDR STORE ISZ HCONT PARAMETER. LDA CNTRR LINE STATE STA STAT2 EQUALS CONTROL. JSB RDMA INHIBIT DMA INTERRUPTS. IO10 STC SC,C SET INTERFACE CONTROL WORD. LDA TCWD5 JSB OTA LDA ADDR,I GET CHARACTER. JSB OTA JMP CRTN CONTINUATION RETURN TO SYSTEM. SPC 2 *--------------------------------------------------+ * CONTROL INTERRUPT ! *--------------------------------------------------+ LSID CLA,RSS NORMAL COMPLETION. * LSTD LDA P15$ TIMEOUT. JMP HCONT,I RETURN TO LOGICAL. SPC 2 *--------------------------------------------------+ * SEND INTERRUPT ! * WRITE END OF TEXT ! *--------------------------------------------------+ LSIE JSB RDMA RELEASE DMA. LDA TCWD3 END OF TEXT. JSB CLC.C SEND ETX. JSB OTA LDA TRLOG MODIFY CMA,INA AND B17$ ETX ALF,ALF BY ALF BYTE IOR ETX COUNT. JSB OTA JSB WAIT LDA TCWD4 SEND CRC. JSB CLC.C JSB OTA JSB OTA DUMMY WORD. JSB WAIT LDA S2R LINE STATE EQUALS STA STAT2 SEND TO RECEIVE. LDA IO05A INHIBIT DMA. STA STDMA START INSTRUCTION. JSB READP READ GARBAGE CHARACTER. LSIF CLA RETURN TO CLB LOGICAL. JMP HSND,I COMPLETION. * LSTE LDA P15$ TIMEOUT. JMP HSND,I RETURN TO LOGICAL. SPC 1 * WAIT NOP SUBROUTINE TO WAIT LDA DELAY SEVERAL MICRO-SECONDS CHK SLA,RAR SO HP3000 WON'T JMP WAIT,I MISS ANY DATA. JMP *+1,I DEF CHK SPC 2 *--------------------------------------------------+ * ENABLE INTERFACE TO READ ! *--------------------------------------------------+ READP NOP LDA RCWD1 SET CONTROL WORD. JSB CLC.C JSB OTA JSB LIA READ 1 OR 2 JSB LIA DATA WORDS. IO08 STC SC,C SET CONTROL, CLEAR FLAG, JSB LIA AND CLEAR THE STATUS WORD. STDMA NOP [OVERLAY WITH START DMA INST.] NOP [OVERLAY WITH CLC DMAH.] CLA CLEAR THE START DMA INST. STA STDMA STA STDMA+1 JMP READP,I RETURN TO CALLER. SPC 2 *--------------------------------------------------+ * PROCESS END OF TEXT ! *--------------------------------------------------+ PETX EQU * IO14 STF DMAH INHIBIT DMA XFERS. IO15 LIA DMAL GET CHARACTER COUNT. STA MOD16 SAVE IT. JSB WAIT WAIT FOR HP 3000. JSB CLC.C READ STATUS JSB LIA WORD. JSB LIA READ CRC WORD. LDA TCWD4 TRANSMIT JSB CLC.C CRC JSB OTA TO JSB OTA CHECK IT. JSB WAIT JSB CLC.C READ STATUS & JSB LIA CHECK AND P02$ ERROR SZA BITS. JMP BTEXT CRC ERROR. LDA MOD16 CHECK MODULO COUNT. LDB LNGTH NEGATIVE BYTE COUNT. CMB,INB MAKE IT POSITIVE BRS WORDS. STB LNGTH ADA LNGTH ADD WORD COUNT. ALS MAKE POSITIVE BYTES. STA TRLOG STORE IN XMISSION LOG. ALF,ALF ALF XOR XTE AND NIB3 MASK FOR ERROR. SZA JMP BTEX1 JSB RDMA RELEASE DMA. LDA P10$ GOOD TEXT. JMP HREC,I RETURN TO LOGICAL. * BTEXT LDA P11$ CRC ERROR. JMP LRTN RETURN TO LOGICAL. * * BTEX1 LDA P12$ TEXT UNDERRUN. JMP LRTN RETURN TO LOGICAL. SPC 2 *-----------------------------------------------------+ * RECEIVE INTERRUPT ! *-----------------------------------------------------+ LSIC LDA SCODE ADA N08$ IGNORE SSA DMA JMP CRTN INTERRUPTS. JSB CLC.C READ INTERRUPT. JSB LIA TAG1 WORD? SLA NO, JUST DATA WORD. JMP RTAG1 YES. WENDC STC SC,C REENABLE INTERFACE. KJSB LIA JSB LIA JMP CRTN CONTINUATION RETURN TO SYSTEM. * RTAG1 JSB LIA LOAD TAG1 WORD. STA XTE SAVE CHARACTER. AND MASK0 CLEAR HI-ORDER BIT. CPA ACK0 CHARACTER = JMP ACK0R ACK0 CPA ENQ CHARACTER = JMP ENQR ENQ CPA EOT CHARACTER = JMP EOTR EOT CPA ACK1 CHARACTER = JMP ACK1R ACK1 CPA WACK CHARACTER = JMP WACKR WACK CPA RVI CHARACTER = JMP RVIR RVI CPA NAK CHARACTER = JMP NAKR NAK CPA DEOT CHARACTERS = JMP DEOTR DLE EOT CPA TTD CHARACTERS = JMP TTDR STX ENQ/ABORTED TEXT AND MASK1 HI-ORDER BITS. CPA ETX CHARACTER = JMP PETX ETX/PROCESS CRC JMP BTEXT NO RECOGNIZABLE CHARACTERS. XTE OCT 0 IO09 EQU WENDC SPC 1 ACK0R CLA,INA JMP LRTN SPC 1 ACK1R LDA P02$ JMP LRTN SPC 1 WACKR LDB P10$ BUMP WACK/TTD JSB BUMP LONG-TERM STAT. LDA P03$ JMP LRTN SPC 1 RVIR LDA P04$ JMP LRTN SPC 1 ENQR LDA P05$ LDB SWORD WAITING FOR SZB,RSS LINE BID? JMP HREC,I NO. TAKE LOGICAL RETURN. JMP SCASE YES. SPECIAL CASE. SPC 1 NAKR LDB P05$ BUMP NAK JSB BUMP LONG-TERM STAT. LDA P06$ JMP LRTN SPC 1 EOTR LDA P07$ LDB SWORD WAITING FOR SZB,RSS LINE BID? JMP HREC,I NO. TAKE LOGICAL RETURN. STA EBIT SET EOT RECEIVED. * SCASE LDA RNUMB UNLOCK RN. JSB $CGRN CLA,INA STA TRLOG JMP CRTN CONTINUATION RETURN TO SYSTEM. SPC 1 DEOTR LDA P08$ JMP LRTN SPC 1 TTDR LDA P09$ JMP LRTN SPC 2 LSTC LDA P15$ TIMEOUT. JMP HREC,I RETURN TO LOGICAL. SPC 3 * IF DVG67 WAS IN "SPECIAUNLHL READ" STATE (WAITING FOR LINE BID) AND * SOMETHING OTHER THAN ENQ OR EOT CAME DOWN THE LINE, HANDLE AS A * SPURIOUS INTERRUPT. OTHERWISE RETURN TO LOGICAL DRIVER. * LRTN LDB SWORD WAS DRIVER WAITING SZB,RSS FOR LINE BID (ENQ)? JMP HREC,I NO. RETURN TO LOGICAL. CLB YES. TREAT AS A JMP SPUR2 SPURIOUS INTERRUPT. ;N SKP ******************************************************* * * * INTERFACE COMMANDS * * * ******************************************************* CLC.C NOP XIO02 CLC SC,C JMP CLC.C,I SPC 1 OTA NOP XIO03 OTA SC JMP OTA,I SPC 1 LIA NOP XIO05 LIA SC JMP LIA,I SPC 4 **************************************************** * * * COMMON RETURN * * * **************************************************** * * CONTINUATION RETURN AT CRTN; COMPLETION AT RTRN * CRTN ISZ CG67 INCREMENT FOR CONTINUATION. * RTRN LDA STAT1 GET SLC STATUS. STA EQT05,I LDB TRLOG GET TRANSMISSION LOG. LDA RTX DETERMINE SZA,RSS RETURN TYPE. JMP RTRN1 IG67. * LDA SAVA COMPLETION STATUS. ISZ IFLAG IF INTERRUPT SYSTEM ON, STF 0 ENABLE INTERRUPTS. JMP CG67,I RETURN TO SYSTEM. * RTRN1 LDA SAVA ISZ IFLAG STF 0 JMP IG67,I SKP * SUBROUTINE TO BUMP LONG-TERM STATISTIC. * CALLING SEQUENCE: LDB * JSB BUMP * BUMP NOP ENTRY. ADB EXTSN ADD BASE ADDRESS. ISZ B,I BUMP IT. NOP IN CASE OF ROLL-OVER. JMP BUMP,I RETURN. SPC 4 * * SET "INTERRUPT ON" FLAG * INTON NOP CCB ASSUME ON. SFC 0 IF NOT, CLB USE 0. STB IFLAG STORE INTERRUPT FLAG. JMP INTON,I SPC 2 * * DMA IS NOT REQUIRED. INHIBIT IT. * RDMA NOP LDA CONWD CLEAR DMA AND DMAA IF CHANNEL SZA,RSS IS JMP RDMA1 ALLOCATED. IO05B CLC DMAH,C IO13 STF DMAH RDMA1 LDA x8CONWD AND DMAMF STA CONWD JMP RDMA,I SKP **************************************************** * * * STORAGE & CONATANTS * * * **************************************************** SPC 1 * INTERNAL EQT VALUES. *ENTRIES ARE IN DOS-III ORDER. SOME ARE NOT USED, BUT ARE NEEDED AS *PLACE HOLDERS FOR HSLC. THEY DO DOUBLE-DUTY AS VARIABLE LOCATIONS. * EQTAD DEF *+1 BASE ADDRESS FOR EQT .EQ1 NOP .EQ2 NOP .EQ3 NOP STAT1 NOP STATUS STAT2 NOP LINE STATE CONWD NOP I/F CONTROL WORD .EQ7 NOP .EQ8 NOP .EQ9 NOP PARM1 NOP PARAMETER 1 PARM2 NOP PARAMETER 2 .EQ12 NOP .EQ13 NOP TRLOG NOP TRANSMISSION LOG .EQ15 NOP .EQ16 NOP EXTSN NOP EXTENSION LINK TSBTS NOP BOARD PARAMETERS DEQ22 NOP LOGICAL READ ADDRESS DEQ23 NOP LOGICAL WRITE ADDRESS DEQ24 NOP LOGICAL CONTROL ADDRESS ADDR NOP ADDR PARAMETER FOR HREC, HSND & HCONT LNGTH NOP LENGTH PARAMETER FOR HREC, HSND & GTEXT SPC 2 EBIT EQU .EQ1 IFLAG EQU .EQ2 MOD16 EQU .EQ3 RNUMB EQU .EQ7 RTX EQU .EQ8 SAVA EQU .EQ9 SCODE EQU .EQ12 SWORD EQU .EQ16 SPC 2 N04$ DEC -4 N08$ DEC -8 P00$ DEC 0 P01$ DEC 1 P02$ DEC 2 P03$ DEC 3 P04$ DEC 4 P05$ DEC 5 P06$ DEC 6 P07$ DEC 7 P08$ DEC 8 P09$ DEC 9 P10$ DEC 10 P11$ DEC 11 P12$ DEC 12 P15$ DEC 15 P65$ DEC 65 P67$ DEC 67 P72$ DEC 72 B17$ EQU P15$ B77$ OCT 77 B4400 OCT 4400 B4500 OCT 4500 LBYT$ OCT 177400 BIT15 OCT 100000 BIT14 OCT 40000 BIT12 OCT 10000 BIT11 OCT 4000 BIT10 OCT 2000 BIT9 OCT 1000 BIT6 OCT 100 N64$ OCT 177700 ACK0 OCT 2176 ACK1 OCT 4176 AOPEN EQU P01$ CLOSE EQU P00$ CNTRR EQU P04$ CONOF OCT 40001 DELAY EQU BIT15 DEOT OCT 16177 DMAA EQU BIT9 DMAMF OCT 172777 DMAM EQU BIT11 DMAL EQU 0 DMAH EQU 0 ENQ OCT 77776 EOT OCT 1176 ETX OCT 1775 ICLCC EQU BIT11 IDLE EQU P02$ ILIA EQU N64$ IOTA OCT 172700 INCD EQU P67$ ISTCC OCT 103700 .ISTC OCT 1204 ISTF EQU LBYT$ ISTF0 OCT 177300 MASK0 OCT 77777 MASK1 OCT 7777 MASK2 OCT 7700 NIB3 OCT 170000 NAK OCT 0576 PAROF OCT 173777 RECV EQU P03$ RCWD1 OCT 2404 RVI OCT 0376 SEND EQU P05$ S2R EQU P06$ TCWD1 EQU P04$ TCWD3 EQU BIT6 TCWD4 EQU BIT11 TCWD5 EQU BIT6 TTD OCT 7176 WACK OCT 3576 SPC 1 BSS 0 SIZE OF DVG67. SPC 1 END IG67 X ?U 91741-18002 1740 S C0122 DS/1000 MODULE: QUEZ              H0101 bOASMB,R,L,C HED 3000 SLAVE REQ. WATCHDOG * (C) HEWLETT-PACKARD CO. 1977 NAM QUEZ,17,2 91741-16002 REV 1740 770830 SPC 1  ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT QUEZ * EXT EXEC,#LU3K,#QXCL,RNRQ,#QZRN * * QUEZ * SOURCE: 91741-18002 * BINARY: 91741-16002 * PRGMR: JIM HARTSELL * DATE: 17 FEB 76 * * * QUEZ IS A "POLLING PROGRAM" FOR UNSOLICITED SLAVE REQUESTS * FROM THE HP3000. WHEN QUEX HAS NOTHING TO DO, QUEZ IS * SCHEDULED TO WAIT FOR THE SLC DRIVER TO RECEIVE AN "ENQ" * FROM THE 3000. QUEZ THEN WRITES A ZERO LENGTH * REQUEST TO QUEX'S I/O CLASS, TO FORCE QUEX TO * RECEIVE THE PENDING SLAVE REQUEST. * * QUEZ ALSO PERFORMS "LINE OPEN" CALL FOR QUEX SO THAT QUEX * NEED NOT LOCK UP A PARTITION DURING I/O SUSPEND. * QUEZ LDA 1,I GET SCHEDULE PARAM. SZA,RSS NORMAL "POLLING" ENTRY? JMP POLL YES. * * LINE OPEN SECTION. QUEX HAS SCHEDULED QUEZ WITH WAIT. * LDA LOPWD NO. CONFIGURE LINE OPEN CALL. IOR #LU3K STA TEMP * JSB EXEC ISSUE LINE OPEN REQUEST. DEF *+6 (SETS # RETRIES = 7, DEF B2 LONG TIMEOUT = 60 SEC., DEF #LU3K # ID SEQUENCES = 0) DEF B2 GO TO "SEND" STATE. DEF B3 DEF TEMP (QUEX WILL CHECK FOR ERRORS) * JMP EXIT TERMINATE WHEN CALL COMPLETES. SKP * * SLAVE "POLL" SECTION. * POLL LDA SPRWD CONFIGURE SPECIAL READ PARAM. IOR #LU3K STA TEMP LDA #QZRN STA TEMP1 * JSB EXEC ISSUE SPECIAL "READ ENQ". DEF *+6 c   DEF B1 DEF #LU3K DEF TEMP1 RESOURCE NUMBER. DEF B0 DEF TEMP * JSB RNRQ HANG ON ATTEMPT TO LOCK RN. DEF *+4 COMMUNICATION DRIVER WILL UNLOCK DEF GLLCK WHEN AN "ENQ" IS RECEIVED AND QUEZ DEF #QZRN WILL RESUME EXECUTION WITH RN LOCKED. DEF TEMP B0 NOP IGNORE ERROR RETURN. * JSB EXEC CLASS WRITE TO QUEX. DEF *+8 (NO REPLY EXPECTED) DEF CLS20 DEF B0 DEF B0 DUMMY BUFFER ADDRESS. DEF B0 ZERO-LENGTH RECORD. DEF B0 LENGTH PASSED TO QUEX. DEF B0 DEF #QXCL NOP IGNORE ERRORS. * EXIT JSB EXEC TERMINATE. DEF *+2 DEF B6 SPC 1 * ****************************************** * B1 OCT 1 B2 OCT 2 B3 OCT 3 B6 OCT 6 GLLCK OCT 40002 CLS20 OCT 100024 LOPWD OCT 060200 SPRWD OCT 024500 TEMP NOP TEMP1 NOP * END QUEZ ;  @G 91741-18003 2013 S C0322 &QUEX              H0103 WASMB,L,R,C HED QUEX: HP 3000 COMMUNICATIONS MONITOR * (C) HEWLETT-PACKARD CO. NAM QUEX,19,4 91741-16003 REV 2013 800109 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * Z OPTION INCLUDES DEBUG. * EXT EXEC,D$EQT,#LU3K,D$LID,#LDEF,SLC,#TST EXT #QXCL,#RQCV,D$XS5 EXT #RSAX,PGMAD,$OPSY,#CL3K,$TIME EXT $LIBR,$LIBX SPC 1 ****************************** QUEX ****************************** * * * SOURCE: 91741-18003 * * * * BINARY: 91741-16003 * * * * JIM HARTSELL * * * * AUGUST 25, 1975 * * * ****************************************************************** * * * MODIFIED BY DAVE TRIBBY BEGINNING SEPT. 18, 1978 * * * ****************************************************************** SPC 1 L EQU 304 MAXIMUM LINE BUFFER SIZE. * * QUEX PERFORMS COMMUNICATION WITH A REMOTE HP3000 COMPUTER. * ALL MASTER REQUESTORS AND SLAVE MONITORS WISHING TO TRANSMIT * TO AN HP3000 DO SO BY WRITING THEIR BUFFERS TO THE * QUEX I/O CLASS. QUEX HANGS ON A CLASS GET CALL * AND THEN BLOCKS AS MANY REQUESTS/REPLIES AS WILL FIT INTO THE * SEND BUFFER. A "WRITE CONVERSATIONAL" CALL TO THE SYNCHRONOUS * LINE CONTROL PACKAGE (SLC) TRANSMITS THE SEND BUFFER AND * RETURNS A RECEIVE BUFFER. QUEX THEN DE-BLOCKS THE RECEIVE * BUFFER AND DISPATCHES THE REQUESTS/REPLIES TO THE PROPER MONITORS * OR MASTER REQUESTORS VIA CLASS WRITES. THE RECEIVE BUFFER * MAY BE EMPTY. SKP SUP A EQU 0 B EQU 1 SPC 2 QUEX LDA $OPSY CHECK FOR OPERATING RAR,SLA SYSTEM TYPE. RSS RSS IF MAPPED SYSTEM, JMP INITL LDA RSS CONFIGURE CROSS-MAP STA MODI2 LOAD STA MODI1 AND STORE. SPC 1 SPC 1 * * FIRST ENTRY INTO QUEX (SCHEDULED BY LSTEN OR UPLIN): * INITIALIZE THE HP3000 COMMUNICATION LINK. * INITL LDA #QXCL SAVE QUEX CLASS NUMBER. ELA,CLE,ERA CLEAR "DISCONNECT" BIT. STA QXCLS IOR B140K ADD NO-WAIT & BUFFER-SAVE BITS. STA QCLAS * LDA N16 INITIALIZE DELAY STA DCONT COUNT TO 16 (SPECIAL). * JSB CLNUP CLEAN OUT PREVIOUS ACTIVITY. * LDA D$XS5 SET FLAG WHETHER RAR HARD-WIRED OR AND D1 MODEM LINK. STA LINK 0 = HSI, 1 = MODEM. * * SET UP START AND END OF DRIVER TRACE TABLE. * LDA @D$EQ GET EXTENSION ADDR. RSS MAKE INDR LDA A,I SURE RAL,CLE,SLA,ERA IT'S JMP INDR DIRECT. STA @D$EQ ADA D$EQT ADD LENGTH. LDB D$XS5+1 SUBTRACT # WORDS CMB,INB IN CHARACTER ADA B TABLE. STA EOTBL LAST ADDRESS IN EVENT TABLE. * LDA @D$EQ GET ADDRESS ADA D76 OF TRACE TABLE. STA SOTBL FIRST ADDRESS IN EVENT TABLE. * LDA CNTRL CONFIGURE THE CONTROL WORDS. STA TEMP CLOOP LDA TEMP,I GET NEXT. SZA,RSS DO:NE IF ZERO. JMP INIT AND B1777 CLEAR LOW 6 BITS. IOR #LU3K INSERT LU OF 3000. STA TEMP,I STORE BACK. ISZ TEMP JMP CLOOP LOOP TILL DONE. SPC 3 * * ENTER HERE AFTER LINE CLOSE. * INIT CLA,INA STA ENQFL SET "NEED ENQ" FLAG. * LDA #CL3K GET LOGGING LU. SZA IF NOT SPECIFIED, SSA OR BAD, JMP CLRQ GO CLEAR. LDA #CL3K+1 IF DRIVER AND BIT13 TRACE WAS SZA,RSS NOT SPECIFIED, JMP CLRQ GO CLEAR. * LDA N2 SET TRACE STA TRBUF TO -2. LDA @STAT STATISTICS' ADDRESS (SOURCE). LDB @TRBF SET TRACE POINTER STB TPNTR FOR OUTPUT. INB POINT TO SECOND WORD FOR MOVE. MVW D11 MOVE 11 WORDS. LDA D12 TRACE BUFFER STA TRLEN LENGTH IS 12. JSB TRCOT WRITE TRACE ENTRY. * CLRQ JSB EXEC ISSUE CLEAR REQUEST. DEF *+6 DEF D2 DEF #LU3K DEF D0 DEF D3 DEF CLRWD * JSB SLC INITIALIZE SLC. DEF *+3 DEF #LU3K LU OF THE 3000. @D$EQ DEF D$EQT EQT EXTENSION ADDRESS. * SZA,RSS JMP LNOPN * LDA @D0 INITIALIZATION ERROR. STA SLCER LDB @EM18 JMP ABT SPECIAL "SLCER" ENTRY. @D0 DEF D0 * LNOPN LDA D$XS5+15 INITIALIZE STA OLENT TRACE POINTER. * JSB EXEC SCHEDULE QUEZ WITH WAIT TO DEF *+4 PERFORM LINE OPEN REQUEST. DEF D9 (THIS KEEPS QUEX FROM LOCKING UP DEF QUEZ PARTITION WHILE IN I/O SUSPEND.) DEF D1 SCHEDULE PARAM FOR QUEZ. * JSB SLCER CHECK FOR ERRORS. D1 DEC 1 * LDA LINK MODEM LINK? SZA,RSS JMP CERP NO. * JSB EXEC YES. DISPLAY DEF *+5 ">> HP 3000: READY FOR DIALING" DEF D2 DEF D1 ) DEF DIALM DEF D15 * LDA D$LID ADDR OF LOCAL ID IN "RES". LDB Q$LID ADDR OF LOCAL ID AREA IN QUEX. MVW D19 MOVE LOCAL & REMOTE ID STORED IN "RES" * LDA LOCID GET BYTE LENGTH OF LOCAL ID. SZA,RSS JMP RDISQ ZERO. NO LOCAL ID. * JSB EXEC ESTABLISH LOCAL ID SEQUENCE. DEF *+6 DEF D2 DEF #LU3K DEF D1 DEF LOCID DEF LIDSQ * JSB SLCER CHECK FOR ERRORS. D0 DEC 0 * RDISQ LDA REMID GET BYTE LENGTH OF REMOTE ID. SZA,RSS JMP CERP ZERO. NO REMOTE ID. * JSB EXEC ESTABLISH REMOTE ID SEQUENCE. DEF *+6 DEF D2 DEF #LU3K DEF D1 DEF RCVID DEF RIDSQ * JSB SLCER CHECK FOR ERRORS. DEC 0 * * CERP JSB EXEC CHANGE ERROR RECOVERY PARAMETERS. DEF *+6 DEF D2 DEF #LU3K DEF D20 # RETRIES = 20. DEF D7 LONG TIMEOUT = 21 SEC. DEF ERCWD * JSB SLCER CHECK FOR ERRORS. DEC 0 * * SEND INITIALIZATION REQUEST. * LDA XLEN STORE MAX. SIZE, CLB DIV D16 (MODULO 16) ADA N1 STA B ALF,ALF IOR B AND CURRENT SIZE. STA STRTM+4 * LDA STRTM ADDR OF INIT. REQUEST. TOBUF LDB WRADR ADDR OF SEND BUFFER. STB BPNTR MVW D8 MOVE INIT. REQUEST TO "SEND" * LDA D8 SET BLOCK LENGTH STA LOG TO EIGHT. CLA GO TO VERIF IN CASE JSB VERIF TRACE WAS SPECIFIED. NOP IGNORE ERROR. **SHOULDN'T HAPPEN** * LDA WRADR SET BUFFER POINTER ADA D8 TO END OF MESSAGE. STA BPNTR LDA N16 SET WRITE LENGTH TO 16 BYTES. STA WRLEN * JMP REMIO GO SEND INIT. REQUEST. SPC 1 @STAT DEF D$XS5+2 ADDRESS OF LONG TERM STATS. SKP * * WAIT FOR THE 3000 TO SENW D SOMETHING BY SCHEDULING "QUEZ". * WAIT FOR SOMETHING TO SEND TO THE HP 3000 BY HANGING ON * A CLASS I/O GET WITH WAIT TO QUEX'S I/O CLASS. * BLOCK AS MANY REQUESTS/REPLIES FROM QUEX'S I/O CLASS * BUFFER AS WILL FIT IN THE TRANSMIT BUFFER. * WATCH JSB OFFQZ MAKE SURE QUEZ IS DORMANT. JSB EXEC SCHEDULE QUEZ TO LOOK FOR DEF *+4 SLAVE REQUESTS FROM THE 3000. DEF D10 DEF QUEZ DEF D0 SET SCHEDULE OPTION CODE. * NEWGT CLA INITIALIZE LENGTH (BYTES) STA WRLEN OF TRANSMIT BUFFER. LDA WRADR INITIALIZE BUFFER POINTER TO STA BPNTR START OF SEND AREA. * GET JSB EXEC CLASS I/O GET TO LOOK FOR DEF *+6 MASTER REQUESTS FROM RTE USERS. DEF CLS21 NO ABORT. DEF QXCLS QUEX I/O CLASS. BPNTR NOP DEF MXLEN BUFFER LENGTH. DEF LOG RETURNED BLOCK LENGTH (WORDS). NOP IGNORE ERROR RETURN. * * THE CLASS GET HAS COMPLETED. IF RECEIVED DATA LENGTH IS ZERO, * THE 3000 WANTS TO SEND A SLAVE REQUEST OR A MASTER REPLY. * IF NON-ZERO, THE RTE IS SENDING A MASTER REQUEST OR SLAVE REPLY. * LDA LOG IS QUEZ TELLING US THE 3000 IS SENDING? SZA JMP BLKIN NO. ACCUMULATE OUTGOING REQUESTS. * LDA IGNOR YES. ARE WE TO IGNORE THIS ONE? SZA,RSS JMP RINTL NO. NEED TO SERVICE THE 3000. CLA YES. GO BACK TO THE GET. STA IGNOR JMP NULGT SPC 1 * A BLOCK HAS BEEN ADDED TO THE TRANSMIT BUFFER. * ADVANCE BUFFER POINTER AND COUNTER. * BLKIN LDA SGNOF INIT. REQ. EXCHANGED YET? SZA JMP NULGT NO. IGNORE. **SHOULDN'T HAPPEN** ADDBU CLA MESSAGE IS FROM 1000. JSB VERIF CHECK VALIDITY. JMP NULGT INVALID: IGNORE. * LDA BUFL ADD LEN OF BLOCK IN NEG BYTES CLE,ELA TO TOTAL XMIT BYTE LEN (NEG) CMA,INA THAT HAVE BEEN ACCUMULATED. ADA WRLEN  STA WRLEN * LDA BPNTR ADVANCE BUFFER POINTER. ADA BUFL STA BPNTR * LDA BUFL SUBTRACT THE LENGTH CMA,INA OF PROCESSED BUFFERS ADA LOG FROM BLOCK LENGTH. STA LOG SAVE REMAINING LENGTH. SZA IF ANOTHER BUFFER, JMP ADDBU GO ADD IT. * * ISSUE A NULL GET CALL TO QUEX'S I/O CLASS TO SEE * IF THERE IS ANOTHER PENDING REQUEST AND TO SEE WHETHER * THERE IS ROOM IN THE TRANSMIT BUFFER. ISSUE THE GET * WITHOUT WAIT, SAVE CLASS BUFFER, AND BUF LEN = 0. * NULGT JSB EXEC CLASS GET (DUMMY). DEF *+6 DEF CLS21 NO ABORT. DEF QCLAS QUEX I/O CLASS. DEF D0 DUMMY BUFFER. DEF D0 ZERO LENGTH BUFFER. DEF LOG RETURNED BLOCK LENGTH (WORDS). NOP IGNORE ERROR RETURN. * SSA WAS THERE ANYTHING THERE? JMP REMIO NO. GO SEND WHAT WE HAVE. * * A REQUEST IS IN THE CLASS BUFFER. SEE IF THERE * IS ROOM TO BLOCK IT INTO THE TRANSMIT BUFFER. * LDA BPNTR CMA,INA ADA RDADR # WORDS LEFT IN XMIT BUFR. INA CMA,INA NEGATE. ADA LOG ADD LENGTH OF BLOCK (WORDS). SSA JMP GET FITS. GO READ IT IN. * * IF THERE WAS NO ROOM FOR THE LAST BLOCK, IT IS STILL IN * THE CLASS BUFFER AND WILL BE PICKED UP NEXT TIME AROUND. * * SEND THE BLOCKS TO THE HP3000 AND WAIT FOR INCOMING BLOCKS. * REMIO LDA ENQFL DO WE NEED TO DO A SZA,RSS "WRITE INQUIRY"? JMP WRCON NO. * JSB EXEC ISSUE WRITE INQUIRY. DEF *+6 DEF D2 DEF #LU3K DEF D1 DEF D0 DEF WNQWD * JSB SLCER CHECK FOR ERRORS. D2 DEC 2 * LDB @D2 CPA D5 EOT RECEIVED? JMP EOTER YES. **PROTOCOL FAILURE** * CLA STA ENQFL CLEAR ENQ FLAG. * CPA D13 BACK OFF TO READ INITIAL IF JMP RINTL ENQ RECEIVED (ONLY IF RTE SECONDARY). SPC 3 * * PERFORM WRITE CONVERSATIONAL TO HP 3000. * WRCON JSB EXEC WRITE CONVERSATIONAL. DEF *+6 DEF D2 DEF #LU3K DEF WRLEN LEN/SEND BUFFER/RECEIVE BUFFER. DEF BFLEN LEN OF RECEIVE BUFFER (-BYTES). DEF CONWD CONTROL WORD. * CPB D2 TREAT 2 BYTES AS ZERO. CLB STB RDLEN SAVE POSITIVE # BYTES. * JSB SLCER CHECK FOR SLC ERROR. D3 DEC 3 * LDB WRLEN SAVE WRITE LENGTH STB OWLEN FOR 0-LEN CHECK. CLB INDICATE DATA IN WRITE STB WRLEN BUFFER HAS BEEN SENT. * CPA D5 CHECK FOR JMP EOT EOT RECEIVED. SPC 3 * REQUESTS AND/OR REPLIES HAVE BEEN RECEIVED FROM THE HP 3000. * FOR REQUESTS, DO A CLASS WRITE TO THE REQUEST CONVERTER (RQCNV). * FOR REPLIES, SEARCH THE MASTER LIST (VIA SEQUENCE #) AND DO A CLASS * WRITE TO THE CORRESPONDING MASTER CLASS NUMBER. * STLEN LDA RDLEN SET # OF CLE,INA WORDS READ. ERA STA LOG SPC 2 * * GET TO THE NEXT BLOCK IN READ BUFFER. * DISP SZA,RSS IS THERE ANOTHER BLOCK? JMP DONE NO. SERVICING COMPLETE. * ADA N7 IGNORE IF LESS THAN 8 WORDS. SSA JMP DONE IGNORE REST OF BLOCK. **SHOULDN'T HAPPEN** * * DETERMINE WHETHER MESSAGE IS A REQUEST FROM THE 3000 * OR A REPLY TO AN RTE MASTER'S REQUEST. * CLA,INA CHECK VALIDITY AND SET UP , JSB VERIF , , AND . JMP DONE INVALID REQUEST. IGNORE REST OF BLOCK. * LDA STMWD ISOLATE REPLY AND AND B140K REJECT BITS. * CPA B140K IF BOTH SET, 3000 IS REJECTING JMP NEXT AN RTE REPLY. IGNORE. * SZA IF EITHER IS SET, JMP REPLY IT'S A REPLY TO AN RTE MASTER. SPC 3 * * A REQUEST HAS ARRIVED FROM THE 3000. * LDA CLAS)/S IF MESSAGE CLASS SZA,RSS IS ZERO, JMP MZERO GO TO SPECIAL HANDLER. LDB SGNOF INIT. REQ. EXCHANGED YET? SZB JMP REJCT NO. REJECT. * CPA D5 CLASS 5? ($STDIN/$STDLIST) JMP $SCHK YES--MAY BE FOR MASTER. * RQCNV LDA #RQCV SET IOR BIT15 NO-WAIT STA CLASN BIT. * JSB EXEC WRITE REQUEST TO RQCNV'S CLASS. DEF *+8 DEF CLS20 DEF D0 DEF BPNTR,I DEF BUFL DEF D0 DEF D0 DEF CLASN CLASS NUMBER OF RQCNV. JMP REJCT ERROR RETURN. SZA IF NO SAM, JMP REJCT TRY TO REJECT. * JMP NEXT GO DISPATCH NEXT BLOCK. SPC 3 * * THE MESSAGE IS A DS/3000 REPLY TO AN RTE MASTER REQUEST. * CHECK FOR SPECIAL CLASSES: 0, 5, AND 6. * REPLY LDA CLASS MESSAGE CLASS 0? SZA,RSS JMP REPL0 YES--GO TO SPECIAL HANDLER. * IFN ********************************************** CPA D5 MESSAGE CLASS 5? JMP LUMAP YES--PASS TO LU MAPPING MONITOR. XIF ********************************************* * CPA D6 MESSAGE CLASS 6? JMP LBYE? YES--CHECK FOR LAST BYE. * * SEARCH FOR MASTER TCB. * SRCHM LDB BPNTR GET ADB D5 SEQUENCE LDA B,I NUMBER. STA TEMP JSB #RSAX CALL DEF *+3 #RSAX DEF D4 FOR DEF TEMP SEARCH. SSB FOUND? JMP REJCT NO--REJECT. SPC 2 IOR BIT15 SET NO-WAIT BIT STA CLASN SAVE I/O CLASS #. * JSB EXEC CLASS DEF *+8 WRITE DEF CLS20 TO DEF D0 CLASN. DEF BPNTR,I DEF BUFL DEF BUFL DEF D0 DEF CLASN JMP NEXT ERROR--IGNORE. SZA IF NO SAM, JMP NOSAM PRINT ERROR MESSAGE. L SPC 2 * * END OF PROCESSING FOR THIS BLOCK. * NEXT LDA BPNTR BLOCK PROCESSED: ADA BUFL UPDATE POINTER INTO STA BPNTR RECEIVE BUFFER. * LDA BUFL CALCULATE NUMBER CMA,INA OF WORDS REMAINING ADA LOG IN READ BUFFER. STA LOG * JMP DISP GO CHECK FOR ANOTHER BLOCK. SPC 2 * * ALL RECEIVED BLOCKS HAVE BEEN DISPATCHED. * DONE LDA WRLEN RESET CMA,INA BUFFER CLE,ERA POINTER. ADA WRADR STA BPNTR * LDA WRLEN ANY DATA IN WRITE BUFFER? SZA (ACCUMULATION INTERRUPTED BY ENQ.) JMP NULGT YES--CONTINUE ACCUMULATION. * JSB EXEC "NULL" CLASS GET. (BUFFERS MAY HAVE BEEN DEF *+6 ADDED WHILE QUEX WAS I-O SUSPENDED). DEF CLS21 DEF QCLAS DEF D0 DEF D0 DEF LOG NOP IGNORE ERROR RETURN. * SSA ANYTHING THERE? JMP NOMOR NO. * LDA LOG YES. SZA ZERO LENGTH BUFFER? JMP NEWGT NO. * YES. QUEZ DID IT JUST BEFORE THE INA WRITE CONVERSATIONAL. REQUEST HAS STA IGNOR ALREADY BEEN READ, SO IGNORE IT. * NOMOR LDA DCNFL ARE WE TO ATTEMPT DISCONNECT? SZA,RSS JMP CKDAT NO. * CLA YES. SEND TERMINATION REQUEST. STA DCNFL LDA TRMRQ MOVE TERMINATION REQUEST TO JMP TOBUF CURRENT BUFFER LOCATION. * * WE HAVE NOTHING TO SEND TO HP 3000. IF EMPTY MESSAGES HAVE * BEEN EXCHANGED, GO TO WRITE RESET. OTHERWISE SEND EMPTY MESSAGE. * CKDAT LDA OWLEN IF OLD WRITE LENGTH SZA,RSS OR LDA RDLEN CURRENT READ LENGTH SZA IS NOT ZERO, JMP WRCON GO SEND EMPTY MESSAGE. * RESET JSB EXEC PERFORM "WRITE RESET" (SEND EOT). DEF *+6 DEF D2 DEF #LU3K DEF D0J DEF D0 DEF RESWD * JSB SLCER CHECK FOR ERRORS. D5 DEC 5 * EOT CLA,INA STA ENQFL SET "SEND ENQ" FLAG. * JMP WATCH SPC 5 * * PRINT ERROR MESSAGE WHEN CLASS I/O FAILS BECAUSE OF NO SAM. * NOSAM JSB EXEC DEF *+5 DEF SD2 DEF D1 DEF SAMER DEF D13 NOP JMP NEXT * SAMER ASC 13,/QUEX: INSUFFICIENT S.A.M. SKP * * THE SEND BUFFER CONTAINS MASTER REQUESTS AND/OR SLAVE REPLIES, * BUT BEFORE IT COULD BE SENT, THE 3000 HAS SENT A LINE BID. * THE WRITE LENGTH INDICATES THE SEND BUFFER CONTAINS GOOD DATA. * * READ INITIAL--GET 3000'S BID FOR LINE. * RINTL JSB EXEC ISSUE "READ INITIAL" CALL. DEF *+6 DEF D1 DEF #LU3K DEF BPNTR,I DEF BFLEN DEF RDIWD * CPB D2 IF 2 BYTES WERE SENT, CLB IT'S AN EMPTY MESSAGE. STB RDLEN SAVE POSITIVE # BYTES. * JSB SLCER CHECK FOR ERRORS. D4 DEC 4 * LDB @D4 CPA D5 JMP EOTER RECEIVED EOT. **PROTOCOL FAILURE** * LDB RDLEN CHECK TRANSMISSION LOG. SZB,RSS JMP RESET SEND EOT IF ZERO. * CLA CLEAR "NEED STA ENQFL ENQ" FLAG. * JMP STLEN DISPATCH BLOCKS FROM READ BUFFER. * SPC 2 * EOTER STB SLCER EOT RECEIVED IN READ LDB @EM5 INITIAL OR WRITE INQUIRY. JMP ABT SPECIAL "SLCER" ENTRY. @D2 DEF D2 @D4 DEF D4 SKP * * CHECK WHETHER $STDLIST REQUEST SHOULD GO TO MASTER OR CNSLM. * $SCHK LDB BPNTR GET "FROM PROCESS NUMBER." ADB D4 LDA B,I ALF,ALF AND B377 SZA,RSS IF ZERO, JMP RQCNV PASS TO RQCNV. LDA B,I GET "TO PROCESS NUMBER" AND B377 SZA,RSS IF ZERO, JMP RQCNV PASS TO RQCNV. JMP SRCHM BOTH NON-ZERO. PASS TO MASTER. SPC 3 * REQUEST RECEIVED ON CLASS 0. * CLASS 0, STREAM 20: INITIALIZATION * CLASS 0, STREAM 21: TERMINATION * MZERO LDA STREM STREAM = CPA B20 OCTAL 20? JMP REJCT YES. REJECT INITIALIZATION. CPA B21 STREAM = RSS OCTAL 21? JMP REJCT NO--UNKNOWN. REJECT. **SHOULDN'T HAPPEN** * * HP 3000 REQUESTS TERMINATION ONLY WHEN IT THINKS NEITHER * SIDE HAS ANYTHING GOING. MAKE SURE PNL IS EMPTY. * CCB GET ADDRESS OF ADB #LDEF PNL HEADER ADDR. LDB B,I GET ADDR OF JSB LODWD PNL HEADER. SZA IF ANYONE IS IN LIST, JMP REJCT REJECT. **SHOULDN'T HAPPEN** JSB DCNCT SET DISCONNECT STATUS JMP CLOSE AND GO CLOSE THE LINE. SPC 1 * * REPLY RECEIVED ON CLASS 0. * REPL0 LDB STMWD GET STREAM WORD RBL AND POSITION REJECT BIT. LDA STREM IF STREAM = CPA B20 OCTAL 20, JMP INIRP IT'S AN INITIALIZATION REPLY. CPA B21 IF STREAM NOT = RSS OCTAL 21, JMP REJCT UNKNOWN. REJECT. **SHOULDN'T HAPPEN** * * HP 3000 IS REPLYING TO OUR TERMINATION REQUEST. * SSB REJECT BIT SET? JMP NEXT YES--DON'T DISCONNECT. JMP CLOSE NO--GO AHEAD AND CLOSE LINE. * * HP 3000 IS REPLYING TO OUR INITIALIZATION REQUEST. * INIRP SSB REJECT BIT SET? JMP INIT YES--RETRY. JSB CNNCT NO--ESTABLISH CONNECT STATUS. LDA D$XS5 SET MODE IOR D1 TO "PRIMARY." STA D$XS5 * LDA DCONT IF DELAY COUNT CPA N50 IS 50, SKIP JMP NEXT THE "UP" MESSAGE. * DLD UP 3000 LINK IS "UP". DST STMSG+16 LDA UP+2 STA STMSG+18 * JSB EXEC DISPLAY STATUS DEF *+5 MESSAGE ON LU 1. DEF D2 DEF D1 DEF STMSG DEF D20 * LDA N50 8SET DELAY COUNT STA DCONT TO 50 (LONG). * JMP NEXT PROCESS NEXT BLOCK. SPC 3 * THE 3000 HAS FOUND NOTHING TO DO (NO HELLO OUTSTANDING AND * NO SLAVE ACTIVITY) AND HAS DISCONNECTED THE LINE, OR AN * ABORTIVE COMMUNICATION ERROR HAS OCCURRED. CLOSE THE * LINE AND RE-INITIALIZE THE DRIVER AND QUEX. * CLOSE JSB EXEC WRITE DISCONNECT. DEF *+6 DEF D2 DEF #LU3K DEF D0 DEF D0 DEF WRDIS * LNCLO JSB EXEC CLOSE THE LINE. DEF *+6 DEF D2 DEF #LU3K DEF D0 DEF D3 DEF LCLWD * JSB DVRTC PERFORM DRIVER TRACE. * JSB OFFQZ MAKE SURE QUEZ IS DORMANT. * LDA D$XS5 RESET TO "SECONDARY" MODE. AND N2 STA D$XS5 * LDA LINK IS THIS A MODEM LINK? SZA,RSS JMP INIT NO. * JSB EXEC YES. DISPLAY DEF *+5 ">> HP 3000: DISCONNECT" DEF D2 DEF D1 DEF SNOFF (QUEX WILL HANG IN "LINE OPEN" DEF D11 UNTIL EITHER END RE-DIALS.) * JMP INIT GO RE-INITIALIZE. SPC 5 * * SEND "REJECT" REPLY FOR ILLEGAL REQUESTS. * REJCT LDA STMWD MAKE SURE AND BIT14 WE AREN'T SZA REJECTING JMP NEXT A REJECT! LDA BPNTR,I APPENDAGE AND B377 LENGTH IOR LB8 IS 8. STA BPNTR,I LDA STMWD SET REJECT BIT. IOR BIT14 LDB BPNTR ADB D2 STA B,I ADB D2 REVERSE PROCESS NUMBERS. LDA B,I ALF,ALF STA B,I ADB D3 DATA LENGTH = 0. CLA STA B,I * LDA QXCLS IOR BIT15 SET NO-WAIT BIT. STA CLASN SAVE I/O CLASS #. * JSB EXEC CLASS DEF *+8 WRITE DEF CLS20 TO DEF D0 QUEX. DEF BPNTR,I DEF D8 DEF D8 DEF D0 DEF CLASN JMP ݘNLHNEXT ERROR--IGNORE. SZA IF NO SAM, JMP NOSAM PRINT ERROR MESSAGE. JMP NEXT * LB8 BYT 10,0 LEFT BYTE DECIMAL 8. SPC 3 * * ESTABLISH "DISCONNECT" STATUS (CHECKED BY UPLIN AND D3KMS). * DCNCT NOP CLA,INA SET SIGN OFF FLAG. STA SGNOF LDA #QXCL SET DISCONNECT FLAG IN #QXCL IOR BIT15 TO INDICATE DISCONNECT STATUS. STA #QXCL JMP DCNCT,I RETURN. * * ESTABLISH "CONNECT" STATUS. * CNNCT NOP CLA CLEAR SIGN OFF FLAG. STA SGNOF LDA #QXCL CLEAR DISCONNECT FLAG IN #QXCL ELA,CLE,ERA TO INDICATE CONNECT STATUS. STA #QXCL JMP CNNCT,I RETURN. SPC 3 * * CLASS 6 REPLY RECEIVED. IS IT LAST BYE? * LBYE? LDA STREM IF NOT CPA B21 STREAM 21, RSS IT'S NOT JMP SRCHM A BYE. * CCB GET ADDR OF PNL HEADER ADDR. ADB #LDEF LDB B,I GET ADDR OF PNL HEADER JSB LODWD GET ADDR OF FIRST PNL ENTRY. SZA,RSS JMP STDIS IF ZERO, SET DISCONNECT FLAG. LDB A PICK UP LINK. ON JSB LODWD GET ADDR OF SECOND PNL ENTRY. SZA JMP SRCHM MORE THAN ONE HELLO OUTSTANDING. * STDIS CLA,INA SET DISCONNECT FLAG. STA DCNFL JMP SRCHM SEARCH FOR MASTER. SPC 3 * * SUBROUTINE TO TERMINATE QUEZ. * OFFQZ NOP ENTRY. JSB EXEC CALL EXEC FOR DEF *+3 SON'S TERMINATION. DEF SD6 DEF QUEZ NOP IGNORE ERRORS. JMP OFFQZ,I RETURN. * SD6 DEF 6,I SKP * * SUBROUTINE TO VERIFY AUTHENTICITY OF REQUESTS AND REPLIES * BEING SENT OR RECEIVED. ALSO SETS , , , * AND AND PERFORMS TRACE (IF REQUESTED). * * ON ENTRY, (A) = 0 IF OUTGOING REQ/REPLY, * = 1 IF INCOMING REQ/REPLY. * BPNTR = BUFFER ADDRESS OF REQ/REPLY. * VERIF NOP STA TEMP SAVE DIRECTION CODE. LDB BPNTR LOAD ADDRESS OF MESSAGE. * LDA B,I CHECK WORD 1: SZA,RSS JMP BADBF ERROR IF ZERO. AND B377 ISOLATE MESSAGE CLASS. STA CLASS SAVE IT. ADA N9 SSA,RSS JMP BADBF ERROR IF MESSAGE CLASS > 8. * ADB D2 CHECK WORD 3: LDA B,I STA STMWD SAVE IT. AND B377 ISOLATE STREAM TYPE. STA STREM SAVE IT. ADA NB20 SSA JMP BADBF ERROR IF < OCTAL 20. ADA NB10 SSA,RSS JMP BADBF ERROR IF > OCTAL 27. * ADB D5 CHECK WORD 8: LDA B,I SSA JMP BADBF ERROR IF NEGATIVE. * LDB BPNTR VERIFY THAT ADB D7 WDCNT <= N(WORDS) + 8. LDB B,I INB CLE,ERB ADB D8 STB BUFL SAVE WORD COUNT. INB CMB,INB LDA BPNTR,I ALF,ALF AND B377 ADA B SSA,RSS JMP BADBF ERROR. ISZ VERIF NO ERROR, TAKE NORMAL RETURN. * LDA #CL3K TRACE OPTION REQUESTED? q  SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. * LDA #CL3K+1 BUFFERS TO BE TRACED? SSA,RSS IF BIT 15 NOT SET, JMP VERIF,I RETURN. * LDA D8 INITIALIZE TRACE STA TRLEN LENGTH TO 8. * LDA #CL3K+1 APPENDAGE BIT SET? AND BIT14 SZA,RSS JMP WRTRC NO. GO WRITE. * LDA BPNTR,I GET LENGTH OF ALF,ALF APPENDAGE AND AND B377 HEADER FROM STA TRLEN WORD 1. * LDA #CL3K+1 GET MAX DATA LENGTH AND LENBT FROM BITS 0-12. ADA TRLEN ADD HEADER/APPEND LENGTH. STA B HOLD IN B-REG. CMA,INA IF GREATER THAN ACTUAL ADA BUFL BUFFER LENGTH, SSA LDB BUFL USE BUFFER LENGTH. STB TRLEN STORE TRACE LENGTH. * WRTRC CCA ADA BPNTR SET TRACE STA TPNTR POINTER. LDB TPNTR,I SET FIRST WORD STB HOLD TO INDICATE LDB TEMP DIRECTION. STB TPNTR,I ISZ TRLEN ADD 1 TO LENGTH. JSB TRCOT WRITE TRACE. LDA HOLD RESTORE FIRST STA TPNTR,I BUFFER WORD. JMP VERIF,I RETURN. * BADBF LDA DRECV INITIALIZE FOR "RECEIVED". LDB TEMP CHECK DIRECTION FLAG. SZB,RSS LDA DOUTG CHANGE TO "OUTGOING". LDB DINSR GET ADDR IN MAIN MESSAGE. MVW D5 MOVE DIRECTION MESSAGE. * LDA LOG SET BUFFER LENGTH STA BUFL TO REMAINING BLOCK STA TRLEN LENGTH & SET TRACE LEN. * JSB EXEC DISPLAY DEF *+5 ">> HP 3000: BAD BUFFER RECEIVED". DEF D2 OR DEF D1 ">> HP 3000: BAD BUFFER OUTGOING". DEF BDBUF DEF D16 * LDA #CL3K TRACE OPTION REQUESTED? SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. JMP WRTRC YES.& SPC 1 * VALUES SET BY VERIF: CLASS NOP DS/3000 MESSAGE CLASS. STMWD NOP DS/3000 STREAM WORD. STREM NOP DS/3000 MESSAGE STREAM. BUFL NOP WORD COUNT OF BUFFER. HOLD NOP SPC 5 * * SUBROUTINE TO WRITE A RECORD TO TRACE LU. * CALLING SEQUENCE: * JSB TRCOT * TRCOT NOP ENTRY POINT. * LDA #CL3K CHECK BIT 13 AND BIT13 OF LOG WORD. SZA JMP CLIO SET--DO CLASS I/O. * JSB EXEC WRITE ENTIRE DEF *+5 MESSAGE TO DEF SD2 TRACING LU. DEF #CL3K DEF TPNTR,I DEF TRLEN RSS ERROR RETURN. JMP TRCOT,I NO ERROR. RETURN. * WRERR DST ABREG PRINT JSB EXEC ERROR DEF *+5 MESSAGE. DEF SD2 DEF D1 DEF IOERR DEF D13 NOP * LDA #CL3K SET "BAD" BIT IOR BIT15 IN TRACE LU. STA #CL3K JMP TRCOT,I RETURN. * CLIO LDA #CL3K SET NO-WAIT BIT IOR BIT15 IN CLASS NUMBER. STA CLASN JSB EXEC WRITE TO I/O CLASS. DEF *+8 DEF CLS20 DEF D0 DEF TPNTR,I DEF TRLEN DEF TRLEN DEF D0 DEF CLASN JMP WRERR (ERROR RETURN.) SZA,RSS CHECK FOR NO S.A.M. JMP TRCOT,I NO ERROR...RETURN. DLD "SAM" REPORT SAM ERROR. JMP WRERR * "SAM" ASC 2,SAM IOERR ASC 11,/QUEX: TRACING ERROR ABREG BSS 2 TRLEN NOP TRACE OUTPUT LENGTH. TPNTR NOP TRACE OUTPUT POINTER. SPC 5 * * SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I GET WORD FROM TCB (RSS IF DMS SYSTEM). JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I RETURN. SPC 3 * * SUBROUTINE TO STORE WORD INTO ALTERNATE MAP (IF MAPPED SYSTEM) * STRWD NOP JSB $LIBR LOWER FENCE NOP MODI1 NOP RSS HERE IF DMS SYSTEM. JMP TSTC3 XSA B,I STORE INTO SYSTEM MAPPED LOCATION. RSS * FOLLOWING INSTRUCTION IS EXECUTED FOR NON-DMS SYSTEMS ONLY TSTC3 STA B,I STORE WORD. JSB $LIBX RAISE FENCE. DEF STRWD RETURN. SKP IFZ *** DEBUG OPTION *** * ***** SPECIAL DEBUG SECTION: TRACE * INSERT A "JSB TRACE" IN PROGRAM. QUEX WILL PRINT CALL LOCATION * AND CONTENTS OF A- & B-REGISTERS ON LU SPECIFIED IN #CL3K+2. * EXT CNUMO TRACE NOP ENTRY DST ABREG STORE REGISTERS LDA #CL3K+2 SZA,RSS IF TRACE LU ISN'T SPECIFIED, JMP TRTRN RETURN FROM TRACE. * LDB 1727B GET POINTER TO STARTING ADDR FROM BASE PG. JSB LODWD GET STARTING ADDR FROM ID SEG. CMA,INA NEGATE. ADA TRACE ADD CALLING ADDRESS STA TOFST TO GET OFFSET. * JSB CNUMO CONVERT DEF *+3 ADDRESS OFFSET DEF TOFST TO DEF TADDR OCTAL. * JSB CNUMO CONVERT DEF *+3 A-REG DEF ABREG TO DEF TAREG OCTAL. * JSB CNUMO CONVERT DEF *+3 B-REG DEF ABREG+1 TO DEF TBREG OCTAL. * JSB EXEC PRINT DEF *+5 INFORMATION. DEF SD2 DEF #CL3K+1 DEF TINFO DEF D20 NOP TRTRN DLD ABREG RESTORE REGISTERS. JMP TRACE,I RETURN. * TOFST NOP TINFO ASC 7,/QUEX TRACE @ TADDR ASC 3, ASC 2,: A= TAREG ASC 3, ASC 2,, B= TBREG ASC 3 XIF ***** END OF DEBUG ***** SKP * * SUBROUTINE TO CHECK STATUS AFTER SLC CALLS. * SLCER NOP ENTRY. * JSB DVRTC PERFORM DRIVER TRACE. * JSB EXEC ISSUE STATUS CALL. DEF *+5 DEF D13 DEF #LU3K CURRENT HP3000 LU.c DEF STATS COMPLETION STATUS (EQT WORD 5). DEF TEMP2 EQT WORD 4. * LDA STATS WAS THERE AN ERROR? AND B37 STA STATS SZA,RSS JMP ERREX NO. RETURN. (A) = 0. * LDB ETABL ADDR OF ERROR MESSAGE TABLE. ADB A ADD STATUS CODE. LDB B,I GET ADDR OF ERROR MESSAGE. SZB JMP ABT NON-ZERO. SET UP ERROR MESSAGE. * ERREX ISZ SLCER JMP SLCER,I RETURN TO CALLER. (A)=NON-ABORT CODE. * ABT STB A ADDR OF ERROR MESSAGE. LDB MSGA1 STORAGE ADDR IN MAIN MESSAGE. MVW D8 MOVE ERROR MSG TO MAIN MESSAGE. * LDA DCONT IF DELAY COUNT CPA N2 IS 2 (SHORT), JMP SKPRT SKIP PRINT. * LDA SLCER,I PLACE TYPE OF CALL IN MESSAGE. MPY D5 ADA DCTN LDB DEM11 MVW D5 * DLD DOWN INSERT "*DOWN*". DST STMSG+16 LDA DOWN+2 STA STMSG+18 * JSB EXEC DISPLAY ERROR MSG ON LU 1. DEF *+5 DEF D2 DEF D1 DEF STMSG DEF D39 * SKPRT JSB CLNUP PERFORM GLOBAL CLEANUP. * LDA LINK MODEM LINK? SZA JMP SDLAY YES. SET THE DELAY COUNT. * GDRMT JSB EXEC GO DORMANT, SAVE RESOURCES. DEF *+4 (UPLIN WILL RESTART QUEX DEF D6 IN FIVE SECONDS.) DEF D0 DEF D1 * ISZ DCONT BUMP COUNTER. JMP GDRMT STAY IN LOOP UNTIL 0. * SDLAY LDA N2 SET DELAY COUNT STA DCONT TO 2 (SHORT). * LDA STATS IF ERROR WAS DLE EOT, CPA D6 GO RIGHT TO LINE CLOSE. JMP LNCLO JMP CLOSE OTHERWISE SEND DLE EOT FIRST. * * DCTN DEF *+1 ASC 5, ASC 5, LINE OPEN ASC 5, SEND ENQ ASC 5, WRITE CON ASC 5, READ INIT ASC 5, SEND EOT * DCONT BSS 1 DELAY COUNT = -50 WHEN LINE * FIRST GO>ES DOWN, -2 AFTERWARD. SKP * * SUBROUTINE TO BUILD AND WRITE TRACE ENTRY FOR DRIVER CALLS. * CALLING SEQUENCE: JSB DVRTC * DVRTC NOP ENTRY. DST A&B SAVE REGISTERS. LDA #CL3K GET LOGGING LU. SZA IF NOT SPECIFIED, SSA OR BAD, JMP RTRN1 RETURN. * LDA #CL3K+1 IF DRIVER AND BIT13 TRACE WAS SZA,RSS NOT SPECIFIED, JMP RTRN1 RETURN. * CCA SET TRACE TYPE STA TRBUF TO -1. * DLD $TIME GET SYSTEM DST TRTIM TIME. * LDA WRLEN SAVE STA TWLEN WRITE LDA RDLEN AND READ STA TRDLN LENGTHS. * LDA @TDAT INITIALIZE TRACE STA TDPNT DESTINATION POINTER. * LDB OLENT INITIALIZE TRACE STB ENTRY SOURCE POINTER. * NWENT STB ELINK SAVE POINTER TO NEXT ENTRY JSB NXTEV PICK UP WORD TWO. SVENT JSB STBUF SAVE IN BUFFER. JSB NXTEV PICK UP EVENT/STATE WORD. LDB ELINK,I UP TO NEXT ENTRY? CPB ENTRY RSS JMP SVENT NO. GET NEXT EVENT/STATE. * CCA STORE -1 IN BUFFER JSB STBUF TO INDICATE END OF ENTRY. LDB ELINK,I CPB D$XS5+14 END OF TABLE? RSS JMP NWENT NO. DO NEXT ENTRY. * LDA @TRBF SAVE START OF TRACE STA TPNTR BUFFER FOR OUTPUT. CMA,INA CALCULATE LENGTH ADA TDPNT OF BUFFER. STA TRLEN JSB TRCOT WRITE ENTRY. * RTRN1 LDA D$XS5+14 SET UP OLD ENTRY STA OLENT POINTER FOR NEXT TIME. DLD A&B RESTORE REGISTERS. JMP DVRTC,I RETURN. * * BUFFER FOR DRIVER TRACE: TRBUF NOP TRACE TYPE TRTIM BSS 2 TIME TWLEN NOP WRITE LENGTH TRDLN NOP READ LENGTH TRDAT BSS 50 TRACE ENTRIES @EOTB DEF * * * STORAGE FOR DRIVER TRACE: @TRBF DEF TRBUF @TDAT DEF TRDAT A&B BSS 2 TDPNT NOP DESTINATION POINTER. OLENT NOP OLD TRACE ENTRY. ELINK NOP ENTRY LINK. SPC 3 * * SUBROUTINE TO STORE A-REG IN BUFFER AND BUMP POINTER. * CALLING SEQUENCE: * JSB STBUF * STBUF NOP ENTRY. LDB @EOTB IF POINTER IS AT END CPB TDPNT OF TRACE BUFFER, JMP STBUF,I SKIP THE STORE. STA TDPNT,I STORE WORD. ISZ TDPNT BUMP POINTER. JMP STBUF,I RETURN. * ENTRY NOP POINTER INTO TRACE TABLE. EOTBL NOP LAST ADDRESS IN TABLE. SOTBL NOP FIRST ADDRESS IN TABLE. SPC 3 * * GET NEXT ENTRY IN EVENT TABLE * NXTEV NOP LDA ENTRY GET CURRENT ENTRY ADDRESS. INA ADD ONE. CPA EOTBL IF OUT OF TABLE, LDA SOTBL RESET TO BEGINNING. STA ENTRY STORE. LDA A,I A:=CONTENTS OF ENTRY. JMP NXTEV,I RETURN. * SKP * * SUBROUTINE TO CLEAN UP FOR FRESH START: * TELL UPLIN TO TIMEOUT ALL MASTER REQUESTS TO 3000 AND ZERO PNL LIST. * NEW REQUESTS ARE BLOCKED SINCE HP 3000 IS IN "DISCONNECT" STATUS. * CLNUP NOP JSB DCNCT ESTABLISH "DISCONNECT" STATUS. * IFN *** IFN CODE WILL BE ADDED LATER ************ * LOCK "QUEX ABORT" RN (GLOBALLY) SO UPLIN WILL CLEAN UP. * JSB RQRN DEF *+4 DEF LOCK DEF #QARN DEF TEMP XIF ********************************************** JSB OFFQZ MAKE QUEZ DORMANT. * *****WHEN ALL IS SAID AND DONE, THIS SECTION SHOULD BE REMOVED ************ HUPLN JSB PGMAD MAKE SURE QUEX DIDNT INTERRUPT UPLIN. * DEF *+4 * DEF UPLIN * DEF TEMP * DEF TEMP1 * *  * * LDA TEMP1 WAS UPLIN RUNNING? * SZA,RSS * JMP UPLN NO. * * * * JSB EXEC YES. GO INTO TIME LIST FOR * DEF *+6 500 MILLISECONDS. * DEF D12 * DEF D0 * DEF D1 * DEF D0 * DEF N50 * * * * JMP HUPLN GO CHECK UPLIN AGAIN. * * * * UPLN JSB EXEC HOLD OFF UPLIN BY PUTTING IN * DEF *+6 TIME LIST TO RUN IN ONE MINUTE. * DEF SCHTM * DEF UPLIN * DEF D3 * DEF D1 * DEF N1 * NOP IGNORE ERROR RETURN. * *************************************************************************** * LDA QXCLS QUEX CLASS # /NO DE-ALLOC (BIT13). IOR BIT15 SET NO-WAIT BIT (#15). STA CLASN RELEASE BUFFER. * FLUSH JSB EXEC FLUSH QUEX'S I/O CLASS. DEF *+5 DEF CLS21 DEF CLASN DEF D0 DEF D0 RSS IGNORE ERRORS. * SSA,RSS ANYTHING THERE? JMP FLUSH YES. KEEP FLUSHING. * IFN *************************************** * HANG ON "QUEX ABORT" RN UNTIL UPLIN FINISHES CLEANUP. EXT RNRQ JSB RNRQ DEF *+4 DEF LKCLR DEF #QARN DEF TEMP XIF *************************************** * ****** FOLLOWING CODE SHOULD BE MOVED TO UPLIN **************************** * * * * LDB #LDEF ADDR OF MASTER LIST HEADER ADDR. INB LDB B,I GET ADDR OF MASTER HEADER. CKMST STB LSTAD ADDR OF NEXT TCB ADDR. CKMS2 JSB LODWD (CROSS) LOAD ADDR OF NEXT TCB. SZA,RSS JMP PNLST NO MORE MASTER TCBS TO PROCESS. * * MASTER LIST ENTRY FOUND FOR AN ACTIVE MASTER REQUEST. ONLY IF * IT IS FOR A HP 3000 USER, SEND A 0-LEN TIMEOUT MESSAGE (IF THE * PROGRAM IS WAITING IN STATE 3) OR RELEASE THE I/O CLASS AND TCB. * STA NXTAD SAVE ADDR IN CASE LIST ISN'T CHANGED. LDB A INB POINT TO FLAGS-TIMEOUT WORD. JSB LODWD (CROSS) LOAD. RAL CHECK "3000 REQ" BIT. SSA,RSS SET? JMP CKMS3 NO. THIS IS A DS/1000 REQUEST! INB POINT TO TCB WORD 3. JSB LODWD (CROSS) LOAD SEQUENCE NUMBER. STA SEQ# SAVE FOR TCB RELEASE. INB POINT TO TCB WORD 4. JSB LODWD (CROSS) LOAD CLASS NUMBER. IOR BIT15 INCLUDE NO-WAIT BIT (#15), STA CLASN AND SAVE FOR CLASS # RELEASE. INB POINT TO ID SEG ADDR WORD. JSB LODWD (CROSS) LOAD ID SEG ADDR OF THIS USER. RAL,CLE,SLA,ERA CLEAR AND CHECK SIGN BIT. JMP CREPT "BAD CONTENTS" SET. CLEAR CLASS. ADA D15 POINT TO STATUS WORD. LDA A,I AND B17 ISOLATE STATUS. CPA D3 "WAIT" STATE? JMP NULRQ YES--SEND TIMEOUT. SPC 1 * * MASTER PROGRAM IS NOT WAITING WITH CLASS GET. CLEAR CLASS AND TCB. * CREPT JSB DEFLU RELEASE MASTER CLASS[ NUMBER (FLUSH). JSB #RSAX GO TO "RES" ACCESS ROUTINE. DEF *+3 DEF D6 CLEAR A LIST ENTRY. DEF SEQ# SEARCH, USING SEQ NUMBER. * LDB LSTAD LIST CHANGED. LSTAD POINTS TO NEW TCB. JMP CKMS2 GO CHECK FOR NEXT TCB. * * * WRITE A NULL REQUEST INTO THE MASTER REQUESTOR'S CLASS TO * INDICATE A TIMEOUT. * NULRQ JSB EXEC CLASS WRITE/READ, NO ABORT. DEF *+8 DEF CLS20 DEF ZBIT DEF D0 DEF D0 DEF D0 DEF D0 DEF CLASN NOP CKMS3 LDB NXTAD LIST UNCHANGED. GET NEXT ADDR. JMP CKMST SPC 3 * * REMOVE ALL ACTIVE HELLO'S FROM THE PROCESS NUMBER LIST. * PNLST CCB GET ADDR OF PNL HEADER. ADB #LDEF LDB B,I JSB LODWD (CROSS) LOAD ADDR OF NEXT PNL ENTRY. SZA,RSS (ALWAYS POINTS TO "FIRST" ENTRY) JMP CLTST DONE WITH PNL ENTRIES. * LDB A ADB D2 POINT TO 3RD WORD OF ENTRY. JSB LODWD (CROSS) LOAD THE PROCESS NUMBER. STA TEMP2 SAVE PROCESS NUMBER FOR SEARCH. * JSB #RSAX DELETE PROCESS NUMBER LIST ENTRY. DEF *+3 DEF D10 CODE FOR "REMOVE". DEF TEMP2 SEARCH, USING PROCESS NUMBER. * JMP PNLST GO CHECK NEXT ENTRY. SPC 1 * * CLEAN OUT ENTRIES IN TST * CLTST LDA #TST+1 GET # OF ENTRIES. SZA,RSS IF NONE, JMP CLNUP,I DONE. **SHOULDN'T HAPPEN** CMA,INA NEGATE FOR USE AS COUNTER. STA COUNT LDB #TST GET FIRST TST ADDRESS. * TLOOP STB ADDR SAVE CURRENT ADDRESS. JSB LODWD (CROSS)LOAD ENTRY. SZA,RSS IF ZERO, JMP BUMP LOOK AT NEXT TST ENTRY. STA STREM SAVE SLAVE STREAM NUMBER. INB JSB LODWD (CROSS) LOAD 2ND TST WORD. STA SEQ# STORE SEQUENCE NUMBER. INB GET TST WORD 3 JSB LODWD (HOLDING CLASS). CCE,SZA,RSS ZEwRO? JMP RLSLV YES--GO RELEASE SLAVE TCB. RAL,ERA SET BIT 15 TO DEALLOCATE CLASS STA CLASN AND FLUSH BUFFER. JSB DEFLU * RLSLV JSB #RSAX DELETE SLAVE TCB. DEF *+4 DEF D7 DEF SEQ# SEQUENCE NUMBER DEF STREM SLAVE STREAM * CLA (CROSS) STORE ZERO LDB ADDR IN TST WORD 1 JSB STRWD FOR RELEASE. * BUMP ADB D14 POINT TO NEXT TST ENTRY. ISZ COUNT STAY IN LOOP UNTIL JMP TLOOP COUNTER GOES TO 0. SPC 1 * * * * ***** END OF UPLIN CODE *************************************************** SPC 2 ***** THIS CODE SHOULD BE REMOVED ***************************************** JSB EXEC RESTORE UPLIN INTERVAL TO 5 SECONDS, * * DEF *+6 TO BEGIN IN 2 SECONDS. * * DEF SCHTM * * DEF UPLIN * * DEF D2 * * DEF D5 * * DEF N2 * * NOP IGNORE ERROR RETURN. * * * * ***** END OF REMOVABLE CODE *********************************************** * JMP CLNUP,I RETURN TO CALLER. SPC 2 CLMSK OCT 157777 SCHTM OCT 100014 UPLIN ASC 3,UPLIN LSTAD NOP NXTAD NOP ADDR NOP COUNT NOP SEQ# NOP D14 DEC 14 SD2 DEF 2,I ZBIT OCT 10000 SPC 3 ***** UPLIN CODE ********************************************************** *  * * * SUBROUTINE TO RELEASE AN I/O CLASS. * DEFLU NOP CCA STA TEMP2 SET RELEASE RETRY SWITCH TO -1. * CLRTN JSB EXEC RELEASE CLASS NUMBER. DEF *+5 DEF CLS21 SPECIFY CLASS GET - NO ABORT. DEF CLASN CLASS/RELEASE/NO WAIT. DEF D0 DEF D0 RSS ERROR RETURN. ISZ TEMP2 RELEASE PROCESSING COMPLETED? JMP DEFLU,I YES. RETURN. INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP DEFLU+1 NO. CONTINUE TO CLEAR REQUESTS. * LDA CLASN GET THE CLASS NUMBER AGAIN. AND CLMSK EXCLUDE THE NO-DEALLOC BIT (13). STA CLASN JMP CLRTN RETURN FOR FINAL DEALLOCATION. * * * * ****** END OF UPLIN CODE ************************************************** SKP ETABL DEF * TABLE OF ERROR MESSAGES FOR STATUS. DEF EM1 =1 DEF EM2 =2 DEF EM3 =3 DEF EM4 =4 NOP =5 NON-ABORTIVE (EOT RECEIVED). DEF EM6 =6 DEF EM7 =7 DEF EM8 =8 DEF EM9 =9 DEF EM10 =10 DEF EM11 =11 DEF EM12 =12 NOP =13 NON-ABORTIVE (SENT ENQ, GOT ENQ). DEF EM14 =14 DEF EM15 =15 DEF EM16 =16 DEF EM17 =17 @EM18 DEF EM18 =18 (ADDED CODE FOR SLC ERROR). @EM5 DEF EM5 * EM1 ASC 8,INVALID REQUEST EM2 ASC 8,WRONG LINE STATE EM3 ASC 8,BAD ID SEQUENCE EM4 ASC 8,HARDWARE FAILURE EM5 ASC 8,EOT RECEIVED EM6 ASC 8,DLE EOT RECEIVED EM7 ASC 8,TIMEOUT EM8 ASC 8,SENT EOT,GOT ENQ EM9 ASC 8,DATA OVERRUN EM10 ASC 8,MAX. NAKS RECV'D EM11 ASC 8,MAX # ENQ SENT EM12 ASC 8,RVI RECEIVED EM14 ASC 8,NAK RECEIVED EM15 ASC 8,MAX ENQ RECEIVEDg|NLH EM16 ASC 8,NO NAK TO TTD EM17 ASC 8,IMPOSSIBLE ERROR EM18 ASC 8,SLC INIT. ERROR * STMSG BYT 15,12 , ASC 18,>> HP 3000 COMMUNICATION LINK *DOWN* BYT 15,12 , EMSG ASC 18,>> **************** @ ********* BYT 15,12 , DEM11 DEF EMSG+11 UP ASC 3,* UP * DOWN ASC 3,*DOWN* DIALM ASC 15,>> HP 3000: READY FOR DIALING SNOFF ASC 11,>> HP 3000: DISCONNECT BDBUF ASC 16,>> HP 3000: BAD BUFFER RECEIVED DINSR DEF BDBUF+11 DRECV DEF *+1 ASC 5, RECEIVED DOUTG DEF *+1 ASC 5, OUTGOING * B37 OCT 37 MSGA1 DEF EMSG+2 N SKP * * CONSTANTS AND WORKING STORAGE. * Q$LID DEF LOCID LOCID NOP LOCAL ID BYTE COUNT. BSS 8 LOCAL ID, UP TO 15 CHAR. RCVID NOP RESERVED FOR PARAM FROM SLC. REMID NOP REMOTE ID BYTE COUNT. BSS 8 REMOTE ID, UP TO 15 CHAR. * D6 DEC 6 D7 DEC 7 NB10 OCT -10 NB20 OCT -20 B377 OCT 377 B140K OCT 140000 B1777 OCT 177700 BIT15 OCT 100000 BIT14 OCT 40000 BIT13 OCT 20000 LENBT OCT 17777 BITS 0-12 CLS20 DEF 20,I CLS21 DEF 21,I D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D15 DEC 15 B17 EQU D15 D19 DEC 19 D20 DEC 20 D39 DEC 39 D76 DEC 76 N1 DEC -1 N2 DEC -2 N7 DEC -7 N9 DEC -9 N16 EQU NB20 N50 DEC -50 QXCLS NOP QUEX CLASS NUMBER. QCLAS NOP (WITH NO-WAIT & SAVE-BUFFER BITS SET.) LOG NOP WORDS TO PROCESS IN CURRENT BUFFER LINK OCT 0 ARE WE MODEM OR HARD-WIRE? DCNFL OCT 0 SGNOF OCT 0 ENQFL OCT 0 IGNOR OCT 0 QUEZ ASC 3,QUEZ * CNTRL DEF *+1 TABLE OF CONTROL WORDS. CLRWD OCT 064400 CLEAR LIDSQ OCT 064000 LOCAL ID SEQUENCE RIDSQ OCT 064100 REMOTE ID SEQUENCE WNQWD OCT 020100 WRITE INQUIRY ERCWD OCT 064200 ERROR PARAMETERS CONWD OCT 022300 WRITE CONVERSATIONAL RESWD OCT 020400 WRITE RESET (EOT) RDIWD OCT 020200 READ INITIAL LCLWD OCT 060300 LINE CLOSE WRDIS OCT 020500 WRITE DISCONNECT (DLE EOT) DEC 0 DELIMITER. * OWLEN NOP STATS NOP CLASN NOP TEMP NOP TEMP1 NOP TEMP2 NOP RDLEN NOP * STRTM DEF *+1 BYT 10,0 INITIALIZATION REQUEST. DEC 0 B20 OCT 20 OCT 0,0,0,0,0 D16 EQU B20 * TRMRQ DEF *+1 BYT 10,0 TERMINATION REQUEST. DEC 0 B21 OCT 21 OCT 0,0,0,0,0 * XLEN ABS L MAX # WORDS PER TRANSMISSION. * WRADR DEF WRBUF ADDRESS OF WRITE BUFFER RDADR DEF RDBUF ADDRESS OF READ BUFFER * *** DO NOT C[{  HANGE ORDER OF NEXT THREE LINES ****** WRLEN NOP LENGTH OF WRITE BUFR (-BYTES). WRBUF BSS L WRITE BUFFER. RDBUF BSS L READ BUFFER. * BFLEN ABS -L-L MAX -CHAR LENGTH OF RECEIVE BUFFER. MXLEN ABS L MAX +WORD LENGTH OF TRANSMIT BUFFER. * BSS 0 *** SIZE OF QUEX **** * END QUEX V  C"f 91741-18004 1913 S C0222 DS/1000 MODULE: RQCNV QUEZ             H0102 ASMB,R,L,C HED 3000 REQUEST CONVERTER (C) HEWLETT-PACKARD CO. 1979 NAM RQCNV,19,25 91741-16004 REV 1913 790104 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT EXEC,$LIBR,$LIBX,$RNTB,#QXCL,RNRQ EXT #RSAX,#TST,#NULL,#LDEF,#TBRN EXT #RQCV,#QRN,#RPCV,$OPSY SPC 2 **************************** RQCNV ******************************* * * * SOURCE: 91741-18004 * * * * BINARY: 91741-16004 * * * * PROGRAMMER: JIM HARTSELL * * * * FEBRUARY 14, 1977 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 7, 1978 * * * ****************************************************************** SPC 2 L EQU 304 MAXIMUM LINE BUFFER SIZE. DBL EQU 512 MAXIMUM SLAVE DATA LENGTH. * * RQCNV IS THE INTERFACE TO THE DS/1000 SLAVE MONITORS FOR REQUESTS * ORIGINATING FROM THE HP 3000. ALL INCOMING REQUESTS ARE CONVERTED * TO DS/1000 FORMATS FOR PROCESSING AT THE RTE SYSTEM. a* SUP A EQU 0 B EQU 1 SPC 1 RQCNV LDA $OPSY RAR,SLA IS THIS AN RTE-III OR IV? RSSI RSS YES. JMP GET NO. LDB RSSI GET "RSS" INSTRUCTION. STB MODI2 MODIFY TO DO CROSS-MAP LOAD. STB MODI3 MODIFY TO DO CROSS-MAP STORE. DLD MWII MODIFY TO DO "MWI" DST DMS2 CROSS-MAP MOVE. DLD MWFI MODIFY TO DO "MWF" DST DMS3 CROSS-MAP MOVE. * ************************************************************ * * * MAIN PROCESSING SECTION FOR ALL REQUESTS FROM THE 3000. * * * ************************************************************ * GET EQU * * JSB EXEC WAIT FOR A REQUEST. DEF *+5 DEF CLS21 DEF #RQCV RQCNV'S I/O CLASS. DEF RQBUF 3000 REQUEST BUFFER. DEF MAXRQ NOP IGNORE ERRORS. * STB RCVLN SAVE ACTUAL # WORDS RECEIVED. CLA CLEAR TST POINTER INTO S.A.M. STA TSTAD STA STREM CLEAR LOCAL TST HEADER. STA LCSEQ STA HLDCL STA MCLAS STA FCNCD STA MASK * LDA PARMA CLEAR DS/1000 REQUEST BUFFER AREA. STA TEMP LDB PRMBL CMB,INB CLA CLR STA TEMP,I ISZ TEMP INB,SZB JMP CLR * **** EVENTUALLY, BREAK SHOULD BE HANDLED BY REMOTE SESSION MONITOR **** LDA RQ0 CHECK FOR MESSAGE CLASS 6, AND B377 STREAM 22 OCTAL (BREAK). ALF,ALF STA B LDA RQ2 AND B377 IOR B CPA M6S22 JMP SNREP YES. JUST SEND A REPLY. * * CHECK TRANSACTION STATUS TABLE (TST) FOR MATCHING SEQUENCE # * IN 8-WORD FIXED-FORMAT HEADER. A MATCH WILL BE FOUND FOR * RFA/P-TO-P/DEXEC WRITE AND READ CONTINUATIONS. NOTE THAT * THE CONTINUATION BIT IS NOT SET IF THIS IS THE LAST ONE. * DLD #TST GET TST ADDR AND # OF ENTRIES. STA TEMP CMB,INB STB TEMP1 SZA SZB,RSS JMP REJCT REJECT IF NO TST. (SHOULDN'T HAPPEN) * TSTLP LDB TEMP CHECK NEXT ENTRY. JSB LODWD ENTRY IN USE? SZA,RSS JMP NXTST NO. GO ON TO NEXT ENTRY. INB YES. JSB LODWD (CROSS) LOAD LOCAL SEQ. #. CPA RQ5 JMP CONT1 MATCH. GO PROCESS CONTINUATION. * NXTST LDB TEMP BUMP TO NEXT ENTRY. ADB TSTLN STB TEMP ISZ TEMP1 JMP TSTLP * * NO TST ENTRY. PERFORM "GRPM" FUNCTIONS FOR NEW REQUEST. * LDA RQ0 IF WORD COUNT BYTE = 8, THIS ALF,ALF IS A RESIDUAL CONTINUATION AND B377 REQUEST AFTER A TIMEOUT. CPA D8 JMP REJCT * LDB #NULL SZB,RSS ANY TCBS AVAILABLE? JMP REJCT NO. REJECT. * LDA RQ0 GET 3000 MESSAGE CLASS. AND B377 STA TEMP1 LDA RQ2 GET 3000 STREAM TYPE. AND B377 STA TEMP2 * LDB MAPTB MAP DS/3000 MSG CLASS AND STB TEMP STREAM TO DS/1000 STREAM. * MAPLP LDA B,I GET NEXT MAP TABLE ENTRY. CPA N1 JMP REJCT NOT IN TABLE. CPA TEMP1 COMPARE MESSAGE CLASS. RSS JMP NMACH NO MATCH ON THIS ONE. * INB MATCH. LDA B,I COMPARE DS/3000 STREAM TYPE. SZA IF TABLE ENTRY = 0, IT'S A MATCH. CPA TEMP2 NON-ZERO: TEST IT. JMP MATCH MATCH. GO GET DS/1000 STREAM TYPE. * NMACH LDB TEMP BUMP TO NEXT MAP TABLE ENTRY. ADB D3 STB TEMP JMP MAPLP CONTINUE SEARCH. * MATCH INB LDA B,I GET DS/1000 STREAM TYPE. STA STREM * ADA #LDEF ADA D2 POINT TO LIST HEADER POINTER. LDB A,I POINT TO LIST HEADER. INB LDA B,I STA MCLAS SAVE MONITOR'S CLASS #. INB LDB B,I GET ID SEG ADDR OF MONITOR. RBL,CLE,ERB SZB,RSS IF MONITOR NOT ENABLED, JMP REJCT REJECT REQUEST. ADB D15 LDA B,I AND D15 CPA D4 AVAILABLE MEMORY SUSPEND? JMP REJCT YES. REJECT THE REQUEST. * LDB $RNTA RSS LDB B,I RESOLVE INDIRECT. RBL,CLE,SLB,ERB JMP *-2 LDA #QRN GET QUIESCENT RN. AND B377 ISOLATE TABLE INDEX. ADB A COMPUTE POSITION IN RN TABLE. LDA B,I GET IT. AND B377 SZA QUIESCING? JMP REJCT YES. SEND IT BACK. STA PARMB+2 SET SOURCE NODE # = 0. * CCA SET DESTINATION NODE = LOCAL. STA PARMB+3 * JSB #RSAX BUILD TCB FOR THIS STREAM. DEF *+5 DEF D3 DEF D0 PASS ORIGINATORS SEQUENCE # DEF STREM & STREAM DEF PARMB+2 & ORIGIN NODE #. * SSB OK? JMP REJCT NO. STA PARMB+1 YES. STORE SEQ # IN PARMB. STA LCSEQ SAVE FOR TST ENTRY. * INB SET "3K" BIT IN WORD 2 OF TCB. JSB LODWD IOR BIT14 JSB STRWD ADB D2 LDA LCSEQ STORE "LOCAL SEQ #" AS JSB STRWD "ORIG SEQ #" IN TCB. * LDB #NULL IF WE USED SZB LAST TCB, JMP OK JSB RNRQ LOCK TABLE DEF *+4 ACCESS RN DEF LGNW [GLOBAL LOCK] DEF #TBRN [NO WAIT] DEF TEMP [NO ABORT] * * IF CONTINUATION BIT IS SET IN DS/3000 REQUEST, ALLOCATE * A HOLDING CLASS FOR COLLECTION OF DATA BLOCKS BEFORE * PASSING REQUEST TO DS/1000 MONITOR. * OK LDA RQ2 BIT 13 OF STREAM WORD RAL,RAL IS CONTINUATION BIT. SSA,RSS JMP CONV NO CONTINUATION. * LDA B1315 INITIALIZE CLASS # FOR STA HLDCL NO RELEASE & NO WAIT. * JSB EXEC Ȓ QUICK ALLOCATE - NO ABORT. DEF *+5 DEF CLS19 CLASS CONTROL. DEF D0 LU = "BIT BUCKET" FOR ALLOCATION. DEF D0 DUMMY PARAM FOR ALLOCATION. DEF HLDCL CLASS NUMBER STORAGE ADDRESS. JMP REJCT ERROR. * JSB EXEC COMPLETE PREVIOUS ALLOC. REQUEST. DEF *+5 DEF CLS21 CLASS GET - NO ABORT. DEF HLDCL DEF D0 DEF D0 JMP REJCT ERROR. * * CONVERT DS/3000 REQUEST TO DS/1000 FORMAT. * CONV JSB D1000 * STA RQLEN SAVE LENGTH OF DS/1000 REQUEST. * * BUILD ENTRY IN TRANSACTION STATUS TABLE (TST). * DLD #TST FIND EMPTY SLOT (AVAIL. ENTRY). STA TEMP CMB,INB STB TEMP1 BLOOP LDB TEMP CHECK NEXT ENTRY. JSB LODWD CROSS LOAD WORD 1. SZA,RSS ZERO? JMP STTST YES. (B) = ADDR IN S.A.M. * LDB TEMP NO. GO TO NEXT ENTRY. ADB TSTLN STB TEMP ISZ TEMP1 JMP BLOOP JMP REJCT NO AVAILABLE ENTRY. * STTST STB TSTAD SAVE ADDR OF TST ENTRY IN S.A.M. LDA TSTLN LENGTH OF A TST ENTRY. CAX PREPARE FOR A DMS "MWI". LDA LTSTA GET LOCAL TST AREA ADDRESS. JSB $LIBR NOP DMS2 MVW TSTLN MOVE ENTRY TO TST [DMS: "MVI"]. JSB $LIBX DEF *+1 DEF *+1 * STDL LDB ARQ0 PREPARE FOR DATA ADDRESS POINTER. LDA RQ0 IS THERE DATA? ALF,ALF AND B377 ADB A STB DABUF SET ADDR OF POSSIBLE DATA. ADA N8 CMA,INA LDB RQ7 INB BRS ADA B STA DALEN SAVE LENGTH OF DATA (OR ZERO). * * CHECK IF THERE WILL BE A CONTINUATION OF DATA. * LDA RQ2 CONTINUATION BIT SET IN RAL,RAL DS/3000 REQUEST? SSA JMP CONT2 YES. GO USE HOLDING CLASS. * * CLASS WRITE THE DS/1000 REQUEST TO REQUIRED MONITOR. * PUT JSB EXEC DO CLASS WRITE/READ. t DEF *+8 DEF CLS20 NO ABORT. DEF CONWX CONTROL WORD W/"Z" BIT & "WRITE". DEF DABUF,I DATA ADDRESS. DEF DALEN DATA LENGTH (COULD BE ZERO). DEF PARMB REQUEST ADDRESS. DEF RQLEN REQUEST LENGTH. DEF MCLAS I/O CLASS OF MONITOR. JMP REJCT ERROR RETURN. * JMP GET GO GET NEXT REQUEST. SKP * * PROCESS CONTINUATION REQUEST. * CONT1 LDA TEMP SAVE ADDR OF TST ENTRY IN S.A.M. STA TSTAD * LDA RQ0 IF REQUEST IS A ALF,ALF CONTINUATION AND B377 WITHOUT DATA, ADA N8 CLE,ELA CMA,INA ADA RQ7 SZA PASS IT TO RPCNV. JMP CONRQ (OTHERWISE PROCESS CONT.) SPC 1 ************************************************************ * * * LET RPCNV HANDLE INTERMEDIATE CONTINUATION REQUESTS FOR * * DREAD/PREAD/DEXEC(1). * * * ************************************************************ * JSB EXEC CLASS WRITE/READ TO RPCNV. DEF *+8 DEF CLS20 NO ABORT. DEF D0 SEND ONLY ONE BUFFER. DEF RQBUF DS/3000 CONT. REQ. DEF D8 # OF WORDS. DEF D8 FLAG TO RPCNV. DEF TSTAD TST ENTRY ADDR. DEF #RPCV REPLY CONVERTER CLASS. JMP REJCT ERROR RETURN. JMP GET GET NEXT REQUEST. SPC 1 ************************************************************ * * * SECONDARY SECTION FOR DWRIT/PWRIT/DEXEC(2) WHEN DATA * * RECORD LENGTH IS GREATER THAN 256 WORDS (CONTINUATIONS). * * * ************************************************************ * CONRQ LDA D6 MOVE 1ST 6 WORDS OF TST ENTRY  CAX TO LOCAL TST STORAGE AREA. LDA TSTAD LDB LTSTA JSB $LIBR NOP DMS3 MVW D6 MOVE: [DMS: "MWF"]. JSB $LIBX DEF *+1 DEF *+1 * JSB #RSAX IS SLAVE TCB STILL AROUND? DEF *+4 DEF D5 DEF LCSEQ DEF STREM * SSB JMP REJCT NO! REJECT. * LDB ARQ0 YES. SET DATA POINTER & LENGTH. LDA RQ0 ALF,ALF AND B377 ADB A STB DABUF ADA N8 CMA,INA LDB RQ7 INB BRS ADA B STA DALEN * JMP CONT3 GO STACK THE DATA BLOCK. * * WRITE DS/1000 REQUEST TO HOLDING CLASS. LOCAL TST STORAGE * AREA CONTAINS APPLICABLE TST ENTRY. * CONT2 JSB EXEC WRITE THE DS/1000 REQUEST TO DEF *+8 THE HOLDING CLASS. DEF CLS20 DEF D0 DEF PARMB ADDRESS OF REQUEST. DEF RQLEN LENGTH. DEF RQLEN DEF D0 DEF HLDCL JMP REJCT ERROR. * * WRITE THE DATA BLOCK TO THE HOLDING CLASS. LOCAL TST * STORAGE AREA CONTAINS APPLICABLE TST ENTRY. * CONT3 JSB EXEC WRITE DATA BLOCK TO HOLDING CLASS. DEF *+8 DEF CLS20 DEF D0 DEF DABUF,I ADDRESS OF DATA. DEF DALEN LENGTH OF THIS BLOCK. DEF DALEN DEF D0 DEF HLDCL JMP REJCT ERROR. * LDA RQ2 CONTINUATION BIT SET (IS THERE MORE?). RAL,RAL SSA,RSS JMP GATHR NO. GO PREPARE FOR MONITOR. * * SEND INTERMEDIATE REPLY FOR THIS CONTINUATION REQUEST. * SNREP LDA RQ0 SET WDCNT = 8. AND B377 IOR LFT8 STA RQ0 LDA RQ2 SET REPLY BIT. IOR BIT15 STA RQ2 LDA RQ4 REVERSE PROCESS NUMBERS. ALF,ALF STA RQ4 LDA LCSEQ STORE LOCAL SEQUENCE NUMBER. STA RQ5 CLA SET N = 0. STA RQ7 * LDA #QXCL SSA JMP GET LINE L IS DISCONNECTED. IGNORE. * JSB EXEC WRITE "REPLY" TO QUEX'S CLASS. DEF *+8 DEF CLS20 DEF D0 DEF RQBUF DEF D8 DEF D8 DEF D0 DEF #QXCL JMP REJCT ERROR. * JMP GET GO WAIT FOR CONTINUATION. * * GATHER DS/1000 REQUEST AND DATA BLOCKS FOR * PASSAGE TO DS/1000 SLAVE MONITOR. * GATHR JSB EXEC GET DS/1000 REQUEST. DEF *+6 DEF CLS21 DEF HLDCL NO WAIT, NO RELEASE. DEF PARMB DEF PRMBL DEF LOG JMP REJCT ERROR. * SSA ANYTHING THERE? JMP REJCT NO. * LDA LOG STA RQLEN SAVE LEN OF DS/1000 REQUEST. * LDA ARQ8 INIT DATA BUFFER POINTER. STA DABUF SET POINTER TO DATA. STA TEMP CLA INIT TOTAL DATA LENGTH. STA DALEN * GDATA JSB EXEC GET A DATA BLOCK. DEF *+6 DEF CLS21 DEF HLDCL NO WAIT, NO RELEASE. DEF TEMP,I DATA BUFFER POINTER. DEF MAXDA MAX DATA LENGTH. DEF LOG JMP REJCT ERROR. * SSA,RSS ANYTHING THERE? JMP ADJST YES. LDA DALEN NO. DID WE GET ANY DATA? SZA,RSS JMP REJCT NO. REJECT. JSB RLEAS YES. RELEASE HOLDING CLASS. JMP PUT GO SEND REQUEST TO MONITOR. * ADJST LDA TEMP ADJUST FOR NEXT DATA BLOCK. ADA LOG STA TEMP LDA DALEN ADA LOG STA DALEN * JMP GDATA GET MORE DATA. SKP * * SEND A "REJECT" REPLY TO THE 3000 FOR THIS REQUEST. * LOCAL TST STORAGE AREA CONTAINS CURRENT TST 6-WORD HEADER * AND FIXED-FORMAT HEADER FROM CURRENT REQUEST. "TSTAD" * CONTAINS ADDRESS OF TST ENTRY IN S.A.M. * REJCT LDB TSTAD DELETE TST ENTRY IN S.A.M. CLA SZB SKIP IF NO TST CREATED. JSB STRWD * LDA LCSEQ WAS SLAVE TCB CREATED? SZA,RSS JMP HLD NO. * !JSB #RSAX YES. DELETE SLAVE TCB. DEF *+4 DEF D7 DEF LCSEQ DEF STREM * HLD LDA HLDCL HOLDING CLASS ALLOCATED? SZA JSB RLEAS YES. RELEASE IT. * LDA RQ2 SET REJECT BIT IN REQUEST. IOR BIT14 STA RQ2 LDA D8 STA RQLEN JMP SNREP GO SEND REJECT REPLY. SPC 3 * * SUBROUTINE TO FLUSH AND RELEASE THE HOLDING CLASS. * RLEAS NOP * CREPT CCA SET RELEASE RE-TRY SWITCH STA TEMP TO -1. * CLRTN JSB EXEC RELEASE CLASS NUMBER. DEF *+5 DEF CLS21 NO ABORT. DEF HLDCL HOLDING CLASS #. DEF D0 DEF D0 RSS * ISZ TEMP RELEASE PROCESSING COMPLETED? JMP RLEND YES. INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP CREPT NO. CONTINUE TO CLEAR REQUESTS. * LDA HLDCL YES. SET FOR DE-ALLOCATE. AND CLMSK STA HLDCL JMP CLRTN DO FINAL DEALLOCATION. * RLEND CLA CLEAR SLOT IN LOCAL TST. STA HLDCL LDB TSTAD IF TST ENTRY EXISTS, SZB,RSS JMP RLEAS,I ADB D2 CLEAR SLOT THERE, TOO. JSB STRWD JMP RLEAS,I RETURN TO CALLER. SKP * * SUBROUTINE TO LOAD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I (RSS IF DMS SYSTEM) JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I * MWII MWI NOP * MWFI MWF NOP SPC 3 * * SUBROUTINE TO STORE INTO ALTERNATE MAP (IF RTE-III OR IV). * STRWD NOP JSB $LIBR NOP MODI3 STA B,I (RSS IF DMS SYSTEM) JMP OUT XSA B,I STORE WORD INTO ALTERNATE MAP. OUT JSB $LIBX DEF STRWD SKP ************************************************************** * * * SUBROUTINE TO CONVERT DS/3000 REQUESTS T<O DS/1000 FORMAT. * * * ************************************************************** * D1000 NOP * * KEY OFF 3000 MESSAGE CLASS NUMBER. * LDA RQ0 AND B377 ISOLATE MESSAGE CLASS. ADA N3 SUBRACT 3. LDB D5 JSB BNDCK CHECK RANGE: 0 - 5. ADA JTAB1 TABLE ADDRESS + MESSAGE CLASS. LDA A,I LDB RQ2 GET DS/3000 STREAM WORD. JMP A,I GO TO MESSAGE CLASS PROCESSORS. * JTAB1 DEF *+1 DEF MSCL3 OPERATOR COMMAND. DEF MSCL4 PREAD/PWRIT/PCONT. DEF MSCL5 $STDLIST/$STDIN. DEF REJCT DEF MSCL7 POPEN/PCLOS. DEF MSCL8 RFA/DEXEC. * ************************************************ * MESSAGE CLASS 3 ..... OPERATOR COMMANDS. * ************************************************ * MSCL3 CPB B20 RSS JMP REJCT ILLEGAL STREAM TYPE. * LDA D7 STORE DS/1000 STREAM TYPE. IOR BIT3K SET "3K" BIT. STA PARMB LDA RQ7 STORE COMMAND LENGTH. STA PARMB+4 (+ BYTES) INA ARS CONVERT +BYTES TO +WORDS. STA TEMP * CMA,INA CHECK LENGTH AGAINST LIMIT. ADA PRMBL ADA N5 SSA JMP REJCT COMMAND IS TOO LONG. REJECT. * LDA ARQ8 MOVE ASCII COMMAND. LDB NAMA MVW TEMP * LDA TEMP SET LENGTH OF DS/1000 REQUEST. ADA D5 JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 4 ..... PREAD/PWRIT/PCONT. * ************************************************ * MSCL4 LDA D4 STORE DS/1000 STREAM TYPE. IOR BIT3K SET "3K" BIT. STA PARMB LDA B GET DS/3000 STREAM WORD. AND B377 ISOLATE STREAM. ADA NB22 SUBRACT 22 OCTAL. LDB D2 JSB BNDCK CHECK RANGE: 0 - 2. ADA D2 FORM PTOP FCODE.  STA PARMB+7 STORE IN REQUEST. STA FCNCD STORE IN TST ENTRY. * LDA ARQ10 MOVE PCB AND TAG FIELD. LDB PCBA MVW D23 * LDA FCNCD CPA D4 JMP MSC4A SKIP IF PCONT. LDA RQ9 CHECK FOR DATA LIMIT. JSB LIMCK STB PARMB+10 STORE IL PARAM IN PARMB. * MSC4A LDA D31 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 5 ..... $STDLIST/$STDIN * ************************************************ * MSCL5 LDA RCVLN CHECK LENGTH AGAINST LIMIT. CMA,INA ADA PRMBL LDB PRMBL SSA STB RCVLN TOO LONG. TRUNCATE MESSAGE. * LDA ARQ0 MOVE REQ TO PARMB AREA. LDB PARMA MVW RCVLN LDA LCSEQ STORE SEQUENCE NUMBER. STA PARMB+5 * LDA RCVLN SET LENGTH OF REQUEST. STA RQLEN JMP STDL PASS ON TO "CNSLM". * ************************************************ * MESSAGE CLASS 7, STREAM 21 ..... POPEN/PCLOS.* ************************************************ * MSCL7 LDA B AND B377 CPA B21 RSS JMP REJCT ILLEGAL STREAM. * LDA D4 STORE DS/1000 STREAM TYPE. IOR BIT3K SET "3K" BIT. STA PARMB * LDA RQ10 GET DS/3000 "RFA" CODE. AND B377 ADA NB25 SUBTRACT 25 OCTAL. LDB D1 JSB BNDCK CHECK RANGE: 0 - 1. SZA JMP PCLOS * * CONVERT POPEN REQUEST. * CLA,INA STORE PTOP FCODE. STA PARMB+7 STA FCNCD STORE IN TST ENTRY. * LDA ARQ11 MOVE PROGRAM NAME. LDB PCBA MVW D3 LDA ARQ29 MOVE TAG FIELD. LDB PCBA ADB D3 MVW D20 * LDA RQ55 STORE POPEN MASK IN TST ENTRY. STA MASK * LDA D31 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * * CONVERT PCLOS REQUEST. <* PCLOS LDA D5 STORE PTOP FCODE. STA PARMB+7 STA FCNCD STORE IN TST ENTRY. * LDA ARQ11 MOVE PCB. LDB PCBA MVW D3 * LDA D11 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I * ************************************************ * MESSAGE CLASS 8, STREAM 20 ..... RFA. * ************************************************ * MSCL8 LDA B AND B377 CPA B20 RSS JMP STM21 STREAM 21 IS DEXEC. * LDA D6 STORE DS/1000 STREAM TYPE. IOR BIT3K SET "3K" BIT. STA PARMB LDA ARQ12 MOVE DCB (GARBAGE FOR DSTAT). LDB NAMA MVW D3 * LDA RQ8 GET FCN CODE FROM DS/3000 REQUEST. ADA N150 SUBRACT 150. LDB D12 JSB BNDCK CHECK RANGE: 0 - 12. ADA JMAP1 TABLE ADDRESS + 3000 FCN CODE. LDA A,I GET DS/1000 FCN CODE. STA PARMB+4 STORE IN DS/1000 REQUEST. STA FCNCD STORE IN TST ENTRY. * ADA JTAB3 TABLE ADDRESS + 1000 FCN CODE. LDB A,I LDA XEQT GET ID SEG ADDR OF RQCNV (DUMMY). JMP B,I GO CONVERT THE RFA REQUEST. * JMAP1 DEF *+1 DS/3000 - DS/1000 FCN MAPPING TABLE. D3 DEC 3 DCRET D8 DEC 8 DPURG D6 DEC 6 DOPEN D12 DEC 12 DWRIT D9 DEC 9 DREAD D7 DEC 7 DPOSN D11 DEC 11 DWIND D1 DEC 1 DCLOS D5 DEC 5 DNAME D2 DEC 2 DCONT D4 DEC 4 DLOCF D0 DEC 0 DAPOS D10 DEC 10 DSTAT * JTAB3 DEF *+1 TABLE OF CONVERSION ROUTINE ADDRESSES. DEF DAPOS DEF DCLOS DEF DCONT DEF DCRET DEF DLOCF DEF DNAME DEF DOPEN DEF DPOSN DEF DPURG DEF DREAD DEF DSTAT DEF DWIND DEF DWRIT * * CONVERT DS/3000 RFA REQUEST TO DS/1000 FORMAT. * DAPOS STA PARMB+5 LDA RQ15 MOVE RECNUNLHM PARAM. STA PARMB+8 LDA RQ16 MOVE REL BLOCK PARAM. STA PARMB+9 LDA RQ17 MOVE BLOCK OFFSET PARAM. STA PARMB+10 * LDA D11 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DCLOS STA PARMB+5 LDA RQ15 MOVE ITRUN PARAM. STA PARMB+8 LDA D9 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DCONT STA PARMB+5 DLD RQ15 MOVE ICON1, ICON2 DST PARMB+8 * LDA D10 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DCRET STA PARMB+9 LDA RQ19 MOVE ICR PARAM. STA PARMB+8 LDA RQ18 MOVE ISECU PARAM. STA PARMB+10 DLD RQ15 MOVE ISIZE(1), ISIZE(2). DST PARMB+11 LDA RQ17 MOVE ITYPE PARAM. STA PARMB+13 * LDA D14 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DLOCF STA PARMB+5 LDA D8 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DNAME STA PARMB+9 LDA RQ19 MOVE ICR PARAM. STA PARMB+8 LDA RQ18 MOVE ISECU PARAM. STA PARMB+10 DLD RQ15 MOVE NEWNAME PARAM. DST PARMB+11 LDA RQ17 STA PARMB+13 * jN LDA D14 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DOPEN STA PARMB+9 LDA RQ17 MOVE ICR PARAM. STA PARMB+8 LDA RQ16 MOVE ISECU PARAM. STA PARMB+10 LDA RQ15 MOVE IOPTN PARAM. STA PARMB+11 * LDA D12 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DPOSN STA PARMB+5 LDA RQ15 MOVE NUR PARAM. STA PARMB+8 LDA RQ16 MOVE ICR PARAM. STA PARMB+9 * LDA D10 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DPURG STA PARMB+9 LDA RQ16 MOVE ICR PARAM. STA PARMB+8 LDA RQ15 MOVE ISECU PARAM. STA PARMB+10 * LDA D11 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DREAD STA PARMB+5 LDA RQ15 MOVE IL PARAM. STA PARMB+8 LDA RQ17 MOVE NUM PARAM. STA PARMB+9 * LDA D10 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DSTAT CLA STA PARMB+5 STA PARMB+6 * LDA D7 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DWIND STA PARMB+5 LDA D8 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. .q * DWRIT STA PARMB+5 LDA RQ15 MOVE IL PARAM. STA PARMB+8 LDA RQ16 MOVE NUM PARAM. STA PARMB+9 * LDA RQ10 CHECK FOR DATA LIMIT. JSB LIMCK * LDA D10 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 8, STREAM 21 ..... DEXEC. * ************************************************ * STM21 CPA B21 RSS JMP REJCT ILLEGAL STREAM TYPE. * LDA D5 STORE DS/1000 STREAM TYPE. IOR BIT3K SET "3K" BIT. STA PARMB * LDA RQ12 GET RCODE FROM DS/3000 REQUEST. ADA N1 SUBTRACT 1. LDB D12 JSB BNzDCK CHECK RANGE: 0 - 12. LDB A STORE RCODE IN TST ENTRY. INB STB FCNCD STB PARMB+4 STORE RCODE FOR DS/1000. ADA JTAB4 TABLE ADDRESS + RCODE. LDA A,I JMP A,I GO CONVERT THE DEXEC REQUEST. * JTAB4 DEF *+1 TABLE OF CONVERSION ROUTINE ADDRESSES. DEF DEX1 READ DEF DEX1 WRITE (SAME AS READ) DEF DEX3 I/O CONTROL. DEF REJCT DEF REJCT DEF REJCT DEF REJCT DEF REJCT DEF REJCT DEF DEX10 SCHEDULE DEF DEX11 TIME DEF DEX12 EXECUTION TIME DEF DEX13 I/O STATUS * * CONVERT DS/3000 DEXEC REQUEST TO DS/1000 FORMAT. * DEX1 LDA RQ13 MOVE ICNWD PARAM. STA PARMB+5 LDA RQ14 MOVE IBUFL PARAM. STA PARMB+6 DLD RQ15 MOVE IPRM1, IPRM2. DST PARMB+7 * LDA RQ10 CHECK FOR DATA LIMIT. JSB LIMCK * LDA D9 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX3 LDA RQ13 MOVE ICNWD PARAM. STA PARMB+5 LDA RQ14 MOVE IPRAM STA PARMB+6 * LDA D7 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX10 LDA ARQ13 MOVE PROG NAME & 5 PARAMS. LDB NAMA MVW D8 * LDA D13 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX11 LDA D13 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX12 LDA ARQ13 MOVE PROGRAM NAME. LDB NAMA MVW D3 DLD RQ16 MOVE IRESL, MULT PARAMS. DST PARMB+8 LDA RQ18 MOVE IOFST/IHRS PARAM. STA PARMB+10 SSA JMP DX12A NEGATIVE - DONE WITH THIS ONE. * DLD RQ19 MOVE MINS, ISECS. DST PARMB+11 LDA RQ21 MOVE MSECS. STA PARMB+13 LDA D14 SET LENGTH OF DS 1000 REQUEST. RSS * DX12A LDA D11 SET LENGTH OF DS/Y1000 REQUEST. JMP D1000,I RETURN. * DEX13 LDA RQ13 MOVE ICNWD PARAM. STA PARMB+5 * LDA D10 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. SKP * * SUBROUTINE TO CHECK IF INDEX IS WITHIN SPECIFIED RANGE. * (A) = INDEX (PRESERVED) (B) = UPPER LIMIT. * REQUEST IS REJECTED IF OUT OF BOUNDS. * BNDCK NOP STA LOC SAVE A-REGISTER. SSA JMP REJCT REJECT IF NEGATIVE. CMA,INA ADA B SSA JMP REJCT REJECT IF BEYOND LIMIT. LDA LOC RESTORE A-REGISTER. JMP BNDCK,I RETURN. * LOC OCT 0 SPC 3 * * SUBROUTINE TO CHECK IF DATA LENGTH EXCEEDS DS/1000 LIMIT. * LIMCK NOP (A) = TCOUNT: -BYTES OR +WORDS. SSA,RSS JMP LIM1 + WORDS. CMA,INA - BYTES. CONVERT TO +WORDS. INA ARS LIM1 STA B SAVE WORD COUNT IN B-REG. CMA,INA ADA MAXDA SSA JMP REJCT EXCEEDS LIMIT. REJECT. JMP LIMCK,I SKP * * CONSTANTS AND WORKING STORAGE. * * MAPPING TABLE BETWEEN DS/3000 AND DS/1000 STREAM TYPES. * * WORD 1 = DS/3000 MESSAGE CLASS. * WORD 2 = DS/3000 STREAM (0 = DON'T CARE). * WORD 3 = DS/1000 STREAM TYPE. * MAPTB DEF *+1 OCT 3,0,7 RTE COMMANDS - OPERM OCT 4,0,4 SLAVE PREAD/PWRIT/PCONT - PTOPM OCT 5,0,2 $STDLIST/$STDIN - CNSLM OCT 7,21,4 SLAVE POPEN/PCLOS - PTOPM OCT 10,20,6 RTE FMP RFA - RFAM OCT 10,21,5 REMOTE EXEC (DEXEC) - EXECM OCT -1 DELIMITER FOR MAP TABLE. * XEQT EQU 1717B LGNW OCT 140002 USED FOR RN LOCK B20 OCT 20 B21 OCT 21 B377 OCT 377 B1315 OCT 120000 BIT14 OCT 40000 BIT15 OCT 100000 BIT3K EQU BIT15 "3K" BIT FOR DS/1000 STREAM WORD. CLMSK OCT 117777 LFT8 BYT 10,0 DECIMAL 8, LEFT BYTE. CONWX OCT 10100 CLS19 DEF 19,I CLS20 DEF 20,I CLS21 DEF 21,I M6S22 BYT 6,22 CLASS 6, STREAM 22. D13 DEC 13 D14 DEC 14 D15 DEC 15 D20 DEC 20 D23 DEC 23 D31 DEC 31 N1 DEC -1 N3 DEC -3 N5 DEC -5 N8 DEC -8 N150 DEC -150 NB22 OCT -22 NB25 OCT -25 $RNTA DEF $RNTB LOG NOP TEMP NOP TEMP1 NOP TEMP2 NOP RCVLN NOP RQLEN NOP DABUF NOP DALEN NOP * PRMBL DEC 50 MAX LENGTH OF DS/1000 REQUEST. PARMB BSS 50 DS/1000 REQUEST BUFFER. PARMA DEF PARMB NAMA DEF PARMB+5 PCBA DEF PARMB+8 * TSTAD NOP ADDR OF TST ENTRY IN S.A.M. TSTLN DEC 14 LENGTH OF TST ENTRY. LTSTA DEF STREM ADDR OF LOCAL TST AREA. ******************************************************************** STREM NOP * * DS/1000 STREAM TYPE * LCSEQ NOP * L * LOCAL SEQUENCE NUMBER * HLDCL NOP * O T * HOLDING CLASS NUMBER * MCLAS NOP * C S * MONITOR CLASS NUMBER * FCNCD NOP * A T * CALL TYPE * MASK NOP * L * MASK WORD FOR POPEN * RQBUF BSS 8 * * DS/3000 FIXED FORMAT HEADER, * ******************************************************************** BSS L-8 PLUS REQUEST BUFFER. BSS DBL-L+8 EXTRA ROOM FOR DATA ACCUMULATION. * MAXRQ ABS L MAXDA ABS DBL * RQ0 EQU RQBUF RQ2 EQU RQBUF+2 RQ4 EQU RQBUF+4 RQ5 EQU RQBUF+5 RQ7 EQU RQBUF+7 RQ8 EQU RQBUF+8 RQ9 EQU RQBUF+9 RQ10 EQU RQBUF+10 RQ11 EQU RQBUF+11 RQ12 EQU RQBUF+12 RQ13 EQU RQBUF+13 RQ14 EQU RQBUF+14 RQ15 EQU RQBUF+15 RQ16 EQU RQBUF+16 RQ17 EQU RQBUF+17 RQ18 EQU RQBUF+18 RQ19 EQU RQBUF+19 RQ21 EQU RQBUF+21 RQ29 EQU RQBUF+29 RQ55 EQU RQBUF+55 * ARQ0 DEF RQ0 ARQ8 DEF RQ8 ARQ10 DEF RQ10 ARQ11 DEF RQ11 ARQ12 DEF RQ12 ARQ13 DEF RQ13 ARQ29 DEF RQ29 * BSS 0 ******** SIZE OF RQCNV ************ * END RQCNV  E] 91741-18005 2026 S C0122 &RPCNV +              H0101 ASMB,L,R,C HED 3000 REPLY CONVERTER (C) HEWLETT-PACKARD CO. 1980 NAM RPCNV,19,25 91741-16005 REV 2026 800314 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT EXEC,$LIBR,$LIBX,D65GT EXT #RPCV,#QXCL,#TST,$OPSY SPC 1 **************************** RPCNV ******************************* * * * SOURCE: 91741-18005 * * * * BINARY: 91741-16005 * * * * PROGRAMMER: JIM HARTSELL * * * * FEBRUARY 28, 1977 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 7, 1978 * * * *----------------------------------------------------------------* * BIG FIXES: * * CHECK PROPER WORD FOR CONTINUATION REJECT [800314] DMT * ****************************************************************** SPC 1 * D EQU 256 MAX DATA PER 3000 DATA REPLY. L EQU 304 MAXIMUM LINE BUFFER SIZE. DBL EQU 512 MAXIMUM SLAVE DATiQA LENGTH. * * RPCNV IS THE INTERFACE TO THE DS/1000 SLAVE MONITORS FOR REPLIES * DESTINED FOR THE HP 3000. ALL OUTGOING REPLIES ARE CONVERTED * TO DS/3000 FORMATS. * SUP A EQU 0 B EQU 1 SKP RPCNV LDA $OPSY RAR,SLA IS THIS AN RTE-III OR IV? RSSI RSS YES. JMP SETCL NO. LDB RSSI GET "RSS" INSTRUCTION. STB MODI2 MODIFY TO DO CROSS-MAP LOAD. STB MODI3 MODIFY TO DO CROSS-MAP STORE. DLD MWFI MODIFY TO DO "MWF" DST DMS3 CROSS-MAP MOVE. * SETCL LDA #RPCV SET BIT IOR B60K TO SAVE STA CLASS BUFFER. * ************************************************************ * * * MAIN PROCESSING SECTION FOR ALL REPLIES FOR THE 3000. * * * ************************************************************ * GET EQU * JSB EXEC LOOK AT THE CLASS. DEF *+7 DEF D21 DEF CLASS DEF RQBUF DEF D8 DEF PARM1 DEF PARM2 * LDA PARM1 IF IT'S NOT AN CPA D8 INTERMEDIATE CONTINUATION RSS REQUEST, JMP DO65G PICK UP VIA D65GT. * LDA CLASS CLEAR "SAVE BUFFER" ALR,RAR FLAG IN CLASS. STA TEMP JSB EXEC DO DUMMY "GET" DEF *+5 TO RELEASE DEF D21 BUFFER. DEF TEMP DEF DABUF DEF D0 * LDB PARM2 GET TST ADDRESS. STB TSTAD ADB D2 GET HOLDING CLASS JSB LODWD FROM S.A.M. STA HLDCL ADB D9 GET ORIGINAL SEQUENCE JSB LODWD NUMBER FROM S.A.M. STA RQ5 * LDA RQ2 IF 3000 AND BIT14 REJECTED, SZA JMP RLTST RELEASE TST. * JMP PSTUP DO PRELIMINARY SET-UP. SPC 1 * BUFFER CAME FROM DS/1000 MONITOR.€ DO65G JSB D65GT PICK UP BUFFER DEF *+6 FROM DS/1000 SLAVE MONITORS. DEF #RPCV RPCNV'S I/O CLASS. DEF PARMB 1000 REPLY BUFFER. DEF PRMBL MAXIMUM LENGTH. DBUFA DEF DABUF DEF MAXDA JMP GET ERROR RETURN. * STA RQLOG SAVE REPLY LENGTH. STB TCNT SAVE LENGTH OF DATA RECEIVED. * * SEARCH TRANSACTION STATUS TABLE (TST) FOR MATCHING SEQUENCE # * IN 8-WORD FIXED-FORMAT HEADER. * DLD #TST GET TST ADDR AND # OF ENTRIES. STA TEMP CMB,INB STB TEMP1 SZA SZB,RSS JMP GET FORGET IT IF NO TST. * TSTLP LDB TEMP CHECK NEXT ENTRY. JSB LODWD VALID ENTRY? SZA,RSS JMP NXTST NO. GO CHECK NEXT ENTRY. INB YES. JSB LODWD (CROSS) LOAD LOCAL SEQ. #. CPA PARMB+1 JMP CONV MATCH. GO PROCESS REPLY. * NXTST LDB TEMP BUMP TO NEXT ENTRY. ADB TSTLN STB TEMP ISZ TEMP1 JMP TSTLP JMP GET NOT FOUND. * * MOVE TST ENTRY FROM S.A.M. TO LOCAL STORAGE AREA. * (THIS IS 8-WORD HEADER BELONGING TO THIS REPLY.) * CONV LDA TEMP SAVE ADDR OF TST ENTRY IN S.A.M. STA TSTAD LDA TSTLN MOVE TST ENTRY TO LOCAL STORAGE. CAX LDA TSTAD LDB LTSTA DMS3 MVW TSTLN MOVE: [DMS: "MWF"]. * * PERFORM PRELIMINARY SET-UP OF FIXED FORMAT HEADER. * PSTUP LDA RQ2 AND NOT13 CLEAR CONTINUATION BIT. IOR BIT15 SET REPLY BIT. STA RQ2 LDA RQ4 REVERSE PROCESS NUMBERS. ALF,ALF STA RQ4 * LDA PARM1 DS/3000 CONTINUATION REQUEST? CPA D8 JMP CONRQ YES. GET DATA OFF BUFFER. * LDA RQLOG IF UPLIN DETECTED A TIMEOUT CPA D2 ON THIS REQUEST, JMP REJCT REJECT IT. * * IF OPERATOR COMMAND REPLY, PROCESS INTERVENING $STDLIST MESSAGE. * LDA PARMB AND B17 CPA xD7 RSS JMP CONV1 NOT A COMMAND REPLY. * LDA PARMB+7 IF NO ASCII SZA,RSS REPLY MESSAGE, JMP CONV1 DON'T DO THE $STDLIST. * LDA RQ4 SAVE 3000 PROCESS NUMBERS. STA SVFTO AND B377 SET "FROM PROCESS NO." STA RQ4 ZERO. (NO 3000 REPLY) LDA RQ0 SAVE 3000 MESSAGE CLASS. STA SVMCL LDA RQ2 SAVE 3000 STREAM TYPE. STA SVSTR (REPLY BIT IS SET) LDA D5 BUILD $STDLIST REQUEST. STA RQ0 MESSAGE CLASS = 5. LDA B20 STA RQ2 STREAM = 20. CLA CLEAR CONTROL WORDS. STA RQ8 STA RQ9 LDA PARMB+7 GET LENGTH OF ASCII REPLY MSG. ADA D2 ADD # CONTROL WORDS. ALS STA RQ7 STORE BYTE COUNT. ARS ADA D8 STA RQLEN SAVE LENGTH OF REQUEST. ALF,ALF STA B LDA RQ0 STORE WORD COUNT. AND B377 IOR B STA RQ0 * LDA PCBA MOVE ASCII REPLY MESSAGE. LDB ARQ10 MVW PARMB+7 * JSB SEND WRITE $STDLIST TO QUEX. JMP RLTST ERROR RTN: LINE DISCONNECTED. * LDA SVMCL RESTORE 3000 MESSAGE CLASS. STA RQ0 LDA SVSTR RESTORE 3000 STREAM. STA RQ2 LDA SVFTO RESTORE 3000 PROCESS NUMBERS. STA RQ4 * * CONVERT DS/1000 REPLY TO DS/3000 FORMAT. * CONV1 CLA CLEAR "DATA IN STA INPLC PLACE" FLAG. JSB D1000 MAKE CONVERSION. * STA RQ7 STORE BYTE LENGTH. INA STORE WORD COUNT BYTE. ARS ADA D8 STA RQLEN SAVE LEN OF DS/3000 REPLY. ALF,ALF STA B LDA RQ0 AND B377 IOR B STA RQ0 * * CHECK IF THERE IS DATA IN THIS REPLY. * LDA TCNT IS THERE DATA? SZA JMP CONT1 YES. GO PREPARE DATA REPLY. * * CLASS WRITE THE DS/3000 REPLY TO QUEX'S I-O CLASS. * PUT JSB SEND DO CLASS WRITE/READ. NOP IGNORE ERROR RETURN. * * RELEASE TST ENTRY IN S.A.M. * RLTST LDA HLDCL LEAVING A HOLDING CLASS? SZA,RSS JMP STO0 NO. SET 1ST WORD TO 0. * JSB EXEC GET BUFFER OFF DEF *+5 HOLDING CLASS DEF CLS21 AND DEALLOCATE. DEF HLDCL DEF TEMP DEF D0 NOP (IGNORE ERRORS.) * STO0 LDB TSTAD CLA SZB (MAKE SURE ADDR IS GOOD!) JSB STRWD * JMP GET DONE WITH THIS REPLY. SPC 5 ************************************************************ * * * INTERMEDIATE CONTINUATION REQUEST RECEIVED FOR DS/3000 * * DREAD/PREAD/DEXEC(1) DATA REPLIES. * * * ************************************************************ * CONRQ JSB EXEC READ DATA. DEF *+6 DEF CLS21 DEF HLDCL (DE-ALLOCATE) DEF RQ8 DEF MAXDA DEF TCNT # WORDS REMAINING. JMP REJCT ERROR. * ISZ INPLC DATA IS IN PLACE. CLA RESET BYTE STA RQ7 COUNT AND CLEAR STA HLDCL CLASS NUMBER IN LDB TSTAD LOCAL AND ADB D2 SAM TST. JSB STRWD LDA RQ0 RESET AND B377 WORD IOR UP8 COUNT. STA RQ0 SPC 1 ************************************************************ * * * SECONDARY SECTION FOR DREAD/PREAD/DEXEC(1) DATA REPLIES. * * * ************************************************************ * * PROCESS DATA REPLIES (POSSIBLE CONTINUATIONS). * CONT1 LDA TCNT TOTAL # DATA WORDS REMAINING. STA DALEN CMA,INA ADA BLKLN WILL IT ALL FIT IN THIS REPLY? SSA,RSS JMP CONT3 YES. * LDA BLKLN NO. SET BLOCK LENGTH TO MAX. STA DALEN LDA RQ2 SET CONTINUATION BIT. IOR BIT13 STA RQ2 LDA LCSEQ SET RTE SEQUENCE # SO CONT. STA RQ5 REQUEST WILL GO TO RPCNV. * CONT3 LDA RQ0 STORE HEADER + ALF,ALF APPENDAGE LENGTH. AND B377 STA APLEN ADA DALEN CALCULATE STA RQLEN TOTAL LENGTH. * LDA INPLC IF "DATA IN PLACE" SZA FLAG IS SET, JMP CONT4 DON'T NEED TO MOVE DATA. * LDB ARQ0 FIND WHERE TO PUT THE DATA ADB APLEN IN THE DS/3000 REPLY. LDA DBUFA MVW DALEN MOVE THE NEXT DATA BLOCK. * CONT4 LDA DALEN UPDATE REPLY BYTE COUNT. ALS ADA RQ7 STA RQ7 * JSB SEND WRITE REPLY TO QUEX. JMP RLTST ERROR RTN: LINE DISCONNECTED. * LDA DALEN REDUCE TCNT BY DALEN. CMA,INA ADA TCNT STA TCNT SZA,RSS ANY MORE DATA BLOCKS? JMP RLTST NO. GO RELEASE TST ENTRY. * * ALLOCATE A HOLDING CLASS AND WRITE DATA. * LDA BIT15 INITIALIZE CLASS # FOR STA HLDCL NO WAIT. * LDA DBUFA CALCULATE ADDRESS ADA DALEN OF REMAINING DATA. STA DTADR * JSB EXEC WRITE DATA BLOCK TO HOLDING CLASS. DEF *+8 DEF CLS20 DEF D0 DTADR DEF *-* ADDRESS OF REMAINING DATA. DEF TCNT LENGTH OF THIS BLOCK. DEF TCNT DEF D0 DEF HLDCL JMP REJCT ERROR. * LDB TSTAD SET HOLDING CLASS ADB D2 NUMBER IN TST. LDA HLDCL JSB STRWD * JMP GET GET NEXT REPLY. SKP * * SEND A "REJECT" REPLY TO THE 3000 FOR THIS REQUEST. * LOCAL TST STORAGE AREA CONTAINS CURRENT TST 4-WORD HEADER * AND FIXED-FORMAT HEADER FROM CURRENT REQUEST. "TSTAD" * MCONTAINS ADDRESS OF TST ENTRY IN S.A.M. * REJCT LDA RQ2 SET REJECT BIT IN REQUEST. IOR BIT14 STA RQ2 LDA RQ7 SET LENGTH OF REPLY. INA CLE,ERA ADA D8 STA RQLEN JMP PUT GO SEND REJECT REPLY & RELEASE TST. SPC 5 * * SUBROUTINE TO SAVE RESOURCES AND TERMINATE UNTIL * RE-SCHEDULED BY QUEX WHEN INTERMEDIATE REPLY ARRIVES. * * * SUBROUTINE TO LOAD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I (RSS IF DMS SYSTEM) JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I * MWFI MWF NOP SPC 3 * * SUBROUTINE TO STORE INTO ALTERNATE MAP (IF RTE-III OR IV). * STRWD NOP JSB $LIBR NOP MODI3 STA B,I (RSS IF DMS SYSTEM) JMP OUT XSA B,I STORE WORD INTO ALTERNATE MAP. OUT JSB $LIBX DEF STRWD RETURN TO CALLER. SKP * * SUBROUTINE TO WRITE TO QUEX'S I/O CLASS. * SEND NOP * LDA #QXCL IF DISCONNECTED, SSA TAKE ERROR RETURN. JMP SEND,I * JSB EXEC DO CLASS WRITE/READ. DEF *+8 DEF CLS20 NO ABORT. DEF D0 DEF RQBUF REPLY ADDRESS. DEF RQLEN REPLY LENGTH. DEF RQLEN DEF D0 DEF #QXCL I/O CLASS OF QUEX. JMP RLTST ERROR RETURN. * ISZ SEND TAKE NORMAL RETURN. JMP SEND,I RETURN TO CALLER. SKP Pl * ************************************************************** * * * SUBROUTINE TO CONVERT DS/1000 REPLIES TO DS/3000 FORMAT. * * * ************************************************************** * D1000 NOP LDA PARMB ISOLATE STREAM TYPE. AND B377 ADA N4 SUBRACT 4. LDB D3 JSB BNDCK CHECK RANGE: 0 - 3. ADA K1JTAB1 TABLE ADDRESS + STREAM TYPE. LDA A,I JMP A,I GO TO MESSAGE CLASS PROCESSORS. * JTAB1 DEF *+1 DEF MSCL4 PTOP. DEF MSC8B DEXEC. DEF MSC8A RFA. DEF MSCL3 OPERATOR COMMAND. * ************************************************ * MESSAGE CLASS 3 ..... OPERATOR COMMANDS. * ************************************************ * MSCL3 CLA SET (A) = BYTE COUNT. JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 4 ..... PREAD/PWRIT/PCONT.* ************************************************ * MESSAGE CLASS 7, STREAM 21 ..... POPEN/PCLOS.* ************************************************ * MSCL4 LDA PARMB+7 PCLOS REPLY? AND B17 CPA D5 JMP SBC YES. * LDA PARMB+5 MAP DS/1000 ERROR CODES TO DS/3000. LDB BIT15 SET DEFAULT TO "CCE". CPA N41 LDB CL209 MAP -41 TO CCL & 209. CPA N42 LDB CL205 MAP -42 TO CCL & 205. CPA N44 LDB CL213 MAP -44 TO CCL & 213. CPA N45 LDB CL216 MAP -45 TO CCL & 216. STB RQ8 STORE IN DS/3000 REPLY. * LDA SB21 INIT. STREAM TO 100021B. STA RQ2 * LDB MASK IF POPEN REPLY, LDA FCNCD CPA D1 STB RQ33 MOVE MASK WORD TO DS/3000 REPLY. * LDA B26 SET ACCEPT/REJECT STREAM TYPE. LDB PARMB+7 SSB LDA B27 IOR BIT15 SET REPLY BIT. STA RQ2 ELA,CLE,ERA LDB D211 IF REJECT, CPA B27 STB RQ8 STORE CCG & 211. * CLA CLEAR UNUSED WORD. STA RQ9 * LDA PCBA MOVE PCB & TAG. LDB ARQ10 MVW D23 * ISZ INPLC SET "DATA IN PLACE" FLAG. * SBC LDA FCNCD SET REPLY BYTE COUNT. AND B17 ADA N1 ADA JTAB2 LDA A,I RETURN (A) = BYTE CNT W/O DATA. JMP D1000,I * JTAB2 DEF *+1 DEC 52 POPEN. DEC 50 PREAD. DEC 50 PWRIT. DEC 50 PCONT. DEC 0 PCLOS. * ************************************************ * MESSAGE CLASS 8, STREAM 20 ..... RFA. * ************************************************ * MSC8A LDB PARMB+5 MOVE IERR TO "A-REG", IERR. STB RQ8 STB RQ10 * CLA SSB IF ERROR, SKIP RFAMD #. JMP MSCA1 LDB FCNCD IF DCRET OR DOPEN, MOVE CPB D3 RFAMD ENTRY # TO "B-REG" SLOT. LDA PARMB+7 CPB D6 LDA PARMB+7 MSCA1 STA RQ9 * CPB D9 CHECK FOR ADDITIONAL PROCESSING. JMP DREAD CPB D4 JMP DLOCF CPB D10 JMP DSTAT * LDA D6 NONE OF THE ABOVE. JMP D1000,I RETURN WITH (A) = BYTE COUNT. * DREAD LDA PARMB+7 MOVE LEN PARAM. LDB PARMB+5 SSB CLA STA RQ11 LDA D8 JMP D1000,I RETURN WITH (A) = BYTE COUNT. * DLOCF LDA PMB7A MOVE DLOCF PARAMS. LDB ARQ11 MVW D7 LDA D20 JMP D1000,I RETURN WITH (A) = BYTE COUNT. * DSTAT CLA STA RQ8 STA RQ9 LDA D4 JMP D1000,I RETURN WITH (A) = BYTE COUNT. * ************************************************ * MESSAGE CLASS 8, STREAM 21 ..... DEXEC. * ************************************************ * MSC8B DLD PARMB+4 MOVE A&B-REG RETURN VALUES. DST RQ8 * CLA MOVE ADDITIONAL VALUES. LDB FCNCD CPB D11 LDA D5 CPB D13 LDA D2 STA TEMP # ADDITIONAL WORDS. * SZA,RSS JMP FRBC NONE TO MOVE. * LDA PMB7A LDB ARQ10 MVW TEMP * FRBC LDA TEMP FIND RESULTING BYTE COUNT. ADA D2 ALS JMP D1000,I RETURN WITH (A) = BYTE COUNT. SKP * * SUBROUTINE TO CHECK IF INDEX IS WITHIN SPECIFIED RANGE. * (A) = INDEX (PARESERVED) (B) = UPPER LIMIT. * REQUEST IS REJECTED OF OUT OF BOUNDS. * BNDCK NOP STA LOC SAVE A-REGISTER. SSA JMP REJCT REJECT IF NEGATIVE. CMA,INA ADA B SSA JMP REJCT REJECT IF BEYOND LIMIT. LDA LOC RESTORE A-REGISTER. JMP BNDCK,I RETURN. * LOC OCT 0 SPC 3 * * SUBROUTINE TO CHECK IF DATA LENGTH EXCEEDS DS/1000 LIMIT. * LIMCK NOP (A) = TCOUNT: -BYTES OR +WORDS. SSA,RSS JMP LIM1 + WORDS. CMA,INA - BYTES. CONVERT TO +WORDS. INA ARS LIM1 CMA,INA ADA MAXDA SSA JMP REJCT EXCEEDS LIMIT. REJECT. JMP LIMCK,I SKP * * CONSTANTS AND WORKING STORAGE. * D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D13 DEC 13 D20 DEC 20 D21 DEC 21 D23 DEC 23 D211 DEC 211 B17 OCT 17 B20 OCT 20 B26 OCT 26 B27 EQU D23 B377 OCT 377 B60K OCT 60000 UP8 BYT 10,0 DECIMAL 8, LEFT BYTE. BIT13 OCT 20000 BIT14 OCT 40000 BIT15 OCT 100000 NOT13 OCT 157777 SB21 OCT 100021 CLS20 DEF 20,I CLS21 DEF 21,I CL205 OCT 040315 CL209 OCT 040321 CL213 OCT 040325 CL216 OCT 040330 N1 DEC -1 N4 DEC -4 N41 DEC -41 N42 DEC -42 N44 DEC -44 N45 DEC -45 CLASS NOP PARM1 NOP PARM2 NOP INPLC NOP SVMCL NOP SVSTR NOP SVFTO NOP TEMP NOP TEMP1 NOP RQLOG NOP RQLEN NOP APLEN NOP DALEN NOP TCNT NOP * PRMBL DEC 31 MAX LENGTH OF DS/1000 REQUEST. PARMB BSS 31 DS/1000 REQUEST BUFFER. PMB7A DEF PARMB+7 PCBA DEF PARMB+8 * TSTAD NOP ADDR OF TST ENTRY IN S.A.M. TSTLN DEC 14 LENGTH OF TST ENTRY. LTSTA DEF STREM ADDR OF LOCAL TST AREA. ******************************************************************** STREM NOP * * DS/1000 STREAM TYPE * LCSEQ NOP * LB@< * LOCAL SEQUENCE NUMBER * HLDCL NOP * O T * HOLDING CLASS NUMBER * NOP * C S * MONITOR CLASS NUMBER * FCNCD NOP * A T * CALL TYPE * MASK NOP * L * MASK WORD FOR POPEN * RQBUF BSS 8 * * DS/3000 FIXED FORMAT HEADER * ******************************************************************** BSS L-8 PLUS REQUEST BUFFER. BSS DBL-L+33 MORE ROOM FOR DATA BUFFER. DABUF EQU RQBUF+33 FWA OF DATA BUFFER AREA. * MAXDA ABS DBL BLKLN ABS D * RQ0 EQU RQBUF RQ2 EQU RQBUF+2 RQ4 EQU RQBUF+4 RQ5 EQU RQBUF+5 RQ7 EQU RQBUF+7 RQ8 EQU RQBUF+8 RQ9 EQU RQBUF+9 RQ10 EQU RQBUF+10 RQ11 EQU RQBUF+11 RQ33 EQU RQBUF+33 * ARQ0 DEF RQ0 ARQ10 DEF RQ10 ARQ11 DEF RQ11 * BSS 0 ******** SIZE OF RPCNV ************ * END RPCNV IB FV 91741-18006 1913 S C0122 DS/1000 MODULE: CNSLM              H0101 ?ASMB,L,R,C HED 3000 $STDLIST MONITOR * (C) HEWLETT-PACKARD CO. 1979 NAM CNSLM,19,30 91741-16006 REV 1913 781114 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT EXEC,XLUEX,#QXCL,#RSAX,D65GT,$OPSY SPC 3 *************************** CNSLM ****************************** * * * SOURCE: 91741-18006 * * * * BINARY: 91741-16006 * * * * PROGRAMMR: JIM HARTSELL * * * * DATE: FEBRUARY 10, 1976 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 3, 1978 * * * ****************************************************************** SPC 3 * CNSLM IS THE DS/1000 MONITOR WHICH RECEIVES "UNEXPECTED" * $STDLIST REQUESTS INITIATED BY AN HP 3000. THESE ARE USUALLY * "TELL" MESSAGES OR THE LOGOFF FROM A "KILLED" SESSION. SPC 2 A EQU 0 B EQU 1 SUP SKP CNSLM LDA $OPSY CHECK FOR OPERATING RAR SYSTEM TYPE. SLA,RSS JMP LDABI  XLA B,I DMS LOAD. RSS LDABI LDA B,I NON-DMS LOAD. STA CLSN SAVE CLASS NUMBER. * GET JSB D65GT DO A CLASS GET AND WAIT FOR REQUEST DEF *+6 DEF CLSN CLASS # DEF RQBUF REQUEST BUFFER DEF D80 MAX LENGTH = 80 WORDS. DEF TEMP DUMMY BUFFER. DEF D0 JMP GET ERROR RETURN. * LDA RQBUF GET LENGTH/CLASS WORD. AND B77 ISOLATE CLASS. CPA D5 IS IT 5? RSS JMP GET NO. IGNORE. * LDA RQBUF+2 GET STREAM TYPE WORD. AND B77 ISOLATE STREAM TYPE. CPA B20 RSS STREAM 20 IS $STDLIST. JMP REJCT REJECT ALL OTHERS. * LDA RQBUF+4 AND B377 STA TONUM STORE "TO" NUMBER (LU # OR 0) * LDA RQBUF+7 GET BYTE LENGTH. ADA MD4 OMIT CONTROL WORDS FROM COUNT. CMA,INA NEGATE MESSAGE BYTE LENGTH. STA BUFL SAVE NEGATIVE LENGTH. * LDA TONUM IF DIRECTED TO USER, SZA JSB OTPUT DISPLAY ON THAT LOG LU. CLA,INA IF USER CONSOLE CPA TONUM IS NOT 1, RSS DISPLAY ON JSB OTPUT SYSTEM CONSOLE. * * BUILD A REPLY FOR THE $STDLIST REQUEST. * LDA RQBUF STORE COUNT WORD. AND B377 IOR LB9 STA RQBUF LDA RQBUF+2 SET REPLY BIT. IOR BIT15 STA RQBUF+2 LDA D2 STA RQBUF+7 LDA CCE STORE STATUS WORD. STA RQBUF+8 * * SEND THE REPLY OR REJECT * SEND LDA RQBUF+4 REVERSE PROCESS NUMBERS. ALF,ALF STA RQBUF+4 AND B377 IF NO REPLY TO BE SENT, SZA,RSS JMP CNSL1 GO RELEASE SLAVE TCB. * LDA RQBUF+7 GET BYTE COUNTER. INA CLE,ERA ADA D8 STA RQLEN LENGTH OF REPLY. * LDA #QXCL IS 3000 LINK DOWN? SSA JMP CNSL1 YES. IGNORE REPLY. * JSB EXECrl WRITE REPLY TO QUEX. DEF *+8 DEF CLS20 DEF D0 DEF RQBUF DEF RQLEN DEF RQLEN DEF D0 DEF #QXCL NOP IGNORE ERROR RETURN. * CNSL1 JSB #RSAX DELETE SLAVE TCB. DEF *+4 DEF D7 CODE FOR "CLEAR". DEF RQBUF+5 LOCAL SEQUENCE #. DEF D2 CNSLM STREAM TYPE. * JMP GET GO WAIT FOR ANOTHER REQUEST. SKP * SUBROUTINE TO PERFORM $STDLIST ON LU IN A-REGISTER * OTPUT NOP ENTRY POINT STA LU STORE LU NUMBER * JSB XLUEX DISPLAY MESSAGE DEF *+5 DEF SD2 DEF LU DEF RQBUF+10 DEF BUFL NOP IGNORE ERRORS * LDA RQBUF+8 IF DOUBLE CPA B60 SPACE WAS RSS SPECIFIED, JMP OTPUT,I * JSB XLUEX PRINT A DEF *+5 BLANK DEF SD2 LINE. DEF LU DEF BLANK DEF D1 NOP JMP OTPUT,I RETURN. * B60 OCT 60 BLANK ASC 1, * * DO NOT CHANGE THE ORDER OF THE FOLLOWING TWO STATEMENTS. LU BSS 1 LU NUMBER OCT 200 CONTROL BIT TO PRINT COL 1 SPC 5 * * SEND "REJECT" REPLY FOR ILLEGAL REQUESTS. * REJCT LDA RQBUF TOTAL AND B377 LENGTH IOR LB8 IS 8. STA RQBUF LDA RQBUF+2 SET REJECT BIT. IOR BIT14 STA RQBUF+2 CLA DATA LENGTH = 0. STA RQBUF+7 JMP SEND SEND REJECT TO QUEX. SPC 5 * * CONSTANTS AND WORKING STORAGE. * D0 OCT 0 D1 DEC 1 D2 DEC 2 D5 DEC 5 D7 DEC 7 D8 DEC 8 D80 DEC 80 B20 OCT 20 B77 OCT 77 B377 OCT 377 CLS20 DEF 20,I MD4 DEC -4 SD2 DEF 2,I LB8 BYT 10,0 DECIMAL 8, LEFT BYTE. LB9 BYT 11,0 DECIMAL 9, LEFT BYTE. BIT14 OCT 40000 REJECT BIT BIT15 OCT 100000 REPLY BIT CLSN NOP RQLEN NOP TEMP NOP CCE OCT 1000 BUFL NOP TONUM NOP  RQBUF BSS 80 * BSS 0 SIZE OF CNSLM * END CNSLM  GP 91741-18007 2013 S C0222 &RMOTE              H0102 ASMB,Q,C HED OPERATOR ACCESS TO 3000 * (C) HEWLETT-PACKARD CO. 1980 NAM RMOTE,19,80 91741-16007 REV 2013 790731 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * RMOTE * SOURCE: 91741-18007 * BINARY: 91741-16007 * JIM HARTSELL * OCT 21, 1975 * * DS/1000 PROGRAM TO PROVIDE OPERATOR ACCESS * TO A REMOTE HP3000 COMPUTER. RMOTE CAN BE USED BY SEVERAL * TERMINALS - SEE RTE MANUAL, MULTIPLE TERMINAL OPERATION. * * EXT EXEC,PARSE,CNUMD,KCVT,MESSS,REIO EXT OPEN,READF,POSNT,CLOSE EXT .ENTR,#LU3K,HELLO,BYE EXT D3KMS,D$STW,D$ZRO,D$WDC EXT D$RQB,D$INI,D$ERR EXT D$INP,D$LOG,D$SMP IFZ EXT DBUG XIF * A EQU 0 B EQU 1 SUP * * CHECK FOR DEBUG OPTION. * RMOTE EQU * IFZ LDA B,I IS P1 = -1 ? CPA MD1 (*ON,RMOTE,-1 TO INVOKE DEBUG) RSS JMP INIT NO. INITIALIZE DATA LINK. * JSB DBUG YES. ALLOW DEBUG COMMANDS HERE, DEF *+1 FOLLOWED BY "CONTINUE". * JSB EXEC SAVE RESOURCES & TERMINATE. DEF *+4 RE-SCHEDULE RMOTE WITH DESIRED PARAMS. DEF B6 DEF B0 DEF B1 * JMP RMOTE RE-SCHEDULE STARTS HERE. XIF * * INITIALIZE TRANSFER STACK AND PROMPT CHARACTER. * INIT STB TEMP SAVE ADDR OF SCHEDULE PARAMS. * LDA STKHD RESET STACK POINTER. STA P.STK CLA,INA SET FIRST STACK ENTRY STA P.STK,I FOR LOGICAL UNIT 1 (DEFAULT). CLA STA DSTLU RESET DEST. LU TO LOCAL. STA D$SMP FOR RTE-M, CLEAR SMP NUMBER. * LDA LPRMP INITIALIZE FOR LOCAL PROMPT CHAR. STA CPRMP LDA PROMP AND B377 IOR CPRMP STA PROMP OPERATOR PROMPT CHAR. * LDA A.TR AND B377 IOR CPRMP STA A.TR CANNED TRANSFER COMMAND. * LDA TEMP,I CHECK IF P1 = ASCII PARAM. AND HB377 SZA,RSS JMP STR NO. MUST BE INPUT LU. * * FETCH SCHEDULE PARAMETERS (FL,NA,ME,SEVERITY,LIST). * LDA A.TR GENERATE "$TR,FLNAME" IN BUFFER. STA INBUF LDA A.TR1 STA INBUF+1 LDA TEMP,I STA INBUF+2 ISZ TEMP LDA TEMP,I SZA,RSS LDA BLNKS STA INBUF+3 ISZ TEMP LDA TEMP,I SZA,RSS LDA BLNKS STA INBUF+4 ISZ TEMP * LDA B5 SET COUNT. STA INCNT * LDA TEMP,I SET UP DUMMY SCHEDULE PARAMS. STA ALTBK+3 SEVERITY CODE. ISZ TEMP LDA TEMP,I STA ALTBK+2 LIST LU. * LDA DFALT POINT TO DUMMY PARAMS. STA TEMP * STR STA TRFLG SET/CLEAR FLAG FOR QUERY SECTION. * * FETCH SCHEDULE PARAMETERS (LU,LOG,LIST,SEVERITY CODE). * LDA TEMP,I GET LU OF INPUT DEVICE. SZA,RSS JMP STAT IF NONE, USE DEFAULT. CPA B1 IGNORE IF = 1. JMP STAT * STA P.STK,I PUT SPECIFIED LU INTO XFER STACK. * STAT LDA P.STK,I JSB EQTYP CHECK EQ. TYPE OF INPUT LU. STA LUTYP * ISZ TEMP LDA TEMP,I GET LU OF LOG DEVICE. SZA JMP SVLOG * LDB LUTYP CLA,INA EITHER LU 1 OR SZB,RSS LDA P.STK,I INPUT LU IF TTY DEVICE. SVLOG STA LOGLU STA D$LOG * LDB LUTYP SET LU FOR ERROR MESSAGES: CLA,INA SZB,RSS LDA P.STK,I INPUT LU IF TTY DEVICE. STA ERRLU OTHERWISE, 1. * ISZ TEMP LDA TEMP,I GET LU OF LIST DEVICE, SZA,RSS LDA B6 OR USE{ DEFAULT = 6. STA LSTLU * ISZ TEMP LDA TEMP,I SAVE SEVERITY CODE. STA SEVER * LDA TRFLG IF SCHEDULED WITH FILE NAME, SZA ALREADY HAVE TR SIMULATED. JMP CHKPR SKP * * DISPLAY PROMPT CHARACTER (IF TTY DEVICE). * CONTROL RETURNS HERE WHEN REQUEST PROCESSING COMPLETES. * QUERY LDA P.STK,I CHECK CURRENT INPUT: AND HB377 NON ZERO IF FILE NAME, ELSE LU. SZA JMP REMRD DISK FILE. * LDA P.STK,I STA TEMP SAVE LU FOR LATER USE. JSB EQTYP CHECK TYPE. STA LUTYP SZA JMP LOCRD LU NOT TTY DEVICE. * JSB REIO DISPLAY PROMPT ON TTY DEVICE. DEF *+5 DEF B2 DEF P.STK,I DEF PROMP DEF B1 * LDA P.STK,I SET ECHO BIT. IOR B400 STA TEMP * * INPUT OPERATOR REQUEST FROM CURRENT DEVICE OR FILE. * LOCRD JSB REIO LU READ. DEF *+5 DEF SD1 DEF TEMP DEF INBUF DEF D40 RSS JMP RDOK IF ERROR ON INPUT LU, DST EMSG+3 SET LDA EMSG+2 UP AND HB377 ERROR IOR B40 MESSAGE. JMP INERR GO TO INPUT ERROR HANDLER. * RDOK STA TEMP SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. JSB EOFCK CHECK FOR END OF FILE. JMP TRANS GOT IT. JMP ECHO GO ECHO IF NECCESSARY. * REMRD JSB READF LOCAL DISK FILE. DEF *+6 (OPENED WHEN FIRST TRANSFER DEF IDCB WAS PERFORMED) DEF IERR DEF INBUF DEF D40 DEF INCNT ACTUAL WORD COUNT. * JSB ERCHK CHECK FOR ERRORS. * LDA INCNT IF EOF, GENERATE TR REQUEST. INA,SZA JMP BUMP TRANS LDA A.TR RESULTS IN TR,-1 (TO PREVIOUS ONE). STA INBUF LDA A.TR+1 STA INBUF+1 LDA B2 STA INCNT JMP ECHO * BUMP LDA P.STK ADA B3 ISZ A,I iU BUMP RECORD COUNT. * * ECHO THE REQUEST IF NOT INPUT FROM TTY DEVICE. * ECHO LDA LUTYP SZA,RSS JMP CKCNT IT IS A TTY DEVICE. * LDA SEVER ECHO IF SZA,RSS SEVERITY CODE = 0. JSB ECHPR * CHKPR LDA INBUF FIRST CHARACTER MUST AND HB377 BE CURRENT PROMPT CHARACTER. CPA CPRMP RSS JMP INVAL * LDA INBUF BLANK OUT THE PROMPT CHAR. AND B377 IOR BLANK STA INBUF * CKCNT LDB INCNT IGNORE REQUEST IF NULL. RBL MAKE CHARACTER COUNT. SZB,RSS JMP QUERY * * PARSE THE OPERATOR REQUEST. * STB TEMP * JSB PARSE DEF *+4 DEF INBUF DEF TEMP DEF PRAMS PARAMETER BUFFER ADDRESS. * JMP M0000 TRY FOR RMOTE COMMAND FIRST. * * LOCAL RTE OR REMOTE HP3000 COMMAND. * OTHER LDA INCNT SET UP +CHAR COUNT. RAL STA TEMP SZA,RSS JMP QUERY IGNORE IF ZERO. * LDA DSTLU IF LOCAL MODE, SEND COMMAND SZA,RSS TO RTE. JMP LCRTE * * SEND REMOTE HP3000 COMMANDS. * LDA D$SMP HAS "HELLO" BEEN ENTERED? SZA,RSS JMP NHLLO NO. ERROR. * JSB BLKIL KILL LEADING BLANKS IN COMMAND. SNCMD JSB CMNDS SEND COMMAND TO HP3000. DEF *+3 DINBF DEF INBUF DEF TEMP * JMP QUERY * * PASS COMMAND TO LOCAL RTE. * LCRTE JSB MESSS PROCESS COMMAND. DEF *+4 (RU & ON COME THRU HERE IF 5TH DEF INBUF PARAM WAS SPECIFIED IN COMMAND.) DEF TEMP DEF STKHD,I PASS LU OF USER'S TERMINAL. * SZA,RSS IF CHAR CNT NON-ZERO, JMP QUERY * STA TEMP NEGATIVE CHARACTER COUNT. * JSB REIO DISPLAY REPLY MESSAGE. DEF *+5 DEF SD2 DEF LOGLU DEF INBUF DEF TEMP RSS ERROR CHECK. * JMP QUERY * * ERROR ON OUTPUT LU OTERR DST EM,SG+3 SET LDA EMSG+2 UP AND HB377 ERROR IOR B40 MESSAGE JSB EROUT PRINT IT. JMP QUERY SKP * * CHECK THE OPERATOR REQUEST CODE AGAINST THE LEGAL * REQUEST CODES AND JUMP TO THE PROPER PROCESSOR. * * TO ADD NEW REQUEST ONE MERELY: * A. ADDS ASCII OPERATION CODE TO TABLE "LDOPC". * B. ADDS PROCESSOR START ADDRESS TO TABLE "LDJMP". * C. ADDS PROCESSOR CODING TO PROCESS THE REQUEST. * M0000 LDA OP FETCH OPERATION CODE. AND UMASK UPSHIFT. STA B STB OPP SET STOP FLAG. LDA LDOPC SET OPERATION TABLE POINTER. STA TEMP1 LDA LDJMP SET PROCESSOR JUMP ADDRESS. STA TEMP2 * M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE. JMP TEMP2,I COMPARES. GO DO IT. * ISZ TEMP1 KEEP LOOKING. ISZ TEMP2 JMP M0030 * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS. * ASC 8,SWHEBYTREXRUONLL OPP NOP OP CODE FOR CURRENT REQ. * LDJMP DEF *+1,I JMP ADDRESS FOR EACH OP CODE. DEF M0100 SWITCH. DEF M0200 HELLO. DEF M0300 BYE. DEF M0400 TRANSFER. DEF M0500 EXIT. DEF M0600 "RU" COMMAND TRAP. DEF M0600 "ON" COMMAND TRAP. DEF M0700 LL COMMAND. DEF OTHER ASSUME RTE OR HP3000 COMMAND. * NHLLO JSB DSPLY DISPLAY "NEED HELLO" DEF NHMSG JMP QUERY * NHMSG DEF *+2 DEF B6 ASC 6,NEED "HELLO" * INVAL JSB DSPLY DISPLAY "INVALID INPUT". DEF INVLM JMP QUERY * INVLM DEF *+2 DEF B7 ASC 7,INVALID INPUT * UMASK OCT 157737 UPSHIFT MASK. SKP * * SW[,N] * * CHANGE OR TOGGLE DESTINATION OF OPERATOR COMMANDS. * M0100 LDA CP1 CHECK IF FIRST PARAM SPECIFIED. SZA JMP M0105 PARAM SPECIFIED. * LDB CPRMP NO PARAM. TREAT AS A TOGGLE. CLA CPB RPRMP IS CbURRENT PROMPT = REMOTE PROMPT? JMP M0110 YES. SWITCH TO LOCAL PROMPT. LDA #LU3K NO. GET LU OF 3000. SZA JMP M0110 GO CHANGE CURRENT PROMPT. JMP NLSTN TELL USER HE NEEDS TO RUN "LSTEN". * M0105 LDA P1 PARAM GIVEN: SZA,RSS 0=LOCAL RTE, N=HP3000 LU. JMP M0110 LDB #LU3K IF NON-ZERO, MUST BE IN #LU3K. SZB,RSS JMP NLSTN TELL USER HE NEEDS TO RUN "LSTEN". CPB A CHECK FOR VALID REMOTE LU. JMP M0110 VALID. JSB DSPLY DISPLAY "INVALID REMOTE LU". DEF ILLU JMP CLRLU * M0110 STA DSTLU CHANGE THE PROMPT CHARACTER: LDB LPRMP LOCAL IF NEW LU = 0, SZA LDB RPRMP REMOTE IF NEW LU NON-ZERO. STB CPRMP * LDA PROMP CHANGE OPERATOR PROMPT. AND B377 IOR CPRMP STA PROMP * LDA A.TR CHANGE CANNED TR AND B377 COMMAND PROMPT. IOR CPRMP STA A.TR * JMP QUERY * DSTLU OCT 0 CURRENT DESTINATION LU. * NLSTN JSB DSPLY DISPLAY "NEED TO RUN LSTEN". DEF NLSN * CLRLU CLA STA DSTLU * JMP QUERY * NLSN DEF *+2 DEF D10 ASC 10,NEED TO RUN "LSTEN" * ILLU DEF *+2 DEF D9 ASC 9,INVALID REMOTE LU SKP * * PROCESSOR FOR "HELLO" COMMAND. * M0200 LDA CPRMP IF LOCAL PROMPT, CPA LPRMP JMP NDREM COMMAND IS AN ERROR. * JSB BLKIL KILL LEADING BLANKS IN COMMAND. LDA INCNT GET MESSAGE BYTE LENGTH. CLE,ELA STA #BYTS * LDA P.STK,I IF CURRENT INPUT IS A LOGICAL UNIT, STA B USE IT. IF NOT, USE SPECIFED LU. AND HB377 SZA LDB STKHD,I STB D$INP * JSB HELLO SEND "HELLO" TO HP3000. DEF *+7 DEF IERR DEF DSTLU LU OF HP3000. DEF LOGLU LU OF LOG DEVICE. DEF SMPNM RETURNED PROCESS NUMBER. nDEF INBUF ADDR OF HELLO MESSAGE. DEF #BYTS POS. # BYTES. * LDA IERR CHECK FOR ERRORS. SZA JMP BDHEL FAILED. JMP QUERY BDHEL CPA B1 ERROR CODE = 1? RSS JMP RFAIL NO. * JSB DSPLY YES. DISPLAY MESSAGE. DEF HFAIL * JMP QUERY * HFAIL DEF *+2 DEF D13 ASC 13,HELLO FAILED OR LINE DOWN SKP * * PROCESSOR FOR "BYE" COMMAND. * M0300 LDA CPRMP IF LOCAL PROMPT, CPA LPRMP JMP NDREM COMMAND IS AN ERROR. LDA D$SMP IF NO HELLO ISSUED, SZA,RSS JMP NHLLO COMMAND IS AN ERROR. * JSB BYE SEND "BYE" TO HP3000. DEF *+5 DEF IERR DEF DSTLU LU OF HP3000. DEF LOGLU LU OF LOG DEVICE. DEF SMPNM PROCESS NUMBER. * LDA IERR CHECK FOR ERRORS. SZA JMP RFAIL FAILED. * JMP QUERY SKP RFAIL CPA B5 JMP TMOUT CPA "IO" JMP OTERR CPB "05" JMP TMOUT CPA B1 JMP DSCNT CPB "01" JMP DSCNT * JSB DSPLY DISPLAY "REQUEST FAILED". DEF RQFL * JMP QUERY * DSCNT JSB DSPLY DISPLAY "LINK IS DISCONNECTED". DEF DISCN JMP QUERY * RQFL DEF *+2 DEF B7 ASC 7,REQUEST FAILED * TMOUT JSB DSPLY "TIMEOUT" DEF TOMSG * JMP QUERY * TOMSG DEF *+2 DEF D15 ASC 15,TIMEOUT: NO REPLY FROM REMOTE * NDREM JSB DSPLY NOT LOCAL COMMAND. DEF NTLOC * JMP QUERY * NTLOC DEF *+2 DEF D9 ASC 9,NOT LOCAL COMMAND * DISCN DEF *+2 DEF D10 ASC 10,LINK IS DISCONNECTED SKP * TR PROCESSOR. * * TRANSFER CONTROL TO LU OR DISK FILE. * M0400 LDA P.STK,I IF CURRENT INPUT IS FROM A AND HB377 DISC FILE, CLOSE IT. SZA,RSS JMP M1210 * JSB CLOSE DEF *+3 DEF IDCB DEF IERR * CLA CLEAR IDCB OPEN FLAG. STA OPNFL * M1210 LDA P1 GET PARAM 1. SZA,RSS IF NOT SPECIFIED, CCA SIMULATE "TR,-1". SSA,RSS NEGATIVE INTEGER? JMP M1220 NO. * * BACK UP THROUGH TRANSFER STACK. * LDB P.STK TOP OF STACK? BKUP CPB STKHD JMP M0500 YES. SIMULATE "EX" REQUEST. ADB MD4 NO. BACK UP 1 ENTRY. INA,SZA JMP BKUP LOOP TILL DONE. STB P.STK SET NEW STACK ADDRESS. JMP M1250 GO CHECK FOR FILE. * * ADD NEW CONTROL TO THE TRANSFER STACK. * M1220 LDA P.STK BUMP TO NEXT ENTRY. ADA B4 STA P.STK CPA STKEN RSS JMP M1230 JSB DSPLY STACK OVERFLOW. DEF STKOV * JMP QUERY * M1230 LDB P1 STORE LU OR FILE NAME. STB A,I INA LDB P1+1 STB A,I INA LDB P1+2 STB A,I INA CLB,INB SET RECORD NUMBER TO 1. STB A,I * * IF DISK FILE, OPEN AND OPTIONALLY POSITION. * M1250 LDA P.STK,I AND HB377 SZA,RSS JMP QUERY LOCAL LU. GO GET NEXT REQUEST. * STA LUTYP SET LU TYPE NON-TTY. JSB OPEN OPEN THE FILE. DEF *+4 DEF IDCB DEF IERR DEF P.STK,I * LDA IERR PROCESS ERRORS ONLY IF SSA IERR IS NEGATIVE. JSB ERCHK ISZ OPNFL SET OPEN FLAG. * LDA P.STK POSITIONING REQUIRED? ADA B3 LDB A,I CPB B1 (REC. CNT MORE THAN 1?) JMP QUERY NO. STB TEMP YES. * JSB POSNT POSITION TO NEXT RECORD. DEF *+5 DEF IDCB DEF IERR DEF TEMP NUR GREATER THAN ZERO. DEF TEMP ABSOLUTE RECORD NUMBER. * JSB ERCHK CHECK FOR ERRORS. JMP QUERY * * TRANSFER STACK: * FOR EACH ENTRY, WORD 1 = INTEGER LU OR * FIRMST 2 FNAME CHAR. * WORD 2,3 = REST OF FNAME. * WORD 4 = NEXT RECORD NUMBER. * P.STK NOP STACK POINTER. STKHD DEF *+1 * BSS 32 8 ENTRIES. * STKEN DEF * STACK LWA+1. * STKOV DEF *+2 DEF D9 ASC 9,TR STACK OVERFLOW SKP * * EX PROCESSOR * * TERMINATE THE OPERATOR INTERFACE PROGRAM. * M0500 LDA D$SMP CHECK IF A "HELLO" IS OUTSTANDING. SZA,RSS JMP M0510 NO. * JSB BYE YES. ISSUE AN AUTO BYE. DEF *+5 DEF IERR DEF #LU3K DEF LOGLU DEF SMPNM * LDA IERR CHECK FOR ERRORS. SZA,RSS JMP M0510 NONE. JSB DSPLY ERROR FROM "BYE". DEF BYMSG * M0510 JSB DSPLY DISPLAY TERMINATION MESSAGE DEF TRMSG ON LOG DEVICE. * JSB CLSFL CLOSE OPEN FILES. * JSB EXEC EXIT. DEF *+2 DEF B6 * BYMSG DEF *+2 DEF D9 ASC 9,AUTO "BYE" FAILED TRMSG DEF *+2 DEF B6 ASC 6, $END RMOTE SKP * * PROCESSOR FOR "RU" COMMAND TRAP. IF ENTERED UNDER THE LOCAL * PROMPT, AND 5TH PARAM IS NOT SPECIFIED, PASS SESSION NUMBER * AS 5TH SCHEDULE PARAMETER. * M0600 LDA RPRMP IF REMOTE PROMPT, CPA CPRMP JMP OTHER LET IT GO BY. LDA P2 FIRST PARAM = "NOW"? CPA "NO" JMP OTHER YES. LET IT GO BY. * LDA CP6 WAS 5TH PARAM SPECIFIED? SZA JMP M0610 YES. LEAVE IT ALONE. * LDA D$SMP NO. GET CURRENT PROCESS NUMBER, CMA,INA NEGATE IT, STA P6 AND STORE AS 5TH SCHEDULE PARAM. * M0610 LDB STKHD,I LDA CP2 IS FIRST PARAM SPECIFIED? SZA,RSS STB P2 NO. PASS LU OF USER'S TERMINAL. * JSB EXEC SCHEDULE THE PROGRAM WITH WAIT. DEF *+8 PASS 1ST 4 PARAMS ALONG WITH 5TH. DEF SD9 DEF P1 PROGRAM NAME. DEF P2A1 SCHEDULE PARAMETERS. DEF P3 DEF P4 DEF P5 DEF P6 JMP SCERR ERROR RETURN. * SZA,RSS NORMAL RETURN. JMP QUERY LDA PGBZY PROGRAM WAS BUSY. JMP SCMSG * SCERR CPA "SC" RSS JMP SCM1 NOT A SCHEDULING ERROR. LDA DSC03 CPB "03" JMP SCMSG "ILLEGAL STATUS" LDA DSC05 CPB "05" JMP SCMSG "NO SUCH PROG" SCM1 LDA RQFL "REQUEST FAILED" SCMSG STA SCM2 JSB DSPLY SCM2 NOP JMP QUERY * DSC03 DEF *+1 DEF *+2 DEF B7 ASC 7,ILLEGAL STATUS DSC05 DEF *+1 DEF *+2 DEF B6 ASC 6,NO SUCH PROG PGBZY DEF *+1 DEF *+2 DEF B5 ASC 5,PROG BUSY SKP * * PROCESSOR FOR LL COMMAND. CHANGE $STDLIST DESTINATION (D$LOG). * M0700 LDB CP1 JSB INTCK CHECK FOR NUMERIC PARAM. LDA P1 STA D$LOG CHANGE $STDLIST DESTINATION. JMP QUERY * SKP * * * SEND OPERATOR COMMAND (ASCII STRING) TO HP3000. * * CALLING SEQUENCE: * * JSB CMNDS * DEF *+3 * DEF BUFA ADDR OF ASCII STRING. * DEF BUFL POS. # BYTES IN STRING. * PARMS NOP ADDR OF ASCII COMMAND STRING. NOP LENGTH OF ASCII STRING (+BYTES). * CMNDS NOP JSB .ENTR GET PARAM ADDRESSES. DPRAM DEF PARMS CLA CLEAR ERROR CODE STORAGE. CLB DST D$ERR * * BEGIN CONSTRUCTION OF REQUEST BUFFER WITH * THE 8-WORD FIXED FORMAT FOR REMOTE COMMANDS. * LDA DPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * LDA B3 STORE MESSAGE CLASS = 3. JSB D$STW CLA CLEAR COMPUTER ID. JSB D$STW LDA B20 STORE STREAM TYPE = 20 OCTAL. JSB D$STW LDA MD4 CLEAR SUB-STREAM, PROCESS #'S. JSB D$ZRO LDA PARMS+1,I SET BYTE COUNT IN REQUEST. ADA MD2  ADJUST FOR D$STW. JSB D$STW STORE MESSAGE BYTE COUNT. * * MOVE ASCII MESSAGE TO REQUEST BUFFER. * LDA PARMS COMMAND MESSAGE SOURCE ADDRESS. LDB PARMS+1,I NUMBER OF BYTES. INB ROUND UP. CLE,ERB MAKE WORDS. STB TEMP LDB D$RQB DESTINATION ADDRESS. ADB D8 * MVW TEMP MOVE THE MESSAGE. * JSB D$WDC SET WORD LENGTH OF REQUEST. * * SET UP INPUT LU FOR $STDIN REQUESTS. * LDA P.STK,I IF CURRENT INPUT IS A LOGICAL UNIT, STA B USE IT. IF NOT, USE SPECIFIED LU. AND HB377 SZA LDB STKHD,I STB D$INP * * SEND REQUEST TO THE 3000 BY WRITING TO * QUEX'S CLASS, AND WAIT FOR THE REPLY. * JSB D3KMS SHIP THE REQUEST BUFFER TO QUEX. DEF *+2 NO ABORT IF ERROR. DEF CONWD NO TIMEOUT. JMP RFAIL REQUEST FAILED. * JMP CMNDS,I RETURN. * CONWD OCT 140000 SKP * * SUBROUTINE TO TEST FOR END OF FILE ON VARIOUS DEVICES. * * TEMP = EQT STATUS WORD. * INCNT = EQT WORD COUNT. * LUTYP = EQUIPMENT TYPE. * JSB EOFCK * EOF RETURN * NORMAL RETURN * EOFCK NOP CLE LDA LUTYP EOF DEPENDS ON DEVICE. SZA,RSS JMP EOF1 TTY. CPA B1 JMP EOF1 PHOTOREADER. CPA D9 JMP EOF4 CARD READER. CPA D13 JMP EOF4 MARK SENSE. CCE DEFAULT TO MAG TAPE. * EOF1 LDA TEMP GET STATUS WORD. ALF,ALF SEZ,RSS IF E=1, CHECK BIT 7. JMP EOF2 SSA JMP EOF3 EOF2 RAL,RAL CHECK BIT 5. SSA,RSS JMP EOF5 NO EOF. * EOF3 LDA LUTYP END OF FILE. SZA IF TTY, OUTPUT CAR. RET. JMP EOF6 * JSB REIO OUTPUT CARRIAGE-RETURN. DEF *+5 DEF B2 DEF P.STK,I DEF CR DEF B1 * JMP EOF6 * EOF4 LDA INCNT CHECK FOR BLANK CARD. HFBSZA EOF5 ISZ EOFCK EOF6 JMP EOFCK,I SKP * * KILL LEADING BLANKS IN COMMAND. * BLKIL NOP LBLNK LDA INBUF CHECK FOR LEADING BLANK AND HB377 (OK FOR RTE, BUT NG FOR 3000). CPA BLANK RSS JMP BLKIL,I NONE. RETURN. * LDA DINBF ADDRESS OF ASCII COMMAND. STA TEMP1 SOURCE POINTER. STA TEMP2 DESTINATION POINTER. LDA INCNT CMA,INA STA TEMP3 NEGATIVE # WORDS. LDB TEMP1,I PRIME THE PUMP. ISZ TEMP1 * LOOP1 LDA TEMP1,I MOVE STRING LEFT ONE BYTE. RRL 8 STB TEMP2,I ISZ TEMP2 RRL 8 ISZ TEMP1 ISZ TEMP3 JMP LOOP1 LOOP TILL DONE. * CCA SUBTRACT 1 FROM ADA TEMP CHARACTER COUNT. STA TEMP SZA CHECK FOR ZERO LENGTH. * JMP LBLNK GO LOOK FOR ANOTHER LEADING BLANK. * JMP QUERY ALL BLANKS. GET NEXT COMMAND. ?H SKP * * SUBROUTINE TO CHECK INTEGER PARAMETERS. * INTCK NOP (B) = CODE WORD. SZB,RSS JMP INVAL ERROR IF MISSING. ADB MD1 SZB JMP INVAL ERROR IF NOT NUMERIC. JMP INTCK,I SPC 3 * * SUBROUTINE TO FIND EQUIPMENT TYPE OF AN LU. * RETURN DRIVER TYPE, OR 0 FOR INTERACTIVE LU. * EQTYP NOP (A) = LU. STA TEMP1 * JSB EXEC DEF *+6 DEF D13 ICODE FOR STATUS DEF TEMP1 LU DEF TEMP2 EQT 5 RTN DEF TEMP3 EQT 4 RTN DEF TEMP4 UP/SUBCHANNEL RTN * LDA TEMP2 ALF,ALF ISOLATE AND B77 DRIVER NUMBER. STA TEMP2 * CPA B5 DVR05? JMP SUBC? YES--CHECK SUBCHANNEL. CPA B7 DVR07? JMP SUBC? YES--CHECK SUBCHANNEL. JMP EQTYP,I RETURN WITH TYPE IN A-REG. * SUBC? LDA TEMP4 DVR05 OR DVR07. AND B37 ISOLATE SUBCHANNEL. SZA IF ZERO, RETURN ZERO... LDA TEMP2 ELSE RETURN TYPE. JMP EQTYP,I RETURN. SPC 3 * * SUBROUTINE TO PROCESS ERRORS IN FILE CALLS. * ERCHK NOP LDA IERR CAN BE POS. OR NEG. SZA,RSS JMP ERCHK,I NO ERROR. * LDB BLANK MAKE POSITIVE, SET SIGN WORD. SSA,RSS JMP ERCK1 LDB MINUS CMA,INA ERCK1 STB EMSG+3 STA TEMP * JSB CNUMD DECIMAL CONVERSION. DEF *+3 CONVERT TO ASCII. DEF TEMP DEF ASCI LDA ASCI+2 STORE LAST 2 DIGITS IN MSG BUFFR. IOR LB20 LEADING BLANK TO ASCII 0. STA EMSG+4 LDA ASCI+1 SET UP SIGN AND AND B377 FIRST DIGIT. IOR EMSG+3 IOR B20 LEADING BLANK TO ASCII 0. STA EMSG+3 STORE IN MESSAGE BUFFER. SPC 2 * RESULT OF BAD INPUT LU/FILE: * ECHO OFFENDING COMMAND (IF SEVERITY=2) * CLOSE COMMAND FILE (IF OPEN) * DISPLAY ERRORō MESSAGE * GENERATE TR TO INITIAL LU OR 1 * INERR LDA SEVER IF SEVERITY CPA B2 CODE = 2, JSB ECHPR ECHO OFFENDING COMMAND. JSB EROUT PRINT ERROR MESSAGE. * JSB CLSFL CLOSE COMMAND FILE (IF ONE IS OPEN). * LDA STKHD IF STACK POINTER CPA P.STK IS AT THE TOP, JMP M0500 EXIT RMOTE! * STA P.STK RESET STACK POINTER. * LDA LUTYP SZA,RSS JMP QUERY * LDA A.TR GENERATE TR TO INITIAL LU (OR 1), STA INBUF USING CURRENT PROMPT CHAR. LDA A.TR1 STA INBUF+1 LDA A.TR1+1 STA INBUF+2 LDA STKHD,I ENTRY AT TOP OF STACK. AND HB377 SZA FILE NAME? JMP TR1 YES. USE TR,1. * JSB KCVT NO. CONVERT LU TO ASCII AND DEF *+2 PLACE IN TR COMMAND. DEF STKHD,I * STA INBUF+2 TR1 LDA B3 STA INCNT JMP ECHO SPC 3 * PRINT ERROR MESAGE * EROUT NOP JSB REIO DEF *+5 DEF B2 DEF ERRLU DEF EMSG DEF B5 JMP EROUT,I * EMSG ASC 5,RMOTE ERRLU NOP SPC 3 * * ECHO LAST INPUT * ECHPR NOP JSB REIO DEF *+5 DEF B2 DEF LOGLU DEF INBUF DEF INCNT JMP ECHPR,I SPC 3 * * SUBROUTINE TO CLOSE THE COMMAND FILE OPEN TO IDCB, IF OPEN. * CLSFL NOP LDA OPNFL SZA,RSS JMP CLSFL,I DCB IS ALREADY CLOSED. * JSB CLOSE CLOSE THE COMMAND FILE. DEF *+3 DEF IDCB DEF IERR * CLA STA OPNFL CLEAR OPEN FLAGS. JMP CLSFL,I RETURN. SPC 4 * * DISPLAY ON LOG DEVICE. * DSPLY NOP LDB DSPLY,I GET ADDR OF MESSAGE BUFFER. LDA B,I STA DSPL1 ADA MD1 GET ADDR OF MESSAGE LENGTH. LDA A,I STA DSPL2 * JSB REIO DISPLAY. DEF *+5 DEF SD2 DEF LOGLU  DSPL1 NOP MESSAGE ADDRESS. DSPL2 NOP MESSAGE LENGTH. * NOP IGNORE ERRORS ISZ DSPLY RETURN. JMP DSPLY,I SKP * * PARAMETER STORAGE AREA. * PRAMS NOP FLAG WORD. OP BSS 3 OPERATION CODE. CP1 NOP FLAG WORD. P1 BSS 3 PARAM 1 (UP TO 6 CHARACTERS). CP2 NOP P2 BSS 3 NOP P3 BSS 3 NOP P4 BSS 3 NOP P5 BSS 3 CP6 NOP P6 BSS 3 NOP BSS 3 NOP PARAMETER COUNTER. * B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B20 OCT 20 B37 OCT 37 B40 OCT 40 B77 OCT 77 B377 OCT 377 B400 OCT 400 LB20 OCT 10000 HB377 OCT 177400 MD1 DEC -1 MD2 DEC -2 MD4 DEC -4 D8 DEC 8 D9 DEC 9 D10 DEC 10 D13 DEC 13 D15 DEC 15 D40 DEC 40 SD1 DEF 1,I SD2 DEF 2,I SD9 DEF 9,I "IO" ASC 1,IO "NO" ASC 1,NO "SC" ASC 1,SC "01" ASC 1,01 "03" ASC 1,03 "05" ASC 1,05 OPNFL NOP ASCI BSS 3 SMPNM NOP TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP INCNT NOP # WORDS IN INPUT REQUEST. #BYTS NOP LUTYP NOP EQ. TYPE OF INPUT DEVICE. LOGLU NOP LU OF LOG DEVICE. LSTLU NOP LU OF LIST DEVICE. SEVER NOP SEVERITY CODE. A.TR ASC 2,$TR TR COMMAND WITH CURRENT PROMPT CHAR. A.TR1 ASC 2,R,1 CR OCT 6400 LPRMP OCT 22000 "$" PROMPT FOR LOCAL RTE. RPRMP OCT 21400 "#" PROMPT FOR REMOTE 3000. CPRMP NOP CURRENT PROMPT (LEFT BYTE). IERR NOP PROMP ASC 1,$_ CURRENT OPERATOR PROMPT. BLANK OCT 020000 BLNKS OCT 20040 MINUS OCT 026400 DFALT DEF ALTBK ALTBK OCT 0,0,0,0 TRFLG NOP INBUF BSS 40 BUFFER. IDCB BSS 144 * BSS 0 **** SIZE OF RMOTE **** * END RMOTE BG I_ 91741-18008 1740 S C0122 DS/1000 MODULE: D$EQT              H0101 ASMB,R,L HED SLC EQT EXTENSION * (C) HEWLETT-PACKARD CO. 1977 NAM D$EQT,30 91741-16008 REV 1740 770830 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$EQT,D$XS5 * * D$EQT * SOURCE: 91741-18008 * BINARY: 91741-16008 * JIM HARTSELL * DEC. 15, 1975 * S EQU 56 LENGTH OF EQTX STORAGE AREA. T EQU 100 LENGTH OF EQTX EVENT TRACE TABLE. F EQU 4 LENGTH OF EQTX CHAR TRACE TABLE. * * EQT EXTENSION BUFFER - SYNCHRONOUS LINE CONTROL PACKAGE. * D$EQT ABS 20+S+T+F LENGTH OF EQT EXTENSION. OCT 100030 LINE PLEX, REVERSE CHANNEL. (BY "LSTEN") OCT 26 SYNC CHARACTER = ASCII. OCT 0 SPEED INDICATOR. SPC 1 BSS S STORAGE AREA. D$XS5 OCT 0 ENVIRONMENT. (BY "LSTEN") ABS F LENGTH OF CHAR TRACE TABLE. SPC 1 1 OCT 0 # OF READ REQUESTS. ******************* OCT 0 # OF WRITE REQUESTS. * * OCT 0 # OF MESSAGES TRANSMITTED. * LONG-TERM * OCT 0 # OF ERROR-FREE MSGS RECV. * * OCT 0 # OF LINE ERRORS. * * OCT 0 # OF TIMES NAK RECEIVED. * COMMUNICATION * OCT 0 # OF TIMES BCC/PARITY. * * OCT 0 # OF LONG TIMEOUTS. * * OCT 0 # OF RESPONSE ERRORS. * STATISTICS * OCT 0 # OF TIMES RESPONSE REJ. * * OCT 0 # OF TIMES WACK/TTD RECV. ******************* SPC 1 OCT 0 ADDR OF NEXT WORD IN CHAR TRACE. OCT 0 ADDR OF CURR>   ENT ENTRY IN EVENT TRACE. OCT 0 ADDR OF OLDEST ENTRY IN EVENT TRACE. SPC 1 BSS T EVENT TRACE TABLE. BSS F CHARACTER TRACE TABLE. * SIZE EQU * END C  JQ 91741-18009 1740 S C0122 DS/1000 MODULE: FCHEK              H0101 (ASMB,R,L,C HED FCHEK 91741-16009 REV 1740 770317 * (C) HEWLETT-PACKARD CO. 1977 NAM FCHEK,7 91741-16009 REV 1740 770317 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FCHEK * EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS EXT D$ERR,D$WDC,D$RQB,D$IPM,D$NPM,D$SPM * * FCHEK * SOURCE: 91741-18009 * BINARY: 91741-16009 * JIM HARTSELL * AUG. 13, 1975 * FCHEK NOP ENTRY POINT. CLA STA PRAMS CLEAR OLD PARAM ADDRESSES. STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 STA PRAMS+4 LDA FCHEK STA ENTRY JMP BEGIN * PRAMS NOP FILE NUMBER. NOP ERROR CODE. NOP TRANSMISSION LOG. NOP BLOCK # (DBL-WORD). NOP # RECORDS IN BAD BLOCK. * ENTRY NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA B16 JSB D$STW FCHEK CODE = 16 OCTAL. * * MOVE USER PARAMS TO REQUEST BUFFER. * LDA N1 MOVE FNUM. JSB D$PRM * LDA N5 SET UP PARAMETER MASK. STA TEMP LDA DPRAM STA TEMP1 CLA,RSS LOOP RAL LDB TEMP1,I SZB IOR B1 SET BIT IF PARAM SPECIFIED. ISZ TEMP1 ISZ TEMP JMP LOOP JSB D$STW STORE MASK IN REQUEST. * JSB D$WDC SET WORD COUNT. * * REQUEST BUFFER= READY. SEND TO QUEX'S CLASS, * AND WAIT FOR REPLY. * JSB D3KMS SHIP REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * JMP RTPRM NORMAL RETURN. (A) = STATUS. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. * * PASS RETURN PARAMETERS TO CALLER. * RTPRM STA STAT SAVE STATUS WORD FOR RETURN. * LDB D$RQB IF REPLY PARAM NOT RETURNED, ADB B7 STORE ZERO IN PARAM SLOT. LDA B,I REPLY BYTE COUNT. ADB B7 STB TEMP POINTER TO LAST PARAM. INA ARS REPLY WORD COUNT. ADA N7 # PARAM WORDS TO CLEAR. SSA,RSS JMP RTP ALL PARAMS RETURNED. LOOP1 CLB STB TEMP,I LDB TEMP ADB N1 STB TEMP INA,SZA JMP LOOP1 * RTP LDB D255 SET UP FOR IMPOSSIBLE ERROR, LDA D$ERR AND CHECK DS ERROR CODE. SZA,RSS JMP RTPM1 NO ERROR POSTED. * CPA "DS" DS ERROR: IMPOSSIBLE ERROR? RSS JMP POST YES. * DLD D$ERR ERROR CODE IS "DSXX". PERFORM MAPPING. LDA B LDB D254 CPA "01" JMP POST MAP "DS01" TO DECIMAL 254. LDB D245 CPA "05" JMP POST MAP "DS05" TO DECIMAL 245. LDB D216 CPA "06" JMP POST MAP "DS06" TO DECIMAL 216. LDB D255 IMPOSSIBLE ERROR. POST LDA D$RQB STORE DS ERROR IN REPLY BUFFER. ADA D9 STB A,I * RTPM1 LDB D$RQB INITIALIZE: ADB D9 (B) = ADDR OF 1ST REPLY VALUE. LDA DPRAM INA (A) = ADDR OF 1ST RETURN PARAM ADDR. JSB D$IPM * LDA N2 PASS ERROR CODE, TLOG. CCB JSB D$NPM * LDA N2 PASS BLKNUM (2 WORDS). JSB D$SPM * CCA PASS NUMREC (1 WORD). JSB D$SPM * LDA STAT RESTORE STATUS WORD. JMP ENTRY,I RETURN. SP C 3 * * CONSTANTS AND WORKING STORAGE. * A EQU 0 B EQU 1 B1 OCT 1 B7 OCT 7 B16 OCT 16 D9 DEC 9 D216 DEC 216 D245 DEC 245 D254 DEC 254 D255 DEC 255 N1 DEC -1 N2 DEC -2 N5 DEC -5 N7 DEC -7 BIT15 OCT 100000 STAT NOP TEMP NOP TEMP1 NOP "DS" ASC 1,DS "01" ASC 1,01 "05" ASC 1,05 "06" ASC 1,06 * END  KS 91741-18010 1740 S C0122 DS/1000 MODULE: FCLOS              H0101 3ASMB,R,L,C HED FCLOS 91741-16010 REV 1740 770317 * (C) HEWLETT-PACKARD CO. 1977 NAM FCLOS,7 91741-16010 REV 1740 770317 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FCLOS,FRDSK,FRLAB,FWLAB,FSPAC,FPOIN,FCNTL ENT FSTMD,FRNAM,FRLAT,FLOCK,FUNLK * EXT D$RQB,D$NWD EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS EXT D$ERR,D$WDC,D$NWD,D$ASC,D$IPM,D$SPM * * FCLOS * SOURCE: 91741-18010 * BINARY: 91741-16010 * JIM HARTSELL * AUG. 13, 1975 * A EQU 0 B EQU 1 * FCLOS NOP FCLOSE. JSB ENTRY OCT 203 * FRDSK NOP FREADSEEK. JSB ENTRY OCT 501 * FRLAB NOP FREADLABEL. JSB ENTRY OCT 1001 * FWLAB NOP FWRITELABEL. JSB ENTRY OCT 1101 * FSPAC NOP FSPACE. JSB ENTRY OCT 1302 * FPOIN NOP FPOINT. JSB ENTRY OCT 1401 * FCNTL NOP FCONTROL. JSB ENTRY OCT 1703 * FSTMD NOP FSETMODE. JSB ENTRY OCT 2002 * FRNAM NOP FRENAME. JSB ENTRY OCT 2101 * FRLAT NOP FRELATE. JSB ENTRY OCT 2202 * FLOCK NOP FLOCK. JSB ENTRY OCT 2302 * FUNLK NOP FUNLOCK. JSB ENTRY OCT 2401 * * ALL ENTRY POINTS CONVERGE HERE. * ENTRY NOP LDA ENTRY,I SAVE FUNCTION CODE. ALF,ALF RAL,RAL AND B77 STA FCN LDA ENTRY,I SAVE # OF INITIAL PARAMS. AND B77 CMA,INA STA NUM CLA CLEAR OLD PARAM nADDRESSES. STA PRAMS STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 LDA ENTRY GET ADDR OF USER'S JSB + 1. ADA N2 LDA A,I STA RETRN SET UP FOR .ENTR CALL. JMP BEGIN * PRAMS NOP NOP NOP NOP * RETRN NOP COMMON ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS * CLA CLEAR ERROR CODE FOR FCHEK. CLB DST D$ERR * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA FCN JSB D$STW STORE FUNCTION CODE IN REQUEST. * * MOVE USER PARAMS TO REQUEST BUFFER. * LDA NUM MOVE INITIAL PARAMETERS. JSB D$PRM * * PERFORM SPECIAL HANDLING FOR CERTAIN FILE CALLS. * LDA FCN CPA B5 JMP F5 FREADSEEK. CPA B10 JMP F11 FREADLABEL. CPA B11 JMP F11 FWRITELABEL. CPA B14 JMP F5 FPOINT. CPA B21 JMP F21 FRENAME. JMP STWD * F5 LDA N2 FREADSEEK: JSB D$NWD MOVE RECNUM. JMP STWD * F11 CLA FWRITELABEL AND FREADLABEL: LDA PRAMS+2,I JSB D$STW STORE TCOUNT (+WORDS). CLA (A) CLEARED IN CASE NO PARAM. LDA PRAMS+3,I JSB D$STW STORE LABELID. * LDA DPRAM SET UP PARAMETER MASK. STA TEMP LDA N4 MAX. NUMBER OF PARAMS. STA TEMP1 CLA,RSS MSK RAL SHIFT ACCUMULATED BITS. LDB TEMP,I SEE IF PARAM GIVEN. SZB IOR B1 YES. SET THE BIT. ISZ TEMP ISZ TEMP1 JMP MSK LOOP TILL DONE. * JSB D$STW STORE MASK. LDA FCN DONE IF FREADLABEL. CPA B10 JMP STWD LDA PRAMS+1 FWRITELABEL. SZA,RSS JMP >STWD NO TARGET ADDRESS. CLA CLEARED IN CASE NO PARAM. LDA PRAMS+2,I SZA,RSS JMP STWD TCOUNT IS ZERO OR NOT GIVEN. SSA ARS NEG BYTES. MAKE NEG WORDS. SSA,RSS CMA,INA POS WORDS. MAKE NEG WORDS. JSB D$NWD STORE LABEL. JMP STWD * F21 LDA PRAMS+1 FRENAME: LDB N14 SZA SKIP IF NO FILE NAME. JSB D$ASC STORE NEW FILE NAME. * STWD JSB D$WDC SET WORD COUNT. * * REQUEST BUFFER READY. SEND TO QUEX'S CLASS, * AND WAIT FOR REPLY. * JSB D3KMS SHIP REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * * PASS ANY RETURN PARAMETERS TO USER. * STA TEMP SAVE STATUS WORD. * LDA FCN CHECK TYPE OF CALL. CPA B10 JMP FF10 CPA B17 JMP FF17 CPA B22 RSS JMP RET * LDB D$RQB FRELATE: ADB D9 LDA B,I PASS JMP RETRN,I (A) = INT-OR-DUP WORD. * FF17 LDB D$RQB FCONTROL: ADB D9 LDB B,I GET RETURN PARAMETER. LDA PRAMS+2 SZA STB A,I PASS TO CALLER. JMP RET * FF10 LDA PRAMS+1 IF NO TARGET ADDR, SZA,RSS JMP RET DON'T PASS LABEL. LDA DPRAM FREADLABEL: INA LDB D$RQB ADB D9 JSB D$IPM INITIALIZE PARAM PASSERS. * LDA D$RQB DETERMINE # WORDS IN LABEL. ADA B7 LDA A,I ADA N1 # BYTES -1 (DELETE STATUS WORD). ARS # WORDS. CMA,INA NEG. # WORDS. SZA SKIP IF NO LABEL RETURNED. JSB D$SPM PASS N-WORD PARAM. * RET LDA TEMP RESTORE STATUS WORD. * JMP RETRN,I RETURN TO USER. (A) = STATUS. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP RETRN,I RETURN. SKP  * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B5 OCT 5 B7 OCT 7 B10 OCT 10 B11 OCT 11 B14 OCT 14 B17 OCT 17 B21 OCT 21 B22 OCT 22 B77 OCT 77 N1 DEC -1 N4 DEC -4 D9 DEC 9 N2 DEC -2 N14 DEC -14 BIT15 OCT 100000 TEMP NOP TEMP1 NOP FCN NOP NUM NOP * END my LU 91741-18011 1840 S C0122 &FINFO              H0101 uASMB,R,L,C HED FINFO 91741-16011 REV 1840 780612 * (C) HEWLETT-PACKARD CO. 1978 NAM FINFO,7 91741-16011 REV 1840 780612 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FINFO * EXT D$RQB EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS EXT D$ERR,D$WDC,D$IPM,D$NPM,D$SPM * * FINFO * SOURCE: 91741-18011 * BINARY: 91741-16011 * JIM HARTSELL * AUG. 13, 1975 * FINFO NOP ENTRY POINT. LDA DPRAM CLEAR OLD PARAM ADDRESSES. STA ENTRY LDB COUNT CLA STA ENTRY,I ISZ ENTRY INB,SZB JMP *-3 LDA FINFO STA ENTRY JMP BEGIN COUNT DEC -20 * PRAMS NOP FILE NUMBER. NOP FILE NAME ARRAY (14 WORDS). NOP FOPTIONS. NOP AOPTIONS. NOP RECORD SIZE. NOP DEVICE TYPE. NOP LOGICAL DEVICE #. NOP HARDWARE ADDRESS. NOP FILE CODE. NOP RECORD POINTER (DBL-WORD). NOP END-OF-FILE (DBL-WORD). NOP FILE LIMITS (DBL-WORD). NOP # RECORDS XF (DBL-WORD). NOP # PHYS I/O XF (DBL-WORD). NOP BLOCK SIZE. NOP EXTENT SIZE. NOP NUMBER OF EXTENTS. NOP USER LABELS. NOP CREATOR ID (4 WORDS). NOP LABEL ADDRESS (DBL-WORD). * ENTRY NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS CLA CLEAR ERROR CODE FOR FCHEK. CLB G" DST D$ERR * B EQU 1 SKP * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA B15 JSB D$STW FINFO CODE = 15 OCTAL. * * MOVE USER PARAMS TO REQUEST BUFFER. * CCA MOVE FNUM. JSB D$PRM * * SET UP DBL-WORD PARAMETER MASK FOR 20 PARAMS: BIT 3 OF 1ST WORD * REPRESENTS THE FILNUM PARAM; BIT 0 OF 2ND WORD REPRESENTS * LABADDR. IF A BIT IS SET, THAT PARAMETER WAS SPECIFIED IN * THE CALLING SEQUENCE. * LDA DPRAM ADDR OF 1ST PARAM ADDRESS. LDB N4 CHECK 1ST 4 PARAMS FOR MASK(1). JSB BTMSK BUILD MASK WORD 1. JSB D$STW STORE WORD 1 OF MASK IN REQUEST. LDA DPRAM ADA B4 ADDR OF 5TH PARAM ADDRESS. LDB N16 CHECK LAST 16 PARAMS FOR MASK(2). JSB BTMSK BUILD MASK WORD 2. JSB D$STW STORE WORD 2 OF MASK IN REQUEST. * JSB D$WDC SET WORD COUNT. * * REQUEST BUFFER READY. SEND TO QUEX'S CLASS, * AND WAIT FOR REPLY. * JSB D3KMS SHIP REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * * PASS RETURN PARAMETERS TO THE CALLER IF PARAM SPECIFIED. * STA TEMP SAVE STATUS WORD. * LDB D$RQB IF REPLY PARAM NOT RETURNED, ADB B7 STORE ZERO IN PARAM SLOT. LDA B,I REPLY BYTE COUNT. ADB D44 STB TEMP1 POINTER TO LAST PARAM. INA ARS REPLY WORD COUNT. ADA N44 # PARAMS WORDS TO CLEAR. SSA,RSS JMP RTP ALL PARAMS RETURNED. LOOP CLB STB TEMP1,I LDB TEMP1 ADB N1 STB TEMP1 INA,SZA JMP LOOP * RTP LDA DPRAM INITIALIZE: INA (A) = ADDR OF 1ST RETURN PARAM ADDR. LDB D$RQB ADB D9 (B) = ADDR OF 1ST REPLY VALUE. 2 JSB D$IPM * LDA N14 RETURN FILE NAME (14 WORDS). JSB D$SPM * LDA N7 RETURN FOPTIONS THRU FILECODE. CCB (SINGLE WORD VALUES) JSB D$NPM * LDA N5 RETURN RECPT THRU PHYSCOUNT. LDB N2 (DOUBLE WORD VALUES) JSB D$NPM * LDA N4 RETURN BLKSIZE THRU USERLABELS. CCB (SINGLE WORD VALUES) JSB D$NPM * LDA N4 RETURN CREATORID. JSB D$SPM (4-WORD VALUES) * LDA N2 RETURN LABADDR. JSB D$SPM * LDA TEMP RESTORE STATUS WORD. JMP ENTRY,I RETURN TO USER. (A) = STATUS. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP ENTRY,I RETURN. * * SUBROUTINE TO BUILD PARAMETER BIT MASK. * (A) = ADDR OF 1ST PARAM. * (B) = # PARAMS. * BTMSK NOP STA TEMP SAVE PARAM ADDR. STB TEMP1 SAVE # PARAMS. CLA,RSS RESET BIT MASK WORD. MSK RAL SHIFT ACCUMULATED BITS. LDB TEMP,I SEE IF PARAM GIVEN. SZB IOR B1 YES. SET THE BIT. ISZ TEMP ISZ TEMP1 JMP MSK LOOP FOR N PARAMS. JMP BTMSK,I RETURN. (A) = BIT MASK. SKP * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B4 OCT 4 B7 OCT 7 B15 OCT 15 D9 DEC 9 D44 DEC 44 N1 DEC -1 N2 DEC -2 N4 DEC -4 N5 DEC -5 N7 DEC -7 N14 DEC -14 N16 DEC -16 N44 DEC -44 BIT15 OCT 100000 TEMP NOP TEMP1 NOP * END # MU 91741-18012 1740 S C0122 DS/1000 MODULE: FREAD              H0101 {4ASMB,R,L,C HED FREAD 91741-16012 REV 1740 770317 * (C) HEWLETT-PACKARD CO. 1977 NAM FREAD,7 91741-16012 REV 1740 770317 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT FREAD,FRDIR * EXT .ENTR,D3KMS,D$INI,D$RFH,D$STW,D$PRM EXT D$RQB,D$ERR,D$WDC * * FREAD * SOURCE: 91741-18012 * BINARY: 91741-16012 * JIM HARTSELL * AUG. 14, 1975 * A EQU 0 B EQU 1 * FREAD NOP FREAD. JSB ENTRY B3 OCT 3 * FRDIR NOP FREADDIR. JSB ENTRY OCT 4 * ENTRY NOP CLA CLEAR OLD PARAM ADDRESSES. STA PRAMS STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 LDA ENTRY,I SAVE FUNCTION CODE. STA FCN LDA ENTRY SET UP FOR .ENTR CALL. ADA N2 LDA A,I STA RETRN JMP BEGIN * PRAMS NOP FILE NUMBER. NOP BUFFER ADDRESS NOP BUFFER LENGTH NOP RECORD NUMBER. * RETRN NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRS OF USER PARAMS. DPRAM DEF PRAMS * CLA CLEAR ERROR CODE FOR FCHEK. CLB DST D$ERR SKP * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA FCN JSB D$STW FREAD CODE = 3, FRDIR = 4. * * MOVE USER PARAMS TO REQUEST BUFFER. * CCA JSB D$PRM MOVE FNUM. * LDA PRAMS+1 IF NO TARGET ADDR, SZA,RSS STA PRAMS+2 ZERO TCOUNT ADDR." CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+2,I STORE USER BUFFER LEN IN "TCOUNT". JSB D$STW + = WORDS, - = BYTES. * LDA FCN IF FREADDIR, STORE RECNUM. CPA B3 JMP STWD CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+3,I JSB D$STW CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+3 SZA INA LDA A,I JSB D$STW * STWD JSB D$WDC SET WORD COUNT. LDA N4 SET APPENDAGE LENGTH = 4 BYTES. STA APEND * * SEND REQUEST TO 3000 BY WRITING TO QUEX'S CLASS, * AND WAIT FOR THE REPLIES (MAY BE SEVERAL). * LDA PRAMS+1 SET ADDR OF USER DATA BUFFER. STA TBUF CLA STA TCNT CLEAR RECEIVED BYTE COUNT (LOG). * INA SIGNAL FOR MULTIPLE REPLIES. SN/RC IOR BIT15 STORE CONTROL WORD FOR D3KMS. STA CONWD HAS NO-ABORT BIT SET. * JSB D3KMS SHIP REQUEST BUFFER TO QUEX, DEF *+2 AND WAIT FOR DATA REPLY. DEF CONWD JMP ABERR ERROR RETURN. * LDA CONWD WAS LAST CALL TO RELEASE AND B377 CPA B4 CLASS ONLY? JMP DONE YES. * LDA D$RQB CHECK IF ANY DATA WAS ADA B7 RECEIVED. LDA A,I ADA APEND SZA,RSS JMP CONBT READ ERROR - NO DATA. * * PASS RECEIVED DATA BLOCK BACK TO USER. * JSB MOVE MOVE DATA TO USER BUFFER. * CONBT LDA D$RQB IS CONTINUATION BIT SET? ADA B2 LDA A,I RAL,RAL SSA JMP DMREP YES. LDA B4 NO. DE-ALLOC CLASS. JMP SN/RC * DMREP LDB D$RQB SET UP "REPLY". LDA B,I STORE COUNT AND MSG CLASS. AND B377 IOR LB10 STA B,I ADB B2 LDA B,I CLEAR REPLY BIT. ELA,CLE,ERA STA B,I ADB B2 LDA B,I REVERSE PROCESS NUMBERS. ALF,ALF STA B,I ADB B3  CLA CLEAR BYTE COUNT. STA B,I STA APEND SET APPENDAGE LEN = 0. * LDA B2 TELL D3KMS TO LOOK FOR MORE. JMP SN/RC GO GET NEXT DATA BLOCK. * DONE LDA TCNT RETURN TO USER WITH LDB PRAMS+2 (A) = + WORDS OR + BYTES SZB,RSS JMP RETRN,I LDB B,I SSB DEPENDING ON HIS BUFLEN. JMP RETRN,I INA CLE,ERA JMP RETRN,I * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP RETRN,I RETURN. SPC 3 * * SUBROUTINE TO MOVE A BLOCK OF DATA FROM REPLY * BUFFER TO USER BUFFER. * ENTRY: (A) = + # DATA BYTES IN THIS REPLY. * EXIT WITH TCNT = TOTAL BYTES RECEIVED. * MOVE NOP LDB A ACCUMULATE LOG. ADB TCNT STB TCNT INA (A) = + BYTES. CLE,ERA CMA,INA STA TEMP NEG. # WORDS TO MOVE. * LDA APEND COMPUTE ADDR OF REPLY DATA. CMA,INA ARS LDB D$RQB ADB D8 ADB A STB RQPTR ADDRESS OF REPLY DATA. * LOOP LDA RQPTR,I MOVE WORD FROM REPLY STA TBUF,I TO USER BUFFER. ISZ RQPTR BUMP POINTERS. ISZ TBUF * ISZ TEMP JMP LOOP LOOP TILL DONE. JMP MOVE,I SKP * * CONSTANTS AND WORKING STORAGE. * B2 OCT 2 B4 OCT 4 B7 OCT 7 D8 DEC 8 N2 DEC -2 N4 DEC -4 LB10 OCT 4000 B377 OCT 377 BIT15 OCT 100000 APEND NOP FCN NOP CONWD NOP TCNT NOP TBUF NOP TEMP NOP RQPTR NOP * END L NV 91741-18013 1840 S C0122 &FWRIT              H0101 ASMB,R,L,C HED FWRIT 91741-16013 REV 1840 780612 * (C) HEWLETT-PACKARD CO. 1978 NAM FWRIT,7 91741-16013 REV 1840 780612 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FWRIT,FWDIR,FUPDT * EXT .ENTR,D3KMS,D$INI,D$RFH,D$STW,D$PRM EXT D$RQB,D$ERR,D$WDC * * FWRIT * SOURCE: 91741-18013 * BINARY: 91741-16013 * JIM HARTSELL * AUG. 13, 1975 * D EQU 256 MAX. LENGTH OF DATA BLOCK (WORDS). A EQU 0 B EQU 1 * FWRIT NOP FWRITE. JSB ENTRY OCT 6 * FWDIR NOP FWRITEDIR. JSB ENTRY B7 OCT 7 * FUPDT NOP FUPDATE. JSB ENTRY B12 OCT 12 * ENTRY NOP LDA ENTRY,I SAVE FUNCTION CODE. STA FCN CLA CLEAR OLD PARAM ADDRESSES. STA PRAMS STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 LDA ENTRY SET UP FOR .ENTR CALL. ADA N2 LDA A,I STA RETRN JMP BEGIN * PRAMS NOP FILE NUMBER NOP BUFFER ADDRESS NOP BUFFER LENGTH NOP CONTROL WORD OR RECNUM. * RETRN NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRS OF USER PARAMS. DPRAM DEF PRAMS * CLA CLEAR ERROR CODE FOR FCHECK. CLB DST D$ERR * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA FCN JSB D$STW FWRIT = 6, FWDIR = 7, FUPDT = 12. * * MOVE USER PARAMS TO REQUEST BUFFER. * ~CCA JSB D$PRM MOVE FNUM. * LDA PRAMS+1 IF NO TARGET ADDR, SZA,RSS STA PRAMS+2 CLEAR TCOUNT ADDR. CLA JSB D$STW STORE DUMMY TCOUNT FOR NOW. LDA D5 INITIALIZE LENGTH OF STA APEND APPENDAGE TO 5 WORDS. * LDA FCN IF UPDATE, NO MORE PARAMS. CPA B12 JMP STWD * ISZ APEND CHANGE APPENDAGE TO 6. CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+3,I JSB D$STW MOVE CONTROL WORD OR RECNUM. * CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+3 SZA INA LDA A,I LDB FCN IF FWRITEDIR, STORE WORD 2 OF RECNUM. CPB B7 RSS JMP STWD JSB D$STW ISZ APEND CHANGE APPENDAGE TO 7. * STWD JSB D$WDC SET WORD COUNT. * * MOVE USER DATA TO REQUEST BUFFER. BLOCK IT OUT. * LDA PRAMS+1 SET POINTER TO USER DATA. STA TBUF * CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+2,I GET USER BUFFER LENGTH. SSA,RSS + = WORDS, - = BYTES. RAL WORDS. CONVERT. SSA BYTES. MAKE POSITIVE. CMA,INA STA TCNT TOTAL DATA BYTES TO SEND. CMA,INA STORE "TCOUNT" IN REQUEST. LDB D$RQB ADB D12 STA B,I * SZA SKIP MOVE IF NO DATA. JSB MOVE MOVE 1ST BLOCK TO REQ BUFFER. * CLA SET APPENDAGE = 0. STA APEND LDA TCNT SZA,RSS IF ALL DATA MOVED, JMP SEND TELL D3KMS THERE IS SINGLE REPLY. * LDB D$RQB CONTINUATION BLOCKS REQUIRED. ADB D2 LDA B,I IOR BIT13 SET CONTINUATION BIT IN STREAM WORD. STA B,I CLA,INA TELL D3KMS THERE ARE MULT. BLOCKS. * * SEND REQ TO 3000 BY WRITING TO QUEX'S CLASS. * SEND IOR BIT15 STORE CONTROL WORD FOR D3KMS. STA CONWD (NO-ABORT BIT SET) * JSB D3KMS SH0\IP REQUEST BUFFER TO QUEX, DEF *+2 AND WAIT FOR INTERMEDIATE DEF CONWD OR FINAL REPLY. JMP ABERR ERROR RETURN. * LDB TCNT IF ALL DATA OUT, WE HAVE SZB,RSS RECEIVED THE REPLY. JMP RETRN,I RETURN. (A) = STATUS WORD. * LDB D$RQB IF CONTINUATION ADB D2 BIT IS NOT LDA B,I SET, ERROR AND BIT13 CONDITION! SZA,RSS RETURN. USER JMP RETRN,I GETS REASON VIA ICC. * * MORE DATA... SHIP OUT NEXT BLOCK. * LDA B,I CLEAR REPLY BIT. ELA,CLE,ERA STA B,I * JSB MOVE MOVE SOME MORE DATA TO REQUEST. * LDA D2 LDB TCNT SZB IF MORE DATA, KEEP CONTIN. BIT. JMP SEND CALL D3KMS WITH RCODE = 2. * LDB D$RQB THIS IS LAST BLOCK. ADB D2 LDA B,I AND NOT13 CLEAR CONTINUATION BIT. STA B,I LDA D3 TELL D3KMS THIS IS LAST BLOCK. JMP SEND * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP RETRN,I RETURN. SKP * * SUBROUTINE TO STORE # BYTES LEFT TO SEND IN REQ * BUFFER AND MOVE NEXT BLOCK OF USER DATA (REMAINING * BYTES UP TO MAX). STORE ADJUSTED BYTE COUNTER (N) * IN REQUEST. ON EXIT, TCNT IS REMAINING # DATA * BYTES OR ZERO. * MOVE NOP LDA D$RQB INITIALIZE BYTE COUNTER (N). ADA B7 LDA A,I STA BYTCT LDB D$RQB ADB D8 * ADB APEND SET ADDR OF DATA IN RQBUF. STB RQPTR LDA MAXSZ STA TEMP SET LIMIT OF MAX WORDS. * LOOP LDA TBUF,I MOVE DATA FROM USER TO REQUEST. STA RQPTR,I ISZ TBUF ISZ RQPTR ISZ BYTCT ADD 2 TO BYTE COUNTER (N). ISZ BYTCT LDA TCNT DECREMENT TOTAL DATA BYTES LEFT. ADA N2 STA TCNT CMA,INA NEGATE. SSA,RSS IF 0 OR 1, JMP ADJ ALL USER DATA MOVED, ISbZ TEMP JMP LOOP ELSE LOOP TILL DONE. JMP STBYT REACHED LIMIT OF MAX WORDS. * ADJ CMA,INA ADJUST BYTE COUNTER (N) ADA BYTCT IF ODD # DATA BYTES. STA BYTCT * STBYT LDA D$RQB STORE BYTE COUNT (N). ADA B7 LDB BYTCT STB A,I LDA TCNT IF TCNT = -1, MAKE IT 0. CPA N1 CLA STA TCNT * JMP MOVE,I RETURN. SKP * * CONSTANTS AND WORKING STORAGE. * D2 DEC 2 D3 DEC 3 D5 DEC 5 D8 DEC 8 D12 DEC 12 N1 DEC -1 N2 DEC -2 BIT13 OCT 20000 NOT13 OCT 157777 BIT15 OCT 100000 FCN NOP CONWD NOP TBUF NOP TCNT NOP BYTCT NOP RQPTR NOP TEMP NOP APEND OCT 0 MAXSZ ABS -D * END  OX 91741-18014 1913 S C0122 DS/1000 MODULE: HELLO              H0101 7ASMB,R,L,C HED HELLO 91741-16014 * (C) HEWLETT-PACKARD CO. NAM HELLO,7 91741-16014 REV 1913 781114 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT HELLO,BYE EXT D$RQB,#LU3K,.ENTR,#RSAX,#TBRN,RNRQ EXT D$INI,D$STW,D3KMS,D$ZRO,D$WDC EXT D$SMP,D$LOG,LUTRU SPC 3 **************************** HELLO ***************************** * * * SOURCE: 91741-18014 * * * * BINARY: 91741-16014 * * * * PROGRAMMER: JIM HARTSELL * * * * SEPTEMBER 29, 1975 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 14, 1978 * * * ****************************************************************** SPC 2 B EQU 1 SUP SKP * SUBROUTINE HELLO MUST BE CALLED BY A USER PROGRAM BEFORE * ANY MASTER COMMUNICATION FUNCTIONS WITH AN HP3000, SUCH AS * RFA AND PTOP. THIS SUBROUTINE ESTABLISHES COMMUNICATION * AND CREATES A REMOTE SESSION MAIN PROCESS ON THE HP3000 WHICH * ACTS AS A LOGIHCAL EXTENSION TO THE LOCAL PROCESS. * * SUBROUTINE BYE IS CALLED TO TERMINATE COMMUNICATION WITH * A REMOTE HP3000 AND TO RELEASE THE SESSION MAIN PROCESS NUMBER. * * CALLING SEQUENCES: * * JSB HELLO JSB BYE * DEF *+7 DEF *+5 * DEF ERRCD <<<<<<<<< ERROR CODE >>>>>>>>>> DEF ERRCD * DEF LDEV <<<<<<< LU OF AN HP3000 >>>>>>> DEF LDEV * DEF LSTDV <<<<<< LU OF LOG DEVICE >>>>>>> DEF LSTDV * DEF SMPNM <<< RETURNED PROCESS NUMBER >>> DEF SMPNM * DEF LOGB << ADDRESS OF LOGON MESSAGE . * DEF LOGBL < LENGTH OF LOGON MSG IN BYTES . * . . * . . * . . * LOGB ASC 8,HELLO USER.ACCT * * RETURNED ERRCD: 0 = NO ERROR. * 1 = HELLO FAILURE (SMPNM = 0) OR LINK DOWN. * 2 = RESERVED FOR EXCLUSIVE ACCESS. * 4 = INVALID LU. * 5 = TIMEOUT. * 6 = ILLEGAL (REJECTED) REQUEST. * 7 = "RES" TABLE ACCESS ERROR. * 8 = IMPOSSIBLE ERROR. * SKP * HELLO NOP ENTRY FOR "HELLO". LDA HELLO LDB B20 STREAM = 20 OCTAL. JMP PASAD * BYE NOP ENTRY FOR "BYE". LDA BYE LDB B21 STREAM = 21 OCTAL. * PASAD STA RETRN SET UP RETURN ADDRESS. STB STREM SAVE STREAM TYPE. CLA STA PRAMS CLEAR OLD PARAM ADDRESSES. STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 STA PRAMS+4 STA PRAMS+5 JMP ENTER * PRAMS NOP ERROR CODE. NOP LOGICAL UNIT OF HP3000. NOP LU OF LOG DEVICE. NOP RETURNED PROCESS NUMBER. NOP ADDR OF LOGON MESSTAGE. NOP LENGTH OF LOGON MESSAGE (BYTES). * RETRN NOP ENTER JSB .ENTR GET PARAM ADDRESSES. DPRAM DEF PRAMS * LDA DPRAM CHECK FOR MISSING PARAMETERS. STA TEMP LDA STREM LDB N6 6 PARAMS FOR HELLO, CPA B21 OR LDB N4 4 PARAMS FOR BYE. PLOOP LDA TEMP,I SZA,RSS JMP ILL ERROR - MISSING PARAM. ISZ TEMP INB,SZB JMP PLOOP * * VERIFY VALID HP3000 LOGICAL UNIT. * LDA B4 PRESET THE ERROR CODE. LDB #LU3K CPB PRAMS+1,I RSS JMP NGOOD INVALID LU. * * CHECK IF USER FOLLOWED A "HELLO" WITH ANOTHER "HELLO", * AND IF SO, PERFORM "BYE" PROCESSING FOR PREVIOUS "HELLO". * LDA STREM IS THIS A "HELLO"? CPA B21 JMP GTLOG NO. * LDA D$SMP GET CURRENT PROCESS NUMBER. SZA,RSS HAS IT ALREADY BEEN ESTABLISHED? JMP GTLOG NO. * JSB #RSAX YES. DO "BYE" PROCESSING FOR DEF *+3 PREVIOUS "HELLO": DEF D10 REMOVE OLD ENTRY FROM THE PNL. DEF D$SMP PROCESS NUMBER. * GTLOG LDA PRAMS+2,I GET LU OF LOG DEVICE. SZA,RSS CLA,INA ZERO: SET DEFAULT = LU 1. STA D$LOG SAVE LOG LU. * * BEGIN CONSTRUCTION OF REQUEST BUFFER WITH * THE 8-WORD FIXED FORMAT FOR REMOTE HELLO OR BYE. * LDA DPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * LDA B6 STORE MESSAGE CLASS = 6. JSB D$STW CLA CLEAR COMPUTER ID. JSB D$STW LDA STREM STORE STREAM TYPE. JSB D$STW LDA N4 CLEAR SUB-STREAM, PROCESS #'S. JSB D$ZRO CLA,INA LDB STREM HELLO OR BYE? CPB B20 BYE: BYTE COUNT WILL BE 3. LDA PRAMS+5,I HELLO: USE SUPPLIED BYTE COUNT. SZA,RSS JMP NOLEN ZERO LENGTH: ILLEGAL REQUEST. ADA N2 ADJUST FOR D$STW.  JSB D$STW STORE MESSAGE BYTE COUNT. JMP MOVE NOLEN CLA,INA JMP NGOOD ILL LDA B6 JMP NGOOD TBLER LDA B7 JMP NGOOD * * MOVE ASCII MESSAGE TO REQUEST BUFFER. * MOVE LDA STREM HELLO OR BYE? CPA B20 JMP MVMSG HELLO. * LDA "BY" BYE. MOVE ASCII "BYE". JSB D$STW LDA "E" JSB D$STW BYTE COUNT NOW = 3. LDA PRAMS+3,I FORCE USER'S PROCESS # FOR D3KMS. STA D$SMP JMP STCNT * MVMSG LDB PRAMS+5,I NUMBER OF BYTES. INB ROUND UP. CLE,ERB MAKE WORDS. STB TEMP LDA PRAMS+4 SOURCE ADDRESS. LDB D$RQB ADB D8 DESTINATION ADDRESS. MVW TEMP MOVE THE MESSAGE. * STCNT JSB D$WDC STORE WORD LENGTH OF REQUEST. * * SEND REQUEST TO THE 3000 BY WRITING TO QUEX'S CLASS. * JSB D3KMS SHIP THE REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO-ABORT BIT SET IN CONWD. JMP ERRTN ERROR RETURN. * CLA CLEAR ERROR CODE. STA PRAMS,I LDA STREM HELLO OR BYE? CPA B21 JMP BYEX BYE: CLEAN UP. * LDB D$RQB HELLO: GET PROCESS NUMBER ADB B4 FROM REPLY BUFFER. LDA B,I ALF,ALF AND B377 STA D$SMP STORE FOR MASTER REQUESTS. STA PRAMS+3,I PASS BACK TO CALLER. STA B CLA,INA SZB,RSS JMP NGOOD HELLO FAILURE. * * BUILD PROCESS NUMBER LIST ENTRY IN "RES". * JSB LUTRU GET "REAL" LOG LU. DEF *+3 DEF D$LOG DEF REALU * JSB RNRQ WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE. DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT/NO ABORT. DEF #TBRN TABLE-ACCESS RN. DEF TEMP DUMMY. JMP TBLER ** RTE ERROR. * JSB #RSAX ADD PROCESS # LIST ENTRY. DEF *+5 DEF D8 DEF REALU LOGGING LU. DEF XEQT IDSEG ADDR OF USER. DEF D$SMP PROCESS NUMBER. * SSB ANY ERRORS? JMP TBLER YES. * * SEND "DSLINE" COMMAND TO HP3000 AFTER "HELLO". * LDA DSLBF MOVE REQUEST TO D3KMS BUFFER. LDB D$RQB MVW D12 * JSB D3KMS SEND "DSLINE" TO HP3000, DEF *+2 AND WAIT FOR REPLY. DEF BIT15 NO ABORT. JMP ERRTN ERROR RETURN. * JMP RETRN,I RETURN TO USER. * * BYE: REMOVE AN ENTRY FROM THE PROCESS # LIST IN "RES". * BYEX JSB #RSAX DEF *+3 DEF D10 REMOVE AN ENTRY. DEF D$SMP PROCESS NUMBER. * CLA CLEAR STA D$SMP PROCESS NUMBER. JMP RETRN,I RETURN TO USER. * ERRTN CPA "DS" RSS JMP IMPOS IMPOSSIBLE ERROR. * LDA B GET NUMERIC PORTION OF "DSXX". CPA "00" JMP IMPOS IMPOSSIBLE IF ZERO. AND B7 ISOLATE LAST DIGIT. * NGOOD LDB PRAMS MAKE SURE ERROR PARAM SZB WAS SPECIFIED. STA PRAMS,I RETURN ERROR CODE. JMP RETRN,I RETURN TO CALLER. * IMPOS LDA D8 JMP NGOOD SKP * * CONSTANTS AND WORKING STORAGE. * B4 OCT 4 B6 OCT 6 B7 OCT 7 B20 OCT 20 B21 OCT 21 BIT15 OCT 100000 B377 OCT 377 D8 DEC 8 D10 DEC 10 D12 DEC 12 N2 DEC -2 N4 DEC -4 N6 DEC -6 XEQT EQU 1717B LGW OCT 40002 STREM NOP "BY" ASC 1,BY "E" ASC 1,E "DS" ASC 1,DS "00" ASC 1,00 TEMP NOP REALU NOP * DSLBF DEF *+1 OCT 006003 "DSLINE" REQUEST BUFFER. OCT 0 OCT 22 OCT 0,0,0,0 OCT 10 ASC 2,RFA OCT 27 OCT 0 * END  P Z 91741-18015 2013 S C0322 &HSLC              H0103 VASMB,R,Q,C *** SLC *** HED SYNC LINE CONTROL 06/01/79 HI-SPEED NAM HSLC,30 91741-16015 REV 2013 790601 SPC 2 ******************************************************* * * * MODIFIED BY DMT ON MAY 30, 1978 TO REMOVE UNUSED * * CODE, MOSTLY IN THESE AREAS * * EBCDIC CHARACTER HANDLING * * LCR BLOCK CHECK (CRC ONLY IS USED) * * ID SEQUENCE CHECKING/SENDING * * CHARACTER CHECK UPON RETURN FROM DRIVER * * * * FURTHER CLEANUP DONE ONE YEAR LATER. * * * ******************************************************* SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT SLC LOGICAL INIT ROUTINE EXT EQTAD EXT .ENTR EXT EXEC * * SLC (HSI VERSION) * SOURCE: 91741-18015 * BINARY: 91741-16015 * TOM KEANE * JULY 1, 1975 * EXT HCONT,HSND,HREC * * SUBROUTINE SLC: LOGICAL INITIALIZATION ROUTINE FOR SLC * JSB SLC * DEF *+3 * DEF LU LOGICAL UNIT NUMBER * DEF BUFFER EQT EXTENSION * LU OCT 0 PTR TO LOGICAL UNIT NUMBER EQTXP OCT 0 ADDR OF EQT EXTENSION BUFFER * SLC NOP JSB .ENTR PROCESS PARAMETERS DEF LU LDB EQTXP GET ADDR OF EQTX ADB .4 B = EQT22 ADDR LDA .SLCR STA B,I SET UP SLC READ ADDR INB LDA .SLCW  STA B,I SET UP SLC WRITE ADDR INB LDA .SLCC STA B,I SET UP SLC CONTROL ADDR INB ADB M5 B = EQTX3 ADDR (SYNC) LDA B,I GET SPECIFIED SYNC CHAR ADB .31 B = EQTX WORD 34 ADDR CPA .22 ASCII SYNC CHAR? JMP ASCII YES CLA,INA NO, SET A-REG =1 AS AN ERROR IND JMP SLC,I & RETURN, BYPASSING EXEC CALL * ASCII EQU * ADB .4 B = EQTX WORD 38 DATA ADB .23 B = EQTX WORD 61 ADDR LDA B,I GET ENVIR IOR H4000 SET BIT 14 FOR ASCII STA B,I & SAVE ENVIR ADB M59 B = EQTX WORD 2 ADDR LDA B,I GET EQTX2 AND M64 MASK OUT PARITY & CHAR SIZE IOR .8 SPEC NO PARITY & 8-BIT BYTE STA B,I LDA EQTXP A = ADDR OF EQTX ADA .61 A = ADDR OF CHAR TRACE LENGTH LDA A,I ADA EFIXL ADA .3 CMA,INA A = EQTX LENGTH - (FIXED LENGTH ADA EQTXP,I + CHAR TRACE +3) SSA EVENT TRACE LENGTH > 2? JMP ASCII-2 NO, ERROR: BYPASS EXEC CALL LDA LU,I GET LOG UNIT # IOR B100 SET FUNCTION CODE =1 (INITLIZE) STA LU LDA EQTXP A =ADDR OF EQTX ADA EFIXL A =ADDR OF TRACE TABLE STA B INB INIT WORD 1 OF 1ST ENTRY STB A,I IN TRACE TABLE ADB M2 B =ADDR OF TRACE TABLE -1 STA B,I INIT OLDEST ENTRY ADDR ADB M1 B =ADDR OF TRACE TABLE -2 STA B,I INIT NEWEST ENTRY ADDR JSB EXEC MAKE CONTROL (INITIALIZE) REQ DEF *+6 DEF .2 SPECIFY WRITE DEF LU CONTROL WORD: FUNCTION & LU DEF EQTXP,I EQT EXTENSION BUFFER DEF .3 DUMMY PARAMETER DEF OP1 CLA SET A =0 TO IND A GOOD REQ JMP SLC,I RETURN * .23 DEC 23 DEC 23, OCT 27 .61 DEC 61 M59 DEC -59 M64 $ DEC -64 OCT 177700, DEC -64 .SLCC DEF SLCC ADDR OF SLC CONTROL ROUTINE .SLCR DEF SLCR READ ROUTINE .SLCW DEF SLCW WRITE ROUTINE OP1 OCT 40103 OPTIONAL PARAMETER .22 DEC 22 SYN SKP * SLC CONTROL ROUTINE FOR LOGICAL DRIVER * SLCC NOP STB PHB SAVE B-REG LDB SLCC GET RETURN ADDRESS JSB SETUP SET UP RETURN ADDR & PTRS LDB PHB GET B-REG FROM PHYSICAL SSB,RSS IS THIS A NEW REQUEST (B NEG)? JMP SLCER NO, ERROR LDB B300 SPECIFY CONTROL: REQ CODE OFFSET JSB TRAIN GET FUNCTION & INIT TRACE ENTRY CPA .1 INITIALIZE? JMP CF01 YES CPA .2 LINE OPEN? JMP CF02 YES CPA .3 LINE CLOSE? JMP CF02 YES ADA M32 SUBTRACT OCT 40 FROM FUNCTION CPA .2 CHANGE ERROR RECOVERY PARAMS? JMP CF42 YES CPA .3 ZERO THE LONG TERM STATISTICS? JMP CF43 YES SSA,RSS FUNCTION BELOW 40? JMP SLCER NO,ERROR CLA YES CLB JMP PRET,I LET PHYSICAL (P+2) LOOK AT FUNCT * CF01 CLA SET STATE = 0 (UNOPENED) STA STATE,I * ------------------------------------------------- * COMPLETE "CONTINUATION" RETURN TO PHYSICAL * SLCPC LDA PRET SPECIFY CONTINUATION CLB & COMP STATUS = 0 = OK JMP SLCXT+2 * ------------------------------------------------- CF02 ADA M2 GET EVENT NO. (0 OR 1) JMP SEA GO TO STATE-EVENT-ACTION CIRCLE CF42 LDA EQT10,I GET SPECIFIED # LDA A,I CMA,INA MAKE NEGATIVE STA NTRY,I AND SAVE LDA EQT11,I GET # OF 3-SEC PERIODS IN LTO CMA,INA MAKE NEG STA NLTO,I & SAVE JMP SLCXT EXIT WITH STATUS =OK CF43 JSB ZSTAT ZERO THE LONG TERM STATISTICS y JMP SLCXT EXIT WITH STATUS =OK * SLCER CLB,INB COMP STATUS =INVALID REQUEST =1 JMP SLCXT+1 * ------------------------------------------------- * COMPLETION RETURN TO PHYSICAL * SLCXT CLB COMPLETION STATUS =OK =0 LDA PRETF SPECIFY COMPLETION STA PRETV & SET UP RETURN LDA MPFLS,I AND M3 CLEAR SEND-CONTINUE FLAG (BIT 1) STA MPFLS,I LDA ET04,I AND HFF00 MASK OUT OLD COMP STATUS IOR B & PUT NEW ONE LDB BLKSP,I PLUS THE BLOCK SPEC BITS BLF (MOVED TO BITS 7-5) RBL,RBL SLB,RSS IS THIS A WRITE REQ? IOR B NO, PUT BLK SPEC INTO STATUS STA ET04,I RIGHT HALF OF EQT 4 * ------------------------------------------------- * ROUTINE TO COMPLETE TRACE TABLE ENTRY * AND B377 ALF,ALF MOVE COMPLETION STATUS TO LEFT LDB TRNEW,I B =ADDR OF CURRENT ENTRY WORD 1 JSB TRINC GET ADDR OF ENTRY WORD 2 IOR B,I MERGE IN REQUEST & FUNCTION CODE STA B,I & STORE BACK IN WORD 2 LDB TRNEW,I LDB B,I B = ADDR OF NEXT WORD TO BE FILLD STB TRTMP SAVE IT (NOW ADDR OF NEXT ENTRY) JSB TRINC GET ADDR OF WORD AFTER NEXT STB A JSB TRACE INIT WORD 1 FOR NEXT ENTRY LDB TRNEW,I B =ADDR OF CURRENT ENTRY WORD 1 LDA TRTMP A =ADDR OF NEXT ENTRY WORD 1 STA B,I RESTORE PTR TO NEXT ENTRY STA TRNEW,I & SET NEXT ENTRY =CURRENT ENTRY CLA CLB JMP PRETV,I RETURN TO PHYSICAL SPC 4 * SLC READ ROUTINE FOR LOGICAL DRIVER * SLCR NOP STB PHB SAVE B-REG LDB SLCR GET RETURN ADDRESS JSB SETUP SET UP RETURN ADDR & PTRS LDB PHB GET B-REG FROM PHYSICAL SSB,RSS IS THIS A NEW REQUEST (B NEG)? JMP LCONT NO, CONTINUE READ/WRITE LDA NTRY,I STA RTCTR,I INIT RETRY CTR ISZ LTCS,I INC TOTAL # OF READ REQUESTS NOP NULL IN CASE OF ROLLOVER LDB B100 SPECIFY READ: REQ CODE OFFSET JSB TRAIN GET FUNCTION & INIT TRACE ENTRY SZA,RSS FUNCTION = 0? JMP SLCER YES,ERROR CPA .7 FUNCTION = 7? JMP SLCER YES, ERROR INA GET EVENT NO. (2 THROUGH 7) STA CURRQ,I SAVE CURRENT READ REQ # JMP SEA GO TO STATE-EVENT-ACTION CIRCLE SPC 4 * SLC WRITE ROUTINE FOR LOGICAL DRIVER * SLCW NOP STB PHB SAVE B-REG LDB SLCW GET RETURN ADDRESS JSB SETUP SET UP RETURN ADDR & PTRS LDB PHB GET B-REG FROM PHYSICAL SSB,RSS IS THIS A NEW REQUEST (B NEG)? JMP LCONT NO, CONTINUE READ/WRITE LDA NTRY,I STA RTCTR,I INIT RETRY CTR LDA LTCS A=ADDR OF WORD 1, LONG-TERM STAT INA ISZ A,I INC TOTAL # OF WRITE REQUESTS NOP NULL IN CASE OF ROLLOVER LDB B200 SPECIFY WRITE: REQ CODE OFFSET JSB TRAIN GET FUNCTION & INIT TRACE ENTRY ADB B2000 SET BIT 10 TO IND WRITE STB BLKSP,I SAVE BLOCK SPEC BITS SLB,RSS TRANSPARENT TEXT TO BE SENT? JMP *+4 NO LDB ENVIR,I SSB LRC SPECIFIED? JMP SLCER YES, ERROR SZA,RSS FUNCTION = 0? JMP SLCER YES,ERROR ADA M7 SSA,RSS FUNCTION > 6? JMP SLCER YES, ERROR ADA .14 GET EVENT NO. (8 THROUGH 13) JMP SEA GO TO STATE-EVENT-ACTION CIRCLE * LCONT LDB KEY,I B = ADDR OF EDITOR ENTRY LDA PHA GET A-REG PASSED BY PHYSICAL JMP B,I * HE000 OCT 160000 OCT 160000 SPC 6 * STATE-EVENT-ACTION CIRCLE -- A STATE-TRANSITION PROCESSOR * * CALLING SEQUENCE: * (A) = EVENT # * (P) = JMP SEA * (A) = MESSAGE PROCESSOR FLAGS * SEA STA EVENT SAVE EVENT # LDA PRVST,I GET PREVIOUS STATES, AND B377 ISOLATE PREV-1, ALF,ALF & MOVE TO LEFT HALF LDB STATE,I GET CURRENT STATE (NOW PREV) IOR B MERGE IN PREV STATE STA PRVST,I ADB STADT ADD STATE TABLE BASE, GET ENTRY STB A INA LDA A,I GET ADDR OF NEXT STATE STA NEXST LDB B,I GET CLUSTER HEADER ADDR PCLUS LDA B,I GET CLUSTER HEADER INB STB CLUST SAVE ADDR OF 1ST CLUSTER WORD CLB RRR 8 A = 1ST EVENT IN CLUSTER BLF,BLF & B = -1 + LENGTH OF CLUSTER CMA,INA ADA EVENT COMPUTE REAL EVENT - 1ST EVENT SSA RESULTS NEG (EVENT BELOW CLUST)? JMP SEAER YES, ERROR STA EVOFF SAVE EVENT OFFSET CMA,INA ADA B COMPUTE CLUSTER LENGTH - OFFSET SSA RESULTS NEG (EVENT ABOVE CLUST)? JMP EVOUT YES LDB CLUST ADB EVOFF B = ADDR OF ACTION/NEXT STATE PR LDA B,I SEAF CLB RRR 8 A = ACTION INDEX BLF,BLF & B = NEXT STATE STB STATE,I STA CURAC SAVE ACTION LDA EVENT ALF,ALF GET WORD READY FOR TRACE TABLE: IOR B EVENT & RESULTANT STATE JSB TRACE LDA PRVAC,I AND B377 ISOLATE PREVIOUS ACTION ALF,ALF IOR CURAC MERGE IN CURRENT ACTION STA PRVAC,I & SAVE LDA CURAC ADA ACTAD A = ADDR OF APPROPRIATE ACTION: LDB A,I LDA MPFLS,I JMP B,I GO TO ACTION EVOUT ADB CLUST INB B = ADDR OF NEXT CLUSTER HEADER CPB NEXST ARE WE THROUGH WITH THIS STATE? JMP SEAER YES, ERROR SINCE EVENT NOT FOUND JMP PCLUS NO, PROCESS NEXT CLUSTER SEAER LDA BLOUT SET ACTION/NEXT STATE TO HANDLE JMP SEAF2 IMPROBABLE SITUATION * CLUST OCT 0 ADDR OF 1ST CLUSTER ENTRY CURAC OCT 0 CURRENT ACTION EVENT OCT 0 CURRENT EVENT # EVOFF OCT 0 OFFSET OF EVENT FROM CLUSTER NEXST OCT 0 ADDR OF ENTRY FOR NEXT STATE SKP * SUBROUTINE SCM: SEND CONTROL MESSAGE (ID, IF ANY, HAS * BEEN SENT ALREADY) * (A) = INDEX OF MESSAGE TO BE SENT: * 0 = ENQ 5 = WACK * 1 = NAK 6 = RVI * 2 = EOT 7 = DLE EOT * 3 = ACK0 8 = TTD (STX ENQ) * 4 = ACK1 9 = SOH ENQ * SCM NOP STA SCMTP LDB SCM STB CMRET,I SAVE SCM RETURN ADA ASCMA LDA A,I A = ADDR OF MESSAGE JSB HCONT NOP SZA SEND OK? JMP LOW NO, SET EVENT =LINE ERROR (LOW) LDA CMRET,I GET RETURN FROM SCM JMP STXT4 INC # OF MESSAGES SENT SCMTP OCT 0 TEMP FOR SCM SKP * SUBROUTINE SETUP: SET UP RETURN ADDRESSES TO PHYSICAL * DRIVER & EQTX POINTERS * (A) = A-REG PASSED BY PHYSICAL * (B) = P+1 RETURN OF CURRENT SLC ROUTINE * (P) = JSB SETUP * SETUP NOP STA PHA SAVE A-REG PADDED BY PHYSICAL STB PRETF SAVE P+1 (COMPLETION) ADDR INB STB PRET SAVE P+2 (CONTINUATION) ADDR LDB EQTAD B = EQT 1 ADDR ADB .3 B = EQT 4 ADDR CPB ET04 ALREADY CONFIGURED FOR THIS EQT? JMP SETUP,I YES STB ET04 ADB .6 B = EQT 10 ADDR STB ET10 INB B = EQT 11 ADDR STB ET11 ADB .3 B = EQT 14 ADDR STB ET14 ADB .3 B = EQT 17 ADDR LDB B,I B = EQTX 1 ADDR LDA B,I COMPUTE TOTAL EQTX LENGTH ADA EFIXC -(1 + FIXED LENGTH) ADB .22 EQTX 23 STB BLKSP BLOCK SPEC BITS INB Й EQTX 24 STB EBUFA EDITOR BUFFER ADDR INB EQTX 25 STB EBUFL EDITOR BUFFER LENGTH ADB .2 EQTX 27 STB ERET EDITOR RETURN ADDR ADB .6 EQTX 33 STB KEY ENTRY AFTER PHYS RECALL ADB .2 EQTX 35 STB MPFLS MESSAGE PROCESSOR FLAGS INB EQTX 36 STB NTRY NUMBER OF RETRIES INB EQTX 37 STB RTCTR RETRY CTR ADB .2 EQTX 39 STB CONVL CONVERSTNL BUFFER LENGTH INB EQTX 40 STB CURRQ CURRENT READ REQ # ADB .2 EQTX 42 STB NLTO # OF 3-SECS IN LONG T/O INB EQTX 43 STB PRVAC PREV & CURRENT ACTIONS INB EQTX 44 STB PRVST PREV-1 & PREV STATES INB EQTX 45 STB PVACK CODE FOR PREV ACK ADB .3 EQTX 48 STB STATE MAIN SLC STATE NUMBER INB EQTX 49 STB TOCTR LONG-TIMEOUT CTR INB EQTX 50 STB CMBUF CONTROL MESSAGE BUFFER ADB .8 EQTX 58 STB CMRET SCM RETURN ADDR INB EQTX 59 STB TXRET STXT RETURN ADDR INB EQTX 60 STB TLOG TRANSMISSION LOG (POSTV) INB EQTX 61 STB ENVIR SPECIFIED ENVIRONMENT INB EQTX 62 STB CTLEN CHAR TRACE LENGTH INB EQTX 63 STB LTCS LONG-TERM COMM STATISTCS ADB .12 EQTX 75 STB TRNEW ADDR OF NEWST TRACE NTRY INB EQTX 76 STB TROLD ADDR OF OLDST TRACE NTRY INB EQTX 77 STB TRFWA TRACE TABLE 1ST WORD ADB A EQTX LWA STB CTLWA 5_ CHAR TRACE LAST WORD LDA CTLEN,I CMA,INA ADB A STB TRLWA EVENT TRACE LAST WORD JMP SETUP,I * EFLEN EQU 76 LENGTH OF EQTX - TRACE TABLE EFIXC ABS -1-EFLEN -1( + FIXED-LENGTH PART OF EQTX) EFIXL DEF EFLEN FIXED LENGTH OF EQT EXTENSION SPC 4 * SUBROUTINE STXT: SEND TEXT * STXT NOP LDA MPFLS,I AND HFFBF CLEAR MP TIMEOUT FLAG (BIT 6) STA MPFLS,I LDA STXT STA TXRET,I SAVE STXT RETURN CLA STA TLOG,I ZERO TRANSMISSION LOG LDA ET10,I A = BUFFER ADDR LDB ET11,I JSB HSND NOP NOP SZA SEND OK? JMP LOW NO, SET EVENT =LINE ERROR(LOW) LDA NLTO,I STA TOCTR,I RESET LONG-TIME-OUT CTR LDA MPFLS,I AND M3 CLEAR SEND-CONTINUE FLAG STA MPFLS,I LDA TXRET,I GET RETURN FROM STXT STXT4 LDB .2 INC # OF MESSAGES SENT; ADB LTCS WORD 3 OF LONG-TERM STAT ISZ B,I NOP NULL IN CASE OF ROLLOVER JMP A,I RETURN HFFBF OCT 177677 REVERSE MASK BIT 6 SPC 2 * SUBROUTINE STXCH: SEND TEXT CHARACTERS * (A) = INDEX OF MESSAGE TO BE SENT * 10 = SOH 11 = STX ) ONE CHAR * 12 = ETX 13 = ETB ) * 14 = DLE STX 15 = DLE ETX ) TWO CHAR * 16 = DLE ETB ) STXCH NOP STA SCMTP ADA ASCMA LDA A,I A = ADDR OF CHARS LDB SCMTP ADB M14 COMPUTE INDEX - 14 SSB INDEX 14 OR MORE? JMP *+3 NO LDB M3 YES: IN EITHER CASE, RSS LDB M2 B = - (1 + # OF CHARS) JMP STXCH,I RETURN SKP * SUBROUTINE TRACE: PUT WORD INTO TRACE TABLE * (A) = WORD TO BE STORED * TRACE NOP LDB TRNEW,I A =ADDR OF CURRENT ENTRY, WORD 1 LDB B,I B =A0DDR OF NEXT WORD TO BE FILLD CPB TROLD,I MATCH ADDR OF OLDEST ENTRY? RSS YES JMP *+5 NO LDB B,I B =ADDR OF NEXT-TO-OLDEST ENTRY STB TROLD,I UPDATE PTR TO OLDEST ENTRY LDB TRNEW,I LDB B,I B=ADDR OF NEXT WORD TO BE FILLED STA B,I STORE WORD IN TRACE TABLE JSB TRINC GET ADDR OF NEXT WORD TO FILL LDA TRNEW,I CPB A IS NEXT WORD = CURRENT ENTRY? RSS YES, SET NEXT WORD = ENTRY START JMP *+3 JSB TRINC ADVANCE TO 2ND WORD OF ENTRY JSB TRINC ADVANCE TO 3RD WORD OF ENTRY STB A,I UPDATE WORD 1 OF CURRENT ENTRY JMP TRACE,I SPC 2 * SUBROUTINE TRAIN: GET FUNCTION & INITIALIZE TRACE ENTRY * (B) = REQUEST CODE (OFFSET 6 BITS TO LEFT) * (P) = JSB TRAIN * (A) = FUNCTION CODE * (B) = BLOCK SPEC BITS * TRAIN NOP LDA EQT09,I GET CONTROL WORD ALF,ALF & POSITION FUNCTION RAL,RAL CPB B300 IS THIS A CONTROL REQUEST? RSS YES AND .7 ISOLATE READ/WRITE FUNCTION AND B77 ISOLATE CONTROL FUNCTION STA TRTMP & SAVE IT IOR B MERGE IN REQUEST CODE (OFFSET) JSB TRACE STORE REQ & FUNCT IN TRACE TABLE CLA STA TLOG,I STA BLKSP,I LDA EQT09,I GET CONTROL WORD ALF POSITION BLOCK SPEC BITS AND HE000 & ISOLATE THEM RAL,RAL NOW IN BITS 1,0, & 15 STA B LDA TRTMP GET FUNCTION JMP TRAIN,I TRTMP OCT 0 TRACE TABLE TEMPORARY SKP * SUBROUTINE TRINC: INCREMENTS ADDRESS IN EVENT TRACE, * CHECKING FOR WRAPAROUND * (B) = ADDR TO BE INC * TRINC NOP CPB TRLWA IS IT LAST WORD OF TABLE? JMP *+3 YES INB JMP TRINC,I LDB TRFWA WRAPAROUND TO 1ST OF TABLE JMP TRINC,I SPC 3 W * SUBROUTINE ZSTAT: ZERO LONG TERM COMM. STATISTICS * ZSTAT NOP LDA M11 STA MPCTR SET COUNTER = 11 LDA LTCS A=ADDR OF WORD 1, LONG-TERM STAT CLB ZLOOP STB A,I ZERO TABLE ENTRY INA ISZ MPCTR JMP ZLOOP JMP ZSTAT,I * MPCTR OCT 0 COUNTER SKP * CONSTANTS & STORAGE FOR MESSAGE PROCESSOR ONLY * .16 DEC 16 DEC 16, OCT 20 .20 DEC 20 DEC 20, OCT 24 .27 DEC 27 DEC 27, OCT 33 .29 DEC 29 DEC 29, OCT 35 .30 DEC 30 DEC 30, OCT 34 .31 DEC 31 DEC 31, OCT 37 .32 DEC 32 DEC 32, OCT 40, BIT 5 B200 OCT 200 OCT 200, DEC 128 B300 OCT 300 OCT 300, DEC 192 B2000 OCT 002000 OCT 2000, BIT 10, LEFT 4 H1400 OCT 012000 LEFT HALF = DEC 20 HBFFF OCT 137777 OCT 137777, REVERSE BIT 14 HEFFF OCT 167777 OCT 167777, REVERSE BIT 12 HFF00 OCT 177400 M11 DEC -11 DEC -11, OCT 177765 M14 DEC -14 DEC -14, OCT 177762 M17 DEC -17 DEC -17, OCT 177757, REV BIT 4 M20 DEC -20 DEC -20, OCT 177754, OCT -24 M32 DEC -32 DEC -32, OCT 177740, OCT -40 * PHA OCT 0 A-REG ON ENTRY FROM PHYSICAL PHB OCT 0 B-REG ON ENTRY FROM PHYSICAL PRETV OCT 0 VARIABLE RETURN TO PHYSICAL * * EQT POINTERS ET04 OCT 0 PTR TO COMPLETION STATUS IN EQT ET11 OCT 0 PTR TO EQT 11: REQ BUFFER LENGTH ET14 OCT 0 PTR TO TRANS LOG IN EQT 14 * * EQT EXTENSION POINTERS * CMRET OCT 0 PTR TO SCM RETURN CONVL OCT 0 PTR TO WRITE-CONV BUFFER LENGTH CURRQ OCT 0 PTR TO CURRENT READ REQ # NLTO OCT 0 PTR TO # OF 3-SECS IN LONG TMOUT PRVAC OCT 0 PTR TO PREV ACTION: PREV,CURRENT PRVST OCT 0 PTR TO PREV STATES: PREV-1,PREV PVACK OCT 0 PTR TO CODE FOR PREV ACK STATE OCT 0 PTR TO MAIN SLC STATE NUMBER TOCTR OCT 0 oHFB PTR TO LONG-TIMEOUT CTR CMBUF OCT 0 ADDR OF CONTROL MESSAGE RECV BUF LTCS OCT 0 ADDR OF LONG-TERM COMM STATISTCS TRNEW OCT 0 ADDR OF NEWEST TRACE TABLE ENTRY TROLD OCT 0 ADDR OF OLDEST TRACE TABLE ENTRY TRFWA OCT 0 FIRST WORD ADDR OF TRACE TABLE TRLWA OCT 0 LAST WORD ADDR OF TRACE TABLE TXRET OCT 0 PTR TO STXT RETURN SKP * ASCII CONTROL MESSAGES -- WITH ODD PARITY * ASCM OCT 77776 ENQ 0 OCT 000576 NAK 1 OCT 001176 EOT 2 OCT 002176 ACK0 3 OCT 77577 PAD PAD OCT 004176 ACK1 4 OCT 77577 PAD PAD OCT 003576 WACK 5 OCT 77577 PAD PAD OCT 000376 RVI 6 OCT 77577 PAD PAD OCT 016177 EOT 7 OCT 77577 PAD PAD OCT 007176 TTD 8 OCT 00605 SOH ENQ 9 OCT 00400 SOH 10 OCT 01000 STX 11 OCT 101400 ETX 12 OCT 113400 ETB 13 OCT 10002 DLE STX 14 OCT 010203 DLE ETX 15 OCT 010227 DLE ETB 16 * ASCMA DEF *+1 ASCII CONTROL MESSAGE ADDR PTR DEF ASCM ENQ 0 DEF ASCM+1 NAK DEF ASCM+2 EOT DEF ASCM+3 ACK0 DEF ASCM+5 ACK1 DEF ASCM+7 WACK DEF ASCM+9 RVI DEF ASCM+11 DLE EOT DEF ASCM+13 TTD DEF ASCM+14 SOH ENQ DEF ASCM+15 SOH 10 TEXT DEF ASCM+16 STX 11 DEF ASCM+17 ETX 12 DEF ASCM+18 ETB 13 DEF ASCM+19 DLE STX 14 DEF ASCM+20 DLE ETX 15 DEF ASCM+21 DLE ETB 16 SPC 2 H SKP * ACTION DEFINITIONS * AC01 EQU 400B OPEN LINE AC02 EQU 1000B CLOSE LINE AC03 EQU 1400B SEND EOT AC04 EQU 2000B SEND EOT, RECV RESPONSE AC05 EQU 2400B SEND ENQ, RECV RESPONSE AC06 EQU 3000B SEND ENQ, RECV CONVERSATNAL TEXT AC07 EQU 3400B INC RETRY CTR & RESPONSE ERRORS AC08 EQU 4000B SEE IF PRIMARY OR SECONDARY AC09 EQU 4400B SET CONTACT FLG & POST NORM COMP AC10 EQU 5000B POST 0, NORMAL COMPLETION AC11 EQU 5400B POST 1, INVALID REQUEST AC12 EQU 6000B POST 2, REQ INCOMPATIBLE W STATE AC13 EQU 6400B POST 3, BAD ID SEQUENCE AC14 EQU 7000B POST 4, LINE ERROR AC15 EQU 7400B POST 5, EOT RECVD AC16 EQU 10000B POST 6, DLE EOT RECVD AC17 EQU 10400B POST 7, LONG TIMEOUT OCCURRED AC18 EQU 11000B POST 8, ENQ RECVD AFTER EOT SENT AC19 EQU 11400B POST 9, TEXT OVERRUN AC20 EQU 12000B POST 10, MAX # OF NAKS RECVD AC21 EQU 12400B POST 11, MAX # OF ENQS SENT AC22 EQU 13000B POST 12, RVI RECVD AC23 EQU 13400B POST 13, ENQ RECVD AFTER ENQ SENT AC24 EQU 14000B POST 14, NAK RECVD AFTER ENQ SENT AC25 EQU 14400B POST 15, MAX ENQS RECVD FRM CONV AC26 EQU 15000B POST 16, BAD RESPONSE TO TTD AC27 EQU 15400B SEND TTD, RECV RESPONSE AC28 EQU 16000B SEND TEXT, RECV RESPONSE AC29 EQU 16400B SEND TEXT, TEXT AC30 EQU 17000B CHECK RVI AC31 EQU 17400B PROCESS POSITIVE ACK AC32 EQU 20000B PROCESS SHORT TIMEOUT DURNG SEND AC33 EQU 20400B INC RETRY CTR AC34 EQU 21000B CHECK TIMEOUT & BAD RESPSE FLAGS AC35 EQU 21400B PROCESS ENQ RECVDIN WRITE STATE AC36 EQU 22000B PROCESS SHORT TIMEOUT DURNG RECV AC37 EQU 22400B CHECK READ REQUEST TYPE AC38 EQU 23000B SEND ACK, RECV TEXT AC39 EQU 23400B SEND PREV ACK, RECV TEXT AC40 EQU 24000B SEND NAK, REVV TEXT AC41 EQU 24400B RECV RESPONSE AC42 EQU 25000B RECV TEXT AC43 EQU 25400B SEND WACK, RECV RESPONSE AC44 EQU 26000B SENDT RVI, RECV TEXT AC45 EQU 26400B POST 17, IMPOSSIBLE SITUATION AC46 EQU 27000B SEND DLE-EOT AC47 EQU 27400B INC MESSAGE ERRORS,RECV RESPONSE AC48 EQU 30000B TOGGLE RECV ACK FLAG AC49 EQU 30400B BCC ERROR: SEND NAK, RECV TEXT AC50 EQU 31000B SET RECV ACK, CLEAR SEND ACK FLG AC51 EQU 31400B TOGGLE SEND ACK FLAG AC52 EQU 32000B TOGGLE SEND ACK & RECV ACK FLAGS * * EVENT DEFINITIONS * EV00 EQU 0 EVENT 0: LINE OPEN REQUEST EV14 EQU AC14 EVENT 14: ACK0 RECVD EV18 EQU AC18 EVENT 18: ENQ RECEIVED EV29 EQU AC29 EVENT 29: LONG TIMEOUT EV30 EQU AC30 EVENT 30: LOW EV31 EQU AC31 EVENT 31: HIGH SPC 4 * LINE OPEN ACT1 JSB ZSTAT ZERO THE LONG TERM STATISTICS LDA M7 STA NTRY,I INIT # OF RETRIES = 7 LDA M20 STA NLTO,I INIT LONG TIMEOUT = 60 SEC CLA STA MPFLS,I INIT MESS PROC FLAGS JMP SLCPC CONT.RETURN TO PHYS, STATUS = OK SPC 2 * LINE CLOSE ACT2 JMP SLCPC CONT.RETURN TO PHYS, STATUS = OK SPC 2 * SEND EOT ACT3 LDA .2 JSB SCM SEND EOT CONTROL MESSAGE LDA MPFLS,I AND .1 EXCEPT FOR CONTACT-MADE FLAG, STA MPFLS,I INIT MESS PROC FLAGS JMP HIGH SET EVENT = HIGH (NORMAL COMPL) SPC 2 * SEND EOT, RECV RESPONSE ACT4 LDA .2 JSB SCM SEND EOT CONTROL MESSAGE LDA MPFLS,I AND .1 EXCEPT FOR CONTACT-MADE FLAG, STA MPFLS,I INIT MESS PROC FLAGS ACT4A LDA NLTO,I STA TOCTR,I RESET LONG-TIMEOUT CTR JMP ACT5B RECV RESPONSE (NO ID) SPC 2 * SEND ENQ, RECV RESPONSE ACT5 EQU * LDB ENVIR,I GET SPECIFIED ENVIRONMENT CLA SPECIFY ENQ MESSAGE BLF,SLB HASP WORKSTATION (BIT 12 =1)? LDA .9 YES, SPECIFY SOH ENQ MESSAGE JSB SCM SEND CONTR| OL MESSAGE LDA PRVAC,I AND HFF00 ISOLATE PREV ACTION CPA H2000 PREV ACTION = 32? JMP *+3 YES, BYPASS RESET LDA NLTO,I STA TOCTR,I RESET LONG-TIME-OUT CTR LDA ENVIR,I SLA,RSS IS STATION PRIMARY? JMP ACT5C NO LDA M270 STA NOM3 SET NOM 3-SEC TIMEOUT TO 2.7 SEC ACT5C LDA MPFLS,I AND M3 CLEAR SEND-CONTINUE FLAG (BIT 1) STA MPFLS,I ACT5A EQU * JMP ACT5B NO * M270 DEC -270 * ACT5B CLE SET E = 0: DISCARD ID LDA CMBUF A = ADDR OF CONTRL MESS RECV BUF LDB M17 B = -(1 + BUF LENGTH) JSB BSCR RECEIVE CONTROL MESSAGE * ------------------------------------------------- STEM ADA .13 SET UP MOST EVENT NUMBERS CPA .27 LINE ERROR? ADA .3 YES, CHANGE EVENT TO "LOW" JMP SEA GO TO STATE-EVENT-ACTION CIRCLE SPC 2 * SEND ENQ, RECEIVE CONVERSATIONAL TEXT ACT6 CLA CODE = 0 JSB SCM SEND CONTROL MESSAGE: ENQ LDA PRVAC,I AND HFF00 ISOLATE PREV ACTION CPA H2000 PREV ACTION = 32? JMP *+3 YES, BYPASS RESET OF LTO CTR LDA NLTO,I STA TOCTR,I RESET LONG-TIMEOUT CTR CLA STA TLOG,I ZERO TRANS LOG LDA ET10,I GET REQ BUFFER ADDR LDA A,I GET LENGTH OF WRITE BUFFER ISZ ET10,I GET CORRECT POINTER LDB ET11,I GET READ BUFFER LENGTH JMP AC29A RECV CONV TEXT SPC 2 * INCREMENT RETRY CTR & NO. OF RESPONSE ERRORS ACT7 LDB LTCS B = ADDR OF 1ST LONG-TERM STAT ADB .8 B = ADDR OF 9TH LONG-TERM STAT ISZ B,I INCREMENT NO. OF RESPONSE ERRORS NOP NULL IN CASE OF ROLLOVER IOR .32 SET BAD-RESPONSE FLAG (BIT 5) STA MPFLS,I JMP INTRY INC RETRY CTR & GET EVENT SPC 2 * SEE IF Px~RIMARY OR SECONDARY ACT8 LDA ENVIR,I GET SPECIFIED ENVIRONMENT SLA,RSS IS STATION PRIMARY? JMP LOW NO, SECONDARY: SET EVENT = LOW LDA RTCTR,I SZA,RSS CTR =0? JMP LOW YES ISZ RTCTR,I YES; RETRY CTR OVERFLOW? JMP HIGH NO, SET EVENT =HIGH JMP LOW YES, REPORT ENQ-ENQ CONTENTION SPC 2 * SET CONTACT-MADE FLAG & POST NORMAL COMP ACT9 IOR .1 SET CONTACT-MADE FLAG STA MPFLS,I SPC 2 * POST NORMAL COMPLETION ACT10 JMP SLCXT EXIT WITH COMP STATUS = 0 = OK SPC 2 * REPORT: ACT11 CLB,INB COMP STATUS = 1 =INVALID REQ JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT12 LDB .2 STATUS =2 =REQ INCOMPATL W STATE JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT13 LDB .3 STATUS =3 =BAD ID JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT14 LDB .4 STATUS =4 =LINE ERROR LDA .4 INC TOTAL # OF LINE ERRORS ACXIT ADA LTCS A=ADDR OF WORD 1, LONG-TERM STAT ISZ A,I UPDATE LONG-TERM STAT TABLE NOP NULL IN CASE OF ROLLOVER JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT15 LDB .5 STATUS =5 =EOT RECVD AND .1 EXCEPT FOR CONTACT-MADE FLAG, A15ST STA MPFLS,I INIT MESS-PROC FLAGS JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT16 LDB .6 STATUS =6 =DLE EOT RECVD JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT17 LDB .7 STATUS =7 =LONG TIMEOUT LDA .7 INC TOTAL # OF LONG TIMEOUTS JMP ACoXIT P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT18 LDB .8 STATUS =8 =ENQ RECVD TO EOT SENT AND HBFFF CLEAR BIT 14 (SEND ACK FLAG) IOR H8000 SET BIT 15 (RECV ACK FLAG) JMP A15ST STORE FLAGS & RETURN SPC 2 * REPORT: ACT19 LDB .9 STATUS = 9 =DATA OVERRUN JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT20 LDB .10 STATUS =10 =MAX # NAKS RECVD JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT21 LDB .11 STATUS =11 =MAX # ENQS SENT AND HFFDF CLEAR BAD-RESPONSE FLAG JMP A15ST STORE FLAGS & RETURN HFFDF OCT 177737 REVERSE MASK BIT 5 SPC 2 * REPORT: ACT22 LDB .12 STATUS =12 =RVI RECBD ADA H8000 TOGGLE RECV ACK FLAG (BIT 15) JMP A15ST STORE FLAGS & RETURN SPC 2 * REPORT: ACT23 LDB .13 STATUS =13 =ENQ RECV TO ENQ SENT JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT24 LDB .14 STATUS =14 =NAK RECV TO ENQ SENT JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT25 LDB .15 STATUS =15 =MAX ENQS FROM CONVER JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT26 LDB .16 STATUS =16 =BAD RESPONSE TO TTD JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * SEND TTD, RECEIVE RESPONSE ACT27 LDA .8 JSB SCM SEND CONTROL MESSAGE: TTD JMP ACT4A RESET LTO CTR & RECV RESPONSE SPC 2 * SEND TEXT, READ RESPONSE ACT28 JSB STXT SEND TEXT JMP ACT4A RESET LTO CTR & RECV RESPONSE N SPC 2 * SEND TEXT, RECEIVE TEXT ACT29 LDA ET10,I GET REQUEST BUFFER ADDR LDB ET11,I GET & STB CONVL,I SAVE REQUEST BUFFER LENGTH LDA A,I GET LENGTH OF WRITE BUFFER STA ET11,I & PUT INTO EQT 11 ISZ ET10,I ADVANCE TO WRITE BUFFER ADDR JSB STXT SEND TEXT IN THE WRITE BUFFER LDA NLTO,I STA TOCTR,I RESET LONG-TIMEOUT CTR CLA STA TLOG,I ZERO TRANSMISSION LOG LDA ET11,I GET WRITE BUFFER LENGTH IN BYTES LDB CONVL,I STB ET11,I PUT BACK ORIG :READ BUFFR LENGTH AC29A CMA,INA CLE,ERA CHANGE TO POSITIVE WORD COUNT SEZ BYTE LENGTH ODD? INA YES, ADD ONE TO WORD LENGTH ADA ET10,I A = RECV BUFFER ADDR STA SAVA SAVE FOR WC NAK 10/16 ADB M1 B= -(1+RECV BUFFER LENGTH) STB SAVB SAVE FOR WC NAK 10/16 CLE E = 0: DISCARD ID OR LG JSB BSCR RECEIVE TEXT LDB ET10,I RETURN POINTER ADB M1 STB ET10,I JMP STEM GET EVENT FROM COMPLETION CODE SPC 2 * SET RVI FLAG ACT30 STA B BLF,SLB RVI FLAG (BIT 12) SET? JMP LOW YES, SET EVENT =LOW(BAD RVI) IOR H1000 NO, THEN SET RVI FLAG STA MPFLS,I JMP HIGH SET EVENT =HIGH (GOOD RVI) SPC 2 * PROCESS RECVD POSITIVE ACKNOWLEDGEMENT ACT31 AND HEFFF CLEAR RVI FLAG STA MPFLS,I CLE,ELA PUT ACK0/1 FLAG (BIT 15) INTO E LDA .14 START WITH ACK0 IND LDB ENVIR,I BLF,SLB HASP WORKSTATION? JMP *+3 YES, ONLY ACK0 VALID SEZ CURRENT FLAG = ACK1? INA YES, CHANGE TO ACK1 IND CPA EVENT CURRENT EVENT = CORRECT ACK? JMP MID YES, SET EVENT = MID JMP LOW NO, SET EVENT = LOW SPC 2 * PROCESS SHORT TIMEOUT (SENDINGc) ACT32 IOR B100 & SET MP TIMEOUT FLAG (BIT 6) STA MPFLS,I LDA TOCTR,I SZA,RSS LTO CTR =0? JMP *+3 YES ISZ TOCTR,I LONG TIMEOUT CTR OVERFLOW? JMP INTRY NO LDA .29 SET EVENT =29 =LONG TIMEOUT JMP SEA GO TO STATE-EVENT-ACTION CIRCLE * ------------------------------------------------- * ROUTINE TO INCREMENT RETRY COUNTER * INTRY LDA RTCTR,I SZA,RSS RETRY CTR =0? JMP *+3 YES ISZ RTCTR,I RETRY CTR OVERFLOW? JMP MID+2 NO LDB EVENT LDA .30 START WITH NEXT EVENT = LOW CPB .27 CURRENT EVENT = BAD ID? MID LDA .32 YES, SET EVENT = MID JMP SEA GO TO STATE-EVENT-ACTION CIRCLE LDB PRVST,I GET PREV STATES CLA RRR 8 B = PREV -1, A = PREV (OFFSET) CPA H1400 PREV STATE = WRITE CONV (20)? JMP MID YES, SET EVENT = MID LDA .31 NO, START WITH EVENT = HIGH CPB .20 PREV -1 STATE = WRITE CONV? JMP MID YES, SET EVENT = MID JMP SEA GO TO STATE-EVENT-ACTION CIRCLE SPC 2 * INCREMENT RETRY COUNTER ACT33 JMP INTRY INCREMENT RETRY COUNTER SPC 2 * CHECK TIMEOUT & BAD RESPONSE FLAGS ACT34 ALF,ALF RAL,RAL SLA,RSS MP TIMEOUT FLAG SET (BIT 6 =1)? JMP LOW NO, SET EVENT =LOW SSA BAD RESPONSE FLAG SET (BIT 5 =1)? JMP LOW YES, SET EVENT =LOW LDA PRVST,I AND HFF00 ISOLATE PREV-1 STATE CPA H1400 PREV-1 STATE =WRITE CONV (20)? JMP MID YES, SET EVENT =MID JMP HIGH NO, SET EVENT =HIGH SPC 2 * PROCESS ENQ RECVD IN WRITE ACT35 LDB .9 INC # OF PREV-RESP ENQS RECVD, ADB LTCS WORD 10 OF LONG-TERM STAT ISZ B,I NOP NULL IN CASE OF RODLLOVER ALF,ALF SLA ENQ JUST SENT (BIT 8 =1)?? JMP MID YES, SET EVENT = MID SSA TEXT JUST RECVD (BIT 7 =1)? JMP HIGH YES, SET EVENT = HIGH JMP LOW NO, SET EVENT = LOW SPC 2 * PROCESS SHORT TIMEOUT, RECEIVING ACT36 LDA .29 START WITH EVENT = LONG TIMEOUT LDB TOCTR,I SZB,RSS LTO CTR =0? JMP SEA YES ISZ TOCTR,I INCREMENT TIMEOUT CTR RSS NO OVFLO JMP SEA OVFLO: STATE-EVENT-ACTION CIRCLE LDA STATE,I CPA .2 CURRENT STATE = READ ENQ? JMP ACT5A YES, RECV RESPONSE & ID, IF ANY JMP AC38C NO, RECEIVE TEXT SPC 2 * CHECK READ REQUEST TYPE ACT37 AND HBFFF CLEAR BIT 14 (SEND ACK FLAG) IOR H8000 SET BIT 15 (RECV ACK FLAG) STA MPFLS,I LDA CURRQ,I GET CURRENT READ REQUEST # CPA .3 CURRENT REQ = 3 (READ INITIAL)? JMP HIGH YES, SET EVENT = HIGH LDA PRVST,I AND HFF00 ISOLATE PREV-1 STATE CPA B4000 PREV-1 STATE =8 (RESTRCTED READ)? JMP MID YES, SET EVENT = MID LOW LDA .30 SET EVENT = LOW JMP SEA GO TO STATE-EVENT-ACTION CIRCLE HIGH LDA .31 SET EVENT = HIGH JMP SEA GO TO STATE-EVENT-ACTION CIRCLE SPC 2 * SEND ACK, RECV TEXT ACT38 EQU * LDA .3 START WITH MESSAGE CODE FOR ACK0 LDB ENVIR,I GET SPECIFIED ENVIRONMENT BLF,SLB HASP WORKSTATION? JMP AC38A YES, SEND ONLY ACK0 LDB MPFLS,I GET SEND ACK FLAG (BIT 14) RBL SSB ACK0 TO BE SENT (BIT 14 =0)? INA NO AC38A STA PVACK,I SET UP PREV ACK AC38D JSB SCM SEND ACK LDA MPFLS,I AND M3 CLEAR SEND-CONTINUE FLAG (BIT 1) STA MPFLS,I LDA NLTO,I STA TOCTR,I RESET LONG-TIMEOUT CTR AC38C CLA U STA TLOG,I ZERO TRANSMISSION LOG LDA EQT09,I GET CONTROL WORD 10/16 AND M64 MASK OUT FUNCTION 10/16 CPA WCWRD WRITE CONVERSATIONAL 10/16 JMP WCNAK YES/GET ORIGINAL POINTERS 10/16 LDA ET10,I A = RECV BUFFER ADDR LDB ET11,I ADB M1 B = - (1 + RECV BUFFER LENGTH) CLRE CLE SET E =0: DISCARD ID OR LG JSB BSCR RECEIVE TEXT JMP STEM GET EVENT FROM COMPLETION CODE * WCNAK LDA SAVA GET RECEIVE 10/16 LDB SAVB POINTERS 10/16 JMP CLRE RETURN * SAVA NOP SAVB NOP WCWRD OCT 22300 SPC 2 * SEND PREV ACK, RECEIVE TEXT ACT39 EQU * LDB .9 INC # OF PREV-RESP ENQS RECVD, ADB LTCS WORD 10 OF LONG-TERM STAT ISZ B,I NOP NULL IN CASE OF ROLLOVER LDA PVACK,I GET MESSAGE CODE FOR PREV ACK JMP AC38D SEND CONTROL MESSAGE: PREV ACK SPC 2 * SEND NAK, RECEIVE TEXT ACT40 EQU * AC40A CLA,INA AC40B STA PVACK,I SET UP PREV ACK JMP AC38D SEND CONTROL MESSAGE: NAK SPC 2 * RECEIVE RESPONSE ACT41 LDA NLTO,I STA TOCTR,I RESET LONG-TIMEOUT CTR JMP ACT5A RECV RESPONSE, CHECK ID, IF ANY SPC 2 * INC MESSAGE ERRORS, RECV TEXT ACT42 LDA .6 ADA LTCS A =ADDR OF WORD 7,LONG-TERM STAT ISZ A,I UPDATE MESSAGE ERROR STAT NOP NULL IN CASE OF ROLLOVER JMP AC38C RECV TEXT BUT DONT RESET TIMER SPC 2 * SEND WACK, RECV RESPONSE ACT43 LDA .5 JMP ACT27+1 SEND WACK, RESET LTO, RECV RESP SPC 2 * SEND RVI, RECV TEXT ACT44 LDA .6 SET UP PREV ACK, SEND RVI, JMP AC40B SPC 2 * REPORT IMPOSSIBLE SITUATION ACT45 LDB .17 STATUS =17 =IMPOSSIBLE SITUATION JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPYC 2 * SEND DLE-EOT (DISCONNECT) ACT46 LDA .7 JMP ACT3+1 SEND DLE-EOT CONTROL MESSAGE SPC 2 * INC. MESSAGE ERRORS, READ RESPONSE ACT47 LDA .6 ADA LTCS A =ADDR OF WORD 7,LONG-TERM STAT ISZ A,I UPDATE MESSAGE ERROR STAT NOP NULL IN CASE OF ROLLOVER CLA SINCE READ ERROR, ALLOW TIMEOUT: STA NOM3 DONT RESTART 3-SEC TIMEOUT JMP ACT5A RECV RESPONSE SPC 2 * TOGGLE RECV ACK FLAG ACT48 ADA H8000 TOGGLE RECV ACK FLAG (BIT 15) JMP ACT9 SET CNTACT-MADE FLG,STORE,& RETN SPC 2 * SEND NAK BECAUSE OF ERROR, RECEIVE TEXT ACT49 LDB .6 ADB LTCS B =ADDR OF WORD M, LONG-TERM ST ISZ B,I UPDATE MESSAGE-ERROR STAT NOP NULL IN CASE OF ROLLOVER RAR,RAR SLA,RSS NAK SENDING DISABLED (BIT 2 =1)? JMP AC40A NO SEND NAK, RECV TEXT LDB .18 YES; STATUS =18 =BAD BCC ETC. JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL .18 DEC 18 * * SET RECV ACK, CLEAR SEND ACK FLAG + ACT 9 ACT50 AND HBFFF CLEAR BIT 14 (SEND ACK FLAG) IOR H8000 SET BIT 15 (RECV ACK FLAG) JMP ACT9 SET CNTACT-MADE FLG,STORE,& RETN SPC 2 * TOGGLE SEND ACK FLAG + ACT 9 ACT51 RAL ADA H8000 TOGGLE SEND ACK FLAG (BIT 14) RAR JMP ACT9 SET CNTACT-MADE FLG,STORE,& RETN SPC 2 * TOGGLE SEND ACK & RECV ACK FLAGS + ACT 9 ACT52 ADA H8000 TOGGLE RECV ACK FLAG (BIT 15) JMP ACT51 SPC 5 * ACTION ADDRESS TABLE * ACTAD DEF * DEF ACT1 DEF ACT2 DEF ACT3 DEF ACT4 DEF ACT5 DEF ACT6 DEF ACT7 DEF ACT8 DEF ACT9 DEF ACT10 DEF ACT11 DEF ACT12 DEF ACT13 DEF ACT14 DEF ACT15 DEF ACT16 B@- ABS AC47+RENQ HIGH (NO OVERFLOW) ABS AC13+CNTRL MID (CTR OVERFLOW & BAD ID) * * STATE 4: RREQ - CHECK READ REQUEST TYPE * ST04 ABS EV30+2 -------------------- ABS AC10+READ LOW=READ ENQ OR DELAY, READ ABS AC38+RTEXT HIGH=READ INITIAL, READ ST ABS AC10+RREAD MID=READ DELAY, RESTCT READ * * STATE 5: READ - READ -- WAITING FOR READ REQ * ST05 ABS EV00+13 -------------------- ABS AC12+READ REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE CLOSE ABS AC12+READ REQUEST: READ ENQ ABS AC12+READ REQUEST: READ INIT ABS AC38+RTEXT REQUEST: READ CONT ABS AC40+RTEXT REQUEST: READ REPEAT ABS AC30+RRVI REQUEST: READ WITH RVI ABS AC43+RENQ REQUEST: DELAY READ ABS AC12+READ REQUEST: WRITE ENQ ABS AC28+WTEXT REQUEST: WRITE CONTINUE ABS AC29+WCONV REQUEST: WRITE CONV ABS AC03+WEOT REQUEST: WRITE EOT ABS AC46+WEOT REQUEST: WRITE DISCONNECT ABS AC12+READ REQUEST: DELAY WRITE * * STATE 6: RTEXT - READ TEXT * ST06 ABS EV14+16 -------------------- ABS AC42+RTEXT ACK0 RECVD ABS AC42+RTEXT ACK1 RECVD ABS AC42+RTEXT WACK RECVD ABS AC42+RTEXT RVI RECVD ABS AC39+RTEXT ENQ ABS AC42+RTEXT NAK ABS AC15+CNTRL EOT ABS AC16+HNGUP DLE EOT RECVD ABS AC40+RTEXT TTD RECVD ABS AC51+READ TEXT RECVD ABS AC49+RTEXT BAD TEXT RECVD ABS AC19+READ TEXT OVERRUN ABS AC42+RTEXT GARBAGE RECVD ABS AC45+CNTRL BAD ID ABS AC36+RTEXT SHORT TIMEOUT ABS AC17+CNTRL LONG TIMEOUT ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 7: RRVI - READ RVI -- IS RVI VALID * ST07 ABS EV30+1 -------------------- ABS AC12+READ { LOW (2ND RVI REQUEST) ABS AC44+RTEXT HIGH (OK TO SEND RVI) * * STATE 8: RREAD - RESTRICTED READ * ST08 ABS EV00+13 -------------------- ABS AC12+RREAD REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE CLOSE ABS AC12+RREAD REQUEST: READ ENQ ABS AC12+RREAD REQUEST: READ INIT ABS AC38+RTEXT REQUEST: READ CONT ABS AC40+RTEXT REQUEST: READ REPEAT ABS AC12+RREAD REQUEST: READ WITH RVI ABS AC43+RENQ REQUEST: DELAY READ ABS AC12+RREAD REQUEST: WRITE ENQ ABS AC12+RREAD REQUEST: WRITE CONTINUE ABS AC12+RREAD REQUEST: WRITE CONV ABS AC03+WEOT REQUEST: WRITE EOT ABS AC46+WEOT REQUEST: WRITE DISCONNECT ABS AC12+RREAD REQUEST: DELAY WRITE * * STATE 9: WENQ - WRITE ENQ * ST09 ABS EV14+16 -------------------- ABS AC50+WRITE ACK0 RECVD ABS AC07+ERRWE ACK1 RECVD ABS AC05+WENQ WACK RECVD ABS AC07+ERRWE RVI RECVD ABS AC08+EN.EN ENQ ABS AC24+CNTRL NAK ABS AC15+CNTRL EOT ABS AC16+HNGUP DLE EOT RECVD ABS AC07+ERRWE TTD RECVD ABS AC07+ERRWE TEXT RECVD ABS AC07+ERRWE BAD TEXT RECVD ABS AC07+ERRWE TEXT OVERRUN ABS AC07+ERRWE GARBAGE RECVD ABS AC07+ERRWE BAD ID ABS AC32+ERRWE SHORT TIMEOUT ABS AC45+CNTRL LONG TIMEOUT ABS AC14+CNTRL LOW (LINE ERROR) BLOUT EQU ST09+16 ACTION STATE FOR IMPROBABLE ERR * * STATE 10: ERRWE - "WRITE ENQ" ERROR * ST10 ABS EV29+3 -------------------- ABS AC17+CNTRL LONG TIMEOUT ABS AC21+CNTRL LOW (CTR OVFLO, NO BAD ID) ABS AC05+WENQ HIGH (NO OVFLO) ABS AC13+CNTRL MID (CTR OVFLO, BAD ID) * * STATE 11: EN.EN - ENQ-ENQ CONTENTION * ST11 ABS EV30+1 -------------------- % ABS AC23+CNTRL LOW (SECONDARY OR CTR OFLOW) ABS AC05+WENQ HIGH (PRIMARY) * * STATE 12: WRITE - WRITE -- WAITING FOR WRITE REQ * ST12 ABS EV00+13 -------------------- ABS AC12+WRITE REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE CLOSE ABS AC12+WRITE REQUEST: READ ENQ ABS AC12+WRITE REQUEST: READ INIT ABS AC12+WRITE REQUEST: READ CONT ABS AC12+WRITE REQUEST: READ REPEAT ABS AC12+WRITE REQUEST: READ WITH RVI ABS AC12+WRITE REQUEST: DELAY READ ABS AC12+WRITE REQUEST: WRITE ENQ ABS AC28+WTEXT REQUEST: WRITE CONTINUE ABS AC29+WCONV REQUEST: WRITE CONV ABS AC04+REOTR REQUEST: WRITE EOT ABS AC46+WEOT REQUEST: WRITE DISCONNECT ABS AC27+WTTD REQUEST: DELAY WRITE * * STATE 13: WTEXT - WRITE TEXT * ST13 ABS EV14+16 -------------------- . ABS AC31+CKRES ACK0 RECVD ABS AC31+CKRES ACK1 RECVD ABS AC05+WTEXT WACK RECVD ABS AC30+CKRES RVI RECVD ABS AC35+WRENQ ENQ RECVD ABS AC33+WRTRY NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+HNGUP DLE EOT RECVD ABS AC07+WPREV TTD RECVD ABS AC07+WPREV TEXT RECVD ABS AC07+WPREV BAD TEXT RECVD ABS AC07+WPREV TEXT OVERRUN ABS AC07+WPREV GARBAGE RECVD ABS AC07+WPREV BAD ID ABS AC32+WPREV SHORT TIMEOUT ABS AC45+CNTRL LONG TIMEOUT (NOT EXECTED) ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 14: WPREV - WRITE PREVIOUS RESPONSE ENQ * ST14 ABS EV29+3 ------------------- ABS AC17+CNTRL LONG TIMEOUT ABS AC21+CNTRL LOW: CTR OVERFLOW ABS AC05+WTEXT HIGH: WRITE, NO OVERFLOW ABS AC06+WCONV MID: WRITE CONV, NO OVFLOW * * STATE 15: CKRES - CHECK RESPONSE * ST15 ABS EV30+2 D -------------------- ABS AC34+BDACK LOW (BAD ACK) ABS AC22+WRITE HIGH (RVI RECVD) ABS AC48+WRITE MID (GOOD ACK) * * STATE 16: BDACK - BAD ACK RECEIVED * ST16 ABS EV30+2 --------------------------- ABS AC07+WPREV LOW: T/O FLAG NOT SET OR * BR FLAG SET ABS AC28+WTEXT HIGH: WRITE, T/O FLAG SET & * BR FLAG NOT SET ABS AC29+WCONV MID: WRITE CONV, " " * * STATE 17: WRTRY - WRITE RETRY * ST17 ABS EV30+2 -------------------- ABS AC20+CNTRL LOW (CTR OVERFLOW) ABS AC28+WTEXT HIGH (WRITE, NO OVFLO) ABS AC29+WCONV MID (WRITE CONV, NO OVFLO) * * STATE 18: WRENQ - ENQ RECVD IN WRITE OR CONV * ST18 ABS EV30+2 --------------------------- ABS AC07+WPREV LOW (TEXT NOT JJUST RECVD) ABS AC07+WRNQ2 HIGH (TEXT RECVD,ENQ NOT X) ABS AC23+CNTRL MID (ENQ JUST SENT) * * STATE 19: WRNQ2 - 2ND STATE, ENQ RECVD IN WRITE * ST19 ABS EV30+2 --------------------------- ABS AC25+CNTRL LOW (CTR OVERFLOW) ABS AC28+WTEXT HIGH (NO OVFLO, WRITE) ABS AC29+WCONV MID (NO OVFLO, WRITE CONV) * * STATE 20: WCONV - WRITE CONVERSATIONAL * ST20 ABS EV14+16 -------------------- ABS AC31+CKRES ACK0 RECVD ABS AC31+CKRES ACK1 RECVD ABS AC06+WCONV WACK RECVD ABS AC30+CKRES RVI RECVD ABS AC35+WRENQ ENQ RECVD ABS AC33+WRTRY NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+HNGUP DLE EOT RECVD ABS AC40+WCONV TTD RECVD ABS AC52+READ TEXT RECVD ABS AC49+WCONV BAD TEXT RECVD ABS AC19+READ TEXT OVERRUN ABS AC07+WPREV GARBAGE RECVD ABS AC45+CNTRL BAD ID (NOT EXPECTED) ABS AC32+WPREV SHOFT& TIMEOUT ABS AC45+CNTRL LONG TIMEOUT (NOT EXECTED) ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 21: WEOT - WRITE EOT * ST21 ABS EV30+1 -------------------- ABS AC14+CNTRL LOW (LINE ERROR) ABS AC10+CNTRL HIGH (NORMAL COMPLETION * * STATE 22: REOTR - READ EOT RESPONSE * ST22 ABS EV18+12 -------------------- ABS AC18+RREAD ENQ RECVD ABS AC45+CNTRL NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+HNGUP DLE EOT RECVD ABS AC45+CNTRL TTD RECVD ABS AC45+CNTRL TEXT RECVD ABS AC47+REOTR DATA ERROR RECVD ABS AC47+REOTR DATA OVERRUN ABS AC47+REOTR GARBAGE RECVD ABS AC45+CNTRL BAD ID ABS AC10+CNTRL SHORT TIMEOUT ABS AC17+CNTRL LONG TIMEOUT ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 23: HNGUP - HANG UP -- DLE EOT RECVD * ST23 ABS EV00+13 -------------------- ABS AC16+HNGUP REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE CLOSE ABS AC16+HNGUP REQUEST: READ ENQ ABS AC16+HNGUP REQUEST: READ INIT ABS AC16+HNGUP REQUEST: READ CONT ABS AC16+HNGUP REQUEST: READ REPEAT ABS AC16+HNGUP REQUEST: READ WITH RVI ABS AC16+HNGUP REQUEST: DELAY READ ABS AC16+HNGUP REQUEST: WRITE ENQ ABS AC16+HNGUP REQUEST: WRITE CONTINUE ABS AC16+HNGUP REQUEST: WRITE CONV ABS AC16+HNGUP REQUEST: WRITE EOT ABS AC16+HNGUP REQUEST: WRITE DISCONNECT ABS AC16+HNGUP REQUEST: DELAY WRITE * * STATE 24: WTTD - WRITE TTD * ST24 ABS EV14+16 -------------------- ABS AC26+CNTRL ACK0 RECVD ABS AC26+CNTRL ACK1 RECVD ABS AC26+CNTRL WACK RECVD ABS AC26+CNTRL RVI RECVD ABS AC26+CNTRL ENQ RECVD ABS AC10+WRITE NAK RECVD ABS AC15+CNTRL G EOT RECVD ABS AC16+CNTRL DLE EOT RECVD ABS AC26+CNTRL TTD RECVD ABS AC26+CNTRL TEXT RECVD ABS AC26+CNTRL BAD TEXT RECVD ABS AC26+CNTRL TEXT OVERRUN ABS AC10+WRITE GARBAGE RECVD ABS AC45+CNTRL BAD ID (NOT EXPECTED) ABS AC27+WTTD SHORT TIMEOUT ABS AC17+CNTRL LONG TIMEOUT (NOT EXECTED) ABS AC14+CNTRL LOW (LINE ERROR) * ST25 NOP LOGICAL END TO STATE-TRANS SKP * CONSTANTS & STORAGE SHARED BY MESSAGE PROC & CHARACTER PROC * .1 DEC 1 DEC 1 .2 DEC 2 DEC 2 .3 DEC 3 DEC 3 .4 DEC 4 DEC 4 .5 DEC 5 DEC 5 .6 DEC 6 DEC 6 .7 DEC 7 DEC 7 .8 DEC 8 DEC 8 OCT 10 .9 DEC 9 DEC 9 OCT 11 .10 DEC 10 DEC 10 OCT 12 .11 DEC 11 DEC 11 OCT 13 .12 DEC 12 DEC 12, OCT 14 .13 DEC 13 DEC 13, OCT 15 .14 DEC 14 DEC 14, OCT 16 .15 DEC 15 DEC 15, OCT 17 .17 DEC 17 DEC 17 OCT 21 A EQU 0 B EQU 1 B77 DEC 63 DEC 63, OCT 77 B100 DEC 64 DEC 64, OCT 100 B377 DEC 255 DEC 255, OCT 377 B4000 OCT 004000 OCT 4000, BIT 11, LEFT 8 H1000 OCT 010000 BIT 12 H2000 OCT 020000 BIT 13 H4000 OCT 040000 BIT 14 H8000 OCT 100000 BIT 15 M1 DEC -1 DEC -1, OCT 177777 M2 DEC -2 DEC -2, OCT 177776 M3 DEC -3 DEC -3, OCT 177775 M5 DEC -5 DEC -5, OCT 177773 M7 DEC -7 DEC -7, OCT 177771 M300 DEC -300 NOM3 DEC -30 TICKS IN NOMINAL 3-SEC TIMEOUT PRET OCT 0 P+2 RETURN ADDRESS FOR PHYSICAL PRETF OCT 0 P+1 RETURN ADDRESS FOR PHYSICAL * * EQT POINTERS EQT09 EQU 1665B PTR TO CONTROL WORD IN EQT EQT10 EQU 1666B EQT 10: VALUE OF CONTROL PARAM 1 * OR REQUEST BUFFER ADDR EQT11 EQU 1667B EQT 11: ADDR OF CONTROL PARAM 2 * OR REQUEST BUFFp640ER LENGTH ET10 OCT 0 PTR TO EQT 10 SPC 4 * EQT EXTENSION POINTERS * CTLEN OCT 0 PTR TO CHAR TRACE LENGTH CTLWA OCT 0 LAST WORD ADDR OF CHAR TRACE ERET OCT 0 PTR TO RETURN ADDR FOR EDITOR KEY OCT 0 PTR TO ADDR EXECUTED AFTER ENTRY * FROM PHYSICAL MPFLS OCT 0 PTR TO MESSAGE PROCESSOR FLAGS NTRY OCT 0 PTR TO # OF RETRIES RTCTR OCT 0 PTR TO RETRY CTR TLOG OCT 0 PTR TO TRANSMISSION LOG ENVIR OCT 0 PTR TO SPECIFIED ENVIRONMENT SKP * SUBROUTINE BSCR: BSC RECEIVE * (A) = BUFFER ADDRESS * (B) = -(1 + BUFFER LENGTH IN BYTES) * (E) = INDICATOR: 1 =SAVE ID SEQ, 0 =DONT SAVE ID * (P) = JSB BSCR * (A) = COMPLETION STATUS * BSCR NOP RCVR ENTRY STA EBUFA,I SAVE BYTE ADDR STB EBUFL,I & BUFFER LENGTH LDA BSCR STA ERET,I SAVE RETURN ADDR LDB NOM3 SPECIFY NOMINAL 3-SEC TIMEOUT STB PTME THIRD PARAMETER LDA M300 STA NOM3 SET NOM 3-SEC TIMEOUT TO 3 SEC LDA EBUFA,I ADDRESS LDB EBUFL,I COUNT JSB HREC PTME NOP NOP LDB ERET,I GET RETURN ADDRESS JMP B,I RETURN * * EQT EXTENSION POINTERS * BLKSP OCT 0 PTR TO BLOCK SPEC BITS (15 - 13) EBUFA OCT 0 PTR TO EDITOR BUFFER ADDR EBUFL OCT 0 PTR TO EDITOR BUFFER LENGTH SPC 1 BSS 0 SIZE OF HSLC SPC 1 END @6 S&z 91741-18016 2013 S C0222 &POPEN              H0102 ~ASMB,Q,C,N *USE 'ASMB,R,N' FOR DS/1000 ONLY, AND 'ASMB,R,Z' FOR DS/1000 & DS/3000 IFN NAM POPEN,7 91740-16042 REV 1740 770714 XIF IFZ NAM POPEN,7 91741-16016 REV 2013 790731 XIF UNL IFN HED POPEN (DS/1000) 91740-16042 * (C) HEWLETT-PACKARD CO 1980 XIF IFZ HED POPEN (DS/1000 & DS/3000) 91741-16016 * (C) HEWLETT-PACKARD CO 1980 XIF LST * * IFN OPTION * NAME: POPEN * SOURCE: 91740-18042 * RELOC: 91740-16042 * PRGMR: CHUCK WHELAN * * IFZ OPTION * NAME: POPEN * SOURCE: 91741-18016 * RELOC: 91741-16016 * PRGMR: CHUCK WHELAN & JIM HARTSELL * * MODIFIED QCLOS RETURN FOR 2013 PCO. [DMT] * SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT POPEN,PREAD,PWRIT,PCONT,PCLOS EXT D65MS EXT .ENTR IFZ EXT #LU3K EXT D3KMS,D$INI,D$STW,D$ASC EXT D$RQB,D$NWD,D$ZRO,D$WDC,D$SMP * D EQU 256 MAX # DATA WORDS/BLOCK (DS/3000). XIF SUP * SPC 3 * THIS PROGRAM PERFORMS ALL MASTER PROGRAM TO PROGRAM FUNCTOIONS * IN THE DISTRIBUTED SYSTEM. ON EACH REQUEST IT DOES THE FOLLOWING: * * 1. MOVES PCB FROM USER AREA TO REQUEST (EXCEPT POPEN) * 2. VERIFIES SUFFICIENT PARAMETERS PASSED IN CALL * 3. MOVES 20 WORD TAG FIELD INTO REQUEST (EXCEPT PCLOS) * 4. SETS STREAM, FUNCTION, AND ORIGINATOR NODE INTO REQUEST * 5. CALLS "D65MS" TO SEND REQUEST (& DATA) AND GET REPLY * 6. IF NO SYSTEM ERROR, MOVES TAG FIELD INTO USER AREA (EXCEPT PCLOS) * 7. EXAMINES STATUS & GIVES "ACEPT", "REJCT", OR ERROR CODE BACK TO CALLER SKP IPCB NOP IERR NOP INAM NOP INODE NOP ITAG NOP IFZ ENAM NOP DS/3000: ENTRY NAME NOP CONTROL INFORMATION. NOP LOADING OPTIONS. BUFSZ NOP MAX DATA RECORD LENGTH XIF SPC 3 POPEN NOP * * MASTER REQUESTS FOR POPEN COME HERE * JSB .ENTR PICK UP THE USER PARAMETERS DEF IPCB * LDB IPCB USER'S PCB ADDRESS LDA INODE,I DESTINATION NODE ADB K3 4TH WORD OF PCB HAS NODE STA 1,I PUT IT THERE STA $DEST SAVE IT * LDB POPEN SET UP ERROR RETURN LDA IERR JSB BLDRQ SET UP BASIC REQST DEF ITAG DEC 1 FCN = 1 IFZ JMP QOPEN DO POPEN TO 3000 XIF * LDA INAM ADDR OF NAME FIELD LDB RPCBA ADDR OF PCB IN REQ BUFFER MVW K3 MOVE NAME INTO PCB FIELD * LDA IPCB * NODAT LDB DUMAD USE DUMMY AS DATA POINTER STB DBUF CLB STB WRLEN SET WRITE DATA LENGTH = 0 * * * THIS CODE IS USED IN COMMON BY ALL P TO P CALLS * MAIN STB RDLEN SET READ DATA LENGTH STA PCBAD SAVE PCB ADDRESS * LDA K4 STA $STRM SET P TO P STREAM IN REQ * * THE CALL TO D65MS WILL: * 1) GET AN I/O CLASS * 2) INSERT SEQ # & ORIGIN NODE * 3) BUILD MASTER TCB * 4) SEND REQUEST (& DATA) * 5) CALL "D65GT" TO AWAIT AND GET REPLY * 6) RETURN REPLY (& DATA) * 7) RETURN CONTROL JSB D65MS ISSUE REQUEST CALL DEF *+8 DEF CONWD DEF IRBUF REQUEST BUFFER DEF IRBFL REQUEST LENGTH DBUF NOP DATA BUFFER ADDRESS DEF WRLEN DATA WRITE LENGTH DEF RDLEN DATA READ LENGTH DEF IRBFL MAX EXPECTED REPLY LENGTH * JMP ERR ERROR DETECTED LDA $FUNC FUNCTION COD]*E CPA K5 IS THIS A PCLOS? JMP NOMOV YES, WE'RE DONE * RPCBA EQU *+1 DLD $PCB GET PCB PCBAD EQU *+1 DST * SAVE 1ST 2 PCB WORDS IN USER AREA * LDA RTAGA ADDR OF TAG FIELD IN REQUEST LDB TAGAD ADDR OF TAG FIELD IN USER AREA MVW K20 MOVE 20 WORDS TO USER TAG FIELD * NOMOV LDA $ERR SZA WAS ERROR DETECTED? JMP EXIT YES, IERR SET LDB $FUNC SSB WAS REQUEST REJECTED? CLA,INA YES, SET REJECT IERR EXIT STA ERRAD,I RETURN IT TO CALLER CLB STB CLEAR,I CLEAR PARAM CHECK LOC JMP RTRN,I RETURN SKP * * MOVE PCB INTO REQUEST BUFFER MVPCB NOP LDB N2 ADB MVPCB POINT TO ADDR OF PCB ADDR LDB 1,I GET ADDR OF PCB ADDR LDA 1,I GET PCB ADDR LDB RPCBA GET ADDR OF PCB IN BUFFER MVW K2 MOVE 1ST TWO WORDS TO REQUEST INA POINT TO 4TH DCB WORD LDB 0,I GET DESTINATION NODE STB $DEST SAVE IT JMP MVPCB,I RETURN SPC 2 * * COMMON PARAMETER SET-UP AND TAG FIELD MOVE FOR ALL BUT "PCLOS" BLDRQ NOP STB RTRN RETURN ADDRESS FOR ALL STA ERRAD ADDR OF ERROR PARAMETER * DLD BLDRQ,I GET TAG ADDR ADDR, AND FUNC CODE STA CLEAR SAVE LAST PARAM ADDR LDA 0,I GET ADDR OF USER'S TAG FIELD SZA,RSS WAS LAST PARAM SPECIFIED JMP ERR2 TOO FEW PARAMETERS IN CALL STB $FUNC SET FUNCTION CODE IFZ LDB #LU3K GET DS/3000 LU CMB,INB,SZB,RSS NEGATE JMP *+3 NO 3000 CPB $DEST IS IT NEGATIVE LU OF 3000? JMP RQEX YES, PERFORM DS/3000 P-TO-P XIF LDB K31 REQUEST LENGTH STB IRBFL * STA TAGAD LDB RTAGA ADDR OF TAG FIELD IN REQUEST MVW K20 MOVE TAG FIELD INTO REQ IFZ ISZ BLDRQ XIF RQEXx  ISZ BLDRQ ISZ BLDRQ JMP BLDRQ,I RETURN SPC 3 * ERROR PROCESSING SECTION ERR ADB NEG00 SUBTRACT ASCII "00" CPA "DS" IS IT A "DSXX" ERROR? SSB AND >= "00"? JMP ERR47 NO, GIVE -47 LDA 1 ADA N9 NUMERIC PART - 9 CMA,SSA SKIP IF DS00 - DS08 ERR47 LDA K11 MAKE A -47 ERROR ADA N58 A = -47 OR -50 THRU -58 JMP EXIT ERR2 LDA N40 JMP EXIT RETURN WITH IERR SKP * * READ REQUESTS * RIPCB NOP RIERR NOP RIBUF NOP RIL NOP RITAG NOP * PREAD NOP JSB .ENTR GET USER PARAMETERS DEF RIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST * LDB PREAD RETURN ADDRESS LDA RIERR JSB BLDRQ BASIC REQUEST PROCESSING DEF RITAG K2 DEC 2 IFZ JMP QREAD PERFORM PREAD TO 3000 XIF * LDA RIBUF SAVE BUFFER ADDRESS STA DBUF LDB RIL,I SAVE DATA LENGTH STB $DLEN * CLA STA WRLEN CLEAR WRITE DATA LENGTH LDA RIPCB PCB ADDRESS JMP MAIN NOW DO LINE COMM & RETURN SKP * * WRITE REQUESTS * PIPCB NOP PIERR NOP PIBUF NOP PIL NOP PITAG NOP * * PWRIT NOP PWRITE REQUESTS HERE JSB .ENTR PICK UP PARAMETERS DEF PIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDB PWRIT SET UP ERROR RETURN LDA PIERR JSB BLDRQ BUILD BASIC REQST DEF PITAG K3 DEC 3 IFZ JMP QWRIT PERFORM PWRIT TO 3000 XIF * LDA PIBUF GET DATA ADDRESS STA DBUF LDA PIL,I GET DATA LENGTH STA $DLEN STA WRLEN * LDA PIPCB CLB JMP MAIN NOW DO LINE COMM & RETURN SKP * * CONTROL REQUESTS * CIPCB NOP CIERR NOP CITAG NOP * * PCONT NOP JSB .ENTR GET PARAMETERS DEF CIPCB JSB 4MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDB PCONT SET UP RETURN ADDR LDA CIERR JSB BLDRQ BUILD BASIC REQST DEF CITAG K4 DEC 4 IFZ JMP QCONT PERFORM PCONT TO 3000 XIF * LDA CIPCB PCB ADDRESS JMP NODAT DO LINE COMM & RETURN SKP * * CLOSE REQUESTS * FIPCB NOP FIERR NOP * * RTRN EQU * PCLOS NOP JSB .ENTR GET PARAMETERS DEF FIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDA DFIEA STA CLEAR SAVE LAST PARAM ADDR LDA FIERR SZA,RSS ERROR ADDR SPECIFIED? JMP ERR2 NO, GIVE ERROR STA ERRAD SET ERROR ADDRESS IFZ LDA #LU3K GET 3000 LU CMA,INA,SZA,RSS NEGATE IT JMP *+3 JUMP IF NO 3000 LINK CPA $DEST WAS NEGATIVE LU OF 3000 SPECIFIED? JMP QCLOS YES, DO PCLOS TO 3000 XIF * LDA K11 STA IRBFL 11 WORD REQUEST LDA K5 STA $FUNC FUNCTION CODE = 5 * LDA FIPCB PCB ADDRESS JMP NODAT DO COMMUNICATION & RETURN SKP * * DATA AREA * IRBFL NOP WRLEN NOP RDLEN NOP K5 DEC 5 K11 DEC 11 K20 DEC 20 K31 DEC 31 N2 DEC -2 N9 DEC -9 N40 DEC -40 N58 DEC -58 NEG00 OCT 147720 "DS" ASC 1,DS CONWD OCT 100000 ERRAD NOP TAGAD NOP CLEAR NOP DFIEA DEF FIERR RTAGA DEF $TAG ADDR OF REQ TAG FIELD DUMAD DEF * * * DEFINE REQUEST IRBUF BSS 31 IFZ BSS 4 XIF $STRM EQU IRBUF $DEST EQU IRBUF+3 $ERR EQU IRBUF+5 $FUNC EQU IRBUF+7 $PCB EQU IRBUF+8 $DLEN EQU IRBUF+10 $TAG EQU IRBUF+11 IFN UNL XIF IFZ SKP * * GENERATE POPEN REQUEST FOR REMOTE DS/3000 COMPUTER. * QOPEN LDA ITAG STA TAGAD * LDA ITAG SZA,RSS JMP ERR2 ILLEGAL NUMBER OF PARAMETERS. * * BEGIN THE REQUEST BUFFER WITH SETUP OF 8-WORD FIXED o* FORMAT FOR PTOPC, THEN "RFA " IN NEXT 2 WORDS. * LDA IPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B21 POPEN STREAM = 21 OCTAL. JSB D$PTP SET UP 8 WORD FIXED FORMAT AREA. LDB D$RQB LDA B7 CHANGE POPEN MSG CLASS TO 7. STA B,I * LDA "RF" JSB D$STW STORE "RFA ". LDA "A" JSB D$STW * LDA B25 JSB D$STW FUNCTION CODE = 25 OCTAL. * LDA INAM MOVE PROGRAM NAME (UP TO 28 BYTES). LDB N14 (DELIMITER = BLANK) JSB D$ASC * INA (A) = TOTAL BYTES IN REQUEST. ARS NEED TO INSERT TRAILING BLANKS ADA N17 IN PROGRAM NAME FIELD? STA TEMP SSA,RSS JMP MVENT NO. * LOOP2 LDA BLNKS YES. ADD TRAILING BLANKS JSB D$STW TO FILL OUT 14-WORD FIELD. ISZ TEMP JMP LOOP2 * MVENT LDA ENAM MOVE ENTRY NAME (UP TO 8 BYTES). LDB N4 DELIMITER = BLANK. JSB D$ASC * INA (A) = TOTAL BYTES IN REQUEST. ARS ADA N21 NEED TO INSERT TRAILING BLANKS STA TEMP IN ENTRY NAME FIELD? SSA,RSS JMP MVTAG NO. * LOOP3 LDA BLNKS YES. ADD TRAILING BLANKS TO FILL JSB D$STW OUT 4-WORD FIELD. ISZ TEMP JMP LOOP3 * MVTAG LDA N20 MOVE TAG FIELD. JSB D$NWD * CLA MOVE 2 PARAMETERS. LDA ENAM+1,I JSB D$STW CLA LDA ENAM+2,I JSB D$STW CLA ZERO 3 WORDS. JSB D$STW CLA JSB D$STW CLA JSB D$STW LDA MAXSZ STORE MAX BLOCK SIZE (+WORDS). LDB BUFSZ GET USER'S VALUE IF SZB IT WAS SPECIFIED. LDA BUFSZ,I SZA SSA LDA MAXSZ JSB D$STW * * SET UP PARAMETER MASK AS FOLLOWS: * BIT 9 = PROGRAM NAME * BIT 8 = ENTRY NAME * BIT 7 = 0 * BIT 6 = CONTROL INFO * BIT 5 = LOADING OPTIONS * BIT 4 = 0 * BIT 3 = 0 * BIT 2 = 0 * BIT 1 = 0 * BIT 0 = 0 * LDA DPARM FWA PARAM ADDR LIST. STA TEMP LDA N5 COUNTER. STA CONTR CLA INITIALIZE PARAMETER MASK. * LOOP4 LDB TEMP,I GET ADDR OF NEXT PARAM. LDB B,I SZB IOR B1 SET BIT IF PARAM SPECIFIED. RAL MOVE IT OVER. ISZ TEMP ISZ CONTR JMP LOOP4 LOOP TILL DONE. ALF BITS 0-4 = 0. JSB D$STW * * REQUEST BUFFER READY. D3KMS WILL WRITE IT TO QUEX'S I/O * CLASS. USER WILL BE SUSPENDED UNTIL D3KMS'S CLASS GET * IS COMPLETED WHEN THE REPLY ARRIVES. * JSB D$WDC STORE WORD COUNT. CLA POPEN HAS A SINGLE REPLY. LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND WAIT FOR REPLY. * JSB PASSP RETURN ERROR CODE AND TAG FIELD. * LDA D$RQB RETURN PCB FROM REPLY. ADA K10 (CURRENTLY NOT USED - ALL ZEROES) STA TAGPR LDA N3 LDB IPCB JSB MOVE * LDA ERRAD,I JMP RTRN,I RETURN TO CALLER. * * DPARM DEF *+1 TABLE OF POPEN PARAMETER DEF INAM ADDRESSES FOR BIT MASK. DEF ENAM DEF B0 DEF ENAM+1 DEF ENAM+2 * SKP * * SUBROUTINE TO SEND AND/OR RECEIVE BUFFERS TO/FROM THE HP3000. * REMIO NOP IOR 1 STA CNWRD * JSB D3KMS DEF *+2 DEF CNWRD JMP ERR ERROR RETURN. * LDA D$RQB SAVE "FROM PROCESS #" AS ADA K4 "TO PROCESS #" FOR NEXT REQUEST. LDA A,I ALF,ALF AND B377 STA D$SMP * ISZ BLKCT BUMP PREAD/PWRIT BLOCK COUNTER. JMP REMIO,I EXIT. * * SUBROUTINE TO BUILD 8-WORD FIXED FORMAT AREA OF REQUEST. * * (A) = 1ST BYTE RIGHT JUSTIFED * (B) = STREAM TYPE. * D$PTP NOP STB TEMP SAVE STREAM TYPE. LDA K4 STORE MESSAGE CLASS = 4. JSB D$STW STORE 1ST WORD IN REQUEST BUFFER. CLA CLEAR COMPUTER ID. JSB D$STW LDA TEMP STORE STREAM TYPE. JSB D$STW LDA N4 CLEAR NEXT 4 WORDS. JSB D$ZRO LDA N2 FORCE BYTE COUNTER TO CLEAR. JSB D$STW JMP D$PTP,I * * SUBROUTINE TO PASS RETURNED ERROR CODE AND TAG * FIELD TO THE USER PROGRAM. * PASSP NOP LDB D$RQB RETURN ERROR CODE. ADB K8 LDB B,I CLA MAP DS/3000 TO DS/1 ERROR CODES. CPB CG211 INA CCG & 211 = 1 (REJECT). CPB CL209 LDA N41 CCL & 209 = -41. CPB CL205 LDA N42 CCL & 205 = -42. CPB CG210 LDA N44 CCG & 210 = -44. CPB CL213 LDA N44 CCL & 213 = -44. STA ERRAD,I * LDB D$RQB ADB K13 RETURN TAG FIELD. STB TAGPR LDA N20 20 WORDS. LDB TAGAD JSB MOVE JMP PASSP,I SKP * * GENERATE PREAD REQUEST FOR REMOTE DS/3000 COMPUTER. * QREAD CLA CLEAR BLOCK COUNTER. STA BLKCT LDA RITAG STA TAGAD SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA RPRAM POINT TO ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B22 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP * CLA JSB D$STW * LDA RIL,I GET USER BUFFER LENGTH. SSA,RSS JMP *+4 CMA,INA INA CLE,ERA JSB D$STW STORE IN REQUEST BUFFER. * LDA RIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * JSB D$WDC SET WORD COUNT. * * SEND REQUEST TO THE 3000 AND WAIT FOR REPLIES. * LDA RIBUF SET ADDR O_ZF USER DATA BUFFER. STA TBUF CLA STA TCNT CLEAR RECEIVED BYTE COUNTER. INA SIGNAL FOR MULTIPLE REPLIES. * SN/RC LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND GET REPLIES. * LDA CNWRD WAS LAST CALL TO RELEASE CLASS ONLY? AND B377 CPA K4 JMP DONE YES. * LDA BLKCT IF FIRST REPLY, PASS ERROR CPA B1 CODE AND TAG TO USER. JSB PASSP * LDA D$RQB CHECK IF ANY DATA WAS RECEIVED. ADA B7 LDA A,I (A) = + BYTES. ADA N10 ADJUST FOR IERR & PCB. LDB BLKCT CPB B1 IF FIRST REPLY, ADJUST FOR TAG. ADA N40 SZA,RSS JMP DEALC NO DATA (COULD BE REJECT). * JSB RDMOV MOVE DATA TO USER BUFFER. * LDA D$RQB IS CONTINUATION BIT SET? ADA K2 LDA A,I RAL,RAL SSA JMP DMREP YES. DEALC LDA K4 NO. DE-ALLOCATE CLASS. JMP SN/RC * DMREP LDB D$RQB NO. SET UP "REPLY". LDA B,I STORE COUNT AND MSG CLASS. AND B377 IOR LB10 STA B,I ADB K2 LDA B,I CLEAR REPLY BIT. ELA,CLE,ERA STA B,I ADB K2 LDA B,I REVERSE PROCESS NUMBERS. ALF,ALF STA B,I ADB K3 CLA CLEAR BYTE COUNT. STA B,I * LDA K2 TELL D3KMS TO LOOK FOR MORE. JMP SN/RC GO GET NEXT DATA BLOCK. * DONE LDA ERRAD,I JMP RTRN,I RETURN TO USER. SPC 2 * * MOVE SUBROUTINE * MOVE NOP STA CONTR MOVE1 LDA TAGPR,I PICK UP NEXT WORD STA 1,I AND PUT IT AWAY INB ISZ TAGPR INCREMENT POINTERS ISZ CONTR JMP MOVE1 UNTIL DONE JMP MOVE,I SKP * * SUBROUTINE TO MOVE A BLOCK OF DATA FROM REPLY * BUFFER TO USER BUFFER (REMAINING BYTES UP TO MAX LEN). * EXIT WITH TCNT = TOTAL BYTES REMAINIBNG. * RDMOV NOP (A) = + BYTES. SZA,RSS EXIT FOR JMP RDMOV,I 0-LEN DATA. LDB A ACCUMULATE LOG. ADB TCNT STB TCNT INA CLE,ERA (A) = + WORDS. CMA,INA STA TEMP NEG. # WORDS TO MOVE. LDB D$RQB ADB K13 GET PAST 3-WORD "PCB" AREA. LDA BLKCT IF THIS IS FIRST REPLY, CPA B1 ADB K20 ADJUST FOR TAG FIELD. STB RQPTR ADDR OF REPLY DATA. * LOOP LDA RQPTR,I MOVE WORD FROM REPLY STA TBUF,I TO USER BUFFER. ISZ RQPTR BUMP POINTERS. ISZ TBUF * ISZ TEMP JMP LOOP ELSE LOOP TILL DONE. JMP RDMOV,I REACHED LIMIT OF MAX WORDS. SKP * * GENERATE PWRIT REQUEST FOR REMOTE DS/3000 COMPUTER. * QWRIT CLA CLEAR BLOCK COUNTER. STA BLKCT LDA PITAG STA TAGAD * SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA PPRAM POINT TO ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B23 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP * CLA JSB D$STW * LDA PIBUF SET POINTER TO USER DATA. STA TBUF * LDA PIL,I GET USER BUFFER LENGTH. SSA,RSS JMP *+5 CMA,INA SLA INA RSS CLE,ELA BYTES (POSITIVE). STA TCNT TOTAL DATA BYTES TO SEND. CLE,ERA JSB D$STW STORE IN REQUEST BUFFER (TCOUNT). * LDA PIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * JSB D$WDC SET WORD COUNT. * JSB WRMOV MOVE 1ST BLOCK TO REQUEST BUFFER. LDA TCNT SZA,RSS IF ALL DATA MOVED, JMP SEND TELL D3KMS THERE IS A SINGLE REPLY. * LDB D$RQB CONTINUATION BLOCKS REQUIRED. ADB K2 LDA B,I IOR BIT13 SET CONTINUATION BIT IN STREAM WORD. STA B,I CLA,INA TELL D3KMS THERE ARE MULT. BLOCKS. * * SEND REQUESTS TO THE 3000 AND GET THE REPLY. * SEND LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUESTS AND/OR GET REPLY. * LDB TCNT IF ALL DATA OUT, WE HAVE RECEIVED SZB THE REPLY. JMP MORE JSB PASSP RETURN ERROR CODE & TAG TO USER. LDA ERRAD,I JMP RTRN,I RETURN TO CALLER. * * MORE DATA... SHIP OUT THE NEXT BLOCK. * MORE LDB D$RQB CLEAR REPLY BIT. ADB K2 LDA B,I ELA,CLE,ERA STA B,I * JSB WRMOV MOVE NEXT CHUNK OF DATA. LDA K2 LDB TCNT SZB IF MORE DATA, KEEP CONT. BIT. JMP SEND CALL D3KMS WITH RCODE = 2. * LDB D$RQB THIS IS LAST BLOCK. ADB K2 LDA B,I AND NOT13 CLEAR CONTINUATION BIT. STA B,I LDA K3 TELL K3KMS THIS IS LAST BLOCK. JMP SEND SKP * SUBROUTINE TO STORE # BYTES LEFT TO SEND IN REQ * BUFFER AND MOVE NEXT BLOCK OF USER DATA (REMAINING * BYTES UP TO MAX). STORE ADJUSTED BYTE COUNTER (N) * IN REQUEST. ON EXIT, TCNT IS REMAINING # DATA * BYTES OR ZERO. * WRMOV NOP LDB D$RQB ADB B7 LDA B,I INITIALIZE BYTE COUNTER (N). STA BYTCT LDA TCNT # REMAINING DATA BYTES. SZA,RSS EXIT FOR JMP WRMOV,I 0-LEN DATA. LDB D$RQB * ADB K13 SET ADDR OF DATA IN RQBUF. LDA BLKCT SZA,RSS ADJUST FOR TAG FIELD ADB K20 IN FIRST REQUEST. STB RQPTR LDA RLSIZ STA TEMP SET MAX # DATA WORDS (NEG). * LOOP1 LDA TBUF,I MOVE DATA FROM USER TO REQUEST. STA RQPTR,I ISZ TBUF ISZ RQPTR ISZ BYTCT ADD 2 TO BYTE COUNTER (N). ISZ BYTCT LDA TCNT DECREMENT TOTAL DATA BYTES LEFT. ADA N2 STA TCNT CMA,INA NE<GATE. SSA,RSS IF 0 OR 1, JMP ADJ1 ALL USER DATA MOVED, ISZ TEMP JMP LOOP1 ELSE LOOP TILL DONE. JMP STBYT REACHED LIMIT OF MAX WORDS. * ADJ1 CMA,INA ADJUST BYTE COUNTER (N) ADA BYTCT STA BYTCT * STBYT LDA D$RQB STORE BYTE COUNT (N). ADA B7 LDB BYTCT STB A,I LDA TCNT IF TCNT = -1, MAKE IT 0. CPA N1 CLA STA TCNT JMP WRMOV,I RETURN. SKP * * GENERATE PCONT REQUEST FOR REMOTE DS/3000 COMPUTER. * QCONT LDA CITAG STA TAGAD * SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA CPRAM ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B24 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP LDA N2 CLEAR NEXT 2 WORDS. JSB D$ZRO * LDA CIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * JSB D$WDC SET WORD COUNT. * * SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY. * CLA SINGLE BLOCK. LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND GET REPLY. * JSB PASSP RETURN ERROR CODE & TAG FIELD. * LDA ERRAD,I JMP RTRN,I RETURN. SKP * * GENERATE PCLOS REQUEST FOR REMOTE DS/3000 COMPUTER. * QCLOS LDB D$RQB MOVE REQUEST TO D3KMS BUFFER. LDA BRKBF MVW K8 MOVE 8 WORDS * JSB D3KMS SEND BREAK REQ TO 3000, DEF *+2 AND GET THE REPLY. DEF BIT15 NOP * LDA FIERR ADDR OF 1ST PARAM (DUMMY). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDB B21 SET UP 8-WORD FIXED FORMAT AREA. JSB D$PTP * LDB D$RQB CHANGE PCLOS MSG CLASS TO 7. LDA B7 STA B,I * LDA "RF" STORE "RFA ". JSB D$STW LDA "A" NLH JSB D$STW LDA B26 STORE FCN CODE = 26 OCTAL. JSB D$STW * LDA FIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) * JSB D$WDC SET WORD COUNT. * * SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY. * CLA SINGLE BLOCK. LDB BIT15 SET NO-ABORT BIT IN FLAG WORD. * JSB REMIO SEND REQUEST AND GET REPLY. * CLA RETURN ERROR CODE OF 0. * STA ERRAD,I JMP RTRN,I RETURN. SKP * * MOVE PCB FROM USER ARRAY TO REQUEST BUFFER. * MVPC NOP STA TAGPR POINTER TO PCB. LDA N3 STA CONTR MVP1 LDA TAGPR,I JSB D$STW ISZ TAGPR ISZ CONTR JMP MVP1 JMP MVPC,I * * TEST WHETHER REQUEST FOR 3000 OR REMOTE RTE. * DS3K NOP (A) = ADDR OF USER PCB. ADA K3 BUMP TO LU WORD. STA TEMP LDA #LU3K GET LU OF 3000. INA LDB A,I CPB TEMP,I SAME AS LU IN USER PCB? RSS YES. EXIT VIA P+1. ISZ DS3K NO. EXIT VIA P+2. JMP DS3K,I N SKP * * CONSTANTS AND WORKING STORAGE. * B0 OCT 0 B1 OCT 1 B7 OCT 7 B21 OCT 21 B22 OCT 22 B23 OCT 23 B24 OCT 24 B25 OCT 25 B26 OCT 26 B377 OCT 377 LB10 OCT 4000 K8 DEC 8 K10 DEC 10 K13 DEC 13 N1 DEC -1 N3 DEC -3 N4 DEC -4 N5 DEC -5 N10 DEC -10 N14 DEC -14 N17 DEC -17 N20 DEC -20 N21 DEC -21 N41 DEC -41 N42 DEC -42 N44 DEC -44 CL205 OCT 040315 CL209 OCT 040321 CG210 OCT 000322 CG211 OCT 000323 CL213 OCT 040325 MAXSZ DEC 4096 MAXIMUM USER BUFFER SIZE. RLSIZ ABS -D MAXIMUM # DATA WORDS PER REQUEST. "RF" ASC 1,RF "A" ASC 1,A BIT13 OCT 20000 NOT13 OCT 157777 BLNKS ASC 1, RQPTR NOP BYTCT NOP IPRAM DEF ITAG RPRAM DEF RITAG PPRAM DEF PITAG CPRAM DEF CITAG CNWRD NOP BLKCT NOP TEMP BSS 2 TCNT NOP TBUF NOP * BRKBF DEF *+1 OCT 4006 OCT 0 OCT 22 OCT 0,0,0,0,0 A EQU 0 B EQU 1 TAGPR NOP CONTR NOP BIT15 EQU CONWD XIF * LST * SIZE EQU * * END d  Ui 91741-18017 1740 S C0122 DS/1000 MODULE: FOPEN              H0101 5ASMB,R,L,C HED FOPEN 91741-16017 REV 1740 770317 * (C) HEWLETT-PACKARD CO. 1977 NAM FOPEN,7 91741-16017 REV 1740 770317 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FOPEN,D$RFH * EXT .ENTR,D3KMS,D$INI,D$STW,D$WDC,D$ZRO EXT D$PRM,D$NWD,D$ASC,D$RQB,D$ERR * * FOPEN * SOURCE: 91741-18017 * BINARY: 91741-16017 * JIM HARTSELL * AUG. 7, 1975 * A EQU 0 B EQU 1 * FOPEN NOP ENTRY POINT. LDA DPRAM CLEAR OLD PARAM ADDRESSES. STA ENTRY LDB COUNT CLA STA ENTRY,I ISZ ENTRY INB,SZB JMP *-3 LDA FOPEN STA ENTRY JMP BEGIN COUNT DEC -13 * PRAMS NOP FILE NAME (BYTE ARRAY) NOP FOPTIONS NOP AOPTIONS NOP RECORD SIZE NOP DEVICE SPECS (BYTE ARRAY) NOP FORMS MESSAGE (BYTE ARRAY) NOP # USER LABELS NOP BLOCK FACTOR NOP # BUFFERS NOP FILE SIZE (DBL-WORD) NOP # EXTENTS NOP INITALLOC NOP FILE CODE * ENTRY NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS CLA CLEAR ERROR CODE FOR FCHEK. CLB DST D$ERR * * BUILD THE REQUEST BUFFER. BEGIN WITH SETUP OF * 8-WORD FIXED FORMAT HEADER FOR RFA, THEN "RFA " IN * THE NEXT TWO WORDS. * LDA DPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT AND b"RFA5". * CLA,INA JSB D$STW FOPEN CODE = 1. * * MOVE USER CALL PARAMETERS TO REQUEST BUFFER. * LDA N9 MOVE DUMMY,FOPTN,AOPTN,RECSZ, JSB D$PRM DUMMY,DUMMY,ULABL,BLCKF,NUMBF. * LDA N2 MOVE FILE SIZE JSB D$NWD (DOUBLE-WORD PARAM). * LDA N3 MOVE NUMXT,INALC,FLCOD. JSB D$PRM * * SET UP PARAMETER MASK FOR 13 PARAMS: BIT 12 REPRESENTS THE * FILENAME PARAM; BIT 0 REPRESENTS FILECODE. IF A BIT IS SET, * THAT PARAMETER WAS SPECIFIED IN THE CALLING SEQUENCE. * LDA DPRAM POINTER TO PARAM ADDRESSES. STA TEMP LDA N13 MAX. OF 13 PARAMS. STA TEMP1 CLA,RSS MSK RAL SHIFT ACCUMULATED BITS. LDB TEMP,I SEE IF PARAM GIVEN. SZB IOR B1 YES. SET THE BIT. ISZ TEMP ISZ TEMP1 JMP MSK LOOP FOR 13 PARAMS. STA TEMP SAVE PRELIMINARY MASK. * * FOR ASCII PARAMETERS, CHECK WHETHER A FILLER OF ZERO * WAS GIVEN TO SPECIFY NO PARAMETER. * CLA CLEAR (A) IN CASE PARAM NOT SPECIFIED. CLB INITIALIZE RESET MASK. LDA PRAMS,I GET 1ST WORD OF FILE NAME (ASCII). SZA,RSS LDB B10K NO FILE NAME. SET BIT 12. CLA CLEARED IN CASE NO PARAM. LDA PRAMS+4,I GET 1ST WORD OF DEV NAME. SZA,RSS ADB B400 NO DEV NAME. SET BIT 8. CLA CLEARED IN CASE NO PARAM. LDA PRAMS+5,I GET 1ST WORD OF FORMMSG. SZA,RSS ADB B200 NO FORMMSG. SET BIT 7. CMB COMPLIMENT (B), LDA TEMP GET THE PRELIMINARY MASK, AND B AND CLEAR REQUIRED BITS. * JSB D$STW STORE MASK IN REQUEST. INA STA NBYTS * * MOVE ASCII STRINGS TO REQUEST BUFFER. * CLA CLEAR BYTE POINTERS IN REQUEST. LDB D$RQB ADB D11 STA B,I FILE NAME POINTER. ADB B4 STA B,I DEvV NAME POINTER. INB STA B,I FORMMSG POINTER. * LDA PRAMS CHECK IF FILE NAME SPECIFIED. LDB A,I SZA SZB,RSS JMP SEND NO NAME. LDB D$RQB GET ADDR OF FLNAME BYTE ADB D11 POINTER IN RQBUF. LDA NBYTS REPLACE DUMMY VALUE WITH ADA N1 STA B,I BYTE POINTER TO ASCII STRING. LDA PRAMS MOVE FILE NAME ASCII STRING LDB N14 JSB D$ASC TO REQUEST BUFFER. INA STA NBYTS * LDA PRAMS+4 CHECK IF DEV NAME SPECIFIED. LDB A,I SZA SZB,RSS JMP FRMSG NO NAME. GO CHECK FORMMSG. LDB D$RQB ADB D15 LDA NBYTS REPLACE DUMMY VALUE WITH ADA N1 STA B,I BYTE POINTER TO ASCII STRING. LDA PRAMS+4 MOVE DEVICE NAME. LDB N4 MAX WORDS (NEG). JSB D$ASC INA STA NBYTS * FRMSG LDA PRAMS+5 CHECK IF FORMMSG SPECIFIED. LDB A,I SZA SZB,RSS JMP SEND NO FORMMSG. LDB D$RQB ADB D16 LDA NBYTS REPLACE DUMMY VALUE WITH ADA N1 STA B,I BYTE POINTER TO ASCII STRING. LDA PRAMS+5 MOVE FORMS MESSAGE. LDB N25 MAX WORDS (NEG). JSB D$ASC * * REQUEST BUFFER READY: D3KMS WILL WRITE IT TO QUEX'S * I/O CLASS. USER WILL BE SUSPENDED UNTIL D3KMS'S CLASS GET * IS COMPLETED WHEN THE REPLY ARRIVES. D3KMS WILL RETURN * WITH A-REG = STATUS WORD (FILE NUMBER). * SEND JSB D$WDC STORE WORD COUNT BYTE. * JSB D3KMS SHIP THE REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * AND B377 ISOLATE FILE NUMBER IN A-REG. JMP ENTRY,I RETURN TO USER. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP ENTRY,I FILE NUMBER = 0. SPC 3 * * D$RFH - COMMON SUBROUTINE FOR ALL RFA CALLS TO 3000. * SET UP FRONT END OF REQUEST BUFFER. * D$RFH NOP LDA B7 STORE MESSAGE CLASS = 7. JSB D$STW CLA CLEAR COMPUTER ID. JSB D$STW LDA B20 STORE STREAM TYPE = 20 OCTAL. JSB D$STW LDA N4 CLEAR SUB-STREAM, ETC. JSB D$ZRO LDA N2 FORCE BYTE CNTR TO CLEAR. JSB D$STW LDA "RF" JSB D$STW STORE "RFA ". LDA "A" JSB D$STW JMP D$RFH,I RETURN. SKP * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B4 OCT 4 B7 OCT 7 B20 OCT 20 B377 OCT 377 B200 OCT 200 B400 OCT 400 B10K OCT 10000 D11 DEC 11 D15 DEC 15 D16 DEC 16 N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N9 DEC -9 N13 DEC -13 N14 DEC -14 N25 DEC -25 "RF" ASC 1,RF "A" ASC 1,A BIT15 OCT 100000 NBYTS OCT 0 TEMP NOP TEMP1 NOP * END 5 V_ 91741-18018 2026 S C0122 &D3KMS +              H0101 lASMB,R,L,C HED D3KMS 91741-16018 * (C) HEWLETT-PACKARD CO. NAM D3KMS,7 91741-16018 REV 2026 800502 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D3KMS,PRCNM,D$INI,D$STW,D$PRM,D$ABT ENT D$NWD,D$ASC,D$RQB,ICC,D$ZRO,D$WDC ENT D$ERR,D$INP ENT D$IPM,D$APM,D$NPM,D$SPM,D$SMP,D$LOG SPC 1 EXT .ENTR,EXEC,REIO,IFBRK,IFTTY,#LDEF,LUTRU,LOGLU EXT #QRN,RNRQ,#TBRN,#RSAX,#QXCL EXT CNUMO,.DFER,$LIBR,$LIBX,$OPSY SPC 2 L EQU 304 MAXIMUM LINE BUFFER SIZE. SPC 2 ************************** D3KMS ************************* * * * SOURCE: 91741-18018 * * * * BINARY: 91741-16018 * * * * PROGRAMMER: JIM HARTSELL * * * * AUGUST 11, 1975 * * * *---------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING OCTOBER 30, 1978 * * * ***************************************************************** SPC 3 A EQU 0 B EQU 1 SUP SKP * D3KMS fPROVIDES THE MASTER REQUESTOR WITH AN INTERFACE TO AN * HP3000 REMOTE COMPUTER. ALL REQUESTS ARE SENT TO THE 3000 * LU, AND MPE PROCESS NUMBER, WHICH WERE DEFINED IN THE PREVIOUS * CALL TO HELLO. D3KMS WRITES THE REQUESTS TO THE QUEX I-O CLASS, * WHICH QUEX RETRIEVES VIA CLASS I/O GET CALLS PRIOR TO TRANSMISSION. * D3KMS IS THE COUNTERPART OF THE DS/1000 D65MS SUBROUTINE. * * D3KMS CALLING SEQUENCE: * * JSB D3KMS * DEF *+2 * DEF CONWD CONTROL WORD (SEE BELOW). * RETURN HERE UPON ERROR DETECTION. * NORMAL RETURN. * * ENTRY CONDITIONS: * * CONWD ASSIGN SEND GET DEALLOC * BITS 0-7 CLASS REQ REPLY CLASS * * 0 YES YES YES YES * 1 YES YES YES NO * 2 NO YES YES NO * 3 NO YES YES YES * 4 NO NO NO YES * * BIT 15 - ERROR-RETURN FLAG (NO-ABORT BIT). * BIT 14 - NO TIMEOUT. SPC 1 * * D3KMS ERROR PROCESSING: * * 1. IF SIGN BIT (15) OF CONTROL WORD IS SET, ASCII ERROR CODES * ARE SUPPLIED TO THE CALLER IN THE A & B REGISTERS, UPON * RETURN TO THE POINT IN THE CALLING SEQUENCE. * * 2. IF THE SIGN BIT IS NOT SET, THEN THE CALLER'S PROGRAM IS * ABORTED, AFTER PRINTING AN ERROR MESSAGE ON THE SYSTEM * CONSOLE. THE MESSAGE PRINTED WILL CONTAIN THE ADDRESS OF THE * USER"S RETURN FROM "D3KMS". * * D3KMS ERROR MESSAGES: * * "DS00" - LOCAL SYSTEM IS NOT INITIALIZED SHUT DOWN * "DS01" - DS/3000 LINK NOT INITIALIZED OR SHUT DOWN. * "DS05" - TIMEOUT. * "DS06" - ILLEGAL REQUEST. * "DS07" - "RES" LIST ACCESS ERROR. * * * EXIT CONDITIONS: A-REG = STATUS WORD. * * ICC = -1 IF CCL (01) CONDITION CODE (A LA HP3000) FOR EVERY REPLY. * = 0 IF CCE (10) " * = 1 IF CCG (00) " SKP CONWD NOP CONTROL WORD ADDRESS. * D3KMS NOP ENTRY POINT. V JSB .ENTR OBTAIN DIRECT ADDRESSES DEF CONWD FOR PARAMETERS & RETURN POINT. * CLB CLEAR STB BRFLG BREAK FLAG AND STB OEFLG OUTPUT ERROR FLAG STB PRFLG AND PROMPT FLAG. * LDA $OPSY IS THIS AN RTE-III OR IV? RAR,SLA RSSI RSS YES. JMP CECND NO. LDB RSSI GET "RSS" INSTRUCTION. STB MODI2 MODIFY TO DO CROSS-MAP LOAD. STB MODI3 MODIFY TO DO CROSS-MAP STORE. * CECND LDA CONWD,I GET CONTROL WORD. AND B377 ISOLATE REQUEST CODE. STA RCODE SZA CPA D1 CHECK ENTRY CONDITIONS. JMP NEWRQ NEW REQUEST: ASSIGN MASTER CLASS #. CPA D4 RSS JMP FRMTO USE CURRENT MASTER CLASS #. * JSB CLNUP RELEASE CLASS # ONLY. CLA JMP NEXIT * * A NEW REQUEST IS READY TO GO TO THE HP3000. CHECK FOR * LOCAL SYSTEM SHUT-DOWN OR QUIESCENT STATUS. * (CONTINUATION REQUESTS WILL NOT COME THRU HERE.) * NEWRQ LDA #QRN GET THE QUIESCENT/SHUTDOWN RN. SZA,RSS IS THE SYSTEM SHUT DOWN? JMP DOWN YES. GO TELL CALLER. * * NEW REQUESTS WILL BE FORCED TO WAIT HERE * IF LOCAL SYSTEM HAS BEEN QUIESCED. * JSB RNRQ GO TO RTE TO CHECK FOR QUIESCENCE. DEF *+4 DEF LCGW LOCK/CLEAR/WAIT/NO-ABORT. DEF #QRN SYSTEM-QUIESCENCE RESOURCE NUMBER. DEF TEMP DUMMY PARAMETER. JMP PASER * RTE ERROR - PASS CODE TO CALLER * * LDA #QRN IF QUIESCENT STATE HAS BEEN CHANGED SZA,RSS TO SYSTEM SHUT-DOWN STATE, JMP DOWN THEN TELL THE CALLER. * * * GET A CLASS NUMBER FOR THIS REQUEST. * LDA BIT13 CLEAR CLASS # AND SET BIT 13 STA CLASN FOR NON-RELEASE USAGE. * JSB EXEC GO TO RTE FOR A CLASS NO.---WAIT FOR IT. DEF *+5 DEF CLS19 CLASS CONTROL(QUICK ALLOCATE)- NO ABORT. DEF D0 LU = "BIT BUCK,ET" FOR ALLOCATION. DEF D0 DUMMY PARAMETER. DEF CLASN CLASS NUMBER STORAGE ADDRESS. JMP PASER * RTE ERROR: MESSAGE IN A & B * * JSB EXEC GO TO RTE TO COMPLETE DEF *+5 PREVIOUS ALLOCATION REQUEST. DEF CLS21 CLASS GET - NO ABORT. DEF CLASN CLASS NUMBER STORAGE ADDRESS. DEF D0 DUMMY. DEF D0 DUMMY. JMP PASER * RTE ERROR: MESSAGE IN A & B * * * ADD LOG LU TO REQUEST. * FRMTO JSB LUTRU GET "REAL" LOG DEF *+3 LU NUMBER. DEF D$LOG DEF TEMP LDA TEMP STORE LOG LU IN AND B377 "FROM PROCESS #". ALF,ALF STA RQBUF+4 * * USE MPE PROCESS NUMBER RETRIEVED FROM "HELLO" * AS THE "TO PROCESS #". IF ZERO, THIS MUST BE A HELLO COMMAND. * LDA RQBUF ISOLATE MESSAGE CLASS. AND B377 STA B HOLD IT IN B-REG. LDA D$SMP GET SESSION NUMBER. AND B377 IOR RQBUF+4 STA RQBUF+4 CPB D6 IF NOT HELLO, JMP SEND AND B377 SZA,RSS AND SESSION # IS ZERO, JMP ILRQ IT IS AN ILLEGAL REQUEST. * * VERIFY THAT SMP # IS GOOD BY SEARCHING PNL. CCB ADDR OF PNL HEADER ADDRESS. ADB #LDEF LDB B,I GET ADDR OF FIRST ENTRY. STLST SZB,RSS END OF LIST? JMP NTFND YES. SMP # NOT FOUND. JSB LODWD GET NEXT ADDR. STA NXTAD SAVE NEXT ADDRESS. ADB D2 POINT TO SMP WORD. JSB LODWD LOAD. CPA D$SMP OURS? JMP SEND YES! OK TO SEND. LDB NXTAD GET NEXT ADDR. JMP STLST GO CHECK NEXT ENTRY. * * SMP NOT FOUND IN LIST. (LINE WAS PROBABLY RE-ENABLED.) NTFND STB D$SMP SET SMP # TO 0. JMP ILRQ REPORT ILLEGAL REQUEST. * NXTAD NOP * * WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE IN "RES"; ADD NEW ENTRY. * SEND LDA RQBUF+7 GET BYTE COUNTER. INA  CLE,ERA MAKE WORD COUNT. ADA D8 ADD FIXED FORMAT LENGTH. STA BUFL STORE REQUEST LENGTH. * SEND1 JSB RNRQ CHECK TABLE-ACCESS RN. DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT/NO ABORT. DEF #TBRN TABLE-ACCESS SPACE-AVAILABLE RN. DEF TEMP DUMMY. JMP PASER * RTE ERROR - PASS ERROR CODE TO USER * * LDA CONWD,I RAL,ELA BIT 14 HAS TIMEOUT SUPPRESS FLAG. LDA CLASN RAL,ERA MOVE FLAG TO BIT 15 OF CLASS WORD. STA TEMP * JSB #RSAX GO TO "RES" ACCESS ROUTINE. DEF *+5 DEF D2 ADD A MASTER ENTRY. DEF TEMP CLASS # AND TIMEOUT FLAG. DEF XEQT ID SEGMENT ADDRESS OF USER. DEF D0 DUMMY DESTINATION NODE. SSB ANY ERRORS? JMP RESER * ERROR: "DS07" (NOT LIKELY) * * STA RQBUF+5 STORE SEQ # IN REQUEST. STA SEQ# SAVE LOCALLY. * INB SET "3K" BIT IN MASTER TCB. JSB LODWD IOR BIT14 JSB STRWD * LDA BRFLG IF CONTROL-Y SZA,RSS BREAK IS JMP CLSWR BEING SENT, LDA SEQ# STORE SEQ # IN STA YSEQ#,I CONTROL-Y REQUEST. CLA CLEAR STA BRFLG BREAK FLAG. * * SEND REQUEST TO THE 3000 BY WRITING IT * TO THE I/O CLASS FOR QUEX. * CLSWR LDA #QXCL GET QUEX I/O CLASS. SZA,RSS JMP NINIT DS/3000 NOT INITIALIZED. SSA JMP NINIT DS/3000 DISCONNECTED. * JSB EXEC CLASS WRITE TO QUEX. DEF *+8 DEF CLS20 DEF D0 DEF RQBUF DEF BUFL DEF BUFL PASS LENGTH FOR "GET" (WORDS). DEF D0 DEF #QXCL QUEX I/O CLASS. JMP PASER * RTE ERROR - PASS CODE TO CALLER * * LDA BRFLG WAS A "BREAK" SENT? SZA,RSS JMP WAIT NO. LDA D4 YES. EXIT WITH CLEAN-UP. STA RCODE [JMP EXIT * * ISSUE A CLASS GET TO USER'S CLASS TO WAIT FOR A REPLY. * USER WILL BE SUSPENDED UNTIL REPLY ARRIVES. * WAIT LDA RQSIZ CMA,INA STA BUFL * JSB EXEC GO TO RTE TO GET THE REPLY. DEF *+5 DEF CLS21 CLASS GET - NO ABORT. DEF CLASN MASTER CLASS NO. -- NO RELEASE. DEF RQBUF REPLY ADDRESS. DEF BUFL REPLY LENGTH. JMP PASER * RTE ERROR: MESSAGE IN A & B * * * CHECK FOR PROPER REPLY. * SZB,RSS CHECK FOR ZERO REPLY LENGTH. JMP MTOER YES. GO PROCESS TIMEOUT ERROR. * LDA RQBUF+2 CHECK REJECT BIT. RAL SSA JMP ILRQ REQUEST REJECTED. * * GO CHECK IF A $STDLIST OR $STDIN WAS RECEIVED. IF NOT, * CONTROL WILL BE RETURNED. IF YES, THE MASTER-LIST ENTRY WILL * BE CLEARED, THE PRINT OR READ WILL BE PROCESSED, A REPLY WILL BE * BUILT, AND CONTROL WILL GO TO "SEND". * JSB PRTRD GO CHECK FOR PRINT/READ REQUEST. * * DE-ALLOCATE THE USER'S CLASS NUMBER IF RCODE = 0 OR 3 OR 4, * AND RELEASE MASTER LIST ENTRY IN "RES". * EXIT JSB CLNUP GO CLEAN UP BEFORE EXIT. * * STORE CONDITION CODE IN ICC AND RETURN TO * CALLER WITH (A) = STATUS WORD. * LDB OEFLG WAS THERE AN OUTPUT ERROR? SZB JMP PSER1 YES! LDA RQBUF+8 ALF,ALF AND D3 IF CC IS: SET ICC TO: CPA D1 CCB 01 (CCL) -1 CPA D2 CLB 10 (CCE) 0 CPA D0 CLB,INB 00 (CCG) +1 LDA RCODE DON'T CHANGE ICCC IF RCODE = 2. CPA D2 RSS STB ICCC * LDA RQBUF+8 NEXIT ISZ D3KMS SET EXIT POINTER FOR NORMAL RETURN. JMP D3KMS,I RETURN. (A) = STATUS WORD. SKP * * SUBROUTINE TO PROCESS $STDLIST OR $STDIN "REQUESTS" THAT * MAY HAVE BEEN RECEIVED AS A "REPLY" FROM THE 3000. * PRTRD NOP LDA RQBUF AND B377 CHECK FOR MESSAGE CLASS 5 CPA D5 ($STDLIST, $STDIN, OR $STDIX). RSS JMP PRTRD,I NOT PRINT/READ. RETURN. LDA RQBUF+2 SSA CHECK IF IT IS A REQUEST. JMP PRTRD,I NO... REPLY, SO LET IT THROUGH. * LDA RQBUF+2 GET STREAM WORD. AND B77 ISOLATE STREAM TYPE. CPA B20 JMP MESG STREAM 20 IS $STDLIST "REPLY". CPA B21 STREAM 21 IS $STDIN "REQUEST". JMP STDIN CPA B23 IF NOT FCONTROL, RSS JMP PRTRD,I JUST IGNORE. SPC 2 * * FCONTROL REQUEST. SEE IF IT'S ONE WE CAN REALLY ACT UPON. * LDA RQBUF+9 CHECK FOR VALID FUNCTIONS. CPA D39 FCONTROL 39-- JMP SETYP SET TERMINAL TYPE. CPA D41 FCONTROL 41-- JMP RDSTP READ STRAPS. * SETPR LDA RQBUF+10 MOVE PARAM STAPN STA RQBUF+9 WORD. LDA D4 SET BYTE STA RQBUF+7 LEN WORD. JMP NEXT1 * * * FUNCTION 39 * SETYP JSB IFTTY SET TERMINAL TYPE BY DEF *+2 CHECKING RTE DRIVER DEF D$LOG TYPE. SZA,RSS NON-INTERACTIVE. JMP STAPN RETURN TYPE=0. LDA B IF DRIVER ALF,ALF IS 5 AND B77 CLB CPA D5 LDB D10 USE 10. CPA D7 IF 7 (MULTIPOINT), LDB D14 USE 14. LDA B (OTHERWISE USE 0.) JMP STAPN STORE IN APPENDAGE. * * FUNCTION 41 * ON MPE THIS SETS UNEDITED TERMINAL MODE. * FOR RTE, TELL DRIVER TO CHECK TERMINAL STRAPS. * RDSTP JSB IFTTY IF INPUT DEF *+2 LU IS NOT DEF D$INP INTERACTIVE, SSA,RSS JMP SETPR JUST REPLY. * LDA B ISOLATE ALF,ALF TERMINAL AND B377 TYPE. CPA D5 IF NOT TYPE 5, RSS JMP SETPR JUST REPLY. * LDA D$INP MAKE I/O CONTROL AND B77 IOR B700 REQUEST 7, STA CNWRD F> WHICH CLEARS STATUS JSB EXEC BIT 3 FOR A NORMAL DEF *+3 DV.05 TERMINAL, DEF SD3 BUT SETS IT FOR MUX. DEF CNWRD NOP JSB EXEC GET STATUS WORD. DEF *+4 DEF D13 DEF D$INP DEF TEMP LDB B2500 ASSUME IT'S NORMAL. LDA TEMP ISOLATE BIT AND B40 3 OF STATUS. SZA IF IT'S SET LDB B3200 TERMINAL IS A MUX. LDA D$INP SET UP CONTROL WORD AND B77 IOR B TO READ STRAPS. STA CNWRD JSB EXEC TELL DRIVER DEF *+3 TO CHECK DEF SD3 THE STRAPS. DEF CNWRD JSB OERR (ABORT RETURN.) JMP SETPR SEND REPLY. SKP * * WE HAVE A REQUEST FROM THE HP3000 FOR INPUT FROM A * USER TERMINAL (PREVIOUS $STDLIST SHOULD HAVE * PROVIDED A PROMPT MESSAGE OR CHARACTER). * STDIN JSB #RSAX CLEAR CURRENT MASTER LIST ENTRY. DEF *+3 DEF D6 DEF SEQ# * * CHECK WHETHER WE NEED TO REWRITE PREVIOUS $SDTLIST BY CHECKING: * D$INP <> D$LOG AND PROPMT FLAG = TRUE AND D$INP IS INTERACTIVE. LDA D$INP IF D$INP = XOR D$LOG D$LOG, AND B77 JMP RDLIN GO READ. LDA PRFLG IF PROMPT SZA,RSS IS ZERO, JMP RDLIN GO READ. JSB IFTTY IF D$INP DEF *+2 IS NOT DEF D$INP INTERACTIVE, SZA,RSS JMP RDLIN GO READ. * LDA D$INP SET "ECHO INPUT" & IOR B600 "PRINT COL 1" BITS. STA CNWRD JSB REIO REPEAT DEF *+5 PROMPT DEF SD2 ON DEF CNWRD INPUT DEF ORCRD DEVICE. DEF OLDLN NOP IGNORE ERRORS. CLA CLEAR PROMPT STA PRFLG FLAG. * RDLIN LDA RQBUF+10 GET PARAMETER WORD. AND B100 IF "SPECIAL READ" SZA,RSS BIT ISN'T SET`, JMP DOREA GO DO THE READ. * * FOR SPECIAL BLOCK MODE READ, DO A DUMMY READ AND HOME THE CURSOR. * LDA D$INP STORE LU IN CNWRD AND B77 STA CNWRD WITHOUT FUNCTION BITS. STA RQBUF+10 INSURE 1ST CHAR ISN'T ESC. JSB EXEC DUMMY READ. DEF *+5 DEF SD1 DEF CNWRD DEF RQBUF+10 DEF RQBUF+8 CLB * LDA RQBUF+10 IF 1ST CHAR IS AND UP377 ESCAPE, ASSUME CPA ESC BUFFER IS FROM SOFT JMP GTRLN KEY. USE IT! * JSB EXEC HOME CURSOR DEF *+5 AND RE-READ DEF SD2 THE SCREEN. DEF CNWRD DEF HCENT DEF N5 NOP * DOREA JSB REIO READ FROM USER TERMINAL. DEF *+5 DEF SD1 DEF CNWRD DEF RQBUF+10 DEF RQBUF+8 (+ = WORDS, - = BYTES) CLB INPUT ERROR: SET B:=0. * GTRLN LDA RQBUF+8 (B) = POS. BYTES OR POS. WORDS INPUT. SSA,RSS IF $STDIN SPECIFIED POS. WORDS, BLS MAKE (B) = POS. BYTES. * LDA B IF # BYTES IS ADA N3 SSA,RSS ONE OR TWO, JMP REPLY LDA RQBUF+10 AND INPUT WORD = BLANKS, CPA BLNKS CLB SET 0-LEN REPLY MESSAGE. * REPLY ADB D4 COUNT CONTROL & LENGTH WORDS. STB RQBUF+7 STORE TOTAL REPLY BYTE LENGTH. * ADB N4 RESTORE POS. BYTE LEN OF INPUT. LDA RQBUF+8 SSA IF $STDIN SPECIFIED NEG. BYTES, CMB,INB,RSS MAKE (B) = NEG. BYTES, BRS ELSE MAKE (B) = POS. WORDS. STB RQBUF+9 STORE NEG. BYTE OR POS. WORD COUNT. * CLB,INB STORE STATUS WORD. STB RQBUF+8 * JSB D$WDC STORE WORD COUNT IN REPLY. * LDA RQBUF+2 SET REPLY BIT IN STREAM WORD. IOR BIT15 STA RQBUF+2 * LDA RQBUF+4 REVERSE "FROM & TO" PROCESS #'S. ALF,ALF STA RQBUF+4 * `D JSB BRKCK CHECK FOR OPERATOR BREAK. JMP BREAK YES. GO BUILD BREAK REQUEST. JMP SEND NONE. SEND $STDIN REPLY. * * WE HAVE A REPLY MESSAGE FROM THE HP3000. * DISPLAY ON USER-SPECIFIED LOG DEVICE. * MESG LDA OEFLG SKIP OUTPUT SZA IF OUTPUT ERROR JMP NEXT FLAG IS SET. STA SKIP CLEAR SKIP FLAG. LDA RQBUF+7 GET BYTE LENGTH. ADA N4 OMIT CONTROL WORDS FROM COUNT. CMA,INA NEGATE MESSAGE BYTE LENGTH. STA BUFL SAVE NEGATIVE LENGTH. * * CHECK FOR SPECIAL BLOCK MODE FOR MULTIPOINT. LDA RQBUF+9 ISOLATE "SPECIAL BLOCK AND B100 MODE" INDICATION BIT. SZA,RSS IF NOT SET, JMP REGWR IT'S A REGULAR WRITE. * JSB IFTTY GET TERMINAL DEF *+2 TYPE. DEF D$LOG LDA B ALF,ALF AND B377 IF IT'S TYPE CPA D7 7 (MULTIPOINT), RSS JMP REGWR LDA B100 SET 100B BIT JMP DOWRT IN CONTROL WORD. * REGWR LDA RQBUF+8 GET FORMS CONTROL WORD. AND B377 JSB CNTRL PROCESS FORMS CONTROL. * LDA B600 SET "ECHO INPUT" & DOWRT IOR D$LOG "PRINT COL 1" BITS. STA CNWRD JSB REIO DISPLAY THE MESSAGE. DEF *+5 DEF SD2 DEF CNWRD BUFA DEF RQBUF+10 DEF BUFL JSB OERR OUTPUT ERROR. * * SAVE OUTPUT LINE FOR POSSIBLE RE-PROMPT. * LDA BUFL IGNORE SZA,RSS WRITES WITH JMP NEXT NO DATA. STA OLDLN SAVE LENGTH. CMA,INA GET INA POSITIVE CLE,ERA NUMBER STA TEMP OF WORDS. ADA N40 DON'T SSA LET JMP MVBUF LENGTH LDA N80 GO STA OLDLN OVER CMA,INA 40. CLE,ERA STA TEMP MVBUF LDA BUFA MOVE LDB @ORCD THE MVW TEMP BUFFNER. CCA PROMPT FLAG STA PRFLG := TRUE. * LDA SKIP IF SKIP-LINE-AFTER-PRINT SZA,RSS FLAG IS SET, JMP NEXT * JSB REIO PRINT A BLANK DEF *+5 LINE. DEF SD2 DEF D$LOG DEF BLNKS DEF N1 JSB OERR OUTPUT ERROR. CLA CLEAR SKIP FLAG. STA SKIP * * BUILD A REPLY FOR THE $STDLIST REQUEST. * NEXT LDA D2 SET BYTE COUNT = 2. STA RQBUF+7 NEXT1 LDA RQBUF+2 SET REPLY BIT. IOR BIT15 STA RQBUF+2 LDA RQBUF+4 REVERSE PROCESS NUMBERS. ALF,ALF STA RQBUF+4 AND B377 IF NO REPLY TO BE SENT, SZA,RSS JMP WAIT GO WAIT FOR REAL REPLY. * JSB #RSAX CLEAR CURRENT MASTER LIST ENTRY. DEF *+3 DEF D6 DEF SEQ# * LDA CCE STORE STATUS WORD. STA RQBUF+8 JSB D$WDC STORE WORD COUNT. CLA STA APEND * JSB BRKCK CHECK FOR OPERATOR BREAK. JMP BREAK YES. GO BUILD BREAK REQUEST. JMP SEND NONE. SEND $STDLIST REPLY. * SKIP NOP SKIP-AFTER-PRINT FLAG. B23 OCT 23 B100 OCT 100 B700 OCT 700 B2500 OCT 2500 B3200 OCT 3200 D10 DEC 10 D14 DEC 14 D39 DEC 39 D41 DEC 41 N5 DEC -5 ESC BYT 33,0 ESCAPE CHARACTER. * ESCAPE CODES TO HOME CURSOR AND ENTER DATA (WITHOUT CARRIAGE RETURN) HCENT BYT 33,110,33,144,137 SKP * * ADD BREAK OR CONTROL Y REQUEST TO END OF $STDLIST/$STDIN * REPLY BEFORE SENDING TO QUEX. (P.PTR POINTS TO WHERE TO * START BUILDING THIS ADDITIONAL REQUEST.) * BREAK STB BRFLG SAVE STREAM TYPE FROM "BRKCK". LDA RQBUF+7 SAVE BYTE COUNT FROM 1ST BLOCK. STA TEMP2 INA SET P.PTR TO END OF REPLY. CLE,ERA ADA D8 ADA D$RQB STA P.PTR LDA MSGCL STORE WDCNT/MESSAGE CLASS. JSB D$STW CLA JSB D$STW LDA BRFLG ST/ORE STREAM TYPE. JSB D$STW CLA JSB D$STW LDA RQBUF+4 STEAL "FROM/TO" FROM 1ST BLOCK. JSB D$STW LDA P.PTR SAVE CONTROL-Y STA YSEQ# SEQ # ADDR. JSB D$STW CLA JSB D$STW CLA STA P.PTR,I CLEAR BYTE COUNT WORD. LDA TEMP2 RESTORE BLOCK 1 BYTE COUNT. STA RQBUF+7 * ISZ P.PTR SET UP BUFL FOR CLASS WRITE. LDA D$RQB CMA,INA ADA P.PTR STA BUFL * LDA BRFLG CPA B25 GO WRITE TO QUEX: JMP SEND1 CONTROL-Y INCLUDES MASTER TCB. JMP CLSWR BREAK DOESN'T. * MSGCL OCT 4006 YSEQ# NOP SKP * * SUBR. TO MAP HP3000 MPE FORMS CONTROL TO RTE. * (A) = FORMS CONTROL WORD. * CNTRL NOP STA TEMP FORMS CONTROL WORD. CPA B60 IF OCTAL 60, JMP DBLSP GO SET DOUBLE SPACE. AND B300 SKIP N CPA B200 LINES? JMP SKIPN YES. JSB IFTTY IF LU DEF *+2 TYPE IS DEF D$LOG NON-INTERACTIVE, SZA,RSS JMP CNTRL,I DON'T TRY OTHER CONTROLS. LDA TEMP GET CONTROL WORD. CPA B320 IF OCTAL 320, JMP BKARR GO DO BACK-ARROW THING. JMP CNTRL,I NEITHER. RETURN. * * SKIP N LINES VIA I-O CONTROL CALL. * SKIPN LDA TEMP AND B77 SZA ADA N1 RTE WILL SKIP 1 LINE DURING WRITE. SZA,RSS IF N WAS 0 OR 1, JMP CNTRL,I EXIT! STA TEMP IPRAM FOR I/O CONTROL (# OF LINES) * LDA D$LOG IOR FCN11 STA CNWRD CONTROL WORD WITH FUNCTION CODE. * JSB EXEC I/O CONTROL CALL. DEF *+4 DEF SD3 DEF CNWRD CONTROL WORD. DEF TEMP IPRAM. JSB OERR OUTPUT ERROR. * JMP CNTRL,I RETURN. * * INSERT A BACK-ARROW AS LAST CHAR. IN MESSAGE. * BKARR LDB BUFL CMB,INB POSITIVE # MESSAGE BYTES. CLE,jERB E SET IF ODD # BYTES. ADB BUFA ADDR OF WORD FOR BACK-ARROW. * LDA B,I CLEAR DESTINATION BYTE. SEZ,RSS ALF,ALF AND HB377 * IOR "_" INSERT BACK ARROW. SEZ,RSS ALF,ALF STA B,I * LDA BUFL INCR NEG. BYTE COUNT BY 1. ADA N1 STA BUFL * JMP CNTRL,I RETURN TO DISPLAY SECTION. * * SET FOR DOUBLE SPACE AFTER PRINT. * DBLSP STA SKIP SET SKIP-LINE-AFTER-PRINT FLAG. JMP CNTRL,I RETURN. * B60 OCT 60 B600 OCT 600 B320 OCT 320 B300 OCT 300 B200 OCT 200 CNWRD NOP FCN11 OCT 1100 "_" OCT 137 SKP * * SUBROUTINE TO TEST AND SERVICE OPERATOR BREAK. * BRKCK NOP LDA OEFLG OUTPUT ERROR SZA FLAG SET? JMP BRK1 YES--IGNORE BREAK CHECK. JSB IFBRK DEF *+1 SZA,RSS HAS THERE BEEN A BREAK? JMP BRK1 NO. TAKE "NO-BREAK" RETURN. * LDA D$INP SET "ECHO INPUT" & IOR B600 "PRINT COL 1" BITS. STA CNWRD JSB REIO DISPLAY DEF *+5 "ENTER CONTROL REQ. (B OR Y)". DEF SD2 DEF CNWRD DEF CMSG DEF D13 JMP BRK1 OUTPUT ERROR. * JSB REIO READ OPERATOR RESPONSE. DEF *+5 DEF SD1 DEF CNWRD DEF INBUF DEF D2 JMP BRK1 INPUT ERROR. * LDA INBUF TEST RESPONSE. AND HB377 ALF,ALF LDB B22 CPA "B" JMP BRKCK,I BREAK. LDB B25 CPA "Y" JMP BRKCK,I CONTROL Y. * JSB REIO NEITHER: DEF *+5 DISPLAY "INVALID INPUT" DEF D2 DEF CNWRD DEF ILMSG DEF D7 * BRK1 ISZ BRKCK SET "NO-BREAK" RETURN. JMP BRKCK,I * CMSG ASC 13,ENTER CONTROL REQ (B OR Y) ILMSG ASC 7,INVALID INPUT "B" OCT 102 "Y" OCT 131 SKP * SUBROUTINE TO RELEASE THE MASTER CLASS AND CLEAR MASTER-LIST E?@NTRY. * CLNUP NOP ENTRY/EXIT. CPA "DS" JMP CLASS CLEAR ALL FOR ABORTIVE ERROR. LDA RCODE CPA D1 JMP CLRES KEEP CLASS #. CPA D2 JMP CLRES KEEP CLASS #. * CLASS LDA CLASN GET THE CLASS NUMBER. CCE,SZA,RSS IF CLASS NUMBER NEVER ASSIGNED, JMP CLNUP,I RETURN NOW. * RAL,ERA INCLUDE THE NO-WAIT BIT (#15), STA CLASN AND SAVE FOR RELEASE. CREPT CCA SET THE RELEASE RE-TRY SWITCH STA TEMP TO -1. * CLRTN JSB EXEC GO TO RT TO RELEASE CLASS NUMBER. DEF *+5 DEF CLS21 SPECIFY CLASS GET - NO ABORT. DEF CLASN MASTER CLASS/RELEASE/NO WAIT. DEF D0 DUMMY BUFFER ADDRESS. DEF D0 DUMMY BUFFER LENGTH. RSS IGNORE ERRORS. * ISZ TEMP RELEASE PROCESSING COMPLETED? JMP CLRES YES. GO TO CLEAR THE "RES" ENTRY. INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP CREPT NO. CONTINUE TO CLEAR REQUESTS. * LDA CLASN GET THE CLASS NUMBER AGAIN. AND CLMSK EXCLUDE THE NO-DE-ALLOCATION BIT (13). STA CLASN RESTORE THE MODIFIED CLASS WORD. JMP CLRTN RETURN FOR FINAL DE-ALLOCATION. * CLRES JSB #RSAX GO TO "RES" ACCESS ROUTINE. DEF *+3 DEF D6 CLEAR A LIST ENTRY. DEF SEQ# SEARCH, USING SEQUENCE NUMBER. * LDB RCODE IF RCODE = 1 OR 2, KEEP CLASS #. CPB D1 JMP CLNUP,I CPB D2 JMP CLNUP,I * CLA STA CLASN JMP CLNUP,I RETURN. * CLMSK OCT 117777 CLASS NUMBER MASK. SKP * * ERROR PROCESSING SECTION. * DOWN LDB "00" SYSTEM IS SHUT-DOWN: "DS00". JMP GETDS NINIT LDB "01" DS/3000 LINK NOT INITIALIZED. JMP GETDS MTOER LDB "05" MASTER REQUEST TIMEOUT: "DS05". JMP GETDS ILRQ LDB "06" ILLEGAL REQUEST. JMP GETDS RESER LDB "07" "RES" QLIST-ACCESS ERROR: "DS07". JMP GETDS * GETDS LDA "DS" GET FIRST HALF OF ERROR MESSAGE: "DS". * PASER DST MSGBF SAVE TOTAL ERROR MESSAGE. * JSB CLNUP GO TO CLEAN UP BEFORE EXITING. (A)="DS". * PSER1 LDB MSGAD POINTS TO ERROR MESSAGE ADDRESS. LDA CONWD GET ERROR-RETURN FLAG. ELA POSITION TO FOR TESTING. LDA D3KMS GET ERROR ADDRESS SEZ ABORT OR RETURN TO CALLER? JSB D$ABT ABORT! - NO RETURN. LDA N1 SET CONDITION CODE TO CCL. STA ICCC DLD MSGBF GET ERROR CODES AND RETURN TO JMP D3KMS,I THE CALLER AT ERROR-RETURN POINT. SPC 3 * * OUTPUT ERROR WAS DETECTED * OERR NOP DST MSGBF SAVE ERROR MESSAGE. STA OEFLG SET OUTPUT ERROR FLAG. JMP OERR,I RETURN. SKP * SUBROUTINE TO HANDLE ABORT MESSAGES. * * A REG = SUSPEND OR ABORT ADDRESS. * B REG = ADDRESS OF 4 CHAR ERROR MESSAGE. * JSB D$ABT (DOES NOT RETURN TO CALLER) * D$ABT NOP STA ERCD SAVE ABORT ADDRESS. DLD B,I GET ERROR MESSAGE. DST MSG SAVE ERROR MESSAGE. * JSB CNUMO CONVERT ERROR ADDRESS TO OCTAL. DEF *+3 DEF ERCD DEF ERCD * LDA 1717B GET ADDRESS OF ID SEGMENT. ADA D12 GET TO NAME ADDRESS. STA TEMP SAVE ADDRESS FOR XFER. JSB .DFER MOVE NAME INTO AREA. MSGA DEF AMSG DESTINATION ADDRESS. DEF TEMP,I SOURCE ADDRESS. * JSB .DFER MOVE NAME FOR DS ERROR MESSAGE. DEF PNAM1 DESTINATION ADDRESS. DEF TEMP,I SOURCE ADDRESS. LDB MSGA MOVE A SPACE LAST CHAR OF NAME. ADB D2 LDA B,I AND UP377 IOR B40 STA B,I SAVE IT AGAIN. STA LNAM SAVE FOR LINE 1 ERROR. * LDA D$LOG SET "ECHO INPUT" & IOR B600 "PRINT COL 1" BITS. STA CNWRD JSB EXEC SEND 2`x-LINE ERROR/ABORT MESSAGE. DEF *+5 DEF D2 DEF CNWRD LOG DEVICE GIVEN FOR HELLO CALL. DEF MSG DEF D18 * JSB EXEC TERMINATION REQUEST. DEF *+2 NO RETURN. DEF D6 SPC 1 MSG ASC 3,DS PNAM1 ASC 2, LNAM ASC 1, ERCD ASC 3, BYT 15,12 CR/LF AMSG ASC 8, ABORTED D6 DEC 6 B40 OCT 40 D12 DEC 12 D18 DEC 18 UP377 OCT 177400 SPC 3 * * FUNCTION FOR RETRIEVAL OF CONDITION CODE. * ICC NOP LDA ICC,I SET RETURN ADDRESS. STA ICC LDA ICCC FETCH CONDITION CODE. JMP ICC,I RETURN. SPC 3 * * SUBROUTINE TO STORE CURRENT PROCESS NUMBER. * * JSB PRCNM * DEF *+2 * DEF ISMP NEGATIVE PROCESS NUMBER. * ISMP NOP PRCNM NOP JSB .ENTR GET ADDRESS OF PROCESS NUMBER. DEF ISMP * LDA ISMP,I GET NEGATIVE PROCESS NUMBER. CMA,INA MAKE POSITIVE. STA D$SMP STORE AS CURRENT PROCESS #. * JSB LOGLU GET TERMINAL'S LU. DEF *+2 DEF TEMP STA D$LOG SAVE AS $STDLIST AND STA D$INP $STDIN DEVICES. * JMP PRCNM,I RETURN. SPC 3 * * SUBROUTINE TO LOAD FROM ALTERNATE MAP. * LODWD NOP MODI2 LDA B,I (RSS IF DMS SYSTEM) JMP LODWD,I XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I * * SUBROUTINE TO STORE INTO ALTERNATE MAP. * STRWD NOP JSB $LIBR NOP MODI3 STA B,I (RSS IF DMS SYSTEM) JMP OUT XSA B,I STORE WORD INTO ALTERNATE MAP. OUT JSB $LIBX DEF STRWD SKP * * INITIALIZE BUFFER STUFFING ROUTINES. * CALLING SEQUENCE: LDA