ASMB,R,Q,C NAM WHZAT,17,1 91750-16217 REV 2013 791219 * * **************************************************************** * * (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. * * **************************************************************** * HED WHZAT FOR RTE-IV * * NAME: WHZAT * SOURCE: 91750-18217 * RELOC: 91750-16217 * PRGMR: E.J.W.,D.B. * SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,$TIME,$RNTB,$CLAS,TMVAL EXT $ELTB EXT $MATA,$MNP EXT DEXEC,#CNOD,#NODE * A EQU 0 B EQU 1 * EQTA EQU 1650B EQT# EQU 1651B DRT EQU 1652B LUMAX EQU 1653B KEYWD EQU 1657B * * *THE FOLLOWING IS A SAMPLE OUTPUT OF THIS PROGRAM: * RU,WHZAT,LU,AL * * * *13:37: 1:770 *------------------------------------------------------------------------ * PRGRM T PRIOR PT SZ DO.SC.IO.WT.ME.DS.OP. .PRG CNTR. .NEXT TIME. *------------------------------------------------------------------------ ***FMG73 3 00051 22 10 * * * * 3,WHZ73 * * * * * P:42274 * WHZ73 3 00001 13 4 . 1, . . . . . . . . . . . P:37045 *. *. ***FMG18 3 00051 20 10 * * * * 3,REA18 * * * * * P:42274 * REA18 3 00090 9 16 . . . 2,EQ: 8,AV:2,ST:004 P:61106 ***FMG66 3 00051 14 10 * * * * 3,EDI66 * * * * * P:42274 * EDI66 3 00051 21 7 . . . 2,EQ: 12,AV:2,ST:002 P:42704 ***FMG78 3 00051 29 10 * * * * 3,SNGGN * * * * * P:42274 * SNGGN 3 00099 18 14 . . . 2,EQ: 23,AV:2,ST:002 P:52640 ***FMG84 3 00051 41 10 * * * * 3,EDI84 * * * * * P:42274 * EDI84 3 00051 36 15 . . . 2,EQ: 30,AV:2,ST:002 P:45055 ***FMG70 3 00051 32 10 * * * * 3,EDI70 * * * * * P:42274 * EDI70 3 00051 35 15 . . . 2,EQ: 15,AV:2,ST:002 P:45055 ***FMG74 3 00051 31 10 * * * * 3,SHE74 * * * * * P:42274 * SHE74 3 00051 27 14 . . . 2,EQ: 19,AV:2,ST:002 P:55304 *. * R$PN$ 1 00010 0 . . . . . 3,CL 025 . . . . P:41016 * UPLIN 1 00003 0 . 0, . . . . . . . . . . . . P:00000 13:37: 4:120 * GRPM 1 00004 0 . . . . . 3,CL 039 . . . . P:45600 * RTRY 1 00020 0 . . . . . 3,CL 038 . . . . P:46366 * SPOUT 2 00011 4 3 . . . . 3,CL 024 . . . . P:34250 * LOGON 3 00049 30 11 . . . . 3,CL 026 . . . . P:35616 * LGOFF 3 00051 40 9 . . . . 3,CL 027 . . . . P:35133 * QCLM 3 00028 20 2 . . . . 3,CL 037 . . . . P:34045SWP * DLIST 3 00030 13 3 . . . . 3,CL 036 . . . . P:37113SWP * PROGL 3 00030 29 5 . . . . 3,CL 030 . . . . P:34065SWP * RFAM 3 00030 30 8 . . . . 3,CL 032 . . . . P:47203SWP * EXECM 3 00030 21 3 . . . . 3,CL 033 . . . . P:34054SWP * EXECW 3 00030 20 2 . . . . 3,CL 035 . . . . P:35614SWP * OPERM 3 00030 20 2 . . . . 3,CL 031 . . . . P:35377SWP * PTOPM 3 00030 47 2 . . . . 3,CL 034 . . . . P:34052 * FMG81 3 00051 45 10 . . . 2,EQ: 27,AV:2,ST:002 P:52220 *------------------------------------------------------------------------ *ALL LU'S OK *ALL EQT'S OK *LOCKED LU'S (PROG NAME) 8(REA18), *MAX CONT. FREE TRKS : 127, LU 3 *------------------------------------------------------------------------ *13:37: 2:170 * * * * FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-IVB * RU,WHZAT,LU,PA * * 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 16 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 WHAT XLA B,I RAL CHECK IF ASCHII SSA JMP WHASC YES,TREAT THIS AS SECOND PARAMETER INB RAR RESTORE A REGISTER CLE,SZA,RSS SCHED W PRAM ? CLA,CCE,INA NO-DEFAULT TO LU 1 WHT0 STA CRTLU SAVE LU FOR OUTPUT XLA B,I STA PARM2 SAVE SECOND PARAMETER INB XLA B,I GET SPECIAL LU PARAM INB STB PARMA SAVE PARAMETER ADDRESS ISZ PARMA & UPDATE FOR PARM 5 SZA NON ZERO NODE SPECIFIED JMP CONT YES, JUST CONTINUE XCA B,I NO, FLAG WAS SET JSB PANOD CONT CPA M1 -1 WAS SPECIFIED LDA #NODE YES, THEN GET THE LOCAL NODE STA DNODE SAVE NODE FOR EXEC CALLS XLA PARMA,I GET SPECIAL LU PARAM SZA,RSS IN CASE OF PREV RUN LDA CRTLU SEZ DEFAULT NEEDED? STA CRTLU YES INB PICK UP THE XLB B,I SESID FROM LAST TIME STB SESID AND SAVE FOR NOW IF NEEDED JMP WHT1 * WHASC CLE CLA,INA CRTLU = 1 JMP WHT0 * SPC 2 WHT1 LDA .EOF SEND BLANK LINE LDB DM6 JSB PRINT USE STD PRINT SUB JSB TOD PRINT TIME-OF-DAY AS NEXT LINE LDA DNODE IF WE WERE RUNNING REMOTELY CPA #NODE PRINT PROGRAM AND NODE ID RSS JSB PGID JSB DASHS ERASE EOL + A LINE OF DASHES * LDA PARM2 CPA "PA" PARTITION REPORT REQUEST ? JMP WHATP YES. * LDA .HEAD GET THE HEAD LDB DM76 AND JSB PRINT PRINT IT JSB DASHS PRINT A LINE * LDA NAMSB CLEAR THE ID STACK STA NAMST (STACK OF PROCESSED ID'S) STA DLKFL SET THE DEAD LOCK FLAG * LDA PARM2 GET THE SECOND PARAMETER CPA "AL" IF ALL CODED,THEN GO REPORT ALL JMP FULL * CPA "SM" ALMOST ALL ? JMP FULL YES, GO DO IT. * LDA XEQT GET CURRENT SESSION ADD ADA D32 XLA A,I FROM THE ID SZA IF NOT ZERO STA SESID SAVE IT LDA SESID WELL, WHAT DO WE HAVE ?? SZA,RSS IF ZERO JMP FULL1 REPORT ALL ACTIVE PROGRAMS JMP SES * FULL EQU * LDA XEQT GET THE SESSION ADDRESS AGAIN ADA D32 XLA A,I SZA,RSS IF ZERO,NON SESSION JMP FULL1 ZERO SO REPORT ALL THE PROGRAMS * STA SESID SAVE IT JSB DOIT DISPLAY THE SESSION RELATED PROGRAMS FIRST JSB ODTSP OUTPUT AN ADDITIONAL LINE * FULL1 CLA NOW DISPLAY REST OF THE PROGRAMS STA SESID JSB DOIT YES, DO IT JMP FINIS EXIT * SES EQU * JSB DOIT DISPLAY ONLY SESSION RELATED PROGRAMS JMP FINIS * * * SUBROUTINE DO IT * DOIT NOP CLA STA IDCNT SET UP TO START THE ID SCAN STA ALL * * NXSES LDA KEYWD START THE SCAN ADA IDCNT GET KEY WORD ADDRESS XLA A,I GET THE ID ADDRESS 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 XLB A,I GET FLAG WORD BLF,BLF ROTATE IT AROUND BLF,SLB,BLF WELL?? JMP FINX YES END OF USEFUL ID'S * INA CHECK IF ID IS IN USE XLB A,I GET STATUS SZB ZERO DORMANT JMP NOTDM NOT DORMANT CONSIDER IT * ADA D2 GET THE TIME LIST WORD XLB A,I GOT IT 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 XLA A,I GET THE WORD 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 XLA B,I GET FATHER POINTER RAL POSITION THE BIT SSA IS THEIR A FATHER? JMP POP YES GO TRY HIM * ADB DM5 NO TRY FOR A SON XLA B,I GET STATUS WORD AND B10K ISOLATE THE WAITING BIT SZA SET?? JMP PRGN1 YES THIS IS A PROGININATOR * LDA ALL AN INDEPENDENT PROG. CHECK IF OK TO REPORT SZA WELL? JMP PRGN1 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 XLA A,I GET HIS ID ADDRESS 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 * PRGN1 CLA STA PRGFL INITIALIZE THE 'PROGINATOR' FLAG * 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 B17 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 PRGN1+1 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 DON'T STEP ALL ISZ ALL ELSE SET THE ALL FLAG DLD BLOCK TELL HIM WHAT WE ARE DOINT JSB PRINT JMP THIS1 * ENDBL EQU * CLA STA PRGFL INITIALIZE THE PROG FLAG 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 DOIT,I RETURN FROM THE SUBROUTINE * LDA D2 AND STA ALL SET UP TO PICK UP THE INDEPENDENTS JSB ODTSP OUTPUT A SEPARATION LINE 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 * PRGFL NOP SON NOP LNAID NOP ID ADDRESS OF LAST NAME PRINTED XEQT EQU 1717B 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 XLA A,I THAT THIS 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 * * ********************************************************************** * SUBROUTINE ODTSP * OUTPUTS A LINE CONTAINING ONLY A DOT AND A SPACE ************************************************************************ * ODTSP NOP RETURN ADDRESS JSB SETPT RESET STACK LDA .DTSP DOT & SPACE JSB MVBYT PUSH ON THE STACK DEF D2 JSB OUTPT OUTPUT JMP ODTSP,I RETURN * * D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D8 DEC 8 D12 DEC 12 D14 DEC 14 D15 DEC 15 D16 DEC 16 D17 DEC 17 D21 DEC 21 B77 OCT 77 B17 EQU D15 CRTLU NOP PARM2 NOP PARMA NOP DNODE NOP IDCNT NOP IDPNT NOP STATS NOP STACK OCT 0,0 BSS 36 .STAK DEF STACK STKPT NOP .TM. DEF STACK+32 .DNTM DEF STACK+27 .PR. DEF STACK+27 .LAST DEF STACK+37 NDID ASC 9,REMOTE WHZAT NODE .NDID DEF NDID EXW ASC 3,EXECW .EXW DBL EXW ADASH OCT 0,0 UNL REP 36 ASC 1,-- LST .ASTE DEF ADASH * .SPAC DEF *+1 UNL REP 36 ASC 1, LST * .DTSP DEF *+1 UNL REP 20 ASC 1,. LST * .STSP DEF *+1 UNL REP 20 ASC 1,* LST DM4 DEC -4 D7 DEC 7 SPC 4 PROCS NOP JSB SETPT CLEAR THE STACK CLB AND STB SON THE SON FLAG * JSB PSPAC PUSH 2 SPACES JSB PSPAC * * * DISPLAY PROGRAM'S NAME * LDA IDPNT ID SEG ADDRESS JSB MVNAM MOVE NAME TO OUTPUT STACK CLA STA LNAID CLEAR NAME MOVED FLAG FOR SESSION REPORTS JSB PSPAC PUSH A SPACE * * PUSH THE TYPE TYPE LDB D14 GET PROGRAM TYPE JSB IDWRD AND D7 MASK OFF IDSEG(15[2-0]) STA TYP SAVE IT JSB .ASC1 & STORE THE BYTE LDB D28 LDA TYP GET THE TYPE CPA D1 IS IT MEMORY RESIDENT ? 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 THE SPACE JSB MVBYT PUSH IT DEF D1 * * NOW, PUSH IN THE PRIORITY PRIOR LDB D6 GET PROGRAM PRIORITY JSB IDWRD IN A-REG JSB ZASC5 CONVERT TO ASCII & ADD TO STACK * LDB D20 JSB IDWRD GET (IDWRD+20) LDB .SPAC SSA IF RUNNING UNDER BATCH LDB .B PRINT 'B' LDA B ELSE PRINT SPACE JSB MVBYT PUSH IT DEF D1 * * NOW, PUSH THE PARTITION SIZE LDB D14 JSB IDWRD GET PROG TYPE AND D7 CPA D1 RESIDENT PROGRAM ? RSS JMP PRLNG NO, PROCESS DISK RESIDENT * LDA .RSDT YES,RESIDENT PROGRAM JSB MVBYT PRINT IT IN PARTITION 0 DEF D6 JMP STAT * PRLNG LDB D21 GET CONTENTS JSB IDWRD OF WORD 22 STA NUM STA B AND B77 SSB,RSS WAS PROG ASSIGNED TO PARTITION SZA NO, WAS IT IN ANY PTTN JMP PRPTN YES, ASSIGNED OR IN PTTN * LDB D8 JSB IDWRD HAS PROG BEEN SUSPENDED BEFORE SZA JMP PRPT YES, THEN PARTITION # 1 IS OK * LDA .SPAC NO,PROGRAM MAY NOT HAVE BEEN LOADED JSB MVBYT DEF D2 JMP PRASG 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 LINE DEF D1 * LDA NUM ALF,RAL GET NUMBER OF PAGES RAL IN PARTITION AND B37 INA ADD 1 FOR BASE PAGE JSB .ASC2 JSB PSPAC SPACE * * STAT EQU * CLA INITIALIZE THE STR VAR.(DEFAULT IS DOTS) STA STR * LDA STATS CALCULATE STATUS COLM. SZA,RSS DORMANT ? JMP M NO DOTS/STARS NECESSARY MPY D3 3 CHAR PER COLUMN SLA IF ODD,SUBTRACT 1 FROM IT ADA M1 STA NUM * LDA STKPT SAVE THE CURRENT STACK POINTER STA PTR * LDA .DTSP FOR OTHERS PUSH DOTS AND SPACES JSB MVBYT DEF NUM # OF BYTES. * LDB STATS IF STATUS ODD,ADD ADDITIONAL SPACE SLB JSB PSPAC PUSH ADDITIONAL SPACE * M LDA STATS CONVERT STATUS TO ASCII JSB .ASC1 & PUSH ONTO STACK * LDA .CMBL PUSH COMMA JSB MVBYT DEF D1 * LDA STATS GET STATUS CPA D2 I/O SUSPEND ? JMP EQT YES, PROCESS EQT # CPA D3 GENERAL WAIT ? JMP WAIT YES. JMP TLIST JUMP TO TLIST TO PROCESS PROG CNT & TIME * TYP NOP 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 D50 DEC 50 DM100 DEC -100 * * STATE 2 - I/O WAIT PROCESSING EQT CLA STA #EQTS SET UP EQT INDEX * EQTLP LDA #EQTS GET EQT INDEX MPY D15 15 WORD EQT ADA EQTA STA EQTPT SAVE THIS EQT7S ADDRESS XLA A,I GET CONTENTS OF EQT'S FIRST WORD * IDSLP SZA,RSS SCAN SUSPEND LIST. NULL LIST ? JMP NXTEQ YES, GO TO NEXT EQT CPA IDPNT NO, POINT TO OUR ID SEG JMP FNDEQ YES, GO PROCESS SSA IF INDIRECT, MUST BE GARBAGE JMP NXTEQ XLA A,I NO, NEXT LIST ELEMENT JMP IDSLP & CONTINUE THE SEARCH * NXTEQ ISZ #EQTS STEP EQT COUNTER LDA #EQTS ARE WE THROUGH ? CPA EQT# COMPARE WITH BASE PAGE COUNT JMP OSCAR YES, MUST BE OSCAR JMP EQTLP NO GO TO EQT LOOP * OSCAR LDA .EXEC MOVE EXEC ON STACK JSB MVBYT DEF D6 JMP TLIST & CHECK TIME LIST & PROG CNTR * * .EXEC DEF *+1 ASC 3,EXEC B140K ABS 140000B .LPAR DEF *+1 ASC 1,( * .EQ DEF *+1 ASC 2,EQ: .AV DEF *+1 ASC 2,,AV: .CMBL EQU .AV .ST DEF *+1 ASC 2,,ST: B300 ABS 300B B70 ABS 70B * FNDEQ EQU * * FDEQ0 LDA .EQ MOVE EQ: JSB MVBYT DEF D3 * LDA #EQTS CALCULATE EQT# INA JSB .ASC3 CONVERT TO ASCII * FDEQ1 LDA .AV PUSH ',AV:' ON THE STACK JSB MVBYT DEF D4 * LDB EQTPT GET DEVICE LOG STATUS ADB D4 LDA B,I GET THE STATUS WORD STA EQST SAVE IT AND B140K MASK OFF LOGICAL STATUS RAL,RAL RIGHT JUSTIFY IN WORD JSB .ASC1 CONVERT TO ASCII & STORE * LDA .ST PUSH ',ST:' ON STACK JSB MVBYT DEF D4 * * NOW, CONVERT THE STATUS WORD INTO THE OCTAL ADDRESS LDA EQST STATUS WORD AND B300 ISOLATE THE STATUS WORD CLB RRR 6 SHIFT IT RIGHT BY 6 JSB .ASC1 PRINT IT * LDA EQST STATUS WORD AND B70 CLB RRR 3 JSB .ASC1 PRINT SECOND OCTAL DIGIT LDA EQST AND D7 CLB JSB .ASC1 PRINT THE THIRD DIGIT * JMP TLIST PROCESS PRG CNT & TIME LIST * DM8 DEC -8 D20 DEC 20 D27 DEC 27 REASN NOP TEST EQU REASN EQST NOP * WAIT EQU * XLB $ELTB GET THE ADDRESS OF THE EQT LOCK TABLE STB .ELTB SAVE IT 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 .ELTB CHECK IF EQT LOCK TABLE FULL JMP LKWT YES, DISPLAY THAT MESSAGE * 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 * JSB TSTWD EQTLOCK <=IDSEG(2)<=[EQTLOCK] .ELTB NOP JMP EQLK * 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 EQU * LDB D15 JSB IDWRD CHECK IF BIT 12 SET ALF,SLA JMP SNID1 SET * CLA STA SON LDA REASN PUSH THE NAME OF THE PROG JSB MVNAM LDA .QUE JMP PUSH8 * SNID1 JSB PSTR PUSH STARS LDA REASN STA SON JSB MVNAM MOVE SON'S NAME ON THE STACK JMP TLIST * SPC 2 .BLIM DEF *+1 ASC 3,BL,EQT00 * BL EQU * LDA .BLIM SET UP BUFFER LIMIT MESSAGE JSB MVBYT DEF D6 LDA TEMP JSB .ASC3 CONVERT EQT# & PUSH JMP TLIST TEMP NOP SPC 2 .QUE DEF *+1 ASC 4,'S QUEUE .RN?? DEF *+1 ASC 4,RESOURCE * * RESOURCE LOCK RESLK EQU * LDA .RN?? PUSH 'RN ??' ONTO STACK JMP PUSH8 SPC 2 .CL?? DEF *+1 ASC 4,CLASS # CLSLK EQU * LDA .CL?? PUSH 'CL ??' ONTO STACK PUSH8 JSB MVBYT PUSH 8 CHARS ONTO STACK DEF D8 JMP TLIST * * EQT LOCK WAIT,NO ENTRY AVAILABLE IN $ELTB LKWT EQU * LDA .EQWT PUSH THE MESSAGE ON THE STACK JSB MVBYT DEF D15 * JMP TLIST * .EQWT DEF *+1 ASC 8,EQLK TABLE FULL * SPC 2 .LU DEF *+1 ASC 2,LU: .DN DEF *+1 ASC 2, DN, * DEVDN EQU * * LDB D2 JSB IDWRD GET LU# FROM SUSPENDED ID STA REASN SAVE IT TEMPORARILY SSA IF NEGATIVE,IT IS THE EQT ADDR OF DOWN DEVICE JMP DVDNE * LDA .LU PUSH ',LU:' ON STACK JSB MVBYT DEF D3 * LDA REASN PUSH THE LOGICAL UNIT NO JSB .ASC3 * LDA .DN PUSH ' DN,' JSB MVBYT DEF D4 * CCA FIND EQT NO FOR LU ADA REASN ADA DRT LDA A,I AND B77 ADA M1 STA #EQTS * MPY D15 ADA EQTA STA EQTPT SAVE IT IN 'EQTPT' JMP FDEQ0 * DVDNE EQU * CMA,INA STA EQTPT LDA REASN CONVERT EQT ADDR TO EQT # ADA EQTA BY SUBTRACTING EQT BASE ADDR. CMA,INA CLB DIV D15 AND DIVIDING BY 15 INA OFFSET IT BY 1 STA #EQTS SAVE IT * LDA .EQ PUSH EQ: JSB MVBYT DEF D3 * LDA #EQTS EQT NO JSB .ASC3 DISPLAY IT * LDA .DN DISPLAY ' DN,' JSB MVBYT DEF D3 JMP FDEQ1 * 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 EQU * 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 * LDA PTR,I SEARCH FOR LU LOCK,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 PROGRAM NAME IN MESSAGE JMP TLIST * * EQT LOCK, PUSH IT ON THE STACK EQLK EQU * XLB REASN,I GET THE EQT NO STB EQNO SAVE IT * XLA $ELTB,I GET THE TABLE LENGTH AND B77K MASK OUT THE MSB ADA REASN POINT TO LOCKER'S ID NO XLA A,I AND B77K ISOLATE THE IDNSEG NO. STA IDNO SAVE IT * PUSH THE MESSAGE EQLK XXX,LKPRG = PROGA ON THE STACK LDA .EQLK JSB MVBYT MOVE THE MESSAGE DEF D4 * LDA EQNO PROCESS EQT NO JSB .ASC3 * LDA .LKPR PUSH ',LKPRG=' JSB MVBYT DEF D7 * GET THE ID ADDRESS & PUSH THE PROG NAME ON THE STACK LDA IDNO JSB MVNAM MOVE NAME * JMP TLIST * .EQLK DEF *+1 ASC 2,EQLK * IDNO BSS 1 EQNO BSS 1 * ************************************************************************* * SUBROUTINE - PSTR PUSHES STARS ON THE STACK(OVERWRITES * THE PREVIOUSLY PUSHED DOTS) ************************************************************************* .STST DEF *+1 ASC 1,** * PSTR NOP LDA PRGFL GET THE PROGINATOR FLAG SZA IF ZERO,IT IS AN ACTUAL PROGINATOR JMP PSTEX OTHERWISE,IT ITSELF WAS A SON JSB SETPT PUSH 2 STARS IN THE BEGINNING OF LINE LDA .STST JSB MVBYT DEF D2 * LDA PTR RESTORE THE OLD VALUE OF STACK POINTER STA STKPT * LDA .STSP PUSH STARS & SPACES JSB MVBYT DEF NUM * JSB PSPAC PUSH ADDITIONAL SPACE AS STATE IS ODD LDA D3 STA STR MAKE STR NON-ZERO FOR SUB PFILL JSB .ASC1 PUSH THE STATE NO ON THE STACK * LDA .CMBL PUSH COMMA JSB MVBYT DEF D1 PSTEX JMP PSTR,I RETURN * STR NOP * SPC 2 PLOCK NOP LDA .LKPR PUSH ",LKPRG=" ONTO STACK JSB MVBYT DEF D7 LDA .RNTB ADA RN XLA A,I AND B377 GET RESOURCE LOCKER'S ID SEG # CPA B377 IS IT GLOBAL? JMP PLCK9 YES. ADA M1 ADA KEYWD XLA 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 PTSSP NOP .CLGT DEF *+1 ASC 3,CL CL# NOP * CLGET EQU * STA CL# LDA .CLGT PUSH "CL " ONTO STACK JSB MVBYT DEF D4 LDA CL# JSB ZASC3 JMP TLIST * * TLIST EQU * JSB PSPAC PUSH A SPACE LDA .PR. PROGRAM COUNTER'S LOCATION CLE,ELA CONVERT TO BYTES CMA,INA MAKE IT NEGATIVE ADA STKPT COMPUTE STKPT-PR CMA,INA COMPUTE # OF DOTS OR STARS TO BE PUT IN SSA,RSS MORE THAN WE CAN FIT IN JMP NXTM2 YES,WE ARE OK. * NO, WE CAN NOT PUT PROGRAM COUNTER IN THIS LINE,GOTO NEXT JSB OUTPT PRINT THIS LINE FIRST JSB SETPT INITIALIZE THE STACK POINTER LDA .SPAC JSB MVBYT PUT SPACES IN THE NEXT LINE DEF D50 JMP NXTM3 NXTM2 JSB PFILL PUSH STARS/DOTS DEPENDING UPON THE CASE NXTM3 LDA .P PUSH P: JSB MVBYT DEF D2 * NOW GET THE POINT OF SUSPENSION FROM ID SEGMENT LDB D8 GET POINT OF SUSPENSION JSB IDWRD RAL STA PTSSP POINT OF SUSPENSION * LDB DM5 LOOP COUNT STB CNT NXLLP LDA PTSSP LOOP,GET POINT OF SUSPENSION ALF ROTATE LEFT 4 TIMES RAR EFFECTIVELY ROTATE LEFT 3 TIMES STA PTSSP SAVE IT AND D7 ISOLATE THE DIGIT JSB .ASC1 DISPLAY THE OCTAL DIGIT ISZ CNT INCREMENT THE LOOP COUNT JMP NXLLP DISPLAY THE NEXT DIGIT * * NOW DETERMINE IF THE PROGRAM SWAPPED OUT * IF SO,PUSH SWP ON THE STACK LDA .SPAC LDB TYP GET TYPE OF THE PROGRAM CPB D1 JMP NXTM4 * LDB D27 JSB IDWRD GET THE SWAP TRACK ADDRESS AND B77K LDB A B GETS CONTENTS OF A-REG LDA .SPAC SZB,RSS IF ZERO, NOT SWAPPED OUT JMP NXTM4 * LDA .SWP PUSH, SWP ON THE STACK NXTM4 JSB MVBYT DEF D3 * LDB D17 TIME LIST INDICATOR JSB IDWRD ALF,SLA SET ? JMP NXTM5 JMP DUMP NO, DUMP THE CURRENT LINE NXTM5 EQU * * NXTM6 LDA IDPNT ADA D18 JSB CNVTM CONVERT TIME * DUMP JSB OUTPT DISPLAY THE CURRENT LINE JMP PROCS,I * SPC 2 FINIS JSB DASHS * DNDEV JSB SETPT RESET STACK FOR DOWN LU'S. CLA INITIALIZE NOOUT STA NOOUT 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 COUNTER. * DNLU1 LDA EQTPT,I GET LU'S STATUS. ISZ #EQTS SSA,RSS IS IT DOWN? JMP NXTLU NO--GET NEXT LU. * ISZ NOOUT INCREMENT THE COUNT 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. LDA NOOUT FETCH THE COUNT OF DOWN LU'S SZA ZERO ? JMP NXTLO NO, PRINT THE LINE JSB SETPT YES, DISPLAY THE MESSAGE 'ALL LU'S OK' LDA .LUOK JSB MVBYT DEF D12 * NXTLO JSB OUTPT PRINT STACK. * JSB SETPT RESET STACK FOR DOWN EQTS CLA INITIALIZE THE COUNT OF DOWN EQT STA NOOUT * 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 LDA 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 * ISZ NOOUT INCREMENT THE COUNT 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 LDA NOOUT FETCH THE COUNT OF DOWN EQT'S SZA ZERO ? JMP DONE NO, PRINT THE LINE AS IT IS JSB SETPT INITIALIZE THE POINTER LDA .EQOK MESSAGE 'ALL EQT'S OK' JSB MVBYT DEF D12 SPC 2 DONE JSB OUTPT PRINT STACK DONE1 EQU * JSB LOCLU DISPLAY ALL LOCKED LU'S JSB LOCEQ DISPLAY ALL LOCKED EQT'S JSB CMTRK COMPUTE FREE TRACKS AVAILABLE JSB COMSM DISPLAY SAM RELATED INFO IF NEED BE DONE2 JSB DASHS * EXIT JSB TOD FINALLY TIME OF DAY LDA .EOF ANOTHER BLANK LINE LDB DM6 JSB PRINT SPC 2 LDA XEQT CHECK IF I AM IN TIME LIST ADA D17 XLA A,I GET THE WORD 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 #NODE DEF ZERO DEF CRTLU RSTRT JMP WHAT RESTART 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 .EQOK DEF *+1 ASC 6,ALL EQT'S OK .LUOK DEF *+1 ASC 6,ALL LU'S OK .SWP DEF *+1 ASC 2,SWP .P DEF *+1 ASC 1,P: D9 DEC 9 * .EOF DEF *+1 OCT 0,0,20040 .HEAD DEF *+1 OCT 0,0 ASC 11, PRGRM T PRIOR PT SZ ASC 10,DO.SC.IO.WT.ME.DS.OP ASC 10,. .PRG CNTR. . ASC 5,NEXT TIME. SKP SPC 2 FROM BSS 2 TO EQU FROM+1 B377 OCT 377 B7K OCT 7777 B77K OCT 77777 SPC 2 * ************************************************************************* * SUBROUTINE PFILL PUSHES EITHER THE STARS OR DOTS ON THE STACK * DEPENDING ON THE CASE(STR NONZERO OR ZERO) * ARG: A-REG CONTAINS NO OF PLACES TO BE FILLED IN ************************************************************************* * PFILL NOP SZA,RSS IF ZERO,EXIT JMP PFLEX YES STA NUM SAVE NO OF SPACES TO BE FILLED IN LDA STKPT CHECK IF STKPT ODD OR EVEN SLA,RSS IF ODD ,IT IS POINTING TO ODD COLM JMP PFL1 THE STARS/DOTS START AT EVEN COLM JSB PSPAC PUSH ADDITIONAL SPACE TO MAKE IT EVEN LDA NUM ADA M1 NUM = NUM-1 SZA,RSS IF ZERO,FORGET IT JMP PFLEX YES STA NUM PFL1 LDA .DTSP PICK APPROPRIATE TEXT DEPENDING ON STR LDB STR SZB LDA .STSP TAKE STARS AS STR NON ZERO JSB MVBYT DEF NUM * PFLEX JMP PFILL,I RETURN 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 SPC 2 PSPAC NOP LDA .SPAC PUSH A SPACE JSB MVBYT DEF D1 JMP PSPAC,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 DASHS NOP LDA .ASTE LDB DM76 JSB PRINT JMP DASHS,I * DM76 DEC -76 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 XLA B,I GET UPPER LIMIT BY ADDING AND B77K MASK OUT THE MSB 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 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 DEXEC DEF *+1+5 DEF DNODE DEF D2 DEF CRTLU .BUFF DEF STACK DEF CNT JMP PRINT,I * * PGID NOP JSB SETPT SET STACK POINTER LDA .NDID MOVE PROGRAM ID JSB MVBYT STRING TO STACK DEF D18 LDA #NODE GET LOCAL NODE NUMBER JSB .ASC2 CONVERT TO ASCII & ADD TO STACK JSB OUTPT JMP PGID,I AND RETURN * 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 TO USER MAP FROM SYS MAP LDB DWRD1 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 XLA B,I JMP IDWRD,I * * PANOD NOP LDB XEQT GET ADDR OF PROG'S ID SEG ADB D20 PA'S ID SEG #= SON'S IDSEG(WRD 21) XLA B,I GET PA'S SEG # AND B377 AND ISOLATE IT SZA,RSS IF ZERO, WE ARE LOCAL JMP LOCAL ADA M1 ELSE,SET INDEX INTO IDSEGS ADA KEYWD ADD TO KEYWD TO GET PROPER IDSEG XLA A,I ADA D12 PA'S NAME= PA'S IDSEG(WRD 13-15) LDB D3 SET UP X REG FOR X MOVE CBX LDB .PAW GET ADDRESS OF LOCAL STORAGE MWF AND MOVE PA'S NAME INTO PROGRAM LDB .PAB GET BYTE ADDR. OF LOCAL STORAGE LDA .EXW AND OF EXEC CBT D5 STRINGS (NAMES) THE SAME ? JMP NTLOC YES-- NOT A LOCAL CALL NOP LOCAL LDA #NODE DEST NODE # = #NODE JMP PANOD,I NTLOC LDA #CNOD DEST NODE # = #CNOD JMP PANOD,I * .PAW DEF WORD1 .PAB DEF WORD1 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 DASHS '----------' * CLA,INA STA PTN# INIT PARTITION NUMBER CLA SET STA UFLAG NO. UNDEFINED TO ZERO XLA $MATA STA PTNAD INIT PARTITION ADDR XLA $MNP GET # OF PARTITIONS SZA,RSS JMP DONE IN CASE BOO-BOO MPY D7 ADA PTNAD CALCULATE ADDR OF STA LPTAD LAST PARTITION * NXPTN XLA PTNAD,I GET LINK WORD 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 & DEF 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 PARTITION 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 DONE2 AND GO EXIT * NOPRG LDA .NONE JSB MVBYT DEF D6 JMP DMPTN SPC 2 PTNWD NOP ADB PTNAD XLA 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 * .NONE 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 * * ************************************************************************* * * SUBROUTINE - LOCEQ * SUBROUTINE TO PRINT THE LOCKED EQTS * * IF NO EQT IS LOCKED,IT DOES NOT PRINT ANYTHING.THE SUBROUTINE * ACCESSES A TABLE ($ELTB) IN TABLE AREA II.IF THE MOST SIGNIFICANT * BIT OF THE FIRST WORD OF THIS TABLE SET,THE TABLE HAS ATLEAST * ONE ENTRY,OTHERWISE THE TABLE IS EMPTY. * * DATE : 6/25/79 DB ************************************************************************* * * LOCEQ NOP RETURN ADDRESS XLB $ELTB GET THE ADDRESS LDA B,I GET THE FIRST WORD OF THE TABLE. SSA,RSS IF M.S.B. NOT SET,SKIP THE SUBROUTINE. JMP LCEEX YES,EXIT * * THE TABLE HAS ATLEST ONE NON-ZERO ENTRY.BUT WE HAVE TO BE CAREFULL * BECAUSE BY THE TIME WE PICK UP THE ENTREE, THE ENTREES MIGHT * BECOME ZERO(BECAUSE OF INTERRUPT).THEREFORE, IF ALL THE ENTRIES * ARE ZEROS, NO MESSAGE IS PRINTED. * JSB SETPT RESET THE STACK LDA .LKEQ LOCKED EQT MESSAGE. JSB MVBYT MOVE THE MESSAGE ON THE STACK DEF D24 * XLB $ELTB GET THE TABLE ADDRESS AGAIN XLA B,I GET THE FIRST WORD AND B77K A-REG CONTAINS THE NO OF ENTRIES. STA LENTH SAVE IT * ADA B CREATE THE LAST POINTER INA STA TBLST SAVE IT AS THE LAST POINTER INB B-REG POINTS TO FIRST EQT NO STB TBPTR STORE IT AS A TABLE POINTER * LCLP0 CLA STA NOOUT INITIALIZE THE 'NOOUT' * * LCLP1 LDB TBPTR PICK UP THE POINTER CPB TBLST COMPARE IT AGAINST THE LAST POINTER JMP LOCN2 YES, SKIP * LDB NOOUT NUMBER OF LOCKED EQT OUTPUT IN THIS LINE CPB D4 IS IT ONLY 4 (ALLOWS 4 PER LINE) JMP LOCN3 YES * XLA TBPTR,I GET THE EQT SZA,RSS IF ZERO, NOT A VALID ENTRY JMP LOCN1 YES, GET THE NEXT ENTREE ISZ NOOUT MAKE IT NON ZERO AS ATLEAST 1 LOCKED EQT JSB .ASC3 CONVERT TO ASCHII * LDA .LPAR PUSH LEFT PARENTHESIS JSB MVBYT MOVE BYTES DEF D1 * * NOW DETERMINE THE PROGRAM'S NAME & PUSH IT ON THE STACK. LDB TBPTR PICK UP THE POINTER ADB LENTH POINT TO ID-ADDRESS XLA B,I GET THE ID-ADDRESS AND B77K MASK OUT THE M.S.B JSB MVNAM MOVE THE NAME ON THE STACK * LDA .RPAR PUSH RIGHT PARANTHESIS,COMMA & SPACE JSB MVBYT MOVE THE BYTES DEF D2 * LOCN1 ISZ TBPTR BUMP THE POINTER JMP LCLP1 CONTINUE THE LOOP * * TABLE PROCESSED COMPLETELY,FLUSH THE MESSAGE OUT. LOCN2 LDA NOOUT ARE ALL ZEROS ? SZA JSB OUTPT DISPLAY THE LINE LCEEX JMP LOCEQ,I EXIT * * ONE LINE FULL,GO TO THE NEXT LINE LOCN3 JSB OUTPT OUTPUT THE LINE JSB SETPT INITIALIZE THE STACK POINTER LDA .SPAC NEXT LINE WITH SPACES JSB MVBYT MOVE THE SPACES DEF D24 JMP LCLP0 GO & PROCESS MORE * * D26 DEC 26 * * ************************************************************************** * * SUBROUTINE - LOCLU * IT PRINTS THE LOCKED LU'S. * THE SUBROUTINE SEARCHES THE DRT TABLE,PICKS OUT THE RESOURCE * NO & FROM THE RESOURCE TABLE, PICKS OUT THE LOCKER'S ID-SEGMENT * NO. THEN THE CORRESPONDING NAME IS DISPLAYED * THE MESSAGE IS: * LOCKED LU'S(PROG NAME) XXX(PROGA),XXX(PROGB) * * IF NONE OF THE LU'S ARE LOCKED,NO MESSAGE IS DISPLAYED. * ************************************************************************ * RNTB DEF $RNTB+0 LOCLU NOP RETURN ADDRESS JSB SETPT RESET THE STACK LDA .LKLU PUSH THE TITLE 'LOCKED LU'S' JSB MVBYT DEF D24 * LDA @DRT GET THE DRT ADDRESS STA TBPTR SAVE IT AS THE TABLE POINTER * LDA @LUMX GET MAX # OF LU'S CMA,INA SAVE NEGATIVE OF THAT STA CNT1 * LULP0 CLA INITIALIZE THE 'NOOUT' STA NOOUT * LULP1 EQU * LDB NOOUT NUMBER CPB D4 ALLOW 4 PER LINE JMP LUCN3 YES,PRINT NEW LINE * XLA TBPTR,I GET THE WORD FROM THE DRT TABLE RRR 6 AND B37 ISOLATE THE RESOURCE NO SZA,RSS IF ZERO,IT IS NOT LOCKED JMP LUCN1 YES, PICK THE NEXT ONE * * LOOK INTO THE RNTB TO MAKE SURE THAT THE ENTREE IS VALID ADA RNTB POINT TO THE RESOURCE NO ENTREE XLA A,I GET THE ENTREE AND B377 ISOLATE THE LOCKER'S ID SEG NO SZA,RSS IF IT IS ZERO,IT IS NOT OWNED. JMP LUCN1 YES,LOOK INTO THE NEXT ENTREE STA IDNO1 SAVE IT ISZ NOOUT * * NOW PUSH THE LU NO & THE CORRESPONDING PROGRAM NAME. * LDA CNT1 ADA @LUMX LU NO : @LUMX-CNT INA JSB .ASC3 CONVERT TO ASCHII & PUSH IT ON STACK * LDA .LPAR PUSH LEFT PARENTHESIS JSB MVBYT DEF D1 * LDA IDNO1 GET THE IDNO CPA B377 IS IT GLOBAL JMP LUGLB YES ADA M1 CREATE A POINTER IN KEYWORD BLOCK ADA KEYWD XLA A,I GET THE ID-NUMBER JSB MVNAM MOVE THE NAME ON THE STACK JMP LUCN0 * LUGLB LDA .GLBL GLOBAL JSB MVBYT MOVE THE WORD 'GLOBAL' DEF D5 * LUCN0 LDA .RPAR PUSH RIGHT PARENTHESIS,COMMA & SPACE JSB MVBYT DEF D2 * LUCN1 ISZ TBPTR INCREMENT THE TABLE POINTER ISZ CNT1 INCREMENT THE -VE COUNT JMP LULP1 CONTINUE * * TABLE PROCESSED COMPLETELY,FLUSH THE MESSAGE OUT LDA NOOUT CHECK IF IT IS ZERO SZA IF ZERO,THIS LINE NOT TO BE OUTPUT JSB OUTPT OUTPUT THE LINE LCLEX JMP LOCLU,I RETURN FROM THE SUBROUTINE * * THIS LINE OF DISPLAY FULL, GO TO NEXT LINE LUCN3 JSB OUTPT OUTPUT THIS LINE JSB SETPT INITIALIZE THE STACK POINTER AGAIN LDA .SPAC NEXT LINE WITH SPACES JSB MVBYT MOVE THE SPACES DEF D24 JMP LULP0 JUMP BACK. * .RPAR DEF *+1 ASC 2,), * .LKEQ DEF *+1 ASC 12,LOCKED EQT'S (PROG NAME) * * .LKLU DEF *+1 ASC 12,LOCKED LU'S (PROG NAME) TBPTR BSS 1 TABLE POINTER LENTH BSS 1 LENGTH OF THE ENTRIES NOOUT BSS 1 TBLST BSS 1 CNT1 BSS 1 IDNO1 BSS 1 * * ***************************************************************************** * * SUBROUTINE - CMTRK * * SUBROUTINE TO COMPUTE TOTAL NO OF CONTIGOUS FREE TRACKS * AVAILABLE ON EITHER LU2 (SYSTEM DISK) OR LU3 (AUX. DISK). * ***************************************************************************** * TAT EQU 1656B TATSD EQU 1756B TATLG EQU 1755B * CMTRK NOP RETURN ADDRESS JSB SETPT INITIALIZE THE STACK POINTER LDA .FRTR FREE TRACKS MESSAGE JSB MVBYT PUSH IT ON THE STACK DEF D24 * * COMPUTE MAX. NO OF FREE TRKS ON SYSTEM DISK. * LDA TAT GET THE TRACK ASSIGNMENT TABLE ADDRESS LDB TATSD NO OF TRACKS ON THE SYSTEM DISK. JSB COMPT COMPUTE NO OF FREE CONTIGOUS TRACKS AVAILABLE STA MAXL2 RESULT IN A-REG.(SAVE IT) * * NOW DO THE SAME FOR THE AUXILIARY DISK (LU 3) * LDA TAT TRACK ASSIGNMENT TABLE ADDRESS ADA TATSD CREATE POINTER (EQ TO TAT+TATSD) LDB TATSD NO OF TRACKS ON AUX DISK = TATLG-TATSD ADB TATLG COMPUTE TATSD-TATLG CMB,INB NEGATE IT SZB,RSS IF AUX NOT DEFINED, FORGET IT JMP CM1 JSB COMPT COMPUTE FREE TRACKS ON AUX DISK STA MAXL3 SAVE IT * * CHECK WHICH IS GREATER CMA,INA -MAXL3 ADA MAXL2 COMPUTE MAXL2-MAXL3 SSA,SZA JMP CM2 MAXL3 .GT. MAXL2 CM1 LDA MAXL2 MAXL2 .GT. MAXL3 LDB D2 LOGICAL UNIT NO JMP CM3 * CM2 LDA MAXL3 MAXL3 .GT. MAXL2 LDB D3 CM3 STB LUNO SAVE LOGICAL NO JSB .ASC3 PUSH THE NO OF TRACKS ON THE STACK * LDA .LU1 PUSH 'LU' ON THE STACK JSB MVBYT DEF D6 * LDA LUNO PUSH LOGICAL UNIT NO JSB .ASC3 ON THE STACK JSB OUTPT OUTPUT THE LINE JMP CMTRK,I RETURN * * MAXL2 NOP MAXL3 NOP D24 DEC 24 .LU1 DEF *+1 ASC 3,, LU * .FRTR DEF *+1 ASC 12,MAX CONT. FREE TRKS : * ************************************************************************* * SUBROUTINE - COMSM * COMPUTES THE MAX CONTIGOUS SAM,TOTAL SAM & * LARGEST SAM EVER AVAILABLE AT THE INSTANT OF TIME ************************************************************************* * SUSP3 EQU 01714B EXT $PNTI,$MAXI EXT $LIBR,$LIBX * COMSM NOP RETURN ADDRESS LDA SUSP3 CHECK THE MEMORY SUSPEND LIST SZA,RSS IF NO PROG MEM SUSPENDED,SKIP IT JMP SMEX * CLA CAX X-REG ACTS AS ACCUMULATOR FOR TATAL SAM CLB B- REG WOULD CONTAIN THE MAX CONT. SAM AVAIL XLA $PNTI,I GET THE SAM FREE LIST HEADER STA PNTR STORE IT LOCALLY * **************GO PRIVILEGED FROM HERE * JSB $LIBR NOP * CMM1 XLA PNTR,I PICK # OF FREE WORDS ADX A ADD TO ACCUMULATOR * ADA B COMPUTE (A-B):B-REG IS NEGATIVE SSA SKIP IF (A).GT.(B) JMP CMM2 NO,(A).LT.(B),B THEN REMAINS UNCHANGED CMA,INA MAKE IT -(A-B) ADB A B-REG = -B+[-(A-B)]=-A<=>MAX SAM SO FAR CMM2 ISZ PNTR BUMP THE POINTER XLA PNTR,I GET THE ADDRESS OF NEXT FREE BLOCK CPA B77K END OF LIST ? JMP SMEXT YES,PRINT THE STUFF & BUZZ 0FF STA PNTR UPDATE THE POINTER JMP CMM1 CONTINUE IN THE LOOP * ***************GO UNPRIVILEGED HERE * SMEXT JSB $LIBX DEF *+1 DEF *+1 * * X-REG CONTAINS TOTAL SAM AVAIL:B-REG CONTAINS -VE OF MAX * CONT. SAM AVAILABLE. * CMB,INB MAKE IT +VE STB MAXSM STX TOTSM SAVE B & X REGS * JSB SETPT INITIALIZE STACK POINTER LDA .MXSM JSB MVBYT PUSH TITLE ON THE STACK DEF D24 * LDA MAXSM PUSH MAX SAM JSB .ASC5 * LDA .WRD PUSH 'WORDS' JSB MVBYT DEF D8 * JSB OUTPT FLUSH THE MESSAGE * JSB SETPT INITIALIZE THE STACK AGAIN LDA .TOSM PUSH THE TITLE FOR TOTAL SAM JSB MVBYT DEF D24 * LDA TOTSM JSB .ASC5 * LDA .WRD JSB MVBYT PUSH WORDS DEF D8 * JSB OUTPT FLUSH THE MESSAGE OUT * JSB SETPT INITIALIZE THE STACK POINTER AGAIN LDA .LRSM JSB MVBYT 'LARGEST SAM EVER AVAILABLE' DEF D28 * XLA $MAXI,I CMA,INA JSB .ASC5 * LDA .WRD JSB MVBYT DEF D8 * JSB OUTPT * SMEX JMP COMSM,I RETURN PNTR NOP MAXSM NOP TOTSM NOP .MXSM DEF *+1 ASC 12,MAX CONT. SAM AVAIL : .TOSM DEF *+1 ASC 12,TOTAL SAM AVAILABLE : .LRSM DEF *+1 ASC 14,MAX CONT. SAM EVER AVAIL : * * .WRD DEF *+1 ASC 4, WORDS * * * ************************************************************************* * * SUBROUTINE - COMPT * SUBROUTINE TO COMPUTE THE MAX NO OF CONTIGOUS FREE TRACKS * * ARGUMENTS: A-REG : ADDRESS FROM WHERE THE SEARCH TO BEGIN IN TAT * B-REG : TOTAL NO OF TRACKS ON THE DISK * * RESULT PASSED BACK IN A-REG * ************************************************************************* * COMPT NOP RETURN ADDRESS ADA M1 OFFSET THE BEGINNING SEARCH ADDRESS BY 1 STA BGADR SAVE THE BEGINNING SEARCH ADDRESS CMB,INB SAVE NEGATIVE OF TOTAL NO OF TRACKS AVAILABLE INB OFFSET IT BY 1(FOR LOOP END CHECK) STB TKCNT * CLA INITIALIZE VAR 'MAXTK' STA MAXTK * CMLP0 CLB B-REG WOULD HAVE NO OF FREE TRKS IN A LOOP CMLP1 ISZ BGADR INCREMENT BEGINNING ADDRESS ISZ TKCNT SEARCHING DONE ? JMP CM4 JMP CMEXT YES,EXIT CM4 XLA BGADR,I GET THE ENTREE FROM THE TRACK ASSIGN TABLE SZA JMP CM5 NON ZERO, COMPUTE IF .GT. THE PREVIOUS ONE INB INCREMENT B-REG. JMP CMLP1 FIND MORE * CM5 STB TEMP1 SAVE IT TEMPORARILY CMB,INB NEGATIVE OF FREE TRACKS FOUND ADB MAXTK MAXTK-FREE TRACKS FOUND SSB,RSS JMP CMLP0 OK,MAXTK .GT. FREE TRACKS FOUND LDB TEMP1 MAXTK = FREE TRACKS FOUND IN THIS LOOP STB MAXTK JMP CMLP0 * CMEXT LDA MAXTK PICK UP THE MAX FREE TRACKS FOUND JMP COMPT,I RETURN * MAXTK BSS 1 TEMP1 BSS 1 BGADR BSS 1 TKCNT BSS 1 LUNO BSS 1 * UNS END WHAT