:ST,S,$TC04,5 ASMB,L,C NAM STRT!,7 HED ***TCS UTILITIES (STRT!) - 9/74*** ENT STRT! EXT CB$,CNFIG EXT EXEC EXT GBUF EXT ERR0 EXT CNFGX * * CONDITIONAL COMMON FOR IMAGE/2100 * IFZ COM IMAG1(1024),IMAG2(1),IMAG3(1175),IMAG4(128) XIF COM ISTAT,IPAR,ILU,ILOG A EQU 0 B EQU 1 STRT! NOP LDA B,I STA CBLOK INB LDA B,I STA SYST /SAVE CONFIGURATION ADDRESS INB LDA B,I STA RTRN /SAVE RETURN ADDRESS (MAIN) INA STA RTRN1 /SAVE RETURN ADDRESS(THREAD) INB LDA B,I STA POPR /SAVE ADDRESS OF JSB POP IN MAIN INB LDA B,I STA START /SAVE ADDRESS OF CB PARAMETERS LDA SYST,I /GET JSB TCS/MTO AND =B101777 /ISOLATE BASE PAGE LINK STA MTO /SAVE FOR LOCAL CALLS JSB CNFGX /ENABLE EQT EXTENSION LOGGING DEF *+2 EQTX DEF EQT JSB CNFIG /CONFIGURE SYSTEM DEF *+4 SYST DEF * LUPTR DEF LUT DEF LUCNT * JSB MTO,I DEF *+3 DEF P79$ DEF ISTAT LDA ISTAT SZA OK? JMP ABRT NO. JSB MTO,I DEF *+6 DEF P78$ DEF ISTAT DEF IPAR DEF ILU DEF ILOG * LDA CB$X AND =B77777 LDB A,I /GET ADDRESS OF CB PARAMETERS ADB =B3 /BYPASS SEGMENT NAME LDA B,I STA ICBX1 /SAVE # OF ONLINE DEVICES INB LDA B,I STA ICBX2 /SAVE # OF OFFLINE DEVICES INB LDA B,I CPA LUCNT /ALL UNITS INITIALIZED? RSS /YES JMP ABRT /NO-ABORT INB LDA B,I STA START,I /SAVE LENGTH OF CONTROL BLOCK STA CBL ISZ START LDA MTO /SAVE MTO/TCS LINKAGE STA START,I INB LDA B,I STA BASE ISZ START STA START,I /SAVE CB START LDA ICBX1 ISZ START STA START,I /SAVE IN UTIL ROUTINE ISZ START LDA ICBX2 STA START,I * LDA P01$ STA IPAR * STRT2 LDB BASE LDA LUPTR,I /GET LU SSA /PRIVILEGED DEVICE? JMP STRT5 /NO ADA =B141000 /TYPE+302 RSS STRT5 EQU * JSB FIND /FIND TYPE FOR NON-PRIVILEGED DEV LDB BASE STA TEMP AND =B77 STA B,I /SAVE LU ON CB LDA TEMP ALF,ALF /POSITION TYPE AND =B377 /ISOLATE TYPE INB STA B,I /SAVE ON CB ADB =D2 STB TEMP /SAVE WB PARAMETER ADDRESSES INB STB G1 * JSB GBUF /GET WORK BLOCK DEF *+3 G1 DEF * G2 DEF P01$ STA TEMP,I LDA G1,I SSA /GOT ONE? JMP ABRT /NO. ALF,ALF IOR P01$ STA G1,I LDB BASE ADB =D9 LDA EQTX,I /GET EQT EXTENSION STA B,I /SAVE IN CB10 INB ISZ EQTX LDA =B400 /SET CONTROL WORDS IN CB11 & CB12 STA B,I INB STA B,I * LDB BASE LDA CBLS ADB A /CALCULATE STACK PTR ADDRESS INA STA B,I /INDICATE NO ENTRIES ADA =D2 STA TEMP LDA IPAR CMA,INA ADA ICBX1 SSA /ONLINE DEVICE? JMP STRT1 /NO STRT4 LDA TEMP /YES STA B,I /PUT ONE ENTRY IN STACK ADB =D2 LDA RTRN1 STA B,I LDA CBLOK INB STA B,I * JSB MTO,I DEF *+7 DEF P01$ DEF NWAIT DEF P01$ DEF P01$ DEF IPAR DEF POPR STRT3 LDA BASE /UPDATE CB ADDR ADA CBL STA BASE ISZ LUPTR /INCR LU TABLE PTR ISZ IPAR /INCR THREAD LDA IPAR CMA,INA ADA ICBX2 SSA,RSS /DONE? JMP STRT2 /NO JSB MTO,I DEF *+2 DEF P53$ MTO DEF * POPR DEF * CB$X DEF CB$ ICBX1 NOP ICBX2 NOP ICBP NOP * * STRT1 EQU * LDA IPAR CPA ICBX2 /LAST CB? RSS /YES JMP STRT3 /NO LDA RTRN /CHG RETURN FOR MAIN THREAD STA RTRN1 JMP STRT4 ABRT EQU * JSB EXEC DEF *+5 DEF P02$ DEF P01$ DEF INER DEF P09$ JSB EXEC DEF *+2 DEF COMP COMP DEC 6 **************************************************** FIND EQU * NOP LDA LUPTR,I CMA,INA STA LU CPA =B1 /CONSOLE JMP FIND1 /YES CPA =B77 /NO-DUMMY? JMP FIND2 / YES JSB EXEC /GET DRIVER TYPE DEF *+4 DEF P13$ DEF LU DEF ISTAT LDA ISTAT ALF,ALF AND =B77 STA ISTAT LDB TYPE FIND4 LDA B,I AND =B77 /MASK DRIVER TYPE CPA ISTAT /MATCH? JMP FIND3 /YES INB /NO CPB ENDT /END OF LIST? RSS /YES-DEFAULT TO TERMINAL JMP FIND4 NO-KEEP LOOKING FIND2 LDB TYPE FIND3 LDA B,I RAL,RAL /POSITION DEVICE TYPE AND =B177700 /FORM NEW TYPE/LU WORD IOR LU JMP FIND,I FIND1 LDA =B30000 /SYSTEM CONSOLE JMP FIND3+1 **************************************************** **************************************************** TYPE DEF *+1 OCT 30100 /00 TERMINAL OCT 21301 /01 READER OCT 11402 /02 PUNCH OCT 30005 /05 SYSTEM CONSOLE OCT 31507 /07 READER / PUNCH OCT 21311 /11 READER OCT 11212 /12 PRINTER OCT 11414 /14 PUNCH OCT 21315 /15 READER OCT 31123 /23 MAGTAPE OCT 30126 /26 TERMINAL OCT 11427 /27 PRINTER OCT 31031 /31 DISC OCT 31667 /67 HSI ENDT DEF * **************************************************** LU NOP NWAIT OCT 20077 P01$ DEC 1 P02$ DEC 2 P09$ DEC 9 P13$ DEC 13 P53$ DEC 53 P78$ DEC 78 P79$ DEC 79 CBLOK NOP START NOP RTRN NOP RTRN1 NOP CBL NOP CBLS DEC 16 /CB LENGTH W/O STACK -2 BASE NOP TEMP NOP LUCNT NOP LUT BSS 256 EQT BSS 256 INER ASC 9,INIT ERROR (ABORT) END :: :ST,S,$TC05,5 ASMB,L,C NAM JOIN,7 HED ***TCS UTILITIES (JOIN) - 9/74*** ENT JOIN EXT PUSH,POP,PAUZ,START EXT .ENTR * * CONDITIONAL COMMON FOR IMAGE/2100 * IFZ COM IMAG1(1024),IMAG2(1),IMAG3(1175),IMAG4(128) XIF COM ISTAT,IPAR NOP JOIN NOP JSB .ENTR DEF JOIN JSB PUSH /PUT RETURN ON STACK DEF *+3 DEF JOIN-1 DEF CB LDA IPAR LDB CB-1 ADB P02$ /CALCULATE CB2 CMA,INA ADA B,I /CALCULATE DIFF. BETWEEN THREADS TO BE JOINED MPY START / ADA CB-1 FORM ADDRESS OF OTHER CB ADA P02$ LDB A,I SWP IOR =B100000 /SET FLAG STA B,I /ON OTHER CB JOINX EQU * JSB PAUZ /WAIT FOR OTHER CB DEF *+1 LDB CB-1 ADB P02$ /CALCULATE ADDR OF CB3 LDA B,I SSA,RSS /FLAG SET JMP JOINX /NO RAL,CLE,ERA /YES-CLEAR FLAG STA B,I JSB POP /RETURN TO CALLER NOP CB BSS 7 A EQU 0 B EQU 1 P02$ DEC 2 END :: :ST,S,$TC06,5 ASMB,L,C NAM PCODE,7 HED ***TCS UTILITIES (PCODE) - 9/74*** ENT PCODE A EQU 0 B EQU 1 ******************************************************************************** * * * PCODE SUBROUTINE - ALLOWS CORE TO CORE USE OF FORMATTER * ORIGINAL CALLING SEQ. * * JSB PCODE * DEF *+2 * LDA PTR * CLB * JSB .DIO. * * MODIFIED CALLING SEQ. * * JSB PCODE * DEF PTR-1 * CLB * JSB .DIO. * DEF PTR * * ******************************************************************************** PCODE NOP LDA PCODE INA CPA PCODE,I /FIRST TIME THRU? JMP PCOD1 /YES LDB PCODE /NO LDA B,I LDA A,I ADB P03$ STA B,I ISZ PCODE CLA JMP PCODE,I PCOD1 EQU * LDB PCODE,I LDA B,I /GET LDA PTR[,I] STA INST AND =B101777 STA BASE /SAVE I + 10BIT ADDR STB A AND =B76000 STA PAGE /SAVE UPPER 5 BITS LDA INST AND =B2000 SZA /CURRENT/BASE PAGE? LDA PAGE /CURRENT IOR BASE RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 ADA N01$ LDB PCODE STA B,I /SET POINTER TO ARRAY IN CALLING SEQ. ADB N01$ STB PCODX /SET RETURN ADB P02$ STB PCODE INB LDA B,I /CHANGE STA PCODE,I /FROM---LDA PTR[,I] ISZ PCODE CLB INB JSB .DIO. LDA B,I /TO ---CLB STA PCODE,I JSB .DIO. JMP PCODX,I DEF PTR PCODX NOP * BASE NOP PAGE NOP INST NOP N01$ EQU 52B P02$ EQU 55B P03$ EQU 56B END :: :ST,S,$TC07,5 ASMB,L,C NAM ARRAY,7 HED ***TCS UTILITIES (ARRAY) - 9/74*** ENT ARRAY EXT .ENTR A EQU 0 B EQU 1 * ARRAY DEFINITION * SUBROUTINE REDEFINES DUMMY ARRAY X TO BE ARRAY Y * (DYNAMIC EQUIVALENCE) * JSB ARRAY * DEF *+3 * DEF X * DEF Y * * EXAMPLE * CALL ARRAY(X,Y(1,5)) * X(3)=A+B+C * * X(3) IS ACTUALLY Y(3,5) * ALL REFERENCES TO X MUST BE SUBSCRIPTED, UNLESS USED * IN A READ/WRITE STATEMENT PRECEDED BY A PCODE CALL. NOP NOP ARRAY NOP JSB .ENTR DEF ARRAY-2 CCA ADA ARRAY-2 LDB ARRAY-1 STB A,I JMP ARRAY,I END :: :ST,S,$TC08,5 ASMB,L,C NAM .TAPE,7 HED ***TCS UTILITIES (.TAPE) - 9/74*** ENT .TAPE EXT .ENTR EXT PUSH,POP,TCNTL A EQU 0 B EQU 1 * * THIS ROUTINE IS CALLED BY FORTRAN COMPILED PROGRAMS * WHICH USE TAPE COMMANDS. * REWIND * BACKSPACE * ENDFILE * NOP .TAPE NOP AND MASK STA FUNCT JSB PUSH DEF *+2 DEF .TAPE-1 JSB TCNTL DEF *+4 DEF FUNCT DEF P00$ DEF * JSB POP MASK OCT 7700 FUNCT NOP P00$ EQU 53B END :: :ST,S,$TC09,5 ASMB,L,C NAM ERR0,7 HED ***TCS UTILITIES (ERR0) - 9/74*** ENT ERR0 EXT .MTO ERR0 NOP STA TEXT+5 STB TEXT+7 LDA .MTO STA MTO /LINK WITH TCS/MTO * EXPG EQU 141B * LDA EXPG STA TEXT+1 LDA EXPG+1 STA TEXT+2 LDA EXPG+2 AND 75B IOR =B40 STA TEXT+3 JSB MTO,I DEF *+7 DEF P02$ DEF NWAIT DEF TEXT DEF N16$ DEF P00$ DEF ERR0 JSB MTO,I DEF *+2 DEF P53$ NWAIT OCT 20001 TEXT ASC 5, : ASC 3, # EQU 53B P01$ EQU #+1 P02$ EQU #+2 N16$ DEC -16 P00$ EQU # P53$ DEC 53 MTO NOP END :: :ST,S,$TC10,5 ASMB,L,C NAM GDISC,7 HED ***TCS UTILITIES (GDISC) - 4/75*** ENT GDISC ENT NDISC EXT EXEC,PAUZ,PUSH,POP,.ENTR EXT .RST * * CONDITIONAL COMMON FOR IMAGE/2100 * IFZ COM IMAG1(1024),IMAG2(1),IMAG3(1175),IMAG4(128) XIF COM ISTAT,IPAR,ILU,ILOG A EQU 0 B EQU 1 * * GDISC NOP LDA GDISC /SAVE RETURN STA CDISC JSB COMM GDSC2 JSB FIND /FIND AVAILABLE TRACK JMP GDSC1 /ALL BUSY GDSC3 LDA CTRAK /GOTONE ALF,ALF STA PARM2,I /RET TRACK TO USER LDA N01$ /FLAG AS BUSY STA B,I GDSC4 CLA LDB .RST STA B,I JSB POP GDSC1 JSB NFIND /INDICATE NO FIND JSB PAUZ /WAIT FOR A FREE TRACK DEF *+1 JSB RSTR /RESTOR PARAMETERS JMP GDSC2 /RESUME SEARCH * * NDISC NOP LDA NDISC /SAVE RETURN STA CDISC JSB COMM JSB STPTR /SET POINTERS JSB NEXT /GET NEXT SECTOR RSS /END OF TRACK JMP GDSC4 SEZ /ALLOCATE JMP NDSC1 /NO NDSC3 EQU * JSB FIND /YES-FIND AVAILABLE TRACK JMP NDSC2 /ALL BUSY LDA CTRAK ALF,ALF IOR PTR,I /MERGE NEW TRACK W/LLD TRACK STA PTR,I JMP GDSC3 NDSC1 LDA PTR,I AND LBYT$ STA PARM2,I LDA PARM1,I AND P04$ CLB SZA /FREE? STB PTR,I /YES-CLEAR BUSY LDA PARM2,I SZA,RSS /LAST TRACK? NDSC4 EQU * LDB N01$ /YES LDA .RST STB A,I JSB POP NDSC2 JSB NFIND /INDICATE NO FIND JSB PAUZ /WAIT FOR FREE TRACK DEF *+1 JSB RSTR /RESTOR PARAMETERS JMP NDSC3 * * COMM NOP JMP INIT /GET WORK AREA LIMITS JMP CDISC+1 PARM1 NOP PARM2 NOP CDISC NOP JSB .ENTR DEF PARM1 JSB PUSH /PUT RETURN ON STACK DEF *+3 DEF PARM2 DEF CB+1 LDB CB /SAVE PARAMETERS ON CONTROL BLOCK ADB =D12 LDA PARM1 STA B,I INB LDA PARM2 STA B,I JMP COMM,I * INIT CLA STA COMM+1 /CALL AT INITIALIZE ONLY JSB EXEC /GET LIMITS DEF *+6 DEF P17$ DEF FTRAK DEF LTRAK DEF MSCTR DEF P00$ SYSSC ONLY! KM JMP COMM+1 * FIND NOP LDB FTRAK /SEARCH FROM 1ST TRACK FIND1 STB CTRAK ADB DMAP /CALCULATE DISC MAP ADDRESS LDA B,I SZA,RSS /TRACK AVAILABLE? JMP FINDX /YES LDB CTRAK /NO INB CPB LTRAK /END OF WORK AREA? JMP FIND,I /YES JMP FIND1 /NO FINDX ISZ FIND JMP FIND,I * NEXT NOP LDA PTRC,I /GET TRACK/SECTOR WORD INA /INCR. SECTOR AND RBYT$ CPA MAX MAX VALUE? JMP NEXT,I /YES ISZ PTRC,I /NO-UPDATE SECTOR COUNT IN CORE ALF,ALF IOR CTRAK /MERGE WITH CURRENT TRACK ALF,ALF /RESTORE TRACK/SECTOR POSITION STA PARM2,I /RETURN TO USER NEW VALUE ISZ NEXT /INDICATE SAME TRACK JMP NEXT,I STPTR NOP LDA PARM2,I /SETUP POINTERS ALF,ALF AND RBYT$ ISOLATE TRACK STA CTRAK ADA DMAP /CALCULATE ADDR. OF DISC MAP ENTRY STA PTR LDA PARM1,I AND P02$ SZA /ALLOCATE? JMP SPTR1 /NO-CHAIN CLE /CLEAR FLAG LDB PTR /SET UP FOR TRACK ALLOCATION LDA MSCTR SPTR2 STA MAX STB PTRC LDA PTR,I CPA N01$ /FIRST ACCESS? RSS /YES JMP STPTR,I /NO CLA SEZ /YES-ALLOCATE? JMP NDSC4 /NO-END OF TRACK STA PTR,I /YES-ADJUST SECTOR JMP STPTR,I SPTR1 CCE /SET FLAG LDB PARM2 /SETUP FOR TRACK CHAIN LDA PTR,I AND RBYT$ INA JMP SPTR2 NFIND NOP LDA N01$ /NO FIND IN STATUS LDB .RST STA B,I LDA PARM1,I SLA /WITHOUT WAIT JSB POP /YES-RETURN JMP NFIND,I /NO * * RSTR NOP LDB CB ADB =D12 /RESTOR PARAMETERS LDA B,I STA PARM1 INB LDA B,I STA PARM2 JSB STPTR JMP RSTR,I * PTR NOP FTRAK NOP LTRAK NOP CTRAK NOP MSCTR NOP PTRC NOP MAX NOP P00$ NOP KM P02$ DEC 2 P04$ DEC 4 P16$ DEC 16 P17$ DEC 17 N01$ DEC -1 LBYT$ OCT 177400 RBYT$ OCT 377 CB DEF *+1 BSS 7 DMAP DEF *+1 BSS 256 * END :: :ST,S,$TC11,5 ASMB,L,C NAM BLANK,7 HED ***TCS UTILITIES (BLANK) - 9/74*** ENT BLANK EXT .ENTR ADDR NOP COUNT NOP BLANK NOP JSB .ENTR DEF ADDR LDB COUNT,I CMB,INB LDA =B20040 STA ADDR,I ISZ ADDR INB,SZB JMP *-3 JMP BLANK,I END :: :ST,S,$TC12,5 ASMB,L,C NAM LNGTH,7 HED ***TCS UTILITIES (LNGTH) - 9/74*** ENT LNGTH EXT .ENTR ADDR NOP SIZE NOP LNGTH NOP JSB .ENTR DEF ADDR CCB ADB ADDR ADB SIZE,I /CALCULATE LAST WORD OF ARRAY LDA SIZE,I CMA,INA /FORM NEG. COUNT STA SIZE LNGT1 LDA B,I CPA =B20040 /BLANKS? JMP LNGT2 /YES LDB SIZE /NO CMB,INB /CONVERT TO POSITIVE COUNT RBL /X2 FOR CHARACTERS AND =B377 CPA =B40 /LAST ONE A BLANK ADB =D-1 YES-DECREMENT COUNT STB A JMP LNGTH,I /RETURN WITH ANSWER IN A LNGT2 EQU * ADB =D-1 BACK UP POINTER ISZ SIZE DONE? JMP LNGT1 /NO CLA /YES JMP LNGTH,I A EQU 0 B EQU 1 END :: :ST,S,$TC13,5 ASMB,L,C NAM ENDO,7 HED ***TCS UTILITIES (ENDO) - 9/74*** ENT ENDO EXT .ENTR J NOP K NOP L NOP ENDO NOP JSB .ENTR DEF J LDA J,I ADA L,I /INCR INDEX STA J,I CMA,INA ADA K,I /FORM DIFF. BETWEEN INDEX AND TARGET AND =B100000 /MASK FOR LOGICAL JMP ENDO,I END :: :CO MOUNT TAPE #9, TYPE :GO :PA