ASMB HED . T M S M A I N NAM $MTMS,7 92080-1X102 REV.2026 800429 1125 SPC 3 ********************************************************************** * * * NAME: $MTMS TMS MAIN PROGRAM * * SOURCE: &$MTMS 92080-18102 * * BINARY: %$MTMS ----NONE--- PART OF %TMSLB 92080-16100 * * * * PGMR: FRANCOIS GAULLIER * * * ********************************************************************** 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 3 ENT $MTMS,.MGT0 EXT $TMSA,.EMAP,.EMIO,BITSR,BITST,ERR0 *REQ EXT DMPTM EXT .MGTG,.MGTR,#REQU,#QCNT,DRTEQ EXT EXEC,LURQ,$CVT3,$LIBR,$LIBX,NUL,JASC EXT .ENTR,$TIME,IDGET,KLCLS,NRCLS,PNAME,RMPAR EXT DORMT,.UPIO,MESSS,.LURQ,NAMR EXT NSCAN,MOVCA,OPLOG * EXT DBUGR SPC 1 A EQU 0 B EQU 1 SUP SKP .PARA NOP PRG PARAMETERS ADDR PNX00 NOP DEFINE THE STARTING PROCESS PNXXX NOP DEFINE THE INITIAL PROCESS LUXXX NOP DEFINE THE LU FOR THE INITIAL PROCESS LOGXX NOP ADDR OF LOG FILE NAME OF LU .TMLU NOP .TMTP NOP .TMSB NOP .TMPR NOP .TMSL NOP ADDR OF TMS LINK NAME .TMST NOP ADDR OF TMS TIMER NAME IMAGE NOP IMAGE PARAMETERS $MTMS NOP TMS ENTRY POINT. JSB .ENTR DEF .PARA SPC 2 * RETREIVE PROGRAM PARAMETER AND SAVE THEM * TO INIT THE COMMON BLOCK # 0 SPC 1 LDB .PARA,I SAVE THE FIVE PARAMETERS JSB RMPAR INTO BUF TO SEND THEM INTO SAM DEF *+2 AS THE INITIAL CB0 DEF BUF * JSB EXEC GET RUN STRING DEF *+5 PASSED BY SCHEDULING PROGRAM DEF D14 FOR USE BY USER DEF D1 DEF URNST DEF D19 SZA SUCCESSFUL GET? JMP STA10 NO, ZERO RUN STRING BUFFER * LDA URNST YES, CHECK FOR "RU" OR "ON" COMMAND CPA RU JMP STA09 "RU" COMMAND, PARSE BUFFER CPA ON JMP STA09 "ON" COMMAND, PARSE BUFFER JMP STA11 PROGRAM SCHEDULE, SKIP PARSING * * STA09 CLA,INA PARSE RUN STRING BUFFER STA DUMMY SET START CHAR TO 1 FOR NSCAN CALL JSB NSCAN FIND PART OF STRING FOLLOWING: DEF *+5 "RU,PNAME,LU,,,,," DEF URNST THESE PARAMETERS ARE RESERVED FOR THE USER DEF DUMMY DEF AS0CM , DEF D7 SZA SEVENTH COMMA FOUND? JMP STA10 NO, USER RUN STRING NOT PRESENT * LDA DUMMY CALCULATE NO. OF CHAR TO MOVE CMA,INA ADA D40 STA DUMM2 * ISZ DUMMY POINT TO FIRST CHAR IN USER RUN STRING JSB MOVCA MOVE USER RUN STRING TO BEGINNING OF BUFFER DEF *+6 DEF URNST DEF DUMMY DEF URNST DEF D1 DEF DUMM2 JMP STA11 * STA10 JSB NUL NO, ZERO RUN STRING BUFFER DEF *+3 DEF URNST DEF D19 * STA11 LDA BUF RECALL FIRST PARAM (LU) SZA,RSS DEFAULT LU IS 1 INA STA BUF STA LU SET CONSOLE LU * * SEARCH LU LIST TO CONVERT LU SPECIFIED IN TMPGN TO COSOLE LU * LDA .TMLU GET START ADDR OF LU TABLE ADA DM2 POINT TO TOTAL NO. OF LUS DLD A,I A = TOTAL NO. OF LUS, B = NO. OF INTERACTIVE LUS CMA,INA ADA B A = - TOTAL NO. OF AUX LUS INB CBX X = INDEX TO FIRST AUX LU STA13 LBX .TMLU,I GET AUX LU CPB LUXXX,I SAME AS INIT PROCESS LU? JMP STA14 YES, SET LU TO CONSOLE LU ISX NO, POINT TO NEXT LU INA,SZA LAST LU ? JMP STA13 NO, KEEP SEARCHING HLT 37B YES, ERROR STA14 LDA LU GET CONSOLE LU STA LUXXX,I SET INIT PROCESS LU TO CONSOLE LU SAX .TMLU,I SET LU IN TABLE TO CONSOLE LU * * DISABLE REQUE CHECK IN #REQU (DS LIBRARY) * LDA #QCNT STA TQSAV LDA BIT15 STA #QCNT SPC 1 * JSB .DBUG CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!! * EXT .DBUG CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!! SPC 1 JSB EXEC SWAP THE WHOLE AREA DEF *+3 DEF D22 DEF D3 SWAP THE ENTIRE PARTITION SPC 1 JSB PNAME RETREIVE TMS-APPLICATION NAME DEF *+2 DEF APLNM SAVE NAME HERE LDB @APLN SEARCH LAST CHARAC. TO PUT THE ":" STA12 LBT GET BYTE CPA O40 IS IT SPACE ? RSS YES JMP STA12 NO, LOOP UNTIL SPACE LDA O72 ":" ADB DM1 BACKSPACE BYTE POINTER SBT AND STORE THE ":" LDA @APLN CMA,INA ADA B ADA @MSB1 ADD TO STARTING BYTE ADDR INA STA @MSBX SAVE BYTE POINTER LDA @APLN MOVE PROG NAME LDB @MSB1 INTO THE MESSAGE BUFFER MBT D6 SPC 2 * RETREIVE FWA AND LENGTH OF BUFFER AREA * TO INIT THE TMS MEMORY MANAGEMENT ROUTINE SPC 1 * LEAVE THAT FOR RTE-III M (MAY BE) !! * * EXT COR.A * XEQT EQU 1717B * AVMEM EQU 1751B * BGLWA EQU 1777B * * * LDA XEQT GET ID SEGMENT ADDR * JSB COR.A GET FWA * STA FWA * CMA,INA * LDB BGLWA GET BACKGROUND LWA * ADA AVMEM CHECK IF PROGRAM RUN FOR./BACK. PARTITION * SSA,RSS FOREGROUND ? * LDB AVMEM YES, USE FOREGROUND LWA * ADB DM1 YES, LOST TWO WORDS ! (MMGT PB) !! * LDA FWA B=LWA * CMA,INA * ADA B COMPUTE AVAILABLE MEMORY SIZE * STA LENA * JSB EXEC MEMORY SIZE REQUEST DEF *+5 DEF D26 REQUEST CODE DEF FWA FIRST WORD AVAILABLE DEF LENA # OF WORDS AVAILABLE DEF TEMP PARTITION LENGTH * JSB .MGTR FWA NOP FWA OF BUFFER LENA NOP # OF WORDS JMP .MGTG INITIALISE MEMORY MANAGEMENT SYSTEM * .MGT0 EQU * MEMORY MNGT SYSTEM IS READY. SPC 2 * CHECK ALL INTERACTIVE TERMINALS, UP THE * TERMINAL IF IT IS DOWN AND LOCK IT. SPC 1 LDB .TMLU SET UP TO CALL LURQ ADB DM1 TO LOCK ALL INTERACTIVE DEVICE STB STA33 SET # OF INTER. DEVICES ADDR. ADB D2 STB STA31 SET LU'S BUFFER STB STKLN SAVE LU'S ADDR. TO DO THE UPIO LDA STA33,I RECALL NUMBER OF LU'S CMA,INA AND STA #LU SET UP LU COUNTER * STA26 LDA STKLN,I GET LU JSB .UPIO TRY TO UP THE DEVICE IF DOWN JMP LULAB ERROR RETURN, ABORT TMS WITH ERROR # 1 ISZ STKLN BUMP LU ADDR. ISZ #LU BUMP LU COUNTER JMP STA26 AND LOOP UNTIL THE END * JSB LURQ LOCK ALL INTERCATIVE DEVICE DEF *+4 TO PROTECT PREVENT ANY OTHER DEF IOPTN LOCK/NO WAIT/NO ABORT STA31 NOP BUFFER CONTAINING LU'S STA33 NOP NUMBER OF LU'S JMP LULAB ERROR RETURN SZA LOCK OK ? JMP LULAB NO, ABORT TMS WITH ERROR # 1 * LDA STA31,I RECALL FIRST INTERACTIVE LU JSB .LURQ TO GET THE LU-LOCK ID WORD STA RNLCK SAVE FUNNY WORD (LOCKER ID - RN #) SPC 2 * INITIATE LOGGING IF REQUIRED SPC 1 LDB LOGXX,I LOGGING REQUIRED? SZB,RSS JMP STA40 NO, SKIP DCLOG INITIALIZATION LDA LOGXX YES, GET ADDR OF LOG FILE/DEV STA OPLO1 CLA SET LOG REQUEST TO 0 FOR OPEN JSB OPLOG OPLO1 BSS 1 DEF LU SZA ERROR? JSB LOGER YES, GO SHIT STB LGCLA NO, SAVE CLASS IO WD SPC 2 * CHECK THAT ALL PROGRAM ARE IN IDSEG SPC 1 STA40 LDA .TMSL TMS LINK JSB IDSG? LDA .TMST TMS TIMER JSB IDSG? * LDA .TMPR,I CHECK PROGRAM CONTAINING CMA,INA USER CODE (A = - # OF PRG) * STA43 STA TEMP ADA .TMPR,I COMPUTE INDEX INTO PRG TABLE MPY UPTEN UPT TABLE ENTRY LENGTH INA ADA .TMPR GO INTO PRG TABLE JSB IDSG? LDA TEMP RECALL INDEX INA,SZA END OF TABLE ? JMP STA43 NO, CONTINUE UNTIL END SPC 2 * ALLOCATE BIT TABLE, STACK TABLE AND ALL STACKS SPC 1 LDB .TMLU ADB DM3 LDA B,I GET EMA SIZE IN K WORDS STA TEMP SAVE IT CLB AND CALCULATE THE # OF WORDS PER ELEMENT DIV =D17 USING THE FOLLOWING FORMULA: ADA D2 # WORD/ELEM = 2 + EMA SIZE / 17 STA WPELE CLA,INA FIRST BIT # IN THE TABLE STA FSTBT LDA TEMP RECAL EMA SIZE IN K WORDS MPY D1024 DIV WPELE DIV BY # OF WORDS/ELEMENT ADA DM1 LAST ELEMENT MIGHT NOT BE TOTALLY IN STA LSTBT SETUP LAST BIT # IN THE TABLE CLB DIV D16 COMPUTE LENGTH OF THE TABLE ADA D2 IN WORDS, TO BE SECURE STA STA46 SETUP BIT TABLE LENGTH IN WORD * JSB .MGTG ALLOCATE THE BIT TABLE STA46 NOP LENGTH IN WORDS JMP .ER02 JMP .ER02 STA .BITB SETUP ADDR. OF THE BIT TABLE LDX STA46 AND CLEAR THE BIT TABLE ADA DM1 TO USE X REGISTER CLB SET ALL WORDS TO ZERO STA47 SBX A,I DSX JMP STA47 SPC 1 LDB .TMLU ALLOCATE STACK FOR EACH LU'S. LDA B,I GET STACK LENGTH STA STKLN ADB =D-2 LDA B,I GET TOTAL # OF LU STA #LU AND SAVE LOCALY SPC 1 JSB .MGTG ALLOCATE MEMORY FOR STACK TABLE #LU NOP TABLE LENGTH JMP .ER02 ERROR, NOT ENOUGH MEMORY JMP .ER02 ERROR, NOT ENOUGH MEMORY ADA DM1 OK, A=TABLE ADDR, DO -1 TO USE X REG STA .STKT INIT STACK TABLE ADDR. SPC 1 LDY #LU STAR4 JSB .MGTG ALLOCATE MEMORY FOR EACH STACK STKLN NOP STACK LENGTH .ER02 JSB ERRAB NOT ENOUGH MEMORY TO ALLOCATE JMP *-1 ALL STACKS: ERROR # 02 --> ABORT !!! SAY .STKT,I SAVE ADDR. OF STACK IN STACK TABLE LDB BIT15 SET IN FIRST WORD STB A,I STACK NOT ACTIVE ADA T4OFS CLEAR LINK WORD (TEMP4 IN THE STACK) CLB STB A,I DSY MORE LU ? JMP STAR4 YES, ALLOCATE AN OTHER STACK SPC 2 * ALLOCATE ALL NEEDED CLASS I/O SPC 1 JSB WRI/O SAVE PRG. SCHEDULE PARAM INTO CB0 (STKPT MUST=100001) LDA CLASS RECALL CLASS I/O WORD FOR CB0 IOR BIT13 SET "DO NOT DEALLOCATE CLASS" BIT STA CLAS0 AND SET CLASS I/O TO BE USED FOR CB0 CLA,INA RESET I/O BUF LENGTH STA WRI/L * CLA RESET CLASS WORD STA CLASS TO ALLOCATE A NEW CLASS FOR THE JSB WRI/O TMS-FMP CALL, LENGTH OF BUFFER IS ONE LDA CLASS TO INDICATE THAT THE DIRECTORY IS EMPTY IOR BIT13 SET "DO NOT DEALLOCATE CLASS" BIT STA FMPCL SET THE TMS-FMT CLASS I/O WORD * JSB GTCLW GET A CLASS I/O WORD STA MCLAS SET MAIN CLASS I/O JSB GTCLW GET A CLASS I/O WORD STA ICLAS INIT INTERNAL CLASS I/O JSB GTCLW GET ANOTHER CLASS I/O WORD STA CLASS INIT EXTERNAL CLASS I/O IOR =B40000 SAVE BUFFER CLASS STA CLASG SPC 2 * INITIATE ALL TMS-SYSTEM PROGRAM: TMSL/TMST/TMSIM SPC 1 LDA .TMSL SCHEDULE TMS LINK PRG. STA SCHFL SET SCHEDULE FLAG "WITH WAIT" JSB SCHUP HLT 11B PROGRAM MISSING !!! * LDA .TMST SCHEDULE TMS TIMER PRG. JSB SCHUP HLT 12B PROGRAM MISSING !!! SPC 2 LDA IMAGE,I GET THE NUMBER OF DATA-BASES SZA,RSS ANY DB DEFINED IN THIS APPLICATION ? JMP STAR6 NO, FORGET DB OPEN REQUEST CLB,INB YES, OPEN ALL THE DATA-BASES * STA53 STB TEMP SAVE DB # BLF,BLF ROTATE DB# INTO BITS 15-13 BLF,RBL CLA OPEN DATA BASE REQUEST JSB IMRQT SCHEDULE TMS-IMAGE-MODULE PROGRAM JMP STAR6 LAST DATA BASE HAS BEEN OPEN JMP STA58 RETURN OK CONTINUE STA55 DST BUF ERROR RETURN, SET IMAGE ERR# & RQ # .ER21 JSB ERRAB AND PROCESS IMAGE ERROR (NEVER COME BACK) SPC 1 STA58 CMA,INA DBOPN IS OK, A REG CONTAINS NEG INTERNAL DB NO. STA .IMF4,I LDB IMRQ2 ADB D3 INIT THE DBOPEN TABLE LDA IMBF+1 SET THE INITIAL LOCKID WORD STA B,I AFTER PROG. NAME INB LDA .IMF4 MOVE THE CLASS I/O - DB CRC - MVW D5 INTO THE DBOPEN TABL. * LDB TEMP RECALL DB# INB AND TRY TO OPEN THE NEXT DATA-BASE JMP STA53 SPC 2 * INTERNAL INITIALISATION PHASE IS COMPLETED: * =========================================== * * START UP PROCESSES, THE INITIAL & ALL * INTERCATIVE PROCESSES. SPC 1 STAR6 CCA SET ABORT TMS WHEN ERROR FLAG STA NOABT CLA SET SCHEDULE FLAG "NO-WAIT" STA SCHFL * LDA PNXXX,I GET NAME ADDR OF THE INITIAL-PROCESS SZA INITIAL-PROCESS ? JMP ISPRL YES, SET IT UP STAR8 JSB STIPR NO, START ALL INTERACTIVE PROCESSES SPC 1 JMP IDLE SPC 2 UPTEN DEC 5 UPT TABLE ENTRY LENGTH TUSEN DEC 5 TUS TABLE ENTRY LENGTH AS0CM OCT 54 COMMA RU ASC 1,RU ON ASC 1,ON HED . CONSTANT, VARIABLE AND UTILITIES FOR THE START-UP PHASE IOPTN OCT 140001 LU LOCK/NO WAIT/NO ABORT O72 OCT 72 O40 OCT 40 @APLN DBL APLNM O77 OCT 77 LBYTE OCT 177400 O114C OCT 11400 BIT13 OCT 20000 CLASG NOP UNBMS ASC 5, EQ,XX,UN UNBUFFERED THE LOG DEVICE SPC 2 IDSG? NOP STA IDSG3 SAVE PROGRAM NAME ADDR JSB IDGET CHECK IF IDSEG IS THERE DEF *+2 IDSG3 NOP PNAME SZA,RSS IDSEG HERE ? JMP IDSG6 NO, ERROR * JSB DORMT PROGRAM DORMANT ? DEF *+2 DEF IDSG3,I PROGRAM NAME ADDR. SSA DORMANT ? JMP IDSG?,I YES, RETURN * LDA IDSG3 NO, DO AN 'OF,PNAME,1' LDB .IDS8 TO MAKE IT DORMANT MVW D3 MOVE PROG. NAME INTO THE BUFFER JSB MESSS CALL SYSTEM PROCESSOR MESSAGE DEF *+3 DEF IDS8 MESSAGE BUFFER DEF D12 MESSAGE LENGTH JMP IDSG?,I AND RETURN * IDSG6 LDA IDSG3 NO, PUT PNAME IN MESSAGE LDB .MS04 MVW D3 LDA IDSG7 MVW =D4 LDA .MS0 JSB OUTM OUTPUT "TMS 00 PNAME MISSING" JMP ABT3 EXIT. * IDSG7 DEF *+1 ASC 4,MISSING .IDS8 DEF IDS8+2 IDS8 ASC 6, OF,XXXXXX,1 SPC 2 IMRQT NOP DST IMBF SET IMAGE RQ CODE LDA B ALF,RAR ROTATE AND ISOLATE DB# AND D7 STA DB# SAVE DB# INTO B REG ADA .DB INDEX IN DBOPEN TABEL LDA A,I STA IMRQ2 SAVE PRGRAM NAME ADDR. LDA DB# RECALL DB# CMA,INA AND VERIFY IF THE DATA BASE EXIST ADA IMAGE,I ADD TO MAX DB# SSA DATA BASE DEFINED ? JMP IMRQT,I NO, RETURN P+1 LDA IMRQ2,I RECALL 1ST WORD OF PRG NAME SZA PRG NAME DEFINED ? JMP IMRQ1 YES, CONTINUE LDA IMBF NO, RECALL RQ CODE SZA OPEN REQUEST JMP IMRQT,I NO, RETURN P+1 (DB UNDEFINED) IMRQ1 JSB DBNAD RETREIVE DB NAME ADDR FROM DB# LDB .IMF4 MOVE THE DB OPEN INFORMATION MVW D9 INTO THE BUFFER THAT WILL BE SEND TO LDB IMRQ2 THE TMS-IMAGE MODULE, SAVE PROGRAM MVW D3 NAME INTO THE DBOPEN TABLE INB MOVE WHATEVER IS IN IMAGE INTERNAL DB# SLOT STB IMBF+2 INTO BUFFER, (IN CASE CALL IS DBCLS) ISZ IMRQT RETURN ADDR WILL BE P+2 OR P+3 * JSB EXEC SCHEDULE TMS-IMAGE-MODULE DEF *+10 DEF NAB23 QUEUE SCHEDULE WITH WAIT & NO-ABORT IMRQ2 NOP PROGRAM NAME DEF LU 1ST PARAM DEF * DEF * DEF * DEF * DEF IMBF STRING PASSING BUFFER DEF D14 STRING LENGTH JMP IMRQ5 ERROR RETURN (PROGRAM NOT PRESENT) JSB RMPAR RETURN OK, GET PARAMATER BACK DEF *+2 .IMF4 DEF IMBF+4 DLD IMBF+4 SSA IMAGE REQUEST OK ? (NEG - OK, POS - ERROR)!!!!!! * IF OK, THEN A CONTAINS NEG IMAGE INT. DB NO. JMP IMRQT,I YES, RETURN P+2 IMRQ4 LDB IMBF NO, RECALL IMAGE RQ CODE ISZ IMRQT AND RETURN P+3 JMP IMRQT,I * IMRQ5 LDA D450 PROGRAM NOT LOADED = ERROR # 1 JMP IMRQ4 SPC 2 DBNAD NOP RETEIVE THE DB NAME ADDR. FROM THE DB# LDA DB# RECALL DB# ADA DM1 INDEX INTO THE DATA BASE DEFINITION TABLE MPY D12 TO RETEIVE DATA BASE CHARACTERISTICS. INA SKIP THE DB COUNT ADA IMAGE INDEX IN THE DEFINITION TABLE. JMP DBNAD,I SPC 2 * DBOPEN DATA BASE * * FORMAT: * ------- * * 4 ENTRIES (ONE FOR EACH POSSIBLE DATA BASE) * 9 WORDS PER ENTRY * * 3 WORDS - TMS-IMAGE-MODULE NAME * 1 WORD - INITIAL LOCKIDWORD ( TMS DB# / PID ) * BIT 15-13 / 12-0 * 1 WORD - IMAGE INTERNAL DB# * 1 WORD - CLASS I/O (USED TO SEND RQ TO TMS-IMAGE-MOD.) * 1 WORD - DATA BASE CRC * 1 WORD - MAXIMUM ITEM LENGTH IN WORDS * 1 WORD - MAXIMUM ENTRY LENGTH IN WORDS SPC 2 DB# NOP HOLD THE DATA BASE NUMBER * .DB DEF * DEF .DB1 DEF .DB1+9 DEF .DB1+18 DEF .DB1+27 * .DB1 EQU * REP 36 DEC 0 SPC 2 IMBF BSS 13 BUFFER SEND TO TMS-IMAGE-MODULE DEC 1 SPC 2 * * * APLNM BSS 3 SPC 2 SPC 2 STIPR NOP START ALL INTERACTIVE PROCESSES LDA STKPT SAVE STACK POINTER STA STIP4 CLA STA SCODE SUBROUTINE CODE=0 FOR START TMS STA SPR80 CLEAR CALL TO THIS ROUTINE (ONLY ONCE) STA STAR8 " " " " STA .PAR5+4 INIT DEFAULT LOCK ID WORD (INIT CB1(7)) * LDX DM1 LAX .TMLU,I GET # OF INTERACTIVE DEVICES CAX STIP2 LBX .STKT,I JSB INSTK INITIALIZE STACK JSB WRI/O START UP THE PROCESS DSX MORE INTERACTIVE DEVICES ? JMP STIP2 YES, CONTINUE LDA STIP4 NO, RESTORE STACK POINTER STA STKPT AND EXIT. JMP STIPR,I * STIP4 NOP .STKT NOP ADDR OF STACK TABLE ADDR - 1 (USAGE OF X) SPC 2 ILRQ STA TEMP NOP HLT 20B HED . T M S --- I D L E L O O P --- EXITZ JSB WRI/O QUEUE UP THIS PROCESS SPC 2 IDLE RSS FLAG TO SCAN/NOT SCAN THE EXT. EVENT WAIT QUEUE JMP IDLEZ LDB .EXTW,I SCAN THE EXTERNAL EVENT WAIT QUEUE SZB,RSS QUEUE EMPTY ? JMP IDLEZ YES, SUSPEND TMSYS ON THE CLASS I/O GET !! * LDB .EXTW NO, GET QUEUE HEAD IDLEQ STB EXTWP SAVE QUEUE POINTER LDB B,I GO AHEAD IN THE QUEUE SZB,RSS END OF QUEUE ? JMP IDLEY YES, SET IDLE LOOP TIMING ADB T3MOF NO, SET B=STACK POINTER LDA B,I A=S REG. LDA A,I A=SUBROUTINE ADDR JSB A,I TRY TO RESTART THE PROCESS LDB EXTWP,I GET NEXT ELEMENT OF THE QUEUE JMP IDLEQ AND LOOP UNTIL END. SPC 1 IDLEZ JSB EXEC CLASS I/O GET DEF *+7 DEF D21 DEF CLASG SAVE BUFFER .BUF DEF BUF DEF DM8 DEF STKPT GET BACK STACK ADDR .SCOD DEF SCODE GET BACK SUBROUTINE CODE SSA HLT 22B STA TEMP SAVE STATUS OF THE LAST OPERATION SPC 2 LDA SCODE GET SUBROUTINE CODE SSA SPECIAL OPERATION FROM TMSB ? HLT 24B YES, PROCESS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ADA C.TAB NO, INDEX IN TABLE JMP A,I AND JMP TO RIGHT CODE SPC 2 * EXTERNAL EVENTS WAIT QUEUE PROCESS AND * IDLE LOOP TIMING. SPC 1 IDLEY CLA DO NOT SCAN THE EXT. EVENTS WAIT QUEUE STA IDLE IF WAITING ON THE IDLE LOOP TIMING LDA .DSTK GET DUMMY STACK ADDR STA STKPT TO SET STACK POINTER LDA PAUCD AND SIMULATE A PAUZ REQUEST STA SCODE FOR THAT DUMMY STACK. LDA =D100 PAUSE FOR 1.00 SECONDS STA .PAR1 JMP PAUS EXECUTE PAUSE CODE SPC 1 IDLEX LDA .RSS RETURN FORM THE TIMER, STA IDLE RESTORE THE SCANNING OF THE EXT. EVENT JMP IDLE WAIT QUEUE SPC 1 * DUMMY STACK USED FOR IDLE LOOP TIMING. SPC 1 .DSTK DEF *+1 DUMMY STACK ADDR (DO NOT MIX NEXT WORDS !!) * DEF *+13 DUMMY S REG. DEF *+11 DUMMY Q REG. EXTWP NOP QUEUE POINTER .EXTW DEF *+1 EXTERNAL EVENT WAIT QUEUE HEAD OCT 0 O40K OCT 40000 PAUCD DEC 12 BSS 5 TEMP1/TEMP4 ON THE STACK OCT 40002 VERY 1ST TMS SUB. # (SPECIAL WITH BIT14) OCT 0 RTN ADDR OF THE DUMMY STACK SPC 2 DEXTW NOP DEQUEUE FROM EXTERNAL EVENT WAIT QUEUE STB STKPT B MUST = STACK POINTER ADB T3OFS TO ACCESS THE LINK WORD LDA B,I GET NEXT LINK IN THE QUEUE STA EXTWP,I TO REPLACE THE CURRENT ENTRY CLA STA B,I CLEAR LINK WORD IN THE STACK JMP DEXTW,I SPC 2 IDL00 JSB RELBU RELEASE THE BUFFER CLASS AND FORGET JMP IDLE (THOSE CALL NEVER RETURN TO TMLIB) SPC 1 IDL02 JSB RELBU RELEASE THE BUFFER CLASS AND IDL03 JSB SETST SAVE STATUS & TLOG INTO CB1 WORD 4&5 JMP EXIT4 AND RETURN TO 'TMLIB' SPC 1 IDL04 JSB RELBU RELEASE THE BUFFER CLASS AND IDL41 CLA RESET STATUS & TLOG IDL42 CLB JMP IDL03 SPC 1 IDL06 JSB RELBU RELEASE THE BUFFER CLASS AND JMP EXIT4 RETURN TO 'TMLIB' WITHOUT UPDATING STATUS. SPC 1 IDL08 LDA DM4 DELAY THAT REQUEST, WAIT FOR A MAXIMUM LDB .IDL8 1 SEC, BUT CHECK QUEUE LEN EVERY 250 MS JSB WAIT SUSPEND PROGAM IDL82 JSB #REQU TIME ELAPSED, DO THE REQUEUE NOW DEF *+3 DEF CLASS DEF CLASS SZA REQUE OK ? HLT 40B ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *REQ JSB DMPTM *REQ DEF *+7 *REQ DEF D6 *REQ DEF LU *REQ DEF D20 *REQ DEF REQM1 *REQ DEF D20 *REQ DEF D1 JMP IDLE DEC 100 * .IDL8 DEF *+1 NOP CHECK QUEUE LENGTH JSB NRCLS RETREIVE THE NUMBER OF COMPLETED DEF *+2 REQUESTED PENDING ON THAT I/O CLASS DEF CLASS COMPLETION QUEUE CPA D1 ONLY ONE ? JMP .IDL8+1,I YES, THE ONE TO BE REQUE JMP IDL82 NO, REQUE NOW TO GET OTHER PENDING RQ SPC 2 WAIT NOP SUSPEND ITSELF FOR SMALL PERIOD OF TIME STB WAITX SAVE ADDR. OF THE CHECK CONDITION ROUTINE SSA,RSS MAKE TIME COUNTER NEGATIVE CMA STA WAITY WAIT2 JSB WAITX,I CHECK FOR THE CONDITION JSB EXEC SUSPEND ITSELF DEF *+6 FOR .25 SEC. DEF D12 TIMED EXECUTION (INITIAL OFFSET) DEF D0 PROGRAM NAME (CALLING PROGRAM) DEF D1 RESOLUTION CODE (1/100 SEC.) DEF D0 EXECUTION MULT. (ONLY ONCE) DEF DM25 TIME (250 MS) ISZ WAITY CONDITION NOT MET YET, WAIT MORE ? JMP WAIT2 YES, WAIT LONGER JMP WAIT,I NO, RETURN TO CALLER * WAITX NOP WAITY NOP HED TMS RETURN TO USER PROGRAM (RETURN INTO 'TMLIB') EXIT3 CCA SET REQUEUE FLAG STA RQU? AND RETURN TO TMLIB SPC 1 EXIT4 CCA STA SRFLG SET SEND MAIL-BOX FLAG DLD STKPT,I DST S SET S & Q REGISTER * INB LDA B,I STA RTRNA SET RETURN ADDR SPC 1 LDA Q,I RECALL TMS SUBROUTINE NUMBER CLE CLEAR BIT15 AND ELA,CLE,ELA SAVE BIT14 INTO E RAR,RAR SEZ SPECIAL RETURN ? JMP SEXIT YES, SPECIAL RETURN PROCESSING MPY TUSEN NO, RETURN TO TMLIB ADA .TMSB RETREIVE PRG NAME STA .EPAO INIT 'ENTRY POINT ADDR OF SUB' ADDR ADA DM1 TO GET PROGRAM NAME ADDR LDA A,I GET PROGRAM NAME ADDR STA PNADR SET IT TO THE SCHEDULE RQ LDB RTRNA GET RETURN ADDR SZB FIRST TIME ENTRY ? JMP EXIT6 NO, SKIP CALCULATION OF LOCAL SUB # ADA UPTEN YES, COMPUTE LOCAL SUB # ADA DM1 LDA A,I CMA,INA INA ADA .EPAO DIV TUSEN B IS ALREADY CLEARED CMA,INA MAKE IT NEGATIVE FOR THE FIRST ENTRY STA RTRNA SET RTN ADDR TO NEG. LOCAL SUB # SPC 1 EXIT6 LDA .EPAO,I GET 'ENTRY POINT ADDR OF SUB' STA EPAOS * LDA LEN00 SET CB0 LENGTH IF IT IS DEFINED LDB Q,I INSIDE THIS TMS SUBROUTINE SSB,RSS CB0 DEFINED ? CLA NO, CB0 LEN = 0 STA LEN0 YES, SET CB0 LEN * LDA STKPT ADA T1OFS MOVE FUNCTION PARAMETERS LDB .FPAR FROM THE STACK INTO THE BUFFER SEND MVW #FPAR TO TMLIB. (3 FUNCTION PARAMETERS) LDA Q GET ADDRESS IN THE STACK ADA QCBLA TO MOVE CB DEFINITION MVW D11 MOVE CB'S DEFINITION SPC 1 JSB SRCB SEND ALL NEEDED CB'S SPC 1 LDA RQU? RECALL REQU FLAG SZA,RSS REQU NEEDED ? JMP EXIT8 NO, CONTINUE * JSB #REQU YES, REQUEUE THE PENDING BUFFER DEF *+3 FROM THE TMS EXTERNAL CLASS I/O DEF CLASS TO THE TMS INTERNAL CLASS I/O DEF ICLAS SZA REQUEUE OK ? HLT 25B !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *REQ JSB DMPTM *REQ DEF *+7 *REQ DEF D6 *REQ DEF LU *REQ DEF D20 *REQ DEF REQM2 *REQ DEF D20 *REQ DEF D1 CLA RESET THE REQUEUE FLAG STA RQU? SPC 2 EXIT8 LDA PNADR RECALL PROGRAM NAME ADDR JSB SCHUP SHEDULE PROGRAM (USER PARTITION) HLT 30B ERROR RETURN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SPC 1 CLA STA SRFLG SET RECEIVE MAIL-BOX FLAG * LDA ICLAS SWAP THE MAIN & THE INTERNAL LDB MCLAS CLASS I/O WORD STA MCLAS STB ICLAS * JSB MAILB SUSPEND TMSYS ON THE MAIN CLASS I/O DEF LCLAS TO WAIT THAT THE UPT RETURN TO TMSYS ABS PARLN WITH THE REQUEST ON THIS CLASS SPC 2 ************************************************************************** SPC 2 LDA ICLAS SWAP BACK THE MAIN & THE INTERNAL LDB MCLAS CLASS I/O WORD TO RESTORE THEM STA MCLAS STB ICLAS SPC 1 LDA SCOD. RESTORE SCODE STA SCODE CPA ABTFL ERROR IN TM-LIBRARY ? JMP TMLER YES, PROCESS IT SPC 1 LDB Q SAVE RETURN ADDRESS INB INTO THE STACK LDA RTRN. STA B,I LDA LCLAS GET LOCAL CLASS I/O SZA,RSS PROGRAM SUSPENDED ON CLASS I/O JMP SAV25 NO, CONTINUE * IOR BIT15 YES, SET BIT 15 TO DIFFERENTIATE FROM PNAME CPA PNADR,I FIRST TIME ? JMP SAV25 NO, CONTINUE STA TEMP YES, SAVE IT TEMPORARILY JSB IDGET RETREIVE ID SEG ADDR DEF *+2 DEF PNADR,I RETURN WITH A = IDSEG ADDR LDB A SET B = IDSEG ADDR LDA TEMP AND REPLACE PNAME WITH CLASS I/O WORD DST PNADR,I AND ID SEG ADDR IN PLACE OF PNAME SPC 1 SAV25 CCA SET 'NO ABORT FLAG' FALSE STA NOABT I.E.: ERRORS WILL ABORT TM SPC 1 JSB SRCB SAVE CB'S DATA INTO THE EMA ARRAY SPC 1 SAV40 CLA SET 'MEMORY SUSPEND FLAG' STA MSUFL I.E.: PROCESS WILL BE SUSPENDED LDA SCODE RECALL SUBROUTINE CODE ADA I.TAB JMP A,I SPC 1 RQU? OCT 0 REQUEUE FLAG (NOT 0 IF REQUEUE IS NEEDED) SPC 3 * SPECIAL RETURN INSIDE TMSYS INSTEAD OF * RETURNING TO TMLIB. SPC 1 SEXIT ADA .SEXI INDEX INTO RETURN TABLE JMP A,I AND GO EXECUTE THE PROPER STATEMENT SPC 1 .SEXI DEF *+1,I SPECIAL RETURN TABLE DEF SPR80 0 RETURN FROM AN AUXILIARY PROCESS DEF .ER07 1 RETURN FROM AN INTERACTIVE PROCESS --> ERROR DEF IDLEX 2 IDLE LOOP TIMING RETURN SPC 2 .ER07 JSB ERRAB ERROR # 7: RETURN FROM AN INTERACTIVE PROCESS SPC 4 SRCB NOP CLA INIT THE NUMBER OF DEFINED CB'S STA #DFCB LDA Q GET POINTER TO CB'S DEFINITION ADA QCBLA INTO THE STACK LDX A,I GET CB1 LOCAL ADDR LDB STKPT SET UP LOGICAL CB ADDR ADB D2 POINTER INTO THE STACK STB PT * SRCB1 INA INCREMENT CB'S DEFINITION PT CPA S END OF STACK ? JMP SRCB,I YES, RETURN LDB A,I NO, GET CURRENT CB LENGTH RBL,CLE,ERB CLEAR BIT15, E=ENABLE/DESABLE FLAG SEZ CB ENABLED ? JMP SRCB8 NO, GOTO NEXT CB STA TEMP YES, SAVE A (CB DEFINI. PT) LDA PT,I GET LOGICAL CB ADDR. SZA,RSS ALLOCATED ? HLT 32B NO, ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB MAPCB MAP CB DATA, RETURN ADDR. OF CBX(1) DST SRCB6 SET ACTUAL CB ADDR & CURRENT CB LENGTH SPC 1 LDB PNADR GET SYSTEM COMMON/CLASS I/O FLAG ADB D3 IT IS BIT15 OF WORD FOLLOWING PNAME LDB B,I SSB,RSS SYSTEM COMMON BEING USED ? JMP SRCB5 NO, GO USE CLASS I/O * LDB SRFLG YES, CHECK SEND/RECEIVE FLAG SZB SEND ? JMP SRCB3 YES, MOVE FROM MEMORY TO COMMON CXA NO, MOVE FROM COMMON TO MEMORY LDB SRCB6 GET TO ADDR (INTO EMA ARRAY) JMP SRCB4 AND GO PERFORM THE MOVE SRCB3 CXB SEND, GET TO ADDR (SYSTEM COMMON) SRCB4 MVW SRCB6+1 MOVE DATA * DST PARM1 * JSB DMPTM * DEF *+7 * DEF D6 * DEF SRCB6,I * DEF SRCB6+1 * DEF MES3 * DEF D10 * DEF D1 * DLD PARM1 JMP SRCB7 AND CONTINUE FOR NEXT CB * SRCB5 JSB MAILB SEND/RECEIVE COMMON BLOCK DATA SRCB6 BSS 2 * SRCB7 LDA TEMP RESTORE CB'S DEFINITION POINTER SPC 1 SRCB8 INA BUMP CB'S DEFINITION PT ADX A,I MAINTAIN LOCAL CB ADDR. INTO X REG ISZ PT BUMP LOGICAL ADDR PT ISZ #DFCB BUMP NUMBER OF DEFINED CB'S JMP SRCB1 AND LOOP UNTIL END SPC 2 STKPA JSB STKP. STACK PARAM .ADDR. JMP IDLE AND EXIT * STKP. NOP SAVE ADDR OF THE 3 FUNCTION PARAMETERS LDA ..PA1 LDB STKPT INTO THE STACK ADB T1OFS MVW #FPAR JMP STKP.,I AND GO TO IDLE LOOP. * .FPAR DEF FPARM ..PA1 DEF .PAR1 NOABT NOP .EPAO NOP PNADR NOP PROGRAM NAME ADDRESS HED START-UP TMS PROCESSES START JSB RELBU DLD STKPT,I INIT S & Q REGISTERS DST S * ISZ B,I SET VERY 1ST TUS# FOR INTER. PROCESS CLA SET STOP-INHIBIT FLAG TO 0 ADB DM1 (TMS CAN BE STOPPED DURING A INTERACTIVE STA B,I PROCESS) * LDA PNX00 MOVE STARTING PROCESS NAME LDB ..PA1 IN PLACE OF PARAMETERS TO MVW D3 SIMULATE A TM SUBROUTINE CALL. JMP SPR88 SPC 4 * * RESTART THE PROCESS AFTER * A MEMORY SUSPEND OPERATION. SPC 1 MSU50 JSB RELBU DLD STKPT,I RESTART PROCESS DST S LDB ..PA1 RESTORE CALLING SEQUENCE MVW D10 AT THE TIME OF THE MEM. SUSP. LDA STKPT ADA T2OFS RETREIVE SUBROUTINE CODE OF LDA A,I SUSPENDED OPERATION STA SCODE AND JMP SAV40 RESTART FROM THE SUSP. POINT SPC 3 T1OFS DEC 7 OFFSET FROM BEGINNING OF STACK TO TEMP1 T2OFS DEC 8 OFFSET FROM BEGINNING OF STACK TO TEMP2 T3OFS DEC 9 OFFSET FROM BEGINNING OF STACK TO TEMP3 T4OFS DEC 10 OFFSET FROM BEGINNING OF STACK TO TEMP4 T3MOF DEC -9 NEG. OFFSET FROM BEGINNING OF STACK TO TEMP3 NSOFS DEC 11 OFFSET FROM BEGINNING OF STACK TO STP-INHIBIT TYOFS DEC 12 OFFSET FROM BEGINNING OF STACK TO STACK TYPE HED WRITE/READ AND LOGGING REQUEST WRRQ JSB RELBU RELEASE OUTPUT BUFFER LDA STKPT RECALL STACK POINTER ADA T2OFS RETREIVE FUNCTION PARAMATERS STA WRRQ3 SET READ BUFFER LENGTH INA TO GET USER SUPPLIED CTL BIT LDB A,I GET USER SUPPLIED CTL BIT LDA STKPT ADA D2 LDA A,I GET CB1 LOGICAL ADDR JSB GCBAD MAP THE FIRST 1025 WORDS INA TO GET CTL BIT FROM CB1 SZB,RSS USER SUPPLY THE CTL BIT ? LDB A,I NO, GET THE STANDARD ONE SWP YES, KEEP IT AND EXCHANGE A & B AND =B177400 ISOLATE CTL BITS RAR,RAR POSITION CTL BIT ADB DM1 TO RETREIVE LU IOR B,I MERGE WITH LU STA TEMP SAVE CONTROL WORD JSB EXEC DO THE READ REQUEST DEF *+10 DEF D17 READ REQUEST DEF TEMP LU DEF * BUFFER ADDR. WRRQ3 NOP BUFFER LENGTH DEF STKPT 1ST PARAM (STACK POINTER) DEF D1 2ND PARAM (SCODE FOR READ RQ) DEF CLASS CLASS I/O WORD DEF * PLACE HOLDER DEF RNLCK BYPASS THE LU-LOCK CHECK JMP IDLE RETURN SPC 1 SPC 2 LOGRT LDA BUF RECALL DCLOG STATUS LDB BUF+1 GET SUBROUTINE CODE SZA OK? JSB LOGER NO, KILL PROGRAM JMP IDL04 YES, IT IS OK, RELEASE BUF AND RETURN TO TMLIB * HED IMAGE REQUEST IMULK LDX #LU BEFORE UNLCK, CHECK IF LOCKID IS USED ! SPC 1 IMUL2 LBX .STKT,I B=STACK POINTER LDA B,I GET S VALUE SSA STACK ACTIVE ? JMP IMUL7 NO, FORGET IT ADB D2 ADDR. OF ACTUAL CB1 ADDR LDA B,I RETREIVE CB1 ADDR. (0 IF NOT ALLOCATED) ADB DM2 RESTORE B=STACK POINTER JSB GCBAD MAP 1025 FIRST WORDS OF CB & RETURN ADDR. SWP SWAP A & B REG. ADB D11 ADDR. OF CB1(12) (LOCK ID WORD) ADA T2OFS PRESET A TO GET LOCKID FROM STACK AT TEMP2 CPB D11 CB1 ALLOCATED ? LDB A NO, THEN THE LOCKID IS STILL ON STACK ADA D2 PRESET A TO EXAMINE THE WAITING QUEUE JMP IMUL5 AND GO CHECK THIS LOCK ID WORD * IMUL4 LDA A,I GO DOWN IN THE WAITING QUEUE SZA,RSS END OF WAITING QUEUE ? JMP IMUL7 YES, GO TO NEXT STACK LDB A NO, RETREIVE THE LOCK ID FROM ADB D9 THE WAITING BLOCK IN MEMORY IMUL5 JSB .IMU2,I CHECK THIS LOCKID, B=ADDR. OF LOCKID JMP IMUL4 CONTINUE UNTIL END OF WAITING QUEUE * IMUL7 DSX GO TO NEXT STACK JMP IMUL2 UNTIL END OF TABLE JMP .IMU4,I ALL STACK HAVE BEEN CHECKED, EXIT SPC 2 .IMU4 DEF *+1 AND THIS LOCKID IS NO LONGER USED JSB RELBU RELEASE THE BUFFER LDB BUF RECALL THE LOCKID WORD TO JSB IMULO RELEASE ALL RECORDS LOCK TO THIS ID JMP IDLE RETURN OK JMP STA55 ERROR RETURN, ABORT TMS APPLICATION ! SPC 2 IMULO NOP ROUTINE TO PERFORM THE UNLOCK REQUEST LDA D8 IMAGE RQ=8 FOR UNLOCK REQUEST JSB IMRQT SCHEDULE TMS-IMAGE-MODULE PROGRAM HLT 40B IMAGE NOT THERE JMP IMULO,I RETURN OK ISZ IMULO GO PROCESS FATAL IMAGE ERROR. JMP IMULO,I SPC 2 .IMU2 DEF *+1 SUBROUTINE ENTRY POINT ADDR NOP SUBROUTINE ENTRY POINT LDB B,I GET THE LOCK ID WORD CPB BUF IS IT USED ? JMP IDL08 YES, DELAY THE UNLOCK REQUEST JMP .IMU2+1,I NO, CONTINUE THE SEARCHING *DLD1 JSB DMPTM *** DEF *+7 *** DEF D6 *** DEF LU *** DEF D100 *** DEF IDMS1 *** DEF D20 *** DEF D1 *** JMP IDL08 *DLD2 JSB DMPTM *** DEF *+7 *** DEF D6 *** DEF LU *** DEF D100 *** DEF IDMS2 *** DEF D20 *** DEF D1 *** JMP IDL08 *DMS1 ASC 10,1FROM .IMU2 *DMS2 ASC 10,1FROM TSP40 *100 DEC 100 * SPC 3 * IMAGE REQUEST: * IF NOT DBOPN REQUEST, STACK PARAMETER AND RETURN * * IF DBPON, RE-INIT CB1[6:13] AND RETURN * DIRECTLY TO 'TMLIB'. * * FORMAT OF CB1[6:13] * * WORD 1 - 3 IMAGE MODULE NAME * 4 CLASS I/O WD * 5 MAX ITEM LENGTH * 6 MAX ENTRY LENGTH * 7 TMS DB# / LOCK ID * 8 IMAGE INTERNAL DB# * * SPC 1 IMGRQ LDA .PAR1+14 RECALL IMAGE RQ SZA DBOPN RQ ? JMP STKPA NO, STACK PARAM. AND EXIT * CLB,INB YES, MAP THE CB1 JSB COM.U STA TEMP SAVE CB1 ACTUAL ADDR ADA D13 SAVE ALSO ADDR OF CB1(14) WHERE STA TEMP1 THE IMAGE STATUS SHOULD BE RETURNED * LDA IMAGE,I GET THE NUMBER OF DATA BASES SZA,RSS ANY DB DEFINED IN THIS APPLICATION ? JMP IMG30 NO, RETURN ERROR # 398 CMA,INA STA TEMP2 IMAGE DB COUNTER CLA,INA STA DB# INIT DB# * CLA,INA STA DUMMY JSB NAMR PARSE INPUT DATA BASE NAMR DEF *+5 DEF BUF OUTPUT BUFFER: * WDS 1-3 - D.B. NAME * WD 4 - TYPE CODE * WD 5 - SEC. CODE * WD 6 - CR. NO. DEF .PAR5 INPUT BUFFER (NAMR) DEF D19 19 CHAR. MAX DEF DUMMY * IMG12 JSB DBNAD RETRIEVE THE DB NAME ADDR FROM THE DB# LDB .BUF ADDR OF DB NAME FROM OUTPUT BUFFER CMW D3 DB NAME COMPARE ? JMP IMG14 YES, TEST SEC. CODE AND CR. NO. NOP JMP IMG16 * IMG14 ADA D3 INB CMW D2 MAKE SURE THAT SEC. CODE AND CR. NO. MATCH JMP IMG20 EVERYTHING MATCHES, DATA BASE FOUND!! NOP NO MATCH IMG16 ISZ DB# NO, CHECK THE NEXT DATA-BASE ISZ TEMP2 ANY DATA-BASE LEFT ? JMP IMG12 YES, CHECK IF IT IS THIS ONE IMG30 LDA =D398 NO, RETURN ERROR # 398 TO THE USER IMG33 STA TEMP1,I JSB STKP. STACK PARAMETER JMP EXIT4 AND RETURN TO 'TMLIB' IMMEDIATLY SPC 1 IMG20 CLA DBOPN SUCCED, RETURN GOOD IMAGE STATUS STA TEMP1,I TO THE USER ISZ TEMP1 STA TEMP1,I RETURN ACCESS LEVEL ISZ TEMP1 STA TEMP1,I RETURN RUN TABLE SIZE ISZ TEMP1 TO RETURN DB-CRC LDA DB# RECALL DB# TO INDEX INTO THE DBOPEN TABLE JSB ICB1I INIT CB1 FOR IMAGE ADA DM6 SET ADDR OF INITIAL LOCKID WORD MVW D2 STORE INITIAL LOCK ID WORD & IMAGE INTERNAL DB# INA SET ADDR OF DB-CRC LDA A,I GET DB-CRC TO RETURN IT INTO JMP IMG33 IMGAGE STATUS WORD 4, RETURN SPC 1 ICB1I NOP INIT CB1 FOR IMAGE. ADA .DB RETREIVE TMS-IMAGE-MODULE NAME, LDA A,I CLASS I/O, MAX ITM LN & MAX ENT LN. LDB TEMP CB1(1) ADDR ADB D5 CB1(6) ADDR MVW D3 MOVE TMS-IMAGE-MODULE PROG. NAME ADA D2 SKIP LOCKID AND IMAGE INTERNAL DB# MVW D1 STORE CLASS I/O INA SKIP DB CRC MVW D2 MOVE MAX ITM & MAX ENT LENGTH JMP ICB1I,I SPC 1 ..PA7 DEF .PAR1+6 DUMMY BSS 1 DUMM2 BSS 1 SPC 3 * RESTART THE PROCESS AFTER * AN IMAGE REQUEST SPC 1 IMRTN LDA BUF RECALL IMAGE ERROR CODE SZA,RSS FATAL ERROR ? JMP EXIT3 NO, SET REQUEUE FLAG AND RETURN TO USER * JSB RELBU YES, FATAL ERROR, RELEASE BUFFER CLB,INB MAP CB1 TO GET THE LOCKID WORD JSB COM.U AND THEN RETREIVE THE DB# ADA D11 LDA A,I A=LOCKID WORD ALF,RAR ISOLATE DB# AND D7 STA DB# JMP .ER21 AND ABORT TMS. HED COMMON-BLOCK ENABLE/DISABLE PROCESS CBENB LDA .PAR1 SET UP MEMORY SUSP. FLAG STA MSUFL AS REQUESTED BY THE USER LDA ..PA2 JSB MEMOK CHECK THAT THERE IS ENOUGH MEMORY LDA ..PA2 OK, PERFORM THE FUNCTION STA TEMP1 * CBEN3 LDA TEMP1,I GET PARAMETER SZA,RSS PARAMETER DEFINED ? JMP EXITZ NO, RETURN TO THE OTHER PROG. JSB GECB# YES, GET CB # JSB COM.E ENABLE & ALLOCATE THIS CB HLT 43B MEMORY SUSPEND RETURN SZA,RSS ALLOCATED DONE ? .ER05 JSB ERRAB NO, LOCAL CB LENGTH =0 ---> ABORT TMS ISZ TEMP1 GET NEXT PARAMETER JMP CBEN3 SPC 1 CBDES LDA ..PA1 STA TEMP1 * CBDE3 LDA TEMP1,I GET PARAMETER SZA,RSS PARAMETER DEFINED ? JMP CBDE5 NO, RETURN MEMORY AND EXIT JSB GECB# YES, GET CB # JSB COM.D DISABLE CB ISZ TEMP1 GET NEXT PARAMETER JMP CBDE3 * CBDE5 JSB CLECO RETURN FREE MEMORY TO MMGT JMP EXITZ EXIT SPC 1 CBLEN LDA .PAR1 CHANGE CB LENGTH JSB GECB# RETREIVE CB # JSB COM.U INIT A,B & Y STA TEMP1 SAVE CB ACTUAL ADDR LDB LCBLP,I RECALL LOCAL CB LENGTH LDA .PAR2 GET NEW LENGTH SSA NEW LENGTH OK ? .ER20 JSB ERRAB NO, IRRECOVERABLE ERROR, ABORT TMS SZA,RSS OK ? JMP .ER20 NO CBLE3 CMB MAKE - LOC. LENGTH - 1 ADB A NEW LEN - LOC. LEN - 1 SSB,RSS NEW MUST BE = < LOCAL LEN IN ANY CASE ! JMP .ER20 NEW LENGTH IS TOO BIG, ERROR LDB TEMP1 RECALL ACTUAL CB ADDR. SZB ENABLE OR 1ST TIME THROUGH ? JMP CBLE5 YES, CHECK FOR LENGTH WHEN ALLOCATED LDB CCBLP,I NO, RECALL CURRENT LEN TO GET ENABLE RBL,CLE,ERB MOVE ENABLE FLAG INTO E RAL,ERA AND SET ENABLE FLAG WITH NEW CURRENT LENGTH STA CCBLP,I STORE BACK NEW CURRENT CB LENGTH JMP EXIT4 AND RETURN. * CBLE5 ADB DM1 CHECK NEW LEN MUST BE = < LEN WHEN ALLOCATED LDB B,I RECALL LENGTH WHEN ALLOCATED CLA CLEAR 1ST TIME THROUGH STA TEMP1 LDA .PAR2 RESTORE A WITH NEW LENGTH JMP CBLE3 AND CHECK THAT IS CORRECT HED TM SUBROUTINE CALL/EXIT PROCESS SBCAL LDB STKPT CHECK FOR STACK OVERFLOW CMB,INB ADB S ADB =D25 (ALWAYS 10 EXTRA FREE WORDS ON STACK) CMB,INB ADB STKLN SSB STACK OVERFLOW ? .ER12 JSB ERRAB YES, ERROR ALWAYS ABORT !! DLD S NO, RECALL S & Q CMB,INB TO STACK THE NEW CALL ADB A COMPUTE 'DELTA Q' CMB (-X-1) ROOM FOR DELTA Q STB A,I SAVE MINUS DELTA Q IN THE STACK INA STA TEMP SAVE NEW Q REGISTER VALUE SPC 1 LDB ..PA1 RECALL TM-SUBROUTINE NAME/# ADDR JSB GTSU# GET TM-SUB # (A=TMSUB # ON EXIT) JMP SBCER ERROR RETURN (A = ERR#) STA TEMP,I SAVE TUS # INTO THE STACK LDA TEMP A=NEW Q CLB CLEAR THE STACK LDX QCBLA USE X REG AS COUNTER TO CLEAR THE STACK SBCA4 INA BUMP STACK PT STB A,I CLEAR /RTN ADDR/CB1 LOC ADDR./ DSX JMP SBCA4 LOOP UNTIL END INA SKIP ONE EXTRA WORD TO HAVE S NEW VALUE LDB TEMP GET NEW Q VALUE DST STKPT,I SAVE NEW S & Q REGISTER JMP EXITZ JMP EXIT4 = DO NOT LEAVE THIS PROCESS SPC 1 SBCER LDB D10 NO ABORT PROCESSING STB SCODE SET RETURN SUBROUTINE CODE CMA,INA SET STATUS WITH NEG. ERROR CODE JMP SBRT3 AND EXIT WITH TM-SUB RETURN CODE SPC 2 SBRTN JSB DSTAK AJUST THE STACK JSB CLECO DE-ALLOCATE ALL NECESSARY CB CLA SET STATUS TO OK SBRT3 CLB CLEAR TLOG AND JSB SETST STORE STAT. & TLOG IN CB1 WORD 4 & 5 JMP EXITZ JMP EXIT4 = DO NOT LEAVE THIS PROCESS SPC 3 GTSU# NOP GET TMS-SUB # (B=ADDR OF NAME/#) LDA B,I CHECK FOR THE "NO ABORT" BIT RAL,CLE,SLA,ERA CLEAR AND CHECK BIT 15 STA NOABT SET NOABT FLAG, IF NECESSARY STA B,I AND STORE BACK THE FIRST PARAMETER ADA =D-256 IS THE SUBROUTINE DEFINED SSA BY NAME ? JMP GTSU2 NO, IT IS THE SUBROUTINE # LDA .TMSB,I YES, SUBROUTINE CALL BY NAME STA TEMP1 SAVE # OF SUBROUTINE CMA,INA STA TEMP2 USE AS COUNTER STB TEMP4 SAVE B REG. * GTSU5 LDA TEMP2 ADA TEMP1 STA TEMP3 MPY TUSEN MPY BY T.U.S. TABLE ENTRY LENGTH INA ADA .TMSB LDB TEMP4 ADDR. OF ASKED FOR SUB. NAME CMW D3 JMP GTSU7 IT IS THIS ONE NOP LESS THAN ISZ TEMP2 GREATER THAN, MORE TM SUBROUTINE ? JMP GTSU5 YES, LOOP UNTIL END .ER10 JSB ERROR NO, SUBROUTINE NAME NOT FOUND JMP GTSU#,I NO ABORT PROCESSING * GTSU7 LDA TEMP3 INA A IS THE SUB # LDB TEMP4 RESTORE B REG STA B,I AND STORE TMS-SUB # IN PLACE OF NAME * GTSU2 LDA B,I IT IS THE SUBROUTINE # SZA,RSS JMP GTSUE ILLEGAL SUB # CMA,INA CHECK THE LEGALITY ADA .TMSB,I SSA IS IT LEGAL ? JMP GTSUE NO, ILLEGAL SUBROUTINE # LDA B,I YES, GET SUB # ISZ GTSU# RETURN OK JMP GTSU#,I SPC 1 .ER11 EQU * GTSUE JSB ERROR ILLEGAL TMS-SUB NUMBER JMP GTSU#,I IF NO-ABORT RETURN IN ERROR RETURN SKP DFINE LDA RQCNT THIS CALL MUST HAVE AT LEAST ADA =D-3 TREE PARAMETERS SSA OK ? .ER09 JSB ERRAB NO, ERROR --> ABORT TMS LDA Q,I RECALL TMS-SUBR. # IN ORDER AND =B37777 TO SET UP 'EPAOS', CLEAR BIT 14 & 15 MPY TUSEN ADA .TMSB A=ADDR OF 'EPAOS' LDB .PAR5+5 RECALL 'ENTRY POINT ADDR. OF SUBROUTINE' STB A,I FROM 'TMLIB' BUFFER TO SAVE IT. LDA Q CHECK THAT ADA QCBLA COMMON IS NOT ALREADY DEFINED INA CPA S COMMON ALREADY DEFINED ? .RSS RSS NO CONTINUE .ER14 JSB ERRAB YES, 2ND TMDFN IN SAME TMSUB --> ABORT TMS LDX DM1 SET UP LOAD INDEX LDY QCBLA SET UP STORE INDEX LDB .PAR1 GET CB0 LOCAL ADDR * DFIN1 CMB,INB SAVE COMMON BLOCK DEFINTION INTO STB A THE STACK LBX .PAR3 GET NEXT PARAMETER (CB LOCAL ADDR.) SZB,RSS END OF CALLING SEQUENCE JMP DFIN2 YES, CONTINUE ADA B NO, COMPUTE LOCAL CB LENGTH AND SSA AND VERIFY IT IS OK .ER08 JSB ERRAB ERROR IN CB DEFINTION --> ABORT TMS IOR BIT15 SET BIT 15 (NOT ENABLE) SAY Q,I STORE CB CURRENT LENGTH INTO THE STACK ISX BUMP FORM INDEX, SKIP IF 1ST TIME ISY BUMP TO INDEX IF NOT 1ST TIME RAL,CLE,ERA CLEAR BIT 15 FOR LOCAL CB LENGTH SAY Q,I STORE CB LOCAL LENGTH INTO THE STACK ISY BUMP TO INDEX JMP DFIN1 AND CONTINUE * DFIN2 CYA FIND NEW S VALUE ADA Q A=NEW S VALUE STA STKPT,I SAVE NEW S INTO THE STACK STA S REINIT S REGISTER * LDY QCBLA SET Y TO RECALL LAY Q,I CB0 LOCAL LENGTH SZA,RSS IS TRUE CB DEFINED IN THIS TM-SUBROUTINE ? JMP DFIN3 NO, NO TRUE COMMON IN THIS TM-SUBROUTINE LDB LEN00 YES, IS TRUE COMMON SZB,RSS ALREADY DEFINED ? STA LEN00 NO, INIT LEN0 CPA LEN00 YES, IT MUST HAVE THE RSS THE SAME LENGTH THAT THE FIRST ONE .ER04 JSB ERRAB NO, ERROR ---> ABORT TMS LDA Q,I SET CB0 DEFINED FLAG IOR BIT15 BY MERGING BIT15 WITH THE STA Q,I TMS SUBROUTINE # IN THE STACK * DFIN3 LDA .PAR2 RECALL CB1 LOCAL ADDR SAY Q,I AND SAVE IT INTO THE STACK * LDA STKPT INA NOW ENABLE AUTOMATICALLY STA PT ALL PREVIOUSLY ALLOCATED CB * DFIN5 LAX PT,I GET ACTUAL CB ADDR SZA,RSS ALLOCATED ? JMP DFIN6 NO CXB YES, PASSES CB# TO ENABLE IT JSB COM.E MEMORY IS ALREADY ALLOCATED, SET ENABLE BIT ONLY HLT 45B MEMORY SUSPEND RETURN !! DFIN6 DSX MORE COMMON BLOCK JMP DFIN5 YES, CONTINUE * ISZ PT LDA PT,I IS FIRST COMMON BLOCK SZA CURRENTLY ALLOCATED ? JMP EXIT4 YES, EXIT SPC 1 LDB DFNCD NO, ALLOCATE CB # 1 STB SCODE SET SPECIAL OP-CODE FOR MEM. SUSP. DFN10 LDA STKPT ADA T1OFS DLD A,I RECALL PARAM SAVED IN THE STACK DST TEMP1 (X REG. & LOCKID) CLB,INB ENABLE THE FIRST COMMON BLOCK JSB COM.E ALLOCATE MEMORY JMP MSU10 MEMORY SUSPEND RETURN, SUSPEND THE PROCESS SZA,RSS ALLOCATED DONE ? .ER03 JSB ERRAB NO CB1 IN THE 1ST TMSUB. OF A PROCESS STA TEMP YES, SAVE CB1(1) ADDR. LDX TEMP1 SET UP X REGISTER WITH LU # INDEX LBX .TMLU,I GET LU STB A,I AND SAVE IT IN 1ST WORD OF THE CB#1 INA LDB =B2000 READ-WRITE CONTROL BITS STB A,I READ CTL=400B, WRITE CTL=0B INA LBX .TMTP,I STB A,I SET DEVICE TYPE LDB CCBLP,I RECALL CB1 LENGTH ADB =D-3 TREE FIRST WORDS ARE ALREADY SET UP SSB CB1 LENGTH < 3 JMP .ER03 YES, ERROR SZB,RSS JMP .ER03 CBX USE X REG AS A COUNTER CLB INIT THE CB1 TO 0 DFN12 SBX A,I DSX JMP DFN12 * LDB IMAGE,I RECALL THE NUMBER OF DB DEFINED SZB,RSS ANY DB DEFINED ? JMP DFN11 NO, SKIP INIT CB1 FOR IMAGE LDA TEMP2 RECALL PREVIOUS VALUE OF LOCKID ALF,RAR AND ISOLATE DB# AND D7 SZA,RSS DBOPEN TO THAT PROCESS ? JMP DFN11 NO, SKIP INIT CB1 FOR IMAGE LDB CCBLP,I YES, RECALL CURRENT CB LENGTH ADB DM23 IS CB1 BIG ENOUGH TO HANDLE SSB TMS-IMAGE CALL ? JMP DFN11 NO, SKIP INIT CB1 FOR IMAGE JSB ICB1I YES, INIT CB1 FOR IMAGE ADA DM5 LDA A,I INB STA B,I ADB DM1 LDA TEMP2 AND PASSES LOCKID WORD STA B,I * DFN11 LDA DFNS# RESET THE SUBROUTINE CODE STA SCODE JMP EXIT4 SPC 1 DFNCD DEC 22 QCBLA DEC 2 # OF WORDS FROM Q --> CB1 LOCAL ADDR LEN00 DEC 0 INITIAL TRUE COMMON BLOCK LENGTH PT NOP HED TMS PAUSE PROCESS PAUS JSB STIME SAVE CURRENT TIME. LDA STKPT ADA T1OFS STA TEMP ROOM TO STORE FUTURE TIME VALUE ADA D2 STA TEMP3 LINK ADDR LDA .PAR1 GET TIME OF THE PAUSE SSA .ER18 JSB ERRAB MUST BE POSITIVE SZA,RSS JMP EXITZ ALLOWS OTHERS PROCESS TO RUN CLB DST X DLD TTIME JSB DADD ADD TO CURRENT ONE DST TEMP,I AND SAVE FINAL TIME IN STACK JSB DCMX COMPLEMENTE IT DST X AND SAVE IT * LDB .PAUZ GET PAUSE QUEUE HEAD RSS PAUS3 LDB TEMP2 LDA B,I SZA,RSS END OF QUEUE ? JMP PAUS4 YES, ADD NEW ENTRY HERE STB TEMP4 STA TEMP2 ADA DM2 TO GET TIME IN THIS STACK DLD A,I GET TIME IN STACK JSB DADD COMPARE THE TWO TIME SSB COMPARE ? JMP PAUS3 STACK IN QUEUE < NEW STACK --> LOOP SZB HLT 50B LDB TEMP4 S.I.Q > N.S ---> QUEUE NEW STACK HERE LDA B,I GET NEXT LINK PAUS4 STA TEMP3,I SET IN NEW STACK LDA TEMP3 AND SET NEW STACK STA B,I IN THE QUEUE LDA .PAR1 CPB .PAUZ DID WE CHANGE THE QUEUE HEAD ? JMP PAUS8 YES, MUST REQUEST ANOTHER TIME JMP IDLEZ NO, DO NOT CHANGE TIME REQUESTD TO TIMER SPC 2 PAUS0 JSB RELBU TIMER IS BACK HERE, RELEASE THE BUFFER PAUS5 LDA .PAUZ,I AND PROCESS THE PAUSE QUEUE SZA,RSS JMP IDLEZ (HLT) ?????????????????????????????????????????? LDB A,I GET NEXT LINK STB .PAUZ,I ADA T3MOF STA STKPT RE-INIT STACK POINTER LDA PAUCD RE-INIT PAUSE SUBROUTINE CODE STA SCODE SZB,RSS PAUSE QUEUE EMPTY ? JMP EXIT4 YES, RETURN TO TMS LIBRARY NOW JSB WRI/O NO, RE-QUEUE A GOOD BUFFER JSB STIME AND RESTART THE TIMER FOR THE QUEUE HEAD LDB .PAUZ,I GET THE FIRST ONE IN ADB DM2 THE QUEUE TO SCHEDULE DLD B,I GET FINAL TIME JSB DADD FINAL TIME - CURRENT TIME SSB JMP PAUS5 TOO LATE, PROCESS IT IMMETIALLY SZB HLT 52B PAUS8 CMA,INA INDICATE ABSOLUTE OFFSET SSA,RSS JMP PAUS5 TOO LATE, PROCESS IT IMMEDIATELY STA STIME * JSB EXEC PUT "TMST" IN THE TIME LIST DEF *+6 DEF D12 TIMED EXECUTION (INITIAL OFFSET) DEF .TMST,I PROGRAM NAME DEF D1 RESOLUTION CODE ( 1/100 SEC) DEF D0 EXECUTION MULT. (ONLY ONCE) DEF STIME INITIAL TIME OFFSET JMP IDLEZ GOTO IDLE LOOP * SPC 1 STIME NOP LDB .TIME XLA B,I GET CURRENT TIME FROM THE SYSTEM MAP INB XLB B,I DST TTIME JSB DCMX DST X JMP STIME,I * .TIME DEF $TIME+0 TTIME BSS 2 SPC 2 DADD NOP A,B PLUS X,X+1 CLE ADA X ADD LEAST SIGNIFICANT BITS CLO SEZ,CLE INB PROPAGATE CARRY OUT ADB X+1 ADD MOST SIGNIFICANT BITS SOC OVERFLOW ? HLT 53B JMP DADD,I SPC 1 DCMX NOP TWO'COMPLEMENT OF A,B CMA ONE' COMPLEMEMT CMB DST X CLA,INA AND THEN ADD ONE. CLB JSB DADD JMP DCMX,I X BSS 2 SPC 2 .PAUZ DEF *+1 PAUSE QUEUE HEAD OCT 0 SPC 1 HED TMS SUB-PROCESS LAUNCHING PROCESS ISPRL LDB LUXXX,I SZB,RSS LDB LU NO, GET CONSOLE LU STB .PAR1 LDB ..PA2 LDA PNXXX INITIAL PROCESS NAME ADDR MVW D3 JMP SPR01 SPC 2 SPR00 JSB RELBU PROCESS LAUNCH FROM 'TMSL', RELEASE BUFFER LDA .BUF AND GET PARAMETERS PASSE BY LDB ..PA1 'TMSL' TO MOVE THEM MVW D4 INTO THE RIGTH BUFFER SPR01 CLA,CCE STA .PAR5 NO CB ARE PASSED TO THE PROCESS STA .PAR5+1 STA .PAR5+2 STA .PAR5+3 STA STKPT NO STACK EXIST RIGHT NOW LDA .PAR2 SET THE NO ABORT BIT IN RAL,ERA THE TM-SUBROUTINE NAME STA .PAR2 SPC 1 SPRL CCA SET SUBPRO-QUEUE FLAG TO 'QUEUE UP' STA SPRQF LDA .PAR1 RECALL LU (BIT15 --> DO NOT QUEUE SUBPRO.) RAL,CLE,SLA,ERA CLEAR BIT15 AND STA SPRQF SET SUBPRO-QUEUE FLAG TO 'DO NOT QUEUE' STA SPRLU SAVE LU LDB ..PA2 RECALL TMSUB NAME/# ADDR JSB GTSU# RECALL TMSUB # IN A REG. & .PAR2 CMA,INA,RSS ILLEGAL NAME OR # RETURN CLA RETURN OK CLB CLEAR THE TLOG JSB SETST SET STATUS ACCORDING TO GTSU# SUB. SZA WAS IT OK ? JMP SPR13 NO, FORGET THE LAUNCH LDB .TMLU ADB DM2 DLD B,I CMA,INA ADA B B IS MINUS # OF AUXILIARY DEVICES INB CBX X TO GET FIRST AUXILIARY DEVICE SPR12 LBX .TMLU,I GET ONE LU CPB SPRLU IS IT THIS ONE ? JMP SPR14 YES, ISX NO, GET NEXT ONE INA,SZA MORE LU ? JMP SPR12 YES, CONTINUE SPR13 LDA STKPT NO, FORGET THE LAUNCH SZA IF LAUNCH FROM AN OTHER PROCESS JSB WRI/O RESTART THE CALLING PROCESS JMP STAR8 RETURN TO IDLE LOOP SPC 5 * THE LU IS FOUND, * DUPLICATE CB'S TO BE PASSED TO THE SON PROCESS * IF LU IS FREE THEN START THE PROCESS, * ELSE QUEUE IT ACCORDING TO THE QUEUE REQUEST FLAG. * SPR14 CLA INIT LOCK ID WORD TO 0 STA .PAR5+4 * LDA STKPT PROCESS LAUNCH FROM STA SPRLU SAVE STACK POINTER TEMPORARILY SZA,RSS OUTSIDE ? JMP SPR50 YES, SKIP THE FOLLOWING SPC 2 * DUPLICATE CB'S AND PASSES LOCKID * STX SPRTX SAVE X REG LDA ..PA5 NO, SET UP TO GET PARAMETERS JSB MEMOK RESOLVE MEMORY SUSPEND PROBLEM. * JSB .MGTG ALLOCATE A BUFFER TEMPORARILY SPR38 DEC 0 AS INTERMEDIATE STORAGE FOR CB JMP .ER13 TO DUPLICATE THEM. JMP MSU05 ---> GOTO MEM SUSP. DST SPR47 SAVE ADDR. AND LENGTH SPC 1 JSB WRI/O RESTART CALLING PROCESS SPC 1 LDA ..PA5 STA TEMP1 SET UP POINTER TO LOCAL CB'S ADDR. LDA Q STA TEMP2 SAVE Q VALUE LDX SPRTX RECALL X REG TO LAX .STKT,I GET THE STACK POINTER OF THE ADA S0 FUTURE STACK IN ORDER TO INA CALCULATE THE FIRST Q VALUE STA TEMP4 THAT WILL BE WHEN THE CB IS ENABLED * SPR42 LDA TEMP1,I GET LOCAL CB ADDR FROM SZA,RSS THE CALLING SEQUENCE, CB HERE ? JMP SPR45 NO, IT IS THE END OF LIST CLB YES, CLEAR LOCAL ADDR. IN CALLING SEQUENCE STB TEMP1,I SINCE IT WILL BE REPLACED BY LOGICAL ADDR. JSB GECB# SET B = CB NUMBER JSB COM.U INIT A, B & Y AND MAP THE 1025 FIRST WORDS SZA,RSS ALLOCATED ? JMP SPR44 NO, GOTO NEXT ONE SSB YES, ENABLED ? JMP SPR44 NO, GOTO NEXT ONE STB TEMP3 SAVE CURRENT CB LEN IN WORDS FOR MOVE * LDA TEMP4 SET Q VALUE WITH WHAT IT WILL BE STA Q WHEN THAT CB WILL BE ENABLED LDA TEMP1 A=ADDR WHERE CB SHOULD BE SAVED JSB ALCB ALLOCATE MEMORY FOR THAT CB HLT 55B SHOULD NOT HAPPENS, TESTED BY 'MEMOK' LDA TEMP2 RESTORE THE VARIABLE Q STA Q * LAY STKPT,I RECALL ORIGINAL CB LOGICAL ADDR LDB TEMP3 AND LENGTH TO JSB MAPCB MAKE SURE THE ENTIRE CB IS MAPPED LDB SPR47 TO MOVE IT INTO THE INTERMEDIATE MVW TEMP3 BUFFER * LDA TEMP1,I RECALL LOGICAL ADDR AND LENGTH LDB TEMP3 OF NEW CB TO MAKE SURE JSB MAPCB THAT THE ENTIRE CB IS MAPPED LDB A SET DESTINATION ADDR LDA SPR47 GET SOURCE ADDR AND MVW TEMP3 MOVE FROM INTERMEDIATE TO THE NEW ONE SPR44 ISZ TEMP1 BUMP POINTER INTO CALLING SEQUENCE JMP SPR42 AND LOOP UNTIL END OF LIST * SPR45 JSB .MGTR RELEASE TEMPORARY BUFFER SPR47 BSS 2 * LDB IMAGE,I RECALL NUMBER OF DATA BASES SZB,RSS IMAGE USED ? JMP SPR49 NO CLB,INB YES, GET PREVIOUS LOCK ID WORD FROM CB1 JSB COM.U SET A,B,Y & TEMP, MAP THE FIRST 1025 WORDS SZA,RSS ALLOCATED ? JMP SPR49 NO, FORGET IT LDB A B = ACTUAL ADDR ADB DM1 LDB B,I B = ACTUAL SIZE ADB DM23 ACTUAL SIZE - 23 SSB ACTUAL SIZE > 22 JMP SPR49 NO, FORGET IT ADA D11 YES, SET A TO CB1(12) LDA A,I GET LOCK ID WORD STA .PAR5+4 PASSES IT TO THE SON PROCESS * SPR49 LDX SPRTX RESTORE X REG SPC 2 * START THE SON PROCESS, OR QUEUE THE REQUEST * IF LU IS BUSY OR LOCKED. SPC 1 SPR50 LBX .STKT,I GET STACK POINTER LDA B,I SSA,RSS IS THIS LU FREE ? JMP SPR70 NO, GO TO QUEUE THIS REQUEST JSB INSTK YES, INITIALIZE STACK LAX .TMLU,I GET AUXILIARY LU STA TEMP,I AND SAVE IT INTO THE STACK AT S+1 LDB STKPT INIT B JSB LRQ TRY TO LOCK LU JMP SPR85 LOCK WAS SUCCESSFULL, START SON PROCESS SPC 1 LDA SPRQF LOCK HAS FAILED, RECALL QUEUE FLAG SSA QUEUED REQUEST ? JMP SPR56 YES, INSERT REQUEST INTO EXTER. EVENTS QUEUE LDA BIT15 NO, RETURN STATUS TO CALLING PROCESS AND STA STKPT,I DO NOT START SON PROCESS. FREE STACK AGAIN LDA SPRLU RESTORE STACK POINTER STA STKPT SPR53 CCA RETURN STAT.=-1 TO CALLING PROCESS, TO CLB INDICATE THAT THE 'TMPRO' RQ IS NEITHER JSB SETST EXECUTED OR QUEUED. LDA STKPT PROCESS LAUNCH FROM SZA,RSS INSIDE ? JMP STAR8 NO, OK * LDA ..PA1 YES, MUST RELEASE ALL ALLOCATED CB ADA D3 STA PT SET UP POINTER TO CB LOGICAL ADDR CLA STA Q TO RELEASE THE CB (CUR. Q > Q) STA .PAR5+4 NO CB HERE JSB RLCB RELEASE THE MEMORY JMP STAR8 AND EXIT SPC 1 SPR56 ADB T3OFS LDA .EXTW,I SET UP TO QUEUE ON THE STA B,I EXTERNAL EVENT WAIT QUEUE STB .EXTW,I LDA .LRQX SET SUBROUTINE ADR INTO THE STACK STA S,I AT S LOCATION INB UPDATE B AND QUEUE THE REQUEST JMP SPR72 SPC 2 * THE LU IS BUSY OR LOCK BY AN OTHER RTE PROGRAM * QUEUE THIS REQUEST IN THE WAITING QUEUE OF * THIS AUXILIARY LU. (REQUEST A 11 WORDS BLOCK TO * MMGT TO SAVE ALL INFORMATIONS) * SPR70 ADB T4OFS UPDATE B TO GET HEAD OF WAITING QUEUE LDA SPRQF AUTOMATIC QUEUE FEATURE SSA,RSS REQUESTED ? JMP SPR53 NO, RETURN STATUS TO CALLING PROCESS SPR72 LDA B,I SZA,RSS JMP SPR75 END OF LIST STA B CONTINUE UNTIL END OF LIST JMP SPR72 * SPR75 STB TEMP1 SAVE ADDR OF LAST ELEMENT IN JSB .MGTG THE QUEUE DEC 11 HLT 56B JMP SPR77 MEMORY SUSPEND RETURN !! STB A,I SAVE ACTUAL BLOCK LENGTH INA STA TEMP1,I LINK THIS BLOCK IN THE LIST CLB STB 0,I END OF LIST INA STX A,I SAVE INDEX TO TMLU TABLE INA LDB A TO ADDR LDA ..PA2 MVW D8 SAVE ADDR OF CB TO BE PASSED TO JMP IDLE THE SUB-PROCESS, RETURN SPC 1 SPR77 LDA STKPT THIS PROCESS MUST HAVE BEEN SZA LAUNCHED FROM OUTSIDE, IS IT ? HLT 60B NO !!!!!!!!!!!!!!!!!!!!!!!! LDA =D18 SET UP SPECIAL STA SCODE SUBROUTINE CODE LDA D4 AND QUEUE UP AGAIN THIS EXTERNAL STA WRI/L EVENT REQUEST IN THE EXTERNAL CLASS I/O LDA DM4 DELAY THE REQUEUE FOR A MAXIMUM OF 1 SEC, LDB .SPR7 BUT CHECK THE CLASS I/O QUEUE EVERY 250MS JSB WAIT SUSPEND FOR 250MS SPR78 JSB WRI/O CLASS I/O QUEUE CLA,INA (THIS WILL LOAD THE SYSTEM A LOT STA WRI/L BUT WHAT CAN WE DO ?) JMP IDLE * .SPR7 DEF *+1 ADDR OF SUB. EXECUTED EVERY 250MS NOP JSB NRCLS RETREIVE THE NUMBER OF COMPLETED RQ DEF *+2 PENDING ON THAT CLASS I/O DEF CLASS COMPLETION QUEUE. SZA,RSS NONE ? JMP .SPR7+1,I YES, WAIT LONGER JMP SPR78 NO, REQUEUE NOW TO GET OTHER RQ PENDING SPC 2 * PREVIOUS PROCESS HAS COMPLETED, * START THE FIRST ONE OF THE WAITING QUEUE * (USE THE 11 WORDS BLOCK AND REALESE THIS BLOCK) SPC 1 SPR80 JSB STIPR START INTERAC. PROCESS (CLEARED WHEN DONE) LDA STKPT END OF SUB-PROCESS ADA T4OFS CHECK IF SOMETHING IS LDB A,I WAITING FOR THIS LU SZB,RSS WAITING QUEUE EMPTY ? JMP SPR93 YES, UNLOCK LU AND SET IT INACTIVE STB TEMP1 SAVE ADD+1 OF THIS BLOCK LDB B,I AND LINK THE NEXT ONE STB A,I IN PLACE OF THIS ONE. * LDA TEMP1 INA RESTORE INDEX IN TMLU TABLE LDX A,I * INA RESTORE ALL PARAMETERS LDB ..PA2 MVW D8 * LDA TEMP1 RETURN THIS BLOCK OF MEMORY ADA DM1 TO MMGT LDB A,I GET ACTUAL LENGTH DST SPR82 JSB .MGTR RETURN MEMORY SPR82 BSS 2 LDB STKPT RESTORE B REGISTER JSB INSTK RE-INIT STACK SPC 1 SPR85 LDA ..PA5 STORE LOGICAL CB ADDR INTO LDB STKPT THE STACK ADB D3 MVW D4 LDA .PAR2 RECALL T.U.S. NUMBER TO SIMULATE STA .PAR1 A 'TMSUB' CALL NOW. SPR88 LDA =D8 STA SCODE SIMULATE TM SUB CALL JMP SBCAL SPC 2 * PREVIOUS PROCESS HAS COMPLETED, * AND NO REQUEST IS QUEUING FOR THAT LU * SET THIS LU INACTIVE AND UNLOCK IT (RTE LU UNLOCK) * SPC 1 SPR93 LDB BIT15 SET LU INACTIVE STB STKPT,I ADA DM3 TO RECALL TEMP1 FROM STACK STA SPR95 TO UNLCK THE AUXILIARY LU JSB LCKL? LOCK THIS LU ? JMP IDLE NO, FORGET IT JSB LURQ YES, PERFORM THE UNLOCK CALL DEF *+4 DEF O40K UNLOCK LU SPR95 NOP LU ADDR. DEF D1 UNLOCK ONLY ONE LU HLT 62B ERROR RETURN SZA UNLOCK OK ? HLT 63B JMP IDLE AND RETURN TO IDLE LOOP SPC 3 INSTK NOP INITIALIZE STACK ROUTINE STB STKPT LDY T3OFS CLEAR THE FIRST WORDS OF STACK CLA UP TO TEMP4 (NOT INCLUDED) INST3 SAY B,I DSY JMP INST3 DLD S0 ADA STKPT ABSOLUTE S VALUE ADB STKPT ABSOLUTE Q VALUE DST S DST STKPT,I SET S & Q INITIAL VALUE INA STA TEMP SAVE NEXT Q VALUE LDA BIT14 SET BIT14 THAT INDICATE STACK FOR STA B,I AUXILIARY LU (SPECIAL RTN CD=0) ADB DM1 SET STOP-INHIBITED FLAG TO NOT ZERO STA B,I (PROCESS CANNOT BE STOPPED) ADB DM3 LDA .PAR5+4 SAVE LOCKID WORD INTO THE STACK AT STA B,I TEMP2 TO INIT CB1(12) LATER. ADB DM1 SAVE X REG INTO THE STACK AT STX B,I TEMP1 TO INIT CB1(1) & CB1(3) JMP INSTK,I TO ENABLE AND INIT CB1 SPC 2 .LRQX DEF *+1 NOP SUBROUTINE ENTRY POINT JSB LRQ RSS OK, RESTART THE PROCESS JMP .LRQX+1,I LOCK FAIL, RETURN JSB DEXTW DEQUEUE FROM EXTERNAL EVENT WAIT QUEUE JMP SPR80 AND RESTART THE PROCESS SPC 1 LRQ NOP LDA B,I A = S REG. INA STA LRQ3 SET LU ADDR. JSB LCKL? LOCK THIS LU ? JMP LRQ,I NO, FORGET IT JSB LURQ YES, PERFORM THE LU LOCK REQUEST DEF *+4 DEF IOPTN LRQ3 NOP LU DEF D1 # OF LU HLT 64B ERROR RETURN SZA LOCK DONE ? ISZ LRQ NO, RETURN P+2 JMP LRQ,I YES, RETRUN P+1 SPC 1 LCKL? NOP LOCK THIS LU ? LDA A,I GET LU CPA D1 LU = 1 ? JMP LCK?3 YES, PERFORM THE LOCK RQ ADA DM4 IF LU = < 3 DO NOT LOCK IT SSA,RSS LCK?3 ISZ LCKL? > 3, PERFORM THE LOCK RQ JMP LCKL?,I = < 3, FORGET THE LOCK SPC 2 ..PA2 DEF .PAR2 ..PA5 DEF .PAR5 BIT14 EQU O40K SPRQF NOP SON PROCESS QUEUE REQUEST FLAG SPRLU NOP SON PROCESS LU SPRTX NOP HED TMS SCHEDULE NON-TMS PROGRAM PROCESS SCHPR LDA ..PA1 ADA D2 SKIP PROGRAM NAME HLT 12B !!!!!!!!!!!!! NOT IMPLEMENTED !!!!!!!!!!!!!!!!!!!!! STA TEMP1 USE AS POINTER TO ACCESS USER PARAM * CCA STA SRFLG SET SEND MAIL BOX FLAG * LDA ICLAS SAVE TMS-INTERNAL CLASS WORD STA SCHPZ CLA STA ICLAS INIT ICLAS TO ALLOCATE A CLASS WORD STA RTRNA INIT LENGTH OF 1ST CB SEND * SCH02 ISZ TEMP1 SCH03 LDA TEMP1,I GET PARAM SZA,RSS END OF LIST ? JMP SCH20 YES, JSB GECB# NO, SET COMB# = CB NUMBER JSB COM.U AND INIT A, B & Y SZA,RSS ALLOCATED ? JMP SCH02 NO, FORGET IT SSB YES, ENABLED ? JMP SCH02 NO, FORGET IT DST SCH15 YES, SET MAILB PARAM SCH05 ISZ TEMP1 GET LENGTH OF NEXT CB LDA TEMP1,I CLB SZA,RSS END OF LIST ? JMP SCH07 YES, SEND THE CURRENT ONE JSB GECB# NO, TRY TO GET LENGTH JSB COM.U SZA,RSS ALLOCATED ? JMP SCH05 NO, FORGET IT SSB YES, ENABLED ? JMP SCH05 NO, FORGET IT SCH07 STB TEMP YES, SAVE LENGTH OF NEXT CB LDB SCH15+1 RECALL LENGTH OF CURRENT CB LDA RTRNA RTRNA ALREADY SZA,RSS INIATILIZED ? STB RTRNA NO, SET 1ST CB LEN SEND LDA TEMP RECALL NEXT CB LENGTH JSB MAILB AND SEND CURRENT CB SCH15 BSS 2 JMP SCH03 LOOP UNTIL END SPC 1 SCH20 LDA .PAR1 RECALL FIRST WORD OF PRG NAME SSA,RSS REQUEST WITH WAIT ? JMP SCH25 YES, DO IT WITH WAIT RAL,CLE,ERA NO, CLEAR BIT 15 STA .PAR1 TO RESTORE PROGRAM NAME JSB WRI/O QUEUE UP PROCESS IMMEDIATELY (NO WAIT) SCH25 LDA ..PA1 JSB SCHUP SCHEDULE NON-TMS USER PROGRAM .ER22 JSB ERRAB ERROR RETURN ! * LDA SCHPZ RESTORE THE TMS-INTERNAL CLASS WORD STA ICLAS JMP IDLE AND EXIT * SCHPZ NOP HED TMS ABORT / SOFT STOP PROCESS * SET/RESET STOP-INHIBIT FLAG * =========================== * SIF LDA .PAR1 GET USER REQUEST SZA SET/RESET ? JMP SIF05 DISALLOW STOP OF TMS SIF03 LDB STKPT ALLOW STOP AGAIN ADB NSOFS SET THE STOP-INHIBIT FLAG STA B,I ON THE STACK JMP IDL41 RETURN STATUS OK AND EXIT * SIF05 LDB STPFL RECALL STOP IN PROGRESS FLAG CCA SZB,RSS STOP IN PROGESS ? JMP SIF03 NO, SET FLAG ON THE STACK AND EXIT JMP IDL42 YES, RETURN BAD STATUS TO THE USER SPC 1 STPFL DEC 0 STOP IN PROGESS FLAG (NO 0=IN PROGRESS) SPC 3 * STOP FROM 'TMSL' * ================ * STPX CLA STOP TMS REQUEST FROM 'TMSL' STA STKPT OUTPUT "TMS OPERATOR STOP ! " JMP TMSP1 SPC 2 STPY CCA "SOFT ABORT" TMSL 97 STA STKPT JMP TMSP1 SPC 2 * STOP FROM A USER REQUEST USING 'TMSTP' CALL * =========================================== * TMSP LDA .PAR1 GET STOP # STA STP# AND SAVE IT LDA STKPT RESET THE STOP-INHIBIT FLAG FOR THIS ADA NSOFS PROCESS CLB STB A,I * TMSP1 CCA SET THE STOP IN PROGRESS FLAG STA STPFL * JSB RELBU RELEASE THE BUFFER LDA =D25 SET THE NEW SUBROUTINE CODE STA SCODE FOR STOP IN PROCESS JSB STIME AND SAVE CURRENT TIME DLD TTIME DST STPTI JMP EXITZ AND QUEUE THAT STOP IN PROGRESS RQ SPC 2 TMSPX CPB D3 TLOG = 3 ? JMP TSP90 YES, CHECK FOR ANSWER "YES" TSP10 LDX #LU NO, CHECK STOP-INHIBIT FLAG OF ALL STACKS TMSP2 LAX .STKT,I A=STACK POINTER * LDB STKPT GET STOP FLAG SSB,RSS "SOFT ABORT"? JMP TSP11 NO, DON'T BOTHER TO CHECK STACK TYPE ADA TYOFS YES, CHECK STACK TYPE LDA A,I GET TYPE AND =B37777 KEEP LOWER 14 BITS CPA D1 INTERACTIVE LU STACK? JMP TMSP6 YES, SKIP THIS STACK, GO ONTO NEXT LAX .STKT,I NO, CHECK STACK FOR ACTIVITY * TSP11 LDB A,I GET S SSB STACK ACTIVE ? JMP TMSP3 NO, CHECK IF ANY THINGS IS WAITING ADA NSOFS YES, ACCESS THE STOP-INHIBIT FLAG LDA A,I GET FLAG SZA STOP ALLOWED ? JMP TSP40 NO, WAIT LONGER TMSP6 DSX YES, CHECK NEXT STACK JMP TMSP2 AND LOOP SPC 2 JSB OUTLF YES, PERFORM THE TMS STOP REQUEST JSB OUTLF LDB STKPT LDA .MS4 SZB,RSS STOP FROM 'TMSL' ? JMP TMAB8 YES, PRINT "TMS OPERATOR STOP !" LDA .MS5 SSB STOP 98? JMP TMAB8 YES, PRINT "TMS SCHEDULED STOP !" LDA STP# NO, FROM TMLIB, PRINT STOP # JMP TMAB4 SPC 1 TMSP3 ADA T4OFS TO ACCESS QUEUE HEAD OF THE WAITING LIST LDA A,I SZA,RSS WAITING BLOCK ? JMP TMSP6 NO, CONTINUE HLT 13B YES, ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SPC 2 * TMS CANNOT BE STOPPED (STOP-INHIBIT FLAG AND/OR * SUBPROCESSES WAITING), CHECK IF TIME TO REPORT * THAT, IF NOT WAIT LONGER. * TSP40 JSB STIME GET THE CURRENT TIME DLD STPTI RECALL FINAL TIME JSB DADD FINAL TIME - CURRENT TIME SSB,RSS FINAL TIME REACHED ? JMP IDL08 NO, WAIT LONGER TO REPORT ERROR LDA D500 YES, SET THE NEXT FINAL TIME CLB DST X DLD TTIME JSB DADD ADD TO CURRENT TIME DST STPTI AND SAVE FINAL TIME * * REPORT TMS ACTIVITY NOW: * (LU BUSY & SUBPROCESSES QUEUE UP) * JSB OUTLF SPACE TWO LINE JSB OUTLF LDA .MSX OUTPUT "STOP DELAYED DUE TO ACTIVE TERMINAL" JSB OUTM * TMSP4 LAX .TMLU,I THIS LU IS BUSY JSB CASC STA .MSZ+3 LDA .MSZ JSB OUTM LBX .STKT,I NOW CHECK IF PROCESS ARE ADB T4OFS WAITING FOR THIS LU CCA INIT # OF PRCESS WAITING TSP42 LDB B,I GO ON THE WAITING QUEUE INA INCREMENT THE COUNTER FOR WAITING PROCESS SZB END OF QUEUE ? JMP TSP42 NO, LOOP UNTIL END * SZA,RSS PROCESS WAITING ? JMP TSP70 NO, GO TO NEXT STACK JSB CASC YES, REPORT THE NUMBER OF WAITING PROCESS STA .MSY+3 LDA .MSY JSB OUTM TSP70 DSX ANY MORE STACK ? RSS YES, CHECK IF OK TO REPORT LU BUSY JMP TSP80 NO, ASK FOR ABORT NOW * LAX .STKT,I GET NEXT STACK POINTER LDB STKPT GET TYPE OF STOP SSB,RSS "SOFT ABORT"? JMP TSP71 NO, DON'T CHECK FOR STACK TYPE ADA TYOFS YES, CHECK STACK TYPE LDA A,I GET STACK TYPE AND =B37777 KEEP LOWEST 14 BITS CPA D1 INTERACTIVE LU STACK? JMP TSP70 YES, SKIP THIS STACK, CHECK NEXT LAX .STKT,I NO, CHECK IF STACK IS BUSY * TSP71 LDB A,I B=S REG. SSB STACK ACTIVE ? JMP TSP70 NO, GOTO NEXT STACK ADA NSOFS YES, GET THE STOP-INHIBIT FLAG LDA A,I SZA STOP ALLOWED ? JMP TMSP4 NO, REPORT LU BUSY JMP TSP70 YES, GOTO NEXT STACK SPC 1 * TMS ACTIVITY HAS BEEN REPORTED, ASK IF "OK TO ABORT ?" * TSP80 LDA LU SET TIME OUT ON THE TERMINAL IOR =B2200 STA TEMP JSB EXEC DEF *+4 DEF D3 CONTROL RQ DEF TEMP LU + 2200B DEF D500 TIME OUT IS 5 SEC. * JSB RELBU RELEASE BUFFER QUEUED IN THE CLASS QUEUE LDA .MSW OUTPUT JSB OUTM "OK TO ABORT (YES/NO) _" LDA LU IOR =B400 MERGE ECHO BIT STA TEMP JSB EXEC REQUEST THE ANSWER DEF *+8 DEF D17 CLASS READ DEF TEMP LU + ECHO BIT, ASCII READ DEF BUF DUMMY BUFFER DEF DM4 MAX BUFFER LENGTH DEF STKPT 1ST PARAM = STACK POINTER DEF SCODE 2ND PARAM = SUBROUTINE CODE DEF CLASS CLASS WORD JMP IDLE SPC 1 TSP90 LDA BUF CHECK THE ANSWER CPA =AYE RSS YES ? JMP TSP10 NO, CHECK IF OK TO STOP LDA BUF+1 NOW CHECK FOR "S" AND =B177400 CPA O514C "S" RSS YES, ABORT TMS NOW JMP TSP10 NO, CHECK IF OK TO STOP JSB OUTLF SPACE ONE LINE JMP ABTX AND ABORT TMS APPLICATION SPC 1 .MSZ DEF *+1 ASC 11, LU XX IS BUSY .MSY DEF *+1 ASC 11, XX PROCESS WAITING .MSX DEF *+1 ASC 11,STOP DELAYED BECAUSE: .MSW DEF *+1 ASC 11,OK TO ABORT(YES/NO) ?_ * STP# NOP SAVE THE STOP NUMBER STPTI BSS 2 O514C OCT 51400 SKP * ABORT FROM 'TMSL' * ================= * ABTX LDA .MS3 JMP TMAB8 REPORT "TMS OPERATOR ABORT ! " SPC 2 * TMS ABORT REQUEST BY A USER CALL 'TMSAB' * ======================================== * TMAB EQU * ABORT THE TM SOFTWARE LDA .MS37 SET UP TO ABORT MESSAGE LDB .MS12 MVW D3 LDA .PAR1 GET STOP # TMAB4 CCE DECIMAL CONVERSION JSB $CVTX INA LDB .MS15 MVW D2 JSB GPNAD GET TM-SUBROUTINE NAME ADDR LDB .MS18 AND MOVE IT IN MESSAGE MVW D3 LDA .MS1 TMAB8 JSB OUTM OUTPUT "TMS ABORT XXXX TMSUBX" JMP ABT00 CLEAN UP AND EXIT. SPC 3 GPNAD NOP RETREIVE T.U.S. NAME LDA STKPT RECALL STACK POINTER SZA,RSS STACK DEFINED ? JMP GPNA3 NO, LEAVE "TMSYS" INA LDA A,I GET Q REG VALUE LDA A,I GET TUS# OR SPECAIL THINGS WITH BIT14 CLE CLEAR BIT 15 & 14 ELA,CLE,ELA AND MOVE BIT14 INTO E RAR,RAR SEZ SPECIAL CASE ? JMP GPNA5 YES, NO TUS # DEFINED ADA DM1 NO, THIS IS THE TUS#, GET NAME FORM MPY D5 THE TMS TABLE. ADA .TMSB INA,RSS GPNA2 LDA PNX00 JMP GPNAD,I GPNA3 LDA .MS04 LEAVE "TMSYS .." JMP GPNAD,I GPNA5 CPA D1 INTERACTIVE PROCESS ? JMP GPNA2 YES, GET STARTING PROCESS NAME JMP GPNA3 NO, LEAVE "TMSYS" SPC 2 MS0 ASC 16,TMS 00 TMSUB @123456 - MS1 ASC 11,TMS STOP 3456 TMSUB MS3 ASC 11,TMS OPERATOR ABORT ! MS4 ASC 11,TMS OPERATOR STOP ! MS5 ASC 11,TMS SCHEDULED STOP ! .MS1 DEF MS1 .MS3 DEF MS3 .MS4 DEF MS4 .MS5 DEF MS5 .MS12 DEF MS1+2 .MS15 DEF MS1+5 .MS18 DEF MS1+8 .MS37 DEF MS3+7 ERR. ASC 2,ERR ASC@ ASC 1, @ .M013 DEF MS0+13 HED TERMINAL-MONITOR ERROR CONDITION PROCESS .ERR DEC 35 TOTAL NUMBER OF ERRORS NOP 1 INTERAC. LU'S DOWN OR LOCKED DEF .ER02+1 2 NOT ENOUGH MEM FOR STACK ALLOCATION DEF .ER03+1 3 NO OR BAD CB1 IN 1ST TUS OF A PROCESS DEF .ER04+1 4 TRUE COMMON HAS NOT THE SAME LENGTH DEF .ER05+1 5 ENABLE CB WITH LENGTH = 0 DEF .ER06+1 6 ENABLE CB FOR THE 2ND TIME DEF .ER07+1 7 'RETURN' IN AN INTERAC. PROCESS DEF .ER08+1 8 CB DEFINTION ERROR DEF .ER09+1 9 'TMDFN' HAS LESS THAN 3 PARAMETERS DEF .ER10+1 10 T.U.S. NAME NOT FOUND DEF .ER11+1 11 ILLEGAL T.U.S. NUMBER DEF .ER12+1 12 STACK OVERFLOW ('TMSUB' CALL) --> ABT DEF .ER13+1 13 CB LENGTH > EVER AVAILABLE MEMORY DEF .ER14+1 14 2ND 'TMDFN' IN A T.U.S. --> ABT DEF .ER15+1 15 BAD CB IN 'TMCBE/D' (LEN=0 OR 1ST CB) DEF .ER16+1 16 DISABLE A NO-ALLOCATED CB DEF .ER17+1 17 DISABLE A NO-ENABLE CB DEF .ER18+1 18 TIME IN 'TMPZ' REQUEST IS NOT LEGAL NOP 19 DEF .ER20+1 20 NEW CB LEN IN 'TMCBL' IS NOT LEGAL .IMER DEF .ER21+1 21 RESERVED FOR IMAGE ERROR DEF .ER22+1 22 SCHEDULE A NON-TMS PRG NOT LOADED NOP 23 INTERNAL TMS ERROR (LOGIQUE/TABLE) NOP (TMLIB#4) 24 TMS USER CALL HAS MORE THAN 9 PARAM. NOP (TMLIB#5) 25 'TMDFN' NOT 1ST CALL IN A T.U.S. NOP (TMLIB#6) 26 CB1 DISABLE DURING AN I/O CALL NOP (TMLIB#7) 27 CB1 DISABLE/TOO SMALL FOR 'TBXXX' CALL NOP (TMLIB#8) 28 CB1(1) OR CB1[6:13] HAS BEEN MODIFIED NOP 29 NOP 30 NOP 31 NOP 32 NOP 33 NOP 34 NOP 35 RESERVED FOR LOGGING ERROR SPC 1 IMERC ABS .IMER-.ERR SPC 3 ERRAB NOP ERROR PROCESS FOR FATALS ERRORS CCA STA NOABT SET ABORT FLAG LDA ERRAB STA ERROR JMP ERROR+1 SPC 1 ERROR NOP LDX .ERR ERR02 LAX .ERR CPA ERROR IS IT THIS ERROR ? JMP ERR03 DSX END OF TABLE ? JMP ERR02 NO, CONTINUE HLT 65B YES, ERROR IN ERROR !!! ???????????? SPC 1 ERR03 CXA STA ERR# SAVE ERROR # LDB NOABT CHECK TO ABORT SSB,RSS ABORT ALLOWED ? JMP ERROR,I NO ABORT ! RETURN TO CALLER ERR JSB ERRPR PRINT ERROR MESSAGE JMP ABT00 CLEAN UP AND EXIT. SPC 2 ERRPR NOP FORMAT AND PRINT ERROR MESSAGES LDA ERR# JSB CASC CONVERT IT INTO ASCII STA MS0+2 LDA ERR# RECALL ERROR NUMBER CPA IMERC IS IT AN IMAGE ERROR ? RSS YES JMP ERR04 NO, CONTINUE * LDA BUF+1 RECALL TMS-IMAGE SUBROUTINE CODE MPY D3 ADA .IMGT INDEX IN IMAGE NAME TABLE LDB .MS04 AND MOVE TMS-IMAGE SUBROUTINE MVW D3 NAME INTO OUTPUT BUFFER LDA BUF RECALL IMAGE STATUS CCE DECIMAL CONVERSION JMP ERR05 SPC 1 ERR04 JSB GPNAD LDB .MS04 MVW D3 INA LDA A,I GET EPAOS CMA,INA SZA IS IT DEFINED ? ADA XSUSP YES, COMPUTE RELATIVE ADDR IN THE TM-SUBROUTINE CLE IN ABORT MESSAGE (OCTAL VALUE) ERR05 JSB $CVTX * LDB .MS08 MVW D3 ADB =D-3 CLE,ELB ERR07 LBT CPA O40 RSS JMP ERR08 IOR =B20 ADB DM1 SBT JMP ERR07 ERR08 LDA ASC@ STA MS0+7 LDA ERR# RECALL ERROR NUMBER CPA IMERC IS IT AN IMAGE ERROR ? RSS YES JMP ERR09 NO, CONTINUE DLD ERR. DST MS0+7 SET "ERR " INTO OUTPUT BUFFER JSB DBNAD RETEIVE THE DB NAME ADDR FROM THE DB# LDB .M013 MVW D3 LDA .MS0 ERROR MESSAGE ADDR. LDB =D32 ERROR MESSAGE LENGTH IN BYTES JSB OUTM0 OUTPUT ERROR MESSAGE JMP ERRPR,I ERR09 LDA .MS0 JSB OUTM OUTPUT "TMS XX TMSUB @123456" JMP ERRPR,I SPC 1 CASC NOP CONVERT INTO ASC CLB DIV D10 SZA,RSS LDA =B360 TO HAVE LEADING SPACE INSTEAD OF ZERO ALF,ALF ADA B ADA =A00 JMP CASC,I SPC 1 OUTM NOP LDB D22 MESSAGE LENGTH IN BYTES JSB OUTM0 JMP OUTM,I SPC 1 OUTM0 NOP CLE,ELA --> BYTE POINTER STB CASC LDB @MSBX BYTE DESTINATION ADDR MBT CASC MOVE MESSAGE CMB,INB ADB @MSBU STB CASC JSB EXEC DEF *+5 DEF D2 DEF LU DEF MSBU DEF CASC JMP OUTM0,I * @MSBX NOP SPC 1 OUTLF NOP JSB EXEC OUTPUT ONE SPACE DEF *+5 DEF D2 DEF LU DEF MS0+3 DEF DM1 ONLY ONE BYTE JMP OUTLF,I SPC 2 LULAB LDA .LUMS JSB OUTM JMP ABT3 * .LUMS DEF *+1 ASC 11,TMS 01 DOWN OR LOCKED SPC 2 LOGER NOP ERROR DUE TO LOGGING DEVICE STB BUF+1 SAVE SUBROUTINE CODE, ERROR CODE IN A LOGE2 CCE SET DECIMAL FLAG JSB $CVTX CONVERT ERROR CODE TO ASCII LDB .LGM1 MVW D3 LDA .LGMS LDB D24 JSB OUTM0 AND PRINT OUT "TMS 35 DCLOG ERR XXXX" * LDA BUF+1 RECALL OPERATION CODE SZA,RSS INITIALIZE DCLOG? JMP ABT3 YES, DIE NOW CPA D1 TERMINATE DCLOG? JMP LOGER,I YES, RETURN CLB RETURN FROM LOG OPERATION, ZERO OUT LOG DEVICE STB LOGXX,I TO PREVENT DCLOG TERMINATION (IT IS ALREADY DEAD) JMP ABT00 THEN, ABORT APPLICATION * * .LGMS DEF *+1 ASC 9,TMS 35 DCLOG ERR LGME1 BSS 3 ASC01 ASC 1,01 * .LGM1 DEF LGME1 SPC 2 ERR# NOP * .MS0 DEF MS0 .MS04 DEF MS0+4 .MS08 DEF MS0+8 SPC 1 .IMGT DEF *+1 ASC 12,DBOPN DBCLS TBGET TBFND ASC 12,TBPUT TBUPD TBDEL TBINF ASC 3,TBULK SPC 2 TMLER LDA .PAR1 RECALL ERROR # ADA =D20 SET IT TO ACTUAL TMS ERROR # STA ERR# JMP ERR GOTO ERROR PROCESSING HED TERMINAL-MONITOR ABORT PROCESSING ABT00 CLA,INA SET SCHEDULE FLAG "WITH WAIT" STA SCHFL SPC 2 LDA IMAGE,I RECALL TMS-IMAGE-MODULE PROGRAM NAME SZA,RSS IMAGE USED ? JMP ABT50 NO, SKIP IMAGE THINGS * LDA IMERC IMAGE IS USED, SET THE IMAGE ERROR STA ERR# JUST IN CASE CLA,INA INIT INDEX INTO BUF STA ABT21 TO,KEEP TRACK OF THE LOCKID RELEASED. * LDA ABT.1 SET UP ADDR. ROUTINE TO UNLOCK STA .IMU2 ALL RECORDS OWN BY THIS TMS LDA ABT.4 APPLICATION. STA .IMU4 JMP IMULK GO RETREIVE ALL LOCKID'S USED SPC 1 ABT.1 DEF *+1 ABT10 NOP STA ABT22 SAVE A REGISTER STX ABT23 SAVE X REGISTER LDA B,I GET THE LOCKID WORD STA TEMP AND SAVE IT AND PIDMK ISOLATE PID (CLEAR DB#) SZA,RSS LOCKID WORD HERE ? JMP ABT17 NO, CONTINUE LDY ABT21 YES, SET UP Y INDEX REG. ABT13 DSY END OF BUFFER ? RSS NO, CHECK IF THE LOCKID IS ALREADY IN BUF JMP ABT15 YES, THIS IS A NEW LOCKID, DO THE UNLOCK LBY BUF+1 RECALL LOCKID ALREADY RELEASED CPB TEMP IS IT THE SAME ? JMP ABT17 YES, ALREADY RELEASED, FORGET IT JMP ABT13 NO, CONTINUE UP TO THE END OF BUF * ABT15 ISZ ABT21 BUMP BUF INDEX LDA ABT21 AND ADD THIS NEW LOCKID CPA =D47 BUF OVERFLOW ? JMP ABT.4,I YES, FORGET ALL THE UNLOCK ADA .BUF NO, SAVE THE NEW LOCKID LDB TEMP INTO BUF AND STB A,I JSB IMULO RELEASE THIS LOCKID JMP ABT17 RETURN OK DST BUF ERROR RETURN, SET UP ERROR CODES JSB ERRPR PRINT THE ERROR MESSAGE ABT17 LDA ABT22 RESTORE A REG. LDX ABT23 RESTORE X REG. JMP ABT10,I AND SEARCH THE NEXT LOCKID USED * ABT21 NOP ABT22 NOP ABT23 NOP PIDMK OCT 17777 SPC 1 ABT.4 DEF *+1 CLB,INB CLOSE ALL DATA-BASES OPEN ABT43 STB ABT21 BLF,BLF ROTATE DB# INTO BITS 15-13 BLF,RBL CLA,INA CLOSE DATA BASE REQUEST JSB IMRQT JMP ABT50 THE LAST DATA BASE HAS BEEN CLOSED JMP ABT46 RETURN OK, TRY TO CLOSE THE NEXT ONE DST BUF SET UP IMAGE ERROR CODES JSB ERRPR AND PRINT ERROR MESSAGE * ABT46 LDB ABT21 CLOSE THE NEXT DATA BASE INB JMP ABT43 SPC 2 ABT50 LDA LOGXX,I IS A LOGGING DEVICE OR FILE SZA,RSS DEFINED ? JMP ABT52 NO, SKIP DCLOG CLOSE CLA,INA YES, SET FLAG TO 1 FOR CLOSE LDB LOGXX GET LOG DEVICE ADDR STB OPLO2 JSB OPLOG CLOSE LOG FILE/DEV OPLO2 BSS 1 DEF LU SZA ERROR? JSB LOGER YES, GO SHIT SPC 2 ABT52 JSB OUTLF OUTPUT ONE BLANK LINE SPC 1 JSB STPPR STOP ALL PROGRAM OF THE APPLICATION SPC 1 JSB RECLS RELEASE ALL TMS CLASS I/O * * ENABLE REQUE COUNT CHECK IN #REQU * LDA TQSAV STA #QCNT SPC 1 ABT3 LDA @$END MOVE "$END" INTO MESSAGE LDB @MSBX MBT D10 JSB EXEC PRINT " /XXXX: $END" DEF *+5 DEF D2 DEF LU DEF MSBU DEF D7 * LDA LU SET TERMINAL TIME OUT TO 0 IOR =B2200 STA TEMP JSB EXEC DEF *+4 DEF D3 DEF TEMP DEF D0 SPC 1 JSB EXEC ABORT TMSYS ITSELF DEF *+4 DEF D6 DEF D0 DEF D0 KILL TMS MAIN PROGRAM !! HLT 67B SPC 2 ABTFL OCT 125252 TQSAV BSS 1 SAVE INITIAL REQU# COUNT @MSBU DBL MSBU @MSB1 DBL MSBU+1 MSBU ASC 5, /XXXXX: ASC 16, @$END DBL *+1 ASC 5,$END HED ABORT ALL PROGRAMS OF THE APPLICATION STPPR NOP STOP ALL PROGRAM LDA ABTCD GET ABORT CODE (17) STA SCODE SET SPECIAL ABORT INDICATOR CLA SIGNAL TO 'TMLIB' THAT THERE IS STA #DFCB NO CB'S TO RECEIVE !! STA EPAOS NO ENTRY POINT ADDR OF SUBROUTINE !! SPC 1 LDA .TMST JSB SCHUP ABORT "TMST" PROG. HLT 70B JSB EXEC REMOVE THE TMS-TIMER FROM DEF *+6 THE TIME LIST DEF D12 DEF .TMST,I PROGRAM NAME DEF D1 RESOLUTION CODE ( 1/100 SEC) DEF D0 EXECUTION MULT. (ONLY ONCE) DEF DM1 START IT NEXT TBG'S TIC * LDA .TMSL JSB SCHUP ABORT "TMSL" PROG. HLT 71B * LDA .TMPR,I SETUP TO ABORT ALL TMS PROGRAM CMA,INA * STPP5 STA $CVTX ABORT ALL TM PROGRAM ADA .TMPR,I I.E.: ALL PROGRAM DECLARED IN MPY UPTEN THE TMSGN TABLE, MULTIPLY BY ENTRY LEN INA ADA .TMPR JSB SCHUP SHEDULE USER PROG TO ABORT IT HLT 72B * LDA $CVTX INA,SZA JMP STPP5 LOOP UNTIL END JMP STPPR,I * ABTCD DEC 17 SPC 3 $CVTX NOP CONVERSION PROGRAM SEZ,RSS IS NUMBER OCTAL? JMP CVTX1 YES, CONVERT USING $CVT3 * STA $CVTZ NO, DECIMAL, USE JASC JSB JASC DEF *+5 DEF $CVTZ DEF $CVTY DEF D1 DEF D6 JMP CVTX2 * CVTX1 JSB $CVT3 LDB .CVTY MVW D3 CVTX2 LDA .CVTY JMP $CVTX,I * MINZE OCT 6400 MINUS SIGN WHEN IOR'ED WITH BLANK .CVTY DEF $CVTY $CVTY BSS 3 $CVTZ NOP SPC 2 RECLS NOP RELEASE ALL TMS CLASS I/O SPC 1 * SET ALL INTERACTIVE LUS TO EQT 0 TO KILL ALL IO * REQUESTS * LDA STA33,I GET NO. OF INTERACTIVE LUS CMA,INA NEGATE STA #LU SAVE LDA STA31 GET ADDR OF LU TABLE IN HEADER PROGRAM STA TEMP1 SAVE LDA .SCOD GET DESTINATION ADDR OF EQT TABLE STA TEMP2 * RECL1 JSB DRTEQ GET EQT FROM LU DEF *+2 DEF TEMP1,I LU # AND O77 GET EQT# (RETURNED IN LOWER SIX BITS OF A REG) CCE DECIMAL FLAG JSB $CVTX CONVERT EQT# TO ASCII ADA D2 ASCII NO. ADDR IN A REG, POINT TO TWO LEAST SIG DIGITS LDA A,I GET ASCII NO. STA TEMP2,I SAVE IN EQT TABLE STA EQUP+2 SAVE IN "UP,XX" MESSAGE STA EQDN+2 SAVE IN "DN,XX" MESSAGE LDA TEMP1,I GET LU NO. CCE DECIMAL FLAG JSB $CVTX CONVERT LU# TO ASCII ADA D2 POINT TO TWO LEAST SIG DIGITS LDA A,I GET ASCII NO. STA TEMP1,I STORE BACK IN LU TABLE STA LUEQ+2 STORE IN MESSAGE JSB MESSS ISSUE "LU,XX,0" DEF *+3 DEF LUEQ DEF D8 JSB MESSS ISSUE "DN,XX" DEF *+3 DEF EQDN DEF D6 JSB MESSS ISSUE "UP,XX" DEF *+3 DEF EQUP DEF D6 * ISZ TEMP1 POINT TO NEXT LU ISZ TEMP2 POINT TO NEXT EQT SLOT ISZ #LU LAST LU? JMP RECL1 NO, KEEP GOING SPC 1 LDA MCLAS RELEASE MAIN CLASS I/O JSB KLCLX SPC 1 LDA ICLAS RELEASE INTERNAL CLASS I/O JSB KLCLX SPC 1 LDA CLASS RELEASE EXTERNAL CLASS I/O JSB KLCLX SPC 1 LDA CLAS0 RELEASE TRUE COMMON CLASS I/O JSB KLCLX SPC 1 LDA FMPCL RELEASE TMS-FMP CLASS I/O JSB KLCLX SPC 1 * POINT LUS BACK TO THEIR ORIGINAL EQT'S * LDA STA33,I GET NO. OF LUS CMA,INA STA #LU SAVE LDA STA31 GET ADDR OF LU TABLE IN HEADER PROGRAM STA TEMP1 SAVE LDA .SCOD GET ADDR OF EQT TABLE STA TEMP2 RECL2 LDA TEMP1,I GET ASCII LU NO. STA LUEQ+2 SAVE IN MESSAGE BUFFER LDA TEMP2,I GET ASCII EQT NO. STA LUEQ+4 SAVE IN MESSAGE BUFFER JSB MESSS ISSUE "LU,XX,YY" MESSAGE DEF *+3 DEF LUEQ DEF D10 ISZ TEMP1 POINT TO NEXT LU ISZ TEMP2 POINT TO NEXT EQT ISZ #LU LAST LU? JMP RECL2 NO, CONTINUE JMP RECLS,I YES, RETURN SPC 1 LUEQ ASC 5, LU,00,000 EQUP ASC 3, UP,00 EQDN ASC 3, DN,00 SPC 2 KLCLX NOP STA KLCL5 JSB KLCLS DEF *+2 DEF KLCL5 SZA HLT 73B JMP KLCLX,I * KLCL5 NOP HED UTILITY SUBROUTINE * EMA UTILITY * =========== SPC 1 EMATB DEC 1 ONE DIMENSION ARRAY DEC -1 LOWER BOUNDS WPELE DEC 10 # WORDS/ELEMENT DEC 0,0 OFFSET SPC 1 * LDA CBLAD CB LOGICAL ADDR. (FROM THE STACK) * JSB GCBAD MAP IN C.B. (1025 WORDS ONLY) * A = ADDR OF WORD CBX(1) (1ST USER WORD) * B,X & Y ARE NOT MODIFIED * GCBAD NOP SZA,RSS CB ALLOCATED ? JMP GCBAD,I NO, FORGET IT DST GCBA0 SAVE A & B REG. CXA SAVE X & Y REG. SINCE EMA SOFTWARE CYB USE THEM, THIS IS THE FASTEST WAY DST GCBA1 TO DO IT. JSB .EMAP CALL EMA ROUTINE DEF *+4 DEF $TMSA EMA NAME DEF EMATB EMA TABLE DEF GCBA0 SUBSCRIPT VALUE (LOGICAL CB ADDR.) JSB ERR0 LDA B SET TRUE ADDR INTO A ADA CBOVH SKIP CB INTERNAL THINGS LDB GCBA0+1 RESTORE B REG. LDX GCBA1 RESTORE X REG. LDY GCBA1+1 RESTORE Y REG. JMP GCBAD,I AND RETURN * GCBA0 BSS 2 GCBA1 BSS 2 * MCBOV DEC -5 SPC 1 * LDA CBLAD CB LOGICAL ADDR. (FROM THE STACK) * LDB CBLEN CB LENGTH IN WORDS * JSB MAPCB MAP THE ENTIRE CB * A = ADDR OF WORD CBX(1), (1ST USER WORD) * B IS UNCHANGED * MAPCB NOP GET ACTUAL ADDR. OF A CB * CHECK FOR 1025 ( 1020 IN FACT) TO USE .EMAP JSB GCBAD JMP MAPCB,I TEMPORARILY !!!!!!!!!!!!!!!!!!!!!!! ADB CBOVH FOR INTERNAL STAFF DST ACBA0 JSB .EMIO CALL EMA ROUTINE DEF *+4 DEF ACBA0+1 BUFFER LENGTH DEF EMATB EMA TABLE DEF ACBA0 SUBSCRIPT VALUE JSB ERR0 ERROR RETURN LDA B SET A=ACTUAL ADDR ADA CBOVH SKIP INTERNAL STAFF LDB ACBA0+1 RESTORE B REG. ADB MCBOV JMP MAPCB,I AND RETURN * ACBA0 BSS 2 SPC 2 * LDA PT ADDR WHERE THE LOGICAL ADDR. IS * TO BE SAVE ( PT INTO THE STACK) * LDB CBLEN CB LENGTH IN WORDS * JSB ALCB PERFORM THE ALLOCATION AND IF * SUCCESFULL SETUP CB INTERNAL POINTER * AND SAVE CB LOGICAL ADDR. INTO A REG. * ADDRESS. * (P+1) MEMORY SUSPEND RETURN, B=# OF ELEMENT * OF MEMORY REQUIRED * (P+2) RETURN OK, A=ADDR. OF CBX(1) (1ST USER WORD) * AND THE FIRST 1025 WORDS ARE MAPPED. SPC 1 ALCB NOP STA ALCB1 SAVE ADDR IN THE STACK LDA FSTBT RECALL FIRST BIT # OF BIT TABLE JSB ALCB0 AND GO FIND A HOLE IN THE BIT TABLE SSB OK ? JMP .ER13 NO, NEVER OK --> ABORT TMS LDB ALCB4 RECALL # OF ELEMENT REQUIRED SSA IS IT OK NOW ? JMP ALCB,I NO, WAIT --> MEMORY SUSPEND ISZ ALCB YES, SET RETURN ADDR STA ALCB3 AND SAVE THE LOGICAL ADDR OF THE CB * JSB BITST SET THAT PIECE OF MEMORY ALLOCATED DEF *+5 BY SETTING CORESPONDING BITS TO 1 DEF .BITB,I BIT TABLE ADDR DEF ALCB3 STARTING BIT OF THE ZONE DEF ALCB4 NUMBER OF BIT TO SET DEF D1 VALUE TO SET THE BIT * LDA ALCB3 RECALL LOGICAL ADDR OF CB JSB GCBAD MAP THE FIRST 1025 WORDS OF IT ADA DM1 AND INITIALIZE THE 5 FIRST WORDS LDB ALCB2 STB A,I CB LENGTH IN WORDS (-1) ADA DM1 LDB Q STB A,I CURRENT Q VALUE (-2) ADA DM1 LDB ALCB1,I RECALL LOGICAL ADDR OF STB A,I PREVIOUS COMMON BLOCK (-3) ADA DM1 LDB ALCB1 ADDR WHERE THAT CB IS SAVED (-4) STB A,I LDB ALCB3 STORE LOGICAL ADDR. OF THIS CB STB ALCB1,I WHERE IT SHOULD BE SAVED (STACK USUALLY) ADA DM1 LDB ALCB4 RECALL CB LENGTH IN STB A,I NUMBER OF ELEMENT (-5) ADA CBOVH RESTORE CB ADDR. OF CBX(1) (1ST USER WORD) JMP ALCB,I * ALCB1 NOP ALCB2 NOP ALCB3 NOP ALCB4 NOP ALCB5 NOP SPC 2 ALCB0 NOP STA ALCB5 SAVE 1ST BIT # IN THE TABLE STB ALCB2 SAVE CB LENGTH IN WORDS LDA B GET CB LENGTH ADA CBOVH AND ADD LENGTH FOR INTERNAL CB DATA CLB TO COMPUTE LEN IN NUMBER OF ELEMENT DIV WPELE BY DIVIDING BY THE # OF WORDS / ELEMENT SZB IF REMAINDER NOT ZERO INA NEED ONE MORE ELEMENT STA ALCB4 SAVE LENGTH IN # OF ELEMENT CMA,INA AND CHECK THAT THIS LENGTH ADA LSTBT DOES NOT EXEED THE TOTAL LENGTH SSA EVER AVAILABLE .ER13 JSB ERRAB TOO BAD. CB IS TOO BIG --> ABORT TMS JSB BITSR SEARCH INTO THE BIT TABLE DEF *+5 FOR A HOLE BIG ENOUGH .BITB NOP BIT TABLE ADDR DEF ALCB5 FIRST BIT NUMBER OF THE TABLE DEF LSTBT LAST BIT NUMBER OF THE TABLE DEF ALCB4 NUMBER OF BIT NEEDED JMP ALCB0,I SPC 2 * THIS SUBROUTINE RELEASE ALLOCATED COMMON-BLOCK * * IT RELEASES CB WITH A "CURRENT Q VALUE" > Q, * IF RECURSIVE ALLOCATION EXIT, THIS SUBROUTINE * WILL LINK THE NEW CB IN PLACE OF THE CURRENT ONE, * THE MEMORY OCCUPIED BY THE DEALLOCATED CB IS * RELEASED AND THE TOTAL MEMORY RELEASED (IN NUMBER * OF ELEMENT) IS SAVED IN TEMP. SPC 1 RLCB NOP LDX D5 INIT X REG TO CHECK ALL CB'S CLA INIT # OF ELEMENT IN MEMORY RELEASED STA TEMP * RLCB2 LAX PT,I GET ACTUAL CB ADDR. SZA,RSS CB ALLOCATED ? JMP RLCB8 NO, CHECK NEXT ONE STA ALCB3 YES, SAVE LOGICAL ADDR. JSB GCBAD MAP THE 1025 FIRST WORDS OF THIS CB ADA DM2 CHECK IF DE-ALLOCATED LDB A,I IS NEEDED, GET Q AT TIME CMB,INB OF ALLOCATED ADB Q Q NOW - Q AT ALLOC. TIME SSB,RSS DEALLOCATED NEEDED ? JMP RLCB8 NO, CHECK NEXT ONE ADA DM1 YES, RESOLVE RECURSIVE ALLOCATION LDB A,I GET ACTUAL CB ADDR. OF PREVIOUS LEVEL SBX PT,I AND PUT IT IN THE STACK ADA DM2 LDB A,I GET # OF ELEMENT STB ALCB4 SAVE IT TO CLEAR THOSE BITS ADB TEMP AND ACCUMULATE THIS TO KNOW HOW MANY STB TEMP ELEMENTS HAVE BEEN RELEASED * JSB BITST CLEAR BITS IN THE BIT TABLE DEF *+5 DEF .BITB,I BIT TABLE ADDR DEF ALCB3 STARTING BIT NUMBER DEF ALCB4 # OF BITS TO BE CLEARED DEF D0 CLEAR THE BITS, AND CHECK AGAIN JMP RLCB2 FOR THE NEW CB ADDR. (RECURSIVE ALLOC.) * RLCB8 DSX MORE COMMON BLOCK JMP RLCB2 YES, CONTINUE JMP RLCB,I NO, RETURN * FSTBT NOP FIRST BIT NUMBER OF THE BIT TABLE LSTBT NOP LAST BIT NUMBER OF THE BIT TABLE SKP * ENABLE/DESABLE COMMON BLOCK ROUTINE: * ------------------------------------- SPC 1 * 'STKPT' & 'Q' VARIABLE MUST BE SET UP BEFORE * USING ANY OF THE FOLLOWING ROUTINE. * * LDB CB# B=CB NUMBER * JSB COM.U * RETURN (P+1) * A=ACTUAL ADDR INTO EMA ARRAY * B=CURRENT LENGTH WITH BIT15=ENABLE FLAG * Y=INDEX TO GET LOGICAL ADDR FROM STACK * LCBLP=ADDR OF LOCAL CB LENGTH IN THE STACK * CCBLP=ADDR OF CURRENT CB LENGTH IN THE STACK SPC 1 COM.U NOP COMMON BLOCK ENABLE/DISABLE UTILITY CBY Y=CB # ISY TO ACCESS CORRESPONDING LOGICAL ADDR BLS MPY D2 ADB QCBLA ADD DISPLACEMENT FROM Q TO CB1 LOCAL ADDR ADB Q ADD Q VALUE TO GET POINTER IN THE STACK STB LCBLP SAVE POINTER TO LOCAL CB LENGTH ADB DM1 STB CCBLP SAVE POINTER TO CURRENT CB LENGTH LAY STKPT,I GET LOGICAL CB ADDRESS FROM STACK JSB GCBAD MAP THE 1025 FIRST WORDS OF THE CB LDB B,I GET CURRENT CB LEN & BIT15=ENABLE FLAG JMP COM.U,I * LCBLP NOP CCBLP NOP SPC 1 COM.E NOP ENABLE ONE COMMON BLOCK JSB COM.U SET A,B,Y,CCBLP & LCBLP, MAP 1ST 1025 WORDS CPB BIT15 B=CURRENT LEN., DOES LOCAL CB EXIST ? JMP CO4.E NO, EXIT WITOUT ALLOCATION SZA ALLOCATED ? JMP CO2.E YES, IT IS ALLOCATED SSB,RSS NO, ENABLE ? HLT 13B YES, ENABLE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CO1.E RBL,CLE,ERB NO, SET BIT15 TO INDICATE ENABLE STB CCBLP,I AND STORE BACK IN THE STACK CYA Y --> A ADA STKPT TO HAVE POINTER INTO THE STACK JSB ALCB ALLOCATE THE MEMORY FOR THE CB JMP COM.E,I RETURN P+1, PUT IN MEMORY SUSPEND ! CO9.E ISZ COM.E RETURN OK (P+2) JMP COM.E,I * CO2.E SSB,RSS ALREADY ENABLE ? JMP CO5.E YES, IT MUST BE A LOCAL ENABLE RBL,CLE,ERB NO, SET BIT15 TO INDICATE ENABLE STB CCBLP,I AND STORE CURRENT LENGTH IN THE STACK CMB,INB STA COM.U SAVE A ADA DM1 VERIFY CURRENT LENGTH VS ACTUAL SIZE LDA A,I GET ACTUAL SIZE ADB A ACTUAL SIZE - LOCAL SIZE SSB ACTUAL GREATER ? STA CCBLP,I NO, CHANGE CURRENT SIZE TO ACTUAL SIZE LDA COM.U YES, RESTORE A TO ACTUAL COMMON ADDR JMP CO9.E SPC 1 CO4.E CLA INDICATE NO ALLOCATION DONE JMP CO9.E * CO5.E ADA DM2 LOCAL ENABLE PROCESS LDA A,I CPA Q SECOND ENABLE IN THE SAME ROUTINE ? .ER06 JSB ERRAB YES, ERROR # 6 --> ABORT TMS JMP CO1.E NO, PERFORM RECURSIVE ALLOCATION OF CB SPC 3 COM.D NOP DESABLE ONE COMMON BLOCK JSB COM.U SZA,RSS ALLOCATED ? .ER16 JSB ERRAB NO, NOT ALLOCATED, ERROR !! SSB YES, ENABLE ? .ER17 JSB ERRAB NO, NOT ENABLED, ERROR !! * ADA DM2 LDB =B77777 SET A LARGE Q VALUE STB A,I TO RETURN MEMORY WITH 'CLECO' ROUTINE ADA DM1 LDB A,I CHECK FOR RECURSIVE ENABLE CCE,SZB RECURSIVELY ENABLED ? JMP COM.D,I YES, SO LEAVE THIS CB ENABLED LDB CCBLP,I NO, INDICATE THAT CB IS RBL,ERB NOW DISABLED. STB CCBLP,I JMP COM.D,I RETURN SPC 3 MEMOK NOP A=POINTER TO CB LOCAL ADDR STA TEMP1 SAVE IT * LDA =D12 INIT MEMORY NEEDED (12) FOR STA SPR38 THE 11 WORDS BLOCK (SUB-PRO LAUNCH) CLA,INA SET UP 1ST BIT NUMBER STA TEMP2 CLA INIT STA TEMP3 TOTAL NUMBER OF ELEMENT NEEDED STA TEMP4 FAIL/SUCCES FLAG (0=OK) * MEMO3 LDA TEMP1,I SZA,RSS CB DEFINED HERE ? JMP MEMO6 END OF CALLING SEQUENCE: NO MORE CB'S JSB GECB# YES, RETREIVE CB # JSB COM.U INIT A,B AND Y REG., MAP THE FIRST 1025 WORDS RBL,CLE,ERB CLEAR BIT 15 OF CB LENGTH IN WORD LDA TEMP2 RECALL STARTING BIT NUMBER JSB ALCB0 AND TRY TO ALLOCATE MEMORY LDB ALCB4 RECALL CB LENGTH IN # OF ELEMENT SSA,RSS ALLOCATION OK ? JMP MEMO4 YES, CONTINUE STA TEMP4 NO, SET FAIL FLAG LDA LSTBT AND SET FIRST BIT TO LAST BIT NUMBER JMP MEMO5 MEMO4 ADA B COMPUTE THE NEW FIRST BIT NUMBER MEMO5 STA TEMP2 SET NEW FIRST BIT NUMBER ADB TEMP3 ACCUMULATE NEEDED NUMBER OF ELEMENT STB TEMP3 INTO TEMP3 LDA ALCB2 RECALL CB LEN IN WORDS (SAVED BY 'ALCB0') LDB SPR38 RECALL OLD MAX CB LENGTH CMB,INB TO SAVE INTO 'SPR38' THE MAXIMUM CB LEN ADB A CURRENT CB LENGTH - MAX CB LEN SSB,RSS CURRENT - MAX >= 0 ? STA SPR38 YES, SET NEW MAXIMUM CB LEN ISZ TEMP1 GET NEXT CB FROM THE CALLING SEQUENCE JMP MEMO3 AND CONTINUE * MEMO6 LDA TEMP4 RECALL THE FLAG SZA,RSS OK ? JMP MEMOK,I YES, RETURN SPC 1 * PUT THAT PROCESS IN MEMORY SUSPEND * ---------------------------------- SPC 1 MSU05 LDB TEMP3 RECALL THE TOTAL # OF ELEMENT REQUIRED MSU10 LDA MSUFL RECALL MEMORY SUSP. FLAG SZA SUSPEND OK ? JMP MSU20 NO, DO NOT SUSPEND THE PROCESS LDA STKPT YES, SUSPEND CURRENT PROCESS ADA =D7 SAVE # OF ELEMENT REQUIRED STB A,I IN THE STACK INA SAVE ALSO CURRENT SUBROUTINE CODE LDB SCODE IN THE STB A,I STACK INA STA TEMP SAVE ADDR OF THE LINK WORD * LDB .MSUP MEMORY SUSPEND QUEUE HEAD MSU12 LDA B,I SZA,RSS JMP MSU14 END OF QUEUE LDB A LOOP UNTIL JMP MSU12 END OF QUEUE IS REACHED * MSU14 STA TEMP,I SET END OF QUEUE IN THE NEW LINK LDA TEMP AND LINK STA B,I NEW STACK IN THE QUEUE. * LDA ..PA1 SAVE CALLING SEQUENCE PARAMETERS LDB S IN THE STACK MVW D10 THERE IS ALWAYS 10 EXTRA FREE WORDS JMP IDLE ON THE STACK ! GOTO IDLE LOOP SPC 1 MSUCD DEC 21 MSUFL NOP MEMORY SUSPEND FLAG (0 --> SUSP.) .MSUP DEF *+1 MEMORY SUSPEND QUEUE HEAD OCT 0 SPC 2 MSU20 LDB Q DO NOT SUSPEND THAT PROCESS, RETURN INB TO THE PROCESS AT THE SPECIAL STA B,I RETURN ADDR. PROVIDED IN THE JMP EXITZ CALLING SEQUENCE. SPC 3 DSTAK NOP DE-STACK ONE LEVEL LDA Q ADA DM1 A IS THE NEW S REGISTER LDB A,I GET MINUS DELTA Q ADB Q B IS THE NEW Q REGISTER DST STKPT,I SAVE S & Q REGISTER IN THE STACK DST S SET NEW S & Q VALUE JMP DSTAK,I SPC 2 CLECO NOP CLEAR ALL NEEDED COMMON BLOCK LDB STKPT RELATED TO THE STATE OF INB THE STACK. STB PT INB POINTER TO ACTUAL ADDR. OF CB1 LDA B,I GET CB1 ADDR JSB GCBAD MAP 1025 FIRST WORDS OF THAT CB LDA A,I GET LU ASSOCIATED WITH THAT STACK ADB =D5 STA B,I AND SAVE IT INTO THE STACK (INTO TEMP1) * JSB RLCB RELEASE THE MEMORY * LDA TEMP MEMORY HAS BEEN RELEASED ? SZA,RSS JMP CLECO,I NO MEMORY RETURNED. CMA,INA MAKE # OF ELEMENT AVAILABLE STA TEMP NEGATIVE. SPC 1 LDB .MSUP TRY TO RESTART SOME PROCESSES * CLEC8 LDA B,I SZA,RSS END OF MEMORY SUSPEND QUEUE ? JMP CLECO,I YES, EXIT STB TEMP1 SAVE QUEUE POINTER STA B ADA =D-2 TO GET REQUESTED LEN LDA A,I A = PROCESS REQUESTED MEMORY LEN ADA TEMP ENOUGH AVAILABLE ? SSA,RSS JMP CLEC8 NO, TRY ANOTHER PROCESS * STA TEMP AJUST FREE MEMORY LEN LDA B,I DEQUEUE THIS PROCESS STA TEMP1,I BY LINKING NEXT ONE CLA STA B,I CLEAR LINK WORD IN THIS STACK LDA SCODE SAVE CURRENT PROCESS SUBROUTINE CODE STA TEMP2 LDA STKPT AND SAVE CURRENT PROCESS STACK ADDR STA TEMP3 LDA MSUCD SET MEMORY SUSPEND SUBROUTINE CODE STA SCODE ADB =D-9 STB STKPT JSB WRI/O REQUEUE THIS PROCESS TO RESTART IT LDA TEMP2 RESTORE CURRENT PROCESS PARAMETERS STA SCODE (SUBROUTINE CODE AND STACK POINTER) LDA TEMP3 STA STKPT LDB TEMP1 RESTORE MEMORY SUSPEND QUEUE POINTER JMP CLEC8 AND LOOP UNTIL END OF QUEUE SPC 2 * RETREIVE THE NUMBER OF THE COMMON BLOCK FROM * THE LOCAL CB ADDR * THIS ROUTINE MUST NOT BE USED FOR CB # 1 * * LDA LCBAD A=LOCAL CB ADDR * JSB GECB# * RETURN (P+1) * B = CB# * * IF THE CB IS NOT FOUND, THE TMS APPLICATION * IS ABORTED WITH ERROR # 15 SPC 1 GECB# NOP GET CB# FROM LOCAL CB ADDR. IN A REG STA RELBU SAVE LOCAL CB ADDR CLA INIT THE CB # STA TEMP LDA Q ADA QCBLA TO ACCESS THE FIRST CB LOCAL ADDR LDX A,I GET CB1 LOCAL ADDR * GEC3# INA BUMP STACK POINTER CPA S END OF STACK ? .ER15 JSB ERRAB YES, UNKNOWN OR ILLEGAL CB ADR, ERROR !! ISZ TEMP BUMP CB # INA TO ACCESS LOCAL CB LENGTH LDB A,I GET CB LOCAL LENGTH SZB,RSS LOCAL LENGTH NUL ? JMP GEC3# YES, GO TO NEXT CB XBX X=CB LENGTH, B=CB LOCAL ADDR. ADX B MAINTAIN X=LOCAL CB ADDR CPB RELBU IS IT THIS CB ? RSS YES, CHECK FOR CB # 1 JMP GEC3# NO, CONTINUE LDB TEMP RECALL CB# CPB D1 IS IT CB1 ? JMP .ER15 YES, IT MUST NOT BE --> ABORT TMS JMP GECB#,I NO, RETURN WITH B=CB# SPC 3 RELBU NOP RELEASE BUFFER CLASS JSB EXEC DEF *+8 DEF D21 DEF CLASS DEF BUF DEF D10 DEF TEMP DEF TEMP1 DEF TEMP2 SSA HLT 74B JMP RELBU,I SPC 2 SETST NOP SAVE STATUS & TLOG INTO CB1 WORD 4 & 5 CAX SAVE A INTO X REG LDA STKPT SETUP TO SAVE STATUS & TLOG SZA,RSS STACK DEFINED ? JMP SETST,I NO, FORGET IT ADA D2 YES, ACCESS FIRST COMMON BLOCK LDA A,I GET COMMON LOGICAL ADDR SZA,RSS CB1 ALLOCATED ? JMP SETST,I NO, FORGET IT JSB GCBAD YES, MAP THE CB TO STORE STATUS & TLOG XAX RESTORE STAT IN A, SET X=CB ADDR SAX 3B STORE STATUS SBX 4B STORE TLOG JMP SETST,I SPC 2 WRI/O NOP EXECUTE A WRITE/READ CLASS I/O JSB EXEC DEF *+8 DEF D20 WRITE/READ DEF D0 DUMMY LU DEF BUF DUMMY BUFFER DEF WRI/L DUMMY LENGTH DEF STKPT STACK ADDRESS DEF SCODE SUBROUTINE CODE DEF CLASS CLASS WORD JMP WRI/O,I * WRI/L DEC 5 SPC 2 GTCLW NOP GET A CLASS I/O WORD FROM SYSTEM LDA CLASS SAVE THE CLASS WORD STA TEMP3 CLA INIT TO ZERO TO GET ONE CLASS STA CLASS JSB WRI/O DO A WRITE/READ REQUEST LDA CLASS RECALL THE CLASS WORD IOR BIT13 AND MERGE BIT 13 TO NOT DEALLOCATE STA CLASS THE CLASS NUMBER. JSB RELBU RELEASE THE BUFFER CLASS LDA CLASS A REG. IS THE NEW CLASS NUMBER LDB TEMP3 RESTORE WORD "CLASS" STB CLASS JMP GTCLW,I RETURN WITH A=CLASS I/O WORD SPC 2 SCHUP NOP SCHEDULE A USER PROGRAM (GROUPING OF TMSUB) STA SCHU7 SAVE PARTITION NAME ADDR STA SRFLG SET SEND MAIL BOX FLAG LDB SCHFL RECALL SCHEDULE FLAG (0 --> NO-WAIT) LDA A,I GET FIRST 2 CHAR. OF THE NAME OR SSA,RSS CLASS WORD, CLASS WORD ? JMP SCHU3 NO, GO SCHEDULE PROGRAM AND =B17777 YES, CLEAR BIT 15 OF CLASS WORD SZB,RSS WAIT / NO WAIT ? STB SCHU7 NO WAIT, CLEAR THE FLAG LDB ICLAS PUT LOCAL CLASS WORD INSTEAD OF STA ICLAS TMS INTERNAL CLASS WORD STB SCHRQ SAVE TEMPORARILY INTERNAL CLASS WORD * JSB MAILB DEF SCODE #PARG ABS PARLG * LDA SCHRQ RESTORE TMS INTERNAL CLASS WORD STA ICLAS LDA SCHU7 WAIT / NO-WAIT REQUEST ? SZA,RSS JMP SCHU8 NO WAIT REQUEST, RETURN IMMEDIATLY * ISZ SCHU7 REQUEST WITH WAIT OPTION SCHU1 LDA DM2 WAIT UNTIL PRG GO TO 'DORMANT' STATE LDB .SCH2 CHEK ROUTINE ADDR JSB WAIT JMP SCHU1 LOOP UNTIL PRG IS DORMANT * .SCH2 DEF *+1 CHECK ROUTINE ADDR NOP CHECK ROUTINE ENTRY POINT LDA SCHU7,I VERIFY THAT PROGRAM IS NOW 'DORMANT' ADA =D15 XLA A,I GET STATUS AND =B17 ISOLATE STATUS SZA DORMANT ? JMP .SCH2+1,I NO, WAIT LONGER JMP SCHU8 YES, EXIT SPC 1 SCHU3 LDA NAB24 GET NO WAIT - NO ABORT CODE SZB REQUEST WITH WAIT ? LDA NAB23 YES, GET WAIT - NO ABORT CODE STA SCHRQ JSB EXEC SCHEDULE REQUEST DEF *+10 DEF SCHRQ QUEUE SCHEDULE - NO ABORT SCHU7 NOP PROGRAM NAME DEF LU LU USED TO START UP THE TMS APPLICATION DEF CLASS TMS EXTERNAL CLASS I/O WORD DEF MCLAS MAIN CLASS I/O WORD DEF ICLAS TMS INTERNAL CLASS I/O WORD DEF CLAS0 TMS CLASS I/O WORD USED FOR CB0 DEF SCODE BUFFER SEND TO PROGRAM DEF #PAR2 BUFFER LENGTH JMP SCHUP,I ERROR RETURN SCHU8 ISZ SCHUP AND RETURN OK TO USER JMP SCHUP,I * SCHRQ NOP SCHFL NOP NAB23 OCT 100027 NAB24 OCT 100030 #PAR2 ABS PARL2 SPC 2 MAILB NOP SEND/RECEIVE MAIL-BOX TO/FROM TMLIB DST PARM1 LDA MAILB,I CALLING SEQUENCE: JSB MAILB STA MAIL2 ----------------- DEF BUFF BUF ADDR ISZ MAILB DEC 10 BUF LENGTH LDA SRFLG SZA SEND OR RECEIVE ? JMP MAIL5 SEND MAIL BOX JSB EXEC DEF *+7 DEF D21 CLASS I/O GET DEF ICLAS INTERNAL CLASS I/O WORD MAIL2 NOP DEF MAILB,I BUFFER LENGTH DEF PARM1 DEF PARM2 SSA HLT 75B * JSB DMPTM * DEF *+7 * DEF D6 * DEF MAIL2,I * DEF MAILB,I * DEF MES1 * DEF D10 * DEF D1 ISZ MAILB AJUST RETURN ADDR DLD PARM1 JMP MAILB,I MES1 ASC 10,0MTMS REC M.B. * MAIL5 JSB EXEC DEF *+8 DEF D20 WRITE/READ CLASS I/O CALL DEF D0 DUMMY LU DEF MAIL2,I BUFFER ADDR DEF MAILB,I BUFFER LENGTH DEF PARM1 DEF PARM2 DEF ICLAS INTERNAL CLASS I/O WORD SZA WAS IT OK HLT 76B * JSB DMPTM * DEF *+7 * DEF D6 * DEF MAIL2,I * DEF MAILB,I * DEF MES2 * DEF D10 * DEF D1 ISZ MAILB AJUST RETURN ADDR DLD PARM1 JMP MAILB,I MES2 ASC 10,0MTMS SEND M.B. MES3 ASC 10,0MTMS SY C.B. SPC 1 SRFLG NOP SEND/RECEIVE FLAG FOR MAIL-BOX SEND/RECEI. ROUTINE HED CONSTANTS & VARIABLES PARM1 NOP PARM2 NOP * S NOP DO NOT DISTURB NEXT WORDS Q NOP S0 DEC 13,12 (INITIAL S & Q RELATIVE VALUE) TEMP NOP DO NOT DISTURB NEXT WORDS TEMP1 NOP TEMP2 NOP TEMP3 NOP TEMP4 NOP SPC 2 I.TAB DEF *+1,I DEF ILRQ 0 DEF STKPA 1 READ: STACK PARAMETERS DEF IDLE 2 DEF IDLE 3 DEF ILRQ 4 DEF ILRQ 5 DEF CBENB 6 CB ENABLE DEF CBDES 7 CB DISABLE DEF SBCAL 8 DEF DFINE 9 DEF SBRTN 10 DEF STKPA 11 WRITE-READ: STACK PARAMETERS DEF PAUS 12 PAUS REQUEST DEF SPRL 13 SUB-PROCESS LAUNCHING DEF CBLEN 14 CHANGE CB LENGTH DEF SIF 15 SET/RESET STOP-INHIBIT FLAG DEF ILRQ 16 UNLCK-IMAGE FUNCTION (NEVER COME HERE) DEF TMAB 17 ABORT TMS (RQ FROM TMLIB) DEF ILRQ 18 PROCESS LAUNCH FROM 'TMSL' (NEVER RETURN) DEF ILRQ 19 TIMER INTERRUPT (NEVER RETURN) DEF TMSP 20 STOP TMS (RQ FROM TMLIB) DEF ILRQ 21 MEMORY SUSPEND OPERATION DEF DFN10 22 SPECIAL -DEFIN CB'S- OPCODE DEF IMGRQ 23 IMAGE REQUEST STACK PARAMETERS ADDR DEF IDLE 24 LOGGING REQUEST DEF ILRQ 25 TMS STOP IN PROGRESS (NEVER COME HERE) DEF ILRQ 26 TMS "SOFT ABORT" (NEVER COME HERE) SPC 1 C.TAB DEF *+1,I DEF START 0 START: START UP INITIALS PROCESSES DEF EXIT3 1 READ, REQUEUE THE BUFFER & RETURN TO USER DEF IDL02 2 WRITE, RELEASE THE BUFFER & RETURN TO USER DEF IDL02 3 CNTL, RELEASE THE BUFFER & RETURN TO USER DEF IDL00 4 BUF. WRITE, RELEASE BUFFER & FORGET DEF IDL00 5 BUF. CNTL, RELEASE BUFFER & FORGET DEF IDL04 6 CB ENABLE, RELEASE DUMMY BUF. & RETURN TO USER DEF IDL04 7 CB DISABLE, RELEASE DUMMY BUF. & RETURN TO USER DEF IDL06 8 SB CALL, RELEASE DUMMY BUF. & RETURN TO USER DEF IDL04 9 CB DEF., RELEASE DUMMY BUF. & RETURN TO USER DEF IDL06 10 SB RTN, RELEASE DUMMY BUF. & RETURN TO USER DEF WRRQ 11 WRITE-READ, DO THE READ DEF IDL04 12 PAUSE, RELEASE DUMMY BUF. & RETURN TO USER DEF IDL06 13 SUB-PROCESS DEF ILRQ 14 CHANGE CB LENGTH DEF ILRQ 15 SET/RESET STP-INHIBIT FLG (NEVER GET HERE) DEF IMULK 16 UNLCK-IMAGE FUNCTION DEF ABTX 17 ABORT TMS (RQ FORM 'TMSL') DEF SPR00 18 PROCESS LAUNCH FROM 'TMSL' DEF PAUS0 19 TIMER INTERRUPT DEF STPX 20 STOP TMS (RQ FROM 'TMSL') DEF MSU50 21 MEMORY SUSPEND OPERATION DEF ILRQ 22 SPECIAL DEFINE OPCODE (NEVER GET HERE) DEF IMRTN 23 IMAGE REQUEST RETURN DEF LOGRT 24 LOGGING REQUEST COMPLETED DEF TMSPX 25 STOP TMS IN PROGRESS DEF STPY 26 TMS "SOFT ABORT" (FROM TMSL) SPC 2 DM900 DEC -900 DM120 DEC -120 DM25 DEC -25 DM23 DEC -23 DM21 DEC -21 DM8 DEC -8 DM6 DEC -6 DM5 DEC -5 DM4 DEC -4 DM3 DEC -3 DM2 DEC -2 DM1 DEC -1 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 D12 DEC 12 D13 DEC 13 D14 DEC 14 D16 DEC 16 D17 DEC 17 D26 DEC 26 D38 DEC 38 D450 DEC 450 D500 DEC 500 D1024 DEC 1024 D19 DEC 19 D20 DEC 20 D21 DEC 21 D22 DEC 22 D24 DEC 24 D40 DEC 40 * DFNS# EQU D9 CBOVH EQU D5 BIT15 OCT 100000 HED *** BUFFER EXCHANGED BETWEEN TMLIB & TMSYS *** * BUFFER RECEIVED FROM TMLIB * IDENTIFY THE TMS REQUEST THAT MUST BE EXECUTED SPC 1 LCLAS NOP CLASS I/O USED BY THE PRG. TO SUSP. ITSELF .PAR1 NOP USER PARAMETERS VALUE ARE RECIEVED HERE .PAR2 NOP .PAR3 NOP .PAR4 NOP .PAR5 NOP .PAR6 BSS 10 RQCNT NOP XSUSP NOP SCOD. NOP SUBROUTINE CODE RETURNED BY TMLIB RTRN. NOP RETURN ADDR IN THE USER PARTITION SPC 1 PARLN EQU RTRN.-LCLAS+1 SPC 2 * BUFFERS SEND BY TMSYS TO TMLIB * DEFINE ALL CLASS I/O WORD TO BE USED, * DEFINE THE CB LOCAL ADDR & LENGTH, * AND GIVE SOME USEFUL INFORMATION TOO SPC 1 * 5 PARAMETERS SEND AS PRG PARAMETERS SPC 1 LU NOP LU USED TO START THE TMS APPLICATION CLASS NOP TMS EXTERNAL CLASS I/O WORD MCLAS NOP TMS MAIN CLASS I/O WORD ICLAS NOP TMS INTERNAL CLASS I/O WORD CLAS0 NOP TMS CB0 SPECIAL CLASS I/O WORD SPC 2 * BUFFER PASSES USING THE STRING PASSING FEATURE SPC 1 SCODE OCT 0 TMS INTERNAL SUBR. CODE SEND BACK TO COMPLETE THE RQ FMPCL NOP TMS-FMP CLASS I/O WORD LEN0 NOP CURRENT CB0 LENGTH #DFCB NOP MINUS # OF DEFINED CB'S EPAOS NOP 'ENTRY POINT ADDR OF SUBROUTINE' RTRNA NOP RETURN ADDR / ABORT CODE RNLCK NOP RN# USED BY LURQ STKPT OCT 100001 STACK POINTER LGCLA BSS 5 DCLOG CLASS IO NUMER FPARM BSS 3 FUNCTION PARAMETERS (3 WORDS) BSS 11 CB'S DEFINITION PARLG EQU *-SCODE URNST BSS 19 RUN STRING PASSED BY SCHEDULING PROG, FOR USE * USER OCT 0 SPC 1 PARL2 EQU *-SCODE #FPAR EQU D3 SPC 1 BUF BSS 50 SKP UNS SPC 3 ORG * END