FTN,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 PREVENT 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 MAP(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 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 C 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 NAM 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 FOR 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 SEGMENT ? 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 LONG 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 BUMP 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 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 THE 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 .SMEM 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. 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 ITS 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 DESCRIPTION[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 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